;;; org-table.el --- The table editor for Org-mode
-;; Copyright (C) 2004-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2004-2015 Free Software Foundation, Inc.
;; Author: Carsten Dominik <carsten at orgmode dot org>
;; Keywords: outlines, hypermedia, calendar, wp
(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)
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
| | |
"))
"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 template. 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
: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.
"^[-+]?\\([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
(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.")
- 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)
((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)
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))
(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
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)
(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.
(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.
(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
(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)
))
+;;;###autoload
(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."
(beginning-of-line 2)
(point))))
+;;;###autoload
(defun org-table-end (&optional table-type)
"Find the end of the table and return its position.
With argument TABLE-TYPE, go to the end of a table.el-type table."
(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 "| ?")
(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))))
(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)
(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?
(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
(< (setq cnt (1+ cnt)) N)))
(= cnt N)))
+;;;###autoload
(defun org-table-blank-field ()
"Blank the current table field or active region."
(interactive)
(defun org-table-field-info (arg)
"Show info about the current field, and highlight any reference at point."
(interactive "P")
+ (unless (org-at-table-p) (user-error "Not at a table"))
(org-table-get-specials)
(save-excursion
(let* ((pos (point))
"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))
(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)
"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))
"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))
(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)
(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)
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
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))
"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)))
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))
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 ""))
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)
(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)))
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"
(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)))
;; 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))
(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)))
For all numbers larger than LIMIT, shift them by DELTA."
(save-excursion
(goto-char (org-table-end))
- (when (let ((case-fold-search t)) (looking-at "[ \t]*#\\+tblfm:"))
+ (while (let ((case-fold-search t)) (looking-at "[ \t]*#\\+tblfm:"))
(let ((msg "The formulas in #+TBLFM have been updated")
(re (concat key "\\([0-9]+\\)"))
(re2
(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"
- (match-string 0))
+ (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)
(unless (save-match-data (org-in-regexp "remote([^)]+?)"))
(message msg))
((and limit (> n limit))
(replace-match (concat key (int-to-string (+ n delta))) t t)
- (message msg)))))))))
+ (message msg))))))
+ (forward-line))))
(defun org-table-get-specials ()
"Get the column names and local parameters for this table."
(string-match "^[a-zA-Z][_a-zA-Z0-9]*$" field))
(push (cons field v) org-table-local-parameters)
(push (list field line col) org-table-named-field-locations))))
- ;; Analyse the line types
+ ;; Analyze the line types.
(goto-char beg)
(setq org-table-current-begin-line (org-current-line)
org-table-current-begin-pos (point)
(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.
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))
(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)
(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))
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)
(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
(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
(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
- (setq form (replace-regexp-in-string org-ts-regexp3 "<\\1>" form))
+ (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
+ (while (string-match (concat "\\[" org-ts-regexp1 "\\]") form)
+ (setq form (replace-match "<\\1>" nil nil 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))
@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")
(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"))
(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))
;; 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)))
(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)))
(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)
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.
(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)
(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))
(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)
(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)))
(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 ()
(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 (point-marker))
+ (insert (concat formula "\n"))
+ (setq e (point-marker))
+ ;; 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.
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)))))
(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)
((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))
(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)
(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."
(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*")
(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)
((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)
(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)))
(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)))
((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
(push org-table-current-begin-pos org-show-positions)
(let ((min (apply 'min org-show-positions))
(max (apply 'max org-show-positions)))
- (goto-char min) (recenter 0)
+ (set-window-start (selected-window) min)
(goto-char max)
- (or (pos-visible-in-window-p max) (recenter -1))))
+ (or (pos-visible-in-window-p max)
+ (set-window-start (selected-window) max))))
(select-window win))))
(defun org-table-force-dataline ()
(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."
'(arg)
(concat "In tables, run `" (symbol-name fun) "'.\n"
"Outside of tables, run the binding of `"
- (mapconcat (lambda (x) (format "%s" x)) keys "' or `")
+ (mapconcat #'key-description keys "' or `")
"'.")
'(interactive "p")
(list 'if
(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."
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
(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")
(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."
(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")))
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))))
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))
(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))
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"
(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
(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)))
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))
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*)))
(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).
(*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)
(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))
: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)
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)
: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)
(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
(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)))
(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
(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: