ob-calc.el 3.3 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105
  1. ;;; ob-calc.el --- org-babel functions for calc code evaluation
  2. ;; Copyright (C) 2010 Free Software Foundation, Inc
  3. ;; Author: Eric Schulte
  4. ;; Keywords: literate programming, reproducible research
  5. ;; Homepage: http://orgmode.org
  6. ;; Version: 7.5
  7. ;; This file is part of GNU Emacs.
  8. ;; GNU Emacs is free software: you can redistribute it and/or modify
  9. ;; it under the terms of the GNU General Public License as published by
  10. ;; the Free Software Foundation, either version 3 of the License, or
  11. ;; (at your option) any later version.
  12. ;; GNU Emacs is distributed in the hope that it will be useful,
  13. ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  14. ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  15. ;; GNU General Public License for more details.
  16. ;; You should have received a copy of the GNU General Public License
  17. ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
  18. ;;; Commentary:
  19. ;; Org-Babel support for evaluating calc code
  20. ;;; Code:
  21. (require 'ob)
  22. (require 'calc)
  23. (require 'calc-store)
  24. (unless (featurep 'xemacs) (require 'calc-trail))
  25. (eval-when-compile (require 'ob-comint))
  26. (defvar org-babel-default-header-args:calc nil
  27. "Default arguments for evaluating an calc source block.")
  28. (defun org-babel-expand-body:calc (body params)
  29. "Expand BODY according to PARAMS, return the expanded body." body)
  30. (defun org-babel-execute:calc (body params)
  31. "Execute a block of calc code with Babel."
  32. (unless (get-buffer "*Calculator*")
  33. (save-window-excursion (calc) (calc-quit)))
  34. (let* ((vars (mapcar #'cdr (org-babel-get-header params :var)))
  35. (var-syms (mapcar #'car vars))
  36. (var-names (mapcar #'symbol-name var-syms)))
  37. (mapc
  38. (lambda (pair)
  39. (calc-push-list (list (cdr pair)))
  40. (calc-store-into (car pair)))
  41. vars)
  42. (mapc
  43. (lambda (line)
  44. (when (> (length line) 0)
  45. (cond
  46. ;; simple variable name
  47. ((member line var-names) (calc-recall (intern line)))
  48. ;; stack operation
  49. ((string= "'" (substring line 0 1))
  50. (funcall (lookup-key calc-mode-map (substring line 1)) nil))
  51. ;; complex expression
  52. (t
  53. (calc-push-list
  54. (list ((lambda (res)
  55. (cond
  56. ((numberp res) res)
  57. ((math-read-number res) (math-read-number res))
  58. ((listp res) (error "calc error \"%s\" on input \"%s\""
  59. (cadr res) line))
  60. (t (replace-regexp-in-string
  61. "'\\[" "["
  62. (calc-eval
  63. (math-evaluate-expr
  64. ;; resolve user variables, calc built in
  65. ;; variables are handled automatically
  66. ;; upstream by calc
  67. (mapcar #'ob-calc-maybe-resolve-var
  68. ;; parse line into calc objects
  69. (car (math-read-exprs line)))))))))
  70. (calc-eval line))))))))
  71. (mapcar #'org-babel-trim
  72. (split-string (org-babel-expand-body:calc body params) "[\n\r]"))))
  73. (save-excursion
  74. (with-current-buffer (get-buffer "*Calculator*")
  75. (calc-eval (calc-top 1)))))
  76. (defvar var-syms) ; Dynamically scoped from org-babel-execute:calc
  77. (defun ob-calc-maybe-resolve-var (el)
  78. (if (consp el)
  79. (if (and (equal 'var (car el)) (member (cadr el) var-syms))
  80. (progn
  81. (calc-recall (cadr el))
  82. (prog1 (calc-top 1)
  83. (calc-pop 1)))
  84. (mapcar #'ob-calc-maybe-resolve-var el))
  85. el))
  86. (provide 'ob-calc)
  87. ;; arch-tag: 5c57a3b7-5818-4c6c-acda-7a94831a6449
  88. ;;; ob-calc.el ends here