From 4b19e5fb0b96b8959fed7684b09f87b8c6a80398 Mon Sep 17 00:00:00 2001 From: Ahmed Shariff Date: Sun, 20 Nov 2022 21:43:22 -0800 Subject: [PATCH 1/3] Allow mulitple values to be read for org-ql-view-buffers-files commit d8f29225a3735e7e548c1fd7ae0d1d28d43e941e Author: Ahmed Shariff Date: Fri Sep 24 15:47:38 2021 -0500 Abstract buffers-files being flattened to a list of strings commit 2d4974542591a74186bd8ba35e545cd5612be541 Author: Ahmed Shariff Date: Fri Sep 17 17:53:21 2021 -0500 Fix: \w duplicates & func's with buffers/names with expand/contract commit 576f9d3512769a073a470a500a832c70ea1afa04 Author: Ahmed Shariff Date: Thu Sep 16 18:42:32 2021 -0500 Handling support for functions \w functions using completing-read-multiple commit cea165192d25e6115adf7e309fa53b45aff2f633 Author: Ahmed Shariff Date: Thu Sep 16 16:49:19 2021 -0500 Cleaning up functions and improvements for clarity. commit aa9c6ccdfa0ca43f020a8828d5874fd32611bdbf Author: Ahmed Shariff Date: Wed Sep 15 17:56:19 2021 -0500 Adding `comma separated` instruction to readme commit 564d491604f76aa05e6e0a8e9d87b762153a78fd Author: Ahmed Shariff Date: Mon Sep 13 17:05:14 2021 -0500 Fixes for using mulitiple values and related test suite improvements commit ffaebcbcbef2fb5b471cd50fa673b1fec36aee12 Merge: 788951a 94f9e6f Author: Ahmed Shariff Date: Mon Sep 13 13:15:57 2021 -0500 Merge branch 'master' of https://github.com/alphapapa/org-ql commit 788951a4a9068b5ba14240fd25e4293a3712a716 Author: Ahmed Shariff Date: Mon Sep 13 11:01:55 2021 -0500 Replacing org-ql-view--expand-buffers-files commit cabf88eea5014149d9aabecc9a80cc853fd3b961 Author: Ahmed Shariff Date: Mon Jul 19 00:19:52 2021 -0500 removing duplcates when expanding buffers-files commit b68d83656265cbdbb4133dddc0280f54ee88fa87 Author: Ahmed Shariff Date: Sun Jul 18 23:49:54 2021 -0500 Using completing-read-multiple for org-ql-view--complete-buffers-files commit 06bdfc7a9ec8db8d0a4849a16176f3a6c5c370e5 Author: Ahmed Shariff Date: Sun Jul 4 23:32:08 2021 -0500 Fn always promts for buffer/files; handle buffer obj and list Fn: org-ql-view--complete-buffers-files With buffers, org-ql-view--contract-buffers-files return the buffer name. When org-ql-view-buffers-files is a list, just dumpt it as a string and check if completion-read returns the same value, if so return the original value of org-ql-view-buffers-files commit cc6e22dd309be75d462255a7fce0449d92beb188 Author: Ahmed Shariff Date: Sun Jul 4 23:31:31 2021 -0500 Allow reading buffer names for buffers-or-names commit 89b84768ad4c451bd43d17d072ef081f3dd521e1 Author: Ahmed Shariff Date: Sat Jul 3 21:25:10 2021 -0500 Test cases for all org-ql-view--*-buffers-files functions commit 7120b6334da5ce241e2738d0cb7fd387df2604a6 Author: Ahmed Shariff Date: Sat Jul 3 02:17:33 2021 -0500 Refactor of org-ql-view--complete-buffers-files Handles the different values `org-ql-view-buffers-files` can hold. Use completing-read only if `org-ql-view-buffers-files` is nil or the contracted form of `org-ql-view-buffers-files` is a string. commit 7b990e5275bd15104d8c17b33e65fbc4e260ff6a Author: Ahmed Shariff Date: Wed Jun 30 18:01:49 2021 -0500 Fix for issue with initial-input in org-ql-view--complete-buffers-files --- README.org | 2 +- org-ql-view.el | 140 ++++++++++++++++++++++++++++++++++--------------- 2 files changed, 99 insertions(+), 43 deletions(-) diff --git a/README.org b/README.org index 7ccf544f..b656fd4e 100644 --- a/README.org +++ b/README.org @@ -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~. diff --git a/org-ql-view.el b/org-ql-view.el index 74f74d96..de38ad77 100644 --- a/org-ql-view.el +++ b/org-ql-view.el @@ -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 @@ -1033,54 +1054,89 @@ 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) + 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." From 2d68ef526d2a21a9f1448a80a470d8c25e863854 Mon Sep 17 00:00:00 2001 From: Ahmed Shariff Date: Sun, 20 Nov 2022 21:53:29 -0800 Subject: [PATCH 2/3] Adding test cases for buffers-files --- tests/test-org-ql.el | 116 ++++++++++++++++++++++++++++++++++++++++--- 1 file changed, 109 insertions(+), 7 deletions(-) diff --git a/tests/test-org-ql.el b/tests/test-org-ql.el index 41ba1f6a..66a364a6 100644 --- a/tests/test-org-ql.el +++ b/tests/test-org-ql.el @@ -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]]") @@ -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") @@ -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") From 874d9d70d82347ee0d551c377a82c07982e92d51 Mon Sep 17 00:00:00 2001 From: Ahmed Shariff Date: Sun, 20 Nov 2022 23:56:32 -0800 Subject: [PATCH 3/3] Inform users: repscting a func set to org-ql-view-buffers-files --- org-ql-view.el | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/org-ql-view.el b/org-ql-view.el index de38ad77..5859dfdb 100644 --- a/org-ql-view.el +++ b/org-ql-view.el @@ -1106,7 +1106,9 @@ representation `org-ql-view-buffers-files' is returned." ",")) (_ (format "%s" contracted-org-ql-view-buffers-files)))) (completion-read-result (if (functionp contracted-org-ql-view-buffers-files) - 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)