From 9d86ee9e1098fef5b4a17e98321f522f6d8fc20b Mon Sep 17 00:00:00 2001 From: Adam Porter Date: Mon, 16 Nov 2020 02:02:22 -0600 Subject: [PATCH] Change/Fix: Bookmark, link storing/loading/safety This makes several changes and fixes and adds test cases for all the combinations I'm aware of. See #147. Thanks to @tpeacock19 for patiently reporting these issues. Squashed commit of the following: commit d1b396c5654ae3fa8ad03d0d4b2cbde20000fa1a Author: Adam Porter Date: Mon Nov 16 02:01:23 2020 -0600 WIP: Fixes commit 23215a723c4bf6e249c330863e01029166db56c3 Author: Adam Porter Date: Mon Nov 16 01:34:34 2020 -0600 WIP: Fixes commit 97b13d09d4d52bb168bfc19fb6f8daf2964f4b6c Author: Adam Porter Date: Mon Nov 16 00:46:49 2020 -0600 WIP: Test links too Everything passes now. commit 1866a71dbbb6416f7e365c90cadd269765d52b70 Author: Adam Porter Date: Sun Nov 15 22:22:22 2020 -0600 WIP: Test loading/saving bookmarks --- org-ql-view.el | 62 +++++---- org-ql.el | 2 + tests/test-org-ql.el | 321 ++++++++++++++++++++++++++++++++++++------- 3 files changed, 310 insertions(+), 75 deletions(-) diff --git a/org-ql-view.el b/org-ql-view.el index 062c9e9..8e8d40b 100644 --- a/org-ql-view.el +++ b/org-ql-view.el @@ -620,7 +620,7 @@ protocol. See, e.g. `org-ql-view--link-store'." (read-value (read stored-string))) ;; Ensure the value is either a symbol or list of symbols (which excludes lambdas). (unless (or (symbolp read-value) (cl-every #'symbolp read-value)) - (error "Potentially unsafe value found in link's SORT parameter (%s). Link not opened" + (error "CAUTION: Link not opened because unsafe sort parameter detected: %s" read-value)) read-value)) (org-super-agenda-allow-unsafe-groups nil) ; Disallow unsafe group selectors. @@ -631,6 +631,10 @@ protocol. See, e.g. `org-ql-view--link-store'." (buffers-files (--if-let (alist-get "buffers-files" params nil nil #'string=) (org-ql-view--expand-buffers-files (read it)) (current-buffer)))) + (unless (or (bufferp buffers-files) + (stringp buffers-files) + (cl-every #'stringp buffers-files)) + (error "CAUTION: Link not opened because unsafe buffers-files parameter detected: %s" buffers-files)) (when (and org-ql-view-ask-unsafe-links (or (string-match (rx bol (0+ space) "(") query) (listp query))) @@ -655,31 +659,31 @@ When opened, the link searches the buffer it's opened from." (require 'url-util) (when org-ql-view-query ;; Only Org QL View buffers should have `org-ql-view-query' set. - (cl-flet ((prompt-for (buffers-files) - (pcase-exhaustive - (completing-read (format "Link to search file containing inserted link or %s? " buffers-files) - (list "containing file" buffers-files) nil t) - ("containing file" nil) - (buffers-files (prin1-to-string buffers-files)))) - (string-or-file-buffer-p - (thing) (cl-etypecase thing - (string thing) - (buffer (or (buffer-file-name thing) - ;; TODO: Should indirect buffers be allowed? Maybe not, since their narrowing isn't preserved. - ;; On the other hand, it's possible to accidentally make a search view for an indirect buffer - ;; that's 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) - (buffer-file-name (buffer-base-buffer thing)))))))) - (unless (or (string-or-file-buffer-p org-ql-view-buffers-files) - (and (listp org-ql-view-buffers-files) - (cl-every #'string-or-file-buffer-p org-ql-view-buffers-files))) + (cl-labels ((prompt-for (buffers-files) + (pcase-exhaustive + (completing-read (format "Make link that searches: ") + '("file link is in" "files currently searched") + nil t nil nil "file link is in") + ("file link is in" nil) + ("files currently searched" buffers-files))) + (strings-or-file-buffers-p + (thing) (cl-etypecase thing + (list (cl-every #'strings-or-file-buffers-p thing)) + (string thing) + (buffer (or (buffer-file-name thing) + ;; TODO: Should indirect buffers be allowed? Maybe not, since their narrowing isn't preserved. + ;; On the other hand, it's possible to accidentally make a search view for an indirect buffer + ;; that's 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) + (buffer-file-name (buffer-base-buffer thing)))))))) + (unless (strings-or-file-buffers-p org-ql-view-buffers-files) (user-error "Views that search non-file-backed buffers can't be linked to")) (let* ((query-string (--if-let (org-ql--query-sexp-to-string org-ql-view-query) it (org-ql-view--format-query org-ql-view-query))) (buffers-files (prompt-for (org-ql-view--contract-buffers-files org-ql-view-buffers-files))) (params (list (when buffers-files - (list "buffers-files" buffers-files)) + (list "buffers-files" (prin1-to-string buffers-files))) (when org-ql-view-super-groups (list "super-groups" (prin1-to-string org-ql-view-super-groups))) (when org-ql-view-sort @@ -1037,16 +1041,14 @@ current buffer. Otherwise BUFFERS-FILES is returned unchanged." "org-agenda-files") ((pred (seq-set-equal-p (org-ql-search-directories-files))) "org-directory") - (_ (let ((print-length nil)) - (concat "'" (prin1-to-string buffers-files)))))) + (_ 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)) - (_ (let ((print-length nil)) - (prin1-to-string buffers-files)))))) + (_ buffers-files)))) (defun org-ql-view--complete-buffers-files () "Return value for `org-ql-view-buffers-files' using completion." @@ -1068,13 +1070,15 @@ current buffer. Otherwise BUFFERS-FILES is returned unchanged." "Return BUFFERS-FILES expanded to a list of files or buffers. The counterpart to `org-ql-view--contract-buffers-files'." (pcase-exhaustive buffers-files - ((pred bufferp) buffers-files) - ((or "" "buffer") (current-buffer)) - ("org-agenda-files" (org-agenda-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)) - (else (s-split (rx (1+ space)) else)))) + ((or "" "buffer") (current-buffer)) + ((pred bufferp) buffers-files) + ((pred listp) buffers-files) + ;; A single filename. + ((pred stringp) buffers-files))) (defun org-ql-view--complete-super-groups () "Return value for `org-ql-view-super-groups' using completion." diff --git a/org-ql.el b/org-ql.el index 3825ec2..3b97307 100644 --- a/org-ql.el +++ b/org-ql.el @@ -225,6 +225,8 @@ returns nil or non-nil." (list buffers-or-files) (otherwise (list buffers-or-files))) (--map (cl-etypecase it + ;; NOTE: This etypecase is essential to opening links safely, + ;; as it rejects, e.g. lambdas in the buffers-files argument. (buffer it) (string (or (find-buffer-visiting it) (when (file-readable-p it) diff --git a/tests/test-org-ql.el b/tests/test-org-ql.el index 95519e8..f9499b7 100644 --- a/tests/test-org-ql.el +++ b/tests/test-org-ql.el @@ -3,7 +3,7 @@ ;; Copyright (C) 2019 Adam Porter ;; Author: Adam Porter -;; Package-Requires: ((buttercup)) +;; Package-Requires: ((buttercup) (with-simulated-input)) ;; This program is free software; you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by @@ -27,6 +27,7 @@ ;;;; Requirements (require 'buttercup) +(require 'with-simulated-input) (require 'org-ql) @@ -1166,6 +1167,11 @@ RESULTS should be a list of strings as returned by ;; different reason. Were it not for testing the specific error AND its arguments, that test ;; case would have apparently passed, but it would have hidden the mistake in the test. + ;; NOTE: Rather than calling `message' in the "evil" lambdas (which, if it succeeds + ;; in being evil, merely writes a string to the test output, which is EASILY missed), + ;; we call `error', which, in combination with testing for specific error types and + ;; arguments, correctly causes tests to fail if the unsafe condition is not caught. + ;; Also, while writing these tests, the version of org-super-agenda in the test sandbox does ;; not have the fix applied yet, and the test for that apparently, correctly does not pass yet. @@ -1187,72 +1193,295 @@ RESULTS should be a list of strings as returned by (backward-char 1) (call-interactively #'org-open-at-point)))) - (it "buffers-files parameter" - (let ((quoted-lambda-link "[[org-ql-search:todo:?buffers-files%3D%28lambda%20nil%20%28message%20%22AHA%22%29%29]]") - (unquoted-lambda-link "[[org-ql-search:todo:?buffers-files%3D%28lambda%20nil%20%28message%20%22AHA%22%29%29]]") - (quoted-lambda-in-list-link "[[org-ql-search:todo:?buffers-files%3D%28%28quote%20%28lambda%20nil%20%28message%20%22AHA%22%29%29%29%29]]") - (unquoted-lambda-in-list-link "[[org-ql-search:todo:?buffers-files%3D%28%28lambda%20nil%20%28message%20%22AHA%22%29%29%29]]")) + (describe "buffers-files parameter" + :var ((quoted-lambda-link "[[org-ql-search:todo:?buffers-files%3D%28lambda%20nil%20%28error%20%22UNSAFE%22%29%29]]") + (unquoted-lambda-link "[[org-ql-search:todo:?buffers-files%3D%28lambda%20nil%20%28error%20%22UNSAFE%22%29%29]]") + (quoted-lambda-in-list-link "[[org-ql-search:todo:?buffers-files%3D%28%28quote%20%28lambda%20nil%20%28error%20%22UNSAFE%22%29%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" (expect (open-link quoted-lambda-link) - :to-throw 'wrong-type-argument '(stringp (lambda nil (message "AHA")))) + :to-throw 'error '("CAUTION: Link not opened because unsafe buffers-files parameter detected: (lambda nil (error UNSAFE))"))) + (it "Errors for an unquoted lambda" (expect (open-link unquoted-lambda-link) - :to-throw 'wrong-type-argument '(stringp (lambda nil (message "AHA")))) + :to-throw 'error '("CAUTION: Link not opened because unsafe buffers-files parameter detected: (lambda nil (error UNSAFE))"))) + (it "Errors for a quoted lambda in a list" (expect (open-link quoted-lambda-in-list-link) - :to-throw 'wrong-type-argument '(stringp ((quote (lambda nil (message "AHA")))))) + :to-throw 'error '("CAUTION: Link not opened because unsafe buffers-files parameter detected: ((quote (lambda nil (error UNSAFE))))"))) + (it "Errors for an unquoted lambda in a list" (expect (open-link unquoted-lambda-in-list-link) - :to-throw 'wrong-type-argument '(stringp ((lambda nil (message "AHA"))))))) + :to-throw 'error '("CAUTION: Link not opened because unsafe buffers-files parameter detected: ((lambda nil (error UNSAFE)))")))) - (it "super-groups parameter" - (let ((quoted-lambda-link "[[org-ql-search:todo:?super-groups%3D%28lambda%20nil%20%28message%20%22AHA%22%29%29]]") - (unquoted-lambda-link "[[org-ql-search:todo:?super-groups%3D%28lambda%20nil%20%28message%20%22AHA%22%29%29]]") - (quoted-expression-link "[[org-ql-search:todo:?super-groups%3D%28message%20%22AHA%22%29]]") - (unquoted-expression-link "[[org-ql-search:todo:?super-groups%3D%22AHA%22]]") - (pred-selector-link "[[org-ql-search:todo:?super-groups%3D%28%28%3Apred%20%28lambda%20%28_%29%20%28message%20%22AHA%22%29%29%29%29]]") - (auto-map-selector-link "[[org-ql-search:todo:?super-groups%3D%28%28%3Aauto-map%20%28lambda%20%28_%29%20%28message%20%22AHA%22%29%29%29%29]]")) + (describe "super-groups parameter" + :var ((quoted-lambda-link "[[org-ql-search:todo:?super-groups%3D%28lambda%20nil%20%28error%20%22UNSAFE%22%29%29]]") + (unquoted-lambda-link "[[org-ql-search:todo:?super-groups%3D%28lambda%20nil%20%28error%20%22UNSAFE%22%29%29]]") + (quoted-expression-link "[[org-ql-search:todo:?super-groups%3D%28error%20%22UNSAFE%22%29]]") + (unquoted-expression-link "[[org-ql-search:todo:?super-groups%3D%22UNSAFE%22]]") + (pred-selector-link "[[org-ql-search:todo:?super-groups%3D%28%28%3Apred%20%28lambda%20%28_%29%20%28error%20%22UNSAFE%22%29%29%29%29]]") + (auto-map-selector-link "[[org-ql-search:todo:?super-groups%3D%28%28%3Aauto-map%20%28lambda%20%28_%29%20%28error%20%22UNSAFE%22%29%29%29%29]]")) + (it "Errors for a quoted lambda" (expect (open-link quoted-lambda-link) - :to-throw 'wrong-type-argument '(listp lambda)) + :to-throw 'wrong-type-argument '(listp lambda))) + (it "Errors for an unquoted lambda" (expect (open-link unquoted-lambda-link) - :to-throw 'wrong-type-argument '(listp lambda)) + :to-throw 'wrong-type-argument '(listp lambda))) + (it "Errors for a quoted expression" (expect (open-link quoted-expression-link) - :to-throw 'wrong-type-argument '(listp message)) + :to-throw 'wrong-type-argument '(listp error))) + (it "Errors for an unquoted expression" (expect (open-link unquoted-expression-link) - :to-throw 'error '("cl-etypecase failed: AHA, (symbol list)")) + :to-throw 'error '("cl-etypecase failed: UNSAFE, (symbol list)"))) - ;; FIXME: These two tests will not pass (i.e. they will not - ;; signal an error) until the version of org-super-agenda in - ;; the test sandbox is upgraded, which I'll do when MELPA - ;; packages the latest version. On the bright side, I just - ;; confirmed that, without the fix to org-super-agenda, - ;; these are vulnerable, which means that the test catches - ;; this problem and detects the fix. + ;; NOTE: These two tests depend on `org-super-agenda' to signal these errors. It's probably better + ;; to catch these in `org-super-agenda' rather than in `org-ql', because if other potentially unsafe + ;; selectors were added to org-super-agenda, org-ql would have to play catch-up, adding more tests. + ;; Catching them in org-super-agenda means that it can add more checks itself in the future. + (it "Errors for a :pred group" (expect (open-link pred-selector-link) - :to-throw 'error '("Unsafe groups disallowed (:pred): (lambda (_) (message AHA))")) + :to-throw 'error '("Unsafe groups disallowed (:pred): (lambda (_) (error UNSAFE))"))) + (it "Errors for an :auto-map group" (expect (open-link auto-map-selector-link) - :to-throw 'error '("Unsafe groups disallowed (:auto-map): ((lambda (_) (message AHA)))")))) + :to-throw 'error '("Unsafe groups disallowed (:auto-map): ((lambda (_) (error UNSAFE)))")))) - (it "title parameter" - (let ((quoted-lambda-link "[[org-ql-search:todo:?title%3D%28lambda%20%28_%20_%29%20%28message%20%22AHA%22%29%29]]") - (unquoted-lambda-link "[[org-ql-search:todo:?title%3D%28lambda%20%28_%20_%29%20%28message%20%22AHA%22%29%29]]") - (expression-link "[[org-ql-search:todo:?title%3D%28message%20%22AHA%22%29]]")) + (describe "title parameter" + :var ((quoted-lambda-link "[[org-ql-search:todo:?title%3D%28lambda%20%28_%20_%29%20%28error%20%22UNSAFE%22%29%29]]") + (unquoted-lambda-link "[[org-ql-search:todo:?title%3D%28lambda%20%28_%20_%29%20%28error%20%22UNSAFE%22%29%29]]") + (expression-link "[[org-ql-search:todo:?title%3D%28error%20%22UNSAFE%22%29]]")) + (it "Errors for a quoted lambda" (expect (open-link quoted-lambda-link) - :to-throw 'wrong-type-argument '(characterp lambda)) + :to-throw 'wrong-type-argument '(characterp lambda))) + (it "Errors for an unquoted lambda" (expect (open-link unquoted-lambda-link) - :to-throw 'wrong-type-argument '(characterp lambda)) + :to-throw 'wrong-type-argument '(characterp lambda))) + (it "Errors for an expression" (expect (open-link expression-link) - :to-throw 'wrong-type-argument '(characterp message)))) + :to-throw 'wrong-type-argument '(characterp error)))) - (it "sort parameter" - (let ((quoted-lambda-link "[[org-ql-search:todo:?sort%3D%28lambda%20%28_%20_%29%20%28message%20%22AHA%22%29%29]]") - (unquoted-lambda-link "[[org-ql-search:todo:?sort%3D%28lambda%20%28_%20_%29%20%28message%20%22AHA%22%29%29]]") - (quoted-lambda-in-list-link "[[org-ql-search:todo:?sort%3D%28%28quote%20%28lambda%20%28_%20_%29%20%28message%20%22AHA%22%29%29%29%29]]") - (unquoted-lambda-in-list-link "[[org-ql-search:todo:?sort=((lambda%20nil%20(message%20\"AHA\")))]]")) + (describe "sort parameter" + :var ((quoted-lambda-link "[[org-ql-search:todo:?sort%3D%28lambda%20%28_%20_%29%20%28error%20%22UNSAFE%22%29%29]]") + (unquoted-lambda-link "[[org-ql-search:todo:?sort%3D%28lambda%20%28_%20_%29%20%28error%20%22UNSAFE%22%29%29]]") + (quoted-lambda-in-list-link "[[org-ql-search:todo:?sort%3D%28%28quote%20%28lambda%20%28_%20_%29%20%28error%20%22UNSAFE%22%29%29%29%29]]") + (unquoted-lambda-in-list-link "[[org-ql-search:todo:?sort=((lambda%20nil%20(error%20\"UNSAFE\")))]]")) + (it "Errors for a quoted lambda" (expect (open-link quoted-lambda-link) - :to-throw 'error '("Potentially unsafe value found in link’s SORT parameter ((lambda (_ _) (message AHA))). Link not opened")) + :to-throw 'error '("CAUTION: Link not opened because unsafe sort parameter detected: (lambda (_ _) (error UNSAFE))"))) + (it "Errors for an unquoted lambda" (expect (open-link unquoted-lambda-link) - :to-throw 'error '("Potentially unsafe value found in link’s SORT parameter ((lambda (_ _) (message AHA))). Link not opened")) + :to-throw 'error '("CAUTION: Link not opened because unsafe sort parameter detected: (lambda (_ _) (error UNSAFE))"))) + (it "Errors for a quoted lambda in a list" (expect (open-link quoted-lambda-in-list-link) - :to-throw 'error '("Potentially unsafe value found in link’s SORT parameter (((quote (lambda (_ _) (message AHA))))). Link not opened")) + :to-throw 'error '("CAUTION: Link not opened because unsafe sort parameter detected: ((quote (lambda (_ _) (error UNSAFE))))"))) + (it "Errors for an unquoted lambda in a list" (expect (open-link unquoted-lambda-in-list-link) - :to-throw 'error '("Potentially unsafe value found in link’s SORT parameter (((lambda nil (message AHA)))). Link not opened")))))))) + :to-throw 'error '("CAUTION: Link not opened because unsafe sort parameter detected: ((lambda nil (error UNSAFE)))"))))))) + + (describe "View saving/loading" + :var* ((temp-dir (make-temp-file "test-org-ql-" 'dir)) + (temp-filenames (cl-loop for file in '("test1.org" "test2.org") + collect (expand-file-name file temp-dir))) + (file-contents (with-temp-buffer + (insert "#+TITLE: Test data\n\n" + "* TODO Heading 1\n" + "Heading 1 text.\n\n" + "* Heading 2\n" + "Heading 2 text.\n") + (buffer-string)))) + + ;; This section will test saving and loading search views by a few different + ;; means. In each one, the values of these buffer-local variables will be + ;; stored before saving a view and compared after loading it: + + ;; - org-ql-view-buffers-files + ;; - org-ql-view-query + ;; - org-ql-view-sort + ;; - org-ql-view-super-groups + ;; - org-ql-view-title + + ;; `org-ql-view-buffers-files' needs to be tested with these kinds of values: + + ;; - A buffer + ;; - A string (filename) + ;; - List of buffers + ;; - List of strings (filenames) + ;; - Combination + + ;; `org-ql-view-query' needs to be tested with these kinds of values: + + ;; - String query + ;; - Sexp query + + ;; `org-ql-view-sort' needs to be tested with these kinds of values: + + ;; - Symbol + ;; - List of symbols + + ;; `org-ql-view-super-groups' can probably be tested with nearly + ;; any list value (because this set of tests is not intended to + ;; test link safety). + + ;; TODO: `org-ql-view-title' needs to be tested with a string value. + + (before-all + (dolist (filename temp-filenames) + (with-temp-file filename + (insert file-contents)))) + + (after-all + (delete-directory temp-dir 'recursive)) + + (describe "Bookmarks" + :var ((title "ORG-QL-TEST") + bookmark-alist + view-buffer) + + (before-each + (setf view-buffer (get-buffer-create "*TEST*")) + (dolist (filename temp-filenames) + ;; Kill any existing buffers visiting these files. + (when-let ((buffer (find-file-noselect filename 'nowarn))) + (kill-buffer buffer)))) + + (cl-flet ((var-after-bookmark-set-and-jump + (var buffers-files query &key sort super-groups) + (org-ql-search buffers-files query + :super-groups super-groups + :sort sort :title title :buffer view-buffer) + (set-buffer view-buffer) + (bookmark-set title) + (kill-buffer) + (bookmark-jump title) + (buffer-local-value var (get-buffer (concat "*Org QL View: " title "*"))))) + + (describe "Grouping" + :var ((query '(and (todo "TODO") (regexp "heading"))) + (super-groups '((:auto-priority)))) + (it "is restored" + (expect (var-after-bookmark-set-and-jump 'org-ql-view-super-groups temp-filenames query + :super-groups super-groups) + :to-equal super-groups))) + + (describe "Queries" + :var ((string-query "todo:TODO regexp:heading") + (sexp-query '(and (todo "TODO") (regexp "heading")))) + (it "Sexps match" + (expect (var-after-bookmark-set-and-jump 'org-ql-view-query temp-filenames sexp-query) :to-equal sexp-query)) + (it "Strings match" + ;; NOTE: This test includes the string query being replaced with its sexp form after the query is run. + (expect (var-after-bookmark-set-and-jump 'org-ql-view-query temp-filenames string-query) + :to-equal sexp-query))) + + (describe "Sorting" + :var ((query '(and (todo "TODO") (regexp "heading"))) + (sorter 'todo) + (multiple-sorters '(todo priority))) + (it "One sorter is restored" + (expect (var-after-bookmark-set-and-jump 'org-ql-view-sort temp-filenames query :sort sorter) + :to-equal sorter)) + (it "Multiple sorters are restored" + ;; NOTE: This test includes the string query being replaced with its sexp form after the query is run. + (expect (var-after-bookmark-set-and-jump 'org-ql-view-sort temp-filenames query :sort multiple-sorters) + :to-equal multiple-sorters))) + + (describe "Buffers/Files" + :var ((query '(and (todo "TODO") (regexp "heading"))) + (one-filename (car temp-filenames))) + (it "One filename matches" + (expect (var-after-bookmark-set-and-jump 'org-ql-view-buffers-files one-filename query) + :to-equal one-filename)) + (it "A list of filenames matches" + (expect (var-after-bookmark-set-and-jump 'org-ql-view-buffers-files temp-filenames query) + :to-equal temp-filenames)) + ;; NOTE: These actually bookmark the filenames backing the buffers. + (it "One buffer matches" + (expect (var-after-bookmark-set-and-jump 'org-ql-view-buffers-files + (find-file-noselect (car temp-filenames)) query) + :to-equal one-filename)) + (it "A list of buffers matches" + (expect (var-after-bookmark-set-and-jump 'org-ql-view-buffers-files + (mapcar #'find-file-noselect temp-filenames) query) + :to-equal temp-filenames))))) + + (describe "Links" + ;; Not sure if this binding works. + :var ((title "ORG-QL-TEST") + (view-buffer-name "*TEST VIEW BUFFER*") + link-buffer view-buffer) + + (before-each + (kill-buffer (get-buffer view-buffer-name)) + (setf link-buffer (get-buffer-create "*TEST LINK BUFFER*") + view-buffer (get-buffer-create view-buffer-name)) + (with-current-buffer link-buffer + (erase-buffer) + (insert "* TODO Test heading\n\n") + (org-mode))) + + (cl-flet ((var-after-link-save-open + (var buffers-files query &key sort super-groups (input "RET")) + (org-ql-search buffers-files query + :super-groups super-groups + :sort sort :title title :buffer view-buffer) + (with-current-buffer view-buffer + (with-simulated-input input + ;; Avoid writing "Stored: ..." to test output. + (let ((inhibit-message t)) + (org-store-link nil))) + (kill-buffer)) + ;; ;; Let's see if this trick works. + (org-open-link-from-string (caar org-stored-links) nil link-buffer) + (with-current-buffer (get-buffer (concat "*Org QL View: " title "*")) + (prog1 (buffer-local-value var (current-buffer)) + (kill-buffer))))) + + (describe "Queries" + :var ((string-query "todo:TODO regexp:heading") + (sexp-query '(and (todo "TODO") (regexp "heading")))) + (it "Sexps match" + (expect (var-after-link-save-open 'org-ql-view-query temp-filenames sexp-query) :to-equal sexp-query)) + (it "Strings match" + ;; NOTE: This test includes the string query being replaced with its sexp form after the query is run. + (expect (var-after-link-save-open 'org-ql-view-query temp-filenames string-query) + :to-equal sexp-query))) + + (describe "Grouping" + :var ((query '(and (todo "TODO") (regexp "heading"))) + (super-groups '((:auto-priority)))) + (it "is restored" + (expect (var-after-link-save-open 'org-ql-view-super-groups temp-filenames query + :super-groups super-groups) + :to-equal super-groups))) + + (describe "Sorting" + :var ((query '(and (todo "TODO") (regexp "heading"))) + (sorter 'todo) + (multiple-sorters '(todo priority))) + (it "One sorter is restored" + (expect (var-after-link-save-open 'org-ql-view-sort temp-filenames query :sort sorter) + :to-equal sorter)) + (it "Multiple sorters are restored" + ;; NOTE: This test includes the string query being replaced with its sexp form after the query is run. + (expect (var-after-link-save-open 'org-ql-view-sort temp-filenames query :sort multiple-sorters) + :to-equal multiple-sorters))) + + (describe "Buffers/Files" + :var ((query '(and (todo "TODO") (regexp "heading"))) + (one-buffer (find-file-noselect (car temp-filenames))) + (one-filename (car temp-filenames)) + (buffers (mapcar #'find-file-noselect temp-filenames))) + (it "Can search buffer containing the link" + (expect (var-after-link-save-open 'org-ql-view-buffers-files one-filename query) + :to-equal link-buffer)) + (it "Can search a file by filename" + (expect (var-after-link-save-open 'org-ql-view-buffers-files one-filename query + :input "M-n M-n RET") + :to-equal one-filename)) + (it "Can search multiple files by filename" + (expect (var-after-link-save-open 'org-ql-view-buffers-files temp-filenames query + :input "M-n M-n RET") + :to-equal temp-filenames))))) + + ;; MAYBE: Also test `org-ql-views', although I already know it works now. + ;; (describe "org-ql-views") + )) ;; Local Variables: ;; truncate-lines: t