From 17e28d6467d146dc88eaa1ee461e34c395e28f6e Mon Sep 17 00:00:00 2001
From: Nicolas Goaziou <mail@nicolasgoaziou.fr>
Date: Tue, 23 Oct 2018 23:27:28 +0200
Subject: [PATCH] org-capture: Various fixes to item capture

* lisp/org-capture.el (org-capture-place-item): Rewrite function.
* testing/lisp/test-org-capture.el (test-org-capture/abort): Add test.
(test-org-capture/item): New test.
---
 lisp/org-capture.el              | 160 +++++++++++++++++---------
 testing/lisp/test-org-capture.el | 192 +++++++++++++++++++++++++++++++
 2 files changed, 295 insertions(+), 57 deletions(-)

diff --git a/lisp/org-capture.el b/lisp/org-capture.el
index 153b17f67..bb83e077c 100644
--- a/lisp/org-capture.el
+++ b/lisp/org-capture.el
@@ -1147,63 +1147,109 @@ may have been stored before."
 
 (defun org-capture-place-item ()
   "Place the template as a new plain list item."
-  (let* ((txt (org-capture-get :template))
-	 (target-entry-p (org-capture-get :target-entry-p))
-	 (ind 0)
-	 beg end)
-    (if (org-capture-get :exact-position)
-	(goto-char (org-capture-get :exact-position))
-      (cond
-       ((not target-entry-p)
-	;; Insert as top-level entry, either at beginning or at end of file
-	(setq beg (point-min) end (point-max)))
-       (t
-	(setq beg (1+ (point-at-eol))
-	      end (save-excursion (outline-next-heading) (point)))))
-      (setq ind nil)
-      (if (org-capture-get :prepend)
-	  (progn
-	    (goto-char beg)
-	    (when (org-list-search-forward (org-item-beginning-re) end t)
-	      (goto-char (match-beginning 0))
-	      (setq ind (current-indentation))))
-	(goto-char end)
-	(when (org-list-search-backward (org-item-beginning-re) beg t)
-	  (setq ind (current-indentation))
-	  (org-end-of-item)))
-      (unless ind (goto-char end)))
-    ;; Remove common indentation
-    (setq txt (org-remove-indentation txt))
-    ;; Make sure this is indeed an item
-    (unless (string-match (concat "\\`" (org-item-re)) txt)
-      (setq txt (concat "- "
-			(mapconcat 'identity (split-string txt "\n")
-				   "\n  "))))
-    ;; Prepare surrounding empty lines.
-    (unless (bolp) (insert "\n"))
-    (org-capture-empty-lines-before)
-    (setq beg (point))
-    (unless (eolp) (save-excursion (insert "\n")))
-    (unless ind
-      (org-indent-line)
-      (setq ind (current-indentation))
-      (delete-region beg (point)))
-    ;; Set the correct indentation, depending on context
-    (setq ind (make-string ind ?\ ))
-    (setq txt (concat ind
-		      (mapconcat 'identity (split-string txt "\n")
-				 (concat "\n" ind))
-		      "\n"))
-    ;; Insert item.
-    (insert txt)
-    (org-capture-empty-lines-after)
-    (org-capture-position-for-last-stored beg)
-    (setq end (point))
-    (org-capture-mark-kill-region beg end)
-    (org-capture-narrow beg end)
-    (when (or (re-search-backward "%\\?" beg t)
-	      (re-search-forward "%\\?" end t))
-      (replace-match ""))))
+  (let ((prepend? (org-capture-get :prepend))
+	(template (org-remove-indentation (org-capture-get :template)))
+	item)
+    ;; Make template suitable for insertion.  In particular, add
+    ;; a main bullet if it is missing.
+    (unless (string-match-p (concat "\\`" (org-item-re)) template)
+      (setq template (concat "- " (mapconcat #'identity
+					     (split-string template "\n")
+					     "\n  "))))
+    ;; Delimit the area where we should look for a plain list.
+    (pcase-let ((`(,beg . ,end)
+		 (cond ((org-capture-get :exact-position)
+			;; User gave a specific position.  Start
+			;; looking for lists from here.
+			(cons (save-excursion
+				(goto-char (org-capture-get :exact-position))
+				(line-beginning-position))
+			      (org-entry-end-position)))
+		       ((org-capture-get :target-entry-p)
+			;; At a heading, limit search to its body.
+			(cons (line-beginning-position 2)
+			      (org-entry-end-position)))
+		       (t
+			;; Table is not necessarily under a heading.
+			;; Search whole buffer.
+			(cons (point-min) (point-max))))))
+      ;; Find the first plain list in the delimited area.
+      (goto-char beg)
+      (let ((item-regexp (org-item-beginning-re)))
+	(catch :found
+	  (while (re-search-forward item-regexp end t)
+	    (when (setq item (org-element-lineage
+			      (org-element-at-point) '(plain-list) t))
+	      (goto-char (org-element-property (if prepend? :post-affiliated
+						 :contents-end)
+					       item))
+	      (throw :found t)))
+	  ;; No list found.  Move to the location when to insert
+	  ;; template.
+	  (goto-char (if prepend? beg end)))))
+    ;; Insert template.
+    (let ((origin (point)))
+      (unless (bolp) (insert "\n"))
+      ;; When a new list is created, always obey to `:empty-lines' and
+      ;; friends.
+      ;;
+      ;; When capturing in an existing list, do not change blank lines
+      ;; above or below the list; consider it to be a stable
+      ;; structure.  However, we can control how many blank lines
+      ;; separate items.  So obey to `:empty-lines' between items as
+      ;; long as it does not insert more than one empty line.  In the
+      ;; specific case of empty lines above, it means we only obey the
+      ;; parameter when appending an item.
+      (unless (and item prepend?)
+	(org-capture-empty-lines-before
+	 (and item
+	      (not prepend?)
+	      (min 1 (or (org-capture-get :empty-lines-before)
+			 (org-capture-get :empty-lines)
+			 0)))))
+      (org-capture-position-for-last-stored (point))
+      (let ((beg (line-beginning-position))
+	    (end (progn
+		   (insert (org-trim template) "\n")
+		   (point-marker))))
+	(when item
+	  (let ((i (save-excursion
+		     (goto-char (org-element-property :post-affiliated item))
+		     (current-indentation))))
+	    (save-excursion
+	      (goto-char beg)
+	      (save-excursion
+		(while (< (point) end)
+		  (indent-to i)
+		  (forward-line)))
+	      ;; Pre-pending an item could change the type of the list
+	      ;; if there is a mismatch.  In this situation,
+	      ;; prioritize the existing list.
+	      (when prepend?
+		(let ((ordered? (eq 'ordered (org-element-property :type item))))
+		  (when (org-xor ordered?
+				 (string-match-p "\\`[A-Za-z0-9]\\([.)]\\)"
+						 template))
+		    (org-cycle-list-bullet (if ordered? "1." "-")))))
+	      ;; Eventually repair the list for proper indentation and
+	      ;; bullets.
+	      (org-list-repair))))
+	;; Limit number of empty lines.  See above for details.
+	(unless (and item (not prepend?))
+	  (org-capture-empty-lines-after
+	   (and item
+		prepend?
+		(min 1 (or (org-capture-get :empty-lines-after)
+			   (org-capture-get :empty-lines)
+			   0)))))
+	(org-capture-mark-kill-region origin (point))
+	;; ITEM always end with a newline character.  Make sure we do
+	;; not narrow at the beginning of the next line, possibly
+	;; altering its structure (e.g., when it is a headline).
+	(org-capture-narrow beg (1- end))
+	(when (or (search-backward "%?" beg t)
+		  (search-forward "%?" end t))
+	  (replace-match ""))))))
 
 (defun org-capture-place-table-line ()
   "Place the template as a table line."
diff --git a/testing/lisp/test-org-capture.el b/testing/lisp/test-org-capture.el
index f53c15472..9d9ef1033 100644
--- a/testing/lisp/test-org-capture.el
+++ b/testing/lisp/test-org-capture.el
@@ -161,6 +161,15 @@
 	(insert "Capture text")
 	(org-capture-kill))
       (buffer-string))))
