123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110 |
- (require 'ob)
- (require 'calc)
- (require 'calc-trail)
- (require 'calc-store)
- (declare-function calc-store-into "calc-store" (&optional var))
- (declare-function calc-recall "calc-store" (&optional var))
- (declare-function math-evaluate-expr "calc-ext" (x))
- (declare-function org-trim "org" (s &optional keep-lead))
- (defvar org-babel-default-header-args:calc nil
- "Default arguments for evaluating an calc source block.")
- (defun org-babel-expand-body:calc (body _params)
- "Expand BODY according to PARAMS, return the expanded body." body)
- (defvar org--var-syms)
- (defun org-babel-execute:calc (body params)
- "Execute a block of calc code with Babel."
- (unless (get-buffer "*Calculator*")
- (save-window-excursion (calc) (calc-quit)))
- (let* ((vars (org-babel--get-vars params))
- (org--var-syms (mapcar #'car vars))
- (var-names (mapcar #'symbol-name org--var-syms)))
- (mapc
- (lambda (pair)
- (calc-push-list (list (cdr pair)))
- (calc-store-into (car pair)))
- vars)
- (mapc
- (lambda (line)
- (when (> (length line) 0)
- (cond
-
- ((member line var-names) (calc-recall (intern line)))
-
- ((string= "'" (substring line 0 1))
- (funcall (lookup-key calc-mode-map (substring line 1)) nil))
-
- (t
- (calc-push-list
- (list (let ((res (calc-eval line)))
- (cond
- ((numberp res) res)
- ((math-read-number res) (math-read-number res))
- ((listp res) (error "Calc error \"%s\" on input \"%s\""
- (cadr res) line))
- (t (replace-regexp-in-string
- "'" ""
- (calc-eval
- (math-evaluate-expr
-
-
-
- (mapcar #'org-babel-calc-maybe-resolve-var
-
- (car (math-read-exprs line)))))))))
- ))))))
- (mapcar #'org-trim
- (split-string (org-babel-expand-body:calc body params) "[\n\r]"))))
- (save-excursion
- (with-current-buffer (get-buffer "*Calculator*")
- (prog1
- (calc-eval (calc-top 1))
- (calc-pop 1)))))
- (defun org-babel-calc-maybe-resolve-var (el)
- (if (consp el)
- (if (and (eq 'var (car el)) (member (cadr el) org--var-syms))
- (progn
- (calc-recall (cadr el))
- (prog1 (calc-top 1)
- (calc-pop 1)))
- (mapcar #'org-babel-calc-maybe-resolve-var el))
- el))
- (provide 'ob-calc)
|