todo-mode.el: Fix handling of hidden item headers (bug#27609)

* lisp/calendar/todo-mode.el (todo--item-headers-hidden): New variable.
(todo-toggle-item-header): Use it.  Make this command a noop
if the file has no items.
(todo-move-item, todo-item-done): Instead of concatenating the
items to move into one string, make a list of them to
facilitate handling hidden headers.  Adjust insertion accordingly.
(todo-archive-done-item): Handle hidden headers in archive file.
(todo-unarchive-items): Handle hidden headers in todo file.
(todo-backward-item): Use todo--item-headers-hidden and handle
moving backward work when item date-time headers are hidden.
(todo-remove-item): Delete date-time header overlay.
(todo-get-overlay, todo-insert-with-overlays): Make them work
with hidden date-time headers.
(todo-modes-set-2): Make todo--item-headers-hidden buffer local.

1 files changed, 124 insertions, 61 deletions

diff --git a/lisp/calendar/todo-mode.el b/lisp/calendar/todo-mode.el
index eb8d3d65eb5..235eb83e85b 100644
--- a/lisp/calendar/todo-mode.el
+++ b/lisp/calendar/todo-mode.el
@@ -1034,29 +1034,41 @@ empty line above the done items separator."
         (hl-line-mode -1)
       (hl-line-mode 1))))
 
