Browse Source

Improve `org-promote' and `org-demote'

* lisp/org.el (org-promote, org-demote): Fix docstring.  Small
  refactoring.  Ignore narrowing.
(org-fixup-indentation): Smarter indentation: handle inlinetasks and
footnote definitions.

* testing/lisp/test-org.el (test-org/demote, test-org/promote): New
  test.

`org-called-with-limited-levels' check is removed when promoting
a top-level headline.  The motivation behind it in this particular
case wasn't clear (see 10aba6b1261a47a2aa4862b7222f87814af7ba31) and
I couldn't find a good reason to keep it.

Suggested-by: Sébastien Vauban
<http://permalink.gmane.org/gmane.emacs.orgmode/92450>
Nicolas Goaziou 10 years ago
parent
commit
cba2f0a2a3
2 changed files with 349 additions and 53 deletions
  1. 104 53
      lisp/org.el
  2. 245 0
      testing/lisp/test-org.el

+ 104 - 53
lisp/org.el

@@ -8125,42 +8125,38 @@ even level numbers will become the next higher odd number."
 	'org-get-valid-level "23.1")))
 
 (defun org-promote ()
-  "Promote the current heading higher up the tree.
-If the region is active in `transient-mark-mode', promote all headings
-in the region."
-  (org-back-to-heading t)
-  (let* ((level (save-match-data (funcall outline-level)))
-	 (after-change-functions (remove 'flyspell-after-change-function
-					 after-change-functions))
-	 (up-head (concat (make-string (org-get-valid-level level -1) ?*) " "))
-	 (diff (abs (- level (length up-head) -1))))
-    (cond ((and (= level 1) org-called-with-limited-levels
-		org-allow-promoting-top-level-subtree)
-	   (replace-match "# " nil t))
-	  ((= level 1)
-	   (user-error "Cannot promote to level 0.  UNDO to recover if necessary"))
-	  (t (replace-match up-head nil t)))
-    ;; Fixup tag positioning
-    (unless (= level 1)
-      (and org-auto-align-tags (org-set-tags nil 'ignore-column))
-      (if org-adapt-indentation (org-fixup-indentation (- diff))))
-    (run-hooks 'org-after-promote-entry-hook)))
+  "Promote the current heading higher up the tree."
+  (org-with-wide-buffer
+   (org-back-to-heading t)
+   (let* ((after-change-functions (remq 'flyspell-after-change-function
+					after-change-functions))
+	  (level (save-match-data (funcall outline-level)))
+	  (up-head (concat (make-string (org-get-valid-level level -1) ?*) " "))
+	  (diff (abs (- level (length up-head) -1))))
+     (cond
+      ((and (= level 1) org-allow-promoting-top-level-subtree)
+       (replace-match "# " nil t))
+      ((= level 1)
+       (user-error "Cannot promote to level 0.  UNDO to recover if necessary"))
+      (t (replace-match up-head nil t)))
+     (unless (= level 1)
+       (when org-auto-align-tags (org-set-tags nil 'ignore-column))
+       (when org-adapt-indentation (org-fixup-indentation (- diff))))
+     (run-hooks 'org-after-promote-entry-hook))))
 
 (defun org-demote ()
-  "Demote the current heading lower down the tree.
-If the region is active in `transient-mark-mode', demote all headings
-in the region."
-  (org-back-to-heading t)
-  (let* ((level (save-match-data (funcall outline-level)))
-	 (after-change-functions (remove 'flyspell-after-change-function
-					 after-change-functions))
-	 (down-head (concat (make-string (org-get-valid-level level 1) ?*) " "))
-	 (diff (abs (- level (length down-head) -1))))
-    (replace-match down-head nil t)
-    ;; Fixup tag positioning
-    (and org-auto-align-tags (org-set-tags nil 'ignore-column))
-    (if org-adapt-indentation (org-fixup-indentation diff))
-    (run-hooks 'org-after-demote-entry-hook)))
+  "Demote the current heading lower down the tree."
+  (org-with-wide-buffer
+   (org-back-to-heading t)
+   (let* ((after-change-functions (remq 'flyspell-after-change-function
+					after-change-functions))
+	  (level (save-match-data (funcall outline-level)))
+	  (down-head (concat (make-string (org-get-valid-level level 1) ?*) " "))
+	  (diff (abs (- level (length down-head) -1))))
+     (replace-match down-head nil t)
+     (when org-auto-align-tags (org-set-tags nil 'ignore-column))
+     (when org-adapt-indentation (org-fixup-indentation diff))
+     (run-hooks 'org-after-demote-entry-hook))))
 
 (defun org-cycle-level ()
   "Cycle the level of an empty headline through possible states.
@@ -8225,27 +8221,82 @@ After top level, it switches back to sibling level."
 		  (not (eobp)))
 	(funcall fun)))))
 
-(defvar org-property-end-re) ; silence byte-compiler
 (defun org-fixup-indentation (diff)
   "Change the indentation in the current entry by DIFF.
-However, if any line in the current entry has no indentation, or if it
-would end up with no indentation after the change, nothing at all is done."
-  (save-excursion
-    (let ((end (save-excursion (outline-next-heading)
-			       (point-marker)))
-	  (prohibit (if (> diff 0)
-			"^\\S-"
-		      (concat "^ \\{0," (int-to-string (- diff)) "\\}\\S-")))
-	  col)
-      (unless (save-excursion (end-of-line 1)
-			      (re-search-forward prohibit end t))
-	(while (and (< (point) end)
-		    (re-search-forward "^[ \t]+" end t))
-	  (goto-char (match-end 0))
-	  (setq col (current-column))
-	  (if (< diff 0) (replace-match ""))
-	  (org-indent-to-column (+ diff col))))
-      (move-marker end nil))))
+
+DIFF is an integer.  Indentation is done according to the
+following rules:
+
+  - Planning information and property drawers are always indented
+    according to the new level of the headline;
+
+  - Footnote definitions and their contents are ignored;
+
+  - Inlinetasks' boundaries are not shifted;
+
+  - Empty lines are ignored;
+
+  - Other lines' indentation are shifted by DIFF columns, unless
+    it would introduce a structural change in the document, in
+    which case no shifting is done at all.
+
+Assume point is at a heading or an inlinetask beginning."
+  (org-with-wide-buffer
+   (narrow-to-region (line-beginning-position)
+		     (save-excursion
+		       (if (org-with-limited-levels (org-at-heading-p))
+			   (org-with-limited-levels (outline-next-heading))
+			 (org-inlinetask-goto-end))
+		       (point)))
+   (forward-line)
+   ;; Indent properly planning info and property drawer.
+   (when (org-looking-at-p org-planning-line-re)
+     (org-indent-line)
+     (forward-line))
+   (when (looking-at org-property-drawer-re)
+     (goto-char (match-end 0))
+     (forward-line)
+     (save-excursion (org-indent-region (match-beginning 0) (match-end 0))))
+   (catch 'no-shift
+     (when (zerop diff) (throw 'no-shift nil))
+     ;; If DIFF is negative, first check if a shift is possible at all
+     ;; (e.g., it doesn't break structure).  This can only happen if
+     ;; some contents are not properly indented.
+     (when (< diff 0)
+       (let ((diff (- diff))
+	     (forbidden-re (concat org-outline-regexp
+				   "\\|"
+				   (substring org-footnote-definition-re 1))))
+	 (save-excursion
+	   (while (not (eobp))
+	     (cond
+	      ((org-looking-at-p "[ \t]*$") (forward-line))
+	      ((and (org-looking-at-p org-footnote-definition-re)
+		    (let ((e (org-element-at-point)))
+		      (and (eq (org-element-type e) 'footnote-definition)
+			   (goto-char (org-element-property :end e))))))
+	      ((org-looking-at-p org-outline-regexp) (forward-line))
+	      ;; Give up if shifting would move before column 0 or if
+	      ;; it would introduce a headline or a footnote
+	      ;; definition.
+	      (t
+	       (skip-chars-forward " \t")
+	       (let ((ind (current-column)))
+		 (when (or (< ind diff)
+			   (and (= ind diff) (org-looking-at-p forbidden-re)))
+		   (throw 'no-shift nil)))
+	       (forward-line)))))))
+     ;; Shift lines but footnote definitions and inlinetasks by DIFF.
+     (while (not (eobp))
+       (cond
+	((and (org-looking-at-p org-footnote-definition-re)
+	      (let ((e (org-element-at-point)))
+		(and (eq (org-element-type e) 'footnote-definition)
+		     (goto-char (org-element-property :end e))))))
+	((org-looking-at-p org-outline-regexp) (forward-line))
+	((org-looking-at-p "[ \t]*$") (forward-line))
+	(t (org-indent-line-to (+ (org-get-indentation) diff))
+	   (forward-line)))))))
 
 (defun org-convert-to-odd-levels ()
   "Convert an org-mode file with all levels allowed to one with odd levels.

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

@@ -1957,6 +1957,251 @@ Text.
 	      (overlays-in (point-min) (point-max)))))))
 
 
+
+;;; Outline structure
+
+(ert-deftest test-org/demote ()
+  "Test `org-demote' specifications."
+  ;; Add correct number of stars according to `org-odd-levels-only'.
+  (should
+   (= 2
+      (org-test-with-temp-text "* H"
+	(let ((org-odd-levels-only nil)) (org-demote))
+	(org-current-level))))
+  (should
+   (= 3
+      (org-test-with-temp-text "* H"
+	(let ((org-odd-levels-only t)) (org-demote))
+	(org-current-level))))
+  ;; When `org-auto-align-tags' is non-nil, move tags accordingly.
+  (should
+   (org-test-with-temp-text "* H  :tag:"
+     (let ((org-tags-column 10)
+	   (org-auto-align-tags t)
+	   (org-odd-levels-only nil))
+       (org-demote))
+     (org-move-to-column 10)
+     (org-looking-at-p ":tag:$")))
+  (should-not
+   (org-test-with-temp-text "* H  :tag:"
+     (let ((org-tags-column 10)
+	   (org-auto-align-tags nil)
+	   (org-odd-levels-only nil))
+       (org-demote))
+     (org-move-to-column 10)
+     (org-looking-at-p ":tag:$")))
+  ;; When `org-adapt-indentation' is non-nil, always indent planning
+  ;; info and property drawers accordingly.
+  (should
+   (= 3
+      (org-test-with-temp-text "* H\n  SCHEDULED: <2014-03-04 tue.>"
+	(let ((org-odd-levels-only nil)
+	      (org-adapt-indentation t))
+	  (org-demote))
+	(forward-line)
+	(org-get-indentation))))
+  (should
+   (= 3
+      (org-test-with-temp-text "* H\n  :PROPERTIES:\n  :FOO: Bar\n  :END:"
+	(let ((org-odd-levels-only nil)
+	      (org-adapt-indentation t))
+	  (org-demote))
+	(forward-line)
+	(org-get-indentation))))
+  (should-not
+   (= 3
+      (org-test-with-temp-text "* H\n  SCHEDULED: <2014-03-04 tue.>"
+	(let ((org-odd-levels-only nil)
+	      (org-adapt-indentation nil))
+	  (org-demote))
+	(forward-line)
+	(org-get-indentation))))
+  ;; When `org-adapt-indentation' is non-nil, shift all lines in
+  ;; section accordingly.  Ignore, however, footnote definitions and
+  ;; inlinetasks boundaries.
+  (should
+   (= 3
+      (org-test-with-temp-text "* H\n  Paragraph"
+	(let ((org-odd-levels-only nil)
+	      (org-adapt-indentation t))
+	  (org-demote))
+	(forward-line)
+	(org-get-indentation))))
+  (should
+   (= 2
+      (org-test-with-temp-text "* H\n  Paragraph"
+	(let ((org-odd-levels-only nil)
+	      (org-adapt-indentation nil))
+	  (org-demote))
+	(forward-line)
+	(org-get-indentation))))
+  (should
+   (zerop
+    (org-test-with-temp-text "* H\n[fn:1] Definition."
+      (let ((org-odd-levels-only nil)
+	    (org-adapt-indentation t))
+	(org-demote))
+      (forward-line)
+      (org-get-indentation))))
+  (should
+   (= 3
+      (org-test-with-temp-text "* H\n[fn:1] Def.\n\n\n  After def."
+	(let ((org-odd-levels-only nil)
+	      (org-adapt-indentation t))
+	  (org-demote))
+	(goto-char (point-max))
+	(org-get-indentation))))
+  (when (featurep 'org-inlinetask)
+    (should
+     (zerop
+      (let ((org-inlinetask-min-level 5)
+	    (org-adapt-indentation t))
+	(org-test-with-temp-text "* H\n***** I\n***** END"
+	  (org-demote)
+	  (forward-line)
+	  (org-get-indentation))))))
+  (when (featurep 'org-inlinetask)
+    (should
+     (= 3
+	(let ((org-inlinetask-min-level 5)
+	      (org-adapt-indentation t))
+	  (org-test-with-temp-text "* H\n***** I\n  Contents\n***** END"
+	    (org-demote)
+	    (forward-line 2)
+	    (org-get-indentation)))))))
+
+(ert-deftest test-org/promote ()
+  "Test `org-promote' specifications."
+  ;; Return an error if headline is to be promoted to level 0, unless
+  ;; `org-allow-promoting-top-level-subtree' is non-nil, in which case
+  ;; headline becomes a comment.
+  (should-error
+   (org-test-with-temp-text "* H"
+     (let ((org-allow-promoting-top-level-subtree nil)) (org-promote))))
+  (should
+   (equal "# H"
+	  (org-test-with-temp-text "* H"
+	    (let ((org-allow-promoting-top-level-subtree t)) (org-promote))
+	    (buffer-string))))
+  ;; Remove correct number of stars according to
+  ;; `org-odd-levels-only'.
+  (should
+   (= 2
+      (org-test-with-temp-text "*** H"
+	(let ((org-odd-levels-only nil)) (org-promote))
+	(org-current-level))))
+  (should
+   (= 1
+      (org-test-with-temp-text "*** H"
+	(let ((org-odd-levels-only t)) (org-promote))
+	(org-current-level))))
+  ;; When `org-auto-align-tags' is non-nil, move tags accordingly.
+  (should
+   (org-test-with-temp-text "** H :tag:"
+     (let ((org-tags-column 10)
+	   (org-auto-align-tags t)
+	   (org-odd-levels-only nil))
+       (org-promote))
+     (org-move-to-column 10)
+     (org-looking-at-p ":tag:$")))
+  (should-not
+   (org-test-with-temp-text "** H :tag:"
+     (let ((org-tags-column 10)
+	   (org-auto-align-tags nil)
+	   (org-odd-levels-only nil))
+       (org-promote))
+     (org-move-to-column 10)
+     (org-looking-at-p ":tag:$")))
+  ;; When `org-adapt-indentation' is non-nil, always indent planning
+  ;; info and property drawers.
+  (should
+   (= 2
+      (org-test-with-temp-text "** H\n   SCHEDULED: <2014-03-04 tue.>"
+	(let ((org-odd-levels-only nil)
+	      (org-adapt-indentation t))
+	  (org-promote))
+	(forward-line)
+	(org-get-indentation))))
+  (should
+   (= 2
+      (org-test-with-temp-text "** H\n   :PROPERTIES:\n   :FOO: Bar\n   :END:"
+	(let ((org-odd-levels-only nil)
+	      (org-adapt-indentation t))
+	  (org-promote))
+	(forward-line)
+	(org-get-indentation))))
+  (should-not
+   (= 2
+      (org-test-with-temp-text "** H\n   SCHEDULED: <2014-03-04 tue.>"
+	(let ((org-odd-levels-only nil)
+	      (org-adapt-indentation nil))
+	  (org-promote))
+	(forward-line)
+	(org-get-indentation))))
+  ;; When `org-adapt-indentation' is non-nil, shift all lines in
+  ;; section accordingly.  Ignore, however, footnote definitions and
+  ;; inlinetasks boundaries.
+  (should
+   (= 2
+      (org-test-with-temp-text "** H\n   Paragraph"
+	(let ((org-odd-levels-only nil)
+	      (org-adapt-indentation t))
+	  (org-promote))
+	(forward-line)
+	(org-get-indentation))))
+  (should-not
+   (= 2
+      (org-test-with-temp-text "** H\n   Paragraph"
+	(let ((org-odd-levels-only nil)
+	      (org-adapt-indentation nil))
+	  (org-promote))
+	(forward-line)
+	(org-get-indentation))))
+  (should
+   (= 2
+      (org-test-with-temp-text "** H\n   Paragraph\n[fn:1] Definition."
+	(let ((org-odd-levels-only nil)
+	      (org-adapt-indentation t))
+	  (org-promote))
+	(forward-line)
+	(org-get-indentation))))
+  (when (featurep 'org-inlinetask)
+    (should
+     (zerop
+      (let ((org-inlinetask-min-level 5)
+	    (org-adapt-indentation t))
+	(org-test-with-temp-text "** H\n***** I\n***** END"
+	  (org-promote)
+	  (forward-line)
+	  (org-get-indentation))))))
+  (when (featurep 'org-inlinetask)
+    (should
+     (= 2
+	(let ((org-inlinetask-min-level 5)
+	      (org-adapt-indentation t))
+	  (org-test-with-temp-text "** H\n***** I\n   Contents\n***** END"
+	    (org-promote)
+	    (forward-line 2)
+	    (org-get-indentation))))))
+  ;; Give up shifting if it would break document's structure
+  ;; otherwise.
+  (should
+   (= 3
+      (org-test-with-temp-text "** H\n   Paragraph\n [fn:1] Def."
+	(let ((org-odd-levels-only nil)
+	      (org-adapt-indentation t))
+	  (org-promote))
+	(forward-line)
+	(org-get-indentation))))
+  (should
+   (= 3
+      (org-test-with-temp-text "** H\n   Paragraph\n * list."
+	(let ((org-odd-levels-only nil)
+	      (org-adapt-indentation t))
+	  (org-promote))
+	(forward-line)
+	(org-get-indentation)))))
+
 
 ;;; Planning