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

Merge 874d9d70d8 into 4f62ba3bd6

Browse source
This commit is contained in:
Ahmed Shariff 2023-11-11 02:09:27 -07:00 • committed by GitHub
commit 837dd98def
No known key found for this signature in database
GPG key ID: 4AEE18F83AFDEB23
3 changed files with 210 additions and 50 deletions
Download patch file Download diff file Expand all files Collapse all files

2
README.org
View file

@ -140,7 +140,7 @@ Read ~QUERY~ and search with ~org-ql~. Interactively, prompt for these variable
+ ~buffer~: search the current buffer + ~buffer~: search the current buffer
+ ~all~: search all Org buffers + ~all~: search all Org buffers
+ ~agenda~: search buffers returned by the function ~org-agenda-files~ + ~agenda~: search buffers returned by the function ~org-agenda-files~
+ A space-separated list of file or buffer names + A comma-separated list of file, buffer names, or the above keywords
~GROUPS~: An ~org-super-agenda~ group set. See variable ~org-super-agenda-groups~. ~GROUPS~: An ~org-super-agenda~ group set. See variable ~org-super-agenda-groups~.

142
org-ql-view.el
View file

@ -1030,6 +1030,27 @@ property."
(declare-function org-ql-search-directories-files "org-ql-search" t) (declare-function org-ql-search-directories-files "org-ql-search" t)
(defun org-ql-view--buffers-files-to-uniq-strings (buffers-files)
"Flatten, remove duplicates and convert elements in BUFFERS-FILES to strings.
This used by `org-ql-view--contract-buffers-files' and
`org-ql-view--expand-buffers-files'. Would signal error
if an element is not a buffer or string."
(cl-labels ((convert-to-strings
;; Expanding all buffers to file names or buffer names to remove duplicate entries.
(list) (--map
(pcase-exhaustive it
((pred bufferp) (or (buffer-file-name it)
(buffer-name it)))
;; Any values at this point should be a buffer or string.
;; Testing for string anyways.
((pred stringp) it))
list)))
(--> buffers-files
-flatten
-non-nil
convert-to-strings
-uniq)))
(defun org-ql-view--contract-buffers-files (buffers-files) (defun org-ql-view--contract-buffers-files (buffers-files)
"Return BUFFERS-FILES in its \"contracted\" form. "Return BUFFERS-FILES in its \"contracted\" form.
The contracted form is \"org-agenda-files\" if BUFFERS-FILES The contracted form is \"org-agenda-files\" if BUFFERS-FILES
@ -1044,54 +1065,91 @@ current buffer. Otherwise BUFFERS-FILES is returned unchanged."
(string (expand-file-name it)) (string (expand-file-name it))
(otherwise it)) (otherwise it))
list))) list)))
;; TODO: Test this more exhaustively. (let ((contracted-buffers-files
(pcase buffers-files ;; TODO: Test this more exhaustively.
((pred listp) (pcase buffers-files
(pcase (expand-files buffers-files) ((pred functionp) (pcase buffers-files
((pred (seq-set-equal-p (mapcar #'expand-file-name (org-agenda-files)))) ('org-agenda-files "org-agenda-files")
"org-agenda-files") (_ buffers-files)))
((and (guard (file-exists-p org-directory)) ((pred listp)
(pred (seq-set-equal-p (org-ql-search-directories-files (pcase (expand-files buffers-files)
:directories (list org-directory))))) ((pred (seq-set-equal-p (mapcar #'expand-file-name (org-agenda-files))))
"org-directory") "org-agenda-files")
(_ buffers-files))) ((and (guard (file-exists-p org-directory))
((pred (equal (current-buffer))) (pred (seq-set-equal-p (org-ql-search-directories-files
"buffer") :directories (list org-directory)))))
((or 'org-agenda-files '(function org-agenda-files)) "org-directory")
"org-agenda-files") (_ buffers-files)))
((and (pred bufferp) (guard (buffer-file-name buffers-files))) ((pred (equal (current-buffer)))
(buffer-file-name buffers-files)) "buffer")
(_ buffers-files)))) ((or 'org-agenda-files '(function org-agenda-files))
"org-agenda-files")
((and (pred bufferp) (guard (buffer-file-name buffers-files)))
(buffer-file-name buffers-files))
((pred bufferp)
(buffer-name buffers-files))
(_ buffers-files))))
;; To filter duplicates with the extend counterpart of this function,
;; this needs to be a string or a list of string.
;; Hence, making sure the buffers are convered to file names or buffer names.
;; Using file-names when it's a file-buffer to avoid duplicates resulting from
;; the file-buffer and file name being entered.
(cl-typecase contracted-buffers-files
(function contracted-buffers-files)
(string contracted-buffers-files)
(list (org-ql-view--buffers-files-to-uniq-strings contracted-buffers-files))
(t (error (format "Value %s is not a string, a valid function or a list of buffer/strings" contracted-buffers-files)))))))
(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 When `org-ql-view-buffers-files' cannot be contracted to a string
() (when org-ql-view-buffers-files representation `org-ql-view-buffers-files' is returned."
(org-ql-view--contract-buffers-files (let* ((contracted-org-ql-view-buffers-files
org-ql-view-buffers-files)))) (when org-ql-view-buffers-files
(if (and org-ql-view-buffers-files (org-ql-view--contract-buffers-files
(bufferp org-ql-view-buffers-files)) org-ql-view-buffers-files)))
;; Buffers can't be input by name, so if the default value is a buffer, just use it. (initial-input (pcase contracted-org-ql-view-buffers-files
;; TODO: Find a way to fix this. ('nil nil)
('string contracted-org-ql-view-buffers-files)
((pred functionp) contracted-org-ql-view-buffers-files)
((pred listp)
(mapconcat 'identity contracted-org-ql-view-buffers-files
","))
(_ (format "%s" contracted-org-ql-view-buffers-files))))
(completion-read-result (if (functionp contracted-org-ql-view-buffers-files)
(progn
(message "`org-ql-view-buffers-files' is a function, cannot use completion with it.")
contracted-org-ql-view-buffers-files)
(completing-read-multiple
"Buffers/Files: "
(list 'buffer 'org-agenda-files 'org-directory 'all)
nil nil initial-input))))
(if (equal completion-read-result initial-input)
org-ql-view-buffers-files org-ql-view-buffers-files
(org-ql-view--expand-buffers-files (org-ql-view--expand-buffers-files completion-read-result))))
(completing-read "Buffers/Files: "
(list 'buffer 'org-agenda-files 'org-directory 'all)
nil nil (initial-input))))))
(defun org-ql-view--expand-buffers-files (buffers-files) (defun org-ql-view--expand-buffers-files (buffers-files)
"Return BUFFERS-FILES expanded to a list of files or buffers. "Return BUFFERS-FILES expanded to a list of files or buffers.
The counterpart to `org-ql-view--contract-buffers-files'." The counterpart to `org-ql-view--contract-buffers-files'.
(pcase-exhaustive buffers-files This always returns a list of string values."
("all" (--select (equal (buffer-local-value 'major-mode it) 'org-mode) (let ((expanded-buffers-files
(buffer-list))) (--> buffers-files
("org-agenda-files" (org-agenda-files)) -list -non-nil
("org-directory" (org-ql-search-directories-files)) (-map (lambda (buffer-file)
((or "" "buffer") (current-buffer)) (pcase-exhaustive buffer-file
((pred bufferp) buffers-files) ("all" (--select (equal (buffer-local-value 'major-mode it) 'org-mode)
((pred listp) buffers-files) (buffer-list)))
;; A single filename. ("org-agenda-files" (org-agenda-files))
((pred stringp) buffers-files))) ("org-directory" (org-ql-search-directories-files))
((or "" "buffer")
(current-buffer))
((or (pred bufferp)
;; A single filename.
(pred stringp))
buffer-file)
(_ (error (format "Value %s is not a valid buffer/file" buffer-file)))))
it))))
(org-ql-view--buffers-files-to-uniq-strings expanded-buffers-files)))
(defun org-ql-view--complete-super-groups () (defun org-ql-view--complete-super-groups ()
"Return value for `org-ql-view-super-groups' using completion." "Return value for `org-ql-view-super-groups' using completion."

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

@ -1852,19 +1852,19 @@ with keyword arg NOW in PLIST."
(unquoted-lambda-in-list-link "[[org-ql-search:todo:?buffers-files%3D%28%28lambda%20nil%20%28error%20%22UNSAFE%22%29%29%29]]")) (unquoted-lambda-in-list-link "[[org-ql-search:todo:?buffers-files%3D%28%28lambda%20nil%20%28error%20%22UNSAFE%22%29%29%29]]"))
(it "Errors for a quoted lambda" (it "Errors for a quoted lambda"
(expect (open-link quoted-lambda-link) (expect (open-link quoted-lambda-link)
:to-throw 'error '("CAUTION: Link not opened because unsafe buffers-files parameter detected: (lambda nil (error UNSAFE))"))) :to-throw 'error '("Value lambda is not a valid buffer/file")))
(it "Errors for an unquoted lambda" (it "Errors for an unquoted lambda"
(expect (open-link unquoted-lambda-link) (expect (open-link unquoted-lambda-link)
:to-throw 'error '("CAUTION: Link not opened because unsafe buffers-files parameter detected: (lambda nil (error UNSAFE))"))) :to-throw 'error '("Value lambda is not a valid buffer/file")))
(it "Errors for a quoted lambda in a list" (it "Errors for a quoted lambda in a list"
(if (version< (org-version) "9.3") (if (version< (org-version) "9.3")
(expect (open-link quoted-lambda-in-list-link) (expect (open-link quoted-lambda-in-list-link)
:to-throw 'error '("CAUTION: Link not opened because unsafe buffers-files parameter detected: ((quote (lambda nil (error UNSAFE))))")) :to-throw 'error '("Value (quote (lambda nil (error UNSAFE))) is not a valid buffer/file"))
(expect (open-link quoted-lambda-in-list-link) (expect (open-link quoted-lambda-in-list-link)
:to-throw 'error '("CAUTION: Link not opened because unsafe buffers-files parameter detected: ('(lambda nil (error UNSAFE)))")))) :to-throw 'error '("Value ’(lambda nil (error UNSAFE)) is not a valid buffer/file"))))
(it "Errors for an unquoted lambda in a list" (it "Errors for an unquoted lambda in a list"
(expect (open-link unquoted-lambda-in-list-link) (expect (open-link unquoted-lambda-in-list-link)
:to-throw 'error '("CAUTION: Link not opened because unsafe buffers-files parameter detected: ((lambda nil (error UNSAFE)))")))) :to-throw 'error '("Value (lambda nil (error UNSAFE)) is not a valid buffer/file"))))
(describe "super-groups parameter" (describe "super-groups parameter"
:var ((quoted-lambda-link "[[org-ql-search:todo:?super-groups%3D%28lambda%20nil%20%28error%20%22UNSAFE%22%29%29]]") :var ((quoted-lambda-link "[[org-ql-search:todo:?super-groups%3D%28lambda%20nil%20%28error%20%22UNSAFE%22%29%29]]")
@ -2234,7 +2234,7 @@ with keyword arg NOW in PLIST."
(it "Can search a file by filename" (it "Can search a file by filename"
(expect (var-after-link-save-open 'org-ql-view-buffers-files one-filename query (expect (var-after-link-save-open 'org-ql-view-buffers-files one-filename query
:store-input "M-n M-n RET") :store-input "M-n M-n RET")
:to-equal one-filename)) :to-equal (list one-filename)))
(it "Can search multiple files by filename" (it "Can search multiple files by filename"
(expect (var-after-link-save-open 'org-ql-view-buffers-files temp-filenames query (expect (var-after-link-save-open 'org-ql-view-buffers-files temp-filenames query
:store-input "M-n M-n RET") :store-input "M-n M-n RET")
@ -2277,7 +2277,109 @@ with keyword arg NOW in PLIST."
(it "Refuses to link to non-file-backed buffer" (it "Refuses to link to non-file-backed buffer"
(expect (var-after-link-save-open 'org-ql-view-buffers-files link-buffer query (expect (var-after-link-save-open 'org-ql-view-buffers-files link-buffer query
:buffer link-buffer) :buffer link-buffer)
:to-throw 'user-error '("Views that search non-file-backed buffers can't be linked to")))))) :to-throw 'user-error '("Views that search non-file-backed buffers can’t be linked to"))))
(describe "while completion for files/buffers"
(describe "contracting org-ql-view-buffers-files"
(it "list of files to \"org-agenda-files\""
(spy-on 'org-agenda-files :and-return-value temp-filenames)
(expect (org-ql-view--contract-buffers-files temp-filenames) :to-equal "org-agenda-files"))
(it "list of files to \"org-directory\""
(spy-on 'org-agenda-files :and-return-value '())
;; Also indirectly tests org-ql-search-directories-files
(let ((org-directory temp-dir)) ;; the :var binding does not work? https://github.com/jorgenschaefer/emacs-buttercup/issues/127
(expect (org-ql-view--contract-buffers-files temp-filenames) :to-equal "org-directory")))
(it "to \"buffer\" when passing current-buffer"
(with-current-buffer (org-ql-test-data-buffer "data.org")
(expect (org-ql-view--contract-buffers-files (current-buffer)) :to-equal "buffer")))
(it "to \"org-agenda-files\" from symbol values ('org-agenda-files or #'org-agenda-files)"
(spy-on 'org-agenda-files :and-return-value temp-filenames)
(expect (org-ql-view--contract-buffers-files 'org-agenda-files) :to-equal "org-agenda-files")
(expect (org-ql-view--contract-buffers-files #'org-agenda-files) :to-equal "org-agenda-files"))
(it "returns function"
(let ((quoted-function (lambda nil temp-filenames))
(unquoted-function '(lambda nil temp-filenames)))
(expect (org-ql-view--contract-buffers-files quoted-function) :to-equal quoted-function)
(expect (org-ql-view--contract-buffers-files unquoted-function) :to-equal unquoted-function)))
(it "with a list of strings"
(let ((list-of-strings '("a.org" "b.org")))
(expect (org-ql-view--contract-buffers-files list-of-strings) :to-equal list-of-strings)))
(describe "invalid values"
:var ((list-of-strings-and-functions '("a.org" "b.org" 'org-agenda-files))
(invalid-type 'a)
(invalid-type-list '(a)))
(it "signals error if called with value not a buffer, or string"
(expect (org-ql-view--contract-buffers-files list-of-strings-and-functions) :to-throw)
(expect (org-ql-view--contract-buffers-files invalid-type) :to-throw)
(expect (org-ql-view--contract-buffers-files invalid-type-list) :to-throw))))
(describe "handles duplicate values")
(describe "expanding org-ql-view-buffers-files"
(it "with \"all\" returns all buffers with `org-mode' as the major-mode"
(let ((buffers (list (generate-new-buffer "test.org") (generate-new-buffer "test.other"))))
(with-current-buffer (car buffers)
(org-mode))
(spy-on 'buffer-list :and-return-value buffers)
(expect (org-ql-view--expand-buffers-files "all") :to-equal (list (buffer-name (car buffers))))))
(it "returns values of \"org-agenda-files\""
(let ((org-agenda-files (mapcar
(lambda (it)
(expand-file-name (buffer-name it)))
(list (org-ql-test-data-buffer "data.org")
(org-ql-test-data-buffer "data2.org")))))
(expect (org-ql-view--expand-buffers-files "org-agenda-files") :to-equal org-agenda-files)))
(it "returns values of \"org-directory\""
;; Also indirectly tests `org-ql-view--expand-buffers-files'.
(let ((org-directory temp-dir))
(expect (org-ql-view--expand-buffers-files "org-directory") :to-equal temp-filenames)))
(it "returns the current buffer"
(with-temp-buffer
(expect (org-ql-view--expand-buffers-files "buffer") :to-equal (list (buffer-name (current-buffer))))))
(it "signals error when called with a function"
(expect (org-ql-view--expand-buffers-files '((lambda nil temp-filenames))) :to-throw 'error '("Value (lambda nil temp-filenames) is not a valid buffer/file")))
(it "returns literal value(s)"
(with-temp-buffer
(expect (org-ql-view--expand-buffers-files (current-buffer)) :to-equal (list (buffer-name (current-buffer)))))
(let ((test-buffer (generate-new-buffer "test")))
(expect (org-ql-view--expand-buffers-files test-buffer) :to-equal (list (buffer-name test-buffer))))
(let ((list-of-numbers '(1 2 3))
(literal-string "random string"))
;; Signal error if any of the values are not a buffer, function, or string.
(expect (org-ql-view--expand-buffers-files list-of-numbers) :to-throw)
(expect (org-ql-view--expand-buffers-files literal-string) :to-equal (list literal-string))))
(it "contracts to a list without duplicates"
(let* ((list-of-strings '("a.org" "b.org"))
(duplicate-buffer-and-file (list (find-file-noselect (car temp-filenames))
(car temp-filenames)))
(org-agenda-files (list (car temp-filenames)))
(random-buffer (generate-new-buffer "new-buffer"))
(random-buffer-name (buffer-name random-buffer))
(duplicate-buffer-and-name (list random-buffer-name random-buffer))
(buffer-collection (append org-agenda-files (list random-buffer-name))))
(expect (org-ql-view--expand-buffers-files duplicate-buffer-and-file) :to-equal (list (car temp-filenames)))
(expect (org-ql-view--expand-buffers-files duplicate-buffer-and-name) :to-equal (list random-buffer-name))
(expect (org-ql-view--expand-buffers-files (list "org-agenda-files" random-buffer)) :to-equal buffer-collection))))
(describe "testing `org-ql-view--complete-buffers-files'"
(it "returns `org-agenda-files'"
(let ((org-ql-view-buffers-files temp-filenames))
(spy-on 'org-ql-view--contract-buffers-files :and-call-through)
(spy-on 'org-agenda-files :and-return-value temp-filenames)
(spy-on 'completing-read-multiple :and-return-value "org-agenda-files")
(expect (org-ql-view--complete-buffers-files) :to-equal temp-filenames)
(expect 'org-ql-view--contract-buffers-files :to-have-been-called-with temp-filenames)
;; Also testing if the initial values are set correctly.
(expect 'completing-read-multiple :to-have-been-called-with "Buffers/Files: "
(list 'buffer 'org-agenda-files 'org-directory 'all)
nil nil "org-agenda-files")))
(it "returns nil"
(let ((org-ql-view-buffers-files nil))
(spy-on 'completing-read-multiple :and-return-value nil)
(expect (org-ql-view--complete-buffers-files) :to-equal nil)
(expect 'completing-read-multiple :to-have-been-called-with "Buffers/Files: "
(list 'buffer 'org-agenda-files 'org-directory 'all)
nil nil nil)))
(it "returna a list of buffers/files"
(let ((list-of-files temp-filenames))
(spy-on 'completing-read-multiple :and-return-value list-of-files)
(expect (org-ql-view--complete-buffers-files) :to-equal list-of-files)))))))
;; MAYBE: Also test `org-ql-views', although I already know it works now. ;; MAYBE: Also test `org-ql-views', although I already know it works now.
;; (describe "org-ql-views") ;; (describe "org-ql-views")