diff options
Diffstat (limited to 'lisp/org/org-table.el')
| -rw-r--r-- | lisp/org/org-table.el | 513 |
1 files changed, 327 insertions, 186 deletions
diff --git a/lisp/org/org-table.el b/lisp/org/org-table.el index 00b2eb4d028..246cf8d605c 100644 --- a/lisp/org/org-table.el +++ b/lisp/org/org-table.el @@ -38,13 +38,11 @@ (require 'cl)) (require 'org) -(declare-function org-table-clean-before-export "org-exp" - (lines &optional maybe-quoted)) -(declare-function org-format-org-table-html "org-html" (lines &optional splice)) +(declare-function org-export-string-as "ox" + (string backend &optional body-only ext-plist)) (declare-function aa2u "ext:ascii-art-to-unicode" ()) (defvar orgtbl-mode) ; defined below (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) @@ -54,6 +52,8 @@ 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.") +(defvar org-table-TBLFM-begin-regexp "|\n[ \t]*#\\+TBLFM: ") + (defcustom orgtbl-optimized (eq org-enable-table-editor 'optimized) "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 @@ -94,6 +94,22 @@ this variable requires a restart of Emacs to become effective." | | | ")) "Templates for radio tables in different major modes. +Each template must define lines that will be treated as a comment and that +must contain the \"BEGIN RECEIVE ORGTBL %n\" and \"END RECEIVE ORGTBL\" +lines where \"%n\" will be replaced with the name of the table during +insertion of the tempate. The transformed table will later be inserted +between these lines. + +The template should also contain a minimal table in a multiline comment. +If multiline comments are not possible in the buffer language, +you can pack it into a string that will not be used when the code +is compiled or executed. Above the table will you need a line with +the fixed string \"#+ORGTBL: SEND\", followed by instruction on how to +convert the table into a data structure useful in the +language of the buffer. Check the manual for the section on +\"Translator functions\", and more generally check out +http://orgmode.org/manual/Tables-in-arbitrary-syntax.html#Tables-in-arbitrary-syntax + All occurrences of %n in a template will be replaced with the name of the table, obtained by prompting the user." :group 'org-table @@ -112,7 +128,7 @@ table, obtained by prompting the user." :type 'string) (defcustom org-table-number-regexp - "^\\([<>]?[-+^.0-9]*[0-9][-+^.0-9eEdDx()%:]*\\|\\(0[xX]\\)[0-9a-fA-F]+\\|nan\\)$" + "^\\([<>]?[-+^.0-9]*[0-9][-+^.0-9eEdDx()%:]*\\|[<>]?[-+]?0[xX][0-9a-fA-F.]+\\|[<>]?[-+]?[0-9]+#[0-9a-zA-Z.]+\\|nan\\|[-+u]?inf\\)$" "Regular expression for recognizing numbers in table columns. If a table column contains mostly numbers, it will be aligned to the right. If not, it will be aligned to the left. @@ -136,10 +152,10 @@ Other options offered by the customize interface are more restrictive." "^[-+]?\\([0-9]*\\.[0-9]+\\|[0-9]+\\.?[0-9]*\\)$") (const :tag "Exponential, Floating point, Integer" "^[-+]?[0-9.]+\\([eEdD][-+0-9]+\\)?$") - (const :tag "Very General Number-Like, including hex" - "^\\([<>]?[-+^.0-9]*[0-9][-+^.0-9eEdDx()%]*\\|\\(0[xX]\\)[0-9a-fA-F]+\\|nan\\)$") - (const :tag "Very General Number-Like, including hex, allows comma as decimal mark" - "^\\([<>]?[-+^.,0-9]*[0-9][-+^.0-9eEdDx()%]*\\|\\(0[xX]\\)[0-9a-fA-F]+\\|nan\\)$") + (const :tag "Very General Number-Like, including hex and Calc radix" + "^\\([<>]?[-+^.0-9]*[0-9][-+^.0-9eEdDx()%]*\\|[<>]?[-+]?0[xX][0-9a-fA-F.]+\\|[<>]?[-+]?[0-9]+#[0-9a-zA-Z.]+\\|nan\\|[-+u]?inf\\)$") + (const :tag "Very General Number-Like, including hex and Calc radix, allows comma as decimal mark" + "^\\([<>]?[-+^.,0-9]*[0-9][-+^.0-9eEdDx()%]*\\|[<>]?[-+]?0[xX][0-9a-fA-F.]+\\|[<>]?[-+]?[0-9]+#[0-9a-zA-Z.]+\\|nan\\|[-+u]?inf\\)$") (string :tag "Regexp:"))) (defcustom org-table-number-fraction 0.5 @@ -419,6 +435,40 @@ available parameters." (org-split-string (match-string 1 line) "[ \t]*|[ \t]*"))))))) +(defvar org-table-clean-did-remove-column nil) ; dynamically scoped +(defun org-table-clean-before-export (lines &optional maybe-quoted) + "Check if the table has a marking column. +If yes remove the column and the special lines." + (let ((special (if maybe-quoted + "^[ \t]*| *\\\\?[\#!$*_^/ ] *|" + "^[ \t]*| *[\#!$*_^/ ] *|")) + (ignore (if maybe-quoted + "^[ \t]*| *\\\\?[!$_^/] *|" + "^[ \t]*| *[!$_^/] *|"))) + (setq org-table-clean-did-remove-column + (not (memq nil + (mapcar + (lambda (line) + (or (string-match org-table-hline-regexp line) + (string-match special line))) + lines)))) + (delq nil + (mapcar + (lambda (line) + (cond + ((or (org-table-colgroup-line-p line) ;; colgroup info + (org-table-cookie-line-p line) ;; formatting cookies + (and org-table-clean-did-remove-column + (string-match ignore line))) ;; non-exportable data + nil) + ((and org-table-clean-did-remove-column + (or (string-match "^\\([ \t]*\\)|-+\\+" line) + (string-match "^\\([ \t]*\\)|[^|]*|" line))) + ;; remove the first column + (replace-match "\\1|" t nil line)) + (t line))) + lines)))) + (defconst org-table-translate-regexp (concat "\\(" "@[-0-9I$]+" "\\|" "[a-zA-Z]\\{1,2\\}\\([0-9]+\\|&\\)" "\\)") "Match a reference that needs translation, for reference display.") @@ -503,7 +553,7 @@ nil When nil, the command tries to be smart and figure out the - when each line contains a TAB, assume TAB-separated material - when each line contains a comma, assume CSV material - else, assume one or more SPACE characters as separator." - (interactive "rP") + (interactive "r\nP") (let* ((beg (min beg0 end0)) (end (max beg0 end0)) re) @@ -539,7 +589,7 @@ nil When nil, the command tries to be smart and figure out the ((equal separator '(16)) "^\\|\t") ((integerp separator) (if (< separator 1) - (error "Number of spaces in separator must be >= 1") + (user-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) @@ -579,9 +629,7 @@ whether it is set locally or up in the hierarchy, then on the extension of the given file name, and finally on the variable `org-table-export-default-format'." (interactive) - (unless (org-at-table-p) - (error "No table at point")) - (require 'org-exp) + (unless (org-at-table-p) (user-error "No table at point")) (org-table-align) ;; make sure we have everything we need (let* ((beg (org-table-begin)) (end (org-table-end)) @@ -598,13 +646,13 @@ extension of the given file name, and finally on the variable (setq file (read-file-name "Export table to: ")) (unless (or (not (file-exists-p file)) (y-or-n-p (format "Overwrite file %s? " file))) - (error "Abort"))) + (user-error "File not written"))) (if (file-directory-p file) - (error "This is a directory path, not a file")) + (user-error "This is a directory path, not a file")) (if (and (buffer-file-name) (equal (file-truename file) (file-truename (buffer-file-name)))) - (error "Please specify a file name that is different from current")) + (user-error "Please specify a file name that is different from current")) (setq fileext (concat (file-name-extension file) "$")) (unless format (setq deffmt-readable @@ -641,7 +689,7 @@ extension of the given file name, and finally on the variable skipcols i0))) (unless (fboundp transform) - (error "No such transformation function %s" transform)) + (user-error "No such transformation function %s" transform)) (setq txt (funcall transform table params)) (with-current-buffer (find-file-noselect file) @@ -652,7 +700,7 @@ extension of the given file name, and finally on the variable (save-buffer)) (kill-buffer buf) (message "Export done.")) - (error "TABLE_EXPORT_FORMAT invalid")))) + (user-error "TABLE_EXPORT_FORMAT invalid")))) (defvar org-table-aligned-begin-marker (make-marker) "Marker at the beginning of the table last aligned. @@ -760,7 +808,7 @@ When nil, simply write \"#ERROR\" in corrupted fields.") (error (kill-region beg end) (org-table-create org-table-default-size) - (error "Empty table - created default table"))) + (user-error "Empty table - created default table"))) ;; A list of empty strings to fill any short rows on output (setq emptystrings (make-list maxfields "")) ;; Check for special formatting. @@ -787,7 +835,7 @@ When nil, simply write \"#ERROR\" in corrupted fields.") (concat "Clipped table field, use C-c ` to edit. Full value is:\n" (org-no-properties (copy-sequence xx)))) (setq f1 (min fmax (or (string-match org-bracket-link-regexp xx) fmax))) (unless (> f1 1) - (error "Cannot narrow field starting with wide link \"%s\"" + (user-error "Cannot narrow field starting with wide link \"%s\"" (match-string 0 xx))) (add-text-properties f1 (length xx) (list 'org-cwidth t) xx) (add-text-properties (- f1 2) f1 @@ -860,7 +908,8 @@ When nil, simply write \"#ERROR\" in corrupted fields.") (org-goto-line winstartline) (setq winstart (point-at-bol)) (org-goto-line linepos) - (set-window-start (selected-window) winstart 'noforce) + (when (eq (window-buffer (selected-window)) (current-buffer)) + (set-window-start (selected-window) winstart 'noforce)) (org-table-goto-column colpos) (and org-table-overlay-coordinates (org-table-overlay-coordinates)) (setq org-table-may-need-update nil) @@ -978,7 +1027,7 @@ Before doing so, re-align the table if necessary." (progn (re-search-backward "|" (org-table-begin)) (re-search-backward "|" (org-table-begin))) - (error (error "Cannot move to previous table field"))) + (error (user-error "Cannot move to previous table field"))) (while (looking-at "|\\(-\\|[ \t]*$\\)") (re-search-backward "|" (org-table-begin))) (if (looking-at "| ?") @@ -994,7 +1043,7 @@ With numeric argument N, move N-1 fields forward first." (setq n (1- n)) (org-table-previous-field)) (if (not (re-search-backward "|" (point-at-bol 0) t)) - (error "No more table fields before the current") + (user-error "No more table fields before the current") (goto-char (match-end 0)) (and (looking-at " ") (forward-char 1))) (if (>= (point) pos) (org-table-beginning-of-field 2)))) @@ -1055,7 +1104,7 @@ copying. In the case of a timestamp, increment by one day." (interactive "p") (let* ((colpos (org-table-current-column)) (col (current-column)) - (field (org-table-get-field)) + (field (save-excursion (org-table-get-field))) (non-empty (string-match "[^ \t]" field)) (beg (org-table-begin)) (orig-n n) @@ -1091,7 +1140,7 @@ copying. In the case of a timestamp, increment by one day." (org-table-maybe-recalculate-line)) (org-table-align) (org-move-to-column col)) - (error "No non-empty field found")))) + (user-error "No non-empty field found")))) (defun org-table-check-inside-data-field (&optional noerror) "Is point inside a table data field? @@ -1103,7 +1152,7 @@ This actually throws an error, so it aborts the current command." (looking-at "[ \t]*$")) (if noerror nil - (error "Not in table data field")) + (user-error "Not in table data field")) t)) (defvar org-table-clip nil @@ -1286,7 +1335,7 @@ However, when FORCE is non-nil, create new columns if necessary." "Insert a new column into the table." (interactive) (if (not (org-at-table-p)) - (error "Not at a table")) + (user-error "Not at a table")) (org-table-find-dataline) (let* ((col (max 1 (org-table-current-column))) (beg (org-table-begin)) @@ -1326,7 +1375,7 @@ However, when FORCE is non-nil, create new columns if necessary." (if (and (org-at-table-p) (not (org-at-table-hline-p))) t - (error + (user-error "Please position cursor in a data line for column operations"))))) (defun org-table-line-to-dline (line &optional above) @@ -1356,7 +1405,7 @@ first dline below it is used. When ABOVE is non-nil, the one above is used." "Delete a column from the table." (interactive) (if (not (org-at-table-p)) - (error "Not at a table")) + (user-error "Not at a table")) (org-table-find-dataline) (org-table-check-inside-data-field) (let* ((col (org-table-current-column)) @@ -1400,7 +1449,7 @@ first dline below it is used. When ABOVE is non-nil, the one above is used." "Move the current column to the right. With arg LEFT, move to the left." (interactive "P") (if (not (org-at-table-p)) - (error "Not at a table")) + (user-error "Not at a table")) (org-table-find-dataline) (org-table-check-inside-data-field) (let* ((col (org-table-current-column)) @@ -1411,9 +1460,9 @@ first dline below it is used. When ABOVE is non-nil, the one above is used." (linepos (org-current-line)) (colpos (if left (1- col) (1+ col)))) (if (and left (= col 1)) - (error "Cannot move column further left")) + (user-error "Cannot move column further left")) (if (and (not left) (looking-at "[^|\n]*|[^|\n]*$")) - (error "Cannot move column further right")) + (user-error "Cannot move column further right")) (goto-char beg) (while (< (point) end) (if (org-at-table-hline-p) @@ -1461,7 +1510,7 @@ first dline below it is used. When ABOVE is non-nil, the one above is used." (beginning-of-line tonew) (unless (org-at-table-p) (goto-char pos) - (error "Cannot move row further")) + (user-error "Cannot move row further")) (setq hline2p (looking-at org-table-hline-regexp)) (goto-char pos) (beginning-of-line 1) @@ -1486,7 +1535,7 @@ first dline below it is used. When ABOVE is non-nil, the one above is used." With prefix ARG, insert below the current line." (interactive "P") (if (not (org-at-table-p)) - (error "Not at a table")) + (user-error "Not at a table")) (let* ((line (buffer-substring (point-at-bol) (point-at-eol))) (new (org-table-clean-line line))) ;; Fix the first field if necessary @@ -1508,7 +1557,7 @@ With prefix ARG, insert below the current line." With prefix ABOVE, insert above the current line." (interactive "P") (if (not (org-at-table-p)) - (error "Not at a table")) + (user-error "Not at a table")) (when (eobp) (insert "\n") (backward-char 1)) (if (not (string-match "|[ \t]*$" (org-current-line-string))) (org-table-align)) @@ -1558,7 +1607,7 @@ In particular, this does handle wide and invisible characters." "Delete the current row or horizontal line from the table." (interactive) (if (not (org-at-table-p)) - (error "Not at a table")) + (user-error "Not at a table")) (let ((col (current-column)) (dline (org-table-current-dline))) (kill-region (point-at-bol) (min (1+ (point-at-eol)) (point-max))) @@ -1710,7 +1759,7 @@ the table is enlarged as needed. The process ignores horizontal separator lines." (interactive) (unless (and org-table-clip (listp org-table-clip)) - (error "First cut/copy a region to paste!")) + (user-error "First cut/copy a region to paste!")) (org-table-check-inside-data-field) (let* ((clip org-table-clip) (line (org-current-line)) @@ -1796,11 +1845,16 @@ will be transposed as 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)))))) + (let* ((table (delete 'hline (org-table-to-lisp))) + (contents (mapcar (lambda (p) + (let ((tp table)) + (mapcar + (lambda (rown) + (prog1 + (pop (car tp)) + (setq tp (cdr tp)))) + table))) + (car table)))) (delete-region (org-table-begin) (org-table-end)) (insert (mapconcat (lambda(x) (concat "| " (mapconcat 'identity x " | " ) " |\n" )) contents "")) @@ -1839,7 +1893,7 @@ blank, and the content is appended to the field above." nlines) (org-table-cut-region (region-beginning) (region-end)) (if (> (length (car org-table-clip)) 1) - (error "Region must be limited to single column")) + (user-error "Region must be limited to single column")) (setq nlines (if arg (if (< arg 1) (+ (length org-table-clip) arg) @@ -2008,12 +2062,12 @@ If NLAST is a number, only the NLAST fields will actually be summed." (setq col (org-table-current-column)) (goto-char (org-table-begin)) (unless (re-search-forward "^[ \t]*|[^-]" nil t) - (error "No table data")) + (user-error "No table data")) (org-table-goto-column col) (setq beg (point)) (goto-char (org-table-end)) (unless (re-search-backward "^[ \t]*|[^-]" nil t) - (error "No table data")) + (user-error "No table data")) (org-table-goto-column col) (setq end (point)))) (let* ((items (apply 'append (org-table-copy-region beg end))) @@ -2031,7 +2085,7 @@ If NLAST is a number, only the NLAST fields will actually be summed." h (floor (/ diff 3600)) diff (mod diff 3600) m (floor (/ diff 60)) diff (mod diff 60) s diff) - (format "%d:%02d:%02d" h m s)))) + (format "%.0f:%02.0f:%02.0f" h m s)))) (kill-new sres) (if (org-called-interactively-p 'interactive) (message "%s" @@ -2098,7 +2152,7 @@ When NAMED is non-nil, look for a named equation." (int-to-string (org-table-current-column)))) (dummy (and (or nameass refass) (not named) (not (y-or-n-p "Replace existing field formula with column formula? " )) - (error "Abort"))) + (message "Formula not replaced"))) (name (or name ref)) (org-table-may-need-update nil) (stored (cdr (assoc scol stored-list))) @@ -2122,7 +2176,7 @@ When NAMED is non-nil, look for a named equation." ;; remove formula (setq stored-list (delq (assoc scol stored-list) stored-list)) (org-table-store-formulas stored-list) - (error "Formula removed")) + (user-error "Formula removed")) (if (string-match "^ *=?" eq) (setq eq (replace-match "" t t eq))) (if (string-match " *$" eq) (setq eq (replace-match "" t t eq))) (if (and name (not named)) @@ -2207,7 +2261,7 @@ When NAMED is non-nil, look for a named equation." (message "Double definition `$%s=' in TBLFM line, please fix by hand" scol) (ding) (sit-for 2)) - (error "Double definition `$%s=' in TBLFM line, please fix by hand" scol)) + (user-error "Double definition `$%s=' in TBLFM line, please fix by hand" scol)) (push scol seen)))))) (nreverse eq-alist))) @@ -2231,7 +2285,7 @@ For all numbers larger than LIMIT, shift them by DELTA." (while (re-search-forward re2 (point-at-eol) t) (unless (save-match-data (org-in-regexp "remote([^)]+?)")) (if (equal (char-before (match-beginning 0)) ?.) - (error "Change makes TBLFM term %s invalid, use undo to recover" + (user-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) @@ -2338,7 +2392,7 @@ If yes, store the formula and apply it." (equal (substring eq 0 (min 2 (length eq))) "'(")) (org-table-eval-formula (if named '(4) nil) (org-table-formula-from-user eq)) - (error "Calc does not seem to be installed, and is needed to evaluate the formula")))))) + (user-error "Calc does not seem to be installed, and is needed to evaluate the formula")))))) (defvar org-recalc-commands nil "List of commands triggering the recalculation of a line. @@ -2363,7 +2417,7 @@ after prompting for the marking character. After each change, a message will be displayed indicating the meaning of the new mark." (interactive) - (unless (org-at-table-p) (error "Not at a table")) + (unless (org-at-table-p) (user-error "Not at a table")) (let* ((marks (append (mapcar 'car org-recalc-marks) '(" "))) (beg (org-table-begin)) (end (org-table-end)) @@ -2382,13 +2436,13 @@ of the new mark." (setq newchar (char-to-string (read-char-exclusive)) forcenew (car (assoc newchar org-recalc-marks)))) (if (and newchar (not forcenew)) - (error "Invalid NEWCHAR `%s' in `org-table-rotate-recalc-marks'" + (user-error "Invalid NEWCHAR `%s' in `org-table-rotate-recalc-marks'" newchar)) (if l1 (org-goto-line l1)) (save-excursion (beginning-of-line 1) (unless (looking-at org-table-dataline-regexp) - (error "Not at a table data line"))) + (user-error "Not at a table data line"))) (unless have-col (org-table-goto-column 1) (org-table-insert-column) @@ -2483,7 +2537,7 @@ not overwrite the stored one." (or suppress-analysis (org-table-get-specials)) (if (equal arg '(16)) (let ((eq (org-table-current-field-formula))) - (or eq (error "No equation active for current field")) + (or eq (user-error "No equation active for current field")) (org-table-get-field nil eq) (org-table-align) (setq org-table-may-need-update t)) @@ -2557,7 +2611,10 @@ not overwrite the stored one." fields))) (if (eq numbers t) (setq fields (mapcar - (lambda (x) (number-to-string (string-to-number x))) + (lambda (x) + (if (string-match "\\S-" x) + (number-to-string (string-to-number x)) + x)) fields))) (setq ndown (1- ndown)) (setq form (copy-sequence formula) @@ -2612,7 +2669,7 @@ not overwrite the stored one." (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))) + (user-error "Spreadsheet error: invalid reference \"%s\"" form))) ;; Insert simple ranges (while (string-match "\\$\\([0-9]+\\)\\.\\.\\$\\([0-9]+\\)" form) (setq form @@ -2630,11 +2687,12 @@ not overwrite the stored one." (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\"" + (unless x (user-error "Invalid field specifier \"%s\"" (match-string 0 form))) (setq form (replace-match (save-match-data - (org-table-make-reference x nil numbers lispp)) + (org-table-make-reference + x keep-empty numbers lispp)) t t form))) (if lispp @@ -2646,12 +2704,23 @@ not overwrite the stored one." (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")) - ;; "Inactivate" time-stamps so that Calc can handle them + (user-error "Calc does not seem to be installed, and is needed to evaluate the formula")) + ;; Use <...> time-stamps so that Calc can handle them (setq form (replace-regexp-in-string org-ts-regexp3 "<\\1>" form)) + ;; I18n-ize local time-stamps by setting (system-time-locale "C") + (when (string-match org-ts-regexp2 form) + (let* ((ts (match-string 0 form)) + (tsp (apply 'encode-time (save-match-data (org-parse-time-string ts)))) + (system-time-locale "C") + (tf (or (and (save-match-data (string-match "[0-9]\\{1,2\\}:[0-9]\\{2\\}" ts)) + (cdr org-time-stamp-formats)) + (car org-time-stamp-formats)))) + (setq form (replace-match (format-time-string tf tsp) t t form)))) + (setq ev (if (and duration (string-match "^[0-9]+:[0-9]+\\(?::[0-9]+\\)?$" form)) form - (calc-eval (cons form org-tbl-calc-modes) (if numbers 'num))) + (calc-eval (cons form org-tbl-calc-modes) + (when (and (not keep-empty) numbers) 'num))) ev (if duration (org-table-time-seconds-to-string (if (string-match "^[0-9]+:[0-9]+\\(?::[0-9]+\\)?$" ev) (string-to-number (org-table-time-string-to-seconds ev)) @@ -2667,7 +2736,7 @@ $xyz-> %s @r$c-> %s $1-> %s\n" orig formula form0 form)) (if (listp ev) - (princ (format " %s^\nError: %s" + (princ (format " %s^\nError: %s" (make-string (car ev) ?\-) (nth 1 ev))) (princ (format "Result: %s\nFormat: %s\nFinal: %s" ev (or fmt "NONE") @@ -2678,7 +2747,7 @@ $1-> %s\n" orig formula form0 form)) (unless (let (inhibit-redisplay) (y-or-n-p "Debugging Formula. Continue to next? ")) (org-table-align) - (error "Abort")) + (user-error "Abort")) (delete-window bw) (message ""))) (if (listp ev) (setq fmt nil ev "#ERROR")) @@ -2716,7 +2785,7 @@ in the buffer and column1 and column2 are table column numbers." (let ((thisline (org-current-line)) beg end c1 c2 r1 r2 rangep tmp) (unless (string-match org-table-range-regexp desc) - (error "Invalid table range specifier `%s'" desc)) + (user-error "Invalid table range specifier `%s'" desc)) (setq rangep (match-end 3) r1 (and (match-end 1) (match-string 1 desc)) r2 (and (match-end 4) (match-string 4 desc)) @@ -2784,7 +2853,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)) + (user-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))) @@ -2798,7 +2867,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) + (user-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))) @@ -2818,41 +2887,56 @@ and TABLE is a vector with line types." (cond ((eq org-table-relative-ref-may-cross-hline t) t) ((eq org-table-relative-ref-may-cross-hline 'error) - (error "Row descriptor %s used in line %d crosses hline" desc cline)) + (user-error "Row descriptor %s used in line %d crosses hline" desc cline)) (t (setq i (- i (if backwards -1 1)) n 1) nil)) t))) (setq n (1- n))) (if (or (< i 0) (>= i l)) - (error "Row descriptor %s used in line %d leads outside table" + (user-error "Row descriptor %s used in line %d leads outside table" desc cline) i))) (defun org-table-rewrite-old-row-references (s) (if (string-match "&[-+0-9I]" s) - (error "Formula contains old &row reference, please rewrite using @-syntax") + (user-error "Formula contains old &row reference, please rewrite using @-syntax") s)) (defun org-table-make-reference (elements keep-empty numbers lispp) "Convert list ELEMENTS to something appropriate to insert into formula. KEEP-EMPTY indicated to keep empty fields, default is to skip them. NUMBERS indicates that everything should be converted to numbers. -LISPP means to return something appropriate for a Lisp list." - (if (stringp elements) ; just a single val +LISPP non-nil means to return something appropriate for a Lisp +list, 'literal is for the format specifier L." + ;; Calc nan (not a number) is used for the conversion of the empty + ;; field to a reference for several reasons: (i) It is accepted in a + ;; Calc formula (e. g. "" or "()" would result in a Calc error). + ;; (ii) In a single field (not in range) it can be distinguished + ;; from "(nan)" which is the reference made from a single field + ;; containing "nan". + (if (stringp elements) + ;; field reference (if lispp (if (eq lispp 'literal) elements - (prin1-to-string (if numbers (string-to-number elements) elements))) - (if (equal elements "") (setq elements "0")) - (if numbers (setq elements (number-to-string (string-to-number elements)))) - (concat "(" elements ")")) + (if (and (eq elements "") (not keep-empty)) + "" + (prin1-to-string + (if numbers (string-to-number elements) elements)))) + (if (string-match "\\S-" elements) + (progn + (when numbers (setq elements (number-to-string + (string-to-number elements)))) + (concat "(" elements ")")) + (if (or (not keep-empty) numbers) "(0)" "nan"))) + ;; range reference (unless keep-empty (setq elements (delq nil (mapcar (lambda (x) (if (string-match "\\S-" x) x nil)) elements)))) - (setq elements (or elements '("0"))) + (setq elements (or elements '())) ; if delq returns nil then we need '() (if lispp (mapconcat (lambda (x) @@ -2862,11 +2946,33 @@ LISPP means to return something appropriate for a Lisp list." elements " ") (concat "[" (mapconcat (lambda (x) - (if numbers (number-to-string (string-to-number x)) x)) + (if (string-match "\\S-" x) + (if numbers + (number-to-string (string-to-number x)) + x) + (if (or (not keep-empty) numbers) "0" "nan"))) elements ",") "]")))) ;;;###autoload +(defun org-table-set-constants () + "Set `org-table-formula-constants-local' in the current buffer." + (let (cst consts const-str) + (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)) + (when (string-match "^\\([a-zA-Z0][_a-zA-Z0-9]*\\)=\\(.*\\)" e) + (if (assoc-string (match-string 1 e) cst) + (setq cst (delete (assoc-string (match-string 1 e) cst) cst))) + (push (cons (match-string 1 e) (match-string 2 e)) cst))) + (setq org-table-formula-constants-local cst))))))) + +;;;###autoload (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. @@ -2879,7 +2985,7 @@ known that the table will be realigned a little later anyway." (interactive "P") (or (memq this-command org-recalc-commands) (setq org-recalc-commands (cons this-command org-recalc-commands))) - (unless (org-at-table-p) (error "Not at a table")) + (unless (org-at-table-p) (user-error "Not at a table")) (if (or (eq all 'iterate) (equal all '(16))) (org-table-iterate) (org-table-get-specials) @@ -2902,7 +3008,7 @@ known that the table will be realigned a little later anyway." (car x)) 1) (cdr x))) (if (assoc (car x) eqlist1) - (error "\"%s=\" formula tries to overwrite existing formula for column %s" + (user-error "\"%s=\" formula tries to overwrite existing formula for column %s" lhs1 (car x)))) (cons (org-table-formula-handle-first/last-rc (car x)) @@ -2947,7 +3053,7 @@ known that the table will be realigned a little later anyway." (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)) + (user-error "Several field/range formulas try to set %s" name1)) (push name1 seen-fields) (and (not a) @@ -2956,7 +3062,7 @@ known that the table will be realigned a little later anyway." (condition-case nil (aref org-table-dlines (string-to-number (match-string 1 name))) - (error (error "Invalid row number in %s" + (error (user-error "Invalid row number in %s" name))) (string-to-number (match-string 2 name))))) (when (and a (or all (equal (nth 1 a) thisline))) @@ -3026,7 +3132,7 @@ with the prefix ARG." (message "Convergence after %d iterations" i) (message "Table was already stable")) (throw 'exit t))) - (error "No convergence after %d iterations" i)))) + (user-error "No convergence after %d iterations" i)))) ;;;###autoload (defun org-table-recalculate-buffer-tables () @@ -3057,7 +3163,40 @@ with the prefix ARG." (message "Convergence after %d iterations" (- imax i)) (throw 'exit t)) (setq checksum c1))) - (error "No convergence after %d iterations" imax)))))) + (user-error "No convergence after %d iterations" imax)))))) + +(defun org-table-calc-current-TBLFM (&optional arg) + "Apply the #+TBLFM in the line at point to the table." + (interactive "P") + (unless (org-at-TBLFM-p) (user-error "Not at a #+TBLFM line")) + (let ((formula (buffer-substring + (point-at-bol) + (point-at-eol))) + s e) + (save-excursion + ;; Insert a temporary formula at right after the table + (goto-char (org-table-TBLFM-begin)) + (setq s (set-marker (make-marker) (point))) + (insert (concat formula "\n")) + (setq e (set-marker (make-marker) (point))) + ;; Recalculate the table + (beginning-of-line 0) ; move to the inserted line + (skip-chars-backward " \r\n\t") + (if (org-at-table-p) + (unwind-protect + (org-call-with-arg 'org-table-recalculate (or arg t)) + ;; delete the formula inserted temporarily + (delete-region s e)))))) + +(defun org-table-TBLFM-begin () + "Find the beginning of the TBLFM lines and return its position. +Return nil when the beginning of TBLFM line was not found." + (save-excursion + (when (progn (forward-line 1) + (re-search-backward + org-table-TBLFM-begin-regexp + nil t)) + (point-at-bol 2)))) (defun org-table-expand-lhs-ranges (equations) "Expand list of formulas. @@ -3115,7 +3254,7 @@ borders of the table using the @< @> $< $> makers." len (- nmax len -1))) (if (or (< n 1) (> n nmax)) - (error "Reference \"%s\" in expression \"%s\" points outside table" + (user-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))))) @@ -3214,7 +3353,7 @@ Parameters get priority." (interactive) (when (save-excursion (beginning-of-line 1) (let ((case-fold-search t)) (looking-at "[ \t]*#\\+TBLFM"))) (beginning-of-line 0)) - (unless (org-at-table-p) (error "Not at a table")) + (unless (org-at-table-p) (user-error "Not at a table")) (org-table-get-specials) (let ((key (org-table-current-field-formula 'key 'noerror)) (eql (sort (org-table-get-stored-formulas 'noerror) @@ -3436,7 +3575,7 @@ minutes or seconds." ((org-at-regexp-p "\\(\\<[a-zA-Z]\\)&") (if (memq dir '(left right)) (org-rematch-and-replace 1 (eq dir 'left)) - (error "Cannot shift reference in this direction"))) + (user-error "Cannot shift reference in this direction"))) ((org-at-regexp-p "\\(\\<[a-zA-Z]\\{1,2\\}\\)\\([0-9]+\\)") ;; A B3-like reference (if (memq dir '(up down)) @@ -3451,7 +3590,7 @@ minutes or seconds." (defun org-rematch-and-replace (n &optional decr hline) "Re-match the group N, and replace it with the shifted reference." - (or (match-end n) (error "Cannot shift reference in this direction")) + (or (match-end n) (user-error "Cannot shift reference in this direction")) (goto-char (match-beginning n)) (and (looking-at (regexp-quote (match-string n))) (replace-match (org-table-shift-refpart (match-string 0) decr hline) @@ -3487,7 +3626,7 @@ a translation reference." (org-number-to-letters (max 1 (+ (org-letters-to-number ref) (if decr -1 1))))) - (t (error "Cannot shift reference")))))) + (t (user-error "Cannot shift reference")))))) (defun org-table-fedit-toggle-coordinates () "Toggle the display of coordinates in the referenced table." @@ -3519,14 +3658,14 @@ With prefix ARG, apply the new formulas to the table." (while (string-match "[ \t]*\n[ \t]*" form) (setq form (replace-match " " t t form))) (when (assoc var eql) - (error "Double formulas for %s" var)) + (user-error "Double formulas for %s" var)) (push (cons var form) eql))) (setq org-pos nil) (set-window-configuration org-window-configuration) (select-window sel-win) (goto-char pos) (unless (org-at-table-p) - (error "Lost table position - cannot install formulas")) + (user-error "Lost table position - cannot install formulas")) (org-table-store-formulas eql) (move-marker pos nil) (kill-buffer "*Edit Formulas*") @@ -3556,14 +3695,14 @@ With prefix ARG, apply the new formulas to the table." (call-interactively 'lisp-indent-line)) ((looking-at "[$&@0-9a-zA-Z]+ *= *[^ \t\n']") (goto-char pos)) ((not (fboundp 'pp-buffer)) - (error "Cannot pretty-print. Command `pp-buffer' is not available")) + (user-error "Cannot pretty-print. Command `pp-buffer' is not available")) ((looking-at "[$&@0-9a-zA-Z]+ *= *'(") (goto-char (- (match-end 0) 2)) (setq beg (point)) (setq ind (make-string (current-column) ?\ )) (condition-case nil (forward-sexp 1) (error - (error "Cannot pretty-print Lisp expression: Unbalanced parenthesis"))) + (user-error "Cannot pretty-print Lisp expression: Unbalanced parenthesis"))) (setq end (point)) (save-restriction (narrow-to-region beg end) @@ -3615,7 +3754,7 @@ With prefix ARG, apply the new formulas to the table." ((org-at-regexp-p "\\$[a-zA-Z][a-zA-Z0-9]*") 'name) ((org-at-regexp-p "\\$[0-9]+") 'column) ((not local) nil) - (t (error "No reference at point"))) + (t (user-error "No reference at point"))) match (and what (or match (match-string 0)))) (when (and match (not (equal (match-beginning 0) (point-at-bol)))) (org-table-add-rectangle-overlay (match-beginning 0) (match-end 0) @@ -3682,7 +3821,7 @@ With prefix ARG, apply the new formulas to the table." (goto-char (match-beginning 1)) (org-table-highlight-rectangle) (message "Named column (column %s)" (cdr e))) - (error "Column name not found"))) + (user-error "Column name not found"))) ((eq what 'column) ;; column number (org-table-goto-column (string-to-number (substring match 1))) @@ -3695,10 +3834,10 @@ With prefix ARG, apply the new formulas to the table." (goto-char (match-beginning 1)) (org-table-highlight-rectangle) (message "Local parameter.")) - (error "Parameter not found"))) + (user-error "Parameter not found"))) (t (cond - ((not var) (error "No reference at point")) + ((not var) (user-error "No reference at point")) ((setq e (assoc var org-table-formula-constants-local)) (message "Local Constant: $%s=%s in #+CONSTANTS line." var (cdr e))) @@ -3708,7 +3847,7 @@ With prefix ARG, apply the new formulas to the table." ((setq e (and (fboundp 'constants-get) (constants-get var))) (message "Constant: $%s=%s, from `constants.el'%s." var e (format " (%s units)" constants-unit-system))) - (t (error "Undefined name $%s" var))))) + (t (user-error "Undefined name $%s" var))))) (goto-char pos) (when (and org-show-positions (not (memq this-command '(org-table-fedit-scroll @@ -3734,7 +3873,7 @@ With prefix ARG, apply the new formulas to the table." (goto-char (if (< (abs (- p1 (point))) (abs (- p2 (point)))) p1 p2))) ((or p1 p2) (goto-char (or p1 p2))) - (t (error "No table dataline around here")))))) + (t (user-error "No table dataline around here")))))) (defun org-table-fedit-line-up () "Move cursor one line up in the window showing the table." @@ -3999,7 +4138,7 @@ to execute outside of tables." (defun orgtbl-error () "Error when there is no default binding for a table key." (interactive) - (error "This key has no function outside tables")) + (user-error "This key has no function outside tables")) (defun orgtbl-setup () "Setup orgtbl keymaps." @@ -4151,7 +4290,7 @@ 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 ((case-fold-search t) (pos (point)) action consts-str consts cst const-str) + (let ((case-fold-search t) (pos (point)) action) (save-excursion (beginning-of-line 1) (setq action (cond @@ -4169,17 +4308,7 @@ With prefix arg, also recompute table." (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))))) + (org-table-set-constants) (save-excursion (beginning-of-line 1) (skip-chars-backward " \r\n\t") @@ -4264,31 +4393,6 @@ overwritten, and the table is not marked as requiring realignment." (defvar orgtbl-exp-regexp "^\\([-+]?[0-9][0-9.]*\\)[eE]\\([-+]?[0-9]+\\)$" "Regular expression matching exponentials as produced by calc.") -(defun orgtbl-export (table target) - (require 'org-exp) - (let ((func (intern (concat "orgtbl-to-" (symbol-name target)))) - (lines (org-split-string table "[ \t]*\n[ \t]*")) - org-table-last-alignment org-table-last-column-widths - maxcol column) - (if (not (fboundp func)) - (error "Cannot export orgtbl table to %s" target)) - (setq lines (org-table-clean-before-export lines)) - (setq table - (mapcar - (lambda (x) - (if (string-match org-table-hline-regexp x) - 'hline - (org-split-string (org-trim x) "\\s-*|\\s-*"))) - lines)) - (setq maxcol (apply 'max (mapcar (lambda (x) (if (listp x) (length x) 0)) - table))) - (loop for i from (1- maxcol) downto 0 do - (setq column (mapcar (lambda (x) (if (listp x) (nth i x) nil)) table)) - (setq column (delq nil column)) - (push (apply 'max (mapcar 'string-width column)) org-table-last-column-widths) - (push (> (/ (apply '+ (mapcar (lambda (x) (if (string-match org-table-number-regexp x) 1 0)) column)) maxcol) org-table-number-fraction) org-table-last-alignment)) - (funcall func table nil))) - (defun orgtbl-gather-send-defs () "Gather a plist of :name, :transform, :params for each destination before a radio table." @@ -4311,15 +4415,15 @@ a radio table." (save-excursion (goto-char (point-min)) (unless (re-search-forward - (concat "BEGIN RECEIVE ORGTBL +" name "\\([ \t]\\|$\\)") nil t) - (error "Don't know where to insert translated table")) + (concat "BEGIN +RECEIVE +ORGTBL +" name "\\([ \t]\\|$\\)") nil t) + (user-error "Don't know where to insert translated table")) (goto-char (match-beginning 0)) (beginning-of-line 2) (save-excursion (let ((beg (point))) (unless (re-search-forward - (concat "END RECEIVE ORGTBL +" name) nil t) - (error "Cannot find end of insertion region")) + (concat "END +RECEIVE +ORGTBL +" name) nil t) + (user-error "Cannot find end of insertion region")) (beginning-of-line 1) (delete-region beg (point)))) (insert txt "\n"))) @@ -4332,7 +4436,7 @@ for a horizontal separator line, or a list of field values as strings. The table is taken from the parameter TXT, or from the buffer at point." (unless txt (unless (org-at-table-p) - (error "No table at point"))) + (user-error "No table at point"))) (let* ((txt (or txt (buffer-substring-no-properties (org-table-begin) (org-table-end)))) @@ -4351,7 +4455,7 @@ With argument MAYBE, fail quietly if no transformation is defined for this table." (interactive) (catch 'exit - (unless (org-at-table-p) (error "Not at a table")) + (unless (org-at-table-p) (user-error "Not at a table")) ;; when non-interactive, we assume align has just happened. (when (org-called-interactively-p 'any) (org-table-align)) (let ((dests (orgtbl-gather-send-defs)) @@ -4359,7 +4463,7 @@ this table." (org-table-end))) (ntbl 0)) (unless dests (if maybe (throw 'exit nil) - (error "Don't know how to transform this table"))) + (user-error "Don't know how to transform this table"))) (dolist (dest dests) (let* ((name (plist-get dest :name)) (transform (plist-get dest :transform)) @@ -4392,7 +4496,7 @@ this table." skipcols i0)) (txt (if (fboundp transform) (funcall transform table params) - (error "No such transformation function %s" transform)))) + (user-error "No such transformation function %s" transform)))) (orgtbl-send-replace-tbl name txt)) (setq ntbl (1+ ntbl))) (message "Table converted and installed at %d receiver location%s" @@ -4422,7 +4526,7 @@ First element has index 0, or I0 if given." (commented (save-excursion (beginning-of-line 1) (cond ((looking-at re1) t) ((looking-at re2) nil) - (t (error "Not at an org table"))))) + (t (user-error "Not at an org table"))))) (re (if commented re1 re2)) beg end) (save-excursion @@ -4440,7 +4544,7 @@ First element has index 0, or I0 if given." (let* ((e (assq major-mode orgtbl-radio-table-templates)) (txt (nth 1 e)) name pos) - (unless e (error "No radio table setup defined for %s" major-mode)) + (unless e (user-error "No radio table setup defined for %s" major-mode)) (setq name (read-string "Table name: ")) (while (string-match "%n" txt) (setq txt (replace-match name t t txt))) @@ -4474,7 +4578,8 @@ First element has index 0, or I0 if given." fmt)) (defsubst orgtbl-apply-fmt (fmt &rest args) - "Apply format FMT to the arguments. NIL FMTs return the first argument." + "Apply format FMT to arguments ARGS. +When FMT is nil, return the first argument from ARGS." (cond ((functionp fmt) (apply fmt args)) (fmt (apply 'format fmt args)) (args (car args)) @@ -4504,7 +4609,7 @@ First element has index 0, or I0 if given." f))) line))) (push (if *orgtbl-lfmt* - (orgtbl-apply-fmt *orgtbl-lfmt* line) + (apply #'orgtbl-apply-fmt *orgtbl-lfmt* line) (concat (orgtbl-eval-str *orgtbl-lstart*) (mapconcat 'identity line *orgtbl-sep*) (orgtbl-eval-str *orgtbl-lend*))) @@ -4523,12 +4628,15 @@ First element has index 0, or I0 if given." (orgtbl-format-line prevline)))))) ;;;###autoload -(defun orgtbl-to-generic (table params) +(defun orgtbl-to-generic (table params &optional backend) "Convert the orgtbl-mode TABLE to some other format. 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. +A third optional argument BACKEND can be used to convert the content of +the cells using a specific export back-end. + For the generic converter, some parameters are obligatory: you need to specify either :lfmt, or all of (:lstart :lend :sep). @@ -4599,22 +4707,31 @@ directly by `orgtbl-send-table'. See manual." (*orgtbl-llfmt* (or (plist-get params :llfmt) *orgtbl-lfmt*)) (*orgtbl-fmt* (plist-get params :fmt)) *orgtbl-rtn*) - + ;; Convert cells content to backend BACKEND + (when backend + (setq *orgtbl-table* + (mapcar + (lambda(r) + (if (listp r) + (mapcar + (lambda (c) + (org-trim (org-export-string-as c backend t '(:with-tables t)))) + r) + r)) + *orgtbl-table*))) ;; Put header (unless splicep (when (plist-member params :tstart) (let ((tstart (orgtbl-eval-str (plist-get params :tstart)))) (if tstart (push tstart *orgtbl-rtn*))))) - - ;; Do we have a heading section? If so, format it and handle the - ;; trailing hline. + ;; If we have a heading, format it and handle the trailing hline. (if (and (not splicep) (or (consp (car *orgtbl-table*)) (consp (nth 1 *orgtbl-table*))) (memq 'hline (cdr *orgtbl-table*))) (progn (when (eq 'hline (car *orgtbl-table*)) - ;; there is a hline before the first data line + ;; There is a hline before the first data line (and hline (push hline *orgtbl-rtn*)) (pop *orgtbl-table*)) (let* ((*orgtbl-lstart* (or (plist-get params :hlstart) @@ -4632,15 +4749,12 @@ directly by `orgtbl-send-table'. See manual." (orgtbl-format-section 'hline)) (if (and hline (not skipheadrule)) (push hline *orgtbl-rtn*)) (pop *orgtbl-table*))) - ;; Now format the main section. (orgtbl-format-section nil) - (unless splicep (when (plist-member params :tend) (let ((tend (orgtbl-eval-str (plist-get params :tend)))) (if tend (push tend *orgtbl-rtn*))))) - (mapconcat (if remove-newlines (lambda (tend) (replace-regexp-in-string "[\n\r\t\f]" "\\\\n" tend)) @@ -4698,7 +4812,8 @@ this function is called." :tend "\\end{tabular}" :lstart "" :lend " \\\\" :sep " & " :efmt "%s\\,(%s)" :hline "\\hline"))) - (orgtbl-to-generic table (org-combine-plists params2 params)))) + (require 'ox-latex) + (orgtbl-to-generic table (org-combine-plists params2 params) 'latex))) ;;;###autoload (defun orgtbl-to-html (table params) @@ -4714,22 +4829,14 @@ Currently this function recognizes the following parameters: The general parameters :skip and :skipcols have already been applied when this function is called. The function does *not* use `orgtbl-to-generic', so you cannot specify parameters for it." - (let* ((splicep (plist-get params :splice)) - (html-table-tag org-export-html-table-tag) - html) - ;; Just call the formatter we already have - ;; We need to make text lines for it, so put the fields back together. - (setq html (org-format-org-table-html - (mapcar - (lambda (x) - (if (eq x 'hline) - "|----+----|" - (concat "| " (mapconcat 'org-html-expand x " | ") " |"))) - table) - splicep)) - (if (string-match "\n+\\'" html) - (setq html (replace-match "" t t html))) - html)) + (require 'ox-html) + (let ((output (org-export-string-as + (orgtbl-to-orgtbl table nil) 'html t '(:with-tables t)))) + (if (not (plist-get params :splice)) output + (org-trim + (replace-regexp-in-string + "\\`<table .*>\n" "" + (replace-regexp-in-string "</table>\n*\\'" "" output)))))) ;;;###autoload (defun orgtbl-to-texinfo (table params) @@ -4768,7 +4875,8 @@ this function is called." :tend "@end multitable" :lstart "@item " :lend "" :sep " @tab " :hlstart "@headitem "))) - (orgtbl-to-generic table (org-combine-plists params2 params)))) + (require 'ox-texinfo) + (orgtbl-to-generic table (org-combine-plists params2 params) 'texinfo))) ;;;###autoload (defun orgtbl-to-orgtbl (table params) @@ -4815,22 +4923,22 @@ it here: http://gnuvola.org/software/j/aa2u/ascii-art-to-unicode.el." (unless (delq nil (mapcar (lambda (l) (string-match "aa2u" (car l))) org-stored-links)) (push '("http://gnuvola.org/software/j/aa2u/ascii-art-to-unicode.el" "Link to ascii-art-to-unicode.el") org-stored-links)) - (error "Please download ascii-art-to-unicode.el (use C-c C-l to insert the link to it)")) + (user-error "Please download ascii-art-to-unicode.el (use C-c C-l to insert the link to it)")) (buffer-string))) (defun org-table-get-remote-range (name-or-id form) "Get a field value or a list of values in a range from table at ID. -NAME-OR-ID may be the name of a table in the current file as set by -a \"#+TBLNAME:\" directive. The first table following this line +NAME-OR-ID may be the name of a table in the current file as set +by a \"#+NAME:\" 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. +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 \"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 ." +list of the fields in the rectangle." (save-match-data (let ((case-fold-search t) (id-loc nil) ;; Protect a bunch of variables from being overwritten @@ -4851,12 +4959,13 @@ list of the fields in the rectangle ." (save-excursion (goto-char (point-min)) (if (re-search-forward - (concat "^[ \t]*#\\+tblname:[ \t]*" (regexp-quote name-or-id) "[ \t]*$") + (concat "^[ \t]*#\\+\\(tbl\\)?name:[ \t]*" + (regexp-quote name-or-id) "[ \t]*$") nil t) (setq buffer (current-buffer) loc (match-beginning 0)) (setq id-loc (org-id-find name-or-id 'marker)) (unless (and id-loc (markerp id-loc)) - (error "Can't find remote table \"%s\"" name-or-id)) + (user-error "Can't find remote table \"%s\"" name-or-id)) (setq buffer (marker-buffer id-loc) loc (marker-position id-loc)) (move-marker id-loc nil))) @@ -4868,7 +4977,7 @@ list of the fields in the rectangle ." (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)) + (user-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 @@ -4879,6 +4988,38 @@ list of the fields in the rectangle ." (org-table-get-range (match-string 0 form) tbeg 1)) form))))))))) +(defmacro org-define-lookup-function (mode) + (let ((mode-str (symbol-name mode)) + (first-p (equal mode 'first)) + (all-p (equal mode 'all))) + (let ((plural-str (if all-p "s" ""))) + `(defun ,(intern (format "org-lookup-%s" mode-str)) (val s-list r-list &optional predicate) + ,(format "Find %s occurrence%s of VAL in S-LIST; return corresponding element%s of R-LIST. +If R-LIST is nil, return matching element%s of S-LIST. +If PREDICATE is not nil, use it instead of `equal' to match VAL. +Matching is done by (PREDICATE VAL S), where S is an element of S-LIST. +This function is generated by a call to the macro `org-define-lookup-function'." + mode-str plural-str plural-str plural-str) + (let ,(let ((lvars '((p (or predicate 'equal)) + (sl s-list) + (rl (or r-list s-list)) + (ret nil)))) + (if first-p (add-to-list 'lvars '(match-p nil))) + lvars) + (while ,(if first-p '(and (not match-p) sl) 'sl) + (progn + (if (funcall p val (car sl)) + (progn + ,(if first-p '(setq match-p t)) + (let ((rval (car rl))) + (setq ret ,(if all-p '(append ret (list rval)) 'rval))))) + (setq sl (cdr sl) rl (cdr rl)))) + ret))))) + +(org-define-lookup-function first) +(org-define-lookup-function last) +(org-define-lookup-function all) + (provide 'org-table) ;; Local variables: |