Function: org-make-tags-matcher

org-make-tags-matcher is a byte-compiled function defined in org.el.gz.

Signature

(org-make-tags-matcher MATCH &optional ONLY-LOCAL-TAGS)

Documentation

Create the TAGS/TODO matcher form for the selection string MATCH.

Returns a cons of the selection string MATCH and a function implementing the matcher.

The matcher is to be called at an Org entry, with point on the headline, and returns non-nil if the entry matches the selection string MATCH. It must be called with three arguments: the TODO keyword at the entry (or nil if none), the list of all tags at the entry including inherited ones and the reduced level of the headline. Additionally, the category of the entry, if any, must be specified as the text property org-category on the headline.

This function sets the variable org--matcher-tags-todo-only to a non-nil value if the matcher restricts matching to TODO entries, otherwise it is not touched.

When ONLY-LOCAL-TAGS is non-nil, ignore the global tag completion table, only get buffer tags.

See also org-scan-tags.

Source Code

;; Defined in /usr/src/emacs/lisp/org/org.el.gz
(defun org-make-tags-matcher (match &optional only-local-tags)
  "Create the TAGS/TODO matcher form for the selection string MATCH.

Returns a cons of the selection string MATCH and a function
implementing the matcher.

The matcher is to be called at an Org entry, with point on the
headline, and returns non-nil if the entry matches the selection
string MATCH.  It must be called with three arguments: the TODO
keyword at the entry (or nil if none), the list of all tags at
the entry including inherited ones and the reduced level of the
headline.  Additionally, the category of the entry, if any, must
be specified as the text property `org-category' on the headline.

This function sets the variable `org--matcher-tags-todo-only' to
a non-nil value if the matcher restricts matching to TODO
entries, otherwise it is not touched.

When ONLY-LOCAL-TAGS is non-nil, ignore the global tag completion
table, only get buffer tags.

See also `org-scan-tags'."
  (unless match
    ;; Get a new match request, with completion against the global
    ;; tags table and the local tags in current buffer.
    (let ((org-last-tags-completion-table
	   (org--tag-add-to-alist
	    (org-get-buffer-tags)
	    (unless only-local-tags
	      (org-global-tags-completion-table)))))
      (setq match
	    (completing-read
	     "Match: "
	     'org-tags-completion-function nil nil nil 'org-tags-history))))

  (let ((match0 match)
	(re (concat
	     "^&?\\([-+:]\\)?\\({[^}]+}\\|LEVEL\\([<=>]\\{1,2\\}\\)"
	     "\\([0-9]+\\)\\|\\(\\(?:[[:alnum:]_]+\\(?:\\\\-\\)*\\)+\\)"
	     "\\([<>=]\\{1,2\\}\\)"
	     "\\({[^}]+}\\|\"[^\"]*\"\\|-?[.0-9]+\\(?:[eE][-+]?[0-9]+\\)?\\)"
	     "\\|" org-tag-re "\\)"))
	(start 0)
	tagsmatch todomatch tagsmatcher todomatcher)

    ;; Expand group tags.
    (setq match (org-tags-expand match))

    ;; Check if there is a TODO part of this match, which would be the
    ;; part after a "/".  To make sure that this slash is not part of
    ;; a property value to be matched against, we also check that
    ;; there is no / after that slash.  First, find the last slash.
    (let ((s 0))
      (while (string-match "/+" match s)
	(setq start (match-beginning 0))
	(setq s (match-end 0))))
    (if (and (string-match "/+" match start)
	     (not (string-match-p "\"" match start)))
	;; Match contains also a TODO-matching request.
	(progn
	  (setq tagsmatch (substring match 0 (match-beginning 0)))
	  (setq todomatch (substring match (match-end 0)))
	  (when (string-prefix-p "!" todomatch)
	    (setq org--matcher-tags-todo-only t)
	    (setq todomatch (substring todomatch 1)))
	  (when (string-match "\\`\\s-*\\'" todomatch)
	    (setq todomatch nil)))
      ;; Only matching tags.
      (setq tagsmatch match)
      (setq todomatch nil))

    ;; Make the tags matcher.
    (when (org-string-nw-p tagsmatch)
      (let ((orlist nil)
	    (orterms (org-split-string tagsmatch "|"))
	    term)
	(while (setq term (pop orterms))
	  (while (and (equal (substring term -1) "\\") orterms)
	    (setq term (concat term "|" (pop orterms)))) ;repair bad split.
	  (while (string-match re term)
	    (let* ((rest (substring term (match-end 0)))
		   (minus (and (match-end 1)
			       (equal (match-string 1 term) "-")))
		   (tag (save-match-data
			  (replace-regexp-in-string
			   "\\\\-" "-" (match-string 2 term))))
		   (regexp (eq (string-to-char tag) ?{))
		   (levelp (match-end 4))
		   (propp (match-end 5))
		   (mm
		    (cond
		     (regexp `(org-match-any-p ,(substring tag 1 -1) tags-list))
		     (levelp
		      `(,(org-op-to-function (match-string 3 term))
			level
			,(string-to-number (match-string 4 term))))
		     (propp
		      (let* ((gv (pcase (upcase (match-string 5 term))
				   ("CATEGORY"
				    '(org-get-category (point)))
				   ("TODO" 'todo)
				   (p `(org-cached-entry-get nil ,p))))
			     (pv (match-string 7 term))
			     (regexp (eq (string-to-char pv) ?{))
			     (strp (eq (string-to-char pv) ?\"))
			     (timep (string-match-p "^\"[[<]\\(?:[0-9]+\\|now\\|today\\|tomorrow\\|[+-][0-9]+[dmwy]\\).*[]>]\"$" pv))
			     (po (org-op-to-function (match-string 6 term)
						     (if timep 'time strp))))
			(setq pv (if (or regexp strp) (substring pv 1 -1) pv))
			(when timep (setq pv (org-matcher-time pv)))
			(cond ((and regexp (eq po '/=))
			       `(not (string-match ,pv (or ,gv ""))))
			      (regexp `(string-match ,pv (or ,gv "")))
			      (strp `(,po (or ,gv "") ,pv))
			      (t
			       `(,po
				 (string-to-number (or ,gv ""))
				 ,(string-to-number pv))))))
		     (t `(member ,tag tags-list)))))
	      (push (if minus `(not ,mm) mm) tagsmatcher)
	      (setq term rest)))
	  (push `(and ,@tagsmatcher) orlist)
	  (setq tagsmatcher nil))
	(setq tagsmatcher `(progn (setq org-cached-props nil) (or ,@orlist)))))

    ;; Make the TODO matcher.
    (when (org-string-nw-p todomatch)
      (let ((orlist nil))
	(dolist (term (org-split-string todomatch "|"))
	  (while (string-match re term)
	    (let* ((minus (and (match-end 1)
			       (equal (match-string 1 term) "-")))
		   (kwd (match-string 2 term))
		   (regexp (eq (string-to-char kwd) ?{))
		   (mm (if regexp `(string-match ,(substring kwd 1 -1) todo)
			 `(equal todo ,kwd))))
	      (push (if minus `(not ,mm) mm) todomatcher))
	    (setq term (substring term (match-end 0))))
	  (push (if (> (length todomatcher) 1)
		    (cons 'and todomatcher)
		  (car todomatcher))
		orlist)
	  (setq todomatcher nil))
	(setq todomatcher (cons 'or orlist))))

    ;; Return the string and function of the matcher.  If no
    ;; tags-specific or todo-specific matcher exists, match
    ;; everything.
    (let ((matcher (if (and tagsmatcher todomatcher)
		       `(and ,tagsmatcher ,todomatcher)
		     (or tagsmatcher todomatcher t))))
      (when org--matcher-tags-todo-only
	(setq matcher `(and (member todo org-not-done-keywords) ,matcher)))
      (cons match0 `(lambda (todo tags-list level) ,matcher)))))