0
0
Fork 1
mirror of https://git.savannah.gnu.org/git/emacs/org-mode.git synced 2024-09-22 10:10:42 +00:00

New allowed value 'start-level for `org-loop-over-headlines-in-active-region'.

* org.el (org-scan-tags): New parameter `start-level' to
scan only through headlines of that level.
(org-map-entries): New allowed value `region-start-level' for
the `scope' parameter, to allow scanning through headlines of
the same level than the first headline in the region.
(org-loop-over-headlines-in-active-region): New allowed value
'start-level.

This change gives more flexibility when looping over the active
region for commands like `org-schedule', `org-deadline', etc.
By setting `org-loop-over-headlines-in-active-region' to
̀start-level', those command will act upon headlines that are
of the same level than the first one in the region.
This commit is contained in:
Bastien Guerry 2011-12-30 11:09:26 +01:00
parent 361261b048
commit dec7efc414

View file

@ -410,6 +410,10 @@ XEmacs user should have this variable set to nil, because
When set to `t', some commands will be performed in all headlines When set to `t', some commands will be performed in all headlines
within the active region. within the active region.
When set to `start-level', some commands will be performed in all
headlines within the active region, provided that these headlines
are of the same level than the first one.
When set to a string, those commands will be performed on the When set to a string, those commands will be performed on the
matching headlines within the active region. Such string must be matching headlines within the active region. Such string must be
a tags/property/todo match as it is used in the agenda tags view. a tags/property/todo match as it is used in the agenda tags view.
@ -419,6 +423,7 @@ The list of commands is:
- `org-deadline'" - `org-deadline'"
:type '(choice (const :tag "Don't loop" nil) :type '(choice (const :tag "Don't loop" nil)
(const :tag "All headlines in active region" t) (const :tag "All headlines in active region" t)
(const :tag "In active region, headlines at the same level than the first one" 'start-level)
(string :tag "Tags/Property/Todo matcher")) (string :tag "Tags/Property/Todo matcher"))
:group 'org-todo :group 'org-todo
:group 'org-archive) :group 'org-archive)
@ -12718,7 +12723,7 @@ obtain a list of properties. Building the tags list for each entry in such
a file becomes an N^2 operation - but with this variable set, it scales a file becomes an N^2 operation - but with this variable set, it scales
as N.") as N.")
(defun org-scan-tags (action matcher &optional todo-only) (defun org-scan-tags (action matcher &optional todo-only start-level)
"Scan headline tags with inheritance and produce output ACTION. "Scan headline tags with inheritance and produce output ACTION.
ACTION can be `sparse-tree' to produce a sparse tree in the current buffer, ACTION can be `sparse-tree' to produce a sparse tree in the current buffer,
@ -12728,9 +12733,17 @@ this case the return value is a list of all return values from these calls.
MATCHER is a Lisp form to be evaluated, testing if a given set of tags MATCHER is a Lisp form to be evaluated, testing if a given set of tags
qualifies a headline for inclusion. When TODO-ONLY is non-nil, qualifies a headline for inclusion. When TODO-ONLY is non-nil,
only lines with a TODO keyword are included in the output." only lines with a TODO keyword are included in the output.
START-LEVEL can be a string with asterisks, reducing the scope to
headlines matching this string."
(require 'org-agenda) (require 'org-agenda)
(let* ((re (concat "^" org-outline-regexp " *\\(\\<\\(" (let* ((re (concat "^"
(if start-level
;; Get the correct level to match
(concat "\\*\\{" (number-to-string start-level) "\\} ")
org-outline-regexp)
" *\\(\\<\\("
(mapconcat 'regexp-quote org-todo-keywords-1 "\\|") (mapconcat 'regexp-quote org-todo-keywords-1 "\\|")
(org-re (org-re
"\\>\\)\\)? *\\(.*?\\)\\(:[[:alnum:]_@#%:]+:\\)?[ \t]*$"))) "\\>\\)\\)? *\\(.*?\\)\\(:[[:alnum:]_@#%:]+:\\)?[ \t]*$")))
@ -13724,6 +13737,9 @@ SCOPE determines the scope of this command. It can be any of:
nil The current buffer, respecting the restriction if any nil The current buffer, respecting the restriction if any
tree The subtree started with the entry at point tree The subtree started with the entry at point
region The entries within the active region, if any region The entries within the active region, if any
region-start-level
The entries within the active region, but only those at
the same level than the first one.
file The current buffer, without restriction file The current buffer, without restriction
file-with-archives file-with-archives
The current buffer, and any archives associated with it The current buffer, and any archives associated with it
@ -13752,13 +13768,15 @@ 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. 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 Note that if your function moves around to retrieve tags and properties at
a *different* entry, you cannot use these techniques." a *different* entry, you cannot use these techniques."
(unless (and (eq scope 'region) (not (org-region-active-p))) (unless (and (or (eq scope 'region) (eq scope 'region-start-level))
(not (org-region-active-p)))
(let* ((org-agenda-archives-mode nil) ; just to make sure (let* ((org-agenda-archives-mode nil) ; just to make sure
(org-agenda-skip-archived-trees (memq 'archive skip)) (org-agenda-skip-archived-trees (memq 'archive skip))
(org-agenda-skip-comment-trees (memq 'comment skip)) (org-agenda-skip-comment-trees (memq 'comment skip))
(org-agenda-skip-function (org-agenda-skip-function
(car (org-delete-all '(comment archive) skip))) (car (org-delete-all '(comment archive) skip)))
(org-tags-match-list-sublevels t) (org-tags-match-list-sublevels t)
(start-level (eq scope 'region-start-level))
matcher file res matcher file res
org-todo-keywords-for-agenda org-todo-keywords-for-agenda
org-done-keywords-for-agenda org-done-keywords-for-agenda
@ -13777,7 +13795,14 @@ a *different* entry, you cannot use these techniques."
(org-back-to-heading t) (org-back-to-heading t)
(org-narrow-to-subtree) (org-narrow-to-subtree)
(setq scope nil)) (setq scope nil))
((and (eq scope 'region) (org-region-active-p)) ((and (or (eq scope 'region) (eq scope 'region-start-level))
(org-region-active-p))
;; If needed, set start-level to a string like "2"
(when start-level
(save-excursion
(goto-char (region-beginning))
(unless (org-at-heading-p) (outline-next-heading))
(setq start-level (org-current-level))))
(narrow-to-region (region-beginning) (narrow-to-region (region-beginning)
(save-excursion (save-excursion
(goto-char (region-end)) (goto-char (region-end))
@ -13790,7 +13815,7 @@ a *different* entry, you cannot use these techniques."
(progn (progn
(org-prepare-agenda-buffers (org-prepare-agenda-buffers
(list (buffer-file-name (current-buffer)))) (list (buffer-file-name (current-buffer))))
(setq res (org-scan-tags func matcher))) (setq res (org-scan-tags func matcher nil start-level)))
;; Get the right scope ;; Get the right scope
(cond (cond
((and scope (listp scope) (symbolp (car scope))) ((and scope (listp scope) (symbolp (car scope)))