;; Author: Carsten Dominik <carsten at orgmode dot org>
;; Keywords: outlines, hypermedia, calendar, wp
;; Homepage: http://orgmode.org
-;; Version: 7.4
+;; Version: 7.7
;;
;; This file is part of GNU Emacs.
;;
(defvar orgtbl-mode-menu) ; defined when orgtbl mode get initialized
(defvar org-export-html-table-tag) ; defined in org-exp.el
(defvar constants-unit-system)
+(defvar org-table-follow-field-mode)
(defvar orgtbl-after-send-table-hook nil
"Hook for functions attaching to `C-c C-c', if the table is sent.
This can be used to add additional functionality after the table is sent
-to the receiver position, othewise, if table is not sent, the functions
+to the receiver position, othewise, if table is not sent, the functions
are not run.")
(defcustom orgtbl-optimized (eq org-enable-table-editor 'optimized)
:group 'org-table-editing
:type 'boolean)
+(defcustom org-table-exit-follow-field-mode-when-leaving-table t
+ "Non-nil means automatically exit the follow mode.
+When nil, the follow mode will stay on and be active in any table
+the cursor enters. Since the table follow filed mode messes with the
+window configuration, it is not recommended to set this variable to nil,
+except maybe locally in a special file that has mostly tables with long
+fields."
+ :group 'org-table
+ :type 'boolean)
+
+(defcustom org-table-fix-formulas-confirm nil
+ "Whether the user should confirm when Org fixes formulas."
+ :group 'org-table-editing
+ :type '(choice
+ (const :tag "with yes-or-no" yes-or-no-p)
+ (const :tag "with y-or-n" y-or-n-p)
+ (const :tag "no confirmation" nil)))
+(put 'org-table-fix-formulas-confirm
+ 'safe-local-variable
+ #'(lambda (x) (member x '(yes-or-no-p y-or-n-p))))
+
(defcustom org-table-tab-jumps-over-hlines t
"Non-nil means tab in the last column of a table with jump over a hline.
If a horizontal separator line is following the current line,
:tag "Org Table Calculation"
:group 'org-table)
-(defcustom org-table-use-standard-references t
+(defcustom org-table-use-standard-references 'from
"Should org-mode work with table references like B3 instead of @3$2?
Possible values are:
nil never use them
from accept as input, do not present for editing
-t: accept as input and present for editing"
+t accept as input and present for editing"
:group 'org-table-calculation
:type '(choice
(const :tag "Never, don't even check user input for them" nil)
(const :tag "Always, both as user input, and when editing" t)
- (const :tag "Convert user input, don't offer during editing" 'from)))
+ (const :tag "Convert user input, don't offer during editing" from)))
(defcustom org-table-copy-increment t
"Non-nil means increment when copying current field with \\[org-table-copy-down]."
:group 'org-table-calculation
:type 'plist)
+(defcustom org-table-duration-custom-format 'hours
+ "Format for the output of calc computations like $1+$2;t.
+The default value is 'hours, and will output the results as a
+number of hours. Other allowed values are 'seconds, 'minutes and
+'days, and the output will be a fraction of seconds, minutes or
+days."
+ :group 'org-table-calculation
+ :type '(choice (symbol :tag "Seconds" 'seconds)
+ (symbol :tag "Minutes" 'minutes)
+ (symbol :tag "Hours " 'hours)
+ (symbol :tag "Days " 'days)))
+
(defcustom org-table-formula-evaluate-inline t
"Non-nil means TAB and RET evaluate a formula in current table field.
If the current field starts with an equal sign, it is assumed to be a formula
"Table begin line, non-nil only for the duration of a command.")
(defvar org-table-current-begin-pos nil
"Table begin position, non-nil only for the duration of a command.")
+(defvar org-table-current-ncol nil
+ "Number of columns in table, non-nil only for the duration of a command.")
(defvar org-table-dlines nil
"Vector of data line line numbers in the current table.")
(defvar org-table-hlines nil
((equal separator '(4)) "^\\|\"?[ \t]*,[ \t]*\"?")
((equal separator '(16)) "^\\|\t")
((integerp separator)
- (format "^ *\\| *\t *\\| \\{%d,\\}" separator))
+ (if (< separator 1)
+ (error "Number of spaces in separator must be >= 1")
+ (format "^ *\\| *\t *\\| \\{%d,\\}" separator)))
(t (error "This should not happen"))))
(while (re-search-forward re end t)
(replace-match "| " t t)))
(let* ((beg (org-table-begin))
(end (org-table-end))
(txt (buffer-substring-no-properties beg end))
- (file (or file
- (condition-case nil
- (org-entry-get beg "TABLE_EXPORT_FILE" t)
- (error nil))))
+ (file (or file (org-entry-get beg "TABLE_EXPORT_FILE" t)))
(format (or format
- (condition-case nil
- (org-entry-get beg "TABLE_EXPORT_FORMAT" t)
- (error nil))))
+ (org-entry-get beg "TABLE_EXPORT_FORMAT" t)))
buf deffmt-readable)
(unless file
(setq file (read-file-name "Export table to: "))
(defun org-table-copy-down (n)
"Copy a field down in the current column.
-If the field at the cursor is empty, copy into it the content of the nearest
-non-empty field above. With argument N, use the Nth non-empty field.
-If the current field is not empty, it is copied down to the next row, and
-the cursor is moved with it. Therefore, repeating this command causes the
-column to be filled row-by-row.
-If the variable `org-table-copy-increment' is non-nil and the field is an
-integer or a timestamp, it will be incremented while copying. In the case of
-a timestamp, if the cursor is on the year, change the year. If it is on the
-month or the day, change that. Point will stay on the current date field
-in order to easily repeat the interval."
+If the field at the cursor is empty, copy into it the content of
+the nearest non-empty field above. With argument N, use the Nth
+non-empty field. If the current field is not empty, it is copied
+down to the next row, and the cursor is moved with it.
+Therefore, repeating this command causes the column to be filled
+row-by-row.
+If the variable `org-table-copy-increment' is non-nil and the
+field is an integer or a timestamp, it will be incremented while
+copying. In the case of a timestamp, increment by one day."
(interactive "p")
(let* ((colpos (org-table-current-column))
(col (current-column))
(org-move-to-column col))
(error "No non-empty field found"))))
-(defun org-table-check-inside-data-field ()
+(defun org-table-check-inside-data-field (&optional noerror)
"Is point inside a table data field?
I.e. not on a hline or before the first or after the last column?
This actually throws an error, so it aborts the current command."
(= (org-table-current-column) 0)
(org-at-table-hline-p)
(looking-at "[ \t]*$"))
- (error "Not in table data field")))
+ (if noerror
+ nil
+ (error "Not in table data field"))
+ t))
(defvar org-table-clip nil
"Clipboard for table regions.")
"Blank the current table field or active region."
(interactive)
(org-table-check-inside-data-field)
- (if (and (interactive-p) (org-region-active-p))
+ (if (and (org-called-interactively-p 'any) (org-region-active-p))
(let (org-table-clip)
(org-table-cut-region (region-beginning) (region-end)))
(skip-chars-backward "^|")
(let* ((pos (match-beginning 0))
(val (buffer-substring (1+ pos) (match-end 0))))
(if replace
- (replace-match (concat "|" replace) t t))
+ (replace-match (concat "|" (if (equal replace "") " " replace))
+ t t))
(goto-char (min (point-at-eol) (+ 2 pos)))
val)
(forward-char 1) ""))
(cname (car (rassoc (int-to-string col) org-table-column-names)))
(name (car (rassoc (list (org-current-line) col)
org-table-named-field-locations)))
- (eql (org-table-get-stored-formulas))
+ (eql (org-table-expand-lhs-ranges
+ (mapcar
+ (lambda (e)
+ (cons (org-table-formula-handle-first/last-rc
+ (car e)) (cdr e)))
+ (org-table-get-stored-formulas))))
(dline (org-table-current-dline))
(ref (format "@%d$%d" dline col))
(ref1 (org-table-convert-refs-to-an ref))
(fequation (or (assoc name eql) (assoc ref eql)))
(cequation (assoc (int-to-string col) eql))
(eqn (or fequation cequation)))
+ (if (and eqn (get-text-property 0 :orig-eqn (car eqn)))
+ (setq eqn (get-text-property 0 :orig-eqn (car eqn))))
(goto-char pos)
(condition-case nil
(org-table-show-reference 'local)
(defun org-table-current-column ()
"Find out which column we are in."
(interactive)
- (if (interactive-p) (org-table-check-inside-data-field))
+ (if (org-called-interactively-p 'any) (org-table-check-inside-data-field))
(save-excursion
(let ((cnt 0) (pos (point)))
(beginning-of-line 1)
(while (search-forward "|" pos t)
(setq cnt (1+ cnt)))
- (if (interactive-p) (message "In table column %d" cnt))
+ (when (org-called-interactively-p 'interactive)
+ (message "In table column %d" cnt))
cnt)))
(defun org-table-current-dline ()
"Find out what table data line we are in.
Only data lines count for this."
(interactive)
- (if (interactive-p) (org-table-check-inside-data-field))
+ (when (org-called-interactively-p 'any)
+ (org-table-check-inside-data-field))
(save-excursion
(let ((cnt 0) (pos (point)))
(goto-char (org-table-begin))
(while (<= (point) pos)
(if (looking-at org-table-dataline-regexp) (setq cnt (1+ cnt)))
(beginning-of-line 2))
- (if (interactive-p) (message "This is table line %d" cnt))
+ (when (org-called-interactively-p 'any)
+ (message "This is table line %d" cnt))
cnt)))
(defun org-table-goto-column (n &optional on-delim force)
(org-goto-line linepos)
(org-table-goto-column colpos)
(org-table-align)
- (org-table-fix-formulas "$" nil (1- col) 1)
- (org-table-fix-formulas "$LR" nil (1- col) 1)))
+ (when (or (not org-table-fix-formulas-confirm)
+ (funcall org-table-fix-formulas-confirm "Fix formulas? "))
+ (org-table-fix-formulas "$" nil (1- col) 1)
+ (org-table-fix-formulas "$LR" nil (1- col) 1))))
(defun org-table-find-dataline ()
"Find a data line in the current table, which is needed for column commands."
(error
"Please position cursor in a data line for column operations")))))
+(defun org-table-line-to-dline (line &optional above)
+ "Turn a buffer line number into a data line number.
+If there is no data line in this line, return nil.
+If there is no matching dline (most likely te refrence was a hline), the
+first dline below it is used. When ABOVE is non-nil, the one above is used."
+ (catch 'exit
+ (let ((ll (length org-table-dlines))
+ i)
+ (if above
+ (progn
+ (setq i (1- ll))
+ (while (> i 0)
+ (if (<= (aref org-table-dlines i) line)
+ (throw 'exit i))
+ (setq i (1- i))))
+ (setq i 1)
+ (while (< i ll)
+ (if (>= (aref org-table-dlines i) line)
+ (throw 'exit i))
+ (setq i (1+ i)))))
+ nil))
+
(defun org-table-delete-column ()
"Delete a column from the table."
(interactive)
(org-goto-line linepos)
(org-table-goto-column colpos)
(org-table-align)
- (org-table-fix-formulas "$" (list (cons (number-to-string col) "INVALID"))
- col -1 col)
- (org-table-fix-formulas "$LR" (list (cons (number-to-string col) "INVALID"))
- col -1 col)))
+ (when (or (not org-table-fix-formulas-confirm)
+ (funcall org-table-fix-formulas-confirm "Fix formulas? "))
+ (org-table-fix-formulas "$" (list (cons (number-to-string col) "INVALID"))
+ col -1 col)
+ (org-table-fix-formulas "$LR" (list (cons (number-to-string col) "INVALID"))
+ col -1 col))))
(defun org-table-move-column-right ()
"Move column to the right."
(org-goto-line linepos)
(org-table-goto-column colpos)
(org-table-align)
- (org-table-fix-formulas
- "$" (list (cons (number-to-string col) (number-to-string colpos))
- (cons (number-to-string colpos) (number-to-string col))))
- (org-table-fix-formulas
- "$LR" (list (cons (number-to-string col) (number-to-string colpos))
- (cons (number-to-string colpos) (number-to-string col))))))
+ (when (or (not org-table-fix-formulas-confirm)
+ (funcall org-table-fix-formulas-confirm "Fix formulas? "))
+ (org-table-fix-formulas
+ "$" (list (cons (number-to-string col) (number-to-string colpos))
+ (cons (number-to-string colpos) (number-to-string col))))
+ (org-table-fix-formulas
+ "$LR" (list (cons (number-to-string col) (number-to-string colpos))
+ (cons (number-to-string colpos) (number-to-string col)))))))
(defun org-table-move-row-down ()
"Move table row down."
(insert txt)
(beginning-of-line 0)
(org-move-to-column col)
- (unless (or hline1p hline2p)
+ (unless (or hline1p hline2p
+ (not (or (not org-table-fix-formulas-confirm)
+ (funcall org-table-fix-formulas-confirm
+ "Fix formulas? "))))
(org-table-fix-formulas
"@" (list (cons (number-to-string dline1) (number-to-string dline2))
(cons (number-to-string dline2) (number-to-string dline1)))))))
(re-search-forward "| ?" (point-at-eol) t)
(and (or org-table-may-need-update org-table-overlay-coordinates)
(org-table-align))
- (org-table-fix-formulas "@" nil (1- (org-table-current-dline)) 1)))
+ (when (or (not org-table-fix-formulas-confirm)
+ (funcall org-table-fix-formulas-confirm "Fix formulas? "))
+ (org-table-fix-formulas "@" nil (1- (org-table-current-dline)) 1))))
(defun org-table-insert-hline (&optional above)
"Insert a horizontal-line below the current line into the table.
(kill-region (point-at-bol) (min (1+ (point-at-eol)) (point-max)))
(if (not (org-at-table-p)) (beginning-of-line 0))
(org-move-to-column col)
- (org-table-fix-formulas "@" (list (cons (number-to-string dline) "INVALID"))
- dline -1 dline)))
+ (when (or (not org-table-fix-formulas-confirm)
+ (funcall org-table-fix-formulas-confirm "Fix formulas? "))
+ (org-table-fix-formulas "@" (list (cons (number-to-string dline) "INVALID"))
+ dline -1 dline))))
(defun org-table-sort-lines (with-case &optional sorting-type)
"Sort table lines according to the column at point.
(thiscol (org-table-current-column))
beg end bcol ecol tend tbeg column lns pos)
(when (equal thiscol 0)
- (if (interactive-p)
+ (if (org-called-interactively-p 'any)
(setq thiscol
(string-to-number
(read-string "Use column N for sorting: ")))
When called with a \\[universal-argument] prefix, just make the full field visible so that
it can be edited in place."
(interactive "P")
- (if arg
- (let ((b (save-excursion (skip-chars-backward "^|") (point)))
- (e (save-excursion (skip-chars-forward "^|\r\n") (point))))
- (remove-text-properties b e '(org-cwidth t invisible t
- display t intangible t))
- (if (and (boundp 'font-lock-mode) font-lock-mode)
- (font-lock-fontify-block)))
+ (cond
+ ((equal arg '(16))
+ (org-table-follow-field-mode (if org-table-follow-field-mode -1 1)))
+ (arg
+ (let ((b (save-excursion (skip-chars-backward "^|") (point)))
+ (e (save-excursion (skip-chars-forward "^|\r\n") (point))))
+ (remove-text-properties b e '(org-cwidth t invisible t
+ display t intangible t))
+ (if (and (boundp 'font-lock-mode) font-lock-mode)
+ (font-lock-fontify-block))))
+ (t
(let ((pos (move-marker (make-marker) (point)))
+ (coord
+ (if (eq org-table-use-standard-references t)
+ (concat (org-number-to-letters (org-table-current-column))
+ (int-to-string (org-table-current-dline)))
+ (concat "@" (int-to-string (org-table-current-dline))
+ "$" (int-to-string (org-table-current-column)))))
(field (org-table-get-field))
(cw (current-window-configuration))
p)
- (org-switch-to-buffer-other-window "*Org tmp*")
+ (goto-char pos)
+ (org-switch-to-buffer-other-window "*Org Table Edit Field*")
+ (when (and (local-variable-p 'org-field-marker)
+ (markerp org-field-marker))
+ (move-marker org-field-marker nil))
(erase-buffer)
- (insert "#\n# Edit field and finish with C-c C-c\n#\n")
+ (insert "#\n# Edit field " coord " and finish with C-c C-c\n#\n")
(let ((org-inhibit-startup t)) (org-mode))
+ (auto-fill-mode -1)
+ (setq truncate-lines nil)
+ (setq word-wrap t)
(goto-char (setq p (point-max)))
(insert (org-trim field))
(remove-text-properties p (point-max)
(org-set-local 'org-finish-function 'org-table-finish-edit-field)
(org-set-local 'org-window-configuration cw)
(org-set-local 'org-field-marker pos)
- (message "Edit and finish with C-c C-c"))))
+ (message "Edit and finish with C-c C-c")))))
(defun org-table-finish-edit-field ()
"Finish editing a table data field.
(org-table-align)
(message "New field value inserted")))
+(define-minor-mode org-table-follow-field-mode
+ "Minor mode to make the table field editor window follow the cursor.
+When this mode is active, the field editor window will always show the
+current field. The mode exits automatically when the cursor leaves the
+table (but see `org-table-exit-follow-field-mode-when-leaving-table')."
+ nil " TblFollow" nil
+ (if org-table-follow-field-mode
+ (org-add-hook 'post-command-hook 'org-table-follow-fields-with-editor
+ 'append 'local)
+ (remove-hook 'post-command-hook 'org-table-follow-fields-with-editor 'local)
+ (let* ((buf (get-buffer "*Org Table Edit Field*"))
+ (win (and buf (get-buffer-window buf))))
+ (when win (delete-window win))
+ (when buf
+ (with-current-buffer buf
+ (move-marker org-field-marker nil))
+ (kill-buffer buf)))))
+
+(defun org-table-follow-fields-with-editor ()
+ (if (and org-table-exit-follow-field-mode-when-leaving-table
+ (not (org-at-table-p)))
+ ;; We have left the table, exit the follow mode
+ (org-table-follow-field-mode -1)
+ (when (org-table-check-inside-data-field 'noerror)
+ (let ((win (selected-window)))
+ (org-table-edit-field nil)
+ (org-fit-window-to-buffer)
+ (select-window win)))))
+
(defvar org-timecnt) ; dynamically scoped parameter
(defun org-table-sum (&optional beg end nlast)
s diff)
(format "%d:%02d:%02d" h m s))))
(kill-new sres)
- (if (interactive-p)
+ (if (org-called-interactively-p 'interactive)
(message "%s"
(substitute-command-keys
(format "Sum of %d items: %-20s (\\[yank] will insert result into buffer)"
"\n")))
(defsubst org-table-formula-make-cmp-string (a)
- (when (string-match "^\\(@\\([0-9]+\\)\\)?\\(\\$?\\([0-9]+\\)\\)?\\(\\$?[a-zA-Z0-9]+\\)?" a)
+ (when (string-match "\\`$[<>]" a)
+ (let ((arrow (string-to-char (substring a 1))))
+ ;; Fake a high number to make sure this is sorted at the end.
+ (setq a (org-table-formula-handle-first/last-rc a))
+ (setq a (format "$%d" (+ 10000
+ (if (= arrow ?<) -1000 0)
+ (string-to-number (substring a 1)))))))
+ (when (string-match
+ "^\\(@\\([0-9]+\\)\\)?\\(\\$?\\([0-9]+\\)\\)?\\(\\$?[a-zA-Z0-9]+\\)?"
+ a)
(concat
- (if (match-end 2) (format "@%05d" (string-to-number (match-string 2 a))) "")
- (if (match-end 4) (format "$%05d" (string-to-number (match-string 4 a))) "")
- (if (match-end 5) (concat "@@" (match-string 5 a))))))
+ (if (match-end 2)
+ (format "@%05d" (string-to-number (match-string 2 a))) "")
+ (if (match-end 4)
+ (format "$%05d" (string-to-number (match-string 4 a))) "")
+ (if (match-end 5)
+ (concat "@@" (match-string 5 a))))))
(defun org-table-formula-less-p (a b)
"Compare two formulas for sorting."
(save-excursion
(goto-char (org-table-end))
(when (looking-at "\\([ \t]*\n\\)*[ \t]*#\\+TBLFM: *\\(.*\\)")
- (setq strings (org-split-string (match-string 2) " *:: *"))
+ (setq strings (org-split-string (org-match-string-no-properties 2)
+ " *:: *"))
(while (setq string (pop strings))
- (when (string-match "\\`\\(@[0-9]+\\$[0-9]+\\|\\$\\([a-zA-Z0-9]+\\)\\) *= *\\(.*[^ \t]\\)" string)
+ (when (string-match "\\`\\(@[-+I<>0-9.$@]+\\|@?[0-9]+\\|\\$\\([a-zA-Z0-9]+\\|[<>]+\\)\\) *= *\\(.*[^ \t]\\)" string)
(setq scol (if (match-end 2)
(match-string 2 string)
(match-string 1 string))
+ scol (if (member (string-to-char scol) '(?< ?>))
+ (concat "$" scol) scol)
eq (match-string 3 string)
eq-alist (cons (cons scol eq) eq-alist))
(if (member scol seen)
org-table-named-field-locations nil
org-table-current-begin-line nil
org-table-current-begin-pos nil
- org-table-current-line-types nil)
+ org-table-current-line-types nil
+ org-table-current-ncol 0)
(goto-char beg)
(when (re-search-forward "^[ \t]*| *! *\\(|.*\\)" end t)
(setq names (org-split-string (match-string 1) " *| *")
(string-match "^[a-zA-Z][a-zA-Z0-9]*$" field))
(push (cons field v) org-table-local-parameters)
(push (list field line col) org-table-named-field-locations))))
- ;; Analyse the line types
+ ;; Analyze the line types
(goto-char beg)
(setq org-table-current-begin-line (org-current-line)
org-table-current-begin-pos (point)
"[ \t]*|[ \t]*"))
(nfields (length fields))
al al2)
+ (setq org-table-current-ncol nfields)
(loop for i from 1 to nfields do
(push (list (format "LR%d" i) l i) al)
(push (cons (format "LR%d" i) (nth (1- i) fields)) al2))
(setq org-table-local-parameters
(append org-table-local-parameters al2))))))
-
(defun org-table-maybe-eval-formula ()
"Check if the current field starts with \"=\" or \":=\".
If yes, store the formula and apply it."
(org-goto-line l1)))
(if (not (= epos (point-at-eol))) (org-table-align))
(org-goto-line l)
- (and (interactive-p) (message "%s" (cdr (assoc new org-recalc-marks))))))
+ (and (org-called-interactively-p 'interactive)
+ (message "%s" (cdr (assoc new org-recalc-marks))))))
(defun org-table-maybe-recalculate-line ()
"Recompute the current line if marked for it, and if we haven't just done it."
(modes (copy-sequence org-calc-default-modes))
(numbers nil) ; was a variable, now fixed default
(keep-empty nil)
- n form form0 bw fmt x ev orig c lispp literal)
+ n form form0 formrpl formrg bw fmt x ev orig c lispp literal duration)
;; Parse the format string. Since we have a lot of modes, this is
;; a lot of work. However, I think calc still uses most of the time.
(if (string-match ";" formula)
(?s . sci) (?e . eng))))
n))))
(setq fmt (replace-match "" t t fmt)))
- (if (string-match "[NT]" fmt)
- (setq numbers (equal (match-string 0 fmt) "N")
+ (if (string-match "T" fmt)
+ (setq duration t numbers t
+ duration-output-format nil
+ fmt (replace-match "" t t fmt)))
+ (if (string-match "t" fmt)
+ (setq duration t
+ duration-output-format org-table-duration-custom-format
+ numbers t
+ fmt (replace-match "" t t fmt)))
+ (if (string-match "N" fmt)
+ (setq numbers t
fmt (replace-match "" t t fmt)))
(if (string-match "L" fmt)
(setq literal t
(org-no-properties
(buffer-substring (point-at-bol) (point-at-eol)))
" *| *"))
+ ;; replace fields with duration values if relevant
+ (if duration
+ (setq fields
+ (mapcar (lambda (x) (org-table-time-string-to-seconds x))
+ fields)))
(if (eq numbers t)
(setq fields (mapcar
(lambda (x) (number-to-string (string-to-number x)))
fields)))
(setq ndown (1- ndown))
(setq form (copy-sequence formula)
- lispp (and (> (length form) 2)(equal (substring form 0 2) "'(")))
+ lispp (and (> (length form) 2) (equal (substring form 0 2) "'(")))
(if (and lispp literal) (setq lispp 'literal))
;; Insert row and column number of formula result field
;; Insert complex ranges
(while (and (string-match org-table-range-regexp form)
(> (length (match-string 0 form)) 1))
- (setq form
- (replace-match
- (save-match-data
- (org-table-make-reference
- (org-table-get-range (match-string 0 form) nil n0)
- keep-empty numbers lispp))
- t t form)))
+ (setq formrg (save-match-data
+ (org-table-get-range (match-string 0 form) nil n0)))
+ (setq formrpl
+ (save-match-data
+ (org-table-make-reference
+ ;; possibly handle durations
+ (if duration
+ (if (listp formrg)
+ (mapcar (lambda(x) (org-table-time-string-to-seconds x)) formrg)
+ (org-table-time-string-to-seconds formrg))
+ formrg)
+ keep-empty numbers lispp)))
+ (if (not (save-match-data
+ (string-match (regexp-quote form) formrpl)))
+ (setq form (replace-match formrpl t t form))
+ (error "Spreadsheet error: invalid reference \"%s\"" form)))
;; Insert simple ranges
(while (string-match "\\$\\([0-9]+\\)\\.\\.\\$\\([0-9]+\\)" form)
(setq form
t t form)))
(setq form0 form)
;; Insert the references to fields in same row
- (while (string-match "\\$\\([0-9]+\\)" form)
- (setq n (string-to-number (match-string 1 form))
- x (nth (1- (if (= n 0) n0 n)) fields))
+ (while (string-match "\\$\\(\\([-+]\\)?[0-9]+\\)" form)
+ (setq n (+ (string-to-number (match-string 1 form))
+ (if (match-end 2) n0 0))
+ x (nth (1- (if (= n 0) n0 (max n 1))) fields))
(unless x (error "Invalid field specifier \"%s\""
(match-string 0 form)))
(setq form (replace-match
(setq ev (condition-case nil
(eval (eval (read form)))
(error "#ERROR"))
- ev (if (numberp ev) (number-to-string ev) ev))
+ ev (if (numberp ev) (number-to-string ev) ev)
+ ev (if duration (org-table-time-seconds-to-string
+ (string-to-number ev)
+ duration-output-format) ev))
(or (fboundp 'calc-eval)
(error "Calc does not seem to be installed, and is needed to evaluate the formula"))
- (setq ev (calc-eval (cons form modes)
- (if numbers 'num))))
+ (setq ev (calc-eval (cons form modes) (if numbers 'num))
+ ev (if duration (org-table-time-seconds-to-string
+ (string-to-number ev)
+ duration-output-format) ev)))
(when org-table-formula-debug
(with-output-to-temp-buffer "*Substitution History*"
(if fmt (format fmt (string-to-number ev)) ev)))))
(setq bw (get-buffer-window "*Substitution History*"))
(org-fit-window-to-buffer bw)
- (unless (and (interactive-p) (not ndown))
+ (unless (and (org-called-interactively-p 'any) (not ndown))
(unless (let (inhibit-redisplay)
(y-or-n-p "Debugging Formula. Continue to next? "))
(org-table-align)
(progn (skip-chars-forward "^|") (point))
prop value)))
-(defun org-table-get-range (desc &optional tbeg col highlight)
+(defun org-table-get-range (desc &optional tbeg col highlight corners-only)
"Get a calc vector from a column, according to descriptor DESC.
Optional arguments TBEG and COL can give the beginning of the table and
the current column, to avoid unnecessary parsing.
-HIGHLIGHT means just highlight the range."
+
+HIGHLIGHT means just highlight the range.
+
+When CORNERS-ONLY is set, only return the corners of the range as
+a list (line1 column1 line2 column2) where line1 and line2 are line numbers
+in the buffer and column1 and column2 are table column numbers."
(if (not (equal (string-to-char desc) ?@))
(setq desc (concat "@" desc)))
(save-excursion
(if (not r2) (setq r2 thisline))
(if (not c1) (setq c1 col))
(if (not c2) (setq c2 col))
- (if (or (not rangep) (and (= r1 r2) (= c1 c2)))
+ (if (and (not corners-only)
+ (or (not rangep) (and (= r1 r2) (= c1 c2))))
;; just one field
(progn
(org-goto-line r1)
;; First sort the numbers to get a regular ractangle
(if (< r2 r1) (setq tmp r1 r1 r2 r2 tmp))
(if (< c2 c1) (setq tmp c1 c1 c2 c2 tmp))
- (org-goto-line r1)
- (while (not (looking-at org-table-dataline-regexp))
- (beginning-of-line 2))
- (org-table-goto-column c1)
- (setq beg (point))
- (org-goto-line r2)
- (while (not (looking-at org-table-dataline-regexp))
- (beginning-of-line 0))
- (org-table-goto-column c2)
- (setq end (point))
- (if highlight
- (org-table-highlight-rectangle
- beg (progn (skip-chars-forward "^|\n") (point))))
- ;; return string representation of calc vector
- (mapcar 'org-trim
- (apply 'append (org-table-copy-region beg end)))))))
+ (if corners-only
+ ;; Only return the corners of the range
+ (list r1 c1 r2 c2)
+ ;; Copy the range values into a list
+ (org-goto-line r1)
+ (while (not (looking-at org-table-dataline-regexp))
+ (beginning-of-line 2))
+ (org-table-goto-column c1)
+ (setq beg (point))
+ (org-goto-line r2)
+ (while (not (looking-at org-table-dataline-regexp))
+ (beginning-of-line 0))
+ (org-table-goto-column c2)
+ (setq end (point))
+ (if highlight
+ (org-table-highlight-rectangle
+ beg (progn (skip-chars-forward "^|\n") (point))))
+ ;; return string representation of calc vector
+ (mapcar 'org-trim
+ (apply 'append (org-table-copy-region beg end))))))))
(defun org-table-get-descriptor-line (desc &optional cline bline table)
"Analyze descriptor DESC and retrieve the corresponding line number.
(org-table-get-specials)
(let* ((eqlist (sort (org-table-get-stored-formulas)
(lambda (a b) (string< (car a) (car b)))))
+ (eqlist1 (copy-sequence eqlist))
(inhibit-redisplay (not debug-on-error))
(line-re org-table-dataline-regexp)
(thisline (org-current-line))
(thiscol (org-table-current-column))
- beg end entry eqlnum eqlname eqlname1 eql (cnt 0) eq a name)
+ seen-fields lhs1
+ beg end entry eqlnum eqlname eqlname1 eql (cnt 0) eq a name name1)
;; Insert constants in all formulas
(setq eqlist
(mapcar (lambda (x)
- (setcdr x (org-table-formula-substitute-names (cdr x)))
- x)
+ (when (string-match "\\`$[<>]" (car x))
+ (setq lhs1 (car x))
+ (setq x (cons (substring
+ (org-table-formula-handle-first/last-rc
+ (car x)) 1)
+ (cdr x)))
+ (if (assoc (car x) eqlist1)
+ (error "\"%s=\" formula tries to overwrite existing formula for column %s"
+ lhs1 (car x))))
+ (cons
+ (org-table-formula-handle-first/last-rc (car x))
+ (org-table-formula-substitute-names
+ (org-table-formula-handle-first/last-rc (cdr x)))))
eqlist))
;; Split the equation list
(while (setq eq (pop eqlist))
(push eq eqlnum)
(push eq eqlname)))
(setq eqlnum (nreverse eqlnum) eqlname (nreverse eqlname))
+ ;; Expand ranges in lhs of formulas
+ (setq eqlname (org-table-expand-lhs-ranges eqlname))
+
+ ;; Get the correct line range to process
(if all
(progn
(setq end (move-marker (make-marker) (1+ (org-table-end))))
(goto-char beg)
(and all (message "Re-applying formulas to full table..."))
- ;; First find the named fields, and mark them untouchable
+ ;; First find the named fields, and mark them untouchable.
+ ;; Also check if several field/range formulas try to set the same field.
(remove-text-properties beg end '(org-untouchable t))
(while (setq eq (pop eqlname))
(setq name (car eq)
a (assoc name org-table-named-field-locations))
+ (setq name1 name)
+ (if a (setq name1 (format "@%d$%d" (org-table-line-to-dline (nth 1 a))
+ (nth 2 a))))
+ (when (member name1 seen-fields)
+ (error "Several field/range formulas try to set %s" name1))
+ (push name1 seen-fields)
+
(and (not a)
(string-match "@\\([0-9]+\\)\\$\\([0-9]+\\)" name)
(setq a (list name
(org-table-goto-column (nth 2 a))
(push (append a (list (cdr eq))) eqlname1)
(org-table-put-field-property :org-untouchable t)))
+ (setq eqlname1 (nreverse eqlname1))
;; Now evaluate the column formulas, but skip fields covered by
;; field formulas
(and all (message "Re-applying formulas...done"))))))
(defun org-table-iterate (&optional arg)
- "Recalculate the table until it does not change anymore."
+ "Recalculate the table until it does not change anymore.
+The maximum number of iterations is 10, but you can chose a different value
+with the prefix ARG."
(interactive "P")
(let ((imax (if arg (prefix-numeric-value arg) 10))
(i 0)
(setq checksum c1)))
(error "No convergence after %d iterations" imax))))))
+(defun org-table-expand-lhs-ranges (equations)
+ "Expand list of formulas.
+If some of the RHS in the formulas are ranges or a row reference, expand
+them to individual field equations for each field."
+ (let (e res lhs rhs range r1 r2 c1 c2)
+ (while (setq e (pop equations))
+ (setq lhs (car e) rhs (cdr e))
+ (cond
+ ((string-match "^@-?[-+I0-9]+\\$-?[0-9]+$" lhs)
+ ;; This just refers to one fixed field
+ (push e res))
+ ((string-match "^[a-zA-Z][a-zA-Z0-9]*$" lhs)
+ ;; This just refers to one fixed named field
+ (push e res))
+ ((string-match "^@[0-9]+$" lhs)
+ (loop for ic from 1 to org-table-current-ncol do
+ (push (cons (format "%s$%d" lhs ic) rhs) res)
+ (put-text-property 0 (length (caar res))
+ :orig-eqn e (caar res))))
+ (t
+ (setq range (org-table-get-range lhs org-table-current-begin-pos
+ 1 nil 'corners))
+ (setq r1 (nth 0 range) c1 (nth 1 range)
+ r2 (nth 2 range) c2 (nth 3 range))
+ (setq r1 (org-table-line-to-dline r1))
+ (setq r2 (org-table-line-to-dline r2 'above))
+ (loop for ir from r1 to r2 do
+ (loop for ic from c1 to c2 do
+ (push (cons (format "@%d$%d" ir ic) rhs) res)
+ (put-text-property 0 (length (caar res))
+ :orig-eqn e (caar res)))))))
+ (nreverse res)))
+
+(defun org-table-formula-handle-first/last-rc (s)
+ "Replace @<, @>, $<, $> with first/last row/column of the table.
+So @< and $< will always be replaced with @1 and $1, respectively.
+The advantage of these special markers are that structure editing of
+the table will not change them, while @1 and $1 will be modified
+when a line/row is swaped out of that privileged position. So for
+formulas that use a range of rows or columns, it may often be better
+to anchor the formula with \"I\" row markers, or to offset from the
+borders of the table using the @< @> $< $> makers."
+ (let (n nmax len char)
+ (while (string-match "\\([@$]\\)\\(<+\\|>+\\)" s)
+ (setq nmax (if (equal (match-string 1 s) "@")
+ (1- (length org-table-dlines))
+ org-table-current-ncol)
+ len (- (match-end 2) (match-beginning 2))
+ char (string-to-char (match-string 2 s))
+ n (if (= char ?<)
+ len
+ (- nmax len -1)))
+ (if (or (< n 1) (> n nmax))
+ (error "Reference \"%s\" in expression \"%s\" points outside table"
+ (match-string 0 s) s))
+ (setq s (replace-match (format "%s%d" (match-string 1 s) n) t t s))))
+ s)
+
(defun org-table-formula-substitute-names (f)
"Replace $const with values in string F."
(let ((start 0) a (f1 f) (pp (/= (string-to-char f) ?')))
(wc (current-window-configuration))
(sel-win (selected-window))
(titles '((column . "# Column Formulas\n")
- (field . "# Field Formulas\n")
+ (field . "# Field and Range Formulas\n")
(named . "# Named Field Formulas\n")))
entry s type title)
(org-switch-to-buffer-other-window "*Edit Formulas*")
(setq startline (org-current-line))
(while (setq entry (pop eql))
(setq type (cond
+ ((string-match "\\`$[<>]" (car entry)) 'column)
((equal (string-to-char (car entry)) ?@) 'field)
((string-match "^[0-9]" (car entry)) 'column)
(t 'named)))
(when (setq title (assq type titles))
(or (bobp) (insert "\n"))
(insert (org-add-props (cdr title) nil 'face font-lock-comment-face))
- (setq titles (delq title titles)))
+ (setq titles (remove title titles)))
(if (equal key (car entry)) (setq startline (org-current-line)))
- (setq s (concat (if (equal (string-to-char (car entry)) ?@) "" "$")
+ (setq s (concat (if (member (string-to-char (car entry)) '(?@ ?$)) "" "$")
(car entry) " = " (cdr entry) "\n"))
(remove-text-properties 0 (length s) '(face nil) s)
(insert s))
s))
(defun org-table-convert-refs-to-rc (s)
- "Convert spreadsheet references from AB7 to @7$28.
+ "Convert spreadsheet references from A7 to @7$28.
Works for single references, but also for entire formulas and even the
full TBLFM line."
(let ((start 0))
n (/ (1- n) 26)))
s))
+(defun org-table-time-string-to-seconds (s)
+ "Convert a time string into numerical duration in seconds.
+S can be a string matching either -?HH:MM:SS or -?HH:MM.
+If S is a string representing a number, keep this number."
+ (let (hour min sec res)
+ (cond
+ ((and (string-match "\\(-?\\)\\([0-9]+\\):\\([0-9]+\\):\\([0-9]+\\)" s))
+ (setq minus (< 0 (length (match-string 1 s)))
+ hour (string-to-number (match-string 2 s))
+ min (string-to-number (match-string 3 s))
+ sec (string-to-number (match-string 4 s)))
+ (if minus
+ (setq res (- (+ (* hour 3600) (* min 60) sec)))
+ (setq res (+ (* hour 3600) (* min 60) sec))))
+ ((and (not (string-match org-ts-regexp-both s))
+ (string-match "\\(-?\\)\\([0-9]+\\):\\([0-9]+\\)" s))
+ (setq minus (< 0 (length (match-string 1 s)))
+ hour (string-to-number (match-string 2 s))
+ min (string-to-number (match-string 3 s)))
+ (if minus
+ (setq res (- (+ (* hour 3600) (* min 60))))
+ (setq res (+ (* hour 3600) (* min 60)))))
+ (t (setq res (string-to-number s))))
+ (number-to-string res)))
+
+(defun org-table-time-seconds-to-string (secs &optional output-format)
+ "Convert a number of seconds to a time string.
+If OUTPUT-FORMAT is non-nil, return a number of days, hours,
+minutes or seconds."
+ (cond ((eq output-format 'days)
+ (format "%.3f" (/ (float secs) 86400)))
+ ((eq output-format 'hours)
+ (format "%.2f" (/ (float secs) 3600)))
+ ((eq output-format 'minutes)
+ (format "%.1f" (/ (float secs) 60)))
+ ((eq output-format 'seconds)
+ (format "%d" secs))
+ (t (org-format-seconds "%.2h:%.2m:%.2s" secs))))
+
(defun org-table-fedit-convert-buffer (function)
"Convert all references in this buffer, using FUNCTION."
(let ((line (org-current-line)))
(let ((pos org-pos) (sel-win org-selected-window) eql var form)
(goto-char (point-min))
(while (re-search-forward
- "^\\(@[0-9]+\\$[0-9]+\\|\\$\\([a-zA-Z0-9]+\\)\\) *= *\\(.*\\(\n[ \t]+.*$\\)*\\)"
+ "^\\(@[-+I<>0-9.$@]+\\|@?[0-9]+\\|\\$\\([a-zA-Z0-9]+\\|[<>]+\\)\\) *= *\\(.*\\(\n[ \t]+.*$\\)*\\)"
nil t)
(setq var (if (match-end 2) (match-string 2) (match-string 1))
form (match-string 3))
var name e what match dest)
(if local (org-table-get-specials))
(setq what (cond
+ ((org-at-regexp-p "^@[0-9]+[ \t=]")
+ (setq match (concat (substring (match-string 0) 0 -1)
+ "$1.."
+ (substring (match-string 0) 0 -1)
+ "$100"))
+ 'range)
((or (org-at-regexp-p org-table-range-regexp2)
(org-at-regexp-p org-table-translate-regexp)
(org-at-regexp-p org-table-range-regexp))
(defun org-table-cleanup-narrow-column-properties ()
"Remove all properties related to narrow-column invisibility."
- (let ((s 1))
+ (let ((s (point-min)))
(while (setq s (text-property-any s (point-max)
'display org-narrow-column-arrow))
(remove-text-properties s (1+ s) '(display t)))
- (setq s 1)
+ (setq s (point-min))
(while (setq s (text-property-any s (point-max) 'org-cwidth 1))
(remove-text-properties s (1+ s) '(org-cwidth t)))
- (setq s 1)
+ (setq s (point-min))
(while (setq s (text-property-any s (point-max) 'invisible 'org-cwidth))
(remove-text-properties s (1+ s) '(invisible t)))))
If it is a table to be sent away to a receiver, do it.
With prefix arg, also recompute table."
(interactive "P")
- (let ((pos (point)) action)
+ (let ((pos (point)) action consts-str consts cst const-str)
(save-excursion
(beginning-of-line 1)
- (setq action (cond ((looking-at "[ \t]*#\\+ORGTBL:.*\n[ \t]*|") (match-end 0))
- ((looking-at "[ \t]*|") pos)
- ((looking-at "[ \t]*#\\+TBLFM:") 'recalc))))
+ (setq action (cond
+ ((looking-at "[ \t]*#\\+ORGTBL:.*\n[ \t]*|") (match-end 0))
+ ((looking-at "[ \t]*|") pos)
+ ((looking-at "[ \t]*#\\+TBLFM:") 'recalc))))
(cond
((integerp action)
(goto-char action)
(when (orgtbl-send-table 'maybe)
(run-hooks 'orgtbl-after-send-table-hook)))
((eq action 'recalc)
+ (save-excursion
+ (goto-char (point-min))
+ (while (re-search-forward "^[ \t]*#\\+CONSTANTS: \\(.*\\)" nil t)
+ (setq const-str (substring-no-properties (match-string 1)))
+ (setq consts (append consts (org-split-string const-str "[ \t]+")))
+ (when consts
+ (let (e)
+ (while (setq e (pop consts))
+ (if (string-match "^\\([a-zA-Z0][_a-zA-Z0-9]*\\)=\\(.*\\)" e)
+ (push (cons (match-string 1 e) (match-string 2 e)) cst)))
+ (setq org-table-formula-constants-local cst)))))
(save-excursion
(beginning-of-line 1)
(skip-chars-backward " \r\n\t")
(looking-at "[^|\n]* +|"))
(let (org-table-may-need-update)
(goto-char (1- (match-end 0)))
- (delete-backward-char 1)
+ (delete-char -1)
(goto-char (match-beginning 0))
(self-insert-command N))
(setq org-table-may-need-update t)
(catch 'exit
(unless (org-at-table-p) (error "Not at a table"))
;; when non-interactive, we assume align has just happened.
- (when (interactive-p) (org-table-align))
+ (when (org-called-interactively-p 'any) (org-table-align))
(let ((dests (orgtbl-gather-send-defs))
(txt (buffer-substring-no-properties (org-table-begin)
(org-table-end)))
TABLE is a list, each entry either the symbol `hline' for a horizontal
separator line, or a list of fields for that line.
PARAMS is a property list of parameters that can influence the conversion.
-For the generic converter, some parameters are obligatory: You need to
+For the generic converter, some parameters are obligatory: you need to
specify either :lfmt, or all of (:lstart :lend :sep).
Valid parameters are
will then be used. Alternatively, it may be an ID referring to
any entry, also in a different file. In this case, the first table
in that entry will be referenced.
-FORM is a field or range descriptor like \"@2$3\" or or \"B3\" or
+FORM is a field or range descriptor like \"@2$3\" or \"B3\" or
\"@I$2..@II$2\". All the references must be absolute, not relative.
The return value is either a single string for a single field, or a
org-table-local-parameters org-table-named-field-locations
org-table-current-line-types org-table-current-begin-line
org-table-current-begin-pos org-table-dlines
+ org-table-current-ncol
org-table-hlines org-table-last-alignment
org-table-last-column-widths org-table-last-alignment
org-table-last-column-widths tbeg
(provide 'org-table)
+
;;; org-table.el ends here
HCoop / bpt / emacs.git / blobdiff