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

Fix: (org-ql) Set "today" to org-ql--today in symbol-macrolet

Browse source 
Since we byte-compile the lambda, this is necessary (at least, I think
this is why).  Remember that we set org-ql--today when we actually run
queries.
This commit is contained in:
Adam Porter 2018-08-01 10:53:15 -05:00
parent 4c045f78ea
commit fe3d5c2bd8
1 changed files with 25 additions and 26 deletions
Download patch file Download diff file Expand all files Collapse all files

51
org-ql.el
View file

@ -32,7 +32,8 @@ buffer (the default is to widen and search the entire buffer)."
(declare (indent defun)) (declare (indent defun))
`(org-ql--query ,buffers-or-files `(org-ql--query ,buffers-or-files
(byte-compile (lambda () (byte-compile (lambda ()
(cl-symbol-macrolet ((= #'=) (cl-symbol-macrolet ((today org-ql--today) ; Necessary because of byte-compiling the lambda
(= #'=)
(< #'<) (< #'<)
(> #'>) (> #'>)
(<= #'<=) (<= #'<=)
@ -103,31 +104,29 @@ Headings should return non-nil for any ANY-PREDS and nil for all
NONE-PREDS. If NARROW is non-nil, buffer will not be widened NONE-PREDS. If NARROW is non-nil, buffer will not be widened
first." first."
;; Cache `org-today' so we don't have to run it repeatedly. ;; Cache `org-today' so we don't have to run it repeatedly.
(let (today) (org-ql--fmap ((category #'org-ql--category-p)
(cl-letf ((today org-ql--today)) (date #'org-ql--date-plain-p)
(org-ql--fmap ((category #'org-ql--category-p) (deadline #'org-ql--deadline-p)
(date #'org-ql--date-plain-p) (scheduled #'org-ql--scheduled-p)
(deadline #'org-ql--deadline-p) (closed #'org-ql--closed-p)
(scheduled #'org-ql--scheduled-p) (habit #'org-ql--habit-p)
(closed #'org-ql--closed-p) (priority #'org-ql--priority-p)
(habit #'org-ql--habit-p) (todo #'org-ql--todo-p)
(priority #'org-ql--priority-p) (done #'org-ql--done-p)
(todo #'org-ql--todo-p) (tags #'org-ql--tags-p)
(done #'org-ql--done-p) (property #'org-ql--property-p)
(tags #'org-ql--tags-p) (regexp #'org-ql--regexp-p)
(property #'org-ql--property-p) (org-back-to-heading #'outline-back-to-heading))
(regexp #'org-ql--regexp-p) (save-excursion
(org-back-to-heading #'outline-back-to-heading)) (save-restriction
(save-excursion (unless narrow
(save-restriction (widen))
(unless narrow (goto-char (point-min))
(widen)) (when (org-before-first-heading-p)
(goto-char (point-min)) (outline-next-heading))
(when (org-before-first-heading-p) (cl-loop when (funcall pred)
(outline-next-heading)) collect (org-element-headline-parser (line-end-position))
(cl-loop when (funcall pred) while (outline-next-heading))))))
collect (org-element-headline-parser (line-end-position))
while (outline-next-heading))))))))
;;;;; Predicates ;;;;; Predicates