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

Tidy: Indentation

Browse source 
For Emacs 29.1's and with-simulated-input's changes.
This commit is contained in:
Adam Porter 2023-12-16 05:22:08 -06:00
parent c62ff77cd3
commit 004ed1ee0f
4 changed files with 312 additions and 314 deletions
Download patch file Download diff file Expand all files Collapse all files

4
org-ql-search.el
View file

@ -341,8 +341,8 @@ 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))

26
org-ql-view.el
View file

@ -533,8 +533,8 @@ 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)
@ -661,15 +661,17 @@ When opened, the link searches the buffer it's opened from."
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
;; 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) (when (buffer-base-buffer thing)
(buffer-file-name (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)
@ -1048,8 +1050,8 @@ 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)))
@ -1074,8 +1076,8 @@ 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

39
org-ql.el
View file

@ -808,25 +808,24 @@ 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)
"]]")))) "]]"))))
@ -2529,8 +2528,8 @@ If QUERY can't be converted to a string, return nil."
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))
@ -2540,14 +2539,14 @@ If QUERY can't be converted to a string, return nil."
(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...
@ -2558,18 +2557,18 @@ If QUERY can't be converted to a string, return nil."
((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

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

@ -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. ;; 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")
@ -2006,8 +2006,7 @@ 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)
@ -2069,8 +2068,8 @@ 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"
@ -2109,8 +2108,7 @@ 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
@ -2122,8 +2120,7 @@ with keyword arg NOW in PLIST."
(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