X-Git-Url: http://git.hcoop.net/bpt/emacs.git/blobdiff_plain/b349f79f7434513bd603b063473bfdf59c465817..d6685abc9e7e9940fa4e9d683c4cc52826efc0f9:/lisp/org/org-table.el diff --git a/lisp/org/org-table.el b/lisp/org/org-table.el index 45981776c4..0b369a73ad 100644 --- a/lisp/org/org-table.el +++ b/lisp/org/org-table.el @@ -1,11 +1,12 @@ ;;; org-table.el --- The table editor for Org-mode -;; Copyright (C) 2004, 2005, 2006, 2007, 2008 Free Software Foundation, Inc. +;; Copyright (C) 2004, 2005, 2006, 2007, 2008, 2009 +;; Free Software Foundation, Inc. ;; Author: Carsten Dominik ;; Keywords: outlines, hypermedia, calendar, wp ;; Homepage: http://orgmode.org -;; Version: 6.05a +;; Version: 6.20c ;; ;; This file is part of GNU Emacs. ;; @@ -25,7 +26,7 @@ ;; ;;; Commentary: -;; This file contains the table editor and spreadsheed for Org-mode. +;; This file contains the table editor and spreadsheet for Org-mode. ;; Watch out: Here we are talking about two different kind of tables. ;; Most of the code is for the tables created with the Org-mode table editor. @@ -43,7 +44,7 @@ (declare-function org-format-org-table-html "org-exp" (lines &optional splice)) (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) (defcustom orgtbl-optimized (eq org-enable-table-editor 'optimized) @@ -169,7 +170,7 @@ this line." :group 'org-table) (defcustom org-table-use-standard-references t - "Should org-mode work with table refrences like B3 instead of @3$2? + "Should org-mode work with table references like B3 instead of @3$2? Possible values are: nil never use them from accept as input, do not present for editing @@ -191,7 +192,7 @@ t: accept as input and present for editing" calc-angle-mode deg calc-prefer-frac nil calc-symbolic-mode nil - calc-date-format (YYYY "-" MM "-" DD " " Www (" " HH ":" mm)) + calc-date-format (YYYY "-" MM "-" DD " " Www (" " hh ":" mm)) calc-display-working-message t ) "List with Calc mode settings for use in calc-eval for table formulas. @@ -244,6 +245,14 @@ Automatically means, when TAB or RET or C-c C-c are pressed in the line." :group 'org-table-calculation :type 'boolean) +(defcustom org-table-error-on-row-ref-crossing-hline t + "Non-nil means, a relative row reference that tries to cross a hline errors. +When nil, the reference will silently be to the field just next to the hline. +Coming from below, it will be the field below the hline, coming from +above, it will be the field above the hline." + :group 'org-table + :type 'boolean) + (defgroup org-table-import-export nil "Options concerning table import and export in Org-mode." :tag "Org Table Import Export" @@ -378,8 +387,8 @@ integer When a number, use that many spaces as field separator nil When nil, the command tries to be smart and figure out the separator in the following way: - when each line contains a TAB, assume TAB-separated material - - when each line contains a comme, assume CSV material - - else, assume one or more SPACE charcters as separator." + - when each line contains a comma, assume CSV material + - else, assume one or more SPACE characters as separator." (interactive "rP") (let* ((beg (min beg0 end0)) (end (max beg0 end0)) @@ -445,8 +454,14 @@ property, locally or anywhere up in the hierarchy." (let* ((beg (org-table-begin)) (end (org-table-end)) (txt (buffer-substring-no-properties beg end)) - (file (or file (org-entry-get beg "TABLE_EXPORT_FILE" t))) - (format (or format (org-entry-get beg "TABLE_EXPORT_FORMAT" t))) + (file (or file + (condition-case nil + (org-entry-get beg "TABLE_EXPORT_FILE" t) + (error nil)))) + (format (or format + (condition-case nil + (org-entry-get beg "TABLE_EXPORT_FORMAT" t) + (error nil)))) buf deffmt-readable) (unless file (setq file (read-file-name "Export table to: ")) @@ -464,8 +479,13 @@ property, locally or anywhere up in the hierarchy." (setq deffmt-readable (replace-match "\\t" t t deffmt-readable))) (while (string-match "\n" deffmt-readable) (setq deffmt-readable (replace-match "\\n" t t deffmt-readable))) - (setq format (read-string "Format: " deffmt-readable))) - + (setq format (org-completing-read + "Format: " + '("orgtbl-to-tsv" "orgtbl-to-csv" + "orgtbl-to-latex" "orgtbl-to-html" + "orgtbl-to-generic" "orgtbl-to-texinfo" + "orgtbl-to-orgtbl") nil nil + deffmt-readable))) (if (string-match "\\([^ \t\r\n]+\\)\\( +.*\\)?" format) (let* ((transform (intern (match-string 1 format))) (params (if (match-end 2) @@ -854,6 +874,7 @@ in order to easily repeat the interval." (field (org-table-get-field)) (non-empty (string-match "[^ \t]" field)) (beg (org-table-begin)) + (orig-n n) txt) (org-table-check-inside-data-field) (if non-empty @@ -870,17 +891,19 @@ in order to easily repeat the interval." (org-table-goto-column colpos t) (if (and (looking-at "|[ \t]*\\([^| \t][^|]*?\\)[ \t]*|") - (= (setq n (1- n)) 0)) + (<= (setq n (1- n)) 0)) (throw 'exit (match-string 1)))))))) (if txt (progn (if (and org-table-copy-increment - (string-match "^[0-9]+$" txt)) + (not (equal orig-n 0)) + (string-match "^[0-9]+$" txt) + (< (string-to-number txt) 100000000)) (setq txt (format "%d" (+ (string-to-number txt) 1)))) (insert txt) (org-move-to-column col) (if (and org-table-copy-increment (org-at-timestamp-p t)) - (org-timestamp-up 1) + (org-timestamp-up-day) (org-table-maybe-recalculate-line)) (org-table-align) (org-move-to-column col)) @@ -979,7 +1002,7 @@ is always the old value." (defun org-table-current-dline () "Find out what table data line we are in. -Only datalins count for this." +Only datalines count for this." (interactive) (if (interactive-p) (org-table-check-inside-data-field)) (save-excursion @@ -1038,7 +1061,8 @@ However, when FORCE is non-nil, create new columns if necessary." (goto-line linepos) (org-table-goto-column colpos) (org-table-align) - (org-table-fix-formulas "$" nil (1- col) 1))) + (org-table-fix-formulas "$" nil (1- col) 1) + (org-table-fix-formulas "$LR" nil (1- col) 1))) (defun org-table-find-dataline () "Find a dataline in the current table, which is needed for column commands." @@ -1085,6 +1109,8 @@ However, when FORCE is non-nil, create new columns if necessary." (org-table-goto-column colpos) (org-table-align) (org-table-fix-formulas "$" (list (cons (number-to-string col) "INVALID")) + col -1 col) + (org-table-fix-formulas "$LR" (list (cons (number-to-string col) "INVALID")) col -1 col))) (defun org-table-move-column-right () @@ -1128,7 +1154,10 @@ However, when FORCE is non-nil, create new columns if necessary." (org-table-align) (org-table-fix-formulas "$" (list (cons (number-to-string col) (number-to-string colpos)) - (cons (number-to-string colpos) (number-to-string col)))))) + (cons (number-to-string colpos) (number-to-string col)))) + (org-table-fix-formulas + "$LR" (list (cons (number-to-string col) (number-to-string colpos)) + (cons (number-to-string colpos) (number-to-string col)))))) (defun org-table-move-row-down () "Move table row down." @@ -1194,6 +1223,9 @@ With prefix ABOVE, insert above the current line." (interactive "P") (if (not (org-at-table-p)) (error "Not at a table")) + (when (eobp) (insert "\n") (backward-char 1)) + (if (not (string-match "|[ \t]*$" (org-current-line-string))) + (org-table-align)) (let ((line (org-table-clean-line (buffer-substring (point-at-bol) (point-at-eol)))) (col (current-column))) @@ -1630,7 +1662,7 @@ If NLAST is a number, only the NLAST fields will actually be summed." items1))) (res (apply '+ numbers)) (sres (if (= org-timecnt 0) - (format "%g" res) + (number-to-string res) (setq diff (* 3600 res) h (floor (/ diff 3600)) diff (mod diff 3600) m (floor (/ diff 60)) diff (mod diff 60) @@ -1654,14 +1686,14 @@ If NLAST is a number, only the NLAST fields will actually be summed." (cond ((and (string-match "0" s) (string-match "\\`[-+ \t0.edED]+\\'" s)) 0) - ((string-match "\\`[ \t]+\\'" s) nil) + ((string-match "\\`[ \t]+\\'" s) nil) ((string-match "\\`\\([0-9]+\\):\\([0-9]+\\)\\(:\\([0-9]+\\)\\)?\\'" s) (let ((h (string-to-number (or (match-string 1 s) "0"))) (m (string-to-number (or (match-string 2 s) "0"))) (s (string-to-number (or (match-string 4 s) "0")))) (if (boundp 'org-timecnt) (setq org-timecnt (1+ org-timecnt))) (* 1.0 (+ h (/ m 60.0) (/ s 3600.0))))) - ((equal n 0) nil) + ((equal n 0) nil) (t n)))) (defun org-table-current-field-formula (&optional key noerror) @@ -1694,11 +1726,14 @@ When NAMED is non-nil, look for a named equation." (ref (format "@%d$%d" (org-table-current-dline) (org-table-current-column))) (refass (assoc ref stored-list)) + (nameass (assoc name stored-list)) (scol (if named - (if name name ref) + (if (and name (not (string-match "^LR[0-9]+$" name))) + name + ref) (int-to-string (org-table-current-column)))) - (dummy (and (or name refass) (not named) - (not (y-or-n-p "Replace field formula with column formula? " )) + (dummy (and (or nameass refass) (not named) + (not (y-or-n-p "Replace existing field formula with column formula? " )) (error "Abort"))) (name (or name ref)) (org-table-may-need-update nil) @@ -1785,12 +1820,12 @@ When NAMED is non-nil, look for a named equation." eq (match-string 3 string) eq-alist (cons (cons scol eq) eq-alist)) (if (member scol seen) - (if noerror - (progn - (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)) + (if noerror + (progn + (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)) (push scol seen)))))) (nreverse eq-alist))) @@ -1804,8 +1839,9 @@ For all numbers larger than LIMIT, shift them by DELTA." (let ((re (concat key "\\([0-9]+\\)")) (re2 (when remove - (if (equal key "$") - (format "\\(@[0-9]+\\)?\\$%d=.*?\\(::\\|$\\)" remove) + (if (or (equal key "$") (equal key "$LR")) + (format "\\(@[0-9]+\\)?%s%d=.*?\\(::\\|$\\)" + (regexp-quote key) remove) (format "@%d\\$[0-9]+=.*?\\(::\\|$\\)" remove)))) s n a) (when remove @@ -1824,7 +1860,7 @@ For all numbers larger than LIMIT, shift them by DELTA." (save-excursion (let ((beg (org-table-begin)) (end (org-table-end)) names name fields fields1 field cnt - c v l line col types dlines hlines) + c v l line col types dlines hlines last-dline) (setq org-table-column-names nil org-table-local-parameters nil org-table-named-field-locations nil @@ -1874,9 +1910,26 @@ For all numbers larger than LIMIT, shift them by DELTA." (if (match-end 1) (push l hlines) (push l dlines)) (beginning-of-line 2) (setq l (1+ l))) + (push 'hline types) ;; add an imaginary extra hline to the end (setq org-table-current-line-types (apply 'vector (nreverse types)) + last-dline (car dlines) org-table-dlines (apply 'vector (cons nil (nreverse dlines))) - org-table-hlines (apply 'vector (cons nil (nreverse hlines))))))) + org-table-hlines (apply 'vector (cons nil (nreverse hlines)))) + (goto-line last-dline) + (let* ((l last-dline) + (fields (org-split-string + (buffer-substring (point-at-bol) (point-at-eol)) + "[ \t]*|[ \t]*")) + (nfields (length fields)) + al al2) + (loop for i from 1 to nfields do + (push (list (format "LR%d" i) l i) al) + (push (cons (format "LR%d" i) (nth (1- i) fields)) al2)) + (setq org-table-named-field-locations + (append org-table-named-field-locations al)) + (setq org-table-local-parameters + (append org-table-local-parameters al2)))))) + (defun org-table-maybe-eval-formula () "Check if the current field starts with \"=\" or \":=\". @@ -2100,9 +2153,20 @@ not overwrite the stored one." lispp (and (> (length form) 2)(equal (substring form 0 2) "'("))) (if (and lispp literal) (setq lispp 'literal)) ;; Check for old vertical references - (setq form (org-rewrite-old-row-references form)) + (setq form (org-table-rewrite-old-row-references form)) + ;; Insert remote references + (while (string-match "\\ (length (match-string 0 form)) 1)) (setq form (replace-match (save-match-data @@ -2157,7 +2221,7 @@ $1-> %s\n" orig formula form0 form)) ev (or fmt "NONE") (if fmt (format fmt (string-to-number ev)) ev))))) (setq bw (get-buffer-window "*Substitution History*")) - (shrink-window-if-larger-than-buffer bw) + (org-fit-window-to-buffer bw) (unless (and (interactive-p) (not ndown)) (unless (let (inhibit-redisplay) (y-or-n-p "Debugging Formula. Continue to next? ")) @@ -2182,7 +2246,7 @@ $1-> %s\n" orig formula form0 form)) prop value))) (defun org-table-get-range (desc &optional tbeg col highlight) - "Get a calc vector from a column, accorting to descriptor DESC. + "Get a calc vector from a column, according to descriptor DESC. Optional arguments TBEG and COL can give the beginning of the table and the current column, to avoid unnecessary parsing. HIGHLIGHT means, just highlight the range." @@ -2273,26 +2337,32 @@ and TABLE is a vector with line types." (if (and (not hn) on (not odir)) (error "should never happen");;(aref org-table-dlines on) (if (and hn (> hn 0)) - (setq i (org-find-row-type table i 'hline (equal hdir "-") nil hn))) + (setq i (org-table-find-row-type table i 'hline (equal hdir "-") + nil hn cline desc))) (if on - (setq i (org-find-row-type table i 'dline (equal odir "-") rel on))) + (setq i (org-table-find-row-type table i 'dline (equal odir "-") + rel on cline desc))) (+ bline i))))) -(defun org-find-row-type (table i type backwards relative n) +(defun org-table-find-row-type (table i type backwards relative n cline desc) + "FIXME: Needs more documentation." (let ((l (length table))) (while (> n 0) (while (and (setq i (+ i (if backwards -1 1))) (>= i 0) (< i l) (not (eq (aref table i) type)) (if (and relative (eq (aref table i) 'hline)) - (progn (setq i (- i (if backwards -1 1)) n 1) nil) + (if org-table-error-on-row-ref-crossing-hline + (error "Row descriptor %s used in line %d crosses hline" desc cline) + (progn (setq i (- i (if backwards -1 1)) n 1) nil)) t))) (setq n (1- n))) (if (or (< i 0) (>= i l)) - (error "Row descriptor leads outside table") + (error "Row descriptor %s used in line %d leads outside table" + desc cline) i))) -(defun org-rewrite-old-row-references (s) +(defun org-table-rewrite-old-row-references (s) (if (string-match "&[-+0-9I]" s) (error "Formula contains old &row reference, please rewrite using @-syntax") s)) @@ -2331,12 +2401,17 @@ LISPP means to return something appropriate for a Lisp list." (defun org-table-recalculate (&optional all noalign) "Recalculate the current table line by applying all stored formulas. -With prefix arg ALL, do this for all lines in the table." +With prefix arg ALL, do this for all lines in the table. +With the prefix argument ALL is `(16)' (a double `C-c C-u' prefix), or if +it is the symbol `iterate', recompute the table until it no longer changes. +If NOALIGN is not nil, do not re-align the table after the computations +are done. This is typically used internally to save time, if it is +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")) - (if (equal all '(16)) + (if (or (eq all 'iterate) (equal all '(16))) (org-table-iterate) (org-table-get-specials) (let* ((eqlist (sort (org-table-get-stored-formulas) @@ -2465,12 +2540,14 @@ With prefix arg ALL, do this for all lines in the table." (setq f (replace-match (concat "$" (cdr a)) t t f))) ;; Parameters and constants (setq start 0) - (while (setq start (string-match "\\$\\([a-zA-Z][_a-zA-Z0-9]*\\)" f start)) - (setq start (1+ start)) - (if (setq a (save-match-data - (org-table-get-constant (match-string 1 f)))) - (setq f (replace-match - (concat (if pp "(") a (if pp ")")) t t f)))) + (while (setq start (string-match "\\$\\([a-zA-Z][_a-zA-Z0-9]*\\)\\|\\(\\\\|&\\)\\|\\(;[^\r\n:]+\\)" s start) + (while (string-match "\\<\\([a-zA-Z]+\\)\\([0-9]+\\>\\|&\\)\\|\\(;[^\r\n:]+\\|\\ AB." s)) (defun org-table-fedit-convert-buffer (function) - "Convert all references in this buffer, using FUNTION." + "Convert all references in this buffer, using FUNCTION." (let ((line (org-current-line))) (goto-char (point-min)) (while (not (eobp)) @@ -2731,10 +2808,10 @@ For example: 28 -> AB." (or (match-end n) (error "Cannot shift reference in this direction")) (goto-char (match-beginning n)) (and (looking-at (regexp-quote (match-string n))) - (replace-match (org-shift-refpart (match-string 0) decr hline) + (replace-match (org-table-shift-refpart (match-string 0) decr hline) t t))) -(defun org-shift-refpart (ref &optional decr hline) +(defun org-table-shift-refpart (ref &optional decr hline) "Shift a refrence part REF. If DECR is set, decrease the references row/column, else increase. If HLINE is set, this may be a hline reference, it certainly is not @@ -2767,7 +2844,7 @@ a translation reference." (t (error "Cannot shift reference")))))) (defun org-table-fedit-toggle-coordinates () - "Toggle the display of coordinates in the refrenced table." + "Toggle the display of coordinates in the referenced table." (interactive) (let ((pos (marker-position org-pos))) (with-current-buffer (marker-buffer org-pos) @@ -2869,8 +2946,8 @@ With prefix ARG, apply the new formulas to the table." (org-table-remove-rectangle-highlight) (catch 'exit (let ((pos (if local (point) org-pos)) - (face2 'highlight) - (org-inhibit-highlight-removal t) + (face2 'highlight) + (org-inhibit-highlight-removal t) (win (selected-window)) (org-show-positions nil) var name e what match dest) @@ -2982,15 +3059,15 @@ With prefix ARG, apply the new formulas to the table." (t (error "Undefined name $%s" var))))) (goto-char pos) (when (and org-show-positions - (not (memq this-command '(org-table-fedit-scroll - org-table-fedit-scroll-down)))) + (not (memq this-command '(org-table-fedit-scroll + org-table-fedit-scroll-down)))) (push pos org-show-positions) (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) - (goto-char max) - (or (pos-visible-in-window-p max) (recenter -1)))) + (goto-char min) (recenter 0) + (goto-char max) + (or (pos-visible-in-window-p max) (recenter -1)))) (select-window win)))) (defun org-table-force-dataline () @@ -3018,7 +3095,7 @@ With prefix ARG, apply the new formulas to the table." (org-table-fedit-move 'next-line)) (defun org-table-fedit-move (command) - "Move the cursor in the window shoinw the table. + "Move the cursor in the window showing the table. Use COMMAND to do the motion, repeat if necessary to end up in a data line." (let ((org-table-allow-automatic-line-recalculation nil) (pos org-pos) (win (selected-window)) p) @@ -3085,7 +3162,7 @@ Use COMMAND to do the motion, repeat if necessary to end up in a data line." (setq org-table-rectangle-overlays nil))) (defvar org-table-coordinate-overlays nil - "Collects the cooordinate grid overlays, so that they can be removed.") + "Collects the coordinate grid overlays, so that they can be removed.") (make-variable-buffer-local 'org-table-coordinate-overlays) (defun org-table-overlay-coordinates () @@ -3223,7 +3300,7 @@ table editor in arbitrary modes.") (easy-menu-add orgtbl-mode-menu) (run-hooks 'orgtbl-mode-hook)) (setq auto-fill-inhibit-regexp org-old-auto-fill-inhibit-regexp) - (org-cleanup-narrow-column-properties) + (org-table-cleanup-narrow-column-properties) (org-remove-from-invisibility-spec '(org-cwidth)) (remove-hook 'before-change-functions 'org-before-change-function t) (when (fboundp 'font-lock-remove-keywords) @@ -3232,7 +3309,7 @@ table editor in arbitrary modes.") (easy-menu-remove orgtbl-mode-menu) (force-mode-line-update 'all)))) -(defun org-cleanup-narrow-column-properties () +(defun org-table-cleanup-narrow-column-properties () "Remove all properties related to narrow-column invisibility." (let ((s 1)) (while (setq s (text-property-any s (point-max) @@ -3286,31 +3363,29 @@ to execute outside of tables." (bindings (list '([(meta shift left)] org-table-delete-column) - '([(meta left)] org-table-move-column-left) + '([(meta left)] org-table-move-column-left) '([(meta right)] org-table-move-column-right) '([(meta shift right)] org-table-insert-column) '([(meta shift up)] org-table-kill-row) '([(meta shift down)] org-table-insert-row) - '([(meta up)] org-table-move-row-up) - '([(meta down)] org-table-move-row-down) - '("\C-c\C-w" org-table-cut-region) - '("\C-c\M-w" org-table-copy-region) - '("\C-c\C-y" org-table-paste-rectangle) - '("\C-c-" org-table-insert-hline) - '("\C-c}" org-table-toggle-coordinate-overlays) - '("\C-c{" org-table-toggle-formula-debugger) - '("\C-m" org-table-next-row) - '([(shift return)] org-table-copy-down) - '("\C-c\C-q" org-table-wrap-region) - '("\C-c?" org-table-field-info) - '("\C-c " org-table-blank-field) - '("\C-c+" org-table-sum) - '("\C-c=" org-table-eval-formula) - '("\C-c'" org-table-edit-formulas) - '("\C-c`" org-table-edit-field) - '("\C-c*" org-table-recalculate) - '("\C-c|" org-table-create-or-convert-from-region) - '("\C-c^" org-table-sort-lines) + '([(meta up)] org-table-move-row-up) + '([(meta down)] org-table-move-row-down) + '("\C-c\C-w" org-table-cut-region) + '("\C-c\M-w" org-table-copy-region) + '("\C-c\C-y" org-table-paste-rectangle) + '("\C-c-" org-table-insert-hline) + '("\C-c}" org-table-toggle-coordinate-overlays) + '("\C-c{" org-table-toggle-formula-debugger) + '("\C-m" org-table-next-row) + '([(shift return)] org-table-copy-down) + '("\C-c?" org-table-field-info) + '("\C-c " org-table-blank-field) + '("\C-c+" org-table-sum) + '("\C-c=" org-table-eval-formula) + '("\C-c'" org-table-edit-formulas) + '("\C-c`" org-table-edit-field) + '("\C-c*" org-table-recalculate) + '("\C-c^" org-table-sort-lines) '([(control ?#)] org-table-rotate-recalc-marks))) elt key fun cmd) (while (setq elt (pop bindings)) @@ -3343,6 +3418,8 @@ to execute outside of tables." [(meta return)] "\M-\C-m")) (org-defkey orgtbl-mode-map "\C-c\C-c" 'orgtbl-ctrl-c-ctrl-c) + (org-defkey orgtbl-mode-map "\C-c|" 'orgtbl-create-or-convert-from-region) + (when orgtbl-optimized ;; If the user wants maximum table support, we need to hijack ;; some standard editing functions @@ -3353,6 +3430,9 @@ to execute outside of tables." (org-defkey orgtbl-mode-map "|" 'org-force-self-insert)) (easy-menu-define orgtbl-mode-menu orgtbl-mode-map "OrgTbl menu" '("OrgTbl" + ["Create or convert" org-table-create-or-convert-from-region + :active (not (org-at-table-p)) :keys "C-c |" ] + "--" ["Align" org-ctrl-c-ctrl-c :active (org-at-table-p) :keys "C-c C-c"] ["Next Field" org-cycle :active (org-at-table-p) :keys "TAB"] ["Previous Field" org-shifttab :active (org-at-table-p) :keys "S-TAB"] @@ -3437,6 +3517,16 @@ With prefix arg, also recompute table." (t (let (orgtbl-mode) (call-interactively (key-binding "\C-c\C-c"))))))) +(defun orgtbl-create-or-convert-from-region (arg) + "Create table or convert region to table, if no conflicting binding. +This installs the table binding `C-c |', but only if there is no +conflicting binding to this key outside orgtbl-mode." + (interactive "P") + (let* (orgtbl-mode (cmd (key-binding "\C-c|"))) + (if cmd + (call-interactively cmd) + (call-interactively 'org-table-create-or-convert-from-region)))) + (defun orgtbl-tab (arg) "Justification and field motion for `orgtbl-mode'." (interactive "P") @@ -3447,8 +3537,10 @@ With prefix arg, also recompute table." (defun orgtbl-ret () "Justification and field motion for `orgtbl-mode'." (interactive) - (org-table-justify-field-maybe) - (org-table-next-row)) + (if (bobp) + (newline) + (org-table-justify-field-maybe) + (org-table-next-row))) (defun orgtbl-self-insert-command (N) "Like `self-insert-command', use overwrite-mode for whitespace in tables. @@ -3475,8 +3567,14 @@ overwritten, and the table is not marked as requiring realignment." (goto-char (match-beginning 0)) (self-insert-command N)) (setq org-table-may-need-update t) - (let (orgtbl-mode) - (call-interactively (key-binding (vector last-input-event)))))) + (let (orgtbl-mode a) + (call-interactively + (or (key-binding + (or (and (listp function-key-map) + (setq a (assoc last-input-event function-key-map)) + (cdr a)) + (vector last-input-event))) + 'self-insert-command))))) (defvar orgtbl-exp-regexp "^\\([-+]?[0-9][0-9.]*\\)[eE]\\([-+]?[0-9]+\\)$" "Regular expression matching exponentials as produced by calc.") @@ -3541,8 +3639,29 @@ a radio table." (delete-region beg (point)))) (insert txt "\n"))) +;;;###autoload +(defun org-table-to-lisp (&optional txt) + "Convert the table at point to a Lisp structure. +The structure will be a list. Each item is either the symbol `hline' +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"))) + (let* ((txt (or txt + (buffer-substring-no-properties (org-table-begin) + (org-table-end)))) + (lines (org-split-string txt "[ \t]*\n[ \t]*"))) + + (mapcar + (lambda (x) + (if (string-match org-table-hline-regexp x) + 'hline + (org-split-string (org-trim x) "\\s-*|\\s-*"))) + lines))) + (defun orgtbl-send-table (&optional maybe) - "Send a tranformed version of this table to the receiver position. + "Send a transformed version of this table to the receiver position. With argument MAYBE, fail quietly if no transformation is defined for this table." (interactive) @@ -3687,9 +3806,9 @@ First element has index 0, or I0 if given." (orgtbl-apply-fmt efmt (match-string 1 f) (match-string 2 f)) f))) - (orgtbl-apply-fmt (or (orgtbl-get-fmt *orgtbl-fmt* i) - *orgtbl-default-fmt*) - f))) + (orgtbl-apply-fmt (or (orgtbl-get-fmt *orgtbl-fmt* i) + *orgtbl-default-fmt*) + f))) line))) (push (if *orgtbl-lfmt* (orgtbl-apply-fmt *orgtbl-lfmt* line) @@ -3794,9 +3913,15 @@ directly by `orgtbl-send-table'. See manual." ;; Do we have a heading section? If so, format it and handle the ;; trailing hline. - (if (and (not splicep) (listp (car *orgtbl-table*)) - (memq 'hline *orgtbl-table*)) + (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 + (and hline (push hline *orgtbl-rtn*)) + (pop *orgtbl-table*)) (let* ((*orgtbl-lstart* (or (plist-get params :hlstart) *orgtbl-lstart*)) (*orgtbl-llstart* (or (plist-get params :hllstart) @@ -3818,8 +3943,8 @@ directly by `orgtbl-send-table'. See manual." (unless splicep (when (plist-member params :tend) - (let ((tend (orgtbl-eval-str (plist-get params :tend)))) - (if tend (push tend *orgtbl-rtn*))))) + (let ((tend (orgtbl-eval-str (plist-get params :tend)))) + (if tend (push tend *orgtbl-rtn*))))) (mapconcat 'identity (nreverse (if remove-nil-linesp (remq nil *orgtbl-rtn*) @@ -3887,6 +4012,7 @@ 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. @@ -3948,14 +4074,68 @@ and :tend suppress strings without splicing; they can be set to provide ORGTBL directives for the generated table." (let* ((params2 (list - :tstart nil :tend nil - :hline "|---" - :sep " | " - :lstart "| " - :lend " |")) + :tstart nil :tend nil + :hline "|---" + :sep " | " + :lstart "| " + :lend " |")) (params (org-combine-plists params2 params))) (orgtbl-to-generic table params))) +(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 +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 netry will be referenced. +FORM is a field or range descriptor like \"@2$3\" or or \"B3\" or +\"@I$2..@II$2\". All the references must be absolute, not relative. + +The return value is either a single string for a single field, or a +list of the fields in the rectangle ." + (save-match-data + (let ((id-loc nil) + org-table-column-names org-table-column-name-regexp + org-table-local-parameters org-table-named-field-locations + org-table-current-line-types org-table-current-begin-line + org-table-current-begin-pos org-table-dlines + org-table-hlines org-table-last-alignment + org-table-last-column-widths org-table-last-alignment + org-table-last-column-widths tbeg + buffer loc) + (save-excursion + (save-restriction + (widen) + (save-excursion + (goto-char (point-min)) + (if (re-search-forward + (concat "^#\\+TBLNAME:[ \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) + buffer (marker-buffer id-loc) + loc (marker-position id-loc)) + (move-marker id-loc nil))) + (switch-to-buffer buffer) + (save-excursion + (save-restriction + (widen) + (goto-char loc) + (forward-char 1) + (unless (and (re-search-forward "^\\(\\*+ \\)\\|[ \t]*|" nil t) + (not (match-beginning 1))) + (error "Cannot find a table at NAME or ID %s" name-or-id)) + (setq tbeg (point-at-bol)) + (org-table-get-specials) + (setq form (org-table-formula-substitute-names form)) + (if (and (string-match org-table-range-regexp form) + (> (length (match-string 0 form)) 1)) + (save-match-data + (org-table-get-range (match-string 0 form) tbeg 1)) + form)))))))) + (provide 'org-table) ;; arch-tag: 4d21cfdd-0268-440a-84b0-09237a0fe0ef