+(defvar todo--item-headers-hidden nil
+  "Non-nil if item date-time headers in current buffer are hidden.")
+
 (defun todo-toggle-item-header ()
   "Hide or show item date-time headers in the current file.
 With done items, this hides only the done date-time string, not
 the the original date-time string."
   (interactive)
-  (save-excursion
-    (save-restriction
-      (goto-char (point-min))
-      (let ((ov (todo-get-overlay 'header)))
-        (if ov
-            (remove-overlays 1 (1+ (buffer-size)) 'todo 'header)
-          (widen)
-          (goto-char (point-min))
-          (while (not (eobp))
-            (when (re-search-forward
-                   (concat todo-item-start
-                           "\\( " diary-time-regexp "\\)?"
-                           (regexp-quote todo-nondiary-end) "? ")
-                   nil t)
-              (setq ov (make-overlay (match-beginning 0) (match-end 0) nil t))
-              (overlay-put ov 'todo 'header)
-              (overlay-put ov 'display ""))
-            (todo-forward-item)))))))
+  (unless (catch 'nonempty
+            (dolist (type '(todo done))
+              (dolist (c todo-categories)
+                (let ((count (todo-get-count type (car c))))
+                  (unless (zerop count)
+                    (throw 'nonempty t))))))
+    (user-error "This file has no items"))
+  (if todo--item-headers-hidden
+      (progn
+        (remove-overlays 1 (1+ (buffer-size)) 'todo 'header)
+        (setq todo--item-headers-hidden nil))
+    (save-excursion
+      (save-restriction
+        (widen)
+        (goto-char (point-min))
+        (let (ov)
+          (while (not (eobp))
+            (when (re-search-forward
+                   (concat todo-item-start
+                           "\\( " diary-time-regexp "\\)?"
+                           (regexp-quote todo-nondiary-end) "? ")
+                   nil t)
+              (setq ov (make-overlay (match-beginning 0) (match-end 0) nil t))
+              (overlay-put ov 'todo 'header)
+              (overlay-put ov 'display ""))
+            (forward-line)))
+        (setq todo--item-headers-hidden t)))))
 
 ;; -----------------------------------------------------------------------------
 ;;; File and category editing
@@ -2673,7 +2685,7 @@ section in the category moved to."
              (num todo-category-number)
              (item (todo-item-string))
              (diary-item (todo-diary-item-p))
-             (done-item (and (todo-done-item-p) (concat item "\n")))
+             (done-item (and (todo-done-item-p) item))
              (omark (save-excursion (todo-item-start) (point-marker)))
              (todo 0)
              (diary 0)
@@ -2703,43 +2715,51 @@ section in the category moved to."
               (while (not (eobp))
                 (when (todo-marked-item-p)
                   (if (todo-done-item-p)
-                      (setq done-items (concat done-items
-                                               (todo-item-string) "\n")
-                            done (1+ done))
-                    (setq todo-items (concat todo-items
-                                             (todo-item-string) "\n")
-                          todo (1+ todo))
+                      (progn
+                        (push (todo-item-string) done-items)
+                        (setq done (1+ done)))
+                    (push (todo-item-string) todo-items)
+                    (setq todo (1+ todo))
                     (when (todo-diary-item-p)
                       (setq diary (1+ diary)))))
                 (todo-forward-item))
-              ;; Chop off last newline of multiple todo item string,
-              ;; since it will be reinserted when setting priority
-              ;; (but with done items priority is not set, so keep
-              ;; last newline).
-              (and todo-items
-                   (setq todo-items (substring todo-items 0 -1))))
+              (setq todo-items (nreverse todo-items))
+              (setq done-items (nreverse done-items)))
           (if (todo-done-item-p)
-              (setq done 1)
-            (setq todo 1)
+              (progn
+                (push done-item done-items)
+                (setq done 1))
+            (push item todo-items)
+            (setq todo 1)
             (when (todo-diary-item-p) (setq diary 1))))
         (set-window-buffer (selected-window)
                            (set-buffer (find-file-noselect file2 'nowarn)))
         (unwind-protect
-            (progn
-              (when (or todo-items (and item (not done-item)))
-                (todo-set-item-priority (or todo-items item) cat2 t))
+            (let (here)
+              (when todo-items
+                (todo-set-item-priority (pop todo-items) cat2 t)
+                (setq here (point))
+                (while todo-items
+                  (todo-forward-item)
+                  (todo-insert-with-overlays (pop todo-items))))
               ;; Move done items en bloc to top of done items section.
-              (when (or done-items done-item)
+              (when done-items
                 (todo-category-number cat2)
                 (widen)
                 (goto-char (point-min))
                 (re-search-forward
-                 (concat "^" (regexp-quote (concat todo-category-beg cat2))
-                         "$") nil t)
+                 (concat "^" (regexp-quote (concat todo-category-beg cat2)) "$")
+                 nil t)
                 (re-search-forward
                  (concat "^" (regexp-quote todo-category-done)) nil t)
                 (forward-line)
-                (insert (or done-items done-item)))
+                (unless here (setq here (point)))
+                (while done-items
+                  (todo-insert-with-overlays (pop done-items))
+                  (todo-forward-item)))
+              ;; If only done items were moved, move point to the top
+              ;; one, otherwise, move point to the top moved todo item.
+              (goto-char here)
               (setq moved t))
           (cond
            ;; Move succeeded, so remove item from starting category,
@@ -2787,7 +2807,7 @@ section in the category moved to."
             (set-window-buffer (selected-window)
                                (set-buffer (find-file-noselect file2 'nowarn)))
             (setq todo-category-number (todo-category-number cat2))
-            (let ((todo-show-with-done (or done-items done-item)))
+            (let ((todo-show-with-done (> done 0)))
               (todo-category-select))
             (goto-char nmark)
             ;; If item is moved to end of (just first?) category, make
@@ -2836,12 +2856,13 @@ visible."
                           (goto-char (point-min))
                           (re-search-forward todo-done-string-start nil t)))
              (buffer-read-only nil)
-             item done-item
+             header item done-items
              (opoint (point)))
         ;; Don't add empty comment to done item.
         (setq comment (unless (zerop (length comment))
                         (concat " [" todo-comment-string ": " comment "]")))
         (and marked (goto-char (point-min)))
+        (setq header (todo-get-overlay 'header))
         (catch 'done
           ;; Stop looping when we hit the empty line below the last
           ;; todo item (this is eobp if only done items are hidden).
@@ -2849,17 +2870,15 @@ visible."
             (if (or (not marked) (and marked (todo-marked-item-p)))
                 (progn
                   (setq item (todo-item-string))
-                  (setq done-item (concat done-item done-prefix item
-                                          comment (and marked "\n")))
+                  (push (concat done-prefix item comment) done-items)
                   (setq item-count (1+ item-count))
                   (when (todo-diary-item-p)
                     (setq diary-count (1+ diary-count)))
                   (todo-remove-item)
                   (unless marked (throw 'done nil)))
               (todo-forward-item))))
+        (setq done-items (nreverse done-items))
         (when marked
-          ;; Chop off last newline of done item string.
-          (setq done-item (substring done-item 0 -1))
           (setq todo-categories-with-marks
                 (assq-delete-all cat todo-categories-with-marks)))
         (save-excursion
@@ -2868,7 +2887,17 @@ visible."
            (concat "^" (regexp-quote todo-category-done)) nil t)
           (forward-char)
           (when show-done (setq opoint (point)))
-          (insert done-item "\n"))
+          (while done-items
+            (insert (pop done-items) "\n")
+            (when header (let ((copy (copy-overlay header)))
+                   (re-search-backward
+                    (concat todo-item-start
+                            "\\( " diary-time-regexp "\\)?"
+                            (regexp-quote todo-nondiary-end) "? ")
+                    nil t)
+                   (move-overlay copy (match-beginning 0) (match-end 0)))
+                  (todo-item-end)
+                  (forward-char))))
         (todo-update-count 'todo (- item-count))
         (todo-update-count 'done item-count)
         (todo-update-count 'diary (- diary-count))
@@ -3095,7 +3124,9 @@ this category does not exist in the archive, it is created."
               (throw 'end (message "Only done items can be archived"))
             (with-current-buffer archive
               (unless (derived-mode-p 'todo-archive-mode) (todo-archive-mode))
-              (let (buffer-read-only)
+              (let ((headers-hidden todo--item-headers-hidden)
+                    buffer-read-only)
+                (if headers-hidden (todo-toggle-item-header))
                 (widen)
                 (goto-char (point-min))
                 (if (and (re-search-forward
@@ -3121,7 +3152,8 @@ this category does not exist in the archive, it is created."
                 (unless (nth 7 (file-attributes afile))
                   (write-region nil nil afile t t)
                   (setq todo-archives (funcall todo-files-function t))
-                  (todo-archive-mode))))
+                  (todo-archive-mode))
+                (if headers-hidden (todo-toggle-item-header))))
             (with-current-buffer tbuf
               (cond
                (all
@@ -3200,7 +3232,9 @@ the only category in the archive, the archive file is deleted."
             (todo-forward-item))))
       ;; Restore items to top of category's done section and update counts.
       (with-current-buffer tbuf
-        (let (buffer-read-only newcat)
+        (let ((headers-hidden todo--item-headers-hidden)
+              buffer-read-only newcat)
+          (if headers-hidden (todo-toggle-item-header))
           (widen)
           (goto-char (point-min))
           ;; Find the corresponding todo category, or if there isn't
@@ -3224,6 +3258,7 @@ the only category in the archive, the archive file is deleted."
                  (todo-update-count 'done 1 cat)
                  (unless newcat         ; Newly added category has no archive.
                    (todo-update-count 'archived -1 cat))))
+          (if headers-hidden (todo-toggle-item-header))
           (todo-update-categories-sexp)))
       ;; Delete restored items from archive.
       (when marked
@@ -5156,7 +5191,17 @@ empty line above the done items separator."
   (let* ((done (todo-done-item-p)))
     (todo-item-start)
     (unless (bobp)
-      (re-search-backward todo-item-start nil t (or count 1)))
+      (re-search-backward (concat todo-item-start
+                                  "\\( " diary-time-regexp "\\)?"
+                                  (regexp-quote todo-nondiary-end) "? ")
+                          nil t (or count 1))
+      ;; If the item date-time header is hidden, the display engine
+      ;; moves point to the next earlier displayable position, which
+      ;; is the end of the next item above, so we move it to the start
+      ;; of the current item's text (that's what the display engine
+      ;; does with todo-forward-item in this case.)
+      ;; FIXME: would it be better to use cursor-sensor-functions?
+      (when todo--item-headers-hidden (goto-char (match-end 0))))
     ;; Unless this is a regexp filtered items buffer (which can contain
     ;; intermixed todo and done items), if points advances by one from a
     ;; done to a todo item, go back to the space above
@@ -5172,10 +5217,12 @@ empty line above the done items separator."
 
 (defun todo-remove-item ()
   "Internal function called in editing, deleting or moving items."
-  (let* ((end (progn (todo-item-end) (1+ (point))))
-         (beg (todo-item-start))
-         (ov (todo-get-overlay 'prefix)))
-    (when ov (delete-overlay ov))
+  (let ((end (progn (todo-item-end) (1+ (point))))
+        (beg (todo-item-start))
+        ovs)
+    (push (todo-get-overlay 'prefix) ovs)
+    (push (todo-get-overlay 'header) ovs)
+    (dolist (ov ovs) (when ov (delete-overlay ov)))
     (delete-region beg end)))
 
 (defun todo-diary-item-p ()
@@ -5309,6 +5356,11 @@ marked) not done todo items."
 
 (defun todo-get-overlay (val)
   "Return the overlay at point whose `todo' property has value VAL."
+  ;; When headers are hidden, the display engine makes item's start
+  ;; inaccessible to commands, so go there here, if necessary, in
+  ;; order to check for prefix and header overlays.
+  (when (memq val '(prefix header))
+    (unless (looking-at todo-item-start) (todo-item-start)))
   ;; Use overlays-in to find prefix overlays and check over two
   ;; positions to find done separator overlay.
   (let ((ovs (overlays-in (point) (1+ (point))))
@@ -5333,16 +5385,26 @@ In that case, return the item's prefix overlay."
     (when marked ov)))
 
 (defun todo-insert-with-overlays (item)
-  "Insert ITEM at point and update prefix/priority number overlays."
+  "Insert ITEM at point and update prefix and header overlays."
   (todo-item-start)
-  ;; Insertion pushes item down but not its prefix overlay.  When the
-  ;; overlay includes a mark, this would now mark the inserted ITEM,
-  ;; so move it to the pushed down item.
   (let ((ov (todo-get-overlay 'prefix))
         (marked (todo-marked-item-p)))
     (insert item "\n")
-    (when marked (move-overlay ov (point) (point))))
-  (todo-backward-item)
+    ;; Insertion pushes item down but not its prefix overlay.  When
+    ;; the overlay includes a mark, this would now mark the inserted
+    ;; ITEM, so move it to the pushed down item.
+    (when marked (move-overlay ov (point) (point)))
+    (todo-backward-item)
+    ;; With hidden headers, todo-backward-item puts point on first
+    ;; visible character after header, so we have to search backward.
+    (when todo--item-headers-hidden
+      (re-search-backward (concat todo-item-start
+                                 "\\( " diary-time-regexp "\\)?"
+                                 (regexp-quote todo-nondiary-end) "? ")
+                         nil t)
+              (setq ov (make-overlay (match-beginning 0) (match-end 0) nil t))
+              (overlay-put ov 'todo 'header)
+              (overlay-put ov 'display "")))
   (todo-prefix-overlays))
 
 (defun todo-prefix-overlays ()
@@ -6607,6 +6669,7 @@ Added to `window-configuration-change-hook' in Todo mode."
   "Make some settings that apply to multiple Todo modes."
   (add-to-invisibility-spec 'todo)
   (setq buffer-read-only t)
+  (setq-local todo--item-headers-hidden nil)
   (setq-local desktop-save-buffer 'todo-desktop-save-buffer)
   (setq-local hl-line-range-function 'todo-hl-line-range))