From mboxrd@z Thu Jan 1 00:00:00 1970 From: Jan Malakhovski Subject: [PATCH 8/9] ob-calc: add more API, documentation and examples so that it can be used in tables Date: Tue, 3 Nov 2015 20:15:46 +0000 Message-ID: <1446581747-1960-9-git-send-email-oxij@oxij.org> References: <1446581747-1960-1-git-send-email-oxij@oxij.org> Return-path: Received: from eggs.gnu.org ([2001:4830:134:3::10]:37243) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1Zti0I-0002bc-N2 for emacs-orgmode@gnu.org; Tue, 03 Nov 2015 15:16:28 -0500 Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1Zti0H-0004Td-6H for emacs-orgmode@gnu.org; Tue, 03 Nov 2015 15:16:26 -0500 Received: from tricoro.koumakan.jp ([195.154.188.176]:29111) by eggs.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1Zti0G-0004TI-UH for emacs-orgmode@gnu.org; Tue, 03 Nov 2015 15:16:25 -0500 In-Reply-To: <1446581747-1960-1-git-send-email-oxij@oxij.org> List-Id: "General discussions about Org-mode." List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: emacs-orgmode-bounces+geo-emacs-orgmode=m.gmane.org@gnu.org Sender: emacs-orgmode-bounces+geo-emacs-orgmode=m.gmane.org@gnu.org To: emacs-orgmode@gnu.org Cc: Jan Malakhovski * lisp/ob-calc.el (org-babel-calc-eval): (org-babel-calc-set-env): (org-babel-calc-reset-env): (org-babel-calc-store-env): (org-babel-calc-eval-string): (org-babel-calc-eval-line): New funcion. (org-babel-execute:calc): Rewrite to use new functions. This also makes ob-calc useful for computing complicated stuff in org-tables. See `org-babel-calc-eval` docstring for more info. --- lisp/ob-calc.el | 232 ++++++++++++++++++++++++++++++++++++++++++++------------ 1 file changed, 183 insertions(+), 49 deletions(-) diff --git a/lisp/ob-calc.el b/lisp/ob-calc.el index a8c50da..e8b43e7 100644 --- a/lisp/ob-calc.el +++ b/lisp/ob-calc.el @@ -1,4 +1,4 @@ -;;; ob-calc.el --- Babel Functions for Calc -*- lexical-binding: t; -*- +;;; ob-calc.el --- Babel Functions for Calc ;; Copyright (C) 2010-2015 Free Software Foundation, Inc. @@ -23,7 +23,8 @@ ;;; Commentary: -;; Org-Babel support for evaluating calc code +;; Org-Babel and Org-Table support for evaluating calc code. +;; See `org-babel-calc-eval' for documentation. ;;; Code: (require 'ob) @@ -42,67 +43,200 @@ (defun org-babel-expand-body:calc (body _params) "Expand BODY according to PARAMS, return the expanded body." body) -(defvar org--var-syms) ; Dynamically scoped from org-babel-execute:calc - (defun org-babel-execute:calc (body params) "Execute a block of calc code with Babel." + (org-babel-calc-eval (org-babel-expand-body:calc body params) + (org-babel--get-vars params))) + +(defvar org--ob-calc-env-symbol nil) ; For org-babel-calc-eval +(defvar org--ob-calc-var-names nil) + +(defun org-babel-calc-eval (text &optional environment env-symbol setup env-setup) + "Evaluate TEXT as set of calc expressions (one per line) and return the top of the stack. + +Optional argument ENVIRONMENT is a user-defined variables +environment which is an alist of (SYMBOL . VALUE). + +Optional argument ENV-SYMBOL is a symbol of a user-defined +variables environment which is an alist of (SYMBOL . VALUE). + +Setting your environment using either of ENVIRONMENT or +ENV-SYMBOL has the same effect. The difference is that this +function caches the value of ENV-SYMBOL internally between +succesive evaluations with ENV-SYMBOL arguments of equal symbol +names and reevaluates the value of ENV-SYMBOL only when the +symbol name of ENV-SYMBOL changes. + +Additionally, setting ENV-SYMBOL to nil will forget any +internal environment before applying ENVIRONMENT, i.e. with +ENV-SYMBOL set to nil this function is pure. + +You can also use `org-babel-calc-set-env', +`org-babel-calc-reset-env' and `org-babel-calc-store-env' to set, +reset and update the internal environment between evaluations. + +Optional argument SETUP allows additional calc setup on every +evaluation. + +Optional argument ENV-SETUP allows additional calc setup on every +ENV-SYMBOL change. + +This function is useful if you want to evaluate complicated +formulas in a table, e.g. after evaluating + + (setq an-env '((foo . \"2 day\") + (bar . \"6 hr\"))) + +you can use this in the following table + + | Expr | Result | + |-----------+--------------| + | foo + bar | 2 day + 6 hr | + | foo - bar | 2 day - 6 hr | + |-----------+--------------| + #+TBLFM: $2='(org-babel-calc-eval $1 an-env) + +which would become slow to recompute with a lot of rows, but then +you can change the TBLFM line to + + #+TBLFM: $2='(org-babel-calc-eval $1 nil 'an-env) + +and it would become fast again. + +SETUP argument can be used like this: + + | Expr | Result | + |-----------+----------| + | foo + bar | 2.25 day | + | foo - bar | 1.75 day | + |-----------+----------| + #+TBLFM: $2='(org-babel-calc-eval $1 nil 'an-env nil (lambda () (calc-units-simplify-mode t))) + +In case that is not fast or complicated enough, you can combine +this with `org-babel-calc-store-env' to produce some clever stuff +like, e.g. computing environment on the fly (an-env variable is +not actually used here, it is being generated just in case you +want to use it elsewhere): + + (setq an-env nil) + (defun compute-and-remember (name expr) + (let* ((v (org-babel-calc-eval expr nil 'an-env nil (lambda () (calc-units-simplify-mode t)))) + (c `(,(intern name) . ,v))) + (org-babel-calc-store-env (list c)) + (push c an-env) + v)) + +and then + + | Name | Expr | Value | + |------+------------+----------| + | foo | 2 day | 2 day | + | bar | foo + 6 hr | 2.25 day | + |------+------------+----------| + #+TBLFM: $3='(compute-and-remember $1 $2) + +Note that you can set ENV-SYMBOL to 'nil to get ENV-SETUP +without. + +The subsequent results might become somewhat surprising in case +ENVIRONMENT overrides variables set with ENV-SYMBOL." + (org-babel-calc-init) + (cond + ((equal env-symbol nil) (org-babel-calc-reset-env)) + ((not (equal (symbol-name env-symbol) org--ob-calc-env-symbol)) + (org-babel-calc-set-env env-symbol) + (unless (null env-setup) + (funcall env-setup)))) + (org-babel-calc-store-env environment) + (unless (null setup) + (funcall setup)) + (org-babel-calc-eval-string text)) + +(defun org-babel-calc-init () + "Initialize calc. + +You probably don't want to call this function explicitly." (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 - ;; simple variable name - ((member line var-names) (calc-recall (intern line))) - ;; stack operation - ((string= "'" (substring line 0 1)) - (funcall (lookup-key calc-mode-map (substring line 1)) nil)) - ;; complex expression - (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 - ;; resolve user variables, calc built in - ;; variables are handled automatically - ;; upstream by calc - (mapcar #'org-babel-calc-maybe-resolve-var - ;; parse line into calc objects - (car (math-read-exprs line))))))))) - )))))) - (mapcar #'org-babel-trim - (split-string (org-babel-expand-body:calc body params) "[\n\r]")))) + (save-window-excursion (calc) (calc-quit)))) + +(defun org-babel-calc-set-env (env-symbol) + "Force update current environment with the value of ENV-SYMBOL. + +See `org-babel-calc-eval' for more info." + (org-babel-calc-reset-env) + (org-babel-calc-store-env (eval env-symbol)) + (setq org--ob-calc-env-symbol (symbol-name env-symbol))) + +(defun org-babel-calc-reset-env () + "Forget current environment and the value of the last +ENV-SYMBOL. + +See `org-babel-calc-eval' for more info." + (setq org--ob-calc-var-names nil + org--ob-calc-env-symbol nil)) + +(defun org-babel-calc-store-env (vars) + "Store an environment (alist of (SYMBOL . VALUE) pairs) into calc. + +See `org-babel-calc-eval' for more info." + (mapc + (lambda (pair) + (let ((name (symbol-name (car pair))) + (value (cdr pair))) + ;; Using symbol-name and then intern here may seem a little + ;; crazy, but without it calc may not recall some of variables + ;; that got non-canonical symbols, which will be very surprising + ;; for users that produce their environments with '(...) syntax. + ;; Better safe than sorry. + (calc-store-value (intern name) value "" 0) + (push name org--ob-calc-var-names))) + vars)) + +(defun org-babel-calc-eval-string (text) + (mapc #'org-babel-calc-eval-line (split-string text "[\n\r]")) (save-excursion (with-current-buffer (get-buffer "*Calculator*") (calc-eval (calc-top 1))))) +(defun org-babel-calc-eval-line (line) + (let ((line (org-babel-trim line))) + (when (> (length line) 0) + (cond + ;; simple variable name + ((member line org--ob-calc-var-names) (calc-recall (intern line))) + ;; stack operation + ((string= "'" (substring line 0 1)) + (funcall (lookup-key calc-mode-map (substring line 1)) nil)) + ;; complex expression + (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 + ;; resolve user variables, calc built in + ;; variables are handled automatically + ;; upstream by calc + (mapcar #'org-babel-calc-maybe-resolve-var + ;; parse line into calc objects + (car (math-read-exprs line)))))))))))))))) + (defun org-babel-calc-maybe-resolve-var (el) (if (consp el) - (if (and (equal 'var (car el)) (member (cadr el) org--var-syms)) + (if (and (equal 'var (car el)) + (member (symbol-name (cadr el)) org--ob-calc-var-names)) (progn (calc-recall (cadr el)) - (prog1 (calc-top 1) + (prog1 + (calc-top 1) (calc-pop 1))) - (mapcar #'org-babel-calc-maybe-resolve-var el)) + (mapcar #'org-babel-calc-maybe-resolve-var el)) el)) (provide 'ob-calc) - - ;;; ob-calc.el ends here -- 2.6.2