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

Tidy: Indentation

Browse source 
Due to changes in dash.
This commit is contained in:
Adam Porter 2021-06-08 10:53:13 -05:00
parent 105715309e
commit 7a8e3b2e8e
5 changed files with 112 additions and 112 deletions
Download patch file Download diff file Expand all files Collapse all files

8
helm-org-ql.el
View file

@ -59,8 +59,8 @@ Based on `helm-map'.")
(helm-make-source "Org QL Views" 'helm-source-sync (helm-make-source "Org QL Views" 'helm-source-sync
:candidates (lambda () :candidates (lambda ()
(->> org-ql-views (->> org-ql-views
(-map #'car) (-map #'car)
(-sort #'string<))) (-sort #'string<)))
:action (list (cons "Show view" #'org-ql-view))) :action (list (cons "Show view" #'org-ql-view)))
"Helm source for `org-ql-views'.") "Helm source for `org-ql-views'.")
@ -209,8 +209,8 @@ WINDOW-WIDTH should be the width of the Helm window."
(width (- window-width (length prefix))) (width (- window-width (length prefix)))
(heading (org-get-heading t)) (heading (org-get-heading t))
(path (-> (org-get-outline-path) (path (-> (org-get-outline-path)
(org-format-outline-path width nil "") (org-format-outline-path width nil "")
(org-split-string ""))) (org-split-string "")))
(path (if helm-org-ql-reverse-paths (path (if helm-org-ql-reverse-paths
(concat heading "\\" (s-join "\\" (nreverse path))) (concat heading "\\" (s-join "\\" (nreverse path)))
(concat (s-join "/" path) "/" heading)))) (concat (s-join "/" path) "/" heading))))

10
org-ql-search.el
View file

