From 29c2827469b38f2827f6107f3bc7ddbae69500da Mon Sep 17 00:00:00 2001 From: Nicolas Goaziou Date: Wed, 4 Sep 2013 15:21:33 +0200 Subject: [PATCH] org-list: Fix list repairing * lisp/org-list.el (org-list-struct-apply-struct): Do not move item's contents within a child above when repairing indentation. * testing/lisp/test-org-list.el: Add tests. --- lisp/org-list.el | 87 ++++++++++++++++++++++++------------------- testing/lisp/test-org-list.el | 36 ++++++++++++++++++ 2 files changed, 84 insertions(+), 39 deletions(-) diff --git a/lisp/org-list.el b/lisp/org-list.el index 86afe11cd..676e44a38 100644 --- a/lisp/org-list.el +++ b/lisp/org-list.el @@ -1863,9 +1863,10 @@ Initial position of cursor is restored after the changes." (item-re (org-item-re)) (shift-body-ind (function - ;; Shift the indentation between END and BEG by DELTA. - ;; Start from the line before END. - (lambda (end beg delta) + ;; Shift the indentation between END and BEG by DELTA. If + ;; MAX-IND is non-nil, ensure that no line will be indented + ;; more than that number. Start from the line before END. + (lambda (end beg delta max-ind) (goto-char end) (skip-chars-backward " \r\t\n") (beginning-of-line) @@ -1879,7 +1880,8 @@ Initial position of cursor is restored after the changes." ;; Shift only non-empty lines. ((org-looking-at-p "^[ \t]*\\S-") (let ((i (org-get-indentation))) - (org-indent-line-to (+ i delta))))) + (org-indent-line-to + (if max-ind (min (+ i delta) max-ind) (+ i delta)))))) (forward-line -1))))) (modify-item (function @@ -1915,53 +1917,60 @@ Initial position of cursor is restored after the changes." (indent-to new-ind))))))) ;; 1. First get list of items and position endings. We maintain ;; two alists: ITM-SHIFT, determining indentation shift needed - ;; at item, and END-POS, a pseudo-alist where key is ending + ;; at item, and END-LIST, a pseudo-alist where key is ending ;; position and value point. (let (end-list acc-end itm-shift all-ends sliced-struct) - (mapc (lambda (e) - (let* ((pos (car e)) - (ind-pos (org-list-get-ind pos struct)) - (ind-old (org-list-get-ind pos old-struct)) - (bul-pos (org-list-get-bullet pos struct)) - (bul-old (org-list-get-bullet pos old-struct)) - (ind-shift (- (+ ind-pos (length bul-pos)) - (+ ind-old (length bul-old)))) - (end-pos (org-list-get-item-end pos old-struct))) - (push (cons pos ind-shift) itm-shift) - (unless (assq end-pos old-struct) - ;; To determine real ind of an ending position that - ;; is not at an item, we have to find the item it - ;; belongs to: it is the last item (ITEM-UP), whose - ;; ending is further than the position we're - ;; interested in. - (let ((item-up (assoc-default end-pos acc-end '>))) - (push (cons end-pos item-up) end-list))) - (push (cons end-pos pos) acc-end))) - old-struct) + (dolist (e old-struct) + (let* ((pos (car e)) + (ind-pos (org-list-get-ind pos struct)) + (ind-old (org-list-get-ind pos old-struct)) + (bul-pos (org-list-get-bullet pos struct)) + (bul-old (org-list-get-bullet pos old-struct)) + (ind-shift (- (+ ind-pos (length bul-pos)) + (+ ind-old (length bul-old)))) + (end-pos (org-list-get-item-end pos old-struct))) + (push (cons pos ind-shift) itm-shift) + (unless (assq end-pos old-struct) + ;; To determine real ind of an ending position that + ;; is not at an item, we have to find the item it + ;; belongs to: it is the last item (ITEM-UP), whose + ;; ending is further than the position we're + ;; interested in. + (let ((item-up (assoc-default end-pos acc-end '>))) + (push (cons end-pos item-up) end-list))) + (push (cons end-pos pos) acc-end))) ;; 2. Slice the items into parts that should be shifted by the - ;; same amount of indentation. The slices are returned in - ;; reverse order so changes modifying buffer do not change - ;; positions they refer to. + ;; same amount of indentation. Each slice follow the pattern + ;; (END BEG DELTA MAX-IND-OR-NIL). Slices are returned in + ;; reverse order. (setq all-ends (sort (append (mapcar 'car itm-shift) (org-uniquify (mapcar 'car end-list))) '<)) (while (cdr all-ends) (let* ((up (pop all-ends)) (down (car all-ends)) - (ind (if (assq up struct) - (cdr (assq up itm-shift)) - (cdr (assq (cdr (assq up end-list)) itm-shift))))) - (push (list down up ind) sliced-struct))) + (itemp (assq up struct)) + (item (if itemp up (cdr (assq up end-list)))) + (ind (cdr (assq item itm-shift))) + ;; If we're not at an item, there's a child of the item + ;; point belongs to above. Make sure this slice isn't + ;; moved within that child by specifying a maximum + ;; indentation. + (max-ind (and (not itemp) + (+ (org-list-get-ind item struct) + (length (org-list-get-bullet item struct)) + org-list-indent-offset)))) + (push (list down up ind max-ind) sliced-struct))) ;; 3. Shift each slice in buffer, provided delta isn't 0, from ;; end to beginning. Take a special action when beginning is ;; at item bullet. - (mapc (lambda (e) - (unless (zerop (nth 2 e)) (apply shift-body-ind e)) - (let* ((beg (nth 1 e)) - (cell (assq beg struct))) - (unless (or (not cell) (equal cell (assq beg old-struct))) - (funcall modify-item beg)))) - sliced-struct)) + (dolist (e sliced-struct) + (unless (and (zerop (nth 2 e)) (not (nth 3 e))) + (apply shift-body-ind e)) + (let* ((beg (nth 1 e)) + (cell (assq beg struct))) + (unless (or (not cell) (equal cell (assq beg old-struct))) + (funcall modify-item beg))))) ;; 4. Go back to initial position and clean marker. (goto-char origin) (move-marker origin nil))) diff --git a/testing/lisp/test-org-list.el b/testing/lisp/test-org-list.el index 39cf4819c..ac81d4dd2 100644 --- a/testing/lisp/test-org-list.el +++ b/testing/lisp/test-org-list.el @@ -713,6 +713,42 @@ (forward-line -1) (looking-at "$"))))) +(ert-deftest test-org-list/repair () + "Test `org-list-repair' specifications." + ;; Repair indentation. + (should + (equal "- item\n - child" + (org-test-with-temp-text "- item\n - child" + (let ((org-list-indent-offset 0)) (org-list-repair)) + (buffer-string)))) + ;; Repair bullets and numbering. + (should + (equal "- a\n- b" + (org-test-with-temp-text "- a\n+ b" + (let ((org-list-indent-offset 0)) + (org-list-repair)) + (buffer-string)))) + (should + (equal "1. a\n2. b" + (org-test-with-temp-text "1. a\n1. b" + (let ((org-list-indent-offset 0) + (org-plain-list-ordered-item-terminator t)) + (org-list-repair)) + (buffer-string)))) + ;; Repair check-boxes. + (should + (equal "- [X] item\n - [X] child" + (org-test-with-temp-text "- [ ] item\n - [X] child" + (let ((org-list-indent-offset 0)) + (org-list-repair)) + (buffer-string)))) + ;; Special case: do not move contents of an item within its child. + (should + (equal "- item\n - child\n within item" + (org-test-with-temp-text "- item\n - child\n within item" + (let ((org-list-indent-offset 0)) (org-list-repair)) + (buffer-string))))) + ;;; Radio Lists -- 2.11.4.GIT