From 10aba6b1261a47a2aa4862b7222f87814af7ba31 Mon Sep 17 00:00:00 2001 From: Bastien Guerry Date: Tue, 8 May 2012 15:19:36 +0200 Subject: [PATCH] New option `org-allow-promoting-top-level-subtree'. * org.el (org-allow-promoting-top-level-subtree): New option to allow promoting a top-level subtree. (org-called-with-limited-levels): New variable, dynamically bound within the `org-with-limited-levels' macro. (org-promote): Use the new option to allow promoting a top-level subtree. * org-macs.el (org-with-limited-levels): Let-bind `org-called-interactively-p' to t. Promoting a top-level subtree can be useful but should not be allowed by default, as this restructuring is only reversible with M-x undo RET. --- lisp/org-macs.el | 3 ++- lisp/org.el | 25 ++++++++++++++++++++----- 2 files changed, 22 insertions(+), 6 deletions(-) diff --git a/lisp/org-macs.el b/lisp/org-macs.el index 481558fed..1c2524933 100644 --- a/lisp/org-macs.el +++ b/lisp/org-macs.el @@ -372,7 +372,8 @@ point nowhere." (defmacro org-with-limited-levels (&rest body) "Execute BODY with limited number of outline levels." - `(let* ((org-outline-regexp (org-get-limited-outline-regexp)) + `(let* ((org-called-with-limited-levels t) + (org-outline-regexp (org-get-limited-outline-regexp)) (outline-regexp org-outline-regexp) (org-outline-regexp-at-bol (concat "^" org-outline-regexp))) ,@body)) diff --git a/lisp/org.el b/lisp/org.el index 8ffeee179..98af1280e 100644 --- a/lisp/org.el +++ b/lisp/org.el @@ -5418,6 +5418,14 @@ will be prompted for." :group 'org-appearance :group 'org-babel) +(defcustom org-allow-promoting-top-level-subtree nil + "When non-nil, allow promoting a top level subtree. +The leading star of the top level headline will be replaced +by a #." + :type 'boolean + :version "24.1" + :group 'org-appearance) + (defun org-fontify-meta-lines-and-blocks (limit) (condition-case nil (org-fontify-meta-lines-and-blocks-1 limit) @@ -7466,6 +7474,8 @@ even level numbers will become the next higher odd number." (define-obsolete-function-alias 'org-get-legal-level 'org-get-valid-level "23.1"))) +(defvar org-called-with-limited-levels nil) ;; Dynamically bound in + ;; ̀org-with-limited-levels' (defun org-promote () "Promote the current heading higher up the tree. If the region is active in `transient-mark-mode', promote all headings @@ -7476,11 +7486,16 @@ in the region." after-change-functions)) (up-head (concat (make-string (org-get-valid-level level -1) ?*) " ")) (diff (abs (- level (length up-head) -1)))) - (if (= level 1) (error "Cannot promote to level 0. UNDO to recover if necessary")) - (replace-match up-head nil t) - ;; Fixup tag positioning - (and org-auto-align-tags (org-set-tags nil t)) - (if org-adapt-indentation (org-fixup-indentation (- diff))) + (cond ((and (= level 1) org-called-with-limited-levels + org-allow-promoting-top-level-subtree) + (replace-match "# " nil t)) + ((= level 1) + (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 t)) + (if org-adapt-indentation (org-fixup-indentation (- diff)))) (run-hooks 'org-after-promote-entry-hook))) (defun org-demote ()