/[emacs]/emacs/lisp/textmodes/org.el
ViewVC logotype

Diff of /emacs/lisp/textmodes/org.el

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.30 by lute, Mon Jul 4 16:44:59 2005 UTC revision 1.31 by cdominik, Tue Jul 19 16:54:26 2005 UTC
# Line 5  Line 5 
5  ;; Author: Carsten Dominik <dominik at science dot uva dot nl>  ;; Author: Carsten Dominik <dominik at science dot uva dot nl>
6  ;; Keywords: outlines, hypermedia, calendar  ;; Keywords: outlines, hypermedia, calendar
7  ;; Homepage: http://www.astro.uva.nl/~dominik/Tools/org/  ;; Homepage: http://www.astro.uva.nl/~dominik/Tools/org/
8  ;; Version: 3.13  ;; Version: 3.14
9  ;;  ;;
10  ;; This file is part of GNU Emacs.  ;; This file is part of GNU Emacs.
11  ;;  ;;
# Line 21  Line 21 
21    
22  ;; You should have received a copy of the GNU General Public License  ;; 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  ;; along with GNU Emacs; see the file COPYING.  If not, write to the
24  ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,  ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
25  ;; Boston, MA 02110-1301, USA.  ;; Boston, MA 02111-1307, USA.
26  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
27  ;;  ;;
28  ;;; Commentary:  ;;; Commentary:
# Line 80  Line 80 
80  ;;  ;;
81  ;; Changes:  ;; Changes:
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    ;;
89  ;; Version 3.13  ;; Version 3.13
90  ;;    - Efficiency improvements:  Fewer table re-alignments needed.  ;;    - Efficiency improvements:  Fewer table re-alignments needed.
91  ;;    - New special lines in tables, for defining names for individual cells.  ;;    - New special lines in tables, for defining names for individual cells.
# Line 182  Line 188 
188    
189  ;;; Customization variables  ;;; Customization variables
190    
191  (defvar org-version "3.13"  (defvar org-version "3.14"
192    "The version number of the file org.el.")    "The version number of the file org.el.")
193  (defun org-version ()  (defun org-version ()
194    (interactive)    (interactive)
# Line 1215  line will be formatted with <th> tags." Line 1221  line will be formatted with <th> tags."
1221    :group 'org-table    :group 'org-table
1222    :type 'boolean)    :type 'boolean)
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)
1238    
1239  (defgroup org-table-calculation nil  (defgroup org-table-calculation nil
1240    "Options concerning tables in Org-mode."    "Options concerning tables in Org-mode."
# Line 1284  in table calculations, including symboli Line 1304  in table calculations, including symboli
1304    :group 'org-table-calculation    :group 'org-table-calculation
1305    :type 'boolean)    :type 'boolean)
1306    
1307  (defcustom org-table-tab-recognizes-table.el t  (defcustom org-table-allow-automatic-line-recalculation t
1308    "Non-nil means, TAB will automatically notice a table.el table.    "Non-nil means, lines makred with |#| or |*| will be recomputed automatically.
1309  When it sees such a table, it moves point into it and - if necessary -  Automatically means, when TAB or RET or C-c C-c are pressed in the line."
1310  calls `table-recognize-table'."    :group 'org-table-calculation
   :group 'org-table  
   :type 'boolean)  
   
 (defcustom org-export-prefer-native-exporter-for-tables nil  
   "Non-nil means, always export tables created with table.el natively.  
 Natively means, use the HTML code generator in table.el.  
 When nil, Org-mode's own HTML generator is used when possible (i.e. if  
 the table does not use row- or column-spanning).  This has the  
 advantage, that the automatic HTML conversions for math symbols and  
 sub/superscripts can be applied.  Org-mode's HTML generator is also  
 much faster."  
   :group 'org-table  
   :type 'boolean)  
   
 (defcustom org-enable-fixed-width-editor t  
   "Non-nil means, lines starting with \":\" are treated as fixed-width.  
 This currently only means, they are never auto-wrapped.  
 When nil, such lines will be treated like ordinary lines."  
   :group 'org-table  
1311    :type 'boolean)    :type 'boolean)
1312    
1313  (defgroup org-export nil  (defgroup org-export nil
# Line 1425  This option can also be set with the +OP Line 1426  This option can also be set with the +OP
1426    :group 'org-export    :group 'org-export
1427    :type 'boolean)    :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."
1437      :group 'org-export
1438      :type 'boolean)
1439    
1440  (defcustom org-export-html-table-tag  (defcustom org-export-html-table-tag
1441    "<table border=1 cellspacing=0 cellpadding=6>"    "<table border=1 cellspacing=0 cellpadding=6>"
1442    "The HTML tag used to start a table.    "The HTML tag used to start a table.
# Line 1926  The following commands are available: Line 1938  The following commands are available:
1938            '("^[ \t]*\\(\\(|\\|\\+-[-+]\\).*\\S-\\)"            '("^[ \t]*\\(\\(|\\|\\+-[-+]\\).*\\S-\\)"
1939              (1 'org-table t))              (1 'org-table t))
1940            '("^[ \t]*\\(:.*\\)" (1 'org-table t))            '("^[ \t]*\\(:.*\\)" (1 'org-table t))
1941            '("| *\\(=[^|\n]*\\)" (1 'org-formula t))            '("| *\\(:?=[^|\n]*\\)" (1 'org-formula t))
1942            '("^[ \t]*| *\\([#!$*_^]\\) *|" (1 'org-formula t))            '("^[ \t]*| *\\([#!$*_^]\\) *|" (1 'org-formula t))
1943            )))            )))
1944      (set (make-local-variable 'org-font-lock-keywords)      (set (make-local-variable 'org-font-lock-keywords)
# Line 2634  heading be marked DONE, and the current Line 2646  heading be marked DONE, and the current
2646          (setq level (match-end 0))          (setq level (match-end 0))
2647        (setq heading nil level 0))        (setq heading nil level 0))
2648      (save-excursion      (save-excursion
2649        (org-copy-subtree)  ; We first only copy, in case something goes wrong        ;; 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))
2653        (set-buffer buffer)        (set-buffer buffer)
2654        ;; Enforce org-mode for the archive buffer        ;; Enforce org-mode for the archive buffer
2655        (if (not (eq major-mode 'org-mode))        (if (not (eq major-mode 'org-mode))
# Line 2691  heading be marked DONE, and the current Line 2706  heading be marked DONE, and the current
2706          (if (not (eq this-buffer buffer)) (save-buffer))))          (if (not (eq this-buffer buffer)) (save-buffer))))
2707      ;; Here we are back in the original buffer.  Everything seems to have      ;; Here we are back in the original buffer.  Everything seems to have
2708      ;; worked.  So now cut the tree and finish up.      ;; worked.  So now cut the tree and finish up.
2709      (org-cut-subtree)      (let (this-command) (org-cut-subtree))
2710      (if (looking-at "[ \t]*$") (kill-line))      (if (looking-at "[ \t]*$") (kill-line))
2711      (message "Subtree archived %s"      (message "Subtree archived %s"
2712               (if (eq this-buffer buffer)               (if (eq this-buffer buffer)
# Line 2717  At all other locations, this simply call Line 2732  At all other locations, this simply call
2732                    (skip-chars-backward "a-zA-Z0-9_:$")                    (skip-chars-backward "a-zA-Z0-9_:$")
2733                    (point)))                    (point)))
2734             (texp (equal (char-before beg) ?\\))             (texp (equal (char-before beg) ?\\))
            (form (equal (char-before beg) ?=))  
2735             (opt (equal (buffer-substring (max (point-at-bol) (- beg 2))             (opt (equal (buffer-substring (max (point-at-bol) (- beg 2))
2736                                           beg)                                           beg)
2737                         "#+"))                         "#+"))
# Line 2734  At all other locations, this simply call Line 2748  At all other locations, this simply call
2748                     (texp                     (texp
2749                      (setq type :tex)                      (setq type :tex)
2750                      org-html-entities)                      org-html-entities)
                    (form  
                     (setq type :form)  
                     '(("sum") ("sumv") ("sumh")))  
2751                     ((string-match "\\`\\*+[ \t]*\\'"                     ((string-match "\\`\\*+[ \t]*\\'"
2752                                    (buffer-substring (point-at-bol) beg))                                    (buffer-substring (point-at-bol) beg))
2753                      (setq type :todo)                      (setq type :todo)
# Line 5816  See also the variable `org-reverse-note- Line 5827  See also the variable `org-reverse-note-
5827    "Detects a table line marked for automatic recalculation.")    "Detects a table line marked for automatic recalculation.")
5828  (defconst org-table-recalculate-regexp "^[ \t]*| *[#*] *\\(|\\|$\\)"  (defconst org-table-recalculate-regexp "^[ \t]*| *[#*] *\\(|\\|$\\)"
5829    "Detects a table line marked for automatic recalculation.")    "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.")
5832  (defconst org-table-hline-regexp "^[ \t]*|-"  (defconst org-table-hline-regexp "^[ \t]*|-"
5833    "Detects an org-type table hline.")    "Detects an org-type table hline.")
5834  (defconst org-table1-hline-regexp "^[ \t]*\\+-[-+]"  (defconst org-table1-hline-regexp "^[ \t]*\\+-[-+]"
# Line 6119  Optional argument NEW may specify text t Line 6132  Optional argument NEW may specify text t
6132    (cond    (cond
6133     ((and (not new) org-table-may-need-update)) ; Realignment will happen anyway     ((and (not new) org-table-may-need-update)) ; Realignment will happen anyway
6134     ((org-at-table-hline-p)     ((org-at-table-hline-p)
6135      ;; FIXME:  I use to enforce realign here, but I think this is not needed.      ;; FIXME:  I used to enforce realign here, but I think this is not needed.
6136      ;; (setq org-table-may-need-update t)      ;; (setq org-table-may-need-update t)
6137      )      )
6138     ((and (not new)     ((and (not new)
# Line 6133  Optional argument NEW may specify text t Line 6146  Optional argument NEW may specify text t
6146      (let* ((pos (point)) s      (let* ((pos (point)) s
6147             (col (org-table-current-column))             (col (org-table-current-column))
6148             (num (nth (1- col) org-table-last-alignment))             (num (nth (1- col) org-table-last-alignment))
6149             l f n o upd)             l f n o e)
6150        (when (> col 0)        (when (> col 0)
6151          (skip-chars-backward "^|\n")          (skip-chars-backward "^|\n")
6152          (if (looking-at " *\\([^|\n]*?\\) *|")          (if (looking-at " *\\([^|\n]*?\\) *\\(|\\|$\\)")
6153              (progn              (progn
6154                (setq s (match-string 1)                (setq s (match-string 1)
6155                      o (match-string 0)                      o (match-string 0)
6156                      l (max 1 (- (match-end 0) (match-beginning 0) 3)))                      l (max 1 (- (match-end 0) (match-beginning 0) 3))
6157                (setq f (format (if num " %%%ds |" " %%-%ds |") l)                      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) ""))
6160                      n (format f s t t))                      n (format f s t t))
6161                (if new                (if new
6162                    (if (<= (length new) l)                    (if (<= (length new) l)
# Line 6980  If NLAST is a number, only the NLAST fie Line 6995  If NLAST is a number, only the NLAST fie
6995       ((equal n 0)                             nil)       ((equal n 0)                             nil)
6996       (t n))))       (t n))))
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    
7054  (defvar org-table-formula-history nil)  (defvar org-table-formula-history nil)
7055    
7056  (defun org-table-get-formula (&optional equation)  (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)
7066    "Read a formula from the minibuffer, offer stored formula as default."    "Read a formula from the minibuffer, offer stored formula as default."
7067    (let* ((col (org-table-current-column))    (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")))
7077           (org-table-may-need-update nil)           (org-table-may-need-update nil)
7078           (stored-list (org-table-get-stored-formulas))           (stored-list (org-table-get-stored-formulas))
7079           (stored (cdr (assoc col stored-list)))           (stored (cdr (assoc scol stored-list)))
7080           (eq (cond           (eq (cond
7081                ((and stored equation (string-match "^ *= *$" equation))                ((and stored equation (string-match "^ *= *$" equation))
7082                 stored)                 stored)
7083                ((stringp equation)                ((stringp equation)
7084                 equation)                 equation)
7085                (t (read-string                (t (read-string
7086                    "Formula: " (or stored "") 'org-table-formula-history                    (format "%s formula $%s=" (if named "Field" "Column") scol)
7087                    stored)))))                    (or stored "") 'org-table-formula-history
7088      (if (not (string-match "\\S-" eq))                    ;stored
7089          (error "Empty formula"))                    ))))
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"))
7096      (if (string-match "^ *=?" eq) (setq eq (replace-match "" t t eq)))      (if (string-match "^ *=?" eq) (setq eq (replace-match "" t t eq)))
7097      (if (string-match " *$" eq) (setq eq (replace-match "" t t eq)))      (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))
7102      (if stored      (if stored
7103          (setcdr (assoc col stored-list) eq)          (setcdr (assoc scol stored-list) eq)
7104        (setq stored-list (cons (cons col eq) stored-list)))        (setq stored-list (cons (cons scol eq) stored-list)))
7105      (if (not (equal stored eq))      (if (or mustsave (not (equal stored eq)))
7106          (org-table-store-formulas stored-list))          (org-table-store-formulas stored-list))
7107      eq))      eq))
7108    
7109  (defun org-table-store-formulas (alist)  (defun org-table-store-formulas (alist)
7110    "Store the list of formulas below the current table."    "Store the list of formulas below the current table."
7111    (setq alist (sort alist (lambda (a b) (< (car a) (car b)))))    (setq alist (sort alist (lambda (a b) (string< (car a) (car b)))))
7112    (save-excursion    (save-excursion
7113      (goto-char (org-table-end))      (goto-char (org-table-end))
7114      (if (looking-at "\\([ \t]*\n\\)*#\\+TBLFM:.*\n?")      (if (looking-at "\\([ \t]*\n\\)*#\\+TBLFM:.*\n?")
7115          (delete-region (point) (match-end 0)))          (delete-region (point) (match-end 0)))
7116      (insert "#+TBLFM: "      (insert "#+TBLFM: "
7117              (mapconcat (lambda (x)              (mapconcat (lambda (x)
7118                           (concat "$" (int-to-string (car x)) "=" (cdr x)))                           (concat "$" (car x) "=" (cdr x)))
7119                         alist "::")                         alist "::")
7120              "\n")))              "\n")))
7121    
7122  (defun org-table-get-stored-formulas ()  (defun org-table-get-stored-formulas ()
7123    "Return an alist withh the t=stored formulas directly after current table."    "Return an alist with the t=stored formulas directly after current table."
7124    (interactive)    (interactive)
7125    (let (col eq eq-alist strings string)    (let (scol eq eq-alist strings string seen)
7126      (save-excursion      (save-excursion
7127        (goto-char (org-table-end))        (goto-char (org-table-end))
7128        (when (looking-at "\\([ \t]*\n\\)*#\\+TBLFM: *\\(.*\\)")        (when (looking-at "\\([ \t]*\n\\)*#\\+TBLFM: *\\(.*\\)")
7129          (setq strings (org-split-string (match-string 2) " *:: *"))          (setq strings (org-split-string (match-string 2) " *:: *"))
7130          (while (setq string (pop strings))          (while (setq string (pop strings))
7131            (if (string-match "\\$\\([0-9]+\\) *= *\\(.*[^ \t]\\)" string)            (when (string-match "\\$\\([a-zA-Z0-9]+\\) *= *\\(.*[^ \t]\\)" string)
7132                (setq col (string-to-number (match-string 1 string))              (setq scol (match-string 1 string)
7133                      eq (match-string 2 string)                    eq (match-string 2 string)
7134                      eq-alist (cons (cons col eq) eq-alist))))))                    eq-alist (cons (cons scol eq) eq-alist))
7135      eq-alist))              (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)))
7139    
7140  (defun org-table-modify-formulas (action &rest columns)  (defun org-table-modify-formulas (action &rest columns)
7141    "Modify the formulas stored below the current table.    "Modify the formulas stored below the current table.
7142  ACTION can be `remove', `insert', `swap'.  For `swap', two column numbers are  ACTION can be `remove', `insert', `swap'.  For `swap', two column numbers are
7143  expected, for the other action only a single column number is needed."  expected, for the other action only a single column number is needed."
7144    (let ((list (org-table-get-stored-formulas))    (let ((list (org-table-get-stored-formulas))
7145          (nmax (length (org-split-string (buffer-substring (point-at-bol) (point-at-eol))          (nmax (length (org-split-string
7146                                          "|")))                         (buffer-substring (point-at-bol) (point-at-eol))
7147          col col1 col2)                         "|")))
7148            col col1 col2 scol si sc1 sc2)
7149      (cond      (cond
7150       ((null list))   ; No action needed if there are no stored formulas       ((null list))   ; No action needed if there are no stored formulas
7151       ((eq action 'remove)       ((eq action 'remove)
7152        (setq col (car columns))        (setq col (car columns)
7153        (org-table-replace-in-formulas list col "INVALID")              scol (int-to-string col))
7154        (if (assoc col list) (setq list (delq (assoc col list) list)))        (org-table-replace-in-formulas list scol "INVALID")
7155          (if (assoc scol list) (setq list (delq (assoc scol list) list)))
7156        (loop for i from (1+ col) upto nmax by 1 do        (loop for i from (1+ col) upto nmax by 1 do
7157              (org-table-replace-in-formulas list i (1- i))              (setq si (int-to-string i))
7158              (if (assoc i list) (setcar (assoc i list) (1- i)))))              (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))))))
7161       ((eq action 'insert)       ((eq action 'insert)
7162        (setq col (car columns))        (setq col (car columns))
7163        (loop for i from nmax downto col by 1 do        (loop for i from nmax downto col by 1 do
7164              (org-table-replace-in-formulas list i (1+ i))              (setq si (int-to-string i))
7165              (if (assoc i list) (setcar (assoc i list) (1+ i)))))              (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))))))
7168       ((eq action 'swap)       ((eq action 'swap)
7169        (setq col1 (car columns) col2 (nth 1 columns))        (setq col1 (car columns) col2 (nth 1 columns)
7170        (org-table-replace-in-formulas list col1 "Z")              sc1 (int-to-string col1) sc2 (int-to-string col2))
7171        (org-table-replace-in-formulas list col2 col1)        ;; Hopefully, ZqZ will never be a name in a table...  FIXME:
7172        (org-table-replace-in-formulas list "Z" col2)        (org-table-replace-in-formulas list sc1 "ZqZ")
7173        (if (assoc col1 list) (setcar (assoc col1 list) "Z"))        (org-table-replace-in-formulas list sc2 sc1)
7174        (if (assoc col2 list) (setcar (assoc col2 list) col1))        (org-table-replace-in-formulas list "ZqZ" sc2)
7175        (if (assoc "Z" list)  (setcar (assoc "Z" list) col2)))        (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)))
7178       (t (error "Invalid action in `org-table-modify-formulas'")))       (t (error "Invalid action in `org-table-modify-formulas'")))
7179      (if list (org-table-store-formulas list))))      (if list (org-table-store-formulas list))))
7180    
# Line 7079  expected, for the other action only a si Line 7189  expected, for the other action only a si
7189          (setq s (replace-match s2 t t s)))          (setq s (replace-match s2 t t s)))
7190        (setcdr elt s))))        (setcdr elt s))))
7191    
 (defvar org-table-column-names nil  
   "Alist with column names, derived from the `!' line.")  
 (defvar org-table-column-name-regexp nil  
   "Regular expression matching the current column names.")  
 (defvar org-table-local-parameters nil  
   "Alist with parameter names, derived from the `$' line.")  
   
