;;; org-table.el --- The table editor for Org-mode
-;; Copyright (C) 2004, 2005, 2006, 2007, 2008, 2009, 2010, 2011
-;; Free Software Foundation, Inc.
+;; Copyright (C) 2004-2012 Free Software Foundation, Inc.
;; Author: Carsten Dominik <carsten at orgmode dot org>
;; Keywords: outlines, hypermedia, calendar, wp
;; Homepage: http://orgmode.org
-;; Version: 6.33x
;;
;; 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, otherwise, if table is not sent, the functions
+are not run.")
(defcustom orgtbl-optimized (eq org-enable-table-editor 'optimized)
- "Non-nil means, use the optimized table editor version for `orgtbl-mode'.
+ "Non-nil means use the optimized table editor version for `orgtbl-mode'.
In the optimized version, the table editor takes over all simple keys that
normally just insert a character. In tables, the characters are inserted
in a way to minimize disturbing the table structure (i.e. in overwrite mode
:group 'org-table)
(defcustom org-table-automatic-realign t
- "Non-nil means, automatically re-align table when pressing TAB or RETURN.
+ "Non-nil means automatically re-align table when pressing TAB or RETURN.
When nil, aligning is only done with \\[org-table-align], or after column
removal/insertion."
:group 'org-table-editing
:type 'boolean)
(defcustom org-table-auto-blank-field t
- "Non-nil means, automatically blank table field when starting to type into it.
+ "Non-nil means automatically blank table field when starting to type into it.
This only happens when typing immediately after a field motion
command (TAB, S-TAB or RET).
Only relevant when `org-enable-table-editor' is equal to `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.
+ "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,
`org-table-next-field' can either create a new row before that line, or jump
over the line. When this option is nil, a new line will be created before
: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]."
+ "Non-nil means increment when copying current field with \\[org-table-copy-down]."
:group 'org-table-calculation
:type 'boolean)
calc-date-format (YYYY "-" MM "-" DD " " Www (" " hh ":" mm))
calc-display-working-message t
)
- "List with Calc mode settings for use in calc-eval for table formulas.
+ "List with Calc mode settings for use in `calc-eval' for table formulas.
The list must contain alternating symbols (Calc modes variables and values).
Don't remove any of the default settings, just change the values. Org-mode
relies on the variables to be present in the list."
: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-field-format "%s"
+ "Format for fields which contain the result of a formula.
+For example, using \"~%s~\" will display the result within tilde
+characters. Beware that modifying the display can prevent the
+field from being used in another formula."
+ :group 'org-table-settings
+ :type 'string)
+
(defcustom org-table-formula-evaluate-inline t
- "Non-nil means, TAB and RET evaluate a formula in current table field.
+ "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
which should be evaluated as described in the manual and in the documentation
string of the command `org-table-eval-formula'. This feature requires the
:type 'boolean)
(defcustom org-table-formula-use-constants t
- "Non-nil means, interpret constants in formulas in tables.
+ "Non-nil means interpret constants in formulas in tables.
A constant looks like `$c' or `$Grav' and will be replaced before evaluation
by the value given in `org-table-formula-constants', or by a value obtained
from the `constants.el' package."
(string :tag "value"))))
(defcustom org-table-allow-automatic-line-recalculation t
- "Non-nil means, lines marked with |#| or |*| will be recomputed automatically.
-Automatically means, when TAB or RET or C-c C-c are pressed in the line."
+ "Non-nil means lines marked with |#| or |*| will be recomputed automatically.
+Automatically means when TAB or RET or C-c C-c are pressed in the line."
:group 'org-table-calculation
:type 'boolean)
:type 'boolean)
(defcustom org-table-relative-ref-may-cross-hline t
- "Non-nil means, relative formula references may cross hlines.
+ "Non-nil means relative formula references may cross hlines.
Here are the allowed values:
nil Relative references may not cross hlines. They will reference the
:group 'org-table)
(defcustom org-table-export-default-format "orgtbl-to-tsv"
- "Default export parameters for org-table-export. These can be
-overridden on for a specific table by setting the TABLE_EXPORT_FORMAT
-property. See the manual section on orgtbl radio tables for the different
-export transformations and available parameters."
+ "Default export parameters for `org-table-export'.
+These can be overridden for a specific table by setting the
+TABLE_EXPORT_FORMAT property. See the manual section on orgtbl
+radio tables for the different export transformations and
+available parameters."
:group 'org-table-import-export
:type 'string)
(defconst org-table-calculate-mark-regexp "^[ \t]*| *[!$^_#*] *\\(|\\|$\\)"
"Detects a table line marked for automatic recalculation.")
(defconst org-table-border-regexp "^[ \t]*[^| \t]"
- "Searching from within a table (any type) this finds the first line
-outside the table.")
+ "Searching from within a table (any type) this finds the first line outside the table.")
(defvar org-table-last-highlighted-reference nil)
(defvar org-table-formula-history nil)
"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
"\\(" "@?[-0-9I$&]+" "\\|" "[a-zA-Z]\\{1,2\\}\\([0-9]+\\|&\\)" "\\|" "\\$[a-zA-Z0-9]+" "\\)")
"Match a range for reference display.")
+(defun org-table-colgroup-line-p (line)
+ "Is this a table line colgroup information?"
+ (save-match-data
+ (and (string-match "[<>]\\|&[lg]t;" line)
+ (string-match "\\`[ \t]*|[ \t]*/[ \t]*\\(|[ \t<>0-9|lgt&;]+\\)\\'"
+ line)
+ (not (delq
+ nil
+ (mapcar
+ (lambda (s)
+ (not (member s '("" "<" ">" "<>" "<" ">" "<>"))))
+ (org-split-string (match-string 1 line) "[ \t]*|[ \t]*")))))))
+
+(defun org-table-cookie-line-p (line)
+ "Is this a table line with only alignment/width cookies?"
+ (save-match-data
+ (and (string-match "[<>]\\|&[lg]t;" line)
+ (or (string-match
+ "\\`[ \t]*|[ \t]*/[ \t]*\\(|[ \t<>0-9|lrcgt&;]+\\)\\'" line)
+ (string-match "\\(\\`[ \t<>lrc0-9|gt&;]+\\'\\)" line))
+ (not (delq nil (mapcar
+ (lambda (s)
+ (not (or (equal s "")
+ (string-match
+ "\\`<\\([lrc]?[0-9]+\\|[lrc]\\)>\\'" s)
+ (string-match
+ "\\`<\\([lrc]?[0-9]+\\|[lrc]\\)>\\'"
+ s))))
+ (org-split-string (match-string 1 line)
+ "[ \t]*|[ \t]*")))))))
+
(defconst org-table-translate-regexp
(concat "\\(" "@[-0-9I$]+" "\\|" "[a-zA-Z]\\{1,2\\}\\([0-9]+\\|&\\)" "\\)")
"Match a reference that needs translation, for reference display.")
(if (y-or-n-p "Convert table to Org-mode table? ")
(org-table-convert)))
((org-at-table-p)
- (if (y-or-n-p "Convert table to table.el table? ")
- (org-table-convert)))
+ (when (y-or-n-p "Convert table to table.el table? ")
+ (org-table-align)
+ (org-table-convert)))
(t (call-interactively 'table-insert))))
(defun org-table-create-or-convert-from-region (arg)
(t 1))))
(goto-char beg)
(if (equal separator '(4))
- (while (<= (point) end)
+ (while (< (point) end)
;; parse the csv stuff
(cond
((looking-at "^") (insert "| "))
((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)))
a TABLE_EXPORT_FILE property in the current entry or higher up in the
hierarchy, or the user will be prompted for a file name.
FORMAT can be an export format, of the same kind as it used when
-orgtbl-mode sends a table in a different format. The default format can
+`orgtbl-mode' sends a table in a different format. The default format can
be found in the variable `org-table-export-default-format', but the function
first checks if there is an export format specified in a TABLE_EXPORT_FORMAT
property, locally or anywhere up in the hierarchy."
(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: "))
"List of max width of fields in each column.
This is being used to correctly align a single field after TAB or RET.")
(defvar org-table-formula-debug nil
- "Non-nil means, debug table formulas.
+ "Non-nil means debug table formulas.
When nil, simply write \"#ERROR\" in corrupted fields.")
(make-variable-buffer-local 'org-table-formula-debug)
(defvar org-table-overlay-coordinates nil
(make-variable-buffer-local 'org-table-overlay-coordinates)
(defvar org-last-recalc-line nil)
+(defvar org-table-do-narrow t) ; for dynamic scoping
(defconst org-narrow-column-arrow "=>"
"Used as display property in narrowed table columns.")
(make-string sp2 ?\ ) "%%%s%ds" (make-string sp1 ?\ ) "|"))
(hfmt1 (concat
(make-string sp2 ?-) "%s" (make-string sp1 ?-) "+"))
- emptystrings links dates emph narrow falign falign1 fmax f1 len c e)
+ emptystrings links dates emph raise narrow
+ falign falign1 fmax f1 len c e space)
(untabify beg end)
(remove-text-properties beg end '(org-cwidth t org-dwidth t display t))
;; Check if we have links or dates
(setq emph (and org-hide-emphasis-markers
(re-search-forward org-emph-re end t)))
(goto-char beg)
+ (setq raise (and org-use-sub-superscripts
+ (re-search-forward org-match-substring-regexp end t)))
+ (goto-char beg)
(setq dates (and org-display-custom-times
(re-search-forward org-ts-regexp-both end t)))
;; Make sure the link properties are right
;; Make sure the date properties are right
(when dates (goto-char beg) (while (org-activate-dates end)))
(when emph (goto-char beg) (while (org-do-emphasis-faces end)))
+ (when raise (goto-char beg) (while (org-raise-scripts end)))
;; Check if we are narrowing any columns
(goto-char beg)
- (setq narrow (and org-format-transports-properties-p
- (re-search-forward "<[rl]?[0-9]+>" end t)))
+ (setq narrow (and org-table-do-narrow
+ org-format-transports-properties-p
+ (re-search-forward "<[lrc]?[0-9]+>" end t)))
(goto-char beg)
- (setq falign (re-search-forward "<[rl][0-9]*>" end t))
+ (setq falign (re-search-forward "<[lrc][0-9]*>" end t))
(goto-char beg)
;; Get the rows
(setq lines (org-split-string
(while (< (setq i (1+ i)) maxfields) ;; Loop over all columns
(setq column (mapcar (lambda (x) (or (nth i x) "")) fields))
;; Check if there is an explicit width specified
+ (setq fmax nil)
(when (or narrow falign)
(setq c column fmax nil falign1 nil)
(while c
(setq e (pop c))
- (when (and (stringp e) (string-match "^<\\([rl]\\)?\\([0-9]+\\)?>$" e))
+ (when (and (stringp e) (string-match "^<\\([lrc]\\)?\\([0-9]+\\)?>$" e))
(if (match-end 1) (setq falign1 (match-string 1 e)))
- (if (match-end 2)
+ (if (and org-table-do-narrow (match-end 2))
(setq fmax (string-to-number (match-string 2 e)) c nil))))
;; Find fields that are wider than fmax, and shorten them
(when fmax
(list 'display org-narrow-column-arrow)
xx)))))
;; Get the maximum width for each column
- (push (apply 'max 1 (mapcar 'org-string-width column)) lengths)
+ (push (apply 'max (or fmax 1) 1 (mapcar 'org-string-width column))
+ lengths)
;; Get the fraction of numbers, to decide about alignment of the column
(if falign1
(push (equal (downcase falign1) "r") typenums)
;; With invisible characters, `format' does not get the field width right
;; So we need to make these fields wide by hand.
- (when (or links emph)
+ (when (or links emph raise)
(loop for i from 0 upto (1- maxfields) do
(setq len (nth i lengths))
(loop for j from 0 upto (1- (length fields)) do
(setq c (nthcdr i (car (nthcdr j fields))))
(if (and (stringp (car c))
- (text-property-any 0 (length (car c)) 'invisible 'org-link (car c))
-; (string-match org-bracket-link-regexp (car c))
+ (or (text-property-any 0 (length (car c))
+ 'invisible 'org-link (car c))
+ (text-property-any 0 (length (car c))
+ 'org-dwidth t (car c)))
(< (org-string-width (car c)) len))
- (setcar c (concat (car c) (make-string (- len (org-string-width (car c))) ?\ )))))))
+ (progn
+ (setq space (make-string (- len (org-string-width (car c))) ?\ ))
+ (setcar c (if (nth i typenums)
+ (concat space (car c))
+ (concat (car c) space))))))))
;; Compute the formats needed for output of the table
(setq rfmt (concat indent "|") hfmt (concat indent "|"))
(append (pop fields) emptystrings))
hfmt))
lines ""))
- (if (equal (char-before) ?\n)
- ;; This hack is for org-indent, to force redisplay of the
- ;; line prefix of the first line. Apparently the redisplay
- ;; is tied to the newline, which is, I think, a bug.
- ;; To force this redisplay, we remove and re-insert the
- ;; newline, so that the redisplay engine thinks it belongs
- ;; to the changed text.
- (progn
- (backward-delete-char 1)
- (insert "\n")))
(move-marker org-table-aligned-begin-marker (point))
(insert new)
;; Replace the old one
(delete-region (point) end)
(move-marker end nil)
(move-marker org-table-aligned-end-marker (point))
- (when (and orgtbl-mode (not (org-mode-p)))
+ (when (and orgtbl-mode (not (eq major-mode 'org-mode)))
(goto-char org-table-aligned-begin-marker)
(while (org-hide-wide-columns org-table-aligned-end-marker)))
;; Try to move to the old location
(setq org-table-may-need-update nil)
))
-
-
-
-
-
-
-
-
(defun org-table-begin (&optional table-type)
"Find the beginning of the table and return its position.
With argument TABLE-TYPE, go to the beginning of a table.el-type table."
(if (<= (length new) l) ;; FIXME: length -> str-width?
(setq n (format f new))
(setq n (concat new "|") org-table-may-need-update t)))
+ (if (equal (string-to-char n) ?-) (setq n (concat " " n)))
(or (equal n o)
(let (org-table-may-need-update)
(replace-match n t t))))
(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.")
+(defun org-table-get (line column)
+ "Get the field in table line LINE, column COLUMN.
+If LINE is larger than the number of data lines in the table, the function
+returns nil. However, if COLUMN is too large, we will simply return an
+empty string.
+If LINE is nil, use the current line.
+If column is nil, use the current column."
+ (setq column (or column (org-table-current-column)))
+ (save-excursion
+ (and (or (not line) (org-table-goto-line line))
+ (org-trim (org-table-get-field column)))))
+
+(defun org-table-put (line column value &optional align)
+ "Put VALUE into line LINE, column COLUMN.
+When ALIGN is set, also realign the table."
+ (setq column (or column (org-table-current-column)))
+ (prog1 (save-excursion
+ (and (or (not line) (org-table-goto-line line))
+ (progn (org-table-goto-column column nil 'force) t)
+ (org-table-get-field column value)))
+ (and align (org-table-align))))
+
+(defun org-table-current-line ()
+ "Return the index of the current data line."
+ (let ((pos (point)) (end (org-table-end)) (cnt 0))
+ (save-excursion
+ (goto-char (org-table-begin))
+ (while (and (re-search-forward org-table-dataline-regexp end t)
+ (setq cnt (1+ cnt))
+ (< (point-at-eol) pos))))
+ cnt))
+
+(defun org-table-goto-line (N)
+ "Go to the Nth data line in the current table.
+Return t when the line exists, nil if it does not exist."
+ (goto-char (org-table-begin))
+ (let ((end (org-table-end)) (cnt 0))
+ (while (and (re-search-forward org-table-dataline-regexp end t)
+ (< (setq cnt (1+ cnt)) N)))
+ (= cnt N)))
+
(defun org-table-blank-field ()
"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 (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)))
+ (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 datalines count for this."
+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)
If there are less than N fields, just go to after the last delimiter.
However, when FORCE is non-nil, create new columns if necessary."
(interactive "p")
- (let ((pos (point-at-eol)))
- (beginning-of-line 1)
- (when (> n 0)
- (while (and (> (setq n (1- n)) -1)
- (or (search-forward "|" pos t)
- (and force
- (progn (end-of-line 1)
- (skip-chars-backward "^|")
- (insert " | "))))))
-; (backward-char 2) t)))))
- (when (and force (not (looking-at ".*|")))
- (save-excursion (end-of-line 1) (insert " | ")))
- (if on-delim
- (backward-char 1)
- (if (looking-at " ") (forward-char 1))))))
-
+ (beginning-of-line 1)
+ (when (> n 0)
+ (while (and (> (setq n (1- n)) -1)
+ (or (search-forward "|" (point-at-eol) t)
+ (and force
+ (progn (end-of-line 1)
+ (skip-chars-backward "^|")
+ (insert " | ")
+ t)))))
+ (when (and force (not (looking-at ".*|")))
+ (save-excursion (end-of-line 1) (insert " | ")))
+ (if on-delim
+ (backward-char 1)
+ (if (looking-at " ") (forward-char 1)))))
(defun org-table-insert-column ()
"Insert a new column into the table."
(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 dataline in the current table, which is needed for column commands."
+ "Find a data line in the current table, which is needed for column commands."
(if (and (org-at-table-p)
(not (org-at-table-hline-p)))
t
(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 the reference 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: ")))
(replace-match "-+"))
(goto-char beg)))))
+(defun org-table-transpose-table-at-point ()
+ "Transpose orgmode table at point and eliminate hlines.
+So a table like
+
+| 1 | 2 | 4 | 5 |
+|---+---+---+---|
+| a | b | c | d |
+| e | f | g | h |
+
+will be transposed as
+
+| 1 | a | e |
+| 2 | b | f |
+| 4 | c | g |
+| 5 | d | h |
+
+Note that horizontal lines disappeared."
+ (interactive)
+ (let ((contents
+ (apply #'mapcar* #'list
+ ;; remove 'hline from list
+ (delq nil (mapcar (lambda (x) (when (listp x) x))
+ (org-table-to-lisp))))))
+ (delete-region (org-table-begin) (org-table-end))
+ (insert (mapconcat (lambda(x) (concat "| " (mapconcat 'identity x " | " ) " |\n" ))
+ contents ""))
+ (org-table-align)))
+
(defun org-table-wrap-region (arg)
"Wrap several fields in a column like a paragraph.
This is useful if you'd like to spread the contents of a field over several
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
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)
(when remove
(while (re-search-forward re2 (point-at-eol) t)
(unless (save-match-data (org-in-regexp "remote([^)]+?)"))
- (replace-match ""))))
+ (if (equal (char-before (match-beginning 0)) ?.)
+ (error "Change makes TBLFM term %s invalid. Use undo to recover."
+ (match-string 0))
+ (replace-match "")))))
(while (re-search-forward re (point-at-eol) t)
(unless (save-match-data (org-in-regexp "remote([^)]+?)"))
(setq s (match-string 1) n (string-to-number s))
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) " *| *")
cnt 1)
(while (setq name (pop names))
(setq cnt (1+ cnt))
- (if (string-match "^[a-zA-Z][a-zA-Z0-9]*$" name)
+ (if (string-match "^[a-zA-Z][_a-zA-Z0-9]*$" name)
(push (cons name (int-to-string cnt)) org-table-column-names))))
(setq org-table-column-names (nreverse org-table-column-names))
(setq org-table-column-name-regexp
(while (and fields1 (setq field (pop fields)))
(setq v (pop fields1) col (1+ col))
(when (and (stringp field) (stringp v)
- (string-match "^[a-zA-Z][a-zA-Z0-9]*$" field))
+ (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
"[ \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 duration-output-format)
;; 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
+ (while (string-match "[@$]#" form)
+ (setq form
+ (replace-match
+ (format "%d"
+ (save-match-data
+ (if (equal (substring form (match-beginning 0)
+ (1+ (match-beginning 0)))
+ "@")
+ (org-table-current-dline)
+ (org-table-current-column))))
+ t t form)))
+
;; Check for old vertical references
(setq form (org-table-rewrite-old-row-references form))
;; Insert remote references
;; 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? "))
+ (y-or-n-p "Debugging Formula. Continue to next? "))
(org-table-align)
(error "Abort"))
(delete-window bw)
(message "")))
(if (listp ev) (setq fmt nil ev "#ERROR"))
(org-table-justify-field-maybe
- (if fmt (format fmt (string-to-number ev)) ev))
+ (format org-table-formula-field-format
+ (if fmt (format fmt (string-to-number ev)) ev)))
(if (and down (> ndown 0) (looking-at ".*\n[ \t]*|[^-]"))
(call-interactively 'org-return)
(setq ndown 0)))
(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)
(prog1 (org-trim (org-table-get-field c1))
(if highlight (org-table-highlight-rectangle (point) (point)))))
;; A range, return a vector
- ;; First sort the numbers to get a regular ractangle
+ ;; First sort the numbers to get a regular rectangle
(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.
;; 1 2 3 4 5 6
(and (not (match-end 3)) (not (match-end 6)))
(and (match-end 3) (match-end 6) (not (match-end 5))))
- (error "invalid row descriptor `%s'" desc))
+ (error "Invalid row descriptor `%s'" desc))
(let* ((hdir (and (match-end 2) (match-string 2 desc)))
(hn (if (match-end 3) (- (match-end 3) (match-beginning 3)) nil))
(odir (and (match-end 5) (match-string 5 desc)))
(setq i 0 hdir "+")
(if (eq (aref table 0) 'hline) (setq hn (1- hn)))))
(if (and (not hn) on (not odir))
- (error "should never happen");;(aref org-table-dlines on)
+ (error "Should never happen");;(aref org-table-dlines on)
(if (and hn (> hn 0))
(setq i (org-table-find-row-type table i 'hline (equal hdir "-")
nil hn cline desc)))
(defun org-table-recalculate (&optional all noalign)
"Recalculate the current table line by applying all stored formulas.
With prefix arg ALL, do this for all lines in the table.
-With the prefix argument ALL is `(16)' (a double `C-c C-u' prefix), or if
+With the prefix argument ALL is `(16)' \
+\(a double \\[universal-prefix] \\[universal-prefix] prefix), or if
it is the symbol `iterate', recompute the table until it no longer changes.
If NOALIGN is not nil, do not re-align the table after the computations
are done. This is typically used internally to save time, if it is
(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 choose a different value
+with the prefix ARG."
(interactive "P")
(let ((imax (if arg (prefix-numeric-value arg) 10))
(i 0)
(throw 'exit t)))
(error "No convergence after %d iterations" i))))
+(defun org-table-recalculate-buffer-tables ()
+ "Recalculate all tables in the current buffer."
+ (interactive)
+ (save-excursion
+ (save-restriction
+ (widen)
+ (org-table-map-tables (lambda () (org-table-recalculate t)) t))))
+
+(defun org-table-iterate-buffer-tables ()
+ "Iterate all tables in the buffer, to converge inter-table dependencies."
+ (interactive)
+ (let* ((imax 10)
+ (checksum (md5 (buffer-string)))
+
+ c1
+ (i imax))
+ (save-excursion
+ (save-restriction
+ (widen)
+ (catch 'exit
+ (while (> i 0)
+ (setq i (1- i))
+ (org-table-map-tables (lambda () (org-table-recalculate t)) t)
+ (if (equal checksum (setq c1 (md5 (buffer-string))))
+ (progn
+ (message "Convergence after %d iterations" (- imax i))
+ (throw 'exit t))
+ (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 swapped 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 (start 0))
+ (while (string-match "\\([@$]\\)\\(<+\\|>+\\)\\|\\(remote([^\)]+)\\)"
+ s start)
+ (if (match-end 3)
+ (setq start (match-end 3))
+ (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 start (match-beginning 0))
+ (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) ?')))
(org-defkey map "\C-x\C-s" 'org-table-fedit-finish)
(org-defkey map "\C-c\C-s" 'org-table-fedit-finish)
(org-defkey map "\C-c\C-c" 'org-table-fedit-finish)
+ (org-defkey map "\C-c'" 'org-table-fedit-finish)
(org-defkey map "\C-c\C-q" 'org-table-fedit-abort)
(org-defkey map "\C-c?" 'org-table-show-reference)
(org-defkey map [(meta shift up)] 'org-table-fedit-line-up)
(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))
(if (eq org-table-use-standard-references t)
(org-table-fedit-toggle-ref-type))
(org-goto-line startline)
- (message "Edit formulas and finish with `C-c C-c'. See menu for more commands.")))
+ (message "Edit formulas, finish with `C-c C-c' or `C-c ' '. See menu for more commands.")))
(defun org-table-fedit-post-command ()
(when (not (memq this-command '(lisp-complete-symbol)))
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))
(not (equal ?. (aref s (max (- (match-beginning 0) 2) 0)))))
;; 3.e5 or something like this.
(setq start (match-end 0)))
+ ((or (> (- (match-end 1) (match-beginning 1)) 2)
+ ;; (member (match-string 1 s)
+ ;; '("arctan" "exp" "expm" "lnp" "log" "stir"))
+ )
+ ;; function name, just advance
+ (setq start (match-end 0)))
(t
(setq start (match-beginning 0)
s (replace-match
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 minus 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)))
(org-rematch-and-replace 5 (eq dir 'left))))))
(defun org-rematch-and-replace (n &optional decr hline)
- "Re-match the group N, and replace it with the shifted refrence."
+ "Re-match the group N, and replace it with the shifted reference."
(or (match-end n) (error "Cannot shift reference in this direction"))
(goto-char (match-beginning n))
(and (looking-at (regexp-quote (match-string n)))
t t)))
(defun org-table-shift-refpart (ref &optional decr hline)
- "Shift a refrence part REF.
+ "Shift a reference part REF.
If DECR is set, decrease the references row/column, else increase.
If HLINE is set, this may be a hline reference, it certainly is not
a translation reference."
(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))
(select-window sel-win)
(goto-char pos)
(unless (org-at-table-p)
- (error "Lost table position - cannot install formulae"))
+ (error "Lost table position - cannot install formulas"))
(org-table-store-formulas eql)
(move-marker pos nil)
(kill-buffer "*Edit Formulas*")
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-add-rectangle-overlay (beg end &optional face)
"Add a new overlay."
- (let ((ov (org-make-overlay beg end)))
- (org-overlay-put ov 'face (or face 'secondary-selection))
+ (let ((ov (make-overlay beg end)))
+ (overlay-put ov 'face (or face 'secondary-selection))
(push ov org-table-rectangle-overlays)))
(defun org-table-highlight-rectangle (&optional beg end face)
"Remove the rectangle overlays."
(unless org-inhibit-highlight-removal
(remove-hook 'before-change-functions 'org-table-remove-rectangle-highlight)
- (mapc 'org-delete-overlay org-table-rectangle-overlays)
+ (mapc 'delete-overlay org-table-rectangle-overlays)
(setq org-table-rectangle-overlays nil)))
(defvar org-table-coordinate-overlays nil
(defun org-table-overlay-coordinates ()
"Add overlays to the table at point, to show row/column coordinates."
(interactive)
- (mapc 'org-delete-overlay org-table-coordinate-overlays)
+ (mapc 'delete-overlay org-table-coordinate-overlays)
(setq org-table-coordinate-overlays nil)
(save-excursion
(let ((id 0) (ih 0) hline eol s1 s2 str ic ov beg)
(goto-char (org-table-begin))
(while (org-at-table-p)
(setq eol (point-at-eol))
- (setq ov (org-make-overlay (point-at-bol) (1+ (point-at-bol))))
+ (setq ov (make-overlay (point-at-bol) (1+ (point-at-bol))))
(push ov org-table-coordinate-overlays)
(setq hline (looking-at org-table-hline-regexp))
(setq str (if hline (format "I*%-2d" (setq ih (1+ ih)))
s1 (concat "$" (int-to-string ic))
s2 (org-number-to-letters ic)
str (if (eq org-table-use-standard-references t) s2 s1))
- (setq ov (org-make-overlay beg (+ beg (length str))))
+ (setq ov (make-overlay beg (+ beg (length str))))
(push ov org-table-coordinate-overlays)
(org-overlay-display ov str 'org-special-keyword 'evaporate)))
(beginning-of-line 2)))))
(if (and (org-at-table-p) org-table-overlay-coordinates)
(org-table-align))
(unless org-table-overlay-coordinates
- (mapc 'org-delete-overlay org-table-coordinate-overlays)
+ (mapc 'delete-overlay org-table-coordinate-overlays)
(setq org-table-coordinate-overlays nil)))
(defun org-table-toggle-formula-debugger ()
;; active, this binding is ignored inside tables and replaced with a
;; modified self-insert.
-(defvar orgtbl-mode nil
- "Variable controlling `orgtbl-mode', a minor mode enabling the `org-mode'
-table editor in arbitrary modes.")
-(make-variable-buffer-local 'orgtbl-mode)
(defvar orgtbl-mode-map (make-keymap)
"Keymap for `orgtbl-mode'.")
(orgtbl-mode 1))
(defvar org-old-auto-fill-inhibit-regexp nil
- "Local variable used by `orgtbl-mode'")
+ "Local variable used by `orgtbl-mode'.")
(defconst orgtbl-line-start-regexp
"[ \t]*\\(|\\|#\\+\\(TBLFM\\|ORGTBL\\|TBLNAME\\):\\)"
(defconst orgtbl-extra-font-lock-keywords
(list (list (concat "^" orgtbl-line-start-regexp ".*")
0 (quote 'org-table) 'prepend))
- "Extra font-lock-keywords to be added when orgtbl-mode is active.")
+ "Extra `font-lock-keywords' to be added when `orgtbl-mode' is active.")
+
+;; Install it as a minor mode.
+(put 'orgtbl-mode :included t)
+(put 'orgtbl-mode :menu-tag "Org Table Mode")
;;;###autoload
-(defun orgtbl-mode (&optional arg)
+(define-minor-mode orgtbl-mode
"The `org-mode' table editor as a minor mode for use in other modes."
- (interactive)
+ :lighter " OrgTbl" :keymap orgtbl-mode-map
(org-load-modules-maybe)
- (if (org-mode-p)
- ;; Exit without error, in case some hook functions calls this
- ;; by accident in org-mode.
- (message "Orgtbl-mode is not useful in org-mode, command ignored")
- (setq orgtbl-mode
- (if arg (> (prefix-numeric-value arg) 0) (not orgtbl-mode)))
- (if orgtbl-mode
- (progn
- (and (orgtbl-setup) (defun orgtbl-setup () nil))
- ;; Make sure we are first in minor-mode-map-alist
- (let ((c (assq 'orgtbl-mode minor-mode-map-alist)))
- (and c (setq minor-mode-map-alist
- (cons c (delq c minor-mode-map-alist)))))
- (org-set-local (quote org-table-may-need-update) t)
- (org-add-hook 'before-change-functions 'org-before-change-function
- nil 'local)
- (org-set-local 'org-old-auto-fill-inhibit-regexp
- auto-fill-inhibit-regexp)
- (org-set-local 'auto-fill-inhibit-regexp
- (if auto-fill-inhibit-regexp
- (concat orgtbl-line-start-regexp "\\|"
- auto-fill-inhibit-regexp)
- orgtbl-line-start-regexp))
- (org-add-to-invisibility-spec '(org-cwidth))
- (when (fboundp 'font-lock-add-keywords)
- (font-lock-add-keywords nil orgtbl-extra-font-lock-keywords)
- (org-restart-font-lock))
- (easy-menu-add orgtbl-mode-menu)
- (run-hooks 'orgtbl-mode-hook))
- (setq auto-fill-inhibit-regexp org-old-auto-fill-inhibit-regexp)
- (org-table-cleanup-narrow-column-properties)
- (org-remove-from-invisibility-spec '(org-cwidth))
- (remove-hook 'before-change-functions 'org-before-change-function t)
- (when (fboundp 'font-lock-remove-keywords)
- (font-lock-remove-keywords nil orgtbl-extra-font-lock-keywords)
- (org-restart-font-lock))
- (easy-menu-remove orgtbl-mode-menu)
- (force-mode-line-update 'all))))
+ (cond
+ ((eq major-mode 'org-mode)
+ ;; Exit without error, in case some hook functions calls this
+ ;; by accident in org-mode.
+ (message "Orgtbl-mode is not useful in org-mode, command ignored"))
+ (orgtbl-mode
+ (and (orgtbl-setup) (defun orgtbl-setup () nil)) ;; FIXME: Yuck!?!
+ ;; Make sure we are first in minor-mode-map-alist
+ (let ((c (assq 'orgtbl-mode minor-mode-map-alist)))
+ ;; FIXME: maybe it should use emulation-mode-map-alists?
+ (and c (setq minor-mode-map-alist
+ (cons c (delq c minor-mode-map-alist)))))
+ (org-set-local (quote org-table-may-need-update) t)
+ (org-add-hook 'before-change-functions 'org-before-change-function
+ nil 'local)
+ (org-set-local 'org-old-auto-fill-inhibit-regexp
+ auto-fill-inhibit-regexp)
+ (org-set-local 'auto-fill-inhibit-regexp
+ (if auto-fill-inhibit-regexp
+ (concat orgtbl-line-start-regexp "\\|"
+ auto-fill-inhibit-regexp)
+ orgtbl-line-start-regexp))
+ (add-to-invisibility-spec '(org-cwidth))
+ (when (fboundp 'font-lock-add-keywords)
+ (font-lock-add-keywords nil orgtbl-extra-font-lock-keywords)
+ (org-restart-font-lock))
+ (easy-menu-add orgtbl-mode-menu))
+ (t
+ (setq auto-fill-inhibit-regexp org-old-auto-fill-inhibit-regexp)
+ (org-table-cleanup-narrow-column-properties)
+ (org-remove-from-invisibility-spec '(org-cwidth))
+ (remove-hook 'before-change-functions 'org-before-change-function t)
+ (when (fboundp 'font-lock-remove-keywords)
+ (font-lock-remove-keywords nil orgtbl-extra-font-lock-keywords)
+ (org-restart-font-lock))
+ (easy-menu-remove orgtbl-mode-menu)
+ (force-mode-line-update 'all))))
(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)))))
-;; Install it as a minor mode.
-(put 'orgtbl-mode :included t)
-(put 'orgtbl-mode :menu-tag "Org Table Mode")
-(add-minor-mode 'orgtbl-mode " OrgTbl" orgtbl-mode-map)
-
(defun orgtbl-make-binding (fun n &rest keys)
"Create a function for binding in the table minor mode.
FUN is the command to call inside a table. N is used to create a unique
"Setup orgtbl keymaps."
(let ((nfunc 0)
(bindings
- (list
- '([(meta shift left)] org-table-delete-column)
- '([(meta left)] org-table-move-column-left)
- '([(meta right)] org-table-move-column-right)
- '([(meta shift right)] org-table-insert-column)
- '([(meta shift up)] org-table-kill-row)
- '([(meta shift down)] org-table-insert-row)
- '([(meta up)] org-table-move-row-up)
- '([(meta down)] org-table-move-row-down)
- '("\C-c\C-w" org-table-cut-region)
- '("\C-c\M-w" org-table-copy-region)
- '("\C-c\C-y" org-table-paste-rectangle)
- '("\C-c-" org-table-insert-hline)
- '("\C-c}" org-table-toggle-coordinate-overlays)
- '("\C-c{" org-table-toggle-formula-debugger)
- '("\C-m" org-table-next-row)
- '([(shift return)] org-table-copy-down)
- '("\C-c?" org-table-field-info)
- '("\C-c " org-table-blank-field)
- '("\C-c+" org-table-sum)
- '("\C-c=" org-table-eval-formula)
- '("\C-c'" org-table-edit-formulas)
- '("\C-c`" org-table-edit-field)
- '("\C-c*" org-table-recalculate)
- '("\C-c^" org-table-sort-lines)
- '("\M-a" org-table-beginning-of-field)
- '("\M-e" org-table-end-of-field)
- '([(control ?#)] org-table-rotate-recalc-marks)))
+ '(([(meta shift left)] org-table-delete-column)
+ ([(meta left)] org-table-move-column-left)
+ ([(meta right)] org-table-move-column-right)
+ ([(meta shift right)] org-table-insert-column)
+ ([(meta shift up)] org-table-kill-row)
+ ([(meta shift down)] org-table-insert-row)
+ ([(meta up)] org-table-move-row-up)
+ ([(meta down)] org-table-move-row-down)
+ ("\C-c\C-w" org-table-cut-region)
+ ("\C-c\M-w" org-table-copy-region)
+ ("\C-c\C-y" org-table-paste-rectangle)
+ ("\C-c\C-w" org-table-wrap-region)
+ ("\C-c-" org-table-insert-hline)
+ ("\C-c}" org-table-toggle-coordinate-overlays)
+ ("\C-c{" org-table-toggle-formula-debugger)
+ ("\C-m" org-table-next-row)
+ ([(shift return)] org-table-copy-down)
+ ("\C-c?" org-table-field-info)
+ ("\C-c " org-table-blank-field)
+ ("\C-c+" org-table-sum)
+ ("\C-c=" org-table-eval-formula)
+ ("\C-c'" org-table-edit-formulas)
+ ("\C-c`" org-table-edit-field)
+ ("\C-c*" org-table-recalculate)
+ ("\C-c^" org-table-sort-lines)
+ ("\M-a" org-table-beginning-of-field)
+ ("\M-e" org-table-end-of-field)
+ ([(control ?#)] org-table-rotate-recalc-marks)))
elt key fun cmd)
(while (setq elt (pop bindings))
(setq nfunc (1+ nfunc))
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)
(call-interactively 'org-table-recalculate)
(org-table-maybe-recalculate-line))
(call-interactively 'org-table-align)
- (orgtbl-send-table 'maybe))
+ (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)
(funcall func table nil)))
(defun orgtbl-gather-send-defs ()
- "Gathers a plist of :name, :transform, :params for each destination before
+ "Gather a plist of :name, :transform, :params for each destination before
a radio table."
(save-excursion
(goto-char (org-table-begin))
(let (rtn)
(beginning-of-line 0)
- (while (looking-at "[ \t]*#\\+ORGTBL[: \t][ \t]*SEND +\\([a-zA-Z0-9_]+\\) +\\([^ \t\r\n]+\\)\\( +.*\\)?")
+ (while (looking-at "[ \t]*#\\+ORGTBL[: \t][ \t]*SEND[ \t]+\\([^ \t\r\n]+\\)[ \t]+\\([^ \t\r\n]+\\)\\([ \t]+.*\\)?")
(let ((name (org-no-properties (match-string 1)))
(transform (intern (match-string 2)))
(params (if (match-end 3)
(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)))
(orgtbl-send-replace-tbl name txt))
(setq ntbl (1+ ntbl)))
(message "Table converted and installed at %d receiver location%s"
- ntbl (if (> ntbl 1) "s" "")))))
+ ntbl (if (> ntbl 1) "s" ""))
+ (if (> ntbl 0)
+ ntbl
+ nil))))
(defun org-remove-by-index (list indices &optional i0)
"Remove the elements in LIST with indices in INDICES.
(defvar *orgtbl-rtn* nil
"Formatting routines push the output lines here.")
;; Formatting parameters for the current table section.
-(defvar *orgtbl-hline* nil "Text used for horizontal lines")
-(defvar *orgtbl-sep* nil "Text used as a column separator")
-(defvar *orgtbl-default-fmt* nil "Default format for each entry")
-(defvar *orgtbl-fmt* nil "Format for each entry")
-(defvar *orgtbl-efmt* nil "Format for numbers")
-(defvar *orgtbl-lfmt* nil "Format for an entire line, overrides fmt")
-(defvar *orgtbl-llfmt* nil "Specializes lfmt for the last row")
-(defvar *orgtbl-lstart* nil "Text starting a row")
-(defvar *orgtbl-llstart* nil "Specializes lstart for the last row")
-(defvar *orgtbl-lend* nil "Text ending a row")
-(defvar *orgtbl-llend* nil "Specializes lend for the last row")
+(defvar *orgtbl-hline* nil "Text used for horizontal lines.")
+(defvar *orgtbl-sep* nil "Text used as a column separator.")
+(defvar *orgtbl-default-fmt* nil "Default format for each entry.")
+(defvar *orgtbl-fmt* nil "Format for each entry.")
+(defvar *orgtbl-efmt* nil "Format for numbers.")
+(defvar *orgtbl-lfmt* nil "Format for an entire line, overrides fmt.")
+(defvar *orgtbl-llfmt* nil "Specializes lfmt for the last row.")
+(defvar *orgtbl-lstart* nil "Text starting a row.")
+(defvar *orgtbl-llstart* nil "Specializes lstart for the last row.")
+(defvar *orgtbl-lend* nil "Text ending a row.")
+(defvar *orgtbl-llend* nil "Specializes lend for the last row.")
(defsubst orgtbl-get-fmt (fmt i)
"Retrieve the format from FMT corresponding to the Ith column."
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
(let* ((splicep (plist-get params :splice))
(hline (plist-get params :hline))
(remove-nil-linesp (plist-get params :remove-nil-lines))
+ (remove-newlines (plist-get params :remove-newlines))
(*orgtbl-hline* hline)
(*orgtbl-table* table)
(*orgtbl-sep* (plist-get params :sep))
(let ((tend (orgtbl-eval-str (plist-get params :tend))))
(if tend (push tend *orgtbl-rtn*)))))
- (mapconcat 'identity (nreverse (if remove-nil-linesp
- (remq nil *orgtbl-rtn*)
- *orgtbl-rtn*)) "\n")))
+ (mapconcat (if remove-newlines
+ (lambda (tend)
+ (replace-regexp-in-string "[\n\r\t\f]" "\\\\n" tend))
+ 'identity)
+ (nreverse (if remove-nil-linesp
+ (remq nil *orgtbl-rtn*)
+ *orgtbl-rtn*)) "\n")))
(defun orgtbl-to-tsv (table params)
"Convert the orgtbl-mode table to TAB separated material."
(orgtbl-to-generic table (org-combine-plists params2 params))))
(defun orgtbl-to-html (table params)
- "Convert the orgtbl-mode TABLE to LaTeX.
+ "Convert the orgtbl-mode TABLE to HTML.
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.
(lambda (x)
(if (eq x 'hline)
"|----+----|"
- (concat "| " (mapconcat 'identity x " | ") " |")))
+ (concat "| " (mapconcat 'org-html-expand x " | ") " |")))
table)
splicep))
(if (string-match "\n+\\'" html)
provide ORGTBL directives for the generated table."
(let* ((params2
(list
+ :remove-newlines t
:tstart nil :tend nil
:hline "|---"
:sep " | "
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
list of the fields in the rectangle ."
(save-match-data
(let ((id-loc nil)
+ ;; Protect a bunch of variables from being overwritten
+ ;; by the context of the remote table
org-table-column-names org-table-column-name-regexp
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
(setq buffer (marker-buffer id-loc)
loc (marker-position id-loc))
(move-marker id-loc nil)))
- (switch-to-buffer buffer)
- (save-excursion
- (save-restriction
- (widen)
- (goto-char loc)
- (forward-char 1)
- (unless (and (re-search-forward "^\\(\\*+ \\)\\|[ \t]*|" nil t)
- (not (match-beginning 1)))
- (error "Cannot find a table at NAME or ID %s" name-or-id))
- (setq tbeg (point-at-bol))
- (org-table-get-specials)
- (setq form (org-table-formula-substitute-names form))
- (if (and (string-match org-table-range-regexp form)
- (> (length (match-string 0 form)) 1))
- (save-match-data
- (org-table-get-range (match-string 0 form) tbeg 1))
- form))))))))
+ (with-current-buffer buffer
+ (save-excursion
+ (save-restriction
+ (widen)
+ (goto-char loc)
+ (forward-char 1)
+ (unless (and (re-search-forward "^\\(\\*+ \\)\\|[ \t]*|" nil t)
+ (not (match-beginning 1)))
+ (error "Cannot find a table at NAME or ID %s" name-or-id))
+ (setq tbeg (point-at-bol))
+ (org-table-get-specials)
+ (setq form (org-table-formula-substitute-names
+ (org-table-formula-handle-first/last-rc form)))
+ (if (and (string-match org-table-range-regexp form)
+ (> (length (match-string 0 form)) 1))
+ (save-match-data
+ (org-table-get-range (match-string 0 form) tbeg 1))
+ form)))))))))
(provide 'org-table)
-;; arch-tag: 4d21cfdd-0268-440a-84b0-09237a0fe0ef
-
;;; org-table.el ends here