[elpa] externals/org 3c4290e 21/29: org.el/org-scan-tags: Make use of fast `org-element-cache-map'

[ELPA Syncer]

branch: externals/org
commit 3c4290e668b15c64e6d48b1926291987742476e8
Author: Ihor Radchenko <yantar92@gmail.com>
Commit: Ihor Radchenko <yantar92@gmail.com>

    org.el/org-scan-tags: Make use of fast `org-element-cache-map'
---
 lisp/org.el | 304 ++++++++++++++++++++++++++++++++++++++----------------------
 1 file changed, 195 insertions(+), 109 deletions(-)

diff --git a/lisp/org.el b/lisp/org.el
index 5256fa4..2dde75d 100644
--- a/lisp/org.el
+++ b/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
-
-                ;; 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)))