Tidy: Indentation
For Emacs 29.1's and with-simulated-input's changes.
This commit is contained in:
Adam Porter
parent
c62ff77cd3
commit
004ed1ee0f
4 changed files with 312 additions and 314 deletions
|
|
@ -341,17 +341,17 @@ this (must be a single line in the Org buffer):
|
||||||
(setf elements (cl-etypecase take
|
(setf elements (cl-etypecase take
|
||||||
((and integer (satisfies cl-minusp)) (-take-last (abs take) elements))
|
((and integer (satisfies cl-minusp)) (-take-last (abs take) elements))
|
||||||
(integer (-take take elements)))))
|
(integer (-take take elements)))))
|
||||||
(cl-labels ((format-element
|
(cl-labels ((format-element (element)
|
||||||
(element) (string-join (cl-loop for column in columns
|
(string-join (cl-loop for column in columns
|
||||||
collect (or (pcase-exhaustive column
|
collect (or (pcase-exhaustive column
|
||||||
((pred symbolp)
|
((pred symbolp)
|
||||||
(funcall (alist-get column format-fns) element))
|
(funcall (alist-get column format-fns) element))
|
||||||
(`((,column . ,args) ,_header)
|
(`((,column . ,args) ,_header)
|
||||||
(apply (alist-get column format-fns) element args))
|
(apply (alist-get column format-fns) element args))
|
||||||
(`(,column ,_header)
|
(`(,column ,_header)
|
||||||
(funcall (alist-get column format-fns) element)))
|
(funcall (alist-get column format-fns) element)))
|
||||||
""))
|
""))
|
||||||
" | ")))
|
" | ")))
|
||||||
;; Table header
|
;; Table header
|
||||||
(insert "| " (string-join (--map (pcase it
|
(insert "| " (string-join (--map (pcase it
|
||||||
((pred symbolp) (capitalize (symbol-name it)))
|
((pred symbolp) (capitalize (symbol-name it)))
|
||||||
|
|
|
||||||
|
|
@ -487,11 +487,11 @@ If TITLE, prepend it to the header."
|
||||||
Makes QUERY more readable, e.g. timestamp objects are replaced
|
Makes QUERY more readable, e.g. timestamp objects are replaced
|
||||||
with human-readable strings."
|
with human-readable strings."
|
||||||
(cl-labels ((rec (form)
|
(cl-labels ((rec (form)
|
||||||
(cl-typecase form
|
(cl-typecase form
|
||||||
(ts (ts-format form))
|
(ts (ts-format form))
|
||||||
(cons (cons (rec (car form))
|
(cons (cons (rec (car form))
|
||||||
(rec (cdr form))))
|
(rec (cdr form))))
|
||||||
(otherwise form))))
|
(otherwise form))))
|
||||||
(format "%S" (rec query))))
|
(format "%S" (rec query))))
|
||||||
|
|
||||||
(defun org-ql-view--font-lock-string (mode s)
|
(defun org-ql-view--font-lock-string (mode s)
|
||||||
|
|
@ -533,14 +533,14 @@ dates in the past, and negative for dates in the future."
|
||||||
|
|
||||||
(defun org-ql-view-bookmark-make-record ()
|
(defun org-ql-view-bookmark-make-record ()
|
||||||
"Return a bookmark record for the current Org QL View buffer."
|
"Return a bookmark record for the current Org QL View buffer."
|
||||||
(cl-labels ((file-nameize
|
(cl-labels ((file-nameize (b-f)
|
||||||
(b-f) (abbreviate-file-name
|
(abbreviate-file-name
|
||||||
(cl-typecase b-f
|
(cl-typecase b-f
|
||||||
(string b-f)
|
(string b-f)
|
||||||
(buffer (or (buffer-file-name b-f)
|
(buffer (or (buffer-file-name b-f)
|
||||||
(when (buffer-base-buffer b-f)
|
(when (buffer-base-buffer b-f)
|
||||||
(buffer-file-name (buffer-base-buffer b-f)))))
|
(buffer-file-name (buffer-base-buffer b-f)))))
|
||||||
(t (user-error "Only file-backed buffers can be bookmarked by Org QL View: %s" b-f))))))
|
(t (user-error "Only file-backed buffers can be bookmarked by Org QL View: %s" b-f))))))
|
||||||
(-let* ((plist (org-ql-view--plist (current-buffer)))
|
(-let* ((plist (org-ql-view--plist (current-buffer)))
|
||||||
((&plist :buffers-files) plist))
|
((&plist :buffers-files) plist))
|
||||||
;; Replace buffers with their filenames, and signal error if any are not file-backed.
|
;; Replace buffers with their filenames, and signal error if any are not file-backed.
|
||||||
|
|
@ -655,23 +655,25 @@ When opened, the link searches the buffer it's opened from."
|
||||||
(when org-ql-view-query
|
(when org-ql-view-query
|
||||||
;; Only Org QL View buffers should have `org-ql-view-query' set.
|
;; Only Org QL View buffers should have `org-ql-view-query' set.
|
||||||
(cl-labels ((prompt-for (buffers-files)
|
(cl-labels ((prompt-for (buffers-files)
|
||||||
(pcase-exhaustive
|
(pcase-exhaustive
|
||||||
(completing-read (format "Make link that searches: ")
|
(completing-read (format "Make link that searches: ")
|
||||||
'("file link is in" "files currently searched")
|
'("file link is in" "files currently searched")
|
||||||
nil t nil nil "file link is in")
|
nil t nil nil "file link is in")
|
||||||
("file link is in" nil)
|
("file link is in" nil)
|
||||||
("files currently searched" buffers-files)))
|
("files currently searched" buffers-files)))
|
||||||
(strings-or-file-buffers-p
|
(strings-or-file-buffers-p (thing)
|
||||||
(thing) (cl-etypecase thing
|
(cl-etypecase thing
|
||||||
(list (cl-every #'strings-or-file-buffers-p thing))
|
(list (cl-every #'strings-or-file-buffers-p thing))
|
||||||
(string thing)
|
(string thing)
|
||||||
(buffer (or (buffer-file-name thing)
|
(buffer (or (buffer-file-name thing)
|
||||||
;; TODO: Should indirect buffers be allowed? Maybe not, since their narrowing isn't preserved.
|
;; TODO: Should indirect buffers be allowed? Maybe not, since their
|
||||||
;; On the other hand, it's possible to accidentally make a search view for an indirect buffer
|
;; narrowing isn't preserved. On the other hand, it's possible to
|
||||||
;; that's since been widened, and forcing the user to manually change that would be awkward,
|
;; accidentally make a search view for an indirect buffer that's
|
||||||
;; and trying to communicate the problem would be difficult, so maybe it's okay to allow it.
|
;; since been widened, and forcing the user to manually change that
|
||||||
(when (buffer-base-buffer thing)
|
;; would be awkward, and trying to communicate the problem would be
|
||||||
(buffer-file-name (buffer-base-buffer thing))))))))
|
;; difficult, so maybe it's okay to allow it.
|
||||||
|
(when (buffer-base-buffer thing)
|
||||||
|
(buffer-file-name (buffer-base-buffer thing))))))))
|
||||||
(unless (strings-or-file-buffers-p org-ql-view-buffers-files)
|
(unless (strings-or-file-buffers-p org-ql-view-buffers-files)
|
||||||
(user-error "%s" "Views that search non-file-backed buffers can't be linked to"))
|
(user-error "%s" "Views that search non-file-backed buffers can't be linked to"))
|
||||||
(let* ((query-string (--if-let (org-ql--query-sexp-to-string org-ql-view-query)
|
(let* ((query-string (--if-let (org-ql--query-sexp-to-string org-ql-view-query)
|
||||||
|
|
@ -1048,11 +1050,11 @@ the variable), \"org-directory\" if it matches the value of
|
||||||
current buffer. Otherwise BUFFERS-FILES is returned unchanged."
|
current buffer. Otherwise BUFFERS-FILES is returned unchanged."
|
||||||
;; Used in `org-ql-view--complete-buffers-files' and
|
;; Used in `org-ql-view--complete-buffers-files' and
|
||||||
;; `org-ql-view--header-line-format'.
|
;; `org-ql-view--header-line-format'.
|
||||||
(cl-labels ((expand-files
|
(cl-labels ((expand-files (list)
|
||||||
(list) (--map (cl-typecase it
|
(--map (cl-typecase it
|
||||||
(string (expand-file-name it))
|
(string (expand-file-name it))
|
||||||
(otherwise it))
|
(otherwise it))
|
||||||
list)))
|
list)))
|
||||||
;; TODO: Test this more exhaustively.
|
;; TODO: Test this more exhaustively.
|
||||||
(pcase buffers-files
|
(pcase buffers-files
|
||||||
((pred listp)
|
((pred listp)
|
||||||
|
|
@ -1074,10 +1076,10 @@ current buffer. Otherwise BUFFERS-FILES is returned unchanged."
|
||||||
|
|
||||||
(defun org-ql-view--complete-buffers-files ()
|
(defun org-ql-view--complete-buffers-files ()
|
||||||
"Return value for `org-ql-view-buffers-files' using completion."
|
"Return value for `org-ql-view-buffers-files' using completion."
|
||||||
(cl-labels ((initial-input
|
(cl-labels ((initial-input ()
|
||||||
() (when org-ql-view-buffers-files
|
(when org-ql-view-buffers-files
|
||||||
(org-ql-view--contract-buffers-files
|
(org-ql-view--contract-buffers-files
|
||||||
org-ql-view-buffers-files))))
|
org-ql-view-buffers-files))))
|
||||||
(if (and org-ql-view-buffers-files
|
(if (and org-ql-view-buffers-files
|
||||||
(bufferp org-ql-view-buffers-files))
|
(bufferp org-ql-view-buffers-files))
|
||||||
;; Buffers can't be input by name, so if the default value is a buffer, just use it.
|
;; Buffers can't be input by name, so if the default value is a buffer, just use it.
|
||||||
|
|
|
||||||
403
org-ql.el
403
org-ql.el
|
|
@ -755,38 +755,38 @@ be coalesced."
|
||||||
;; can't be coalesced with it since they don't specify the same
|
;; can't be coalesced with it since they don't specify the same
|
||||||
;; language. That could be fixed, but it's probably not worth it.
|
;; language. That could be fixed, but it's probably not worth it.
|
||||||
(cl-labels ((rec (sexp)
|
(cl-labels ((rec (sexp)
|
||||||
(pcase sexp
|
(pcase sexp
|
||||||
(`(,(and boolean (or 'or 'not)) . ,sexps)
|
(`(,(and boolean (or 'or 'not)) . ,sexps)
|
||||||
`(,boolean ,@(mapcar #'rec sexps)))
|
`(,boolean ,@(mapcar #'rec sexps)))
|
||||||
(`(and . ,sexps)
|
(`(and . ,sexps)
|
||||||
(anded sexps))
|
(anded sexps))
|
||||||
(_ sexp)))
|
(_ sexp)))
|
||||||
(anded (sexps)
|
(anded (sexps)
|
||||||
(let (anded-predicates new-sexp)
|
(let (anded-predicates new-sexp)
|
||||||
(dolist (sexp sexps)
|
(dolist (sexp sexps)
|
||||||
(pcase sexp
|
(pcase sexp
|
||||||
(`(,(or 'or 'not) . ,_)
|
(`(,(or 'or 'not) . ,_)
|
||||||
(push (rec sexp) new-sexp))
|
(push (rec sexp) new-sexp))
|
||||||
(`(,predicate . ,args)
|
(`(,predicate . ,args)
|
||||||
(pcase-exhaustive (plist-get (alist-get predicate org-ql-predicates) :coalesce)
|
(pcase-exhaustive (plist-get (alist-get predicate org-ql-predicates) :coalesce)
|
||||||
(`nil (push sexp new-sexp))
|
(`nil (push sexp new-sexp))
|
||||||
(`t (setf (alist-get predicate anded-predicates)
|
(`t (setf (alist-get predicate anded-predicates)
|
||||||
(append (alist-get predicate anded-predicates) args)))
|
(append (alist-get predicate anded-predicates) args)))
|
||||||
((and fn (pred functionp))
|
((and fn (pred functionp))
|
||||||
(if-let (new-args (funcall fn (alist-get predicate anded-predicates) args))
|
(if-let (new-args (funcall fn (alist-get predicate anded-predicates) args))
|
||||||
(setf (alist-get predicate anded-predicates) new-args)
|
(setf (alist-get predicate anded-predicates) new-args)
|
||||||
(push sexp new-sexp)))))))
|
(push sexp new-sexp)))))))
|
||||||
(delq nil `(and ,@(nreverse new-sexp) ,@(nreverse anded-predicates))))))
|
(delq nil `(and ,@(nreverse new-sexp) ,@(nreverse anded-predicates))))))
|
||||||
(rec query)))
|
(rec query)))
|
||||||
|
|
||||||
(defun org-ql--sanity-check-form (form)
|
(defun org-ql--sanity-check-form (form)
|
||||||
"Signal error if any forms in FORM do not have preconditions met.
|
"Signal error if any forms in FORM do not have preconditions met.
|
||||||
Or, when possible, fix the problem."
|
Or, when possible, fix the problem."
|
||||||
(cl-flet ((check (symbol)
|
(cl-flet ((check (symbol)
|
||||||
(pcase symbol
|
(pcase symbol
|
||||||
('done (unless org-done-keywords
|
('done (unless org-done-keywords
|
||||||
;; NOTE: This check needs to be done from within the Org buffer being checked.
|
;; NOTE: This check needs to be done from within the Org buffer being checked.
|
||||||
(error "Variable `org-done-keywords' is nil. Are you running this from an Org buffer?"))))))
|
(error "Variable `org-done-keywords' is nil. Are you running this from an Org buffer?"))))))
|
||||||
(cl-loop for elem in form
|
(cl-loop for elem in form
|
||||||
if (consp elem)
|
if (consp elem)
|
||||||
do (progn
|
do (progn
|
||||||
|
|
@ -808,28 +808,27 @@ respectively."
|
||||||
(and "\\" (0+ "\\\\") (any "[]"))
|
(and "\\" (0+ "\\\\") (any "[]"))
|
||||||
(and (1+ "\\") (not (any "[]")))))))
|
(and (1+ "\\") (not (any "[]")))))))
|
||||||
(cl-labels
|
(cl-labels
|
||||||
((no-desc
|
((no-desc (match)
|
||||||
(match) (rx-to-string `(seq (or bol (1+ blank))
|
(rx-to-string `(seq (or bol (1+ blank))
|
||||||
"[[" ,link-target-part (regexp ,match) ,link-target-part
|
"[[" ,link-target-part (regexp ,match) ,link-target-part
|
||||||
"]]")))
|
"]]")))
|
||||||
(match-both
|
(match-both (description target)
|
||||||
(description target)
|
(rx-to-string `(seq (or bol (1+ blank))
|
||||||
(rx-to-string `(seq (or bol (1+ blank))
|
"[[" ,link-target-part (regexp ,target) ,link-target-part
|
||||||
"[[" ,link-target-part (regexp ,target) ,link-target-part
|
"][" (*? anything) (regexp ,description) (*? anything)
|
||||||
"][" (*? anything) (regexp ,description) (*? anything)
|
"]]")))
|
||||||
"]]")))
|
|
||||||
;; Note that these actually allow empty descriptions
|
;; Note that these actually allow empty descriptions
|
||||||
;; or targets, depending on what they are matching.
|
;; or targets, depending on what they are matching.
|
||||||
(match-desc
|
(match-desc (match)
|
||||||
(match) (rx-to-string `(seq (or bol (1+ blank))
|
(rx-to-string `(seq (or bol (1+ blank))
|
||||||
"[[" ,link-target-part
|
"[[" ,link-target-part
|
||||||
"][" (*? anything) (regexp ,match) (*? anything)
|
"][" (*? anything) (regexp ,match) (*? anything)
|
||||||
"]]")))
|
"]]")))
|
||||||
(match-target
|
(match-target (match)
|
||||||
(match) (rx-to-string `(seq (or bol (1+ blank))
|
(rx-to-string `(seq (or bol (1+ blank))
|
||||||
"[[" ,link-target-part (regexp ,match) ,link-target-part
|
"[[" ,link-target-part (regexp ,match) ,link-target-part
|
||||||
"][" (*? anything)
|
"][" (*? anything)
|
||||||
"]]"))))
|
"]]"))))
|
||||||
(cond (description-or-target
|
(cond (description-or-target
|
||||||
(rx-to-string `(or (regexp ,(no-desc description-or-target))
|
(rx-to-string `(or (regexp ,(no-desc description-or-target))
|
||||||
(regexp ,(match-desc description-or-target))
|
(regexp ,(match-desc description-or-target))
|
||||||
|
|
@ -884,48 +883,48 @@ Arguments STRING, POS, FILL, and LEVEL are according to
|
||||||
;; NOTE: The pcases check for both t/nil symbols and strings, because the
|
;; NOTE: The pcases check for both t/nil symbols and strings, because the
|
||||||
;; string queries always return keyword arguments' values as strings.
|
;; string queries always return keyword arguments' values as strings.
|
||||||
(cl-macrolet ((clocked (&key from to on)
|
(cl-macrolet ((clocked (&key from to on)
|
||||||
`(org-ql--predicate-clocked :from ,from :to ,to))
|
`(org-ql--predicate-clocked :from ,from :to ,to))
|
||||||
(closed (&key from to on (with-time 'not-found))
|
(closed (&key from to on (with-time 'not-found))
|
||||||
`(org-ql--predicate-closed :from ,from :to ,to))
|
`(org-ql--predicate-closed :from ,from :to ,to))
|
||||||
(deadline (&key from to on (with-time 'not-found))
|
(deadline (&key from to on (with-time 'not-found))
|
||||||
`(org-ql--predicate-deadline
|
`(org-ql--predicate-deadline
|
||||||
:from ,from :to ,to :with-time ',with-time
|
:from ,from :to ,to :with-time ',with-time
|
||||||
:regexp ,(pcase-exhaustive with-time
|
:regexp ,(pcase-exhaustive with-time
|
||||||
((or 't "t") org-ql-regexp-deadline-with-time)
|
((or 't "t") org-ql-regexp-deadline-with-time)
|
||||||
((or 'nil "nil") org-ql-regexp-deadline-without-time)
|
((or 'nil "nil") org-ql-regexp-deadline-without-time)
|
||||||
('not-found org-ql-regexp-deadline))))
|
('not-found org-ql-regexp-deadline))))
|
||||||
(planning (&key from to on (with-time 'not-found))
|
(planning (&key from to on (with-time 'not-found))
|
||||||
`(org-ql--predicate-planning
|
`(org-ql--predicate-planning
|
||||||
:from ,from :to ,to :with-time ',with-time
|
:from ,from :to ,to :with-time ',with-time
|
||||||
:regexp ,(pcase-exhaustive with-time
|
:regexp ,(pcase-exhaustive with-time
|
||||||
((or 't "t") org-ql-regexp-planning-with-time)
|
((or 't "t") org-ql-regexp-planning-with-time)
|
||||||
((or 'nil "nil") org-ql-regexp-planning-without-time)
|
((or 'nil "nil") org-ql-regexp-planning-without-time)
|
||||||
('not-found org-ql-regexp-planning))))
|
('not-found org-ql-regexp-planning))))
|
||||||
(scheduled (&key from to on (with-time 'not-found))
|
(scheduled (&key from to on (with-time 'not-found))
|
||||||
`(org-ql--predicate-scheduled
|
`(org-ql--predicate-scheduled
|
||||||
:from ,from :to ,to :with-time ',with-time
|
:from ,from :to ,to :with-time ',with-time
|
||||||
:regexp ,(pcase-exhaustive with-time
|
:regexp ,(pcase-exhaustive with-time
|
||||||
((or 't "t") org-ql-regexp-scheduled-with-time)
|
((or 't "t") org-ql-regexp-scheduled-with-time)
|
||||||
((or 'nil "nil") org-ql-regexp-scheduled-without-time)
|
((or 'nil "nil") org-ql-regexp-scheduled-without-time)
|
||||||
('not-found org-ql-regexp-scheduled))))
|
('not-found org-ql-regexp-scheduled))))
|
||||||
(ts (&key from to on (type 'both) (with-time 'not-found))
|
(ts (&key from to on (type 'both) (with-time 'not-found))
|
||||||
;; NOTE: The TYPE argument is elided from the arguments actually passed to the predicate, being converted to the REGEXP argument.
|
;; NOTE: The TYPE argument is elided from the arguments actually passed to the predicate, being converted to the REGEXP argument.
|
||||||
;; MAYBE: Move the :regexp handling out of this macrolet and into the normalizer.
|
;; MAYBE: Move the :regexp handling out of this macrolet and into the normalizer.
|
||||||
`(org-ql--predicate-ts
|
`(org-ql--predicate-ts
|
||||||
:from ,from :to ,to :with-time ',with-time
|
:from ,from :to ,to :with-time ',with-time
|
||||||
:regexp ,(pcase type
|
:regexp ,(pcase type
|
||||||
((or 'nil 'both) (pcase-exhaustive with-time
|
((or 'nil 'both) (pcase-exhaustive with-time
|
||||||
((or 't "t") org-ql-regexp-ts-both-with-time)
|
((or 't "t") org-ql-regexp-ts-both-with-time)
|
||||||
((or 'nil "nil") org-ql-regexp-ts-both-without-time)
|
((or 'nil "nil") org-ql-regexp-ts-both-without-time)
|
||||||
('not-found org-ql-regexp-ts-both)))
|
('not-found org-ql-regexp-ts-both)))
|
||||||
('active (pcase-exhaustive with-time
|
('active (pcase-exhaustive with-time
|
||||||
((or 't "t") org-ql-regexp-ts-active-with-time)
|
((or 't "t") org-ql-regexp-ts-active-with-time)
|
||||||
((or 'nil "nil") org-ql-regexp-ts-active-without-time)
|
((or 'nil "nil") org-ql-regexp-ts-active-without-time)
|
||||||
('not-found org-ql-regexp-ts-active)))
|
('not-found org-ql-regexp-ts-active)))
|
||||||
('inactive (pcase-exhaustive with-time
|
('inactive (pcase-exhaustive with-time
|
||||||
((or 't "t") org-ql-regexp-ts-inactive-with-time)
|
((or 't "t") org-ql-regexp-ts-inactive-with-time)
|
||||||
((or 'nil "nil") org-ql-regexp-ts-inactive-without-time)
|
((or 'nil "nil") org-ql-regexp-ts-inactive-without-time)
|
||||||
('not-found org-ql-regexp-ts-inactive)))))))
|
('not-found org-ql-regexp-ts-inactive)))))))
|
||||||
,query)))))
|
,query)))))
|
||||||
|
|
||||||
;;;;; String query parsing
|
;;;;; String query parsing
|
||||||
|
|
@ -1042,21 +1041,21 @@ This function is defined by calling
|
||||||
`org-ql--define-normalize-query-fn', which uses normalizer forms
|
`org-ql--define-normalize-query-fn', which uses normalizer forms
|
||||||
defined in `org-ql-predicates' by calling `org-ql-defpred'."
|
defined in `org-ql-predicates' by calling `org-ql-defpred'."
|
||||||
(cl-labels ((rec (element)
|
(cl-labels ((rec (element)
|
||||||
(pcase element
|
(pcase element
|
||||||
(`(or . ,clauses) `(or ,@(mapcar #'rec clauses)))
|
(`(or . ,clauses) `(or ,@(mapcar #'rec clauses)))
|
||||||
(`(and . ,clauses) `(and ,@(mapcar #'rec clauses)))
|
(`(and . ,clauses) `(and ,@(mapcar #'rec clauses)))
|
||||||
(`(not . ,clauses) `(not ,@(mapcar #'rec clauses)))
|
(`(not . ,clauses) `(not ,@(mapcar #'rec clauses)))
|
||||||
(`(when ,condition . ,clauses) `(when ,(rec condition)
|
(`(when ,condition . ,clauses) `(when ,(rec condition)
|
||||||
,@(mapcar #'rec clauses)))
|
,@(mapcar #'rec clauses)))
|
||||||
(`(unless ,condition . ,clauses) `(unless ,(rec condition)
|
(`(unless ,condition . ,clauses) `(unless ,(rec condition)
|
||||||
,@(mapcar #'rec clauses)))
|
,@(mapcar #'rec clauses)))
|
||||||
;; TODO: Combine (regexp) when appropriate (i.e. inside an OR, not an AND).
|
;; TODO: Combine (regexp) when appropriate (i.e. inside an OR, not an AND).
|
||||||
((pred stringp) `(,org-ql-default-predicate ,element))
|
((pred stringp) `(,org-ql-default-predicate ,element))
|
||||||
|
|
||||||
,@normalizer-patterns
|
,@normalizer-patterns
|
||||||
|
|
||||||
;; Any other form: passed through unchanged.
|
;; Any other form: passed through unchanged.
|
||||||
(_ element))))
|
(_ element))))
|
||||||
;; Repeat normalization until result doesn't change (limiting to 10 in case of an infinite-loop bug).
|
;; Repeat normalization until result doesn't change (limiting to 10 in case of an infinite-loop bug).
|
||||||
(cl-loop with limit = 10 and count = 0
|
(cl-loop with limit = 10 and count = 0
|
||||||
for new-query = (rec query)
|
for new-query = (rec query)
|
||||||
|
|
@ -1109,18 +1108,18 @@ defined in `org-ql-predicates' by calling `org-ql-defpred'."
|
||||||
(_ (let ((preamble-case-fold t)
|
(_ (let ((preamble-case-fold t)
|
||||||
org-ql-preamble)
|
org-ql-preamble)
|
||||||
(cl-labels ((rec (element)
|
(cl-labels ((rec (element)
|
||||||
(or (when org-ql-preamble
|
(or (when org-ql-preamble
|
||||||
;; Only one preamble is allowed
|
;; Only one preamble is allowed
|
||||||
element)
|
element)
|
||||||
(pcase element
|
(pcase element
|
||||||
(`(or _) element)
|
(`(or _) element)
|
||||||
|
|
||||||
,@preamble-patterns
|
,@preamble-patterns
|
||||||
|
|
||||||
(`(and . ,rest)
|
(`(and . ,rest)
|
||||||
(let ((clauses (mapcar #'rec rest)))
|
(let ((clauses (mapcar #'rec rest)))
|
||||||
`(and ,@(-non-nil clauses))))
|
`(and ,@(-non-nil clauses))))
|
||||||
(_ element)))))
|
(_ element)))))
|
||||||
(setq query (pcase (mapcar #'rec (list query))
|
(setq query (pcase (mapcar #'rec (list query))
|
||||||
((or `(nil)
|
((or `(nil)
|
||||||
`((nil))
|
`((nil))
|
||||||
|
|
@ -1984,8 +1983,8 @@ language. Matching is done case-insensitively."
|
||||||
Tests both inherited and local tags."
|
Tests both inherited and local tags."
|
||||||
;; MAYBE: -all versions for inherited and local.
|
;; MAYBE: -all versions for inherited and local.
|
||||||
:body (cl-macrolet ((tags-p (tags)
|
:body (cl-macrolet ((tags-p (tags)
|
||||||
`(and ,tags
|
`(and ,tags
|
||||||
(not (eq 'org-ql-nil ,tags)))))
|
(not (eq 'org-ql-nil ,tags)))))
|
||||||
(-let* (((inherited local) (org-ql--tags-at (point))))
|
(-let* (((inherited local) (org-ql--tags-at (point))))
|
||||||
(cl-typecase tags
|
(cl-typecase tags
|
||||||
(null (or (tags-p inherited)
|
(null (or (tags-p inherited)
|
||||||
|
|
@ -2010,8 +2009,8 @@ If TAGS is nil, return non-nil if heading has any inherited tags."
|
||||||
:normalizers ((`(,predicate-names . ,tags)
|
:normalizers ((`(,predicate-names . ,tags)
|
||||||
`(tags-inherited ,@tags)))
|
`(tags-inherited ,@tags)))
|
||||||
:body (cl-macrolet ((tags-p (tags)
|
:body (cl-macrolet ((tags-p (tags)
|
||||||
`(and ,tags
|
`(and ,tags
|
||||||
(not (eq 'org-ql-nil ,tags)))))
|
(not (eq 'org-ql-nil ,tags)))))
|
||||||
(-let* (((inherited _) (org-ql--tags-at (point))))
|
(-let* (((inherited _) (org-ql--tags-at (point))))
|
||||||
(cl-typecase tags
|
(cl-typecase tags
|
||||||
(null (tags-p inherited))
|
(null (tags-p inherited))
|
||||||
|
|
@ -2031,8 +2030,8 @@ If TAGS is nil, return non-nil if heading has any local tags."
|
||||||
t)
|
t)
|
||||||
:query t)))
|
:query t)))
|
||||||
:body (cl-macrolet ((tags-p (tags)
|
:body (cl-macrolet ((tags-p (tags)
|
||||||
`(and ,tags
|
`(and ,tags
|
||||||
(not (eq 'org-ql-nil ,tags)))))
|
(not (eq 'org-ql-nil ,tags)))))
|
||||||
(-let* (((_ local) (org-ql--tags-at (point))))
|
(-let* (((_ local) (org-ql--tags-at (point))))
|
||||||
(cl-typecase tags
|
(cl-typecase tags
|
||||||
(null (tags-p local))
|
(null (tags-p local))
|
||||||
|
|
@ -2045,8 +2044,8 @@ Tests both inherited and local tags."
|
||||||
:normalizers ((`(,predicate-names . ,regexps)
|
:normalizers ((`(,predicate-names . ,regexps)
|
||||||
`(tags-regexp ,@regexps)))
|
`(tags-regexp ,@regexps)))
|
||||||
:body (cl-macrolet ((tags-p (tags)
|
:body (cl-macrolet ((tags-p (tags)
|
||||||
`(and ,tags
|
`(and ,tags
|
||||||
(not (eq 'org-ql-nil ,tags)))))
|
(not (eq 'org-ql-nil ,tags)))))
|
||||||
(-let* (((inherited local) (org-ql--tags-at (point))))
|
(-let* (((inherited local) (org-ql--tags-at (point))))
|
||||||
(cl-typecase regexps
|
(cl-typecase regexps
|
||||||
(null (or (tags-p inherited)
|
(null (or (tags-p inherited)
|
||||||
|
|
@ -2394,12 +2393,12 @@ any planning prefix); it defaults to 0 (i.e. the whole regexp)."
|
||||||
|
|
||||||
:body
|
:body
|
||||||
(cl-macrolet ((next-timestamp ()
|
(cl-macrolet ((next-timestamp ()
|
||||||
`(when (re-search-forward regexp limit t)
|
`(when (re-search-forward regexp limit t)
|
||||||
(ts-parse-org (match-string match-group))))
|
(ts-parse-org (match-string match-group))))
|
||||||
(test-timestamps (pred-form)
|
(test-timestamps (pred-form)
|
||||||
`(cl-loop for next-ts = (next-timestamp)
|
`(cl-loop for next-ts = (next-timestamp)
|
||||||
while next-ts
|
while next-ts
|
||||||
thereis ,pred-form)))
|
thereis ,pred-form)))
|
||||||
(save-excursion
|
(save-excursion
|
||||||
(cond ((not (or from to)) (re-search-forward regexp limit t))
|
(cond ((not (or from to)) (re-search-forward regexp limit t))
|
||||||
((and from to) (test-timestamps (ts-in from to next-ts)))
|
((and from to) (test-timestamps (ts-in from to next-ts)))
|
||||||
|
|
@ -2425,27 +2424,27 @@ PREDICATES is a list of one or more sorting methods, including:
|
||||||
`deadline', `scheduled', `closed' and `priority'."
|
`deadline', `scheduled', `closed' and `priority'."
|
||||||
;; MAYBE: Use macrolet instead of flet.
|
;; MAYBE: Use macrolet instead of flet.
|
||||||
(cl-flet* ((sorter (symbol)
|
(cl-flet* ((sorter (symbol)
|
||||||
(pcase symbol
|
(pcase symbol
|
||||||
((or 'deadline 'scheduled 'closed)
|
((or 'deadline 'scheduled 'closed)
|
||||||
(apply-partially #'org-ql--date-type< (intern (concat ":" (symbol-name symbol)))))
|
(apply-partially #'org-ql--date-type< (intern (concat ":" (symbol-name symbol)))))
|
||||||
;; TODO: Rename `date' to `planning'. `date' should be something else.
|
;; TODO: Rename `date' to `planning'. `date' should be something else.
|
||||||
('date #'org-ql--date<)
|
('date #'org-ql--date<)
|
||||||
('priority #'org-ql--priority<)
|
('priority #'org-ql--priority<)
|
||||||
('random (lambda (&rest _ignore)
|
('random (lambda (&rest _ignore)
|
||||||
(= 0 (random 2))))
|
(= 0 (random 2))))
|
||||||
;; NOTE: reverse and todo are handled below.
|
;; NOTE: reverse and todo are handled below.
|
||||||
;; TODO: Add more.
|
;; TODO: Add more.
|
||||||
(_ (user-error "Invalid sorting predicate: %s" symbol))))
|
(_ (user-error "Invalid sorting predicate: %s" symbol))))
|
||||||
(sort-by-todo-keyword (items)
|
(sort-by-todo-keyword (items)
|
||||||
(let* ((grouped-items (--group-by (when-let (keyword (org-element-property :todo-keyword it))
|
(let* ((grouped-items (--group-by (when-let (keyword (org-element-property :todo-keyword it))
|
||||||
(substring-no-properties keyword))
|
(substring-no-properties keyword))
|
||||||
items))
|
items))
|
||||||
(sorted-groups (cl-sort grouped-items #'<
|
(sorted-groups (cl-sort grouped-items #'<
|
||||||
:key (lambda (keyword)
|
:key (lambda (keyword)
|
||||||
(or (cl-position (car keyword) org-todo-keywords-1 :test #'string=)
|
(or (cl-position (car keyword) org-todo-keywords-1 :test #'string=)
|
||||||
;; Put at end of list if not found
|
;; Put at end of list if not found
|
||||||
(1+ (length org-todo-keywords-1)))))))
|
(1+ (length org-todo-keywords-1)))))))
|
||||||
(-flatten-n 1 (-map #'cdr sorted-groups)))))
|
(-flatten-n 1 (-map #'cdr sorted-groups)))))
|
||||||
(dolist (pred predicates)
|
(dolist (pred predicates)
|
||||||
(setq items (pcase pred
|
(setq items (pcase pred
|
||||||
;; NOTE: Using `reverse' instead of `nreverse' because my gut
|
;; NOTE: Using `reverse' instead of `nreverse' because my gut
|
||||||
|
|
@ -2470,16 +2469,16 @@ A and B are Org headline elements. TYPE should be a symbol like
|
||||||
"Return non-nil if A's deadline or scheduled property is earlier than B's.
|
"Return non-nil if A's deadline or scheduled property is earlier than B's.
|
||||||
Deadline is considered before scheduled."
|
Deadline is considered before scheduled."
|
||||||
(cl-macrolet ((ts (item)
|
(cl-macrolet ((ts (item)
|
||||||
`(or (org-element-property :deadline ,item)
|
`(or (org-element-property :deadline ,item)
|
||||||
(org-element-property :scheduled ,item))))
|
(org-element-property :scheduled ,item))))
|
||||||
(org-ql--org-timestamp-element< (ts a) (ts b))))
|
(org-ql--org-timestamp-element< (ts a) (ts b))))
|
||||||
|
|
||||||
(defun org-ql--org-timestamp-element< (a b)
|
(defun org-ql--org-timestamp-element< (a b)
|
||||||
"Return non-nil if A's date element is earlier than B's.
|
"Return non-nil if A's date element is earlier than B's.
|
||||||
A and B are Org timestamp elements."
|
A and B are Org timestamp elements."
|
||||||
(cl-macrolet ((ts (ts)
|
(cl-macrolet ((ts (ts)
|
||||||
`(when ,ts
|
`(when ,ts
|
||||||
(org-timestamp-format ,ts "%s"))))
|
(org-timestamp-format ,ts "%s"))))
|
||||||
(let* ((a-ts (ts a))
|
(let* ((a-ts (ts a))
|
||||||
(b-ts (ts b)))
|
(b-ts (ts b)))
|
||||||
(cond ((and a-ts b-ts)
|
(cond ((and a-ts b-ts)
|
||||||
|
|
@ -2491,7 +2490,7 @@ A and B are Org timestamp elements."
|
||||||
"Return non-nil if A's priority is higher than B's.
|
"Return non-nil if A's priority is higher than B's.
|
||||||
A and B are Org headline elements."
|
A and B are Org headline elements."
|
||||||
(cl-macrolet ((priority (item)
|
(cl-macrolet ((priority (item)
|
||||||
`(org-element-property :priority ,item)))
|
`(org-element-property :priority ,item)))
|
||||||
;; NOTE: Priorities are numbers in Org elements. This might differ from the priority selector logic.
|
;; NOTE: Priorities are numbers in Org elements. This might differ from the priority selector logic.
|
||||||
(let ((a-priority (priority a))
|
(let ((a-priority (priority a))
|
||||||
(b-priority (priority b)))
|
(b-priority (priority b)))
|
||||||
|
|
@ -2519,66 +2518,66 @@ element should be a regexp string."
|
||||||
If QUERY can't be converted to a string, return nil."
|
If QUERY can't be converted to a string, return nil."
|
||||||
;; This started out pretty simple...but at least it's not just one long function, right?
|
;; This started out pretty simple...but at least it's not just one long function, right?
|
||||||
(cl-labels ((complex-p (query)
|
(cl-labels ((complex-p (query)
|
||||||
(or (contains-p 'or query)
|
(or (contains-p 'or query)
|
||||||
(contains-p 'ancestors query)
|
(contains-p 'ancestors query)
|
||||||
(contains-p 'children query)
|
(contains-p 'children query)
|
||||||
(contains-p 'descendants query)
|
(contains-p 'descendants query)
|
||||||
(contains-p 'parent query)))
|
(contains-p 'parent query)))
|
||||||
(contains-p (symbol list)
|
(contains-p (symbol list)
|
||||||
(cl-loop for element in list
|
(cl-loop for element in list
|
||||||
thereis (or (eq symbol element)
|
thereis (or (eq symbol element)
|
||||||
(and (listp element)
|
(and (listp element)
|
||||||
(contains-p symbol element)))))
|
(contains-p symbol element)))))
|
||||||
(format-args
|
(format-args (args)
|
||||||
(args) (let (non-paired paired next-keyword)
|
(let (non-paired paired next-keyword)
|
||||||
(cl-loop for arg in args
|
(cl-loop for arg in args
|
||||||
do (cond (next-keyword (push (cons next-keyword arg) paired)
|
do (cond (next-keyword (push (cons next-keyword arg) paired)
|
||||||
(setf next-keyword nil))
|
(setf next-keyword nil))
|
||||||
((keywordp arg) (setf next-keyword (substring (symbol-name arg) 1)))
|
((keywordp arg) (setf next-keyword (substring (symbol-name arg) 1)))
|
||||||
(t (push arg non-paired))))
|
(t (push arg non-paired))))
|
||||||
(string-join (append (mapcar #'format-atom non-paired)
|
(string-join (append (mapcar #'format-atom non-paired)
|
||||||
(nreverse (--map (format "%s=%s" (car it) (cdr it))
|
(nreverse (--map (format "%s=%s" (car it) (cdr it))
|
||||||
paired)))
|
paired)))
|
||||||
",")))
|
",")))
|
||||||
(format-atom
|
(format-atom (atom)
|
||||||
(atom) (cl-typecase atom
|
(cl-typecase atom
|
||||||
(string (if (string-match (rx space) atom)
|
(string (if (string-match (rx space) atom)
|
||||||
(format "%S" atom)
|
(format "%S" atom)
|
||||||
(format "%s" atom)))
|
(format "%s" atom)))
|
||||||
(t (format "%s" atom))))
|
(t (format "%s" atom))))
|
||||||
(format-form
|
(format-form (form)
|
||||||
(form) (pcase form
|
(pcase form
|
||||||
(`(not . (,rest)) (concat "!" (format-form rest)))
|
(`(not . (,rest)) (concat "!" (format-form rest)))
|
||||||
(`(priority . ,_) (format-priority form))
|
(`(priority . ,_) (format-priority form))
|
||||||
;; FIXME: Convert (src) queries to non-sexp form...someday...
|
;; FIXME: Convert (src) queries to non-sexp form...someday...
|
||||||
(`(src . ,_) (user-error "Converting (src ...) queries to non-sexp form is not implemented"))
|
(`(src . ,_) (user-error "Converting (src ...) queries to non-sexp form is not implemented"))
|
||||||
(_ (pcase-let* ((`(,pred . ,args) form)
|
(_ (pcase-let* ((`(,pred . ,args) form)
|
||||||
(args-string (pcase args
|
(args-string (pcase args
|
||||||
('() "")
|
('() "")
|
||||||
((guard (= 1 (length args))) (format "%s" (car args)))
|
((guard (= 1 (length args))) (format "%s" (car args)))
|
||||||
(_ (format-args args)))))
|
(_ (format-args args)))))
|
||||||
(format "%s:%s" pred args-string)))))
|
(format "%s:%s" pred args-string)))))
|
||||||
(format-and
|
(format-and (form)
|
||||||
(form) (pcase-let* ((`(and . ,rest) form))
|
(pcase-let* ((`(and . ,rest) form))
|
||||||
(string-join (mapcar #'format-form rest) " ")))
|
(string-join (mapcar #'format-form rest) " ")))
|
||||||
(format-priority
|
(format-priority (form)
|
||||||
(form) (pcase-let* ((`(priority . ,rest) form)
|
(pcase-let* ((`(priority . ,rest) form)
|
||||||
(args (pcase rest
|
(args (pcase rest
|
||||||
(`(,(and comparator (or '< '<= '> '>= '=)) ,letter)
|
(`(,(and comparator (or '< '<= '> '>= '=)) ,letter)
|
||||||
(priority-letters comparator letter))
|
(priority-letters comparator letter))
|
||||||
(_ rest))))
|
(_ rest))))
|
||||||
(concat "priority:" (string-join args ","))))
|
(concat "priority:" (string-join args ","))))
|
||||||
(priority-letters
|
(priority-letters (comparator letter)
|
||||||
(comparator letter) (let* ((char (string-to-char (upcase (symbol-name letter))))
|
(let* ((char (string-to-char (upcase (symbol-name letter))))
|
||||||
(numeric-priorities '(?A ?B ?C))
|
(numeric-priorities '(?A ?B ?C))
|
||||||
;; NOTE: The comparator inversion is intentional.
|
;; NOTE: The comparator inversion is intentional.
|
||||||
(others (pcase comparator
|
(others (pcase comparator
|
||||||
('< (--select (> it char) numeric-priorities))
|
('< (--select (> it char) numeric-priorities))
|
||||||
('<= (--select (>= it char) numeric-priorities))
|
('<= (--select (>= it char) numeric-priorities))
|
||||||
('> (--select (< it char) numeric-priorities))
|
('> (--select (< it char) numeric-priorities))
|
||||||
('>= (--select (<= it char) numeric-priorities))
|
('>= (--select (<= it char) numeric-priorities))
|
||||||
('= (--select (= it char) numeric-priorities)))))
|
('= (--select (= it char) numeric-priorities)))))
|
||||||
(mapcar #'char-to-string others))))
|
(mapcar #'char-to-string others))))
|
||||||
;; FIXME: Error out for ts structs passed to `ts' predicate (very unlikely to be linked to).
|
;; FIXME: Error out for ts structs passed to `ts' predicate (very unlikely to be linked to).
|
||||||
(unless (complex-p query)
|
(unless (complex-p query)
|
||||||
(pcase query
|
(pcase query
|
||||||
|
|
|
||||||
|
|
@ -1844,14 +1844,14 @@ with keyword arg NOW in PLIST."
|
||||||
;; have a chance to be gathered. So we make a test buffer and run the test in that, with a test heading.
|
;; have a chance to be gathered. So we make a test buffer and run the test in that, with a test heading.
|
||||||
|
|
||||||
(let ((test-buffer (get-buffer-create "*test-org-ql*")))
|
(let ((test-buffer (get-buffer-create "*test-org-ql*")))
|
||||||
(cl-flet ((open-link
|
(cl-flet ((open-link (link)
|
||||||
(link) (with-current-buffer test-buffer
|
(with-current-buffer test-buffer
|
||||||
(erase-buffer)
|
(erase-buffer)
|
||||||
(org-mode)
|
(org-mode)
|
||||||
(insert "* TODO Test heading \n\n")
|
(insert "* TODO Test heading \n\n")
|
||||||
(insert link)
|
(insert link)
|
||||||
(backward-char 1)
|
(backward-char 1)
|
||||||
(call-interactively #'org-open-at-point))))
|
(call-interactively #'org-open-at-point))))
|
||||||
|
|
||||||
(describe "buffers-files parameter"
|
(describe "buffers-files parameter"
|
||||||
:var ((quoted-lambda-link "[[org-ql-search:todo:?buffers-files%3D%28lambda%20nil%20%28error%20%22UNSAFE%22%29%29]]")
|
:var ((quoted-lambda-link "[[org-ql-search:todo:?buffers-files%3D%28lambda%20nil%20%28error%20%22UNSAFE%22%29%29]]")
|
||||||
|
|
@ -2006,16 +2006,15 @@ with keyword arg NOW in PLIST."
|
||||||
(when-let ((buffer (find-file-noselect filename 'nowarn)))
|
(when-let ((buffer (find-file-noselect filename 'nowarn)))
|
||||||
(kill-buffer buffer))))
|
(kill-buffer buffer))))
|
||||||
|
|
||||||
(cl-flet ((var-after-bookmark-set-and-jump
|
(cl-flet ((var-after-bookmark-set-and-jump (var buffers-files query &key sort super-groups)
|
||||||
(var buffers-files query &key sort super-groups)
|
(org-ql-search buffers-files query
|
||||||
(org-ql-search buffers-files query
|
:super-groups super-groups
|
||||||
:super-groups super-groups
|
:sort sort :title title :buffer view-buffer)
|
||||||
:sort sort :title title :buffer view-buffer)
|
(set-buffer view-buffer)
|
||||||
(set-buffer view-buffer)
|
(bookmark-set title)
|
||||||
(bookmark-set title)
|
(kill-buffer)
|
||||||
(kill-buffer)
|
(bookmark-jump title)
|
||||||
(bookmark-jump title)
|
(buffer-local-value var (get-buffer (concat "*Org QL View: " title "*")))))
|
||||||
(buffer-local-value var (get-buffer (concat "*Org QL View: " title "*")))))
|
|
||||||
|
|
||||||
(describe "Grouping"
|
(describe "Grouping"
|
||||||
:var ((query '(and (todo "TODO") (regexp "heading")))
|
:var ((query '(and (todo "TODO") (regexp "heading")))
|
||||||
|
|
@ -2069,18 +2068,18 @@ with keyword arg NOW in PLIST."
|
||||||
(describe "Dynamic blocks"
|
(describe "Dynamic blocks"
|
||||||
(describe "warn about sexp queries"
|
(describe "warn about sexp queries"
|
||||||
|
|
||||||
(cl-flet ((test-dblock
|
(cl-flet ((test-dblock (&optional input)
|
||||||
(&optional input) (with-current-buffer (get-buffer-create "*TEST DBLOCK*")
|
(with-current-buffer (get-buffer-create "*TEST DBLOCK*")
|
||||||
(erase-buffer)
|
(erase-buffer)
|
||||||
(org-mode)
|
(org-mode)
|
||||||
(insert "* TODO Heading 1\n\n"
|
(insert "* TODO Heading 1\n\n"
|
||||||
"#+BEGIN: org-ql :query (or (todo) (regexp \"Heading\")) :columns (todo)\n"
|
"#+BEGIN: org-ql :query (or (todo) (regexp \"Heading\")) :columns (todo)\n"
|
||||||
"#+END:")
|
"#+END:")
|
||||||
(goto-char (point-min))
|
(goto-char (point-min))
|
||||||
(forward-line 2)
|
(forward-line 2)
|
||||||
(with-simulated-input input
|
(with-simulated-input input
|
||||||
(org-dblock-update))
|
(org-dblock-update))
|
||||||
(kill-buffer))))
|
(kill-buffer))))
|
||||||
|
|
||||||
(it "when org-ql-ask-unsafe-queries is non-nil"
|
(it "when org-ql-ask-unsafe-queries is non-nil"
|
||||||
;; TODO: Should the query be converted to string form if possible and only warn if not?
|
;; TODO: Should the query be converted to string form if possible and only warn if not?
|
||||||
|
|
@ -2109,39 +2108,37 @@ with keyword arg NOW in PLIST."
|
||||||
(insert "* TODO Test heading\n\n")
|
(insert "* TODO Test heading\n\n")
|
||||||
(org-mode)))
|
(org-mode)))
|
||||||
|
|
||||||
(cl-flet* ((open-link-in
|
(cl-flet* ((open-link-in (link buffer input)
|
||||||
(link buffer input)
|
;; Org REDUCED THE NUMBER OF ARGUMENTS TO `org-open-link-from-string'! That BREAKS BACKWARD
|
||||||
;; Org REDUCED THE NUMBER OF ARGUMENTS TO `org-open-link-from-string'! That BREAKS BACKWARD
|
;; COMPATIBILITY! So I have to make my own function so these tests can work across Org versions!
|
||||||
;; COMPATIBILITY! So I have to make my own function so these tests can work across Org versions!
|
(with-current-buffer buffer
|
||||||
(with-current-buffer buffer
|
(erase-buffer)
|
||||||
(erase-buffer)
|
(org-mode)
|
||||||
(org-mode)
|
(insert "* TODO Test heading\n\n")
|
||||||
(insert "* TODO Test heading\n\n")
|
(insert link)
|
||||||
(insert link)
|
(backward-char 1)
|
||||||
(backward-char 1)
|
(with-simulated-input input
|
||||||
(with-simulated-input input
|
(org-open-at-point))))
|
||||||
(org-open-at-point))))
|
|
||||||
|
|
||||||
(var-after-link-save-open
|
(var-after-link-save-open (var buffers-files query &key sort super-groups
|
||||||
(var buffers-files query &key sort super-groups
|
(buffer link-buffer) (store-input "RET") open-input)
|
||||||
(buffer link-buffer) (store-input "RET") open-input)
|
(org-ql-search buffers-files query
|
||||||
(org-ql-search buffers-files query
|
:super-groups super-groups
|
||||||
:super-groups super-groups
|
:sort sort :title title :buffer view-buffer)
|
||||||
:sort sort :title title :buffer view-buffer)
|
(with-current-buffer view-buffer
|
||||||
(with-current-buffer view-buffer
|
(cl-assert (member '("org-ql-search" :follow org-ql-view--link-follow :store org-ql-view--link-store)
|
||||||
(cl-assert (member '("org-ql-search" :follow org-ql-view--link-follow :store org-ql-view--link-store)
|
org-link-parameters)
|
||||||
org-link-parameters)
|
t)
|
||||||
t)
|
(with-simulated-input store-input
|
||||||
(with-simulated-input store-input
|
;; Avoid writing "Stored: ..." to test output.
|
||||||
;; Avoid writing "Stored: ..." to test output.
|
(let ((inhibit-message t))
|
||||||
(let ((inhibit-message t))
|
(call-interactively #'org-store-link nil)))
|
||||||
(call-interactively #'org-store-link nil)))
|
(kill-buffer))
|
||||||
(kill-buffer))
|
(cl-assert (and org-stored-links (caar org-stored-links)) t)
|
||||||
(cl-assert (and org-stored-links (caar org-stored-links)) t)
|
(open-link-in (caar org-stored-links) buffer open-input)
|
||||||
(open-link-in (caar org-stored-links) buffer open-input)
|
(with-current-buffer (get-buffer (concat "*Org QL View: " title "*"))
|
||||||
(with-current-buffer (get-buffer (concat "*Org QL View: " title "*"))
|
(prog1 (buffer-local-value var (current-buffer))
|
||||||
(prog1 (buffer-local-value var (current-buffer))
|
(kill-buffer)))))
|
||||||
(kill-buffer)))))
|
|
||||||
|
|
||||||
(describe "Queries"
|
(describe "Queries"
|
||||||
:var ((string-query "todo:TODO regexp:heading")
|
:var ((string-query "todo:TODO regexp:heading")
|
||||||
|
|
|
||||||
Loading…
Add table
Add a link
Reference in a new issue