From 9a56141f6c2ff2b8c6f92f93a218f4935b8f0335 Mon Sep 17 00:00:00 2001 From: Adam Porter Date: Sun, 23 Feb 2020 22:58:08 -0600 Subject: [PATCH] Add: (link) predicate --- README.org | 2 + org-ql.el | 141 ++++++++++++++++++++++++++++++++++++++++++- org-ql.info | 50 ++++++++------- tests/data.org | 2 + tests/test-org-ql.el | 31 ++++++++++ 5 files changed, 204 insertions(+), 22 deletions(-) diff --git a/README.org b/README.org index d72776a..21f48fe 100644 --- a/README.org +++ b/README.org @@ -198,6 +198,7 @@ Arguments are listed next to predicate names, where applicable. + =heading (&rest regexps)= :: Return non-nil if current entry's heading matches all ~REGEXPS~ (regexp strings). - Aliases: =h=. + =level (level-or-comparator &optional level)= :: Return non-nil if current heading's outline level matches arguments. The following forms are accepted: ~(level NUMBER)~: Matches if heading level is ~NUMBER~. ~(level NUMBER NUMBER)~: Matches if heading level is equal to or between NUMBERs. ~(level COMPARATOR NUMBER)~: Matches if heading level compares to ~NUMBER~ with ~COMPARATOR~. ~COMPARATOR~ may be ~<~, ~<=~, ~>~, or ~>=~. ++ =link (&optional description-or-target &key description target regexp-p)= :: Return non-nil if current heading contains a link matching arguments. ~DESCRIPTION-OR-TARGET~ is matched against the link's description and target. Alternatively, one or both of ~DESCRIPTION~ and ~TARGET~ may be matched separately. Without arguments, return non-nil if any link is found. + =outline-path (&rest strings)= :: Return non-nil if current node's outline path matches all of ~STRINGS~. Each string may appear as a substring in any part of the node's outline path. For example, the path =Food/Fruits/Grapes= would match ~(olp "Fruit" "Grape")~. - Aliases: ~olp~. + =outline-path-segment (&rest strings)= :: Return non-nil if current node's outline path matches ~STRINGS~. Matches ~STRINGS~ as a contiguous segment of the outline path. Each string is compared as a substring. For example the path ~Food/Fruits/Grapes~ would match ~(olps "Fruit" "Grape")~ but not ~(olps "Food" "Grape")~. @@ -404,6 +405,7 @@ Expands into a call to ~org-ql-select~ with the same arguments. For convenience *Added* + View dispatcher using =transient.el= (like Magit), bound to =v= in search/view buffers. ++ Predicate =link=, which matches descriptions and targets in Org links. *Changed* + Binding to refresh search/view buffers changed to =r=. diff --git a/org-ql.el b/org-ql.el index 0af9c5f..0853659 100644 --- a/org-ql.el +++ b/org-ql.el @@ -3,7 +3,7 @@ ;; Author: Adam Porter ;; Url: https://github.com/alphapapa/org-ql ;; Version: 0.5-pre -;; Package-Requires: ((emacs "26.1") (dash "2.13") (dash-functional "1.2.0") (f "0.17.2") (org "9.0") (org-super-agenda "1.2-pre") (ov "1.0.6") (peg "0.6") (s "1.12.0") (transient "0.1") (ts "0.2-pre")) +;; Package-Requires: ((emacs "26.1") (dash "2.13") (dash-functional "1.2.0") (f "0.17.2") (map "2.1") (org "9.0") (org-super-agenda "1.2-pre") (ov "1.0.6") (peg "0.6") (s "1.12.0") (transient "0.1") (ts "0.2-pre")) ;; Keywords: hypermedia, outlines, Org, agenda ;;; Commentary: @@ -73,6 +73,25 @@ That is, \"CLOSED:\", \"DEADLINE:\", or \"SCHEDULED:\".") Tags are stored in match group 1. Match group 2 stores the tags without the enclosing colons.") +(defconst org-ql-link-regexp + (if (bound-and-true-p org-link-bracket-re) + org-link-bracket-re + org-bracket-link-regexp) + "Regexp used to match Org bracket links. +Necessary because of changes in Org 9.something.") + +(defconst org-ql-link-description-group + (if (bound-and-true-p org-link-bracket-re) + 2 + 3) + ;; I wish Org would not introduce backward-incompatible changes like this in + ;; minor releases. It requires awkward workarounds to be maintained for years. + "Regexp match group used to extract description from Org bracket links. +Necessary because of backward-incompatible changes in Org +9.something: when `org-link-bracket-re' was added, +`org-bracket-link-regexp' was marked as an obsolete alias for it, +but the match groups were changed, so they are not compatible.") + ;;;; Variables (defvar org-ql--today nil) @@ -727,6 +746,40 @@ replace the clause with a preamble." (setq org-ql-preamble (rx-to-string `(seq bol (repeat ,num "*") " ") t)) nil) + ;; Links. Always return nil, because we + ;; shouldn't need to test the predicate. + (`(link) + (setq org-ql-preamble + ;; Match a link with a target and optionally a description. + (rx (or bol (1+ blank)) + "[[" (1+ (not (any "]"))) "]" + (optional (seq "[" (0+ (not (any "]"))) "]")) + "]" + (or eol blank))) + nil) + ;; NOTE: I would use the form "(map :regexp-p)", or at least + ;; "(map (:regexp-p regexp))" but they require map versions from + ;; ELPA. That would be fine, except that I can't automatically + ;; install those versions with makem.sh into a sandbox, because + ;; `package-install' doesn't accept a version argument. So I + ;; have to use `plist-get' here for now. Maybe when we drop + ;; support for Emacs <28... + (`(link ,(and description-or-target + (guard (not (keywordp description-or-target))))) + (setq org-ql-preamble + (org-ql--link-regexp :description-or-target + (regexp-quote description-or-target))) + nil) + (`(link . ,plist) + (setq org-ql-preamble + (org-ql--link-regexp + :description + (when (plist-get plist :description) + (regexp-quote (plist-get plist :description))) + :target (when (plist-get plist :target) + (regexp-quote (plist-get plist :target))))) + nil) + ;; Planning lines. (`(planning . ,_) (setq org-ql-preamble org-ql-planning-regexp) @@ -838,6 +891,47 @@ replace the clause with a preamble." (query (-flatten-n 1 query)))) (list :query query :preamble org-ql-preamble :preamble-case-fold preamble-case-fold)))))) +(cl-defun org-ql--link-regexp (&key description-or-target description target) + "Return a regexp matching Org links according to arguments. +Each argument is treated as a regexp (so non-regexp strings +should be quoted before being passed to this function). If +DESCRIPTION-OR-TARGET, match it in either description or target. +If DESCRIPTION, match it in the description. If TARGET, match it +in the target. If both DESCRIPTION and TARGET, match both, +respectively." + (cl-labels + ((no-desc + (match) (rx-to-string `(seq (or bol (1+ blank)) + "[[" (0+ (not (any "]"))) (regexp ,match) (0+ (not (any "]"))) + "]]"))) + (match-both + (description target) + (rx-to-string `(seq (or bol (1+ blank)) + "[[" (0+ (not (any "]"))) (regexp ,target) (0+ (not (any "]"))) + "][" (0+ (not (any "]"))) (regexp ,description) (0+ (not (any "]"))) + "]]"))) + ;; Note that these actually allow empty descriptions + ;; or targets, depending on what they are matching. + (match-desc + (match) (rx-to-string `(seq (or bol (1+ blank)) + "[[" (0+ (not (any "]"))) + "][" (0+ (not (any "]"))) (regexp ,match) (0+ (not (any "]"))) + "]]"))) + (match-target + (match) (rx-to-string `(seq (or bol (1+ blank)) + "[[" (0+ (not (any "]"))) (regexp ,match) (0+ (not (any "]"))) + "][" (0+ (not (any "]"))) + "]]")))) + (cond (description-or-target + (rx-to-string `(or (regexp ,(no-desc description-or-target)) + (regexp ,(match-desc description-or-target)) + (regexp ,(match-target description-or-target))))) + ((and description target) + (match-both description target)) + (description (match-desc description)) + (target (rx-to-string `(or (regexp ,(no-desc target)) + (regexp ,(match-target target)))))))) + (defun org-ql--format-src-block-regexp (&optional lang) "Return regexp equivalent to `org-babel-src-block-regexp' with LANG filled in." ;; I couldn't find a way to match block contents without the regexp @@ -1073,6 +1167,51 @@ COMPARATOR may be `<', `<=', `>', or `>='." ((pred symbolp) ;; Compare with function (funcall level-or-comparator outline-level level))))) +(org-ql--defpred link (&rest args) + ;; User-facing argument form: (&optional description-or-target &key description target regexp-p). + "Return non-nil if current heading contains a link matching arguments. +DESCRIPTION-OR-TARGET is matched against the link's description +and target. Alternatively, one or both of DESCRIPTION and TARGET +may be matched separately. Without arguments, return non-nil if +any link is found." + ;; NOTE: It would be preferable to avoid this manual argument parsing every time the predicate + ;; is called, but pre-processing it to a normal form gets complicated with the preamble and + ;; pre-processing, because we don't want to display a query like "(link :description-or-target + ;; "FOO")" in the view header, which would be ugly. So, since preambles are expected to be + ;; enabled nearly all of the time, in which case this function won't be called anyway, it's + ;; probably not worth rewriting code all over the place to fix this. + (let* (plist description-or-target description target regexp-p) + (if (not (keywordp (car args))) + (setf description-or-target (car args) + plist (cdr args)) + (setf plist args)) + (setf description (plist-get plist :description) + target (plist-get plist :description) + regexp-p (plist-get plist :regexp-p)) + (unless regexp-p + ;; NOTE: It would also be preferable to avoid regexp-quoting every time this predicate + ;; is called. Ideally that would be handled in the query pre-processing step. However, + ;; handling that properly, in combination with preparing the query preamble and whether + ;; REGEXP-P is enabled, is also complicated, so let's not. + (when description-or-target + (setf description-or-target (regexp-quote description-or-target))) + (when description + (setf description (regexp-quote description))) + (when target + (setf target (regexp-quote target)))) + (when (re-search-forward org-ql-link-regexp (org-entry-end-position) t) + (pcase description-or-target + ('nil (and (or (null target) + (string-match-p target (match-string 1))) + (or (null description) + (string-match-p description (match-string org-ql-link-description-group))))) + (_ (if (and description target) + (and (string-match-p target (match-string 1)) + (string-match-p description (match-string org-ql-link-description-group))) + (or (string-match-p description-or-target (match-string 1)) + (string-match-p description-or-target + (match-string org-ql-link-description-group))))))))) + (org-ql--defpred priority (&rest args) "Return non-nil if current heading has a certain priority. ARGS may be either a list of one or more priority letters as diff --git a/org-ql.info b/org-ql.info index d20b262..10b5e6e 100644 --- a/org-ql.info +++ b/org-ql.info @@ -381,6 +381,12 @@ Arguments are listed next to predicate names, where applicable. Matches if heading level is equal to or between NUMBERs. ‘(level COMPARATOR NUMBER)’: Matches if heading level compares to ‘NUMBER’ with ‘COMPARATOR’. ‘COMPARATOR’ may be ‘<’, ‘<=’, ‘>’, or ‘>=’. +‘link (&optional description-or-target &key description target regexp-p)’ + Return non-nil if current heading contains a link matching + arguments. ‘DESCRIPTION-OR-TARGET’ is matched against the link’s + description and target. Alternatively, one or both of + ‘DESCRIPTION’ and ‘TARGET’ may be matched separately. Without + arguments, return non-nil if any link is found. ‘outline-path (&rest strings)’ Return non-nil if current node’s outline path matches all of ‘STRINGS’. Each string may appear as a substring in any part of @@ -732,6 +738,8 @@ File: README.info, Node: 05-pre, Next: 041, Up: Changelog *Added* • View dispatcher using transient.el (like Magit), bound to v in search/view buffers. + • Predicate link, which matches descriptions and targets in Org + links. *Changed* • Binding to refresh search/view buffers changed to r. @@ -1105,27 +1113,27 @@ Node: org-ql-sparse-tree7044 Node: Queries7844 Node: Non-sexp query syntax8752 Node: General predicates10459 -Node: Ancestor/descendant predicates15266 -Node: Date/time predicates16394 -Node: Functions / Macros19049 -Node: Agenda-like views19282 -Node: Listing / acting-on results20687 -Node: Changelog25289 -Node: 05-pre25853 -Node: 04126121 -Node: 0426363 -Node: 03230294 -Node: 03130671 -Node: 0330866 -Node: 02333839 -Node: 02234065 -Node: 02134331 -Node: 0234528 -Node: 0138563 -Node: Notes38664 -Node: Comparison with Org Agenda searches38826 -Node: org-sidebar39698 -Node: License39977 +Node: Ancestor/descendant predicates15674 +Node: Date/time predicates16802 +Node: Functions / Macros19457 +Node: Agenda-like views19690 +Node: Listing / acting-on results21095 +Node: Changelog25697 +Node: 05-pre26261 +Node: 04126610 +Node: 0426852 +Node: 03230783 +Node: 03131160 +Node: 0331355 +Node: 02334328 +Node: 02234554 +Node: 02134820 +Node: 0235017 +Node: 0139052 +Node: Notes39153 +Node: Comparison with Org Agenda searches39315 +Node: org-sidebar40187 +Node: License40466  End Tag Table diff --git a/tests/data.org b/tests/data.org index 1f618ca..b7a13cb 100644 --- a/tests/data.org +++ b/tests/data.org @@ -91,6 +91,8 @@ Gotta buy one first, though. ** CHECK /r/emacs :website:Emacs: DEADLINE: <2017-07-05 Wed +1w> ++ [[http://reddit.com/r/emacs][Link to /r/emacs]] + ** TODO Shop for groceries :food:shopping:@town: SCHEDULED: <2017-07-05 Wed +1w> :PROPERTIES: diff --git a/tests/test-org-ql.el b/tests/test-org-ql.el index bf2340f..605d32a 100644 --- a/tests/test-org-ql.el +++ b/tests/test-org-ql.el @@ -217,6 +217,7 @@ RESULTS should be a list of strings as returned by :to-equal org-ql-test-num-headings))) (describe "Query pre-processing" + (it "level:" (expect (org-ql--pre-process-query '(level "1")) :to-equal '(level 1)) @@ -225,6 +226,19 @@ RESULTS should be a list of strings as returned by (expect (org-ql--pre-process-query '(level ">" "1")) :to-equal '(level > 1))) + (describe "(link)" + (it "with one argument" + (expect (org-ql--pre-process-query '(link "DESC-OR-TARGET")) + :to-equal '(link "DESC-OR-TARGET"))) + (it "with one argument and :regexp-p" + (expect (org-ql--pre-process-query '(link "DESC-OR-TARGET" :regexp-p t)) + :to-equal '(link "DESC-OR-TARGET" :regexp-p t))) + (it "with keyword arguments" + (expect (org-ql--pre-process-query '(link :description "DESCRIPTION" :target "TARGET" + :regexp-p t)) + :to-equal '(link :description "DESCRIPTION" :target "TARGET" + :regexp-p t)))) + (expect (org-ql--pre-process-query '(and "string1" "string2")) :to-equal '(and (regexp "string1") (regexp "string2"))) (expect (org-ql--pre-process-query '(or "string1" "string2")) @@ -575,6 +589,23 @@ RESULTS should be a list of strings as returned by (org-ql-expect ((heading "Take over" "world")) '("Take over the world")))) + (describe "(link)" + (org-ql-it "without arguments" + (org-ql-expect ((link)) + '("/r/emacs"))) + (org-ql-it "with description-or-target" + (org-ql-expect ((link "emacs")) + '("/r/emacs"))) + (org-ql-it "with :description" + (org-ql-expect ((link :description "emacs")) + '("/r/emacs"))) + (org-ql-it "with :target" + (org-ql-expect ((link :target "reddit.com")) + '("/r/emacs"))) + (org-ql-it "with :description and :target" + (org-ql-expect ((link :description "emacs" :target "reddit.com")) + '("/r/emacs")))) + (describe "(outline-path)" (org-ql-it "with one argument" (org-ql-expect ((outline-path "symphony"))