@ -224,9 +224,9 @@ automatically from the query."
;; `org-agenda-multi' is bound non-nil, in which case `org-agenda-finalize' does nothing. ;; `org-agenda-multi' is bound non-nil, in which case `org-agenda-finalize' does nothing.
;; But we do call `org-agenda-finalize-entries', which allows `org-super-agenda' to work. ;; But we do call `org-agenda-finalize-entries', which allows `org-super-agenda' to work.
(->> items (->> items
(-map #'org-ql-view--format-element) (-map #'org-ql-view--format-element)
org-agenda-finalize-entries org-agenda-finalize-entries
insert) insert)
(insert "\n")))) (insert "\n"))))
;;;###autoload ;;;###autoload
@ -343,8 +343,8 @@ For example, an org-ql dynamic block header could look like:
When RECURSE is non-nil, recurse into subdirectories. When When RECURSE is non-nil, recurse into subdirectories. When
REGEXP is non-nil, only return files that match REGEXP." REGEXP is non-nil, only return files that match REGEXP."
(let ((files (->> directories (let ((files (->> directories
(--map (f-files it nil recurse)) (--map (f-files it nil recurse))
-flatten))) -flatten)))
(if regexp (if regexp
(--select (string-match regexp it) (--select (string-match regexp it)
files) files)

92
org-ql-view.el
View file

@ -153,11 +153,11 @@ See info node `(elisp)Cyclic Window Ordering'."
(interactive) (interactive)
(let* ((ts (ts-now)) (let* ((ts (ts-now))
(beg-of-week (->> ts (beg-of-week (->> ts
(ts-adjust 'day (- (ts-dow (ts-now)))) (ts-adjust 'day (- (ts-dow (ts-now))))
(ts-apply :hour 0 :minute 0 :second 0))) (ts-apply :hour 0 :minute 0 :second 0)))
(end-of-week (->> ts (end-of-week (->> ts
(ts-adjust 'day (- 6 (ts-dow (ts-now)))) (ts-adjust 'day (- 6 (ts-dow (ts-now))))
(ts-apply :hour 23 :minute 59 :second 59)))) (ts-apply :hour 23 :minute 59 :second 59))))
(org-ql-search (org-agenda-files) (org-ql-search (org-agenda-files)
`(ts-active :from ,beg-of-week `(ts-active :from ,beg-of-week
:to ,end-of-week) :to ,end-of-week)
@ -170,11 +170,11 @@ See info node `(elisp)Cyclic Window Ordering'."
(interactive) (interactive)
(let* ((ts (ts-adjust 'day 7 (ts-now))) (let* ((ts (ts-adjust 'day 7 (ts-now)))
(beg-of-week (->> ts (beg-of-week (->> ts
(ts-adjust 'day (- (ts-dow (ts-now)))) (ts-adjust 'day (- (ts-dow (ts-now))))
(ts-apply :hour 0 :minute 0 :second 0))) (ts-apply :hour 0 :minute 0 :second 0)))
(end-of-week (->> ts (end-of-week (->> ts
(ts-adjust 'day (- 6 (ts-dow (ts-now)))) (ts-adjust 'day (- 6 (ts-dow (ts-now))))
(ts-apply :hour 23 :minute 59 :second 59)))) (ts-apply :hour 23 :minute 59 :second 59))))
(org-ql-search (org-agenda-files) (org-ql-search (org-agenda-files)
`(ts-active :from ,beg-of-week `(ts-active :from ,beg-of-week
:to ,end-of-week) :to ,end-of-week)
@ -271,8 +271,8 @@ TYPE may be `ts', `ts-active', `ts-inactive', `clocked', or
`closed'." `closed'."
(interactive (list :num-days (read-number "Days: ") (interactive (list :num-days (read-number "Days: ")
:type (->> '(ts ts-active ts-inactive clocked closed) :type (->> '(ts ts-active ts-inactive clocked closed)
(completing-read "Timestamp type: ") (completing-read "Timestamp type: ")
intern))) intern)))
;; It doesn't make much sense to use other date-based selectors to ;; It doesn't make much sense to use other date-based selectors to
;; look into the past, so to prevent confusion, we won't allow them. ;; look into the past, so to prevent confusion, we won't allow them.
(-let* ((query (pcase-exhaustive type (-let* ((query (pcase-exhaustive type
@ -394,12 +394,12 @@ update search arguments."
(let ((inhibit-read-only t)) (let ((inhibit-read-only t))
(erase-buffer) (erase-buffer)
(->> org-ql-views (->> org-ql-views
(-map #'car) (-map #'car)
(-sort (if org-ql-view-sidebar-sort-views (-sort (if org-ql-view-sidebar-sort-views
#'string< #'string<
#'ignore)) #'ignore))
(s-join "\n") (s-join "\n")
insert)) insert))
(current-buffer))) (current-buffer)))
(defvar bookmark-make-record-function) (defvar bookmark-make-record-function)
@ -468,8 +468,8 @@ If TITLE, prepend it to the header."
(format "%s" (org-ql-view--contract-buffers-files buffers-files)))) (format "%s" (org-ql-view--contract-buffers-files buffers-files))))
(buffers-files-formatted (when buffers-files-formatted (buffers-files-formatted (when buffers-files-formatted
(propertize (->> buffers-files-formatted (propertize (->> buffers-files-formatted
(org-ql-view--font-lock-string 'emacs-lisp-mode) (org-ql-view--font-lock-string 'emacs-lisp-mode)
(s-truncate available-width)) (s-truncate available-width))
'help-echo buffers-files-formatted)))) 'help-echo buffers-files-formatted))))
(concat title (concat title
(when query (propertize "Query:" 'face 'transient-argument)) (when query (propertize "Query:" 'face 'transient-argument))
@ -748,8 +748,8 @@ When opened, the link searches the buffer it's opened from."
(s-truncate (- (window-width) 15) (s-truncate (- (window-width) 15)
(concat (propertize key 'face 'transient-argument) ": " (concat (propertize key 'face 'transient-argument) ": "
(->> value (->> value
org-ql-view--format-query org-ql-view--format-query
(org-ql-view--font-lock-string 'emacs-lisp-mode))))) (org-ql-view--font-lock-string 'emacs-lisp-mode)))))
(define-infix-command org-ql-view--transient-title () (define-infix-command org-ql-view--transient-title ()
;; TODO: Add an asterisk or something when the view has been modified but not saved. ;; TODO: Add an asterisk or something when the view has been modified but not saved.
@ -848,8 +848,8 @@ return an empty string."
;; Adding the relative due date property should probably be done explicitly and separately ;; Adding the relative due date property should probably be done explicitly and separately
;; (which would also make it easier to do it independently of faces, etc). ;; (which would also make it easier to do it independently of faces, etc).
(title (--> (org-ql-view--add-faces element) (title (--> (org-ql-view--add-faces element)
(org-element-property :raw-value it) (org-element-property :raw-value it)
(org-link-display-format it))) (org-link-display-format it)))
(todo-keyword (-some--> (org-element-property :todo-keyword element) (todo-keyword (-some--> (org-element-property :todo-keyword element)
(org-ql-view--add-todo-face it))) (org-ql-view--add-todo-face it)))
(tag-list (if org-use-tag-inheritance (tag-list (if org-use-tag-inheritance
@ -870,9 +870,9 @@ return an empty string."
(org-element-property :tags element))) (org-element-property :tags element)))
(tag-string (when tag-list (tag-string (when tag-list
(--> tag-list (--> tag-list
(s-join ":" it) (s-join ":" it)
(s-wrap it ":") (s-wrap it ":")
(org-add-props it nil 'face 'org-tag)))) (org-add-props it nil 'face 'org-tag))))
;; (category (org-element-property :category element)) ;; (category (org-element-property :category element))
(priority-string (-some->> (org-element-property :priority element) (priority-string (-some->> (org-element-property :priority element)
(char-to-string) (char-to-string)
@ -888,19 +888,19 @@ return an empty string."
(remove-list-of-text-properties 0 (length string) '(line-prefix) string) (remove-list-of-text-properties 0 (length string) '(line-prefix) string)
;; Add all the necessary properties and faces to the whole string ;; Add all the necessary properties and faces to the whole string
(--> string (--> string
;; FIXME: Use proper prefix ;; FIXME: Use proper prefix
(concat " " it) (concat " " it)
(org-add-props it properties (org-add-props it properties
'org-agenda-type 'search 'org-agenda-type 'search
'todo-state todo-keyword 'todo-state todo-keyword
'tags tag-list 'tags tag-list
'org-habit-p habit-property))))) 'org-habit-p habit-property)))))
(defun org-ql-view--add-faces (element) (defun org-ql-view--add-faces (element)
"Return ELEMENT with deadline and scheduled faces added." "Return ELEMENT with deadline and scheduled faces added."
(->> element (->> element
(org-ql-view--add-scheduled-face) (org-ql-view--add-scheduled-face)
(org-ql-view--add-deadline-face))) (org-ql-view--add-deadline-face)))
(defun org-ql-view--add-priority-face (string) (defun org-ql-view--add-priority-face (string)
"Return STRING with priority face added." "Return STRING with priority face added."
@ -957,11 +957,11 @@ return an empty string."
((> today-day-number scheduled-day-number) 'org-scheduled-previously) ((> today-day-number scheduled-day-number) 'org-scheduled-previously)
(t 'org-scheduled))) (t 'org-scheduled)))
(title (--> (org-element-property :raw-value element) (title (--> (org-element-property :raw-value element)
(org-add-props it nil (org-add-props it nil
'face face))) 'face face)))
(properties (--> (cadr element) (properties (--> (cadr element)
(plist-put it :title title) (plist-put it :title title)
(plist-put it :relative-due-date relative-due-date)))) (plist-put it :relative-due-date relative-due-date))))
(list (car element) (list (car element)
properties)) properties))
;; Not scheduled ;; Not scheduled
@ -983,16 +983,16 @@ property."
;; FIXME: Unused for now: (done-p (member todo-keyword org-done-keywords)) ;; FIXME: Unused for now: (done-p (member todo-keyword org-done-keywords))
;; FIXME: Unused for now: (today-p (= today-day-number deadline-day-number)) ;; FIXME: Unused for now: (today-p (= today-day-number deadline-day-number))
(deadline-passed-fraction (--> (- deadline-day-number today-day-number) (deadline-passed-fraction (--> (- deadline-day-number today-day-number)
(float it) (float it)
(/ it (max org-deadline-warning-days 1)) (/ it (max org-deadline-warning-days 1))
(- 1 it))) (- 1 it)))
(face (org-agenda-deadline-face deadline-passed-fraction)) (face (org-agenda-deadline-face deadline-passed-fraction))
(title (--> (org-element-property :raw-value element) (title (--> (org-element-property :raw-value element)
(org-add-props it nil (org-add-props it nil
'face face))) 'face face)))
(properties (--> (cadr element) (properties (--> (cadr element)
(plist-put it :title title) (plist-put it :title title)
(plist-put it :relative-due-date relative-due-date)))) (plist-put it :relative-due-date relative-due-date))))
(list (car element) (list (car element)
properties)) properties))
;; No deadline ;; No deadline
@ -1113,7 +1113,7 @@ The counterpart to `org-ql-view--contract-buffers-files'."
"todo") "todo")
nil nil (when org-ql-view-sort nil nil (when org-ql-view-sort
(prin1-to-string org-ql-view-sort))) (prin1-to-string org-ql-view-sort)))
(--remove (equal "buffer-order" it))))) (--remove (equal "buffer-order" it)))))
(pcase input (pcase input
('nil nil) ('nil nil)
((and (pred listp) sort) ((and (pred listp) sort)

108
org-ql.el
View file

@ -216,18 +216,18 @@ returns nil or non-nil."
(function (funcall buffers-or-files)) (function (funcall buffers-or-files))
(list buffers-or-files) (list buffers-or-files)
(otherwise (list buffers-or-files))) (otherwise (list buffers-or-files)))
(--map (cl-etypecase it (--map (cl-etypecase it
;; NOTE: This etypecase is essential to opening links safely, ;; NOTE: This etypecase is essential to opening links safely,
;; as it rejects, e.g. lambdas in the buffers-files argument. ;; as it rejects, e.g. lambdas in the buffers-files argument.
(buffer it) (buffer it)
(string (or (find-buffer-visiting it) (string (or (find-buffer-visiting it)
(when (file-readable-p it) (when (file-readable-p it)
;; It feels unintuitive that `find-file-noselect' returns ;; It feels unintuitive that `find-file-noselect' returns
;; a buffer if the filename doesn't exist. ;; a buffer if the filename doesn't exist.
(find-file-noselect it)) (find-file-noselect it))
(user-error "Can't open file: %s" it))))) (user-error "Can't open file: %s" it)))))
;; Ignore special/hidden buffers. ;; Ignore special/hidden buffers.
(--remove (string-prefix-p " " (buffer-name it))))) (--remove (string-prefix-p " " (buffer-name it)))))
(query (org-ql--normalize-query query)) (query (org-ql--normalize-query query))
((&plist :query :preamble :preamble-case-fold) (org-ql--query-preamble query)) ((&plist :query :preamble :preamble-case-fold) (org-ql--query-preamble query))
(predicate (org-ql--query-predicate query)) (predicate (org-ql--query-predicate query))
@ -263,12 +263,12 @@ returns nil or non-nil."
(fset name fn))) (fset name fn)))
;; Run query on buffers. ;; Run query on buffers.
(->> buffers (->> buffers
(--map (with-current-buffer it (--map (with-current-buffer it
(unless (derived-mode-p 'org-mode) (unless (derived-mode-p 'org-mode)
(user-error "Not an Org buffer: %s" (buffer-name))) (user-error "Not an Org buffer: %s" (buffer-name)))
(org-ql--select-cached :query query :preamble preamble :preamble-case-fold preamble-case-fold (org-ql--select-cached :query query :preamble preamble :preamble-case-fold preamble-case-fold
:predicate predicate :action action :narrow narrow))) :predicate predicate :action action :narrow narrow)))
(-flatten-n 1))) (-flatten-n 1)))
(--each orig-fns (--each orig-fns
;; Restore original function mappings. ;; Restore original function mappings.
(-let (((&plist :name :fn) it)) (-let (((&plist :name :fn) it))
@ -422,7 +422,7 @@ Returns cons (INHERITED-TAGS . LOCAL-TAGS)."
(cond ((and (listp inherited) (cond ((and (listp inherited)
(listp local)) (listp local))
(->> (append inherited local) (->> (append inherited local)
-non-nil -uniq)) -non-nil -uniq))
((listp inherited) inherited) ((listp inherited) inherited)
((listp local) local))))) ((listp local) local)))))
(cl-typecase org-use-tag-inheritance (cl-typecase org-use-tag-inheritance
@ -518,8 +518,8 @@ from within ELEMENT's buffer."
;; time? I don't know, but for now, it seems that we have to use `copy-marker'. ;; time? I don't know, but for now, it seems that we have to use `copy-marker'.
(let* ((marker (copy-marker (org-element-property :begin element))) (let* ((marker (copy-marker (org-element-property :begin element)))
(properties (--> (cadr element) (properties (--> (cadr element)
(plist-put it :org-marker marker) (plist-put it :org-marker marker)
(plist-put it :org-hd-marker marker)))) (plist-put it :org-hd-marker marker))))
(setf (cadr element) properties) (setf (cadr element) properties)
element)) element))
@ -675,16 +675,16 @@ value of `org-ql-predicates')."
(let* ((names (--map (symbol-name (plist-get (cdr it) :name)) (let* ((names (--map (symbol-name (plist-get (cdr it) :name))
predicates)) predicates))
(aliases (->> predicates (aliases (->> predicates
(--map (plist-get (cdr it) :aliases)) (--map (plist-get (cdr it) :aliases))
-non-nil -non-nil
-flatten -flatten
(-map #'symbol-name))) (-map #'symbol-name)))
(predicate-names (->> (append names aliases) (predicate-names (->> (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,
;; and the shorter one is listed first, the shorter one fails to match. ;; and the shorter one is listed first, the shorter one fails to match.
(-sort (-on #'> #'length)))) (-sort (-on #'> #'length))))
(pexs `((query (+ term (pexs `((query (+ term
(opt (+ (syntax-class whitespace) (any))))) (opt (+ (syntax-class whitespace) (any)))))
(term (or (and negation (list positive-term) (term (or (and negation (list positive-term)
@ -757,8 +757,8 @@ manually; see the definition of `org-ql-defpred').")
"Define function `org-ql--normalize-query' for PREDICATES. "Define function `org-ql--normalize-query' for PREDICATES.
PREDICATES should be the value of `org-ql-predicates'." PREDICATES should be the value of `org-ql-predicates'."
(let ((normalizer-patterns (->> predicates (let ((normalizer-patterns (->> predicates
(--map (plist-get (cdr it) :normalizers)) (--map (plist-get (cdr it) :normalizers))
(-flatten-n 1)))) (-flatten-n 1))))
(fset 'org-ql--normalize-query (fset 'org-ql--normalize-query
(byte-compile (byte-compile
`(lambda (query) `(lambda (query)
@ -969,33 +969,33 @@ predicates."
(when from (when from
(setq from (pcase from (setq from (pcase from
((or 'today "today") (->> (ts-now) ((or 'today "today") (->> (ts-now)
(ts-apply :hour 0 :minute 0 :second 0))) (ts-apply :hour 0 :minute 0 :second 0)))
((pred numberp) (->> (ts-now) ((pred numberp) (->> (ts-now)
(ts-adjust 'day from) (ts-adjust 'day from)
(ts-apply :hour 0 :minute 0 :second 0))) (ts-apply :hour 0 :minute 0 :second 0)))
((and (pred stringp) ((and (pred stringp)
(guard (ignore-errors (cl-parse-integer from)))) (guard (ignore-errors (cl-parse-integer from))))
;; The `pcase' `let' pattern doesn't bind values in the ;; The `pcase' `let' pattern doesn't bind values in the
;; body forms, so we have to parse the integer again. ;; body forms, so we have to parse the integer again.
(->> (ts-now) (->> (ts-now)
(ts-adjust 'day (cl-parse-integer from)) (ts-adjust 'day (cl-parse-integer from))
(ts-apply :hour 0 :minute 0 :second 0))) (ts-apply :hour 0 :minute 0 :second 0)))
((pred stringp) (ts-parse-fill 'begin from)) ((pred stringp) (ts-parse-fill 'begin from))
((pred ts-p) from)))) ((pred ts-p) from))))
(when to (when to
(setq to (pcase to (setq to (pcase to
((or 'today "today") (->> (ts-now) ((or 'today "today") (->> (ts-now)
(ts-apply :hour 23 :minute 59 :second 59))) (ts-apply :hour 23 :minute 59 :second 59)))
((pred numberp) (->> (ts-now) ((pred numberp) (->> (ts-now)
(ts-adjust 'day to) (ts-adjust 'day to)
(ts-apply :hour 23 :minute 59 :second 59))) (ts-apply :hour 23 :minute 59 :second 59)))
((and (pred stringp) ((and (pred stringp)
(guard (ignore-errors (cl-parse-integer to)))) (guard (ignore-errors (cl-parse-integer to))))
;; The `pcase' `let' pattern doesn't bind values in the ;; The `pcase' `let' pattern doesn't bind values in the
;; body forms, so we have to parse the integer again. ;; body forms, so we have to parse the integer again.
(->> (ts-now) (->> (ts-now)
(ts-adjust 'day (cl-parse-integer to)) (ts-adjust 'day (cl-parse-integer to))
(ts-apply :hour 23 :minute 59 :second 59))) (ts-apply :hour 23 :minute 59 :second 59)))
((pred stringp) (ts-parse-fill 'end to)) ((pred stringp) (ts-parse-fill 'end to))
((pred ts-p) to)))))) ((pred ts-p) to))))))
@ -1628,8 +1628,8 @@ parseable by `parse-time-string' which may omit the time value."
:normalizers ((`(,predicate-names ,(and num-days (pred numberp))) :normalizers ((`(,predicate-names ,(and num-days (pred numberp)))
;; (clocked) and (closed) implicitly look into the past. ;; (clocked) and (closed) implicitly look into the past.
(let ((from (->> (ts-now) (let ((from (->> (ts-now)
(ts-adjust 'day (* -1 num-days)) (ts-adjust 'day (* -1 num-days))
(ts-apply :hour 0 :minute 0 :second 0)))) (ts-apply :hour 0 :minute 0 :second 0))))
`(clocked :from ,from)))) `(clocked :from ,from))))
:preambles ((`(,predicate-names ,(pred numberp)) :preambles ((`(,predicate-names ,(pred numberp))
(list :regexp org-ql-clock-regexp :query t)) (list :regexp org-ql-clock-regexp :query t))
@ -1658,8 +1658,8 @@ parseable by `parse-time-string' which may omit the time value."
:normalizers ((`(,predicate-names ,(and num-days (pred numberp))) :normalizers ((`(,predicate-names ,(and num-days (pred numberp)))
;; (clocked) and (closed) implicitly look into the past. ;; (clocked) and (closed) implicitly look into the past.
(let ((from (->> (ts-now) (let ((from (->> (ts-now)
(ts-adjust 'day (* -1 num-days)) (ts-adjust 'day (* -1 num-days))
(ts-apply :hour 0 :minute 0 :second 0)))) (ts-apply :hour 0 :minute 0 :second 0))))
`(closed :from ,from)))) `(closed :from ,from))))
:preambles ((`(,predicate-names . ,_) :preambles ((`(,predicate-names . ,_)
;; Predicate still needs testing. ;; Predicate still needs testing.
@ -1688,13 +1688,13 @@ parseable by `parse-time-string' which may omit the time value."
:normalizers ((`(,predicate-names auto) :normalizers ((`(,predicate-names auto)
;; Use `org-deadline-warning-days' as the :to arg. ;; Use `org-deadline-warning-days' as the :to arg.
(let ((to (->> (ts-now) (let ((to (->> (ts-now)
(ts-adjust 'day org-deadline-warning-days) (ts-adjust 'day org-deadline-warning-days)
(ts-apply :hour 23 :minute 59 :second 59)))) (ts-apply :hour 23 :minute 59 :second 59))))
`(deadline-warning :to ,to))) `(deadline-warning :to ,to)))
(`(,predicate-names ,(and num-days (pred numberp))) (`(,predicate-names ,(and num-days (pred numberp)))
(let ((to (->> (ts-now) (let ((to (->> (ts-now)
(ts-adjust 'day num-days) (ts-adjust 'day num-days)
(ts-apply :hour 23 :minute 59 :second 59)))) (ts-apply :hour 23 :minute 59 :second 59))))
`(deadline :to ,to)))) `(deadline :to ,to))))
;; NOTE: Does this normalizer cause the preamble to not be used? (Adding one to the deadline-warning definition to be sure.) ;; NOTE: Does this normalizer cause the preamble to not be used? (Adding one to the deadline-warning definition to be sure.)
:preambles ((`(,predicate-names . ,_) :preambles ((`(,predicate-names . ,_)
@ -1750,8 +1750,8 @@ FROM, TO, and ON should be either `ts' structs, or strings
parseable by `parse-time-string' which may omit the time value." parseable by `parse-time-string' which may omit the time value."
:normalizers ((`(,predicate-names ,(and num-days (pred numberp))) :normalizers ((`(,predicate-names ,(and num-days (pred numberp)))
(let ((to (->> (ts-now) (let ((to (->> (ts-now)
(ts-adjust 'day num-days) (ts-adjust 'day num-days)
(ts-apply :hour 23 :minute 59 :second 59)))) (ts-apply :hour 23 :minute 59 :second 59))))
`(planning :to ,to)))) `(planning :to ,to))))
:preambles ((`(,predicate-names . ,_) :preambles ((`(,predicate-names . ,_)
(list :regexp org-ql-planning-regexp :query query))) (list :regexp org-ql-planning-regexp :query query)))
@ -1778,8 +1778,8 @@ FROM, TO, and ON should be either `ts' structs, or strings
parseable by `parse-time-string' which may omit the time value." parseable by `parse-time-string' which may omit the time value."
:normalizers ((`(,predicate-names ,(and num-days (pred numberp))) :normalizers ((`(,predicate-names ,(and num-days (pred numberp)))
(let ((to (->> (ts-now) (let ((to (->> (ts-now)
(ts-adjust 'day num-days) (ts-adjust 'day num-days)
(ts-apply :hour 23 :minute 59 :second 59)))) (ts-apply :hour 23 :minute 59 :second 59))))
`(scheduled :to ,to)))) `(scheduled :to ,to))))
:preambles ((`(,predicate-names . ,_) :preambles ((`(,predicate-names . ,_)
(list :regexp org-scheduled-time-regexp :query query))) (list :regexp org-scheduled-time-regexp :query query)))

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

@ -105,9 +105,9 @@ Set at runtime by test suite.")
"Return buffer visiting FILENAME. "Return buffer visiting FILENAME.
FILENAME should be a file in the \"tests\" directory." FILENAME should be a file in the \"tests\" directory."
(->> (locate-dominating-file default-directory ".git") (->> (locate-dominating-file default-directory ".git")
(expand-file-name "tests") (expand-file-name "tests")
(expand-file-name filename) (expand-file-name filename)
find-file-noselect)) find-file-noselect))
;;;; Macros ;;;; Macros