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

Fixes for using mulitiple values and related test suite improvements

Browse source
This commit is contained in:
Ahmed Shariff 2021-09-13 17:05:14 -05:00
parent ffaebcbcbe
commit 564d491604
2 changed files with 120 additions and 94 deletions
Download patch file Download diff file Expand all files Collapse all files

96
org-ql-view.el
View file

@ -1032,26 +1032,39 @@ 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. (-->
(pcase buffers-files ;; TODO: Test this more exhaustively.
((pred listp) (pcase buffers-files
(pcase (expand-files buffers-files) ((pred listp)
((pred (seq-set-equal-p (mapcar #'expand-file-name (org-agenda-files)))) (pcase (expand-files buffers-files)
"org-agenda-files") ((pred (seq-set-equal-p (mapcar #'expand-file-name (org-agenda-files))))
((and (guard (file-exists-p org-directory)) "org-agenda-files")
(pred (seq-set-equal-p (org-ql-search-directories-files ((and (guard (file-exists-p org-directory))
:directories (list org-directory))))) (pred (seq-set-equal-p (org-ql-search-directories-files
"org-directory") :directories (list org-directory)))))
(_ buffers-files))) "org-directory")
((pred (equal (current-buffer))) (_ buffers-files)))
"buffer") ((pred (equal (current-buffer)))
((or 'org-agenda-files '(function org-agenda-files)) "buffer")
"org-agenda-files") ((or 'org-agenda-files '(function org-agenda-files))
((and (pred bufferp) (guard (buffer-file-name buffers-files))) "org-agenda-files")
(buffer-file-name buffers-files)) ((and (pred bufferp) (guard (buffer-file-name buffers-files)))
((pred bufferp) (buffer-file-name buffers-files))
(buffer-name buffers-files)) ((pred bufferp)
(_ buffers-files)))) (buffer-name buffers-files))
(_ buffers-files))
;; All items needs to be strings to pick duplicates when used with the extend conterpart.
;; So making sure the buffers are convered to file names
(if (stringp it)
it
(-map
(lambda (buffer-file)
(if (bufferp buffer-file)
(--if-let (buffer-file-name buffer-file)
it
(buffer-name buffer-file))
buffer-file))
it)))))
(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.
@ -1072,26 +1085,39 @@ representation `org-ql-view-buffers-files' is returned."
"Buffers/Files: " "Buffers/Files: "
(list 'buffer 'org-agenda-files 'org-directory 'all) (list 'buffer 'org-agenda-files 'org-directory 'all)
nil nil initial-input))) nil nil initial-input)))
(if (equalp completion-read-result 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 completion-read-result)))) (org-ql-view--expand-buffers-files completion-read-result))))
(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'.
(--> (-list buffers-files) This always returns a list of string values."
(pcase-exhaustive it (-->
("all" (--select (equal (buffer-local-value 'major-mode it) 'org-mode) (-map (lambda (buffer-file)
(buffer-list))) (pcase-exhaustive buffer-file
("org-agenda-files" (org-agenda-files)) ("all" (--select (equal (buffer-local-value 'major-mode it) 'org-mode)
("org-directory" (org-ql-search-directories-files)) (buffer-list)))
((or "" "buffer") (current-buffer)) ("org-agenda-files" (org-agenda-files))
((pred bufferp) (list it)) ("org-directory" (org-ql-search-directories-files))
((pred listp) (list it)) ((or "" "buffer")
;; A single filename. (current-buffer))
((pred stringp) (list it))) ((pred bufferp) (list buffer-file))
-non-nil -uniq -flatten)) ;; A single filename.
((pred stringp) (list buffer-file))
(_ (error (format "Value %s is not a valid buffer/file" buffer-file)))))
(-list buffers-files))
-flatten -non-nil
;; expanding all file-buffers to file names to avoid duplicate entries being formed
(-map (lambda (buffer-file)
(if (bufferp buffer-file)
(--if-let (buffer-file-name buffer-file)
it
(buffer-name buffer-file))
buffer-file))
it)
-uniq))
(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."
(when (bound-and-true-p org-super-agenda-auto-selector-keywords) (when (bound-and-true-p org-super-agenda-auto-selector-keywords)

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

@ -1686,19 +1686,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 (quote (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]]")
@ -2068,7 +2068,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")
@ -2112,83 +2112,83 @@ with keyword arg NOW in PLIST."
(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 "Completion for Files/buffers" (describe "while completion for files/buffers"
(describe "Contracting org-ql-view-buffers-files" (describe "contracting org-ql-view-buffers-files"
(it "org-agenda-files from list" (it "list of files to \"org-agenda-files\""
(spy-on 'org-agenda-files :and-return-value temp-filenames) (spy-on 'org-agenda-files :and-return-value temp-filenames)
(expect (org-ql-view--contract-buffers-files temp-filenames) :to-equal "org-agenda-files")) (expect (org-ql-view--contract-buffers-files temp-filenames) :to-equal "org-agenda-files"))
(it "org-directory" (it "list of files to \"org-directory\""
(spy-on 'org-ql-search-directories-files :and-return-value temp-filenames)
(spy-on 'org-agenda-files :and-return-value '()) (spy-on 'org-agenda-files :and-return-value '())
(expect (org-ql-view--contract-buffers-files temp-filenames) :to-equal temp-filenames)) ;; Also indirectly tests org-ql-search-directories-files
(it "buffer" (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") (with-current-buffer (org-ql-test-data-buffer "data.org")
(expect (org-ql-view--contract-buffers-files (current-buffer)) :to-equal "buffer"))) (expect (org-ql-view--contract-buffers-files (current-buffer)) :to-equal "buffer")))
(it "org-agenda-files from symbol" (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) (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")
(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 "Non specific list" (it "arbitarary list of buffers/files"
(let ((value1 '("a.org" "b.org")) (let ((value1 '("a.org" "b.org"))
(value2 'a)) (value2 'a))
(expect (org-ql-view--contract-buffers-files value1) :to-equal value1) (expect (org-ql-view--contract-buffers-files value1) :to-equal value1)
(expect (org-ql-view--contract-buffers-files value2) :to-equal value2)))) ;; If the value does not result to a buffer, file, or string, throws error
(describe "Expanding org-ql-view-buffers-files" (expect (org-ql-view--contract-buffers-files value2) :to-throw))))
(it "all" (describe "expanding org-ql-view-buffers-files"
(let* ((buffer-names (list (make-temp-file "test" nil ".org") (make-temp-file "test" nil ".other"))) (it "returns all buffers with `org-mode' as the major-mode"
(buffers (mapcar #'get-buffer-create buffer-names))) (let ((buffers (list (generate-new-buffer "test.org") (generate-new-buffer "test.other"))))
(save-excursion (with-current-buffer (car buffers)
(switch-to-buffer (car buffers))
(org-mode)) (org-mode))
(spy-on 'buffer-list :and-return-value buffers) (spy-on 'buffer-list :and-return-value buffers)
(expect (org-ql-view--expand-buffers-files "all") :to-equal (list (car buffers))))) (expect (org-ql-view--expand-buffers-files "all") :to-equal (list (buffer-name (car buffers))))))
(it "org-agenda-files" (it "returns values of \"org-agenda-files\""
(spy-on 'org-agenda-files :and-return-value "value for org-agenda-files") (let ((org-agenda-files (mapcar
(expect (org-ql-view--expand-buffers-files "org-agenda-files") :to-equal "value for org-agenda-files")) (lambda (it)
(it "org-directory" (buffer-name it))
(spy-on 'org-ql-search-directories-files :and-return-value "value for org-directory") (list (generate-new-buffer "test1")
(expect (org-ql-view--expand-buffers-files "org-directory") :to-equal "value for org-directory")) (generate-new-buffer "test2")))))
(it "buffer" (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 (with-temp-buffer
(expect (org-ql-view--expand-buffers-files "buffer") :to-equal (current-buffer)))) (expect (org-ql-view--expand-buffers-files "buffer") :to-equal (list (buffer-name (current-buffer))))))
(it "literal values" (it "returns literal value(s)"
(with-temp-buffer (with-temp-buffer
(expect (org-ql-view--expand-buffers-files (current-buffer)) :to-equal (current-buffer))) (expect (org-ql-view--expand-buffers-files (current-buffer)) :to-equal (list (buffer-name (current-buffer)))))
(let ((test-buffer (get-buffer-create (make-temp-file "test")))) (let ((test-buffer (generate-new-buffer "test")))
(expect (org-ql-view--expand-buffers-files test-buffer) :to-equal test-buffer)) (expect (org-ql-view--expand-buffers-files test-buffer) :to-equal (list (buffer-name test-buffer))))
(let ((test-list '(1 2 3))) (let ((list-of-numbers '(1 2 3))
(expect (org-ql-view--expand-buffers-files test-list) :to-equal test-list)) (literal-string "random string"))
(let ((string-literal "this is a string")) ;; If the value does not result to a buffer, file, or string, throws error
(expect (org-ql-view--expand-buffers-files string-literal) :to-equal string-literal)))) (expect (org-ql-view--expand-buffers-files list-of-numbers) :to-throw)
(describe "Testing org-ql-view--complete-buffers-files" (expect (org-ql-view--expand-buffers-files literal-string) :to-equal (list literal-string)))))
(it "org-agenda-files" (describe "testing `org-ql-view--complete-buffers-files'"
(it "returns `org-agenda-files'"
(let ((org-ql-view-buffers-files temp-filenames)) (let ((org-ql-view-buffers-files temp-filenames))
(spy-on 'org-ql-view--contract-buffers-files :and-call-through) (spy-on 'org-ql-view--contract-buffers-files :and-call-through)
(spy-on 'org-agenda-files :and-return-value temp-filenames) (spy-on 'org-agenda-files :and-return-value temp-filenames)
(spy-on 'completing-read :and-return-value "org-agenda-files") (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--complete-buffers-files) :to-equal temp-filenames)
(expect 'org-ql-view--contract-buffers-files :to-have-been-called-with temp-filenames) (expect 'org-ql-view--contract-buffers-files :to-have-been-called-with temp-filenames)
(expect 'completing-read :to-have-been-called-with "Buffers/Files: " ;; Also testing if the initial values are set correctly
(list 'buffer 'org-agenda-files 'org-directory 'all) (expect 'completing-read-multiple :to-have-been-called-with "Buffers/Files: "
nil nil "org-agenda-files"))) (list 'buffer 'org-agenda-files 'org-directory 'all)
(it "nil" nil nil "org-agenda-files")))
(it "returns nil"
(let ((org-ql-view-buffers-files nil)) (let ((org-ql-view-buffers-files nil))
(spy-on 'completing-read :and-return-value nil) (spy-on 'completing-read-multiple :and-return-value nil)
(expect (org-ql-view--complete-buffers-files) :to-equal nil) (expect (org-ql-view--complete-buffers-files) :to-equal nil)
(expect 'completing-read :to-have-been-called-with "Buffers/Files: " (expect 'completing-read-multiple :to-have-been-called-with "Buffers/Files: "
(list 'buffer 'org-agenda-files 'org-directory 'all) (list 'buffer 'org-agenda-files 'org-directory 'all)
nil nil nil))) nil nil nil)))
(it "list" (it "returna a list of buffers/files"
(let ((org-ql-view-buffers-files '(1 2 3))) (let ((list-of-files temp-filenames))
(spy-on 'completing-read :and-return-value nil) (spy-on 'completing-read-multiple :and-return-value list-of-files)
(expect (org-ql-view--complete-buffers-files) :to-equal org-ql-view-buffers-files) (expect (org-ql-view--complete-buffers-files) :to-equal list-of-files)))))))
(expect 'completing-read :not :to-have-been-called)))
(it "buffer"
(let ((org-ql-view-buffers-files (get-buffer-create (make-temp-file "test"))))
(spy-on 'completing-read :and-return-value nil)
(expect (org-ql-view--complete-buffers-files) :to-equal org-ql-view-buffers-files)
(expect 'completing-read :not :to-have-been-called)))))))
;; 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")