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

WIP

Browse source
This commit is contained in:
Adam Porter 2020-11-22 13:52:09 -06:00
parent efae2229ed
commit 049485b813
1 changed files with 190 additions and 172 deletions
Download patch file Download diff file Expand all files Collapse all files

362
org-ql.el
View file

@ -251,178 +251,7 @@ Multiple predicates are combined with BOOLEAN."
;;;;; Predicate definition
(defvar org-ql-defpred-defer nil)
(defun org-ql--define-normalize-query (predicates)
"Define function `org-ql--normalize-query' for PREDICATES.
PREDICATES should be the value of `org-ql-predicates'."
(let ((normalizer-patterns (->> predicates
(--map (plist-get (cdr it) :normalizers))
(-flatten-n 1))))
(fset 'org-ql--normalize-query
`(lambda (query)
"FIXME"
(cl-labels ((rec (element)
(pcase element
(`(or . ,clauses) `(or ,@(mapcar #'rec clauses)))
(`(and . ,clauses) `(and ,@(mapcar #'rec clauses)))
(`(not . ,clauses) `(not ,@(mapcar #'rec clauses)))
(`(when ,condition . ,clauses) `(when ,(rec condition)
,@(mapcar #'rec clauses)))
(`(unless ,condition . ,clauses) `(unless ,(rec condition)
,@(mapcar #'rec clauses)))
;; TODO: Combine (regexp) when appropriate (i.e. inside an OR, not an AND).
((pred stringp) `(regexp ,element))
,@normalizer-patterns
;; Any other form: passed through unchanged.
(_ element))))
(rec query))))))
(defun org-ql--define-preamble-fn (predicates)
"Define function `org-ql--query-preamble' for PREDICATES.
PREDICATES should be the value of `org-ql-predicates'."
;; NOTE: I don't how the `list' symbol ends up in the list, but anyway...
(let* ((preamble-patterns
(-flatten-n 1 (-non-nil
;; NOTE: Using -let instead of pcase-let here because I can't make map 2.1 install in the test sandbox.
(--map (-let* (((&plist :preambles) (cdr it)))
(--map (pcase-let* ((`(,pattern ,exp) it))
`(,pattern
(-let* (((&plist :regexp :case-fold :query) ,exp))
(setf org-ql-preamble regexp
preamble-case-fold case-fold)
;; NOTE: Even when `predicate' is nil, it must be returned in the pcase form.
query)))
preambles))
predicates)))))
(fset 'org-ql--query-preamble
`(lambda (query)
"FIXME"
(pcase org-ql-use-preamble
('nil (list :query query :preamble nil))
(_ (let ((preamble-case-fold t)
org-ql-preamble)
(cl-labels ((rec (element)
(or (when org-ql-preamble
;; Only one preamble is allowed
element)
(pcase element
(`(or _) element)
,@preamble-patterns
;; (`(clocked . ,_)
;; (setq org-ql-preamble org-ql-clock-regexp)
;; element)
(`(and . ,rest)
(let ((clauses (mapcar #'rec rest)))
`(and ,@(-non-nil clauses))))
(_ element)))))
(setq query (pcase (mapcar #'rec (list query))
((or `(nil)
`((nil))
`((and))
`((or)))
t)
(`(t) t)
(query (-flatten-n 1 query))))
(list :query query :preamble org-ql-preamble :preamble-case-fold preamble-case-fold)))))))))
(cl-defmacro org-ql-defpred (name args docstring &key body preambles normalizers)
"Define an `org-ql' selector predicate named `org-ql--predicate-NAME'.
NAME may be a symbol or a list of symbols: if a list, the first
is used as NAME and the rest are aliases (which should be
normalized to the name using NORMALIZERS). ARGS is a
`cl-defun'-style argument list. DOCSTRING is the function's
docstring. BODY is the body of the predicate.
Predicate bodies will be evaluated with point on the beginning of
an Org heading and should return non-nil if the heading's entry
is a match.
PREAMBLES and NORMALIZERS are lists of `pcase' forms matched
against Org QL query sexps.
NORMALIZERS are used to normalize queries to standard forms. For
example, predicate aliases are replaced with predicate names.
Also, predicate arguments may be put into a more optimal form so
that the predicate has less work to do at query time.
PREAMBLES refer to regular expressions which may be used to
search through a buffer directly to a potential match (rather
than testing the predicate body on each heading). (Naming things
is hard.) In each `pcase' form in PREAMBLES, the expression
should be a plist with the following keys, each value of which
should be an expression which may refer to variables bound in the
pattern:
:regexp Regular expression which searches directly to a
potential match.
:case-fold Bound to `case-fold-search' around the regexp search.
:query Expression which should replace the query, or `query'
if it should not be changed (e.g. if the regexp is
insufficient to determine whether a heading
matches, in which case the predicate's body needs
to be tested on the heading).
For convenience, within the `pcase' patterns, the symbol
`predicate-names' is a special form which is replaced with a
pattern matching any of the predicate's name and aliases. For
example, if NAME were:
(heading h)
Then if NORMALIZERS were:
((`(,predicate-names . ,args)
`(heading ,@args)))
It would be expanded to:
((`(,(or 'heading 'h) . ,args)
`(heading ,@args)))"
;; NOTE: The debug form works, completely! For example, use `edebug-defun'
;; on the `heading' predicate, then evaluate this form:
;; (let* ((query '(heading "HEADING"))
;; (normalized (org-ql--normalize-query query))
;; (preamble (org-ql--query-preamble normalized)))
;; (list :query query
;; :normalized normalized
;; :preamble preamble))
(declare (debug ([&or symbolp listp] listp stringp
&rest [&or [":body" def-body]
[":normalizers" (&rest (sexp def-body))]
[":preambles" (&rest (sexp def-body))]]))
(indent defun))
(let* ((aliases (when (listp name)
(cdr name)))
(name (cl-etypecase name
(list (car name))
(atom name)))
(fn-name (intern (concat "org-ql--predicate-" (symbol-name name))))
(predicate-name (intern (symbol-name name)))
(predicate-names (delq nil (cons predicate-name aliases)))
(normalizers (cl-sublis (list (cons 'predicate-names (cons 'or (--map (list 'quote it) predicate-names))))
normalizers))
(preambles (cl-sublis (list (cons 'predicate-names (cons 'or (--map (list 'quote it) predicate-names))))
preambles)))
`(cl-eval-when (compile load eval)
;; When compiling, the predicate must be added to `org-ql-predicates' before `org-ql--def-query-string-to-sexp-fn'
;; is called to define `org-ql--query-string-to-sexp'. Otherwise, `org-ql--query-string-to-sexp' seems to work properly
;; when interpreted but not always when the file is byte-compiled.
(setf (map-elt org-ql-predicates ',predicate-name)
`(:name ,',name :aliases ,',aliases :fn ,',fn-name :docstring ,,docstring :args ,',args
:normalizers ,',normalizers :preambles ,',preambles))
(unless org-ql-defpred-defer
(org-ql--define-normalize-query (reverse org-ql-predicates))
;; NOTE: Reversing is important!
(org-ql--define-preamble-fn (reverse org-ql-predicates))
(org-ql--def-query-string-to-sexp-fn))
(cl-defun ,fn-name ,args ,docstring ,body))))
;; TODO: Mark as obsolete/deprecated.
;;;###autoload
@ -972,7 +801,196 @@ Arguments STRING, POS, FILL, and LEVEL are according to
('inactive org-ql-tsr-regexp-inactive)))))
,query)))))
;;;;; Predicates
;;;;; Predicate definition
(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
cause the functions `org-ql--normalize-query',
`org-ql--query-preamble', and `org-ql--query-string-to-sexp' to
be redefined. These functions must be redefined in order to
account for new predicates, but when defining many
predicates (like at load time), that may be deferred for
performance (after which those functions should be updated
manually; see the definition of `org-ql-defpred').")
;; Yes, these two functions are a little hairy: `pcase' is challenging
;; enough, but splicing forms into one is something else. But it's
;; worth it to do this ugly stuff here, in one place, so the
;; `org-ql-defpred' macro becomes easy to use.
(defun org-ql--define-normalize-query (predicates)
"Define function `org-ql--normalize-query' for PREDICATES.
PREDICATES should be the value of `org-ql-predicates'."
(let ((normalizer-patterns (->> predicates
(--map (plist-get (cdr it) :normalizers))
(-flatten-n 1))))
(fset 'org-ql--normalize-query
`(lambda (query)
"FIXME"
(cl-labels ((rec (element)
(pcase element
(`(or . ,clauses) `(or ,@(mapcar #'rec clauses)))
(`(and . ,clauses) `(and ,@(mapcar #'rec clauses)))
(`(not . ,clauses) `(not ,@(mapcar #'rec clauses)))
(`(when ,condition . ,clauses) `(when ,(rec condition)
,@(mapcar #'rec clauses)))
(`(unless ,condition . ,clauses) `(unless ,(rec condition)
,@(mapcar #'rec clauses)))
;; TODO: Combine (regexp) when appropriate (i.e. inside an OR, not an AND).
((pred stringp) `(regexp ,element))
,@normalizer-patterns
;; Any other form: passed through unchanged.
(_ element))))
(rec query))))))
(defun org-ql--define-preamble-fn (predicates)
"Define function `org-ql--query-preamble' for PREDICATES.
PREDICATES should be the value of `org-ql-predicates'."
;; NOTE: I don't how the `list' symbol ends up in the list, but anyway...
(let* ((preamble-patterns
(-flatten-n 1 (-non-nil
;; NOTE: Using -let instead of pcase-let here because I can't make map 2.1 install in the test sandbox.
(--map (-let* (((&plist :preambles) (cdr it)))
(--map (pcase-let* ((`(,pattern ,exp) it))
`(,pattern
(-let* (((&plist :regexp :case-fold :query) ,exp))
(setf org-ql-preamble regexp
preamble-case-fold case-fold)
;; NOTE: Even when `predicate' is nil, it must be returned in the pcase form.
query)))
preambles))
predicates)))))
(fset 'org-ql--query-preamble
`(lambda (query)
"FIXME"
(pcase org-ql-use-preamble
('nil (list :query query :preamble nil))
(_ (let ((preamble-case-fold t)
org-ql-preamble)
(cl-labels ((rec (element)
(or (when org-ql-preamble
;; Only one preamble is allowed
element)
(pcase element
(`(or _) element)
,@preamble-patterns
;; (`(clocked . ,_)
;; (setq org-ql-preamble org-ql-clock-regexp)
;; element)
(`(and . ,rest)
(let ((clauses (mapcar #'rec rest)))
`(and ,@(-non-nil clauses))))
(_ element)))))
(setq query (pcase (mapcar #'rec (list query))
((or `(nil)
`((nil))
`((and))
`((or)))
t)
(`(t) t)
(query (-flatten-n 1 query))))
(list :query query :preamble org-ql-preamble :preamble-case-fold preamble-case-fold)))))))))
(cl-defmacro org-ql-defpred (name args docstring &key body preambles normalizers)
"Define an `org-ql' selector predicate named `org-ql--predicate-NAME'.
NAME may be a symbol or a list of symbols: if a list, the first
is used as NAME and the rest are aliases (which should be
normalized to the name using NORMALIZERS). ARGS is a
`cl-defun'-style argument list. DOCSTRING is the function's
docstring. BODY is the body of the predicate.
Predicate bodies will be evaluated with point on the beginning of
an Org heading and should return non-nil if the heading's entry
is a match.
PREAMBLES and NORMALIZERS are lists of `pcase' forms matched
against Org QL query sexps.
NORMALIZERS are used to normalize queries to standard forms. For
example, predicate aliases are replaced with predicate names.
Also, predicate arguments may be put into a more optimal form so
that the predicate has less work to do at query time.
PREAMBLES refer to regular expressions which may be used to
search through a buffer directly to a potential match (rather
than testing the predicate body on each heading). (Naming things
is hard.) In each `pcase' form in PREAMBLES, the expression
should be a plist with the following keys, each value of which
should be an expression which may refer to variables bound in the
pattern:
:regexp Regular expression which searches directly to a
potential match.
:case-fold Bound to `case-fold-search' around the regexp search.
:query Expression which should replace the query, or `query'
if it should not be changed (e.g. if the regexp is
insufficient to determine whether a heading
matches, in which case the predicate's body needs
to be tested on the heading).
For convenience, within the `pcase' patterns, the symbol
`predicate-names' is a special form which is replaced with a
pattern matching any of the predicate's name and aliases. For
example, if NAME were:
(heading h)
Then if NORMALIZERS were:
((`(,predicate-names . ,args)
`(heading ,@args)))
It would be expanded to:
((`(,(or 'heading 'h) . ,args)
`(heading ,@args)))"
;; NOTE: The debug form works, completely! For example, use `edebug-defun'
;; on the `heading' predicate, then evaluate this form:
;; (let* ((query '(heading "HEADING"))
;; (normalized (org-ql--normalize-query query))
;; (preamble (org-ql--query-preamble normalized)))
;; (list :query query
;; :normalized normalized
;; :preamble preamble))
(declare (debug ([&or symbolp listp] listp stringp
&rest [&or [":body" def-body]
[":normalizers" (&rest (sexp def-body))]
[":preambles" (&rest (sexp def-body))]]))
(indent defun))
(let* ((aliases (when (listp name)
(cdr name)))
(name (cl-etypecase name
(list (car name))
(atom name)))
(fn-name (intern (concat "org-ql--predicate-" (symbol-name name))))
(predicate-name (intern (symbol-name name)))
(predicate-names (delq nil (cons predicate-name aliases)))
(normalizers (cl-sublis (list (cons 'predicate-names (cons 'or (--map (list 'quote it) predicate-names))))
normalizers))
(preambles (cl-sublis (list (cons 'predicate-names (cons 'or (--map (list 'quote it) predicate-names))))
preambles)))
`(cl-eval-when (compile load eval)
;; When compiling, the predicate must be added to `org-ql-predicates' before `org-ql--def-query-string-to-sexp-fn'
;; is called to define `org-ql--query-string-to-sexp'. Otherwise, `org-ql--query-string-to-sexp' seems to work properly
;; when interpreted but not always when the file is byte-compiled.
(setf (map-elt org-ql-predicates ',predicate-name)
`(:name ,',name :aliases ,',aliases :fn ,',fn-name :docstring ,,docstring :args ,',args
:normalizers ,',normalizers :preambles ,',preambles))
(unless org-ql-defpred-defer
(org-ql--define-normalize-query (reverse org-ql-predicates))
;; NOTE: Reversing is important!
(org-ql--define-preamble-fn (reverse org-ql-predicates))
(org-ql--def-query-string-to-sexp-fn))
(cl-defun ,fn-name ,args ,docstring ,body))))
;;;;;; Predicates
(cl-eval-when (compile load eval)
;; Improve load time by deferring the per-predicate preamble- and normalizer-function