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,8 +341,8 @@ this (must be a single line in the Org buffer):
|
|||
(setf elements (cl-etypecase take
|
||||
((and integer (satisfies cl-minusp)) (-take-last (abs take) elements))
|
||||
(integer (-take take elements)))))
|
||||
(cl-labels ((format-element
|
||||
(element) (string-join (cl-loop for column in columns
|
||||
(cl-labels ((format-element (element)
|
||||
(string-join (cl-loop for column in columns
|
||||
collect (or (pcase-exhaustive column
|
||||
((pred symbolp)
|
||||
(funcall (alist-get column format-fns) element))
|
||||
|
|
|
|||
|
|
@ -533,8 +533,8 @@ dates in the past, and negative for dates in the future."
|
|||
|
||||
(defun org-ql-view-bookmark-make-record ()
|
||||
"Return a bookmark record for the current Org QL View buffer."
|
||||
(cl-labels ((file-nameize
|
||||
(b-f) (abbreviate-file-name
|
||||
(cl-labels ((file-nameize (b-f)
|
||||
(abbreviate-file-name
|
||||
(cl-typecase b-f
|
||||
(string b-f)
|
||||
(buffer (or (buffer-file-name b-f)
|
||||
|
|
@ -661,15 +661,17 @@ When opened, the link searches the buffer it's opened from."
|
|||
nil t nil nil "file link is in")
|
||||
("file link is in" nil)
|
||||
("files currently searched" buffers-files)))
|
||||
(strings-or-file-buffers-p
|
||||
(thing) (cl-etypecase thing
|
||||
(strings-or-file-buffers-p (thing)
|
||||
(cl-etypecase thing
|
||||
(list (cl-every #'strings-or-file-buffers-p thing))
|
||||
(string thing)
|
||||
(buffer (or (buffer-file-name thing)
|
||||
;; TODO: Should indirect buffers be allowed? Maybe not, since their narrowing isn't preserved.
|
||||
;; On the other hand, it's possible to accidentally make a search view for an indirect buffer
|
||||
;; that's since been widened, and forcing the user to manually change that would be awkward,
|
||||
;; and trying to communicate the problem would be difficult, so maybe it's okay to allow it.
|
||||
;; TODO: Should indirect buffers be allowed? Maybe not, since their
|
||||
;; narrowing isn't preserved. On the other hand, it's possible to
|
||||
;; accidentally make a search view for an indirect buffer that's
|
||||
;; since been widened, and forcing the user to manually change that
|
||||
;; would be awkward, and trying to communicate the problem would be
|
||||
;; 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)
|
||||
|
|
@ -1048,8 +1050,8 @@ the variable), \"org-directory\" if it matches the value of
|
|||
current buffer. Otherwise BUFFERS-FILES is returned unchanged."
|
||||
;; Used in `org-ql-view--complete-buffers-files' and
|
||||
;; `org-ql-view--header-line-format'.
|
||||
(cl-labels ((expand-files
|
||||
(list) (--map (cl-typecase it
|
||||
(cl-labels ((expand-files (list)
|
||||
(--map (cl-typecase it
|
||||
(string (expand-file-name it))
|
||||
(otherwise it))
|
||||
list)))
|
||||
|
|
@ -1074,8 +1076,8 @@ current buffer. Otherwise BUFFERS-FILES is returned unchanged."
|
|||
|
||||
(defun org-ql-view--complete-buffers-files ()
|
||||
"Return value for `org-ql-view-buffers-files' using completion."
|
||||
(cl-labels ((initial-input
|
||||
() (when org-ql-view-buffers-files
|
||||
(cl-labels ((initial-input ()
|
||||
(when org-ql-view-buffers-files
|
||||
(org-ql-view--contract-buffers-files
|
||||
org-ql-view-buffers-files))))
|
||||
(if (and org-ql-view-buffers-files
|
||||
|
|
|
|||
39
org-ql.el
39
org-ql.el
|
|
@ -808,25 +808,24 @@ respectively."
|
|||
(and "\\" (0+ "\\\\") (any "[]"))
|
||||
(and (1+ "\\") (not (any "[]")))))))
|
||||
(cl-labels
|
||||
((no-desc
|
||||
(match) (rx-to-string `(seq (or bol (1+ blank))
|
||||
((no-desc (match)
|
||||
(rx-to-string `(seq (or bol (1+ blank))
|
||||
"[[" ,link-target-part (regexp ,match) ,link-target-part
|
||||
"]]")))
|
||||
(match-both
|
||||
(description target)
|
||||
(match-both (description target)
|
||||
(rx-to-string `(seq (or bol (1+ blank))
|
||||
"[[" ,link-target-part (regexp ,target) ,link-target-part
|
||||
"][" (*? anything) (regexp ,description) (*? anything)
|
||||
"]]")))
|
||||
;; Note that these actually allow empty descriptions
|
||||
;; or targets, depending on what they are matching.
|
||||
(match-desc
|
||||
(match) (rx-to-string `(seq (or bol (1+ blank))
|
||||
(match-desc (match)
|
||||
(rx-to-string `(seq (or bol (1+ blank))
|
||||
"[[" ,link-target-part
|
||||
"][" (*? anything) (regexp ,match) (*? anything)
|
||||
"]]")))
|
||||
(match-target
|
||||
(match) (rx-to-string `(seq (or bol (1+ blank))
|
||||
(match-target (match)
|
||||
(rx-to-string `(seq (or bol (1+ blank))
|
||||
"[[" ,link-target-part (regexp ,match) ,link-target-part
|
||||
"][" (*? anything)
|
||||
"]]"))))
|
||||
|
|
@ -2529,8 +2528,8 @@ If QUERY can't be converted to a string, return nil."
|
|||
thereis (or (eq symbol element)
|
||||
(and (listp element)
|
||||
(contains-p symbol element)))))
|
||||
(format-args
|
||||
(args) (let (non-paired paired next-keyword)
|
||||
(format-args (args)
|
||||
(let (non-paired paired next-keyword)
|
||||
(cl-loop for arg in args
|
||||
do (cond (next-keyword (push (cons next-keyword arg) paired)
|
||||
(setf next-keyword nil))
|
||||
|
|
@ -2540,14 +2539,14 @@ If QUERY can't be converted to a string, return nil."
|
|||
(nreverse (--map (format "%s=%s" (car it) (cdr it))
|
||||
paired)))
|
||||
",")))
|
||||
(format-atom
|
||||
(atom) (cl-typecase atom
|
||||
(format-atom (atom)
|
||||
(cl-typecase atom
|
||||
(string (if (string-match (rx space) atom)
|
||||
(format "%S" atom)
|
||||
(format "%s" atom)))
|
||||
(t (format "%s" atom))))
|
||||
(format-form
|
||||
(form) (pcase form
|
||||
(format-form (form)
|
||||
(pcase form
|
||||
(`(not . (,rest)) (concat "!" (format-form rest)))
|
||||
(`(priority . ,_) (format-priority form))
|
||||
;; FIXME: Convert (src) queries to non-sexp form...someday...
|
||||
|
|
@ -2558,18 +2557,18 @@ If QUERY can't be converted to a string, return nil."
|
|||
((guard (= 1 (length args))) (format "%s" (car args)))
|
||||
(_ (format-args args)))))
|
||||
(format "%s:%s" pred args-string)))))
|
||||
(format-and
|
||||
(form) (pcase-let* ((`(and . ,rest) form))
|
||||
(format-and (form)
|
||||
(pcase-let* ((`(and . ,rest) form))
|
||||
(string-join (mapcar #'format-form rest) " ")))
|
||||
(format-priority
|
||||
(form) (pcase-let* ((`(priority . ,rest) form)
|
||||
(format-priority (form)
|
||||
(pcase-let* ((`(priority . ,rest) form)
|
||||
(args (pcase rest
|
||||
(`(,(and comparator (or '< '<= '> '>= '=)) ,letter)
|
||||
(priority-letters comparator letter))
|
||||
(_ rest))))
|
||||
(concat "priority:" (string-join args ","))))
|
||||
(priority-letters
|
||||
(comparator letter) (let* ((char (string-to-char (upcase (symbol-name letter))))
|
||||
(priority-letters (comparator letter)
|
||||
(let* ((char (string-to-char (upcase (symbol-name letter))))
|
||||
(numeric-priorities '(?A ?B ?C))
|
||||
;; NOTE: The comparator inversion is intentional.
|
||||
(others (pcase comparator
|
||||
|
|
|
|||
|
|
@ -1844,8 +1844,8 @@ 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.
|
||||
|
||||
(let ((test-buffer (get-buffer-create "*test-org-ql*")))
|
||||
(cl-flet ((open-link
|
||||
(link) (with-current-buffer test-buffer
|
||||
(cl-flet ((open-link (link)
|
||||
(with-current-buffer test-buffer
|
||||
(erase-buffer)
|
||||
(org-mode)
|
||||
(insert "* TODO Test heading \n\n")
|
||||
|
|
@ -2006,8 +2006,7 @@ with keyword arg NOW in PLIST."
|
|||
(when-let ((buffer (find-file-noselect filename 'nowarn)))
|
||||
(kill-buffer buffer))))
|
||||
|
||||
(cl-flet ((var-after-bookmark-set-and-jump
|
||||
(var buffers-files query &key sort super-groups)
|
||||
(cl-flet ((var-after-bookmark-set-and-jump (var buffers-files query &key sort super-groups)
|
||||
(org-ql-search buffers-files query
|
||||
:super-groups super-groups
|
||||
:sort sort :title title :buffer view-buffer)
|
||||
|
|
@ -2069,8 +2068,8 @@ with keyword arg NOW in PLIST."
|
|||
(describe "Dynamic blocks"
|
||||
(describe "warn about sexp queries"
|
||||
|
||||
(cl-flet ((test-dblock
|
||||
(&optional input) (with-current-buffer (get-buffer-create "*TEST DBLOCK*")
|
||||
(cl-flet ((test-dblock (&optional input)
|
||||
(with-current-buffer (get-buffer-create "*TEST DBLOCK*")
|
||||
(erase-buffer)
|
||||
(org-mode)
|
||||
(insert "* TODO Heading 1\n\n"
|
||||
|
|
@ -2109,8 +2108,7 @@ with keyword arg NOW in PLIST."
|
|||
(insert "* TODO Test heading\n\n")
|
||||
(org-mode)))
|
||||
|
||||
(cl-flet* ((open-link-in
|
||||
(link buffer input)
|
||||
(cl-flet* ((open-link-in (link buffer input)
|
||||
;; 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!
|
||||
(with-current-buffer buffer
|
||||
|
|
@ -2122,8 +2120,7 @@ with keyword arg NOW in PLIST."
|
|||
(with-simulated-input input
|
||||
(org-open-at-point))))
|
||||
|
||||
(var-after-link-save-open
|
||||
(var buffers-files query &key sort super-groups
|
||||
(var-after-link-save-open (var buffers-files query &key sort super-groups
|
||||
(buffer link-buffer) (store-input "RET") open-input)
|
||||
(org-ql-search buffers-files query
|
||||
:super-groups super-groups
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue