ob-calc.el (3887B)
1 ;;; ob-calc.el --- Babel Functions for Calc -*- lexical-binding: t; -*- 2 3 ;; Copyright (C) 2010-2023 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." body) 49 50 (defvar org--var-syms) ; Dynamically scoped from org-babel-execute:calc 51 52 (defun org-babel-execute:calc (body params) 53 "Execute a block of calc code with Babel." 54 (unless (get-buffer "*Calculator*") 55 (save-window-excursion (calc) (calc-quit))) 56 (let* ((vars (org-babel--get-vars params)) 57 (org--var-syms (mapcar #'car vars)) 58 (var-names (mapcar #'symbol-name org--var-syms))) 59 (mapc 60 (lambda (pair) 61 (calc-push-list (list (cdr pair))) 62 (calc-store-into (car pair))) 63 vars) 64 (mapc 65 (lambda (line) 66 (when (> (length line) 0) 67 (cond 68 ;; simple variable name 69 ((member line var-names) (calc-recall (intern line))) 70 ;; stack operation 71 ((string= "'" (substring line 0 1)) 72 (funcall (lookup-key calc-mode-map (substring line 1)) nil)) 73 ;; complex expression 74 (t 75 (calc-push-list 76 (list (let ((res (calc-eval line))) 77 (cond 78 ((numberp res) res) 79 ((math-read-number res) (math-read-number res)) 80 ((listp res) (error "Calc error \"%s\" on input \"%s\"" 81 (cadr res) line)) 82 (t (replace-regexp-in-string 83 "'" "" 84 (calc-eval 85 (math-evaluate-expr 86 ;; resolve user variables, calc built in 87 ;; variables are handled automatically 88 ;; upstream by calc 89 (mapcar #'org-babel-calc-maybe-resolve-var 90 ;; parse line into calc objects 91 (car (math-read-exprs line))))))))) 92 )))))) 93 (mapcar #'org-trim 94 (split-string (org-babel-expand-body:calc body params) "[\n\r]")))) 95 (save-excursion 96 (with-current-buffer (get-buffer "*Calculator*") 97 (prog1 98 (calc-eval (calc-top 1)) 99 (calc-pop 1))))) 100 101 (defun org-babel-calc-maybe-resolve-var (el) 102 (if (consp el) 103 (if (and (eq 'var (car el)) (member (cadr el) org--var-syms)) 104 (progn 105 (calc-recall (cadr el)) 106 (prog1 (calc-top 1) 107 (calc-pop 1))) 108 (mapcar #'org-babel-calc-maybe-resolve-var el)) 109 el)) 110 111 (provide 'ob-calc) 112 113 ;;; ob-calc.el ends here