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 |
;; |
;; |
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: |
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. |
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) |
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." |
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 |
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. |
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) |
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)) |
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) |
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 |
"#+")) |
"#+")) |
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) |
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]*\\+-[-+]" |
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) |
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) |
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 |
|
|
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) " *| *") |
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 |
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. |
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)) |
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) |
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. |
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) |
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)) |
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 |
|
|
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)) |
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." |
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 |
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) |
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 #"] |
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 |
)) |
)) |
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) |
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)]) |