New feature: loop over siblings for some commands

New feature: loop over siblings for some commands

[Bastien]

Dear all,

from latest git repo: 

  (setq org-loop-over-siblings-within-active-region-p t)

will allow you to run some commands on several siblings in 
the active region.  

For example:

<start active region>
* Item 1
* Item 2
* Item 3
<end active region>

Then `C-c C-s' (org-schedule) will ask for a schedule date
for each of the item in the active region.  See the commit
log for more details:

  http://orgmode.org/w/?p=org-mode.git;a=commit;h=366254217ac6faea20a5d43fae065bd028806eab

I'm interested in allowing this for org-todo as well, but I
would first like some feedback on the current feature and its
scope wrt actual needs.

Thanks a lot!

-- 
 Bastien

Re: New feature: loop over siblings for some commands

[David Maus]

[-- Attachment #1: Type: text/plain, Size: 1859 bytes --]

At Mon, 18 Jul 2011 10:32:11 +0200,
Bastien wrote:
>
> Dear all,
>
> from latest git repo:
>
>   (setq org-loop-over-siblings-within-active-region-p t)
>
> will allow you to run some commands on several siblings in
> the active region.
>
> For example:
>
> <start active region>
> * Item 1
> * Item 2
> * Item 3
> <end active region>
>
> Then `C-c C-s' (org-schedule) will ask for a schedule date
> for each of the item in the active region.  See the commit
> log for more details:
>
>   http://orgmode.org/w/?p=org-mode.git;a=commit;h=366254217ac6faea20a5d43fae065bd028806eab
>
> I'm interested in allowing this for org-todo as well, but I
> would first like some feedback on the current feature and its
> scope wrt actual needs.

The macro suffers from leaking: It let-binds symbols like beg, end
etc. that might be present in ,@body. The let-bound symbols will
shadow body's.

Minimal example:

,----
| (defmacro leak-it-baby (&rest body)
|   `(let ((foobar 0))
|      (while (< foobar 10)
|        (setq foobar (1+ foobar))
|        ,@body)))
|
| (let ((foobar 9))
|   (leak-it-baby
|    (setq foobar 11)
|    (print foobar)))
|
| ELISP> (macroexpand '(leak-it-baby (setq foobar 11)))
| (let
|     ((foobar 0))
|   (while
|       (< foobar 10)
|     (setq foobar
| 	  (1+ foobar))
|     (setq foobar 11)))
|
| ELISP>
`----

The whole problem of leaking macros is discussed in Peter Seibel's
"Practical Common Lisp", Chapter 8

http://www.gigamonkeys.com/book/macros-defining-your-own.html

The solution is a heavy use of C-h f gensym RET for all symboles
needed in the macro to create fresh, unique und uninterned symbols.

If no one jumps on a fix for this I will provide one till next
sunday. Always wanted to do some lecker macro programming :)

Best,
  -- David
--
OpenPGP... 0x99ADB83B5A4478E6
Jabber.... dmjena@jabber.org
Email..... dmaus@ictsoc.de

