jiri/org-ql
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Add: (link) predicate

Browse source
This commit is contained in:
Adam Porter 2020-02-23 22:58:08 -06:00
parent 5d720b9fc3
commit 9a56141f6c
5 changed files with 204 additions and 22 deletions
Download patch file Download diff file Expand all files Collapse all files

2
README.org
View file

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

141
org-ql.el
View file

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

50
org-ql.info
View file

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

2
tests/data.org
View file

@ -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:

31
tests/test-org-ql.el
View file

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