dotemacs

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

ob-mathomatic.el (5106B)


      1 ;;; ob-mathomatic.el --- Org-babel functions for mathomatic evaluation
      2 
      3 ;; Copyright (C) 2009-2021  Free Software Foundation, Inc.
      4 
      5 ;; Author: Eric S Fraga
      6 ;;	Eric Schulte
      7 ;;  Luis Anaya (Mathomatic)
      8 
      9 ;; Keywords: literate programming, reproducible research, mathomatic
     10 ;; Homepage: https://git.sr.ht/~bzg/org-contrib
     11 
     12 ;; This file is not part of GNU Emacs.
     13 
     14 ;; This program is free software: you can redistribute it and/or modify
     15 ;; it under the terms of the GNU General Public License as published by
     16 ;; the Free Software Foundation, either version 3 of the License, or
     17 ;; (at your option) any later version.
     18 
     19 ;; This program is distributed in the hope that it will be useful,
     20 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
     21 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
     22 ;; GNU General Public License for more details.
     23 
     24 ;; You should have received a copy of the GNU General Public License
     25 ;; along with GNU Emacs.  If not, see <https://www.gnu.org/licenses/>.
     26 
     27 ;;; Commentary:
     28 
     29 ;; Org-Babel support for evaluating mathomatic entries.
     30 ;;
     31 ;; This differs from most standard languages in that
     32 ;;
     33 ;; 1) there is no such thing as a "session" in mathomatic
     34 ;;
     35 ;; 2) we are adding the "cmdline" header argument
     36 
     37 ;;; Code:
     38 (require 'ob)
     39 
     40 (defvar org-babel-tangle-lang-exts)
     41 (add-to-list 'org-babel-tangle-lang-exts '("mathomatic" . "math"))
     42 
     43 (defvar org-babel-default-header-args:mathomatic '())
     44 
     45 (defcustom org-babel-mathomatic-command
     46   (if (boundp 'mathomatic-command) mathomatic-command "mathomatic")
     47   "Command used to call mathomatic on the shell."
     48   :group 'org-babel)
     49 
     50 (defun org-babel-mathomatic-expand (body params)
     51   "Expand a block of Mathomatic code according to its header arguments."
     52   (let ((vars (org-babel--get-vars params)))
     53     (mapconcat 'identity
     54 	       (list
     55 		;; graphic output
     56 		(let ((graphic-file (org-babel-mathomatic-graphical-output-file params)))
     57 		  (if graphic-file
     58 		      (cond
     59 		       ((string-match ".\.eps$" graphic-file)
     60 			(format ;; Need to add command to send to file.
     61 			 "set plot set terminal postscript eps\\;set output %S "
     62 			 graphic-file))
     63 		       ((string-match ".\.ps$" graphic-file)
     64 			(format ;; Need to add command to send to file.
     65 			 "set plot set terminal postscript\\;set output %S "
     66 			 graphic-file))
     67 
     68 		       ((string-match ".\.pic$" graphic-file)
     69 			(format ;; Need to add command to send to file.
     70 			 "set plot set terminal gpic\\;set output %S "
     71 			 graphic-file))
     72 		       (t
     73 			(format ;; Need to add command to send to file.
     74 			 "set plot set terminal png\\;set output %S "
     75 			 graphic-file)))
     76 		    ""))
     77 		;; variables
     78 		(mapconcat 'org-babel-mathomatic-var-to-mathomatic vars "\n")
     79 		;; body
     80 		body
     81 		"")
     82 	       "\n")))
     83 
     84 (defun org-babel-execute:mathomatic (body params)
     85   "Execute a block of Mathomatic entries with org-babel.  This function is
     86 called by `org-babel-execute-src-block'."
     87   (message "executing Mathomatic source code block")
     88   (let ((result-params (split-string (or (cdr (assq :results params)) "")))
     89 	(result
     90 	 (let* ((cmdline (or (cdr (assq :cmdline params)) ""))
     91 		(in-file (org-babel-temp-file "mathomatic-" ".math"))
     92 		(cmd (format "%s -t -c -q  %s %s"
     93 			     org-babel-mathomatic-command in-file cmdline)))
     94 	   (with-temp-file in-file (insert (org-babel-mathomatic-expand body params)))
     95 	   (message cmd)
     96 	   ((lambda (raw) ;; " | grep -v batch | grep -v 'replaced' | sed '/^$/d' "
     97 	      (mapconcat
     98 	       #'identity
     99 	       (delq nil
    100 		     (mapcar (lambda (line)
    101 			       (unless (or (string-match "batch" line)
    102 					   (string-match "^rat: replaced .*$" line)
    103 					   (= 0 (length line)))
    104 				 line))
    105 			     (split-string raw "[\r\n]"))) "\n"))
    106 	    (org-babel-eval cmd "")))))
    107     (if (org-babel-mathomatic-graphical-output-file params)
    108 	nil
    109       (if (or (member "scalar" result-params)
    110 	      (member "verbatim" result-params)
    111 	      (member "output" result-params))
    112 	  result
    113 	(let ((tmp-file (org-babel-temp-file "mathomatic-res-")))
    114 	  (with-temp-file tmp-file (insert result))
    115 	  (org-babel-import-elisp-from-file tmp-file))))))
    116 
    117 (defun org-babel-prep-session:mathomatic (session params)
    118   (error "Mathomatic does not support sessions"))
    119 
    120 (defun org-babel-mathomatic-var-to-mathomatic (pair)
    121   "Convert an elisp val into a string of mathomatic code specifying a var
    122 of the same value."
    123   (let ((var (car pair))
    124         (val (cdr pair)))
    125     (when (symbolp val)
    126       (setq val (symbol-name val))
    127       (when (= (length val) 1)
    128         (setq val (string-to-char val))))
    129       (format "%s=%s" var
    130 	      (org-babel-mathomatic-elisp-to-mathomatic val))))
    131 
    132 (defun org-babel-mathomatic-graphical-output-file (params)
    133   "Name of file to which mathomatic should send graphical output."
    134   (and (member "graphics" (cdr (assq :result-params params)))
    135        (cdr (assq :file params))))
    136 
    137 (defun org-babel-mathomatic-elisp-to-mathomatic (val)
    138   "Return a string of mathomatic code which evaluates to VAL."
    139   (if (listp val)
    140       (mapconcat #'org-babel-mathomatic-elisp-to-mathomatic val " ")
    141     (format "%s" val)))
    142 
    143 (provide 'ob-mathomatic)
    144 
    145 ;;; ob-mathomatic.el ends here