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
(when (derived-mode-p 'org-mode)
(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)
(opre "[<=>]=?\\|[!/]=\\|<>")
(re (concat
"^"
;; implicit AND operator (OR is done by global splitting)
"&?"
;; exclusion and inclusion (the latter being implicit)
"\\(?1:[-+:]\\)?"
;; query term
"\\(?2:"
;; tag regexp match
"{[^}]+}\\|"
;; property match. Try to keep this subre generic
;; and rather handle special properties like LEVEL
;; and CATEGORY further below. This ensures that
;; the same quoting mechanics can be used for all
;; property names.
"\\(?:"
;; property name [1]
"\\(?5:\\(?:[[:alnum:]_]+\\|\\\\[^[:space:]]\\)+\\)"
;; operator, optionally starred
"\\(?6:" opre "\\)\\(?7:\\*\\)?"
;; operand (regexp, double-quoted string,
;; number)
"\\(?8:"
"{[^}]+}\\|"
"\"[^\"]*\"\\|"
"-?[.0-9]+\\(?:[eE][-+]?[0-9]+\\)?"
"\\)"
"\\)\\|"
;; exact tag match
org-tag-re
"\\)"))
(start 0)
tagsmatch todomatch tagsmatcher todomatcher)
;; [1] The history of this particular subre:
;; - \\([[:alnum:]_]+\\) [pre-19b0e03]
;; Does not allow for minus characters in property names.
;; - "\\(\\(?:[[:alnum:]_]+\\(?:\\\\-\\)*\\)+\\)" [19b0e03]
;; Incomplete fix of above issue, still resulting in, e.g.,
;; https://orgmode.org/list/87jzv67k3p.fsf@localhost.
;; - "\\(?5:[[:alnum:]_-]+\\)" [f689eb4]
;; Allows for unquoted minus characters in property names, but
;; conflicts with searches like -TAG-PROP="VALUE". See
;; https://orgmode.org/list/87h6oq2nu1.fsf@gmail.com.
;; - current subre
;; Like second solution, but with proper unquoting and allowing
;; for all possible characters in property names to be quoted.
;; 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) "-")))
;; Bind the whole query term to `tag' and use that
;; variable for a tag regexp match in [2] or as an
;; exact tag match in [3].
(tag (match-string 2 term))
(regexp (eq (string-to-char tag) ?{))
(propp (match-end 5))
(mm
(cond
(regexp ; [2]
`(with-syntax-table org-mode-tags-syntax-table
(org-match-any-p ,(substring tag 1 -1) tags-list)))
(propp
(let* (;; Determine property name.
(pn (upcase
(save-match-data
(replace-regexp-in-string
"\\\\\\(.\\)" "\\1"
(match-string 5 term)
t nil))))
;; Convert property name to an Elisp
;; accessor for that property (aka. as
;; getter value). Symbols LEVEL and TODO
;; referenced below get bound by the
;; matcher that this function returns.
(gv (pcase pn
("LEVEL"
'(number-to-string level))
("CATEGORY"
'(org-get-category (point)))
("TODO" 'todo)
(p `(org-entry-get (point) ,p 'selective))))
;; Determine operand (aka. property
;; value).
(pv (match-string 8 term))
;; Determine type of operand. Note that
;; these are not exclusive: Any TIMEP is
;; also STRP.
(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))
;; Massage operand. TIMEP must come
;; before STRP.
(pv (cond (regexp (substring pv 1 -1))
(timep (org-matcher-time
(substring pv 1 -1)))
(strp (substring pv 1 -1))
(t pv)))
;; Convert operator to Elisp.
(po (org-op-to-function (match-string 6 term)
(if timep 'time strp)))
;; Convert whole property term to Elisp.
(pt (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)))))
;; Respect the star after the operand.
(pt (if (match-end 7) `(and ,gv ,pt) pt)))
pt))
(t `(member ,tag tags-list))))) ; [3]
(push (if minus `(not ,mm) mm) tagsmatcher)
(setq term rest)))
(push `(and ,@tagsmatcher) orlist)
(setq tagsmatcher nil))
(setq tagsmatcher `(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
(byte-compile
`(lambda (todo tags-list level)
;; Pacify byte-compiler.
(ignore todo) (ignore tags-list) (ignore level)
,matcher))))))