Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Allow multiple values in `org-ql-view-buffers-files' #311

Open
wants to merge 3 commits into
base: master
Choose a base branch
from
Open

Allow multiple values in `org-ql-view-buffers-files' #311

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
3 commits
Select commit Hold shift + click to select a range
4b19e5f
Allow mulitple values to be read for org-ql-view-buffers-files
ahmed-shariff Nov 21, 2022
2d68ef5
Adding test cases for buffers-files
ahmed-shariff Nov 21, 2022
874d9d7
Inform users: repscting a func set to org-ql-view-buffers-files
ahmed-shariff Nov 21, 2022
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
2 changes: 1 addition & 1 deletion README.org
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -132,7 +132,7 @@ Read ~QUERY~ and search with ~org-ql~. Interactively, prompt for these variable
+ ~buffer~: search the current buffer
+ ~all~: search all Org buffers
+ ~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~.

Expand Down
142 changes: 100 additions & 42 deletions org-ql-view.el
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -1019,6 +1019,27 @@ property."
;; source code of `check-declare' shows that it searches for "cl-defun" declarations.
(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)
"Return BUFFERS-FILES in its \"contracted\" form.
The contracted form is \"org-agenda-files\" if BUFFERS-FILES
Expand All @@ -1033,54 +1054,91 @@ current buffer. Otherwise BUFFERS-FILES is returned unchanged."
(string (expand-file-name it))
(otherwise it))
list)))
;; TODO: Test this more exhaustively.
(pcase buffers-files
((pred listp)
(pcase (expand-files buffers-files)
((pred (seq-set-equal-p (mapcar #'expand-file-name (org-agenda-files))))
"org-agenda-files")
((and (guard (file-exists-p org-directory))
(pred (seq-set-equal-p (org-ql-search-directories-files
:directories (list org-directory)))))
"org-directory")
(_ buffers-files)))
((pred (equal (current-buffer)))
"buffer")
((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))
(_ buffers-files))))
(let ((contracted-buffers-files
;; TODO: Test this more exhaustively.
(pcase buffers-files
((pred functionp) (pcase buffers-files
('org-agenda-files "org-agenda-files")
(_ buffers-files)))
((pred listp)
(pcase (expand-files buffers-files)
((pred (seq-set-equal-p (mapcar #'expand-file-name (org-agenda-files))))
"org-agenda-files")
((and (guard (file-exists-p org-directory))
(pred (seq-set-equal-p (org-ql-search-directories-files
:directories (list org-directory)))))
"org-directory")
(_ buffers-files)))
((pred (equal (current-buffer)))
"buffer")
((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 ()
"Return value for `org-ql-view-buffers-files' using completion."
(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
(bufferp org-ql-view-buffers-files))
;; Buffers can't be input by name, so if the default value is a buffer, just use it.
;; TODO: Find a way to fix this.
"Return value for `org-ql-view-buffers-files' using completion.
When `org-ql-view-buffers-files' cannot be contracted to a string
representation `org-ql-view-buffers-files' is returned."
(let* ((contracted-org-ql-view-buffers-files
(when org-ql-view-buffers-files
(org-ql-view--contract-buffers-files
org-ql-view-buffers-files)))
(initial-input (pcase contracted-org-ql-view-buffers-files
('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--expand-buffers-files
(completing-read "Buffers/Files: "
(list 'buffer 'org-agenda-files 'org-directory 'all)
nil nil (initial-input))))))
(org-ql-view--expand-buffers-files completion-read-result))))

(defun org-ql-view--expand-buffers-files (buffers-files)
"Return BUFFERS-FILES expanded to a list of files or buffers.
The counterpart to `org-ql-view--contract-buffers-files'."
(pcase-exhaustive buffers-files
("all" (--select (equal (buffer-local-value 'major-mode it) 'org-mode)
(buffer-list)))
("org-agenda-files" (org-agenda-files))
("org-directory" (org-ql-search-directories-files))
((or "" "buffer") (current-buffer))
((pred bufferp) buffers-files)
((pred listp) buffers-files)
;; A single filename.
((pred stringp) buffers-files)))
The counterpart to `org-ql-view--contract-buffers-files'.
This always returns a list of string values."
(let ((expanded-buffers-files
(--> buffers-files
-list -non-nil
(-map (lambda (buffer-file)
(pcase-exhaustive buffer-file
("all" (--select (equal (buffer-local-value 'major-mode it) 'org-mode)
(buffer-list)))
("org-agenda-files" (org-agenda-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 ()
"Return value for `org-ql-view-super-groups' using completion."
Expand Down
116 changes: 109 additions & 7 deletions tests/test-org-ql.el
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -1775,19 +1775,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]]"))
(it "Errors for a quoted lambda"
(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"
(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"
(if (version< (org-version) "9.3")
(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)
: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"
(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"
:var ((quoted-lambda-link "[[org-ql-search:todo:?super-groups%3D%28lambda%20nil%20%28error%20%22UNSAFE%22%29%29]]")
Expand Down Expand Up @@ -2157,7 +2157,7 @@ with keyword arg NOW in PLIST."
(it "Can search a file by filename"
(expect (var-after-link-save-open 'org-ql-view-buffers-files one-filename query
:store-input "M-n M-n RET")
:to-equal one-filename))
:to-equal (list one-filename)))
(it "Can search multiple files by filename"
(expect (var-after-link-save-open 'org-ql-view-buffers-files temp-filenames query
:store-input "M-n M-n RET")
Expand Down Expand Up @@ -2200,7 +2200,109 @@ with keyword arg NOW in PLIST."
(it "Refuses to link to non-file-backed buffer"
(expect (var-after-link-save-open 'org-ql-view-buffers-files link-buffer query
: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.
;; (describe "org-ql-views")
Expand Down