Mercurial > emacs

comparison lisp/textmodes/org.el @ 64515:3f75dfc753c0

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
(org-table-column-names, org-table-column-name-regexp) (org-table-named-field-locations): New variables. (org-archive-subtree): Protect `this-command' when calling `org-copy-subtree' and `org-cut-subtree', to avoid appending to the kill buffer. (org-complete): Removed fixed-formula completion. (org-edit-formulas-map): New variable. (org-table-edit-formulas): New command. (org-finish-edit-formulas, org-abort-edit-formulas, org-show-variable, org-table-get-vertical-vector): New functions. (org-table-maybe-eval-formula): Handle `:=' fields. (org-table-get-stored-formulas, org-table-store-formulas) (org-table-get-formula, org-table-modify-formulas) (org-table-replace-in-formulas): Handle named field formulas. (org-table-get-specials): Store locations of named fields.
author Carsten Dominik <dominik@science.uva.nl>
date Tue, 19 Jul 2005 16:54:26 +0000
parents a8fa7c632ee4
children 7b82147924c7
comparison
equal deleted inserted replaced
64514:39dcd1204b00 64515:3f75dfc753c0
3 ;; Copyright (c) 2004, 2005 Free Software Foundation 3 ;; Copyright (c) 2004, 2005 Free Software Foundation
4 ;; 4 ;;
5 ;; Author: Carsten Dominik <dominik at science dot uva dot nl> 5 ;; Author: Carsten Dominik <dominik at science dot uva dot nl>
6 ;; Keywords: outlines, hypermedia, calendar 6 ;; Keywords: outlines, hypermedia, calendar
7 ;; Homepage: http://www.astro.uva.nl/~dominik/Tools/org/ 7 ;; Homepage: http://www.astro.uva.nl/~dominik/Tools/org/
8 ;; Version: 3.13 8 ;; Version: 3.14
9 ;; 9 ;;
10 ;; This file is part of GNU Emacs. 10 ;; This file is part of GNU Emacs.
11 ;; 11 ;;
12 ;; GNU Emacs is free software; you can redistribute it and/or modify 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 13 ;; it under the terms of the GNU General Public License as published by
19 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 19 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
20 ;; GNU General Public License for more details. 20 ;; GNU General Public License for more details.
21 21
22 ;; You should have received a copy of the GNU General Public License 22 ;; You should have received a copy of the GNU General Public License
23 ;; along with GNU Emacs; see the file COPYING. If not, write to the 23 ;; along with GNU Emacs; see the file COPYING. If not, write to the
24 ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, 24 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
25 ;; Boston, MA 02110-1301, USA. 25 ;; Boston, MA 02111-1307, USA.
26 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 26 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
27 ;; 27 ;;
28 ;;; Commentary: 28 ;;; Commentary:
29 ;; 29 ;;
30 ;; Org-mode is a mode for keeping notes, maintaining ToDo lists, and doing 30 ;; Org-mode is a mode for keeping notes, maintaining ToDo lists, and doing
78 ;; Org-mode, you can read the same text online as HTML. There is also an 78 ;; Org-mode, you can read the same text online as HTML. There is also an
79 ;; excellent reference card made by Philip Rooke. 79 ;; excellent reference card made by Philip Rooke.
80 ;; 80 ;;
81 ;; Changes: 81 ;; Changes:
82 ;; ------- 82 ;; -------
83 ;; Version 3.14
84 ;; - Formulas for individual fields in table.
85 ;; - Automatic recalculation in calculating tables.
86 ;; - Named fields and columns in tables.
87 ;; - Fixed bug with calling `org-archive' several times in a row.
88 ;;
83 ;; Version 3.13 89 ;; Version 3.13
84 ;; - Efficiency improvements: Fewer table re-alignments needed. 90 ;; - Efficiency improvements: Fewer table re-alignments needed.
85 ;; - New special lines in tables, for defining names for individual cells. 91 ;; - New special lines in tables, for defining names for individual cells.
86 ;; 92 ;;
87 ;; Version 3.12 93 ;; Version 3.12
180 (require 'time-date) 186 (require 'time-date)
181 (require 'easymenu) 187 (require 'easymenu)
182 188
183 ;;; Customization variables 189 ;;; Customization variables
184 190
185 (defvar org-version "3.13" 191 (defvar org-version "3.14"
186 "The version number of the file org.el.") 192 "The version number of the file org.el.")
187 (defun org-version () 193 (defun org-version ()
188 (interactive) 194 (interactive)
189 (message "Org-mode version %s" org-version)) 195 (message "Org-mode version %s" org-version))
190 196
1213 In Org-mode tables, all lines before the first horizontal separator 1219 In Org-mode tables, all lines before the first horizontal separator
1214 line will be formatted with <th> tags." 1220 line will be formatted with <th> tags."
1215 :group 'org-table 1221 :group 'org-table
1216 :type 'boolean) 1222 :type 'boolean)
1217 1223
1224 (defcustom org-table-tab-recognizes-table.el t
1225 "Non-nil means, TAB will automatically notice a table.el table.
1226 When it sees such a table, it moves point into it and - if necessary -
1227 calls `table-recognize-table'."
1228 :group 'org-table
1229 :type 'boolean)
1230
1231 ;; FIXME: Should this one be in another group? Which one?
1232 (defcustom org-enable-fixed-width-editor t
1233 "Non-nil means, lines starting with \":\" are treated as fixed-width.
1234 This currently only means, they are never auto-wrapped.
1235 When nil, such lines will be treated like ordinary lines."
1236 :group 'org-table
1237 :type 'boolean)
1218 1238
1219 (defgroup org-table-calculation nil 1239 (defgroup org-table-calculation nil
1220 "Options concerning tables in Org-mode." 1240 "Options concerning tables in Org-mode."
1221 :tag "Org Table Calculation" 1241 :tag "Org Table Calculation"
1222 :group 'org) 1242 :group 'org)
1282 must also be a number. When nil, calc's full potential is available 1302 must also be a number. When nil, calc's full potential is available
1283 in table calculations, including symbolics etc." 1303 in table calculations, including symbolics etc."
1284 :group 'org-table-calculation 1304 :group 'org-table-calculation
1285 :type 'boolean) 1305 :type 'boolean)
1286 1306
1287 (defcustom org-table-tab-recognizes-table.el t 1307 (defcustom org-table-allow-automatic-line-recalculation t
1288 "Non-nil means, TAB will automatically notice a table.el table. 1308 "Non-nil means, lines makred with |#| or |*| will be recomputed automatically.
1289 When it sees such a table, it moves point into it and - if necessary - 1309 Automatically means, when TAB or RET or C-c C-c are pressed in the line."
1290 calls `table-recognize-table'." 1310 :group 'org-table-calculation
1291 :group 'org-table
1292 :type 'boolean)
1293
1294 (defcustom org-export-prefer-native-exporter-for-tables nil
1295 "Non-nil means, always export tables created with table.el natively.
1296 Natively means, use the HTML code generator in table.el.
1297 When nil, Org-mode's own HTML generator is used when possible (i.e. if
1298 the table does not use row- or column-spanning). This has the
1299 advantage, that the automatic HTML conversions for math symbols and
1300 sub/superscripts can be applied. Org-mode's HTML generator is also
1301 much faster."
1302 :group 'org-table
1303 :type 'boolean)
1304
1305 (defcustom org-enable-fixed-width-editor t
1306 "Non-nil means, lines starting with \":\" are treated as fixed-width.
1307 This currently only means, they are never auto-wrapped.
1308 When nil, such lines will be treated like ordinary lines."
1309 :group 'org-table
1310 :type 'boolean) 1311 :type 'boolean)
1311 1312
1312 (defgroup org-export nil 1313 (defgroup org-export nil
1313 "Options for exporting org-listings." 1314 "Options for exporting org-listings."
1314 :tag "Org Export" 1315 :tag "Org Export"
1420 | Arthur Dent | England | 29.2.2100 | 1421 | Arthur Dent | England | 29.2.2100 |
1421 1422
1422 In ASCII export, this option has no effect. 1423 In ASCII export, this option has no effect.
1423 1424
1424 This option can also be set with the +OPTIONS line, e.g. \"|:nil\"." 1425 This option can also be set with the +OPTIONS line, e.g. \"|:nil\"."
1426 :group 'org-export
1427 :type 'boolean)
1428
1429 (defcustom org-export-prefer-native-exporter-for-tables nil
1430 "Non-nil means, always export tables created with table.el natively.
1431 Natively means, use the HTML code generator in table.el.
1432 When nil, Org-mode's own HTML generator is used when possible (i.e. if
1433 the table does not use row- or column-spanning). This has the
1434 advantage, that the automatic HTML conversions for math symbols and
1435 sub/superscripts can be applied. Org-mode's HTML generator is also
1436 much faster."
1425 :group 'org-export 1437 :group 'org-export
1426 :type 'boolean) 1438 :type 'boolean)
1427 1439
1428 (defcustom org-export-html-table-tag 1440 (defcustom org-export-html-table-tag
1429 "<table border=1 cellspacing=0 cellpadding=6>" 1441 "<table border=1 cellspacing=0 cellpadding=6>"
1924 (list (concat "^[*]+ +\\<\\(" org-done-string "\\)\\>") 1936 (list (concat "^[*]+ +\\<\\(" org-done-string "\\)\\>")
1925 '(1 'org-done t))) 1937 '(1 'org-done t)))
1926 '("^[ \t]*\\(\\(|\\|\\+-[-+]\\).*\\S-\\)" 1938 '("^[ \t]*\\(\\(|\\|\\+-[-+]\\).*\\S-\\)"
1927 (1 'org-table t)) 1939 (1 'org-table t))
1928 '("^[ \t]*\\(:.*\\)" (1 'org-table t)) 1940 '("^[ \t]*\\(:.*\\)" (1 'org-table t))
1929 '("| *\\(=[^|\n]*\\)" (1 'org-formula t)) 1941 '("| *\\(:?=[^|\n]*\\)" (1 'org-formula t))
1930 '("^[ \t]*| *\\([#!$*_^]\\) *|" (1 'org-formula t)) 1942 '("^[ \t]*| *\\([#!$*_^]\\) *|" (1 'org-formula t))
1931 ))) 1943 )))
1932 (set (make-local-variable 'org-font-lock-keywords) 1944 (set (make-local-variable 'org-font-lock-keywords)
1933 (append 1945 (append
1934 (if org-noutline-p ; FIXME: I am not sure if eval will work 1946 (if org-noutline-p ; FIXME: I am not sure if eval will work
2632 (if (and (> (length heading) 0) 2644 (if (and (> (length heading) 0)
2633 (string-match "^\\*+" heading)) 2645 (string-match "^\\*+" heading))
2634 (setq level (match-end 0)) 2646 (setq level (match-end 0))
2635 (setq heading nil level 0)) 2647 (setq heading nil level 0))
2636 (save-excursion 2648 (save-excursion
2637 (org-copy-subtree) ; We first only copy, in case something goes wrong 2649 ;; We first only copy, in case something goes wrong
2650 ;; we need to protect this-command, to avoid kill-region sets it,
2651 ;; which would lead to duplication of subtrees
2652 (let (this-command) (org-copy-subtree))
2638 (set-buffer buffer) 2653 (set-buffer buffer)
2639 ;; Enforce org-mode for the archive buffer 2654 ;; Enforce org-mode for the archive buffer
2640 (if (not (eq major-mode 'org-mode)) 2655 (if (not (eq major-mode 'org-mode))
2641 ;; Force the mode for future visits. 2656 ;; Force the mode for future visits.
2642 (let ((org-insert-mode-line-in-empty-file t)) 2657 (let ((org-insert-mode-line-in-empty-file t))
2689 ")")) 2704 ")"))
2690 ;; Save the buffer, if it is not the same buffer. 2705 ;; Save the buffer, if it is not the same buffer.
2691 (if (not (eq this-buffer buffer)) (save-buffer)))) 2706 (if (not (eq this-buffer buffer)) (save-buffer))))
2692 ;; Here we are back in the original buffer. Everything seems to have 2707 ;; Here we are back in the original buffer. Everything seems to have
2693 ;; worked. So now cut the tree and finish up. 2708 ;; worked. So now cut the tree and finish up.
2694 (org-cut-subtree) 2709 (let (this-command) (org-cut-subtree))
2695 (if (looking-at "[ \t]*$") (kill-line)) 2710 (if (looking-at "[ \t]*$") (kill-line))
2696 (message "Subtree archived %s" 2711 (message "Subtree archived %s"
2697 (if (eq this-buffer buffer) 2712 (if (eq this-buffer buffer)
2698 (concat "under heading: " heading) 2713 (concat "under heading: " heading)
2699 (concat "in file: " (abbreviate-file-name file)))))) 2714 (concat "in file: " (abbreviate-file-name file))))))
2715 (beg (save-excursion 2730 (beg (save-excursion
2716 (if (equal (char-before (point)) ?\ ) (backward-char 1)) 2731 (if (equal (char-before (point)) ?\ ) (backward-char 1))
2717 (skip-chars-backward "a-zA-Z0-9_:$") 2732 (skip-chars-backward "a-zA-Z0-9_:$")
2718 (point))) 2733 (point)))
2719 (texp (equal (char-before beg) ?\\)) 2734 (texp (equal (char-before beg) ?\\))
2720 (form (equal (char-before beg) ?=))
2721 (opt (equal (buffer-substring (max (point-at-bol) (- beg 2)) 2735 (opt (equal (buffer-substring (max (point-at-bol) (- beg 2))
2722 beg) 2736 beg)
2723 "#+")) 2737 "#+"))
2724 (pattern (buffer-substring-no-properties beg end)) 2738 (pattern (buffer-substring-no-properties beg end))
2725 (completion-ignore-case opt) 2739 (completion-ignore-case opt)
2732 (cons (match-string 2 x) (match-string 1 x))) 2746 (cons (match-string 2 x) (match-string 1 x)))
2733 (org-split-string (org-get-current-options) "\n"))) 2747 (org-split-string (org-get-current-options) "\n")))
2734 (texp 2748 (texp
2735 (setq type :tex) 2749 (setq type :tex)
2736 org-html-entities) 2750 org-html-entities)
2737 (form
2738 (setq type :form)
2739 '(("sum") ("sumv") ("sumh")))
2740 ((string-match "\\`\\*+[ \t]*\\'" 2751 ((string-match "\\`\\*+[ \t]*\\'"
2741 (buffer-substring (point-at-bol) beg)) 2752 (buffer-substring (point-at-bol) beg))
2742 (setq type :todo) 2753 (setq type :todo)
2743 (mapcar 'list org-todo-keywords)) 2754 (mapcar 'list org-todo-keywords))
2744 (t (progn (ispell-complete-word arg) (throw 'exit nil))))) 2755 (t (progn (ispell-complete-word arg) (throw 'exit nil)))))
5814 "Detects an org-type table line.") 5825 "Detects an org-type table line.")
5815 (defconst org-table-auto-recalculate-regexp "^[ \t]*| *# *\\(|\\|$\\)" 5826 (defconst org-table-auto-recalculate-regexp "^[ \t]*| *# *\\(|\\|$\\)"
5816 "Detects a table line marked for automatic recalculation.") 5827 "Detects a table line marked for automatic recalculation.")
5817 (defconst org-table-recalculate-regexp "^[ \t]*| *[#*] *\\(|\\|$\\)" 5828 (defconst org-table-recalculate-regexp "^[ \t]*| *[#*] *\\(|\\|$\\)"
5818 "Detects a table line marked for automatic recalculation.") 5829 "Detects a table line marked for automatic recalculation.")
5830 (defconst org-table-calculate-mark-regexp "^[ \t]*| *[!$^_#*] *\\(|\\|$\\)"
5831 "Detects a table line marked for automatic recalculation.")
5819 (defconst org-table-hline-regexp "^[ \t]*|-" 5832 (defconst org-table-hline-regexp "^[ \t]*|-"
5820 "Detects an org-type table hline.") 5833 "Detects an org-type table hline.")
5821 (defconst org-table1-hline-regexp "^[ \t]*\\+-[-+]" 5834 (defconst org-table1-hline-regexp "^[ \t]*\\+-[-+]"
5822 "Detects a table-type table hline.") 5835 "Detects a table-type table hline.")
5823 (defconst org-table-any-line-regexp "^[ \t]*\\(|\\|\\+-[-+]\\)" 5836 (defconst org-table-any-line-regexp "^[ \t]*\\(|\\|\\+-[-+]\\)"
6117 "Justify the current field, text to left, number to right. 6130 "Justify the current field, text to left, number to right.
6118 Optional argument NEW may specify text to replace the current field content." 6131 Optional argument NEW may specify text to replace the current field content."
6119 (cond 6132 (cond
6120 ((and (not new) org-table-may-need-update)) ; Realignment will happen anyway 6133 ((and (not new) org-table-may-need-update)) ; Realignment will happen anyway
6121 ((org-at-table-hline-p) 6134 ((org-at-table-hline-p)
6122 ;; FIXME: I use to enforce realign here, but I think this is not needed. 6135 ;; FIXME: I used to enforce realign here, but I think this is not needed.
6123 ;; (setq org-table-may-need-update t) 6136 ;; (setq org-table-may-need-update t)
6124 ) 6137 )
6125 ((and (not new) 6138 ((and (not new)
6126 (or (not (equal (marker-buffer org-table-aligned-begin-marker) 6139 (or (not (equal (marker-buffer org-table-aligned-begin-marker)
6127 (current-buffer))) 6140 (current-buffer)))
6131 (setq org-table-may-need-update t)) 6144 (setq org-table-may-need-update t))
6132 (t ;; realign the current field, based on previous full realign 6145 (t ;; realign the current field, based on previous full realign
6133 (let* ((pos (point)) s 6146 (let* ((pos (point)) s
6134 (col (org-table-current-column)) 6147 (col (org-table-current-column))
6135 (num (nth (1- col) org-table-last-alignment)) 6148 (num (nth (1- col) org-table-last-alignment))
6136 l f n o upd) 6149 l f n o e)
6137 (when (> col 0) 6150 (when (> col 0)
6138 (skip-chars-backward "^|\n") 6151 (skip-chars-backward "^|\n")
6139 (if (looking-at " *\\([^|\n]*?\\) *|") 6152 (if (looking-at " *\\([^|\n]*?\\) *\\(|\\|$\\)")
6140 (progn 6153 (progn
6141 (setq s (match-string 1) 6154 (setq s (match-string 1)
6142 o (match-string 0) 6155 o (match-string 0)
6143 l (max 1 (- (match-end 0) (match-beginning 0) 3))) 6156 l (max 1 (- (match-end 0) (match-beginning 0) 3))
6144 (setq f (format (if num " %%%ds |" " %%-%ds |") l) 6157 e (not (= (match-beginning 2) (match-end 2))))
6158 (setq f (format (if num " %%%ds %s" " %%-%ds %s")
6159 l (if e "|" (setq org-table-may-need-update t) ""))
6145 n (format f s t t)) 6160 n (format f s t t))
6146 (if new 6161 (if new
6147 (if (<= (length new) l) 6162 (if (<= (length new) l)
6148 (setq n (format f new t t)) ;; FIXME: why t t????? 6163 (setq n (format f new t t)) ;; FIXME: why t t?????
6149 (setq n (concat new "|") org-table-may-need-update t))) 6164 (setq n (concat new "|") org-table-may-need-update t)))
6978 (if (boundp 'timecnt) (setq timecnt (1+ timecnt))) 6993 (if (boundp 'timecnt) (setq timecnt (1+ timecnt)))
6979 (* 1.0 (+ h (/ m 60.0) (/ s 3600.0))))) 6994 (* 1.0 (+ h (/ m 60.0) (/ s 3600.0)))))
6980 ((equal n 0) nil) 6995 ((equal n 0) nil)
6981 (t n)))) 6996 (t n))))
6982 6997
6998 (defun org-table-get-vertical-vector (desc &optional tbeg col)
6999 "Get a calc vector from a column, accorting to desctiptor
7000 Optional arguments TBEG and COL can give the beginning of the table and
7001 the current column, to avoid unnecessary parsing."
7002 (save-excursion
7003 (or tbeg (setq tbeg (org-table-begin)))
7004 (or col (setq col (org-table-current-column)))
7005 (let (beg end nn n n1 n2 l (thisline (org-current-line)) hline-list)
7006 (cond
7007 ((string-match "\\(I+\\)\\(-\\(I+\\)\\)?" desc)
7008 (setq n1 (- (match-end 1) (match-beginning 1)))
7009 (if (match-beginning 3)
7010 (setq n2 (- (match-end 2) (match-beginning 3))))
7011 (setq n (if n2 (max n1 n2) n1))
7012 (setq n1 (if n2 (min n1 n2)))
7013 (setq nn n)
7014 (while (and (> nn 0)
7015 (re-search-backward org-table-hline-regexp tbeg t))
7016 (push (org-current-line) hline-list)
7017 (setq nn (1- nn)))
7018 (setq hline-list (nreverse hline-list))
7019 (goto-line (nth (1- n) hline-list))
7020 (when (re-search-forward org-table-dataline-regexp)
7021 (org-table-goto-column col)
7022 (setq beg (point)))
7023 (goto-line (if n1 (nth (1- n1) hline-list) thisline))
7024 (when (re-search-backward org-table-dataline-regexp)
7025 (org-table-goto-column col)
7026 (setq end (point)))
7027 (setq l (apply 'append (org-table-copy-region beg end)))
7028 (concat "[" (mapconcat (lambda (x) (setq x (org-trim x))
7029 (if (equal x "") "0" x))
7030 l ",") "]"))
7031 ((string-match "\\([0-9]+\\)-\\([0-9]+\\)" desc)
7032 (setq n1 (string-to-number (match-string 1 desc))
7033 n2 (string-to-number (match-string 2 desc)))
7034 (beginning-of-line 1)
7035 (save-excursion
7036 (when (re-search-backward org-table-dataline-regexp tbeg t n1)
7037 (org-table-goto-column col)
7038 (setq beg (point))))
7039 (when (re-search-backward org-table-dataline-regexp tbeg t n2)
7040 (org-table-goto-column col)
7041 (setq end (point)))
7042 (setq l (apply 'append (org-table-copy-region beg end)))
7043 (concat "[" (mapconcat
7044 (lambda (x) (setq x (org-trim x))
7045 (if (equal x "") "0" x))
7046 l ",") "]"))
7047 ((string-match "\\([0-9]+\\)" desc)
7048 (beginning-of-line 1)
7049 (when (re-search-backward org-table-dataline-regexp tbeg t
7050 (string-to-number (match-string 0 desc)))
7051 (org-table-goto-column col)
7052 (org-trim (org-table-get-field))))))))
7053
6983 (defvar org-table-formula-history nil) 7054 (defvar org-table-formula-history nil)
6984 7055
6985 (defun org-table-get-formula (&optional equation) 7056 (defvar org-table-column-names nil
7057 "Alist with column names, derived from the `!' line.")
7058 (defvar org-table-column-name-regexp nil
7059 "Regular expression matching the current column names.")
7060 (defvar org-table-local-parameters nil
7061 "Alist with parameter names, derived from the `$' line.")
7062 (defvar org-table-named-field-locations nil
7063 "Alist with locations of named fields.")
7064
7065 (defun org-table-get-formula (&optional equation named)
6986 "Read a formula from the minibuffer, offer stored formula as default." 7066 "Read a formula from the minibuffer, offer stored formula as default."
6987 (let* ((col (org-table-current-column)) 7067 (let* ((name (car (rassoc (list (org-current-line)
7068 (org-table-current-column))
7069 org-table-named-field-locations)))
7070 (scol (if named
7071 (if name name
7072 (error "Not in a named field"))
7073 (int-to-string (org-table-current-column))))
7074 (dummy (and name (not named)
7075 (not (y-or-n-p "Replace named-field formula with column equation? " ))
7076 (error "Abort")))
6988 (org-table-may-need-update nil) 7077 (org-table-may-need-update nil)
6989 (stored-list (org-table-get-stored-formulas)) 7078 (stored-list (org-table-get-stored-formulas))
6990 (stored (cdr (assoc col stored-list))) 7079 (stored (cdr (assoc scol stored-list)))
6991 (eq (cond 7080 (eq (cond
6992 ((and stored equation (string-match "^ *= *$" equation)) 7081 ((and stored equation (string-match "^ *= *$" equation))
6993 stored) 7082 stored)
6994 ((stringp equation) 7083 ((stringp equation)
6995 equation) 7084 equation)
6996 (t (read-string 7085 (t (read-string
6997 "Formula: " (or stored "") 'org-table-formula-history 7086 (format "%s formula $%s=" (if named "Field" "Column") scol)
6998 stored))))) 7087 (or stored "") 'org-table-formula-history
6999 (if (not (string-match "\\S-" eq)) 7088 ;stored
7000 (error "Empty formula")) 7089 ))))
7090 mustsave)
7091 (when (not (string-match "\\S-" eq))
7092 ;; remove formula
7093 (setq stored-list (delq (assoc scol stored-list) stored-list))
7094 (org-table-store-formulas stored-list)
7095 (error "Formula removed"))
7001 (if (string-match "^ *=?" eq) (setq eq (replace-match "" t t eq))) 7096 (if (string-match "^ *=?" eq) (setq eq (replace-match "" t t eq)))
7002 (if (string-match " *$" eq) (setq eq (replace-match "" t t eq))) 7097 (if (string-match " *$" eq) (setq eq (replace-match "" t t eq)))
7098 (if (and name (not named))
7099 ;; We set the column equation, delete the named one.
7100 (setq stored-list (delq (assoc name stored-list) stored-list)
7101 mustsave t))
7003 (if stored 7102 (if stored
7004 (setcdr (assoc col stored-list) eq) 7103 (setcdr (assoc scol stored-list) eq)
7005 (setq stored-list (cons (cons col eq) stored-list))) 7104 (setq stored-list (cons (cons scol eq) stored-list)))
7006 (if (not (equal stored eq)) 7105 (if (or mustsave (not (equal stored eq)))
7007 (org-table-store-formulas stored-list)) 7106 (org-table-store-formulas stored-list))
7008 eq)) 7107 eq))
7009 7108
7010 (defun org-table-store-formulas (alist) 7109 (defun org-table-store-formulas (alist)
7011 "Store the list of formulas below the current table." 7110 "Store the list of formulas below the current table."
7012 (setq alist (sort alist (lambda (a b) (< (car a) (car b))))) 7111 (setq alist (sort alist (lambda (a b) (string< (car a) (car b)))))
7013 (save-excursion 7112 (save-excursion
7014 (goto-char (org-table-end)) 7113 (goto-char (org-table-end))
7015 (if (looking-at "\\([ \t]*\n\\)*#\\+TBLFM:.*\n?") 7114 (if (looking-at "\\([ \t]*\n\\)*#\\+TBLFM:.*\n?")
7016 (delete-region (point) (match-end 0))) 7115 (delete-region (point) (match-end 0)))
7017 (insert "#+TBLFM: " 7116 (insert "#+TBLFM: "
7018 (mapconcat (lambda (x) 7117 (mapconcat (lambda (x)
7019 (concat "$" (int-to-string (car x)) "=" (cdr x))) 7118 (concat "$" (car x) "=" (cdr x)))
7020 alist "::") 7119 alist "::")
7021 "\n"))) 7120 "\n")))
7022 7121
7023 (defun org-table-get-stored-formulas () 7122 (defun org-table-get-stored-formulas ()
7024 "Return an alist withh the t=stored formulas directly after current table." 7123 "Return an alist with the t=stored formulas directly after current table."
7025 (interactive) 7124 (interactive)
7026 (let (col eq eq-alist strings string) 7125 (let (scol eq eq-alist strings string seen)
7027 (save-excursion 7126 (save-excursion
7028 (goto-char (org-table-end)) 7127 (goto-char (org-table-end))
7029 (when (looking-at "\\([ \t]*\n\\)*#\\+TBLFM: *\\(.*\\)") 7128 (when (looking-at "\\([ \t]*\n\\)*#\\+TBLFM: *\\(.*\\)")
7030 (setq strings (org-split-string (match-string 2) " *:: *")) 7129 (setq strings (org-split-string (match-string 2) " *:: *"))
7031 (while (setq string (pop strings)) 7130 (while (setq string (pop strings))
7032 (if (string-match "\\$\\([0-9]+\\) *= *\\(.*[^ \t]\\)" string) 7131 (when (string-match "\\$\\([a-zA-Z0-9]+\\) *= *\\(.*[^ \t]\\)" string)
7033 (setq col (string-to-number (match-string 1 string)) 7132 (setq scol (match-string 1 string)
7034 eq (match-string 2 string) 7133 eq (match-string 2 string)
7035 eq-alist (cons (cons col eq) eq-alist)))))) 7134 eq-alist (cons (cons scol eq) eq-alist))
7036 eq-alist)) 7135 (if (member scol seen)
7136 (error "Double definition `$%s=' in TBLFM line, please fix by hand" scol)
7137 (push scol seen))))))
7138 (nreverse eq-alist)))
7037 7139
7038 (defun org-table-modify-formulas (action &rest columns) 7140 (defun org-table-modify-formulas (action &rest columns)
7039 "Modify the formulas stored below the current table. 7141 "Modify the formulas stored below the current table.
7040 ACTION can be `remove', `insert', `swap'. For `swap', two column numbers are 7142 ACTION can be `remove', `insert', `swap'. For `swap', two column numbers are
7041 expected, for the other action only a single column number is needed." 7143 expected, for the other action only a single column number is needed."
7042 (let ((list (org-table-get-stored-formulas)) 7144 (let ((list (org-table-get-stored-formulas))
7043 (nmax (length (org-split-string (buffer-substring (point-at-bol) (point-at-eol)) 7145 (nmax (length (org-split-string
7044 "|"))) 7146 (buffer-substring (point-at-bol) (point-at-eol))
7045 col col1 col2) 7147 "|")))
7148 col col1 col2 scol si sc1 sc2)
7046 (cond 7149 (cond
7047 ((null list)) ; No action needed if there are no stored formulas 7150 ((null list)) ; No action needed if there are no stored formulas
7048 ((eq action 'remove) 7151 ((eq action 'remove)
7049 (setq col (car columns)) 7152 (setq col (car columns)
7050 (org-table-replace-in-formulas list col "INVALID") 7153 scol (int-to-string col))
7051 (if (assoc col list) (setq list (delq (assoc col list) list))) 7154 (org-table-replace-in-formulas list scol "INVALID")
7155 (if (assoc scol list) (setq list (delq (assoc scol list) list)))
7052 (loop for i from (1+ col) upto nmax by 1 do 7156 (loop for i from (1+ col) upto nmax by 1 do
7053 (org-table-replace-in-formulas list i (1- i)) 7157 (setq si (int-to-string i))
7054 (if (assoc i list) (setcar (assoc i list) (1- i))))) 7158 (org-table-replace-in-formulas list si (int-to-string (1- i)))
7159 (if (assoc si list) (setcar (assoc si list)
7160 (int-to-string (1- i))))))
7055 ((eq action 'insert) 7161 ((eq action 'insert)
7056 (setq col (car columns)) 7162 (setq col (car columns))
7057 (loop for i from nmax downto col by 1 do 7163 (loop for i from nmax downto col by 1 do
7058 (org-table-replace-in-formulas list i (1+ i)) 7164 (setq si (int-to-string i))
7059 (if (assoc i list) (setcar (assoc i list) (1+ i))))) 7165 (org-table-replace-in-formulas list si (int-to-string (1+ i)))
7166 (if (assoc si list) (setcar (assoc si list)
7167 (int-to-string (1+ i))))))
7060 ((eq action 'swap) 7168 ((eq action 'swap)
7061 (setq col1 (car columns) col2 (nth 1 columns)) 7169 (setq col1 (car columns) col2 (nth 1 columns)
7062 (org-table-replace-in-formulas list col1 "Z") 7170 sc1 (int-to-string col1) sc2 (int-to-string col2))
7063 (org-table-replace-in-formulas list col2 col1) 7171 ;; Hopefully, ZqZ will never be a name in a table... FIXME:
7064 (org-table-replace-in-formulas list "Z" col2) 7172 (org-table-replace-in-formulas list sc1 "ZqZ")
7065 (if (assoc col1 list) (setcar (assoc col1 list) "Z")) 7173 (org-table-replace-in-formulas list sc2 sc1)
7066 (if (assoc col2 list) (setcar (assoc col2 list) col1)) 7174 (org-table-replace-in-formulas list "ZqZ" sc2)
7067 (if (assoc "Z" list) (setcar (assoc "Z" list) col2))) 7175 (if (assoc sc1 list) (setcar (assoc sc1 list) "ZqZ"))
7176 (if (assoc sc2 list) (setcar (assoc sc2 list) sc1))
7177 (if (assoc "ZqZ" list) (setcar (assoc "ZqZ" list) sc2)))
7068 (t (error "Invalid action in `org-table-modify-formulas'"))) 7178 (t (error "Invalid action in `org-table-modify-formulas'")))
7069 (if list (org-table-store-formulas list)))) 7179 (if list (org-table-store-formulas list))))
7070 7180
7071 (defun org-table-replace-in-formulas (list s1 s2) 7181 (defun org-table-replace-in-formulas (list s1 s2)
7072 (let (elt re s) 7182 (let (elt re s)
7077 (setq s (cdr elt)) 7187 (setq s (cdr elt))
7078 (while (string-match re s) 7188 (while (string-match re s)
7079 (setq s (replace-match s2 t t s))) 7189 (setq s (replace-match s2 t t s)))
7080 (setcdr elt s)))) 7190 (setcdr elt s))))
7081 7191
7082 (defvar org-table-column-names nil
7083 "Alist with column names, derived from the `!' line.")
7084 (defvar org-table-column-name-regexp nil
7085 "Regular expression matching the current column names.")
7086 (defvar org-table-local-parameters nil
7087 "Alist with parameter names, derived from the `$' line.")
7088
7089 (defun org-table-get-specials () 7192 (defun org-table-get-specials ()
7090 "Get the column nmaes and local parameters for this table." 7193 "Get the column nmaes and local parameters for this table."
7091 (save-excursion 7194 (save-excursion
7092 (let ((beg (org-table-begin)) (end (org-table-end)) 7195 (let ((beg (org-table-begin)) (end (org-table-end))
7093 names name fields fields1 field cnt c v) 7196 names name fields fields1 field cnt c v line col)
7094 (setq org-table-column-names nil 7197 (setq org-table-column-names nil
7095 org-table-local-parameters nil) 7198 org-table-local-parameters nil
7199 org-table-named-field-locations nil)
7096 (goto-char beg) 7200 (goto-char beg)
7097 (when (re-search-forward "^[ \t]*| *! *\\(|.*\\)" end t) 7201 (when (re-search-forward "^[ \t]*| *! *\\(|.*\\)" end t)
7098 (setq names (org-split-string (match-string 1) " *| *") 7202 (setq names (org-split-string (match-string 1) " *| *")
7099 cnt 1) 7203 cnt 1)
7100 (while (setq name (pop names)) 7204 (while (setq name (pop names))
7115 (while (re-search-forward "^[ \t]*| *\\([_^]\\) *\\(|.*\\)" end t) 7219 (while (re-search-forward "^[ \t]*| *\\([_^]\\) *\\(|.*\\)" end t)
7116 (setq c (match-string 1) 7220 (setq c (match-string 1)
7117 fields (org-split-string (match-string 2) " *| *")) 7221 fields (org-split-string (match-string 2) " *| *"))
7118 (save-excursion 7222 (save-excursion
7119 (beginning-of-line (if (equal c "_") 2 0)) 7223 (beginning-of-line (if (equal c "_") 2 0))
7224 (setq line (org-current-line) col 1)
7120 (and (looking-at "^[ \t]*|[^|]*\\(|.*\\)") 7225 (and (looking-at "^[ \t]*|[^|]*\\(|.*\\)")
7121 (setq fields1 (org-split-string (match-string 1) " *| *")))) 7226 (setq fields1 (org-split-string (match-string 1) " *| *"))))
7122 (while (setq field (pop fields)) 7227 (while (and fields1 (setq field (pop fields)))
7123 (setq v (pop fields1)) 7228 (setq v (pop fields1) col (1+ col))
7124 (if (and (stringp field) (stringp v) 7229 (when (and (stringp field) (stringp v)
7125 (string-match "^[a-zA-Z][a-zA-Z0-9]*$" field)) 7230 (string-match "^[a-zA-Z][a-zA-Z0-9]*$" field))
7126 (push (cons field v) org-table-local-parameters))))))) 7231 (push (cons field v) org-table-local-parameters)
7232 (push (list field line col) org-table-named-field-locations)))))))
7127 7233
7128 (defun org-this-word () 7234 (defun org-this-word ()
7129 ;; Get the current word 7235 ;; Get the current word
7130 (save-excursion 7236 (save-excursion
7131 (let ((beg (progn (skip-chars-backward "^ \t\n") (point))) 7237 (let ((beg (progn (skip-chars-backward "^ \t\n") (point)))
7132 (end (progn (skip-chars-forward "^ \t\n") (point)))) 7238 (end (progn (skip-chars-forward "^ \t\n") (point))))
7133 (buffer-substring-no-properties beg end)))) 7239 (buffer-substring-no-properties beg end))))
7134 7240
7135 (defun org-table-maybe-eval-formula () 7241 (defun org-table-maybe-eval-formula ()
7136 "Check if the current field starts with \"=\" and evaluate the formula." 7242 "Check if the current field starts with \"=\" or \":=\".
7243 If yes, store the formula and apply it."
7137 ;; We already know we are in a table. Get field will only return a formula 7244 ;; We already know we are in a table. Get field will only return a formula
7138 ;; when appropriate. It might return a separator line, but no problem. 7245 ;; when appropriate. It might return a separator line, but no problem.
7139 (when org-table-formula-evaluate-inline 7246 (when org-table-formula-evaluate-inline
7140 (let* ((field (org-trim (or (org-table-get-field) ""))) 7247 (let* ((field (org-trim (or (org-table-get-field) "")))
7141 (dfield (downcase field)) 7248 named eq)
7142 col bolpos nlast) 7249 (when (string-match "^:?=\\(.+\\)" field)
7143 (when (equal (string-to-char field) ?=) 7250 (setq named (equal (string-to-char field) ?:)
7144 (if (string-match "^\\(=sum[vh]?\\)\\([0-9]+\\)$" dfield) 7251 eq (match-string 1 field))
7145 (setq nlast (1+ (string-to-number (match-string 2 dfield))) 7252 (if (fboundp 'calc-eval)
7146 dfield (match-string 1 dfield))) 7253 (org-table-eval-formula (if named '(4) nil) eq))))))
7147 (cond
7148 ((equal dfield "=sumh")
7149 (org-table-get-field
7150 nil (org-table-sum
7151 (save-excursion (org-table-goto-column 1) (point))
7152 (point) nlast)))
7153 ((member dfield '("=sum" "=sumv"))
7154 (setq col (org-table-current-column)
7155 bolpos (point-at-bol))
7156 (org-table-get-field
7157 nil (org-table-sum
7158 (save-excursion
7159 (goto-char (org-table-begin))
7160 (if (re-search-forward org-table-dataline-regexp bolpos t)
7161 (progn
7162 (goto-char (match-beginning 0))
7163 (org-table-goto-column col)
7164 (point))
7165 (error "No datalines above current")))
7166 (point) nlast)))
7167 ((and (string-match "^ *=" field)
7168 (fboundp 'calc-eval))
7169 (org-table-eval-formula nil field)))))))
7170
7171 (defvar org-last-recalc-undo-list nil)
7172 (defcustom org-table-allow-line-recalculation t
7173 "FIXME:"
7174 :group 'org-table
7175 :type 'boolean)
7176 7254
7177 (defvar org-recalc-commands nil 7255 (defvar org-recalc-commands nil
7178 "List of commands triggering the reccalculation of a line. 7256 "List of commands triggering the reccalculation of a line.
7179 Will be filled automatically during use.") 7257 Will be filled automatically during use.")
7180 7258
7208 (goto-char beg) 7286 (goto-char beg)
7209 (not (re-search-forward "^[ \t]*|[^-|][^|]*[^#!$*_^| \t][^|]*|" end t)))) 7287 (not (re-search-forward "^[ \t]*|[^-|][^|]*[^#!$*_^| \t][^|]*|" end t))))
7210 (col (org-table-current-column)) 7288 (col (org-table-current-column))
7211 (forcenew (car (assoc newchar org-recalc-marks))) 7289 (forcenew (car (assoc newchar org-recalc-marks)))
7212 epos new) 7290 epos new)
7213 (if l1 (setq newchar (char-to-string (read-char-exclusive "Change region to what mark? Type # * ! $ or SPC: ")) 7291 (when l1
7214 forcenew (car (assoc newchar org-recalc-marks)))) 7292 (message "Change region to what mark? Type # * ! $ or SPC: ")
7293 (setq newchar (char-to-string (read-char-exclusive))
7294 forcenew (car (assoc newchar org-recalc-marks))))
7215 (if (and newchar (not forcenew)) 7295 (if (and newchar (not forcenew))
7216 (error "Invalid NEWCHAR `%s' in `org-table-rotate-recalc-marks'" 7296 (error "Invalid NEWCHAR `%s' in `org-table-rotate-recalc-marks'"
7217 newchar)) 7297 newchar))
7218 (if l1 (goto-line l1)) 7298 (if l1 (goto-line l1))
7219 (save-excursion 7299 (save-excursion
7246 (and (interactive-p) (message (cdr (assoc new org-recalc-marks)))))) 7326 (and (interactive-p) (message (cdr (assoc new org-recalc-marks))))))
7247 7327
7248 (defun org-table-maybe-recalculate-line () 7328 (defun org-table-maybe-recalculate-line ()
7249 "Recompute the current line if marked for it, and if we haven't just done it." 7329 "Recompute the current line if marked for it, and if we haven't just done it."
7250 (interactive) 7330 (interactive)
7251 (and org-table-allow-line-recalculation 7331 (and org-table-allow-automatic-line-recalculation
7252 (not (and (memq last-command org-recalc-commands) 7332 (not (and (memq last-command org-recalc-commands)
7253 (equal org-last-recalc-line (org-current-line)))) 7333 (equal org-last-recalc-line (org-current-line))))
7254 (save-excursion (beginning-of-line 1) 7334 (save-excursion (beginning-of-line 1)
7255 (looking-at org-table-auto-recalculate-regexp)) 7335 (looking-at org-table-auto-recalculate-regexp))
7256 (fboundp 'calc-eval) 7336 (fboundp 'calc-eval)
7271 (if (memq var modes) 7351 (if (memq var modes)
7272 (setcar (cdr (memq var modes)) value) 7352 (setcar (cdr (memq var modes)) value)
7273 (cons var (cons value modes))) 7353 (cons var (cons value modes)))
7274 modes) 7354 modes)
7275 7355
7276 (defun org-table-eval-formula (&optional ndown equation 7356 (defun org-table-eval-formula (&optional arg equation
7277 suppress-align suppress-const 7357 suppress-align suppress-const
7278 suppress-store) 7358 suppress-store)
7279 "Replace the table field value at the cursor by the result of a calculation. 7359 "Replace the table field value at the cursor by the result of a calculation.
7280 7360
7281 This function makes use of Dave Gillespie's calc package, in my view the 7361 This function makes use of Dave Gillespie's calc package, in my view the
7282 most exciting program ever written for GNU Emacs. So you need to have calc 7362 most exciting program ever written for GNU Emacs. So you need to have calc
7283 installed in order to use this function. 7363 installed in order to use this function.
7284 7364
7285 In a table, this command replaces the value in the current field with the 7365 In a table, this command replaces the value in the current field with the
7286 result of a formula. While nowhere near the computation options of a 7366 result of a formula. It also installes the formula as the \"current\" column
7287 spreadsheet program, this is still very useful. There is no automatic 7367 formula, by storing it in a special line below the table. When called
7288 updating of a calculated field, but the table will remember the last 7368 with a `C-u' prefix, the current field must ba a named field, and the
7289 formula for each column. The command needs to be applied again after 7369 formula is installed as valid in only this specific field.
7290 changing input fields. 7370
7291 7371 When called, the command first prompts for a formula, which is read in
7292 When called, the command first prompts for a formula, which is read in the 7372 the minibuffer. Previously entered formulas are available through the
7293 minibuffer. Previously entered formulas are available through the history 7373 history list, and the last used formula is offered as a default.
7294 list, and the last used formula for each column is offered as a default.
7295 These stored formulas are adapted correctly when moving, inserting, or 7374 These stored formulas are adapted correctly when moving, inserting, or
7296 deleting columns with the corresponding commands. 7375 deleting columns with the corresponding commands.
7297 7376
7298 The formula can be any algebraic expression understood by the calc package. 7377 The formula can be any algebraic expression understood by the calc package.
7299 Before evaluation, variable substitution takes place: \"$\" is replaced by 7378 For details, see the Org-mode manual.
7300 the field the cursor is currently in, and $1..$n reference the fields in 7379
7301 the current row. Values from a *different* row can *not* be referenced 7380 This function can also be called from Lisp programs and offers
7302 here, so the command supports only horizontal computing. The formula can 7381 additional Arguments: EQUATION can be the formula to apply. If this
7303 contain an optional printf format specifier after a semicolon, to reformat 7382 argument is given, the user will not be prompted. SUPPRESS-ALIGN is
7304 the result. 7383 used to speed-up recursive calls by by-passing unnecessary aligns.
7305 7384 SUPPRESS-CONST suppresses the interpretation of constants in the
7306 A few examples for formulas: 7385 formula, assuming that this has been done already outside the fuction.
7307 $1+$2 Sum of first and second field 7386 SUPPRESS-STORE means the formula should not be stored, either because
7308 $1+$2;%.2f Same, and format result to two digits after dec.point 7387 it is already stored, or because it is a modified equation that should
7309 exp($2)+exp($1) Math functions can be used 7388 not overwrite the stored one."
7310 $;%.1f Reformat current cell to 1 digit after dec.point
7311 ($3-32)*5/9 degrees F -> C conversion
7312
7313 When called with a raw \\[universal-argument] prefix, the formula is applied to the current
7314 field, and to the same same column in all following rows, until reaching a
7315 horizontal line or the end of the table. When the command is called with a
7316 numeric prefix argument (like M-3 or C-7 or \\[universal-argument] 24), the formula is applied
7317 to the current row, and to the following n-1 rows (but not beyond a
7318 separator line).
7319
7320 This function can also be called from Lisp programs and offers two additional
7321 Arguments: EQUATION can be the formula to apply. If this argument is given,
7322 the user will not be prompted. SUPPRESS-ALIGN is used to speed-up
7323 recursive calls by by-passing unnecessary aligns. SUPPRESS-CONST suppresses
7324 the interpretation of constants in the formula. SUPPRESS-STORE means the
7325 formula should not be stored, either because it is already stored, or because
7326 it is a modified equation that should not overwrite the stored one."
7327 (interactive "P") 7389 (interactive "P")
7328 (setq ndown (if (equal ndown '(4)) 10000 (prefix-numeric-value ndown)))
7329 (require 'calc) 7390 (require 'calc)
7330 (org-table-check-inside-data-field) 7391 (org-table-check-inside-data-field)
7331 (org-table-get-specials) 7392 (org-table-get-specials)
7332 (let* (fields 7393 (let* (fields
7394 (ndown (if (integerp arg) arg 1))
7333 (org-table-automatic-realign nil) 7395 (org-table-automatic-realign nil)
7334 (case-fold-search nil) 7396 (case-fold-search nil)
7335 (down (> ndown 1)) 7397 (down (> ndown 1))
7336 (formula (if (and equation suppress-store) 7398 (formula (if (and equation suppress-store)
7337 equation 7399 equation
7338 (org-table-get-formula equation))) 7400 (org-table-get-formula equation (equal arg '(4)))))
7339 (n0 (org-table-current-column)) 7401 (n0 (org-table-current-column))
7340 (modes (copy-sequence org-calc-default-modes)) 7402 (modes (copy-sequence org-calc-default-modes))
7341 n form fmt x ev orig c) 7403 n form fmt x ev orig c)
7342 ;; Parse the format string. Since we have a lot of modes, this is 7404 ;; Parse the format string. Since we have a lot of modes, this is
7343 ;; a lot of work. 7405 ;; a lot of work. However, I think calc still uses most of the time.
7344 (if (string-match ";" formula) 7406 (if (string-match ";" formula)
7345 (let ((tmp (org-split-string formula ";"))) 7407 (let ((tmp (org-split-string formula ";")))
7346 (setq formula (car tmp) 7408 (setq formula (car tmp)
7347 fmt (concat (cdr (assoc "%" org-table-local-parameters)) 7409 fmt (concat (cdr (assoc "%" org-table-local-parameters))
7348 (nth 1 tmp))) 7410 (nth 1 tmp)))
7372 (setq fields (mapcar 7434 (setq fields (mapcar
7373 (lambda (x) (number-to-string (string-to-number x))) 7435 (lambda (x) (number-to-string (string-to-number x)))
7374 fields))) 7436 fields)))
7375 (setq ndown (1- ndown)) 7437 (setq ndown (1- ndown))
7376 (setq form (copy-sequence formula)) 7438 (setq form (copy-sequence formula))
7439 ;; Insert the references to fields in same row
7377 (while (string-match "\\$\\([0-9]+\\)?" form) 7440 (while (string-match "\\$\\([0-9]+\\)?" form)
7378 (setq n (if (match-beginning 1) 7441 (setq n (if (match-beginning 1)
7379 (string-to-int (match-string 1 form)) 7442 (string-to-int (match-string 1 form))
7380 n0) 7443 n0)
7381 x (nth (1- n) fields)) 7444 x (nth (1- n) fields))
7382 (unless x (error "Invalid field specifier \"%s\"" 7445 (unless x (error "Invalid field specifier \"%s\""
7383 (match-string 0 form))) 7446 (match-string 0 form)))
7384 (if (equal x "") (setq x "0")) 7447 (if (equal x "") (setq x "0"))
7385 (setq form (replace-match (concat "(" x ")") t t form))) 7448 (setq form (replace-match (concat "(" x ")") t t form)))
7449 ;; Insert ranges in current column
7450 (while (string-match "\\&[-I0-9]+" form)
7451 (setq form (replace-match
7452 (save-match-data
7453 (org-table-get-vertical-vector (match-string 0 form)
7454 nil n0))
7455 t t form)))
7386 (setq ev (calc-eval (cons form modes) 7456 (setq ev (calc-eval (cons form modes)
7387 (if org-table-formula-numbers-only 'num))) 7457 (if org-table-formula-numbers-only 'num)))
7388 7458
7389 (when org-table-formula-debug 7459 (when org-table-formula-debug
7390 (with-output-to-temp-buffer "*Help*" 7460 (with-output-to-temp-buffer "*Help*"
7422 (or (memq this-command org-recalc-commands) 7492 (or (memq this-command org-recalc-commands)
7423 (setq org-recalc-commands (cons this-command org-recalc-commands))) 7493 (setq org-recalc-commands (cons this-command org-recalc-commands)))
7424 (unless (org-at-table-p) (error "Not at a table")) 7494 (unless (org-at-table-p) (error "Not at a table"))
7425 (org-table-get-specials) 7495 (org-table-get-specials)
7426 (let* ((eqlist (sort (org-table-get-stored-formulas) 7496 (let* ((eqlist (sort (org-table-get-stored-formulas)
7427 (lambda (a b) (< (car a) (car b))))) 7497 (lambda (a b) (string< (car a) (car b)))))
7428 (inhibit-redisplay t) 7498 (inhibit-redisplay t)
7429 (line-re org-table-dataline-regexp) 7499 (line-re org-table-dataline-regexp)
7430 (thisline (+ (if (bolp) 1 0) (count-lines (point-min) (point)))) 7500 (thisline (+ (if (bolp) 1 0) (count-lines (point-min) (point))))
7431 (thiscol (org-table-current-column)) 7501 (thiscol (org-table-current-column))
7432 beg end entry eql (cnt 0)) 7502 beg end entry eqlnum eqlname eql (cnt 0) eq a name)
7433 ;; Insert constants in all formulas 7503 ;; Insert constants in all formulas
7434 (setq eqlist 7504 (setq eqlist
7435 (mapcar (lambda (x) 7505 (mapcar (lambda (x)
7436 (setcdr x (org-table-formula-substitute-names (cdr x))) 7506 (setcdr x (org-table-formula-substitute-names (cdr x)))
7437 x) 7507 x)
7438 eqlist)) 7508 eqlist))
7509 ;; Split the equation list
7510 (while (setq eq (pop eqlist))
7511 (if (<= (string-to-char (car eq)) ?9)
7512 (push eq eqlnum)
7513 (push eq eqlname)))
7514 (setq eqlnum (nreverse eqlnum) eqlname (nreverse eqlname))
7439 (if all 7515 (if all
7440 (progn 7516 (progn
7441 (setq end (move-marker (make-marker) (1+ (org-table-end)))) 7517 (setq end (move-marker (make-marker) (1+ (org-table-end))))
7442 (goto-char (setq beg (org-table-begin))) 7518 (goto-char (setq beg (org-table-begin)))
7443 (if (re-search-forward org-table-recalculate-regexp end t) 7519 (if (re-search-forward org-table-calculate-mark-regexp end t)
7520 ;; This is a table with marked lines, only compute selected lines
7444 (setq line-re org-table-recalculate-regexp) 7521 (setq line-re org-table-recalculate-regexp)
7522 ;; Move forward to the first non-header line
7445 (if (and (re-search-forward org-table-dataline-regexp end t) 7523 (if (and (re-search-forward org-table-dataline-regexp end t)
7446 (re-search-forward org-table-hline-regexp end t) 7524 (re-search-forward org-table-hline-regexp end t)
7447 (re-search-forward org-table-dataline-regexp end t)) 7525 (re-search-forward org-table-dataline-regexp end t))
7448 (setq beg (match-beginning 0)) 7526 (setq beg (match-beginning 0))
7449 nil))) ;; just leave beg where it is 7527 nil))) ;; just leave beg where it is
7450 (setq beg (point-at-bol) 7528 (setq beg (point-at-bol)
7451 end (move-marker (make-marker) (1+ (point-at-eol))))) 7529 end (move-marker (make-marker) (1+ (point-at-eol)))))
7452 (goto-char beg) 7530 (goto-char beg)
7453 (and all (message "Re-applying formulas to full table...")) 7531 (and all (message "Re-applying formulas to full table..."))
7454 (while (re-search-forward line-re end t) 7532 (while (re-search-forward line-re end t)
7455 (unless (string-match "^ *[!$] *$" (org-table-get-field 1)) 7533 (unless (string-match "^ *[_^!$] *$" (org-table-get-field 1))
7456 ;; Unprotected line, recalculate 7534 ;; Unprotected line, recalculate
7457 (and all (message "Re-applying formulas to full table...(line %d)" 7535 (and all (message "Re-applying formulas to full table...(line %d)"
7458 (setq cnt (1+ cnt)))) 7536 (setq cnt (1+ cnt))))
7459 (setq org-last-recalc-line (org-current-line)) 7537 (setq org-last-recalc-line (org-current-line))
7460 (setq eql eqlist) 7538 (setq eql eqlnum)
7461 (while (setq entry (pop eql)) 7539 (while (setq entry (pop eql))
7462 (goto-line org-last-recalc-line) 7540 (goto-line org-last-recalc-line)
7463 (org-table-goto-column (car entry) nil 'force) 7541 (org-table-goto-column (string-to-int (car entry)) nil 'force)
7464 (org-table-eval-formula nil (cdr entry) 'noalign 'nocst 'nostore)))) 7542 (org-table-eval-formula nil (cdr entry) 'noalign 'nocst 'nostore))))
7465 (goto-line thisline) 7543 (goto-line thisline)
7466 (org-table-goto-column thiscol) 7544 (org-table-goto-column thiscol)
7467 (or noalign (and org-table-may-need-update (org-table-align)) 7545 (or noalign (and org-table-may-need-update (org-table-align))
7468 (and all (message "Re-applying formulas to %d lines...done" cnt))))) 7546 (and all (message "Re-applying formulas to %d lines...done" cnt)))
7547 ;; Now do the names fields
7548 (while (setq eq (pop eqlname))
7549 (setq name (car eq)
7550 a (assoc name org-table-named-field-locations))
7551 (when a
7552 (message "Re-applying formula to named field: %s" name)
7553 (goto-line (nth 1 a))
7554 (org-table-goto-column (nth 2 a))
7555 (org-table-eval-formula nil (cdr eq) 'noalign 'nocst 'nostore)))
7556 ;; back to initial position
7557 (goto-line thisline)
7558 (org-table-goto-column thiscol)
7559 (or noalign (and org-table-may-need-update (org-table-align))
7560 (and all (message "Re-applying formulas...done" cnt)))))
7469 7561
7470 (defun org-table-formula-substitute-names (f) 7562 (defun org-table-formula-substitute-names (f)
7471 "Replace $const with values in stirng F." 7563 "Replace $const with values in stirng F."
7472 (let ((start 0) a n1 n2 nn1 nn2 s (f1 f)) 7564 (let ((start 0) a n1 n2 nn1 nn2 s (f1 f))
7473 ;; First, check for column names 7565 ;; First, check for column names
7502 Parameters get priority." 7594 Parameters get priority."
7503 (or (cdr (assoc const org-table-local-parameters)) 7595 (or (cdr (assoc const org-table-local-parameters))
7504 (cdr (assoc const org-table-formula-constants)) 7596 (cdr (assoc const org-table-formula-constants))
7505 (and (fboundp 'constants-get) (constants-get const)) 7597 (and (fboundp 'constants-get) (constants-get const))
7506 "#UNDEFINED_NAME")) 7598 "#UNDEFINED_NAME"))
7599
7600 (defvar org-edit-formulas-map (make-sparse-keymap))
7601 (define-key org-edit-formulas-map "\C-c\C-c" 'org-finish-edit-formulas)
7602 (define-key org-edit-formulas-map "\C-c\C-q" 'org-abort-edit-formulas)
7603 (define-key org-edit-formulas-map "\C-c?" 'org-show-variable)
7604
7605 (defvar org-pos)
7606 (defvar org-window-configuration)
7607
7608 (defun org-table-edit-formulas ()
7609 "Edit the formulas of the current table in a separate buffer."
7610 (interactive)
7611 (unless (org-at-table-p)
7612 (error "Not at a table"))
7613 (org-table-get-specials)
7614 (let ((eql (org-table-get-stored-formulas))
7615 (pos (move-marker (make-marker) (point)))
7616 (wc (current-window-configuration))
7617 entry loc s)
7618 (switch-to-buffer-other-window "*Edit Formulas*")
7619 (erase-buffer)
7620 (fundamental-mode)
7621 (set (make-local-variable 'org-pos) pos)
7622 (set (make-local-variable 'org-window-configuration) wc)
7623 (use-local-map org-edit-formulas-map)
7624 (setq s "# Edit formulas and finish with `C-c C-c'.
7625 # Use `C-u C-c C-c' to also appy them immediately to the entire table.
7626 # Use `C-c ?' to get information about $name at point.
7627 # To cancel editing, press `C-c C-q'.\n")
7628 (put-text-property 0 (length s) 'face 'font-lock-comment-face s)
7629 (insert s)
7630 (while (setq entry (pop eql))
7631 (when (setq loc (assoc (car entry) org-table-named-field-locations))
7632 (setq s (format "# Named formula, referring to column %d in line %d\n"
7633 (nth 2 loc) (nth 1 loc)))
7634 (put-text-property 0 (length s) 'face 'font-lock-comment-face s)
7635 (insert s))
7636 (setq s (concat "$" (car entry) "=" (cdr entry) "\n"))
7637 (remove-text-properties 0 (length s) '(face nil) s)
7638 (insert s))
7639 (goto-char (point-min))
7640 (message "Edit formulas and finish with `C-c C-c'.")))
7641
7642 (defun org-show-variable ()
7643 "Show the location/value of the $ expression at point."
7644 (interactive)
7645 (let (var (pos org-pos) (win (selected-window)) e)
7646 (save-excursion
7647 (or (looking-at "\\$") (skip-chars-backward "$a-zA-Z0-9"))
7648 (if (looking-at "\\$\\([a-zA-Z0-9]+\\)")
7649 (setq var (match-string 1))
7650 (error "No variable at point")))
7651 (cond
7652 ((setq e (assoc var org-table-named-field-locations))
7653 (switch-to-buffer-other-window (marker-buffer pos))
7654 (goto-line (nth 1 e))
7655 (org-table-goto-column (nth 2 e))
7656 (select-window win)
7657 (message "Named field, column %d of line %d" (nth 2 e) (nth 1 e)))
7658 ((setq e (assoc var org-table-column-names))
7659 (switch-to-buffer-other-window (marker-buffer pos))
7660 (goto-char pos)
7661 (goto-char (org-table-begin))
7662 (if (re-search-forward (concat "^[ \t]*| *! *.*?| *\\(" var "\\) *|")
7663 (org-table-end) t)
7664 (progn
7665 (goto-char (match-beginning 1))
7666 (message "Named column (column %s)" (cdr e)))
7667 (error "Column name not found"))
7668 (select-window win))
7669 ((string-match "^[0-9]$" var)
7670 ;; column number
7671 (switch-to-buffer-other-window (marker-buffer pos))
7672 (goto-char pos)
7673 (goto-char (org-table-begin))
7674 (recenter 1)
7675 (if (re-search-forward org-table-dataline-regexp
7676 (org-table-end) t)
7677 (progn
7678 (goto-char (match-beginning 0))
7679 (org-table-goto-column (string-to-number var))
7680 (message "Column %s" var))
7681 (error "Column name not found"))
7682 (select-window win))
7683 ((setq e (assoc var org-table-local-parameters))
7684 (switch-to-buffer-other-window (marker-buffer pos))
7685 (goto-char pos)
7686 (goto-char (org-table-begin))
7687 (if (re-search-forward (concat "^[ \t]*| *\\$ *.*?| *\\(" var "=\\)") nil t)
7688 (progn
7689 (goto-char (match-beginning 1))
7690 (message "Local parameter."))
7691 (error "Parameter not found"))
7692 (select-window win))
7693 (t
7694 (cond
7695 ((setq e (assoc var org-table-formula-constants))
7696 (message "Constant: $%s=%s in `org-table-formula-constants'." var (cdr e)))
7697 ((setq e (and (fboundp 'constants-get) (constants-get var)))
7698 (message "Constant: $%s=%s, retrieved from `constants.el'." var e))
7699 (t (error "Undefined name $%s" var)))))))
7700
7701 (defun org-finish-edit-formulas (&optional arg)
7702 "Parse the buffer for formula definitions and install them.
7703 With prefix ARG, apply the new formulas to the table."
7704 (interactive "P")
7705 (let ((pos org-pos) eql)
7706 (goto-char (point-min))
7707 (while (re-search-forward "^\\$\\([a-zA-Z0-9]+\\) *= *\\(.*?\\) *$" nil t)
7708 (push (cons (match-string 1) (match-string 2)) eql))
7709 (set-window-configuration org-window-configuration)
7710 (select-window (get-buffer-window (marker-buffer pos)))
7711 (goto-char pos)
7712 (unless (org-at-table-p)
7713 (error "Lost table position - cannot install formulae"))
7714 (org-table-store-formulas eql)
7715 (move-marker pos nil)
7716 (kill-buffer "*Edit Formulas*")
7717 (if arg
7718 (org-table-recalculate 'all)
7719 (message "New formulas installed - press C-u C-c C-c to apply."))))
7720
7721 (defun org-abort-edit-formulas ()
7722 "Abort editing formulas, without installing the changes."
7723 (interactive)
7724 (let ((pos org-pos))
7725 (set-window-configuration org-window-configuration)
7726 (select-window (get-buffer-window (marker-buffer pos)))
7727 (goto-char pos)
7728 (message "Formula editing aborted without installing changes")))
7507 7729
7508 ;;; The orgtbl minor mode 7730 ;;; The orgtbl minor mode
7509 7731
7510 ;; Define a minor mode which can be used in other modes in order to 7732 ;; Define a minor mode which can be used in other modes in order to
7511 ;; integrate the org-mode table editor. 7733 ;; integrate the org-mode table editor.
7655 '("\C-c?" org-table-current-column) 7877 '("\C-c?" org-table-current-column)
7656 '("\C-c " org-table-blank-field) 7878 '("\C-c " org-table-blank-field)
7657 '("\C-c+" org-table-sum) 7879 '("\C-c+" org-table-sum)
7658 '("\C-c|" org-table-toggle-vline-visibility) 7880 '("\C-c|" org-table-toggle-vline-visibility)
7659 '("\C-c=" org-table-eval-formula) 7881 '("\C-c=" org-table-eval-formula)
7882 '("\C-c'" org-table-edit-formulas)
7660 '("\C-c*" org-table-recalculate) 7883 '("\C-c*" org-table-recalculate)
7661 '([(control ?#)] org-table-rotate-recalc-marks))) 7884 '([(control ?#)] org-table-rotate-recalc-marks)))
7662 elt key fun cmd) 7885 elt key fun cmd)
7663 (while (setq elt (pop bindings)) 7886 (while (setq elt (pop bindings))
7664 (setq nfunc (1+ nfunc)) 7887 (setq nfunc (1+ nfunc))
7712 ["Copy Rectangle" org-copy-special :active (org-at-table-p) :keys "C-c M-w"] 7935 ["Copy Rectangle" org-copy-special :active (org-at-table-p) :keys "C-c M-w"]
7713 ["Cut Rectangle" org-cut-special :active (org-at-table-p) :keys "C-c C-w"] 7936 ["Cut Rectangle" org-cut-special :active (org-at-table-p) :keys "C-c C-w"]
7714 ["Paste Rectangle" org-paste-special :active (org-at-table-p) :keys "C-c C-y"] 7937 ["Paste Rectangle" org-paste-special :active (org-at-table-p) :keys "C-c C-y"]
7715 ["Fill Rectangle" org-table-wrap-region :active (org-at-table-p) :keys "C-c C-q"]) 7938 ["Fill Rectangle" org-table-wrap-region :active (org-at-table-p) :keys "C-c C-q"])
7716 "--" 7939 "--"
7717 ["Eval Formula" org-table-eval-formula :active (org-at-table-p) :keys "C-c ="] 7940 ["Set Column Formula" org-table-eval-formula :active (org-at-table-p) :keys "C-c ="]
7718 ["Eval Formula Down " (org-table-eval-formula '(4)) :active (org-at-table-p) :keys "C-u C-c ="] 7941 ["Set Named Field Formula" (org-table-eval-formula '(4)) :active (org-at-table-p) :keys "C-u C-c ="]
7942 ["Edit Formulas" org-table-edit-formulas :active (org-at-table-p) :keys "C-c '"]
7719 ["Recalculate line" org-table-recalculate :active (org-at-table-p) :keys "C-c *"] 7943 ["Recalculate line" org-table-recalculate :active (org-at-table-p) :keys "C-c *"]
7720 ["Recalculate all" (org-table-recalculate '(4)) :active (org-at-table-p) :keys "C-u C-c *"] 7944 ["Recalculate all" (org-table-recalculate '(4)) :active (org-at-table-p) :keys "C-u C-c *"]
7721 ["Toggle Recalculate Mark" org-table-rotate-recalc-marks :active (org-at-table-p) :keys "C-c #"] 7945 ["Toggle Recalculate Mark" org-table-rotate-recalc-marks :active (org-at-table-p) :keys "C-c #"]
7722 ["Sum Column/Rectangle" org-table-sum 7946 ["Sum Column/Rectangle" org-table-sum
7723 :active (or (org-at-table-p) (org-region-active-p)) :keys "C-c +"] 7947 :active (or (org-at-table-p) (org-region-active-p)) :keys "C-c +"]
8683 table-orig-buffer (nreverse table-orig-buffer)) 8907 table-orig-buffer (nreverse table-orig-buffer))
8684 (insert (org-format-table-html table-buffer table-orig-buffer)))) 8908 (insert (org-format-table-html table-buffer table-orig-buffer))))
8685 (t 8909 (t
8686 ;; Normal lines 8910 ;; Normal lines
8687 ;; Lines starting with "-", and empty lines make new paragraph. 8911 ;; Lines starting with "-", and empty lines make new paragraph.
8912 ;; FIXME: Should we add + and *?
8688 (if (string-match "^ *-\\|^[ \t]*$" line) (insert "<p>")) 8913 (if (string-match "^ *-\\|^[ \t]*$" line) (insert "<p>"))
8689 (insert line (if org-export-preserve-breaks "<br>\n" "\n")))) 8914 (insert line (if org-export-preserve-breaks "<br>\n" "\n"))))
8690 )) 8915 ))
8691 (if org-export-html-with-timestamp 8916 (if org-export-html-with-timestamp
8692 (insert org-export-html-html-helper-timestamp)) 8917 (insert org-export-html-html-helper-timestamp))
9099 (define-key org-mode-map "\C-c?" 'org-table-current-column) 9324 (define-key org-mode-map "\C-c?" 'org-table-current-column)
9100 (define-key org-mode-map "\C-c " 'org-table-blank-field) 9325 (define-key org-mode-map "\C-c " 'org-table-blank-field)
9101 (define-key org-mode-map "\C-c+" 'org-table-sum) 9326 (define-key org-mode-map "\C-c+" 'org-table-sum)
9102 (define-key org-mode-map "\C-c|" 'org-table-toggle-vline-visibility) 9327 (define-key org-mode-map "\C-c|" 'org-table-toggle-vline-visibility)
9103 (define-key org-mode-map "\C-c=" 'org-table-eval-formula) 9328 (define-key org-mode-map "\C-c=" 'org-table-eval-formula)
9329 (define-key org-mode-map "\C-c'" 'org-table-edit-formulas)
9104 (define-key org-mode-map "\C-c*" 'org-table-recalculate) 9330 (define-key org-mode-map "\C-c*" 'org-table-recalculate)
9105 (define-key org-mode-map [(control ?#)] 'org-table-rotate-recalc-marks) 9331 (define-key org-mode-map [(control ?#)] 'org-table-rotate-recalc-marks)
9106 (define-key org-mode-map "\C-c~" 'org-table-create-with-table.el) 9332 (define-key org-mode-map "\C-c~" 'org-table-create-with-table.el)
9107 (define-key org-mode-map "\C-c\C-q" 'org-table-wrap-region) 9333 (define-key org-mode-map "\C-c\C-q" 'org-table-wrap-region)
9108 (define-key org-mode-map "\C-c\C-xa" 'org-export-as-ascii) 9334 (define-key org-mode-map "\C-c\C-xa" 'org-export-as-ascii)
9383 ["Cut Rectangle" org-cut-special (org-at-table-p)] 9609 ["Cut Rectangle" org-cut-special (org-at-table-p)]
9384 ["Paste Rectangle" org-paste-special (org-at-table-p)] 9610 ["Paste Rectangle" org-paste-special (org-at-table-p)]
9385 ["Fill Rectangle" org-table-wrap-region (org-at-table-p)]) 9611 ["Fill Rectangle" org-table-wrap-region (org-at-table-p)])
9386 "--" 9612 "--"
9387 ("Calculate" 9613 ("Calculate"
9388 ["Eval Formula" org-table-eval-formula (org-at-table-p)] 9614 ["Set Column Formula" org-table-eval-formula (org-at-table-p)]
9389 ["Eval Formula Down" (org-table-eval-formula '(4)) :active (org-at-table-p) :keys "C-u C-c ="] 9615 ["Set Named Field Formula" (org-table-eval-formula '(4)) :active (org-at-table-p) :keys "C-u C-c ="]
9616 ["Edit Formulas" org-table-edit-formulas (org-at-table-p)]
9617 "--"
9390 ["Recalculate line" org-table-recalculate (org-at-table-p)] 9618 ["Recalculate line" org-table-recalculate (org-at-table-p)]
9391 ["Recalculate all" (lambda () (interactive) (org-table-recalculate '(4))) :active (org-at-table-p) :keys "C-u C-c *"] 9619 ["Recalculate all" (lambda () (interactive) (org-table-recalculate '(4))) :active (org-at-table-p) :keys "C-u C-c *"]
9392 ["Toggle Recalculate Mark" org-table-rotate-recalc-marks (org-at-table-p)] 9620 ["Toggle Recalculate Mark" org-table-rotate-recalc-marks (org-at-table-p)]
9621 "--"
9393 ["Sum Column/Rectangle" org-table-sum 9622 ["Sum Column/Rectangle" org-table-sum
9394 (or (org-at-table-p) (org-region-active-p))] 9623 (or (org-at-table-p) (org-region-active-p))]
9395 ["Which Column?" org-table-current-column (org-at-table-p)]) 9624 ["Which Column?" org-table-current-column (org-at-table-p)])
9396 ["Debug Formulas" 9625 ["Debug Formulas"
9397 (setq org-table-formula-debug (not org-table-formula-debug)) 9626 (setq org-table-formula-debug (not org-table-formula-debug))