org.el/org-scan-tags: Make use of fast `org-element-cache-map'
This commit is contained in:
Ihor Radchenko
parent
85e0a69567
commit
3c4290e668
294
lisp/org.el
294
lisp/org.el
|
|
@ -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
|
||||
(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))
|
||||
;; 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)
|
||||
;; 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))))))
|
||||
;; 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")))
|
||||
;; 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
|
||||
(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 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)))
|
||||
|
|
|
|||
Loading…
Reference in New Issue