org.el/org-scan-tags: Make use of fast `org-element-cache-map'

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)))