+  (should
+   (equal "- A\n  - B"
+	  (org-test-with-temp-text-in-file "- A\n  - B"
+	    (let* ((file (buffer-file-name))
+		   (org-capture-templates
+		    `(("t" "Item" item (file ,file) "- X"))))
+	      (org-capture nil "t")
+	      (org-capture-kill))
+	    (buffer-string))))
   (should
    (equal "| a |\n| b |"
 	  (org-test-with-temp-text-in-file "| a |\n| b |"
@@ -199,6 +208,189 @@
 	(org-capture-finalize))
       (buffer-string)))))
 
+(ert-deftest test-org-capture/item ()
+  "Test `item' type in capture template."
+  ;; Insert item in the first plain list found at the target location.
+  (should
+   (equal
+    "* A\n- list 1\n- X\n\n\n1. list 2"
+    (org-test-with-temp-text-in-file "* A\n- list 1\n\n\n1. list 2"
+      (let* ((file (buffer-file-name))
+	     (org-capture-templates
+	      `(("t" "Item" item (file+headline ,file "A") "- X"))))
+	(org-capture nil "t")
+	(org-capture-finalize))
+      (buffer-string))))
+  (should
+   (equal
+    "Text\n- list 1\n- X\n\n\n1. list 2"
+    (org-test-with-temp-text-in-file "Text\n- list 1\n\n\n1. list 2"
+      (let* ((file (buffer-file-name))
+	     (org-capture-templates
+	      `(("t" "Item" item (file ,file) "- X"))))
+	(org-capture nil "t")
+	(org-capture-finalize))
+      (buffer-string))))
+  ;; When targeting a specific location, start looking for plain lists
+  ;; from there.
+  (should
+   (equal
+    "* A\n- skip\n\n\n1. here\n2. X\n"
+    (org-test-with-temp-text-in-file "* A\n- skip\n\n\n1. here"
+      (let* ((file (buffer-file-name))
+	     (org-capture-templates
+	      `(("t" "Item" item (file+regexp ,file "here") "1. X"))))
+	(org-capture nil "t")
+	(org-capture-finalize))
+      (buffer-string))))
+  ;; If there is no such list, create it.
+  (should
+   (equal
+    "* A\n- X\n"
+    (org-test-with-temp-text-in-file "* A"
+      (let* ((file (buffer-file-name))
+	     (org-capture-templates
+	      `(("t" "Item" item (file+headline ,file "A") "- X"))))
+	(org-capture nil "t")
+	(org-capture-finalize))
+      (buffer-string))))
+  ;; When `:prepend' is non-nil, insert new item as the first item.
+  (should
+   (equal
+    "* A\n- X\n- 1\n- 2"
+    (org-test-with-temp-text-in-file "* A\n- 1\n- 2"
+      (let* ((file (buffer-file-name))
+	     (org-capture-templates
+	      `(("t" "Item" item (file+headline ,file "A") "- X"
+		 :prepend t))))
+	(org-capture nil "t")
+	(org-capture-finalize))
+      (buffer-string))))
+  ;; When `:prepend' is nil, insert new item as the last top-level
+  ;; item.
+  (should
+   (equal
+    "* A\n- 1\n  - 2\n- X\n"
+    (org-test-with-temp-text-in-file "* A\n- 1\n  - 2"
+      (let* ((file (buffer-file-name))
+	     (org-capture-templates
+	      `(("t" "Item" item (file+headline ,file "A") "- X"))))
+	(org-capture nil "t")
+	(org-capture-finalize))
+      (buffer-string))))
+  ;; When targeting a specific location, one can insert in a sub-list.
+  (should
+   (equal
+    "* A\n- skip\n  - here\n  - X\n- skip"
+    (org-test-with-temp-text-in-file "* A\n- skip\n  - here\n- skip"
+      (let* ((file (buffer-file-name))
+	     (org-capture-templates
+	      `(("t" "Item" item (file+regexp ,file "here") "- X"))))
+	(org-capture nil "t")
+	(org-capture-finalize))
+      (buffer-string))))
+  ;; Obey `:empty-lines' when creating a new list.
+  (should
+   (equal
+    "\n- X\n\n\n* H"
+    (org-test-with-temp-text-in-file "\n* H"
+      (let* ((file (buffer-file-name))
+	     (org-capture-templates
+	      `(("t" "Item" item (file ,file) "- X"
+		 :empty-lines-before 1 :empty-lines-after 2 :prepend t))))
+	(org-capture nil "t")
+	(org-capture-finalize))
+      (buffer-string))))
+  ;; Obey `:empty-lines' in an existing list only between items, and
+  ;; only if the value doesn't break the list.
+  (should
+   (equal
+    "- A\n\n- X\nText"
+    (org-test-with-temp-text-in-file "- A\nText"
+      (let* ((file (buffer-file-name))
+	     (org-capture-templates
+	      `(("t" "Item" item (file ,file) "- X" :empty-lines 1))))
+	(org-capture nil "t")
+	(org-capture-finalize))
+      (buffer-string))))
+  (should
+   (equal
+    "Text\n- X\n\n- A"
+    (org-test-with-temp-text-in-file "Text\n- A"
+      (let* ((file (buffer-file-name))
+	     (org-capture-templates
+	      `(("t" "Item" item (file ,file) "- X"
+		 :prepend t :empty-lines 1))))
+	(org-capture nil "t")
+	(org-capture-finalize))
+      (buffer-string))))
+  (should-not
+   (equal
+    "- A\n\n\n- X"
+    (org-test-with-temp-text-in-file "- A"
+      (let* ((file (buffer-file-name))
+	     (org-capture-templates
+	      `(("t" "Item" item (file ,file) "- X" :empty-lines 2))))
+	(org-capture nil "t")
+	(org-capture-finalize))
+      (buffer-string))))
+  ;; Preserve list type when pre-pending.
+  (should
+   (equal
+    "1. X\n2. A"
+    (org-test-with-temp-text-in-file "1. A"
+      (let* ((file (buffer-file-name))
+	     (org-capture-templates
+	      `(("t" "Item" item (file ,file) "- X" :prepend t))))
+	(org-capture nil "t")
+	(org-capture-finalize))
+      (buffer-string))))
+  ;; Handle indentation.  Handle multi-lines templates.
+  (should
+   (equal
+    "  - A\n  - X\n"
+    (org-test-with-temp-text-in-file "  - A"
+      (let* ((file (buffer-file-name))
+	     (org-capture-templates
+	      `(("t" "Item" item (file ,file) "- X"))))
+	(org-capture nil "t")
+	(org-capture-finalize))
+      (buffer-string))))
+  (should
+   (equal
+    "  - A\n  - X\n    Line 2\n"
+    (org-test-with-temp-text-in-file "  - A"
+      (let* ((file (buffer-file-name))
+	     (org-capture-templates
+	      `(("t" "Item" item (file ,file) "- X\n  Line 2"))))
+	(org-capture nil "t")
+	(org-capture-finalize))
+      (buffer-string))))
+  ;; Handle incomplete templates.
+  (should
+   (equal
+    "- A\n- X\n"
+    (org-test-with-temp-text-in-file "- A"
+      (let* ((file (buffer-file-name))
+	     (org-capture-templates
+	      `(("t" "Item" item (file ,file) "X"))))
+	(org-capture nil "t")
+	(org-capture-finalize))
+      (buffer-string))))
+  ;; Do not break next headline.
+  (should-not
+   (equal
+    "- A\n- X\nFoo* H"
+    (org-test-with-temp-text-in-file "- A\n* H"
+      (let* ((file (buffer-file-name))
+	     (org-capture-templates
+	      `(("t" "Item" item (file ,file) "- X"))))
+	(org-capture nil "t")
+	(goto-char (point-max))
+	(insert "Foo")
+	(org-capture-finalize))
+      (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.