Add: (link) predicate

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=.

org-ql.el

@@ -3,7 +3,7 @@
 ;; Author: Adam Porter <adam@alphapapa.net>
 ;; 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

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: Ancestor/descendant predicates15674
-Node: Date/time predicates16394
+Node: Date/time predicates16802
-Node: Functions / Macros19049
+Node: Functions / Macros19457
-Node: Agenda-like views19282
+Node: Agenda-like views19690
-Node: Listing / acting-on results20687
+Node: Listing / acting-on results21095
-Node: Changelog25289
+Node: Changelog25697
-Node: 05-pre25853
+Node: 05-pre26261
-Node: 04126121
+Node: 04126610
-Node: 0426363
+Node: 0426852
-Node: 03230294
+Node: 03230783
-Node: 03130671
+Node: 03131160
-Node: 0330866
+Node: 0331355
-Node: 02333839
+Node: 02334328
-Node: 02234065
+Node: 02234554
-Node: 02134331
+Node: 02134820
-Node: 0234528
+Node: 0235017
-Node: 0138563
+Node: 0139052
-Node: Notes38664
+Node: Notes39153
-Node: Comparison with Org Agenda searches38826
+Node: Comparison with Org Agenda searches39315
-Node: org-sidebar39698
+Node: org-sidebar40187
-Node: License39977
+Node: License40466
 
 End Tag Table
 

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:

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