dotemacs

My Emacs configuration
git clone git://git.entf.net/dotemacs
Log | Files | Refs | LICENSE

ob-octave.el (9733B)


      1 ;;; ob-octave.el --- Babel Functions for Octave and Matlab -*- lexical-binding: t; -*-
      2 
      3 ;; Copyright (C) 2010-2023 Free Software Foundation, Inc.
      4 
      5 ;; Author: Dan Davison
      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 ;;; Requirements:
     27 
     28 ;; octave
     29 ;; octave-mode.el and octave-inf.el come with GNU emacs
     30 
     31 ;;; Code:
     32 
     33 (require 'org-macs)
     34 (org-assert-version)
     35 
     36 (require 'ob)
     37 (require 'org-macs)
     38 
     39 (declare-function matlab-shell "ext:matlab-mode")
     40 (declare-function matlab-shell-run-region "ext:matlab-mode")
     41 
     42 (defvar org-babel-default-header-args:matlab '())
     43 (defvar org-babel-default-header-args:octave '())
     44 
     45 (defvar org-babel-matlab-shell-command "matlab -nosplash"
     46   "Shell command to run matlab as an external process.")
     47 (defvar org-babel-octave-shell-command "octave -q"
     48   "Shell command to run octave as an external process.")
     49 
     50 (defvar org-babel-matlab-with-emacs-link nil
     51   "If non-nil use matlab-shell-run-region for session evaluation.
     52 This will use EmacsLink if (matlab-with-emacs-link) evaluates
     53 to a non-nil value.")
     54 
     55 (defvar org-babel-matlab-emacs-link-wrapper-method
     56   "%s
     57 if ischar(ans), fid = fopen('%s', 'w'); fprintf(fid, '%%s\\n', ans); fclose(fid);
     58 else, save -ascii %s ans
     59 end
     60 delete('%s')
     61 ")
     62 (defvar org-babel-octave-wrapper-method
     63   "%s
     64 if ischar(ans), fid = fopen('%s', 'w'); fdisp(fid, ans); fclose(fid);
     65 else, dlmwrite('%s', ans, '\\t')
     66 end")
     67 
     68 (defvar org-babel-octave-eoe-indicator "'org_babel_eoe'")
     69 
     70 (defvar org-babel-octave-eoe-output "ans = org_babel_eoe")
     71 
     72 (defun org-babel-execute:matlab (body params)
     73   "Execute a block of matlab code with Babel."
     74   (org-babel-execute:octave body params 'matlab))
     75 
     76 (defun org-babel-execute:octave (body params &optional matlabp)
     77   "Execute a block of octave code with Babel."
     78   (let* ((session
     79 	  (funcall (intern (format "org-babel-%s-initiate-session"
     80 				   (if matlabp "matlab" "octave")))
     81 		   (cdr (assq :session params)) params))
     82          (result-type (cdr (assq :result-type params)))
     83 	 (full-body
     84 	  (org-babel-expand-body:generic
     85 	   body params (org-babel-variable-assignments:octave params)))
     86 	 (gfx-file (ignore-errors (org-babel-graphical-output-file params)))
     87 	 (result (org-babel-octave-evaluate
     88 		  session
     89 		  (if gfx-file
     90 		      (mapconcat 'identity
     91 				 (list
     92 				  "set (0, \"defaultfigurevisible\", \"off\");"
     93 				  full-body
     94 				  (format "print -dpng %S\nans=%S" gfx-file gfx-file))
     95 				 "\n")
     96 		    full-body)
     97 		  result-type matlabp)))
     98     (if gfx-file
     99 	nil
    100       (org-babel-reassemble-table
    101        result
    102        (org-babel-pick-name
    103 	(cdr (assq :colname-names params)) (cdr (assq :colnames params)))
    104        (org-babel-pick-name
    105 	(cdr (assq :rowname-names params)) (cdr (assq :rownames params)))))))
    106 
    107 (defun org-babel-prep-session:matlab (session params)
    108   "Prepare SESSION according to PARAMS."
    109   (org-babel-prep-session:octave session params 'matlab))
    110 
    111 (defun org-babel-variable-assignments:octave (params)
    112   "Return list of octave statements assigning the block's variables."
    113   (mapcar
    114    (lambda (pair)
    115      (format "%s=%s;"
    116 	     (car pair)
    117 	     (org-babel-octave-var-to-octave (cdr pair))))
    118    (org-babel--get-vars params)))
    119 
    120 (defalias 'org-babel-variable-assignments:matlab
    121   'org-babel-variable-assignments:octave)
    122 
    123 (defun org-babel-octave-var-to-octave (var)
    124   "Convert an emacs-lisp value into an octave variable.
    125 Converts an emacs-lisp variable into a string of octave code
    126 specifying a variable of the same value."
    127   (if (listp var)
    128       (concat "[" (mapconcat #'org-babel-octave-var-to-octave var
    129 			     (if (listp (car var)) "; " ",")) "]")
    130     (cond
    131      ((stringp var)
    132       (format "'%s'" var))
    133      (t
    134       (format "%s" var)))))
    135 
    136 (defun org-babel-prep-session:octave (session params &optional matlabp)
    137   "Prepare SESSION according to the header arguments specified in PARAMS."
    138   (let* ((session (org-babel-octave-initiate-session session params matlabp))
    139 	 (var-lines (org-babel-variable-assignments:octave params)))
    140     (org-babel-comint-in-buffer session
    141       (mapc (lambda (var)
    142               (end-of-line 1) (insert var) (comint-send-input nil t)
    143               (org-babel-comint-wait-for-output session))
    144 	    var-lines))
    145     session))
    146 
    147 (defun org-babel-matlab-initiate-session (&optional session params)
    148   "Create a matlab inferior process buffer.
    149 If there is not a current inferior-process-buffer in SESSION then
    150 create.  Return the initialized session."
    151   (org-babel-octave-initiate-session session params 'matlab))
    152 
    153 (defun org-babel-octave-initiate-session (&optional session _params matlabp)
    154   "Create an octave inferior process buffer.
    155 If there is not a current inferior-process-buffer in SESSION then
    156 create.  Return the initialized session."
    157   (if matlabp (require 'matlab) (or (require 'octave-inf nil 'noerror)
    158 				    (require 'octave)))
    159   (unless (string= session "none")
    160     (let ((session (or session
    161 		       (if matlabp "*Inferior Matlab*" "*Inferior Octave*"))))
    162       (if (org-babel-comint-buffer-livep session) session
    163 	(save-window-excursion
    164 	  (if matlabp (unless org-babel-matlab-with-emacs-link (matlab-shell))
    165 	    (run-octave))
    166 	  (rename-buffer (if (bufferp session) (buffer-name session)
    167 			   (if (stringp session) session (buffer-name))))
    168 	  (current-buffer))))))
    169 
    170 (defun org-babel-octave-evaluate
    171     (session body result-type &optional matlabp)
    172   "Pass BODY to the octave process in SESSION.
    173 If RESULT-TYPE equals `output' then return the outputs of the
    174 statements in BODY, if RESULT-TYPE equals `value' then return the
    175 value of the last statement in BODY, as elisp."
    176   (if session
    177       (org-babel-octave-evaluate-session session body result-type matlabp)
    178     (org-babel-octave-evaluate-external-process body result-type matlabp)))
    179 
    180 (defun org-babel-octave-evaluate-external-process (body result-type matlabp)
    181   "Evaluate BODY in an external octave process."
    182   (let ((cmd (if matlabp
    183 		 org-babel-matlab-shell-command
    184 	       org-babel-octave-shell-command)))
    185     (pcase result-type
    186       (`output (org-babel-eval cmd body))
    187       (`value (let ((tmp-file (org-babel-temp-file "octave-")))
    188 	        (org-babel-eval
    189 		 cmd
    190 		 (format org-babel-octave-wrapper-method body
    191 			 (org-babel-process-file-name tmp-file 'noquote)
    192 			 (org-babel-process-file-name tmp-file 'noquote)))
    193 	        (org-babel-octave-import-elisp-from-file tmp-file))))))
    194 
    195 (defun org-babel-octave-evaluate-session
    196     (session body result-type &optional matlabp)
    197   "Evaluate BODY in SESSION."
    198   (let* ((tmp-file (org-babel-temp-file (if matlabp "matlab-" "octave-")))
    199 	 (wait-file (org-babel-temp-file "matlab-emacs-link-wait-signal-"))
    200 	 (full-body
    201 	  (pcase result-type
    202 	    (`output
    203 	     (mapconcat
    204 	      #'org-babel-chomp
    205 	      (list body org-babel-octave-eoe-indicator) "\n"))
    206 	    (`value
    207 	     (if (and matlabp org-babel-matlab-with-emacs-link)
    208 		 (concat
    209 		  (format org-babel-matlab-emacs-link-wrapper-method
    210 			  body
    211 			  (org-babel-process-file-name tmp-file 'noquote)
    212 			  (org-babel-process-file-name tmp-file 'noquote) wait-file) "\n")
    213 	       (mapconcat
    214 		#'org-babel-chomp
    215 		(list (format org-babel-octave-wrapper-method
    216 			      body
    217 			      (org-babel-process-file-name tmp-file 'noquote)
    218 			      (org-babel-process-file-name tmp-file 'noquote))
    219 		      org-babel-octave-eoe-indicator) "\n")))))
    220 	 (raw (if (and matlabp org-babel-matlab-with-emacs-link)
    221 		  (save-window-excursion
    222 		    (with-temp-buffer
    223 		      (insert full-body)
    224 		      (write-region "" 'ignored wait-file nil nil nil 'excl)
    225 		      (matlab-shell-run-region (point-min) (point-max))
    226 		      (message "Waiting for Matlab Emacs Link")
    227 		      (while (file-exists-p wait-file) (sit-for 0.01))
    228 		      "")) ;; matlab-shell-run-region doesn't seem to
    229 		;; make *matlab* buffer contents easily
    230 		;; available, so :results output currently
    231 		;; won't work
    232 		(org-babel-comint-with-output
    233 		    (session
    234 		     (if matlabp
    235 			 org-babel-octave-eoe-indicator
    236 		       org-babel-octave-eoe-output)
    237 		     t full-body)
    238 		  (insert full-body) (comint-send-input nil t))))
    239 	 results)
    240     (pcase result-type
    241       (`value
    242        (org-babel-octave-import-elisp-from-file tmp-file))
    243       (`output
    244        (setq results
    245 	     (if matlabp
    246 		 (cdr (reverse (delq "" (mapcar #'org-strip-quotes
    247 						(mapcar #'org-trim raw)))))
    248 	       (cdr (member org-babel-octave-eoe-output
    249 			    (reverse (mapcar #'org-strip-quotes
    250 					     (mapcar #'org-trim raw)))))))
    251        (mapconcat #'identity (reverse results) "\n")))))
    252 
    253 (defun org-babel-octave-import-elisp-from-file (file-name)
    254   "Import data from FILE-NAME.
    255 This removes initial blank and comment lines and then calls
    256 `org-babel-import-elisp-from-file'."
    257   (let ((temp-file (org-babel-temp-file "octave-matlab-")) beg end)
    258     (with-temp-file temp-file
    259       (insert-file-contents file-name)
    260       (re-search-forward "^[ \t]*[^# \t]" nil t)
    261       (when (< (setq beg (point-min))
    262                (setq end (line-beginning-position)))
    263 	(delete-region beg end)))
    264     (org-babel-import-elisp-from-file temp-file '(16))))
    265 
    266 (provide 'ob-octave)
    267 
    268 ;;; ob-octave.el ends here