mirrors/org-mode
0
0
Fork 1
mirror of https://git.savannah.gnu.org/git/emacs/org-mode.git synced 2024-09-29 21:37:50 +00:00
Code Releases Activity

org-table: Fix editing multiple TBLFM lines

Browse source 
* lisp/org-table.el (org-table-store-formulas):
(org-table-get-stored-formulas): Add an optional argument to handle
subsequent TBLFM lines.
(org-table--fedit-source): New variable.
(org-table-edit-formulas):
(org-table-fedit-finish): Handle additional TBLFM lines.

Reported-by: Nick Dokos <ndokos@gmail.com>
<http://permalink.gmane.org/gmane.emacs.orgmode/104158>
This commit is contained in:
Nicolas Goaziou 2016-01-14 21:11:12 +01:00
parent a8f278fedf
commit 671ed99d23
1 changed files with 92 additions and 75 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

167
lisp/org-table.el
View file

@ -2247,12 +2247,16 @@ column formula? " ))
(org-table-store-formulas stored-list)) (org-table-store-formulas stored-list))
eq)) eq))
(defun org-table-store-formulas (alist) (defun org-table-store-formulas (alist &optional location)
"Store the list of formulas below the current table." "Store the list of formulas below the current table.
If optional argument LOCATION is a buffer position, insert it at
LOCATION instead."
(save-excursion (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)) (let ((case-fold-search t))
(if (looking-at "\\([ \t]*\n\\)*[ \t]*\\(#\\+tblfm:\\)\\(.*\n?\\)") (if (looking-at "\\([ \t]*\n\\)*[ \t]*\\(#\\+TBLFM:\\)\\(.*\n?\\)")
(progn (progn
;; Don't overwrite TBLFM, we might use text properties to ;; Don't overwrite TBLFM, we might use text properties to
;; store stuff. ;; store stuff.
@ -2292,10 +2296,15 @@ column formula? " ))
(and as bs (string< as bs)))) (and as bs (string< as bs))))
;;;###autoload ;;;###autoload
(defun org-table-get-stored-formulas (&optional noerror) (defun org-table-get-stored-formulas (&optional noerror location)
"Return an alist with the stored formulas directly after current table." "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 (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)) (let ((case-fold-search t))
(when (looking-at "\\([ \t]*\n\\)*[ \t]*#\\+TBLFM: *\\(.*\\)") (when (looking-at "\\([ \t]*\n\\)*[ \t]*#\\+TBLFM: *\\(.*\\)")
(let ((strings (org-split-string (org-match-string-no-properties 2) (let ((strings (org-split-string (org-match-string-no-properties 2)
@ -3528,62 +3537,70 @@ Parameters get priority."
:style toggle :selected org-table-buffer-is-an])) :style toggle :selected org-table-buffer-is-an]))
(defvar org-pos) (defvar org-pos)
(defvar org-table--fedit-source nil
"Position of the TBLFM line being edited.")
;;;###autoload ;;;###autoload
(defun org-table-edit-formulas () (defun org-table-edit-formulas ()
"Edit the formulas of the current table in a separate buffer." "Edit the formulas of the current table in a separate buffer."
(interactive) (interactive)
(when (save-excursion (beginning-of-line) (let ((at-tblfm (org-at-TBLFM-p)))
(let ((case-fold-search t)) (looking-at "[ \t]*#\\+TBLFM"))) (unless (or at-tblfm (org-at-table-p))
(beginning-of-line 0)) (user-error "Not at a table"))
(unless (org-at-table-p) (user-error "Not at a table")) (save-excursion
(org-table-analyze) ;; Move point within the table before analyzing it.
(let ((key (org-table-current-field-formula 'key 'noerror)) (when at-tblfm (re-search-backward "^[ \t]*|"))
(eql (sort (org-table-get-stored-formulas 'noerror) (org-table-analyze))
#'org-table-formula-less-p)) (let ((key (org-table-current-field-formula 'key 'noerror))
(pos (point-marker)) (eql (sort (org-table-get-stored-formulas t (and at-tblfm (point)))
(startline 1) #'org-table-formula-less-p))
(wc (current-window-configuration)) (pos (point-marker))
(sel-win (selected-window)) (source (copy-marker (line-beginning-position)))
(titles '((column . "# Column Formulas\n") (startline 1)
(field . "# Field and Range Formulas\n") (wc (current-window-configuration))
(named . "# Named Field Formulas\n")))) (sel-win (selected-window))
(org-switch-to-buffer-other-window "*Edit Formulas*") (titles '((column . "# Column Formulas\n")
(erase-buffer) (field . "# Field and Range Formulas\n")
;; Keep global-font-lock-mode from turning on font-lock-mode (named . "# Named Field Formulas\n"))))
(let ((font-lock-global-modes '(not fundamental-mode))) (org-switch-to-buffer-other-window "*Edit Formulas*")
(fundamental-mode)) (erase-buffer)
(org-set-local 'font-lock-global-modes (list 'not major-mode)) ;; Keep global-font-lock-mode from turning on font-lock-mode
(org-set-local 'org-pos pos) (let ((font-lock-global-modes '(not fundamental-mode)))
(org-set-local 'org-window-configuration wc) (fundamental-mode))
(org-set-local 'org-selected-window sel-win) (org-set-local 'font-lock-global-modes (list 'not major-mode))
(use-local-map org-table-fedit-map) (org-set-local 'org-pos pos)
(org-add-hook 'post-command-hook #'org-table-fedit-post-command t t) (org-set-local 'org-table--fedit-source source)
(easy-menu-add org-table-fedit-menu) (org-set-local 'org-window-configuration wc)
(setq startline (org-current-line)) (org-set-local 'org-selected-window sel-win)
(dolist (entry eql) (use-local-map org-table-fedit-map)
(let* ((type (cond (org-add-hook 'post-command-hook #'org-table-fedit-post-command t t)
((string-match "\\`$\\([0-9]+\\|[<>]+\\)\\'" (car entry)) (easy-menu-add org-table-fedit-menu)
'column) (setq startline (org-current-line))
((equal (string-to-char (car entry)) ?@) 'field) (dolist (entry eql)
(t 'named))) (let* ((type (cond
(title (assq type titles))) ((string-match "\\`$\\([0-9]+\\|[<>]+\\)\\'" (car entry))
(when title 'column)
(unless (bobp) (insert "\n")) ((equal (string-to-char (car entry)) ?@) 'field)
(insert (org-add-props (cdr title) nil 'face font-lock-comment-face)) (t 'named)))
(setq titles (remove title titles))) (title (assq type titles)))
(when (equal key (car entry)) (setq startline (org-current-line))) (when title
(let ((s (concat (if (member (string-to-char (car entry)) '(?@ ?$)) "" "$") (unless (bobp) (insert "\n"))
(car entry) " = " (cdr entry) "\n"))) (insert
(remove-text-properties 0 (length s) '(face nil) s) (org-add-props (cdr title) nil 'face font-lock-comment-face))
(insert s)))) (setq titles (remove title titles)))
(when (eq org-table-use-standard-references t) (when (equal key (car entry)) (setq startline (org-current-line)))
(org-table-fedit-toggle-ref-type)) (let ((s (concat
(org-goto-line startline) (if (memq (string-to-char (car entry)) '(?@ ?$)) "" "$")
(message (car entry) " = " (cdr entry) "\n")))
(substitute-command-keys "\\<org-mode-map>\ (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]'. \ 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 () (defun org-table-fedit-post-command ()
(when (not (memq this-command '(lisp-complete-symbol))) (when (not (memq this-command '(lisp-complete-symbol)))
@ -3827,31 +3844,31 @@ a translation reference."
With prefix ARG, apply the new formulas to the table." With prefix ARG, apply the new formulas to the table."
(interactive "P") (interactive "P")
(org-table-remove-rectangle-highlight) (org-table-remove-rectangle-highlight)
(if org-table-use-standard-references (when org-table-use-standard-references
(progn (org-table-fedit-convert-buffer 'org-table-convert-refs-to-rc)
(org-table-fedit-convert-buffer 'org-table-convert-refs-to-rc) (setq org-table-buffer-is-an nil))
(setq org-table-buffer-is-an nil))) (let ((pos org-pos)
(let ((pos org-pos) (sel-win org-selected-window) eql var form) (sel-win org-selected-window)
(source org-table--fedit-source)
eql)
(goto-char (point-min)) (goto-char (point-min))
(while (re-search-forward (while (re-search-forward
"^\\(@[-+I<>0-9.$@]+\\|@?[0-9]+\\|\\$\\([a-zA-Z0-9]+\\|[<>]+\\)\\) *= *\\(.*\\(\n[ \t]+.*$\\)*\\)" "^\\(@[-+I<>0-9.$@]+\\|@?[0-9]+\\|\\$\\([a-zA-Z0-9]+\\|[<>]+\\)\\) *= *\\(.*\\(\n[ \t]+.*$\\)*\\)"
nil t) nil t)
(setq var (match-string 1)) (let ((var (match-string 1))
(setq form (org-trim (match-string 3))) (form (org-trim (match-string 3))))
(unless (equal form "") (unless (equal form "")
(while (string-match "[ \t]*\n[ \t]*" form) (while (string-match "[ \t]*\n[ \t]*" form)
(setq form (replace-match " " t t form))) (setq form (replace-match " " t t form)))
(when (assoc var eql) (when (assoc var eql)
(user-error "Double formulas for %s" var)) (user-error "Double formulas for %s" var))
(push (cons var form) eql))) (push (cons var form) eql))))
(setq org-pos nil)
(set-window-configuration org-window-configuration) (set-window-configuration org-window-configuration)
(select-window sel-win) (select-window sel-win)
(goto-char pos) (goto-char source)
(unless (org-at-table-p)
(user-error "Lost table position - cannot install formulas"))
(org-table-store-formulas eql) (org-table-store-formulas eql)
(move-marker pos nil) (set-marker pos nil)
(set-marker source nil)
(kill-buffer "*Edit Formulas*") (kill-buffer "*Edit Formulas*")
(if arg (if arg
(org-table-recalculate 'all) (org-table-recalculate 'all)