[-- Attachment #2: Type: application/pgp-signature, Size: 230 bytes --]

Re: New feature: loop over siblings for some commands

[David Maus]

[-- Attachment #1: Type: text/plain, Size: 1834 bytes --]

After a first look at the macro and its usage I have the feeling that
the macro would be wrong and/or a bad design choice.

It conditionally implements a mapping of body to a headline's
siblings. Thus it is a specialized case of applying a function to zero
or more headlines based on a selection criteria: In other words it is
a special case of org-map-entries.

So first there is duplicate code. Second the usage of the macro in for
instance `org-schedule'. The macro is wrapped around the entire
function body (except the interactive expression) and its only use is
avoidance of creating a separate function with the scheduling
implementation.

I highly recommend to not use this macro but to build the intended
functionality with separate building blocks: Factor out the flesh of
the respective functions (e.g. org-schedule) and use org-map-entries
to map. As far as I can see, the latter provides all we need:

(org-map-entries FUNC &optional MATCH SCOPE &rest SKIP)

We have FUNC (schedule) and MATCH (siblings). Region is the SCOPE (we
have to extend map-entries here). We might even extend the syntax of
MATCH to accept symbols indicating concepts like "sibling" and the
like. Ideally:

#+begin_src emacs-lisp
  (if (or (not (org-region-active-p))
          (not org-loop-over-siblings-within-active-region-p))  ;; -p? its not a predicate function!
      (org-really-do-the-schedule)
    (org-map-entries 'org-really-do-the-schedule 'siblings 'region))
#+end_src

Another abstraction: Instead
'org-loop-over-siblings-with-active-region' something like:
'org-loop-over-headlines-with-active-region' that can be set to a
symbol or a list of symbols indicating which headings to loop over
(e.g. 'siblings, 'children, ...).

Best,
  -- David
--
OpenPGP... 0x99ADB83B5A4478E6
Jabber.... dmjena@jabber.org
Email..... dmaus@ictsoc.de

[-- Attachment #2: Type: application/pgp-signature, Size: 230 bytes --]

Re: New feature: loop over siblings for some commands

[Bastien]

[-- Attachment #1: Type: text/plain, Size: 1379 bytes --]

Hi David,

David Maus <dmaus@ictsoc.de> writes:

> I highly recommend to not use this macro but to build the intended
> functionality with separate building blocks: Factor out the flesh of
> the respective functions (e.g. org-schedule) and use org-map-entries
> to map. As far as I can see, the latter provides all we need:

I took this road.

The first patch manually reverts the commit you are commenting.

The second patch lets `org-map-entries' take a region as a scope.

The third patch implements the "loop" functionality by just using
`org-map-entries', not a macro.

I'm sure we could have an `org-loop' macro factoring out the duplicate
code in the new `org-schedule' and `org-deadline'.  If you have time to
look at this, that will greatly help.

> Another abstraction: Instead
> 'org-loop-over-siblings-with-active-region' something like:
> 'org-loop-over-headlines-with-active-region' that can be set to a
> symbol or a list of symbols indicating which headings to loop over
> (e.g. 'siblings, 'children, ...).

The variable is now called `org-loop-over-headlines-in-active-region'
and understand these kind of values:

- nil: don't loop
- t: loop over all headlines
- "MATCH": a tag/property/todo match to loop over matching headlines

If you can test these patches and send some feedback, that'd be nice!

Thanks again for the analysis and the suggested solution.


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0001-Manually-revert-366254217ac6faea20a5d43fae065bd02880.patch --]
[-- Type: text/x-patch, Size: 25912 bytes --]

From 130dc4e2b1e6a353197a6277818b94b11c0c38d0 Mon Sep 17 00:00:00 2001
From: Bastien Guerry <bzg@altern.org>
Date: Wed, 27 Jul 2011 16:32:41 +0200
Subject: [PATCH 1/3] Manually revert
 366254217ac6faea20a5d43fae065bd028806eab.

As David Maus pointed out, the implementation is not good.

* org.el (org-deadline, org-schedule): Don't loop.
(org-loop-over-siblings-within-active-region-p): Remove.
* org-archive.el (org-archive-subtree)
(org-archive-to-archive-sibling, org-toggle-archive-tag):
Don't loop.

* org-macs.el (org-loop-over-siblings-in-active-region):
Remove.
---
 lisp/org-archive.el |  426 +++++++++++++++++++++++++--------------------------
 lisp/org-macs.el    |   20 ---
 lisp/org.el         |  144 ++++++++----------
 3 files changed, 276 insertions(+), 314 deletions(-)

diff --git a/lisp/org-archive.el b/lisp/org-archive.el
index 30e6184..f6898ea 100644
--- a/lisp/org-archive.el
+++ b/lisp/org-archive.el
@@ -192,159 +192,158 @@ If the cursor is not at a headline when this command is called, try all level
 1 trees.  If the cursor is on a headline, only try the direct children of
 this heading."
   (interactive "P")
-  (org-loop-over-siblings-in-active-region
-   (if find-done
-       (org-archive-all-done)
-     ;; Save all relevant TODO keyword-relatex variables
-     
-     (let ((tr-org-todo-line-regexp org-todo-line-regexp) ; keep despite compiler
-	   (tr-org-todo-keywords-1 org-todo-keywords-1)
-	   (tr-org-todo-kwd-alist org-todo-kwd-alist)
-	   (tr-org-done-keywords org-done-keywords)
-	   (tr-org-todo-regexp org-todo-regexp)
-	   (tr-org-todo-line-regexp org-todo-line-regexp)
-	   (tr-org-odd-levels-only org-odd-levels-only)
-	   (this-buffer (current-buffer))
-	   ;; start of variables that will be used for saving context
-	   ;; The compiler complains about them - keep them anyway!
-	   (file (abbreviate-file-name
-		  (or (buffer-file-name (buffer-base-buffer))
-		      (error "No file associated to buffer"))))
-	   (olpath (mapconcat 'identity (org-get-outline-path) "/"))
-	   (time (format-time-string
-		  (substring (cdr org-time-stamp-formats) 1 -1)
-		  (current-time)))
-	   category todo priority ltags itags atags
-	   ;; end of variables that will be used for saving context
-	   location afile heading buffer level newfile-p infile-p visiting)
-       
-       ;; Find the local archive location
-       (setq location (org-get-local-archive-location)
-	     afile (org-extract-archive-file location)
-	     heading (org-extract-archive-heading location)
-	     infile-p (equal file (abbreviate-file-name afile)))
-       (unless afile
-	 (error "Invalid `org-archive-location'"))
-       
-       (if (> (length afile) 0)
-	   (setq newfile-p (not (file-exists-p afile))
-		 visiting (find-buffer-visiting afile)
-		 buffer (or visiting (find-file-noselect afile)))
-	 (setq buffer (current-buffer)))
-       (unless buffer
-	 (error "Cannot access file \"%s\"" afile))
-       (if (and (> (length heading) 0)
-		(string-match "^\\*+" heading))
-	   (setq level (match-end 0))
-	 (setq heading nil level 0))
-       (save-excursion
-	 (org-back-to-heading t)
-	 ;; Get context information that will be lost by moving the tree
-	 (setq category (org-get-category nil 'force-refresh)
-	       todo (and (looking-at org-todo-line-regexp)
-			 (match-string 2))
-	       priority (org-get-priority
-			 (if (match-end 3) (match-string 3) ""))
-	       ltags (org-get-tags)
-	       itags (org-delete-all ltags (org-get-tags-at))
-	       atags (org-get-tags-at))
-	 (setq ltags (mapconcat 'identity ltags " ")
-	       itags (mapconcat 'identity itags " "))
-	 ;; We first only copy, in case something goes wrong
-	 ;; we need to protect `this-command', to avoid kill-region sets it,
-	 ;; which would lead to duplication of subtrees
-	 (let (this-command) (org-copy-subtree 1 nil t))
-	 (set-buffer buffer)
-	 ;; Enforce org-mode for the archive buffer
-	 (if (not (org-mode-p))
-	     ;; Force the mode for future visits.
-	     (let ((org-insert-mode-line-in-empty-file t)
-		   (org-inhibit-startup t))
-	       (call-interactively 'org-mode)))
-	 (when newfile-p
-	   (goto-char (point-max))
-	   (insert (format "\nArchived entries from file %s\n\n"
-			   (buffer-file-name this-buffer))))
-	 ;; Force the TODO keywords of the original buffer
-	 (let ((org-todo-line-regexp tr-org-todo-line-regexp)
-	       (org-todo-keywords-1 tr-org-todo-keywords-1)
-	       (org-todo-kwd-alist tr-org-todo-kwd-alist)
-	       (org-done-keywords tr-org-done-keywords)
-	       (org-todo-regexp tr-org-todo-regexp)
-	       (org-todo-line-regexp tr-org-todo-line-regexp)
-	       (org-odd-levels-only
-		(if (local-variable-p 'org-odd-levels-only (current-buffer))
-		    org-odd-levels-only
-		  tr-org-odd-levels-only)))
-	   (goto-char (point-min))
-	   (show-all)
-	   (if heading
-	       (progn
-		 (if (re-search-forward
-		      (concat "^" (regexp-quote heading)
-			      (org-re "[ \t]*\\(:[[:alnum:]_@#%:]+:\\)?[ \t]*\\($\\|\r\\)"))
-		      nil t)
-		     (goto-char (match-end 0))
-		   ;; Heading not found, just insert it at the end
-		   (goto-char (point-max))
-		   (or (bolp) (insert "\n"))
-		   (insert "\n" heading "\n")
-		   (end-of-line 0))
-		 ;; Make the subtree visible
-		 (show-subtree)
-		 (if org-archive-reversed-order
-		     (progn
-		       (org-back-to-heading t)
-		       (outline-next-heading))
-		   (org-end-of-subtree t))
-		 (skip-chars-backward " \t\r\n")
-		 (and (looking-at "[ \t\r\n]*")
-		      (replace-match "\n\n")))
-	     ;; No specific heading, just go to end of file.
-	     (goto-char (point-max)) (insert "\n"))
-	   ;; Paste
-	   (org-paste-subtree (org-get-valid-level level (and heading 1)))
-	   ;; Shall we append inherited tags?
-	   (and itags
-		(or (and (eq org-archive-subtree-add-inherited-tags 'infile) 
-			 infile-p)
-		    (eq org-archive-subtree-add-inherited-tags t))
-		(org-set-tags-to atags))
-	   ;; Mark the entry as done
-	   (when (and org-archive-mark-done
-		      (looking-at org-todo-line-regexp)
-		      (or (not (match-end 2))
-			  (not (member (match-string 2) org-done-keywords))))
-	     (let (org-log-done org-todo-log-states)
-	       (org-todo
-		(car (or (member org-archive-mark-done org-done-keywords)
-			 org-done-keywords)))))
-	   
-	   ;; Add the context info
-	   (when org-archive-save-context-info
-	     (let ((l org-archive-save-context-info) e n v)
-	       (while (setq e (pop l))
-		 (when (and (setq v (symbol-value e))
-			    (stringp v) (string-match "\\S-" v))
-		   (setq n (concat "ARCHIVE_" (upcase (symbol-name e))))
-		   (org-entry-put (point) n v)))))
-	   
-	   ;; Save and kill the buffer, if it is not the same buffer.
-	   (when (not (eq this-buffer buffer))
-	     (save-buffer))))
-       ;; Here we are back in the original buffer.  Everything seems to have
-       ;; worked.  So now cut the tree and finish up.
-       (let (this-command) (org-cut-subtree))
-       (when (featurep 'org-inlinetask)
-	 (org-inlinetask-remove-END-maybe))
-       (setq org-markers-to-move nil)
-       (message "Subtree archived %s"
-		(if (eq this-buffer buffer)
-		    (concat "under heading: " heading)
-		  (concat "in file: " (abbreviate-file-name afile))))))
-   (org-reveal)
-   (if (looking-at "^[ \t]*$")
-       (outline-next-visible-heading 1))))
+  (if find-done
+      (org-archive-all-done)
+    ;; Save all relevant TODO keyword-relatex variables
+    
+    (let ((tr-org-todo-line-regexp org-todo-line-regexp) ; keep despite compiler
+	  (tr-org-todo-keywords-1 org-todo-keywords-1)
+	  (tr-org-todo-kwd-alist org-todo-kwd-alist)
+	  (tr-org-done-keywords org-done-keywords)
+	  (tr-org-todo-regexp org-todo-regexp)
+	  (tr-org-todo-line-regexp org-todo-line-regexp)
+	  (tr-org-odd-levels-only org-odd-levels-only)
+	  (this-buffer (current-buffer))
+	  ;; start of variables that will be used for saving context
+	  ;; The compiler complains about them - keep them anyway!
+	  (file (abbreviate-file-name
+		 (or (buffer-file-name (buffer-base-buffer))
+		     (error "No file associated to buffer"))))
+	  (olpath (mapconcat 'identity (org-get-outline-path) "/"))
+	  (time (format-time-string
+		 (substring (cdr org-time-stamp-formats) 1 -1)
+		 (current-time)))
+	  category todo priority ltags itags atags
+	  ;; end of variables that will be used for saving context
+	  location afile heading buffer level newfile-p infile-p visiting)
+      
+      ;; Find the local archive location
+      (setq location (org-get-local-archive-location)
+	    afile (org-extract-archive-file location)
+	    heading (org-extract-archive-heading location)
+	    infile-p (equal file (abbreviate-file-name afile)))
+      (unless afile
+	(error "Invalid `org-archive-location'"))
+      
+      (if (> (length afile) 0)
+	  (setq newfile-p (not (file-exists-p afile))
+		visiting (find-buffer-visiting afile)
+		buffer (or visiting (find-file-noselect afile)))
+	(setq buffer (current-buffer)))
+      (unless buffer
+	(error "Cannot access file \"%s\"" afile))
+      (if (and (> (length heading) 0)
+	       (string-match "^\\*+" heading))
+	  (setq level (match-end 0))
+	(setq heading nil level 0))
+      (save-excursion
+	(org-back-to-heading t)
+	;; Get context information that will be lost by moving the tree
+	(setq category (org-get-category nil 'force-refresh)
+	      todo (and (looking-at org-todo-line-regexp)
+			(match-string 2))
+	      priority (org-get-priority
+			(if (match-end 3) (match-string 3) ""))
+	      ltags (org-get-tags)
+	      itags (org-delete-all ltags (org-get-tags-at))
+	      atags (org-get-tags-at))
+	(setq ltags (mapconcat 'identity ltags " ")
+	      itags (mapconcat 'identity itags " "))
+	;; We first only copy, in case something goes wrong
+	;; we need to protect `this-command', to avoid kill-region sets it,
+	;; which would lead to duplication of subtrees
+	(let (this-command) (org-copy-subtree 1 nil t))
+	(set-buffer buffer)
+	;; Enforce org-mode for the archive buffer
+	(if (not (org-mode-p))
+	    ;; Force the mode for future visits.
+	    (let ((org-insert-mode-line-in-empty-file t)
+		  (org-inhibit-startup t))
+	      (call-interactively 'org-mode)))
+	(when newfile-p
+	  (goto-char (point-max))
+	  (insert (format "\nArchived entries from file %s\n\n"
+			  (buffer-file-name this-buffer))))
+	;; Force the TODO keywords of the original buffer
+	(let ((org-todo-line-regexp tr-org-todo-line-regexp)
+	      (org-todo-keywords-1 tr-org-todo-keywords-1)
+	      (org-todo-kwd-alist tr-org-todo-kwd-alist)
+	      (org-done-keywords tr-org-done-keywords)
+	      (org-todo-regexp tr-org-todo-regexp)
+	      (org-todo-line-regexp tr-org-todo-line-regexp)
+	      (org-odd-levels-only
+	       (if (local-variable-p 'org-odd-levels-only (current-buffer))
+		   org-odd-levels-only
+		 tr-org-odd-levels-only)))
+	  (goto-char (point-min))
+	  (show-all)
+	  (if heading
+	      (progn
+		(if (re-search-forward
+		     (concat "^" (regexp-quote heading)
+			     (org-re "[ \t]*\\(:[[:alnum:]_@#%:]+:\\)?[ \t]*\\($\\|\r\\)"))
+		     nil t)
+		    (goto-char (match-end 0))
+		  ;; Heading not found, just insert it at the end
+		  (goto-char (point-max))
+		  (or (bolp) (insert "\n"))
+		  (insert "\n" heading "\n")
+		  (end-of-line 0))
+		;; Make the subtree visible
+		(show-subtree)
+		(if org-archive-reversed-order
+		    (progn
+		      (org-back-to-heading t)
+		      (outline-next-heading))
+		  (org-end-of-subtree t))
+		(skip-chars-backward " \t\r\n")
+		(and (looking-at "[ \t\r\n]*")
+		     (replace-match "\n\n")))
+	    ;; No specific heading, just go to end of file.
+	    (goto-char (point-max)) (insert "\n"))
+	  ;; Paste
+	  (org-paste-subtree (org-get-valid-level level (and heading 1)))
+	  ;; Shall we append inherited tags?
+	  (and itags
+	       (or (and (eq org-archive-subtree-add-inherited-tags 'infile) 
+			infile-p)
+		   (eq org-archive-subtree-add-inherited-tags t))
+	       (org-set-tags-to atags))
+	  ;; Mark the entry as done
+	  (when (and org-archive-mark-done
+		     (looking-at org-todo-line-regexp)
+		     (or (not (match-end 2))
+			 (not (member (match-string 2) org-done-keywords))))
+	    (let (org-log-done org-todo-log-states)
+	      (org-todo
+	       (car (or (member org-archive-mark-done org-done-keywords)
+			org-done-keywords)))))
+	  
+	  ;; Add the context info
+	  (when org-archive-save-context-info
+	    (let ((l org-archive-save-context-info) e n v)
+	      (while (setq e (pop l))
+		(when (and (setq v (symbol-value e))
+			   (stringp v) (string-match "\\S-" v))
+		  (setq n (concat "ARCHIVE_" (upcase (symbol-name e))))
+		  (org-entry-put (point) n v)))))
+	  
+	  ;; Save and kill the buffer, if it is not the same buffer.
+	  (when (not (eq this-buffer buffer))
+	    (save-buffer))))
+      ;; Here we are back in the original buffer.  Everything seems to have
+      ;; worked.  So now cut the tree and finish up.
+      (let (this-command) (org-cut-subtree))
+      (when (featurep 'org-inlinetask)
+	(org-inlinetask-remove-END-maybe))
+      (setq org-markers-to-move nil)
+      (message "Subtree archived %s"
+	       (if (eq this-buffer buffer)
+		   (concat "under heading: " heading)
+		 (concat "in file: " (abbreviate-file-name afile))))))
+  (org-reveal)
+  (if (looking-at "^[ \t]*$")
+      (outline-next-visible-heading 1)))
 
 (defun org-archive-to-archive-sibling ()
   "Archive the current heading by moving it under the archive sibling.
@@ -352,56 +351,55 @@ The archive sibling is a sibling of the heading with the heading name
 `org-archive-sibling-heading' and an `org-archive-tag' tag.  If this
 sibling does not exist, it will be created at the end of the subtree."
   (interactive)
-  (org-loop-over-siblings-in-active-region
-   (save-restriction
-     (widen)
-     (let (b e pos leader level)
-       (org-back-to-heading t)
-       (looking-at outline-regexp)
-       (setq leader (match-string 0)
-	     level (funcall outline-level))
-       (setq pos (point))
-       (condition-case nil
-	   (outline-up-heading 1 t)
-	 (error (setq e (point-max)) (goto-char (point-min))))
-       (setq b (point))
-       (unless e
-	 (condition-case nil
-	     (org-end-of-subtree t t)
-	   (error (goto-char (point-max))))
-	 (setq e (point)))
-       (goto-char b)
-       (unless (re-search-forward
-		(concat "^" (regexp-quote leader)
-			"[ \t]*"
-			org-archive-sibling-heading
-			"[ \t]*:"
-			org-archive-tag ":") e t)
-	 (goto-char e)
-	 (or (bolp) (newline))
-	 (insert leader org-archive-sibling-heading "\n")
-	 (beginning-of-line 0)
-	 (org-toggle-tag org-archive-tag 'on))
-       (beginning-of-line 1)
-       (if org-archive-reversed-order
-	   (outline-next-heading)
-	 (org-end-of-subtree t t))
-       (save-excursion
-	 (goto-char pos)
-	 (let ((this-command this-command)) (org-cut-subtree)))
-       (org-paste-subtree (org-get-valid-level level 1))
-       (org-set-property
-	"ARCHIVE_TIME"
-	(format-time-string
-	 (substring (cdr org-time-stamp-formats) 1 -1)
-	 (current-time)))
-       (outline-up-heading 1 t)
-       (hide-subtree)
-       (org-cycle-show-empty-lines 'folded)
-       (goto-char pos)))
-   (org-reveal)
-   (if (looking-at "^[ \t]*$")
-       (outline-next-visible-heading 1))))
+  (save-restriction
+    (widen)
+    (let (b e pos leader level)
+      (org-back-to-heading t)
+      (looking-at outline-regexp)
+      (setq leader (match-string 0)
+	    level (funcall outline-level))
+      (setq pos (point))
+      (condition-case nil
+	  (outline-up-heading 1 t)
+	(error (setq e (point-max)) (goto-char (point-min))))
+      (setq b (point))
+      (unless e
+	(condition-case nil
+	    (org-end-of-subtree t t)
+	  (error (goto-char (point-max))))
+	(setq e (point)))
+      (goto-char b)
+      (unless (re-search-forward
+	       (concat "^" (regexp-quote leader)
+		       "[ \t]*"
+		       org-archive-sibling-heading
+		       "[ \t]*:"
+		       org-archive-tag ":") e t)
+	(goto-char e)
+	(or (bolp) (newline))
+	(insert leader org-archive-sibling-heading "\n")
+	(beginning-of-line 0)
+	(org-toggle-tag org-archive-tag 'on))
+      (beginning-of-line 1)
+      (if org-archive-reversed-order
+	  (outline-next-heading)
+	(org-end-of-subtree t t))
+      (save-excursion
+	(goto-char pos)
+	(let ((this-command this-command)) (org-cut-subtree)))
+      (org-paste-subtree (org-get-valid-level level 1))
+      (org-set-property
+       "ARCHIVE_TIME"
+       (format-time-string
+	(substring (cdr org-time-stamp-formats) 1 -1)
+	(current-time)))
+      (outline-up-heading 1 t)
+      (hide-subtree)
+      (org-cycle-show-empty-lines 'folded)
+      (goto-char pos)))
+  (org-reveal)
+  (if (looking-at "^[ \t]*$")
+      (outline-next-visible-heading 1)))
 
 (defun org-archive-all-done (&optional tag)
   "Archive sublevels of the current tree without open TODO items.
@@ -452,22 +450,20 @@ When TAG is non-nil, don't move trees, but mark them with the ARCHIVE tag."
 With prefix ARG, check all children of current headline and offer tagging
 the children that do not contain any open TODO items."
   (interactive "P")
-  (org-loop-over-siblings-in-active-region
-   (if find-done
-       (org-archive-all-done 'tag)
-     (let (set)
-       (save-excursion
-	 (org-back-to-heading t)
-	 (setq set (org-toggle-tag org-archive-tag))
-	 (when set (hide-subtree)))
-       (and set (beginning-of-line 1))
-       (message "Subtree %s" (if set "archived" "unarchived"))))))
+  (if find-done
+      (org-archive-all-done 'tag)
+    (let (set)
+      (save-excursion
+	(org-back-to-heading t)
+	(setq set (org-toggle-tag org-archive-tag))
+	(when set (hide-subtree)))
+      (and set (beginning-of-line 1))
+      (message "Subtree %s" (if set "archived" "unarchived")))))
 
 (defun org-archive-set-tag ()
   "Set the ARCHIVE tag."
   (interactive)
-  (org-loop-over-siblings-in-active-region
-   (org-toggle-tag org-archive-tag 'on)))
+  (org-toggle-tag org-archive-tag 'on))
 
 ;;;###autoload
 (defun org-archive-subtree-default ()
diff --git a/lisp/org-macs.el b/lisp/org-macs.el
index 77a664e..7eac05b 100644
--- a/lisp/org-macs.el
+++ b/lisp/org-macs.el
@@ -370,26 +370,6 @@ The number of levels is controlled by `org-inlinetask-min-level'"
       (format-seconds string seconds)
     (format-time-string string (seconds-to-time seconds))))
 
-(defmacro org-loop-over-siblings-in-active-region (&rest body)
-  "Execute BODY on possibly several headlines."
-  `(if (or (not (org-region-active-p))
-	   (not org-loop-over-siblings-within-active-region-p))
-       ,@body
-     (save-excursion
-       (let ((beg (region-beginning))
-	     (end (region-end))
-	     mrkrs mrkr nxt)
-	 (goto-char beg)
-	 (or (org-at-heading-p) (outline-next-heading))
-	 (setq mrkrs (list (set-marker (make-marker) (point))))
-	 (while (and (setq nxt (org-get-next-sibling)) (< nxt end))
-	   (setq mrkrs 
-		 (append mrkrs (list (set-marker 
-				      (make-marker) (point))))))
-	 (while (setq mrkr (pop mrkrs))
-	   (goto-char mrkr)
-	   ,@body)))))
-
 (provide 'org-macs)
 
 ;; arch-tag: 7e6a73ce-aac9-4fc0-9b30-ce6f89dc6668
diff --git a/lisp/org.el b/lisp/org.el
index 5a4517a..8ef9c9a 100644
--- a/lisp/org.el
+++ b/lisp/org.el
@@ -1981,18 +1981,6 @@ heading."
   "The available interpretation symbols for customizing `org-todo-keywords'.
 Interested libraries should add to this list.")
 
-(defcustom org-loop-over-siblings-within-active-region-p nil
-  "Shall some commands act upon siblings in the active region?
-The list of commands is:
-- `org-schedule'
-- `org-deadline'
-- `org-archive-subtree'
-- `org-archive-to-archive-sibling'
-- `org-archive-set-tag'
-- `org-toggle-archive-tag'"
-  :group 'org-todo
-  :group 'org-archive)
-
 (defcustom org-todo-keywords '((sequence "TODO" "DONE"))
   "List of TODO entry keyword sequences and their interpretation.
 \\<org-mode-map>This is a list of sequences.
@@ -11711,40 +11699,39 @@ With argument REMOVE, remove any deadline from the item.
 With argument TIME, set the deadline at the corresponding date.  TIME
 can either be an Org date like \"2011-07-24\" or a delta like \"+2d\"."
   (interactive "P")
-  (org-loop-over-siblings-in-active-region
-   (let* ((old-date (org-entry-get nil "DEADLINE"))
-	  (repeater (and old-date
-			 (string-match
-			  "\\([.+-]+[0-9]+[dwmy]\\(?:[/ ][-+]?[0-9]+[dwmy]\\)?\\) ?"
+  (let* ((old-date (org-entry-get nil "DEADLINE"))
+	 (repeater (and old-date
+			(string-match
+			 "\\([.+-]+[0-9]+[dwmy]\\(?:[/ ][-+]?[0-9]+[dwmy]\\)?\\) ?"
 			  old-date)
-			 (match-string 1 old-date))))
-     (if remove
-	 (progn
-	   (when (and old-date org-log-redeadline)
-	     (org-add-log-setup 'deldeadline nil old-date 'findpos
-				org-log-redeadline))
-	   (org-remove-timestamp-with-keyword org-deadline-string)
-	   (message "Item no longer has a deadline."))
-       (org-add-planning-info 'deadline time 'closed)
-       (when (and old-date org-log-redeadline
-		  (not (equal old-date
-			      (substring org-last-inserted-timestamp 1 -1))))
-	 (org-add-log-setup 'redeadline nil old-date 'findpos
-			    org-log-redeadline))
-       (when repeater
-	 (save-excursion
-	   (org-back-to-heading t)
-	   (when (re-search-forward (concat org-deadline-string " "
-					    org-last-inserted-timestamp)
-				    (save-excursion
-				      (outline-next-heading) (point)) t)
-	     (goto-char (1- (match-end 0)))
-	     (insert " " repeater)
-	     (setq org-last-inserted-timestamp
-		   (concat (substring org-last-inserted-timestamp 0 -1)
-			   " " repeater
-			   (substring org-last-inserted-timestamp -1))))))
-       (message "Deadline on %s" org-last-inserted-timestamp)))))
+			(match-string 1 old-date))))
+    (if remove
+	(progn
+	  (when (and old-date org-log-redeadline)
+	    (org-add-log-setup 'deldeadline nil old-date 'findpos
+			       org-log-redeadline))
+	  (org-remove-timestamp-with-keyword org-deadline-string)
+	  (message "Item no longer has a deadline."))
+      (org-add-planning-info 'deadline time 'closed)
+      (when (and old-date org-log-redeadline
+		 (not (equal old-date
+			     (substring org-last-inserted-timestamp 1 -1))))
+	(org-add-log-setup 'redeadline nil old-date 'findpos
+			   org-log-redeadline))
+      (when repeater
+	(save-excursion
+	  (org-back-to-heading t)
+	  (when (re-search-forward (concat org-deadline-string " "
+					   org-last-inserted-timestamp)
+				   (save-excursion
+				     (outline-next-heading) (point)) t)
+	    (goto-char (1- (match-end 0)))
+	    (insert " " repeater)
+	    (setq org-last-inserted-timestamp
+		  (concat (substring org-last-inserted-timestamp 0 -1)
+			  " " repeater
+			  (substring org-last-inserted-timestamp -1))))))
+      (message "Deadline on %s" org-last-inserted-timestamp))))
 
 (defun org-schedule (&optional remove time)
   "Insert the SCHEDULED: string with a timestamp to schedule a TODO item.
@@ -11752,40 +11739,39 @@ With argument REMOVE, remove any scheduling date from the item.
 With argument TIME, scheduled at the corresponding date.  TIME can
 either be an Org date like \"2011-07-24\" or a delta like \"+2d\"."
   (interactive "P")
-  (org-loop-over-siblings-in-active-region
-   (let* ((old-date (org-entry-get nil "SCHEDULED"))
-	  (repeater (and old-date
-			 (string-match
-			  "\\([.+-]+[0-9]+[dwmy]\\(?:[/ ][-+]?[0-9]+[dwmy]\\)?\\) ?"
-			  old-date)
-			 (match-string 1 old-date))))
-     (if remove
-	 (progn
-	   (when (and old-date org-log-reschedule)
-	     (org-add-log-setup 'delschedule nil old-date 'findpos
-				org-log-reschedule))
-	   (org-remove-timestamp-with-keyword org-scheduled-string)
-	   (message "Item is no longer scheduled."))
-       (org-add-planning-info 'scheduled time 'closed)
-       (when (and old-date org-log-reschedule
-		  (not (equal old-date
-			      (substring org-last-inserted-timestamp 1 -1))))
-	 (org-add-log-setup 'reschedule nil old-date 'findpos
-			    org-log-reschedule))
-       (when repeater
-	 (save-excursion
-	   (org-back-to-heading t)
-	   (when (re-search-forward (concat org-scheduled-string " "
-					    org-last-inserted-timestamp)
-				    (save-excursion
-				      (outline-next-heading) (point)) t)
-	     (goto-char (1- (match-end 0)))
-	     (insert " " repeater)
-	     (setq org-last-inserted-timestamp
-		   (concat (substring org-last-inserted-timestamp 0 -1)
-			   " " repeater
-			   (substring org-last-inserted-timestamp -1))))))
-       (message "Scheduled to %s" org-last-inserted-timestamp)))))
+  (let* ((old-date (org-entry-get nil "SCHEDULED"))
+	 (repeater (and old-date
+			(string-match
+			 "\\([.+-]+[0-9]+[dwmy]\\(?:[/ ][-+]?[0-9]+[dwmy]\\)?\\) ?"
+			 old-date)
+			(match-string 1 old-date))))
+    (if remove
+	(progn
+	  (when (and old-date org-log-reschedule)
+	    (org-add-log-setup 'delschedule nil old-date 'findpos
+			       org-log-reschedule))
+	  (org-remove-timestamp-with-keyword org-scheduled-string)
+	  (message "Item is no longer scheduled."))
+      (org-add-planning-info 'scheduled time 'closed)
+      (when (and old-date org-log-reschedule
+		 (not (equal old-date
+			     (substring org-last-inserted-timestamp 1 -1))))
+	(org-add-log-setup 'reschedule nil old-date 'findpos
+			   org-log-reschedule))
+      (when repeater
+	(save-excursion
+	  (org-back-to-heading t)
+	  (when (re-search-forward (concat org-scheduled-string " "
+					   org-last-inserted-timestamp)
+				   (save-excursion
+				     (outline-next-heading) (point)) t)
+	    (goto-char (1- (match-end 0)))
+	    (insert " " repeater)
+	    (setq org-last-inserted-timestamp
+		  (concat (substring org-last-inserted-timestamp 0 -1)
+			  " " repeater
+			  (substring org-last-inserted-timestamp -1))))))
+      (message "Scheduled to %s" org-last-inserted-timestamp))))
 
 (defun org-get-scheduled-time (pom &optional inherit)
   "Get the scheduled time as a time tuple, of a format suitable
-- 
1.7.5.2


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #3: 0002-org.el-org-map-entries-Allow-SCOPE-to-be-the-active-.patch --]
[-- Type: text/x-patch, Size: 1361 bytes --]

From f9b98d4f98df81ea1702beef52ce1939dcdc8f5f Mon Sep 17 00:00:00 2001
From: Bastien Guerry <bzg@altern.org>
Date: Wed, 27 Jul 2011 16:34:31 +0200
Subject: [PATCH 2/3] org.el: (org-map-entries): Allow SCOPE to be the active
 region.

---
 lisp/org.el |   12 ++++++++----
 1 files changed, 8 insertions(+), 4 deletions(-)

diff --git a/lisp/org.el b/lisp/org.el
index 8ef9c9a..36b290a 100644
--- a/lisp/org.el
+++ b/lisp/org.el
@@ -13464,6 +13464,7 @@ SCOPE determines the scope of this command.  It can be any of:
 
 nil     The current buffer, respecting the restriction if any
 tree    The subtree started with the entry at point
+region  The entries within the active region, if any
 file    The current buffer, without restriction
 file-with-archives
         The current buffer, and any archives associated with it
@@ -13512,10 +13513,13 @@ a *different* entry, you cannot use these techniques."
 
     (save-excursion
       (save-restriction
-	(when (eq scope 'tree)
-	  (org-back-to-heading t)
-	  (org-narrow-to-subtree)
-	  (setq scope nil))
+	(cond ((eq scope 'tree)
+	       (org-back-to-heading t)
+	       (org-narrow-to-subtree)
+	       (setq scope nil))
+	      ((and (eq scope 'region) (org-region-active-p))
+	       (narrow-to-region (region-beginning) (region-end))
+	       (setq scope nil)))
 
 	(if (not scope)
 	    (progn
-- 
1.7.5.2


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #4: 0003-New-implementation-for-org-loop-over-headlines-in-ac.patch --]
[-- Type: text/x-patch, Size: 3831 bytes --]

From 6fb1d3ec1dafed6389447dc7acef5c237457d263 Mon Sep 17 00:00:00 2001
From: Bastien Guerry <bzg@altern.org>
Date: Wed, 27 Jul 2011 17:20:18 +0200
Subject: [PATCH 3/3] New implementation for
 `org-loop-over-headlines-in-active-region'.

`org-schedule' and `org-deadline' don't use a macro anymore.

* org.el (org-schedule-do): Rename from `org-schedule'.
(org-schedule): Add a loop.
(org-deadline-do): Rename from `org-deadline'.
(org-deadline): Add a loop.
(org-map-entries): Use org-end-of-subtree to make sure the
active region contains the whole subtree.
(org-loop-over-headlines-in-active-region): New variable.
---
 lisp/org.el |   46 +++++++++++++++++++++++++++++++++++++++++++++-
 1 files changed, 45 insertions(+), 1 deletions(-)

diff --git a/lisp/org.el b/lisp/org.el
index 36b290a..aa1b206 100644
--- a/lisp/org.el
+++ b/lisp/org.el
@@ -396,6 +396,25 @@ is Emacs 23 only."
 	  (const :tag "When outside special context" t)
 	  (const :tag "Everywhere except timestamps" always)))
 
+(defcustom org-loop-over-headlines-in-active-region nil
+  "Shall some commands act upon headlines in the active region?
+
+When set to `t', some commands will be performed in all headlines
+within the active region.
+
+When set to a string, those commands will be performed on the
+matching headlines within the active region.  Such string must be
+a tags/property/todo match as it is used in the agenda tags view.
+
+The list of commands is:
+- `org-schedule'
+- `org-deadline'"
+  :type '(choice (const :tag "Don't loop" nil)
+		 (const :tag "All headlines in active region" t)
+		 (string :tag "Tags/Property/Todo matcher"))
+  :group 'org-todo
+  :group 'org-archive)
+
 (defgroup org-startup nil
   "Options concerning startup of Org-mode."
   :tag "Org Startup"
@@ -11694,6 +11713,18 @@ of `org-todo-keywords-1'."
 	     (org-occur (concat "^" org-outline-regexp " *" kwd-re )))))
 
 (defun org-deadline (&optional remove time)
+  "Insert the DEADLINE: string with a timestamp to schedule a TODO item.
+See `org-deadline-do' for details."
+  (interactive "P")
+  (if (or (not (org-region-active-p))
+          (not org-loop-over-headlines-in-active-region))
+      (org-deadline-do remove time)
+    (org-map-entries
+     `(org-deadline-do ,remove ,time)
+     org-loop-over-headlines-in-active-region
+     'region)))
+
+(defun org-deadline-do (&optional remove time)
   "Insert the \"DEADLINE:\" string with a timestamp to make a deadline.
 With argument REMOVE, remove any deadline from the item.
 With argument TIME, set the deadline at the corresponding date.  TIME
@@ -11735,6 +11766,18 @@ can either be an Org date like \"2011-07-24\" or a delta like \"+2d\"."
 
 (defun org-schedule (&optional remove time)
   "Insert the SCHEDULED: string with a timestamp to schedule a TODO item.
+See `org-schedule-do' for details."
+  (interactive "P")
+  (if (or (not (org-region-active-p))
+          (not org-loop-over-headlines-in-active-region))
+      (org-schedule-do remove time)
+    (org-map-entries
+     `(org-schedule-do ,remove ,time)
+     org-loop-over-headlines-in-active-region
+     'region)))
+
+(defun org-schedule-do (&optional remove time)
+  "Insert the SCHEDULED: string with a timestamp to schedule a TODO item.
 With argument REMOVE, remove any scheduling date from the item.
 With argument TIME, scheduled at the corresponding date.  TIME can
 either be an Org date like \"2011-07-24\" or a delta like \"+2d\"."
@@ -13518,7 +13561,8 @@ a *different* entry, you cannot use these techniques."
 	       (org-narrow-to-subtree)
 	       (setq scope nil))
 	      ((and (eq scope 'region) (org-region-active-p))
-	       (narrow-to-region (region-beginning) (region-end))
+	       (narrow-to-region (region-beginning) 
+				 (org-end-of-subtree t))
 	       (setq scope nil)))
 
 	(if (not scope)
-- 
1.7.5.2


[-- Attachment #5: Type: text/plain, Size: 14 bytes --]


-- 
 Bastien

Re: New feature: loop over siblings for some commands

[David Maus]

[-- Attachment #1: Type: text/plain, Size: 3457 bytes --]

Hi Bastien,

At Wed, 27 Jul 2011 17:28:36 +0200,
Bastien wrote:
>
> Hi David,
>
> David Maus <dmaus@ictsoc.de> writes:
>
> > I highly recommend to not use this macro but to build the intended
> > functionality with separate building blocks: Factor out the flesh of
> > the respective functions (e.g. org-schedule) and use org-map-entries
> > to map. As far as I can see, the latter provides all we need:
>
> I took this road.
>
>
> The first patch manually reverts the commit you are commenting.
>
> The third patch implements the "loop" functionality by just using
> `org-map-entries', not a macro.
>
> I'm sure we could have an `org-loop' macro factoring out the duplicate
> code in the new `org-schedule' and `org-deadline'.  If you have time to
> look at this, that will greatly help.

My vacation starts saturday so I do have time and really like to get
my hands dirty with some Lisp hacking.

Now for the macro (2 iterations later): It might not be necessary to
factor out the functions if the function that invokes the looping
can be called recursively.

E.g.

#+begin_src emacs-lisp
  (defmacro org-with-headline-siblings (function)
    "Apply function to siblings of current headline."
    `(org-map-entries ,function 'siblings))

  (defun org-schedule ()
    (...)
    (if (or (not (org-region-active-p))
            (not org-loop-over-siblings))
        (let ((org-loop-over-siblings nil))
          (org-with-headline-siblings 'org-schedule))))
#+end_src

If the function takes arguments, we need to wrap the function call at
the end in a lambda.

And if this works out, we are almost there:

#+begin_src emacs-lisp
  (defmacro org-with-headline-siblings-maybe (predicate &rest body)
    "Execute body on current headline's siblings if PREDICATE."
    `(progn
       ,@body
       (if ,predicate
           (org-map-entries '(lambda () (progn ,@body)) 'siblings))))
#+end_src

>
> > Another abstraction: Instead
> > 'org-loop-over-siblings-with-active-region' something like:
> > 'org-loop-over-headlines-with-active-region' that can be set to a
> > symbol or a list of symbols indicating which headings to loop over
> > (e.g. 'siblings, 'children, ...).
>
> The variable is now called `org-loop-over-headlines-in-active-region'
> and understand these kind of values:
>
> - nil: don't loop
> - t: loop over all headlines
> - "MATCH": a tag/property/todo match to loop over matching headlines
>

Nice. These values can fit into org-map-entries MATCH argument, can't
they?

We would have:
                 org-loop-over-headlines-in-active-region
                                  /
(org-map-entries FUNC &optional MATCH SCOPE &rest SKIP)
                 /                      \
           our function            region is active

I'm not quite sure, but

a/ we move the check for an active region to org-map-entries: If
SCOPE is 'region but no region is active, org-map-entries simply
returns.

b/ we modify org-map-entries, so that a MATCH of nil means: No
match.

This way we can express the predicate as a condition of map.

#+begin_src emacs-lisp
  (defmacro org-loop-over-headlines (&rest body)
    `(progn
       ,@body
       (org-map-entries '(lambda () (progn ,@body)) org-loop-over-headlines-in-active-region 'region)))
#+end_src

> If you can test these patches and send some feedback, that'd be nice!

Scheduled for Sunday.

Best,
  -- David
--
OpenPGP... 0x99ADB83B5A4478E6
Jabber.... dmjena@jabber.org
Email..... dmaus@ictsoc.de

[-- Attachment #2: Type: application/pgp-signature, Size: 230 bytes --]

Re: New feature: loop over siblings for some commands

[Bastien]

Hi David,

David Maus <dmaus@ictsoc.de> writes:

> My vacation starts saturday so I do have time and really like to get
> my hands dirty with some Lisp hacking.

Great, thanks.

> Now for the macro (2 iterations later): It might not be necessary to
> factor out the functions if the function that invokes the looping
> can be called recursively.

I've applied the first two patches that I sent in my previous email,
thus removing the previous half-baked functionality.  

If you can have a look at the third patch and start from there, that
would be great -- this third patch has some problems (with C-u C-c C-s
for example) and was just a first attempt.

Thanks for any update on this!

Best,

-- 
 Bastien

Re: New feature: loop over siblings for some commands

[David Maus]

[-- Attachment #1: Type: text/plain, Size: 1249 bytes --]

Hi Bastien,

I've created a dedicated topic branch on Github

git://github.com/dmj/dmj-org-mode.git feat/org-loop-over-headlines

And implemented looping over headlines in active region for
org-schedule und org-deadline. Differences between this branch and
your proposed patch:

1/ Extend the region to end of entry, not end of subtree


,----
| * One
|
|   X
|
| ** Two
|
| ** Three
|
| * Four
|
|   X
|
| ** Five
`----

If X marks beginning and end of region, using end of subtree would include heading 'Five'.

2/ Immediatly leave org-map-entries if SCOPE is 'region but no region is active.

3/ No need to factor out BODY, simply bind
org-loop-over-headlines-in-active-region to nil and map entries in
region.

Whats next: Handle folded subtrees. Currently org-schedule w/ active
region schedules hidden subtrees, too. Using a tags/prop/todo query
seems suboptimal because you would have to know the characteristics of
the region beforehand. To me this seems to defeat the conveniance of
using the region: If I already know the characteristics of which
headlines to schedule, I would have created a agenda command and use
bulk-schedule.


Best,
  -- David
--
OpenPGP... 0x99ADB83B5A4478E6
Jabber.... dmjena@jabber.org
Email..... dmaus@ictsoc.de

[-- Attachment #2: Type: application/pgp-signature, Size: 230 bytes --]

Re: New feature: loop over siblings for some commands

[David Maus]

[-- Attachment #1: Type: text/plain, Size: 702 bytes --]

At Wed, 10 Aug 2011 10:34:14 +0200,
David Maus wrote:
>
> Whats next: Handle folded subtrees. Currently org-schedule w/ active
> region schedules hidden subtrees, too. Using a tags/prop/todo query
> seems suboptimal because you would have to know the characteristics of
> the region beforehand. To me this seems to defeat the conveniance of
> using the region: If I already know the characteristics of which
> headlines to schedule, I would have created a agenda command and use
> bulk-schedule.
>

Done that.

https://github.com/dmj/dmj-org-mode/commit/c6d636350125916539a041b93e45fc306f4bbd9b

Best,
  -- David
--
OpenPGP... 0x99ADB83B5A4478E6
Jabber.... dmjena@jabber.org
Email..... dmaus@ictsoc.de

[-- Attachment #2: Type: application/pgp-signature, Size: 230 bytes --]

Re: New feature: loop over siblings for some commands

[Bastien]

Hi David,

David Maus <dmaus@ictsoc.de> writes:

> At Wed, 10 Aug 2011 10:34:14 +0200,
> David Maus wrote:
>>
>> Whats next: Handle folded subtrees. Currently org-schedule w/ active
>> region schedules hidden subtrees, too. Using a tags/prop/todo query
>> seems suboptimal because you would have to know the characteristics of
>> the region beforehand. To me this seems to defeat the conveniance of
>> using the region: If I already know the characteristics of which
>> headlines to schedule, I would have created a agenda command and use
>> bulk-schedule.
>
> Done that.
>
> https://github.com/dmj/dmj-org-mode/commit/c6d636350125916539a041b93e45fc306f4bbd9b

Great -- can you submit a patch against current git head?

Best,

-- 
 Bastien

[PATCH 0/5] loop over headlines in active region

[David Maus]

Hi Bastien,

> Great -- can you submit a patch against current git head?

Following 5 patches implement looping over headlines in active region
for org-schedule and org-deadline. Invisible headlines are skipped and
bulk-agenda commands work by binding the customization variable to nil
before executing a command.

I've been running with this modification for 2 weeks now, using the
feature occassionally without a visibile problem.

As for the macro: What stop me to implement a macro for the generic
operation is that for now the macro would depend on the global
customization variable. That's not a problem per se but according to
my readings about macros (mostly in context of Common Lisp, but that
shouldn't matter) it should be considered bad style.

I did some experiments with defining an `org-map-entries' MATCH of
'current that causes FUNC to be applied to the current heading
only, but I'm not sure if this would be a right thing (tm) to do.

Best,
  -- David

David Maus (5):
  Extend scope 'region to include body of last headline in active
    region
  Immediately return if scope is region but no region is active
  New customization variable: Loop over headlines in active region
  Skip invisible headlines when mapping over headlines in active region
  Avoid conflict between bulk command and loop-over-headlines

Re: [PATCH 0/5] loop over headlines in active region

[Carsten Dominik]

[-- Attachment #1: Type: text/html, Size: 3289 bytes --]

Re: [PATCH 0/5] loop over headlines in active region

[David Maus]

[-- Attachment #1: Type: text/plain, Size: 709 bytes --]

Hi Carsten,

At Thu, 25 Aug 2011 08:13:21 +0200,
Carsten Dominik wrote:
> I am wondering, why did you choose to skip invisible headlines?
> I would worry that this introduces inconsistent behavior and also
> makes it hard to use this feature in a programmatic way.

Good points. I though of skipping invisible headlines as a way to
control which headlines are 'looped over' but if this is inconsistent
with already present behaviour of Org mode or Emacs in general we can
scratch that idea.

What brings up the question: What is the current behavior of Org mode
with regards to operations in a region?

Best,
  -- David
--
OpenPGP... 0x99ADB83B5A4478E6
Jabber.... dmjena@jabber.org
Email..... dmaus@ictsoc.de

[-- Attachment #2: Type: application/pgp-signature, Size: 230 bytes --]

Re: [PATCH 0/5] loop over headlines in active region

[Carsten Dominik]

On Aug 28, 2011, at 3:58 PM, David Maus wrote:

> Hi Carsten,
> 
> At Thu, 25 Aug 2011 08:13:21 +0200,
> Carsten Dominik wrote:
>> I am wondering, why did you choose to skip invisible headlines?
>> I would worry that this introduces inconsistent behavior and also
>> makes it hard to use this feature in a programmatic way.
> 
> Good points. I though of skipping invisible headlines as a way to
> control which headlines are 'looped over' but if this is inconsistent
> with already present behaviour of Org mode or Emacs in general we can
> scratch that idea.

Yes, let's do that.

> 
> What brings up the question: What is the current behavior of Org mode
> with regards to operations in a region?

I think almost everything that iterates over a number of
headlines will also do the invisible ones.  Exceptions are
exporting/copying the visible headlines, and probably something else I
am not remembering.

- Carsten

Re: [PATCH 0/5] loop over headlines in active region

[David Maus]

[-- Attachment #1: Type: text/plain, Size: 1317 bytes --]

Hi Carsten,

At Mon, 29 Aug 2011 11:29:04 +0200,
Carsten Dominik wrote:
>
>
> On Aug 28, 2011, at 3:58 PM, David Maus wrote:
>
> > Hi Carsten,
> >
> > At Thu, 25 Aug 2011 08:13:21 +0200,
> > Carsten Dominik wrote:
> >> I am wondering, why did you choose to skip invisible headlines?
> >> I would worry that this introduces inconsistent behavior and also
> >> makes it hard to use this feature in a programmatic way.
> >
> > Good points. I though of skipping invisible headlines as a way to
> > control which headlines are 'looped over' but if this is inconsistent
> > with already present behaviour of Org mode or Emacs in general we can
> > scratch that idea.
>
> Yes, let's do that.
>
> >
> > What brings up the question: What is the current behavior of Org mode
> > with regards to operations in a region?
>
> I think almost everything that iterates over a number of
> headlines will also do the invisible ones.  Exceptions are
> exporting/copying the visible headlines, and probably something else I
> am not remembering.

I'll investigate this. Maybe the customization variable could control
all operations on headlines in active region. Current proposal does
not feel good because it only controls some.

Best,
  -- David
--
OpenPGP... 0x99ADB83B5A4478E6
Jabber.... dmjena@jabber.org
Email..... dmaus@ictsoc.de

[-- Attachment #2: Type: application/pgp-signature, Size: 230 bytes --]

Re: [PATCH 0/5] loop over headlines in active region

[Štěpán Němec]

On Thu, 25 Aug 2011 06:25:29 +0200
David Maus wrote:

> As for the macro: What stop me to implement a macro for the generic
> operation is that for now the macro would depend on the global
> customization variable. That's not a problem per se but according to
> my readings about macros (mostly in context of Common Lisp, but that
> shouldn't matter) it should be considered bad style.

Could you expand on this a bit? As far as I can tell, you obviously
shouldn't depend on a customisation variable at macro expansion time,
but I don't see how depending on it at run time is any different from a
function doing the same.

-- 
Štěpán

Re: [PATCH 0/5] loop over headlines in active region

[David Maus]

[-- Attachment #1: Type: text/plain, Size: 1607 bytes --]

At Thu, 25 Aug 2011 12:08:42 +0200,
Štěpán Němec wrote:
> 
> On Thu, 25 Aug 2011 06:25:29 +0200
> David Maus wrote:
> 
> > As for the macro: What stop me to implement a macro for the generic
> > operation is that for now the macro would depend on the global
> > customization variable. That's not a problem per se but according to
> > my readings about macros (mostly in context of Common Lisp, but that
> > shouldn't matter) it should be considered bad style.
> 
> Could you expand on this a bit? As far as I can tell, you obviously
> shouldn't depend on a customisation variable at macro expansion time,
> but I don't see how depending on it at run time is any different from a
> function doing the same.
> 

At expansion time the macro performs a transformation of the lisp at
the place where the macro is used. At runtime the code of the expanded
macro runs in the scope of the function where the macro was expanded
into. A macro that uses a variable inside the expanded code that is
not under its control (e.g. part of the argument list or gensym'd) is
prone to introduce a bug caused by expanding the macro in an
environment where this variable is not bound or used with a different
semantics.

In this particular case this should not be a problem indeed because we
use a global dynamically scoped customization variable. Thus,
whereever we would use the macro we can be sure the variable in the
macro expansion is bound and carries the same meaning.

Best,
  -- David
-- 
OpenPGP... 0x99ADB83B5A4478E6
Jabber.... dmjena@jabber.org
Email..... dmaus@ictsoc.de

[-- Attachment #2: Type: application/pgp-signature, Size: 230 bytes --]

Re: [PATCH 0/5] loop over headlines in active region

[Štěpán Němec]

On Sun, 28 Aug 2011 15:57:19 +0200
David Maus wrote:

> At Thu, 25 Aug 2011 12:08:42 +0200,
> Štěpán Němec wrote:
>> 
>> On Thu, 25 Aug 2011 06:25:29 +0200
>> David Maus wrote:
>> 
>> > As for the macro: What stop me to implement a macro for the generic
>> > operation is that for now the macro would depend on the global
>> > customization variable. That's not a problem per se but according to
>> > my readings about macros (mostly in context of Common Lisp, but that
>> > shouldn't matter) it should be considered bad style.
>> 
>> Could you expand on this a bit? As far as I can tell, you obviously
>> shouldn't depend on a customisation variable at macro expansion time,
>> but I don't see how depending on it at run time is any different from a
>> function doing the same.
>> 
>
> At expansion time the macro performs a transformation of the lisp at
> the place where the macro is used. At runtime the code of the expanded
> macro runs in the scope of the function where the macro was expanded
> into. A macro that uses a variable inside the expanded code that is
> not under its control (e.g. part of the argument list or gensym'd) is
> prone to introduce a bug caused by expanding the macro in an
> environment where this variable is not bound or used with a different
> semantics.
>
> In this particular case this should not be a problem indeed because we
> use a global dynamically scoped customization variable. Thus,
> whereever we would use the macro we can be sure the variable in the
> macro expansion is bound and carries the same meaning.

So your "what stop me to implement a macro" argument is bogus, isn't it?
I can't really comment on whether using a macro or not is the right
thing here, but it seems to me you shouldn't base the decision on an
invalid argument (IOW, from the fact that you even felt the need to
explain why you didn't use a macro to begin with, it would appear to be
the case that you would have preferred the macro way).

-- 
Štěpán

Re: [PATCH 0/5] loop over headlines in active region

[David Maus]

[-- Attachment #1: Type: text/plain, Size: 3191 bytes --]

At Wed, 07 Sep 2011 21:34:41 +0200,
Štěpán Němec wrote:
> 
> On Sun, 28 Aug 2011 15:57:19 +0200
> David Maus wrote:
> 
> > At Thu, 25 Aug 2011 12:08:42 +0200,
> > Štěpán Němec wrote:
> >> 
> >> On Thu, 25 Aug 2011 06:25:29 +0200
> >> David Maus wrote:
> >> 
> >> > As for the macro: What stop me to implement a macro for the generic
> >> > operation is that for now the macro would depend on the global
> >> > customization variable. That's not a problem per se but according to
> >> > my readings about macros (mostly in context of Common Lisp, but that
> >> > shouldn't matter) it should be considered bad style.
> >> 
> >> Could you expand on this a bit? As far as I can tell, you obviously
> >> shouldn't depend on a customisation variable at macro expansion time,
> >> but I don't see how depending on it at run time is any different from a
> >> function doing the same.
> >> 
> >
> > At expansion time the macro performs a transformation of the lisp at
> > the place where the macro is used. At runtime the code of the expanded
> > macro runs in the scope of the function where the macro was expanded
> > into. A macro that uses a variable inside the expanded code that is
> > not under its control (e.g. part of the argument list or gensym'd) is
> > prone to introduce a bug caused by expanding the macro in an
> > environment where this variable is not bound or used with a different
> > semantics.
> >
> > In this particular case this should not be a problem indeed because we
> > use a global dynamically scoped customization variable. Thus,
> > whereever we would use the macro we can be sure the variable in the
> > macro expansion is bound and carries the same meaning.
> 
> So your "what stop me to implement a macro" argument is bogus, isn't it?
> I can't really comment on whether using a macro or not is the right
> thing here, but it seems to me you shouldn't base the decision on an
> invalid argument (IOW, from the fact that you even felt the need to
> explain why you didn't use a macro to begin with, it would appear to be
> the case that you would have preferred the macro way).

"One of the things Ford Prefect had always found hardest to understand
about humans was their habit of continually stating and repeating the
very very obvious, as in /It's a nice day/, or /You're very tall/, or
/Oh dear you seem to have fallen down a thirty-foot well, are you all
right?/ At first Ford had formed a theory to account for this strange
behavior. If human beings don't keep exercising their lips, he
thought, their mouths probably seize up.

After a few months' consideration and observation he abandoned this
theory in favor of a new one. If they don't keep on exercising their
lips, he thought, their brains start working. After a while he
abandoned this one as well as being obstructively cynical and decided
he quite liked human beings after all, but he always remained
desperately worried about the terrible number of things they didn't
know about."

  Douglas Adams, The Hitchiker's Guide to the Galaxy
-- 
OpenPGP... 0x99ADB83B5A4478E6
Jabber.... dmjena@jabber.org
Email..... dmaus@ictsoc.de

[-- Attachment #2: Type: application/pgp-signature, Size: 230 bytes --]

Re: [PATCH 0/5] loop over headlines in active region

[Štěpán Němec]

On Fri, 09 Sep 2011 06:06:26 +0200
David Maus wrote:

> At Wed, 07 Sep 2011 21:34:41 +0200,
> Štěpán Němec wrote:

>> So your "what stop me to implement a macro" argument is bogus, isn't it?
>> I can't really comment on whether using a macro or not is the right
>> thing here, but it seems to me you shouldn't base the decision on an
>> invalid argument (IOW, from the fact that you even felt the need to
>> explain why you didn't use a macro to begin with, it would appear to be
>> the case that you would have preferred the macro way).
>
> "One of the things Ford Prefect had always found hardest to understand
> about humans was their habit of continually stating and repeating the
> very very obvious, as in /It's a nice day/, or /You're very tall/, or
> /Oh dear you seem to have fallen down a thirty-foot well, are you all
> right?/ At first Ford had formed a theory to account for this strange
> behavior. If human beings don't keep exercising their lips, he
> thought, their mouths probably seize up.
>
> After a few months' consideration and observation he abandoned this
> theory in favor of a new one. If they don't keep on exercising their
> lips, he thought, their brains start working. After a while he
> abandoned this one as well as being obstructively cynical and decided
> he quite liked human beings after all, but he always remained
> desperately worried about the terrible number of things they didn't
> know about."
>
>   Douglas Adams, The Hitchiker's Guide to the Galaxy

In your "enlightened" style, that would be

“曰：‘四境之內不治則如之何？’王顧左右而言他。” 《孟子·梁惠王下》

Still, I'd rather we stuck to the point and expressed ourselves in a way
that doesn't imply the other side is either an idiot or a telepathist
(although I'd argue that in the currrent context, my quotation is much
clearer than yours).

-- 
Štěpán

Re: [PATCH 0/5] loop over headlines in active region

[Bastien]

Guys, let's keep using a civil tone in discussions.

I will come back to this issue and see if I can help.

Thanks,

-- 
 Bastien

Re: [PATCH 0/5] loop over headlines in active region

[Štěpán Němec]

On Fri, Sep 09, 2011 at 12:41:45PM +0200, Bastien wrote:
> Guys, let's keep using a civil tone in discussions.

I think you're confusing "civil tone" with "political correctness"
(which, in a lot of instances, can be translated as "hypocrisy").

I don't think every sentence containing the word "idiot" is uncivil, if
that's what tripped you up.

In any case, I really appreciate David's contributions focused on
improving Org code quality. I even more appreciate that he sends his
patches to the list so that anyone can review and comment on them. It's
just that I believe it's more helpful to stick to the point being
discussed and address questions raised instead of spamming the list with
one's reading notes.

-- 
Štěpán

Re: [PATCH 0/5] loop over headlines in active region

[David Maus]

[-- Attachment #1: Type: text/plain, Size: 734 bytes --]

At Fri, 09 Sep 2011 12:26:31 +0200,
Štěpán Němec wrote:
> 
> Still, I'd rather we stuck to the point and expressed ourselves in a way
> that doesn't imply the other side is either an idiot ...

Your message simply repeated my conclusion: Yes, the problem of
referencing a free variable in the macro expansion does not apply in
this case. Yes, I should base decisions on valid arguments (Who
shouldn't?). Yes, the fact that I refrained from implementing it as a
macro indicates that I wanted to implement it as a macro in the first
place.

Repeating and stating the very, very obvious is one way to call
someone an idiot.
-- 
OpenPGP... 0x99ADB83B5A4478E6
Jabber.... dmjena@jabber.org
Email..... dmaus@ictsoc.de

[-- Attachment #2: Type: application/pgp-signature, Size: 230 bytes --]

Re: [PATCH 0/5] loop over headlines in active region

[Štěpán Němec]

On Fri, 09 Sep 2011 17:10:42 +0200
David Maus wrote:

> At Fri, 09 Sep 2011 12:26:31 +0200,
> Štěpán Němec wrote:
>> 
>> Still, I'd rather we stuck to the point and expressed ourselves in a way
>> that doesn't imply the other side is either an idiot ...
>
> Your message simply repeated my conclusion: Yes, the problem of
> referencing a free variable in the macro expansion does not apply in
> this case. Yes, I should base decisions on valid arguments (Who
> shouldn't?). Yes, the fact that I refrained from implementing it as a
> macro indicates that I wanted to implement it as a macro in the first
> place.
>
> Repeating and stating the very, very obvious is one way to call
> someone an idiot.

It's not. (One way to call someone an idiot is saying "You're an idiot".
If you somehow understood any of my emails as implying you're an idiot,
then I'm sorry. It was definitely not intended.)

The reason I asked (I didn't actually repeat anything, and it's all
apparently still far from obvious, at least to me) is that I'm confused:
You say "I didn't implement is as a macro, because A". Now we both agree
that A is an invalid argument. Given that you now also confirmed you did
want to implement it as a macro in the first place, I would expect that
either you do implement it as a macro, or provide a valid argument for
not doing so. Maybe I really am too dense, but the hitchhiker quotation
didn't help.

-- 
Štěpán

Re: [PATCH 0/5] loop over headlines in active region

[David Maus]

[-- Attachment #1: Type: text/plain, Size: 876 bytes --]

At Fri, 09 Sep 2011 17:26:43 +0200,
Štěpán Němec wrote:
> 
> The reason I asked (I didn't actually repeat anything, and it's all
> apparently still far from obvious, at least to me) is that I'm confused:
> You say "I didn't implement is as a macro, because A". Now we both agree
> that A is an invalid argument. Given that you now also confirmed you did
> want to implement it as a macro in the first place, I would expect that
> either you do implement it as a macro, or provide a valid argument for
> not doing so. Maybe I really am too dense, but the hitchhiker quotation
> didn't help.

Okay, now I get it. Do I implement a macro for the operation? I Don't
know.

Please see http://thread.gmane.org/gmane.emacs.orgmode/44422/focus=46184

Best,
  -- David
-- 
OpenPGP... 0x99ADB83B5A4478E6
Jabber.... dmjena@jabber.org
Email..... dmaus@ictsoc.de

[-- Attachment #2: Type: application/pgp-signature, Size: 230 bytes --]

Re: [PATCH 0/5] loop over headlines in active region

[Carsten Dominik]

Hi David,

I see that this patch is still on the patchwork server.
What is the status, I remember that you dot a number of
comments....

- Carsten

On Aug 25, 2011, at 6:25 AM, David Maus wrote:

> Hi Bastien,
> 
>> Great -- can you submit a patch against current git head?
> 
> Following 5 patches implement looping over headlines in active region
> for org-schedule and org-deadline. Invisible headlines are skipped and
> bulk-agenda commands work by binding the customization variable to nil
> before executing a command.
> 
> I've been running with this modification for 2 weeks now, using the
> feature occassionally without a visibile problem.
> 
> As for the macro: What stop me to implement a macro for the generic
> operation is that for now the macro would depend on the global
> customization variable. That's not a problem per se but according to
> my readings about macros (mostly in context of Common Lisp, but that
> shouldn't matter) it should be considered bad style.
> 
> I did some experiments with defining an `org-map-entries' MATCH of
> 'current that causes FUNC to be applied to the current heading
> only, but I'm not sure if this would be a right thing (tm) to do.
> 
> Best,
>  -- David
> 
> David Maus (5):
>  Extend scope 'region to include body of last headline in active
>    region
>  Immediately return if scope is region but no region is active
>  New customization variable: Loop over headlines in active region
>  Skip invisible headlines when mapping over headlines in active region
>  Avoid conflict between bulk command and loop-over-headlines
> 
> 

- Carsten

Re: [PATCH 0/5] loop over headlines in active region

[David Maus]

[-- Attachment #1: Type: text/plain, Size: 755 bytes --]

Hi Carsten,

At Thu, 6 Oct 2011 10:35:18 +0200,
Carsten Dominik wrote:
>
> Hi David,
>
> I see that this patch is still on the patchwork server.
> What is the status, I remember that you dot a number of
> comments....

Started to make a list of Org's behavior with headlines when region is
active but didn't make much progress. Besides that I'm waiting for
some feedback by Bastien.

Personally I think we can turn the state to "Deferred" -- I don't
consider it of high importance. I gave up on using the functionallity
in favour of Agenda's bulk operations and rescheduling/deadlining
multiple items in the same buffer does not happen that often.

Best,
  -- David
--
OpenPGP... 0x99ADB83B5A4478E6
Jabber.... dmjena@jabber.org
Email..... dmaus@ictsoc.de

[-- Attachment #2: Type: application/pgp-signature, Size: 230 bytes --]

Re: [PATCH 0/5] loop over headlines in active region

[Carsten Dominik]

Hi David,

On 8.10.2011, at 20:59, David Maus wrote:

> Hi Carsten,
> 
> At Thu, 6 Oct 2011 10:35:18 +0200,
> Carsten Dominik wrote:
>> 
>> Hi David,
>> 
>> I see that this patch is still on the patchwork server.
>> What is the status, I remember that you dot a number of
>> comments....
> 
> Started to make a list of Org's behavior with headlines when region is
> active but didn't make much progress. Besides that I'm waiting for
> some feedback by Bastien.
> 
> Personally I think we can turn the state to "Deferred" -- I don't
> consider it of high importance. I gave up on using the functionallity
> in favour of Agenda's bulk operations and rescheduling/deadlining
> multiple items in the same buffer does not happen that often.

OK, lets do that, I agree.  I guess this applies to the whole batch,
910, 911, 925, 926?  I have lost the overview a bit.
Will you change the status?

Cheers

- Carsten

> 
> Best,
>  -- David
> --
> OpenPGP... 0x99ADB83B5A4478E6
> Jabber.... dmjena@jabber.org
> Email..... dmaus@ictsoc.de

Re: [PATCH 0/5] loop over headlines in active region

[David Maus]

[-- Attachment #1: Type: text/plain, Size: 1273 bytes --]

At Sat, 8 Oct 2011 22:11:37 +0200,
Carsten Dominik wrote:
>
> Hi David,
>
> On 8.10.2011, at 20:59, David Maus wrote:
>
> > Hi Carsten,
> >
> > At Thu, 6 Oct 2011 10:35:18 +0200,
> > Carsten Dominik wrote:
> >>
> >> Hi David,
> >>
> >> I see that this patch is still on the patchwork server.
> >> What is the status, I remember that you dot a number of
> >> comments....
> >
> > Started to make a list of Org's behavior with headlines when region is
> > active but didn't make much progress. Besides that I'm waiting for
> > some feedback by Bastien.
> >
> > Personally I think we can turn the state to "Deferred" -- I don't
> > consider it of high importance. I gave up on using the functionallity
> > in favour of Agenda's bulk operations and rescheduling/deadlining
> > multiple items in the same buffer does not happen that often.
>
> OK, lets do that, I agree.  I guess this applies to the whole batch,
> 910, 911, 925, 926?  I have lost the overview a bit.
> Will you change the status?

Done.

Any information about Bastien's absence? I remember he announce to be
on vacation till Sep 5, but as far as I could see hasn't appeared to
be be active on the list.

Best,
  -- David
--
OpenPGP... 0x99ADB83B5A4478E6
Jabber.... dmjena@jabber.org
Email..... dmaus@ictsoc.de

[-- Attachment #2: Type: application/pgp-signature, Size: 230 bytes --]

[PATCH 1/5] Extend scope 'region to include body of last headline in active region

[David Maus]

* org.el (org-map-entries): Extend scope 'region to include entire
body of last headline in active region.
---
 lisp/org.el |    8 ++++++--
 1 files changed, 6 insertions(+), 2 deletions(-)

diff --git a/lisp/org.el b/lisp/org.el
index de8c72b..b69b77c 100644
--- a/lisp/org.el
+++ b/lisp/org.el
@@ -13633,8 +13633,12 @@ a *different* entry, you cannot use these techniques."
 	       (org-narrow-to-subtree)
 	       (setq scope nil))
 	      ((and (eq scope 'region) (org-region-active-p))
-	       (narrow-to-region (region-beginning) (region-end))
-	       (setq scope nil)))
+	       (let ((end (save-excursion
+			    (goto-char (region-end))
+			    (outline-next-heading)
+			    (point))))
+		 (narrow-to-region (region-beginning) end)
+		 (setq scope nil))))
 
 	(if (not scope)
 	    (progn
-- 
1.7.2.5

Re: [PATCH 1/5] Extend scope 'region to include body of last headline in active region

[Carsten Dominik]

On 25.8.2011, at 06:25, David Maus wrote:

> * org.el (org-map-entries): Extend scope 'region to include entire
> body of last headline in active region.
> ---
> lisp/org.el |    8 ++++++--
> 1 files changed, 6 insertions(+), 2 deletions(-)
> 
> diff --git a/lisp/org.el b/lisp/org.el
> index de8c72b..b69b77c 100644
> --- a/lisp/org.el
> +++ b/lisp/org.el
> @@ -13633,8 +13633,12 @@ a *different* entry, you cannot use these techniques."
> 	       (org-narrow-to-subtree)
> 	       (setq scope nil))
> 	      ((and (eq scope 'region) (org-region-active-p))
> -	       (narrow-to-region (region-beginning) (region-end))
> -	       (setq scope nil)))
> +	       (let ((end (save-excursion
> +			    (goto-char (region-end))
> +			    (outline-next-heading)
> +			    (point))))
> +		 (narrow-to-region (region-beginning) end)
> +		 (setq scope nil))))


Hi David,

I think the better algorithm here would be this:
If region-end is at the beginning of a line and that line is a headline,
use region-end as it is.  If not, jump to the next headline.

Cheers

- Carsten


> 
> 	(if (not scope)
> 	    (progn
> -- 
> 1.7.2.5
> 
> 

Re: [PATCH 1/5] Extend scope 'region to include body of last headline in active region

[David Maus]

[-- Attachment #1.1: Type: text/plain, Size: 1359 bytes --]

Hi Carsten,

At Thu, 25 Aug 2011 07:40:52 +0200,
Carsten Dominik wrote:
>
>
> On 25.8.2011, at 06:25, David Maus wrote:
>
> > * org.el (org-map-entries): Extend scope 'region to include entire
> > body of last headline in active region.
> > ---
> > lisp/org.el |    8 ++++++--
> > 1 files changed, 6 insertions(+), 2 deletions(-)
> >
> > diff --git a/lisp/org.el b/lisp/org.el
> > index de8c72b..b69b77c 100644
> > --- a/lisp/org.el
> > +++ b/lisp/org.el
> > @@ -13633,8 +13633,12 @@ a *different* entry, you cannot use these techniques."
> > 	       (org-narrow-to-subtree)
> > 	       (setq scope nil))
> > 	      ((and (eq scope 'region) (org-region-active-p))
> > -	       (narrow-to-region (region-beginning) (region-end))
> > -	       (setq scope nil)))
> > +	       (let ((end (save-excursion
> > +			    (goto-char (region-end))
> > +			    (outline-next-heading)
> > +			    (point))))
> > +		 (narrow-to-region (region-beginning) end)
> > +		 (setq scope nil))))
>
>
> Hi David,
>
> I think the better algorithm here would be this:
> If region-end is at the beginning of a line and that line is a headline,
> use region-end as it is.  If not, jump to the next headline.

Thanks, yes. This makes sense. Attached patch supersedes the previous.

Best,
  -- David
--
OpenPGP... 0x99ADB83B5A4478E6
Jabber.... dmjena@jabber.org
Email..... dmaus@ictsoc.de

[-- Attachment #1.2: 0001-Extend-scope-region-to-include-entire-body-of-last-h.patch --]
[-- Type: text/plain, Size: 1057 bytes --]

From 957dcbe6ae40fa332e48455a260782ba3e61e68d Mon Sep 17 00:00:00 2001
From: David Maus <dmaus@ictsoc.de>
Date: Tue, 30 Aug 2011 06:22:12 +0200
Subject: [PATCH 1/4] Extend scope 'region to include entire body of last headline in active region

* org.el (org-map-entries): Extend scope 'region to include
entire body of last headline in active region.
---
 lisp/org.el |    7 ++++++-
 1 files changed, 6 insertions(+), 1 deletions(-)

diff --git a/lisp/org.el b/lisp/org.el
index d63b854..b770fa6 100644
--- a/lisp/org.el
+++ b/lisp/org.el
@@ -13629,7 +13629,12 @@ a *different* entry, you cannot use these techniques."
 	       (org-narrow-to-subtree)
 	       (setq scope nil))
 	      ((and (eq scope 'region) (org-region-active-p))
-	       (narrow-to-region (region-beginning) (region-end))
+	       (narrow-to-region (region-beginning)
+				 (save-excursion
+				   (goto-char (region-end))
+				   (unless (and (bolp) (org-at-heading-p))
+				     (outline-next-heading))
+				   (point)))
 	       (setq scope nil)))
 
 	(if (not scope)
-- 
1.7.2.5


[-- Attachment #2: Type: application/pgp-signature, Size: 230 bytes --]

[PATCH 2/5] Immediately return if scope is region but no region is active

[David Maus]

* org.el (org-map-entries): Immediately return if scope is region but
no region is active.
---
 lisp/org.el |  116 ++++++++++++++++++++++++++++++-----------------------------
 1 files changed, 59 insertions(+), 57 deletions(-)

diff --git a/lisp/org.el b/lisp/org.el
index b69b77c..27bad52 100644
--- a/lisp/org.el
+++ b/lisp/org.el
@@ -13608,65 +13608,67 @@ with `org-get-tags-at'.  If your function gets properties with
 to t around the call to `org-entry-properties' to get the same speedup.
 Note that if your function moves around to retrieve tags and properties at
 a *different* entry, you cannot use these techniques."
-  (let* ((org-agenda-archives-mode nil) ; just to make sure
-	 (org-agenda-skip-archived-trees (memq 'archive skip))
-	 (org-agenda-skip-comment-trees (memq 'comment skip))
-	 (org-agenda-skip-function
-	  (car (org-delete-all '(comment archive) skip)))
-	 (org-tags-match-list-sublevels t)
-	 matcher file res
-	 org-todo-keywords-for-agenda
-	 org-done-keywords-for-agenda
-	 org-todo-keyword-alist-for-agenda
-	 org-drawers-for-agenda
-	 org-tag-alist-for-agenda)
+  (unless (and (eq scope 'region)
+	       (not (org-region-active-p)))
+    (let* ((org-agenda-archives-mode nil) ; just to make sure
+	   (org-agenda-skip-archived-trees (memq 'archive skip))
+	   (org-agenda-skip-comment-trees (memq 'comment skip))
+	   (org-agenda-skip-function
+	    (car (org-delete-all '(comment archive) skip)))
+	   (org-tags-match-list-sublevels t)
+	   matcher file res
+	   org-todo-keywords-for-agenda
+	   org-done-keywords-for-agenda
+	   org-todo-keyword-alist-for-agenda
+	   org-drawers-for-agenda
+	   org-tag-alist-for-agenda)
 
-    (cond
-     ((eq match t)   (setq matcher t))
-     ((eq match nil) (setq matcher t))
-     (t (setq matcher (if match (cdr (org-make-tags-matcher match)) t))))
+      (cond
+       ((eq match t)   (setq matcher t))
+       ((eq match nil) (setq matcher t))
+       (t (setq matcher (if match (cdr (org-make-tags-matcher match)) t))))
 
-    (save-excursion
-      (save-restriction
-	(cond ((eq scope 'tree)
-	       (org-back-to-heading t)
-	       (org-narrow-to-subtree)
-	       (setq scope nil))
-	      ((and (eq scope 'region) (org-region-active-p))
-	       (let ((end (save-excursion
-			    (goto-char (region-end))
-			    (outline-next-heading)
-			    (point))))
-		 (narrow-to-region (region-beginning) end)
-		 (setq scope nil))))
-
-	(if (not scope)
-	    (progn
-	      (org-prepare-agenda-buffers
-	       (list (buffer-file-name (current-buffer))))
-	      (setq res (org-scan-tags func matcher)))
-	  ;; Get the right scope
-	  (cond
-	   ((and scope (listp scope) (symbolp (car scope)))
-	    (setq scope (eval scope)))
-	   ((eq scope 'agenda)
-	    (setq scope (org-agenda-files t)))
-	   ((eq scope 'agenda-with-archives)
-	    (setq scope (org-agenda-files t))
-	    (setq scope (org-add-archive-files scope)))
-	   ((eq scope 'file)
-	    (setq scope (list (buffer-file-name))))
-	   ((eq scope 'file-with-archives)
-	    (setq scope (org-add-archive-files (list (buffer-file-name))))))
-	  (org-prepare-agenda-buffers scope)
-	  (while (setq file (pop scope))
-	    (with-current-buffer (org-find-base-buffer-visiting file)
-	      (save-excursion
-		(save-restriction
-		  (widen)
-		  (goto-char (point-min))
-		  (setq res (append res (org-scan-tags func matcher))))))))))
-    res))
+      (save-excursion
+	(save-restriction
+	  (cond ((eq scope 'tree)
+		 (org-back-to-heading t)
+		 (org-narrow-to-subtree)
+		 (setq scope nil))
+		((eq scope 'region)
+		 (let ((end (save-excursion
+			      (goto-char (region-end))
+			      (outline-next-heading)
+			      (point))))
+		   (narrow-to-region (region-beginning) end)
+		   (setq scope nil))))
+
+	  (if (not scope)
+	      (progn
+		(org-prepare-agenda-buffers
+		 (list (buffer-file-name (current-buffer))))
+		(setq res (org-scan-tags func matcher)))
+	    ;; Get the right scope
+	    (cond
+	     ((and scope (listp scope) (symbolp (car scope)))
+	      (setq scope (eval scope)))
+	     ((eq scope 'agenda)
+	      (setq scope (org-agenda-files t)))
+	     ((eq scope 'agenda-with-archives)
+	      (setq scope (org-agenda-files t))
+	      (setq scope (org-add-archive-files scope)))
+	     ((eq scope 'file)
+	      (setq scope (list (buffer-file-name))))
+	     ((eq scope 'file-with-archives)
+	      (setq scope (org-add-archive-files (list (buffer-file-name))))))
+	    (org-prepare-agenda-buffers scope)
+	    (while (setq file (pop scope))
+	      (with-current-buffer (org-find-base-buffer-visiting file)
+		(save-excursion
+		  (save-restriction
+		    (widen)
+		    (goto-char (point-min))
+		    (setq res (append res (org-scan-tags func matcher))))))))))
+      res)))
 
 ;;;; Properties
 
-- 
1.7.2.5

Re: [PATCH 2/5] Immediately return if scope is region but no region is active

[Carsten Dominik]

On 25.8.2011, at 06:25, David Maus wrote:

> * org.el (org-map-entries): Immediately return if scope is region but
> no region is active.
> ---
> lisp/org.el |  116 ++++++++++++++++++++++++++++++-----------------------------
> 1 files changed, 59 insertions(+), 57 deletions(-)
> 
> diff --git a/lisp/org.el b/lisp/org.el
> index b69b77c..27bad52 100644
> --- a/lisp/org.el
> +++ b/lisp/org.el
> @@ -13608,65 +13608,67 @@ with `org-get-tags-at'.  If your function gets properties with
> to t around the call to `org-entry-properties' to get the same speedup.
> Note that if your function moves around to retrieve tags and properties at
> a *different* entry, you cannot use these techniques."
> -  (let* ((org-agenda-archives-mode nil) ; just to make sure
> -	 (org-agenda-skip-archived-trees (memq 'archive skip))
> -	 (org-agenda-skip-comment-trees (memq 'comment skip))
> -	 (org-agenda-skip-function
> -	  (car (org-delete-all '(comment archive) skip)))
> -	 (org-tags-match-list-sublevels t)
> -	 matcher file res
> -	 org-todo-keywords-for-agenda
> -	 org-done-keywords-for-agenda
> -	 org-todo-keyword-alist-for-agenda
> -	 org-drawers-for-agenda
> -	 org-tag-alist-for-agenda)
> +  (unless (and (eq scope 'region)
> +	       (not (org-region-active-p)))

Would it be good to throw an error here?

(if (and (eq scope 'region) (not (org-region-active-p)))
    (error "No active region")
  ...

> +    (let* ((org-agenda-archives-mode nil) ; just to make sure
> +	   (org-agenda-skip-archived-trees (memq 'archive skip))
> +	   (org-agenda-skip-comment-trees (memq 'comment skip))
> +	   (org-agenda-skip-function
> +	    (car (org-delete-all '(comment archive) skip)))
> +	   (org-tags-match-list-sublevels t)
> +	   matcher file res
> +	   org-todo-keywords-for-agenda
> +	   org-done-keywords-for-agenda
> +	   org-todo-keyword-alist-for-agenda
> +	   org-drawers-for-agenda
> +	   org-tag-alist-for-agenda)
> 
> -    (cond
> -     ((eq match t)   (setq matcher t))
> -     ((eq match nil) (setq matcher t))
> -     (t (setq matcher (if match (cdr (org-make-tags-matcher match)) t))))
> +      (cond
> +       ((eq match t)   (setq matcher t))
> +       ((eq match nil) (setq matcher t))
> +       (t (setq matcher (if match (cdr (org-make-tags-matcher match)) t))))
> 
> -    (save-excursion
> -      (save-restriction
> -	(cond ((eq scope 'tree)
> -	       (org-back-to-heading t)
> -	       (org-narrow-to-subtree)
> -	       (setq scope nil))
> -	      ((and (eq scope 'region) (org-region-active-p))
> -	       (let ((end (save-excursion
> -			    (goto-char (region-end))
> -			    (outline-next-heading)
> -			    (point))))
> -		 (narrow-to-region (region-beginning) end)
> -		 (setq scope nil))))
> -
> -	(if (not scope)
> -	    (progn
> -	      (org-prepare-agenda-buffers
> -	       (list (buffer-file-name (current-buffer))))
> -	      (setq res (org-scan-tags func matcher)))
> -	  ;; Get the right scope
> -	  (cond
> -	   ((and scope (listp scope) (symbolp (car scope)))
> -	    (setq scope (eval scope)))
> -	   ((eq scope 'agenda)
> -	    (setq scope (org-agenda-files t)))
> -	   ((eq scope 'agenda-with-archives)
> -	    (setq scope (org-agenda-files t))
> -	    (setq scope (org-add-archive-files scope)))
> -	   ((eq scope 'file)
> -	    (setq scope (list (buffer-file-name))))
> -	   ((eq scope 'file-with-archives)
> -	    (setq scope (org-add-archive-files (list (buffer-file-name))))))
> -	  (org-prepare-agenda-buffers scope)
> -	  (while (setq file (pop scope))
> -	    (with-current-buffer (org-find-base-buffer-visiting file)
> -	      (save-excursion
> -		(save-restriction
> -		  (widen)
> -		  (goto-char (point-min))
> -		  (setq res (append res (org-scan-tags func matcher))))))))))
> -    res))
> +      (save-excursion
> +	(save-restriction
> +	  (cond ((eq scope 'tree)
> +		 (org-back-to-heading t)
> +		 (org-narrow-to-subtree)
> +		 (setq scope nil))
> +		((eq scope 'region)
> +		 (let ((end (save-excursion
> +			      (goto-char (region-end))
> +			      (outline-next-heading)
> +			      (point))))
> +		   (narrow-to-region (region-beginning) end)
> +		   (setq scope nil))))
> +
> +	  (if (not scope)
> +	      (progn
> +		(org-prepare-agenda-buffers
> +		 (list (buffer-file-name (current-buffer))))
> +		(setq res (org-scan-tags func matcher)))
> +	    ;; Get the right scope
> +	    (cond
> +	     ((and scope (listp scope) (symbolp (car scope)))
> +	      (setq scope (eval scope)))
> +	     ((eq scope 'agenda)
> +	      (setq scope (org-agenda-files t)))
> +	     ((eq scope 'agenda-with-archives)
> +	      (setq scope (org-agenda-files t))
> +	      (setq scope (org-add-archive-files scope)))
> +	     ((eq scope 'file)
> +	      (setq scope (list (buffer-file-name))))
> +	     ((eq scope 'file-with-archives)
> +	      (setq scope (org-add-archive-files (list (buffer-file-name))))))
> +	    (org-prepare-agenda-buffers scope)
> +	    (while (setq file (pop scope))
> +	      (with-current-buffer (org-find-base-buffer-visiting file)
> +		(save-excursion
> +		  (save-restriction
> +		    (widen)
> +		    (goto-char (point-min))
> +		    (setq res (append res (org-scan-tags func matcher))))))))))
> +      res)))
> 
> ;;;; Properties
> 
> -- 
> 1.7.2.5
> 
> 

Re: [PATCH 2/5] Immediately return if scope is region but no region is active

[David Maus]

[-- Attachment #1: Type: text/plain, Size: 2441 bytes --]

Hi Carsten,

At Thu, 25 Aug 2011 07:43:48 +0200,
Carsten Dominik wrote:
>
>
> On 25.8.2011, at 06:25, David Maus wrote:
>
> > * org.el (org-map-entries): Immediately return if scope is region but
> > no region is active.
> > ---
> > lisp/org.el |  116 ++++++++++++++++++++++++++++++-----------------------------
> > 1 files changed, 59 insertions(+), 57 deletions(-)
> >
> > diff --git a/lisp/org.el b/lisp/org.el
> > index b69b77c..27bad52 100644
> > --- a/lisp/org.el
> > +++ b/lisp/org.el
> > @@ -13608,65 +13608,67 @@ with `org-get-tags-at'.  If your function gets properties with
> > to t around the call to `org-entry-properties' to get the same speedup.
> > Note that if your function moves around to retrieve tags and properties at
> > a *different* entry, you cannot use these techniques."
> > -  (let* ((org-agenda-archives-mode nil) ; just to make sure
> > -	 (org-agenda-skip-archived-trees (memq 'archive skip))
> > -	 (org-agenda-skip-comment-trees (memq 'comment skip))
> > -	 (org-agenda-skip-function
> > -	  (car (org-delete-all '(comment archive) skip)))
> > -	 (org-tags-match-list-sublevels t)
> > -	 matcher file res
> > -	 org-todo-keywords-for-agenda
> > -	 org-done-keywords-for-agenda
> > -	 org-todo-keyword-alist-for-agenda
> > -	 org-drawers-for-agenda
> > -	 org-tag-alist-for-agenda)
> > +  (unless (and (eq scope 'region)
> > +	       (not (org-region-active-p)))
>
> Would it be good to throw an error here?
>
> (if (and (eq scope 'region) (not (org-region-active-p)))
>     (error "No active region")

Not necessarily. I look at map-entries as a function that applies FUNC
to a subset of all headlines. SCOPE, MATCH, and SKIP are selectors
that narrow down the set of headlines.  First SCOPE is applied to the
set containing all headlines, than MATCH is applied to the set of
headlines selected by SCOPE, finally FUNC is applied to all headlines
in the final subset if not SKIP.

If you look at `org-map-entries' this way then calling it with SCOPE
'region but no active region is not an error. How many headlines are
in the active region if there is no active region? Exactly zero. Its
the same with a SCOPE 'file but no headline in current file.

Applying SCOPE to the set of all headings produces the empty set
and `org-map-entries' can simply leave because MATCH and SKIP wouldn't
match anything.

Best,
 -- David
--
OpenPGP... 0x99ADB83B5A4478E6
Jabber.... dmjena@jabber.org
Email..... dmaus@ictsoc.de

[-- Attachment #2: Type: application/pgp-signature, Size: 230 bytes --]

Re: [PATCH 2/5] Immediately return if scope is region but no region is active

[Carsten Dominik]

On Aug 28, 2011, at 4:00 PM, David Maus wrote:

> Hi Carsten,
> 
> At Thu, 25 Aug 2011 07:43:48 +0200,
> Carsten Dominik wrote:
>> 
>> 
>> On 25.8.2011, at 06:25, David Maus wrote:
>> 
>>> * org.el (org-map-entries): Immediately return if scope is region but
>>> no region is active.
>>> ---
>>> lisp/org.el |  116 ++++++++++++++++++++++++++++++-----------------------------
>>> 1 files changed, 59 insertions(+), 57 deletions(-)
>>> 
>>> diff --git a/lisp/org.el b/lisp/org.el
>>> index b69b77c..27bad52 100644
>>> --- a/lisp/org.el
>>> +++ b/lisp/org.el
>>> @@ -13608,65 +13608,67 @@ with `org-get-tags-at'.  If your function gets properties with
>>> to t around the call to `org-entry-properties' to get the same speedup.
>>> Note that if your function moves around to retrieve tags and properties at
>>> a *different* entry, you cannot use these techniques."
>>> -  (let* ((org-agenda-archives-mode nil) ; just to make sure
>>> -	 (org-agenda-skip-archived-trees (memq 'archive skip))
>>> -	 (org-agenda-skip-comment-trees (memq 'comment skip))
>>> -	 (org-agenda-skip-function
>>> -	  (car (org-delete-all '(comment archive) skip)))
>>> -	 (org-tags-match-list-sublevels t)
>>> -	 matcher file res
>>> -	 org-todo-keywords-for-agenda
>>> -	 org-done-keywords-for-agenda
>>> -	 org-todo-keyword-alist-for-agenda
>>> -	 org-drawers-for-agenda
>>> -	 org-tag-alist-for-agenda)
>>> +  (unless (and (eq scope 'region)
>>> +	       (not (org-region-active-p)))
>> 
>> Would it be good to throw an error here?
>> 
>> (if (and (eq scope 'region) (not (org-region-active-p)))
>>    (error "No active region")
> 
> Not necessarily. I look at map-entries as a function that applies FUNC
> to a subset of all headlines. SCOPE, MATCH, and SKIP are selectors
> that narrow down the set of headlines.  First SCOPE is applied to the
> set containing all headlines, than MATCH is applied to the set of
> headlines selected by SCOPE, finally FUNC is applied to all headlines
> in the final subset if not SKIP.
> 
> If you look at `org-map-entries' this way then calling it with SCOPE
> 'region but no active region is not an error. How many headlines are
> in the active region if there is no active region? Exactly zero. Its
> the same with a SCOPE 'file but no headline in current file.
> 
> Applying SCOPE to the set of all headings produces the empty set
> and `org-map-entries' can simply leave because MATCH and SKIP wouldn't
> match anything.

Yes, I agree, I think you are right.  Thanks!

- Carsten

Re: [PATCH 2/5] Immediately return if scope is region but no region is active

[David Maus]

[-- Attachment #1.1: Type: text/plain, Size: 184 bytes --]

Attached patch superseeds the old one, required to be applied after
"Extend scope 'region...".
--
OpenPGP... 0x99ADB83B5A4478E6
Jabber.... dmjena@jabber.org
Email..... dmaus@ictsoc.de

[-- Attachment #1.2: 0002-Immediately-return-if-scope-is-region-but-no-region-.patch --]
[-- Type: text/plain, Size: 5101 bytes --]

From 8a0e1630629693a85a824713b1357faa49a372f0 Mon Sep 17 00:00:00 2001
From: David Maus <dmaus@ictsoc.de>
Date: Tue, 30 Aug 2011 06:29:29 +0200
Subject: [PATCH 2/4] Immediately return if scope is 'region but no region is active

* org.el (org-map-entries): Immediately return if scope is 'region but
no region is active.
---
 lisp/org.el |  117 ++++++++++++++++++++++++++++++-----------------------------
 1 files changed, 59 insertions(+), 58 deletions(-)

diff --git a/lisp/org.el b/lisp/org.el
index b770fa6..d1f9898 100644
--- a/lisp/org.el
+++ b/lisp/org.el
@@ -13604,66 +13604,67 @@ with `org-get-tags-at'.  If your function gets properties with
 to t around the call to `org-entry-properties' to get the same speedup.
 Note that if your function moves around to retrieve tags and properties at
 a *different* entry, you cannot use these techniques."
-  (let* ((org-agenda-archives-mode nil) ; just to make sure
-	 (org-agenda-skip-archived-trees (memq 'archive skip))
-	 (org-agenda-skip-comment-trees (memq 'comment skip))
-	 (org-agenda-skip-function
-	  (car (org-delete-all '(comment archive) skip)))
-	 (org-tags-match-list-sublevels t)
-	 matcher file res
-	 org-todo-keywords-for-agenda
-	 org-done-keywords-for-agenda
-	 org-todo-keyword-alist-for-agenda
-	 org-drawers-for-agenda
-	 org-tag-alist-for-agenda)
+  (unless (and (eq scope 'region) (not (org-region-active-p)))
+    (let* ((org-agenda-archives-mode nil) ; just to make sure
+	   (org-agenda-skip-archived-trees (memq 'archive skip))
+	   (org-agenda-skip-comment-trees (memq 'comment skip))
+	   (org-agenda-skip-function
+	    (car (org-delete-all '(comment archive) skip)))
+	   (org-tags-match-list-sublevels t)
+	   matcher file res
+	   org-todo-keywords-for-agenda
+	   org-done-keywords-for-agenda
+	   org-todo-keyword-alist-for-agenda
+	   org-drawers-for-agenda
+	   org-tag-alist-for-agenda)
 
-    (cond
-     ((eq match t)   (setq matcher t))
-     ((eq match nil) (setq matcher t))
-     (t (setq matcher (if match (cdr (org-make-tags-matcher match)) t))))
+      (cond
+       ((eq match t)   (setq matcher t))
+       ((eq match nil) (setq matcher t))
+       (t (setq matcher (if match (cdr (org-make-tags-matcher match)) t))))
 
-    (save-excursion
-      (save-restriction
-	(cond ((eq scope 'tree)
-	       (org-back-to-heading t)
-	       (org-narrow-to-subtree)
-	       (setq scope nil))
-	      ((and (eq scope 'region) (org-region-active-p))
-	       (narrow-to-region (region-beginning)
-				 (save-excursion
-				   (goto-char (region-end))
-				   (unless (and (bolp) (org-at-heading-p))
-				     (outline-next-heading))
-				   (point)))
-	       (setq scope nil)))
-
-	(if (not scope)
-	    (progn
-	      (org-prepare-agenda-buffers
-	       (list (buffer-file-name (current-buffer))))
-	      (setq res (org-scan-tags func matcher)))
-	  ;; Get the right scope
-	  (cond
-	   ((and scope (listp scope) (symbolp (car scope)))
-	    (setq scope (eval scope)))
-	   ((eq scope 'agenda)
-	    (setq scope (org-agenda-files t)))
-	   ((eq scope 'agenda-with-archives)
-	    (setq scope (org-agenda-files t))
-	    (setq scope (org-add-archive-files scope)))
-	   ((eq scope 'file)
-	    (setq scope (list (buffer-file-name))))
-	   ((eq scope 'file-with-archives)
-	    (setq scope (org-add-archive-files (list (buffer-file-name))))))
-	  (org-prepare-agenda-buffers scope)
-	  (while (setq file (pop scope))
-	    (with-current-buffer (org-find-base-buffer-visiting file)
-	      (save-excursion
-		(save-restriction
-		  (widen)
-		  (goto-char (point-min))
-		  (setq res (append res (org-scan-tags func matcher))))))))))
-    res))
+      (save-excursion
+	(save-restriction
+	  (cond ((eq scope 'tree)
+		 (org-back-to-heading t)
+		 (org-narrow-to-subtree)
+		 (setq scope nil))
+		((and (eq scope 'region) (org-region-active-p))
+		 (narrow-to-region (region-beginning)
+				   (save-excursion
+				     (goto-char (region-end))
+				     (unless (and (bolp) (org-at-heading-p))
+				       (outline-next-heading))
+				     (point)))
+		 (setq scope nil)))
+
+	  (if (not scope)
+	      (progn
+		(org-prepare-agenda-buffers
+		 (list (buffer-file-name (current-buffer))))
+		(setq res (org-scan-tags func matcher)))
+	    ;; Get the right scope
+	    (cond
+	     ((and scope (listp scope) (symbolp (car scope)))
+	      (setq scope (eval scope)))
+	     ((eq scope 'agenda)
+	      (setq scope (org-agenda-files t)))
+	     ((eq scope 'agenda-with-archives)
+	      (setq scope (org-agenda-files t))
+	      (setq scope (org-add-archive-files scope)))
+	     ((eq scope 'file)
+	      (setq scope (list (buffer-file-name))))
+	     ((eq scope 'file-with-archives)
+	      (setq scope (org-add-archive-files (list (buffer-file-name))))))
+	    (org-prepare-agenda-buffers scope)
+	    (while (setq file (pop scope))
+	      (with-current-buffer (org-find-base-buffer-visiting file)
+		(save-excursion
+		  (save-restriction
+		    (widen)
+		    (goto-char (point-min))
+		    (setq res (append res (org-scan-tags func matcher))))))))))
+      res)))
 
 ;;;; Properties
 
-- 
1.7.2.5


[-- Attachment #2: Type: application/pgp-signature, Size: 230 bytes --]

[PATCH 3/5] New customization variable: Loop over headlines in active region

[David Maus]

* org.el (org-loop-over-headlines-in-active-region): New customization
variable. Loop over headlines in active region.
(org-schedule, org-deadline): Apply to headlines in region depending
on new customization variable.
---
 lisp/org.el |  159 ++++++++++++++++++++++++++++++++++------------------------
 1 files changed, 93 insertions(+), 66 deletions(-)

diff --git a/lisp/org.el b/lisp/org.el
index 27bad52..d15c946 100644
--- a/lisp/org.el
+++ b/lisp/org.el
@@ -402,6 +402,25 @@ XEmacs user should have this variable set to nil, because
 	  (const :tag "When outside special context" t)
 	  (const :tag "Everywhere except timestamps" always)))
 
+(defcustom org-loop-over-headlines-in-active-region nil
+  "Shall some commands act upon headlines in the active region?
+
+When set to `t', some commands will be performed in all headlines
+within the active region.
+
+When set to a string, those commands will be performed on the
+matching headlines within the active region.  Such string must be
+a tags/property/todo match as it is used in the agenda tags view.
+
+The list of commands is:
+- `org-schedule'
+- `org-deadline'"
+  :type '(choice (const :tag "Don't loop" nil)
+		 (const :tag "All headlines in active region" t)
+		 (string :tag "Tags/Property/Todo matcher"))
+  :group 'org-todo
+  :group 'org-archive)
+
 (defgroup org-startup nil
   "Options concerning startup of Org-mode."
   :tag "Org Startup"
@@ -11807,39 +11826,43 @@ With argument REMOVE, remove any deadline from the item.
 With argument TIME, set the deadline at the corresponding date.  TIME
 can either be an Org date like \"2011-07-24\" or a delta like \"+2d\"."
   (interactive "P")
-  (let* ((old-date (org-entry-get nil "DEADLINE"))
-	 (repeater (and old-date
-			(string-match
-			 "\\([.+-]+[0-9]+[dwmy]\\(?:[/ ][-+]?[0-9]+[dwmy]\\)?\\) ?"
-			  old-date)
-			(match-string 1 old-date))))
-    (if remove
-	(progn
-	  (when (and old-date org-log-redeadline)
-	    (org-add-log-setup 'deldeadline nil old-date 'findpos
-			       org-log-redeadline))
-	  (org-remove-timestamp-with-keyword org-deadline-string)
-	  (message "Item no longer has a deadline."))
-      (org-add-planning-info 'deadline time 'closed)
-      (when (and old-date org-log-redeadline
-		 (not (equal old-date
-			     (substring org-last-inserted-timestamp 1 -1))))
-	(org-add-log-setup 'redeadline nil old-date 'findpos
-			   org-log-redeadline))
-      (when repeater
-	(save-excursion
-	  (org-back-to-heading t)
-	  (when (re-search-forward (concat org-deadline-string " "
-					   org-last-inserted-timestamp)
-				   (save-excursion
-				     (outline-next-heading) (point)) t)
-	    (goto-char (1- (match-end 0)))
-	    (insert " " repeater)
-	    (setq org-last-inserted-timestamp
-		  (concat (substring org-last-inserted-timestamp 0 -1)
-			  " " repeater
-			  (substring org-last-inserted-timestamp -1))))))
-      (message "Deadline on %s" org-last-inserted-timestamp))))
+  (if (and (org-region-active-p) org-loop-over-headlines-in-active-region)
+      (let (org-loop-over-headlines-in-active-region)
+	(org-map-entries
+	 `(org-deadline ',remove ,time) org-loop-over-headlines-in-active-region 'region))
+    (let* ((old-date (org-entry-get nil "DEADLINE"))
+	   (repeater (and old-date
+			  (string-match
+			   "\\([.+-]+[0-9]+[dwmy]\\(?:[/ ][-+]?[0-9]+[dwmy]\\)?\\) ?"
+			   old-date)
+			  (match-string 1 old-date))))
+      (if remove
+	  (progn
+	    (when (and old-date org-log-redeadline)
+	      (org-add-log-setup 'deldeadline nil old-date 'findpos
+				 org-log-redeadline))
+	    (org-remove-timestamp-with-keyword org-deadline-string)
+	    (message "Item no longer has a deadline."))
+	(org-add-planning-info 'deadline time 'closed)
+	(when (and old-date org-log-redeadline
+		   (not (equal old-date
+			       (substring org-last-inserted-timestamp 1 -1))))
+	  (org-add-log-setup 'redeadline nil old-date 'findpos
+			     org-log-redeadline))
+	(when repeater
+	  (save-excursion
+	    (org-back-to-heading t)
+	    (when (re-search-forward (concat org-deadline-string " "
+					     org-last-inserted-timestamp)
+				     (save-excursion
+				       (outline-next-heading) (point)) t)
+	      (goto-char (1- (match-end 0)))
+	      (insert " " repeater)
+	      (setq org-last-inserted-timestamp
+		    (concat (substring org-last-inserted-timestamp 0 -1)
+			    " " repeater
+			    (substring org-last-inserted-timestamp -1))))))
+	(message "Deadline on %s" org-last-inserted-timestamp)))))
 
 (defun org-schedule (&optional remove time)
   "Insert the SCHEDULED: string with a timestamp to schedule a TODO item.
@@ -11847,39 +11870,43 @@ With argument REMOVE, remove any scheduling date from the item.
 With argument TIME, scheduled at the corresponding date.  TIME can
 either be an Org date like \"2011-07-24\" or a delta like \"+2d\"."
   (interactive "P")
-  (let* ((old-date (org-entry-get nil "SCHEDULED"))
-	 (repeater (and old-date
-			(string-match
-			 "\\([.+-]+[0-9]+[dwmy]\\(?:[/ ][-+]?[0-9]+[dwmy]\\)?\\) ?"
-			 old-date)
-			(match-string 1 old-date))))
-    (if remove
-	(progn
-	  (when (and old-date org-log-reschedule)
-	    (org-add-log-setup 'delschedule nil old-date 'findpos
-			       org-log-reschedule))
-	  (org-remove-timestamp-with-keyword org-scheduled-string)
-	  (message "Item is no longer scheduled."))
-      (org-add-planning-info 'scheduled time 'closed)
-      (when (and old-date org-log-reschedule
-		 (not (equal old-date
-			     (substring org-last-inserted-timestamp 1 -1))))
-	(org-add-log-setup 'reschedule nil old-date 'findpos
-			   org-log-reschedule))
-      (when repeater
-	(save-excursion
-	  (org-back-to-heading t)
-	  (when (re-search-forward (concat org-scheduled-string " "
-					   org-last-inserted-timestamp)
-				   (save-excursion
-				     (outline-next-heading) (point)) t)
-	    (goto-char (1- (match-end 0)))
-	    (insert " " repeater)
-	    (setq org-last-inserted-timestamp
-		  (concat (substring org-last-inserted-timestamp 0 -1)
-			  " " repeater
-			  (substring org-last-inserted-timestamp -1))))))
-      (message "Scheduled to %s" org-last-inserted-timestamp))))
+  (if (and (org-region-active-p) org-loop-over-headlines-in-active-region)
+      (let (org-loop-over-headlines-in-active-region)
+	(org-map-entries
+	 `(org-schedule ',remove ,time) org-loop-over-headlines-in-active-region 'region))
+    (let* ((old-date (org-entry-get nil "SCHEDULED"))
+	   (repeater (and old-date
+			  (string-match
+			   "\\([.+-]+[0-9]+[dwmy]\\(?:[/ ][-+]?[0-9]+[dwmy]\\)?\\) ?"
+			   old-date)
+			  (match-string 1 old-date))))
+      (if remove
+	  (progn
+	    (when (and old-date org-log-reschedule)
+	      (org-add-log-setup 'delschedule nil old-date 'findpos
+				 org-log-reschedule))
+	    (org-remove-timestamp-with-keyword org-scheduled-string)
+	    (message "Item is no longer scheduled."))
+	(org-add-planning-info 'scheduled time 'closed)
+	(when (and old-date org-log-reschedule
+		   (not (equal old-date
+			       (substring org-last-inserted-timestamp 1 -1))))
+	  (org-add-log-setup 'reschedule nil old-date 'findpos
+			     org-log-reschedule))
+	(when repeater
+	  (save-excursion
+	    (org-back-to-heading t)
+	    (when (re-search-forward (concat org-scheduled-string " "
+					     org-last-inserted-timestamp)
+				     (save-excursion
+				       (outline-next-heading) (point)) t)
+	      (goto-char (1- (match-end 0)))
+	      (insert " " repeater)
+	      (setq org-last-inserted-timestamp
+		    (concat (substring org-last-inserted-timestamp 0 -1)
+			    " " repeater
+			    (substring org-last-inserted-timestamp -1))))))
+	(message "Scheduled to %s" org-last-inserted-timestamp)))))
 
 (defun org-get-scheduled-time (pom &optional inherit)
   "Get the scheduled time as a time tuple, of a format suitable
-- 
1.7.2.5

[PATCH 4/5] Skip invisible headlines when mapping over headlines in active region

[David Maus]

* org.el (org-deadline, org-schedule): Skip invisible headlines when
mapping over headlines in active region.
---
 lisp/org.el |    4 ++--
 1 files changed, 2 insertions(+), 2 deletions(-)

diff --git a/lisp/org.el b/lisp/org.el
index d15c946..03c4c13 100644
--- a/lisp/org.el
+++ b/lisp/org.el
@@ -11829,7 +11829,7 @@ can either be an Org date like \"2011-07-24\" or a delta like \"+2d\"."
   (if (and (org-region-active-p) org-loop-over-headlines-in-active-region)
       (let (org-loop-over-headlines-in-active-region)
 	(org-map-entries
-	 `(org-deadline ',remove ,time) org-loop-over-headlines-in-active-region 'region))
+	 `(org-deadline ',remove ,time) org-loop-over-headlines-in-active-region 'region (if (outline-invisible-p) (org-end-of-subtree nil t))))
     (let* ((old-date (org-entry-get nil "DEADLINE"))
 	   (repeater (and old-date
 			  (string-match
@@ -11873,7 +11873,7 @@ either be an Org date like \"2011-07-24\" or a delta like \"+2d\"."
   (if (and (org-region-active-p) org-loop-over-headlines-in-active-region)
       (let (org-loop-over-headlines-in-active-region)
 	(org-map-entries
-	 `(org-schedule ',remove ,time) org-loop-over-headlines-in-active-region 'region))
+	 `(org-schedule ',remove ,time) org-loop-over-headlines-in-active-region 'region (if (outline-invisible-p) (org-end-of-subtree nil t))))
     (let* ((old-date (org-entry-get nil "SCHEDULED"))
 	   (repeater (and old-date
 			  (string-match
-- 
1.7.2.5

[PATCH 5/5] Avoid conflict between bulk command and loop-over-headlines

[David Maus]

* org-agenda.el (org-agenda-bulk-action): Bind
`org-loop-over-headlines-in-active-region' to nil to avoid conflict
with bulk command.
---
 lisp/org-agenda.el |    3 ++-
 1 files changed, 2 insertions(+), 1 deletions(-)

diff --git a/lisp/org-agenda.el b/lisp/org-agenda.el
index 07f3c12..bb0062d 100644
--- a/lisp/org-agenda.el
+++ b/lisp/org-agenda.el
@@ -8306,7 +8306,8 @@ The prefix arg is passed through to the command if possible."
 	  (progn (message "Skipping removed entry at %s" e)
 		 (setq cntskip (1+ cntskip)))
 	(goto-char pos)
-	(eval cmd)
+	(let (org-loop-over-headlines-in-active-region)
+	  (eval cmd))
 	(setq org-agenda-bulk-marked-entries
 	      (delete e org-agenda-bulk-marked-entries))
 	(setq cnt (1+ cnt))))
-- 
1.7.2.5

Re: [PATCH 5/5] Avoid conflict between bulk command and loop-over-headlines

[Bastien]

Hi David,

I have tested the latest versions of this serie of patches.
Everything works as expected.  

Please all check out this new option:

,----[ org-loop-over-headlines-in-active-region ]
| Shall some commands act upon headlines in the active region?
| 
| When set to `t', some commands will be performed in all headlines
| within the active region.
| 
| When set to a string, those commands will be performed on the
| matching headlines within the active region.  Such string must be
| a tags/property/todo match as it is used in the agenda tags view.
| 
| The list of commands is:
| - `org-schedule'
| - `org-deadline'
`----

Having it for `org-schedule' and `org-deadline' is just a beginning, 
I'm willing to implement this for `org-archive' too.  If you have other
ideas on where it could be useful, please share.

Thanks a lot David for the clean implementation!

Best,

-- 
 Bastien

Re: New feature: loop over siblings for some commands

[Bastien]

Hi David,

I've finally managed to get there.

David Maus <dmaus@ictsoc.de> writes:

> The macro suffers from leaking: It let-binds symbols like beg, end
> etc. that might be present in ,@body. The let-bound symbols will
> shadow body's.

Yes, you're right.

> The whole problem of leaking macros is discussed in Peter Seibel's
> "Practical Common Lisp", Chapter 8
>
> http://www.gigamonkeys.com/book/macros-defining-your-own.html

Nice reading!

> The solution is a heavy use of C-h f gensym RET for all symboles
> needed in the macro to create fresh, unique und uninterned symbols.

Thanks for the suggested solution.

I'll continue replying to your other email.

Thanks,

-- 
 Bastien