config

Personal configuration.
git clone git://code.dwrz.net/config
Log | Files | Refs

ob-lua.el (15163B)


      1 ;;; ob-lua.el --- Org Babel functions for Lua evaluation -*- lexical-binding: t; -*-
      2 
      3 ;; Copyright (C) 2014, 2016-2024 Free Software Foundation, Inc.
      4 
      5 ;; Authors: Dieter Schoen
      6 ;; Keywords: literate programming, reproducible research
      7 ;; URL: https://orgmode.org
      8 
      9 ;; This file is part of GNU Emacs.
     10 
     11 ;; GNU Emacs is free software: you can redistribute it and/or modify
     12 ;; it under the terms of the GNU General Public License as published by
     13 ;; the Free Software Foundation, either version 3 of the License, or
     14 ;; (at your option) any later version.
     15 
     16 ;; GNU Emacs is distributed in the hope that it will be useful,
     17 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
     18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
     19 ;; GNU General Public License for more details.
     20 
     21 ;; You should have received a copy of the GNU General Public License
     22 ;; along with GNU Emacs.  If not, see <https://www.gnu.org/licenses/>.
     23 
     24 ;;; Commentary:
     25 
     26 ;; Org-Babel support for evaluating Lua source code.
     27 
     28 ;; Requirements:
     29 ;; for session support, lua-mode is needed.
     30 ;;
     31 ;; lua-mode is not part of GNU Emacs/orgmode, but can be obtained
     32 ;; from NonGNU ELPA (see `M-x list-packages').
     33 ;;
     34 ;; The source repository is here:
     35 ;; https://github.com/immerrr/lua-mode
     36 
     37 ;; However, sessions are not yet working.
     38 
     39 ;;; Code:
     40 
     41 (require 'org-macs)
     42 (org-assert-version)
     43 
     44 (require 'ob)
     45 (require 'org-macs)
     46 (require 'cl-lib)
     47 
     48 (declare-function lua-shell "ext:lua-mode" (&optional argprompt))
     49 (declare-function lua-toggle-shells "ext:lua-mode" (arg))
     50 (declare-function run-lua "ext:lua" (cmd &optional dedicated show))
     51 
     52 (defvar org-babel-tangle-lang-exts)
     53 (add-to-list 'org-babel-tangle-lang-exts '("lua" . "lua"))
     54 
     55 (defvar org-babel-default-header-args:lua '())
     56 
     57 (defcustom org-babel-lua-command "lua"
     58   "Name of the command for executing Lua code."
     59   :version "26.1"
     60   :package-version '(Org . "8.3")
     61   :group 'org-babel
     62   :type 'string)
     63 
     64 (defcustom org-babel-lua-mode 'lua-mode
     65   "Preferred lua mode for use in running lua interactively.
     66 This will typically be `lua-mode'."
     67   :group 'org-babel
     68   :version "26.1"
     69   :package-version '(Org . "8.3")
     70   :type 'symbol)
     71 
     72 (defcustom org-babel-lua-hline-to "None"
     73   "Replace hlines in incoming tables with this when translating to Lua."
     74   :group 'org-babel
     75   :version "26.1"
     76   :package-version '(Org . "8.3")
     77   :type 'string)
     78 
     79 (defcustom org-babel-lua-None-to 'hline
     80   "Replace `None' in Lua tables with this before returning."
     81   :group 'org-babel
     82   :version "26.1"
     83   :package-version '(Org . "8.3")
     84   :type 'symbol)
     85 
     86 (defcustom org-babel-lua-multiple-values-separator ", "
     87   "Separate multiple values with this string."
     88   :group 'org-babel
     89   :package-version '(Org . "9.7")
     90   :type 'string)
     91 
     92 (defun org-babel-execute:lua (body params)
     93   "Execute Lua BODY according to PARAMS.
     94 This function is called by `org-babel-execute-src-block'."
     95   (let* ((session (org-babel-lua-initiate-session
     96 		   (cdr (assq :session params))))
     97          (result-params (cdr (assq :result-params params)))
     98          (result-type (cdr (assq :result-type params)))
     99 	 (return-val (when (and (eq result-type 'value) (not session))
    100 		       (cdr (assq :return params))))
    101 	 (preamble (cdr (assq :preamble params)))
    102          (full-body
    103 	  (org-babel-expand-body:generic
    104 	   (concat body (if return-val (format "\nreturn %s" return-val) ""))
    105 	   params (org-babel-variable-assignments:lua params)))
    106          (result (org-babel-lua-evaluate
    107 		  session full-body result-type result-params preamble)))
    108     (org-babel-reassemble-table
    109      result
    110      (org-babel-pick-name (cdr (assq :colname-names params))
    111 			  (cdr (assq :colnames params)))
    112      (org-babel-pick-name (cdr (assq :rowname-names params))
    113 			  (cdr (assq :rownames params))))))
    114 
    115 (defun org-babel-prep-session:lua (session params)
    116   "Prepare SESSION according to the header arguments in PARAMS.
    117 VARS contains resolved variable references."
    118   (let* ((session (org-babel-lua-initiate-session session))
    119 	 (var-lines
    120 	  (org-babel-variable-assignments:lua params)))
    121     (org-babel-comint-in-buffer session
    122       (mapc (lambda (var)
    123               (end-of-line 1) (insert var) (comint-send-input)
    124               (org-babel-comint-wait-for-output session))
    125 	    var-lines))
    126     session))
    127 
    128 (defun org-babel-load-session:lua (session body params)
    129   "Load BODY into SESSION."
    130   (save-window-excursion
    131     (let ((buffer (org-babel-prep-session:lua session params)))
    132       (with-current-buffer buffer
    133         (goto-char (process-mark (get-buffer-process (current-buffer))))
    134         (insert (org-babel-chomp body)))
    135       buffer)))
    136 
    137 ;; helper functions
    138 
    139 (defun org-babel-variable-assignments:lua (params)
    140   "Return a list of Lua statements assigning the block's variables.
    141 The variable definitions are defining in PARAMS."
    142   (mapcar
    143    (lambda (pair)
    144      (format "%s=%s"
    145 	     (car pair)
    146 	     (org-babel-lua-var-to-lua (cdr pair))))
    147    (org-babel--get-vars params)))
    148 
    149 (defun org-babel-lua-var-to-lua (var)
    150   "Convert an Emacs Lisp value to a Lua variable.
    151 Convert an Emacs Lisp value, VAR, into a string of Lua source code
    152 specifying a variable of the same value."
    153   (if (listp var)
    154       (if (and (= 1 (length var)) (not (listp (car var))))
    155           (org-babel-lua-var-to-lua (car var))
    156         (if (and
    157              (= 2 (length var))
    158              (not (listp (car var))))
    159             (concat
    160              (substring-no-properties (car var))
    161              "="
    162              (org-babel-lua-var-to-lua (cdr var)))
    163           (concat "{" (mapconcat #'org-babel-lua-var-to-lua var ", ") "}")))
    164     (if (eq var 'hline)
    165         org-babel-lua-hline-to
    166       (format
    167        (if (and (stringp var) (string-match "[\n\r]" var)) "[=[%s]=]" "%S")
    168        (if (stringp var) (substring-no-properties var) var)))))
    169 
    170 (defun org-babel-lua-table-or-string (results)
    171   "Convert RESULTS into an appropriate elisp value.
    172 If the results look like a list or tuple, then convert them into an
    173 Emacs-lisp table, otherwise return the results as a string."
    174   (let ((res (org-babel-script-escape results)))
    175     (if (listp res)
    176         (mapcar (lambda (el) (if (eq el 'None)
    177 				 org-babel-lua-None-to el))
    178                 res)
    179       res)))
    180 
    181 (defvar org-babel-lua-buffers '((:default . "*Lua*")))
    182 
    183 (defun org-babel-lua-session-buffer (session)
    184   "Return the buffer associated with SESSION."
    185   (cdr (assoc session org-babel-lua-buffers)))
    186 
    187 (defun org-babel-lua-with-earmuffs (session)
    188   "Return buffer name for SESSION, as *SESSION*."
    189   (let ((name (if (stringp session) session (format "%s" session))))
    190     (if (and (string= "*" (substring name 0 1))
    191 	     (string= "*" (substring name (- (length name) 1))))
    192 	name
    193       (format "*%s*" name))))
    194 
    195 (defun org-babel-session-buffer:lua (session &optional _)
    196   "Return session buffer name for SESSION."
    197   (or (org-babel-lua-session-buffer session)
    198       (org-babel-lua-with-earmuffs session)))
    199 
    200 (defun org-babel-lua-without-earmuffs (session)
    201 "Remove stars around *SESSION*, leaving SESSION."
    202   (let ((name (if (stringp session) session (format "%s" session))))
    203     (if (and (string= "*" (substring name 0 1))
    204 	     (string= "*" (substring name (- (length name) 1))))
    205 	(substring name 1 (- (length name) 1))
    206       name)))
    207 
    208 (defvar lua-default-interpreter)
    209 (defvar lua-which-bufname)
    210 (defvar lua-shell-buffer-name)
    211 (defun org-babel-lua-initiate-session-by-key (&optional session)
    212   "Initiate a Lua session.
    213 If there is not a current inferior-process-buffer in SESSION
    214 then create.  Return the initialized session."
    215   ;; (require org-babel-lua-mode)
    216   (save-window-excursion
    217     (let* ((session (if session (intern session) :default))
    218            (lua-buffer (org-babel-lua-session-buffer session))
    219 	   ;; (cmd (if (member system-type '(cygwin windows-nt ms-dos))
    220 	   ;; 	    (concat org-babel-lua-command " -i")
    221 	   ;; 	  org-babel-lua-command))
    222 	   )
    223       (cond
    224        ((and (eq 'lua-mode org-babel-lua-mode)
    225              (fboundp 'lua-start-process)) ; lua-mode.el
    226         ;; Make sure that lua-which-bufname is initialized, as otherwise
    227         ;; it will be overwritten the first time a Lua buffer is
    228         ;; created.
    229         ;;(lua-toggle-shells lua-default-interpreter)
    230         ;; `lua-shell' creates a buffer whose name is the value of
    231         ;; `lua-which-bufname' with '*'s at the beginning and end
    232         (let* ((bufname (if (and lua-buffer (buffer-live-p lua-buffer))
    233                             (replace-regexp-in-string ;; zap surrounding *
    234                              "^\\*\\([^*]+\\)\\*$" "\\1" (buffer-name lua-buffer))
    235                           (concat "Lua-" (symbol-name session))))
    236                (lua-which-bufname bufname))
    237           (lua-start-process)
    238           (setq lua-buffer (org-babel-lua-with-earmuffs bufname))))
    239        (t
    240 	(error "No function available for running an inferior Lua")))
    241       (setq org-babel-lua-buffers
    242             (cons (cons session lua-buffer)
    243                   (assq-delete-all session org-babel-lua-buffers)))
    244       session)))
    245 
    246 (defun org-babel-lua-initiate-session (&optional session _params)
    247   "Create a session named SESSION according to PARAMS."
    248   (unless (string= session "none")
    249     (error "Sessions currently not supported, work in progress")
    250     (org-babel-lua-session-buffer
    251      (org-babel-lua-initiate-session-by-key session))))
    252 
    253 (defvar org-babel-lua-eoe-indicator "--eoe"
    254   "A string to indicate that evaluation has completed.")
    255 
    256 (defvar org-babel-lua-wrapper-method
    257   "
    258 function main()
    259 %s
    260 end
    261 
    262 function dump(it, indent)
    263    if indent == nil then
    264       indent = ''
    265    end
    266    if type(it) == 'table' and %s then
    267       local count = 0
    268       for _ in pairs(it) do
    269          count = count + 1
    270       end
    271       local result = ''
    272       if #indent ~= 0 then
    273          result = result .. '\\n'
    274       end
    275       for key, value in pairs(it) do
    276          result = result
    277             .. indent
    278             .. dump(key)
    279             .. ' = '
    280             .. dump(value, indent .. '  ')
    281          count = count - 1
    282          if count ~= 0 then
    283             result = result .. '\\n'
    284          end
    285       end
    286       return result
    287    else
    288       return tostring(it)
    289    end
    290 end
    291 
    292 function combine(...)
    293   local result = {}
    294   for index = 1, select('#', ...) do
    295     result[index] = dump(select(index, ...))
    296   end
    297   return table.concat(result, '%s')
    298 end
    299 
    300 output = io.open('%s', 'w')
    301 output:write(combine(main()))
    302 output:close()")
    303 
    304 (defun org-babel-lua-evaluate
    305     (session body &optional result-type result-params preamble)
    306   "Evaluate BODY in SESSION as Lua code.
    307 RESULT-TYPE and RESULT-PARAMS are passed to
    308 `org-babel-lua-evaluate-session' or
    309 `org-babel-lua-evaluate-external-process'.
    310 PREAMBLE is passed to `org-babel-lua-evaluate-external-process'."
    311   (if session
    312       (org-babel-lua-evaluate-session
    313        session body result-type result-params)
    314     (org-babel-lua-evaluate-external-process
    315      body result-type result-params preamble)))
    316 
    317 (defun org-babel-lua-evaluate-external-process
    318     (body &optional result-type result-params preamble)
    319   "Evaluate BODY in external Lua process.
    320 If RESULT-TYPE equals `output' then return standard output as a
    321 string.  If RESULT-TYPE equals `value' then return the value of the
    322 last statement in BODY, as Emacs Lisp.
    323 RESULT-PARAMS list all the :result header arg parameters.
    324 PREAMBLE string is appended to BODY."
    325   (let ((raw
    326          (pcase result-type
    327            (`output (org-babel-eval org-babel-lua-command
    328 				    (concat preamble (and preamble "\n")
    329 					    body)))
    330            (`value (let ((tmp-file (org-babel-temp-file "lua-")))
    331 		     (org-babel-eval
    332 		      org-babel-lua-command
    333 		      (concat
    334 		       preamble (and preamble "\n")
    335 		       (format
    336                         org-babel-lua-wrapper-method
    337 			(mapconcat
    338 			 (lambda (line) (format "\t%s" line))
    339 			 (split-string
    340 			  (org-remove-indentation
    341 			   (org-trim body))
    342 			  "[\r\n]")
    343                          "\n")
    344                         (if (member "pp" result-params)
    345                             "true" "false")
    346                         org-babel-lua-multiple-values-separator
    347 			(org-babel-process-file-name tmp-file 'noquote))))
    348 		     (org-babel-eval-read-file tmp-file))))))
    349     (org-babel-result-cond result-params
    350       raw
    351       (org-babel-lua-table-or-string (org-trim raw)))))
    352 
    353 (defun org-babel-lua-evaluate-session
    354     (session body &optional result-type result-params)
    355   "Pass BODY to the Lua process in SESSION.
    356 If RESULT-TYPE equals `output' then return standard output as a
    357 string.  If RESULT-TYPE equals `value' then return the value of the
    358 last statement in BODY, as Emacs Lisp."
    359   (let* ((send-wait (lambda () (comint-send-input nil t) (sleep-for 0.005)))
    360 	 (dump-last-value
    361 	  (lambda
    362 	    (tmp-file pp)
    363 	    (mapc
    364 	     (lambda (statement) (insert statement) (funcall send-wait))
    365 	     (if pp
    366 		 (list
    367 		  "-- table to string
    368 function t2s(t, indent)
    369    if indent == nil then
    370       indent = \"\"
    371    end
    372    if type(t) == \"table\" then
    373       ts = \"\"
    374       for k,v in pairs(t) do
    375          if type(v) == \"table\" then
    376             ts = ts .. indent .. t2s(k,indent .. \"  \") .. \" = \\n\" ..
    377                t2s(v, indent .. \"  \")
    378          else
    379             ts = ts .. indent .. t2s(k,indent .. \"  \") .. \" = \" ..
    380                t2s(v, indent .. \"  \") .. \"\\n\"
    381          end
    382       end
    383       return ts
    384    else
    385       return tostring(t)
    386    end
    387 end
    388 "
    389 		  (concat "fd:write(_))
    390 fd:close()"
    391 			  (org-babel-process-file-name tmp-file 'noquote)))
    392 	       (list (format "fd=io.open(\"%s\", \"w\")
    393 fd:write( _ )
    394 fd:close()"
    395 			     (org-babel-process-file-name tmp-file
    396                                                           'noquote)))))))
    397 	 (input-body (lambda (body)
    398 		       (mapc (lambda (line) (insert line) (funcall send-wait))
    399 			     (split-string body "[\r\n]"))
    400 		       (funcall send-wait)))
    401          (results
    402           (pcase result-type
    403             (`output
    404              (mapconcat
    405               #'org-trim
    406               (butlast
    407                (org-babel-comint-with-output
    408                    (session org-babel-lua-eoe-indicator t body)
    409                  (funcall input-body body)
    410                  (funcall send-wait) (funcall send-wait)
    411                  (insert org-babel-lua-eoe-indicator)
    412                  (funcall send-wait))
    413                2) "\n"))
    414             (`value
    415              (let ((tmp-file (org-babel-temp-file "lua-")))
    416                (org-babel-comint-with-output
    417                    (session org-babel-lua-eoe-indicator nil body)
    418                  (let ((comint-process-echoes nil))
    419                    (funcall input-body body)
    420                    (funcall dump-last-value tmp-file
    421                             (member "pp" result-params))
    422                    (funcall send-wait) (funcall send-wait)
    423                    (insert org-babel-lua-eoe-indicator)
    424                    (funcall send-wait)))
    425                (org-babel-eval-read-file tmp-file))))))
    426     (unless (string= (substring org-babel-lua-eoe-indicator 1 -1) results)
    427       (org-babel-result-cond result-params
    428 	results
    429         (org-babel-lua-table-or-string results)))))
    430 
    431 (defun org-babel-lua-read-string (string)
    432   "Strip single quotes from around Lua STRING."
    433   (org-unbracket-string "'" "'" string))
    434 
    435 (provide 'ob-lua)
    436 
    437 ;;; ob-lua.el ends here