7192  (defun org-table-get-specials ()  (defun org-table-get-specials ()
7193    "Get the column nmaes and local parameters for this table."    "Get the column nmaes and local parameters for this table."
7194    (save-excursion    (save-excursion
7195      (let ((beg (org-table-begin)) (end (org-table-end))      (let ((beg (org-table-begin)) (end (org-table-end))
7196            names name fields fields1 field cnt c v)            names name fields fields1 field cnt c v line col)
7197        (setq org-table-column-names nil        (setq org-table-column-names nil
7198              org-table-local-parameters nil)              org-table-local-parameters nil
7199                org-table-named-field-locations nil)
7200        (goto-char beg)        (goto-char beg)
7201        (when (re-search-forward "^[ \t]*| *! *\\(|.*\\)" end t)        (when (re-search-forward "^[ \t]*| *! *\\(|.*\\)" end t)
7202          (setq names (org-split-string (match-string 1) " *| *")          (setq names (org-split-string (match-string 1) " *| *")
# Line 7117  expected, for the other action only a si Line 7221  expected, for the other action only a si
7221                fields (org-split-string (match-string 2) " *| *"))                fields (org-split-string (match-string 2) " *| *"))
7222          (save-excursion          (save-excursion
7223            (beginning-of-line (if (equal c "_") 2 0))            (beginning-of-line (if (equal c "_") 2 0))
7224              (setq line (org-current-line) col 1)    
7225            (and (looking-at "^[ \t]*|[^|]*\\(|.*\\)")            (and (looking-at "^[ \t]*|[^|]*\\(|.*\\)")
7226                 (setq fields1 (org-split-string (match-string 1) " *| *"))))                 (setq fields1 (org-split-string (match-string 1) " *| *"))))
7227          (while (setq field (pop fields))          (while (and fields1 (setq field (pop fields)))
7228            (setq v (pop fields1))            (setq v (pop fields1) col (1+ col))
7229            (if (and (stringp field) (stringp v)            (when (and (stringp field) (stringp v)
7230                     (string-match "^[a-zA-Z][a-zA-Z0-9]*$" field))                       (string-match "^[a-zA-Z][a-zA-Z0-9]*$" field))
7231                (push (cons field v) org-table-local-parameters)))))))                (push (cons field v) org-table-local-parameters)
7232                  (push (list field line col) org-table-named-field-locations)))))))
7233    
7234  (defun org-this-word ()  (defun org-this-word ()
7235    ;; Get the current word    ;; Get the current word
# Line 7133  expected, for the other action only a si Line 7239  expected, for the other action only a si
7239        (buffer-substring-no-properties beg end))))        (buffer-substring-no-properties beg end))))
7240    
7241  (defun org-table-maybe-eval-formula ()  (defun org-table-maybe-eval-formula ()
7242    "Check if the current field starts with \"=\" and evaluate the formula."    "Check if the current field starts with \"=\" or \":=\".
7243    If yes, store the formula and apply it."
7244    ;; We already know we are in a table.  Get field will only return a formula    ;; We already know we are in a table.  Get field will only return a formula
7245    ;; when appropriate.  It might return a separator line, but no problem.    ;; when appropriate.  It might return a separator line, but no problem.
7246    (when org-table-formula-evaluate-inline    (when org-table-formula-evaluate-inline
7247      (let* ((field (org-trim (or (org-table-get-field) "")))      (let* ((field (org-trim (or (org-table-get-field) "")))
7248             (dfield (downcase field))             named eq)
7249             col bolpos nlast)        (when (string-match "^:?=\\(.+\\)" field)
7250        (when (equal (string-to-char field) ?=)          (setq named (equal (string-to-char field) ?:)
7251          (if (string-match "^\\(=sum[vh]?\\)\\([0-9]+\\)$" dfield)                eq (match-string 1 field))
7252              (setq nlast (1+ (string-to-number (match-string 2 dfield)))          (if (fboundp 'calc-eval)
7253                    dfield (match-string 1 dfield)))              (org-table-eval-formula (if named '(4) nil) eq))))))
         (cond  
          ((equal dfield "=sumh")  
           (org-table-get-field  
            nil (org-table-sum  
                 (save-excursion (org-table-goto-column 1) (point))  
                 (point) nlast)))  
          ((member dfield '("=sum" "=sumv"))  
           (setq col (org-table-current-column)  
                 bolpos (point-at-bol))  
           (org-table-get-field  
            nil (org-table-sum  
                 (save-excursion  
                   (goto-char (org-table-begin))  
                   (if (re-search-forward org-table-dataline-regexp bolpos t)  
                       (progn  
                         (goto-char (match-beginning 0))  
                         (org-table-goto-column col)  
                         (point))  
                     (error "No datalines above current")))  
                 (point) nlast)))  
          ((and (string-match "^ *=" field)  
                (fboundp 'calc-eval))  
           (org-table-eval-formula nil field)))))))  
   
 (defvar org-last-recalc-undo-list nil)  
 (defcustom org-table-allow-line-recalculation t  
   "FIXME:"  
   :group 'org-table  
   :type 'boolean)  
7254    
7255  (defvar org-recalc-commands nil  (defvar org-recalc-commands nil
7256    "List of commands triggering the reccalculation of a line.    "List of commands triggering the reccalculation of a line.
# Line 7210  of the new mark." Line 7288  of the new mark."
7288           (col (org-table-current-column))           (col (org-table-current-column))
7289           (forcenew (car (assoc newchar org-recalc-marks)))           (forcenew (car (assoc newchar org-recalc-marks)))
7290           epos new)           epos new)
7291      (if l1 (setq newchar (char-to-string (read-char-exclusive "Change region to what mark?  Type # * ! $ or SPC: "))      (when l1
7292                   forcenew (car (assoc newchar org-recalc-marks))))        (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))))
7295      (if (and newchar (not forcenew))      (if (and newchar (not forcenew))
7296          (error "Invalid NEWCHAR `%s' in `org-table-rotate-recalc-marks'"          (error "Invalid NEWCHAR `%s' in `org-table-rotate-recalc-marks'"
7297                 newchar))                 newchar))
# Line 7248  of the new mark." Line 7328  of the new mark."
7328  (defun org-table-maybe-recalculate-line ()  (defun org-table-maybe-recalculate-line ()
7329    "Recompute the current line if marked for it, and if we haven't just done it."    "Recompute the current line if marked for it, and if we haven't just done it."
7330    (interactive)    (interactive)
7331    (and org-table-allow-line-recalculation    (and org-table-allow-automatic-line-recalculation
7332         (not (and (memq last-command org-recalc-commands)         (not (and (memq last-command org-recalc-commands)
7333                   (equal org-last-recalc-line (org-current-line))))                   (equal org-last-recalc-line (org-current-line))))
7334         (save-excursion (beginning-of-line 1)         (save-excursion (beginning-of-line 1)
# Line 7273  When nil, simply write \"#ERROR\" in cor Line 7353  When nil, simply write \"#ERROR\" in cor
7353      (cons var (cons value modes)))      (cons var (cons value modes)))
7354    modes)    modes)
7355    
7356  (defun org-table-eval-formula (&optional ndown equation  (defun org-table-eval-formula (&optional arg equation
7357                                           suppress-align suppress-const                                           suppress-align suppress-const
7358                                           suppress-store)                                           suppress-store)
7359    "Replace the table field value at the cursor by the result of a calculation.    "Replace the table field value at the cursor by the result of a calculation.
# Line 7283  most exciting program ever written for G Line 7363  most exciting program ever written for G
7363  installed in order to use this function.  installed in order to use this function.
7364    
7365  In a table, this command replaces the value in the current field with the  In a table, this command replaces the value in the current field with the
7366  result of a formula.  While nowhere near the computation options of a  result of a formula.  It also installes the formula as the \"current\" column
7367  spreadsheet program, this is still very useful.  There is no automatic  formula, by storing it in a special line below the table.  When called
7368  updating of a calculated field, but the table will remember the last  with a `C-u' prefix, the current field must ba a named field, and the
7369  formula for each column.  The command needs to be applied again after  formula is installed as valid in only this specific field.
7370  changing input fields.  
7371    When called, the command first prompts for a formula, which is read in
7372  When called, the command first prompts for a formula, which is read in the  the minibuffer.  Previously entered formulas are available through the
7373  minibuffer.  Previously entered formulas are available through the history  history list, and the last used formula is offered as a default.
 list, and the last used formula for each column is offered as a default.  
7374  These stored formulas are adapted correctly when moving, inserting, or  These stored formulas are adapted correctly when moving, inserting, or
7375  deleting columns with the corresponding commands.  deleting columns with the corresponding commands.
7376    
7377  The formula can be any algebraic expression understood by the calc package.  The formula can be any algebraic expression understood by the calc package.
7378  Before evaluation, variable substitution takes place: \"$\" is replaced by  For details, see the Org-mode manual.
7379  the field the cursor is currently in, and $1..$n reference the fields in  
7380  the current row.  Values from a *different* row can *not* be referenced  This function can also be called from Lisp programs and offers
7381  here, so the command supports only horizontal computing.  The formula can  additional Arguments: EQUATION can be the formula to apply.  If this
7382  contain an optional printf format specifier after a semicolon, to reformat  argument is given, the user will not be prompted.  SUPPRESS-ALIGN is
7383  the result.  used to speed-up recursive calls by by-passing unnecessary aligns.
7384    SUPPRESS-CONST suppresses the interpretation of constants in the
7385  A few examples for formulas:  formula, assuming that this has been done already outside the fuction.
7386    $1+$2               Sum of first and second field  SUPPRESS-STORE means the formula should not be stored, either because
7387    $1+$2;%.2f          Same, and format result to two digits after dec.point  it is already stored, or because it is a modified equation that should
7388    exp($2)+exp($1)     Math functions can be used  not overwrite the stored one."
   $;%.1f              Reformat current cell to 1 digit after dec.point  
   ($3-32)*5/9         degrees F -> C conversion  
   
 When called with a raw \\[universal-argument] prefix, the formula is applied to the current  
 field, and to the same same column in all following rows, until reaching a  
 horizontal line or the end of the table.  When the command is called with a  
 numeric prefix argument (like M-3 or C-7 or \\[universal-argument] 24), the formula is applied  
 to the current row, and to the following n-1 rows (but not beyond a  
 separator line).  
   
 This function can also be called from Lisp programs and offers two additional  
 Arguments:  EQUATION can be the formula to apply.  If this argument is given,  
 the user will not be prompted.  SUPPRESS-ALIGN is used to speed-up  
 recursive calls by by-passing unnecessary aligns.  SUPPRESS-CONST suppresses  
 the interpretation of constants in the formula.  SUPPRESS-STORE means the  
 formula should not be stored, either because it is already stored, or because  
 it is a modified equation that should not overwrite the stored one."  
7389    (interactive "P")    (interactive "P")
   (setq ndown (if (equal ndown '(4)) 10000 (prefix-numeric-value ndown)))  
7390    (require 'calc)    (require 'calc)
7391    (org-table-check-inside-data-field)    (org-table-check-inside-data-field)
7392    (org-table-get-specials)    (org-table-get-specials)
7393    (let* (fields    (let* (fields
7394             (ndown (if (integerp arg) arg 1))
7395           (org-table-automatic-realign nil)           (org-table-automatic-realign nil)
7396           (case-fold-search nil)           (case-fold-search nil)
7397           (down (> ndown 1))           (down (> ndown 1))
7398           (formula (if (and equation suppress-store)           (formula (if (and equation suppress-store)
7399                        equation                        equation
7400                      (org-table-get-formula equation)))                      (org-table-get-formula equation (equal arg '(4)))))
7401           (n0 (org-table-current-column))           (n0 (org-table-current-column))
7402           (modes (copy-sequence org-calc-default-modes))           (modes (copy-sequence org-calc-default-modes))
7403           n form fmt x ev orig c)           n form fmt x ev orig c)
7404      ;; Parse the format string.  Since we have a lot of modes, this is      ;; Parse the format string.  Since we have a lot of modes, this is
7405      ;; a lot of work.      ;; a lot of work.  However, I think calc still uses most of the time.
7406      (if (string-match ";" formula)      (if (string-match ";" formula)
7407          (let ((tmp (org-split-string formula ";")))          (let ((tmp (org-split-string formula ";")))
7408            (setq formula (car tmp)            (setq formula (car tmp)
# Line 7374  it is a modified equation that should no Line 7436  it is a modified equation that should no
7436                          fields)))                          fields)))
7437        (setq ndown (1- ndown))        (setq ndown (1- ndown))
7438        (setq form (copy-sequence formula))        (setq form (copy-sequence formula))
7439          ;; Insert the references to fields in same row
7440        (while (string-match "\\$\\([0-9]+\\)?" form)        (while (string-match "\\$\\([0-9]+\\)?" form)
7441          (setq n (if (match-beginning 1)          (setq n (if (match-beginning 1)
7442                      (string-to-int (match-string 1 form))                      (string-to-int (match-string 1 form))
# Line 7383  it is a modified equation that should no Line 7446  it is a modified equation that should no
7446                           (match-string 0 form)))                           (match-string 0 form)))
7447          (if (equal x "") (setq x "0"))          (if (equal x "") (setq x "0"))
7448          (setq form (replace-match (concat "(" x ")") t t form)))          (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)))
7456        (setq ev (calc-eval (cons form modes)        (setq ev (calc-eval (cons form modes)
7457                            (if org-table-formula-numbers-only 'num)))                            (if org-table-formula-numbers-only 'num)))
7458    
# Line 7424  $1->    %s\n" orig formula form)) Line 7494  $1->    %s\n" orig formula form))
7494    (unless (org-at-table-p) (error "Not at a table"))    (unless (org-at-table-p) (error "Not at a table"))
7495    (org-table-get-specials)    (org-table-get-specials)
7496    (let* ((eqlist (sort (org-table-get-stored-formulas)    (let* ((eqlist (sort (org-table-get-stored-formulas)
7497                         (lambda (a b) (< (car a) (car b)))))                         (lambda (a b) (string< (car a) (car b)))))
7498           (inhibit-redisplay t)           (inhibit-redisplay t)
7499           (line-re org-table-dataline-regexp)           (line-re org-table-dataline-regexp)
7500           (thisline (+ (if (bolp) 1 0) (count-lines (point-min) (point))))           (thisline (+ (if (bolp) 1 0) (count-lines (point-min) (point))))
7501           (thiscol (org-table-current-column))           (thiscol (org-table-current-column))
7502           beg end entry eql (cnt 0))           beg end entry eqlnum eqlname eql (cnt 0) eq a name)
7503      ;; Insert constants in all formulas      ;; Insert constants in all formulas
7504      (setq eqlist      (setq eqlist
7505            (mapcar (lambda (x)            (mapcar (lambda (x)
7506                      (setcdr x (org-table-formula-substitute-names (cdr x)))                      (setcdr x (org-table-formula-substitute-names (cdr x)))
7507                      x)                      x)
7508                    eqlist))                    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))
7515      (if all      (if all
7516          (progn          (progn
7517            (setq end (move-marker (make-marker) (1+ (org-table-end))))            (setq end (move-marker (make-marker) (1+ (org-table-end))))
7518            (goto-char (setq beg (org-table-begin)))            (goto-char (setq beg (org-table-begin)))
7519            (if (re-search-forward org-table-recalculate-regexp end t)            (if (re-search-forward org-table-calculate-mark-regexp end t)
7520                  ;; This is a table with marked lines, only compute selected lines
7521                (setq line-re org-table-recalculate-regexp)                (setq line-re org-table-recalculate-regexp)
7522                ;; Move forward to the first non-header line
7523              (if (and (re-search-forward org-table-dataline-regexp end t)              (if (and (re-search-forward org-table-dataline-regexp end t)
7524                       (re-search-forward org-table-hline-regexp end t)                       (re-search-forward org-table-hline-regexp end t)
7525                       (re-search-forward org-table-dataline-regexp end t))                       (re-search-forward org-table-dataline-regexp end t))
# Line 7452  $1->    %s\n" orig formula form)) Line 7530  $1->    %s\n" orig formula form))
7530      (goto-char beg)      (goto-char beg)
7531      (and all (message "Re-applying formulas to full table..."))      (and all (message "Re-applying formulas to full table..."))
7532      (while (re-search-forward line-re end t)      (while (re-search-forward line-re end t)
7533        (unless (string-match "^ *[!$] *$" (org-table-get-field 1))        (unless (string-match "^ *[_^!$] *$" (org-table-get-field 1))
7534          ;; Unprotected line, recalculate          ;; Unprotected line, recalculate
7535          (and all (message "Re-applying formulas to full table...(line %d)"          (and all (message "Re-applying formulas to full table...(line %d)"
7536                            (setq cnt (1+ cnt))))                            (setq cnt (1+ cnt))))
7537          (setq org-last-recalc-line (org-current-line))          (setq org-last-recalc-line (org-current-line))
7538          (setq eql eqlist)          (setq eql eqlnum)
7539          (while (setq entry (pop eql))          (while (setq entry (pop eql))
7540            (goto-line org-last-recalc-line)            (goto-line org-last-recalc-line)
7541            (org-table-goto-column (car entry) nil 'force)            (org-table-goto-column (string-to-int (car entry)) nil 'force)
7542            (org-table-eval-formula nil (cdr entry) 'noalign 'nocst 'nostore))))            (org-table-eval-formula nil (cdr entry) 'noalign 'nocst 'nostore))))
7543      (goto-line thisline)      (goto-line thisline)
7544      (org-table-goto-column thiscol)      (org-table-goto-column thiscol)
7545      (or noalign (and org-table-may-need-update (org-table-align))      (or noalign (and org-table-may-need-update (org-table-align))
7546          (and all (message "Re-applying formulas to %d lines...done" cnt)))))          (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)))))
7561    
7562  (defun org-table-formula-substitute-names (f)  (defun org-table-formula-substitute-names (f)
7563    "Replace $const with values in stirng F."    "Replace $const with values in stirng F."
# Line 7505  Parameters get priority." Line 7597  Parameters get priority."
7597        (and (fboundp 'constants-get) (constants-get const))        (and (fboundp 'constants-get) (constants-get const))
7598        "#UNDEFINED_NAME"))        "#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")))
7729    
7730  ;;; The orgtbl minor mode  ;;; The orgtbl minor mode
7731    
7732  ;; Define a minor mode which can be used in other modes in order to  ;; Define a minor mode which can be used in other modes in order to
# Line 7657  to execute outside of tables." Line 7879  to execute outside of tables."
7879            '("\C-c+"              org-table-sum)            '("\C-c+"              org-table-sum)
7880            '("\C-c|"              org-table-toggle-vline-visibility)            '("\C-c|"              org-table-toggle-vline-visibility)
7881            '("\C-c="              org-table-eval-formula)            '("\C-c="              org-table-eval-formula)
7882              '("\C-c'"              org-table-edit-formulas)
7883            '("\C-c*"              org-table-recalculate)            '("\C-c*"              org-table-recalculate)
7884            '([(control ?#)]       org-table-rotate-recalc-marks)))            '([(control ?#)]       org-table-rotate-recalc-marks)))
7885          elt key fun cmd)          elt key fun cmd)
# Line 7714  to execute outside of tables." Line 7937  to execute outside of tables."
7937           ["Paste Rectangle" org-paste-special :active (org-at-table-p) :keys "C-c C-y"]           ["Paste Rectangle" org-paste-special :active (org-at-table-p) :keys "C-c C-y"]
7938           ["Fill Rectangle" org-table-wrap-region :active (org-at-table-p) :keys "C-c C-q"])           ["Fill Rectangle" org-table-wrap-region :active (org-at-table-p) :keys "C-c C-q"])
7939          "--"          "--"
7940          ["Eval Formula" org-table-eval-formula :active (org-at-table-p) :keys "C-c ="]          ["Set Column Formula" org-table-eval-formula :active (org-at-table-p) :keys "C-c ="]
7941          ["Eval Formula Down " (org-table-eval-formula '(4)) :active (org-at-table-p) :keys "C-u C-c ="]          ["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 '"]
7943          ["Recalculate line" org-table-recalculate :active (org-at-table-p) :keys "C-c *"]          ["Recalculate line" org-table-recalculate :active (org-at-table-p) :keys "C-c *"]
7944          ["Recalculate all" (org-table-recalculate '(4)) :active (org-at-table-p) :keys "C-u C-c *"]          ["Recalculate all" (org-table-recalculate '(4)) :active (org-at-table-p) :keys "C-u C-c *"]
7945          ["Toggle Recalculate Mark" org-table-rotate-recalc-marks :active (org-at-table-p) :keys "C-c #"]          ["Toggle Recalculate Mark" org-table-rotate-recalc-marks :active (org-at-table-p) :keys "C-c #"]
# Line 8685  headlines.  The default is 3.  Lower lev Line 8909  headlines.  The default is 3.  Lower lev
8909             (t             (t
8910              ;; Normal lines              ;; Normal lines
8911              ;; Lines starting with "-", and empty lines make new paragraph.              ;; Lines starting with "-", and empty lines make new paragraph.
8912                ;; FIXME: Should we add + and *?
8913              (if (string-match "^ *-\\|^[ \t]*$" line) (insert "<p>"))              (if (string-match "^ *-\\|^[ \t]*$" line) (insert "<p>"))
8914              (insert line (if org-export-preserve-breaks "<br>\n" "\n"))))              (insert line (if org-export-preserve-breaks "<br>\n" "\n"))))
8915            ))            ))
# Line 9101  When LEVEL is non-nil, increase section Line 9326  When LEVEL is non-nil, increase section
9326  (define-key org-mode-map "\C-c+"          'org-table-sum)  (define-key org-mode-map "\C-c+"          'org-table-sum)
9327  (define-key org-mode-map "\C-c|"          'org-table-toggle-vline-visibility)  (define-key org-mode-map "\C-c|"          'org-table-toggle-vline-visibility)
9328  (define-key org-mode-map "\C-c="          'org-table-eval-formula)  (define-key org-mode-map "\C-c="          'org-table-eval-formula)
9329    (define-key org-mode-map "\C-c'"          'org-table-edit-formulas)
9330  (define-key org-mode-map "\C-c*"          'org-table-recalculate)  (define-key org-mode-map "\C-c*"          'org-table-recalculate)
9331  (define-key org-mode-map [(control ?#)]   'org-table-rotate-recalc-marks)  (define-key org-mode-map [(control ?#)]   'org-table-rotate-recalc-marks)
9332  (define-key org-mode-map "\C-c~"          'org-table-create-with-table.el)  (define-key org-mode-map "\C-c~"          'org-table-create-with-table.el)
# Line 9385  scanning the buffer for these lines and Line 9611  scanning the buffer for these lines and
9611       ["Fill Rectangle" org-table-wrap-region (org-at-table-p)])       ["Fill Rectangle" org-table-wrap-region (org-at-table-p)])
9612      "--"      "--"
9613      ("Calculate"      ("Calculate"
9614       ["Eval Formula" org-table-eval-formula (org-at-table-p)]       ["Set Column Formula" org-table-eval-formula (org-at-table-p)]
9615       ["Eval Formula Down" (org-table-eval-formula '(4)) :active (org-at-table-p) :keys "C-u C-c ="]       ["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         "--"
9618       ["Recalculate line" org-table-recalculate (org-at-table-p)]       ["Recalculate line" org-table-recalculate (org-at-table-p)]
9619       ["Recalculate all" (lambda () (interactive) (org-table-recalculate '(4))) :active (org-at-table-p) :keys "C-u C-c *"]       ["Recalculate all" (lambda () (interactive) (org-table-recalculate '(4))) :active (org-at-table-p) :keys "C-u C-c *"]
9620       ["Toggle Recalculate Mark" org-table-rotate-recalc-marks (org-at-table-p)]       ["Toggle Recalculate Mark" org-table-rotate-recalc-marks (org-at-table-p)]
9621         "--"
9622       ["Sum Column/Rectangle" org-table-sum       ["Sum Column/Rectangle" org-table-sum
9623        (or (org-at-table-p) (org-region-active-p))]        (or (org-at-table-p) (org-region-active-p))]
9624       ["Which Column?" org-table-current-column (org-at-table-p)])       ["Which Column?" org-table-current-column (org-at-table-p)])

Legend:
Removed from v.1.30  
changed lines
  Added in v.1.31

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26