diff options
Diffstat (limited to 'lisp/org-table.el')
| -rw-r--r-- | lisp/org-table.el | 348 |
1 files changed, 185 insertions, 163 deletions
diff --git a/lisp/org-table.el b/lisp/org-table.el index e2d3198..e43f0f8 100644 --- a/lisp/org-table.el +++ b/lisp/org-table.el @@ -1,6 +1,6 @@ ;;; org-table.el --- The table editor for Org mode -;; Copyright (C) 2004-2015 Free Software Foundation, Inc. +;; Copyright (C) 2004-2016 Free Software Foundation, Inc. ;; Author: Carsten Dominik <carsten at orgmode dot org> ;; Keywords: outlines, hypermedia, calendar, wp @@ -927,9 +927,9 @@ a table." (match-beginning 0)) ;; When the line right after the table is the last line in ;; the buffer with trailing spaces but no final newline - ;; character, trailing spaces, be sure to catch the correct - ;; ending at its beginning. In any other case, ending is - ;; expected to be at point max. + ;; character, be sure to catch the correct ending at its + ;; beginning. In any other case, ending is expected to be + ;; at point max. (t (goto-char (point-max)) (skip-chars-backward " \t") (if (bolp) (point) (line-end-position)))))) @@ -2169,20 +2169,25 @@ If NLAST is a number, only the NLAST fields will actually be summed." Assumes that table is already analyzed. If KEY is given, return the key to this formula. Otherwise return the formula preceded with \"=\" or \":=\"." - (let* ((col (org-table-current-column)) - (name (car (rassoc (list (count-lines org-table-current-begin-pos - (line-beginning-position)) - col) - org-table-named-field-locations))) - (scol (int-to-string col)) - (ref (format "@%d$%d" (org-table-current-dline) col)) - (stored-list (org-table-get-stored-formulas noerror)) - (ass (or (assoc name stored-list) - (assoc ref stored-list) - (assoc scol stored-list)))) - (cond (key (car ass)) - (ass (concat (if (string-match "^[0-9]+$" (car ass)) "=" ":=") - (cdr ass)))))) + (let* ((line (count-lines org-table-current-begin-pos + (line-beginning-position))) + (row (org-table-line-to-dline line))) + (cond + (row + (let* ((col (org-table-current-column)) + (name (car (rassoc (list line col) + org-table-named-field-locations))) + (scol (format "$%d" col)) + (ref (format "@%d$%d" (org-table-current-dline) col)) + (stored-list (org-table-get-stored-formulas noerror)) + (ass (or (assoc name stored-list) + (assoc ref stored-list) + (assoc scol stored-list)))) + (cond (key (car ass)) + (ass (concat (if (string-match "^[0-9]+$" (car ass)) "=" ":=") + (cdr ass)))))) + (noerror nil) + (t (error "No formula active for the current field"))))) (defun org-table-get-formula (&optional equation named) "Read a formula from the minibuffer, offer stored formula as default. @@ -2242,12 +2247,16 @@ column formula? " )) (org-table-store-formulas stored-list)) eq)) -(defun org-table-store-formulas (alist) - "Store the list of formulas below the current table." +(defun org-table-store-formulas (alist &optional location) + "Store the list of formulas below the current table. +If optional argument LOCATION is a buffer position, insert it at +LOCATION instead." (save-excursion - (goto-char (org-table-end)) + (if location + (progn (goto-char location) (beginning-of-line)) + (goto-char (org-table-end))) (let ((case-fold-search t)) - (if (looking-at "\\([ \t]*\n\\)*[ \t]*\\(#\\+tblfm:\\)\\(.*\n?\\)") + (if (looking-at "\\([ \t]*\n\\)*[ \t]*\\(#\\+TBLFM:\\)\\(.*\n?\\)") (progn ;; Don't overwrite TBLFM, we might use text properties to ;; store stuff. @@ -2287,10 +2296,15 @@ column formula? " )) (and as bs (string< as bs)))) ;;;###autoload -(defun org-table-get-stored-formulas (&optional noerror) - "Return an alist with the stored formulas directly after current table." +(defun org-table-get-stored-formulas (&optional noerror location) + "Return an alist with the stored formulas directly after current table. +By default, only return active formulas, i.e., formulas located +on the first line after the table. However, if optional argument +LOCATION is a buffer position, consider the formulas there." (save-excursion - (goto-char (org-table-end)) + (if location + (progn (goto-char location) (beginning-of-line)) + (goto-char (org-table-end))) (let ((case-fold-search t)) (when (looking-at "\\([ \t]*\n\\)*[ \t]*#\\+TBLFM: *\\(.*\\)") (let ((strings (org-split-string (org-match-string-no-properties 2) @@ -2664,7 +2678,6 @@ not overwrite the stored one." (or suppress-analysis (org-table-analyze)) (if (equal arg '(16)) (let ((eq (org-table-current-field-formula))) - (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)) @@ -3524,62 +3537,70 @@ Parameters get priority." :style toggle :selected org-table-buffer-is-an])) (defvar org-pos) +(defvar org-table--fedit-source nil + "Position of the TBLFM line being edited.") ;;;###autoload (defun org-table-edit-formulas () "Edit the formulas of the current table in a separate buffer." (interactive) - (when (save-excursion (beginning-of-line) - (let ((case-fold-search t)) (looking-at "[ \t]*#\\+TBLFM"))) - (beginning-of-line 0)) - (unless (org-at-table-p) (user-error "Not at a table")) - (org-table-analyze) - (let ((key (org-table-current-field-formula 'key 'noerror)) - (eql (sort (org-table-get-stored-formulas 'noerror) - #'org-table-formula-less-p)) - (pos (point-marker)) - (startline 1) - (wc (current-window-configuration)) - (sel-win (selected-window)) - (titles '((column . "# Column Formulas\n") - (field . "# Field and Range Formulas\n") - (named . "# Named Field Formulas\n")))) - (org-switch-to-buffer-other-window "*Edit Formulas*") - (erase-buffer) - ;; Keep global-font-lock-mode from turning on font-lock-mode - (let ((font-lock-global-modes '(not fundamental-mode))) - (fundamental-mode)) - (org-set-local 'font-lock-global-modes (list 'not major-mode)) - (org-set-local 'org-pos pos) - (org-set-local 'org-window-configuration wc) - (org-set-local 'org-selected-window sel-win) - (use-local-map org-table-fedit-map) - (org-add-hook 'post-command-hook #'org-table-fedit-post-command t t) - (easy-menu-add org-table-fedit-menu) - (setq startline (org-current-line)) - (dolist (entry eql) - (let* ((type (cond - ((string-match "\\`$[<>]" (car entry)) 'column) - ((equal (string-to-char (car entry)) ?@) 'field) - ((string-match "\\'[0-9]" (car entry)) 'column) - (t 'named))) - (title (assq type titles))) - (when title - (unless (bobp) (insert "\n")) - (insert (org-add-props (cdr title) nil 'face font-lock-comment-face)) - (setq titles (remove title titles))) - (when (equal key (car entry)) (setq startline (org-current-line))) - (let ((s (concat (if (member (string-to-char (car entry)) '(?@ ?$)) "" "$") - (car entry) " = " (cdr entry) "\n"))) - (remove-text-properties 0 (length s) '(face nil) s) - (insert s)))) - (when (eq org-table-use-standard-references t) - (org-table-fedit-toggle-ref-type)) - (org-goto-line startline) - (message - (substitute-command-keys "\\<org-mode-map>\ + (let ((at-tblfm (org-at-TBLFM-p))) + (unless (or at-tblfm (org-at-table-p)) + (user-error "Not at a table")) + (save-excursion + ;; Move point within the table before analyzing it. + (when at-tblfm (re-search-backward "^[ \t]*|")) + (org-table-analyze)) + (let ((key (org-table-current-field-formula 'key 'noerror)) + (eql (sort (org-table-get-stored-formulas t (and at-tblfm (point))) + #'org-table-formula-less-p)) + (pos (point-marker)) + (source (copy-marker (line-beginning-position))) + (startline 1) + (wc (current-window-configuration)) + (sel-win (selected-window)) + (titles '((column . "# Column Formulas\n") + (field . "# Field and Range Formulas\n") + (named . "# Named Field Formulas\n")))) + (org-switch-to-buffer-other-window "*Edit Formulas*") + (erase-buffer) + ;; Keep global-font-lock-mode from turning on font-lock-mode + (let ((font-lock-global-modes '(not fundamental-mode))) + (fundamental-mode)) + (org-set-local 'font-lock-global-modes (list 'not major-mode)) + (org-set-local 'org-pos pos) + (org-set-local 'org-table--fedit-source source) + (org-set-local 'org-window-configuration wc) + (org-set-local 'org-selected-window sel-win) + (use-local-map org-table-fedit-map) + (org-add-hook 'post-command-hook #'org-table-fedit-post-command t t) + (easy-menu-add org-table-fedit-menu) + (setq startline (org-current-line)) + (dolist (entry eql) + (let* ((type (cond + ((string-match "\\`$\\([0-9]+\\|[<>]+\\)\\'" (car entry)) + 'column) + ((equal (string-to-char (car entry)) ?@) 'field) + (t 'named))) + (title (assq type titles))) + (when title + (unless (bobp) (insert "\n")) + (insert + (org-add-props (cdr title) nil 'face font-lock-comment-face)) + (setq titles (remove title titles))) + (when (equal key (car entry)) (setq startline (org-current-line))) + (let ((s (concat + (if (memq (string-to-char (car entry)) '(?@ ?$)) "" "$") + (car entry) " = " (cdr entry) "\n"))) + (remove-text-properties 0 (length s) '(face nil) s) + (insert s)))) + (when (eq org-table-use-standard-references t) + (org-table-fedit-toggle-ref-type)) + (org-goto-line startline) + (message + (substitute-command-keys "\\<org-mode-map>\ Edit formulas, finish with `\\[org-ctrl-c-ctrl-c]' or `\\[org-edit-special]'. \ -See menu for more commands.")))) +See menu for more commands."))))) (defun org-table-fedit-post-command () (when (not (memq this-command '(lisp-complete-symbol))) @@ -3823,32 +3844,31 @@ a translation reference." With prefix ARG, apply the new formulas to the table." (interactive "P") (org-table-remove-rectangle-highlight) - (if org-table-use-standard-references - (progn - (org-table-fedit-convert-buffer 'org-table-convert-refs-to-rc) - (setq org-table-buffer-is-an nil))) - (let ((pos org-pos) (sel-win org-selected-window) eql var form) + (when org-table-use-standard-references + (org-table-fedit-convert-buffer 'org-table-convert-refs-to-rc) + (setq org-table-buffer-is-an nil)) + (let ((pos org-pos) + (sel-win org-selected-window) + (source org-table--fedit-source) + eql) (goto-char (point-min)) (while (re-search-forward "^\\(@[-+I<>0-9.$@]+\\|@?[0-9]+\\|\\$\\([a-zA-Z0-9]+\\|[<>]+\\)\\) *= *\\(.*\\(\n[ \t]+.*$\\)*\\)" nil t) - (setq var (if (match-end 2) (match-string 2) (match-string 1)) - form (match-string 3)) - (setq form (org-trim form)) - (when (not (equal form "")) - (while (string-match "[ \t]*\n[ \t]*" form) - (setq form (replace-match " " t t form))) - (when (assoc var eql) - (user-error "Double formulas for %s" var)) - (push (cons var form) eql))) - (setq org-pos nil) + (let ((var (match-string 1)) + (form (org-trim (match-string 3)))) + (unless (equal form "") + (while (string-match "[ \t]*\n[ \t]*" form) + (setq form (replace-match " " t t form))) + (when (assoc var eql) + (user-error "Double formulas for %s" var)) + (push (cons var form) eql)))) (set-window-configuration org-window-configuration) (select-window sel-win) - (goto-char pos) - (unless (org-at-table-p) - (user-error "Lost table position - cannot install formulas")) + (goto-char source) (org-table-store-formulas eql) - (move-marker pos nil) + (set-marker pos nil) + (set-marker source nil) (kill-buffer "*Edit Formulas*") (if arg (org-table-recalculate 'all) @@ -3907,13 +3927,13 @@ With prefix ARG, apply the new formulas to the table." (defvar org-show-positions nil) (defun org-table-show-reference (&optional local) - "Show the location/value of the $ expression at point." + "Show the location/value of the $ expression at point. +When LOCAL is non-nil, show references for the table at point." (interactive) (org-table-remove-rectangle-highlight) (when local (org-table-analyze)) (catch 'exit (let ((pos (if local (point) org-pos)) - (table-start (if local org-table-current-begin-pos (org-table-begin))) (face2 'highlight) (org-inhibit-highlight-removal t) (win (selected-window)) @@ -3966,73 +3986,75 @@ With prefix ARG, apply the new formulas to the table." (marker-buffer pos))))) (goto-char pos) (org-table-force-dataline) - (when dest - (setq name (substring dest 1)) + (let ((table-start + (if local org-table-current-begin-pos (org-table-begin)))) + (when dest + (setq name (substring dest 1)) + (cond + ((org-string-match-p "\\`\\$[a-zA-Z][a-zA-Z0-9]*" dest) + (org-table-goto-field dest)) + ((org-string-match-p "\\`@\\([1-9][0-9]*\\)\\$\\([1-9][0-9]*\\)\\'" + dest) + (org-table-goto-field dest)) + (t (org-table-goto-column (string-to-number name)))) + (move-marker pos (point)) + (org-table-highlight-rectangle nil nil face2)) (cond - ((org-string-match-p "\\`\\$[a-zA-Z][a-zA-Z0-9]*" dest) - (org-table-goto-field dest)) - ((org-string-match-p "\\`@\\([1-9][0-9]*\\)\\$\\([1-9][0-9]*\\)\\'" - dest) - (org-table-goto-field dest)) - (t (org-table-goto-column (string-to-number name)))) - (move-marker pos (point)) - (org-table-highlight-rectangle nil nil face2)) - (cond - ((equal dest match)) - ((not match)) - ((eq what 'range) - (ignore-errors (org-table-get-range match table-start nil 'highlight))) - ((setq e (assoc var org-table-named-field-locations)) - (org-table-goto-field var) - (org-table-highlight-rectangle) - (message "Named field, column %d of line %d" (nth 2 e) (nth 1 e))) - ((setq e (assoc var org-table-column-names)) - (org-table-goto-column (string-to-number (cdr e))) - (org-table-highlight-rectangle) - (goto-char table-start) - (if (re-search-forward (concat "^[ \t]*| *! *.*?| *\\(" var "\\) *|") - (org-table-end) t) - (progn - (goto-char (match-beginning 1)) - (org-table-highlight-rectangle) - (message "Named column (column %s)" (cdr e))) - (user-error "Column name not found"))) - ((eq what 'column) - ;; Column number. - (org-table-goto-column (string-to-number (substring match 1))) - (org-table-highlight-rectangle) - (message "Column %s" (substring match 1))) - ((setq e (assoc var org-table-local-parameters)) - (goto-char table-start) - (if (re-search-forward (concat "^[ \t]*| *\\$ *.*?| *\\(" var "=\\)") nil t) - (progn - (goto-char (match-beginning 1)) - (org-table-highlight-rectangle) - (message "Local parameter.")) - (user-error "Parameter not found"))) - ((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 (assoc var org-table-formula-constants)) - (message "Constant: $%s=%s in `org-table-formula-constants'." - 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 (user-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)))) - (push pos org-show-positions) - (push table-start org-show-positions) - (let ((min (apply 'min org-show-positions)) - (max (apply 'max org-show-positions))) - (set-window-start (selected-window) min) - (goto-char max) - (or (pos-visible-in-window-p max) - (set-window-start (selected-window) max)))) + ((equal dest match)) + ((not match)) + ((eq what 'range) + (ignore-errors (org-table-get-range match table-start nil 'highlight))) + ((setq e (assoc var org-table-named-field-locations)) + (org-table-goto-field var) + (org-table-highlight-rectangle) + (message "Named field, column %d of line %d" (nth 2 e) (nth 1 e))) + ((setq e (assoc var org-table-column-names)) + (org-table-goto-column (string-to-number (cdr e))) + (org-table-highlight-rectangle) + (goto-char table-start) + (if (re-search-forward (concat "^[ \t]*| *! *.*?| *\\(" var "\\) *|") + (org-table-end) t) + (progn + (goto-char (match-beginning 1)) + (org-table-highlight-rectangle) + (message "Named column (column %s)" (cdr e))) + (user-error "Column name not found"))) + ((eq what 'column) + ;; Column number. + (org-table-goto-column (string-to-number (substring match 1))) + (org-table-highlight-rectangle) + (message "Column %s" (substring match 1))) + ((setq e (assoc var org-table-local-parameters)) + (goto-char table-start) + (if (re-search-forward (concat "^[ \t]*| *\\$ *.*?| *\\(" var "=\\)") nil t) + (progn + (goto-char (match-beginning 1)) + (org-table-highlight-rectangle) + (message "Local parameter.")) + (user-error "Parameter not found"))) + ((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 (assoc var org-table-formula-constants)) + (message "Constant: $%s=%s in `org-table-formula-constants'." + 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 (user-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)))) + (push pos org-show-positions) + (push table-start org-show-positions) + (let ((min (apply 'min org-show-positions)) + (max (apply 'max org-show-positions))) + (set-window-start (selected-window) min) + (goto-char max) + (or (pos-visible-in-window-p max) + (set-window-start (selected-window) max))))) (select-window win)))) (defun org-table-force-dataline () |