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 17:07:17 -06:00
parent a87058b440
commit 9a2719f5b3
1 changed files with 20 additions and 22 deletions
Download patch file Download diff file Expand all files Collapse all files

30
org-ql.el
View file

@ -699,19 +699,18 @@ Arguments STRING, POS, FILL, and LEVEL are according to
;; the function correctly, apparently because `org-ql-predicates' ;; the function correctly, apparently because `org-ql-predicates'
;; ends up being not defined correctly at expansion time. ;; ends up being not defined correctly at expansion time.
(defun org-ql--def-query-string-to-sexp-fn () (defun org-ql--def-query-string-to-sexp-fn (predicates)
"Define function `org-ql--query-string-to-sexp'. "Define function `org-ql--query-string-to-sexp' according to PREDICATES.
Builds the PEG expression using predicates defined in Builds the PEG expression using PREDICATES (which should be the
`org-ql-predicates' and `org-ql-predicates-extra-aliases'." value of `org-ql-predicates')."
(let* ((predicates (--map (symbol-name (plist-get (cdr it) :name)) (let* ((names (--map (symbol-name (plist-get (cdr it) :name))
org-ql-predicates)) predicates))
(aliases (->> org-ql-predicates (aliases (->> predicates
(-map #'cdr) (--map (plist-get (cdr it) :aliases))
(--map (plist-get it :aliases))
-non-nil -non-nil
-flatten -flatten
(-map #'symbol-name))) (-map #'symbol-name)))
(predicates (->> (append predicates aliases) (predicates (->> (append names aliases)
-uniq -uniq
;; Sort the keywords longest-first to work around what seems to be an ;; 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, ;; obscure bug in `peg': when one keyword is a substring of another,
@ -961,8 +960,9 @@ It would be expanded to:
normalizers)) normalizers))
(preambles (cl-sublis (list (cons 'predicate-names (cons 'or (--map (list 'quote it) predicate-names)))) (preambles (cl-sublis (list (cons 'predicate-names (cons 'or (--map (list 'quote it) predicate-names))))
preambles))) preambles)))
`(cl-eval-when (compile load eval) `(progn
(cl-defun ,fn-name ,args ,docstring ,body) (cl-eval-when (compile load eval)
(cl-defun ,fn-name ,args ,docstring ,body))
(setf (map-elt org-ql-predicates ',predicate-name) (setf (map-elt org-ql-predicates ',predicate-name)
`(: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)) :normalizers ,',normalizers :preambles ,',preambles))
@ -970,8 +970,7 @@ It would be expanded to:
;; Reversing preserves the order in which predicates were defined. ;; Reversing preserves the order in which predicates were defined.
(org-ql--define-normalize-query-fn (reverse org-ql-predicates)) (org-ql--define-normalize-query-fn (reverse org-ql-predicates))
(org-ql--define-query-preamble-fn (reverse org-ql-predicates)) (org-ql--define-query-preamble-fn (reverse org-ql-predicates))
;; FIXME: Pass an argument to `org-ql--def-query-string-to-sexp-fn' too. (org-ql--def-query-string-to-sexp-fn (reverse org-ql-predicates))))))
(org-ql--def-query-string-to-sexp-fn)))))
(defmacro org-ql--from-to-on () (defmacro org-ql--from-to-on ()
"For internal use. "For internal use.
@ -1836,14 +1835,13 @@ of the line after the heading."
(from (test-timestamps (ts<= from next-ts))) (from (test-timestamps (ts<= from next-ts)))
(to (test-timestamps (ts<= next-ts to))))))) (to (test-timestamps (ts<= next-ts to)))))))
(cl-eval-when (compile load eval)
;; Predicates defined: stop deferring and define normalizer and preamble functions now. ;; Predicates defined: stop deferring and define normalizer and preamble functions now.
(setf org-ql-defpred-defer nil) (setf org-ql-defpred-defer nil)
;; Reversing preserves the order in which they were defined. ;; Reversing preserves the order in which they were defined.
;; Generally it shouldn't matter, but it might... ;; Generally it shouldn't matter, but it might...
(org-ql--define-normalize-query-fn (reverse org-ql-predicates)) (org-ql--define-normalize-query-fn (reverse org-ql-predicates))
(org-ql--define-query-preamble-fn (reverse org-ql-predicates)) (org-ql--define-query-preamble-fn (reverse org-ql-predicates))
(org-ql--def-query-string-to-sexp-fn)) (org-ql--def-query-string-to-sexp-fn (reverse org-ql-predicates))
;;;;; Sorting ;;;;; Sorting