ob-calc.el (4794B)
1 ;;; ob-calc.el --- Babel Functions for Calc -*- lexical-binding: t; -*- 2 3 ;; Copyright (C) 2010-2024 Free Software Foundation, Inc. 4 5 ;; Author: Eric Schulte 6 ;; Maintainer: Tom Gillespie <tgbugs@gmail.com> 7 ;; Keywords: literate programming, reproducible research 8 ;; URL: https://orgmode.org 9 10 ;; This file is part of GNU Emacs. 11 12 ;; GNU Emacs is free software: you can redistribute it and/or modify 13 ;; it under the terms of the GNU General Public License as published by 14 ;; the Free Software Foundation, either version 3 of the License, or 15 ;; (at your option) any later version. 16 17 ;; GNU Emacs is distributed in the hope that it will be useful, 18 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of 19 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 20 ;; GNU General Public License for more details. 21 22 ;; You should have received a copy of the GNU General Public License 23 ;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. 24 25 ;;; Commentary: 26 27 ;; Org-Babel support for evaluating calc code 28 29 ;;; Code: 30 31 (require 'org-macs) 32 (org-assert-version) 33 34 (require 'ob) 35 (require 'org-macs) 36 (require 'calc) 37 (require 'calc-trail) 38 (require 'calc-store) 39 40 (declare-function calc-store-into "calc-store" (&optional var)) 41 (declare-function calc-recall "calc-store" (&optional var)) 42 (declare-function math-evaluate-expr "calc-ext" (x)) 43 44 (defvar org-babel-default-header-args:calc nil 45 "Default arguments for evaluating a calc source block.") 46 47 (defun org-babel-expand-body:calc (body params) 48 "Expand BODY according to PARAMS, return the expanded body." 49 (let ((prologue (cdr (assq :prologue params))) 50 (epilogue (cdr (assq :epilogue params)))) 51 (concat 52 (and prologue (concat prologue "\n")) 53 body 54 (and epilogue (concat "\n" epilogue "\n"))))) 55 56 (defvar org--var-syms) ; Dynamically scoped from org-babel-execute:calc 57 58 (defun org-babel-execute:calc (body params) 59 "Execute BODY of calc code with Babel using PARAMS." 60 (unless (get-buffer "*Calculator*") 61 (save-window-excursion (calc) (calc-quit))) 62 (let* ((vars (org-babel--get-vars params)) 63 (org--var-syms (mapcar #'car vars)) 64 (var-names (mapcar #'symbol-name org--var-syms))) 65 (mapc 66 (lambda (pair) 67 (let ((val (cdr pair))) 68 (calc-push-list 69 (list 70 (cond 71 ;; For a vector, Calc follows the format (vec 1 2 3 ...) so 72 ;; a matrix becomes (vec (vec 1 2 3) (vec 4 5 6) ...). See 73 ;; the comments in "Arithmetic routines." section of 74 ;; calc.el. 75 ((listp val) 76 (cons 'vec 77 (if (null (cdr val)) 78 (car val) 79 (mapcar (lambda (x) (if (listp x) (cons 'vec x) x)) 80 val)))) 81 ((numberp val) 82 (math-read-number (number-to-string val))) 83 (t val))))) 84 (calc-store-into (car pair))) 85 vars) 86 (mapc 87 (lambda (line) 88 (when (> (length line) 0) 89 (cond 90 ;; simple variable name 91 ((member line var-names) (calc-recall (intern line))) 92 ;; stack operation 93 ((string= "'" (substring line 0 1)) 94 (funcall (lookup-key calc-mode-map (substring line 1)) nil)) 95 ;; complex expression 96 (t 97 (calc-push-list 98 (list (let ((res (calc-eval line))) 99 (cond 100 ((numberp res) res) 101 ((math-read-number res) (math-read-number res)) 102 ((listp res) (error "Calc error \"%s\" on input \"%s\"" 103 (cadr res) line)) 104 (t (replace-regexp-in-string 105 "'" "" 106 (calc-eval 107 (math-evaluate-expr 108 ;; resolve user variables, calc built in 109 ;; variables are handled automatically 110 ;; upstream by calc 111 (mapcar #'org-babel-calc-maybe-resolve-var 112 ;; parse line into calc objects 113 (car (math-read-exprs line))))))))) 114 )))))) 115 (mapcar #'org-trim 116 (split-string (org-babel-expand-body:calc body params) "[\n\r]")))) 117 (save-excursion 118 (with-current-buffer "*Calculator*" 119 (prog1 120 (calc-eval (calc-top 1)) 121 (calc-pop 1))))) 122 123 (defun org-babel-calc-maybe-resolve-var (el) 124 "Resolve user variables in EL. 125 EL is taken from the output of `math-read-exprs'." 126 (if (consp el) 127 (if (and (eq 'var (car el)) (member (cadr el) org--var-syms)) 128 (progn 129 (calc-recall (cadr el)) 130 (prog1 (calc-top 1) 131 (calc-pop 1))) 132 (mapcar #'org-babel-calc-maybe-resolve-var el)) 133 el)) 134 135 (provide 'ob-calc) 136 137 ;;; ob-calc.el ends here