Browse Source

org-table: Fix editing multiple TBLFM lines

* 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>
Nicolas Goaziou 4 years ago
parent
commit
671ed99d23
1 changed files with 92 additions and 75 deletions
  1. 92 75
      lisp/org-table.el

+ 92 - 75
lisp/org-table.el

@@ -2247,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.
@@ -2292,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)
@@ -3528,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 "\\`$\\([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 (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)))
@@ -3827,31 +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 (match-string 1))
-      (setq 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)))
-    (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)