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

Change/Fix: Require peg 1.0, fix variable binding depth errors

Browse source 
Had to (and needed to, anyway) use peg-1.0.  And while this does less
macro magic, and less magic with cl-eval-when, I couldn't get around
using eval.  I wish peg had a function that takes a list of rules and
returns a predicate that matches a string or at point.  (I tried to
work around the lack of that by using parts of peg macros, but it's
very complicated, and everything I tried had one problem or another.)
This commit is contained in:
Adam Porter 2020-11-24 11:20:59 -06:00
parent 890c24786a
commit 014d49f416
3 changed files with 101 additions and 113 deletions
Download patch file Download diff file Expand all files Collapse all files

1
README.org
View file

@ -524,6 +524,7 @@ Simple links may also be written manually in either sexp or non-sexp form, like:
*Internal*
+ Predicates are now defined more cleanly with a macro (=org-ql-defpred=) that consolidates functionality related to each predicate. This will also allow users to more easily define custom predicates.
+ Version 1.0 of library ~peg~ is now required.
** 0.5

108
org-ql.el
View file

@ -3,7 +3,7 @@
;; Author: Adam Porter <adam@alphapapa.net>
;; Url: https://github.com/alphapapa/org-ql
;; Version: 0.6-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") (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") (ov "1.0.6") (peg "1.0") (s "1.12.0") (transient "0.1") (ts "0.2-pre"))
;; Keywords: hypermedia, outlines, Org, agenda
;;; Commentary:
@ -671,38 +671,10 @@ Arguments STRING, POS, FILL, and LEVEL are according to
(require 'peg)
;; Fix compiler warnings probably caused by `peg' not using lexical-binding.
;; TODO: File bug report upstream.
(defvar peg-errors nil)
(defvar peg-stack nil)
(defmacro org-ql--peg-parse-string (rules string &optional noerror)
"Parse STRING according to RULES."
;; This sentence was in the docstring but Checkdoc is complaining,
;; so moving it to a comment: "If NOERROR is non-nil, push nil
;; resp. t if the parse failed resp. succeded instead of signaling
;; an error."
;; Unfortunately, this macro was moved to peg-tests.el, so we copy it here.
`(with-temp-buffer
(insert ,string)
(goto-char (point-min))
,(if noerror
(let ((entry (make-symbol "entry"))
(start (caar rules)))
`(peg-parse (,entry (or (and ,start `(-- t)) ""))
. ,rules))
`(peg-parse . ,rules))))
(cl-eval-when (compile load eval)
;; This `eval-when' is necessary, otherwise the macro does not define
;; the function correctly, apparently because `org-ql-predicates'
;; ends up being not defined correctly at expansion time.
(defun org-ql--def-query-string-to-sexp-fn (predicates)
(defun org-ql--def-query-string-to-sexp-fn (predicates)
"Define function `org-ql--query-string-to-sexp' according to PREDICATES.
Builds the PEG expression using PREDICATES (which should be the
value of `org-ql-predicates')."
Builds the PEG expression using PREDICATES (which should be the
value of `org-ql-predicates')."
(let* ((names (--map (symbol-name (plist-get (cdr it) :name))
predicates))
(aliases (->> predicates
@ -710,21 +682,13 @@ value of `org-ql-predicates')."
-non-nil
-flatten
(-map #'symbol-name)))
(predicates (->> (append names aliases)
(predicate-names (->> (append names aliases)
-uniq
;; Sort the keywords longest-first to work around what seems to be an
;; obscure bug in `peg': when one keyword is a substring of another,
;; and the shorter one is listed first, the shorter one fails to match.
(-sort (-on #'> #'length)))))
(fset 'org-ql--query-string-to-sexp
(byte-compile
`(cl-function
(lambda (input &optional (boolean 'and))
"Return query parsed from plain query string INPUT.
Multiple predicates are combined with BOOLEAN."
(unless (s-blank-str? input)
(let* ((query (org-ql--peg-parse-string
((query (+ term
(-sort (-on #'> #'length))))
(pexs `((query (+ term
(opt (+ (syntax-class whitespace) (any)))))
(term (or (and negation (list positive-term)
;; This is a bit confusing, but it seems to work. There's probably a better way.
@ -736,23 +700,47 @@ Multiple predicates are combined with BOOLEAN."
(plain-string (or quoted-arg unquoted-arg))
(predicate-with-args (substring predicate) ":" args)
(predicate-without-args (substring predicate) ":")
(predicate (or ,@predicates))
(predicate (or ,@predicate-names))
(args (list (+ (and (or keyword-arg quoted-arg unquoted-arg) (opt separator)))))
(keyword-arg (and keyword "=" `(kw -- (intern (concat ":" kw)))))
(keyword (substring (+ (not (or separator "=" "\"" (syntax-class whitespace))) (any))))
(quoted-arg "\"" (substring (+ (not (or separator "\"")) (any))) "\"")
(unquoted-arg (substring (+ (not (or separator "\"" (syntax-class whitespace))) (any))))
(negation "!")
(separator "," ))
input 'noerror)))
;; Discard the t that `peg-parse-string' always returns as the first
;; element. I don't know what it means, but we don't want it.
(if (> (length (cdr query)) 1)
(cons boolean (nreverse (cdr query)))
(cadr query)))))))))))
(separator "," )))
(closure (lambda (input &optional boolean)
"Return query parsed from plain query string INPUT.
Multiple predicate-names are combined with BOOLEAN (default: `and')."
;; HACK: Silence unused lexical variable warnings.
(ignore predicates predicate-names names aliases)
(unless (s-blank-str? input)
(let* ((boolean (or boolean 'and))
(parsed-sexp
(with-temp-buffer
(insert input)
(goto-char (point-min))
;; Copied from `peg-parse'. There is no function in `peg' that
;; returns a matcher function--every entry point is a macro,
;; which means that, since we define our PEG rules at runtime when
;; predicate-names are defined, we either have to use `eval', or we
;; have to borrow some code. It ends up that we only have to
;; borrow this `with-peg-rules' call, which isn't too bad.
(eval `(with-peg-rules ,pexs
(peg-run (peg ,(caar pexs)) #'peg-signal-failure)))
)))
(pcase parsed-sexp
(`(,one-predicate) one-predicate)
(`(,_ . ,_) (cons boolean (reverse parsed-sexp)))
(_ nil)))))))
(fset 'org-ql--query-string-to-sexp closure)))
;;;;; Predicate definition
;; HACK: These functions *will* be defined at runtime, so we silence
;; compiler warnings about them:
(declare-function org-ql--normalize-query "org-ql" (query) t)
(declare-function org-ql--query-preamble "org-ql" (query) t)
(defvar org-ql-defpred-defer nil
"Defer expensive function redefinitions when defining predicates.
When non-nil, defining a predicate with `org-ql-defpred' does not
@ -961,11 +949,10 @@ It would be expanded to:
(preambles (cl-sublis (list (cons 'predicate-names (cons 'or (--map (list 'quote it) predicate-names))))
preambles)))
`(progn
(cl-eval-when (compile load eval)
(cl-defun ,fn-name ,args ,docstring ,body))
(cl-defun ,fn-name ,args ,docstring ,body)
;; SOMEDAY: Use `map-elt' here, after map 2.1 can be automatically installed in CI sandbox...
(setf (alist-get ',predicate-name org-ql-predicates)
`(:name ,',name :aliases ,',aliases :fn ,',fn-name :docstring ,,docstring :args ,',args
`(:name ,',name :aliases ,',aliases :fn ,',fn-name :docstring ,(\, docstring) :args ,',args
:normalizers ,',normalizers :preambles ,',preambles))
(unless org-ql-defpred-defer
;; Reversing preserves the order in which predicates were defined.
@ -1018,10 +1005,9 @@ predicates."
;;;;;; Predicates
(cl-eval-when (compile load eval)
;; Improve load time by deferring the per-predicate preamble- and normalizer-function
;; redefinitions until all of the predicates have been defined.
(setf org-ql-defpred-defer t))
;; Improve load time by deferring the per-predicate preamble- and normalizer-function
;; redefinitions until all of the predicates have been defined.
(setf org-ql-defpred-defer t)
(org-ql-defpred category (&rest categories)
"Return non-nil if current heading is in one or more of CATEGORIES (a list of strings)."
@ -1836,10 +1822,10 @@ of the line after the heading."
(from (test-timestamps (ts<= from next-ts)))
(to (test-timestamps (ts<= next-ts to)))))))
;; Predicates defined: stop deferring and define normalizer and preamble functions now.
;; NOTE: Predicates defined: stop deferring and define normalizer and
;; preamble functions now. Reversing preserves the order in which
;; they were defined. Generally it shouldn't matter, but it might...
(setf org-ql-defpred-defer nil)
;; Reversing preserves the order in which they were defined.
;; Generally it shouldn't matter, but it might...
(org-ql--define-normalize-query-fn (reverse org-ql-predicates))
(org-ql--define-query-preamble-fn (reverse org-ql-predicates))
(org-ql--def-query-string-to-sexp-fn (reverse org-ql-predicates))

47
org-ql.info
View file

@ -972,6 +972,7 @@ File: README.info, Node: 06-pre, Next: 05, Up: Changelog
(org-ql-defpred) that consolidates functionality related to each
predicate. This will also allow users to more easily define custom
predicates.
• Version 1.0 of library ‘peg’ is now required.

File: README.info, Node: 05, Next: 049, Prev: 06-pre, Up: Changelog
@ -1487,29 +1488,29 @@ Node: Links33872
Node: Tips34559
Node: Changelog34877
Node: 06-pre35573
Node: 0536139
Node: 04937616
Node: 04837890
Node: 04738237
Node: 04638632
Node: 04539032
Node: 04439391
Node: 04339748
Node: 04239943
Node: 04140104
Node: 0440345
Node: 03244278
Node: 03144657
Node: 0344854
Node: 02347829
Node: 02248057
Node: 02148325
Node: 0248524
Node: 0152559
Node: Notes52660
Node: Comparison with Org Agenda searches52822
Node: org-sidebar53694
Node: License53973
Node: 0536196
Node: 04937673
Node: 04837947
Node: 04738294
Node: 04638689
Node: 04539089
Node: 04439448
Node: 04339805
Node: 04240000
Node: 04140161
Node: 0440402
Node: 03244335
Node: 03144714
Node: 0344911
Node: 02347886
Node: 02248114
Node: 02148382
Node: 0248581
Node: 0152616
Node: Notes52717
Node: Comparison with Org Agenda searches52879
Node: org-sidebar53751
Node: License54030

End Tag Table