Browse Source

Handle 'start-level value of `org-loop-over-headlines-in-active-region' for archiving commands.

* org-archive.el (org-archive-subtree)
(org-archive-to-archive-sibling, org-toggle-archive-tag)
(org-archive-set-tag): Handle the 'start-level value for
`org-loop-over-headlines-in-active-region'.
Bastien Guerry 14 years ago
parent
commit
834d9514bd
1 changed files with 16 additions and 12 deletions
  1. 16 12
      lisp/org-archive.el

+ 16 - 12
lisp/org-archive.el

@@ -191,13 +191,14 @@ If the cursor is not at a headline when this command is called, try all level
 this heading."
 this heading."
   (interactive "P")
   (interactive "P")
   (if (and (org-region-active-p) org-loop-over-headlines-in-active-region)
   (if (and (org-region-active-p) org-loop-over-headlines-in-active-region)
-      (let (org-loop-over-headlines-in-active-region)
+      (let ((cl (if (eq org-loop-over-headlines-in-active-region 'start-level)
+		    'region-current-level 'region))
+	    org-loop-over-headlines-in-active-region)
 	(org-map-entries
 	(org-map-entries
 	 `(progn (setq org-map-continue-from (progn (org-back-to-heading) (point)))
 	 `(progn (setq org-map-continue-from (progn (org-back-to-heading) (point)))
 		 (org-archive-subtree ,find-done))
 		 (org-archive-subtree ,find-done))
 	 org-loop-over-headlines-in-active-region
 	 org-loop-over-headlines-in-active-region
-	 'region
-	 (if (outline-invisible-p) (org-end-of-subtree nil t))))
+	 cl (if (outline-invisible-p) (org-end-of-subtree nil t))))
     (if find-done
     (if find-done
 	(org-archive-all-done)
 	(org-archive-all-done)
       ;; Save all relevant TODO keyword-relatex variables
       ;; Save all relevant TODO keyword-relatex variables
@@ -357,7 +358,9 @@ The archive sibling is a sibling of the heading with the heading name
 sibling does not exist, it will be created at the end of the subtree."
 sibling does not exist, it will be created at the end of the subtree."
   (interactive)
   (interactive)
   (if (and (org-region-active-p) org-loop-over-headlines-in-active-region)
   (if (and (org-region-active-p) org-loop-over-headlines-in-active-region)
-      (let (org-loop-over-headlines-in-active-region)
+      (let ((cl (when (eq org-loop-over-headlines-in-active-region 'start-level)
+		  'region-current-level 'region))
+	    org-loop-over-headlines-in-active-region)
 	(org-map-entries
 	(org-map-entries
 	 '(progn (setq org-map-continue-from
 	 '(progn (setq org-map-continue-from
 		       (progn (org-back-to-heading)
 		       (progn (org-back-to-heading)
@@ -367,8 +370,7 @@ sibling does not exist, it will be created at the end of the subtree."
 		 (when (org-at-heading-p)
 		 (when (org-at-heading-p)
 		   (org-archive-to-archive-sibling)))
 		   (org-archive-to-archive-sibling)))
 	 org-loop-over-headlines-in-active-region
 	 org-loop-over-headlines-in-active-region
-	 'region
-	 (if (outline-invisible-p) (org-end-of-subtree nil t))))
+	 cl (if (outline-invisible-p) (org-end-of-subtree nil t))))
     (save-restriction
     (save-restriction
       (widen)
       (widen)
       (let (b e pos leader level)
       (let (b e pos leader level)
@@ -469,12 +471,13 @@ With prefix ARG, check all children of current headline and offer tagging
 the children that do not contain any open TODO items."
 the children that do not contain any open TODO items."
   (interactive "P")
   (interactive "P")
   (if (and (org-region-active-p) org-loop-over-headlines-in-active-region)
   (if (and (org-region-active-p) org-loop-over-headlines-in-active-region)
-      (let (org-loop-over-headlines-in-active-region)
+      (let ((cl (if (eq org-loop-over-headlines-in-active-region 'start-level)
+		    'region-current-level 'region))
+	    org-loop-over-headlines-in-active-region)
 	(org-map-entries
 	(org-map-entries
 	 `(org-toggle-archive-tag ,find-done)
 	 `(org-toggle-archive-tag ,find-done)
 	 org-loop-over-headlines-in-active-region
 	 org-loop-over-headlines-in-active-region
-	 'region
-	 (if (outline-invisible-p) (org-end-of-subtree nil t))))
+	 cl (if (outline-invisible-p) (org-end-of-subtree nil t))))
     (if find-done
     (if find-done
 	(org-archive-all-done 'tag)
 	(org-archive-all-done 'tag)
       (let (set)
       (let (set)
@@ -489,12 +492,13 @@ the children that do not contain any open TODO items."
   "Set the ARCHIVE tag."
   "Set the ARCHIVE tag."
   (interactive)
   (interactive)
   (if (and (org-region-active-p) org-loop-over-headlines-in-active-region)
   (if (and (org-region-active-p) org-loop-over-headlines-in-active-region)
-      (let (org-loop-over-headlines-in-active-region)
+      (let ((cl (if (eq org-loop-over-headlines-in-active-region 'start-level)
+		    'region-current-level 'region))
+	    org-loop-over-headlines-in-active-region)
 	(org-map-entries
 	(org-map-entries
 	 'org-archive-set-tag
 	 'org-archive-set-tag
 	 org-loop-over-headlines-in-active-region
 	 org-loop-over-headlines-in-active-region
-	 'region
-	 (if (outline-invisible-p) (org-end-of-subtree nil t))))
+	 cl (if (outline-invisible-p) (org-end-of-subtree nil t))))
     (org-toggle-tag org-archive-tag 'on)))
     (org-toggle-tag org-archive-tag 'on)))
 
 
 ;;;###autoload
 ;;;###autoload