|
|
@@ -11533,115 +11533,201 @@ headlines matching this string."
|
|
|
(when (eq action 'sparse-tree)
|
|
|
(org-overview)
|
|
|
(org-remove-occur-highlights))
|
|
|
- (while (let (case-fold-search)
|
|
|
- (re-search-forward re nil t))
|
|
|
- (setq org-map-continue-from nil)
|
|
|
- (catch :skip
|
|
|
- ;; Ignore closing parts of inline tasks.
|
|
|
- (when (and (fboundp 'org-inlinetask-end-p) (org-inlinetask-end-p))
|
|
|
- (throw :skip t))
|
|
|
- (setq todo (and (match-end 1) (match-string-no-properties 1)))
|
|
|
- (setq tags (and (match-end 4) (org-trim (match-string-no-properties 4))))
|
|
|
- (goto-char (setq lspos (match-beginning 0)))
|
|
|
- (setq level (org-reduced-level (org-outline-level))
|
|
|
- category (org-get-category))
|
|
|
- (when (eq action 'agenda)
|
|
|
- (setq ts-date-pair (org-agenda-entry-get-agenda-timestamp (point))
|
|
|
- ts-date (car ts-date-pair)
|
|
|
- ts-date-type (cdr ts-date-pair)))
|
|
|
- (setq i llast llast level)
|
|
|
- ;; remove tag lists from same and sublevels
|
|
|
- (while (>= i level)
|
|
|
- (when (setq entry (assoc i tags-alist))
|
|
|
- (setq tags-alist (delete entry tags-alist)))
|
|
|
- (setq i (1- i)))
|
|
|
- ;; add the next tags
|
|
|
- (when tags
|
|
|
- (setq tags (org-split-string tags ":")
|
|
|
- tags-alist
|
|
|
- (cons (cons level tags) tags-alist)))
|
|
|
- ;; compile tags for current headline
|
|
|
- (setq tags-list
|
|
|
- (if org-use-tag-inheritance
|
|
|
- (apply 'append (mapcar 'cdr (reverse tags-alist)))
|
|
|
- tags)
|
|
|
- org-scanner-tags tags-list)
|
|
|
- (when org-use-tag-inheritance
|
|
|
- (setcdr (car tags-alist)
|
|
|
- (mapcar (lambda (x)
|
|
|
- (setq x (copy-sequence x))
|
|
|
- (org-add-prop-inherited x))
|
|
|
- (cdar tags-alist))))
|
|
|
- (when (and tags org-use-tag-inheritance
|
|
|
- (or (not (eq t org-use-tag-inheritance))
|
|
|
- org-tags-exclude-from-inheritance))
|
|
|
- ;; Selective inheritance, remove uninherited ones.
|
|
|
- (setcdr (car tags-alist)
|
|
|
- (org-remove-uninherited-tags (cdar tags-alist))))
|
|
|
- (when (and
|
|
|
-
|
|
|
- ;; eval matcher only when the todo condition is OK
|
|
|
- (and (or (not todo-only) (member todo org-todo-keywords-1))
|
|
|
- (if (functionp matcher)
|
|
|
- (let ((case-fold-search t) (org-trust-scanner-tags t))
|
|
|
- (funcall matcher todo tags-list level))
|
|
|
- matcher))
|
|
|
-
|
|
|
- ;; Call the skipper, but return t if it does not
|
|
|
- ;; skip, so that the `and' form continues evaluating.
|
|
|
- (progn
|
|
|
- (unless (eq action 'sparse-tree) (org-agenda-skip))
|
|
|
- t)
|
|
|
-
|
|
|
- ;; Check if timestamps are deselecting this entry
|
|
|
- (or (not todo-only)
|
|
|
- (and (member todo org-todo-keywords-1)
|
|
|
- (or (not org-agenda-tags-todo-honor-ignore-options)
|
|
|
- (not (org-agenda-check-for-timestamp-as-reason-to-ignore-todo-item))))))
|
|
|
-
|
|
|
- ;; select this headline
|
|
|
- (cond
|
|
|
- ((eq action 'sparse-tree)
|
|
|
- (and org-highlight-sparse-tree-matches
|
|
|
- (org-get-heading) (match-end 0)
|
|
|
- (org-highlight-new-match
|
|
|
- (match-beginning 1) (match-end 1)))
|
|
|
- (org-show-context 'tags-tree))
|
|
|
- ((eq action 'agenda)
|
|
|
- (setq txt (org-agenda-format-item
|
|
|
- ""
|
|
|
- (concat
|
|
|
- (if (eq org-tags-match-list-sublevels 'indented)
|
|
|
- (make-string (1- level) ?.) "")
|
|
|
- (org-get-heading))
|
|
|
- (make-string level ?\s)
|
|
|
- category
|
|
|
- tags-list)
|
|
|
- priority (org-get-priority txt))
|
|
|
- (goto-char lspos)
|
|
|
- (setq marker (org-agenda-new-marker))
|
|
|
- (org-add-props txt props
|
|
|
- 'org-marker marker 'org-hd-marker marker 'org-category category
|
|
|
- 'todo-state todo
|
|
|
- 'ts-date ts-date
|
|
|
- 'priority priority
|
|
|
- 'type (concat "tagsmatch" ts-date-type))
|
|
|
- (push txt rtn))
|
|
|
- ((functionp action)
|
|
|
- (setq org-map-continue-from nil)
|
|
|
- (save-excursion
|
|
|
- (setq rtn1 (funcall action))
|
|
|
- (push rtn1 rtn)))
|
|
|
- (t (user-error "Invalid action")))
|
|
|
-
|
|
|
- ;; if we are to skip sublevels, jump to end of subtree
|
|
|
- (unless org-tags-match-list-sublevels
|
|
|
- (org-end-of-subtree t)
|
|
|
- (backward-char 1))))
|
|
|
- ;; Get the correct position from where to continue
|
|
|
- (if org-map-continue-from
|
|
|
- (goto-char org-map-continue-from)
|
|
|
- (and (= (point) lspos) (end-of-line 1)))))
|
|
|
+ (if (org-element--cache-active-p)
|
|
|
+ (let ((fast-re (concat "^"
|
|
|
+ (if start-level
|
|
|
+ ;; Get the correct level to match
|
|
|
+ (concat "\\*\\{" (number-to-string start-level) "\\} ")
|
|
|
+ org-outline-regexp))))
|
|
|
+ (org-element-cache-map
|
|
|
+ (lambda (el)
|
|
|
+ (goto-char (org-element-property :begin el))
|
|
|
+ (setq todo (org-element-property :todo-keyword el)
|
|
|
+ level (org-element-property :level el)
|
|
|
+ category (org-entry-get-with-inheritance "CATEGORY" nil el)
|
|
|
+ tags-list (org-get-tags el)
|
|
|
+ org-scanner-tags tags-list)
|
|
|
+ (when (eq action 'agenda)
|
|
|
+ (setq ts-date-pair (org-agenda-entry-get-agenda-timestamp (point))
|
|
|
+ ts-date (car ts-date-pair)
|
|
|
+ ts-date-type (cdr ts-date-pair)))
|
|
|
+ (catch :skip
|
|
|
+ (when (and
|
|
|
+
|
|
|
+ ;; eval matcher only when the todo condition is OK
|
|
|
+ (and (or (not todo-only) (member todo org-todo-keywords-1))
|
|
|
+ (if (functionp matcher)
|
|
|
+ (let ((case-fold-search t) (org-trust-scanner-tags t))
|
|
|
+ (funcall matcher todo tags-list level))
|
|
|
+ matcher))
|
|
|
+
|
|
|
+ ;; Call the skipper, but return t if it does not
|
|
|
+ ;; skip, so that the `and' form continues evaluating.
|
|
|
+ (progn
|
|
|
+ (unless (eq action 'sparse-tree) (org-agenda-skip el))
|
|
|
+ t)
|
|
|
+
|
|
|
+ ;; Check if timestamps are deselecting this entry
|
|
|
+ (or (not todo-only)
|
|
|
+ (and (member todo org-todo-keywords-1)
|
|
|
+ (or (not org-agenda-tags-todo-honor-ignore-options)
|
|
|
+ (not (org-agenda-check-for-timestamp-as-reason-to-ignore-todo-item))))))
|
|
|
+
|
|
|
+ ;; select this headline
|
|
|
+ (cond
|
|
|
+ ((eq action 'sparse-tree)
|
|
|
+ (and org-highlight-sparse-tree-matches
|
|
|
+ (org-get-heading) (match-end 0)
|
|
|
+ (org-highlight-new-match
|
|
|
+ (match-beginning 1) (match-end 1)))
|
|
|
+ (org-show-context 'tags-tree))
|
|
|
+ ((eq action 'agenda)
|
|
|
+ (setq txt (org-agenda-format-item
|
|
|
+ ""
|
|
|
+ (concat
|
|
|
+ (if (eq org-tags-match-list-sublevels 'indented)
|
|
|
+ (make-string (1- level) ?.) "")
|
|
|
+ (org-get-heading))
|
|
|
+ (make-string level ?\s)
|
|
|
+ category
|
|
|
+ tags-list)
|
|
|
+ priority (org-get-priority txt))
|
|
|
+ (goto-char (org-element-property :begin el))
|
|
|
+ (setq marker (org-agenda-new-marker))
|
|
|
+ (org-add-props txt props
|
|
|
+ 'org-marker marker 'org-hd-marker marker 'org-category category
|
|
|
+ 'todo-state todo
|
|
|
+ 'ts-date ts-date
|
|
|
+ 'priority priority
|
|
|
+ 'type (concat "tagsmatch" ts-date-type))
|
|
|
+ (push txt rtn))
|
|
|
+ ((functionp action)
|
|
|
+ (setq org-map-continue-from nil)
|
|
|
+ (save-excursion
|
|
|
+ (setq rtn1 (funcall action))
|
|
|
+ (push rtn1 rtn)))
|
|
|
+ (t (user-error "Invalid action")))
|
|
|
+
|
|
|
+ ;; if we are to skip sublevels, jump to end of subtree
|
|
|
+ (unless org-tags-match-list-sublevels
|
|
|
+ (goto-char (1- (org-element-property :end el))))))
|
|
|
+ ;; Get the correct position from where to continue
|
|
|
+ (when org-map-continue-from
|
|
|
+ (goto-char org-map-continue-from))
|
|
|
+ ;; Return nil.
|
|
|
+ nil)
|
|
|
+ :next-re fast-re
|
|
|
+ :fail-re fast-re
|
|
|
+ :narrow t))
|
|
|
+ (while (let (case-fold-search)
|
|
|
+ (re-search-forward re nil t))
|
|
|
+ (setq org-map-continue-from nil)
|
|
|
+ (catch :skip
|
|
|
+ ;; Ignore closing parts of inline tasks.
|
|
|
+ (when (and (fboundp 'org-inlinetask-end-p) (org-inlinetask-end-p))
|
|
|
+ (throw :skip t))
|
|
|
+ (setq todo (and (match-end 1) (match-string-no-properties 1)))
|
|
|
+ (setq tags (and (match-end 4) (org-trim (match-string-no-properties 4))))
|
|
|
+ (goto-char (setq lspos (match-beginning 0)))
|
|
|
+ (setq level (org-reduced-level (org-outline-level))
|
|
|
+ category (org-get-category))
|
|
|
+ (when (eq action 'agenda)
|
|
|
+ (setq ts-date-pair (org-agenda-entry-get-agenda-timestamp (point))
|
|
|
+ ts-date (car ts-date-pair)
|
|
|
+ ts-date-type (cdr ts-date-pair)))
|
|
|
+ (setq i llast llast level)
|
|
|
+ ;; remove tag lists from same and sublevels
|
|
|
+ (while (>= i level)
|
|
|
+ (when (setq entry (assoc i tags-alist))
|
|
|
+ (setq tags-alist (delete entry tags-alist)))
|
|
|
+ (setq i (1- i)))
|
|
|
+ ;; add the next tags
|
|
|
+ (when tags
|
|
|
+ (setq tags (org-split-string tags ":")
|
|
|
+ tags-alist
|
|
|
+ (cons (cons level tags) tags-alist)))
|
|
|
+ ;; compile tags for current headline
|
|
|
+ (setq tags-list
|
|
|
+ (if org-use-tag-inheritance
|
|
|
+ (apply 'append (mapcar 'cdr (reverse tags-alist)))
|
|
|
+ tags)
|
|
|
+ org-scanner-tags tags-list)
|
|
|
+ (when org-use-tag-inheritance
|
|
|
+ (setcdr (car tags-alist)
|
|
|
+ (mapcar (lambda (x)
|
|
|
+ (setq x (copy-sequence x))
|
|
|
+ (org-add-prop-inherited x))
|
|
|
+ (cdar tags-alist))))
|
|
|
+ (when (and tags org-use-tag-inheritance
|
|
|
+ (or (not (eq t org-use-tag-inheritance))
|
|
|
+ org-tags-exclude-from-inheritance))
|
|
|
+ ;; Selective inheritance, remove uninherited ones.
|
|
|
+ (setcdr (car tags-alist)
|
|
|
+ (org-remove-uninherited-tags (cdar tags-alist))))
|
|
|
+ (when (and
|
|
|
+
|
|
|
+ ;; eval matcher only when the todo condition is OK
|
|
|
+ (and (or (not todo-only) (member todo org-todo-keywords-1))
|
|
|
+ (if (functionp matcher)
|
|
|
+ (let ((case-fold-search t) (org-trust-scanner-tags t))
|
|
|
+ (funcall matcher todo tags-list level))
|
|
|
+ matcher))
|
|
|
+
|
|
|
+ ;; Call the skipper, but return t if it does not
|
|
|
+ ;; skip, so that the `and' form continues evaluating.
|
|
|
+ (progn
|
|
|
+ (unless (eq action 'sparse-tree) (org-agenda-skip))
|
|
|
+ t)
|
|
|
+
|
|
|
+ ;; Check if timestamps are deselecting this entry
|
|
|
+ (or (not todo-only)
|
|
|
+ (and (member todo org-todo-keywords-1)
|
|
|
+ (or (not org-agenda-tags-todo-honor-ignore-options)
|
|
|
+ (not (org-agenda-check-for-timestamp-as-reason-to-ignore-todo-item))))))
|
|
|
+
|
|
|
+ ;; select this headline
|
|
|
+ (cond
|
|
|
+ ((eq action 'sparse-tree)
|
|
|
+ (and org-highlight-sparse-tree-matches
|
|
|
+ (org-get-heading) (match-end 0)
|
|
|
+ (org-highlight-new-match
|
|
|
+ (match-beginning 1) (match-end 1)))
|
|
|
+ (org-show-context 'tags-tree))
|
|
|
+ ((eq action 'agenda)
|
|
|
+ (setq txt (org-agenda-format-item
|
|
|
+ ""
|
|
|
+ (concat
|
|
|
+ (if (eq org-tags-match-list-sublevels 'indented)
|
|
|
+ (make-string (1- level) ?.) "")
|
|
|
+ (org-get-heading))
|
|
|
+ (make-string level ?\s)
|
|
|
+ category
|
|
|
+ tags-list)
|
|
|
+ priority (org-get-priority txt))
|
|
|
+ (goto-char lspos)
|
|
|
+ (setq marker (org-agenda-new-marker))
|
|
|
+ (org-add-props txt props
|
|
|
+ 'org-marker marker 'org-hd-marker marker 'org-category category
|
|
|
+ 'todo-state todo
|
|
|
+ 'ts-date ts-date
|
|
|
+ 'priority priority
|
|
|
+ 'type (concat "tagsmatch" ts-date-type))
|
|
|
+ (push txt rtn))
|
|
|
+ ((functionp action)
|
|
|
+ (setq org-map-continue-from nil)
|
|
|
+ (save-excursion
|
|
|
+ (setq rtn1 (funcall action))
|
|
|
+ (push rtn1 rtn)))
|
|
|
+ (t (user-error "Invalid action")))
|
|
|
+
|
|
|
+ ;; if we are to skip sublevels, jump to end of subtree
|
|
|
+ (unless org-tags-match-list-sublevels
|
|
|
+ (org-end-of-subtree t)
|
|
|
+ (backward-char 1))))
|
|
|
+ ;; Get the correct position from where to continue
|
|
|
+ (if org-map-continue-from
|
|
|
+ (goto-char org-map-continue-from)
|
|
|
+ (and (= (point) lspos) (end-of-line 1))))))
|
|
|
(when (and (eq action 'sparse-tree)
|
|
|
(not org-sparse-tree-open-archived-trees))
|
|
|
(org-hide-archived-subtrees (point-min) (point-max)))
|
Ihor Radchenko