list: Fix cycle indentation

* lisp/org-list.el (org-cycle-item-indentation): Do not stop at
initial indentation before outdenting items.  Implement more robust
algorithm.
* testing/lisp/test-org-list.el (test-org-list/cycle-item-identation):
New test.
* testing/lisp/test-org-list.el (test-org-list/move-item-down): Small
reformatting.

Reported-by: lamaglama@posteo.net
<http://lists.gnu.org/r/emacs-orgmode/2020-05/msg00573.html>

2 files changed, 163 insertions, 60 deletions

diff --git a/lisp/org-list.el b/lisp/org-list.el
index de41751..7a5133d 100644
--- a/lisp/org-list.el
+++ b/lisp/org-list.el
@@ -81,6 +81,7 @@
 (require 'org-compat)
 
 (defvar org-M-RET-may-split-line)
+(defvar org-adapt-indentation)
 (defvar org-auto-align-tags)
 (defvar org-blank-before-new-entry)
 (defvar org-clock-string)
@@ -2774,51 +2775,83 @@ If a region is active, all items inside will be moved."
      (t (error "Not at an item")))))
 
 (defvar org-tab-ind-state)
-(defvar org-adapt-indentation)
 (defun org-cycle-item-indentation ()
   "Cycle levels of indentation of an empty item.
+
 The first run indents the item, if applicable.  Subsequent runs
 outdent it at meaningful levels in the list.  When done, item is
 put back at its original position with its original bullet.
 
 Return t at each successful move."
   (when (org-at-item-p)
-    (let* ((org-adapt-indentation nil)
-	   (struct (org-list-struct))
-	   (ind (org-list-get-ind (point-at-bol) struct))
-	   (bullet (org-trim (buffer-substring (point-at-bol) (point-at-eol)))))
+    (let* ((struct (org-list-struct))
+	   (item (line-beginning-position))
+	   (ind (org-list-get-ind item struct)))
       ;; Accept empty items or if cycle has already started.
       (when (or (eq last-command 'org-cycle-item-indentation)
-		(and (save-excursion
-		       (beginning-of-line)
-		       (looking-at org-list-full-item-re))
-		     (>= (match-end 0) (save-excursion
-					 (goto-char (org-list-get-item-end
-						     (point-at-bol) struct))
-					 (skip-chars-backward " \r\t\n")
-					 (point)))))
+		(and (org-match-line org-list-full-item-re)
+		     (>= (match-end 0)
+			 (save-excursion
+			   (goto-char (org-list-get-item-end item struct))
+			   (skip-chars-backward " \t\n")
+			   (point)))))
 	(setq this-command 'org-cycle-item-indentation)
-	;; When in the middle of the cycle, try to outdent first.  If
-	;; it fails, and point is still at initial position, indent.
-	;; Else, re-create it at its original position.
-	(if (eq last-command 'org-cycle-item-indentation)
+	(let ((prevs (org-list-prevs-alist struct))
+	      (parents (org-list-parents-alist struct)))
+	  (if (eq last-command 'org-cycle-item-indentation)
+	      ;; When in the middle of the cycle, try to outdent.  If
+	      ;; it fails, move point back to its initial position and
+	      ;; reset cycle.
+	      (pcase-let ((`(,old-ind . ,old-bul) org-tab-ind-state)
+			  (allow-outdent
+			   (lambda (struct prevs parents)
+			     ;; Non-nil if current item can be
+			     ;; outdented.
+			     (and (not (org-list-get-next-item item nil prevs))
+				  (not (org-list-has-child-p item struct))
+				  (org-list-get-parent item struct parents)))))
+		(cond
+		 ((and (> ind old-ind)
+		       (org-list-get-prev-item item nil prevs))
+		  (org-list-indent-item-generic 1 t struct))
+		 ((and (< ind old-ind)
+		       (funcall allow-outdent struct prevs parents))
+		  (org-list-indent-item-generic -1 t struct))
+		 (t
+		  (delete-region (line-beginning-position) (line-end-position))
+		  (indent-to-column old-ind)
+		  (insert old-bul " ")
+		  (let* ((struct (org-list-struct))
+			 (parents (org-list-parents-alist struct)))
+		    (if (and (> ind old-ind)
+			     ;; We were previously indenting item.  It
+			     ;; is no longer possible.  Try to outdent
+			     ;; from initial position.
+			     (funcall allow-outdent
+				      struct
+				      (org-list-prevs-alist struct)
+				      parents))
+			(org-list-indent-item-generic -1 t struct)
+		      (org-list-write-struct struct parents)
+		      ;; Start cycle over.
+		      (setq this-command 'identity)
+		      t)))))
+	    ;; If a cycle is starting, remember initial indentation
+	    ;; and bullet, then try to indent.  If it fails, try to
+	    ;; outdent.
+	    (setq org-tab-ind-state
+		  (cons ind (org-trim (org-current-line-string))))
 	    (cond
-	     ((ignore-errors (org-list-indent-item-generic -1 t struct)))
-	     ((and (= ind (car org-tab-ind-state))
-		   (ignore-errors (org-list-indent-item-generic 1 t struct))))
-	     (t (delete-region (point-at-bol) (point-at-eol))
-		(indent-to-column (car org-tab-ind-state))
-		(insert (cdr org-tab-ind-state) " ")
-		;; Break cycle
-		(setq this-command 'identity)))
-	  ;; If a cycle is starting, remember indentation and bullet,
-	  ;; then try to indent.  If it fails, try to outdent.
-	  (setq org-tab-ind-state (cons ind bullet))
-	  (cond
-	   ((ignore-errors (org-list-indent-item-generic 1 t struct)))
-	   ((ignore-errors (org-list-indent-item-generic -1 t struct)))
-	   (t (user-error "Cannot move item"))))
-	t))))
+	     ((org-list-get-prev-item item nil prevs)
+	      (org-list-indent-item-generic 1 t struct))
+	     ((and (not (org-list-get-next-item item nil prevs))
+		   (org-list-get-parent item struct parents))
+	      (org-list-indent-item-generic -1 t struct))
+	     (t
+	      ;; This command failed.  So will the following one.
+	      ;; There's no point in starting the cycle.
+	      (setq this-command 'identity)
+	      (user-error "Cannot move item")))))))))
 
 (defun org-sort-list
     (&optional with-case sorting-type getkey-func compare-func interactive?)
diff --git a/testing/lisp/test-org-list.el b/testing/lisp/test-org-list.el
index aa473c3..1feaf49 100644
--- a/testing/lisp/test-org-list.el
+++ b/testing/lisp/test-org-list.el
@@ -479,18 +479,82 @@ b. Item 2<point>"
   - Item 3.1
 "))))
 
+(ert-deftest test-org-list/cycle-item-identation ()
+  "Test `org-list-cycle-item-indentation' specifications."
+  ;; Refuse to indent non-empty items.
+  (should-not
+   (org-test-with-temp-text "- item - item2<point>"
+     (org-cycle-item-indentation)))
+  ;; First try to indent item.
+  (should
+   (equal "- item\n  - sub-item\n    - "
+	  (org-test-with-temp-text "- item\n  - sub-item\n  - <point>"
+	    (org-cycle-item-indentation)
+	    (buffer-string))))
+  ;; If first indentation is not possible, outdent item.
+  (should
+   (equal "- item\n- "
+	  (org-test-with-temp-text "- item\n  - <point>"
+	    (org-cycle-item-indentation)
+	    (buffer-string))))
+  ;; Throw an error when item cannot move either way.
+  (should-error
+   (org-test-with-temp-text "- "
+     (org-cycle-item-indentation)))
+  ;; On repeated commands, cycle through all the indented positions,
+  ;; then through all the outdented ones, then move back to initial
+  ;; position.
+  (should
+   (equal '(4 6 0 2)
+	  (org-test-with-temp-text "- i0\n  - i1\n    - s1\n  - <point>"
+	    (let ((indentations nil))
+	      (org-cycle-item-indentation)
+	      (dotimes (_ 3)
+		(let ((last-command 'org-cycle-item-indentation))
+		  (push (current-indentation) indentations)
+		  (org-cycle-item-indentation)))
+	      (reverse (cons (current-indentation) indentations))))))
+  ;; Refuse to indent the first item in a sub-list.  Also refuse to
+  ;; outdent an item with a next sibling.
+  (should-error
+   (org-test-with-temp-text "- item\n  - <point>\n  - sub-item 2"
+     (org-cycle-item-indentation)))
+  ;; When cycling back into initial position, preserve bullet type.
+  (should
+   (equal "1. item\n   - "
+	  (org-test-with-temp-text "1. item\n  - <point>"
+	    (org-cycle-item-indentation)
+	    (let ((last-command 'org-cycle-item-indentation))
+	      (org-cycle-item-indentation))
+	    (buffer-string))))
+  (should
+   (equal "1. item\n   - tag :: "
+	  (org-test-with-temp-text "1. item\n  - tag :: <point>"
+	    (org-cycle-item-indentation)
+	    (let ((last-command 'org-cycle-item-indentation))
+	      (org-cycle-item-indentation))
+	    (buffer-string))))
+  ;; When starting at top level, never outdent.
+  (should
+   (org-test-with-temp-text "- item\n- <point>"
+     (org-cycle-item-indentation)
+     (let ((last-command 'org-cycle-item-indentation))
+       (org-cycle-item-indentation))
+     (buffer-string))))
+
 (ert-deftest test-org-list/move-item-down ()
   "Test `org-move-item-down' specifications."
   ;; Standard test.
-  (org-test-with-temp-text "- item 1\n- item 2"
-    (org-move-item-down)
-    (should (equal (buffer-string)
-		   "- item 2\n- item 1")))
+  (should
+   (equal "- item 2\n- item 1"
+	  (org-test-with-temp-text "- item 1\n- item 2"
+	    (org-move-item-down)
+	    (buffer-string))))
   ;; Keep same column in item.
-  (org-test-with-temp-text "- item 1\n- item 2"
-    (forward-char 4)
-    (org-move-item-down)
-    (should (looking-at "em 1")))
+  (should
+   (org-test-with-temp-text "- it<point>em 1\n- item 2"
+     (org-move-item-down)
+     (looking-at "em 1")))
   ;; Move sub-items.
   (org-test-with-temp-text "- item 1\n  - sub-item 1\n- item 2"
     (org-move-item-down)
@@ -504,28 +568,34 @@ b. Item 2<point>"
       (org-move-item-down)
       (buffer-string))))
   ;; Error when trying to move the last item...
-  (org-test-with-temp-text "- item 1\n- item 2"
-    (forward-line)
-    (should-error (org-move-item-down)))
+  (should-error
+   (org-test-with-temp-text "- item 1\n- item 2"
+     (forward-line)
+     (org-move-item-down)))
   ;; ... unless `org-list-use-circular-motion' is non-nil.  In this
   ;; case, move to the first item.
-  (org-test-with-temp-text "- item 1\n- item 2\n- item 3"
-    (forward-line 2)
-    (let ((org-list-use-circular-motion t)) (org-move-item-down))
-    (should (equal (buffer-string) "- item 3\n- item 1\n- item 2\n")))
+  (should
+   (equal  "- item 3\n- item 1\n- item 2\n"
+	   (org-test-with-temp-text "- item 1\n- item 2\n<point>- item 3"
+	     (let ((org-list-use-circular-motion t)) (org-move-item-down))
+	     (buffer-string))))
   ;; Preserve item visibility.
-  (org-test-with-temp-text "* Headline\n- item 1\n  body 1\n- item 2\n  body 2"
-    (let ((org-cycle-include-plain-lists t))
-      (search-forward "- item 1")
-      (org-cycle)
-      (search-forward "- item 2")
-      (org-cycle))
-    (search-backward "- item 1")
-    (org-move-item-down)
-    (forward-line)
-    (should (org-invisible-p2))
-    (search-backward " body 2")
-    (should (org-invisible-p2)))
+  (should
+   (equal
+    '(outline outline)
+    (org-test-with-temp-text
+	"* Headline\n<point>- item 1\n  body 1\n- item 2\n  body 2"
+      (let ((org-cycle-include-plain-lists t))
+	(org-cycle)
+	(search-forward "- item 2")
+	(org-cycle))
+      (search-backward "- item 1")
+      (org-move-item-down)
+      (forward-line)
+      (list (org-invisible-p2)
+	    (progn
+	      (search-backward " body 2")
+	      (org-invisible-p2))))))
   ;; Preserve children visibility.
   (org-test-with-temp-text "* Headline
 - item 1