Просмотр исходного кода

org-capture: Fix capturing in a table

* lisp/org-capture.el (org-capture-place-table-line): Rewrite function.
* testing/lisp/test-org-capture.el (test-org-capture/table-line): New
  test.
Nicolas Goaziou 6 лет назад
Родитель
Сommit
ab53ee2c3d
2 измененных файлов с 177 добавлено и 69 удалено
  1. 61 68
      lisp/org-capture.el
  2. 116 1
      testing/lisp/test-org-capture.el

+ 61 - 68
lisp/org-capture.el

@@ -59,12 +59,13 @@
 (declare-function org-table-current-dline "org-table" ())
 (declare-function org-table-goto-line "org-table" (N))
 
+(defvar dired-buffers)
 (defvar org-end-time-was-given)
 (defvar org-remember-default-headline)
 (defvar org-remember-templates)
-(defvar org-table-hlines)
+(defvar org-table-border-regexp)
 (defvar org-table-current-begin-pos)
-(defvar dired-buffers)
+(defvar org-table-hlines)
 
 (defvar org-capture-clock-was-started nil
   "Internal flag, noting if the clock was started.")
@@ -1199,85 +1200,77 @@ may have been stored before."
 (defun org-capture-place-table-line ()
   "Place the template as a table line."
   (require 'org-table)
-  (let* ((txt (org-capture-get :template))
-	 (target-entry-p (org-capture-get :target-entry-p))
-	 (table-line-pos (org-capture-get :table-line-pos))
-	 beg end)
+  (let ((text
+	 (pcase (org-trim (org-capture-get :template))
+	   ((pred (string-match-p org-table-border-regexp))
+	    "| %?Bad template |")
+	   (text (concat text "\n"))))
+	(table-line-pos (org-capture-get :table-line-pos))
+	beg end)
     (cond
      ((org-capture-get :exact-position)
       (goto-char (org-capture-get :exact-position)))
-     ((not target-entry-p)
-      ;; Table is not necessarily under a heading
+     ((not (org-capture-get :target-entry-p))
+      ;; Table is not necessarily under a heading.  Find first table
+      ;; in the buffer.
       (setq beg (point-min) end (point-max)))
      (t
-      ;; WE are at a heading, limit search to the body
-      (setq beg (1+ (point-at-eol))
-	    end (save-excursion (outline-next-heading) (point)))))
-    (if (re-search-forward org-table-dataline-regexp end t)
-	(let ((b (org-table-begin)) (e (org-table-end)) (case-fold-search t))
-	  (goto-char e)
-	  (if (looking-at "[ \t]*#\\+tblfm:")
-	      (forward-line 1))
-	  (narrow-to-region b (point)))
+      ;; We are at a heading, limit search to the body.
+      (setq beg (line-beginning-position 2))
+      (setq end (save-excursion (outline-next-heading) (point)))))
+    (goto-char beg)
+    ;; Narrow to the table, possibly creating one if necessary.
+    (catch :found
+      (while (re-search-forward org-table-dataline-regexp end t)
+	(pcase (org-element-lineage (org-element-at-point) '(table) t)
+	  (`nil nil)
+	  (table
+	   (goto-char (org-element-property :end table))
+	   (skip-chars-backward " \r\t\n")
+	   (forward-line)
+	   (narrow-to-region (org-element-property :post-affiliated table)
+			     (point))
+	   (throw :found t))))
+      ;; No table found.  Create it with an empty header.
       (goto-char end)
-      (insert "\n|   |\n|----|\n|    |\n")
-      (narrow-to-region (1+ end) (point)))
-    ;; We are narrowed to the table, or to an empty line if there was no table
-
-    ;; Check if the template is good
-    (if (not (string-match org-table-dataline-regexp txt))
-	(setq txt "| %?Bad template |\n"))
-    (if (functionp table-line-pos)
-	(setq table-line-pos (funcall table-line-pos))
-      (setq table-line-pos (eval table-line-pos)))
+      (unless (bolp) (insert "\n"))
+      (let ((origin (point)))
+	(insert "|   |\n|----|\n")
+	(narrow-to-region origin (point))))
+    ;; In the current table, find the appropriate location for TEXT.
     (cond
      ((and table-line-pos
-	   (string-match "\\(I+\\)\\([-+][0-9]\\)" table-line-pos))
+	   (string-match "\\(I+\\)\\([-+][0-9]+\\)" table-line-pos))
       (goto-char (point-min))
-      ;; we have a complex line specification
-      (let ((ll (ignore-errors
-		  (save-match-data (org-table-analyze))
-		  (aref org-table-hlines
-			(- (match-end 1) (match-beginning 1)))))
+      (let ((line
+	     (condition-case _
+		 (progn
+		   (save-match-data (org-table-analyze))
+		   (aref org-table-hlines
+			 (- (match-end 1) (match-beginning 1))))
+	       (error
+		(error "Invalid table line specification %S" table-line-pos))))
 	    (delta (string-to-number (match-string 2 table-line-pos))))
-	;; The user wants a special position in the table
-	(unless ll
-	  (error "Invalid table line specification \"%s\"" table-line-pos))
-	(goto-char org-table-current-begin-pos)
-	(forward-line (+ ll delta (if (< delta 0) 0 -1)))
-	(org-table-insert-row 'below)
-	(beginning-of-line 1)
-	(delete-region (point) (1+ (point-at-eol)))
-	(setq beg (point))
-	(insert txt)
-	(setq end (point))))
+	(forward-line (+ line delta (if (< delta 0) 0 -1)))
+	(forward-line)))		;insert below
      ((org-capture-get :prepend)
       (goto-char (point-min))
-      (re-search-forward org-table-hline-regexp nil t)
-      (beginning-of-line 1)
-      (re-search-forward org-table-dataline-regexp nil t)
-      (beginning-of-line 1)
-      (setq beg (point))
-      (org-table-insert-row)
-      (beginning-of-line 1)
-      (delete-region (point) (1+ (point-at-eol)))
-      (insert txt)
-      (setq end (point)))
+      (cond
+       ((not (re-search-forward org-table-hline-regexp nil t)))
+       ((re-search-forward org-table-dataline-regexp nil t) (beginning-of-line))
+       (t (goto-char (org-table-end)))))
      (t
-      (goto-char (point-max))
-      (re-search-backward org-table-dataline-regexp nil t)
-      (beginning-of-line 1)
-      (org-table-insert-row 'below)
-      (beginning-of-line 1)
-      (delete-region (point) (1+ (point-at-eol)))
-      (setq beg (point))
-      (insert txt)
-      (setq end (point))))
-    (goto-char beg)
-    (org-capture-position-for-last-stored 'table-line)
-    (if (or (re-search-backward "%\\?" beg t)
-	    (re-search-forward "%\\?" end t))
-	(replace-match ""))
+      (goto-char (org-table-end))))
+    ;; Insert text and position point according to template.
+    (unless (bolp) (insert "\n"))
+    (let ((beg (point))
+	  (end (save-excursion
+		 (insert text)
+		 (point))))
+      (org-capture-position-for-last-stored 'table-line)
+      (when (or (re-search-backward "%\\?" beg t)
+		(re-search-forward "%\\?" end t))
+	(replace-match "")))
     (org-table-align)))
 
 (defun org-capture-place-plain-text ()

+ 116 - 1
testing/lisp/test-org-capture.el

@@ -145,7 +145,6 @@
 	     (org-capture-refile)
 	     (list file1 file2 (buffer-file-name)))))))))
 
-
 (ert-deftest test-org-capture/insert-at-end-abort ()
   "Test that capture can be aborted after inserting at end of capture buffer."
   (should
@@ -161,6 +160,122 @@
 	(org-capture-kill))
       (buffer-string)))))
 
+(ert-deftest test-org-capture/table-line ()
+  "Test `table-line' type in capture template."
+  ;; When a only file is specified, use the first table available.
+  (should
+   (equal "Text
+
+| a |
+| x |
+
+| b |"
+	  (org-test-with-temp-text-in-file "Text\n\n| a |\n\n| b |"
+	    (let* ((file (buffer-file-name))
+		   (org-capture-templates
+		    `(("t" "Table" table-line (file ,file) "| x |"
+		       :immediate-finish t))))
+	      (org-capture nil "t"))
+	    (buffer-string))))
+  ;; When an entry is specified, find the first table in the
+  ;; corresponding section.
+  (should
+   (equal "* Foo
+| a |
+* Inbox
+| b |
+| x |
+"
+	  (org-test-with-temp-text-in-file "* Foo\n| a |\n* Inbox\n| b |\n"
+	    (let* ((file (buffer-file-name))
+		   (org-capture-templates
+		    `(("t" "Table" table-line (file+headline ,file "Inbox")
+		       "| x |" :immediate-finish t))))
+	      (org-capture nil "t"))
+	    (buffer-string))))
+  (should
+   (equal "* Inbox
+| a |
+| x |
+
+| b |
+"
+	  (org-test-with-temp-text-in-file "* Inbox\n| a |\n\n| b |\n"
+	    (let* ((file (buffer-file-name))
+		   (org-capture-templates
+		    `(("t" "Table" table-line (file+headline ,file "Inbox")
+		       "| x |" :immediate-finish t))))
+	      (org-capture nil "t"))
+	    (buffer-string))))
+  ;; Create a new table with an empty header when none can be found.
+  (should
+   (equal "|   |   |\n|---+---|\n| a | b |\n"
+	  (org-test-with-temp-text-in-file ""
+	    (let* ((file (buffer-file-name))
+		   (org-capture-templates
+		    `(("t" "Table" table-line (file ,file) "| a | b |"
+		       :immediate-finish t))))
+	      (org-capture nil "t"))
+	    (buffer-string))))
+  ;; When `:prepend' is nil, add the row at the end of the table.
+  (should
+   (equal "| a |\n| x |\n"
+	  (org-test-with-temp-text-in-file "| a |"
+	    (let* ((file (buffer-file-name))
+		   (org-capture-templates
+		    `(("t" "Table" table-line (file ,file)
+		       "| x |" :immediate-finish t))))
+	      (org-capture nil "t"))
+	    (buffer-string))))
+  ;; When `:prepend' is non-nil, add it as the first row after the
+  ;; header, if there is one, or the first row otherwise.
+  (should
+   (equal "| a |\n|---|\n| x |\n| b |"
+	  (org-test-with-temp-text-in-file "| a |\n|---|\n| b |"
+	    (let* ((file (buffer-file-name))
+		   (org-capture-templates
+		    `(("t" "Table" table-line (file ,file)
+		       "| x |" :immediate-finish t :prepend t))))
+	      (org-capture nil "t"))
+	    (buffer-string))))
+  (should
+   (equal "| x |\n| a |"
+	  (org-test-with-temp-text-in-file "| a |"
+	    (let* ((file (buffer-file-name))
+		   (org-capture-templates
+		    `(("t" "Table" table-line (file ,file)
+		       "| x |" :immediate-finish t :prepend t))))
+	      (org-capture nil "t"))
+	    (buffer-string))))
+  ;; When `:table-line-pos' is set and is meaningful, obey it.
+  (should
+   (equal "| a |\n|---|\n| b |\n| x |\n|---|\n| c |"
+	  (org-test-with-temp-text-in-file "| a |\n|---|\n| b |\n|---|\n| c |"
+	    (let* ((file (buffer-file-name))
+		   (org-capture-templates
+		    `(("t" "Table" table-line (file ,file)
+		       "| x |" :immediate-finish t :table-line-pos "II-1"))))
+	      (org-capture nil "t"))
+	    (buffer-string))))
+  (should
+   (equal "| a |\n|---|\n| x |\n| b |\n|---|\n| c |"
+	  (org-test-with-temp-text-in-file "| a |\n|---|\n| b |\n|---|\n| c |"
+	    (let* ((file (buffer-file-name))
+		   (org-capture-templates
+		    `(("t" "Table" table-line (file ,file)
+		       "| x |" :immediate-finish t :table-line-pos "I+1"))))
+	      (org-capture nil "t"))
+	    (buffer-string))))
+  ;; Throw an error on invalid `:table-line-pos' specifications.
+  (should-error
+   (org-test-with-temp-text-in-file "| a |"
+     (let* ((file (buffer-file-name))
+	    (org-capture-templates
+	     `(("t" "Table" table-line (file ,file)
+		"| x |" :immediate-finish t :table-line-pos "II+99"))))
+       (org-capture nil "t")
+       t))))
+
 
 (provide 'test-org-capture)
 ;;; test-org-capture.el ends here