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 10aba6b126) and
I couldn't find a good reason to keep it.
Suggested-by: Sébastien Vauban
<http://permalink.gmane.org/gmane.emacs.orgmode/92450>
This commit is contained in:
Nicolas Goaziou
parent
e429eb4315
commit
cba2f0a2a3
157
lisp/org.el
157
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.
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
||||
|
|
|
|||
Loading…
Reference in New Issue