X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/8307f92370e7d86aea2c78d0dbc06c5ace9c6f11..9805f81dda38cd541ba8043f44e720e06adf6492:/lisp/org/org-table.el diff --git a/lisp/org/org-table.el b/lisp/org/org-table.el index 7d93a82f84..0d2a2e6a97 100644 --- a/lisp/org/org-table.el +++ b/lisp/org/org-table.el @@ -1,12 +1,10 @@ ;;; 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 ;; Keywords: outlines, hypermedia, calendar, wp ;; Homepage: http://orgmode.org -;; Version: 6.33x ;; ;; This file is part of GNU Emacs. ;; @@ -47,9 +45,16 @@ (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 @@ -142,22 +147,43 @@ alignment to the right border applies." :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 @@ -170,20 +196,20 @@ this 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]." + "Non-nil means increment when copying current field with \\[org-table-copy-down]." :group 'org-table-calculation :type 'boolean) @@ -196,15 +222,35 @@ t: accept as input and present for editing" 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 @@ -215,7 +261,7 @@ the command \\[org-table-eval-formula]." :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." @@ -241,8 +287,8 @@ Constants can also be defined on a per-file basis using a line like (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) @@ -252,7 +298,7 @@ Automatically means, when TAB or RET or C-c C-c are pressed in the line." :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 @@ -276,10 +322,11 @@ portability of tables." :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) @@ -290,8 +337,7 @@ export transformations and available parameters." (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) @@ -310,6 +356,8 @@ outside the table.") "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 @@ -327,6 +375,37 @@ outside the table.") "\\(" "@?[-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.") @@ -342,8 +421,9 @@ and table.el tables." (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) @@ -426,7 +506,7 @@ nil When nil, the command tries to be smart and figure out the (t 1)))) (goto-char beg) (if (equal separator '(4)) - (while (<= (point) end) + (while (< (point) end) ;; parse the csv stuff (cond ((looking-at "^") (insert "| ")) @@ -441,7 +521,9 @@ nil When nil, the command tries to be smart and figure out the ((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))) @@ -470,7 +552,7 @@ FILE can be the output file name. If not given, it will be taken from 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." @@ -482,14 +564,9 @@ 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: ")) @@ -567,7 +644,7 @@ This is being used to correctly align a single field after TAB or RET.") "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 @@ -575,6 +652,7 @@ When nil, simply write \"#ERROR\" in corrupted fields.") (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.") @@ -601,7 +679,8 @@ When nil, simply write \"#ERROR\" in corrupted fields.") (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 @@ -611,6 +690,9 @@ When nil, simply write \"#ERROR\" in corrupted fields.") (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 @@ -618,13 +700,15 @@ When nil, simply write \"#ERROR\" in corrupted fields.") ;; 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 @@ -660,13 +744,14 @@ When nil, simply write \"#ERROR\" in corrupted fields.") (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 @@ -685,7 +770,8 @@ When nil, simply write \"#ERROR\" in corrupted fields.") (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) @@ -705,16 +791,22 @@ When nil, simply write \"#ERROR\" in corrupted fields.") ;; 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 "|")) @@ -731,23 +823,13 @@ When nil, simply write \"#ERROR\" in corrupted fields.") (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 @@ -760,14 +842,6 @@ When nil, simply write \"#ERROR\" in corrupted fields.") (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." @@ -826,6 +900,7 @@ Optional argument NEW may specify text to replace the current field content." (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)))) @@ -939,16 +1014,15 @@ Before doing so, re-align the table if necessary." (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)) @@ -990,7 +1064,7 @@ in order to easily repeat the interval." (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." @@ -998,16 +1072,60 @@ 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 "^|") @@ -1032,7 +1150,8 @@ is always the old value." (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) "")) @@ -1047,13 +1166,20 @@ is always the old value." (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) @@ -1074,25 +1200,31 @@ is always the old value." (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) @@ -1102,22 +1234,20 @@ of the field. 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." @@ -1142,11 +1272,13 @@ However, when FORCE is non-nil, create new columns if necessary." (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 @@ -1164,6 +1296,28 @@ However, when FORCE is non-nil, create new columns if necessary." (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) @@ -1189,10 +1343,12 @@ However, when FORCE is non-nil, create new columns if necessary." (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." @@ -1233,12 +1389,14 @@ However, when FORCE is non-nil, create new columns if necessary." (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." @@ -1274,7 +1432,10 @@ However, when FORCE is non-nil, create new columns if necessary." (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))))))) @@ -1296,7 +1457,9 @@ With prefix ARG, insert below the current line." (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. @@ -1357,8 +1520,10 @@ In particular, this does handle wide and invisible characters." (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. @@ -1386,7 +1551,7 @@ should be done in reverse order." (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: "))) @@ -1561,6 +1726,34 @@ blindly applies a recipe that works for simple tables." (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 @@ -1637,21 +1830,38 @@ This is mainly useful for fields that contain hidden parts. 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) @@ -1661,7 +1871,7 @@ it can be edited in place." (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. @@ -1686,22 +1896,34 @@ the table and kill the editing buffer." (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 @@ -1756,7 +1978,7 @@ If NLAST is a number, only the NLAST fields will actually be summed." 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)" @@ -1880,11 +2102,23 @@ When NAMED is non-nil, look for a named equation." "\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." @@ -1899,12 +2133,15 @@ When NAMED is non-nil, look for a named equation." (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) @@ -1935,7 +2172,10 @@ For all numbers larger than LIMIT, shift them by DELTA." (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)) @@ -1957,14 +2197,15 @@ For all numbers larger than LIMIT, shift them by DELTA." 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 @@ -1988,7 +2229,7 @@ For all numbers larger than LIMIT, shift them by DELTA." (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 @@ -2013,6 +2254,7 @@ For all numbers larger than LIMIT, shift them by DELTA." "[ \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)) @@ -2021,7 +2263,6 @@ For all numbers larger than LIMIT, shift them by DELTA." (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." @@ -2110,7 +2351,8 @@ of the new mark." (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." @@ -2194,7 +2436,8 @@ not overwrite the stored one." (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) @@ -2213,8 +2456,17 @@ not overwrite the stored one." (?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 @@ -2235,14 +2487,33 @@ not overwrite the stored one." (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 @@ -2258,13 +2529,22 @@ not overwrite the stored one." ;; 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 @@ -2278,9 +2558,10 @@ not overwrite the stored one." 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 @@ -2292,11 +2573,16 @@ not overwrite the stored one." (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*" @@ -2313,16 +2599,17 @@ $1-> %s\n" orig formula form0 form)) (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))) @@ -2336,11 +2623,16 @@ $1-> %s\n" orig formula form0 form)) (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 @@ -2369,7 +2661,8 @@ HIGHLIGHT means, just highlight the range." (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) @@ -2378,25 +2671,29 @@ HIGHLIGHT means, just highlight the range." (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. @@ -2412,7 +2709,7 @@ and TABLE is a vector with line types." ;; 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))) @@ -2426,7 +2723,7 @@ and TABLE is a vector with line types." (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))) @@ -2497,7 +2794,8 @@ LISPP means to return something appropriate for a Lisp list." (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 @@ -2511,16 +2809,29 @@ known that the table will be realigned a little later anyway." (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)) @@ -2528,6 +2839,10 @@ known that the table will be realigned a little later anyway." (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)))) @@ -2546,11 +2861,19 @@ known that the table will be realigned a little later anyway." (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 @@ -2566,6 +2889,7 @@ known that the table will be realigned a little later anyway." (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 @@ -2606,7 +2930,9 @@ known that the table will be realigned a little later anyway." (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) @@ -2625,6 +2951,98 @@ known that the table will be realigned a little later anyway." (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) ?'))) @@ -2663,6 +3081,7 @@ Parameters get priority." (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) @@ -2726,7 +3145,7 @@ Parameters get priority." (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*") @@ -2744,22 +3163,23 @@ Parameters get priority." (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))) @@ -2783,7 +3203,7 @@ Parameters get priority." 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)) @@ -2797,6 +3217,12 @@ full TBLFM line." (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 @@ -2845,6 +3271,45 @@ For example: 28 -> AB." 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))) @@ -2901,7 +3366,7 @@ For example: 28 -> AB." (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))) @@ -2909,7 +3374,7 @@ For example: 28 -> AB." 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." @@ -2961,7 +3426,7 @@ With prefix ARG, apply the new formulas to the table." (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)) @@ -2977,7 +3442,7 @@ With prefix ARG, apply the new formulas to the table." (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*") @@ -3050,6 +3515,12 @@ With prefix ARG, apply the new formulas to the table." 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)) @@ -3219,8 +3690,8 @@ Use COMMAND to do the motion, repeat if necessary to end up in a data line." (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) @@ -3255,7 +3726,7 @@ Use COMMAND to do the motion, repeat if necessary to end up in a data line." "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 @@ -3265,14 +3736,14 @@ Use COMMAND to do the motion, repeat if necessary to end up in a data line." (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))) @@ -3286,7 +3757,7 @@ Use COMMAND to do the motion, repeat if necessary to end up in a data line." 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))))) @@ -3300,7 +3771,7 @@ Use COMMAND to do the motion, repeat if necessary to end up in a data line." (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 () @@ -3338,10 +3809,6 @@ Use COMMAND to do the motion, repeat if necessary to end up in a data line." ;; 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'.") @@ -3352,7 +3819,7 @@ table editor in arbitrary modes.") (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\\):\\)" @@ -3361,70 +3828,68 @@ table editor in arbitrary modes.") (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 @@ -3459,34 +3924,34 @@ to execute outside of tables." "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)) @@ -3605,12 +4070,13 @@ to execute outside of tables." 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) @@ -3619,8 +4085,20 @@ With prefix arg, also recompute table." (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") @@ -3676,7 +4154,7 @@ overwritten, and the table is not marked as requiring realignment." (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) @@ -3731,13 +4209,13 @@ overwritten, and the table is not marked as requiring realignment." (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) @@ -3794,7 +4272,7 @@ this table." (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))) @@ -3833,7 +4311,10 @@ this table." (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. @@ -3888,17 +4369,17 @@ First element has index 0, or I0 if given." (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." @@ -3961,7 +4442,7 @@ This generic routine can be used for many standard cases. 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 @@ -4018,6 +4499,7 @@ directly by `orgtbl-send-table'. See manual." (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)) @@ -4072,9 +4554,13 @@ directly by `orgtbl-send-table'. See manual." (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." @@ -4125,7 +4611,7 @@ this function is called." (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. @@ -4147,7 +4633,7 @@ so you cannot specify parameters for it." (lambda (x) (if (eq x 'hline) "|----+----|" - (concat "| " (mapconcat 'identity x " | ") " |"))) + (concat "| " (mapconcat 'org-html-expand x " | ") " |"))) table) splicep)) (if (string-match "\n+\\'" html) @@ -4200,6 +4686,7 @@ and :tend suppress strings without splicing; they can be set to provide ORGTBL directives for the generated table." (let* ((params2 (list + :remove-newlines t :tstart nil :tend nil :hline "|---" :sep " | " @@ -4216,17 +4703,20 @@ a \"#+TBLNAME:\" directive. The first table following this line 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 @@ -4247,26 +4737,25 @@ list of the fields in the rectangle ." (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