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.
This commit is contained in:
Nicolas Goaziou 2012-04-18 13:01:44 +02:00
parent ac2cb80ec0
commit 7d6309f132
3 changed files with 313 additions and 31 deletions

View File

@ -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")))))

View File

@ -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)

View File

@ -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