Browse Source

org-list: Fix bugs relative to item indentation

* lisp/org-list.el (org-list-struct-indent): Follow
  `org-list-demote-modify-bullet' specifications for ordered bullets.
(org-list-indent-item-generic, org-indent-item-tree,
org-outdent-item-tree): Fix bug when operating on a region.
(org-outdent-item, org-indent-item): Allow to operate on a region.
* lisp/org.el (org-shiftmetaleft, org-shiftmetaright): Allow to
  operate on a region.
* testing/lisp/test-org-list.el: Add tests.
Nicolas Goaziou 7 years ago
parent
commit
7d6309f132
3 changed files with 313 additions and 31 deletions
  1. 54 23
      lisp/org-list.el
  2. 14 8
      lisp/org.el
  3. 245 0
      testing/lisp/test-org-list.el

+ 54 - 23
lisp/org-list.el

@@ -1484,8 +1484,19 @@ bullets between START and END."
 	 (change-bullet-maybe
 	  (function
 	   (lambda (item)
-	     (let* ((bul (org-trim (org-list-get-bullet item struct)))
-		    (new-bul-p (cdr (assoc bul org-list-demote-modify-bullet))))
+	     (let ((new-bul-p
+		    (cdr (assoc
+			  ;; Normalize ordered bullets.
+			  (let ((bul (org-trim
+				      (org-list-get-bullet item struct))))
+			    (cond ((string-match "[A-Z]\\." bul) "A.")
+				  ((string-match "[A-Z])" bul) "A)")
+				  ((string-match "[a-z]\\." bul) "a.")
+				  ((string-match "[a-z])" bul) "a)")
+				  ((string-match "[0-9]\\." bul) "1.")
+				  ((string-match "[0-9])" bul) "1)")
+				  (t bul)))
+			  org-list-demote-modify-bullet))))
 	       (when new-bul-p (org-list-set-bullet item struct new-bul-p))))))
 	 (ind
 	  (lambda (cell)
@@ -2500,7 +2511,6 @@ STRUCT is the list structure.
 
 Return t if successful."
   (save-excursion
-    (beginning-of-line)
     (let* ((regionp (org-region-active-p))
 	   (rbeg (and regionp (region-beginning)))
 	   (rend (and regionp (region-end)))
@@ -2509,7 +2519,8 @@ Return t if successful."
 	   (prevs (org-list-prevs-alist struct))
 	   ;; Are we going to move the whole list?
 	   (specialp
-	    (and (= top (point))
+	    (and (not regionp)
+		 (= top (point-at-bol))
 		 (cdr (assq 'indent org-list-automatic-rules))
 		 (if no-subtree
 		     (error
@@ -2523,12 +2534,12 @@ Return t if successful."
 	    (progn
 	      (set-marker org-last-indent-begin-marker rbeg)
 	      (set-marker org-last-indent-end-marker rend))
-	  (set-marker org-last-indent-begin-marker (point))
+	  (set-marker org-last-indent-begin-marker (point-at-bol))
 	  (set-marker org-last-indent-end-marker
 		      (cond
 		       (specialp (org-list-get-bottom-point struct))
-		       (no-subtree (1+ (point)))
-		       (t (org-list-get-item-end (point) struct))))))
+		       (no-subtree (1+ (point-at-bol)))
+		       (t (org-list-get-item-end (point-at-bol) struct))))))
       (let* ((beg (marker-position org-last-indent-begin-marker))
 	     (end (marker-position org-last-indent-end-marker)))
 	(cond
@@ -2583,19 +2594,35 @@ Return t if successful."
   "Outdent a local list item, but not its children.
 If a region is active, all items inside will be moved."
   (interactive)
-  (if (org-at-item-p)
-      (let ((struct (org-list-struct)))
-	(org-list-indent-item-generic -1 t struct))
-    (error "Not at an item")))
+  (let ((regionp (org-region-active-p)))
+    (cond
+     ((or (org-at-item-p)
+	  (and regionp
+	       (save-excursion (goto-char (region-beginning))
+			       (org-at-item-p))))
+      (let ((struct (if (not regionp) (org-list-struct)
+		      (save-excursion (goto-char (region-beginning))
+				      (org-list-struct)))))
+	(org-list-indent-item-generic -1 t struct)))
+     (regionp (error "Region not starting at an item"))
+     (t (error "Not at an item")))))
 
 (defun org-indent-item ()
   "Indent a local list item, but not its children.
 If a region is active, all items inside will be moved."
   (interactive)
-  (if (org-at-item-p)
-      (let ((struct (org-list-struct)))
-	(org-list-indent-item-generic 1 t struct))
-    (error "Not at an item")))
+  (let ((regionp (org-region-active-p)))
+    (cond
+     ((or (org-at-item-p)
+	  (and regionp
+	       (save-excursion (goto-char (region-beginning))
+			       (org-at-item-p))))
+      (let ((struct (if (not regionp) (org-list-struct)
+		      (save-excursion (goto-char (region-beginning))
+				      (org-list-struct)))))
+	(org-list-indent-item-generic 1 t struct)))
+     (regionp (error "Region not starting at an item"))
+     (t (error "Not at an item")))))
 
 (defun org-outdent-item-tree ()
   "Outdent a local list item including its children.
@@ -2604,10 +2631,12 @@ If a region is active, all items inside will be moved."
   (let ((regionp (org-region-active-p)))
     (cond
      ((or (org-at-item-p)
-	  (and (org-region-active-p)
-	       (goto-char (region-beginning))
-	       (org-at-item-p)))
-      (let ((struct (org-list-struct)))
+	  (and regionp
+	       (save-excursion (goto-char (region-beginning))
+			       (org-at-item-p))))
+      (let ((struct (if (not regionp) (org-list-struct)
+		      (save-excursion (goto-char (region-beginning))
+				      (org-list-struct)))))
 	(org-list-indent-item-generic -1 nil struct)))
      (regionp (error "Region not starting at an item"))
      (t (error "Not at an item")))))
@@ -2619,10 +2648,12 @@ If a region is active, all items inside will be moved."
   (let ((regionp (org-region-active-p)))
     (cond
      ((or (org-at-item-p)
-	  (and (org-region-active-p)
-	       (goto-char (region-beginning))
-	       (org-at-item-p)))
-      (let ((struct (org-list-struct)))
+	  (and regionp
+	       (save-excursion (goto-char (region-beginning))
+			       (org-at-item-p))))
+      (let ((struct (if (not regionp) (org-list-struct)
+		      (save-excursion (goto-char (region-beginning))
+				      (org-list-struct)))))
 	(org-list-indent-item-generic 1 nil struct)))
      (regionp (error "Region not starting at an item"))
      (t (error "Not at an item")))))

+ 14 - 8
lisp/org.el

@@ -17969,28 +17969,34 @@ See the individual commands for more information."
 
 (defun org-shiftmetaleft ()
   "Promote subtree or delete table column.
-Calls `org-promote-subtree', `org-outdent-item',
-or `org-table-delete-column', depending on context.
-See the individual commands for more information."
+Calls `org-promote-subtree', `org-outdent-item-tree', or
+`org-table-delete-column', depending on context.  See the
+individual commands for more information."
   (interactive)
   (cond
    ((run-hook-with-args-until-success 'org-shiftmetaleft-hook))
    ((org-at-table-p) (call-interactively 'org-table-delete-column))
    ((org-at-heading-p) (call-interactively 'org-promote-subtree))
-   ((org-at-item-p) (call-interactively 'org-outdent-item-tree))
+   ((if (not (org-region-active-p)) (org-at-item-p)
+      (save-excursion (goto-char (region-beginning))
+		      (org-at-item-p)))
+    (call-interactively 'org-outdent-item-tree))
    (t (org-modifier-cursor-error))))
 
 (defun org-shiftmetaright ()
   "Demote subtree or insert table column.
-Calls `org-demote-subtree', `org-indent-item',
-or `org-table-insert-column', depending on context.
-See the individual commands for more information."
+Calls `org-demote-subtree', `org-indent-item-tree', or
+`org-table-insert-column', depending on context.  See the
+individual commands for more information."
   (interactive)
   (cond
    ((run-hook-with-args-until-success 'org-shiftmetaright-hook))
    ((org-at-table-p) (call-interactively 'org-table-insert-column))
    ((org-at-heading-p) (call-interactively 'org-demote-subtree))
-   ((org-at-item-p) (call-interactively 'org-indent-item-tree))
+   ((if (not (org-region-active-p)) (org-at-item-p)
+      (save-excursion (goto-char (region-beginning))
+		      (org-at-item-p)))
+    (call-interactively 'org-indent-item-tree))
    (t (org-modifier-cursor-error))))
 
 (defun org-shiftmetaup (&optional arg)

+ 245 - 0
testing/lisp/test-org-list.el

@@ -113,6 +113,251 @@
 	(org-previous-item)
 	(should (looking-at "  - item 1.3"))))))
 
+(ert-deftest test-org-list/indent-item ()
+  "Test `org-indent-item' specifications."
+  ;; 1. Error when not at an item.
+  (org-test-with-temp-text "Paragraph."
+    (should-error (org-indent-item)))
+  ;; 2. Error when trying to move first item of a list.
+  (org-test-with-temp-text "
+- Item 1
+- Item 2"
+    (forward-line)
+    (should-error (org-indent-item)))
+  ;; 3. Indent a single item, not its children.
+  (org-test-with-temp-text "
+- Item 1
+- Item 2
+  - Item 2.1"
+    (search-forward "- Item 2")
+    (let (org-list-demote-modify-bullet) (org-indent-item))
+    (should (equal (buffer-string)
+		   "
+- Item 1
+  - Item 2
+  - Item 2.1")))
+  ;; 4. Follow `org-list-demote-modify-bullet' specifications.
+  ;;
+  ;; 4.1. With unordered lists.
+  (org-test-with-temp-text "
+- Item 1
+- Item 2"
+    (search-forward "- Item 2")
+    (let ((org-list-demote-modify-bullet '(("-" . "+")))) (org-indent-item))
+    (should (equal (buffer-string)
+		   "
+- Item 1
+  + Item 2")))
+  ;; 4.2. and ordered lists.
+  (org-test-with-temp-text "
+1. Item 1
+2. Item 2"
+    (search-forward "2. Item 2")
+    (let ((org-plain-list-ordered-item-terminator t)
+	  (org-list-demote-modify-bullet '(("1." . "+"))))
+      (org-indent-item))
+    (should (equal (buffer-string)
+		   "
+1. Item 1
+   + Item 2")))
+  ;; 5. When a region is selected, indent every item within.
+  (org-test-with-temp-text "
+- Item 1
+- Item 2
+- Item 3
+"
+    (search-forward "- Item 2")
+    (beginning-of-line)
+    (transient-mark-mode 1)
+    (push-mark (point) t t)
+    (goto-char (point-max))
+    (let (org-list-demote-modify-bullet) (org-indent-item))
+    (should (equal (buffer-string)
+		   "
+- Item 1
+  - Item 2
+  - Item 3
+"))))
+
+(ert-deftest test-org-list/indent-item-tree ()
+  "Test `org-indent-item-tree' specifications."
+  ;; 1. Error when not at an item.
+  (org-test-with-temp-text "Paragraph."
+    (should-error (org-indent-item-tree)))
+  ;; 2. Indent item along with its children.
+  (org-test-with-temp-text "
+- Item 1
+- Item 2
+  - Item 2.1"
+    (search-forward "- Item 2")
+    (let (org-list-demote-modify-bullet) (org-indent-item-tree))
+    (should (equal (buffer-string)
+		   "
+- Item 1
+  - Item 2
+    - Item 2.1")))
+  ;; 3. Special case: When indenting top item, move the whole list.
+  (org-test-with-temp-text "
+- Item 1
+- Item 2"
+    (search-forward "- Item 1")
+    (let (org-list-demote-modify-bullet org-odd-levels-only)
+      (org-indent-item-tree))
+    (should (equal (buffer-string)
+		   "
+ - Item 1
+ - Item 2")))
+  ;; 4. Follow `org-list-demote-modify-bullet' specifications.
+  ;;
+  ;; 4.1. With unordered lists.
+  (org-test-with-temp-text "
+- Item 1
+- Item 2
+  + Item 2.1"
+    (search-forward "- Item 2")
+    (let ((org-list-demote-modify-bullet '(("-" . "+") ("+" . "-"))))
+      (org-indent-item-tree))
+    (should (equal (buffer-string)
+		   "
+- Item 1
+  + Item 2
+    - Item 2.1")))
+  ;; 4.2. and ordered lists.
+  (org-test-with-temp-text "
+1. Item 1
+2. Item 2
+   + Item 2.1"
+    (search-forward "2. Item 2")
+    (let ((org-plain-list-ordered-item-terminator t)
+	  (org-list-demote-modify-bullet '(("1." . "+") ("+" . "1."))))
+      (org-indent-item-tree))
+    (should (equal (buffer-string)
+		   "
+1. Item 1
+   + Item 2
+     1. Item 2.1")))
+  ;; 5. When a region is selected, indent every item within.
+  (org-test-with-temp-text "
+- Item 1
+- Item 2
+  - Item 2.1
+- Item 3
+  - Item 3.1
+"
+    (search-forward "- Item 2")
+    (beginning-of-line)
+    (transient-mark-mode 1)
+    (push-mark (point) t t)
+    (goto-char (point-max))
+    (let (org-list-demote-modify-bullet) (org-indent-item-tree))
+    (should (equal (buffer-string)
+		   "
+- Item 1
+  - Item 2
+    - Item 2.1
+  - Item 3
+    - Item 3.1
+"))))
+
+(ert-deftest test-org-list/outdent-item ()
+  "Test `org-outdent-item' specifications."
+  ;; 1. Error when not at an item.
+  (org-test-with-temp-text "Paragraph."
+    (should-error (org-outdent-item)))
+  ;; 2. Error when trying to move first item of a list.
+  (org-test-with-temp-text "
+- Item 1
+- Item 2"
+    (forward-line)
+    (should-error (org-outdent-item)))
+  ;; 3. Error when trying to outdent an item without its children.
+  (org-test-with-temp-text "
+- Item 1
+  - Item 1.1
+    - Item 1.1.1"
+    (search-forward "- Item 1.1")
+    (should-error (org-outdent-item)))
+  ;; 4. Error when trying to outdent before top item.
+  (org-test-with-temp-text "
+  - Item 1
+  - Item 2"
+    (search-forward "- Item 2")
+    (should-error (org-outdent-item)))
+  ;; 5. When a region is selected, outdent every item within.
+  (org-test-with-temp-text "
+- Item 1
+  - Item 2
+  - Item 3
+"
+    (search-forward "- Item 2")
+    (beginning-of-line)
+    (transient-mark-mode 1)
+    (push-mark (point) t t)
+    (goto-char (point-max))
+    (let (org-list-demote-modify-bullet) (org-outdent-item))
+    (should (equal (buffer-string)
+		   "
+- Item 1
+- Item 2
+- Item 3
+"))))
+
+(ert-deftest test-org-list/outdent-item-tree ()
+  "Test `org-outdent-item-tree' specifications."
+  ;; 1. Error when not at an item.
+  (org-test-with-temp-text "Paragraph."
+    (should-error (org-outdent-item-tree)))
+  ;; 2. Error when trying to outdent before top item.
+  (org-test-with-temp-text "
+  - Item 1
+  - Item 2"
+    (search-forward "- Item 2")
+    (should-error (org-outdent-item-tree)))
+  ;; 3. Outdent item along with its children.
+  (org-test-with-temp-text "
+- Item 1
+  - Item 2
+    - Item 2.1"
+    (search-forward "- Item 2")
+    (org-outdent-item-tree)
+    (should (equal (buffer-string)
+		   "
+- Item 1
+- Item 2
+  - Item 2.1")))
+  ;; 3. Special case: When outdenting top item, move the whole list.
+  (org-test-with-temp-text "
+ - Item 1
+ - Item 2"
+    (search-forward "- Item 1")
+    (let (org-odd-levels-only) (org-outdent-item-tree))
+    (should (equal (buffer-string)
+		   "
+- Item 1
+- Item 2")))
+  ;; 5. When a region is selected, outdent every item within.
+  (org-test-with-temp-text "
+- Item 1
+  - Item 2
+    - Item 2.1
+  - Item 3
+    - Item 3.1
+"
+    (search-forward "- Item 2")
+    (beginning-of-line)
+    (transient-mark-mode 1)
+    (push-mark (point) t t)
+    (goto-char (point-max))
+    (org-outdent-item-tree)
+    (should (equal (buffer-string)
+		   "
+- Item 1
+- Item 2
+  - Item 2.1
+- Item 3
+  - Item 3.1
+"))))
+
 
 (provide 'test-org-list)
 ;;; test-org-list.el ends here