From 706832275725e4d875db0cabb1faa6b40b9f73a2 Mon Sep 17 00:00:00 2001 From: Adam Porter Date: Tue, 16 Jul 2019 12:36:52 -0500 Subject: [PATCH 001/798] Meta: Update version --- README.org | 4 ++++ org-ql.el | 2 +- 2 files changed, 5 insertions(+), 1 deletion(-) diff --git a/README.org b/README.org index 98f6885..a5a6dbd 100644 --- a/README.org +++ b/README.org @@ -231,6 +231,10 @@ If ~MARKERS~ is non-nil, ~org-agenda-ng--add-markers~ is used to add markers to /Note:/ Breaking changes may be made before version 1.0, but in the event of major changes, attempts at backward compatibility will be made with obsolescence declarations, translation of arguments, etc. Users who need stability guarantees before 1.0 may choose to use tagged stable releases. +** 0.2-pre + +Nothing new yet. + ** 0.1 First tagged release. diff --git a/org-ql.el b/org-ql.el index 580722c..13420ad 100644 --- a/org-ql.el +++ b/org-ql.el @@ -2,7 +2,7 @@ ;; Author: Adam Porter ;; Url: http://github.com/alphapapa/org-ql -;; Version: 0.1 +;; Version: 0.2-pre ;; Package-Requires: ((emacs "25.1") (dash "2.13") (org "9.0") (s "1.12.0")) ;; Keywords: hypermedia, outlines, Org, agenda From 7dcdc21ea14f784f8f10dd66e2d89933126f4c27 Mon Sep 17 00:00:00 2001 From: Adam Porter Date: Tue, 16 Jul 2019 12:33:52 -0500 Subject: [PATCH 002/798] Change: (regexp) Accept multiple regexps --- README.org | 3 ++- org-ql.el | 8 +++++--- tests/test-org-ql.el | 12 ++++++++++++ 3 files changed, 19 insertions(+), 4 deletions(-) diff --git a/README.org b/README.org index a5a6dbd..b2693f6 100644 --- a/README.org +++ b/README.org @@ -233,7 +233,8 @@ If ~MARKERS~ is non-nil, ~org-agenda-ng--add-markers~ is used to add markers to ** 0.2-pre -Nothing new yet. +*Changed* ++ ~(regexp)~ selector accepts multiple regexps to test. ** 0.1 diff --git a/org-ql.el b/org-ql.el index 13420ad..fc59f14 100644 --- a/org-ql.el +++ b/org-ql.el @@ -461,14 +461,16 @@ comparator, PRIORITY should be a priority string." "Return non-nil if entry is a habit." (org-is-habit-p)) -(org-ql--defpredicate regexp (regexp) - "Return non-nil if current entry matches REGEXP (a regexp string)." +(org-ql--defpredicate regexp (&rest regexps) + "Return non-nil if current entry matches one of REGEXPS (regexp strings)." (let ((end (or (save-excursion (outline-next-heading)) (point-max)))) (save-excursion (goto-char (line-beginning-position)) - (re-search-forward regexp end t)))) + (cl-loop for regexp in regexps + thereis (save-excursion + (re-search-forward regexp end t)))))) (org-ql--defpredicate heading (regexp) "Return non-nil if current entry's heading matches REGEXP (a regexp string)." diff --git a/tests/test-org-ql.el b/tests/test-org-ql.el index a718f9f..aa9807a 100644 --- a/tests/test-org-ql.el +++ b/tests/test-org-ql.el @@ -255,6 +255,18 @@ :action (org-ql-test-org-get-heading)) :to-equal '("Learn universal sign language"))) + (describe "(regexp)" + (it "with 1 argument" + (expect (org-ql test-buffer + (regexp "Take over") + :sort todo + :action (org-ql-test-org-get-heading)) :to-equal '("Take over the universe" "Take over the world" "Take over Mars" "Take over the moon" "Get haircut"))) + (it "with 2 arguments" + (expect (org-ql test-buffer + (regexp "Take over" "pizza") + :sort todo + :action (org-ql-test-org-get-heading)) :to-equal '("Take over the universe" "Take over the world" "Take over Mars" "Take over the moon" "Order a pizza" "Get haircut")))) + (describe "(ts)" (it "without arguments" (expect (org-ql test-buffer From 25ce89ca2cea3c15a11171f0f41aff09b779c1ee Mon Sep 17 00:00:00 2001 From: Adam Porter Date: Tue, 16 Jul 2019 12:34:20 -0500 Subject: [PATCH 003/798] Tests: Add/change convenience commands --- tests/test-org-ql.el | 27 ++++++++++++++++++++------- 1 file changed, 20 insertions(+), 7 deletions(-) diff --git a/tests/test-org-ql.el b/tests/test-org-ql.el index aa9807a..43dc296 100644 --- a/tests/test-org-ql.el +++ b/tests/test-org-ql.el @@ -34,13 +34,26 @@ (defun org-ql-test-insert-result () "FIXME: docstring" (interactive) - (let* ((value (eval (elisp--preceding-sexp))) - (prefix (if (and value (listp value)) - "'" - ""))) - (insert " :to-equal " - prefix - (format "%S" value)))) + (if-let* ((sexp (elisp--preceding-sexp)) + (correct-sexp-p (eq (car sexp) 'org-ql)) + (value (eval sexp)) + (prefix (if (and value (listp value)) + "'" + ""))) + (insert " :to-equal " + prefix + (format "%S" value)) + (user-error "Point must be after an `org-ql' form"))) + +(defun org-ql-test-show-result () + "Show `org-ql-agenda' for `org-ql' form." + (interactive) + (if-let* ((sexp (elisp--preceding-sexp)) + (correct-sexp-p (eq (car sexp) 'org-ql))) + (progn + (setf (car sexp) 'org-ql-agenda) + (eval sexp)) + (user-error "Point must be after an `org-ql' form"))) ;;;; Tests From 014e0f138884185a54118122e9b71da858958883 Mon Sep 17 00:00:00 2001 From: Adam Porter Date: Tue, 16 Jul 2019 12:34:34 -0500 Subject: [PATCH 004/798] Tests: Add (todo) tests --- tests/test-org-ql.el | 19 +++++++++++++++++++ 1 file changed, 19 insertions(+) diff --git a/tests/test-org-ql.el b/tests/test-org-ql.el index 43dc296..80663ec 100644 --- a/tests/test-org-ql.el +++ b/tests/test-org-ql.el @@ -280,6 +280,25 @@ :sort todo :action (org-ql-test-org-get-heading)) :to-equal '("Take over the universe" "Take over the world" "Take over Mars" "Take over the moon" "Order a pizza" "Get haircut")))) + (describe "(todo)" + (it "without arguments" + ;; FIXME: This returns an item that is done, which is incorrect. + (expect (org-ql test-buffer + (todo) + :sort todo + :action (org-ql-test-org-get-heading)) :to-equal '("Take over the universe" "Take over the world" "Skype with president of Antarctica" "Take over Mars" "Visit Mars" "Take over the moon" "Visit the moon" "Practice leaping tall buildings in a single bound" "Renew membership in supervillain club" "Learn universal sign language" "Order a pizza" "Get haircut" "Internet" "Spaceship lease" "Fix flux capacitor" "/r/emacs" "Shop for groceries" "Rewrite Emacs in Common Lisp" "Write a symphony"))) + (it "with 1 argument" + ;; FIXME: Figure out why this takes >10x longer than the other (todo) tests, according to Buttercup. + (expect (org-ql test-buffer + (todo "WAITING") + :sort todo + :action (org-ql-test-org-get-heading)) :to-equal '("Visit the moon"))) + (it "with 2 arguments" + (expect (org-ql test-buffer + (todo "WAITING" "SOMEDAY") + :sort todo + :action (org-ql-test-org-get-heading)) :to-equal '("Visit the moon" "Rewrite Emacs in Common Lisp" "Write a symphony")))) + (describe "(ts)" (it "without arguments" (expect (org-ql test-buffer From 3adaf4e5fcd676a020a589a6ba70b32fc17070d2 Mon Sep 17 00:00:00 2001 From: Adam Porter Date: Tue, 16 Jul 2019 09:31:48 -0500 Subject: [PATCH 005/798] Change: (org-ql-query) Call --select-cached with query, not pred Since we will be pre-processing and modifying the query, the predicate may not correspond exactly to the query, so we should key the cache on the original query. --- org-ql.el | 44 +++++++++++++++++++++++--------------------- 1 file changed, 23 insertions(+), 21 deletions(-) diff --git a/org-ql.el b/org-ql.el index fc59f14..36c3742 100644 --- a/org-ql.el +++ b/org-ql.el @@ -209,7 +209,7 @@ a list of defined `org-ql' sorting methods: `date', `deadline', (--map (with-current-buffer it (unless (derived-mode-p 'org-mode) (user-error "Not an Org buffer: %s" (buffer-name))) - (org-ql--select-cached :predicate predicate :action action :narrow narrow))) + (org-ql--select-cached :query query :predicate predicate :action action :narrow narrow))) ;; Flatten items (-flatten-n 1)))) ;; Sort items @@ -230,27 +230,29 @@ a list of defined `org-ql' sorting methods: `date', `deadline', "Return results for ARGS and current buffer using cache." ;; MAYBE: Timeout cached queries. Probably not necessarily since they will be removed when a ;; buffer is closed, or when a query is run after modifying a buffer. - (if-let* ((buffer-cache (gethash (current-buffer) org-ql-cache)) - (query-cache (cadr buffer-cache)) - (modified-tick (car buffer-cache)) - (buffer-unmodified-p (eq (buffer-modified-tick) modified-tick)) - (cached-result (gethash args query-cache))) - (pcase cached-result - ('org-ql-nil nil) - (_ cached-result)) - (let ((new-result (apply #'org-ql--select args))) - (cond ((or (not query-cache) - (not buffer-unmodified-p)) - (puthash (current-buffer) - (list (buffer-modified-tick) - (let ((table (make-hash-table :test 'org-ql-hash-test))) - (puthash args (or new-result 'org-ql-nil) table) - table)) - org-ql-cache)) - (t (puthash args (or new-result 'org-ql-nil) query-cache))) - new-result))) + (-let (((&plist :query query :action action :narrow narrow) args)) + (if-let* ((buffer-cache (gethash (current-buffer) org-ql-cache)) + (query-cache (cadr buffer-cache)) + (modified-tick (car buffer-cache)) + (buffer-unmodified-p (eq (buffer-modified-tick) modified-tick)) + (cache-key (list query action narrow)) + (cached-result (gethash cache-key query-cache))) + (pcase cached-result + ('org-ql-nil nil) + (_ cached-result)) + (let ((new-result (apply #'org-ql--select args))) + (cond ((or (not query-cache) + (not buffer-unmodified-p)) + (puthash (current-buffer) + (list (buffer-modified-tick) + (let ((table (make-hash-table :test 'org-ql-hash-test))) + (puthash args (or new-result 'org-ql-nil) table) + table)) + org-ql-cache)) + (t (puthash args (or new-result 'org-ql-nil) query-cache))) + new-result)))) -(cl-defun org-ql--select (&key predicate action narrow) +(cl-defun org-ql--select (&key predicate action narrow &allow-other-keys) "Return results of mapping function ACTION across entries in current buffer matching function PREDICATE. If NARROW is non-nil, buffer will not be widened." ;; Since the mappings are stored in the variable `org-ql-predicates', macros like `flet' From 3933db460bd2519996cfee520c2bcd81087afd1e Mon Sep 17 00:00:00 2001 From: Adam Porter Date: Tue, 16 Jul 2019 10:40:59 -0500 Subject: [PATCH 006/798] Add: Query preambles Notes: Mark preambles as done Docs: Add changelog entry --- README.org | 3 + notes.org | 79 +++++++++++++++++- org-ql.el | 231 ++++++++++++++++++++++++++++++++--------------------- 3 files changed, 223 insertions(+), 90 deletions(-) diff --git a/README.org b/README.org index b2693f6..07d9bbe 100644 --- a/README.org +++ b/README.org @@ -236,6 +236,9 @@ If ~MARKERS~ is non-nil, ~org-agenda-ng--add-markers~ is used to add markers to *Changed* + ~(regexp)~ selector accepts multiple regexps to test. +*Internal* ++ Optimizations for some query selectors, e.g. =regexp= and =todo=. These can provide a significant improvement for some queries. See benchmarks in [[file:notes.org][notes.org]]. + ** 0.1 First tagged release. diff --git a/notes.org b/notes.org index 20c767e..66af1a3 100644 --- a/notes.org +++ b/notes.org @@ -48,7 +48,7 @@ This would be useful for having a menu of saved queries as Org links, or even bo ** TODO [#A] Store query for refreshing ql-agenda buffer -** UNDERWAY [#B] Dual matching with regexp and predicates +** DONE [#B] Dual matching with regexp and predicates :PROPERTIES: :ID: 39972bb5-fdd0-4754-93ba-c85796a67ccf :END: @@ -69,6 +69,83 @@ Only entries that contain the word =lisp= can be matches, and searching each ent This would require processing the predicate to pull out matchers that can be done as buffer-wide regexps, e.g. =regexp=, =heading-regexp=, =todo=, and possibly =tags=. Org has some regexp-building functions that might make this fairly easy, and then we could probably use ~rx~ to make an optimized version of the regexp. It would also require some refactoring to the searching that would go directly to regexp matches when possible, rather than checking every entry with the predicate. +[2019-07-16 Tue 11:14] Made new branch =preamble-re-new= based on current =master=. Seems to work well. Here's some code for testing and comparing performance (~bench-multi-lets~ is from [[https://github.com/alphapapa/emacs-package-dev-handbook#bench-multi-lets][here]]). + +[2019-07-16 Tue 11:56] Going to merge to =master= as 0.2, so marking this as done, even though there's a bit more that can be done from here. + +*** Benchmark code + +#+BEGIN_SRC elisp + (cl-defmacro org-ql-preamble-bench (&key query (file "tests/data.org") (times 10)) + `(bench-multi-lets :times ,times :ensure-equal t + :lets (("preamble" ((org-ql-use-preamble t))) + ("no preamble" ((org-ql-use-preamble nil)))) + :forms ((,(prin1-to-string query) (org-ql-query ,file + ',query + :action (lambda () (org-get-heading t t))))))) +#+END_SRC + +#+BEGIN_SRC elisp + (org-ql-preamble-bench :query (regexp "Emacs") :times 100) +#+END_SRC + +#+RESULTS: +| Form | x faster than next | Total runtime | # of GCs | Total GC runtime | +|-------------------------------+--------------------+---------------+----------+------------------| +| preamble: (regexp "Emacs") | 1.22 | 0.141767 | 0 | 0 | +| no preamble: (regexp "Emacs") | slowest | 0.172398 | 0 | 0 | + +#+BEGIN_SRC elisp + (org-ql-preamble-bench :file "~/org/inbox.org" :query (regexp "Emacs") :times 5) +#+END_SRC + +#+RESULTS: +| Form | x faster than next | Total runtime | # of GCs | Total GC runtime | +|-------------------------------+--------------------+---------------+----------+------------------| +| preamble: (regexp "Emacs") | 1.59 | 2.011043 | 0 | 0 | +| no preamble: (regexp "Emacs") | slowest | 3.206370 | 0 | 0 | + +#+BEGIN_SRC elisp + (org-ql-preamble-bench :file "~/org/inbox.org" :query (and (regexp "Emacs") (todo)) :times 5) +#+END_SRC + +#+RESULTS: +| Form | x faster than next | Total runtime | # of GCs | Total GC runtime | +|--------------------------------------------+--------------------+---------------+----------+------------------| +| preamble: (and (regexp "Emacs") (todo)) | 1.59 | 2.211503 | 0 | 0 | +| no preamble: (and (regexp "Emacs") (todo)) | slowest | 3.512741 | 0 | 0 | + +#+BEGIN_SRC elisp + (org-ql-preamble-bench :file "~/org/inbox.org" :query (and (regexp "Emacs") (todo) (scheduled)) :times 5) +#+END_SRC + +#+RESULTS: +| Form | x faster than next | Total runtime | # of GCs | Total GC runtime | +|--------------------------------------------------------+--------------------+---------------+----------+------------------| +| preamble: (and (regexp "Emacs") (todo) (scheduled)) | 1.69 | 2.042456 | 0 | 0 | +| no preamble: (and (regexp "Emacs") (todo) (scheduled)) | slowest | 3.453756 | 0 | 0 | + +#+BEGIN_SRC elisp + (org-ql-preamble-bench :file "~/org/inbox.org" :query (todo "WAITING") :times 2) +#+END_SRC + +#+RESULTS: +| Form | x faster than next | Total runtime | # of GCs | Total GC runtime | +|-------------------------------+--------------------+---------------+----------+------------------| +| preamble: (todo "WAITING") | 15.60 | 0.070684 | 0 | 0 | +| no preamble: (todo "WAITING") | slowest | 1.102722 | 0 | 0 | + +Wow, that's a huge improvement! + +** TODO Normalize queries + +[2019-07-16 Tue 11:49] This serves two purposes: + +1. Equivalent queries will return the same results from the cache. +2. The selectors that can be converted to the fastest preamble regexps will be sorted first, so the fastest preamble will be used. Although this may not always be straightforward. For example, in a file with only a few =TODO= items, the ~(todo "TODO")~ selector would convert to a preamble that would quickly search through the file. But if there were a thousand =TODO= items, it wouldn't be as much of a benefit, and a ~(regexp "something")~ selector's preamble might be much faster, depending on how many times =something= appears in the file. + +So the second purpose might actually be a drawback, because it would prevent users from optimizing their queries with knowledge of their data. Maybe there should be an option to not normalize queries, so advanced users can order their selectors manually. + ** TODO [#A] Publish to MELPA ** TODO Add more sorters? diff --git a/org-ql.el b/org-ql.el index 36c3742..dd0a4b5 100644 --- a/org-ql.el +++ b/org-ql.el @@ -127,91 +127,93 @@ SORT is either nil, in which case items are not sorted; or one or a list of defined `org-ql' sorting methods: `date', `deadline', `scheduled', `todo', and `priority'." (declare (indent defun)) - (let* ((sources (pcase buffers-or-files - (`nil (list (current-buffer))) - ((pred listp) buffers-or-files) - (_ ; Buffer or string - (list buffers-or-files)))) - (predicate (byte-compile `(lambda () - ;; This is either really elegant or really ugly. Well, also - ;; possibly somewhere in-between. At the least, we should do - ;; this in a more flexible, abstracted way, but this will do - ;; for now. Most importantly, it works! - (let (from to on) - ;; TODO: DRY these macrolets. - (cl-macrolet ((clocked (&key from to on) - (when on - (setq from on - to on)) - (when from - (setq from (org-ql--parse-time-string from))) - (when to - (setq to (org-ql--parse-time-string to 'end))) - ;; NOTE: The macro must expand to the actual `org-ql--predicate-clocked' - ;; function, not another `clocked'. - `(org-ql--predicate-clocked :from ,from :to ,to)) - (ts (&key from to on) - (when on - (setq from on - to on)) - (when from - (setq from (org-ql--parse-time-string from))) - (when to - (setq to (org-ql--parse-time-string to 'end))) - ;; NOTE: The macro must expand to the actual `org-ql--predicate-ts' - ;; function, not another `ts'. - `(org-ql--predicate-ts :from ,from :to ,to)) - (ts-active (&key from to on) - (when on - (setq from on - to on)) - (when from - (setq from (org-ql--parse-time-string from))) - (when to - (setq to (org-ql--parse-time-string to 'end))) - ;; NOTE: The macro must expand to the actual `org-ql--predicate-ts' - ;; function, not another `ts'. - `(org-ql--predicate-ts-active :from ,from :to ,to)) - (ts-inactive (&key from to on) - (when on - (setq from on - to on)) - (when from - (setq from (org-ql--parse-time-string from))) - (when to - (setq to (org-ql--parse-time-string to 'end))) - ;; NOTE: The macro must expand to the actual `org-ql--predicate-ts' - ;; function, not another `ts'. - `(org-ql--predicate-ts-inactive :from ,from :to ,to))) - (cl-symbol-macrolet ((today org-ql--today) ; Necessary because of byte-compiling the lambda - (= #'=) - (< #'<) - (> #'>) - (<= #'<=) - (>= #'>=)) - ,query)))))) - (action (byte-compile action)) - ;; TODO: Figure out how to use or reimplement the org-scanner-tags feature. - ;; (org-use-tag-inheritance t) - ;; (org-trust-scanner-tags t) - (org-ql--today (org-today)) - (items (->> sources - ;; List buffers - (--map (cl-etypecase it - (buffer it) - (string (or (find-buffer-visiting it) - (when (file-readable-p it) - ;; It feels unintuitive that `find-file-noselect' returns - ;; a buffer if the filename doesn't exist. - (find-file-noselect it)) - (user-error "Can't open file: %s" it))))) - ;; Filter buffers (i.e. select items) - (--map (with-current-buffer it - (unless (derived-mode-p 'org-mode) - (user-error "Not an Org buffer: %s" (buffer-name))) - (org-ql--select-cached :query query :predicate predicate :action action :narrow narrow))) - ;; Flatten items - (-flatten-n 1)))) + (-let* ((sources (pcase buffers-or-files + (`nil (list (current-buffer))) + ((pred listp) buffers-or-files) + (_ ; Buffer or string + (list buffers-or-files)))) + ((query preamble-re) (org-ql--query-preamble query)) + (predicate (byte-compile `(lambda () + ;; This is either really elegant or really ugly. Well, also + ;; possibly somewhere in-between. At the least, we should do + ;; this in a more flexible, abstracted way, but this will do + ;; for now. Most importantly, it works! + (let (from to on) + ;; TODO: DRY these macrolets. + (cl-macrolet ((clocked (&key from to on) + (when on + (setq from on + to on)) + (when from + (setq from (org-ql--parse-time-string from))) + (when to + (setq to (org-ql--parse-time-string to 'end))) + ;; NOTE: The macro must expand to the actual `org-ql--predicate-clocked' + ;; function, not another `clocked'. + `(org-ql--predicate-clocked :from ,from :to ,to)) + (ts (&key from to on) + (when on + (setq from on + to on)) + (when from + (setq from (org-ql--parse-time-string from))) + (when to + (setq to (org-ql--parse-time-string to 'end))) + ;; NOTE: The macro must expand to the actual `org-ql--predicate-ts' + ;; function, not another `ts'. + `(org-ql--predicate-ts :from ,from :to ,to)) + (ts-active (&key from to on) + (when on + (setq from on + to on)) + (when from + (setq from (org-ql--parse-time-string from))) + (when to + (setq to (org-ql--parse-time-string to 'end))) + ;; NOTE: The macro must expand to the actual `org-ql--predicate-ts' + ;; function, not another `ts'. + `(org-ql--predicate-ts-active :from ,from :to ,to)) + (ts-inactive (&key from to on) + (when on + (setq from on + to on)) + (when from + (setq from (org-ql--parse-time-string from))) + (when to + (setq to (org-ql--parse-time-string to 'end))) + ;; NOTE: The macro must expand to the actual `org-ql--predicate-ts' + ;; function, not another `ts'. + `(org-ql--predicate-ts-inactive :from ,from :to ,to))) + (cl-symbol-macrolet ((today org-ql--today) ; Necessary because of byte-compiling the lambda + (= #'=) + (< #'<) + (> #'>) + (<= #'<=) + (>= #'>=)) + ,query)))))) + (action (byte-compile action)) + ;; TODO: Figure out how to use or reimplement the org-scanner-tags feature. + ;; (org-use-tag-inheritance t) + ;; (org-trust-scanner-tags t) + (org-ql--today (org-today)) + (items (->> sources + ;; List buffers + (--map (cl-etypecase it + (buffer it) + (string (or (find-buffer-visiting it) + (when (file-readable-p it) + ;; It feels unintuitive that `find-file-noselect' returns + ;; a buffer if the filename doesn't exist. + (find-file-noselect it)) + (user-error "Can't open file: %s" it))))) + ;; Filter buffers (i.e. select items) + (--map (with-current-buffer it + (unless (derived-mode-p 'org-mode) + (user-error "Not an Org buffer: %s" (buffer-name))) + (org-ql--select-cached :query query :preamble-re preamble-re + :predicate predicate :action action :narrow narrow))) + ;; Flatten items + (-flatten-n 1)))) ;; Sort items (pcase sort (`nil items) @@ -226,6 +228,51 @@ a list of defined `org-ql' sorting methods: `date', `deadline', (define-hash-table-test 'org-ql-hash-test #'equal (lambda (args) (sxhash-equal (prin1-to-string args)))) +(defvar org-ql-use-preamble t + ;; FIXME: Move or delete this defvar. + "Use query preambles to speed up searches. +May be disabled for debugging, benchmarks, etc.") + +(defun org-ql--query-preamble (query) + "Return (QUERY PREAMBLE) for QUERY. +When QUERY has a clause with a corresponding preamble, and it's +appropriate to use one (i.e. the clause is not in an `or'), +replace the clause with a preamble." + (if org-ql-use-preamble + (let (org-ql-preamble) + (cl-labels ((rec (element) + (or (when org-ql-preamble + ;; Only one preamble is allowed + element) + (pcase element + (`(or _) element) + (`(regexp . ,regexps) + (let* ((regexp (rx-to-string `(or ,@regexps)))) + (setq org-ql-preamble regexp) + ;; Return nil + nil)) + (`(todo . ,(and todo-keywords (guard todo-keywords))) + (let* ((regexps (--map (list 'regexp + (format org-heading-keyword-regexp-format it)) + todo-keywords)) + (regexp (rx-to-string `(or ,@regexps)))) + (setq org-ql-preamble regexp) + ;; Return nil + nil)) + (`(and . ,rest) + (let ((clauses (mapcar #'rec rest))) + `(and ,@(-non-nil clauses)))) + (_ element))))) + (setq query (pcase (mapcar #'rec (list query)) + ((or `(nil) + `((nil)) + `((and)) + `((or))) + t) + (query (-flatten-n 1 query)))) + (list query org-ql-preamble))) + (list query nil))) + (defun org-ql--select-cached (&rest args) "Return results for ARGS and current buffer using cache." ;; MAYBE: Timeout cached queries. Probably not necessarily since they will be removed when a @@ -252,7 +299,7 @@ a list of defined `org-ql' sorting methods: `date', `deadline', (t (puthash args (or new-result 'org-ql-nil) query-cache))) new-result)))) -(cl-defun org-ql--select (&key predicate action narrow &allow-other-keys) +(cl-defun org-ql--select (&key preamble-re predicate action narrow &allow-other-keys) "Return results of mapping function ACTION across entries in current buffer matching function PREDICATE. If NARROW is non-nil, buffer will not be widened." ;; Since the mappings are stored in the variable `org-ql-predicates', macros like `flet' @@ -279,9 +326,15 @@ If NARROW is non-nil, buffer will not be widened." (goto-char (point-min)) (when (org-before-first-heading-p) (outline-next-heading)) - (cl-loop when (funcall predicate) - collect (funcall action) - while (outline-next-heading))))) + (cond (preamble-re (cl-loop when (and (when (re-search-forward preamble-re nil t) + (outline-back-to-heading 'invisible-ok) + t) + (funcall predicate)) + collect (funcall action) + while (outline-next-heading))) + (t (cl-loop when (funcall predicate) + collect (funcall action) + while (outline-next-heading))))))) (--each orig-fns ;; Restore original function mappings. (fset (plist-get it :name) (plist-get it :fn)))))) From 3b88b71b4167e7f180b71ee484380cbde0f73bbf Mon Sep 17 00:00:00 2001 From: Adam Porter Date: Tue, 16 Jul 2019 13:01:45 -0500 Subject: [PATCH 007/798] Fix: Unused variable warnings --- org-ql.el | 52 +++++++++++++++++++++++++++++++++------------------- 1 file changed, 33 insertions(+), 19 deletions(-) diff --git a/org-ql.el b/org-ql.el index dd0a4b5..499ac7e 100644 --- a/org-ql.el +++ b/org-ql.el @@ -393,7 +393,9 @@ empty time values to 23:59:59; otherwise, to 00:00:00." ;;;;; Predicates -(org-ql--defpredicate clocked (&key from to on) +(org-ql--defpredicate clocked (&key from to _on) + ;; The underscore before `on' prevents "unused lexical variable" warnings, because we + ;; pre-process that argument in a macro before this function is called. "Return non-nil if current entry was clocked in given period. If no arguments are specified, return non-nil if entry was clocked at any time. @@ -417,11 +419,13 @@ ignored." (test-timestamps (pred-form) `(cl-loop for next-ts = (next-timestamp) while next-ts - for beg = (float-time (org-timestamp--to-internal-time next-ts)) - for end = (float-time (org-timestamp--to-internal-time next-ts 'end)) + ;; Using `setf' instead of `for beg =` here prevents "unused lexical variable" warnings. + do (setf beg (float-time (org-timestamp--to-internal-time next-ts)) + end (float-time (org-timestamp--to-internal-time next-ts 'end))) thereis ,pred-form))) (save-excursion - (let ((end-pos (org-entry-end-position))) + (let ((end-pos (org-entry-end-position)) + beg end) (cond ((not (or from to)) (next-timestamp)) ((and from to) (test-timestamps (and (<= beg to) (>= end from)))) @@ -545,11 +549,14 @@ comparator, PRIORITY should be a priority string." ;;;;;; Timestamps -;; TODO: Move active/inactive into (ts) predicate, allowing the first arg to be either inactive/active -;; or the comparator. Using numeric comparators is more powerful, concise, and language-independent -;; than using from/to. Alternatively, add :before/:after, but I think the comparators are better. +;; TODO: Move active/inactive into (ts) predicate, allowing the first arg to be either +;; inactive/active or the comparator. Using numeric comparators is more powerful, concise, +;; and language-independent than using from/to. Alternatively, add :before/:after, but I +;; think the comparators are better. Also consider using a macro to DRY these out. -(org-ql--defpredicate ts (&key from to on) +(org-ql--defpredicate ts (&key from to _on) + ;; The underscore before `on' prevents "unused lexical variable" warnings, because we + ;; pre-process that argument in a macro before this function is called. "Return non-nil if current entry has a timestamp in given period. If no arguments are specified, return non-nil if entry has any timestamp. @@ -575,18 +582,21 @@ FROM, TO, and ON should be strings parseable by (test-timestamps (pred-form) `(cl-loop for next-ts = (next-timestamp) while next-ts - for beg = (float-time (org-timestamp--to-internal-time next-ts)) - for end = (float-time (org-timestamp--to-internal-time next-ts 'end)) + do (setf beg (float-time (org-timestamp--to-internal-time next-ts)) + end (float-time (org-timestamp--to-internal-time next-ts 'end))) thereis ,pred-form))) (save-excursion - (let ((end-pos (org-entry-end-position))) + (let ((end-pos (org-entry-end-position)) + beg end) (cond ((not (or from to)) (next-timestamp)) ((and from to) (test-timestamps (and (<= beg to) (>= end from)))) (from (test-timestamps (<= from end))) (to (test-timestamps (<= beg to)))))))) -(org-ql--defpredicate ts-active (&key from to on) +(org-ql--defpredicate ts-active (&key from to _on) + ;; The underscore before `on' prevents "unused lexical variable" warnings, because we + ;; pre-process that argument in a macro before this function is called. "Return non-nil if current entry has an active timestamp in given period. If no arguments are specified, return non-nil if entry has any active timestamp. @@ -615,18 +625,21 @@ FROM, TO, and ON should be strings parseable by `(cl-loop for next-ts = (next-timestamp) while next-ts when (string-prefix-p "<" next-ts) - for beg = (float-time (org-timestamp--to-internal-time next-ts)) - for end = (float-time (org-timestamp--to-internal-time next-ts 'end)) + do (setf beg (float-time (org-timestamp--to-internal-time next-ts)) + end (float-time (org-timestamp--to-internal-time next-ts 'end))) thereis ,pred-form))) (save-excursion - (let ((end-pos (org-entry-end-position))) + (let ((end-pos (org-entry-end-position)) + beg end) (cond ((not (or from to)) (next-timestamp)) ((and from to) (test-timestamps (and (<= beg to) (>= end from)))) (from (test-timestamps (<= from end))) (to (test-timestamps (<= beg to)))))))) -(org-ql--defpredicate ts-inactive (&key from to on) +(org-ql--defpredicate ts-inactive (&key from to _on) + ;; The underscore before `on' prevents "unused lexical variable" warnings, because we + ;; pre-process that argument in a macro before this function is called. "Return non-nil if current entry has an inactive timestamp in given period. If no arguments are specified, return non-nil if entry has any inactive timestamp. @@ -655,11 +668,12 @@ FROM, TO, and ON should be strings parseable by `(cl-loop for next-ts = (next-timestamp) while next-ts when (string-prefix-p "[" next-ts) - for beg = (float-time (org-timestamp--to-internal-time next-ts)) - for end = (float-time (org-timestamp--to-internal-time next-ts 'end)) + do (setf beg (float-time (org-timestamp--to-internal-time next-ts)) + end (float-time (org-timestamp--to-internal-time next-ts 'end))) thereis ,pred-form))) (save-excursion - (let ((end-pos (org-entry-end-position))) + (let ((end-pos (org-entry-end-position)) + beg end) (cond ((not (or from to)) (next-timestamp)) ((and from to) (test-timestamps (and (<= beg to) (>= end from)))) From 6a968d212f1b7225e288cb34347cbd8deaa3a112 Mon Sep 17 00:00:00 2001 From: Adam Porter Date: Tue, 16 Jul 2019 13:05:16 -0500 Subject: [PATCH 008/798] Docs: Update first paragraph --- README.org | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/README.org b/README.org index 07d9bbe..f3675ca 100644 --- a/README.org +++ b/README.org @@ -1,6 +1,6 @@ #+TITLE: org-ql -~org-ql~ is a lispy query language for Org files. It allows you to find Org entries matching certain criteria and perform actions on them, such as collecting their parsed representation with ~org-element~ (the default action). +~org-ql~ is a lispy query language for Org files. It allows you to find Org entries matching certain criteria and return a list of them or perform actions on them. Commands are also provided which display a buffer with matching results, similar to an Org Agenda buffer. * Contents :PROPERTIES: From 0b7628c1f72d96e799eef7b9b4a213ef4003005b Mon Sep 17 00:00:00 2001 From: Daniel Kraus Date: Fri, 12 Jul 2019 18:52:11 +0200 Subject: [PATCH 009/798] Fix: Byte-compile warnings Define some `org-super-agenda` symbols in case org-super-agenda is not installed. --- org-ql-agenda.el | 8 ++++++++ 1 file changed, 8 insertions(+) diff --git a/org-ql-agenda.el b/org-ql-agenda.el index 09f40e0..bd3e15e 100644 --- a/org-ql-agenda.el +++ b/org-ql-agenda.el @@ -33,6 +33,7 @@ (require 'cl-lib) (require 'org) +(require 'org-element) (require 'org-agenda) (require 'seq) (require 'rx) @@ -42,6 +43,13 @@ (require 'dash) (require 's) +;;;; Compatibility + +(defvar org-super-agenda-auto-selector-keywords) +(defvar org-super-agenda-groups) +(defvar org-super-agenda-mode) +(declare-function org-super-agenda--group-items "org-super-agenda") + ;;;; Variables (defvar org-ql-agenda-buffer-name "*Org Agenda NG*" From adcb96cb1e2fb3a10acf0fb9a3c231d5585af30f Mon Sep 17 00:00:00 2001 From: Daniel Kraus Date: Fri, 12 Jul 2019 18:53:06 +0200 Subject: [PATCH 010/798] Fix: Compatibility with org>=9.2 The API for `org-get-tags-at` and `org-timestamp--to-internal-time` changed in org-mode version 9.2. Thanks to Ataias Pereira Reis (@ataias) and Daniel Kraus (@dakra). Closes #27. Closes #31. --- README.org | 3 +++ org-ql-agenda.el | 7 +++++-- org-ql.el | 10 ++++++++-- 3 files changed, 16 insertions(+), 4 deletions(-) diff --git a/README.org b/README.org index f3675ca..698197d 100644 --- a/README.org +++ b/README.org @@ -236,6 +236,9 @@ If ~MARKERS~ is non-nil, ~org-agenda-ng--add-markers~ is used to add markers to *Changed* + ~(regexp)~ selector accepts multiple regexps to test. +*Compatibility* ++ Fixes for compatibility with Org 9.2. (Thanks to [[https://github.com/ataias][Ataias Pereira Reis]] and [[https://github.com/dakra][Daniel Kraus]].) + *Internal* + Optimizations for some query selectors, e.g. =regexp= and =todo=. These can provide a significant improvement for some queries. See benchmarks in [[file:notes.org][notes.org]]. diff --git a/org-ql-agenda.el b/org-ql-agenda.el index bd3e15e..c8d6074 100644 --- a/org-ql-agenda.el +++ b/org-ql-agenda.el @@ -50,6 +50,9 @@ (defvar org-super-agenda-mode) (declare-function org-super-agenda--group-items "org-super-agenda") +(when (version< org-version "9.2") + (defalias 'org-get-tags 'org-get-tags-at)) + ;;;; Variables (defvar org-ql-agenda-buffer-name "*Org Agenda NG*" @@ -328,8 +331,8 @@ Its property list should be the second item in the list, as returned by `org-ele (if-let ((marker (or (org-element-property :org-hd-marker element) (org-element-property :org-marker element)))) (with-current-buffer (marker-buffer marker) - ;; I wish `org-get-tags-at' used the correct buffer automatically. - (org-get-tags-at marker (not org-use-tag-inheritance))) + ;; I wish `org-get-tags' used the correct buffer automatically. + (org-get-tags marker (not org-use-tag-inheritance))) ;; No marker found (warn "No marker found for item: %s" title) (org-element-property :tags element)) diff --git a/org-ql.el b/org-ql.el index 499ac7e..fd60870 100644 --- a/org-ql.el +++ b/org-ql.el @@ -25,6 +25,12 @@ (require 'dash) +;;;; Compatibility + +(when (version< org-version "9.2") + (defalias 'org-get-tags 'org-get-tags-at) + (defalias 'org-timestamp-to-time 'org-timestamp--to-internal-time)) + ;;;; Variables (defvar org-ql--today nil) @@ -457,8 +463,8 @@ With KEYWORDS, return non-nil if its keyword is one of KEYWORDS (a list of strin (org-ql--defpredicate tags (&rest tags) "Return non-nil if current heading has one or more of TAGS (a list of strings)." ;; TODO: Try to use `org-make-tags-matcher' to improve performance. It would be nice to not have - ;; to run `org-get-tags-at' for every heading, especially with inheritance. - (when-let ((tags-at (org-get-tags-at (point) (not org-use-tag-inheritance)))) + ;; to run `org-get-tags' for every heading, especially with inheritance. + (when-let ((tags-at (org-get-tags (point) (not org-use-tag-inheritance)))) (cl-typecase tags (null t) (otherwise (seq-intersection tags tags-at))))) From 2b267ad195f9bf725cd41c77b64f8f5a3396cf59 Mon Sep 17 00:00:00 2001 From: Adam Porter Date: Tue, 16 Jul 2019 13:45:25 -0500 Subject: [PATCH 011/798] Fix: Depend on Emacs 26.1 for if-let* --- org-ql.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/org-ql.el b/org-ql.el index fd60870..4a1af2d 100644 --- a/org-ql.el +++ b/org-ql.el @@ -3,7 +3,7 @@ ;; Author: Adam Porter ;; Url: http://github.com/alphapapa/org-ql ;; Version: 0.2-pre -;; Package-Requires: ((emacs "25.1") (dash "2.13") (org "9.0") (s "1.12.0")) +;; Package-Requires: ((emacs "26.1") (dash "2.13") (org "9.0") (s "1.12.0")) ;; Keywords: hypermedia, outlines, Org, agenda ;;; Commentary: From 04725bb90026bbd6b602c0971565ee32d628fcf9 Mon Sep 17 00:00:00 2001 From: Adam Porter Date: Tue, 16 Jul 2019 13:45:39 -0500 Subject: [PATCH 012/798] Tidy: Remove unused macro --- org-ql.el | 9 --------- 1 file changed, 9 deletions(-) diff --git a/org-ql.el b/org-ql.el index 4a1af2d..93edb60 100644 --- a/org-ql.el +++ b/org-ql.el @@ -100,15 +100,6 @@ buffer. In this case, ACTION should return an Org element." :narrow ,narrow :sort ',sort)) -(defmacro org-ql--flet (fns &rest body) - ;; FIXME: Docstring. - ;; MAYBE: Use `noflet'. - (declare (indent defun) (debug (listp body))) - `(cl-letf ,(cl-loop for (fn target) in fns - collect `((symbol-function ',fn) - (symbol-function ,target))) - ,@body)) - ;;;; Functions (cl-defun org-ql-query (buffers-or-files query &key action narrow sort) From 42138e2673586301da5854b985648dcef506b1c8 Mon Sep 17 00:00:00 2001 From: Adam Porter Date: Tue, 16 Jul 2019 13:49:41 -0500 Subject: [PATCH 013/798] Docs: Update docstrings To comply with checkdoc. --- org-ql-agenda.el | 4 +++- org-ql.el | 6 +++--- 2 files changed, 6 insertions(+), 4 deletions(-) diff --git a/org-ql-agenda.el b/org-ql-agenda.el index c8d6074..f073f61 100644 --- a/org-ql-agenda.el +++ b/org-ql-agenda.el @@ -294,7 +294,7 @@ dates in the past, and negative for dates in the future." (defun org-ql-agenda--format-element (element) ;; This essentially needs to do what `org-agenda-format-item' does, ;; which is a lot. We are a long way from that, but it's a start. - "Return ELEMENT as a string with its text-properties set according to its property list. + "Return ELEMENT as a string with text-properties set by its property list. Its property list should be the second item in the list, as returned by `org-element-parse-buffer'." (let* ((properties (cadr element)) ;; Remove the :parent property, which so bloats the size of @@ -364,6 +364,7 @@ Its property list should be the second item in the list, as returned by `org-ele 'org-habit-p habit-property)))) (defun org-ql-agenda--add-faces (element) + "Return ELEMENT with deadline and scheduled faces added." (->> element (org-ql-agenda--add-scheduled-face) (org-ql-agenda--add-deadline-face))) @@ -465,6 +466,7 @@ property." element)) (defun org-ql-agenda--add-todo-face (keyword) + "Return KEYWORD with TODO face added." (when-let ((face (org-get-todo-face keyword))) (org-add-props keyword nil 'face face))) diff --git a/org-ql.el b/org-ql.el index 93edb60..7518ee0 100644 --- a/org-ql.el +++ b/org-ql.el @@ -355,7 +355,7 @@ from within ELEMENT's buffer." element)) (defun org-ql--sanity-check-form (form) - "Signal an error if any of the forms in BODY do not have their preconditions met. + "Signal error if any forms in FORM do not have preconditions met. Or, when possible, fix the problem." (cl-flet ((check (symbol) (cl-case symbol @@ -535,7 +535,7 @@ comparator, PRIORITY should be a priority string." (org-ql--defpredicate property (property &optional value) "Return non-nil if current entry has PROPERTY (a string), and optionally VALUE (a string)." (pcase property - ('nil (user-error "Property matcher requires a PROPERTY argument.")) + ('nil (user-error "Property matcher requires a PROPERTY argument")) (_ (pcase value ('nil ;; Check that PROPERTY exists @@ -860,7 +860,7 @@ A and B are Org headline elements. TYPE should be a symbol like (org-element-property type b))) (defun org-ql--date< (a b) - "Return non-nil if A's deadline or scheduled element property is earlier than B's. + "Return non-nil if A's deadline or scheduled property is earlier than B's. Deadline is considered before scheduled." (cl-macrolet ((ts (item) `(or (org-element-property :deadline ,item) From 9648dd12f930569dd61661822d95869bc3a6ec73 Mon Sep 17 00:00:00 2001 From: Adam Porter Date: Tue, 16 Jul 2019 18:46:19 -0500 Subject: [PATCH 014/798] Tidy: Headers, commentaries, etc. --- org-ql-agenda.el | 31 +++++++++++++------------------ org-ql.el | 22 +++++++++++++++++++--- 2 files changed, 32 insertions(+), 21 deletions(-) diff --git a/org-ql-agenda.el b/org-ql-agenda.el index f073f61..1e8a229 100644 --- a/org-ql-agenda.el +++ b/org-ql-agenda.el @@ -2,32 +2,27 @@ ;; Author: Adam Porter ;; Url: http://github.com/alphapapa/org-ql -;; Version: 0.1-pre -;; Package-Requires: ((emacs "25.1") (dash "2.13") (org "9.0")) -;; Keywords: hypermedia, outlines, Org, agenda ;;; Commentary: -;; This library displays buffers similar to Org Agenda buffers, based +;; This library is part of the package `org-ql'; it's not a standalone +;; library. It displays buffers similar to Org Agenda buffers, based ;; on `org-ql' queries. -;;;; Principles +;;; License: -;;;;; Try to imitate traditional Org agenda code's results and methods +;; 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 +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. -;; The traditional agenda code is complicated, but well-optimized. We should imitate it where -;; possible. We should also attempt to return the same results as the traditional agenda code -;; (ultimately, that is; but whether we reach that level of complexity depends on, e.g. performance -;; achieved, whether it looks like a feasible alternative, etc). At the least, we should return -;; results in the same format, so they can be used by other code that uses agenda output -;; (e.g. org-agenda-finalize-entries, org-agenda-finalize, org-super-agenda, etc). Of course, this -;; goal does not necessarily apply to the "query language"-like features, and ideally the -;; agenda-like features should build upon those. +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. -;;;;; Preserve the call to =org-agenda-finalize-entries= - -;; We want to preserve the final call to org-agenda-finalize-entries to preserve compatibility -;; with other packages and functions. +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see . ;;; Code: diff --git a/org-ql.el b/org-ql.el index 7518ee0..14445e9 100644 --- a/org-ql.el +++ b/org-ql.el @@ -9,9 +9,25 @@ ;;; Commentary: ;; `org-ql' is a lispy query language for Org files. It allows you to -;; find Org entries matching certain criteria and perform actions on -;; them, such as collecting their parsed representation with -;; `org-element' (the default action). +;; find Org entries matching certain criteria and return a list of +;; them or perform actions on them. Commands are also provided which +;; display a buffer with matching results, similar to an Org Agenda +;; buffer. + +;;; License: + +;; 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 +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see . ;;; Code: From c6250d1ee25f0bac970eddc4ace5ed520a0e8778 Mon Sep 17 00:00:00 2001 From: Adam Porter Date: Tue, 16 Jul 2019 18:50:06 -0500 Subject: [PATCH 015/798] Tidy: Docstring --- org-ql.el | 8 +++++++- 1 file changed, 7 insertions(+), 1 deletion(-) diff --git a/org-ql.el b/org-ql.el index 14445e9..d8e3ed6 100644 --- a/org-ql.el +++ b/org-ql.el @@ -67,7 +67,13 @@ This list should not contain any duplicates.") ;;;; Macros (cl-defmacro org-ql--defpredicate (name args docstring &rest body) - "FIXME: docstring" + "Define an `org-ql' selector predicate named `org-ql--predicate-NAME'. +ARGS is a `cl-defun'-style argument list. DOCSTRING is the +function's docstring. BODY is the body of the predicate. + +Predicates will be called with point on the beginning of an Org +heading and should return non-nil if the heading's entry is a +match." (declare (debug (symbolp listp stringp def-body)) (indent defun)) (let ((fn-name (intern (concat "org-ql--predicate-" (symbol-name name)))) From 3a2eaceca89e493306592fc7dff0887df0335210 Mon Sep 17 00:00:00 2001 From: Adam Porter Date: Tue, 16 Jul 2019 18:51:59 -0500 Subject: [PATCH 016/798] Tidy: Move defvar --- org-ql.el | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/org-ql.el b/org-ql.el index d8e3ed6..d44e402 100644 --- a/org-ql.el +++ b/org-ql.el @@ -51,6 +51,11 @@ (defvar org-ql--today nil) +(defvar org-ql-use-preamble t + ;; MAYBE: Naming things is hard. There must be a better term than "preamble." + "Use query preambles to speed up searches. +May be disabled for debugging, benchmarks, etc.") + (defvar org-ql-cache (make-hash-table :weakness 'key) ;; IIUC, setting weakness to `key' means that, when a buffer is closed, ;; its entries will be removed from this table at the next GC. @@ -247,11 +252,6 @@ a list of defined `org-ql' sorting methods: `date', `deadline', (define-hash-table-test 'org-ql-hash-test #'equal (lambda (args) (sxhash-equal (prin1-to-string args)))) -(defvar org-ql-use-preamble t - ;; FIXME: Move or delete this defvar. - "Use query preambles to speed up searches. -May be disabled for debugging, benchmarks, etc.") - (defun org-ql--query-preamble (query) "Return (QUERY PREAMBLE) for QUERY. When QUERY has a clause with a corresponding preamble, and it's From cf75e2fb1dfccfbea8a130013514e7c0e91c3c3b Mon Sep 17 00:00:00 2001 From: Adam Porter Date: Tue, 16 Jul 2019 18:52:41 -0500 Subject: [PATCH 017/798] Tidy: Move hash-table-test def --- org-ql.el | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/org-ql.el b/org-ql.el index d44e402..97315e5 100644 --- a/org-ql.el +++ b/org-ql.el @@ -129,6 +129,9 @@ buffer. In this case, ACTION should return an Org element." ;;;; Functions +(define-hash-table-test 'org-ql-hash-test #'equal (lambda (args) + (sxhash-equal (prin1-to-string args)))) + (cl-defun org-ql-query (buffers-or-files query &key action narrow sort) "Return items matching QUERY in BUFFERS-OR-FILES. @@ -249,9 +252,6 @@ a list of defined `org-ql' sorting methods: `date', `deadline', (org-ql--sort-by items sort)) (_ (user-error "SORT must be either nil, or one or a list of the defined sorting methods (see documentation)"))))) -(define-hash-table-test 'org-ql-hash-test #'equal (lambda (args) - (sxhash-equal (prin1-to-string args)))) - (defun org-ql--query-preamble (query) "Return (QUERY PREAMBLE) for QUERY. When QUERY has a clause with a corresponding preamble, and it's From b2e35997c769a6ae034fedf9cbf9c3c3659f76f6 Mon Sep 17 00:00:00 2001 From: Adam Porter Date: Tue, 16 Jul 2019 18:54:31 -0500 Subject: [PATCH 018/798] Tidy: Rename macro to --defpred --- org-ql.el | 40 ++++++++++++++++++++-------------------- 1 file changed, 20 insertions(+), 20 deletions(-) diff --git a/org-ql.el b/org-ql.el index 97315e5..8d568c0 100644 --- a/org-ql.el +++ b/org-ql.el @@ -71,7 +71,7 @@ This list should not contain any duplicates.") ;;;; Macros -(cl-defmacro org-ql--defpredicate (name args docstring &rest body) +(cl-defmacro org-ql--defpred (name args docstring &rest body) "Define an `org-ql' selector predicate named `org-ql--predicate-NAME'. ARGS is a `cl-defun'-style argument list. DOCSTRING is the function's docstring. BODY is the body of the predicate. @@ -412,7 +412,7 @@ empty time values to 23:59:59; otherwise, to 00:00:00." ;;;;; Predicates -(org-ql--defpredicate clocked (&key from to _on) +(org-ql--defpred clocked (&key from to _on) ;; The underscore before `on' prevents "unused lexical variable" warnings, because we ;; pre-process that argument in a macro before this function is called. "Return non-nil if current entry was clocked in given period. @@ -451,14 +451,14 @@ ignored." (from (test-timestamps (<= from end))) (to (test-timestamps (<= beg to)))))))) -(org-ql--defpredicate category (&rest categories) +(org-ql--defpred category (&rest categories) "Return non-nil if current heading is in one or more of CATEGORIES (a list of strings)." (when-let ((category (org-get-category (point)))) (cl-typecase categories (null t) (otherwise (member category categories))))) -(org-ql--defpredicate todo (&rest keywords) +(org-ql--defpred todo (&rest keywords) "Return non-nil if current heading is a TODO item. With KEYWORDS, return non-nil if its keyword is one of KEYWORDS (a list of strings)." (when-let ((state (org-get-todo-state))) @@ -468,12 +468,12 @@ With KEYWORDS, return non-nil if its keyword is one of KEYWORDS (a list of strin (symbol (member state (symbol-value keywords))) (otherwise (user-error "Invalid todo keywords: %s" keywords))))) -(org-ql--defpredicate done () +(org-ql--defpred done () "Return non-nil if entry's TODO keyword is in `org-done-keywords'." ;; NOTE: This was a defsubst before being defined with the macro. Might be good to make it a defsubst again. (or (apply #'org-ql--predicate-todo org-done-keywords))) -(org-ql--defpredicate tags (&rest tags) +(org-ql--defpred tags (&rest tags) "Return non-nil if current heading has one or more of TAGS (a list of strings)." ;; TODO: Try to use `org-make-tags-matcher' to improve performance. It would be nice to not have ;; to run `org-get-tags' for every heading, especially with inheritance. @@ -482,7 +482,7 @@ With KEYWORDS, return non-nil if its keyword is one of KEYWORDS (a list of strin (null t) (otherwise (seq-intersection tags tags-at))))) -(org-ql--defpredicate level (level-or-comparator &optional level) +(org-ql--defpred level (level-or-comparator &optional level) "Return non-nil if current heading's outline level matches LEVEL with COMPARATOR. If LEVEL is nil, LEVEL-OR-COMPARATOR should be an integer level, @@ -498,7 +498,7 @@ function (like `<=')." ;; Check with comparator (_ (funcall level-or-comparator outline-level level))))) -(org-ql--defpredicate priority (&optional comparator-or-priority priority) +(org-ql--defpred priority (&optional comparator-or-priority priority) "Return non-nil if current heading has a certain priority. COMPARATOR-OR-PRIORITY should be either a comparator function, like `<=', or a priority string, like \"A\" (in which case (`=' @@ -535,11 +535,11 @@ comparator, PRIORITY should be a priority string." (org-get-priority (match-string 0))))))) (funcall comparator priority item-priority)))) -(org-ql--defpredicate habit () +(org-ql--defpred habit () "Return non-nil if entry is a habit." (org-is-habit-p)) -(org-ql--defpredicate regexp (&rest regexps) +(org-ql--defpred regexp (&rest regexps) "Return non-nil if current entry matches one of REGEXPS (regexp strings)." (let ((end (or (save-excursion (outline-next-heading)) @@ -550,11 +550,11 @@ comparator, PRIORITY should be a priority string." thereis (save-excursion (re-search-forward regexp end t)))))) -(org-ql--defpredicate heading (regexp) +(org-ql--defpred heading (regexp) "Return non-nil if current entry's heading matches REGEXP (a regexp string)." (string-match regexp (org-get-heading 'no-tags 'no-todo))) -(org-ql--defpredicate property (property &optional value) +(org-ql--defpred property (property &optional value) "Return non-nil if current entry has PROPERTY (a string), and optionally VALUE (a string)." (pcase property ('nil (user-error "Property matcher requires a PROPERTY argument")) @@ -573,7 +573,7 @@ comparator, PRIORITY should be a priority string." ;; and language-independent than using from/to. Alternatively, add :before/:after, but I ;; think the comparators are better. Also consider using a macro to DRY these out. -(org-ql--defpredicate ts (&key from to _on) +(org-ql--defpred ts (&key from to _on) ;; The underscore before `on' prevents "unused lexical variable" warnings, because we ;; pre-process that argument in a macro before this function is called. "Return non-nil if current entry has a timestamp in given period. @@ -613,7 +613,7 @@ FROM, TO, and ON should be strings parseable by (from (test-timestamps (<= from end))) (to (test-timestamps (<= beg to)))))))) -(org-ql--defpredicate ts-active (&key from to _on) +(org-ql--defpred ts-active (&key from to _on) ;; The underscore before `on' prevents "unused lexical variable" warnings, because we ;; pre-process that argument in a macro before this function is called. "Return non-nil if current entry has an active timestamp in given period. @@ -656,7 +656,7 @@ FROM, TO, and ON should be strings parseable by (from (test-timestamps (<= from end))) (to (test-timestamps (<= beg to)))))))) -(org-ql--defpredicate ts-inactive (&key from to _on) +(org-ql--defpred ts-inactive (&key from to _on) ;; The underscore before `on' prevents "unused lexical variable" warnings, because we ;; pre-process that argument in a macro before this function is called. "Return non-nil if current entry has an inactive timestamp in given period. @@ -744,7 +744,7 @@ like one returned by `date-to-day'." (_ (user-error "COMPARATOR (%s) must be a function, and DATE (%s) must be a string or day-number integer" comparator target-date))))) -(org-ql--defpredicate planning (&optional comparator target-date) +(org-ql--defpred planning (&optional comparator target-date) "Return non-nil if entry's planning date (deadline or scheduled) compares with TARGET-DATE using COMPARATOR. TARGET-DATE should be a string parseable by `date-to-day'. COMPARATOR should be a function (like `<=')." @@ -752,7 +752,7 @@ COMPARATOR should be a function (like `<=')." ;; FIXME: I think :date selects either :deadline, :scheduled, or :closed, but I'm not sure. (org-ql--date-type-p :date comparator target-date)) -(org-ql--defpredicate deadline (&optional comparator target-date) +(org-ql--defpred deadline (&optional comparator target-date) "Return non-nil if entry's deadline compares with TARGET-DATE using COMPARATOR. TARGET-DATE should be a string parseable by `date-to-day'; or if omitted, it is determined automatically using @@ -768,21 +768,21 @@ function (like `<=')." ;; selectors, which would also be unintuitive. (org-ql--date-type-p :deadline comparator target-date)) -(org-ql--defpredicate scheduled (&optional comparator target-date) +(org-ql--defpred scheduled (&optional comparator target-date) "Return non-nil if entry's scheduled date compares with TARGET-DATE using COMPARATOR. TARGET-DATE should be a string parseable by `date-to-day'. COMPARATOR should be a function (like `<=')." ;; NOTE: This was a defsubst before being defined with the macro. Might be good to make it a defsubst again. (org-ql--date-type-p :scheduled comparator target-date)) -(org-ql--defpredicate closed (&optional comparator target-date) +(org-ql--defpred closed (&optional comparator target-date) "Return non-nil if entry's closed date compares with TARGET-DATE using COMPARATOR. TARGET-DATE should be a string parseable by `date-to-day'. COMPARATOR should be a function (like `<=')." ;; NOTE: This was a defsubst before being defined with the macro. Might be good to make it a defsubst again. (org-ql--date-type-p :closed comparator target-date)) -(org-ql--defpredicate date (&optional comparator target-date (type 'active)) +(org-ql--defpred date (&optional comparator target-date (type 'active)) "Return non-nil if Org entry at point has date of TYPE that compares with TARGET-DATE using COMPARATOR. Checks all Org-formatted timestamp strings in entry. TYPE may be `active', `inactive', or `all', to control whether active, From 66f36be2caf42fe355b87cbadab9055f7310b451 Mon Sep 17 00:00:00 2001 From: Adam Porter Date: Tue, 16 Jul 2019 18:56:51 -0500 Subject: [PATCH 019/798] Tidy: Remove unused function --- org-ql.el | 3 --- 1 file changed, 3 deletions(-) diff --git a/org-ql.el b/org-ql.el index 8d568c0..af73865 100644 --- a/org-ql.el +++ b/org-ql.el @@ -855,9 +855,6 @@ PREDICATES is a list of one or more sorting methods, including: ;; NOTE: 'todo is handled below ;; FIXME: Add more? (_ (user-error "Invalid sorting predicate: %s" symbol)))) - (todo-keyword-pos (keyword) - ;; MAYBE: Would it be faster to precompute these and do an alist lookup? - (cl-position keyword org-todo-keywords-1 :test #'string=)) (sort-by-todo-keyword (items) (let* ((grouped-items (--group-by (when-let (keyword (org-element-property :todo-keyword it)) (substring-no-properties keyword)) From bc4bdc158702574eba8378eccd5489f3ba9f1d08 Mon Sep 17 00:00:00 2001 From: Adam Porter Date: Tue, 16 Jul 2019 19:01:26 -0500 Subject: [PATCH 020/798] Comment: Add MAYBE --- org-ql-agenda.el | 1 + 1 file changed, 1 insertion(+) diff --git a/org-ql-agenda.el b/org-ql-agenda.el index 1e8a229..48c8e4e 100644 --- a/org-ql-agenda.el +++ b/org-ql-agenda.el @@ -275,6 +275,7 @@ default buffer." (current-buffer))) (defun org-ql-agenda--format-relative-date (difference) + ;; MAYBE: Make this a `defsubst'. "Return relative date string for DIFFERENCE. DIFFERENCE should be an integer number of days, positive for dates in the past, and negative for dates in the future." From 0f963fc81192254bc9dccf80617d3ba95f606ba9 Mon Sep 17 00:00:00 2001 From: Adam Porter Date: Tue, 16 Jul 2019 19:01:33 -0500 Subject: [PATCH 021/798] Tidy: Parens --- org-ql-agenda.el | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/org-ql-agenda.el b/org-ql-agenda.el index 48c8e4e..921d121 100644 --- a/org-ql-agenda.el +++ b/org-ql-agenda.el @@ -314,8 +314,7 @@ Its property list should be the second item in the list, as returned by `org-ele ;; (which would also make it easier to do it independently of faces, etc). (title (--> (org-ql-agenda--add-faces element) (org-element-property :raw-value it) - (org-link-display-format it) - )) + (org-link-display-format it))) (todo-keyword (-some--> (org-element-property :todo-keyword element) (org-ql-agenda--add-todo-face it))) ;; FIXME: Figure out whether I should use `org-agenda-use-tag-inheritance' or `org-use-tag-inheritance', etc. From 9846be03b9c9bbdc8665cb8958b8b1b561719974 Mon Sep 17 00:00:00 2001 From: Adam Porter Date: Tue, 16 Jul 2019 19:07:44 -0500 Subject: [PATCH 022/798] Tidy: Docstring --- org-ql.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/org-ql.el b/org-ql.el index af73865..6617e2b 100644 --- a/org-ql.el +++ b/org-ql.el @@ -108,7 +108,7 @@ one or more sorting methods, including: `date', `deadline', If NARROW is non-nil, query will run without widening the buffer (the default is to widen and search the entire buffer). -If MARKERS is non-nil, `org-agenda-ng--add-markers' is used to +If MARKERS is non-nil, `org-ql--add-markers' is used to add markers to each item, pointing to the item in its source buffer. In this case, ACTION should return an Org element." (declare (indent defun)) From 18def9313acdc8e55278b38b8cc84d086fe8b6ce Mon Sep 17 00:00:00 2001 From: Adam Porter Date: Tue, 16 Jul 2019 19:07:55 -0500 Subject: [PATCH 023/798] Change: (org-ql-agenda--agenda) Avoid eval --- org-ql-agenda.el | 13 +++++++------ 1 file changed, 7 insertions(+), 6 deletions(-) diff --git a/org-ql-agenda.el b/org-ql-agenda.el index 921d121..0aced86 100644 --- a/org-ql-agenda.el +++ b/org-ql-agenda.el @@ -206,13 +206,14 @@ SORT: One or a list of `org-ql' sorting functions, like `date' or (declare (indent defun)) (when (and super-groups (not org-super-agenda-mode)) (user-error "`org-super-agenda-mode' must be activated to use grouping")) - ;; I think it's reasonable to use `eval' here. (let* ((org-super-agenda-groups super-groups) - (entries (--> (eval `(org-ql ',buffers-files - ,query - :sort ,sort - :markers t - :narrow ,narrow)) + (entries (--> (org-ql-query buffers-files + query + :sort sort + :narrow narrow + :action (lambda () + (->> (org-element-headline-parser (line-end-position)) + org-ql--add-markers))) (mapcar #'org-ql-agenda--format-element it) (cond ((bound-and-true-p org-super-agenda-mode) (org-super-agenda--group-items it)) (t it)) From 75d8fd534fdfe6020a98ab1a13a93abe884d25a4 Mon Sep 17 00:00:00 2001 From: Adam Porter Date: Tue, 16 Jul 2019 19:17:56 -0500 Subject: [PATCH 024/798] Tidy: Buffer name --- org-ql-agenda.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/org-ql-agenda.el b/org-ql-agenda.el index 0aced86..faf6813 100644 --- a/org-ql-agenda.el +++ b/org-ql-agenda.el @@ -50,7 +50,7 @@ ;;;; Variables -(defvar org-ql-agenda-buffer-name "*Org Agenda NG*" +(defvar org-ql-agenda-buffer-name "*Org-QL-Agenda*" "Name of default `org-ql-agenda' buffer.") ;; For refreshing results buffers. From 8a8f78408c504c99094ac9b1f1dfbb22435c4824 Mon Sep 17 00:00:00 2001 From: Adam Porter Date: Wed, 17 Jul 2019 09:20:53 -0500 Subject: [PATCH 025/798] Fix: Declare org-super-agenda as ext --- org-ql-agenda.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/org-ql-agenda.el b/org-ql-agenda.el index faf6813..bba97aa 100644 --- a/org-ql-agenda.el +++ b/org-ql-agenda.el @@ -43,7 +43,7 @@ (defvar org-super-agenda-auto-selector-keywords) (defvar org-super-agenda-groups) (defvar org-super-agenda-mode) -(declare-function org-super-agenda--group-items "org-super-agenda") +(declare-function org-super-agenda--group-items "ext:org-super-agenda") (when (version< org-version "9.2") (defalias 'org-get-tags 'org-get-tags-at)) From 3e9f3276c0bdbab6e164410116229f05b6765347 Mon Sep 17 00:00:00 2001 From: Adam Porter Date: Wed, 17 Jul 2019 09:22:01 -0500 Subject: [PATCH 026/798] Fix: Sharp-quote alias targets --- org-ql-agenda.el | 2 +- org-ql.el | 4 ++-- 2 files changed, 3 insertions(+), 3 deletions(-) diff --git a/org-ql-agenda.el b/org-ql-agenda.el index bba97aa..89c9364 100644 --- a/org-ql-agenda.el +++ b/org-ql-agenda.el @@ -46,7 +46,7 @@ (declare-function org-super-agenda--group-items "ext:org-super-agenda") (when (version< org-version "9.2") - (defalias 'org-get-tags 'org-get-tags-at)) + (defalias 'org-get-tags #'org-get-tags-at)) ;;;; Variables diff --git a/org-ql.el b/org-ql.el index 6617e2b..a01a0e8 100644 --- a/org-ql.el +++ b/org-ql.el @@ -44,8 +44,8 @@ ;;;; Compatibility (when (version< org-version "9.2") - (defalias 'org-get-tags 'org-get-tags-at) - (defalias 'org-timestamp-to-time 'org-timestamp--to-internal-time)) + (defalias 'org-get-tags #'org-get-tags-at) + (defalias 'org-timestamp-to-time #'org-timestamp--to-internal-time)) ;;;; Variables From 2a40b180076b5d8959904d6a354a8acc3889abe8 Mon Sep 17 00:00:00 2001 From: Adam Porter Date: Wed, 17 Jul 2019 09:22:08 -0500 Subject: [PATCH 027/798] Fix: (org-ql-search) Space ending prompt string --- org-ql-agenda.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/org-ql-agenda.el b/org-ql-agenda.el index 89c9364..8ff3a9f 100644 --- a/org-ql-agenda.el +++ b/org-ql-agenda.el @@ -154,7 +154,7 @@ searching. Interactively, with prefix, leave narrowed. SORT: One or a list of `org-ql' sorting functions, like `date' or `priority'." (declare (indent defun)) - (interactive (list (pcase-exhaustive (completing-read "Buffers/Files:" + (interactive (list (pcase-exhaustive (completing-read "Buffers/Files: " (list 'buffer 'agenda 'all)) ("agenda" (org-agenda-files)) ("all" (--select (equal (buffer-local-value 'major-mode it) 'org-mode) From f39e752db3a3172049e33f9e37297e697cbcd8b5 Mon Sep 17 00:00:00 2001 From: Adam Porter Date: Wed, 17 Jul 2019 09:23:41 -0500 Subject: [PATCH 028/798] Tidy: http->https --- org-ql-agenda.el | 4 ++-- org-ql.el | 4 ++-- 2 files changed, 4 insertions(+), 4 deletions(-) diff --git a/org-ql-agenda.el b/org-ql-agenda.el index 8ff3a9f..d0e4a67 100644 --- a/org-ql-agenda.el +++ b/org-ql-agenda.el @@ -1,7 +1,7 @@ ;;; org-ql-agenda.el --- Agenda-like view based on org-ql -*- lexical-binding: t; -*- ;; Author: Adam Porter -;; Url: http://github.com/alphapapa/org-ql +;; Url: https://github.com/alphapapa/org-ql ;;; Commentary: @@ -22,7 +22,7 @@ ;; GNU General Public License for more details. ;; You should have received a copy of the GNU General Public License -;; along with this program. If not, see . +;; along with this program. If not, see . ;;; Code: diff --git a/org-ql.el b/org-ql.el index a01a0e8..acc5935 100644 --- a/org-ql.el +++ b/org-ql.el @@ -1,7 +1,7 @@ ;;; org-ql.el --- Query language for Org buffers -*- lexical-binding: t; -*- ;; Author: Adam Porter -;; Url: http://github.com/alphapapa/org-ql +;; Url: https://github.com/alphapapa/org-ql ;; Version: 0.2-pre ;; Package-Requires: ((emacs "26.1") (dash "2.13") (org "9.0") (s "1.12.0")) ;; Keywords: hypermedia, outlines, Org, agenda @@ -27,7 +27,7 @@ ;; GNU General Public License for more details. ;; You should have received a copy of the GNU General Public License -;; along with this program. If not, see . +;; along with this program. If not, see . ;;; Code: From 25ed67a37d617670dbdd76e9423ef2f2f987692b Mon Sep 17 00:00:00 2001 From: Adam Porter Date: Wed, 17 Jul 2019 11:53:51 -0500 Subject: [PATCH 029/798] Change: (--date-type-p) More detailed error for unknown date types --- org-ql.el | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/org-ql.el b/org-ql.el index acc5935..04c81ca 100644 --- a/org-ql.el +++ b/org-ql.el @@ -740,7 +740,8 @@ like one returned by `date-to-day'." (org-time-string-to-absolute (org-element-timestamp-interpreter date-element 'ignore)) target-day-number)) - (_ (error "Unknown date-element type: %s" (org-element-property :type date-element)))))) + (_ (error "Unknown date-element type \"%s\" in buffer %s at position %s" + (org-element-property :type date-element) (current-buffer) (point)))))) (_ (user-error "COMPARATOR (%s) must be a function, and DATE (%s) must be a string or day-number integer" comparator target-date))))) From 25f964dfcb723aa573f30217b079fba42fcf9d00 Mon Sep 17 00:00:00 2001 From: Adam Porter Date: Wed, 17 Jul 2019 12:04:28 -0500 Subject: [PATCH 030/798] Fix: (--date-type-p) Handle ranges I meant to do this in c5599a6, but I omitted the range type symbol when I rewrote the selector and functions. This should work now. Thanks to @codygman, @swflint, and @vikasrawal. --- README.org | 3 +++ org-ql.el | 2 +- 2 files changed, 4 insertions(+), 1 deletion(-) diff --git a/README.org b/README.org index 698197d..6997688 100644 --- a/README.org +++ b/README.org @@ -236,6 +236,9 @@ If ~MARKERS~ is non-nil, ~org-agenda-ng--add-markers~ is used to add markers to *Changed* + ~(regexp)~ selector accepts multiple regexps to test. +*Fixed* ++ Handle date ranges in date-based selectors. (Thanks to [[https://github.com/codygman][Cody Goodman]], [[https://github.com/swflint][Samuel W. Flint]], and [[https://github.com/vikasrawal][Vikas Rawal]].) + *Compatibility* + Fixes for compatibility with Org 9.2. (Thanks to [[https://github.com/ataias][Ataias Pereira Reis]] and [[https://github.com/dakra][Daniel Kraus]].) diff --git a/org-ql.el b/org-ql.el index 04c81ca..0360a28 100644 --- a/org-ql.el +++ b/org-ql.el @@ -735,7 +735,7 @@ like one returned by `date-to-day'." (string (date-to-day (concat target-date " 00:00"))) (integer target-date)))) (pcase (org-element-property :type date-element) - ((or 'active 'inactive) + ((or 'active 'inactive 'active-range 'inactive-range) (funcall comparator (org-time-string-to-absolute (org-element-timestamp-interpreter date-element 'ignore)) From c31f8736255583588624deec2a502d1285e1a70e Mon Sep 17 00:00:00 2001 From: Adam Porter Date: Thu, 18 Jul 2019 01:20:25 -0500 Subject: [PATCH 031/798] Fix: Define own get-tags function for compatibility In Org <9.2, both org-get-tags and org-get-tags-at are functions, and we must not clobber org-get-tags. In Org 9.2+, org-get-tags replaces org-get-tags-at, but org-get-tags-at remains defined as an obsolete alias. Thanks to Chris Rayner (@riscy). --- org-ql.el | 12 ++++++++---- 1 file changed, 8 insertions(+), 4 deletions(-) diff --git a/org-ql.el b/org-ql.el index 0360a28..78abc4e 100644 --- a/org-ql.el +++ b/org-ql.el @@ -43,9 +43,13 @@ ;;;; Compatibility -(when (version< org-version "9.2") - (defalias 'org-get-tags #'org-get-tags-at) - (defalias 'org-timestamp-to-time #'org-timestamp--to-internal-time)) +(if (version< org-version "9.2") + (progn + (defalias 'org-timestamp-to-time #'org-timestamp--to-internal-time) + (defun org-ql--get-tags (&optional pos local) + (org-get-tags-at pos local))) + (defun org-ql--get-tags (&optional pos local) + (org-get-tags pos local))) ;;;; Variables @@ -477,7 +481,7 @@ With KEYWORDS, return non-nil if its keyword is one of KEYWORDS (a list of strin "Return non-nil if current heading has one or more of TAGS (a list of strings)." ;; TODO: Try to use `org-make-tags-matcher' to improve performance. It would be nice to not have ;; to run `org-get-tags' for every heading, especially with inheritance. - (when-let ((tags-at (org-get-tags (point) (not org-use-tag-inheritance)))) + (when-let ((tags-at (org-ql--get-tags (point) (not org-use-tag-inheritance)))) (cl-typecase tags (null t) (otherwise (seq-intersection tags tags-at))))) From f6d2d1e5374c9b8a8f8565f3222c42371db1b95d Mon Sep 17 00:00:00 2001 From: Adam Porter Date: Sat, 20 Jul 2019 10:16:16 -0500 Subject: [PATCH 032/798] Fix: Use org-timestamp-to-time everywhere These changes should have been in adcb96c. Thanks to Chris Rayner (@riscy) for noticing this omission. --- org-ql.el | 16 ++++++++-------- 1 file changed, 8 insertions(+), 8 deletions(-) diff --git a/org-ql.el b/org-ql.el index 78abc4e..a24fa2f 100644 --- a/org-ql.el +++ b/org-ql.el @@ -443,8 +443,8 @@ ignored." `(cl-loop for next-ts = (next-timestamp) while next-ts ;; Using `setf' instead of `for beg =` here prevents "unused lexical variable" warnings. - do (setf beg (float-time (org-timestamp--to-internal-time next-ts)) - end (float-time (org-timestamp--to-internal-time next-ts 'end))) + do (setf beg (float-time (org-timestamp-to-time next-ts)) + end (float-time (org-timestamp-to-time next-ts 'end))) thereis ,pred-form))) (save-excursion (let ((end-pos (org-entry-end-position)) @@ -605,8 +605,8 @@ FROM, TO, and ON should be strings parseable by (test-timestamps (pred-form) `(cl-loop for next-ts = (next-timestamp) while next-ts - do (setf beg (float-time (org-timestamp--to-internal-time next-ts)) - end (float-time (org-timestamp--to-internal-time next-ts 'end))) + do (setf beg (float-time (org-timestamp-to-time next-ts)) + end (float-time (org-timestamp-to-time next-ts 'end))) thereis ,pred-form))) (save-excursion (let ((end-pos (org-entry-end-position)) @@ -648,8 +648,8 @@ FROM, TO, and ON should be strings parseable by `(cl-loop for next-ts = (next-timestamp) while next-ts when (string-prefix-p "<" next-ts) - do (setf beg (float-time (org-timestamp--to-internal-time next-ts)) - end (float-time (org-timestamp--to-internal-time next-ts 'end))) + do (setf beg (float-time (org-timestamp-to-time next-ts)) + end (float-time (org-timestamp-to-time next-ts 'end))) thereis ,pred-form))) (save-excursion (let ((end-pos (org-entry-end-position)) @@ -691,8 +691,8 @@ FROM, TO, and ON should be strings parseable by `(cl-loop for next-ts = (next-timestamp) while next-ts when (string-prefix-p "[" next-ts) - do (setf beg (float-time (org-timestamp--to-internal-time next-ts)) - end (float-time (org-timestamp--to-internal-time next-ts 'end))) + do (setf beg (float-time (org-timestamp-to-time next-ts)) + end (float-time (org-timestamp-to-time next-ts 'end))) thereis ,pred-form))) (save-excursion (let ((end-pos (org-entry-end-position)) From b1b04b3f19517cff42267a90147dcf48d5c1d95b Mon Sep 17 00:00:00 2001 From: Adam Porter Date: Sat, 20 Jul 2019 17:42:08 -0500 Subject: [PATCH 033/798] Docs: Add badges --- README.org | 6 ++++++ images/dont-tread-on-emacs-150.png | Bin 0 -> 5660 bytes 2 files changed, 6 insertions(+) create mode 100644 images/dont-tread-on-emacs-150.png diff --git a/README.org b/README.org index 6997688..91ca0dc 100644 --- a/README.org +++ b/README.org @@ -1,5 +1,11 @@ #+TITLE: org-ql +#+BEGIN_HTML + +#+END_HTML + +[[https://melpa.org/#/org-ql][file:https://melpa.org/packages/org-ql-badge.svg]] [[https://stable.melpa.org/#/org-ql][file:https://stable.melpa.org/packages/org-ql-badge.svg]] + ~org-ql~ is a lispy query language for Org files. It allows you to find Org entries matching certain criteria and return a list of them or perform actions on them. Commands are also provided which display a buffer with matching results, similar to an Org Agenda buffer. * Contents diff --git a/images/dont-tread-on-emacs-150.png b/images/dont-tread-on-emacs-150.png new file mode 100644 index 0000000000000000000000000000000000000000..71f37362a5289714efa07aed1e7520198e8f8b87 GIT binary patch literal 5660 zcmeAS@N?(olHy`uVBq!ia0y~yV3@|hz>vbh1|p+Reqdl=U@3O;4B_D5;Hcq9>0n@B z;4JWnEM{O()C6J1dq)rZF)%PlmbgZg1m~xflqVLYGL)B>>t*I;7bhncr0V4trO$q6 zBgMcVI@8m|F{EP7+qsoFGS_R5+ZVs})yvn*|2UyEU{lKLZL;2dk1ag-Z)VO}mLa5) zadDYz@D`7WOsq^>G6F<0nzy({ZQ;1Z;#qvPY?g)ZWs5=?_iZ_z({k=Es+fN|`+as= zdEdW{Dyp+Ye1l>pdY@yLIrC=r_q2P`H9!0A?{2wY^=!A8nOSzvj(dU|ZqB)JXp<(# zwhcL4O}aX>n-aKBFH^uJ^r^~yfyBg(AFNno_&ApbA9^{Za92u zn=5*!eu?DKox9FUO8I~Io4@zy%i_l=J*ItctQ2p|y^!6I8u+MT*)gG6vrc8?=%xOj zn5LEO9sXs;J8#E%|G&BFeLb@9gt0+%1gq0Vo>$p-Di@kg-IVR$@b>qs`=)aeXViTB ztpBOZ|Bu{}O$9d&?Q-u}cJkXap+1@HCwuqb>O5TfJjqzh@8kCQ|0SD)Z`t-dyruN^ zZOt?N>()ZAT~{(ot-70&t+n*?KCURK+9{Q(bA%SWezJ*e+72_`bZ-HUqs1|Mq!vA2 zo7g9p?>tGYe%tA{3zqKexxD|)ag9qxh2CNJRCW5^t$+5ozF^9wqVtRDc;LZYME*B1m*%T|d2+Nj3LmmiA;7VXc!X(^8bY zm1e4%7SHub^Gq$7!^gP)zVFKWp1E76yU&aH^_O97?$a;+Ea7vG^&XfeeC^%uQ};qc zP9J?<{`m9m%-gaNm*V{{Pn0z}#O1y9S#IiwUAk))DFlQUoxi^`>UWq~^d7ghy4RN) z8_tV)uc0&hWapJC_r$9?mWg+FNT$_T?7DX`LTvHjjbHl?t-4us$V-~(|L;FfzxEy5 z{mK6Rz5~6DN2=VDujcHu5<9T-^W!-({lStEanrl!8C(3%vX8y4CMnyg%)zusL%~z2 ziDi<8QWw)A4JB)rQ>SC5gzwSZVb_u%ae>#-n&Bgt|DZEAe-)9?j`?>_r`u#sV#cPFE3y3yo zOmIz7$}ka-t#hxFYVs+@4(t~)5OIbt`~Ia*FH?0wDG8Q&28)K zpOeqqIt4HNEO&fO#l}|C!@Ubt;(s0TKH}6Z-u-rW*3UcfcIVcqy|?X)EZns8c=F!K zFC+TA^LZ}ZiSY`3d&thU|NOy?k8^##`x@EIOFFvuR5V9)#CwH#h83^h7|5MmRO)`V z>Gvd^q8As$0_Cr&xTt6hQ2WS+Uv(U z({oDq3P(qjA8=VvZs7U;_TiFus}H}8%_v&2PW$NzXWgFCUSXb-=ymvy2kUd5cPWsbXyZ--pZu~|39Z1_|L2R~ ztukGmX=Y3_mmJ&w_pkPxy;5w6*&@BJ_qA-cZEv#w`RDhFb@4Y(>3tVEs#yHR#X8CA zutR;0cf{-NT^e_;zIl4N{+~ow^56C?PfX^9I4MsJ2n@Eo;=|{A^D^sml?Y_3Vb8BhoPELOCOy%H2iHjX>Dzg;D0zH>*&Y0D= zOfq9t-zv$J&1zBS&iFS7wEW4qU~Ot|zH`Nbj@HunYRlf-soDSTyiAyLJ?_=BTURxA zRWDwlwqcEEx=X+|x4)T|BI`Glg{{50dC_IfxSt<+*Tv3Wv|GQ;>bkD-E#+%ro)@{i zCtW+X=I<;2T@~+cuJ$?hRdTv+j$XWTS6D>nk-IlrFL6#?U;oo&{a)M7#G5xSMFnp; zB=w^EPUsK)|7TC{xjXxS-fJ%Bi*;95-xaJ{-@9Jx&Cd8Q&%)KVX-c?iubHFz=@Iw! zaM5pfW+wVn2gEsQMkO-N*=KOF`~Ln-j|zBurLTMKkJQLYl;p7a|A#j(MkYFNNBh0o zj?PnUcki4avULN4(5#dD|6P`jsVuIznYik;*U!!SD|)6$RWoHR)cEC>(GYU&$y;-G z&F@+!`=f%*S~oCkVvE@&al~u&n?3vMA{V>J>a{ZS z=P%y7v*qMNj)yDK&TolSHtXHMz~lWODtyMg?d}Dip>^KYJ>=j^M^pBEKlX?^5rx8tte%OoXy7vB8LHvQ-`v1>eC z8HFYFy8i#a*)jP(U0rwXh{qJ;^zH8dm z=Ly@BXNujO-W0Rj=GcjXIS&^~9GuXlx90zbmtPaSxw6I9^YGt`KkTd?b+dYfWMS{I zinB(S#2Y39hP=$gvx$)`r$n}uhg`T8c<`d|+aKE3>z?jAxK8t4 z#n$<+!_{BPdrrK4#4R#9qWgiE&o7xm#Igoff>7aq`W+*TQ># z9DY4#uffT*IU0L4TT>&&I$c^^wAwP&Dj)q_Yx6rk+(4I`oAJz_n?el2&vZDZHJE9AOm$oo z<(UHo3anD*@Ubp;KK8aK=#{p!#w5=5uG(v2{FJ3;tIhSCbZ$w2vF4?jJd&ZVmrZ!Q z9YjP|t+uUsyL$iOVEJF=EP-w!sVsp`BB?HcvkGTha{t_{;^{G|N#nG~r8A1&9mdxe zsVJWP@%glx?^Zvl*R>{Bs(*ate}61~W6?s}@4ef9>|P(Emi=NzTjRpl635Oge7?a) z)<<-{`@$oS7j4=jGr#;X-~XE*oF^~dn0e?S=cJV^nWn9?JST@;&bTSlWS~7|kHx3! zc_QVU=Oj03=(XmA9e=xerr>4WM9)o4I;TA*HK{zW_kRCF*L(Z!^D*9^dS0lw1S%Kwjs_Hxa)_4k^yCyFvme{@*BzCnIZLFZ{_Lmg*!Z+9_Ym7<76j58V<^Okk0 zDZ5No4w>>ZgKG=(KBt;ryOR!cYRmB(n_Tj>F!D5!Qkv^|Uik3ZJI8h!92Zn&ah&yC z+B+pBMIi9Z`TY|&2gBvCl7dESwkUxin}=kmjYAU+!4W^-GQvlj~>iKi+)(_0iW~AC>JkT>H4g>EX2O zC|>DJeN#`mNbr6W>h_)Jb^K(?rHrU)bJk5hJu|}l%XQ8sj;4l&289j{zRvSC&m8Af zubchBrSI+8-Yr|NZCq>W@OoQR)a_Rp_XFK)i&f`Mn)+6Ihm;QYul%0EZ(n%V#l3uf zWu^C?qJOzAf-!oW`|tN&e|_kA@#C*n>F3t%Jp4ASV7Kg!7_PYWlU#nLRV-ff zG-;NlQI<$(?^Ax=wpDJ1zOt8140vR9XFt90aPF6HJw|3`y_vISESqX>JA-Z7)cE`> zn+_aeIekbee-lIYv;1$jm_Dg-GBQ>!Q_YNgwuay5^pn5-a)%ykKDEAY$$CesR9WGS z@0NMxwv!JlMRY7`Q1U*psb!Ieg{+^=y&x}dEzR%j1-nld?))Qt?@hp!L%XC)VpV7R zPCUEx#M4X0?rn4CIi63wz{`7j(*_;k4bNKABE#Y`!v1ZJ+&oSH^|ka68KFfA3sQUc zB&5v{J^c20O>2z9BoUFL%}To`i1K&6Iri|wB8@zmF8=nz&W67K?@w@jxYuD??1@d> z{L<^|Hc8&N@pGl`#Uywyu{`v6R-WeKH9GmfJ(m~r@VT70yRB%oPWPMJ@(hj-UOnXu z33V4?{q|<9s)(1dm5}=+7OU@9lsGQjmR6g2f~nv^0JHl1TPN@T`KrAltM0AV{PT|0 z?nj#{N=khfr+s04x4roPz5`8`g2{_HlMJWM-M#Ahou-2|E>2 z85$b5E@s{V6J4pZz&gW=@-SRQ~VBKpQ#M%PkopPaiB~E4mrI=u9fFl$7^#JC-M{F+q>!e3tKBb>-Tx z6>BTM@7wg3|H@hJ=^iPTB}*6&8+`mJ6LP(x^JvJe+u9aCzvwC4zi`>4S=M@W$I*}^ zL($7yZv1zUognU`v#RJr0dxPJ<*E06Z&_paUC(rJ@go=Q<8pa%*UD}GMQE$bWk3D( zRWs`LDa()d{_OhtvZT-5Kj-n0WaIt8kyhWYEqd+Uzx$#|bGuyLvx|>!KfB{+bL~_! z`>Ttk%@ICN|NU*;X_97S*(Z}56BhISNGzwe%qfB1RXltyJIhKZ<=1~!I`02O`0tne zH_xii$3A^CQ&8>L=F~d3@hL3y_vUeUZcN&%}bZ z3tt}H<~={@($aoS?$EJowlq1sT7^nQV)d3l}{+6C?GzO1Y=+-d!XA?5N{L zJl!Q$>`%Ja-fm5lP=+TYAIFAmR5F|u42 zH*?PJ?++TQ?(GtIa_MN{w|o1)u(3_o>$`ky+XjvOb7iepRlNT5$JOuLe#>L$?r!gT zJ-zPM>Bs(C^ncDdYEhlma@c)##gB<;arU+*@8e=?Ie&j+uXtwuJwZY(KbB+NkDuFv zH=L@@nCQE^I5PR(t%d9NTAeuDuM=k@(RS3o{*v)|-PxvMDZgi>B}lxtV=`M z??&aj7kc!tPyT#o5-0EW*I}g~yKJ>tq?mY**oqZj&UEicJ-Bo8Vi~)l@~1ze3Vv->tov~P`pgdpZS`KN#CT`^MC&JvQ_)DkN?saFZn*cDgXSs_w2I5 zt!rj(@baEJr>08$`MDm358d;>f8OZ-X7L^y`#Fy{9=|R2#DSr9Z=#fxci@y>Ltibi z;GH#@P0sD&Tq$PhYw}O@-?1s$(kcFbefzw30=9P*_2$Sg-nTHt(IQgJvSbJ2#rAVSKo8sefE03!Z!<_nsTH`%5)eR$?Sgow|rUQ z);m{k@v`%o282CJDo^J%HH|wrPckvbZGo=+}>#XP7}VKc73PAE@5d&kg5#QF5AH#Y)Z zv!gBd+9vv3e)J=GZN*+b70vn4=BB@I-i>rV{>{tH?a>@->s@Q!SN*-EvfDbl;)8>2 z-u6T1>#wzEMqRl&{lb+u&-clO-g(0%*#ETn^uvWO79IVf^Y*PM%d1a`)zybMnEw0< zwhk2OtcZDh(S7^Fl9Qh=S;+Yq*p#F*?vsw*CVXqzh8xq$2@Gd$!yNSd&tH7{&4nKY T9~Ln%Ffe$!`njxgN@xNAk>vYn literal 0 HcmV?d00001 From 0fdfa65bef7d5f05137ccaa7d8e16b81e5c97ddf Mon Sep 17 00:00:00 2001 From: Adam Porter Date: Sat, 20 Jul 2019 18:17:17 -0500 Subject: [PATCH 034/798] Change: (--query-preamble) Add (level) preamble --- notes.org | 26 ++++++++++++++++++++++++++ org-ql.el | 4 ++++ 2 files changed, 30 insertions(+) diff --git a/notes.org b/notes.org index 66af1a3..4a390fc 100644 --- a/notes.org +++ b/notes.org @@ -410,6 +410,32 @@ Also, maybe instead of having a single =date= selector, I should have =scheduled * Profiling +** Preambles + +#+BEGIN_SRC elisp :results silent + (cl-defmacro org-ql-preamble-bench (&key query (file "tests/data.org") (times 10)) + `(bench-multi-lets :times ,times :ensure-equal t + :lets (("preamble" ((org-ql-use-preamble t))) + ("no preamble" ((org-ql-use-preamble nil)))) + :forms ((,(prin1-to-string query) (org-ql-query ,file + ',query + :action (lambda () (org-get-heading t t))))))) +#+END_SRC + +*** =level= + +#+BEGIN_SRC elisp + (org-ql-preamble-bench :times 1 + :file "~/org/inbox.org" + :query (level 1)) +#+END_SRC + +#+RESULTS: +| Form | x faster than next | Total runtime | # of GCs | Total GC runtime | +|------------------------+--------------------+---------------+----------+------------------| +| preamble: (level 1) | 1.34 | 0.562950 | 0 | 0 | +| no preamble: (level 1) | slowest | 0.754050 | 0 | 0 | + ** Using =org-element-parse-buffer= This basically works, as a very basic kind of agenda view, but we can already see that it's much slower (at least, for single-day views) because =org-element-parse-buffer= is slow compared to the agenda code. diff --git a/org-ql.el b/org-ql.el index a24fa2f..6da5c9e 100644 --- a/org-ql.el +++ b/org-ql.el @@ -282,6 +282,10 @@ replace the clause with a preamble." (setq org-ql-preamble regexp) ;; Return nil nil)) + (`(level ,num) + (let* ((regexp (rx-to-string `(seq bol (repeat ,num "*") " ")))) + (setq org-ql-preamble regexp) + nil)) (`(and . ,rest) (let ((clauses (mapcar #'rec rest))) `(and ,@(-non-nil clauses)))) From a56d173eb52ada86089d173e98bcfed636849a9c Mon Sep 17 00:00:00 2001 From: Adam Porter Date: Sat, 20 Jul 2019 22:57:58 -0500 Subject: [PATCH 035/798] Change: (--query-preamble) Use pcase for clarity --- org-ql.el | 76 +++++++++++++++++++++++++++---------------------------- 1 file changed, 38 insertions(+), 38 deletions(-) diff --git a/org-ql.el b/org-ql.el index 6da5c9e..f48377e 100644 --- a/org-ql.el +++ b/org-ql.el @@ -261,44 +261,44 @@ a list of defined `org-ql' sorting methods: `date', `deadline', When QUERY has a clause with a corresponding preamble, and it's appropriate to use one (i.e. the clause is not in an `or'), replace the clause with a preamble." - (if org-ql-use-preamble - (let (org-ql-preamble) - (cl-labels ((rec (element) - (or (when org-ql-preamble - ;; Only one preamble is allowed - element) - (pcase element - (`(or _) element) - (`(regexp . ,regexps) - (let* ((regexp (rx-to-string `(or ,@regexps)))) - (setq org-ql-preamble regexp) - ;; Return nil - nil)) - (`(todo . ,(and todo-keywords (guard todo-keywords))) - (let* ((regexps (--map (list 'regexp - (format org-heading-keyword-regexp-format it)) - todo-keywords)) - (regexp (rx-to-string `(or ,@regexps)))) - (setq org-ql-preamble regexp) - ;; Return nil - nil)) - (`(level ,num) - (let* ((regexp (rx-to-string `(seq bol (repeat ,num "*") " ")))) - (setq org-ql-preamble regexp) - nil)) - (`(and . ,rest) - (let ((clauses (mapcar #'rec rest))) - `(and ,@(-non-nil clauses)))) - (_ element))))) - (setq query (pcase (mapcar #'rec (list query)) - ((or `(nil) - `((nil)) - `((and)) - `((or))) - t) - (query (-flatten-n 1 query)))) - (list query org-ql-preamble))) - (list query nil))) + (pcase org-ql-use-preamble + ('nil (list query nil)) + (_ (let (org-ql-preamble) + (cl-labels ((rec (element) + (or (when org-ql-preamble + ;; Only one preamble is allowed + element) + (pcase element + (`(or _) element) + (`(regexp . ,regexps) + (let* ((regexp (rx-to-string `(or ,@regexps)))) + (setq org-ql-preamble regexp) + ;; Return nil + nil)) + (`(todo . ,(and todo-keywords (guard todo-keywords))) + (let* ((regexps (--map (list 'regexp + (format org-heading-keyword-regexp-format it)) + todo-keywords)) + (regexp (rx-to-string `(or ,@regexps)))) + (setq org-ql-preamble regexp) + ;; Return nil + nil)) + (`(level ,num) + (let* ((regexp (rx-to-string `(seq bol (repeat ,num "*") " ")))) + (setq org-ql-preamble regexp) + nil)) + (`(and . ,rest) + (let ((clauses (mapcar #'rec rest))) + `(and ,@(-non-nil clauses)))) + (_ element))))) + (setq query (pcase (mapcar #'rec (list query)) + ((or `(nil) + `((nil)) + `((and)) + `((or))) + t) + (query (-flatten-n 1 query)))) + (list query org-ql-preamble)))))) (defun org-ql--select-cached (&rest args) "Return results for ARGS and current buffer using cache." From 2b0730d53b96b3fa82471df49165512a4761db0a Mon Sep 17 00:00:00 2001 From: Adam Porter Date: Sat, 20 Jul 2019 23:11:07 -0500 Subject: [PATCH 036/798] Comment: Add FIXME --- org-ql.el | 1 + 1 file changed, 1 insertion(+) diff --git a/org-ql.el b/org-ql.el index f48377e..8c956e0 100644 --- a/org-ql.el +++ b/org-ql.el @@ -222,6 +222,7 @@ a list of defined `org-ql' sorting methods: `date', `deadline', (<= #'<=) (>= #'>=)) ,query)))))) + ;; FIXME: Don't try to byte-compile already-compiled functions. (action (byte-compile action)) ;; TODO: Figure out how to use or reimplement the org-scanner-tags feature. ;; (org-use-tag-inheritance t) From ac402e33c74504d3e380cf89df4a8f31ddb066d5 Mon Sep 17 00:00:00 2001 From: Adam Porter Date: Sat, 20 Jul 2019 23:11:17 -0500 Subject: [PATCH 037/798] Add/Change: (--query-predicate) Move code to new function --- org-ql.el | 120 ++++++++++++++++++++++++++++-------------------------- 1 file changed, 62 insertions(+), 58 deletions(-) diff --git a/org-ql.el b/org-ql.el index 8c956e0..2e84580 100644 --- a/org-ql.el +++ b/org-ql.el @@ -164,64 +164,7 @@ a list of defined `org-ql' sorting methods: `date', `deadline', (_ ; Buffer or string (list buffers-or-files)))) ((query preamble-re) (org-ql--query-preamble query)) - (predicate (byte-compile `(lambda () - ;; This is either really elegant or really ugly. Well, also - ;; possibly somewhere in-between. At the least, we should do - ;; this in a more flexible, abstracted way, but this will do - ;; for now. Most importantly, it works! - (let (from to on) - ;; TODO: DRY these macrolets. - (cl-macrolet ((clocked (&key from to on) - (when on - (setq from on - to on)) - (when from - (setq from (org-ql--parse-time-string from))) - (when to - (setq to (org-ql--parse-time-string to 'end))) - ;; NOTE: The macro must expand to the actual `org-ql--predicate-clocked' - ;; function, not another `clocked'. - `(org-ql--predicate-clocked :from ,from :to ,to)) - (ts (&key from to on) - (when on - (setq from on - to on)) - (when from - (setq from (org-ql--parse-time-string from))) - (when to - (setq to (org-ql--parse-time-string to 'end))) - ;; NOTE: The macro must expand to the actual `org-ql--predicate-ts' - ;; function, not another `ts'. - `(org-ql--predicate-ts :from ,from :to ,to)) - (ts-active (&key from to on) - (when on - (setq from on - to on)) - (when from - (setq from (org-ql--parse-time-string from))) - (when to - (setq to (org-ql--parse-time-string to 'end))) - ;; NOTE: The macro must expand to the actual `org-ql--predicate-ts' - ;; function, not another `ts'. - `(org-ql--predicate-ts-active :from ,from :to ,to)) - (ts-inactive (&key from to on) - (when on - (setq from on - to on)) - (when from - (setq from (org-ql--parse-time-string from))) - (when to - (setq to (org-ql--parse-time-string to 'end))) - ;; NOTE: The macro must expand to the actual `org-ql--predicate-ts' - ;; function, not another `ts'. - `(org-ql--predicate-ts-inactive :from ,from :to ,to))) - (cl-symbol-macrolet ((today org-ql--today) ; Necessary because of byte-compiling the lambda - (= #'=) - (< #'<) - (> #'>) - (<= #'<=) - (>= #'>=)) - ,query)))))) + (predicate (org-ql--query-predicate query)) ;; FIXME: Don't try to byte-compile already-compiled functions. (action (byte-compile action)) ;; TODO: Figure out how to use or reimplement the org-scanner-tags feature. @@ -257,6 +200,67 @@ a list of defined `org-ql' sorting methods: `date', `deadline', (org-ql--sort-by items sort)) (_ (user-error "SORT must be either nil, or one or a list of the defined sorting methods (see documentation)"))))) +(defun org-ql--query-predicate (query) + "Return predicate function for QUERY." + (byte-compile `(lambda () + ;; This is either really elegant or really ugly. Well, also + ;; possibly somewhere in-between. At the least, we should do + ;; this in a more flexible, abstracted way, but this will do + ;; for now. Most importantly, it works! + (let (from to on) + ;; TODO: DRY these macrolets. + (cl-macrolet ((clocked (&key from to on) + (when on + (setq from on + to on)) + (when from + (setq from (org-ql--parse-time-string from))) + (when to + (setq to (org-ql--parse-time-string to 'end))) + ;; NOTE: The macro must expand to the actual `org-ql--predicate-clocked' + ;; function, not another `clocked'. + `(org-ql--predicate-clocked :from ,from :to ,to)) + (ts (&key from to on) + (when on + (setq from on + to on)) + (when from + (setq from (org-ql--parse-time-string from))) + (when to + (setq to (org-ql--parse-time-string to 'end))) + ;; NOTE: The macro must expand to the actual `org-ql--predicate-ts' + ;; function, not another `ts'. + `(org-ql--predicate-ts :from ,from :to ,to)) + (ts-active (&key from to on) + (when on + (setq from on + to on)) + (when from + (setq from (org-ql--parse-time-string from))) + (when to + (setq to (org-ql--parse-time-string to 'end))) + ;; NOTE: The macro must expand to the actual `org-ql--predicate-ts' + ;; function, not another `ts'. + `(org-ql--predicate-ts-active :from ,from :to ,to)) + (ts-inactive (&key from to on) + (when on + (setq from on + to on)) + (when from + (setq from (org-ql--parse-time-string from))) + (when to + (setq to (org-ql--parse-time-string to 'end))) + ;; NOTE: The macro must expand to the actual `org-ql--predicate-ts' + ;; function, not another `ts'. + `(org-ql--predicate-ts-inactive :from ,from :to ,to))) + (cl-symbol-macrolet ((today org-ql--today) ; Necessary because of byte-compiling the lambda + (= #'=) + (< #'<) + (> #'>) + (<= #'<=) + (>= #'>=)) + ,query)))))) + (defun org-ql--query-preamble (query) "Return (QUERY PREAMBLE) for QUERY. When QUERY has a clause with a corresponding preamble, and it's From 3133c4f33bca22d4f5f2e07cabe8207c1f186554 Mon Sep 17 00:00:00 2001 From: Adam Porter Date: Sat, 20 Jul 2019 23:18:39 -0500 Subject: [PATCH 038/798] Change: (org-ql-query) Simplify --- org-ql.el | 30 +++++++++++++----------------- 1 file changed, 13 insertions(+), 17 deletions(-) diff --git a/org-ql.el b/org-ql.el index 2e84580..debed89 100644 --- a/org-ql.el +++ b/org-ql.el @@ -158,11 +158,18 @@ SORT is either nil, in which case items are not sorted; or one or a list of defined `org-ql' sorting methods: `date', `deadline', `scheduled', `todo', and `priority'." (declare (indent defun)) - (-let* ((sources (pcase buffers-or-files - (`nil (list (current-buffer))) - ((pred listp) buffers-or-files) - (_ ; Buffer or string - (list buffers-or-files)))) + (-let* ((buffers (->> (cl-typecase buffers-or-files + (null (list (current-buffer))) + (list buffers-or-files) + (otherwise (list buffers-or-files))) + (--map (cl-etypecase it + (buffer it) + (string (or (find-buffer-visiting it) + (when (file-readable-p it) + ;; It feels unintuitive that `find-file-noselect' returns + ;; a buffer if the filename doesn't exist. + (find-file-noselect it)) + (user-error "Can't open file: %s" it))))))) ((query preamble-re) (org-ql--query-preamble query)) (predicate (org-ql--query-predicate query)) ;; FIXME: Don't try to byte-compile already-compiled functions. @@ -171,23 +178,12 @@ a list of defined `org-ql' sorting methods: `date', `deadline', ;; (org-use-tag-inheritance t) ;; (org-trust-scanner-tags t) (org-ql--today (org-today)) - (items (->> sources - ;; List buffers - (--map (cl-etypecase it - (buffer it) - (string (or (find-buffer-visiting it) - (when (file-readable-p it) - ;; It feels unintuitive that `find-file-noselect' returns - ;; a buffer if the filename doesn't exist. - (find-file-noselect it)) - (user-error "Can't open file: %s" it))))) - ;; Filter buffers (i.e. select items) + (items (->> buffers (--map (with-current-buffer it (unless (derived-mode-p 'org-mode) (user-error "Not an Org buffer: %s" (buffer-name))) (org-ql--select-cached :query query :preamble-re preamble-re :predicate predicate :action action :narrow narrow))) - ;; Flatten items (-flatten-n 1)))) ;; Sort items (pcase sort From 88ba3d3933ede18f5e48e4463e4d58bf9d981b11 Mon Sep 17 00:00:00 2001 From: Adam Porter Date: Sun, 21 Jul 2019 17:21:17 -0500 Subject: [PATCH 039/798] Docs: (org-ql) Improve docstring --- README.org | 2 ++ org-ql.el | 3 +++ 2 files changed, 5 insertions(+) diff --git a/README.org b/README.org index 91ca0dc..7d1cdd0 100644 --- a/README.org +++ b/README.org @@ -218,6 +218,8 @@ If ~NARROW~ is non-nil, buffers are not widened. Find entries in ~BUFFERS-OR-FILES~ that match ~QUERY~, and return the results of running ~ACTION-FN~ on each matching entry. +Unlike the corresponding function ~org-ql-query~, arguments to this macro should not be quoted. + ~BUFFERS-OR-FILES~ is a form which should evaluate to one (or a list of) file(s) or buffer(s). ~QUERY~ is an ~org-ql~ query sexp, unquoted. diff --git a/org-ql.el b/org-ql.el index debed89..39f9221 100644 --- a/org-ql.el +++ b/org-ql.el @@ -95,6 +95,9 @@ match." (action '(org-element-headline-parser (line-end-position)))) "Find entries in BUFFERS-OR-FILES that match QUERY, and return the results of running ACTION-FN on each matching entry. +Unlike the corresponding function `org-ql-query', arguments to +this macro should not be quoted. + BUFFERS-OR-FILES is a form which should evaluate to one (or a list of) file(s) or buffer(s). From 797798bd084ab62490b0ef38582bd57ee1f59c00 Mon Sep 17 00:00:00 2001 From: Adam Porter Date: Sun, 21 Jul 2019 17:21:48 -0500 Subject: [PATCH 040/798] Change: (org-ql-query) Accept comparator function to :sort --- README.org | 3 ++- org-ql.el | 16 +++++++++++----- 2 files changed, 13 insertions(+), 6 deletions(-) diff --git a/README.org b/README.org index 7d1cdd0..34dde96 100644 --- a/README.org +++ b/README.org @@ -210,7 +210,7 @@ Return items matching ~QUERY~ in ~BUFFERS-OR-FILES~. If ~NARROW~ is non-nil, buffers are not widened. -~SORT~ is either nil, in which case items are not sorted; or one or a list of defined ~org-ql~ sorting methods: ~date~, ~deadline~, ~scheduled~, ~todo~, and ~priority~. +~SORT~ is either nil, in which case items are not sorted; or one or a list of defined ~org-ql~ sorting methods (~date~, ~deadline~, ~scheduled~, ~todo~, or ~priority~); or a user-defined comparator function that accepts two items as arguments and returns nil or non-nil. **** Macro: ~org-ql~ @@ -243,6 +243,7 @@ If ~MARKERS~ is non-nil, ~org-agenda-ng--add-markers~ is used to add markers to *Changed* + ~(regexp)~ selector accepts multiple regexps to test. ++ The ~:sort~ argument to ~org-ql~, ~org-ql-query~, etc. now also accepts a comparator function by which to sort items. *Fixed* + Handle date ranges in date-based selectors. (Thanks to [[https://github.com/codygman][Cody Goodman]], [[https://github.com/swflint][Samuel W. Flint]], and [[https://github.com/vikasrawal][Vikas Rawal]].) diff --git a/org-ql.el b/org-ql.el index 39f9221..363b8de 100644 --- a/org-ql.el +++ b/org-ql.el @@ -108,9 +108,11 @@ with point at the beginning of its heading. It is passed to `org-ql-query' as a lambda. By default, `org-element-headline-parser' is called to return an Org element. -SORT is a user defined sorting function, or an unquoted list of -one or more sorting methods, including: `date', `deadline', -`scheduled', `todo', and `priority'. +SORT is either nil, in which case items are not sorted; or one or +a list of predefined `org-ql' sorting methods (`date', `deadline', +`scheduled', `todo', or `priority'; or a user-defined comparator +function that accepts two items as arguments and returns nil or +non-nil. If NARROW is non-nil, query will run without widening the buffer (the default is to widen and search the entire buffer). @@ -158,8 +160,10 @@ compatible with Org Agenda code. If NARROW is non-nil, buffers are not widened. SORT is either nil, in which case items are not sorted; or one or -a list of defined `org-ql' sorting methods: `date', `deadline', -`scheduled', `todo', and `priority'." +a list of defined `org-ql' sorting methods (`date', `deadline', +`scheduled', `todo', or `priority'); or a user-defined comparator +function that accepts two items as arguments and returns nil or +non-nil." (declare (indent defun)) (-let* ((buffers (->> (cl-typecase buffers-or-files (null (list (current-buffer))) @@ -197,6 +201,8 @@ a list of defined `org-ql' sorting methods: `date', `deadline', always (memq elem '(date deadline scheduled todo priority))))) ;; Default sorting functions (org-ql--sort-by items sort)) + ;; Sort by user-given comparator. + ((pred functionp) (sort items sort)) (_ (user-error "SORT must be either nil, or one or a list of the defined sorting methods (see documentation)"))))) (defun org-ql--query-predicate (query) From ad6624d9aea189b3c9e00dc2cf0fe5c029fe156b Mon Sep 17 00:00:00 2001 From: Adam Porter Date: Mon, 22 Jul 2019 14:42:46 -0500 Subject: [PATCH 041/798] Comment: Add FIXME --- org-ql.el | 1 + 1 file changed, 1 insertion(+) diff --git a/org-ql.el b/org-ql.el index 363b8de..9782f3e 100644 --- a/org-ql.el +++ b/org-ql.el @@ -293,6 +293,7 @@ replace the clause with a preamble." (setq org-ql-preamble regexp) ;; Return nil nil)) + ;; FIXME: Need to handle e.g. (level <= 2) (`(level ,num) (let* ((regexp (rx-to-string `(seq bol (repeat ,num "*") " ")))) (setq org-ql-preamble regexp) From dbb94ff3b8c88e47d9aea1822cbd6fdfb2e41cc3 Mon Sep 17 00:00:00 2001 From: Adam Porter Date: Tue, 23 Jul 2019 19:01:16 -0500 Subject: [PATCH 042/798] Tests: Use xr to help format test results --- Cask | 4 +++- tests/test-org-ql.el | 30 ++++++++++++++++++++++-------- 2 files changed, 25 insertions(+), 9 deletions(-) diff --git a/Cask b/Cask index a78c6fa..7afe920 100644 --- a/Cask +++ b/Cask @@ -2,7 +2,9 @@ (files "org-ql.el" "org-ql-agenda.el") +(source gnu) (source melpa) (development - (depends-on "buttercup")) + (depends-on "buttercup") + (depends-on "xr")) diff --git a/tests/test-org-ql.el b/tests/test-org-ql.el index 80663ec..e2e3110 100644 --- a/tests/test-org-ql.el +++ b/tests/test-org-ql.el @@ -35,16 +35,30 @@ "FIXME: docstring" (interactive) (if-let* ((sexp (elisp--preceding-sexp)) - (correct-sexp-p (eq (car sexp) 'org-ql)) - (value (eval sexp)) - (prefix (if (and value (listp value)) - "'" - ""))) - (insert " :to-equal " - prefix - (format "%S" value)) + (correct-sexp-p (pcase (car sexp) + ('org-ql 'org-ql) + ('org-ql--query-preamble 'query-preamble) + (_ nil))) + (result (pcase (car sexp) + ('org-ql (org-ql-test--format-result--ql sexp)) + ('org-ql--query-preamble (org-ql-test--format-result--query-preamble sexp)) + (_ nil)))) + (insert " :to-equal " result) (user-error "Point must be after an `org-ql' form"))) +(defun org-ql-test--format-result--ql (sexp) + (let* ((value (eval sexp)) + (prefix (if (and value (listp value)) + "'" + ""))) + (format "%S" value))) + +(defun org-ql-test--format-result--query-preamble (sexp) + (-let* (((query preamble) (eval sexp)) + (preamble (when preamble + (xr preamble 'brief)))) + (format "`(%S ,(rx %S))" query preamble))) + (defun org-ql-test-show-result () "Show `org-ql-agenda' for `org-ql' form." (interactive) From 99b38d131e2fd10cbf613fb650fef48650d0d822 Mon Sep 17 00:00:00 2001 From: Adam Porter Date: Tue, 23 Jul 2019 19:03:33 -0500 Subject: [PATCH 043/798] Tests: Add org-ql-it macro Tests with and without preamble, ensuring they give the same results. Very important. And macros make this so easy to do. --- tests/test-org-ql.el | 62 ++++++++++++++++++++++++++++---------------- 1 file changed, 40 insertions(+), 22 deletions(-) diff --git a/tests/test-org-ql.el b/tests/test-org-ql.el index e2e3110..427a30d 100644 --- a/tests/test-org-ql.el +++ b/tests/test-org-ql.el @@ -69,6 +69,24 @@ (eval sexp)) (user-error "Point must be after an `org-ql' form"))) +;;;; Macros + +(defmacro org-ql-it (description &rest body) + "Expand to two specs, one of which tests with preambles and the other without. +Based on Buttercup macro `it'." + (declare (indent 1) (debug (&define sexp def-body))) + (if body + `(progn + (buttercup-it ,(concat description " (preamble) ") + (lambda () + (let ((org-ql-use-preamble t)) + ,@body))) + (buttercup-it ,(concat description " (no preamble)") + (lambda () + (let ((org-ql-use-preamble nil)) + ,@body)))) + `(buttercup-xit ,description))) + ;;;; Tests (describe "org-ql" @@ -92,24 +110,24 @@ (describe "Predicates" (describe "(category)" - (it "without arguments" + (org-ql-it "without arguments" (expect (length (org-ql test-buffer (category) :action (org-ql-test-org-get-heading))) :to-equal num-headings)) - (it "with a category" + (org-ql-it "with a category" (expect (org-ql test-buffer (category "ambition") :action (org-ql-test-org-get-heading)) :to-equal '("Take over the universe" "Take over the world" "Skype with president of Antarctica" "Take over Mars" "Visit Mars" "Take over the moon" "Visit the moon" "Practice leaping tall buildings in a single bound" "Renew membership in supervillain club" "Learn universal sign language")))) (describe "(clocked)" - (it "without arguments" + (org-ql-it "without arguments" (expect (org-ql test-buffer (clocked) :action (org-ql-test-org-get-heading)) :to-equal '("Learn universal sign language"))) - (it ":from a timestamp" + (org-ql-it ":from a timestamp" (expect (org-ql test-buffer (clocked :from "2017-07-05") :action (org-ql-test-org-get-heading)) @@ -118,7 +136,7 @@ (clocked :from "2017-07-06") :action (org-ql-test-org-get-heading)) :to-equal nil)) - (it ":to a timestamp" + (org-ql-it ":to a timestamp" (expect (org-ql test-buffer (clocked :to "2017-07-05") :action (org-ql-test-org-get-heading)) @@ -127,7 +145,7 @@ (clocked :to "2017-07-04") :action (org-ql-test-org-get-heading)) :to-equal nil)) - (it ":on a date" + (org-ql-it ":on a date" (expect (org-ql test-buffer (clocked :on "2017-07-05") :action (org-ql-test-org-get-heading)) @@ -136,7 +154,7 @@ (clocked :on "2018-12-02") :action (org-ql-test-org-get-heading)) :to-equal nil)) - (it "within a range (:from and :to)" + (org-ql-it "within a range (:from and :to)" (expect (org-ql test-buffer (clocked :from "2017-07-04" :to "2018-12-11") :action (org-ql-test-org-get-heading)) @@ -151,12 +169,12 @@ :to-equal nil))) (describe "(closed)" - (it "without arguments" + (org-ql-it "without arguments" (expect (org-ql test-buffer (closed) :action (org-ql-test-org-get-heading)) :to-equal '("Learn universal sign language"))) - (it "=" + (org-ql-it "=" (expect (org-ql test-buffer (closed = "2017-07-05") :action (org-ql-test-org-get-heading)) @@ -165,7 +183,7 @@ (closed = "2019-06-09") :action (org-ql-test-org-get-heading)) :to-equal nil)) - (it "<" + (org-ql-it "<" ;; TODO: Figure out why these tests take about 8 times longer than the other comparators in the (closed) tests. (expect (org-ql test-buffer (closed < "2019-06-10") @@ -175,7 +193,7 @@ (closed < "2017-06-10") :action (org-ql-test-org-get-heading)) :to-equal nil)) - (it ">" + (org-ql-it ">" (expect (org-ql test-buffer (closed > "2017-07-04") :action (org-ql-test-org-get-heading)) @@ -184,7 +202,7 @@ (closed > "2019-07-05") :action (org-ql-test-org-get-heading)) :to-equal nil)) - (it ">=" + (org-ql-it ">=" (expect (org-ql test-buffer (closed >= "2017-07-04") :action (org-ql-test-org-get-heading)) @@ -197,7 +215,7 @@ (closed >= "2017-07-06") :action (org-ql-test-org-get-heading)) :to-equal nil)) - (it "<=" + (org-ql-it "<=" (expect (org-ql test-buffer (closed <= "2017-07-04") :action (org-ql-test-org-get-heading)) @@ -212,12 +230,12 @@ :to-equal '("Learn universal sign language")))) (describe "(deadline)" - (it "without arguments" + (org-ql-it "without arguments" (expect (org-ql test-buffer (deadline) :action (org-ql-test-org-get-heading)) :to-equal '("Take over the universe" "Take over the world" "Visit Mars" "Visit the moon" "Renew membership in supervillain club" "Internet" "Spaceship lease" "/r/emacs"))) - (it "=" + (org-ql-it "=" (expect (org-ql test-buffer (deadline = "2017-07-05") :action (org-ql-test-org-get-heading)) @@ -226,7 +244,7 @@ (deadline = "2019-06-09") :action (org-ql-test-org-get-heading)) :to-equal nil)) - (it "<" + (org-ql-it "<" (expect (org-ql test-buffer (deadline < "2019-06-10") :action (org-ql-test-org-get-heading)) @@ -235,7 +253,7 @@ (deadline < "2017-06-10") :action (org-ql-test-org-get-heading)) :to-equal nil)) - (it ">" + (org-ql-it ">" ;; TODO: Figure out why these tests take much longer than e.g. the (deadline <) tests. (expect (org-ql test-buffer (deadline > "2017-07-04 00:00") @@ -245,7 +263,7 @@ (deadline > "2019-07-05") :action (org-ql-test-org-get-heading)) :to-equal nil)) - (it ">=" + (org-ql-it ">=" (expect (org-ql test-buffer (deadline >= "2017-07-04") :action (org-ql-test-org-get-heading)) @@ -262,7 +280,7 @@ (deadline >= "2018-07-06") :action (org-ql-test-org-get-heading)) :to-equal nil)) - (it "<=" + (org-ql-it "<=" (expect (org-ql test-buffer (deadline <= "2017-07-04") :action (org-ql-test-org-get-heading)) @@ -276,7 +294,7 @@ :action (org-ql-test-org-get-heading)) :to-equal '("Take over the universe" "Take over the world" "Visit Mars" "Visit the moon" "Renew membership in supervillain club" "Internet" "Spaceship lease" "/r/emacs")))) - (it "(done)" + (org-ql-it "(done)" (expect (org-ql test-buffer (done) :action (org-ql-test-org-get-heading)) @@ -329,7 +347,7 @@ (ts :from "2019-06-08") :action (org-ql-test-org-get-heading)) :to-equal nil)) - (it ":to a timestamp" + (org-ql-it ":to a timestamp" (expect (org-ql test-buffer (ts :to "2019-06-10") :action (org-ql-test-org-get-heading)) @@ -338,7 +356,7 @@ (ts :to "2017-07-04") :action (org-ql-test-org-get-heading)) :to-equal '("Skype with president of Antarctica"))) - (it ":on a timestamp" + (org-ql-it ":on a timestamp" (expect (org-ql test-buffer (ts :on "2017-07-05") :action (org-ql-test-org-get-heading)) From bdf473356d9f31df88c62803b3f72649f179d5d3 Mon Sep 17 00:00:00 2001 From: Adam Porter Date: Tue, 23 Jul 2019 19:14:01 -0500 Subject: [PATCH 044/798] Change: Improve level predicate Now accepts e.g. (level 2 4) to match headings from levels 2-4, inclusive. Also add tests for (level) preamble conversion. --- README.org | 2 +- org-ql.el | 41 +++++++++++++++++++++++++++-------------- tests/test-org-ql.el | 35 +++++++++++++++++++++++++++++------ 3 files changed, 57 insertions(+), 21 deletions(-) diff --git a/README.org b/README.org index 34dde96..693c7f1 100644 --- a/README.org +++ b/README.org @@ -118,7 +118,7 @@ Note that, for convenience, standard numeric comparator function symbols (~<~, ~ + ~done~ :: Return non-nil if entry's ~TODO~ keyword is in ~org-done-keywords~. + ~habit~ :: Return non-nil if entry is a habit. + ~heading (regexp)~ :: Return non-nil if current entry's heading matches ~REGEXP~ (a regexp string). -+ ~level (level-or-comparator &optional level)~ :: Return non-nil if current heading's outline level matches ~LEVEL~ with ~COMPARATOR~. If ~LEVEL~ is nil, ~LEVEL-OR-COMPARATOR~ should be an integer level, which will be tested for equality to the heading's outline level. If ~LEVEL~ is non-nil, ~LEVEL-OR-COMPARATOR~ should be a comparator function (like ~<=~). ++ ~level (level-or-comparator &optional level)~ :: Return non-nil if current heading's outline level matches arguments. The following forms are accepted: ~(level NUMBER)~: Matches if heading level is ~NUMBER~. ~(level NUMBER NUMBER)~: Matches if heading level is equal to or between NUMBERs. ~(level COMPARATOR NUMBER)~: Matches if heading level compares to ~NUMBER~ with ~COMPARATOR~. ~COMPARATOR~ may be ~<~, ~<=~, ~>~, or ~>=~. + ~planning (&optional comparator target-date)~ :: Return non-nil if entry's planning date (deadline or scheduled) compares with ~TARGET-DATE~ using ~COMPARATOR~. ~TARGET-DATE~ should be a string parseable by ~date-to-day~. ~COMPARATOR~ should be a function (like ~<=~). + ~priority (&optional comparator-or-priority priority)~ :: Return non-nil if current heading has a certain priority. ~COMPARATOR-OR-PRIORITY~ should be either a comparator function, like ~<=~, or a priority string, like "A" (in which case (~=~ will be the comparator). If ~COMPARATOR-OR-PRIORITY~ is a comparator, ~PRIORITY~ should be a priority string. + ~property (property &optional value)~ :: Return non-nil if current entry has ~PROPERTY~ (a string), and optionally ~VALUE~ (a string). diff --git a/org-ql.el b/org-ql.el index 9782f3e..6399d22 100644 --- a/org-ql.el +++ b/org-ql.el @@ -281,7 +281,7 @@ replace the clause with a preamble." (pcase element (`(or _) element) (`(regexp . ,regexps) - (let* ((regexp (rx-to-string `(or ,@regexps)))) + (let* ((regexp (rx-to-string `(or ,@regexps) t))) (setq org-ql-preamble regexp) ;; Return nil nil)) @@ -289,13 +289,21 @@ replace the clause with a preamble." (let* ((regexps (--map (list 'regexp (format org-heading-keyword-regexp-format it)) todo-keywords)) - (regexp (rx-to-string `(or ,@regexps)))) + (regexp (rx-to-string `(or ,@regexps) t))) (setq org-ql-preamble regexp) ;; Return nil nil)) - ;; FIXME: Need to handle e.g. (level <= 2) + (`(level ,comparator-or-num ,num) + (let ((repeat (pcase comparator-or-num + ('< `(repeat 1 ,(1- num) "*")) + ('<= `(repeat 1 ,num "*")) + ('> `(>= ,(1+ num) "*")) + ('>= `(>= ,num "*")) + ((pred integerp) `(repeat ,comparator-or-num ,num "*"))))) + (setq org-ql-preamble (rx-to-string `(seq bol ,repeat " ") t)) + nil)) (`(level ,num) - (let* ((regexp (rx-to-string `(seq bol (repeat ,num "*") " ")))) + (let* ((regexp (rx-to-string `(seq bol (repeat ,num "*") " ") t))) (setq org-ql-preamble regexp) nil)) (`(and . ,rest) @@ -502,20 +510,25 @@ With KEYWORDS, return non-nil if its keyword is one of KEYWORDS (a list of strin (otherwise (seq-intersection tags tags-at))))) (org-ql--defpred level (level-or-comparator &optional level) - "Return non-nil if current heading's outline level matches LEVEL with COMPARATOR. + "Return non-nil if current heading's outline level matches arguments. +The following forms are accepted: -If LEVEL is nil, LEVEL-OR-COMPARATOR should be an integer level, -which will be tested for equality to the heading's outline level. -If LEVEL is non-nil, LEVEL-OR-COMPARATOR should be a comparator -function (like `<=')." + (level NUMBER): Matches if heading level is NUMBER. + (level NUMBER NUMBER): Matches if heading level is equal to or between NUMBERs. + (level COMPARATOR NUMBER): Matches if heading level compares to NUMBER with COMPARATOR. + +COMPARATOR may be `<', `<=', `>', or `>='." ;; NOTE: It might be necessary to take into account `org-odd-levels'; see docstring for ;; `org-outline-level'. (when-let ((outline-level (org-outline-level))) - (pcase level - ;; Check for equality - ((pred null) (= outline-level level-or-comparator)) - ;; Check with comparator - (_ (funcall level-or-comparator outline-level level))))) + (pcase level-or-comparator + ((pred numberp) (pcase level + ('nil ;; Equality + (= outline-level level-or-comparator)) + ((pred numberp) ;; Between two levels + (>= level-or-comparator outline-level level)))) + ((pred symbolp) ;; Compare with function + (funcall level-or-comparator outline-level level))))) (org-ql--defpred priority (&optional comparator-or-priority priority) "Return non-nil if current heading has a certain priority. diff --git a/tests/test-org-ql.el b/tests/test-org-ql.el index 427a30d..0cb32e3 100644 --- a/tests/test-org-ql.el +++ b/tests/test-org-ql.el @@ -107,7 +107,34 @@ Based on Buttercup macro `it'." (cl-loop while (re-search-forward org-heading-regexp nil t) sum 1))))) - (describe "Predicates" + (describe "Query compiling" + ;; Okay, so it's not really "compiling," but it sounds fancy. :) + + ;; TODO: Other predicates. + + (describe "(level)" + (it "with a number" + (expect (org-ql--query-preamble '(level 2)) + :to-equal `(t ,(rx bol (repeat 2 "*") " ")))) + (it "with two numbers" + (expect (org-ql--query-preamble '(level 2 4)) + :to-equal `(t ,(rx bol (repeat 2 4 "*") " ")))) + (it "<" + (expect (org-ql--query-preamble '(level < 3)) + :to-equal `(t ,(rx bol (repeat 1 2 "*") " ")))) + (it "<=" + (expect (org-ql--query-preamble '(level <= 2)) + :to-equal `(t ,(rx bol (repeat 1 2 "*") " ")))) + (it ">" + (expect (org-ql--query-preamble '(level > 2)) + :to-equal `(t ,(rx bol (>= 3 "*") " ")))) + (it ">=" + (expect (org-ql--query-preamble '(level >= 2)) + :to-equal `(t ,(rx bol (>= 2 "*") " ")))))) + + (describe "Query results" + + ;; TODO: Other predicates. (describe "(category)" (org-ql-it "without arguments" @@ -364,10 +391,6 @@ Based on Buttercup macro `it'." (expect (org-ql test-buffer (ts :on "2019-06-09") :action (org-ql-test-org-get-heading)) - :to-equal nil)) - ) - - ;; TODO: Other predicates. - )) + :to-equal nil))))) ;;; org-ql.el ends here From c19cc4d6d21b2a4c41eb4738d316eed527377732 Mon Sep 17 00:00:00 2001 From: Adam Porter Date: Tue, 23 Jul 2019 19:16:10 -0500 Subject: [PATCH 045/798] Docs: (README.org) Remove Predicates from ToC --- README.org | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/README.org b/README.org index 693c7f1..8c3c1f7 100644 --- a/README.org +++ b/README.org @@ -16,7 +16,6 @@ - [[#usage][Usage]] - [[#commands][Commands]] - [[#queries][Queries]] - - [[#predicates][Predicates]] - [[#functions--macros][Functions / Macros]] - [[#changelog][Changelog]] - [[#notes][Notes]] @@ -105,6 +104,9 @@ Here's an example of using it to generate an agenda-like view for certain files A query is a lisp form which may contain arbitrary lisp forms, as well as certain built-in predicates. It is byte-compiled into a predicate function which is tested with point on each heading in an Org buffer; when it returns non-nil, the heading matches the query. *** Predicates +:PROPERTIES: +:TOC: ignore +:END: Arguments are listed next to predicate names, where applicable. From 76ba0afebdda25c8eaec26747cf893fe7b10f7b5 Mon Sep 17 00:00:00 2001 From: Adam Porter Date: Tue, 23 Jul 2019 21:14:33 -0500 Subject: [PATCH 046/798] Comment: Add FIXME --- org-ql.el | 2 ++ 1 file changed, 2 insertions(+) diff --git a/org-ql.el b/org-ql.el index 6399d22..f5574b6 100644 --- a/org-ql.el +++ b/org-ql.el @@ -286,6 +286,8 @@ replace the clause with a preamble." ;; Return nil nil)) (`(todo . ,(and todo-keywords (guard todo-keywords))) + ;; FIXME: With case-folding, a query like (todo "WAITING") + ;; can find a non-todo heading named "Waiting". (let* ((regexps (--map (list 'regexp (format org-heading-keyword-regexp-format it)) todo-keywords)) From 6728ddaaa7d00c134eb8dd18a48ce7d6ea5000ad Mon Sep 17 00:00:00 2001 From: Adam Porter Date: Tue, 23 Jul 2019 21:25:32 -0500 Subject: [PATCH 047/798] Change: (--query-preamble) Simplify (todo) preamble --- org-ql.el | 12 +++++------- 1 file changed, 5 insertions(+), 7 deletions(-) diff --git a/org-ql.el b/org-ql.el index f5574b6..4874030 100644 --- a/org-ql.el +++ b/org-ql.el @@ -288,13 +288,11 @@ replace the clause with a preamble." (`(todo . ,(and todo-keywords (guard todo-keywords))) ;; FIXME: With case-folding, a query like (todo "WAITING") ;; can find a non-todo heading named "Waiting". - (let* ((regexps (--map (list 'regexp - (format org-heading-keyword-regexp-format it)) - todo-keywords)) - (regexp (rx-to-string `(or ,@regexps) t))) - (setq org-ql-preamble regexp) - ;; Return nil - nil)) + (setq org-ql-preamble + (rx-to-string `(seq bol (1+ "*") (1+ space) (or ,@todo-keywords) (or " " eol)) + t)) + ;; Return nil + nil) (`(level ,comparator-or-num ,num) (let ((repeat (pcase comparator-or-num ('< `(repeat 1 ,(1- num) "*")) From 06c7f55b218b0a68ad21aa91c0c5e26d894ea127 Mon Sep 17 00:00:00 2001 From: Adam Porter Date: Tue, 23 Jul 2019 21:32:44 -0500 Subject: [PATCH 048/798] Change: (--query-preamble) Simplify --- org-ql.el | 12 +++++------- 1 file changed, 5 insertions(+), 7 deletions(-) diff --git a/org-ql.el b/org-ql.el index 4874030..8d23add 100644 --- a/org-ql.el +++ b/org-ql.el @@ -281,10 +281,9 @@ replace the clause with a preamble." (pcase element (`(or _) element) (`(regexp . ,regexps) - (let* ((regexp (rx-to-string `(or ,@regexps) t))) - (setq org-ql-preamble regexp) - ;; Return nil - nil)) + (setq org-ql-preamble (rx-to-string `(or ,@regexps) t)) + ;; Return nil + nil) (`(todo . ,(and todo-keywords (guard todo-keywords))) ;; FIXME: With case-folding, a query like (todo "WAITING") ;; can find a non-todo heading named "Waiting". @@ -303,9 +302,8 @@ replace the clause with a preamble." (setq org-ql-preamble (rx-to-string `(seq bol ,repeat " ") t)) nil)) (`(level ,num) - (let* ((regexp (rx-to-string `(seq bol (repeat ,num "*") " ") t))) - (setq org-ql-preamble regexp) - nil)) + (setq org-ql-preamble (rx-to-string `(seq bol (repeat ,num "*") " ") t)) + nil) (`(and . ,rest) (let ((clauses (mapcar #'rec rest))) `(and ,@(-non-nil clauses)))) From 3b9c47419347091fb02d1935298c196ff1abcf5a Mon Sep 17 00:00:00 2001 From: Adam Porter Date: Wed, 24 Jul 2019 00:44:38 -0500 Subject: [PATCH 049/798] Fix: (org-ql-query) Don't byte-compile compiled functions --- org-ql.el | 9 +++++++-- 1 file changed, 7 insertions(+), 2 deletions(-) diff --git a/org-ql.el b/org-ql.el index 8d23add..1fcd939 100644 --- a/org-ql.el +++ b/org-ql.el @@ -179,8 +179,13 @@ non-nil." (user-error "Can't open file: %s" it))))))) ((query preamble-re) (org-ql--query-preamble query)) (predicate (org-ql--query-predicate query)) - ;; FIXME: Don't try to byte-compile already-compiled functions. - (action (byte-compile action)) + (action (cl-etypecase action + (symbol (unless (functionp action) + (user-error "Action not a function: %s" action)) + action) + (function (byte-compile action)) + (list (byte-compile `(lambda (&rest _ignore) + ,action))))) ;; TODO: Figure out how to use or reimplement the org-scanner-tags feature. ;; (org-use-tag-inheritance t) ;; (org-trust-scanner-tags t) From 7c4297b667e36599435f4958c606756ad270819d Mon Sep 17 00:00:00 2001 From: Adam Porter Date: Wed, 24 Jul 2019 01:29:33 -0500 Subject: [PATCH 050/798] Add/Change: (org-ql-select, org-ql-query) Add/rename function Also improve docstrings. --- README.org | 111 +++++++++++++++++++++++++++++++-------- org-ql-agenda.el | 2 +- org-ql.el | 133 +++++++++++++++++++++++++---------------------- 3 files changed, 163 insertions(+), 83 deletions(-) diff --git a/README.org b/README.org index 8c3c1f7..cc68153 100644 --- a/README.org +++ b/README.org @@ -59,12 +59,12 @@ More examples are available in [[examples.org]]. The functionality provided may be grouped by: + Interactive commands :: ~org-ql-search~ -+ Non-interactive functions and macros :: ~org-ql~ (macro), ~org-ql-query~ (function), and ~org-ql-agenda~ (macro) ++ Non-interactive functions and macros :: ~org-ql~ (macro), ~org-ql-select~ (function), ~org-ql-query~ (function), and ~org-ql-agenda~ (macro) Alternatively, they may be grouped by: + Showing an agenda-like view :: ~org-ql-search~ (command), and ~org-ql-agenda~ (macro) -+ Returning a list of matches or acting on them :: ~org-ql~ (macro), and ~org-ql-query~ (function) ++ Returning a list of matches or acting on them :: ~org-ql~ (macro), ~org-ql-select~ (function), and ~org-ql-query~ (function) Feedback on these APIs is welcome. Eventually, after being tested and polished, they will be considered stable. @@ -198,41 +198,105 @@ Here are some other examples: *** Listing / acting-on results -**** Function: ~org-ql-query~ +**** Function: ~org-ql-select~ /Arguments:/ ~(buffers-or-files query &key action narrow sort)~ Return items matching ~QUERY~ in ~BUFFERS-OR-FILES~. -~BUFFERS-OR-FILES~ is a one (or a list of) file(s) or buffer(s). +~BUFFERS-OR-FILES~ is a one or a list of files and/or buffers. ~QUERY~ is an ~org-ql~ query sexp (quoted, since this is a function). -~ACTION~ is a function which is called on each matching entry, with point at the beginning of its heading. For example, ~org-element-headline-parser~ may be used to parse an entry into an Org element (note that it must be called with a limit argument, so a lambda must be used to do so). Also see ~org-ql--add-markers~, which may be used to add markers compatible with Org Agenda code. +~ACTION~ is a function which is called on each matching entry with point at the beginning of its heading. It may be: -If ~NARROW~ is non-nil, buffers are not widened. + - ~element~ or nil: Equivalent to ~org-element-headline-parser~. + + - ~element-with-markers~: Equivalent to calling ~org-element-headline-parser~, with markers added using ~org-ql--add-markers~. Suitable for formatting with ~org-ql-agenda--format-element~, allowing insertion into an Org Agenda-like buffer. + + - A sexp, which will be byte-compiled into a lambda function. + + - A function symbol. + +If ~NARROW~ is non-nil, buffers are not widened (the default is to widen and search the entire buffer). ~SORT~ is either nil, in which case items are not sorted; or one or a list of defined ~org-ql~ sorting methods (~date~, ~deadline~, ~scheduled~, ~todo~, or ~priority~); or a user-defined comparator function that accepts two items as arguments and returns nil or non-nil. +Examples: + +#+BEGIN_SRC elisp + ;; Return list of to-do headings in inbox file with tags and to-do keywords: + (org-ql-select "~/org/inbox.org" + '(todo) + :action #'org-get-heading) + ;; => ("TODO Practice leaping tall buildings in a single bound :personal:" ...) + + ;; Without tags and to-do keywords: + (org-ql-select "~/org/inbox.org" + '(todo) + :action '(org-get-heading t t)) + ;; => ("Practice leaping tall buildings in a single bound" ...) + + ;; Return WAITING heading elements in agenda files: + (org-ql-select (org-agenda-files) + '(todo "WAITING") + :action 'element) + ;; => ((headline (:raw-value "Visit the moon" ...) ...) ...) + + ;; Since `element' is the default for ACTION, it may be omitted: + (org-ql-select (org-agenda-files) + '(todo "WAITING")) + ;; => ((headline (:raw-value "Visit the moon" ...) ...) ...) +#+END_SRC + +**** Function: ~org-ql-query~ + +/Arguments:/ ~(&key (select 'element-with-markers) from where)~ + +Like ~org-ql-select~, but arguments are named more like a ~SQL~ query. + +~SELECT~ corresponds to the ~org-ql-select~ argument ~ACTION~. + +~FROM~ corresponds to the ~org-ql-select~ argument ~BUFFERS-OR-FILES~. + +~WHERE~ corresponds to the ~org-ql-select~ argument ~QUERY~. + +Examples: + +#+BEGIN_SRC elisp + ;; Return list of to-do headings in inbox file with tags and to-do keywords: + (org-ql-query + :select #'org-get-heading + :from "~/org/inbox.org" + :where '(todo)) + ;; => ("TODO Practice leaping tall buildings in a single bound :personal:" ...) + + ;; Without tags and to-do keywords: + (org-ql-query + :select '(org-get-heading t t) + :from "~/org/inbox.org" + :where '(todo)) + ;; => ("Practice leaping tall buildings in a single bound" ...) + + ;; Return WAITING heading elements in agenda files: + (org-ql-query + :select 'element + :from (org-agenda-files) + :where '(todo "WAITING")) + ;; => ((headline (:raw-value "Visit the moon" ...) ...) ...) + + ;; Since `element' is the default for SELECT, it may be omitted: + (org-ql-query + :from (org-agenda-files) + :where '(todo "WAITING")) + ;; => ((headline (:raw-value "Visit the moon" ...) ...) ...) +#+END_SRC + **** Macro: ~org-ql~ /Arguments:/ ~(buffers-or-files query &key sort narrow markers action)~ -Find entries in ~BUFFERS-OR-FILES~ that match ~QUERY~, and return the results of running ~ACTION-FN~ on each matching entry. - -Unlike the corresponding function ~org-ql-query~, arguments to this macro should not be quoted. - -~BUFFERS-OR-FILES~ is a form which should evaluate to one (or a list of) file(s) or buffer(s). - -~QUERY~ is an ~org-ql~ query sexp, unquoted. - -~ACTION~ is a sexp which will be evaluated at each matching entry with point at the beginning of its heading. It is passed to ~org-ql-query~ as a lambda. By default, ~org-element-headline-parser~ is called to return an Org element. - -~SORT~ is a user defined sorting function, or an unquoted list of one or more sorting methods, including: ~date~, ~deadline~, ~scheduled~, ~todo~, and ~priority~. - -If ~NARROW~ is non-nil, query will run without widening the buffer (the default is to widen and search the entire buffer). - -If ~MARKERS~ is non-nil, ~org-agenda-ng--add-markers~ is used to add markers to each item, pointing to the item in its source buffer. In this case, ~ACTION~ should return an Org element. +Expands into a call to ~org-ql-select~ with the same arguments. For convenience, arguments should be unquoted. * Changelog :PROPERTIES: @@ -243,7 +307,12 @@ If ~MARKERS~ is non-nil, ~org-agenda-ng--add-markers~ is used to add markers to ** 0.2-pre +*Added* ++ Function ~org-ql-query~, like ~org-ql-select~ but with arguments named more like a SQL query. + *Changed* ++ Function ~org-ql-query~ renamed to ~org-ql-select~. ++ Macro ~org-ql~ no longer accepts a ~:markers~ argument. Instead, use argument ~:action element-with-markers~. See function ~org-ql-select~, which ~org-ql~ calls. + ~(regexp)~ selector accepts multiple regexps to test. + The ~:sort~ argument to ~org-ql~, ~org-ql-query~, etc. now also accepts a comparator function by which to sort items. diff --git a/org-ql-agenda.el b/org-ql-agenda.el index d0e4a67..f17e069 100644 --- a/org-ql-agenda.el +++ b/org-ql-agenda.el @@ -207,7 +207,7 @@ SORT: One or a list of `org-ql' sorting functions, like `date' or (when (and super-groups (not org-super-agenda-mode)) (user-error "`org-super-agenda-mode' must be activated to use grouping")) (let* ((org-super-agenda-groups super-groups) - (entries (--> (org-ql-query buffers-files + (entries (--> (org-ql-select buffers-files query :sort sort :narrow narrow diff --git a/org-ql.el b/org-ql.el index 1fcd939..a680080 100644 --- a/org-ql.el +++ b/org-ql.el @@ -91,48 +91,13 @@ match." (push (list :name ',pred-name :fn ',fn-name :docstring ,docstring :args ',args) org-ql-predicates) (cl-defun ,fn-name ,args ,docstring ,@body)))) -(cl-defmacro org-ql (buffers-or-files query &key sort narrow markers - (action '(org-element-headline-parser (line-end-position)))) - "Find entries in BUFFERS-OR-FILES that match QUERY, and return the results of running ACTION-FN on each matching entry. - -Unlike the corresponding function `org-ql-query', arguments to -this macro should not be quoted. - -BUFFERS-OR-FILES is a form which should evaluate to one (or a -list of) file(s) or buffer(s). - -QUERY is an `org-ql' query sexp, unquoted. - -ACTION is a sexp which will be evaluated at each matching entry -with point at the beginning of its heading. It is passed to -`org-ql-query' as a lambda. By default, `org-element-headline-parser' - is called to return an Org element. - -SORT is either nil, in which case items are not sorted; or one or -a list of predefined `org-ql' sorting methods (`date', `deadline', -`scheduled', `todo', or `priority'; or a user-defined comparator -function that accepts two items as arguments and returns nil or -non-nil. - -If NARROW is non-nil, query will run without widening the -buffer (the default is to widen and search the entire buffer). - -If MARKERS is non-nil, `org-ql--add-markers' is used to -add markers to each item, pointing to the item in its source -buffer. In this case, ACTION should return an Org element." +(cl-defmacro org-ql (buffers-or-files query &key sort narrow action) + "Expands into a call to `org-ql-select' with the same arguments. +For convenience, arguments should be unquoted." (declare (indent defun)) - (setq action (pcase markers - ('nil `(lambda () - ,action)) - (_ `(lambda () - ;; FIXME: Document that, when markers is t, `action' should return an Org - ;; headline element, which --add-markers works with. On the other hand, - ;; maybe this should be on the agenda-ng side. - (->> ,action - org-ql--add-markers))))) - `(org-ql-query ,buffers-or-files + `(org-ql-select ,buffers-or-files ',query - :action ,action + :action ',action :narrow ,narrow :sort ',sort)) @@ -141,23 +106,31 @@ buffer. In this case, ACTION should return an Org element." (define-hash-table-test 'org-ql-hash-test #'equal (lambda (args) (sxhash-equal (prin1-to-string args)))) -(cl-defun org-ql-query (buffers-or-files query &key action narrow sort) +(cl-defun org-ql-select (buffers-or-files query &key action narrow sort) "Return items matching QUERY in BUFFERS-OR-FILES. -BUFFERS-OR-FILES is a one (or a list of) file(s) or buffer(s). +BUFFERS-OR-FILES is a one or a list of files and/or buffers. QUERY is an `org-ql' query sexp (quoted, since this is a function). -ACTION is a function which is called on each matching entry, with -point at the beginning of its heading. For example, -`org-element-headline-parser' may be used to parse an entry into -an Org element (note that it must be called with a limit -argument, so a lambda must be used to do so). Also see -`org-ql--add-markers', which may be used to add markers -compatible with Org Agenda code. +ACTION is a function which is called on each matching entry with +point at the beginning of its heading. It may be: -If NARROW is non-nil, buffers are not widened. +- `element' or nil: Equivalent to `org-element-headline-parser'. + +- `element-with-markers': Equivalent to calling + `org-element-headline-parser', with markers added using + `org-ql--add-markers'. Suitable for formatting with + `org-ql-agenda--format-element', allowing insertion into an Org + Agenda-like buffer. + +- A sexp, which will be byte-compiled into a lambda function. + +- A function symbol. + +If NARROW is non-nil, buffers are not widened (the default is to +widen and search the entire buffer). SORT is either nil, in which case items are not sorted; or one or a list of defined `org-ql' sorting methods (`date', `deadline', @@ -179,13 +152,23 @@ non-nil." (user-error "Can't open file: %s" it))))))) ((query preamble-re) (org-ql--query-preamble query)) (predicate (org-ql--query-predicate query)) - (action (cl-etypecase action - (symbol (unless (functionp action) - (user-error "Action not a function: %s" action)) - action) - (function (byte-compile action)) - (list (byte-compile `(lambda (&rest _ignore) - ,action))))) + (action (pcase action + ;; NOTE: These two lambdas are backquoted to prevent "unused lexical + ;; variable" warnings from byte-compilation, because they don't use + ;; all of the variables from their enclosing scope. + ('element-with-markers (byte-compile + `(lambda (&rest _ignore) + (org-ql--add-markers + (org-element-headline-parser (line-end-position)))))) + ((or 'nil 'element) (byte-compile + `(lambda (&rest _ignore) + (org-element-headline-parser (line-end-position))))) + ((pred functionp) action) + ((and (pred listp) (guard (functionp (car action)))) + (byte-compile + `(lambda (&rest _ignore) + ,action))) + (_ (user-error "Invalid action form: %s" action)))) ;; TODO: Figure out how to use or reimplement the org-scanner-tags feature. ;; (org-use-tag-inheritance t) ;; (org-trust-scanner-tags t) @@ -210,6 +193,34 @@ non-nil." ((pred functionp) (sort items sort)) (_ (user-error "SORT must be either nil, or one or a list of the defined sorting methods (see documentation)"))))) +(cl-defun org-ql-query (&key (select 'element-with-markers) from where) + "Like `org-ql-select', but arguments are named more like a SQL query. + +SELECT corresponds to the `org-ql-select' argument ACTION. It is +the function called on matching headings, the results of which +are returned by this function. It may be: + +- `element' or nil: Equivalent to `org-element-headline-parser'. + +- `element-with-markers': Equivalent to + `org-element-headline-parser', with markers added using + `org-ql--add-markers'. Suitable for formatting with + `org-ql-agenda--format-element', allowing insertion into an Org + Agenda-like buffer. + +- A sexp, which will be byte-compiled into a lambda function. + +- A function symbol. + +FROM corresponds to the `org-ql-select' argument BUFFERS-OR-FILES. +It may be one or a list of file paths and/or buffers. + +WHERE corresponds to the `org-ql-select' argument QUERY. It +should be an `org-ql' query sexp." + (declare (indent defun)) + (org-ql-select from where + :action select)) + (defun org-ql--query-predicate (query) "Return predicate function for QUERY." (byte-compile `(lambda () @@ -460,7 +471,7 @@ Note: Clock entries are expected to be clocked out. Currently clocked entries (i.e. with unclosed timestamp ranges) are ignored." ;; NOTE: FROM and TO are actually expected to be Unix timestamps. The docstring is written - ;; for end users, for which the arguments are pre-processed by `org-ql-query'. + ;; for end users, for which the arguments are pre-processed by `org-ql-select'. ;; FIXME: This assumes every "clocked" entry is a range. Unclosed clock entries are not handled. (cl-macrolet ((next-timestamp () `(when (re-search-forward org-clock-line-re end-pos t) @@ -626,7 +637,7 @@ FROM, TO, and ON should be strings parseable by `parse-time-string' but may omit the time value." ;; TODO: DRY this with the clocked predicate. ;; NOTE: FROM and TO are actually expected to be Unix timestamps. The docstring is written - ;; for end users, for which the arguments are pre-processed by `org-ql-query'. + ;; for end users, for which the arguments are pre-processed by `org-ql-select'. ;; FIXME: This assumes every "clocked" entry is a range. Unclosed clock entries are not handled. (cl-macrolet ((next-timestamp () `(when (re-search-forward org-element--timestamp-regexp end-pos t) @@ -668,7 +679,7 @@ FROM, TO, and ON should be strings parseable by `parse-time-string' but may omit the time value." ;; TODO: DRY this with the clocked predicate. ;; NOTE: FROM and TO are actually expected to be Unix timestamps. The docstring is written - ;; for end users, for which the arguments are pre-processed by `org-ql-query'. + ;; for end users, for which the arguments are pre-processed by `org-ql-select'. ;; FIXME: This assumes every "clocked" entry is a range. Unclosed clock entries are not handled. (cl-macrolet ((next-timestamp () `(when (re-search-forward org-element--timestamp-regexp end-pos t) @@ -711,7 +722,7 @@ FROM, TO, and ON should be strings parseable by `parse-time-string' but may omit the time value." ;; TODO: DRY this with the clocked predicate. ;; NOTE: FROM and TO are actually expected to be Unix timestamps. The docstring is written - ;; for end users, for which the arguments are pre-processed by `org-ql-query'. + ;; for end users, for which the arguments are pre-processed by `org-ql-select'. ;; FIXME: This assumes every "clocked" entry is a range. Unclosed clock entries are not handled. (cl-macrolet ((next-timestamp () `(when (re-search-forward org-element--timestamp-regexp end-pos t) From 70176d9c5fff9917d392be4c19e3d32716d21055 Mon Sep 17 00:00:00 2001 From: Adam Porter Date: Wed, 24 Jul 2019 20:15:52 -0500 Subject: [PATCH 051/798] Add: Convert bare strings to (regexp) predicates --- README.org | 7 +++++-- org-ql.el | 18 ++++++++++++++++++ tests/test-org-ql.el | 38 +++++++++++++++++++++++++++++++++++++- 3 files changed, 60 insertions(+), 3 deletions(-) diff --git a/README.org b/README.org index cc68153..64c473b 100644 --- a/README.org +++ b/README.org @@ -103,6 +103,10 @@ Here's an example of using it to generate an agenda-like view for certain files A query is a lisp form which may contain arbitrary lisp forms, as well as certain built-in predicates. It is byte-compiled into a predicate function which is tested with point on each heading in an Org buffer; when it returns non-nil, the heading matches the query. +*Notes:* ++ Bare strings like ~"string"~ are automatically converted to ~(regexp "string")~ predicates. ++ Standard numeric comparator function symbols (~<~, ~<=~, ~>~, ~>=~, ~=~ ) need not be quoted when passed as an argument to these predicates. The resemblance to infix notation is coincidental. See examples in documentation. + *** Predicates :PROPERTIES: :TOC: ignore @@ -110,8 +114,6 @@ A query is a lisp form which may contain arbitrary lisp forms, as well as certai Arguments are listed next to predicate names, where applicable. -Note that, for convenience, standard numeric comparator function symbols (~<~, ~=~, etc.) do not need to be quoted when passed as an argument to these predicates. The resemblance to infix notation is coincidental. See examples in documentation. - + ~category (&optional categories)~ :: Return non-nil if current heading is in one or more of ~CATEGORIES~ (a list of strings). + ~clocked (&key from to on)~ :: Return non-nil if current entry was clocked in given period. If no arguments are specified, return non-nil if entry was clocked at any time. If ~FROM~, return non-nil if entry was clocked on or after ~FROM~. If ~TO~, return non-nil if entry was clocked on or before ~TO~. If ~ON~, return non-nil if entry was clocked on date ~ON~. ~FROM~, ~TO~, and ~ON~ should be strings parseable by ~parse-time-string~ but may omit the time value. Note: Clock entries are expected to be clocked out. Currently clocked entries (i.e. with unclosed timestamp ranges) are ignored. + ~closed (&optional comparator target-date)~ :: Return non-nil if entry's closed date compares with ~TARGET-DATE~ using ~COMPARATOR~. ~TARGET-DATE~ should be a string parseable by ~date-to-day~. ~COMPARATOR~ should be a function (like ~<=~). @@ -309,6 +311,7 @@ Expands into a call to ~org-ql-select~ with the same arguments. For convenience *Added* + Function ~org-ql-query~, like ~org-ql-select~ but with arguments named more like a SQL query. ++ Bare strings like ~"string"~ can be used in queries, which are converted to ~(regexp "string")~ automatically. *Changed* + Function ~org-ql-query~ renamed to ~org-ql-select~. diff --git a/org-ql.el b/org-ql.el index a680080..2abeaa3 100644 --- a/org-ql.el +++ b/org-ql.el @@ -150,6 +150,7 @@ non-nil." ;; a buffer if the filename doesn't exist. (find-file-noselect it)) (user-error "Can't open file: %s" it))))))) + (query (org-ql--pre-process-query query)) ((query preamble-re) (org-ql--query-preamble query)) (predicate (org-ql--query-predicate query)) (action (pcase action @@ -221,6 +222,23 @@ should be an `org-ql' query sexp." (org-ql-select from where :action select)) +(defun org-ql--pre-process-query (query) + "Return QUERY having been pre-processed. +Replaces bare strings with (regexp) selectors." + ;; This is unsophisticated, but it works. + (cl-labels ((rec (element) + (pcase element + (`(or . ,clauses) `(or ,@(mapcar #'rec clauses))) + (`(and . ,clauses) `(and ,@(mapcar #'rec clauses))) + (`(when ,condition . ,clauses) `(when ,(rec condition) + ,@(mapcar #'rec clauses))) + (`(unless ,condition . ,clauses) `(unless ,(rec condition) + ,@(mapcar #'rec clauses))) + ;; TODO: Combine (regexp) when appropriate (i.e. inside an OR, not an AND). + ((pred stringp) `(regexp ,element)) + (_ element)))) + (rec query))) + (defun org-ql--query-predicate (query) "Return predicate function for QUERY." (byte-compile `(lambda () diff --git a/tests/test-org-ql.el b/tests/test-org-ql.el index 0cb32e3..835b93b 100644 --- a/tests/test-org-ql.el +++ b/tests/test-org-ql.el @@ -38,10 +38,12 @@ (correct-sexp-p (pcase (car sexp) ('org-ql 'org-ql) ('org-ql--query-preamble 'query-preamble) + ('org-ql--pre-process-query t) (_ nil))) (result (pcase (car sexp) ('org-ql (org-ql-test--format-result--ql sexp)) ('org-ql--query-preamble (org-ql-test--format-result--query-preamble sexp)) + ('org-ql--pre-process-query (format "'%S" (eval sexp))) (_ nil)))) (insert " :to-equal " result) (user-error "Point must be after an `org-ql' form"))) @@ -107,6 +109,27 @@ Based on Buttercup macro `it'." (cl-loop while (re-search-forward org-heading-regexp nil t) sum 1))))) + (it "Query pre-processing" + (expect (org-ql--pre-process-query '(and "string1" "string2")) + :to-equal '(and (regexp "string1") (regexp "string2"))) + (expect (org-ql--pre-process-query '(or "string1" "string2")) + :to-equal '(or (regexp "string1") (regexp "string2"))) + (expect (org-ql--pre-process-query '(and (todo "TODO") + (or "string1" "string2"))) + :to-equal '(and (todo "TODO") (or (regexp "string1") (regexp "string2")))) + (expect (org-ql--pre-process-query '(when (todo "TODO") + (or "string1" "string2"))) + :to-equal '(when (todo "TODO") (or (regexp "string1") (regexp "string2")))) + (expect (org-ql--pre-process-query '(when "string-cond1" + (or "string1" "string2"))) + :to-equal '(when (regexp "string-cond1") (or (regexp "string1") (regexp "string2")))) + (expect (org-ql--pre-process-query '(when (and "string-cond1" "string-cond2") + (or "string1" "string2"))) + :to-equal '(when (and (regexp "string-cond1") (regexp "string-cond2")) (or (regexp "string1") (regexp "string2")))) + (expect (org-ql--pre-process-query '(unless (and "stringcondition1" "stringcond2") + (or "string1" "string2"))) + :to-equal '(unless (and (regexp "stringcondition1") (regexp "stringcond2")) (or (regexp "string1") (regexp "string2"))))) + (describe "Query compiling" ;; Okay, so it's not really "compiling," but it sounds fancy. :) @@ -337,7 +360,20 @@ Based on Buttercup macro `it'." (expect (org-ql test-buffer (regexp "Take over" "pizza") :sort todo - :action (org-ql-test-org-get-heading)) :to-equal '("Take over the universe" "Take over the world" "Take over Mars" "Take over the moon" "Order a pizza" "Get haircut")))) + :action (org-ql-test-org-get-heading)) + :to-equal '("Take over the universe" "Take over the world" "Take over Mars" "Take over the moon" "Order a pizza" "Get haircut"))) + (org-ql-it "with a plain string" + (expect (org-ql test-buffer + "Take over" + :sort todo + :action (org-ql-test-org-get-heading)) + :to-equal '("Take over the universe" "Take over the world" "Take over Mars" "Take over the moon" "Get haircut"))) + (org-ql-it "with two plain strings" + (expect (org-ql test-buffer + (or "Take over" "pizza") + :sort todo + :action (org-ql-test-org-get-heading)) + :to-equal '("Take over the universe" "Take over the world" "Take over Mars" "Take over the moon" "Order a pizza" "Get haircut")))) (describe "(todo)" (it "without arguments" From 3a9b32002e09a4d6e7c081e17c694132478aa698 Mon Sep 17 00:00:00 2001 From: Adam Porter Date: Wed, 24 Jul 2019 20:18:41 -0500 Subject: [PATCH 052/798] Docs: Clarify changelog entries --- README.org | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/README.org b/README.org index 64c473b..edb7054 100644 --- a/README.org +++ b/README.org @@ -312,12 +312,12 @@ Expands into a call to ~org-ql-select~ with the same arguments. For convenience *Added* + Function ~org-ql-query~, like ~org-ql-select~ but with arguments named more like a SQL query. + Bare strings like ~"string"~ can be used in queries, which are converted to ~(regexp "string")~ automatically. ++ Selector ~(regexp)~ accepts multiple regexps to test. ++ Macro ~org-ql~ and functions ~org-ql-query~ and ~org-ql-select~ now also accept a comparator function in their ~:sort~ argument. *Changed* -+ Function ~org-ql-query~ renamed to ~org-ql-select~. ++ Function ~org-ql-query~ renamed to ~org-ql-select~. ~org-ql-query~ now refers to a new function. + Macro ~org-ql~ no longer accepts a ~:markers~ argument. Instead, use argument ~:action element-with-markers~. See function ~org-ql-select~, which ~org-ql~ calls. -+ ~(regexp)~ selector accepts multiple regexps to test. -+ The ~:sort~ argument to ~org-ql~, ~org-ql-query~, etc. now also accepts a comparator function by which to sort items. *Fixed* + Handle date ranges in date-based selectors. (Thanks to [[https://github.com/codygman][Cody Goodman]], [[https://github.com/swflint][Samuel W. Flint]], and [[https://github.com/vikasrawal][Vikas Rawal]].) From 290e25509b2f17281195c5217ff9ad851d01ff63 Mon Sep 17 00:00:00 2001 From: Adam Porter Date: Wed, 24 Jul 2019 20:20:04 -0500 Subject: [PATCH 053/798] Tests: Use org-ql-it in more tests --- tests/test-org-ql.el | 14 +++++++------- 1 file changed, 7 insertions(+), 7 deletions(-) diff --git a/tests/test-org-ql.el b/tests/test-org-ql.el index 835b93b..ba30eec 100644 --- a/tests/test-org-ql.el +++ b/tests/test-org-ql.el @@ -351,12 +351,12 @@ Based on Buttercup macro `it'." :to-equal '("Learn universal sign language"))) (describe "(regexp)" - (it "with 1 argument" + (org-ql-it "with 1 argument" (expect (org-ql test-buffer (regexp "Take over") :sort todo :action (org-ql-test-org-get-heading)) :to-equal '("Take over the universe" "Take over the world" "Take over Mars" "Take over the moon" "Get haircut"))) - (it "with 2 arguments" + (org-ql-it "with 2 arguments" (expect (org-ql test-buffer (regexp "Take over" "pizza") :sort todo @@ -376,31 +376,31 @@ Based on Buttercup macro `it'." :to-equal '("Take over the universe" "Take over the world" "Take over Mars" "Take over the moon" "Order a pizza" "Get haircut")))) (describe "(todo)" - (it "without arguments" + (org-ql-it "without arguments" ;; FIXME: This returns an item that is done, which is incorrect. (expect (org-ql test-buffer (todo) :sort todo :action (org-ql-test-org-get-heading)) :to-equal '("Take over the universe" "Take over the world" "Skype with president of Antarctica" "Take over Mars" "Visit Mars" "Take over the moon" "Visit the moon" "Practice leaping tall buildings in a single bound" "Renew membership in supervillain club" "Learn universal sign language" "Order a pizza" "Get haircut" "Internet" "Spaceship lease" "Fix flux capacitor" "/r/emacs" "Shop for groceries" "Rewrite Emacs in Common Lisp" "Write a symphony"))) - (it "with 1 argument" + (org-ql-it "with 1 argument" ;; FIXME: Figure out why this takes >10x longer than the other (todo) tests, according to Buttercup. (expect (org-ql test-buffer (todo "WAITING") :sort todo :action (org-ql-test-org-get-heading)) :to-equal '("Visit the moon"))) - (it "with 2 arguments" + (org-ql-it "with 2 arguments" (expect (org-ql test-buffer (todo "WAITING" "SOMEDAY") :sort todo :action (org-ql-test-org-get-heading)) :to-equal '("Visit the moon" "Rewrite Emacs in Common Lisp" "Write a symphony")))) (describe "(ts)" - (it "without arguments" + (org-ql-it "without arguments" (expect (org-ql test-buffer (ts) :action (org-ql-test-org-get-heading)) :to-equal '("Test data" "Take over the universe" "Take over the world" "Skype with president of Antarctica" "Visit Mars" "Visit the moon" "Practice leaping tall buildings in a single bound" "Renew membership in supervillain club" "Learn universal sign language" "Order a pizza" "Get haircut" "Internet" "Spaceship lease" "Fix flux capacitor" "/r/emacs" "Shop for groceries" "Rewrite Emacs in Common Lisp"))) - (it ":from a timestamp" + (org-ql-it ":from a timestamp" ;; TODO: Figure out why these take longer than the other (ts) tests. (expect (org-ql test-buffer (ts :from "2017-01-01") From 81ef7adbcaee9a705716089118f66faf84d209f2 Mon Sep 17 00:00:00 2001 From: Adam Porter Date: Wed, 24 Jul 2019 20:21:06 -0500 Subject: [PATCH 054/798] Tests: Change description --- tests/test-org-ql.el | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/tests/test-org-ql.el b/tests/test-org-ql.el index ba30eec..67d92be 100644 --- a/tests/test-org-ql.el +++ b/tests/test-org-ql.el @@ -130,8 +130,7 @@ Based on Buttercup macro `it'." (or "string1" "string2"))) :to-equal '(unless (and (regexp "stringcondition1") (regexp "stringcond2")) (or (regexp "string1") (regexp "string2"))))) - (describe "Query compiling" - ;; Okay, so it's not really "compiling," but it sounds fancy. :) + (describe "Query optimizing" ;; TODO: Other predicates. From b5ccc3294ec7942fa6a7eb041208b2b28c23ecd6 Mon Sep 17 00:00:00 2001 From: Adam Porter Date: Thu, 25 Jul 2019 07:51:28 -0500 Subject: [PATCH 055/798] Fix: (--select) Don't iterate over every heading with preamble Oops, using "when" instead of "while" did outline-next-heading even when re-search-forward found no more matches. That unnecessarily slowed down some searches, negating almost all of the gains. --- org-ql.el | 9 +++++---- 1 file changed, 5 insertions(+), 4 deletions(-) diff --git a/org-ql.el b/org-ql.el index 2abeaa3..bb6e726 100644 --- a/org-ql.el +++ b/org-ql.el @@ -404,10 +404,11 @@ If NARROW is non-nil, buffer will not be widened." (goto-char (point-min)) (when (org-before-first-heading-p) (outline-next-heading)) - (cond (preamble-re (cl-loop when (and (when (re-search-forward preamble-re nil t) - (outline-back-to-heading 'invisible-ok) - t) - (funcall predicate)) + ;; `cl-loop' makes this double-while much clearer than the expanded form. + (cond (preamble-re (cl-loop while (and (when (re-search-forward preamble-re nil t) + (outline-back-to-heading 'invisible-ok) + t) + (funcall predicate)) collect (funcall action) while (outline-next-heading))) (t (cl-loop when (funcall predicate) From cc5756d00dab1613572339e7dbf3544ad23391cb Mon Sep 17 00:00:00 2001 From: Adam Porter Date: Thu, 25 Jul 2019 21:55:49 -0500 Subject: [PATCH 056/798] Add: (org-ql-agenda--header-line-format) Move code to new function --- org-ql-agenda.el | 38 +++++++++++++++++++++----------------- 1 file changed, 21 insertions(+), 17 deletions(-) diff --git a/org-ql-agenda.el b/org-ql-agenda.el index f17e069..0560edc 100644 --- a/org-ql-agenda.el +++ b/org-ql-agenda.el @@ -230,25 +230,9 @@ SORT: One or a list of `org-ql' sorting functions, like `date' or (setq-local org-ql-sort sort) (setq-local org-ql-narrow narrow) (setq-local org-ql-super-groups super-groups) + (setq-local header-line-format (org-ql-agenda--header-line-format buffers-files query)) ;; TODO: Derive a minor mode and set keymap there. (local-set-key "g" #'org-ql-search-refresh) - (let* ((query-formatted (format "%S" query)) - (query-formatted (propertize (org-ql-agenda--font-lock-string 'emacs-lisp-mode query-formatted) - 'help-echo query-formatted)) - (query-width (length query-formatted)) - (available-width (- (window-width) - (length "In: ") - (length "Query: ") - query-width 4)) - (buffers-files-formatted (format "%S" buffers-files)) - (buffers-files-formatted (propertize (->> buffers-files-formatted - (org-ql-agenda--font-lock-string 'emacs-lisp-mode) - (s-truncate available-width)) - 'help-echo buffers-files-formatted))) - (setq-local header-line-format (concat (propertize "Query: " 'face 'org-agenda-structure) - query-formatted " " - (propertize "In: " 'face 'org-agenda-structure) - buffers-files-formatted))) ;; Clear buffer, insert entries, etc. (erase-buffer) (insert entries) @@ -256,6 +240,26 @@ SORT: One or a list of `org-ql' sorting functions, like `date' or (org-agenda-finalize) (goto-char (point-min))))) +(defun org-ql-agenda--header-line-format (buffers-files query) + "Return header-line-format for BUFFERS-FILES and QUERY." + (let* ((query-formatted (format "%S" query)) + (query-formatted (propertize (org-ql-agenda--font-lock-string 'emacs-lisp-mode query-formatted) + 'help-echo query-formatted)) + (query-width (length query-formatted)) + (available-width (- (window-width) + (length "In: ") + (length "Query: ") + query-width 4)) + (buffers-files-formatted (format "%S" buffers-files)) + (buffers-files-formatted (propertize (->> buffers-files-formatted + (org-ql-agenda--font-lock-string 'emacs-lisp-mode) + (s-truncate available-width)) + 'help-echo buffers-files-formatted))) + (concat (propertize "Query: " 'face 'org-agenda-structure) + query-formatted " " + (propertize "In: " 'face 'org-agenda-structure) + buffers-files-formatted))) + (defun org-ql-agenda--font-lock-string (mode s) "Return string S font-locked according to MODE." ;; FIXME: Is this the proper way to do this? It works, but I feel like there must be a built-in way... From 5f60bed1ac44d74b900bf25f97d616b6646213e7 Mon Sep 17 00:00:00 2001 From: Adam Porter Date: Fri, 26 Jul 2019 02:12:11 -0500 Subject: [PATCH 057/798] Notes: Update bench macro --- notes.org | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/notes.org b/notes.org index 4a390fc..281f665 100644 --- a/notes.org +++ b/notes.org @@ -417,9 +417,9 @@ Also, maybe instead of having a single =date= selector, I should have =scheduled `(bench-multi-lets :times ,times :ensure-equal t :lets (("preamble" ((org-ql-use-preamble t))) ("no preamble" ((org-ql-use-preamble nil)))) - :forms ((,(prin1-to-string query) (org-ql-query ,file + :forms ((,(prin1-to-string query) (org-ql-select ,file ',query - :action (lambda () (org-get-heading t t))))))) + :action '(org-get-heading t t)))))) #+END_SRC *** =level= From 8a8b74f1412660515534157c5622009d6b3c06b3 Mon Sep 17 00:00:00 2001 From: Adam Porter Date: Fri, 26 Jul 2019 02:12:32 -0500 Subject: [PATCH 058/798] Add: (tags) Preamble and tests Only enabled when org-use-tag-inheritance is enabled. --- notes.org | 30 ++++++++++++++++++++++++++++++ org-ql.el | 8 ++++++++ tests/test-org-ql.el | 29 +++++++++++++++++++++++++++++ 3 files changed, 67 insertions(+) diff --git a/notes.org b/notes.org index 281f665..e9f1a14 100644 --- a/notes.org +++ b/notes.org @@ -436,6 +436,36 @@ Also, maybe instead of having a single =date= selector, I should have =scheduled | preamble: (level 1) | 1.34 | 0.562950 | 0 | 0 | | no preamble: (level 1) | slowest | 0.754050 | 0 | 0 | +*** =tags= + +If tag inheritance is enabled, we have to check tags on every heading. When it's disabled, we can search directly to headings with the given tags. + +#+BEGIN_SRC elisp + (let ((org-use-tag-inheritance t)) + (org-ql-preamble-bench :times 1 + :file "~/org/inbox.org" + :query (tags "Emacs"))) +#+END_SRC + +#+RESULTS: +| Form | x faster than next | Total runtime | # of GCs | Total GC runtime | +|-----------------------------+--------------------+---------------+----------+------------------| +| no preamble: (tags "Emacs") | 1.01 | 1.899647 | 0 | 0 | +| preamble: (tags "Emacs") | slowest | 1.921799 | 0 | 0 | + +#+BEGIN_SRC elisp + (let ((org-use-tag-inheritance nil)) + (org-ql-preamble-bench :times 1 + :file "~/org/inbox.org" + :query (tags "Emacs"))) +#+END_SRC + +#+RESULTS: +| Form | x faster than next | Total runtime | # of GCs | Total GC runtime | +|-----------------------------+--------------------+---------------+----------+------------------| +| preamble: (tags "Emacs") | 2.08 | 0.274555 | 0 | 0 | +| no preamble: (tags "Emacs") | slowest | 0.570116 | 0 | 0 | + ** Using =org-element-parse-buffer= This basically works, as a very basic kind of agenda view, but we can already see that it's much slower (at least, for single-day views) because =org-element-parse-buffer= is slow compared to the agenda code. diff --git a/org-ql.el b/org-ql.el index bb6e726..4c26b3c 100644 --- a/org-ql.el +++ b/org-ql.el @@ -338,6 +338,14 @@ replace the clause with a preamble." (`(level ,num) (setq org-ql-preamble (rx-to-string `(seq bol (repeat ,num "*") " ") t)) nil) + ((and `(tags . ,tags) (guard (not org-use-tag-inheritance))) + ;; When tag inheritance is disabled, we only consider direct tags, + ;; so we can search directly to headings containing one of the tags. + (setq org-ql-preamble (rx-to-string `(seq bol (1+ "*") (1+ space) (1+ not-newline) + ":" (or ,@tags) ":") + t)) + ;; Return nil, because we don't need to test the predicate. + nil) (`(and . ,rest) (let ((clauses (mapcar #'rec rest))) `(and ,@(-non-nil clauses)))) diff --git a/tests/test-org-ql.el b/tests/test-org-ql.el index 67d92be..9f7e5d8 100644 --- a/tests/test-org-ql.el +++ b/tests/test-org-ql.el @@ -393,6 +393,35 @@ Based on Buttercup macro `it'." :sort todo :action (org-ql-test-org-get-heading)) :to-equal '("Visit the moon" "Rewrite Emacs in Common Lisp" "Write a symphony")))) + (describe "(tags)" + (org-ql-it "without arguments" + (expect (org-ql test-buffer + (tags) + :action (org-ql-test-org-get-heading)) + :to-equal '("Take over the universe" "Take over the world" "Skype with president of Antarctica" "Take over Mars" "Visit Mars" "Take over the moon" "Visit the moon" "Practice leaping tall buildings in a single bound" "Renew membership in supervillain club" "Learn universal sign language" "Order a pizza" "Get haircut" "Internet" "Spaceship lease" "Fix flux capacitor" "/r/emacs" "Shop for groceries" "Rewrite Emacs in Common Lisp" "Write a symphony")) + (expect (org-ql test-buffer + (not (tags)) + :action (org-ql-test-org-get-heading)) + :to-equal '("Test data" "Recurring" "Sunrise/sunset" "Ideas" "Code" "Agenda examining" "Agenda censoring" "Auto grouping" "Auto categories" "Date" "Effort" "Misc" "let-plist" "Profiling"))) + (org-ql-it "with a tag" + (expect (org-ql test-buffer + (tags "Emacs") + :action (org-ql-test-org-get-heading)) + :to-equal '("/r/emacs" "Rewrite Emacs in Common Lisp")) + (expect (org-ql test-buffer + (not (tags "Emacs")) + :action (org-ql-test-org-get-heading)) + :to-equal '("Test data" "Take over the universe" "Take over the world" "Skype with president of Antarctica" "Take over Mars" "Visit Mars" "Take over the moon" "Visit the moon" "Practice leaping tall buildings in a single bound" "Renew membership in supervillain club" "Learn universal sign language" "Order a pizza" "Get haircut" "Internet" "Spaceship lease" "Fix flux capacitor" "Recurring" "Shop for groceries" "Sunrise/sunset" "Ideas" "Write a symphony" "Code" "Agenda examining" "Agenda censoring" "Auto grouping" "Auto categories" "Date" "Effort" "Misc" "let-plist" "Profiling"))) + (org-ql-it "with 2 tags" + (expect (org-ql test-buffer + (tags "Emacs" "space") + :action (org-ql-test-org-get-heading)) + :to-equal '("Visit Mars" "Visit the moon" "/r/emacs" "Rewrite Emacs in Common Lisp")) + (expect (org-ql test-buffer + (not (tags "Emacs" "space")) + :action (org-ql-test-org-get-heading)) + :to-equal '("Test data" "Take over the universe" "Take over the world" "Skype with president of Antarctica" "Take over Mars" "Take over the moon" "Practice leaping tall buildings in a single bound" "Renew membership in supervillain club" "Learn universal sign language" "Order a pizza" "Get haircut" "Internet" "Spaceship lease" "Fix flux capacitor" "Recurring" "Shop for groceries" "Sunrise/sunset" "Ideas" "Write a symphony" "Code" "Agenda examining" "Agenda censoring" "Auto grouping" "Auto categories" "Date" "Effort" "Misc" "let-plist" "Profiling")))) + (describe "(ts)" (org-ql-it "without arguments" (expect (org-ql test-buffer From f8a5dc353d62c66d18e9f8006df7eeb3d17e18c6 Mon Sep 17 00:00:00 2001 From: Adam Porter Date: Fri, 26 Jul 2019 02:13:32 -0500 Subject: [PATCH 059/798] Comment: Add/improve some comments --- org-ql.el | 11 +++++++---- 1 file changed, 7 insertions(+), 4 deletions(-) diff --git a/org-ql.el b/org-ql.el index 4c26b3c..1764efb 100644 --- a/org-ql.el +++ b/org-ql.el @@ -316,15 +316,17 @@ replace the clause with a preamble." (`(or _) element) (`(regexp . ,regexps) (setq org-ql-preamble (rx-to-string `(or ,@regexps) t)) - ;; Return nil + ;; Return nil, because we don't need to test the predicate. nil) (`(todo . ,(and todo-keywords (guard todo-keywords))) - ;; FIXME: With case-folding, a query like (todo "WAITING") - ;; can find a non-todo heading named "Waiting". + ;; FIXME: With case-folding, a query like (todo "WAITING") can find a non-todo + ;; heading named "Waiting". For correctness, we could test the predicate + ;; anyway, but that would negate some of the speed, and in most cases it + ;; probably won't matter, so I'm leaving it this way for now. (setq org-ql-preamble (rx-to-string `(seq bol (1+ "*") (1+ space) (or ,@todo-keywords) (or " " eol)) t)) - ;; Return nil + ;; Return nil, don't test the predicate. nil) (`(level ,comparator-or-num ,num) (let ((repeat (pcase comparator-or-num @@ -334,6 +336,7 @@ replace the clause with a preamble." ('>= `(>= ,num "*")) ((pred integerp) `(repeat ,comparator-or-num ,num "*"))))) (setq org-ql-preamble (rx-to-string `(seq bol ,repeat " ") t)) + ;; Return nil, because we don't need to test the predicate. nil)) (`(level ,num) (setq org-ql-preamble (rx-to-string `(seq bol (repeat ,num "*") " ") t)) From f8a9ae75e2ce7fae9d1be8240a2c56eb58e04dce Mon Sep 17 00:00:00 2001 From: Adam Porter Date: Fri, 26 Jul 2019 02:14:04 -0500 Subject: [PATCH 060/798] Notes: Add MAYBE --- notes.org | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/notes.org b/notes.org index e9f1a14..9694dd2 100644 --- a/notes.org +++ b/notes.org @@ -178,6 +178,10 @@ If your function needs to retrieve the tags including inherited tags at the *cur Because the existing ones only search the special date property line. +** MAYBE Fancier searching for inherited tags + +When tag inheritance is enabled, and the given tags aren't file-level tags, we could search directly to headings containing the matching tags, and then only do per-heading matching on the subtrees. Sometimes that would be much faster. However, that might make the logic special-cased and complicated. Might need a redesign of the whole matching/predicate system to do cleanly. + ** DONE Byte-compile lambdas CLOSED: [2018-05-09 Wed 17:30] :LOGBOOK: From 51af2a16a7944f1b902a7fcfb39ae4018da30330 Mon Sep 17 00:00:00 2001 From: Adam Porter Date: Fri, 26 Jul 2019 02:18:21 -0500 Subject: [PATCH 061/798] Tests: Turn on truncate-lines and add to comment --- tests/test-org-ql.el | 7 ++++++- 1 file changed, 6 insertions(+), 1 deletion(-) diff --git a/tests/test-org-ql.el b/tests/test-org-ql.el index 9f7e5d8..1a01be9 100644 --- a/tests/test-org-ql.el +++ b/tests/test-org-ql.el @@ -382,7 +382,8 @@ Based on Buttercup macro `it'." :sort todo :action (org-ql-test-org-get-heading)) :to-equal '("Take over the universe" "Take over the world" "Skype with president of Antarctica" "Take over Mars" "Visit Mars" "Take over the moon" "Visit the moon" "Practice leaping tall buildings in a single bound" "Renew membership in supervillain club" "Learn universal sign language" "Order a pizza" "Get haircut" "Internet" "Spaceship lease" "Fix flux capacitor" "/r/emacs" "Shop for groceries" "Rewrite Emacs in Common Lisp" "Write a symphony"))) (org-ql-it "with 1 argument" - ;; FIXME: Figure out why this takes >10x longer than the other (todo) tests, according to Buttercup. + ;; FIXME: Figure out why this takes >10x longer than the other (todo) + ;; tests, according to Buttercup. Might just be GC, though. (expect (org-ql test-buffer (todo "WAITING") :sort todo @@ -457,4 +458,8 @@ Based on Buttercup macro `it'." :action (org-ql-test-org-get-heading)) :to-equal nil))))) +;; Local Variables: +;; truncate-lines: t +;; End: + ;;; org-ql.el ends here From 7e5cb3303114062050bcee139c7c52b7c57421cc Mon Sep 17 00:00:00 2001 From: Adam Porter Date: Thu, 8 Aug 2019 08:28:10 -0500 Subject: [PATCH 062/798] Tests: Require buttercup Makes it easier to run interactively by eval'ing the buffer. --- tests/test-org-ql.el | 2 ++ 1 file changed, 2 insertions(+) diff --git a/tests/test-org-ql.el b/tests/test-org-ql.el index 1a01be9..9acca2d 100644 --- a/tests/test-org-ql.el +++ b/tests/test-org-ql.el @@ -25,6 +25,8 @@ ;;;; Requirements +(require 'buttercup) + (require 'org-ql) ;;;; Variables From 4db4e411a0b2b4beb10c552dbdee4ec28b1334dc Mon Sep 17 00:00:00 2001 From: Adam Porter Date: Thu, 8 Aug 2019 08:28:40 -0500 Subject: [PATCH 063/798] Tests: Fix function definer Works correctly interactively now. --- tests/test-org-ql.el | 13 +++++++------ 1 file changed, 7 insertions(+), 6 deletions(-) diff --git a/tests/test-org-ql.el b/tests/test-org-ql.el index 9acca2d..afd2b02 100644 --- a/tests/test-org-ql.el +++ b/tests/test-org-ql.el @@ -97,12 +97,13 @@ Based on Buttercup macro `it'." (before-all - (defun org-ql-test-org-get-heading () - ;; For Org 9.0.5. - (substring-no-properties (org-get-heading t t))) - (defun org-ql-test-org-get-heading () - ;; For Org 9.1.9. - (substring-no-properties (org-get-heading t t t t))) + (if (version< (org-version) "9.1") + (defun org-ql-test-org-get-heading () + ;; For Org 9.0.5. + (substring-no-properties (org-get-heading t t))) + (defun org-ql-test-org-get-heading () + ;; For Org 9.1.9. + (substring-no-properties (org-get-heading t t t t)))) (setq test-buffer (find-file-noselect (concat default-directory "tests/data.org")) num-headings (with-current-buffer test-buffer From c4531b25a44e574a97af55840bba556f58983585 Mon Sep 17 00:00:00 2001 From: Adam Porter Date: Thu, 8 Aug 2019 08:29:26 -0500 Subject: [PATCH 064/798] Fix: Compound queries with preamble Bug was introduced in b5ccc32. --- org-ql.el | 9 ++++----- tests/test-org-ql.el | 11 ++++++++++- 2 files changed, 14 insertions(+), 6 deletions(-) diff --git a/org-ql.el b/org-ql.el index 1764efb..3c323d2 100644 --- a/org-ql.el +++ b/org-ql.el @@ -416,12 +416,11 @@ If NARROW is non-nil, buffer will not be widened." (when (org-before-first-heading-p) (outline-next-heading)) ;; `cl-loop' makes this double-while much clearer than the expanded form. - (cond (preamble-re (cl-loop while (and (when (re-search-forward preamble-re nil t) - (outline-back-to-heading 'invisible-ok) - t) - (funcall predicate)) + (cond (preamble-re (cl-loop while (re-search-forward preamble-re nil t) + do (outline-back-to-heading 'invisible-ok) + when (funcall predicate) collect (funcall action) - while (outline-next-heading))) + do (outline-next-heading))) (t (cl-loop when (funcall predicate) collect (funcall action) while (outline-next-heading))))))) diff --git a/tests/test-org-ql.el b/tests/test-org-ql.el index afd2b02..0925ba6 100644 --- a/tests/test-org-ql.el +++ b/tests/test-org-ql.el @@ -459,7 +459,16 @@ Based on Buttercup macro `it'." (expect (org-ql test-buffer (ts :on "2019-06-09") :action (org-ql-test-org-get-heading)) - :to-equal nil))))) + :to-equal nil))) + + (describe "Compound queries" + + (org-ql-it "Tags and to-do" + (expect (org-ql test-buffer + (and (todo "SOMEDAY") + (tags "Emacs")) + :action (org-ql-test-org-get-heading)) + :to-equal '("Rewrite Emacs in Common Lisp")))))) ;; Local Variables: ;; truncate-lines: t From b7932063a0a8170eb9b0326c35c20f4495f5c8d9 Mon Sep 17 00:00:00 2001 From: Adam Porter Date: Thu, 8 Aug 2019 08:30:53 -0500 Subject: [PATCH 065/798] Fix: (org-ql-agenda--format-element) Extra indentation --- org-ql-agenda.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/org-ql-agenda.el b/org-ql-agenda.el index 0560edc..79dda2e 100644 --- a/org-ql-agenda.el +++ b/org-ql-agenda.el @@ -352,7 +352,7 @@ Its property list should be the second item in the list, as returned by `org-ele (due-string (pcase (org-element-property :relative-due-date element) ('nil "") (string (format " %s " (org-add-props string nil 'face 'underline))))) - (string (s-join " " (list todo-keyword priority-string title due-string tag-string)))) + (string (s-join " " (-non-nil (list todo-keyword priority-string title due-string tag-string))))) (remove-list-of-text-properties 0 (length string) '(line-prefix) string) ;; Add all the necessary properties and faces to the whole string (--> string From d37f7c3eeade3a8db91c76ef75ba8dcb15440f29 Mon Sep 17 00:00:00 2001 From: Adam Porter Date: Thu, 8 Aug 2019 09:03:10 -0500 Subject: [PATCH 066/798] Fix: (org-ql-agenda--agenda) Don't overwrite org-agenda-mode-map --- README.org | 1 + org-ql-agenda.el | 5 +++-- 2 files changed, 4 insertions(+), 2 deletions(-) diff --git a/README.org b/README.org index edb7054..a12c93f 100644 --- a/README.org +++ b/README.org @@ -321,6 +321,7 @@ Expands into a call to ~org-ql-select~ with the same arguments. For convenience *Fixed* + Handle date ranges in date-based selectors. (Thanks to [[https://github.com/codygman][Cody Goodman]], [[https://github.com/swflint][Samuel W. Flint]], and [[https://github.com/vikasrawal][Vikas Rawal]].) ++ Don't overwrite bindings in =org-agenda-mode-map=. *Compatibility* + Fixes for compatibility with Org 9.2. (Thanks to [[https://github.com/ataias][Ataias Pereira Reis]] and [[https://github.com/dakra][Daniel Kraus]].) diff --git a/org-ql-agenda.el b/org-ql-agenda.el index 79dda2e..1bdcb6e 100644 --- a/org-ql-agenda.el +++ b/org-ql-agenda.el @@ -222,8 +222,11 @@ SORT: One or a list of `org-ql' sorting functions, like `date' or (string (org-ql-agenda--buffer buffer)) (null (org-ql-agenda--buffer buffer)) (buffer buffer))) + (map (copy-keymap org-agenda-mode-map)) (inhibit-read-only t)) + (define-key map "g" #'org-ql-search-refresh) (with-current-buffer buffer + (use-local-map map) ;; Prepare buffer, saving data for refreshing. (setq-local org-ql-buffers-files buffers-files) (setq-local org-ql-query query) @@ -231,8 +234,6 @@ SORT: One or a list of `org-ql' sorting functions, like `date' or (setq-local org-ql-narrow narrow) (setq-local org-ql-super-groups super-groups) (setq-local header-line-format (org-ql-agenda--header-line-format buffers-files query)) - ;; TODO: Derive a minor mode and set keymap there. - (local-set-key "g" #'org-ql-search-refresh) ;; Clear buffer, insert entries, etc. (erase-buffer) (insert entries) From bd56652c6607d9852ebaa629e6850aaf867c99b0 Mon Sep 17 00:00:00 2001 From: Adam Porter Date: Thu, 8 Aug 2019 09:34:05 -0500 Subject: [PATCH 067/798] Add: org-ql-block Usable as an Org Agenda custom command block type. Inspired by @pestctrl's custom config: https://github.com/pestctrl/emacs-config/blob/84c557982a860e86d6f67976a82ea776a7bd2c7a/config-org-new.org#my-own-agenda-renderer --- README.org | 29 +++++++++++++++++++++++++++-- org-ql-agenda.el | 27 +++++++++++++++++++++++++++ 2 files changed, 54 insertions(+), 2 deletions(-) diff --git a/README.org b/README.org index a12c93f..cc371be 100644 --- a/README.org +++ b/README.org @@ -59,11 +59,11 @@ More examples are available in [[examples.org]]. The functionality provided may be grouped by: + Interactive commands :: ~org-ql-search~ -+ Non-interactive functions and macros :: ~org-ql~ (macro), ~org-ql-select~ (function), ~org-ql-query~ (function), and ~org-ql-agenda~ (macro) ++ Non-interactive functions and macros :: ~org-ql~ (macro), ~org-ql-select~ (function), ~org-ql-query~ (function), ~org-ql-block~ (agenda function), and ~org-ql-agenda~ (macro) Alternatively, they may be grouped by: -+ Showing an agenda-like view :: ~org-ql-search~ (command), and ~org-ql-agenda~ (macro) ++ Showing an agenda-like view :: ~org-ql-search~ (command), ~org-ql-block~ (agenda function), and ~org-ql-agenda~ (macro) + Returning a list of matches or acting on them :: ~org-ql~ (macro), ~org-ql-select~ (function), and ~org-ql-query~ (function) Feedback on these APIs is welcome. Eventually, after being tested and polished, they will be considered stable. @@ -141,6 +141,30 @@ Arguments are listed next to predicate names, where applicable. *** Agenda-like views +**** Function: ~org-ql-block~ + +For use as a custom agenda block type in ~org-agenda-custom-commands~. For example, you could define a custom series command like this, which would list all priority A items tagged =Emacs= with to-do keyword =SOMEDAY=, followed by the standard agenda view, in a single buffer: + +#+BEGIN_SRC elisp + (setq org-agenda-custom-commands + '(("ces" "Custom: Agenda and Emacs SOMEDAY [#A] items" + ((org-ql-block '(and (todo "SOMEDAY") + (tags "Emacs") + (priority "A"))) + (agenda))))) +#+END_SRC + +Which would be equivalent to a ~tags-todo~ search like this: + +#+BEGIN_SRC elisp + (setq org-agenda-custom-commands + '(("ces" "Custom: Agenda and Emacs SOMEDAY [#A] items" + ((tags-todo "PRIORITY=\"A\"+Emacs/!SOMEDAY") + (agenda))))) +#+END_SRC + +However, the ~org-ql-block~ version runs in about 1/5th the time. + **** Macro: ~org-ql-agenda~ This macro is like ~org-ql~, but it presents matching entries in an Agenda-like view. It's compatible with [[https://github.com/alphapapa/org-super-agenda][org-super-agenda]], which provides grouping. For example: @@ -314,6 +338,7 @@ Expands into a call to ~org-ql-select~ with the same arguments. For convenience + Bare strings like ~"string"~ can be used in queries, which are converted to ~(regexp "string")~ automatically. + Selector ~(regexp)~ accepts multiple regexps to test. + Macro ~org-ql~ and functions ~org-ql-query~ and ~org-ql-select~ now also accept a comparator function in their ~:sort~ argument. ++ Function ~org-ql-block~, which works as an Org Agenda series/composite/block command, usable in custom agenda commands defined in variable ~org-agenda-custom-commands~. (Inspired by [[https://github.com/pestctrl/emacs-config/blob/84c557982a860e86d6f67976a82ea776a7bd2c7a/config-org-new.org#my-own-agenda-renderer][Benson Chu's config]].) *Changed* + Function ~org-ql-query~ renamed to ~org-ql-select~. ~org-ql-query~ now refers to a new function. diff --git a/org-ql-agenda.el b/org-ql-agenda.el index 1bdcb6e..227ea7d 100644 --- a/org-ql-agenda.el +++ b/org-ql-agenda.el @@ -241,6 +241,33 @@ SORT: One or a list of `org-ql' sorting functions, like `date' or (org-agenda-finalize) (goto-char (point-min))))) +(defun org-ql-agenda-block (query) + "Insert items for QUERY into current buffer. +QUERY should be an `org-ql' query form. Like other agenda block +commands, it searches files returned by function +`org-agenda-files'. Intended to be used as a user-defined +function in `org-agenda-custom-commands'. QUERY corresponds to +the `match' item in the custom command form." + (when-let* ((from (org-agenda-files nil 'ifmode)) + (items (org-ql-select from + query :action 'element-with-markers))) + ;; Not sure if calling the prepare function is necessary, but let's follow the pattern. + (org-agenda-prepare) + ;; FIXME: `org-agenda--insert-overriding-header' is from an Org version newer than + ;; I'm using. Should probably declare it as a minimum Org version after upgrading. + ;; (org-agenda--insert-overriding-header (org-ql-agenda--header-line-format from query)) + (insert (org-add-props (org-ql-agenda--header-line-format from query) + nil 'face 'org-agenda-structure) "\n") + ;; Calling `org-agenda-finalize' should be unnecessary, because in a "series" agenda, + ;; `org-agenda-multi' is bound non-nil, in which case `org-agenda-finalize' does nothing. + ;; But we do call `org-agenda-finalize-entries', which allows `org-super-agenda' to work. + (->> items + (-map #'org-ql-agenda--format-element) + org-agenda-finalize-entries + insert))) + +(defalias 'org-ql-block 'org-ql-agenda-block) + (defun org-ql-agenda--header-line-format (buffers-files query) "Return header-line-format for BUFFERS-FILES and QUERY." (let* ((query-formatted (format "%S" query)) From 43545482a4121fa564caaea00cbdffcddd22cfc5 Mon Sep 17 00:00:00 2001 From: Adam Porter Date: Thu, 8 Aug 2019 09:44:02 -0500 Subject: [PATCH 068/798] Docs: Add example --- README.org | 9 +++++++++ 1 file changed, 9 insertions(+) diff --git a/README.org b/README.org index cc371be..946ed9c 100644 --- a/README.org +++ b/README.org @@ -52,6 +52,15 @@ More examples are available in [[examples.org]]. (and (property "genre" "classical") (property "composer" "Chopin") (not (property "key")))) + + ;; Define a custom Org Agenda command which inserts an `org-ql-block' + ;; block before the regular agenda: + (setq org-agenda-custom-commands + '(("ces" "Custom: Agenda and Emacs SOMEDAY [#A] items" + ((org-ql-block '(and (todo "SOMEDAY") + (tags "Emacs") + (priority "A"))) + (agenda))))) #+END_SRC * Usage From 7829238988023c7260072d68d07f3bcf6341d242 Mon Sep 17 00:00:00 2001 From: Adam Porter Date: Thu, 8 Aug 2019 10:36:57 -0500 Subject: [PATCH 069/798] Add: (org-ql-agenda--agenda) Optionally specify entries directly Should probably refactor this a bit more, but this is useful now. --- README.org | 1 + org-ql-agenda.el | 28 +++++++++++++++------------- 2 files changed, 16 insertions(+), 13 deletions(-) diff --git a/README.org b/README.org index 946ed9c..83a2fa7 100644 --- a/README.org +++ b/README.org @@ -348,6 +348,7 @@ Expands into a call to ~org-ql-select~ with the same arguments. For convenience + Selector ~(regexp)~ accepts multiple regexps to test. + Macro ~org-ql~ and functions ~org-ql-query~ and ~org-ql-select~ now also accept a comparator function in their ~:sort~ argument. + Function ~org-ql-block~, which works as an Org Agenda series/composite/block command, usable in custom agenda commands defined in variable ~org-agenda-custom-commands~. (Inspired by [[https://github.com/pestctrl/emacs-config/blob/84c557982a860e86d6f67976a82ea776a7bd2c7a/config-org-new.org#my-own-agenda-renderer][Benson Chu's config]].) ++ Function ~org-ql-agenda--agenda~ optionally takes a list of entries as an argument. *Changed* + Function ~org-ql-query~ renamed to ~org-ql-select~. ~org-ql-query~ now refers to a new function. diff --git a/org-ql-agenda.el b/org-ql-agenda.el index 227ea7d..73e734b 100644 --- a/org-ql-agenda.el +++ b/org-ql-agenda.el @@ -201,23 +201,25 @@ SORT: One or a list of `org-ql' sorting functions, like `date' or ;; TODO: Move the action-fn down into --filter-buffer, so users can avoid calling the ;; headline-parser when they don't need it. -(cl-defun org-ql-agenda--agenda (buffers-files query &key sort buffer narrow super-groups) +(cl-defun org-ql-agenda--agenda (buffers-files query &key entries sort buffer narrow super-groups) "FIXME: Docstring" (declare (indent defun)) (when (and super-groups (not org-super-agenda-mode)) (user-error "`org-super-agenda-mode' must be activated to use grouping")) (let* ((org-super-agenda-groups super-groups) - (entries (--> (org-ql-select buffers-files - query - :sort sort - :narrow narrow - :action (lambda () - (->> (org-element-headline-parser (line-end-position)) - org-ql--add-markers))) - (mapcar #'org-ql-agenda--format-element it) - (cond ((bound-and-true-p org-super-agenda-mode) (org-super-agenda--group-items it)) - (t it)) - (s-join "\n" it))) + (entries (or entries + (--> (org-ql-select buffers-files + query + :sort sort + :narrow narrow + :action (lambda () + (->> (org-element-headline-parser (line-end-position)) + org-ql--add-markers)))))) + (string (--> entries + (mapcar #'org-ql-agenda--format-element it) + (cond ((bound-and-true-p org-super-agenda-mode) (org-super-agenda--group-items it)) + (t it)) + (s-join "\n" it))) (buffer (cl-etypecase buffer (string (org-ql-agenda--buffer buffer)) (null (org-ql-agenda--buffer buffer)) @@ -236,7 +238,7 @@ SORT: One or a list of `org-ql' sorting functions, like `date' or (setq-local header-line-format (org-ql-agenda--header-line-format buffers-files query)) ;; Clear buffer, insert entries, etc. (erase-buffer) - (insert entries) + (insert string) (pop-to-buffer (current-buffer)) (org-agenda-finalize) (goto-char (point-min))))) From 4970d441cc2df69092fd3e87f14d3bcd17754e9b Mon Sep 17 00:00:00 2001 From: Adam Porter Date: Thu, 8 Aug 2019 10:52:33 -0500 Subject: [PATCH 070/798] Change: (org-ql-agenda--format-element) Return empty string if nil This allows mapping the function across elements which may be nil, helping to separate items in agenda views by inserting nil between them. --- org-ql-agenda.el | 134 ++++++++++++++++++++++++----------------------- 1 file changed, 69 insertions(+), 65 deletions(-) diff --git a/org-ql-agenda.el b/org-ql-agenda.el index 73e734b..5423887 100644 --- a/org-ql-agenda.el +++ b/org-ql-agenda.el @@ -326,72 +326,76 @@ dates in the past, and negative for dates in the future." ;; This essentially needs to do what `org-agenda-format-item' does, ;; which is a lot. We are a long way from that, but it's a start. "Return ELEMENT as a string with text-properties set by its property list. -Its property list should be the second item in the list, as returned by `org-element-parse-buffer'." - (let* ((properties (cadr element)) - ;; Remove the :parent property, which so bloats the size of - ;; the properties list that it makes it essentially - ;; impossible to debug, because Emacs takes approximately - ;; forever to show it in the minibuffer or with - ;; `describe-text-properties'. FIXME: Shouldn't be necessary - ;; anymore since we're not parsing the whole buffer. +Its property list should be the second item in the list, as +returned by `org-element-parse-buffer'. If ELEMENT is nil, +return an empty string." + (if (not element) + "" + (let* ((properties (cadr element)) + ;; Remove the :parent property, which so bloats the size of + ;; the properties list that it makes it essentially + ;; impossible to debug, because Emacs takes approximately + ;; forever to show it in the minibuffer or with + ;; `describe-text-properties'. FIXME: Shouldn't be necessary + ;; anymore since we're not parsing the whole buffer. - ;; Also, remove ":" from key symbols. FIXME: It would be - ;; better to avoid this somehow. At least, we should use a - ;; function to convert plists to alists, if possible. - (properties (cl-loop for (key val) on properties by #'cddr - for symbol = (intern (cl-subseq (symbol-name key) 1)) - unless (member symbol '(parent)) - append (list symbol val))) - ;; TODO: --add-faces is used to add the :relative-due-date property, but that fact is - ;; hidden by doing it through --add-faces (which calls --add-scheduled-face and - ;; --add-deadline-face), and doing it in this form that gets the title hides it even more. - ;; Adding the relative due date property should probably be done explicitly and separately - ;; (which would also make it easier to do it independently of faces, etc). - (title (--> (org-ql-agenda--add-faces element) - (org-element-property :raw-value it) - (org-link-display-format it))) - (todo-keyword (-some--> (org-element-property :todo-keyword element) - (org-ql-agenda--add-todo-face it))) - ;; FIXME: Figure out whether I should use `org-agenda-use-tag-inheritance' or `org-use-tag-inheritance', etc. - (tag-list (if org-use-tag-inheritance - ;; FIXME: Note that tag inheritance cannot be used here unless markers are - ;; added, otherwise we can't go to the item's buffer to look for inherited - ;; tags. (Or does `org-element-headline-parser' parse inherited tags too? I - ;; forget...) - (if-let ((marker (or (org-element-property :org-hd-marker element) - (org-element-property :org-marker element)))) - (with-current-buffer (marker-buffer marker) - ;; I wish `org-get-tags' used the correct buffer automatically. - (org-get-tags marker (not org-use-tag-inheritance))) - ;; No marker found - (warn "No marker found for item: %s" title) - (org-element-property :tags element)) - (org-element-property :tags element))) - (tag-string (-some--> tag-list - (s-join ":" it) - (s-wrap it ":") - (org-add-props it nil 'face 'org-tag))) - ;; (category (org-element-property :category element)) - (priority-string (-some->> (org-element-property :priority element) - (char-to-string) - (format "[#%s]") - (org-ql-agenda--add-priority-face))) - (habit-property (org-with-point-at (org-element-property :begin element) - (when (org-is-habit-p) - (org-habit-parse-todo)))) - (due-string (pcase (org-element-property :relative-due-date element) - ('nil "") - (string (format " %s " (org-add-props string nil 'face 'underline))))) - (string (s-join " " (-non-nil (list todo-keyword priority-string title due-string tag-string))))) - (remove-list-of-text-properties 0 (length string) '(line-prefix) string) - ;; Add all the necessary properties and faces to the whole string - (--> string - ;; FIXME: Use proper prefix - (concat " " it) - (org-add-props it properties - 'todo-state todo-keyword - 'tags tag-list - 'org-habit-p habit-property)))) + ;; Also, remove ":" from key symbols. FIXME: It would be + ;; better to avoid this somehow. At least, we should use a + ;; function to convert plists to alists, if possible. + (properties (cl-loop for (key val) on properties by #'cddr + for symbol = (intern (cl-subseq (symbol-name key) 1)) + unless (member symbol '(parent)) + append (list symbol val))) + ;; TODO: --add-faces is used to add the :relative-due-date property, but that fact is + ;; hidden by doing it through --add-faces (which calls --add-scheduled-face and + ;; --add-deadline-face), and doing it in this form that gets the title hides it even more. + ;; Adding the relative due date property should probably be done explicitly and separately + ;; (which would also make it easier to do it independently of faces, etc). + (title (--> (org-ql-agenda--add-faces element) + (org-element-property :raw-value it) + (org-link-display-format it))) + (todo-keyword (-some--> (org-element-property :todo-keyword element) + (org-ql-agenda--add-todo-face it))) + ;; FIXME: Figure out whether I should use `org-agenda-use-tag-inheritance' or `org-use-tag-inheritance', etc. + (tag-list (if org-use-tag-inheritance + ;; FIXME: Note that tag inheritance cannot be used here unless markers are + ;; added, otherwise we can't go to the item's buffer to look for inherited + ;; tags. (Or does `org-element-headline-parser' parse inherited tags too? I + ;; forget...) + (if-let ((marker (or (org-element-property :org-hd-marker element) + (org-element-property :org-marker element)))) + (with-current-buffer (marker-buffer marker) + ;; I wish `org-get-tags' used the correct buffer automatically. + (org-get-tags marker (not org-use-tag-inheritance))) + ;; No marker found + (warn "No marker found for item: %s" title) + (org-element-property :tags element)) + (org-element-property :tags element))) + (tag-string (-some--> tag-list + (s-join ":" it) + (s-wrap it ":") + (org-add-props it nil 'face 'org-tag))) + ;; (category (org-element-property :category element)) + (priority-string (-some->> (org-element-property :priority element) + (char-to-string) + (format "[#%s]") + (org-ql-agenda--add-priority-face))) + (habit-property (org-with-point-at (org-element-property :begin element) + (when (org-is-habit-p) + (org-habit-parse-todo)))) + (due-string (pcase (org-element-property :relative-due-date element) + ('nil "") + (string (format " %s " (org-add-props string nil 'face 'underline))))) + (string (s-join " " (-non-nil (list todo-keyword priority-string title due-string tag-string))))) + (remove-list-of-text-properties 0 (length string) '(line-prefix) string) + ;; Add all the necessary properties and faces to the whole string + (--> string + ;; FIXME: Use proper prefix + (concat " " it) + (org-add-props it properties + 'todo-state todo-keyword + 'tags tag-list + 'org-habit-p habit-property))))) (defun org-ql-agenda--add-faces (element) "Return ELEMENT with deadline and scheduled faces added." From d9b7647f5bc16973d48efada987669c52e7c7221 Mon Sep 17 00:00:00 2001 From: Adam Porter Date: Thu, 8 Aug 2019 15:25:07 -0500 Subject: [PATCH 071/798] Meta: Add .gitignore --- .gitignore | 4 ++++ 1 file changed, 4 insertions(+) create mode 100644 .gitignore diff --git a/.gitignore b/.gitignore new file mode 100644 index 0000000..e5e85fc --- /dev/null +++ b/.gitignore @@ -0,0 +1,4 @@ +*.elc +.#* +/scratch.el +.cask From 2dbe40d9ead5d3d6038ca5898431eae190b50144 Mon Sep 17 00:00:00 2001 From: Adam Porter Date: Thu, 8 Aug 2019 15:28:36 -0500 Subject: [PATCH 072/798] Fix: (org-ql-select) Accept special forms and macros in action --- org-ql.el | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/org-ql.el b/org-ql.el index 3c323d2..e26ca94 100644 --- a/org-ql.el +++ b/org-ql.el @@ -165,7 +165,9 @@ non-nil." `(lambda (&rest _ignore) (org-element-headline-parser (line-end-position))))) ((pred functionp) action) - ((and (pred listp) (guard (functionp (car action)))) + ((and (pred listp) (guard (or (special-form-p (car action)) + (macrop (car action)) + (functionp (car action))))) (byte-compile `(lambda (&rest _ignore) ,action))) From 00d9bbd85beb5a213176b991164cf188ed828a79 Mon Sep 17 00:00:00 2001 From: Adam Porter Date: Thu, 8 Aug 2019 15:29:53 -0500 Subject: [PATCH 073/798] Tests: Add makem.sh, update Makefile --- Makefile | 25 ++- makem.sh | 539 +++++++++++++++++++++++++++++++++++++++++++++++++++++++ 2 files changed, 561 insertions(+), 3 deletions(-) create mode 100755 makem.sh diff --git a/Makefile b/Makefile index d5edecf..4883294 100644 --- a/Makefile +++ b/Makefile @@ -1,4 +1,23 @@ -.PHONY: test +# * Verbosity -test: - cask exec buttercup -L . +# Since the "-v" in "make -v" gets intercepted by Make itself, we have +# to use a variable. + +verbose = $(v) + +ifneq (,$(findstring vv,$(verbose))) + VERBOSE = "-vv" +else ifneq (,$(findstring v,$(verbose))) + VERBOSE = "-v" +endif + +# * Rules + +# Unless/until I add Cask support to makem.sh, I'm keeping this, +# because Cask lets me run the tests with a different version of Org +# than I have installed personally. +cask: + @cask exec buttercup -L . + +%: + @./makem.sh $(VERBOSE) $(@) diff --git a/makem.sh b/makem.sh new file mode 100755 index 0000000..909d9eb --- /dev/null +++ b/makem.sh @@ -0,0 +1,539 @@ +#!/bin/bash + +# * makem.sh --- Script to aid building and testing Emacs Lisp packages + +# * Commentary: + + +# * License: + +# 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 +# the Free Software Foundation, either version 3 of the License, or +# (at your option) any later version. + +# This program is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +# GNU General Public License for more details. + +# You should have received a copy of the GNU General Public License +# along with this program. If not, see . + +# * Safety + +# NOTE: These are disabled by default in this template but should be +# enabled when feasible. Documentation is from the Bash man page. + +# ** errexit + +# Exit immediately if a pipeline (which may consist of a single simple +# command), a list, or a compound command (see SHELL GRAMMAR above), +# exits with a non-zero status. The shell does not exit if the +# command that fails is part of the command list immediately following +# a while or until keyword, part of the test following the if or elif +# reserved words, part of any command executed in a && or || list +# except the command follow‐ ing the final && or ||, any command in a +# pipeline but the last, or if the command's return value is being +# inverted with !. If a compound command other than a subshell +# returns a non-zero status because a command failed while -e was +# being ignored, the shell does not exit. A trap on ERR, if set, is +# executed before the shell exits. This option applies to the shell +# environment and each subshell environment separately (see COMMAND +# EXECUTION ENVIRONMENT above), and may cause subshells to exit before +# executing all the commands in the subshell. + +# If a compound command or shell function executes in a context where +# -e is being ignored, none of the commands executed within the +# compound command or function body will be affected by the -e +# setting, even if -e is set and a command returns a failure status. +# If a compound command or shell function sets -e while executing in a +# context where -e is ignored, that setting will not have any effect +# until the compound command or the command containing the function +# call completes. + +# set -o errexit + +# ** nounset + +# Treat unset variables and parameters other than the special +# parameters "@" and "*" as an error when performing parameter +# expansion. If expansion is attempted on an unset variable or +# parameter, the shell prints an error message, and, if not +# interactive, exits with a non-zero status. + +# NOTE: When this is not enabled, individual variables can be required +# to be set by using "${var:?}" parameter expansion syntax. + +# set -o nounset + +# ** pipefail + +# If set, the return value of a pipeline is the value of the last +# (rightmost) command to exit with a non-zero status, or zero if all +# commands in the pipeline exit successfully. This option is disabled +# by default. + +# set -o pipefail + +# * Elisp + +# These functions return a path to an elisp file which can be loaded +# by Emacs on the command line with -l or --load. + +function elisp-buttercup-file { + # The function buttercup-run, which is called by buttercup-run-discover, + # signals an error if it can't find any Buttercup test suites. We don't + # want that to be an error, so we define advice which ignores that error. + local file=$(mktemp) + cat >$file <$file <$file <$output_file + + exit=$? + [[ $exit != 0 ]] && debug "Emacs exited non-zero: $exit" + if [[ $verbose -gt 1 || $exit != 0 ]] + then + cat $output_file + fi + rm -f $output_file + + return $exit +} + +# ** Compilation + +function batch-byte-compile { + debug "batch-byte-compile: ERROR-ON-WARN:$compile_error_on_warn FILES:$@" + + [[ $compile_error_on_warn ]] && local error_on_warn=(--eval "(setq byte-compile-error-on-warn t)") + + run_emacs \ + "${error_on_warn[@]}" \ + --funcall batch-byte-compile \ + "$@" +} + +# ** Files + +function project-elisp-files { + # Echo list of Elisp files in project. + git ls-files 2>/dev/null | egrep "\.el$" | exclude-files +} + +function project-source-files { + # Echo list of Elisp files that are not tests. + project-elisp-files | egrep -v '^tests?/test-?' +} + +function project-test-files { + # Echo list of Elisp test files. + project-elisp-files | egrep '^tests?/test-?' +} + +function exclude-files { + # Filter out paths (STDIN) which should be excluded by default. + egrep -v "(/\.cask/|-autoloads.el)" +} + +function load-files-args { + # For file in $@, echo "--load $file". + for file in "$@" + do + printf -- '--load %q ' "$file" + done +} + +function files_args { + # For file in STDIN, echo "$file". + while read file + do + printf -- '%q ' "$file" + done +} + +# ** Utility + +function cleanup { + # Remove temporary paths (${temp_paths[@]}). + + for path in "${temp_paths[@]}" + do + if [[ $debug ]] + then + debug "Debugging enabled: not deleting temporary path: $path" + elif [[ -r $path ]] + then + rm -rf "$path" + else + debug "Temporary path doesn't exist, not deleting: $path" + fi + done +} + +function echo_color { + # This allows bold, italic, etc. without needing a function for + # each variation. + if [[ $color ]] + then + local color_code="COLOR_$1" + shift + + echo -e "${!color_code}${@}${COLOR_off}" + else + echo "$@" + fi +} +function debug { + if [[ $debug ]] + then + function debug { + echo_color yellow "DEBUG ($(ts)): $@" >&2 + } + debug "$@" + else + function debug { + true + } + fi +} +function error { + echo_color red "ERROR ($(ts)): $@" >&2 + ((errors++)) +} +function die { + error "$@" + exit $errors +} +function log { + echo "LOG ($(ts)): $@" >&2 +} +function log_color { + local color=$1 + shift + echo_color $color "LOG ($(ts)): $@" >&2 +} +function success { + if [[ $verbose -ge 2 ]] + then + log_color green "$@" >&2 + fi +} +function verbose { + # $1 is the verbosity level, rest are echoed when appropriate. + if [[ $verbose -ge $1 ]] + then + [[ $1 -eq 1 ]] && local color=blue + [[ $1 -ge 2 ]] && local color=cyan + + shift + log_color $color "$@" >&2 + fi +} + +function ts { + date "+%Y-%m-%d %H:%M:%S" +} + +function usage { + cat </dev/null | grep "$rule is a function" &>/dev/null + then + $rule + elif [[ $rule = test ]] + then + # Allow the "tests" rule to be called as "test". Since "test" + # is a shell builtin, this workaround is required. + tests + else + error "Invalid rule: $rule" + fi +done + +if [[ $errors -gt 0 ]] +then + log_color red "Finished with $errors errors." +else + success "Finished without errors." +fi + +exit $errors From cc92fccb7fcd45b7243eda73e80ed26995a93b8b Mon Sep 17 00:00:00 2001 From: Adam Porter Date: Thu, 8 Aug 2019 17:07:25 -0500 Subject: [PATCH 074/798] Test: Simplify with org-ql-expect macro --- tests/test-org-ql.el | 418 ++++++++++++++++++------------------------- 1 file changed, 172 insertions(+), 246 deletions(-) diff --git a/tests/test-org-ql.el b/tests/test-org-ql.el index 0925ba6..5995e1a 100644 --- a/tests/test-org-ql.el +++ b/tests/test-org-ql.el @@ -91,6 +91,16 @@ Based on Buttercup macro `it'." ,@body)))) `(buttercup-xit ,description))) +(defmacro org-ql-expect (ql-args results) + "Expand to `expect' test form that expects QL-ARGS to equal RESULTS. +RESULTS should be a list of strings as returned by +`org-ql-test-org-get-heading'." + (declare (indent defun)) + `(expect (org-ql test-buffer + ,@ql-args + :action (org-ql-test-org-get-heading)) + :to-equal ,results)) + ;;;; Tests (describe "org-ql" @@ -162,313 +172,229 @@ Based on Buttercup macro `it'." ;; TODO: Other predicates. (describe "(category)" + (org-ql-it "without arguments" (expect (length (org-ql test-buffer - (category) - :action (org-ql-test-org-get-heading))) + (category))) :to-equal num-headings)) + (org-ql-it "with a category" - (expect (org-ql test-buffer - (category "ambition") - :action (org-ql-test-org-get-heading)) - :to-equal '("Take over the universe" "Take over the world" "Skype with president of Antarctica" "Take over Mars" "Visit Mars" "Take over the moon" "Visit the moon" "Practice leaping tall buildings in a single bound" "Renew membership in supervillain club" "Learn universal sign language")))) + (org-ql-expect ((category "ambition")) + '("Take over the universe" "Take over the world" "Skype with president of Antarctica" "Take over Mars" "Visit Mars" "Take over the moon" "Visit the moon" "Practice leaping tall buildings in a single bound" "Renew membership in supervillain club" "Learn universal sign language")))) (describe "(clocked)" + (org-ql-it "without arguments" - (expect (org-ql test-buffer - (clocked) - :action (org-ql-test-org-get-heading)) - :to-equal '("Learn universal sign language"))) + (org-ql-expect ((clocked)) + '("Learn universal sign language"))) + (org-ql-it ":from a timestamp" - (expect (org-ql test-buffer - (clocked :from "2017-07-05") - :action (org-ql-test-org-get-heading)) - :to-equal '("Learn universal sign language")) - (expect (org-ql test-buffer - (clocked :from "2017-07-06") - :action (org-ql-test-org-get-heading)) - :to-equal nil)) + (org-ql-expect ((clocked :from "2017-07-05")) + '("Learn universal sign language")) + (org-ql-expect ((clocked :from "2017-07-06")) + nil)) + (org-ql-it ":to a timestamp" - (expect (org-ql test-buffer - (clocked :to "2017-07-05") - :action (org-ql-test-org-get-heading)) - :to-equal '("Learn universal sign language")) - (expect (org-ql test-buffer - (clocked :to "2017-07-04") - :action (org-ql-test-org-get-heading)) - :to-equal nil)) + (org-ql-expect ((clocked :to "2017-07-05")) + '("Learn universal sign language")) + (org-ql-expect ((clocked :to "2017-07-04")) + nil)) + (org-ql-it ":on a date" - (expect (org-ql test-buffer - (clocked :on "2017-07-05") - :action (org-ql-test-org-get-heading)) - :to-equal '("Learn universal sign language")) - (expect (org-ql test-buffer - (clocked :on "2018-12-02") - :action (org-ql-test-org-get-heading)) - :to-equal nil)) + (org-ql-expect ((clocked :on "2017-07-05")) + '("Learn universal sign language")) + (org-ql-expect ((clocked :on "2018-12-02")) + nil)) + (org-ql-it "within a range (:from and :to)" - (expect (org-ql test-buffer - (clocked :from "2017-07-04" :to "2018-12-11") - :action (org-ql-test-org-get-heading)) - :to-equal '("Learn universal sign language")) - (expect (org-ql test-buffer - (clocked :from "2017-07-06" :to "2018-12-11") - :action (org-ql-test-org-get-heading)) - :to-equal nil) - (expect (org-ql test-buffer - (clocked :from "2017-07-01" :to "2017-07-04") - :action (org-ql-test-org-get-heading)) - :to-equal nil))) + (org-ql-expect ((clocked :from "2017-07-04" :to "2018-12-11")) + '("Learn universal sign language")) + (org-ql-expect ((clocked :from "2017-07-06" :to "2018-12-11")) + nil) + (org-ql-expect ((clocked :from "2017-07-01" :to "2017-07-04")) + nil))) (describe "(closed)" + (org-ql-it "without arguments" - (expect (org-ql test-buffer - (closed) - :action (org-ql-test-org-get-heading)) - :to-equal '("Learn universal sign language"))) + (org-ql-expect ((closed)) + '("Learn universal sign language"))) + (org-ql-it "=" - (expect (org-ql test-buffer - (closed = "2017-07-05") - :action (org-ql-test-org-get-heading)) - :to-equal '("Learn universal sign language")) - (expect (org-ql test-buffer - (closed = "2019-06-09") - :action (org-ql-test-org-get-heading)) - :to-equal nil)) + (org-ql-expect ((closed = "2017-07-05")) + '("Learn universal sign language")) + (org-ql-expect ((closed = "2019-06-09")) + nil)) + (org-ql-it "<" ;; TODO: Figure out why these tests take about 8 times longer than the other comparators in the (closed) tests. - (expect (org-ql test-buffer - (closed < "2019-06-10") - :action (org-ql-test-org-get-heading)) - :to-equal '("Learn universal sign language")) - (expect (org-ql test-buffer - (closed < "2017-06-10") - :action (org-ql-test-org-get-heading)) - :to-equal nil)) + (org-ql-expect ((closed < "2019-06-10")) + '("Learn universal sign language")) + (org-ql-expect ((closed < "2017-06-10")) + nil)) + (org-ql-it ">" - (expect (org-ql test-buffer - (closed > "2017-07-04") - :action (org-ql-test-org-get-heading)) - :to-equal '("Learn universal sign language")) - (expect (org-ql test-buffer - (closed > "2019-07-05") - :action (org-ql-test-org-get-heading)) - :to-equal nil)) + (org-ql-expect ((closed > "2017-07-04")) + '("Learn universal sign language")) + (org-ql-expect ((closed > "2019-07-05")) + nil)) + (org-ql-it ">=" - (expect (org-ql test-buffer - (closed >= "2017-07-04") - :action (org-ql-test-org-get-heading)) - :to-equal '("Learn universal sign language")) - (expect (org-ql test-buffer - (closed >= "2017-07-05") - :action (org-ql-test-org-get-heading)) - :to-equal '("Learn universal sign language")) - (expect (org-ql test-buffer - (closed >= "2017-07-06") - :action (org-ql-test-org-get-heading)) - :to-equal nil)) + (org-ql-expect ((closed >= "2017-07-04")) + '("Learn universal sign language")) + (org-ql-expect ((closed >= "2017-07-05")) + '("Learn universal sign language")) + (org-ql-expect ((closed >= "2017-07-06")) + nil)) + (org-ql-it "<=" - (expect (org-ql test-buffer - (closed <= "2017-07-04") - :action (org-ql-test-org-get-heading)) - :to-equal nil) - (expect (org-ql test-buffer - (closed <= "2017-07-05") - :action (org-ql-test-org-get-heading)) - :to-equal '("Learn universal sign language")) - (expect (org-ql test-buffer - (closed <= "2017-07-06") - :action (org-ql-test-org-get-heading)) - :to-equal '("Learn universal sign language")))) + (org-ql-expect ((closed <= "2017-07-04")) + nil) + (org-ql-expect ((closed <= "2017-07-05")) + '("Learn universal sign language")) + (org-ql-expect ((closed <= "2017-07-06")) + '("Learn universal sign language")))) (describe "(deadline)" + (org-ql-it "without arguments" - (expect (org-ql test-buffer - (deadline) - :action (org-ql-test-org-get-heading)) - :to-equal '("Take over the universe" "Take over the world" "Visit Mars" "Visit the moon" "Renew membership in supervillain club" "Internet" "Spaceship lease" "/r/emacs"))) + (org-ql-expect ((deadline)) + '("Take over the universe" "Take over the world" "Visit Mars" "Visit the moon" "Renew membership in supervillain club" "Internet" "Spaceship lease" "/r/emacs"))) + (org-ql-it "=" - (expect (org-ql test-buffer - (deadline = "2017-07-05") - :action (org-ql-test-org-get-heading)) - :to-equal '("/r/emacs")) - (expect (org-ql test-buffer - (deadline = "2019-06-09") - :action (org-ql-test-org-get-heading)) - :to-equal nil)) + (org-ql-expect ((deadline = "2017-07-05")) + '("/r/emacs")) + (org-ql-expect ((deadline = "2019-06-09")) + nil)) + (org-ql-it "<" - (expect (org-ql test-buffer - (deadline < "2019-06-10") - :action (org-ql-test-org-get-heading)) - :to-equal '("Take over the universe" "Take over the world" "Visit Mars" "Visit the moon" "Renew membership in supervillain club" "Internet" "Spaceship lease" "/r/emacs")) - (expect (org-ql test-buffer - (deadline < "2017-06-10") - :action (org-ql-test-org-get-heading)) - :to-equal nil)) + (org-ql-expect ((deadline < "2019-06-10")) + '("Take over the universe" "Take over the world" "Visit Mars" "Visit the moon" "Renew membership in supervillain club" "Internet" "Spaceship lease" "/r/emacs")) + (org-ql-expect ((deadline < "2017-06-10")) + nil)) + (org-ql-it ">" ;; TODO: Figure out why these tests take much longer than e.g. the (deadline <) tests. - (expect (org-ql test-buffer - (deadline > "2017-07-04 00:00") - :action (org-ql-test-org-get-heading)) - :to-equal '("Take over the universe" "Take over the world" "Visit Mars" "Visit the moon" "Renew membership in supervillain club" "Internet" "Spaceship lease" "/r/emacs")) - (expect (org-ql test-buffer - (deadline > "2019-07-05") - :action (org-ql-test-org-get-heading)) - :to-equal nil)) + (org-ql-expect ((deadline > "2017-07-04 00:00")) + '("Take over the universe" "Take over the world" "Visit Mars" "Visit the moon" "Renew membership in supervillain club" "Internet" "Spaceship lease" "/r/emacs")) + (org-ql-expect ((deadline > "2019-07-05")) + nil)) + (org-ql-it ">=" - (expect (org-ql test-buffer - (deadline >= "2017-07-04") - :action (org-ql-test-org-get-heading)) - :to-equal '("Take over the universe" "Take over the world" "Visit Mars" "Visit the moon" "Renew membership in supervillain club" "Internet" "Spaceship lease" "/r/emacs")) - (expect (org-ql test-buffer - (deadline >= "2017-07-05") - :action (org-ql-test-org-get-heading)) - :to-equal '("Take over the universe" "Take over the world" "Visit Mars" "Visit the moon" "Renew membership in supervillain club" "Internet" "Spaceship lease" "/r/emacs")) - (expect (org-ql test-buffer - (deadline >= "2017-07-06") - :action (org-ql-test-org-get-heading)) - :to-equal '("Take over the universe" "Take over the world" "Visit Mars" "Visit the moon" "Renew membership in supervillain club" "Internet" "Spaceship lease")) - (expect (org-ql test-buffer - (deadline >= "2018-07-06") - :action (org-ql-test-org-get-heading)) - :to-equal nil)) + (org-ql-expect ((deadline >= "2017-07-04")) + '("Take over the universe" "Take over the world" "Visit Mars" "Visit the moon" "Renew membership in supervillain club" "Internet" "Spaceship lease" "/r/emacs")) + (org-ql-expect ((deadline >= "2017-07-05")) + '("Take over the universe" "Take over the world" "Visit Mars" "Visit the moon" "Renew membership in supervillain club" "Internet" "Spaceship lease" "/r/emacs")) + (org-ql-expect ((deadline >= "2017-07-06")) + '("Take over the universe" "Take over the world" "Visit Mars" "Visit the moon" "Renew membership in supervillain club" "Internet" "Spaceship lease")) + (org-ql-expect ((deadline >= "2018-07-06")) + nil)) + (org-ql-it "<=" - (expect (org-ql test-buffer - (deadline <= "2017-07-04") - :action (org-ql-test-org-get-heading)) - :to-equal nil) - (expect (org-ql test-buffer - (deadline <= "2017-07-05") - :action (org-ql-test-org-get-heading)) - :to-equal '("/r/emacs")) - (expect (org-ql test-buffer - (deadline <= "2018-07-06") - :action (org-ql-test-org-get-heading)) - :to-equal '("Take over the universe" "Take over the world" "Visit Mars" "Visit the moon" "Renew membership in supervillain club" "Internet" "Spaceship lease" "/r/emacs")))) + (org-ql-expect ((deadline <= "2017-07-04")) + nil) + (org-ql-expect ((deadline <= "2017-07-05")) + '("/r/emacs")) + (org-ql-expect ((deadline <= "2018-07-06")) + '("Take over the universe" "Take over the world" "Visit Mars" "Visit the moon" "Renew membership in supervillain club" "Internet" "Spaceship lease" "/r/emacs")))) (org-ql-it "(done)" - (expect (org-ql test-buffer - (done) - :action (org-ql-test-org-get-heading)) - :to-equal '("Learn universal sign language"))) + (org-ql-expect ((done)) + '("Learn universal sign language"))) (describe "(regexp)" + (org-ql-it "with 1 argument" - (expect (org-ql test-buffer - (regexp "Take over") - :sort todo - :action (org-ql-test-org-get-heading)) :to-equal '("Take over the universe" "Take over the world" "Take over Mars" "Take over the moon" "Get haircut"))) + (org-ql-expect ((regexp "Take over") + :sort todo) + '("Take over the universe" "Take over the world" "Take over Mars" "Take over the moon" "Get haircut"))) + (org-ql-it "with 2 arguments" - (expect (org-ql test-buffer - (regexp "Take over" "pizza") - :sort todo - :action (org-ql-test-org-get-heading)) - :to-equal '("Take over the universe" "Take over the world" "Take over Mars" "Take over the moon" "Order a pizza" "Get haircut"))) + (org-ql-expect ((regexp "Take over" "pizza") + :sort todo) + '("Take over the universe" "Take over the world" "Take over Mars" "Take over the moon" "Order a pizza" "Get haircut"))) + (org-ql-it "with a plain string" - (expect (org-ql test-buffer - "Take over" - :sort todo - :action (org-ql-test-org-get-heading)) - :to-equal '("Take over the universe" "Take over the world" "Take over Mars" "Take over the moon" "Get haircut"))) + (org-ql-expect ("Take over" + :sort todo) + '("Take over the universe" "Take over the world" "Take over Mars" "Take over the moon" "Get haircut"))) + (org-ql-it "with two plain strings" - (expect (org-ql test-buffer - (or "Take over" "pizza") - :sort todo - :action (org-ql-test-org-get-heading)) - :to-equal '("Take over the universe" "Take over the world" "Take over Mars" "Take over the moon" "Order a pizza" "Get haircut")))) + (org-ql-expect ((or "Take over" "pizza") + :sort todo) + '("Take over the universe" "Take over the world" "Take over Mars" "Take over the moon" "Order a pizza" "Get haircut")))) (describe "(todo)" + (org-ql-it "without arguments" ;; FIXME: This returns an item that is done, which is incorrect. - (expect (org-ql test-buffer - (todo) - :sort todo - :action (org-ql-test-org-get-heading)) :to-equal '("Take over the universe" "Take over the world" "Skype with president of Antarctica" "Take over Mars" "Visit Mars" "Take over the moon" "Visit the moon" "Practice leaping tall buildings in a single bound" "Renew membership in supervillain club" "Learn universal sign language" "Order a pizza" "Get haircut" "Internet" "Spaceship lease" "Fix flux capacitor" "/r/emacs" "Shop for groceries" "Rewrite Emacs in Common Lisp" "Write a symphony"))) + (org-ql-expect ((todo) + :sort todo) + '("Take over the universe" "Take over the world" "Skype with president of Antarctica" "Take over Mars" "Visit Mars" "Take over the moon" "Visit the moon" "Practice leaping tall buildings in a single bound" "Renew membership in supervillain club" "Learn universal sign language" "Order a pizza" "Get haircut" "Internet" "Spaceship lease" "Fix flux capacitor" "/r/emacs" "Shop for groceries" "Rewrite Emacs in Common Lisp" "Write a symphony"))) + (org-ql-it "with 1 argument" ;; FIXME: Figure out why this takes >10x longer than the other (todo) ;; tests, according to Buttercup. Might just be GC, though. - (expect (org-ql test-buffer - (todo "WAITING") - :sort todo - :action (org-ql-test-org-get-heading)) :to-equal '("Visit the moon"))) + (org-ql-expect ((todo "WAITING") + :sort todo) + '("Visit the moon"))) + (org-ql-it "with 2 arguments" - (expect (org-ql test-buffer - (todo "WAITING" "SOMEDAY") - :sort todo - :action (org-ql-test-org-get-heading)) :to-equal '("Visit the moon" "Rewrite Emacs in Common Lisp" "Write a symphony")))) + (org-ql-expect ((todo "WAITING" "SOMEDAY") + :sort todo) + '("Visit the moon" "Rewrite Emacs in Common Lisp" "Write a symphony")))) (describe "(tags)" + (org-ql-it "without arguments" - (expect (org-ql test-buffer - (tags) - :action (org-ql-test-org-get-heading)) - :to-equal '("Take over the universe" "Take over the world" "Skype with president of Antarctica" "Take over Mars" "Visit Mars" "Take over the moon" "Visit the moon" "Practice leaping tall buildings in a single bound" "Renew membership in supervillain club" "Learn universal sign language" "Order a pizza" "Get haircut" "Internet" "Spaceship lease" "Fix flux capacitor" "/r/emacs" "Shop for groceries" "Rewrite Emacs in Common Lisp" "Write a symphony")) - (expect (org-ql test-buffer - (not (tags)) - :action (org-ql-test-org-get-heading)) - :to-equal '("Test data" "Recurring" "Sunrise/sunset" "Ideas" "Code" "Agenda examining" "Agenda censoring" "Auto grouping" "Auto categories" "Date" "Effort" "Misc" "let-plist" "Profiling"))) + (org-ql-expect ((tags)) + '("Take over the universe" "Take over the world" "Skype with president of Antarctica" "Take over Mars" "Visit Mars" "Take over the moon" "Visit the moon" "Practice leaping tall buildings in a single bound" "Renew membership in supervillain club" "Learn universal sign language" "Order a pizza" "Get haircut" "Internet" "Spaceship lease" "Fix flux capacitor" "/r/emacs" "Shop for groceries" "Rewrite Emacs in Common Lisp" "Write a symphony")) + (org-ql-expect ((not (tags))) + '("Test data" "Recurring" "Sunrise/sunset" "Ideas" "Code" "Agenda examining" "Agenda censoring" "Auto grouping" "Auto categories" "Date" "Effort" "Misc" "let-plist" "Profiling"))) + (org-ql-it "with a tag" - (expect (org-ql test-buffer - (tags "Emacs") - :action (org-ql-test-org-get-heading)) - :to-equal '("/r/emacs" "Rewrite Emacs in Common Lisp")) - (expect (org-ql test-buffer - (not (tags "Emacs")) - :action (org-ql-test-org-get-heading)) - :to-equal '("Test data" "Take over the universe" "Take over the world" "Skype with president of Antarctica" "Take over Mars" "Visit Mars" "Take over the moon" "Visit the moon" "Practice leaping tall buildings in a single bound" "Renew membership in supervillain club" "Learn universal sign language" "Order a pizza" "Get haircut" "Internet" "Spaceship lease" "Fix flux capacitor" "Recurring" "Shop for groceries" "Sunrise/sunset" "Ideas" "Write a symphony" "Code" "Agenda examining" "Agenda censoring" "Auto grouping" "Auto categories" "Date" "Effort" "Misc" "let-plist" "Profiling"))) + (org-ql-expect ((tags "Emacs")) + '("/r/emacs" "Rewrite Emacs in Common Lisp")) + (org-ql-expect ((not (tags "Emacs"))) + '("Test data" "Take over the universe" "Take over the world" "Skype with president of Antarctica" "Take over Mars" "Visit Mars" "Take over the moon" "Visit the moon" "Practice leaping tall buildings in a single bound" "Renew membership in supervillain club" "Learn universal sign language" "Order a pizza" "Get haircut" "Internet" "Spaceship lease" "Fix flux capacitor" "Recurring" "Shop for groceries" "Sunrise/sunset" "Ideas" "Write a symphony" "Code" "Agenda examining" "Agenda censoring" "Auto grouping" "Auto categories" "Date" "Effort" "Misc" "let-plist" "Profiling"))) + (org-ql-it "with 2 tags" - (expect (org-ql test-buffer - (tags "Emacs" "space") - :action (org-ql-test-org-get-heading)) - :to-equal '("Visit Mars" "Visit the moon" "/r/emacs" "Rewrite Emacs in Common Lisp")) - (expect (org-ql test-buffer - (not (tags "Emacs" "space")) - :action (org-ql-test-org-get-heading)) - :to-equal '("Test data" "Take over the universe" "Take over the world" "Skype with president of Antarctica" "Take over Mars" "Take over the moon" "Practice leaping tall buildings in a single bound" "Renew membership in supervillain club" "Learn universal sign language" "Order a pizza" "Get haircut" "Internet" "Spaceship lease" "Fix flux capacitor" "Recurring" "Shop for groceries" "Sunrise/sunset" "Ideas" "Write a symphony" "Code" "Agenda examining" "Agenda censoring" "Auto grouping" "Auto categories" "Date" "Effort" "Misc" "let-plist" "Profiling")))) + (org-ql-expect ((tags "Emacs" "space")) + '("Visit Mars" "Visit the moon" "/r/emacs" "Rewrite Emacs in Common Lisp")) + (org-ql-expect ((not (tags "Emacs" "space"))) + '("Test data" "Take over the universe" "Take over the world" "Skype with president of Antarctica" "Take over Mars" "Take over the moon" "Practice leaping tall buildings in a single bound" "Renew membership in supervillain club" "Learn universal sign language" "Order a pizza" "Get haircut" "Internet" "Spaceship lease" "Fix flux capacitor" "Recurring" "Shop for groceries" "Sunrise/sunset" "Ideas" "Write a symphony" "Code" "Agenda examining" "Agenda censoring" "Auto grouping" "Auto categories" "Date" "Effort" "Misc" "let-plist" "Profiling")))) (describe "(ts)" + (org-ql-it "without arguments" - (expect (org-ql test-buffer - (ts) - :action (org-ql-test-org-get-heading)) - :to-equal '("Test data" "Take over the universe" "Take over the world" "Skype with president of Antarctica" "Visit Mars" "Visit the moon" "Practice leaping tall buildings in a single bound" "Renew membership in supervillain club" "Learn universal sign language" "Order a pizza" "Get haircut" "Internet" "Spaceship lease" "Fix flux capacitor" "/r/emacs" "Shop for groceries" "Rewrite Emacs in Common Lisp"))) + (org-ql-expect ((ts)) + '("Test data" "Take over the universe" "Take over the world" "Skype with president of Antarctica" "Visit Mars" "Visit the moon" "Practice leaping tall buildings in a single bound" "Renew membership in supervillain club" "Learn universal sign language" "Order a pizza" "Get haircut" "Internet" "Spaceship lease" "Fix flux capacitor" "/r/emacs" "Shop for groceries" "Rewrite Emacs in Common Lisp"))) + (org-ql-it ":from a timestamp" ;; TODO: Figure out why these take longer than the other (ts) tests. - (expect (org-ql test-buffer - (ts :from "2017-01-01") - :action (org-ql-test-org-get-heading)) - :to-equal '("Test data" "Take over the universe" "Take over the world" "Skype with president of Antarctica" "Visit Mars" "Visit the moon" "Practice leaping tall buildings in a single bound" "Renew membership in supervillain club" "Learn universal sign language" "Order a pizza" "Get haircut" "Internet" "Spaceship lease" "Fix flux capacitor" "/r/emacs" "Shop for groceries" "Rewrite Emacs in Common Lisp")) - (expect (org-ql test-buffer - (ts :from "2019-06-08") - :action (org-ql-test-org-get-heading)) - :to-equal nil)) + (org-ql-expect ((ts :from "2017-01-01")) + '("Test data" "Take over the universe" "Take over the world" "Skype with president of Antarctica" "Visit Mars" "Visit the moon" "Practice leaping tall buildings in a single bound" "Renew membership in supervillain club" "Learn universal sign language" "Order a pizza" "Get haircut" "Internet" "Spaceship lease" "Fix flux capacitor" "/r/emacs" "Shop for groceries" "Rewrite Emacs in Common Lisp")) + (org-ql-expect ((ts :from "2019-06-08")) + nil)) + (org-ql-it ":to a timestamp" - (expect (org-ql test-buffer - (ts :to "2019-06-10") - :action (org-ql-test-org-get-heading)) - :to-equal '("Test data" "Take over the universe" "Take over the world" "Skype with president of Antarctica" "Visit Mars" "Visit the moon" "Practice leaping tall buildings in a single bound" "Renew membership in supervillain club" "Learn universal sign language" "Order a pizza" "Get haircut" "Internet" "Spaceship lease" "Fix flux capacitor" "/r/emacs" "Shop for groceries" "Rewrite Emacs in Common Lisp")) - (expect (org-ql test-buffer - (ts :to "2017-07-04") - :action (org-ql-test-org-get-heading)) - :to-equal '("Skype with president of Antarctica"))) + (org-ql-expect ((ts :to "2019-06-10")) + '("Test data" "Take over the universe" "Take over the world" "Skype with president of Antarctica" "Visit Mars" "Visit the moon" "Practice leaping tall buildings in a single bound" "Renew membership in supervillain club" "Learn universal sign language" "Order a pizza" "Get haircut" "Internet" "Spaceship lease" "Fix flux capacitor" "/r/emacs" "Shop for groceries" "Rewrite Emacs in Common Lisp")) + (org-ql-expect ((ts :to "2017-07-04")) + '("Skype with president of Antarctica"))) + (org-ql-it ":on a timestamp" - (expect (org-ql test-buffer - (ts :on "2017-07-05") - :action (org-ql-test-org-get-heading)) - :to-equal '("Test data" "Practice leaping tall buildings in a single bound" "Learn universal sign language" "Order a pizza" "Get haircut" "Fix flux capacitor" "/r/emacs" "Shop for groceries" "Rewrite Emacs in Common Lisp")) - (expect (org-ql test-buffer - (ts :on "2019-06-09") - :action (org-ql-test-org-get-heading)) - :to-equal nil))) + (org-ql-expect ((ts :on "2017-07-05")) + '("Test data" "Practice leaping tall buildings in a single bound" "Learn universal sign language" "Order a pizza" "Get haircut" "Fix flux capacitor" "/r/emacs" "Shop for groceries" "Rewrite Emacs in Common Lisp")) + (org-ql-expect ((ts :on "2019-06-09")) + nil))) (describe "Compound queries" (org-ql-it "Tags and to-do" - (expect (org-ql test-buffer - (and (todo "SOMEDAY") - (tags "Emacs")) - :action (org-ql-test-org-get-heading)) - :to-equal '("Rewrite Emacs in Common Lisp")))))) + (org-ql-expect ((and (todo "SOMEDAY") + (tags "Emacs"))) + '("Rewrite Emacs in Common Lisp")))))) ;; Local Variables: ;; truncate-lines: t From b12d498cec69b141feae05ec1296a0f5da719ff0 Mon Sep 17 00:00:00 2001 From: Adam Porter Date: Fri, 9 Aug 2019 16:47:01 -0500 Subject: [PATCH 075/798] Tests: Update helper functions --- tests/test-org-ql.el | 27 ++++++++++++++++++--------- 1 file changed, 18 insertions(+), 9 deletions(-) diff --git a/tests/test-org-ql.el b/tests/test-org-ql.el index 5995e1a..4e5a8cf 100644 --- a/tests/test-org-ql.el +++ b/tests/test-org-ql.el @@ -39,15 +39,21 @@ (if-let* ((sexp (elisp--preceding-sexp)) (correct-sexp-p (pcase (car sexp) ('org-ql 'org-ql) + ('org-ql-expect t) ('org-ql--query-preamble 'query-preamble) ('org-ql--pre-process-query t) (_ nil))) - (result (pcase (car sexp) - ('org-ql (org-ql-test--format-result--ql sexp)) - ('org-ql--query-preamble (org-ql-test--format-result--query-preamble sexp)) - ('org-ql--pre-process-query (format "'%S" (eval sexp))) + (result (pcase sexp + (`(org-ql-expect ,args) (org-ql-test--format-result--ql `(org-ql test-buffer + ,@args + :action (org-ql-test-org-get-heading)))) + (`(org-ql . _) (org-ql-test--format-result--ql sexp)) + (`(org-ql--query-preamble . _) (org-ql-test--format-result--query-preamble sexp)) + (`(org-ql--pre-process-query . _) (format "'%S" (eval sexp))) (_ nil)))) - (insert " :to-equal " result) + (progn + (backward-char 1) + (insert "\n'" result)) (user-error "Point must be after an `org-ql' form"))) (defun org-ql-test--format-result--ql (sexp) @@ -67,10 +73,13 @@ "Show `org-ql-agenda' for `org-ql' form." (interactive) (if-let* ((sexp (elisp--preceding-sexp)) - (correct-sexp-p (eq (car sexp) 'org-ql))) - (progn - (setf (car sexp) 'org-ql-agenda) - (eval sexp)) + (sexp (pcase sexp + (`(org-ql . ,_) (setf (car sexp) 'org-ql-agenda)) + (`(org-ql-expect ,ql-args . ,_) (setf sexp `(org-ql-agenda test-buffer + ,@ql-args))) + (_ nil)))) + + (eval sexp) (user-error "Point must be after an `org-ql' form"))) ;;;; Macros From e7eb3b2031429a30371d17f34ade539b44e7cd5c Mon Sep 17 00:00:00 2001 From: Adam Porter Date: Fri, 9 Aug 2019 16:47:56 -0500 Subject: [PATCH 076/798] Add: (property) Preambles --- notes.org | 46 ++++++++++++++++++++++++++++++++++++++++++-- org-ql.el | 23 ++++++++++++++++++++++ tests/test-org-ql.el | 14 ++++++++++++++ 3 files changed, 81 insertions(+), 2 deletions(-) diff --git a/notes.org b/notes.org index 9694dd2..f7f2d75 100644 --- a/notes.org +++ b/notes.org @@ -416,11 +416,15 @@ Also, maybe instead of having a single =date= selector, I should have =scheduled ** Preambles +Not sure if clearing the cache is necessary here, because it seemed to make nearly no difference in the results, but I don't know why. + #+BEGIN_SRC elisp :results silent (cl-defmacro org-ql-preamble-bench (&key query (file "tests/data.org") (times 10)) `(bench-multi-lets :times ,times :ensure-equal t - :lets (("preamble" ((org-ql-use-preamble t))) - ("no preamble" ((org-ql-use-preamble nil)))) + :lets (("preamble" ((org-ql-use-preamble t) + (org-ql-cache (ht)))) + ("no preamble" ((org-ql-use-preamble nil) + (org-ql-cache (ht))))) :forms ((,(prin1-to-string query) (org-ql-select ,file ',query :action '(org-get-heading t t)))))) @@ -440,6 +444,44 @@ Also, maybe instead of having a single =date= selector, I should have =scheduled | preamble: (level 1) | 1.34 | 0.562950 | 0 | 0 | | no preamble: (level 1) | slowest | 0.754050 | 0 | 0 | +*** =property= + +#+BEGIN_SRC elisp + (org-ql-preamble-bench :times 1 + :file "~/org/inbox.org" + :query (property "agenda-group")) +#+END_SRC + +#+RESULTS: +| Form | x faster than next | Total runtime | # of GCs | Total GC runtime | +|----------------------------------------+--------------------+---------------+----------+------------------| +| preamble: (property "agenda-group") | 70.44 | 0.016571 | 0 | 0 | +| no preamble: (property "agenda-group") | slowest | 1.167203 | 0 | 0 | + +#+BEGIN_SRC elisp + (org-ql-preamble-bench :times 1 + :file "~/org/inbox.org" + :query (property "ID")) +#+END_SRC + +#+RESULTS: +| Form | x faster than next | Total runtime | # of GCs | Total GC runtime | +|------------------------------+--------------------+---------------+----------+------------------| +| preamble: (property "ID") | 3.51 | 0.369830 | 0 | 0 | +| no preamble: (property "ID") | slowest | 1.299684 | 0 | 0 | + +#+BEGIN_SRC elisp + (org-ql-preamble-bench :times 1 + :file "~/org/inbox.org" + :query (property "agenda-group" "plans")) +#+END_SRC + +#+RESULTS: +| Form | x faster than next | Total runtime | # of GCs | Total GC runtime | +|------------------------------------------------+--------------------+---------------+----------+------------------| +| preamble: (property "agenda-group" "plans") | 72.54 | 0.016862 | 0 | 0 | +| no preamble: (property "agenda-group" "plans") | slowest | 1.223197 | 0 | 0 | + *** =tags= If tag inheritance is enabled, we have to check tags on every heading. When it's disabled, we can search directly to headings with the given tags. diff --git a/org-ql.el b/org-ql.el index e26ca94..58a3286 100644 --- a/org-ql.el +++ b/org-ql.el @@ -343,6 +343,29 @@ replace the clause with a preamble." (`(level ,num) (setq org-ql-preamble (rx-to-string `(seq bol (repeat ,num "*") " ") t)) nil) + (`(property ,property ,value) + ;; We do NOT return nil, because the predicate still needs to be tested, + ;; because the regexp could match a string not inside a property drawer. + (setq org-ql-preamble (rx-to-string `(seq bol (0+ space) ":" ,property ":" + (1+ space) ,value (0+ space) eol))) + element) + (`(property ,property) + ;; We do NOT return nil, because the predicate still needs to be tested, + ;; because the regexp could match a string not inside a property drawer. + ;; NOTE: The preamble only matches if there appears to be a value. + ;; A line like ":ID: " without any other text does not match. + (setq org-ql-preamble (rx-to-string `(seq bol (0+ space) ":" ,property ":" (1+ space) + (minimal-match (1+ not-newline)) eol))) + element) + ;; MAYBE: Support (property) without args. + ;; (`(property) + ;; ;; We do NOT return nil, because the predicate still needs to be tested, + ;; ;; because the regexp could match a string not inside a property drawer. + ;; ;; NOTE: The preamble only matches if there appears to be a value. + ;; ;; A line like ":ID: " without any other text does not match. + ;; (setq org-ql-preamble (rx-to-string `(seq bol (0+ space) ":" (1+ (not (or space ":"))) ":" + ;; (1+ space) (minimal-match (1+ not-newline)) eol))) + ;; element) ((and `(tags . ,tags) (guard (not org-use-tag-inheritance))) ;; When tag inheritance is disabled, we only consider direct tags, ;; so we can search directly to headings containing one of the tags. diff --git a/tests/test-org-ql.el b/tests/test-org-ql.el index 4e5a8cf..51761f1 100644 --- a/tests/test-org-ql.el +++ b/tests/test-org-ql.el @@ -311,6 +311,20 @@ RESULTS should be a list of strings as returned by (org-ql-expect ((done)) '("Learn universal sign language"))) + (describe "(property)" + + ;; MAYBE: Add support for (property) without arguments. + ;; (org-ql-it "without arguments" + ;; (org-ql-expect ((property)))) + + (org-ql-it "with a property" + (org-ql-expect ((property "agenda-group")) + '("Take over the universe" "Spaceship lease" "Recurring" "Write a symphony"))) + + (org-ql-it "with a property and a value" + (org-ql-expect ((property "agenda-group" "plans")) + '("Take over the universe" "Write a symphony")))) + (describe "(regexp)" (org-ql-it "with 1 argument" From ed26effe1c40064941526e9f9a8e66ba3a8c8554 Mon Sep 17 00:00:00 2001 From: Adam Porter Date: Fri, 9 Aug 2019 17:05:17 -0500 Subject: [PATCH 077/798] Add: (deadline) preamble --- notes.org | 26 ++++++++++++++++++++++++++ org-ql.el | 9 +++++++++ 2 files changed, 35 insertions(+) diff --git a/notes.org b/notes.org index f7f2d75..7f834e0 100644 --- a/notes.org +++ b/notes.org @@ -430,6 +430,32 @@ Not sure if clearing the cache is necessary here, because it seemed to make near :action '(org-get-heading t t)))))) #+END_SRC +*** =deadline= + +#+BEGIN_SRC elisp + (org-ql-preamble-bench :times 1 + :file "~/org/inbox.org" + :query (deadline)) +#+END_SRC + +#+RESULTS: +| Form | x faster than next | Total runtime | # of GCs | Total GC runtime | +|-------------------------+--------------------+---------------+----------+------------------| +| preamble: (deadline) | 27.63 | 0.014656 | 0 | 0 | +| no preamble: (deadline) | slowest | 0.404952 | 0 | 0 | + +#+BEGIN_SRC elisp + (org-ql-preamble-bench :times 1 + :file "~/org/inbox.org" + :query (deadline <= "2019-01-01")) +#+END_SRC + +#+RESULTS: +| Form | x faster than next | Total runtime | # of GCs | Total GC runtime | +|-----------------------------------------+--------------------+---------------+----------+------------------| +| preamble: (deadline <= "2019-01-01") | 27.91 | 0.014606 | 0 | 0 | +| no preamble: (deadline <= "2019-01-01") | slowest | 0.407682 | 0 | 0 | + *** =level= #+BEGIN_SRC elisp diff --git a/org-ql.el b/org-ql.el index 58a3286..0a9f431 100644 --- a/org-ql.el +++ b/org-ql.el @@ -316,6 +316,15 @@ replace the clause with a preamble." element) (pcase element (`(or _) element) + (`(deadline . ,_) + (setq org-ql-preamble + (rx-to-string `(seq bol (0+ (any " ")) "DEADLINE" ":" (1+ space) (1+ not-newline)) t)) + ;; Return element, because the predicate still needs testing. + element) + (`(deadline) + (setq org-ql-preamble (rx-to-string `(seq bol (0+ (any " ")) "DEADLINE" ":") t)) + ;; Return element, because the predicate still needs testing. + element) (`(regexp . ,regexps) (setq org-ql-preamble (rx-to-string `(or ,@regexps) t)) ;; Return nil, because we don't need to test the predicate. From cd4f3cc99b57eb54ab74b48e29e959d2f2cc0805 Mon Sep 17 00:00:00 2001 From: Adam Porter Date: Fri, 9 Aug 2019 17:07:49 -0500 Subject: [PATCH 078/798] Add: (scheduled) preamble --- notes.org | 26 ++++++++++++++++++++++++++ org-ql.el | 9 +++++++++ 2 files changed, 35 insertions(+) diff --git a/notes.org b/notes.org index 7f834e0..8397172 100644 --- a/notes.org +++ b/notes.org @@ -508,6 +508,32 @@ Not sure if clearing the cache is necessary here, because it seemed to make near | preamble: (property "agenda-group" "plans") | 72.54 | 0.016862 | 0 | 0 | | no preamble: (property "agenda-group" "plans") | slowest | 1.223197 | 0 | 0 | +*** =scheduled= + +#+BEGIN_SRC elisp + (org-ql-preamble-bench :times 1 + :file "~/org/inbox.org" + :query (scheduled)) +#+END_SRC + +#+RESULTS: +| Form | x faster than next | Total runtime | # of GCs | Total GC runtime | +|--------------------------+--------------------+---------------+----------+------------------| +| preamble: (scheduled) | 4.45 | 0.100968 | 0 | 0 | +| no preamble: (scheduled) | slowest | 0.449321 | 0 | 0 | + +#+BEGIN_SRC elisp + (org-ql-preamble-bench :times 1 + :file "~/org/inbox.org" + :query (scheduled <= "2019-01-01")) +#+END_SRC + +#+RESULTS: +| Form | x faster than next | Total runtime | # of GCs | Total GC runtime | +|------------------------------------------+--------------------+---------------+----------+------------------| +| preamble: (scheduled <= "2019-01-01") | 4.13 | 0.111067 | 0 | 0 | +| no preamble: (scheduled <= "2019-01-01") | slowest | 0.458726 | 0 | 0 | + *** =tags= If tag inheritance is enabled, we have to check tags on every heading. When it's disabled, we can search directly to headings with the given tags. diff --git a/org-ql.el b/org-ql.el index 0a9f431..0cdaa2c 100644 --- a/org-ql.el +++ b/org-ql.el @@ -375,6 +375,15 @@ replace the clause with a preamble." ;; (setq org-ql-preamble (rx-to-string `(seq bol (0+ space) ":" (1+ (not (or space ":"))) ":" ;; (1+ space) (minimal-match (1+ not-newline)) eol))) ;; element) + (`(scheduled . ,_) + (setq org-ql-preamble + (rx-to-string `(seq bol (0+ (any " ")) "SCHEDULED" ":" (1+ space) (1+ not-newline)) t)) + ;; Return element, because the predicate still needs testing. + element) + (`(scheduled) + (setq org-ql-preamble (rx-to-string `(seq bol (0+ (any " ")) "SCHEDULED" ":") t)) + ;; Return element, because the predicate still needs testing. + element) ((and `(tags . ,tags) (guard (not org-use-tag-inheritance))) ;; When tag inheritance is disabled, we only consider direct tags, ;; so we can search directly to headings containing one of the tags. From 13993f1394fa87466351af621eee0adc5f54dcf1 Mon Sep 17 00:00:00 2001 From: Adam Porter Date: Fri, 9 Aug 2019 17:10:03 -0500 Subject: [PATCH 079/798] Add: (closed) preamble --- notes.org | 26 ++++++++++++++++++++++++++ org-ql.el | 9 +++++++++ 2 files changed, 35 insertions(+) diff --git a/notes.org b/notes.org index 8397172..fff5876 100644 --- a/notes.org +++ b/notes.org @@ -430,6 +430,32 @@ Not sure if clearing the cache is necessary here, because it seemed to make near :action '(org-get-heading t t)))))) #+END_SRC +*** =closed= + +#+BEGIN_SRC elisp + (org-ql-preamble-bench :times 1 + :file "~/org/inbox.org" + :query (closed)) +#+END_SRC + +#+RESULTS: +| Form | x faster than next | Total runtime | # of GCs | Total GC runtime | +|-----------------------+--------------------+---------------+----------+------------------| +| preamble: (closed) | 4.80 | 0.086553 | 0 | 0 | +| no preamble: (closed) | slowest | 0.415165 | 0 | 0 | + +#+BEGIN_SRC elisp + (org-ql-preamble-bench :times 1 + :file "~/org/inbox.org" + :query (closed <= "2019-01-01")) +#+END_SRC + +#+RESULTS: +| Form | x faster than next | Total runtime | # of GCs | Total GC runtime | +|---------------------------------------+--------------------+---------------+----------+------------------| +| preamble: (closed <= "2019-01-01") | 4.21 | 0.105782 | 0 | 0 | +| no preamble: (closed <= "2019-01-01") | slowest | 0.445374 | 0 | 0 | + *** =deadline= #+BEGIN_SRC elisp diff --git a/org-ql.el b/org-ql.el index 0cdaa2c..b66f0a3 100644 --- a/org-ql.el +++ b/org-ql.el @@ -316,6 +316,15 @@ replace the clause with a preamble." element) (pcase element (`(or _) element) + (`(closed . ,_) + (setq org-ql-preamble + (rx-to-string `(seq bol (0+ (any " ")) "CLOSED" ":" (1+ space) (1+ not-newline)) t)) + ;; Return element, because the predicate still needs testing. + element) + (`(closed) + (setq org-ql-preamble (rx-to-string `(seq bol (0+ (any " ")) "CLOSED" ":") t)) + ;; Return element, because the predicate still needs testing. + element) (`(deadline . ,_) (setq org-ql-preamble (rx-to-string `(seq bol (0+ (any " ")) "DEADLINE" ":" (1+ space) (1+ not-newline)) t)) From 867bf4edccb097c4da583a26bfba2b32cb21c26b Mon Sep 17 00:00:00 2001 From: Adam Porter Date: Fri, 9 Aug 2019 17:12:27 -0500 Subject: [PATCH 080/798] Docs: Add note about (property) inheritance --- README.org | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/README.org b/README.org index 83a2fa7..f6b3193 100644 --- a/README.org +++ b/README.org @@ -134,7 +134,7 @@ Arguments are listed next to predicate names, where applicable. + ~level (level-or-comparator &optional level)~ :: Return non-nil if current heading's outline level matches arguments. The following forms are accepted: ~(level NUMBER)~: Matches if heading level is ~NUMBER~. ~(level NUMBER NUMBER)~: Matches if heading level is equal to or between NUMBERs. ~(level COMPARATOR NUMBER)~: Matches if heading level compares to ~NUMBER~ with ~COMPARATOR~. ~COMPARATOR~ may be ~<~, ~<=~, ~>~, or ~>=~. + ~planning (&optional comparator target-date)~ :: Return non-nil if entry's planning date (deadline or scheduled) compares with ~TARGET-DATE~ using ~COMPARATOR~. ~TARGET-DATE~ should be a string parseable by ~date-to-day~. ~COMPARATOR~ should be a function (like ~<=~). + ~priority (&optional comparator-or-priority priority)~ :: Return non-nil if current heading has a certain priority. ~COMPARATOR-OR-PRIORITY~ should be either a comparator function, like ~<=~, or a priority string, like "A" (in which case (~=~ will be the comparator). If ~COMPARATOR-OR-PRIORITY~ is a comparator, ~PRIORITY~ should be a priority string. -+ ~property (property &optional value)~ :: Return non-nil if current entry has ~PROPERTY~ (a string), and optionally ~VALUE~ (a string). ++ ~property (property &optional value)~ :: Return non-nil if current entry has ~PROPERTY~ (a string), and optionally ~VALUE~ (a string). Note that property inheritance is currently /not/ enabled for this predicate. If you need to test with inheritance, you could use a custom predicate form, like ~(org-entry-get (point) "PROPERTY" 'inherit)~. + ~regexp (regexp)~ :: Return non-nil if current entry matches ~REGEXP~ (a regexp string). + ~scheduled (&optional comparator target-date)~ :: Return non-nil if entry's scheduled date compares with ~TARGET-DATE~ using ~COMPARATOR~. ~TARGET-DATE~ should be a string parseable by ~date-to-day~. ~COMPARATOR~ should be a function (like ~<=~). + ~tags (&optional tags)~ :: Return non-nil if current heading has one or more of ~TAGS~ (a list of strings). From 1c5bf06804f232e195419ac6992f3e2d4b7ac950 Mon Sep 17 00:00:00 2001 From: Adam Porter Date: Fri, 9 Aug 2019 17:18:56 -0500 Subject: [PATCH 081/798] Tests: Add (habit) --- tests/test-org-ql.el | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/tests/test-org-ql.el b/tests/test-org-ql.el index 51761f1..4875897 100644 --- a/tests/test-org-ql.el +++ b/tests/test-org-ql.el @@ -311,6 +311,10 @@ RESULTS should be a list of strings as returned by (org-ql-expect ((done)) '("Learn universal sign language"))) + (org-ql-it "(habit)" + (org-ql-expect ((habit)) + '("Practice leaping tall buildings in a single bound"))) + (describe "(property)" ;; MAYBE: Add support for (property) without arguments. From 2cdc2106458fd99dd4da82841e1ea49e86ffaaf5 Mon Sep 17 00:00:00 2001 From: Adam Porter Date: Fri, 9 Aug 2019 17:19:07 -0500 Subject: [PATCH 082/798] Add: (habit) preamble --- notes.org | 14 ++++++++++++++ org-ql.el | 4 ++++ 2 files changed, 18 insertions(+) diff --git a/notes.org b/notes.org index fff5876..e224aca 100644 --- a/notes.org +++ b/notes.org @@ -482,6 +482,20 @@ Not sure if clearing the cache is necessary here, because it seemed to make near | preamble: (deadline <= "2019-01-01") | 27.91 | 0.014606 | 0 | 0 | | no preamble: (deadline <= "2019-01-01") | slowest | 0.407682 | 0 | 0 | +*** =habit= + +#+BEGIN_SRC elisp + (org-ql-preamble-bench :times 1 + :file "~/org/inbox.org" + :query (habit)) +#+END_SRC + +#+RESULTS: +| Form | x faster than next | Total runtime | # of GCs | Total GC runtime | +|----------------------+--------------------+---------------+----------+------------------| +| preamble: (habit) | 70.09 | 0.016489 | 0 | 0 | +| no preamble: (habit) | slowest | 1.155649 | 0 | 0 | + *** =level= #+BEGIN_SRC elisp diff --git a/org-ql.el b/org-ql.el index b66f0a3..24d6d2c 100644 --- a/org-ql.el +++ b/org-ql.el @@ -348,6 +348,10 @@ replace the clause with a preamble." t)) ;; Return nil, don't test the predicate. nil) + (`(habit) + (setq org-ql-preamble (rx-to-string `(seq bol (0+ space) ":STYLE:" (1+ space) + "habit" (0+ space) eol))) + nil) (`(level ,comparator-or-num ,num) (let ((repeat (pcase comparator-or-num ('< `(repeat 1 ,(1- num) "*")) From bd3ab6fb02c4c08c99690a3e308c8a2f642898a5 Mon Sep 17 00:00:00 2001 From: Adam Porter Date: Sat, 10 Aug 2019 06:16:59 -0500 Subject: [PATCH 083/798] Notes: Add idea --- notes.org | 43 +++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 43 insertions(+) diff --git a/notes.org b/notes.org index e224aca..6164ac4 100644 --- a/notes.org +++ b/notes.org @@ -4,6 +4,49 @@ ** TODO Update commentary +** TODO ~org-agenda-skip-function~ + +As discussed [[https://www.reddit.com/r/emacs/comments/cnrt2d/orgqlblock_integrates_orgql_into_org_agenda/ewi1q36/][here]], this is a cool feature that allows further integration into existing custom agenda commands. Example: + +#+BEGIN_SRC elisp + ;;; lima-0ac22.el --- -*- lexical-binding: t; -*- + + (defun org-ql-skip-function (query) + "Return a function for `org-agenda-skip-function' for QUERY. + Compared to using QUERY in `org-ql', this effectively turns QUERY + into (not QUERY)." + (let* ((predicate (org-ql--query-predicate '(regexp "ryo-modal")))) + (lambda () + ;; This duplicates the functionality of `org-ql--select'. + (let (orig-fns) + (--each org-ql-predicates + ;; Save original function mappings. + (let ((name (plist-get it :name))) + (push (list :name name :fn (symbol-function name)) orig-fns))) + (unwind-protect + (progn + (--each org-ql-predicates + ;; Set predicate functions. + (fset (plist-get it :name) (plist-get it :fn))) + ;; Run query. + ;; FIXME: "If this function returns nil, the current match should not be skipped. + ;; Otherwise, the function must return a position from where the search + ;; should be continued." + (funcall predicate)) + (--each orig-fns + ;; Restore original function mappings. + (fset (plist-get it :name) (plist-get it :fn)))))))) + + (let ((org-agenda-custom-commands + '(("z" "Z" + ((tags-todo "PRIORITY=\"A\"+Emacs/!SOMEDAY")) + ((org-agenda-skip-function (org-ql-skip-function '(regexp "ryo-modal"))))) + ((org-agenda-files ("~/org/inbox.org")))))) + (org-agenda nil "z")) +#+END_SRC + +I should benchmark it to see how much difference it makes, because all those ~fset~ calls on each heading isn't free. But if a macro were used to rewrite the built-in predicates to their full versions, all of that could be avoided... + ** TODO [#B] Implied string literal regexp selector As mentioned [[https://www.reddit.com/r/emacs/comments/c8e0zp/my_gnu_hyperbole_vision_quest_odyssey_two/esmtqow/][here]]: From ab0df68aae4f7558d47276f9758e9a7681b4d649 Mon Sep 17 00:00:00 2001 From: Adam Porter Date: Sat, 10 Aug 2019 10:18:03 -0500 Subject: [PATCH 084/798] Add: (org-ql-query) narrow, order-by --- README.org | 7 ++++++- org-ql.el | 13 ++++++++++--- 2 files changed, 16 insertions(+), 4 deletions(-) diff --git a/README.org b/README.org index f6b3193..9bcb3f5 100644 --- a/README.org +++ b/README.org @@ -286,7 +286,7 @@ Examples: **** Function: ~org-ql-query~ -/Arguments:/ ~(&key (select 'element-with-markers) from where)~ +/Arguments:/ ~(&key (select 'element-with-markers) from where order-by narrow)~ Like ~org-ql-select~, but arguments are named more like a ~SQL~ query. @@ -296,6 +296,11 @@ Like ~org-ql-select~, but arguments are named more like a ~SQL~ query. ~WHERE~ corresponds to the ~org-ql-select~ argument ~QUERY~. +~ORDER-BY~ corresponds to the ~org-ql-select~ argument ~SORT~, which +see. + +~NARROW~ corresponds to the ~org-ql-select~ argument ~NARROW~. + Examples: #+BEGIN_SRC elisp diff --git a/org-ql.el b/org-ql.el index 24d6d2c..dcc6321 100644 --- a/org-ql.el +++ b/org-ql.el @@ -196,7 +196,7 @@ non-nil." ((pred functionp) (sort items sort)) (_ (user-error "SORT must be either nil, or one or a list of the defined sorting methods (see documentation)"))))) -(cl-defun org-ql-query (&key (select 'element-with-markers) from where) +(cl-defun org-ql-query (&key (select 'element-with-markers) from where narrow order-by) "Like `org-ql-select', but arguments are named more like a SQL query. SELECT corresponds to the `org-ql-select' argument ACTION. It is @@ -219,10 +219,17 @@ FROM corresponds to the `org-ql-select' argument BUFFERS-OR-FILES. It may be one or a list of file paths and/or buffers. WHERE corresponds to the `org-ql-select' argument QUERY. It -should be an `org-ql' query sexp." +should be an `org-ql' query sexp. + +ORDER-BY corresponds to the `org-ql-select' argument SORT, which +see. + +NARROW corresponds to the `org-ql-select' argument NARROW." (declare (indent defun)) (org-ql-select from where - :action select)) + :action select + :narrow narrow + :sort sort)) (defun org-ql--pre-process-query (query) "Return QUERY having been pre-processed. From 6abb2ae8c0c6876c5590ef003ef71c53c9dc3015 Mon Sep 17 00:00:00 2001 From: Adam Porter Date: Sat, 10 Aug 2019 10:18:29 -0500 Subject: [PATCH 085/798] Docs: Improve examples --- README.org | 58 ++++++++++++++++++++++++++++++++---------------------- 1 file changed, 35 insertions(+), 23 deletions(-) diff --git a/README.org b/README.org index 9bcb3f5..48be5ed 100644 --- a/README.org +++ b/README.org @@ -25,36 +25,48 @@ More examples are available in [[examples.org]]. #+BEGIN_SRC elisp - ;; Return a list of Org entry elements in the file "~/org/main.org" which have the SOMEDAY - ;; to-do keyword, are tagged "Emacs", and have priority B or higher. + ;; Return a list of Org entry elements in the file "~/org/main.org" + ;; which have the SOMEDAY to-do keyword, are tagged "Emacs", and have + ;; priority B or higher. (org-ql "~/org/main.org" (and (todo "SOMEDAY") (tags "Emacs") - (priority >= "B"))) ;=> ((headline (:raw-value "org-board" :begin 1220270 :end 1220403 ...)) ...) + (priority >= "B"))) + ;;=> ((headline (:raw-value "org-board" :begin 1220270 :end 1220403 ...)) ...) - ;; Return a list of bills coming due, searching all Org Agenda files, sorted by deadline. Deadlines - ;; are compared with configured Org warning days, which is implied by the plain `<=' in the - ;; `deadline' matcher. - (org-ql (org-agenda-files) - (and (not (done)) - (tags "bills") - (deadline <=)) - :sort deadline) + ;; Set the tag "Emacs" on every entry in the inbox file that mentions + ;; "Emacs". `org-ql-select' works like `org-ql' but is a function + ;; rather than a macro. The bare-string query "Emacs" is equivalent + ;; to (regexp "Emacs"). + (org-ql-select "~/org/inbox.org" + "Emacs" + :action '(org-toggle-tag "Emacs" 'on)) - ;; Set the tag "Emacs" on every entry in the inbox file that mentions "Emacs". - (org-ql "~/org/inbox.org" - (regexp "Emacs") - :action (org-toggle-tag "Emacs" 'on)) + ;; Return a list of bills coming due, searching all Org Agenda files, + ;; sorted by deadline. Deadlines are compared with + ;; `org-deadline-warning-days', which is implied by the plain `<=' in + ;; the `deadline' predicate. `org-ql-query' works like `org-ql-select' + ;; but offers arguments named like SQL queries. + (org-ql-query + :select #'org-get-heading + :from (org-agenda-files) + :where '(and (not (done)) + (tags "bills") + (deadline <=)) + :order-by 'deadline) + ;;=> ("TODO Electric bill" "TODO Water bill") - ;; If you kept a database of music in an Org file, you might run a query like this to find tracks - ;; composed by Chopin that do not have their key recorded in the database: - (org-ql "~/org/music.org" - (and (property "genre" "classical") - (property "composer" "Chopin") - (not (property "key")))) + ;; If you kept a database of music in an Org file, you could run a + ;; query like this to find tracks composed by Chopin that do not have + ;; their key recorded in the database. `org-ql-search' works like + ;; `org-ql-select' and displays results in an agenda-like buffer: + (org-ql-search "~/org/music.org" + '(and (property "genre" "classical") + (property "composer" "Chopin") + (not (property "key")))) - ;; Define a custom Org Agenda command which inserts an `org-ql-block' - ;; block before the regular agenda: + ;; Integrate `org-ql' into a custom Org Agenda command which inserts + ;; an `org-ql' block before the regular agenda: (setq org-agenda-custom-commands '(("ces" "Custom: Agenda and Emacs SOMEDAY [#A] items" ((org-ql-block '(and (todo "SOMEDAY") From c615fbd73fe843e1fde516b49308e973a283b166 Mon Sep 17 00:00:00 2001 From: Adam Porter Date: Sat, 10 Aug 2019 10:21:37 -0500 Subject: [PATCH 086/798] Docs: -query args --- README.org | 15 +++++---------- 1 file changed, 5 insertions(+), 10 deletions(-) diff --git a/README.org b/README.org index 48be5ed..47a20a5 100644 --- a/README.org +++ b/README.org @@ -302,16 +302,11 @@ Examples: Like ~org-ql-select~, but arguments are named more like a ~SQL~ query. -~SELECT~ corresponds to the ~org-ql-select~ argument ~ACTION~. - -~FROM~ corresponds to the ~org-ql-select~ argument ~BUFFERS-OR-FILES~. - -~WHERE~ corresponds to the ~org-ql-select~ argument ~QUERY~. - -~ORDER-BY~ corresponds to the ~org-ql-select~ argument ~SORT~, which -see. - -~NARROW~ corresponds to the ~org-ql-select~ argument ~NARROW~. ++ ~SELECT~ corresponds to the ~org-ql-select~ argument ~ACTION~. ++ ~FROM~ corresponds to the ~org-ql-select~ argument ~BUFFERS-OR-FILES~. ++ ~WHERE~ corresponds to the ~org-ql-select~ argument ~QUERY~. ++ ~ORDER-BY~ corresponds to the ~org-ql-select~ argument ~SORT~, which see. ++ ~NARROW~ corresponds to the ~org-ql-select~ argument ~NARROW~. Examples: From a77e60640b5c4fdcebb71bf9787e87da9c7f538a Mon Sep 17 00:00:00 2001 From: Adam Porter Date: Sun, 11 Aug 2019 10:41:48 -0500 Subject: [PATCH 087/798] Fix: (org-ql-query) Argument Oops. --- org-ql.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/org-ql.el b/org-ql.el index dcc6321..616908c 100644 --- a/org-ql.el +++ b/org-ql.el @@ -229,7 +229,7 @@ NARROW corresponds to the `org-ql-select' argument NARROW." (org-ql-select from where :action select :narrow narrow - :sort sort)) + :sort order-by)) (defun org-ql--pre-process-query (query) "Return QUERY having been pre-processed. From 1ca5930b2fb4941d210626b882dd4640b7583616 Mon Sep 17 00:00:00 2001 From: Adam Porter Date: Sun, 11 Aug 2019 11:02:46 -0500 Subject: [PATCH 088/798] Tidy: (org-ql-query) Indentation --- org-ql.el | 1 - 1 file changed, 1 deletion(-) diff --git a/org-ql.el b/org-ql.el index 616908c..7da1473 100644 --- a/org-ql.el +++ b/org-ql.el @@ -225,7 +225,6 @@ ORDER-BY corresponds to the `org-ql-select' argument SORT, which see. NARROW corresponds to the `org-ql-select' argument NARROW." - (declare (indent defun)) (org-ql-select from where :action select :narrow narrow From b5f9087e586361baa3f4bd761c4286d50dd66a34 Mon Sep 17 00:00:00 2001 From: Adam Porter Date: Sun, 11 Aug 2019 11:34:52 -0500 Subject: [PATCH 089/798] Tests: Update makem.sh --- makem.sh | 26 ++++++++++++++++++++------ 1 file changed, 20 insertions(+), 6 deletions(-) diff --git a/makem.sh b/makem.sh index 909d9eb..07b8308 100755 --- a/makem.sh +++ b/makem.sh @@ -147,11 +147,20 @@ EOF # ** Emacs function run_emacs { - debug "run_emacs: emacs -Q --batch -L \"$load_path\" --load=$package_initialize_file $@" + debug "run_emacs: emacs -Q --batch --load=$package_initialize_file -L \"$load_path\" $@" + if [[ $debug_load_path ]] + then + debug $(emacs -Q --batch \ + --load=$package_initialize_file \ + -L "$load_path" \ + --eval "(message \"LOAD-PATH: %s\" load-path)" \ + 2>&1) + fi output_file=$(mktemp) - emacs -Q --batch -L "$load_path" \ + emacs -Q --batch \ --load=$package_initialize_file \ + -L "$load_path" \ "$@" \ &>$output_file @@ -239,11 +248,11 @@ function cleanup { function echo_color { # This allows bold, italic, etc. without needing a function for # each variation. + local color_code="COLOR_$1" + shift + if [[ $color ]] then - local color_code="COLOR_$1" - shift - echo -e "${!color_code}${@}${COLOR_off}" else echo "$@" @@ -322,6 +331,8 @@ Options: -h, --help I need somebody! -v, --verbose Increase verbosity, up to -vv. + --debug-load-path Print load-path. + -f FILE, --file FILE Check FILE in addition to discovered files. --no-color Disable color output. @@ -462,7 +473,7 @@ COLOR_white='\e[0;37m' # * Args -args=$(getopt -n "$0" -o dhvf:C -l debug,help,verbose,file:,no-color,no-compile -- "$@") || { usage; exit 1; } +args=$(getopt -n "$0" -o dhvf:C -l debug,debug-load-path,help,verbose,file:,no-color,no-compile -- "$@") || { usage; exit 1; } eval set -- "$args" while true @@ -472,6 +483,9 @@ do debug=true verbose=2 ;; + --debug-load-path) + debug_load_path=true + ;; -h|--help) usage exit From 913292787b938ca699a657a825916d343a3ba07b Mon Sep 17 00:00:00 2001 From: Adam Porter Date: Sun, 11 Aug 2019 11:36:37 -0500 Subject: [PATCH 090/798] Tests: Query functions/macros Test a few basic forms of these to ensure, e.g. that arguments don't get broken. --- tests/test-org-ql.el | 19 +++++++++++++++++++ 1 file changed, 19 insertions(+) diff --git a/tests/test-org-ql.el b/tests/test-org-ql.el index 4875897..287c7bd 100644 --- a/tests/test-org-ql.el +++ b/tests/test-org-ql.el @@ -131,6 +131,25 @@ RESULTS should be a list of strings as returned by (cl-loop while (re-search-forward org-heading-regexp nil t) sum 1))))) + (describe "Query functions/macros" + + (it "org-ql" + (expect (length (org-ql test-buffer + (category) + :sort deadline)) + :to-equal num-headings)) + (it "org-ql-select" + (expect (length (org-ql-select test-buffer + '(category) + :sort 'deadline)) + :to-equal num-headings)) + (it "org-ql-query" + (expect (length (org-ql-query :select 'element + :from test-buffer + :where '(category) + :order-by 'date)) + :to-equal num-headings))) + (it "Query pre-processing" (expect (org-ql--pre-process-query '(and "string1" "string2")) :to-equal '(and (regexp "string1") (regexp "string2"))) From 4954789ca5ec33d27d2a353161f8f3da44d782db Mon Sep 17 00:00:00 2001 From: Adam Porter Date: Sun, 11 Aug 2019 11:39:04 -0500 Subject: [PATCH 091/798] Add/Change: Use ts.el, add ts-a and ts-i Improves performance, reduces code, and more test cases added. --- README.org | 11 ++- notes.org | 122 +++++++++++++++++++++++++++++++ org-ql.el | 168 ++++++++++--------------------------------- tests/test-org-ql.el | 114 +++++++++++++++++++++++------ 4 files changed, 261 insertions(+), 154 deletions(-) diff --git a/README.org b/README.org index 47a20a5..fee9ab9 100644 --- a/README.org +++ b/README.org @@ -151,9 +151,11 @@ Arguments are listed next to predicate names, where applicable. + ~scheduled (&optional comparator target-date)~ :: Return non-nil if entry's scheduled date compares with ~TARGET-DATE~ using ~COMPARATOR~. ~TARGET-DATE~ should be a string parseable by ~date-to-day~. ~COMPARATOR~ should be a function (like ~<=~). + ~tags (&optional tags)~ :: Return non-nil if current heading has one or more of ~TAGS~ (a list of strings). + ~todo (&optional keywords)~ :: Return non-nil if current heading is a ~TODO~ item. With ~KEYWORDS~, return non-nil if its keyword is one of ~KEYWORDS~ (a list of strings). -+ ~ts (&key from to on)~ :: Return non-nil if current entry has a timestamp in given period. If no arguments are specified, return non-nil if entry has any timestamp. If ~FROM~, return non-nil if entry has a timestamp on or after ~FROM~. If ~TO~, return non-nil if entry has a timestamp on or before ~TO~. If ~ON~, return non-nil if entry has a timestamp on date ~ON~. ~FROM~, ~TO~, and ~ON~ should be strings parseable by ~parse-time-string~ but may omit the time value. -+ ~ts-active (&key from to on)~ :: Return non-nil if current entry has an active timestamp in given period. If no arguments are specified, return non-nil if entry has any active timestamp. If ~FROM~, return non-nil if entry has an active timestamp on or after ~FROM~. If ~TO~, return non-nil if entry has an active timestamp on or before ~TO~. If ~ON~, return non-nil if entry has an active timestamp on date ~ON~. ~FROM~, ~TO~, and ~ON~ should be strings parseable by ~parse-time-string~ but may omit the time value. -+ ~ts-inactive (&key from to on)~ :: Return non-nil if current entry has an inactive timestamp in given period. If no arguments are specified, return non-nil if entry has any inactive timestamp. If ~FROM~, return non-nil if entry has an inactive timestamp on or after ~FROM~. If ~TO~, return non-nil if entry has an inactive timestamp on or before ~TO~. If ~ON~, return non-nil if entry has an inactive timestamp on date ~ON~. ~FROM~, ~TO~, and ~ON~ should be strings parseable by ~parse-time-string~ but may omit the time value. ++ ~ts (&key from to on type)~ :: Return non-nil if current entry has a timestamp in given period. If no arguments are specified, return non-nil if entry has any timestamp. If ~FROM~, return non-nil if entry has a timestamp on or after ~FROM~. If ~TO~, return non-nil if entry has a timestamp on or before ~TO~. If ~ON~, return non-nil if entry has a timestamp on date ~ON~. ~FROM~, ~TO~, and ~ON~ should be strings parseable by ~parse-time-string~ but may omit the time value. ~TYPE~ may be ~active~ to match active timestamps, ~inactive~ to match inactive ones, or ~both~ / nil to match both types. ++ ~ts-active~ :: Like ~ts~ called with ~:type active~. ++ ~ts-a~ :: Like ~ts~ called with ~:type active~. ++ ~ts-inactive~ :: Like ~ts~ called with ~:type inactive~. ++ ~ts-i~ :: Like ~ts~ called with ~:type inactive~. ** Functions / Macros :PROPERTIES: @@ -361,6 +363,8 @@ Expands into a call to ~org-ql-select~ with the same arguments. For convenience + Macro ~org-ql~ and functions ~org-ql-query~ and ~org-ql-select~ now also accept a comparator function in their ~:sort~ argument. + Function ~org-ql-block~, which works as an Org Agenda series/composite/block command, usable in custom agenda commands defined in variable ~org-agenda-custom-commands~. (Inspired by [[https://github.com/pestctrl/emacs-config/blob/84c557982a860e86d6f67976a82ea776a7bd2c7a/config-org-new.org#my-own-agenda-renderer][Benson Chu's config]].) + Function ~org-ql-agenda--agenda~ optionally takes a list of entries as an argument. ++ Selectors ~ts-a~ and ~ts-i~, aliases for ~ts-active~ and ~ts-inactive~. ++ Selector ~ts~ now accepts a ~:type~ argument. *Changed* + Function ~org-ql-query~ renamed to ~org-ql-select~. ~org-ql-query~ now refers to a new function. @@ -375,6 +379,7 @@ Expands into a call to ~org-ql-select~ with the same arguments. For convenience *Internal* + Optimizations for some query selectors, e.g. =regexp= and =todo=. These can provide a significant improvement for some queries. See benchmarks in [[file:notes.org][notes.org]]. ++ Library [[https://github.com/alphapapa/ts.el][ts]] is now used for parsing and comparing timestamps. ** 0.1 diff --git a/notes.org b/notes.org index 6164ac4..0c8591b 100644 --- a/notes.org +++ b/notes.org @@ -647,6 +647,128 @@ If tag inheritance is enabled, we have to check tags on every heading. When it' | preamble: (tags "Emacs") | 2.08 | 0.274555 | 0 | 0 | | no preamble: (tags "Emacs") | slowest | 0.570116 | 0 | 0 | +** with/without ts.el + +[2019-08-11 Sun 15:39] These results seem to show a minor performance improvement by using ~ts~, and the code is simpler. + +#+BEGIN_SRC elisp + ;; (require 'ts) + + (org-ql--defpred ts-ts (&key from to _on) + ;; The underscore before `on' prevents "unused lexical variable" warnings, because we + ;; pre-process that argument in a macro before this function is called. + "Return non-nil if current entry has a timestamp in given period. + If no arguments are specified, return non-nil if entry has any + timestamp. + + If FROM, return non-nil if entry has a timestamp on or after + FROM. + + If TO, return non-nil if entry has a timestamp on or before TO. + + If ON, return non-nil if entry has a timestamp on date ON. + + FROM, TO, and ON should be strings parseable by + `parse-time-string' but may omit the time value." + ;; TODO: DRY this with the clocked predicate. + ;; NOTE: FROM and TO are actually expected to be Unix timestamps. The docstring is written + ;; for end users, for which the arguments are pre-processed by `org-ql-select'. + ;; FIXME: This assumes every "clocked" entry is a range. Unclosed clock entries are not handled. + (cl-macrolet ((next-timestamp () + `(when (re-search-forward org-element--timestamp-regexp end-pos t) + (ts-parse-org (match-string 0)))) + (test-timestamps (pred-form) + `(cl-loop for next-ts = (next-timestamp) + while next-ts + thereis ,pred-form))) + (save-excursion + (let ((end-pos (org-entry-end-position))) + (cond ((not (or from to)) (re-search-forward org-element--timestamp-regexp end-pos t)) + ((and from to) (test-timestamps (and (ts<= from next-ts) + (ts<= next-ts to)))) + (from (test-timestamps (ts<= from next-ts))) + (to (test-timestamps (ts<= next-ts to)))))))) + +#+END_SRC + +*** Without timestamp argument + +#+BEGIN_SRC elisp + (bench-multi-lexical :times 1 :ensure-equal t + :forms (("old ts" (org-ql "~/org/inbox.org" + (ts))) + ("ts.el ts" (org-ql "~/org/inbox.org" + (ts-ts))))) +#+END_SRC + +#+RESULTS: +| Form | x faster than next | Total runtime | # of GCs | Total GC runtime | +|----------+--------------------+---------------+----------+------------------| +| ts.el ts | 1.14 | 2.251801 | 0 | 0 | +| old ts | slowest | 2.560280 | 0 | 0 | + +#+BEGIN_SRC elisp + (bench-multi-lexical :times 20 :ensure-equal t + :forms (("old ts" (org-ql "~/src/emacs/org-ql/tests/data.org" + (ts))) + ("ts.el ts" (org-ql "~/src/emacs/org-ql/tests/data.org" + (ts-ts))))) +#+END_SRC + +#+RESULTS: +| Form | x faster than next | Total runtime | # of GCs | Total GC runtime | +|----------+--------------------+---------------+----------+------------------| +| ts.el ts | 1.05 | 0.103714 | 0 | 0 | +| old ts | slowest | 0.108663 | 0 | 0 | + +*** :from + +#+BEGIN_SRC elisp + (bench-multi-lexical :times 1 :ensure-equal t + :forms (("old ts" (org-ql "~/org/inbox.org" + (ts :from "2017-01-01"))) + ("ts.el ts" (org-ql "~/org/inbox.org" + (ts-ts :from "2017-01-01"))))) +#+END_SRC + +#+RESULTS: +| Form | x faster than next | Total runtime | # of GCs | Total GC runtime | +|----------+--------------------+---------------+----------+------------------| +| ts.el ts | 1.32 | 1.299966 | 0 | 0 | +| old ts | slowest | 1.713027 | 0 | 0 | + +*** :to + +#+BEGIN_SRC elisp + (bench-multi-lexical :times 1 :ensure-equal t + :forms (("old ts" (org-ql "~/org/inbox.org" + (ts :to "2019-01-01"))) + ("ts.el ts" (org-ql "~/org/inbox.org" + (ts-ts :to "2019-01-01"))))) +#+END_SRC + +#+RESULTS: +| Form | x faster than next | Total runtime | # of GCs | Total GC runtime | +|----------+--------------------+---------------+----------+------------------| +| ts.el ts | 1.01 | 1.300084 | 0 | 0 | +| old ts | slowest | 1.312208 | 0 | 0 | + +*** :on + +#+BEGIN_SRC elisp + (bench-multi-lexical :times 1 :ensure-equal t + :forms (("old ts" (org-ql "~/org/inbox.org" + (ts :on "2019-05-14"))) + ("ts.el ts" (org-ql "~/org/inbox.org" + (ts-ts :on "2019-05-14"))))) +#+END_SRC + +#+RESULTS: +| Form | x faster than next | Total runtime | # of GCs | Total GC runtime | +|----------+--------------------+---------------+----------+------------------| +| ts.el ts | 1.17 | 0.557281 | 0 | 0 | +| old ts | slowest | 0.652149 | 0 | 0 | + ** Using =org-element-parse-buffer= This basically works, as a very basic kind of agenda view, but we can already see that it's much slower (at least, for single-day views) because =org-element-parse-buffer= is slow compared to the agenda code. diff --git a/org-ql.el b/org-ql.el index 7da1473..e51accc 100644 --- a/org-ql.el +++ b/org-ql.el @@ -3,7 +3,7 @@ ;; Author: Adam Porter ;; Url: https://github.com/alphapapa/org-ql ;; Version: 0.2-pre -;; Package-Requires: ((emacs "26.1") (dash "2.13") (org "9.0") (s "1.12.0")) +;; Package-Requires: ((emacs "26.1") (dash "2.13") (org "9.0") (s "1.12.0") (ts "0.2")) ;; Keywords: hypermedia, outlines, Org, agenda ;;; Commentary: @@ -40,6 +40,7 @@ (require 'subr-x) (require 'dash) +(require 'ts) ;;;; Compatibility @@ -53,6 +54,12 @@ ;;;; Variables +(defconst org-ql-tsr-regexp-inactive + (concat org-ts-regexp-inactive "\\(--?-?" + org-ts-regexp-inactive "\\)?") + ;; MAYBE: Propose this for org.el. + "Regular expression matching an inactive timestamp or timestamp range.") + (defvar org-ql--today nil) (defvar org-ql-use-preamble t @@ -232,7 +239,8 @@ NARROW corresponds to the `org-ql-select' argument NARROW." (defun org-ql--pre-process-query (query) "Return QUERY having been pre-processed. -Replaces bare strings with (regexp) selectors." +Replaces bare strings with (regexp) selectors, and appropriate +`ts'-related selectors." ;; This is unsophisticated, but it works. (cl-labels ((rec (element) (pcase element @@ -244,6 +252,8 @@ Replaces bare strings with (regexp) selectors." ,@(mapcar #'rec clauses))) ;; TODO: Combine (regexp) when appropriate (i.e. inside an OR, not an AND). ((pred stringp) `(regexp ,element)) + (`(,(or 'ts-active 'ts-a) . ,rest) `(ts :type active ,@rest)) + (`(,(or 'ts-inactive 'ts-i) . ,rest) `(ts :type inactive ,@rest)) (_ element)))) (rec query))) @@ -267,39 +277,21 @@ Replaces bare strings with (regexp) selectors." ;; NOTE: The macro must expand to the actual `org-ql--predicate-clocked' ;; function, not another `clocked'. `(org-ql--predicate-clocked :from ,from :to ,to)) - (ts (&key from to on) + (ts (&key from to on (type 'both)) (when on (setq from on to on)) (when from - (setq from (org-ql--parse-time-string from))) + (setq from (ts-parse-fill 'begin from))) (when to - (setq to (org-ql--parse-time-string to 'end))) + (setq to (ts-parse-fill 'end to))) ;; NOTE: The macro must expand to the actual `org-ql--predicate-ts' ;; function, not another `ts'. - `(org-ql--predicate-ts :from ,from :to ,to)) - (ts-active (&key from to on) - (when on - (setq from on - to on)) - (when from - (setq from (org-ql--parse-time-string from))) - (when to - (setq to (org-ql--parse-time-string to 'end))) - ;; NOTE: The macro must expand to the actual `org-ql--predicate-ts' - ;; function, not another `ts'. - `(org-ql--predicate-ts-active :from ,from :to ,to)) - (ts-inactive (&key from to on) - (when on - (setq from on - to on)) - (when from - (setq from (org-ql--parse-time-string from))) - (when to - (setq to (org-ql--parse-time-string to 'end))) - ;; NOTE: The macro must expand to the actual `org-ql--predicate-ts' - ;; function, not another `ts'. - `(org-ql--predicate-ts-inactive :from ,from :to ,to))) + `(org-ql--predicate-ts :from ,from :to ,to + :regexp ,(pcase type + ('both org-tsr-regexp-both) + ('active org-tsr-regexp) + ('inactive org-ql-tsr-regexp-inactive))))) (cl-symbol-macrolet ((today org-ql--today) ; Necessary because of byte-compiling the lambda (= #'=) (< #'<) @@ -710,9 +702,11 @@ comparator, PRIORITY should be a priority string." ;; and language-independent than using from/to. Alternatively, add :before/:after, but I ;; think the comparators are better. Also consider using a macro to DRY these out. -(org-ql--defpred ts (&key from to _on) - ;; The underscore before `on' prevents "unused lexical variable" warnings, because we - ;; pre-process that argument in a macro before this function is called. +(org-ql--defpred ts (&key from to _on regexp) + ;; The underscore before `on' prevents "unused lexical variable" warnings, + ;; because we pre-process that argument in a macro before this function is + ;; called. The `regexp' argument is also provided by the macro and is not + ;; to be given by the user, so it is omitted from the docstring. "Return non-nil if current entry has a timestamp in given period. If no arguments are specified, return non-nil if entry has any timestamp. @@ -725,116 +719,28 @@ If TO, return non-nil if entry has a timestamp on or before TO. If ON, return non-nil if entry has a timestamp on date ON. FROM, TO, and ON should be strings parseable by -`parse-time-string' but may omit the time value." +`parse-time-string' but may omit the time value. + +TYPE may be `active' to match active timestamps, `inactive' to +match inactive ones, or `both' / nil to match both types." ;; TODO: DRY this with the clocked predicate. ;; NOTE: FROM and TO are actually expected to be Unix timestamps. The docstring is written ;; for end users, for which the arguments are pre-processed by `org-ql-select'. ;; FIXME: This assumes every "clocked" entry is a range. Unclosed clock entries are not handled. (cl-macrolet ((next-timestamp () - `(when (re-search-forward org-element--timestamp-regexp end-pos t) - (save-excursion - (goto-char (match-beginning 0)) - (org-element-timestamp-parser)))) + `(when (re-search-forward regexp end-pos t) + (ts-parse-org (match-string 0)))) (test-timestamps (pred-form) `(cl-loop for next-ts = (next-timestamp) while next-ts - do (setf beg (float-time (org-timestamp-to-time next-ts)) - end (float-time (org-timestamp-to-time next-ts 'end))) thereis ,pred-form))) (save-excursion - (let ((end-pos (org-entry-end-position)) - beg end) - (cond ((not (or from to)) (next-timestamp)) - ((and from to) (test-timestamps (and (<= beg to) - (>= end from)))) - (from (test-timestamps (<= from end))) - (to (test-timestamps (<= beg to)))))))) - -(org-ql--defpred ts-active (&key from to _on) - ;; The underscore before `on' prevents "unused lexical variable" warnings, because we - ;; pre-process that argument in a macro before this function is called. - "Return non-nil if current entry has an active timestamp in given period. -If no arguments are specified, return non-nil if entry has any -active timestamp. - -If FROM, return non-nil if entry has an active timestamp on or -after FROM. - -If TO, return non-nil if entry has an active timestamp on or -before TO. - -If ON, return non-nil if entry has an active timestamp on date -ON. - -FROM, TO, and ON should be strings parseable by -`parse-time-string' but may omit the time value." - ;; TODO: DRY this with the clocked predicate. - ;; NOTE: FROM and TO are actually expected to be Unix timestamps. The docstring is written - ;; for end users, for which the arguments are pre-processed by `org-ql-select'. - ;; FIXME: This assumes every "clocked" entry is a range. Unclosed clock entries are not handled. - (cl-macrolet ((next-timestamp () - `(when (re-search-forward org-element--timestamp-regexp end-pos t) - (save-excursion - (goto-char (match-beginning 0)) - (org-element-timestamp-parser)))) - (test-timestamps (pred-form) - `(cl-loop for next-ts = (next-timestamp) - while next-ts - when (string-prefix-p "<" next-ts) - do (setf beg (float-time (org-timestamp-to-time next-ts)) - end (float-time (org-timestamp-to-time next-ts 'end))) - thereis ,pred-form))) - (save-excursion - (let ((end-pos (org-entry-end-position)) - beg end) - (cond ((not (or from to)) (next-timestamp)) - ((and from to) (test-timestamps (and (<= beg to) - (>= end from)))) - (from (test-timestamps (<= from end))) - (to (test-timestamps (<= beg to)))))))) - -(org-ql--defpred ts-inactive (&key from to _on) - ;; The underscore before `on' prevents "unused lexical variable" warnings, because we - ;; pre-process that argument in a macro before this function is called. - "Return non-nil if current entry has an inactive timestamp in given period. -If no arguments are specified, return non-nil if entry has any -inactive timestamp. - -If FROM, return non-nil if entry has an inactive timestamp on or -after FROM. - -If TO, return non-nil if entry has an inactive timestamp on or -before TO. - -If ON, return non-nil if entry has an inactive timestamp on date -ON. - -FROM, TO, and ON should be strings parseable by -`parse-time-string' but may omit the time value." - ;; TODO: DRY this with the clocked predicate. - ;; NOTE: FROM and TO are actually expected to be Unix timestamps. The docstring is written - ;; for end users, for which the arguments are pre-processed by `org-ql-select'. - ;; FIXME: This assumes every "clocked" entry is a range. Unclosed clock entries are not handled. - (cl-macrolet ((next-timestamp () - `(when (re-search-forward org-element--timestamp-regexp end-pos t) - (save-excursion - (goto-char (match-beginning 0)) - (org-element-timestamp-parser)))) - (test-timestamps (pred-form) - `(cl-loop for next-ts = (next-timestamp) - while next-ts - when (string-prefix-p "[" next-ts) - do (setf beg (float-time (org-timestamp-to-time next-ts)) - end (float-time (org-timestamp-to-time next-ts 'end))) - thereis ,pred-form))) - (save-excursion - (let ((end-pos (org-entry-end-position)) - beg end) - (cond ((not (or from to)) (next-timestamp)) - ((and from to) (test-timestamps (and (<= beg to) - (>= end from)))) - (from (test-timestamps (<= from end))) - (to (test-timestamps (<= beg to)))))))) + (let ((end-pos (org-entry-end-position))) + (cond ((not (or from to)) (re-search-forward regexp end-pos t)) + ((and from to) (test-timestamps (and (ts<= from next-ts) + (ts<= next-ts to)))) + (from (test-timestamps (ts<= from next-ts))) + (to (test-timestamps (ts<= next-ts to)))))))) ;;;;; Date comparison diff --git a/tests/test-org-ql.el b/tests/test-org-ql.el index 287c7bd..13f7d97 100644 --- a/tests/test-org-ql.el +++ b/tests/test-org-ql.el @@ -169,7 +169,16 @@ RESULTS should be a list of strings as returned by :to-equal '(when (and (regexp "string-cond1") (regexp "string-cond2")) (or (regexp "string1") (regexp "string2")))) (expect (org-ql--pre-process-query '(unless (and "stringcondition1" "stringcond2") (or "string1" "string2"))) - :to-equal '(unless (and (regexp "stringcondition1") (regexp "stringcond2")) (or (regexp "string1") (regexp "string2"))))) + :to-equal '(unless (and (regexp "stringcondition1") (regexp "stringcond2")) (or (regexp "string1") (regexp "string2")))) + + (expect (org-ql--pre-process-query '(or (ts-active :on "2019-01-01") + (ts-a :on "2019-01-01") + (ts-inactive :on "2019-01-01") + (ts-i :on "2019-01-01"))) + :to-equal '(or (ts :type active :on "2019-01-01") + (ts :type active :on "2019-01-01") + (ts :type inactive :on "2019-01-01") + (ts :type inactive :on "2019-01-01")))) (describe "Query optimizing" @@ -412,28 +421,93 @@ RESULTS should be a list of strings as returned by (describe "(ts)" - (org-ql-it "without arguments" - (org-ql-expect ((ts)) - '("Test data" "Take over the universe" "Take over the world" "Skype with president of Antarctica" "Visit Mars" "Visit the moon" "Practice leaping tall buildings in a single bound" "Renew membership in supervillain club" "Learn universal sign language" "Order a pizza" "Get haircut" "Internet" "Spaceship lease" "Fix flux capacitor" "/r/emacs" "Shop for groceries" "Rewrite Emacs in Common Lisp"))) + (describe "active" - (org-ql-it ":from a timestamp" - ;; TODO: Figure out why these take longer than the other (ts) tests. - (org-ql-expect ((ts :from "2017-01-01")) - '("Test data" "Take over the universe" "Take over the world" "Skype with president of Antarctica" "Visit Mars" "Visit the moon" "Practice leaping tall buildings in a single bound" "Renew membership in supervillain club" "Learn universal sign language" "Order a pizza" "Get haircut" "Internet" "Spaceship lease" "Fix flux capacitor" "/r/emacs" "Shop for groceries" "Rewrite Emacs in Common Lisp")) - (org-ql-expect ((ts :from "2019-06-08")) - nil)) + (org-ql-it "without arguments" + (org-ql-expect ((ts :type active)) + '("Take over the universe" "Take over the world" "Skype with president of Antarctica" "Visit Mars" "Visit the moon" "Practice leaping tall buildings in a single bound" "Renew membership in supervillain club" "Order a pizza" "Get haircut" "Internet" "Spaceship lease" "Fix flux capacitor" "/r/emacs" "Shop for groceries" "Rewrite Emacs in Common Lisp"))) - (org-ql-it ":to a timestamp" - (org-ql-expect ((ts :to "2019-06-10")) - '("Test data" "Take over the universe" "Take over the world" "Skype with president of Antarctica" "Visit Mars" "Visit the moon" "Practice leaping tall buildings in a single bound" "Renew membership in supervillain club" "Learn universal sign language" "Order a pizza" "Get haircut" "Internet" "Spaceship lease" "Fix flux capacitor" "/r/emacs" "Shop for groceries" "Rewrite Emacs in Common Lisp")) - (org-ql-expect ((ts :to "2017-07-04")) - '("Skype with president of Antarctica"))) + (org-ql-it ":from a timestamp" + ;; TODO: Figure out why these take longer than the other (ts) tests. + (org-ql-expect ((ts :from "2017-07-08" :type active)) + '("Take over the universe" "Visit Mars" "Visit the moon" "Renew membership in supervillain club" "Internet" "Spaceship lease")) + (org-ql-expect ((ts :from "2019-06-08" :type active)) + nil)) - (org-ql-it ":on a timestamp" - (org-ql-expect ((ts :on "2017-07-05")) - '("Test data" "Practice leaping tall buildings in a single bound" "Learn universal sign language" "Order a pizza" "Get haircut" "Fix flux capacitor" "/r/emacs" "Shop for groceries" "Rewrite Emacs in Common Lisp")) - (org-ql-expect ((ts :on "2019-06-09")) - nil))) + (org-ql-it ":to a timestamp" + (org-ql-expect ((ts :to "2019-06-10" :type active)) + '("Take over the universe" "Take over the world" "Skype with president of Antarctica" "Visit Mars" "Visit the moon" "Practice leaping tall buildings in a single bound" "Renew membership in supervillain club" "Order a pizza" "Get haircut" "Internet" "Spaceship lease" "Fix flux capacitor" "/r/emacs" "Shop for groceries" "Rewrite Emacs in Common Lisp")) + (org-ql-expect ((ts :to "2017-07-04" :type active)) + '("Skype with president of Antarctica"))) + + (org-ql-it ":on a timestamp" + (org-ql-expect ((ts :on "2017-07-05" :type active)) + '("Practice leaping tall buildings in a single bound" "Order a pizza" "Get haircut" "Fix flux capacitor" "/r/emacs" "Shop for groceries" "Rewrite Emacs in Common Lisp")) + (org-ql-expect ((ts :on "2019-06-09" :type active)) + nil))) + + (describe "inactive" + + (org-ql-it "without arguments" + (org-ql-expect ((ts :type inactive)) + '("Test data" "Visit the moon" "Learn universal sign language" "Rewrite Emacs in Common Lisp"))) + + (org-ql-it ":from a timestamp" + (org-ql-expect ((ts :from "2017-07-06" :type inactive)) + '("Visit the moon" "Rewrite Emacs in Common Lisp")) + (org-ql-expect ((ts :from "2019-06-08" :type inactive)) + nil)) + + (org-ql-it ":to a timestamp" + (org-ql-expect ((ts :to "2019-06-10" :type inactive)) + '("Test data" "Visit the moon" "Learn universal sign language" "Rewrite Emacs in Common Lisp")) + (org-ql-expect ((ts :to "2017-07-04" :type inactive)) + 'nil)) + + (org-ql-it ":on a timestamp" + (org-ql-expect ((ts :on "2017-07-05" :type inactive)) + '("Test data" "Learn universal sign language")) + (org-ql-expect ((ts :on "2019-06-09" :type inactive)) + nil))) + + (describe "both" + + (org-ql-it "without arguments" + (org-ql-expect ((ts)) + '("Test data" "Take over the universe" "Take over the world" "Skype with president of Antarctica" "Visit Mars" "Visit the moon" "Practice leaping tall buildings in a single bound" "Renew membership in supervillain club" "Learn universal sign language" "Order a pizza" "Get haircut" "Internet" "Spaceship lease" "Fix flux capacitor" "/r/emacs" "Shop for groceries" "Rewrite Emacs in Common Lisp")) + (org-ql-expect ((ts :type both)) + '("Test data" "Take over the universe" "Take over the world" "Skype with president of Antarctica" "Visit Mars" "Visit the moon" "Practice leaping tall buildings in a single bound" "Renew membership in supervillain club" "Learn universal sign language" "Order a pizza" "Get haircut" "Internet" "Spaceship lease" "Fix flux capacitor" "/r/emacs" "Shop for groceries" "Rewrite Emacs in Common Lisp"))) + + (org-ql-it ":from a timestamp" + ;; TODO: Figure out why these take longer than the other (ts) tests. + (org-ql-expect ((ts :from "2017-07-05")) + '("Test data" "Take over the universe" "Take over the world" "Visit Mars" "Visit the moon" "Practice leaping tall buildings in a single bound" "Renew membership in supervillain club" "Learn universal sign language" "Order a pizza" "Get haircut" "Internet" "Spaceship lease" "Fix flux capacitor" "/r/emacs" "Shop for groceries" "Rewrite Emacs in Common Lisp")) + (org-ql-expect ((ts :from "2017-07-05" :type both)) + '("Test data" "Take over the universe" "Take over the world" "Visit Mars" "Visit the moon" "Practice leaping tall buildings in a single bound" "Renew membership in supervillain club" "Learn universal sign language" "Order a pizza" "Get haircut" "Internet" "Spaceship lease" "Fix flux capacitor" "/r/emacs" "Shop for groceries" "Rewrite Emacs in Common Lisp")) + (org-ql-expect ((ts :from "2019-06-08")) + nil) + (org-ql-expect ((ts :from "2019-06-08" :type both)) + nil)) + + (org-ql-it ":to a timestamp" + (org-ql-expect ((ts :to "2017-07-06")) + '("Test data" "Skype with president of Antarctica" "Practice leaping tall buildings in a single bound" "Learn universal sign language" "Order a pizza" "Get haircut" "Fix flux capacitor" "/r/emacs" "Shop for groceries" "Rewrite Emacs in Common Lisp")) + (org-ql-expect ((ts :to "2017-07-06" :type both)) + '("Test data" "Skype with president of Antarctica" "Practice leaping tall buildings in a single bound" "Learn universal sign language" "Order a pizza" "Get haircut" "Fix flux capacitor" "/r/emacs" "Shop for groceries" "Rewrite Emacs in Common Lisp")) + (org-ql-expect ((ts :to "2017-07-04")) + '("Skype with president of Antarctica")) + (org-ql-expect ((ts :to "2017-07-04" :type both)) + '("Skype with president of Antarctica"))) + + (org-ql-it ":on a timestamp" + (org-ql-expect ((ts :on "2017-07-05")) + '("Test data" "Practice leaping tall buildings in a single bound" "Learn universal sign language" "Order a pizza" "Get haircut" "Fix flux capacitor" "/r/emacs" "Shop for groceries" "Rewrite Emacs in Common Lisp")) + (org-ql-expect ((ts :on "2017-07-05" :type both)) + '("Test data" "Practice leaping tall buildings in a single bound" "Learn universal sign language" "Order a pizza" "Get haircut" "Fix flux capacitor" "/r/emacs" "Shop for groceries" "Rewrite Emacs in Common Lisp")) + (org-ql-expect ((ts :on "2019-06-09")) + nil) + (org-ql-expect ((ts :on "2019-06-09" :type both)) + nil)))) (describe "Compound queries" From a425c45afd563f9b0303fe76ab5a933380574531 Mon Sep 17 00:00:00 2001 From: Adam Porter Date: Sun, 11 Aug 2019 16:40:05 -0500 Subject: [PATCH 092/798] Add: ts preambles --- notes.org | 151 ++++++++++++++++++++++++++++++++++++++++++++++++++++++ org-ql.el | 9 ++++ 2 files changed, 160 insertions(+) diff --git a/notes.org b/notes.org index 0c8591b..0493271 100644 --- a/notes.org +++ b/notes.org @@ -647,6 +647,157 @@ If tag inheritance is enabled, we have to check tags on every heading. When it' | preamble: (tags "Emacs") | 2.08 | 0.274555 | 0 | 0 | | no preamble: (tags "Emacs") | slowest | 0.570116 | 0 | 0 | +*** ~ts~ + +#+BEGIN_SRC elisp + (org-ql-preamble-bench :times 1 + :file "~/org/inbox.org" + :query (ts)) +#+END_SRC + +#+RESULTS: +| Form | x faster than next | Total runtime | # of GCs | Total GC runtime | +|-------------------+--------------------+---------------+----------+------------------| +| preamble: (ts) | 1.13 | 0.475646 | 0 | 0 | +| no preamble: (ts) | slowest | 0.535950 | 0 | 0 | + +#+BEGIN_SRC elisp + (org-ql-preamble-bench :times 1 + :file "~/org/inbox.org" + :query (ts :from "2019-01-01")) +#+END_SRC + +#+RESULTS: +| Form | x faster than next | Total runtime | # of GCs | Total GC runtime | +|--------------------------------------+--------------------+---------------+----------+------------------| +| no preamble: (ts :from "2019-01-01") | 1.11 | 0.537445 | 0 | 0 | +| preamble: (ts :from "2019-01-01") | slowest | 0.594534 | 0 | 0 | + +#+BEGIN_SRC elisp + (org-ql-preamble-bench :times 1 + :file "~/org/inbox.org" + :query (ts :from "2017-01-01")) +#+END_SRC + +#+RESULTS: +| Form | x faster than next | Total runtime | # of GCs | Total GC runtime | +|--------------------------------------+--------------------+---------------+----------+------------------| +| no preamble: (ts :from "2017-01-01") | 1.13 | 0.526891 | 0 | 0 | +| preamble: (ts :from "2017-01-01") | slowest | 0.594360 | 0 | 0 | + +Not sure why that one is slower with preamble. + +#+BEGIN_SRC elisp + (org-ql-preamble-bench :times 10 + :query (ts :from "2017-01-01")) +#+END_SRC + +#+RESULTS: +| Form | x faster than next | Total runtime | # of GCs | Total GC runtime | +|--------------------------------------+--------------------+---------------+----------+------------------| +| no preamble: (ts :from "2017-01-01") | 1.04 | 0.025688 | 0 | 0 | +| preamble: (ts :from "2017-01-01") | slowest | 0.026642 | 0 | 0 | + +#+BEGIN_SRC elisp + (org-ql-preamble-bench :times 1 + :file "~/org/inbox.org" + :query (ts :to "2010-01-01")) +#+END_SRC + +#+RESULTS: +| Form | x faster than next | Total runtime | # of GCs | Total GC runtime | +|------------------------------------+--------------------+---------------+----------+------------------| +| no preamble: (ts :to "2010-01-01") | 1.10 | 0.538603 | 0 | 0 | +| preamble: (ts :to "2010-01-01") | slowest | 0.593466 | 0 | 0 | + +*** ~ts-active~ + +#+BEGIN_SRC elisp + (org-ql-preamble-bench :times 1 + :file "~/org/inbox.org" + :query (ts-a)) +#+END_SRC + +#+RESULTS: +| Form | x faster than next | Total runtime | # of GCs | Total GC runtime | +|---------------------+--------------------+---------------+----------+------------------| +| preamble: (ts-a) | 4.77 | 0.071489 | 0 | 0 | +| no preamble: (ts-a) | slowest | 0.340896 | 0 | 0 | + +#+BEGIN_SRC elisp + (org-ql-preamble-bench :times 1 + :file "~/org/inbox.org" + :query (ts-a :from "2017-07-06")) +#+END_SRC + +#+RESULTS: +| Form | x faster than next | Total runtime | # of GCs | Total GC runtime | +|----------------------------------------+--------------------+---------------+----------+------------------| +| preamble: (ts-a :from "2017-07-06") | 1.78 | 0.188369 | 0 | 0 | +| no preamble: (ts-a :from "2017-07-06") | slowest | 0.335975 | 0 | 0 | + +#+BEGIN_SRC elisp + (org-ql-preamble-bench :times 1 + :file "~/org/inbox.org" + :query (ts-a :to "2017-07-06")) +#+END_SRC + +#+RESULTS: +| Form | x faster than next | Total runtime | # of GCs | Total GC runtime | +|--------------------------------------+--------------------+---------------+----------+------------------| +| preamble: (ts-a :to "2017-07-06") | 4.64 | 0.075307 | 0 | 0 | +| no preamble: (ts-a :to "2017-07-06") | slowest | 0.349445 | 0 | 0 | + +#+BEGIN_SRC elisp + (org-ql-preamble-bench :times 1 + :file "~/org/inbox.org" + :query (ts-a :on "2017-07-06")) +#+END_SRC + +#+RESULTS: +| Form | x faster than next | Total runtime | # of GCs | Total GC runtime | +|--------------------------------------+--------------------+---------------+----------+------------------| +| preamble: (ts-a :on "2017-07-06") | 4.33 | 0.076075 | 0 | 0 | +| no preamble: (ts-a :on "2017-07-06") | slowest | 0.329106 | 0 | 0 | + +*** ~ts-inactive~ + +#+BEGIN_SRC elisp + (org-ql-preamble-bench :times 1 + :file "~/org/inbox.org" + :query (ts-i)) +#+END_SRC + +#+RESULTS: +| Form | x faster than next | Total runtime | # of GCs | Total GC runtime | +|---------------------+--------------------+---------------+----------+------------------| +| preamble: (ts-i) | 1.21 | 0.459152 | 0 | 0 | +| no preamble: (ts-i) | slowest | 0.555632 | 0 | 0 | + +#+BEGIN_SRC elisp + (org-ql-preamble-bench :times 1 + :file "~/org/inbox.org" + :query (ts-i :from "2019-07-06")) +#+END_SRC + +#+RESULTS: +| Form | x faster than next | Total runtime | # of GCs | Total GC runtime | +|----------------------------------------+--------------------+---------------+----------+------------------| +| no preamble: (ts-i :from "2019-07-06") | 1.09 | 0.531976 | 0 | 0 | +| preamble: (ts-i :from "2019-07-06") | slowest | 0.579745 | 0 | 0 | + +#+BEGIN_SRC elisp + (org-ql-preamble-bench :times 1 + :file "~/org/inbox.org" + :query (ts-i :to "2019-07-06")) +#+END_SRC + +#+RESULTS: +| Form | x faster than next | Total runtime | # of GCs | Total GC runtime | +|--------------------------------------+--------------------+---------------+----------+------------------| +| no preamble: (ts-i :to "2019-07-06") | 1.34 | 0.553428 | 0 | 0 | +| preamble: (ts-i :to "2019-07-06") | slowest | 0.743881 | 0 | 0 | + ** with/without ts.el [2019-08-11 Sun 15:39] These results seem to show a minor performance improvement by using ~ts~, and the code is simpler. diff --git a/org-ql.el b/org-ql.el index e51accc..436c865 100644 --- a/org-ql.el +++ b/org-ql.el @@ -403,6 +403,15 @@ replace the clause with a preamble." t)) ;; Return nil, because we don't need to test the predicate. nil) + (`(ts . ,rest) + (setq org-ql-preamble (pcase (plist-get rest :type) + ((or 'nil 'both) org-tsr-regexp-both) + ('active org-tsr-regexp) + ('inactive org-ql-tsr-regexp-inactive))) + ;; Predicate needs testing only when args are present. + (-let (((&keys :from :to :on) rest)) + (when (or from to on) + element))) (`(and . ,rest) (let ((clauses (mapcar #'rec rest))) `(and ,@(-non-nil clauses)))) From 1b83c16426d2472e951a9a97887b3754f14be018 Mon Sep 17 00:00:00 2001 From: Adam Porter Date: Mon, 12 Aug 2019 18:25:42 -0500 Subject: [PATCH 093/798] Notes: Add idea --- notes.org | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/notes.org b/notes.org index 0493271..d7f445b 100644 --- a/notes.org +++ b/notes.org @@ -4,6 +4,10 @@ ** TODO Update commentary +** TODO [#B] Default sort + +Would probably be useful to have a default sort option. + ** TODO ~org-agenda-skip-function~ As discussed [[https://www.reddit.com/r/emacs/comments/cnrt2d/orgqlblock_integrates_orgql_into_org_agenda/ewi1q36/][here]], this is a cool feature that allows further integration into existing custom agenda commands. Example: From fbdfe58a086ea315a272b88a0028d9a90b28b904 Mon Sep 17 00:00:00 2001 From: Adam Porter Date: Mon, 12 Aug 2019 19:22:00 -0500 Subject: [PATCH 094/798] Notes: Add idea and results --- notes.org | 39 +++++++++++++++++++++++++++++++++++++++ 1 file changed, 39 insertions(+) diff --git a/notes.org b/notes.org index d7f445b..9b3f2d1 100644 --- a/notes.org +++ b/notes.org @@ -1707,3 +1707,42 @@ org-super-agenda--filter-finalize-entries 5 0.1316 | re-search-forward | 3754 | 0.0739803739 | 1.970...e-05 | | org-inlinetask-in-task-p | 1365 | 0.0657829330 | 4.819...e-05 | | org-agenda-ng--scheduled-p | 1247 | 0.0619497850 | 4.967...e-05 | + +** Intersecting query results + +An idea that /might/ be helpful for performance in /some/ cases, depending on the query, the data, and whether the query has a preamble. But it looks like it would very rarely be helpful. + +#+BEGIN_SRC elisp + (cl-defun org-ql-agenda-intersection (buffers-files queries &key entries sort buffer narrow super-groups) + "Like `org-ql-agenda', but intersects multiple queries." + (declare (indent defun)) + (let* ((entries (->> queries + (--map (org-ql-select buffers-files + it + :action 'element-with-markers + :narrow narrow + :sort sort)) + (-reduce #'-intersection)))) + (org-ql-agenda--agenda buffers-files queries + :entries entries :super-groups super-groups))) + + (bench-multi-lexical :times 1 + :forms (("intersection" (let ((org-use-tag-inheritance nil)) + (org-ql-agenda-intersection (org-agenda-files) + '((todo "TODO") + (tags "Emacs")) + :sort '(priority deadline) + :super-groups org-super-agenda-groups))) + ("normal" (let ((org-use-tag-inheritance nil)) + (org-ql-agenda (org-agenda-files) + (and (todo "TODO") + (tags "Emacs")) + :sort (priority deadline) + :super-groups org-super-agenda-groups))))) +#+END_SRC + +#+RESULTS: +| Form | x faster than next | Total runtime | # of GCs | Total GC runtime | +|--------------+--------------------+---------------+----------+------------------| +| normal | 4.03 | 0.275053 | 0 | 0 | +| intersection | slowest | 1.109169 | 0 | 0 | From e97d2c0af3e1d30cecfbc55ea3f3e8e034b76353 Mon Sep 17 00:00:00 2001 From: Adam Porter Date: Mon, 12 Aug 2019 20:45:44 -0500 Subject: [PATCH 095/798] Add: org-ql-agenda-face --- README.org | 1 + org-ql-agenda.el | 8 +++++++- 2 files changed, 8 insertions(+), 1 deletion(-) diff --git a/README.org b/README.org index fee9ab9..e7cd729 100644 --- a/README.org +++ b/README.org @@ -365,6 +365,7 @@ Expands into a call to ~org-ql-select~ with the same arguments. For convenience + Function ~org-ql-agenda--agenda~ optionally takes a list of entries as an argument. + Selectors ~ts-a~ and ~ts-i~, aliases for ~ts-active~ and ~ts-inactive~. + Selector ~ts~ now accepts a ~:type~ argument. ++ Face =org-ql-agenda-due-date=. *Changed* + Function ~org-ql-query~ renamed to ~org-ql-select~. ~org-ql-query~ now refers to a new function. diff --git a/org-ql-agenda.el b/org-ql-agenda.el index 5423887..93f67f4 100644 --- a/org-ql-agenda.el +++ b/org-ql-agenda.el @@ -48,6 +48,12 @@ (when (version< org-version "9.2") (defalias 'org-get-tags #'org-get-tags-at)) +;;;; Faces + +(defface org-ql-agenda-due-date + '((t (:slant italic :weight bold))) + "Face for due dates in `org-ql-agenda' views.") + ;;;; Variables (defvar org-ql-agenda-buffer-name "*Org-QL-Agenda*" @@ -385,7 +391,7 @@ return an empty string." (org-habit-parse-todo)))) (due-string (pcase (org-element-property :relative-due-date element) ('nil "") - (string (format " %s " (org-add-props string nil 'face 'underline))))) + (string (format " %s " (org-add-props string nil 'face 'org-ql-agenda-due-date))))) (string (s-join " " (-non-nil (list todo-keyword priority-string title due-string tag-string))))) (remove-list-of-text-properties 0 (length string) '(line-prefix) string) ;; Add all the necessary properties and faces to the whole string From 5174aca4e8fe956abae7161d15058702bc8874c1 Mon Sep 17 00:00:00 2001 From: Adam Porter Date: Mon, 12 Aug 2019 20:46:35 -0500 Subject: [PATCH 096/798] Tidy: (org-ql-agenda--format-element) --- org-ql-agenda.el | 9 +++++---- 1 file changed, 5 insertions(+), 4 deletions(-) diff --git a/org-ql-agenda.el b/org-ql-agenda.el index 93f67f4..8b71892 100644 --- a/org-ql-agenda.el +++ b/org-ql-agenda.el @@ -377,10 +377,11 @@ return an empty string." (warn "No marker found for item: %s" title) (org-element-property :tags element)) (org-element-property :tags element))) - (tag-string (-some--> tag-list - (s-join ":" it) - (s-wrap it ":") - (org-add-props it nil 'face 'org-tag))) + (tag-string (when tag-list + (--> tag-list + (s-join ":" it) + (s-wrap it ":") + (org-add-props it nil 'face 'org-tag)))) ;; (category (org-element-property :category element)) (priority-string (-some->> (org-element-property :priority element) (char-to-string) From 2b47e7c7b0ab60bf860e0ce463c44807f88000f9 Mon Sep 17 00:00:00 2001 From: Adam Porter Date: Tue, 13 Aug 2019 13:14:11 -0500 Subject: [PATCH 097/798] Comment: Add FIXME --- org-ql.el | 2 ++ 1 file changed, 2 insertions(+) diff --git a/org-ql.el b/org-ql.el index 436c865..2f87f47 100644 --- a/org-ql.el +++ b/org-ql.el @@ -429,6 +429,8 @@ replace the clause with a preamble." "Return results for ARGS and current buffer using cache." ;; MAYBE: Timeout cached queries. Probably not necessarily since they will be removed when a ;; buffer is closed, or when a query is run after modifying a buffer. + ;; FIXME: Narrowed queries should conflict in the cache, because the region is not + ;; stored. We should either not cache narrow queries, or store the region with it. (-let (((&plist :query query :action action :narrow narrow) args)) (if-let* ((buffer-cache (gethash (current-buffer) org-ql-cache)) (query-cache (cadr buffer-cache)) From b641e6d53cfc6b4655a34ea9de8b5d3fe275a040 Mon Sep 17 00:00:00 2001 From: Adam Porter Date: Tue, 13 Aug 2019 13:19:08 -0500 Subject: [PATCH 098/798] Comment: Add TODO --- org-ql.el | 1 + 1 file changed, 1 insertion(+) diff --git a/org-ql.el b/org-ql.el index 2f87f47..daed79a 100644 --- a/org-ql.el +++ b/org-ql.el @@ -395,6 +395,7 @@ replace the clause with a preamble." (setq org-ql-preamble (rx-to-string `(seq bol (0+ (any " ")) "SCHEDULED" ":") t)) ;; Return element, because the predicate still needs testing. element) + ;; TODO: Add selector for tags without inheritance. ((and `(tags . ,tags) (guard (not org-use-tag-inheritance))) ;; When tag inheritance is disabled, we only consider direct tags, ;; so we can search directly to headings containing one of the tags. From 31bc01bc52c584b0f4d29e51e0241b8ccac6bde2 Mon Sep 17 00:00:00 2001 From: Adam Porter Date: Tue, 13 Aug 2019 13:48:56 -0500 Subject: [PATCH 099/798] Fix: (org-ql--pre-process-query) Process (not) clauses --- org-ql.el | 1 + 1 file changed, 1 insertion(+) diff --git a/org-ql.el b/org-ql.el index daed79a..49dfc8e 100644 --- a/org-ql.el +++ b/org-ql.el @@ -246,6 +246,7 @@ Replaces bare strings with (regexp) selectors, and appropriate (pcase element (`(or . ,clauses) `(or ,@(mapcar #'rec clauses))) (`(and . ,clauses) `(and ,@(mapcar #'rec clauses))) + (`(not . ,clauses) `(not ,@(mapcar #'rec clauses))) (`(when ,condition . ,clauses) `(when ,(rec condition) ,@(mapcar #'rec clauses))) (`(unless ,condition . ,clauses) `(unless ,(rec condition) From 515b4960c40e6ed6dd5ab404c2bc133fa1225ec7 Mon Sep 17 00:00:00 2001 From: Adam Porter Date: Tue, 13 Aug 2019 13:57:34 -0500 Subject: [PATCH 100/798] Change: (todo) Don't match done tasks --- README.org | 3 ++- org-ql.el | 2 +- tests/test-org-ql.el | 3 +-- 3 files changed, 4 insertions(+), 4 deletions(-) diff --git a/README.org b/README.org index e7cd729..ad6d25f 100644 --- a/README.org +++ b/README.org @@ -150,7 +150,7 @@ Arguments are listed next to predicate names, where applicable. + ~regexp (regexp)~ :: Return non-nil if current entry matches ~REGEXP~ (a regexp string). + ~scheduled (&optional comparator target-date)~ :: Return non-nil if entry's scheduled date compares with ~TARGET-DATE~ using ~COMPARATOR~. ~TARGET-DATE~ should be a string parseable by ~date-to-day~. ~COMPARATOR~ should be a function (like ~<=~). + ~tags (&optional tags)~ :: Return non-nil if current heading has one or more of ~TAGS~ (a list of strings). -+ ~todo (&optional keywords)~ :: Return non-nil if current heading is a ~TODO~ item. With ~KEYWORDS~, return non-nil if its keyword is one of ~KEYWORDS~ (a list of strings). ++ ~todo (&optional keywords)~ :: Return non-nil if current heading is a ~TODO~ item. With ~KEYWORDS~, return non-nil if its keyword is one of ~KEYWORDS~ (a list of strings). When called without arguments, only matches non-done tasks (i.e. does not match keywords in ~org-done-keywords~). + ~ts (&key from to on type)~ :: Return non-nil if current entry has a timestamp in given period. If no arguments are specified, return non-nil if entry has any timestamp. If ~FROM~, return non-nil if entry has a timestamp on or after ~FROM~. If ~TO~, return non-nil if entry has a timestamp on or before ~TO~. If ~ON~, return non-nil if entry has a timestamp on date ~ON~. ~FROM~, ~TO~, and ~ON~ should be strings parseable by ~parse-time-string~ but may omit the time value. ~TYPE~ may be ~active~ to match active timestamps, ~inactive~ to match inactive ones, or ~both~ / nil to match both types. + ~ts-active~ :: Like ~ts~ called with ~:type active~. + ~ts-a~ :: Like ~ts~ called with ~:type active~. @@ -370,6 +370,7 @@ Expands into a call to ~org-ql-select~ with the same arguments. For convenience *Changed* + Function ~org-ql-query~ renamed to ~org-ql-select~. ~org-ql-query~ now refers to a new function. + Macro ~org-ql~ no longer accepts a ~:markers~ argument. Instead, use argument ~:action element-with-markers~. See function ~org-ql-select~, which ~org-ql~ calls. ++ Selector ~(todo)~ no longer matches "done" keywords when used without arguments (i.e. the ones in variable ~org-done-keywords~). *Fixed* + Handle date ranges in date-based selectors. (Thanks to [[https://github.com/codygman][Cody Goodman]], [[https://github.com/swflint][Samuel W. Flint]], and [[https://github.com/vikasrawal][Vikas Rawal]].) diff --git a/org-ql.el b/org-ql.el index 49dfc8e..591031e 100644 --- a/org-ql.el +++ b/org-ql.el @@ -600,7 +600,7 @@ ignored." With KEYWORDS, return non-nil if its keyword is one of KEYWORDS (a list of strings)." (when-let ((state (org-get-todo-state))) (cl-typecase keywords - (null t) + (null (not (member state org-done-keywords))) (list (member state keywords)) (symbol (member state (symbol-value keywords))) (otherwise (user-error "Invalid todo keywords: %s" keywords))))) diff --git a/tests/test-org-ql.el b/tests/test-org-ql.el index 13f7d97..a97d875 100644 --- a/tests/test-org-ql.el +++ b/tests/test-org-ql.el @@ -382,10 +382,9 @@ RESULTS should be a list of strings as returned by (describe "(todo)" (org-ql-it "without arguments" - ;; FIXME: This returns an item that is done, which is incorrect. (org-ql-expect ((todo) :sort todo) - '("Take over the universe" "Take over the world" "Skype with president of Antarctica" "Take over Mars" "Visit Mars" "Take over the moon" "Visit the moon" "Practice leaping tall buildings in a single bound" "Renew membership in supervillain club" "Learn universal sign language" "Order a pizza" "Get haircut" "Internet" "Spaceship lease" "Fix flux capacitor" "/r/emacs" "Shop for groceries" "Rewrite Emacs in Common Lisp" "Write a symphony"))) + '("Take over the universe" "Take over the world" "Skype with president of Antarctica" "Take over Mars" "Visit Mars" "Take over the moon" "Visit the moon" "Practice leaping tall buildings in a single bound" "Renew membership in supervillain club" "Order a pizza" "Get haircut" "Internet" "Spaceship lease" "Fix flux capacitor" "/r/emacs" "Shop for groceries" "Rewrite Emacs in Common Lisp" "Write a symphony"))) (org-ql-it "with 1 argument" ;; FIXME: Figure out why this takes >10x longer than the other (todo) From 76debff1c5960d2f4118928a88e7f25cb6deb02b Mon Sep 17 00:00:00 2001 From: Adam Porter Date: Tue, 13 Aug 2019 13:59:53 -0500 Subject: [PATCH 101/798] Add: Selectors (children) and (descendants) --- README.org | 10 ++++++++++ org-ql.el | 31 +++++++++++++++++++++++++++++++ tests/test-org-ql.el | 23 +++++++++++++++++++++++ 3 files changed, 64 insertions(+) diff --git a/README.org b/README.org index ad6d25f..32dada2 100644 --- a/README.org +++ b/README.org @@ -73,6 +73,13 @@ More examples are available in [[examples.org]]. (tags "Emacs") (priority "A"))) (agenda))))) + + ;; Show a "stuck projects" view: tasks that are not done and have only + ;; non-task children. + (org-ql-agenda (org-agenda-files) + (and (todo) + (children) + (not (children (todo))))) #+END_SRC * Usage @@ -136,10 +143,12 @@ A query is a lisp form which may contain arbitrary lisp forms, as well as certai Arguments are listed next to predicate names, where applicable. + ~category (&optional categories)~ :: Return non-nil if current heading is in one or more of ~CATEGORIES~ (a list of strings). ++ ~children (&optional query)~ :: Return non-nil if current heading has direct child headings. If ~QUERY~, test it against child headings. This selector may be nested, e.g. to match grandchild headings. + ~clocked (&key from to on)~ :: Return non-nil if current entry was clocked in given period. If no arguments are specified, return non-nil if entry was clocked at any time. If ~FROM~, return non-nil if entry was clocked on or after ~FROM~. If ~TO~, return non-nil if entry was clocked on or before ~TO~. If ~ON~, return non-nil if entry was clocked on date ~ON~. ~FROM~, ~TO~, and ~ON~ should be strings parseable by ~parse-time-string~ but may omit the time value. Note: Clock entries are expected to be clocked out. Currently clocked entries (i.e. with unclosed timestamp ranges) are ignored. + ~closed (&optional comparator target-date)~ :: Return non-nil if entry's closed date compares with ~TARGET-DATE~ using ~COMPARATOR~. ~TARGET-DATE~ should be a string parseable by ~date-to-day~. ~COMPARATOR~ should be a function (like ~<=~). + ~date (&optional comparator target-date type)~ :: Return non-nil if Org entry at point has date of ~TYPE~ that compares with ~TARGET-DATE~ using ~COMPARATOR~. Checks all Org-formatted timestamp strings in entry. ~TYPE~ may be ~active~, ~inactive~, or ~all~, to control whether active, inactive, or all timestamps are checked. Ranges of each type are also checked. ~TARGET-DATE~ should be a string parseable by ~date-to-day~. ~COMPARATOR~ should be a function (like ~<=~). + ~deadline (&optional comparator target-date)~ :: Return non-nil if entry's deadline compares with ~TARGET-DATE~ using ~COMPARATOR~. ~TARGET-DATE~ should be a string parseable by ~date-to-day~; or if omitted, it is determined automatically using ~org-deadline-warning-days~. ~COMPARATOR~ should be a function (like ~<=~). ++ ~descendants (&optional query)~ :: Return non-nil if current heading has descendant headings. If ~QUERY~, test it against descendant headings. This selector may be nested (if you can grok the nesting!). + ~done~ :: Return non-nil if entry's ~TODO~ keyword is in ~org-done-keywords~. + ~habit~ :: Return non-nil if entry is a habit. + ~heading (regexp)~ :: Return non-nil if current entry's heading matches ~REGEXP~ (a regexp string). @@ -366,6 +375,7 @@ Expands into a call to ~org-ql-select~ with the same arguments. For convenience + Selectors ~ts-a~ and ~ts-i~, aliases for ~ts-active~ and ~ts-inactive~. + Selector ~ts~ now accepts a ~:type~ argument. + Face =org-ql-agenda-due-date=. ++ Selectors ~(children)~ and ~(descendants)~. *Changed* + Function ~org-ql-query~ renamed to ~org-ql-select~. ~org-ql-query~ now refers to a new function. diff --git a/org-ql.el b/org-ql.el index 591031e..377db58 100644 --- a/org-ql.el +++ b/org-ql.el @@ -253,6 +253,11 @@ Replaces bare strings with (regexp) selectors, and appropriate ,@(mapcar #'rec clauses))) ;; TODO: Combine (regexp) when appropriate (i.e. inside an OR, not an AND). ((pred stringp) `(regexp ,element)) + ;; Quote children queries so the user doesn't have to. + (`(children ,query) `(children ',query)) + (`(children) '(children (lambda () t))) + (`(descendants ,query) `(descendants ',query)) + (`(descendants) '(descendants (lambda () t))) (`(,(or 'ts-active 'ts-a) . ,rest) `(ts :type active ,@rest)) (`(,(or 'ts-inactive 'ts-i) . ,rest) `(ts :type inactive ,@rest)) (_ element)))) @@ -549,6 +554,32 @@ empty time values to 23:59:59; otherwise, to 00:00:00." ;;;;; Predicates +(org-ql--defpred children (query) + "Return non-nil if current entry has children matching QUERY." + (save-excursion + (save-restriction + (org-narrow-to-subtree) + (when (org-goto-first-child) + ;; Lisp makes this easy and elegant: all we do is modify the query, + ;; nesting it inside an (and), and it doesn't descend into grandchildren. + (let* ((level (org-current-level)) + (query (cl-typecase query + (byte-code-function `(and (level ,level) + (funcall ,query))) + (t `(and (level ,level) + ,query))))) + (org-ql-select (current-buffer) + query :narrow t :action (lambda () t))))))) + +(org-ql--defpred descendants (query) + "Return non-nil if current entry has descendants matching QUERY." + (save-excursion + (save-restriction + (org-narrow-to-subtree) + (when (org-goto-first-child) + (org-ql-select (current-buffer) + query :narrow t :action (lambda () t)))))) + (org-ql--defpred clocked (&key from to _on) ;; The underscore before `on' prevents "unused lexical variable" warnings, because we ;; pre-process that argument in a macro before this function is called. diff --git a/tests/test-org-ql.el b/tests/test-org-ql.el index a97d875..245aa2c 100644 --- a/tests/test-org-ql.el +++ b/tests/test-org-ql.el @@ -219,6 +219,29 @@ RESULTS should be a list of strings as returned by (org-ql-expect ((category "ambition")) '("Take over the universe" "Take over the world" "Skype with president of Antarctica" "Take over Mars" "Visit Mars" "Take over the moon" "Visit the moon" "Practice leaping tall buildings in a single bound" "Renew membership in supervillain club" "Learn universal sign language")))) + (describe "(children)" + (org-ql-it "without arguments" + (org-ql-expect ((children)) + '("Test data" "Take over the universe" "Take over the world" "Take over Mars" "Take over the moon" "Recurring" "Ideas" "Code" "Misc"))) + (org-ql-it "with sub-query" + (org-ql-expect ((children (todo "CHECK"))) + '("Recurring"))) + (org-ql-it "with grandchildren query" + ;; It's really cool how this works. It's so simple. + (org-ql-expect ((children (children "moon"))) + '("Test data" "Take over the universe")))) + + (describe "(descendants)" + (org-ql-it "without arguments" + (org-ql-expect ((descendants)) + '("Test data" "Take over the universe" "Take over the world" "Take over Mars" "Take over the moon" "Recurring" "Ideas" "Code" "Misc"))) + (org-ql-it "with sub-query" + (org-ql-expect ((descendants (todo "CHECK"))) + '("Test data" "Recurring"))) + (org-ql-it "with granddescendants query" + (org-ql-expect ((descendants (descendants "moon"))) + '("Test data" "Take over the universe" "Take over the moon" "Code")))) + (describe "(clocked)" (org-ql-it "without arguments" From b634647e466a7b25effddfbc535d61251c6629df Mon Sep 17 00:00:00 2001 From: Adam Porter Date: Tue, 13 Aug 2019 14:37:27 -0500 Subject: [PATCH 102/798] Fix: (org-ql--select) Don't search buffers without headings Especially important when using org-ql-search to search "all" Org buffers. --- README.org | 1 + org-ql.el | 26 +++++++++++++++++--------- 2 files changed, 18 insertions(+), 9 deletions(-) diff --git a/README.org b/README.org index 32dada2..38a79e2 100644 --- a/README.org +++ b/README.org @@ -385,6 +385,7 @@ Expands into a call to ~org-ql-select~ with the same arguments. For convenience *Fixed* + Handle date ranges in date-based selectors. (Thanks to [[https://github.com/codygman][Cody Goodman]], [[https://github.com/swflint][Samuel W. Flint]], and [[https://github.com/vikasrawal][Vikas Rawal]].) + Don't overwrite bindings in =org-agenda-mode-map=. ++ Don't search buffers without headings, and show a message if the user attempts it. *Compatibility* + Fixes for compatibility with Org 9.2. (Thanks to [[https://github.com/ataias][Ataias Pereira Reis]] and [[https://github.com/dakra][Daniel Kraus]].) diff --git a/org-ql.el b/org-ql.el index 377db58..ca38445 100644 --- a/org-ql.el +++ b/org-ql.el @@ -487,15 +487,23 @@ If NARROW is non-nil, buffer will not be widened." (goto-char (point-min)) (when (org-before-first-heading-p) (outline-next-heading)) - ;; `cl-loop' makes this double-while much clearer than the expanded form. - (cond (preamble-re (cl-loop while (re-search-forward preamble-re nil t) - do (outline-back-to-heading 'invisible-ok) - when (funcall predicate) - collect (funcall action) - do (outline-next-heading))) - (t (cl-loop when (funcall predicate) - collect (funcall action) - while (outline-next-heading))))))) + (if (not (org-at-heading-p)) + (progn + ;; No headings in buffer: return nil. + (unless (string-prefix-p " " (buffer-name)) + ;; Not a special, hidden buffer: show message, because if a user accidentally + ;; searches a buffer without headings, he might be confused. + (message "org-ql: No headings in buffer: %s" (current-buffer))) + nil) + ;; `cl-loop' makes this double-while much clearer than the expanded form. + (cond (preamble-re (cl-loop while (re-search-forward preamble-re nil t) + do (outline-back-to-heading 'invisible-ok) + when (funcall predicate) + collect (funcall action) + do (outline-next-heading))) + (t (cl-loop when (funcall predicate) + collect (funcall action) + while (outline-next-heading)))))))) (--each orig-fns ;; Restore original function mappings. (fset (plist-get it :name) (plist-get it :fn)))))) From 3856e61800a12553c2d75213f261b7435bdfad01 Mon Sep 17 00:00:00 2001 From: Adam Porter Date: Tue, 13 Aug 2019 15:05:47 -0500 Subject: [PATCH 103/798] Fix: (org-ql-select) Don't search hidden/special buffers --- README.org | 1 + org-ql.el | 4 +++- 2 files changed, 4 insertions(+), 1 deletion(-) diff --git a/README.org b/README.org index 38a79e2..2726fdd 100644 --- a/README.org +++ b/README.org @@ -386,6 +386,7 @@ Expands into a call to ~org-ql-select~ with the same arguments. For convenience + Handle date ranges in date-based selectors. (Thanks to [[https://github.com/codygman][Cody Goodman]], [[https://github.com/swflint][Samuel W. Flint]], and [[https://github.com/vikasrawal][Vikas Rawal]].) + Don't overwrite bindings in =org-agenda-mode-map=. + Don't search buffers without headings, and show a message if the user attempts it. ++ Don't search hidden/special buffers. *Compatibility* + Fixes for compatibility with Org 9.2. (Thanks to [[https://github.com/ataias][Ataias Pereira Reis]] and [[https://github.com/dakra][Daniel Kraus]].) diff --git a/org-ql.el b/org-ql.el index ca38445..c3e370c 100644 --- a/org-ql.el +++ b/org-ql.el @@ -156,7 +156,9 @@ non-nil." ;; It feels unintuitive that `find-file-noselect' returns ;; a buffer if the filename doesn't exist. (find-file-noselect it)) - (user-error "Can't open file: %s" it))))))) + (user-error "Can't open file: %s" it))))) + ;; Ignore special/hidden buffers. + (--remove (string-prefix-p " " (buffer-name it))))) (query (org-ql--pre-process-query query)) ((query preamble-re) (org-ql--query-preamble query)) (predicate (org-ql--query-predicate query)) From 559764aeddf7fdff77530061f237fa4a6ae6fb1e Mon Sep 17 00:00:00 2001 From: Adam Porter Date: Tue, 13 Aug 2019 15:38:47 -0500 Subject: [PATCH 104/798] Comment: Remove task Basically done. Also, I think :from/:to/:on are ultimately better than numeric comparators like <=, because it's easier to express a range of dates. --- org-ql.el | 4 ---- 1 file changed, 4 deletions(-) diff --git a/org-ql.el b/org-ql.el index c3e370c..1b0970b 100644 --- a/org-ql.el +++ b/org-ql.el @@ -751,10 +751,6 @@ comparator, PRIORITY should be a priority string." ;;;;;; Timestamps -;; TODO: Move active/inactive into (ts) predicate, allowing the first arg to be either -;; inactive/active or the comparator. Using numeric comparators is more powerful, concise, -;; and language-independent than using from/to. Alternatively, add :before/:after, but I -;; think the comparators are better. Also consider using a macro to DRY these out. (org-ql--defpred ts (&key from to _on regexp) ;; The underscore before `on' prevents "unused lexical variable" warnings, From 9f8101779cab91fdfe157d82bfd8fbd125527d49 Mon Sep 17 00:00:00 2001 From: Adam Porter Date: Tue, 13 Aug 2019 16:08:10 -0500 Subject: [PATCH 105/798] Change: (ts) Accept ts structs --- README.org | 2 +- org-ql.el | 12 ++++++++---- 2 files changed, 9 insertions(+), 5 deletions(-) diff --git a/README.org b/README.org index 2726fdd..60c6beb 100644 --- a/README.org +++ b/README.org @@ -160,7 +160,7 @@ Arguments are listed next to predicate names, where applicable. + ~scheduled (&optional comparator target-date)~ :: Return non-nil if entry's scheduled date compares with ~TARGET-DATE~ using ~COMPARATOR~. ~TARGET-DATE~ should be a string parseable by ~date-to-day~. ~COMPARATOR~ should be a function (like ~<=~). + ~tags (&optional tags)~ :: Return non-nil if current heading has one or more of ~TAGS~ (a list of strings). + ~todo (&optional keywords)~ :: Return non-nil if current heading is a ~TODO~ item. With ~KEYWORDS~, return non-nil if its keyword is one of ~KEYWORDS~ (a list of strings). When called without arguments, only matches non-done tasks (i.e. does not match keywords in ~org-done-keywords~). -+ ~ts (&key from to on type)~ :: Return non-nil if current entry has a timestamp in given period. If no arguments are specified, return non-nil if entry has any timestamp. If ~FROM~, return non-nil if entry has a timestamp on or after ~FROM~. If ~TO~, return non-nil if entry has a timestamp on or before ~TO~. If ~ON~, return non-nil if entry has a timestamp on date ~ON~. ~FROM~, ~TO~, and ~ON~ should be strings parseable by ~parse-time-string~ but may omit the time value. ~TYPE~ may be ~active~ to match active timestamps, ~inactive~ to match inactive ones, or ~both~ / nil to match both types. ++ ~ts (&key from to on type)~ :: Return non-nil if current entry has a timestamp in given period. If no arguments are specified, return non-nil if entry has any timestamp. If ~FROM~, return non-nil if entry has a timestamp on or after ~FROM~. If ~TO~, return non-nil if entry has a timestamp on or before ~TO~. If ~ON~, return non-nil if entry has a timestamp on date ~ON~. ~FROM~, ~TO~, and ~ON~ should be either ~ts~ structs, or strings parseable by ~parse-time-string~ which may omit the time value. ~TYPE~ may be ~active~ to match active timestamps, ~inactive~ to match inactive ones, or ~both~ / nil to match both types. + ~ts-active~ :: Like ~ts~ called with ~:type active~. + ~ts-a~ :: Like ~ts~ called with ~:type active~. + ~ts-inactive~ :: Like ~ts~ called with ~:type inactive~. diff --git a/org-ql.el b/org-ql.el index 1b0970b..a7757cb 100644 --- a/org-ql.el +++ b/org-ql.el @@ -290,9 +290,13 @@ Replaces bare strings with (regexp) selectors, and appropriate (setq from on to on)) (when from - (setq from (ts-parse-fill 'begin from))) + (setq from (cl-typecase from + (string (ts-parse-fill 'begin from)) + (ts from)))) (when to - (setq to (ts-parse-fill 'end to))) + (setq to (cl-typecase to + (string (ts-parse-fill 'end to)) + (ts to)))) ;; NOTE: The macro must expand to the actual `org-ql--predicate-ts' ;; function, not another `ts'. `(org-ql--predicate-ts :from ,from :to ,to @@ -768,8 +772,8 @@ If TO, return non-nil if entry has a timestamp on or before TO. If ON, return non-nil if entry has a timestamp on date ON. -FROM, TO, and ON should be strings parseable by -`parse-time-string' but may omit the time value. +FROM, TO, and ON should be either `ts' structs, or strings +parseable by `parse-time-string' which may omit the time value. TYPE may be `active' to match active timestamps, `inactive' to match inactive ones, or `both' / nil to match both types." From 1d69ab7b203ff3d7f6dd2478224c9aabaeb4876c Mon Sep 17 00:00:00 2001 From: Adam Porter Date: Tue, 13 Aug 2019 16:26:56 -0500 Subject: [PATCH 106/798] Fix: (org-ql-query) Indentation declaration --- org-ql.el | 1 + 1 file changed, 1 insertion(+) diff --git a/org-ql.el b/org-ql.el index a7757cb..f077653 100644 --- a/org-ql.el +++ b/org-ql.el @@ -234,6 +234,7 @@ ORDER-BY corresponds to the `org-ql-select' argument SORT, which see. NARROW corresponds to the `org-ql-select' argument NARROW." + (declare (indent 0)) (org-ql-select from where :action select :narrow narrow From 40b36ecad20684b118ba9da3ca22c12488a2cef4 Mon Sep 17 00:00:00 2001 From: Adam Porter Date: Tue, 13 Aug 2019 17:02:38 -0500 Subject: [PATCH 107/798] Comment: Add TODO --- org-ql.el | 2 ++ 1 file changed, 2 insertions(+) diff --git a/org-ql.el b/org-ql.el index f077653..2852157 100644 --- a/org-ql.el +++ b/org-ql.el @@ -970,6 +970,8 @@ PREDICATES is a list of one or more sorting methods, including: (-sort (sorter pred) items))) finally return items))) +;; TODO: Rewrite date sorters using `ts'. + (defun org-ql--date-type< (type a b) "Return non-nil if A's date of TYPE is earlier than B's. A and B are Org headline elements. TYPE should be a symbol like From 6b9b985c1e0373be9ed7d528131d3b7a4253bfd2 Mon Sep 17 00:00:00 2001 From: Adam Porter Date: Tue, 13 Aug 2019 17:06:39 -0500 Subject: [PATCH 108/798] Change: Use ts for all timestamp-related selectors This is much simpler, and it seems quite fast with the preambles. --- README.org | 32 ++-- org-ql.el | 391 +++++++++++++++++++++---------------------- tests/test-org-ql.el | 130 ++++++++------ 3 files changed, 293 insertions(+), 260 deletions(-) diff --git a/README.org b/README.org index 60c6beb..671810c 100644 --- a/README.org +++ b/README.org @@ -144,27 +144,34 @@ Arguments are listed next to predicate names, where applicable. + ~category (&optional categories)~ :: Return non-nil if current heading is in one or more of ~CATEGORIES~ (a list of strings). + ~children (&optional query)~ :: Return non-nil if current heading has direct child headings. If ~QUERY~, test it against child headings. This selector may be nested, e.g. to match grandchild headings. -+ ~clocked (&key from to on)~ :: Return non-nil if current entry was clocked in given period. If no arguments are specified, return non-nil if entry was clocked at any time. If ~FROM~, return non-nil if entry was clocked on or after ~FROM~. If ~TO~, return non-nil if entry was clocked on or before ~TO~. If ~ON~, return non-nil if entry was clocked on date ~ON~. ~FROM~, ~TO~, and ~ON~ should be strings parseable by ~parse-time-string~ but may omit the time value. Note: Clock entries are expected to be clocked out. Currently clocked entries (i.e. with unclosed timestamp ranges) are ignored. -+ ~closed (&optional comparator target-date)~ :: Return non-nil if entry's closed date compares with ~TARGET-DATE~ using ~COMPARATOR~. ~TARGET-DATE~ should be a string parseable by ~date-to-day~. ~COMPARATOR~ should be a function (like ~<=~). -+ ~date (&optional comparator target-date type)~ :: Return non-nil if Org entry at point has date of ~TYPE~ that compares with ~TARGET-DATE~ using ~COMPARATOR~. Checks all Org-formatted timestamp strings in entry. ~TYPE~ may be ~active~, ~inactive~, or ~all~, to control whether active, inactive, or all timestamps are checked. Ranges of each type are also checked. ~TARGET-DATE~ should be a string parseable by ~date-to-day~. ~COMPARATOR~ should be a function (like ~<=~). -+ ~deadline (&optional comparator target-date)~ :: Return non-nil if entry's deadline compares with ~TARGET-DATE~ using ~COMPARATOR~. ~TARGET-DATE~ should be a string parseable by ~date-to-day~; or if omitted, it is determined automatically using ~org-deadline-warning-days~. ~COMPARATOR~ should be a function (like ~<=~). + ~descendants (&optional query)~ :: Return non-nil if current heading has descendant headings. If ~QUERY~, test it against descendant headings. This selector may be nested (if you can grok the nesting!). + ~done~ :: Return non-nil if entry's ~TODO~ keyword is in ~org-done-keywords~. + ~habit~ :: Return non-nil if entry is a habit. + ~heading (regexp)~ :: Return non-nil if current entry's heading matches ~REGEXP~ (a regexp string). + ~level (level-or-comparator &optional level)~ :: Return non-nil if current heading's outline level matches arguments. The following forms are accepted: ~(level NUMBER)~: Matches if heading level is ~NUMBER~. ~(level NUMBER NUMBER)~: Matches if heading level is equal to or between NUMBERs. ~(level COMPARATOR NUMBER)~: Matches if heading level compares to ~NUMBER~ with ~COMPARATOR~. ~COMPARATOR~ may be ~<~, ~<=~, ~>~, or ~>=~. -+ ~planning (&optional comparator target-date)~ :: Return non-nil if entry's planning date (deadline or scheduled) compares with ~TARGET-DATE~ using ~COMPARATOR~. ~TARGET-DATE~ should be a string parseable by ~date-to-day~. ~COMPARATOR~ should be a function (like ~<=~). + ~priority (&optional comparator-or-priority priority)~ :: Return non-nil if current heading has a certain priority. ~COMPARATOR-OR-PRIORITY~ should be either a comparator function, like ~<=~, or a priority string, like "A" (in which case (~=~ will be the comparator). If ~COMPARATOR-OR-PRIORITY~ is a comparator, ~PRIORITY~ should be a priority string. + ~property (property &optional value)~ :: Return non-nil if current entry has ~PROPERTY~ (a string), and optionally ~VALUE~ (a string). Note that property inheritance is currently /not/ enabled for this predicate. If you need to test with inheritance, you could use a custom predicate form, like ~(org-entry-get (point) "PROPERTY" 'inherit)~. + ~regexp (regexp)~ :: Return non-nil if current entry matches ~REGEXP~ (a regexp string). -+ ~scheduled (&optional comparator target-date)~ :: Return non-nil if entry's scheduled date compares with ~TARGET-DATE~ using ~COMPARATOR~. ~TARGET-DATE~ should be a string parseable by ~date-to-day~. ~COMPARATOR~ should be a function (like ~<=~). + ~tags (&optional tags)~ :: Return non-nil if current heading has one or more of ~TAGS~ (a list of strings). + ~todo (&optional keywords)~ :: Return non-nil if current heading is a ~TODO~ item. With ~KEYWORDS~, return non-nil if its keyword is one of ~KEYWORDS~ (a list of strings). When called without arguments, only matches non-done tasks (i.e. does not match keywords in ~org-done-keywords~). -+ ~ts (&key from to on type)~ :: Return non-nil if current entry has a timestamp in given period. If no arguments are specified, return non-nil if entry has any timestamp. If ~FROM~, return non-nil if entry has a timestamp on or after ~FROM~. If ~TO~, return non-nil if entry has a timestamp on or before ~TO~. If ~ON~, return non-nil if entry has a timestamp on date ~ON~. ~FROM~, ~TO~, and ~ON~ should be either ~ts~ structs, or strings parseable by ~parse-time-string~ which may omit the time value. ~TYPE~ may be ~active~ to match active timestamps, ~inactive~ to match inactive ones, or ~both~ / nil to match both types. -+ ~ts-active~ :: Like ~ts~ called with ~:type active~. -+ ~ts-a~ :: Like ~ts~ called with ~:type active~. -+ ~ts-inactive~ :: Like ~ts~ called with ~:type inactive~. -+ ~ts-i~ :: Like ~ts~ called with ~:type inactive~. + +*** Date/time selectors +:PROPERTIES: +:TOC: ignore +:END: + +All of these selectors take optional keyword arguments ~:from~, ~:to:~, and ~:on~. If ~:from~, return non-nil if entry has a timestamp on or after ~:from~. If ~:to~, return non-nil if entry has a timestamp on or before ~:to~. If ~:on~, return non-nil if entry has a timestamp on date ~:on~. Argument values should be either ~ts~ structs, or strings parseable by ~parse-time-string~ which may omit the time value. + ++ ~clocked~ :: Return non-nil if current entry was clocked in given period. If no arguments are specified, return non-nil if entry was clocked at any time. Note: Clock entries are expected to be clocked out. Currently clocked entries (i.e. with unclosed timestamp ranges) are ignored. ++ ~closed~ :: Return non-nil if current entry was closed in given period. If no arguments are specified, return non-nil if entry was closed at any time. ++ ~deadline~ :: Return non-nil if current entry has deadline in given period. If no arguments are specified, return non-nil if entry has any deadline. ++ ~planning~ :: Return non-nil if current entry has planning timestamp in given period (i.e. its deadline, scheduled, or closed timestamp). If no arguments are specified, return non-nil if entry is scheduled at any time. ++ ~scheduled~ :: Return non-nil if current entry is scheduled in given period. If no arguments are specified, return non-nil if entry is scheduled at any time. ++ ~ts~ :: Return non-nil if current entry has a timestamp in given period. If no arguments are specified, return non-nil if entry has any timestamp. ++ ~ts-active~ :: Like ~ts~, but only matches active timestamps. ++ ~ts-a~ :: Like ~ts~, but only matches active timestamps. ++ ~ts-inactive~ :: Like ~ts~, but only matches inactive timestamps. ++ ~ts-i~ :: Like ~ts~, but only matches inactive timestamps. ** Functions / Macros :PROPERTIES: @@ -382,6 +389,9 @@ Expands into a call to ~org-ql-select~ with the same arguments. For convenience + Macro ~org-ql~ no longer accepts a ~:markers~ argument. Instead, use argument ~:action element-with-markers~. See function ~org-ql-select~, which ~org-ql~ calls. + Selector ~(todo)~ no longer matches "done" keywords when used without arguments (i.e. the ones in variable ~org-done-keywords~). +*Removed* ++ Selector ~(date)~, replaced by ~(ts)~. + *Fixed* + Handle date ranges in date-based selectors. (Thanks to [[https://github.com/codygman][Cody Goodman]], [[https://github.com/swflint][Samuel W. Flint]], and [[https://github.com/vikasrawal][Vikas Rawal]].) + Don't overwrite bindings in =org-agenda-mode-map=. diff --git a/org-ql.el b/org-ql.el index 2852157..f5bcebf 100644 --- a/org-ql.el +++ b/org-ql.el @@ -52,7 +52,9 @@ (defun org-ql--get-tags (&optional pos local) (org-get-tags pos local))) -;;;; Variables +;;;; Constants + +;; Note the use of the `rx' `blank' keyword, which matches "horizontal" whitespace. (defconst org-ql-tsr-regexp-inactive (concat org-ts-regexp-inactive "\\(--?-?" @@ -60,6 +62,19 @@ ;; MAYBE: Propose this for org.el. "Regular expression matching an inactive timestamp or timestamp range.") +(defconst org-ql-clock-regexp + (rx bol (0+ blank) "CLOCK:" (group (1+ not-newline))) + "Regular expression matching Org \"CLOCK:\" lines. +Like `org-clock-line-re', but matches the timestamp range in a +match group.") + +(defconst org-ql-planning-regexp + (rx bol (0+ blank) (or "CLOSED" "DEADLINE" "SCHEDULED") ":" (1+ blank) (group (1+ not-newline))) + "Regular expression matching Org \"planning\" lines. +That is, \"CLOSED:\", \"DEADLINE:\", or \"SCHEDULED:\".") + +;;;; Variables + (defvar org-ql--today nil) (defvar org-ql-use-preamble t @@ -275,17 +290,84 @@ Replaces bare strings with (regexp) selectors, and appropriate ;; for now. Most importantly, it works! (let (from to on) ;; TODO: DRY these macrolets. + ;; MAYBE: Instead of defining clocked, closed, etc. as predicates, + ;; rewrite them to call --predicate-ts directly here. Only drawback, + ;; I think, is that it would make documentation less automated. (cl-macrolet ((clocked (&key from to on) (when on (setq from on to on)) (when from - (setq from (org-ql--parse-time-string from))) + (setq from (cl-typecase from + (string (ts-parse-fill 'begin from)) + (ts from)))) (when to - (setq to (org-ql--parse-time-string to 'end))) + (setq to (cl-typecase to + (string (ts-parse-fill 'end to)) + (ts to)))) ;; NOTE: The macro must expand to the actual `org-ql--predicate-clocked' ;; function, not another `clocked'. `(org-ql--predicate-clocked :from ,from :to ,to)) + (closed (&key from to on) + (when on + (setq from on + to on)) + (when from + (setq from (cl-typecase from + (string (ts-parse-fill 'begin from)) + (ts from)))) + (when to + (setq to (cl-typecase to + (string (ts-parse-fill 'end to)) + (ts to)))) + ;; NOTE: The macro must expand to the actual `org-ql--predicate-closed' + ;; function, not another `closed'. + `(org-ql--predicate-closed :from ,from :to ,to)) + (deadline (&key from to on) + (when on + (setq from on + to on)) + (when from + (setq from (cl-typecase from + (string (ts-parse-fill 'begin from)) + (ts from)))) + (when to + (setq to (cl-typecase to + (string (ts-parse-fill 'end to)) + (ts to)))) + ;; NOTE: The macro must expand to the actual `org-ql--predicate-deadline' + ;; function, not another `deadline'. + `(org-ql--predicate-deadline :from ,from :to ,to)) + (planning (&key from to on) + (when on + (setq from on + to on)) + (when from + (setq from (cl-typecase from + (string (ts-parse-fill 'begin from)) + (ts from)))) + (when to + (setq to (cl-typecase to + (string (ts-parse-fill 'end to)) + (ts to)))) + ;; NOTE: The macro must expand to the actual `org-ql--predicate-planning' + ;; function, not another `planning'. + `(org-ql--predicate-planning :from ,from :to ,to)) + (scheduled (&key from to on) + (when on + (setq from on + to on)) + (when from + (setq from (cl-typecase from + (string (ts-parse-fill 'begin from)) + (ts from)))) + (when to + (setq to (cl-typecase to + (string (ts-parse-fill 'end to)) + (ts to)))) + ;; NOTE: The macro must expand to the actual `org-ql--predicate-scheduled' + ;; function, not another `scheduled'. + `(org-ql--predicate-scheduled :from ,from :to ,to)) (ts (&key from to on (type 'both)) (when on (setq from on @@ -327,22 +409,15 @@ replace the clause with a preamble." element) (pcase element (`(or _) element) - (`(closed . ,_) - (setq org-ql-preamble - (rx-to-string `(seq bol (0+ (any " ")) "CLOSED" ":" (1+ space) (1+ not-newline)) t)) - ;; Return element, because the predicate still needs testing. + (`(clocked . ,_) + (setq org-ql-preamble org-ql-clock-regexp) element) - (`(closed) - (setq org-ql-preamble (rx-to-string `(seq bol (0+ (any " ")) "CLOSED" ":") t)) + (`(closed . ,_) + (setq org-ql-preamble org-closed-time-regexp) ;; Return element, because the predicate still needs testing. element) (`(deadline . ,_) - (setq org-ql-preamble - (rx-to-string `(seq bol (0+ (any " ")) "DEADLINE" ":" (1+ space) (1+ not-newline)) t)) - ;; Return element, because the predicate still needs testing. - element) - (`(deadline) - (setq org-ql-preamble (rx-to-string `(seq bol (0+ (any " ")) "DEADLINE" ":") t)) + (setq org-ql-preamble org-deadline-time-regexp) ;; Return element, because the predicate still needs testing. element) (`(regexp . ,regexps) @@ -360,6 +435,7 @@ replace the clause with a preamble." ;; Return nil, don't test the predicate. nil) (`(habit) + ;; TODO: Move regexp to const. (setq org-ql-preamble (rx-to-string `(seq bol (0+ space) ":STYLE:" (1+ space) "habit" (0+ space) eol))) nil) @@ -376,6 +452,10 @@ replace the clause with a preamble." (`(level ,num) (setq org-ql-preamble (rx-to-string `(seq bol (repeat ,num "*") " ") t)) nil) + (`(planning . ,_) + (setq org-ql-preamble org-ql-planning-regexp) + ;; Return element, because the predicate still needs testing. + element) (`(property ,property ,value) ;; We do NOT return nil, because the predicate still needs to be tested, ;; because the regexp could match a string not inside a property drawer. @@ -400,12 +480,7 @@ replace the clause with a preamble." ;; (1+ space) (minimal-match (1+ not-newline)) eol))) ;; element) (`(scheduled . ,_) - (setq org-ql-preamble - (rx-to-string `(seq bol (0+ (any " ")) "SCHEDULED" ":" (1+ space) (1+ not-newline)) t)) - ;; Return element, because the predicate still needs testing. - element) - (`(scheduled) - (setq org-ql-preamble (rx-to-string `(seq bol (0+ (any " ")) "SCHEDULED" ":") t)) + (setq org-ql-preamble org-scheduled-time-regexp) ;; Return element, because the predicate still needs testing. element) ;; TODO: Add selector for tags without inheritance. @@ -595,45 +670,6 @@ empty time values to 23:59:59; otherwise, to 00:00:00." (org-ql-select (current-buffer) query :narrow t :action (lambda () t)))))) -(org-ql--defpred clocked (&key from to _on) - ;; The underscore before `on' prevents "unused lexical variable" warnings, because we - ;; pre-process that argument in a macro before this function is called. - "Return non-nil if current entry was clocked in given period. -If no arguments are specified, return non-nil if entry was -clocked at any time. - -If FROM, return non-nil if entry was clocked on or after FROM. -If TO, return non-nil if entry was clocked on or before TO. -If ON, return non-nil if entry was clocked on date ON. - -FROM, TO, and ON should be strings parseable by -`parse-time-string' but may omit the time value. - -Note: Clock entries are expected to be clocked out. Currently -clocked entries (i.e. with unclosed timestamp ranges) are -ignored." - ;; NOTE: FROM and TO are actually expected to be Unix timestamps. The docstring is written - ;; for end users, for which the arguments are pre-processed by `org-ql-select'. - ;; FIXME: This assumes every "clocked" entry is a range. Unclosed clock entries are not handled. - (cl-macrolet ((next-timestamp () - `(when (re-search-forward org-clock-line-re end-pos t) - (org-element-property :value (org-element-context)))) - (test-timestamps (pred-form) - `(cl-loop for next-ts = (next-timestamp) - while next-ts - ;; Using `setf' instead of `for beg =` here prevents "unused lexical variable" warnings. - do (setf beg (float-time (org-timestamp-to-time next-ts)) - end (float-time (org-timestamp-to-time next-ts 'end))) - thereis ,pred-form))) - (save-excursion - (let ((end-pos (org-entry-end-position)) - beg end) - (cond ((not (or from to)) (next-timestamp)) - ((and from to) (test-timestamps (and (<= beg to) - (>= end from)))) - (from (test-timestamps (<= from end))) - (to (test-timestamps (<= beg to)))))))) - (org-ql--defpred category (&rest categories) "Return non-nil if current heading is in one or more of CATEGORIES (a list of strings)." (when-let ((category (org-get-category (point)))) @@ -756,8 +792,102 @@ comparator, PRIORITY should be a priority string." ;;;;;; Timestamps +(org-ql--defpred clocked (&key from to _on) + ;; The underscore before `on' prevents "unused lexical variable" + ;; warnings, because we pre-process that argument in a macro before + ;; this function is called. + "Return non-nil if current entry was clocked in given period. +If no arguments are specified, return non-nil if entry has any +timestamp. -(org-ql--defpred ts (&key from to _on regexp) +If FROM, return non-nil if entry has a timestamp on or after +FROM. + +If TO, return non-nil if entry has a timestamp on or before TO. + +If ON, return non-nil if entry has a timestamp on date ON. + +FROM, TO, and ON should be either `ts' structs, or strings +parseable by `parse-time-string' which may omit the time value." + (org-ql--predicate-ts :from from :to to :regexp org-ql-clock-regexp :match-group 1)) + +(org-ql--defpred closed (&key from to _on) + ;; The underscore before `on' prevents "unused lexical variable" + ;; warnings, because we pre-process that argument in a macro before + ;; this function is called. + "Return non-nil if current entry was closed in given period. +If no arguments are specified, return non-nil if entry has any +timestamp. + +If FROM, return non-nil if entry has a timestamp on or after +FROM. + +If TO, return non-nil if entry has a timestamp on or before TO. + +If ON, return non-nil if entry has a timestamp on date ON. + +FROM, TO, and ON should be either `ts' structs, or strings +parseable by `parse-time-string' which may omit the time value." + (org-ql--predicate-ts :from from :to to :regexp org-closed-time-regexp :match-group 1)) + +(org-ql--defpred deadline (&key from to _on) + ;; The underscore before `on' prevents "unused lexical variable" + ;; warnings, because we pre-process that argument in a macro before + ;; this function is called. + "Return non-nil if current entry has deadline in given period. +If no arguments are specified, return non-nil if entry has any +timestamp. + +If FROM, return non-nil if entry has a timestamp on or after +FROM. + +If TO, return non-nil if entry has a timestamp on or before TO. + +If ON, return non-nil if entry has a timestamp on date ON. + +FROM, TO, and ON should be either `ts' structs, or strings +parseable by `parse-time-string' which may omit the time value." + (org-ql--predicate-ts :from from :to to :regexp org-deadline-time-regexp :match-group 1)) + +(org-ql--defpred planning (&key from to _on) + ;; The underscore before `on' prevents "unused lexical variable" + ;; warnings, because we pre-process that argument in a macro before + ;; this function is called. + "Return non-nil if current entry has planning timestamp in given period (i.e. its deadline, scheduled, or closed timestamp). +If no arguments are specified, return non-nil if entry has any +timestamp. + +If FROM, return non-nil if entry has a timestamp on or after +FROM. + +If TO, return non-nil if entry has a timestamp on or before TO. + +If ON, return non-nil if entry has a timestamp on date ON. + +FROM, TO, and ON should be either `ts' structs, or strings +parseable by `parse-time-string' which may omit the time value." + (org-ql--predicate-ts :from from :to to :regexp org-ql-planning-regexp :match-group 1)) + +(org-ql--defpred scheduled (&key from to _on) + ;; The underscore before `on' prevents "unused lexical variable" + ;; warnings, because we pre-process that argument in a macro before + ;; this function is called. + "Return non-nil if current entry is scheduled in given period. +If no arguments are specified, return non-nil if entry has any +timestamp. + +If FROM, return non-nil if entry has a timestamp on or after +FROM. + +If TO, return non-nil if entry has a timestamp on or before TO. + +If ON, return non-nil if entry has a timestamp on date ON. + +FROM, TO, and ON should be either `ts' structs, or strings +parseable by `parse-time-string' which may omit the time value." + (org-ql--predicate-ts :from from :to to :regexp org-scheduled-time-regexp :match-group 1)) + +(org-ql--defpred ts (&key from to _on regexp (match-group 0)) ;; The underscore before `on' prevents "unused lexical variable" warnings, ;; because we pre-process that argument in a macro before this function is ;; called. The `regexp' argument is also provided by the macro and is not @@ -784,7 +914,7 @@ match inactive ones, or `both' / nil to match both types." ;; FIXME: This assumes every "clocked" entry is a range. Unclosed clock entries are not handled. (cl-macrolet ((next-timestamp () `(when (re-search-forward regexp end-pos t) - (ts-parse-org (match-string 0)))) + (ts-parse-org (match-string match-group)))) (test-timestamps (pred-form) `(cl-loop for next-ts = (next-timestamp) while next-ts @@ -797,143 +927,6 @@ match inactive ones, or `both' / nil to match both types." (from (test-timestamps (ts<= from next-ts))) (to (test-timestamps (ts<= next-ts to)))))))) -;;;;; Date comparison - -(defun org-ql--date-type-p (type &optional comparator target-date) - "Return non-nil if current heading has a date property of TYPE. -TYPE should be a keyword symbol, like :scheduled or :deadline. - -With COMPARATOR and TARGET-DATE, return non-nil if entry's -scheduled date compares with TARGET-DATE according to COMPARATOR. -TARGET-DATE may be a string like \"2017-08-05\", or an integer -like one returned by `date-to-day'." - (when-let (;; FIXME: Add :date selector, since I put it - ;; in the examples but forgot to actually - ;; make it. - (timestamp (org-entry-get (point) (pcase type - (:deadline "DEADLINE") - (:scheduled "SCHEDULED") - (:closed "CLOSED")))) - (date-element (with-temp-buffer - ;; FIXME: Hack: since we're using - ;; (org-element-property :type date-element) - ;; below, we need this date parsed into an - ;; org-element element - (insert timestamp) - (goto-char 0) - (org-element-timestamp-parser)))) - (pcase comparator - ;; Not comparing, just checking if it has one - ('nil t) - ;; Compare dates - ((pred functionp) - (let ((target-day-number (cl-typecase target-date - (null (+ (org-get-wdays timestamp) (org-today))) - ;; Append time to target-date because `date-to-day' requires it. - (string (date-to-day (concat target-date " 00:00"))) - (integer target-date)))) - (pcase (org-element-property :type date-element) - ((or 'active 'inactive 'active-range 'inactive-range) - (funcall comparator - (org-time-string-to-absolute - (org-element-timestamp-interpreter date-element 'ignore)) - target-day-number)) - (_ (error "Unknown date-element type \"%s\" in buffer %s at position %s" - (org-element-property :type date-element) (current-buffer) (point)))))) - (_ (user-error "COMPARATOR (%s) must be a function, and DATE (%s) must be a string or day-number integer" - comparator target-date))))) - -(org-ql--defpred planning (&optional comparator target-date) - "Return non-nil if entry's planning date (deadline or scheduled) compares with TARGET-DATE using COMPARATOR. -TARGET-DATE should be a string parseable by `date-to-day'. -COMPARATOR should be a function (like `<=')." - ;; NOTE: This was a defsubst before being defined with the macro. Might be good to make it a defsubst again. - ;; FIXME: I think :date selects either :deadline, :scheduled, or :closed, but I'm not sure. - (org-ql--date-type-p :date comparator target-date)) - -(org-ql--defpred deadline (&optional comparator target-date) - "Return non-nil if entry's deadline compares with TARGET-DATE using COMPARATOR. -TARGET-DATE should be a string parseable by `date-to-day'; or if -omitted, it is determined automatically using -`org-deadline-warning-days'. COMPARATOR should be a -function (like `<=')." - ;; NOTE: This was a defsubst before being defined with the macro. Might be good to make it a defsubst again. - ;; FIXME: This is slightly confusing. Using plain (deadline) does, and should, select entries - ;; that have any deadline. But the common case of wanting to select entries whose deadline is - ;; within the warning days (either the global setting or that entry's setting) requires the user - ;; to specify the <= comparator, which is unintuitive. Maybe it would be better to use that - ;; comparator by default, and use an 'any comparator to select entries with any deadline. Of - ;; course, that would make the deadline selector different from the scheduled, closed, and date - ;; selectors, which would also be unintuitive. - (org-ql--date-type-p :deadline comparator target-date)) - -(org-ql--defpred scheduled (&optional comparator target-date) - "Return non-nil if entry's scheduled date compares with TARGET-DATE using COMPARATOR. -TARGET-DATE should be a string parseable by `date-to-day'. -COMPARATOR should be a function (like `<=')." - ;; NOTE: This was a defsubst before being defined with the macro. Might be good to make it a defsubst again. - (org-ql--date-type-p :scheduled comparator target-date)) - -(org-ql--defpred closed (&optional comparator target-date) - "Return non-nil if entry's closed date compares with TARGET-DATE using COMPARATOR. -TARGET-DATE should be a string parseable by `date-to-day'. -COMPARATOR should be a function (like `<=')." - ;; NOTE: This was a defsubst before being defined with the macro. Might be good to make it a defsubst again. - (org-ql--date-type-p :closed comparator target-date)) - -(org-ql--defpred date (&optional comparator target-date (type 'active)) - "Return non-nil if Org entry at point has date of TYPE that compares with TARGET-DATE using COMPARATOR. -Checks all Org-formatted timestamp strings in entry. TYPE may be -`active', `inactive', or `all', to control whether active, -inactive, or all timestamps are checked. Ranges of each type are -also checked. TARGET-DATE should be a string parseable by -`date-to-day'. COMPARATOR should be a function (like `<=')." - ;; TODO: Deprecate this with a warning, suggest using (ts) instead, and remove (date) from examples. - ;; MAYBE: This duplicates some code in --date-p, maybe it could be refactored DRYer. - (let* ((entry-timestamps (save-excursion - ;; NOTE: It's important to `save-excursion', otherwise the point will be moved, which will - ;; likely cause the action function to fail. We could wrap the call to the predicate in - ;; `save-excursion', but that would do it even when not necessary, which would be slower. - (cl-loop while (re-search-forward org-element--timestamp-regexp (org-entry-end-position) t) - collect (match-string 0))))) - (pcase comparator - ('nil (pcase type - ('all entry-timestamps) - ('active (cl-loop for timestamp in entry-timestamps - thereis (string-prefix-p "<" timestamp))) - ('inactive (cl-loop for timestamp in entry-timestamps - thereis (string-prefix-p "[" timestamp))) - (_ (user-error "Invalid type for date selector. May be `active', `inactive', or `all'")))) - ((pred functionp) - ;; TODO: Avoid computing target-day-number every time this is called. - ;; Probably need to make a lambda that has it already defined. - (let ((target-day-number (cl-typecase target-date - (null nil) ; Calculated later. - ;; Append time to target-date because `date-to-day' requires it. - (string (date-to-day (concat target-date " 00:00"))) - (integer target-date)))) - (cl-loop for timestamp in entry-timestamps - for date-element = (with-temp-buffer - ;; MAYBE: Replace with ts.el eventually. - ;; TODO: Parse the element in the re-search-forward loop. - (insert timestamp) - (goto-char 0) - (org-element-timestamp-parser)) - for this-target-day-number = (or target-day-number - ;; FIXME: Not sure if it makes sense to check warning - ;; days for non-planning timestamps, but we'll try it. - (+ (org-get-wdays timestamp) (org-today))) - thereis (when (or (eq 'all type) - (member (org-element-property :type date-element) - (pcase type - ('active '(active active-range)) - ('inactive '(inactive inactive-range))))) - (funcall comparator (org-time-string-to-absolute - (org-element-timestamp-interpreter date-element 'ignore)) - this-target-day-number))))) - (_ (user-error "COMPARATOR (%s) must be a function, and DATE (%s) must be a string or day-number integer" - comparator target-date))))) - ;;;;; Sorting ;; FIXME: These appear to work properly, but it would be good to have tests for them. diff --git a/tests/test-org-ql.el b/tests/test-org-ql.el index 245aa2c..df4a917 100644 --- a/tests/test-org-ql.el +++ b/tests/test-org-ql.el @@ -280,39 +280,26 @@ RESULTS should be a list of strings as returned by (org-ql-expect ((closed)) '("Learn universal sign language"))) - (org-ql-it "=" - (org-ql-expect ((closed = "2017-07-05")) + (org-ql-it ":on" + (org-ql-expect ((closed :on "2017-07-05")) '("Learn universal sign language")) - (org-ql-expect ((closed = "2019-06-09")) + (org-ql-expect ((closed :on "2019-06-09")) nil)) - (org-ql-it "<" - ;; TODO: Figure out why these tests take about 8 times longer than the other comparators in the (closed) tests. - (org-ql-expect ((closed < "2019-06-10")) + (org-ql-it ":from" + (org-ql-expect ((closed :from "2017-07-04")) '("Learn universal sign language")) - (org-ql-expect ((closed < "2017-06-10")) + (org-ql-expect ((closed :from "2017-07-05")) + '("Learn universal sign language")) + (org-ql-expect ((closed :from "2017-07-06")) nil)) - (org-ql-it ">" - (org-ql-expect ((closed > "2017-07-04")) - '("Learn universal sign language")) - (org-ql-expect ((closed > "2019-07-05")) - nil)) - - (org-ql-it ">=" - (org-ql-expect ((closed >= "2017-07-04")) - '("Learn universal sign language")) - (org-ql-expect ((closed >= "2017-07-05")) - '("Learn universal sign language")) - (org-ql-expect ((closed >= "2017-07-06")) - nil)) - - (org-ql-it "<=" - (org-ql-expect ((closed <= "2017-07-04")) + (org-ql-it ":to" + (org-ql-expect ((closed :to "2017-07-04")) nil) - (org-ql-expect ((closed <= "2017-07-05")) + (org-ql-expect ((closed :to "2017-07-05")) '("Learn universal sign language")) - (org-ql-expect ((closed <= "2017-07-06")) + (org-ql-expect ((closed :to "2017-07-06")) '("Learn universal sign language")))) (describe "(deadline)" @@ -321,41 +308,28 @@ RESULTS should be a list of strings as returned by (org-ql-expect ((deadline)) '("Take over the universe" "Take over the world" "Visit Mars" "Visit the moon" "Renew membership in supervillain club" "Internet" "Spaceship lease" "/r/emacs"))) - (org-ql-it "=" - (org-ql-expect ((deadline = "2017-07-05")) + (org-ql-it ":on" + (org-ql-expect ((deadline :on "2017-07-05")) '("/r/emacs")) - (org-ql-expect ((deadline = "2019-06-09")) + (org-ql-expect ((deadline :on "2019-06-09")) nil)) - (org-ql-it "<" - (org-ql-expect ((deadline < "2019-06-10")) + (org-ql-it ":from" + (org-ql-expect ((deadline :from "2017-07-04")) '("Take over the universe" "Take over the world" "Visit Mars" "Visit the moon" "Renew membership in supervillain club" "Internet" "Spaceship lease" "/r/emacs")) - (org-ql-expect ((deadline < "2017-06-10")) - nil)) - - (org-ql-it ">" - ;; TODO: Figure out why these tests take much longer than e.g. the (deadline <) tests. - (org-ql-expect ((deadline > "2017-07-04 00:00")) + (org-ql-expect ((deadline :from "2017-07-05")) '("Take over the universe" "Take over the world" "Visit Mars" "Visit the moon" "Renew membership in supervillain club" "Internet" "Spaceship lease" "/r/emacs")) - (org-ql-expect ((deadline > "2019-07-05")) - nil)) - - (org-ql-it ">=" - (org-ql-expect ((deadline >= "2017-07-04")) - '("Take over the universe" "Take over the world" "Visit Mars" "Visit the moon" "Renew membership in supervillain club" "Internet" "Spaceship lease" "/r/emacs")) - (org-ql-expect ((deadline >= "2017-07-05")) - '("Take over the universe" "Take over the world" "Visit Mars" "Visit the moon" "Renew membership in supervillain club" "Internet" "Spaceship lease" "/r/emacs")) - (org-ql-expect ((deadline >= "2017-07-06")) + (org-ql-expect ((deadline :from "2017-07-06")) '("Take over the universe" "Take over the world" "Visit Mars" "Visit the moon" "Renew membership in supervillain club" "Internet" "Spaceship lease")) - (org-ql-expect ((deadline >= "2018-07-06")) + (org-ql-expect ((deadline :from "2018-07-06")) nil)) - (org-ql-it "<=" - (org-ql-expect ((deadline <= "2017-07-04")) + (org-ql-it ":to" + (org-ql-expect ((deadline :to "2017-07-04")) nil) - (org-ql-expect ((deadline <= "2017-07-05")) + (org-ql-expect ((deadline :to "2017-07-05")) '("/r/emacs")) - (org-ql-expect ((deadline <= "2018-07-06")) + (org-ql-expect ((deadline :to "2018-07-06")) '("Take over the universe" "Take over the world" "Visit Mars" "Visit the moon" "Renew membership in supervillain club" "Internet" "Spaceship lease" "/r/emacs")))) (org-ql-it "(done)" @@ -366,6 +340,34 @@ RESULTS should be a list of strings as returned by (org-ql-expect ((habit)) '("Practice leaping tall buildings in a single bound"))) + (describe "(planning)" + + (org-ql-it "without arguments" + (org-ql-expect ((planning)) + '("Take over the universe" "Take over the world" "Skype with president of Antarctica" "Visit Mars" "Visit the moon" "Practice leaping tall buildings in a single bound" "Renew membership in supervillain club" "Learn universal sign language" "Order a pizza" "Get haircut" "Internet" "Spaceship lease" "Fix flux capacitor" "/r/emacs" "Shop for groceries" "Rewrite Emacs in Common Lisp"))) + + (org-ql-it ":on" + (org-ql-expect ((planning :on "2017-07-05")) + '("Practice leaping tall buildings in a single bound" "Learn universal sign language" "Order a pizza" "Get haircut" "Fix flux capacitor" "/r/emacs" "Shop for groceries" "Rewrite Emacs in Common Lisp")) + (org-ql-expect ((planning :on "2019-06-09")) + nil)) + + (org-ql-it ":from" + (org-ql-expect ((planning :from "2017-07-04")) + '("Take over the universe" "Take over the world" "Skype with president of Antarctica" "Visit Mars" "Visit the moon" "Practice leaping tall buildings in a single bound" "Renew membership in supervillain club" "Learn universal sign language" "Order a pizza" "Get haircut" "Internet" "Spaceship lease" "Fix flux capacitor" "/r/emacs" "Shop for groceries" "Rewrite Emacs in Common Lisp")) + (org-ql-expect ((planning :from "2017-07-05")) + '("Take over the universe" "Take over the world" "Visit Mars" "Visit the moon" "Practice leaping tall buildings in a single bound" "Renew membership in supervillain club" "Learn universal sign language" "Order a pizza" "Get haircut" "Internet" "Spaceship lease" "Fix flux capacitor" "/r/emacs" "Shop for groceries" "Rewrite Emacs in Common Lisp")) + (org-ql-expect ((planning :from "2017-07-06")) + '("Take over the universe" "Take over the world" "Visit Mars" "Visit the moon" "Renew membership in supervillain club" "Internet" "Spaceship lease"))) + + (org-ql-it ":to" + (org-ql-expect ((planning :to "2017-07-04")) + '("Skype with president of Antarctica")) + (org-ql-expect ((planning :to "2017-07-05")) + '("Skype with president of Antarctica" "Practice leaping tall buildings in a single bound" "Learn universal sign language" "Order a pizza" "Get haircut" "Fix flux capacitor" "/r/emacs" "Shop for groceries" "Rewrite Emacs in Common Lisp")) + (org-ql-expect ((planning :to "2018-07-06")) + '("Take over the universe" "Take over the world" "Skype with president of Antarctica" "Visit Mars" "Visit the moon" "Practice leaping tall buildings in a single bound" "Renew membership in supervillain club" "Learn universal sign language" "Order a pizza" "Get haircut" "Internet" "Spaceship lease" "Fix flux capacitor" "/r/emacs" "Shop for groceries" "Rewrite Emacs in Common Lisp")))) + (describe "(property)" ;; MAYBE: Add support for (property) without arguments. @@ -402,6 +404,34 @@ RESULTS should be a list of strings as returned by :sort todo) '("Take over the universe" "Take over the world" "Take over Mars" "Take over the moon" "Order a pizza" "Get haircut")))) + (describe "(scheduled)" + + (org-ql-it "without arguments" + (org-ql-expect ((scheduled)) + '("Skype with president of Antarctica" "Practice leaping tall buildings in a single bound" "Order a pizza" "Get haircut" "Fix flux capacitor" "Shop for groceries" "Rewrite Emacs in Common Lisp"))) + + (org-ql-it ":on" + (org-ql-expect ((scheduled :on "2017-07-05")) + '("Practice leaping tall buildings in a single bound" "Order a pizza" "Get haircut" "Fix flux capacitor" "Shop for groceries" "Rewrite Emacs in Common Lisp")) + (org-ql-expect ((scheduled :on "2019-06-09")) + nil)) + + (org-ql-it ":from" + (org-ql-expect ((scheduled :from "2017-07-04")) + '("Skype with president of Antarctica" "Practice leaping tall buildings in a single bound" "Order a pizza" "Get haircut" "Fix flux capacitor" "Shop for groceries" "Rewrite Emacs in Common Lisp")) + (org-ql-expect ((scheduled :from "2017-07-05")) + '("Practice leaping tall buildings in a single bound" "Order a pizza" "Get haircut" "Fix flux capacitor" "Shop for groceries" "Rewrite Emacs in Common Lisp")) + (org-ql-expect ((scheduled :from "2017-07-06")) + nil)) + + (org-ql-it ":to" + (org-ql-expect ((scheduled :to "2017-07-04")) + '("Skype with president of Antarctica")) + (org-ql-expect ((scheduled :to "2017-07-05")) + '("Skype with president of Antarctica" "Practice leaping tall buildings in a single bound" "Order a pizza" "Get haircut" "Fix flux capacitor" "Shop for groceries" "Rewrite Emacs in Common Lisp")) + (org-ql-expect ((scheduled :to "2018-07-06")) + '("Skype with president of Antarctica" "Practice leaping tall buildings in a single bound" "Order a pizza" "Get haircut" "Fix flux capacitor" "Shop for groceries" "Rewrite Emacs in Common Lisp")))) + (describe "(todo)" (org-ql-it "without arguments" From 62e948619a6a1d45c0c5f6edbeb83908b667726a Mon Sep 17 00:00:00 2001 From: Adam Porter Date: Tue, 13 Aug 2019 17:19:01 -0500 Subject: [PATCH 109/798] Docs: Add example org-ql-agenda-last-days --- examples.org | 29 +++++++++++++++++++++++++++++ 1 file changed, 29 insertions(+) diff --git a/examples.org b/examples.org index 5873c8b..316543d 100644 --- a/examples.org +++ b/examples.org @@ -1,5 +1,34 @@ * Examples +** Show entries with timestamps in the last N days + +#+BEGIN_SRC elisp + (cl-defun org-ql-agenda-last-days (days &optional (type 'ts)) + "Show entries from previous DAYS days with timestamps of TYPE. + TYPE may be `ts', `ts-active', `ts-inactive', `clocked', + `closed', `deadline', `planning', or `scheduled'." + (interactive (list (read-number "Days: ") + (->> '(ts ts-active ts-inactive clocked closed deadline planning scheduled) + (completing-read "Timestamp type: ") + intern))) + (let ((from (->> (ts-now) + (ts-adjust 'day (* -1 days)) + (ts-apply :hour 0 :minute 0 :second 0) + ;; Formatting isn't required, but it looks better in the header than a struct. + ts-format))) + (org-ql-search (org-agenda-files) + `(,type :from ,from :to ,(ts-now))))) + + ;; Show entries with any timestamp from last 7 days: + (org-ql-agenda-last-days 7) + + ;; Show entries clocked in last 7 days: + (org-ql-agenda-last-days 30 'clocked) + + ;; Show entries closed in last 7 days: + (org-ql-agenda-last-days 30 'closed) +#+END_SRC + ** Listing bills coming due This uses the example in the readme file, but maps across the elements returned by ~org-ql~ to present a simple list of titles and deadlines. From a5b06dc1bfe158d0b3121fe37fb7c14c238113c2 Mon Sep 17 00:00:00 2001 From: Adam Porter Date: Tue, 13 Aug 2019 17:36:12 -0500 Subject: [PATCH 110/798] Docs: Add installation instructions --- README.org | 24 ++++++++++++++++++++++++ 1 file changed, 24 insertions(+) diff --git a/README.org b/README.org index 671810c..ad78156 100644 --- a/README.org +++ b/README.org @@ -13,6 +13,7 @@ :TOC: this :END: - [[#examples][Examples]] + - [[#installation][Installation]] - [[#usage][Usage]] - [[#commands][Commands]] - [[#queries][Queries]] @@ -82,6 +83,29 @@ More examples are available in [[examples.org]]. (not (children (todo))))) #+END_SRC +* Installation +:PROPERTIES: +:TOC: ignore-children +:END: + +The package may be installed directly from [[https://melpa.org/#/org-ql][MELPA]] or with other tools like [[https://framagit.org/steckerhalter/quelpa][Quelpa]]. + +After installation. you can use commands like ~org-ql-search~ immediately. + +To use the functions and macros in your own Elisp code, load the libraries ~org-ql~ and/or ~org-ql-agenda~ with e.g. ~(require 'org-ql)~. + +** Quelpa + +Installing with [[https://framagit.org/steckerhalter/quelpa][Quelpa]] is easy: + +1. Install [[https://framagit.org/steckerhalter/quelpa-use-package#installation][quelpa-use-package]] (which can be installed directly from MELPA). +2. Add this form to your init file: + +#+BEGIN_SRC elisp + (use-package org-ql + :quelpa (org-ql :fetcher github :repo "alphapapa/org-ql")) +#+END_SRC + * Usage The functionality provided may be grouped by: From 62fbd6123c9d7d6d10942984d65c27350e3ddf3c Mon Sep 17 00:00:00 2001 From: Adam Porter Date: Tue, 13 Aug 2019 19:35:25 -0500 Subject: [PATCH 111/798] Add: (org-ql-agenda, org-ql-search) :title argument --- README.org | 14 ++++++++++---- org-ql-agenda.el | 33 +++++++++++++++++++++++---------- 2 files changed, 33 insertions(+), 14 deletions(-) diff --git a/README.org b/README.org index ad78156..d33bd47 100644 --- a/README.org +++ b/README.org @@ -77,10 +77,11 @@ More examples are available in [[examples.org]]. ;; Show a "stuck projects" view: tasks that are not done and have only ;; non-task children. - (org-ql-agenda (org-agenda-files) - (and (todo) - (children) - (not (children (todo))))) + (org-ql-search (org-agenda-files) + '(and (todo) + (children) + (not (children (todo)))) + :title "Stuck Projects") #+END_SRC * Installation @@ -238,6 +239,7 @@ This macro is like ~org-ql~, but it presents matching entries in an Agenda-like (deadline <=) (scheduled <= today)) (not (done))) + :title "My Agenda View" ;; The `org-super-agenda-groups' setting is used automatically when set, or it ;; may be overriden by specifying it here: :super-groups ((:name "Bills" @@ -255,6 +257,9 @@ This macro is like ~org-ql~, but it presents matching entries in an Agenda-like (:priority "C" :order 2))) #+END_SRC +*************** TODO Update screenshot (doesn't show title) :noexport: +*************** END + Which presents this buffer: [[images/screenshot.png]] @@ -407,6 +412,7 @@ Expands into a call to ~org-ql-select~ with the same arguments. For convenience + Selector ~ts~ now accepts a ~:type~ argument. + Face =org-ql-agenda-due-date=. + Selectors ~(children)~ and ~(descendants)~. ++ Function ~org-ql-search~ and macro ~org-ql-agenda~ accept a ~:title~ argument, which is displayed in the header. *Changed* + Function ~org-ql-query~ renamed to ~org-ql-select~. ~org-ql-query~ now refers to a new function. diff --git a/org-ql-agenda.el b/org-ql-agenda.el index 8b71892..bb1a7af 100644 --- a/org-ql-agenda.el +++ b/org-ql-agenda.el @@ -65,6 +65,7 @@ (defvar org-ql-sort) (defvar org-ql-narrow) (defvar org-ql-super-groups) +(defvar org-ql-title) ;;;; Macros @@ -93,12 +94,13 @@ SUPER-GROUPS is used to bind variable `org-super-agenda-groups', which see. If t, the existing value of `org-super-agenda-groups' is used, rather than binding it locally." (declare (indent defun) - (advertised-calling-convention (files-or-query &optional query &key sort narrow buffer super-groups) nil)) + (advertised-calling-convention (files-or-query &optional query &key sort narrow buffer super-groups title) nil)) (cl-macrolet ((set-keyword-args (args) `(setq sort (plist-get ,args :sort) narrow (plist-get ,args :narrow) buffer (plist-get ,args :buffer) - super-groups (plist-get ,args :super-groups)))) + super-groups (plist-get ,args :super-groups) + title (plist-get ,args :title)))) (let ((files '(org-agenda-files)) query sort narrow buffer super-groups) ;; Parse args manually (so we can leave FILES nil for a default argument). @@ -130,7 +132,8 @@ is used, rather than binding it locally." :sort ',sort :buffer ,buffer :narrow ,narrow - :super-groups ',super-groups)))) + :super-groups ',super-groups + :title ,title)))) ;;;; Commands @@ -138,7 +141,7 @@ is used, rather than binding it locally." ;; it uses `org-ql-agenda--agenda'. Maybe this could be better organized. ;;;###autoload -(cl-defun org-ql-search (buffers-files query &key narrow groups sort) +(cl-defun org-ql-search (buffers-files query &key narrow groups sort title) "Read QUERY and search with `org-ql'. Interactively, prompt for these variables: @@ -158,7 +161,9 @@ NARROW: When non-nil, don't widen buffers before searching. Interactively, with prefix, leave narrowed. SORT: One or a list of `org-ql' sorting functions, like `date' or -`priority'." +`priority'. + +TITLE: An optional string displayed in the header." (declare (indent defun)) (interactive (list (pcase-exhaustive (completing-read "Buffers/Files: " (list 'buffer 'agenda 'all)) @@ -190,6 +195,7 @@ SORT: One or a list of `org-ql' sorting functions, like `date' or :narrow narrow :sort sort :super-groups groups + :title title :buffer "*Org QL Search*")) (defun org-ql-search-refresh () @@ -200,6 +206,7 @@ SORT: One or a list of `org-ql' sorting functions, like `date' or :sort org-ql-sort :narrow org-ql-narrow :super-groups org-ql-super-groups + :title org-ql-title :buffer (current-buffer))) ;;;; Functions @@ -207,7 +214,7 @@ SORT: One or a list of `org-ql' sorting functions, like `date' or ;; TODO: Move the action-fn down into --filter-buffer, so users can avoid calling the ;; headline-parser when they don't need it. -(cl-defun org-ql-agenda--agenda (buffers-files query &key entries sort buffer narrow super-groups) +(cl-defun org-ql-agenda--agenda (buffers-files query &key entries sort buffer narrow super-groups title) "FIXME: Docstring" (declare (indent defun)) (when (and super-groups (not org-super-agenda-mode)) @@ -241,7 +248,8 @@ SORT: One or a list of `org-ql' sorting functions, like `date' or (setq-local org-ql-sort sort) (setq-local org-ql-narrow narrow) (setq-local org-ql-super-groups super-groups) - (setq-local header-line-format (org-ql-agenda--header-line-format buffers-files query)) + (setq-local org-ql-title title) + (setq-local header-line-format (org-ql-agenda--header-line-format buffers-files query title)) ;; Clear buffer, insert entries, etc. (erase-buffer) (insert string) @@ -276,9 +284,13 @@ the `match' item in the custom command form." (defalias 'org-ql-block 'org-ql-agenda-block) -(defun org-ql-agenda--header-line-format (buffers-files query) +(defun org-ql-agenda--header-line-format (buffers-files query &optional title) "Return header-line-format for BUFFERS-FILES and QUERY." - (let* ((query-formatted (format "%S" query)) + (let* ((title (if title + (concat (propertize "View: " 'face 'org-agenda-structure) + title " ") + "")) + (query-formatted (format "%S" query)) (query-formatted (propertize (org-ql-agenda--font-lock-string 'emacs-lisp-mode query-formatted) 'help-echo query-formatted)) (query-width (length query-formatted)) @@ -291,7 +303,8 @@ the `match' item in the custom command form." (org-ql-agenda--font-lock-string 'emacs-lisp-mode) (s-truncate available-width)) 'help-echo buffers-files-formatted))) - (concat (propertize "Query: " 'face 'org-agenda-structure) + (concat title + (propertize "Query: " 'face 'org-agenda-structure) query-formatted " " (propertize "In: " 'face 'org-agenda-structure) buffers-files-formatted))) From 94d499bcf3ecf2897999e47c417eb2ce79536d19 Mon Sep 17 00:00:00 2001 From: Adam Porter Date: Tue, 13 Aug 2019 19:37:21 -0500 Subject: [PATCH 112/798] Meta: Update description --- org-ql.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/org-ql.el b/org-ql.el index f5bcebf..0f10702 100644 --- a/org-ql.el +++ b/org-ql.el @@ -1,4 +1,4 @@ -;;; org-ql.el --- Query language for Org buffers -*- lexical-binding: t; -*- +;;; org-ql.el --- Org Query Language, search command, and agenda-like view -*- lexical-binding: t; -*- ;; Author: Adam Porter ;; Url: https://github.com/alphapapa/org-ql From df8a155b14b84c2a6d2864dac30ef8c3a8e47189 Mon Sep 17 00:00:00 2001 From: Adam Porter Date: Tue, 13 Aug 2019 19:38:37 -0500 Subject: [PATCH 113/798] Tidy: Indentation in example --- examples.org | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/examples.org b/examples.org index 316543d..233bd1c 100644 --- a/examples.org +++ b/examples.org @@ -5,8 +5,8 @@ #+BEGIN_SRC elisp (cl-defun org-ql-agenda-last-days (days &optional (type 'ts)) "Show entries from previous DAYS days with timestamps of TYPE. - TYPE may be `ts', `ts-active', `ts-inactive', `clocked', - `closed', `deadline', `planning', or `scheduled'." + TYPE may be `ts', `ts-active', `ts-inactive', `clocked', + `closed', `deadline', `planning', or `scheduled'." (interactive (list (read-number "Days: ") (->> '(ts ts-active ts-inactive clocked closed deadline planning scheduled) (completing-read "Timestamp type: ") From aea37ea1c104db3dc462ac8d95fe39efa5f6076a Mon Sep 17 00:00:00 2001 From: Adam Porter Date: Tue, 13 Aug 2019 21:10:42 -0500 Subject: [PATCH 114/798] Docs: Add org-ql-view example --- examples.org | 28 +++++++++++++++++++++++++++- 1 file changed, 27 insertions(+), 1 deletion(-) diff --git a/examples.org b/examples.org index 233bd1c..e2de499 100644 --- a/examples.org +++ b/examples.org @@ -1,5 +1,32 @@ * Examples +** Stored views command + +This defines a simple list of stored views and a command to easily access them with completion, which may be more convenient than defining a command for each view. + +#+BEGIN_SRC elisp + (defun org-ql-view (&optional view) + "Choose and display a stored `org-ql' view." + (interactive (list (completing-read "View: " (mapcar #'car org-ql-views)))) + (funcall (alist-get view org-ql-views nil nil #'string=))) + + (setq org-ql-views + (list (cons "Stuck Projects" (lambda () + (org-ql-agenda (org-agenda-files) + (and (todo) + (not (todo "TO-WATCH" "TO-READ" "MAYBE" "SOMEDAY")) + (children) + (not (children (todo))) + (not (habit))) + :title "Stuck Projects" + :sort (priority date) + :super-groups ((:name "Home" :tag "home") + (:tag ("Emacs" "computer") :order 100) + (:auto-parent t) + (:todo "WAITING") + (:auto-category t))))))) +#+END_SRC + ** Show entries with timestamps in the last N days #+BEGIN_SRC elisp @@ -28,7 +55,6 @@ ;; Show entries closed in last 7 days: (org-ql-agenda-last-days 30 'closed) #+END_SRC - ** Listing bills coming due This uses the example in the readme file, but maps across the elements returned by ~org-ql~ to present a simple list of titles and deadlines. From ae8b0c740c854d1e989d6900b35d89817029a4e9 Mon Sep 17 00:00:00 2001 From: Adam Porter Date: Tue, 13 Aug 2019 21:11:58 -0500 Subject: [PATCH 115/798] Change: (ts) Use ts-in --- org-ql.el | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/org-ql.el b/org-ql.el index 0f10702..077c6ed 100644 --- a/org-ql.el +++ b/org-ql.el @@ -922,8 +922,7 @@ match inactive ones, or `both' / nil to match both types." (save-excursion (let ((end-pos (org-entry-end-position))) (cond ((not (or from to)) (re-search-forward regexp end-pos t)) - ((and from to) (test-timestamps (and (ts<= from next-ts) - (ts<= next-ts to)))) + ((and from to) (test-timestamps (ts-in from to next-ts))) (from (test-timestamps (ts<= from next-ts))) (to (test-timestamps (ts<= next-ts to)))))))) From 4a9379c83e23eb269eb301c8d72c9ed7fa0a879d Mon Sep 17 00:00:00 2001 From: Adam Porter Date: Tue, 13 Aug 2019 21:27:13 -0500 Subject: [PATCH 116/798] Comment: Correct comments --- org-ql.el | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/org-ql.el b/org-ql.el index 077c6ed..886f162 100644 --- a/org-ql.el +++ b/org-ql.el @@ -518,7 +518,7 @@ replace the clause with a preamble." "Return results for ARGS and current buffer using cache." ;; MAYBE: Timeout cached queries. Probably not necessarily since they will be removed when a ;; buffer is closed, or when a query is run after modifying a buffer. - ;; FIXME: Narrowed queries should conflict in the cache, because the region is not + ;; FIXME: Narrowed queries will probably conflict in the cache, because the region is not ;; stored. We should either not cache narrow queries, or store the region with it. (-let (((&plist :query query :action action :narrow narrow) args)) (if-let* ((buffer-cache (gethash (current-buffer) org-ql-cache)) @@ -909,7 +909,7 @@ parseable by `parse-time-string' which may omit the time value. TYPE may be `active' to match active timestamps, `inactive' to match inactive ones, or `both' / nil to match both types." ;; TODO: DRY this with the clocked predicate. - ;; NOTE: FROM and TO are actually expected to be Unix timestamps. The docstring is written + ;; NOTE: FROM and TO are actually expected to be `ts' structs. The docstring is written ;; for end users, for which the arguments are pre-processed by `org-ql-select'. ;; FIXME: This assumes every "clocked" entry is a range. Unclosed clock entries are not handled. (cl-macrolet ((next-timestamp () From eb38cf6b06514c051a6375f4217c08334323def1 Mon Sep 17 00:00:00 2001 From: Adam Porter Date: Tue, 13 Aug 2019 21:28:20 -0500 Subject: [PATCH 117/798] Comment: Clarify --- org-ql.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/org-ql.el b/org-ql.el index 886f162..57e31ba 100644 --- a/org-ql.el +++ b/org-ql.el @@ -577,7 +577,7 @@ If NARROW is non-nil, buffer will not be widened." ;; searches a buffer without headings, he might be confused. (message "org-ql: No headings in buffer: %s" (current-buffer))) nil) - ;; `cl-loop' makes this double-while much clearer than the expanded form. + ;; Find matching entries. (cond (preamble-re (cl-loop while (re-search-forward preamble-re nil t) do (outline-back-to-heading 'invisible-ok) when (funcall predicate) From 317a460c1df4281528140eaf267527d92384a0be Mon Sep 17 00:00:00 2001 From: Adam Porter Date: Tue, 13 Aug 2019 21:29:05 -0500 Subject: [PATCH 118/798] Tidy: (org-ql--parse-time-string) Remove Unused now. It served well. --- org-ql.el | 19 ------------------- 1 file changed, 19 deletions(-) diff --git a/org-ql.el b/org-ql.el index 57e31ba..9c5cfc7 100644 --- a/org-ql.el +++ b/org-ql.el @@ -623,25 +623,6 @@ Or, when possible, fix the problem." (org-ql--sanity-check-form (cdr elem))) else do (check elem)))) -(defun org-ql--parse-time-string (s &optional end) - "Return Unix timestamp by parsing timestamp string S. -Calls `parse-time-string' and fills in nil second, minute, and -hour values, then calls `float-time'. When END is non-nil, sets -empty time values to 23:59:59; otherwise, to 00:00:00." - ;; TODO: Also accept Unix timestamps. - (cl-macrolet ((fill-with (place value) - `(unless (nth ,place parsed-time) - (setf (nth ,place parsed-time) ,value)))) - (let ((parsed-time (parse-time-string s))) - (pcase end - ('nil (fill-with 0 0) - (fill-with 1 0) - (fill-with 2 0)) - (_ (fill-with 0 59) - (fill-with 1 59) - (fill-with 2 23))) - (float-time (apply #'encode-time parsed-time))))) - ;;;;; Predicates (org-ql--defpred children (query) From b256fa6a78e30c50949db5ecc510e218b4f8ae5e Mon Sep 17 00:00:00 2001 From: Adam Porter Date: Tue, 13 Aug 2019 21:33:54 -0500 Subject: [PATCH 119/798] Change: (org-ql-agenda--header-line-format) Spacing A bit more compact. --- org-ql-agenda.el | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/org-ql-agenda.el b/org-ql-agenda.el index bb1a7af..84b5ef4 100644 --- a/org-ql-agenda.el +++ b/org-ql-agenda.el @@ -287,7 +287,7 @@ the `match' item in the custom command form." (defun org-ql-agenda--header-line-format (buffers-files query &optional title) "Return header-line-format for BUFFERS-FILES and QUERY." (let* ((title (if title - (concat (propertize "View: " 'face 'org-agenda-structure) + (concat (propertize "View:" 'face 'org-agenda-structure) title " ") "")) (query-formatted (format "%S" query)) @@ -304,9 +304,9 @@ the `match' item in the custom command form." (s-truncate available-width)) 'help-echo buffers-files-formatted))) (concat title - (propertize "Query: " 'face 'org-agenda-structure) + (propertize "Query:" 'face 'org-agenda-structure) query-formatted " " - (propertize "In: " 'face 'org-agenda-structure) + (propertize "In:" 'face 'org-agenda-structure) buffers-files-formatted))) (defun org-ql-agenda--font-lock-string (mode s) From 7cb80552bac43201b4fd6f338893694868f75876 Mon Sep 17 00:00:00 2001 From: Adam Porter Date: Tue, 13 Aug 2019 22:19:47 -0500 Subject: [PATCH 120/798] Docs: Update/add examples --- examples.org | 50 ++++++++++++++++++++++++++++++++++++++++++++++---- 1 file changed, 46 insertions(+), 4 deletions(-) diff --git a/examples.org b/examples.org index e2de499..f48f8bb 100644 --- a/examples.org +++ b/examples.org @@ -1,6 +1,15 @@ -* Examples +#+TITLE: org-ql examples -** Stored views command +* Contents +:PROPERTIES: +:TOC: this +:END: + - [[#stored-views-command][Stored views command]] + - [[#show-entries-with-timestamps-in-the-last-n-days][Show entries with timestamps in the last N days]] + - [[#stuck-projects-block-agenda][Stuck projects block agenda]] + - [[#listing-bills-coming-due][Listing bills coming due]] + +* Stored views command This defines a simple list of stored views and a command to easily access them with completion, which may be more convenient than defining a command for each view. @@ -27,7 +36,7 @@ This defines a simple list of stored views and a command to easily access them w (:auto-category t))))))) #+END_SRC -** Show entries with timestamps in the last N days +* Show entries with timestamps in the last N days #+BEGIN_SRC elisp (cl-defun org-ql-agenda-last-days (days &optional (type 'ts)) @@ -55,7 +64,28 @@ This defines a simple list of stored views and a command to easily access them w ;; Show entries closed in last 7 days: (org-ql-agenda-last-days 30 'closed) #+END_SRC -** Listing bills coming due + +* Stuck projects block agenda + +Reddit user =emptymatrix= [[https://www.reddit.com/r/emacs/comments/cnrt2d/orgqlblock_integrates_orgql_into_org_agenda/ewtqez8/][shared]] this example of replacing a traditional =org-stuck-projects= view like: + +#+BEGIN_SRC elisp + (setq org-stuck-projects + '("+@project/-DONE" ("NEXT") nil "SCHEDULED:")) +#+END_SRC + +With this =org-ql-block= agenda view, like: + +#+BEGIN_SRC elisp + (setq org-agenda-custom-commands + '(("s" "Stuck Projects" + ((org-ql-block '(and (tags "@project") + (not (done)) + (not (descendants (todo "NEXT"))) + (not (descendants (scheduled))))))))) +#+END_SRC + +* Listing bills coming due This uses the example in the readme file, but maps across the elements returned by ~org-ql~ to present a simple list of titles and deadlines. @@ -72,3 +102,15 @@ This uses the example in the readme file, but maps across the elements returned #+END_SRC This could also be put in a script, which could use desktop notifications to remind of bills coming due: [[examples/org-bills-due.el][org-bills-due.el]]. + +* COMMENT Code :noexport: +:PROPERTIES: +:TOC: ignore +:END: + +** File-local variables + +# Local Variables: +# eval: (require 'org-make-toc) +# before-save-hook: org-make-toc +# End: From 9c45a020c18c8382f014244afcfdf884f2136f90 Mon Sep 17 00:00:00 2001 From: Adam Porter Date: Tue, 13 Aug 2019 22:23:23 -0500 Subject: [PATCH 121/798] Docs: Update example --- examples.org | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/examples.org b/examples.org index f48f8bb..d63e222 100644 --- a/examples.org +++ b/examples.org @@ -53,7 +53,7 @@ This defines a simple list of stored views and a command to easily access them w ;; Formatting isn't required, but it looks better in the header than a struct. ts-format))) (org-ql-search (org-agenda-files) - `(,type :from ,from :to ,(ts-now))))) + `(,type :from ,from :to ,(ts-format (ts-now)))))) ;; Show entries with any timestamp from last 7 days: (org-ql-agenda-last-days 7) From 0a692077596cbfb2c8bdeb50dbd2d7f12b9c16d4 Mon Sep 17 00:00:00 2001 From: Adam Porter Date: Tue, 13 Aug 2019 22:35:06 -0500 Subject: [PATCH 122/798] Add: (org-ql-search) Offer global groups --- README.org | 1 + org-ql-agenda.el | 2 ++ 2 files changed, 3 insertions(+) diff --git a/README.org b/README.org index d33bd47..1d6622d 100644 --- a/README.org +++ b/README.org @@ -413,6 +413,7 @@ Expands into a call to ~org-ql-select~ with the same arguments. For convenience + Face =org-ql-agenda-due-date=. + Selectors ~(children)~ and ~(descendants)~. + Function ~org-ql-search~ and macro ~org-ql-agenda~ accept a ~:title~ argument, which is displayed in the header. ++ Command ~org-ql-search~ offers global ~org-super-agenda-groups~ in completion. *Changed* + Function ~org-ql-query~ renamed to ~org-ql-select~. ~org-ql-query~ now refers to a new function. diff --git a/org-ql-agenda.el b/org-ql-agenda.el index 84b5ef4..54644a1 100644 --- a/org-ql-agenda.el +++ b/org-ql-agenda.el @@ -177,8 +177,10 @@ TITLE: An optional string displayed in the header." :narrow (eq current-prefix-arg '(4)) :groups (pcase (completing-read "Group by: " (cons "Don't group" + "Global groups" (cl-loop for type in org-super-agenda-auto-selector-keywords collect (substring (symbol-name type) 6)))) + ("Global groups" org-super-agenda-groups) ("Don't group" nil) (property (list (list (intern (concat ":auto-" property)))))) :sort (pcase (completing-read "Sort by: " From 31405d91ccd6233686b64ec36e74f10fe453d9bd Mon Sep 17 00:00:00 2001 From: Adam Porter Date: Tue, 13 Aug 2019 22:35:53 -0500 Subject: [PATCH 123/798] Docs: Improve example I should add this command to the package, this is really useful. --- examples.org | 22 ++++++++++++++-------- 1 file changed, 14 insertions(+), 8 deletions(-) diff --git a/examples.org b/examples.org index d63e222..1855094 100644 --- a/examples.org +++ b/examples.org @@ -5,7 +5,7 @@ :TOC: this :END: - [[#stored-views-command][Stored views command]] - - [[#show-entries-with-timestamps-in-the-last-n-days][Show entries with timestamps in the last N days]] + - [[#show-entries-with-recent-timestamps][Show entries with recent timestamps]] - [[#stuck-projects-block-agenda][Stuck projects block agenda]] - [[#listing-bills-coming-due][Listing bills coming due]] @@ -36,11 +36,11 @@ This defines a simple list of stored views and a command to easily access them w (:auto-category t))))))) #+END_SRC -* Show entries with timestamps in the last N days +* Show entries with recent timestamps #+BEGIN_SRC elisp - (cl-defun org-ql-agenda-last-days (days &optional (type 'ts)) - "Show entries from previous DAYS days with timestamps of TYPE. + (cl-defun org-ql-agenda-recent-items (days &optional (type 'ts)) + "Show items from previous DAYS days with timestamps of TYPE. TYPE may be `ts', `ts-active', `ts-inactive', `clocked', `closed', `deadline', `planning', or `scheduled'." (interactive (list (read-number "Days: ") @@ -53,16 +53,22 @@ This defines a simple list of stored views and a command to easily access them w ;; Formatting isn't required, but it looks better in the header than a struct. ts-format))) (org-ql-search (org-agenda-files) - `(,type :from ,from :to ,(ts-format (ts-now)))))) + `(,type :from ,from :to ,(ts-format (ts-now))) + :title "Recent items" + :sort '(date priority todo) + :groups '((:todo "DONE") + (:category "log" :tag "log") + (:auto-parent t) + (:auto-todo t))))) ;; Show entries with any timestamp from last 7 days: - (org-ql-agenda-last-days 7) + (org-ql-agenda-recent-items 7) ;; Show entries clocked in last 7 days: - (org-ql-agenda-last-days 30 'clocked) + (org-ql-agenda-recent-items 30 'clocked) ;; Show entries closed in last 7 days: - (org-ql-agenda-last-days 30 'closed) + (org-ql-agenda-recent-items 30 'closed) #+END_SRC * Stuck projects block agenda From 2d6a8fbe66cb4321e45580de72d2d724a78b4848 Mon Sep 17 00:00:00 2001 From: Adam Porter Date: Wed, 14 Aug 2019 13:10:17 -0500 Subject: [PATCH 124/798] Docs: Fix punctuation --- README.org | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/README.org b/README.org index 1d6622d..dd7b76e 100644 --- a/README.org +++ b/README.org @@ -91,7 +91,7 @@ More examples are available in [[examples.org]]. The package may be installed directly from [[https://melpa.org/#/org-ql][MELPA]] or with other tools like [[https://framagit.org/steckerhalter/quelpa][Quelpa]]. -After installation. you can use commands like ~org-ql-search~ immediately. +After installation, you can use commands like ~org-ql-search~ immediately. To use the functions and macros in your own Elisp code, load the libraries ~org-ql~ and/or ~org-ql-agenda~ with e.g. ~(require 'org-ql)~. From a71e49b70adc794feac91d2b410979aee9093c50 Mon Sep 17 00:00:00 2001 From: Adam Porter Date: Thu, 15 Aug 2019 00:56:22 -0500 Subject: [PATCH 125/798] Notes: Remove done task --- notes.org | 23 ----------------------- 1 file changed, 23 deletions(-) diff --git a/notes.org b/notes.org index 9b3f2d1..13e936d 100644 --- a/notes.org +++ b/notes.org @@ -51,29 +51,6 @@ As discussed [[https://www.reddit.com/r/emacs/comments/cnrt2d/orgqlblock_integra I should benchmark it to see how much difference it makes, because all those ~fset~ calls on each heading isn't free. But if a macro were used to rewrite the built-in predicates to their full versions, all of that could be avoided... -** TODO [#B] Implied string literal regexp selector - -As mentioned [[https://www.reddit.com/r/emacs/comments/c8e0zp/my_gnu_hyperbole_vision_quest_odyssey_two/esmtqow/][here]]: - -#+BEGIN_QUOTE markdown -> Third – The “StringFind” search tool seems to be busted currently, but it’s pretty killer when it works. Basically, it lets you do boolean searches through records, so entering: - -> `(and sonnet italian (not petrarch))` - -`helm-org-rifle` provides this, e.g. the equivalent query would be: - -`sonnet italian !petrarch` - -`org-ql` also provides a lispy way to do this, e.g.: - - (org-ql "poetry.org" - (and (regexp "sonnet") - (regexp "italian") - (not (regexp "petrarch")))) - -It is more verbose because of the explicit `regexp` selector, but it would be easy to add an implied string literal selector. Putting that on the to-do list now... ;) -#+END_QUOTE - ** TODO [#A] Tools for saving queries and accessing them *** TODO Save query from ql-agenda buffer From e5791289c30184519be04a49d3c3420646b81285 Mon Sep 17 00:00:00 2001 From: Adam Porter Date: Thu, 15 Aug 2019 00:57:06 -0500 Subject: [PATCH 126/798] Notes: Fix macro --- notes.org | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/notes.org b/notes.org index 13e936d..75b56c7 100644 --- a/notes.org +++ b/notes.org @@ -104,9 +104,9 @@ This would require processing the predicate to pull out matchers that can be don `(bench-multi-lets :times ,times :ensure-equal t :lets (("preamble" ((org-ql-use-preamble t))) ("no preamble" ((org-ql-use-preamble nil)))) - :forms ((,(prin1-to-string query) (org-ql-query ,file - ',query - :action (lambda () (org-get-heading t t))))))) + :forms ((,(prin1-to-string query) (org-ql-select,file + ',query + :action (lambda () (org-get-heading t t))))))) #+END_SRC #+BEGIN_SRC elisp From 2831e940eb380e28377ae1538d4babc14feb74ca Mon Sep 17 00:00:00 2001 From: Adam Porter Date: Thu, 15 Aug 2019 01:00:28 -0500 Subject: [PATCH 127/798] Notes: Update code --- notes.org | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/notes.org b/notes.org index 75b56c7..3e3e329 100644 --- a/notes.org +++ b/notes.org @@ -429,7 +429,7 @@ Also, maybe instead of having a single =date= selector, I should have =scheduled #+BEGIN_SRC elisp (org-super-agenda--test-with-org-today-date "2017-07-08 00:00" - (org-agenda-ng "~/src/emacs/org-super-agenda/test/test.org" + (org-ql "~/src/emacs/org-super-agenda/test/test.org" (and (or (date = today) (deadline <=) (scheduled <= today)) From c2022b61685e847f1f021192923fde7012e78023 Mon Sep 17 00:00:00 2001 From: Adam Porter Date: Thu, 15 Aug 2019 01:00:40 -0500 Subject: [PATCH 128/798] Notes: Add WIP Helm stuff --- notes.org | 40 ++++++++++++++++++++++++++++++++++++++++ 1 file changed, 40 insertions(+) diff --git a/notes.org b/notes.org index 3e3e329..5aef795 100644 --- a/notes.org +++ b/notes.org @@ -436,6 +436,46 @@ Also, maybe instead of having a single =date= selector, I should have =scheduled (not (done))))) #+END_SRC +** Helm + +#+BEGIN_SRC elisp + (defun helm-org-ql-heading () + (let* ((path (mapconcat 'identity + (nreverse (org-split-string (org-format-outline-path (org-get-outline-path) + 1000 nil "") + "")) + org-sticky-header-outline-path-reversed-separator)) + (s (concat (org-sticky-header--get-prefix) + (org-get-heading) + org-sticky-header-outline-path-reversed-separator + path))) + (remove-list-of-text-properties 0 (length s) '(line-prefix) s) + (s-trim (if (> (length s) (window-width)) + (concat (substring s 0 (- (window-width) 2)) + "..") + s)))) + + (defun helm-org-ql-next () + (interactive) + (helm :sources (list (helm-build-sync-source "helm-org-ql" + ;; :after-init-hook helm-org-rifle-after-init-hook + :candidates (lambda () + (or (when-let* ((items (org-ql-select (org-agenda-files) + '(todo "NEXT") + :action 'element-with-markers + :sort '(priority date)))) + (--map (let* ((marker (org-element-property :org-marker it))) + (org-with-point-at marker + (cons (helm-org-ql-heading) marker))) + items)) + (list "NONE"))) + :match 'identity + :multiline nil + :volatile t + :action 'helm-org-rifle-actions + :keymap helm-org-rifle-map)))) +#+END_SRC + * Profiling ** Preambles From c3b1c0e1402edbd7d2739837ce16b78eca93fbe5 Mon Sep 17 00:00:00 2001 From: Adam Porter Date: Thu, 15 Aug 2019 01:04:22 -0500 Subject: [PATCH 129/798] Notes: Add idea --- notes.org | 9 +++++++++ 1 file changed, 9 insertions(+) diff --git a/notes.org b/notes.org index 5aef795..f80dd95 100644 --- a/notes.org +++ b/notes.org @@ -8,6 +8,15 @@ Would probably be useful to have a default sort option. +** TODO [#A] Outline path in buffers-files arg + +e.g. + +#+BEGIN_SRC elisp + (org-ql (olp "~/org/inbox.org" "Emacs" "Ideas") + (todo "NEXT")) +#+END_SRC + ** TODO ~org-agenda-skip-function~ As discussed [[https://www.reddit.com/r/emacs/comments/cnrt2d/orgqlblock_integrates_orgql_into_org_agenda/ewi1q36/][here]], this is a cool feature that allows further integration into existing custom agenda commands. Example: From b2d54e488967dd821e8f970ff56832e0f817a4d7 Mon Sep 17 00:00:00 2001 From: Adam Porter Date: Thu, 15 Aug 2019 01:06:06 -0500 Subject: [PATCH 130/798] Notes: Update --- notes.org | 299 ++++++++++++++++++++++++++---------------------------- 1 file changed, 143 insertions(+), 156 deletions(-) diff --git a/notes.org b/notes.org index f80dd95..5aab19d 100644 --- a/notes.org +++ b/notes.org @@ -2,12 +2,6 @@ * Tasks -** TODO Update commentary - -** TODO [#B] Default sort - -Would probably be useful to have a default sort option. - ** TODO [#A] Outline path in buffers-files arg e.g. @@ -17,6 +11,59 @@ e.g. (todo "NEXT")) #+END_SRC +** TODO [#A] Tools for saving queries and accessing them + ++ Added example to =examples.org=. + +*** TODO Save query from ql-agenda buffer + +*** TODO Access saved query from saved query list + +*** TODO Org link types +:PROPERTIES: +:ID: 4db73c1c-a4ed-425e-9e38-8d334ed03e1e +:END: + +This would be useful for having a menu of saved queries as Org links, or even bookmarking saved queries. + +**** TODO For all parameters + +**** TODO For saved queries + +*** TODO Bookmarks + +** TODO Add more sorters? + ++ [ ] =category= ++ [ ] Any date :: e.g. it would search for timestamps (active/inactive?) anywhere in an entry + +** TODO [#B] Default sort + +Would probably be useful to have a default sort option. + +** TODO Document sorters + +Note that the built-in sorting only works on Org elements, which is the default ~:action~. So if a different action is used, sorting will not work. In that case, the action should be mapped across the Org element results from outside the ~org-ql~ form. + +** TODO Document/figure out tag inheritance + +I think it should probably be enabled in most cases, to avoid missing results that users would expect to find, but it will reduce performance in some cases, so users should be able to turn it off when they don't need it. + +[2018-06-12 Tue 14:32] The docstring for ~org-map-entries~ says: + +#+BEGIN_QUOTE +If your function needs to retrieve the tags including inherited tags at the *current* entry, you can use the value of the variable ‘org-scanner-tags’ which will be much faster than getting the value with ‘org-get-tags-at’. If your function gets properties with ‘org-entry-properties’ at the *current* entry, bind ‘org-trust-scanner-tags’ to t around the call to ‘org-entry-properties’ to get the same speedup. Note that if your function moves around to retrieve tags and properties at a *different* entry, you cannot use these techniques. +#+END_QUOTE + +** TODO Normalize queries + +[2019-07-16 Tue 11:49] This serves two purposes: + +1. Equivalent queries will return the same results from the cache. +2. The selectors that can be converted to the fastest preamble regexps will be sorted first, so the fastest preamble will be used. Although this may not always be straightforward. For example, in a file with only a few =TODO= items, the ~(todo "TODO")~ selector would convert to a preamble that would quickly search through the file. But if there were a thousand =TODO= items, it wouldn't be as much of a benefit, and a ~(regexp "something")~ selector's preamble might be much faster, depending on how many times =something= appears in the file. + +So the second purpose might actually be a drawback, because it would prevent users from optimizing their queries with knowledge of their data. Maybe there should be an option to not normalize queries, so advanced users can order their selectors manually. + ** TODO ~org-agenda-skip-function~ As discussed [[https://www.reddit.com/r/emacs/comments/cnrt2d/orgqlblock_integrates_orgql_into_org_agenda/ewi1q36/][here]], this is a cool feature that allows further integration into existing custom agenda commands. Example: @@ -60,156 +107,7 @@ As discussed [[https://www.reddit.com/r/emacs/comments/cnrt2d/orgqlblock_integra I should benchmark it to see how much difference it makes, because all those ~fset~ calls on each heading isn't free. But if a macro were used to rewrite the built-in predicates to their full versions, all of that could be avoided... -** TODO [#A] Tools for saving queries and accessing them - -*** TODO Save query from ql-agenda buffer - -*** TODO Access saved query from saved query list - -*** TODO Org link types -:PROPERTIES: -:ID: 4db73c1c-a4ed-425e-9e38-8d334ed03e1e -:END: - -This would be useful for having a menu of saved queries as Org links, or even bookmarking saved queries. - -**** TODO For all parameters - -**** TODO For saved queries - -*** TODO Bookmarks - -** TODO [#A] Store query for refreshing ql-agenda buffer - -** DONE [#B] Dual matching with regexp and predicates -:PROPERTIES: -:ID: 39972bb5-fdd0-4754-93ba-c85796a67ccf -:END: - -/Note: This is underway in the =preamble-re= branch./ - -Searching and matching could be sped up by constructing a regexp that searches directly to the next possible match, and then matching with predicate functions. - -For example, a search like: - -#+BEGIN_SRC elisp - (org-ql (org-agenda-files) - (and (regexp "lisp") - (scheduled < today))) -#+END_SRC - -Only entries that contain the word =lisp= can be matches, and searching each entry for that word is wasteful. Instead, we could search the buffer for the next occurrence of =lisp=, then check the scheduled date for that entry. - -This would require processing the predicate to pull out matchers that can be done as buffer-wide regexps, e.g. =regexp=, =heading-regexp=, =todo=, and possibly =tags=. Org has some regexp-building functions that might make this fairly easy, and then we could probably use ~rx~ to make an optimized version of the regexp. It would also require some refactoring to the searching that would go directly to regexp matches when possible, rather than checking every entry with the predicate. - -[2019-07-16 Tue 11:14] Made new branch =preamble-re-new= based on current =master=. Seems to work well. Here's some code for testing and comparing performance (~bench-multi-lets~ is from [[https://github.com/alphapapa/emacs-package-dev-handbook#bench-multi-lets][here]]). - -[2019-07-16 Tue 11:56] Going to merge to =master= as 0.2, so marking this as done, even though there's a bit more that can be done from here. - -*** Benchmark code - -#+BEGIN_SRC elisp - (cl-defmacro org-ql-preamble-bench (&key query (file "tests/data.org") (times 10)) - `(bench-multi-lets :times ,times :ensure-equal t - :lets (("preamble" ((org-ql-use-preamble t))) - ("no preamble" ((org-ql-use-preamble nil)))) - :forms ((,(prin1-to-string query) (org-ql-select,file - ',query - :action (lambda () (org-get-heading t t))))))) -#+END_SRC - -#+BEGIN_SRC elisp - (org-ql-preamble-bench :query (regexp "Emacs") :times 100) -#+END_SRC - -#+RESULTS: -| Form | x faster than next | Total runtime | # of GCs | Total GC runtime | -|-------------------------------+--------------------+---------------+----------+------------------| -| preamble: (regexp "Emacs") | 1.22 | 0.141767 | 0 | 0 | -| no preamble: (regexp "Emacs") | slowest | 0.172398 | 0 | 0 | - -#+BEGIN_SRC elisp - (org-ql-preamble-bench :file "~/org/inbox.org" :query (regexp "Emacs") :times 5) -#+END_SRC - -#+RESULTS: -| Form | x faster than next | Total runtime | # of GCs | Total GC runtime | -|-------------------------------+--------------------+---------------+----------+------------------| -| preamble: (regexp "Emacs") | 1.59 | 2.011043 | 0 | 0 | -| no preamble: (regexp "Emacs") | slowest | 3.206370 | 0 | 0 | - -#+BEGIN_SRC elisp - (org-ql-preamble-bench :file "~/org/inbox.org" :query (and (regexp "Emacs") (todo)) :times 5) -#+END_SRC - -#+RESULTS: -| Form | x faster than next | Total runtime | # of GCs | Total GC runtime | -|--------------------------------------------+--------------------+---------------+----------+------------------| -| preamble: (and (regexp "Emacs") (todo)) | 1.59 | 2.211503 | 0 | 0 | -| no preamble: (and (regexp "Emacs") (todo)) | slowest | 3.512741 | 0 | 0 | - -#+BEGIN_SRC elisp - (org-ql-preamble-bench :file "~/org/inbox.org" :query (and (regexp "Emacs") (todo) (scheduled)) :times 5) -#+END_SRC - -#+RESULTS: -| Form | x faster than next | Total runtime | # of GCs | Total GC runtime | -|--------------------------------------------------------+--------------------+---------------+----------+------------------| -| preamble: (and (regexp "Emacs") (todo) (scheduled)) | 1.69 | 2.042456 | 0 | 0 | -| no preamble: (and (regexp "Emacs") (todo) (scheduled)) | slowest | 3.453756 | 0 | 0 | - -#+BEGIN_SRC elisp - (org-ql-preamble-bench :file "~/org/inbox.org" :query (todo "WAITING") :times 2) -#+END_SRC - -#+RESULTS: -| Form | x faster than next | Total runtime | # of GCs | Total GC runtime | -|-------------------------------+--------------------+---------------+----------+------------------| -| preamble: (todo "WAITING") | 15.60 | 0.070684 | 0 | 0 | -| no preamble: (todo "WAITING") | slowest | 1.102722 | 0 | 0 | - -Wow, that's a huge improvement! - -** TODO Normalize queries - -[2019-07-16 Tue 11:49] This serves two purposes: - -1. Equivalent queries will return the same results from the cache. -2. The selectors that can be converted to the fastest preamble regexps will be sorted first, so the fastest preamble will be used. Although this may not always be straightforward. For example, in a file with only a few =TODO= items, the ~(todo "TODO")~ selector would convert to a preamble that would quickly search through the file. But if there were a thousand =TODO= items, it wouldn't be as much of a benefit, and a ~(regexp "something")~ selector's preamble might be much faster, depending on how many times =something= appears in the file. - -So the second purpose might actually be a drawback, because it would prevent users from optimizing their queries with knowledge of their data. Maybe there should be an option to not normalize queries, so advanced users can order their selectors manually. - -** TODO [#A] Publish to MELPA - -** TODO Add more sorters? - -+ [ ] =category= -+ [ ] Any date :: e.g. it would search for timestamps (active/inactive?) anywhere in an entry - -** TODO Document matchers/selectors/predicates - -And maybe pick a single name for them... - -+ =deadline= :: Be sure to explain how it works with regard to the implied date and =today=. -+ =date=, =scheduled= :: No implied date, but supports =today=. - -** TODO Document sorters - -Note that the built-in sorting only works on Org elements, which is the default ~:action~. So if a different action is used, sorting will not work. In that case, the action should be mapped across the Org element results from outside the ~org-ql~ form. - -** TODO Document/figure out tag inheritance - -I think it should probably be enabled in most cases, to avoid missing results that users would expect to find, but it will reduce performance in some cases, so users should be able to turn it off when they don't need it. - -[2018-06-12 Tue 14:32] The docstring for ~org-map-entries~ says: - -#+BEGIN_QUOTE -If your function needs to retrieve the tags including inherited tags at the *current* entry, you can use the value of the variable ‘org-scanner-tags’ which will be much faster than getting the value with ‘org-get-tags-at’. If your function gets properties with ‘org-entry-properties’ at the *current* entry, bind ‘org-trust-scanner-tags’ to t around the call to ‘org-entry-properties’ to get the same speedup. Note that if your function moves around to retrieve tags and properties at a *different* entry, you cannot use these techniques. -#+END_QUOTE - -** MAYBE Date predicate that searches entire entry - -Because the existing ones only search the special date property line. +** TODO Update commentary ** MAYBE Fancier searching for inherited tags @@ -332,6 +230,95 @@ Virtually indistinguishable. Going to try moving the =byte-compile= call from t Doesn't seem to make any difference. +** DONE [#B] Dual matching with regexp and predicates +:PROPERTIES: +:ID: 39972bb5-fdd0-4754-93ba-c85796a67ccf +:END: + +/Note: This is underway in the =preamble-re= branch./ + +Searching and matching could be sped up by constructing a regexp that searches directly to the next possible match, and then matching with predicate functions. + +For example, a search like: + +#+BEGIN_SRC elisp + (org-ql (org-agenda-files) + (and (regexp "lisp") + (scheduled < today))) +#+END_SRC + +Only entries that contain the word =lisp= can be matches, and searching each entry for that word is wasteful. Instead, we could search the buffer for the next occurrence of =lisp=, then check the scheduled date for that entry. + +This would require processing the predicate to pull out matchers that can be done as buffer-wide regexps, e.g. =regexp=, =heading-regexp=, =todo=, and possibly =tags=. Org has some regexp-building functions that might make this fairly easy, and then we could probably use ~rx~ to make an optimized version of the regexp. It would also require some refactoring to the searching that would go directly to regexp matches when possible, rather than checking every entry with the predicate. + +[2019-07-16 Tue 11:14] Made new branch =preamble-re-new= based on current =master=. Seems to work well. Here's some code for testing and comparing performance (~bench-multi-lets~ is from [[https://github.com/alphapapa/emacs-package-dev-handbook#bench-multi-lets][here]]). + +[2019-07-16 Tue 11:56] Going to merge to =master= as 0.2, so marking this as done, even though there's a bit more that can be done from here. + +*** Benchmark code + +#+BEGIN_SRC elisp + (cl-defmacro org-ql-preamble-bench (&key query (file "tests/data.org") (times 10)) + `(bench-multi-lets :times ,times :ensure-equal t + :lets (("preamble" ((org-ql-use-preamble t))) + ("no preamble" ((org-ql-use-preamble nil)))) + :forms ((,(prin1-to-string query) (org-ql-select,file + ',query + :action (lambda () (org-get-heading t t))))))) +#+END_SRC + +#+BEGIN_SRC elisp + (org-ql-preamble-bench :query (regexp "Emacs") :times 100) +#+END_SRC + +#+RESULTS: +| Form | x faster than next | Total runtime | # of GCs | Total GC runtime | +|-------------------------------+--------------------+---------------+----------+------------------| +| preamble: (regexp "Emacs") | 1.22 | 0.141767 | 0 | 0 | +| no preamble: (regexp "Emacs") | slowest | 0.172398 | 0 | 0 | + +#+BEGIN_SRC elisp + (org-ql-preamble-bench :file "~/org/inbox.org" :query (regexp "Emacs") :times 5) +#+END_SRC + +#+RESULTS: +| Form | x faster than next | Total runtime | # of GCs | Total GC runtime | +|-------------------------------+--------------------+---------------+----------+------------------| +| preamble: (regexp "Emacs") | 1.59 | 2.011043 | 0 | 0 | +| no preamble: (regexp "Emacs") | slowest | 3.206370 | 0 | 0 | + +#+BEGIN_SRC elisp + (org-ql-preamble-bench :file "~/org/inbox.org" :query (and (regexp "Emacs") (todo)) :times 5) +#+END_SRC + +#+RESULTS: +| Form | x faster than next | Total runtime | # of GCs | Total GC runtime | +|--------------------------------------------+--------------------+---------------+----------+------------------| +| preamble: (and (regexp "Emacs") (todo)) | 1.59 | 2.211503 | 0 | 0 | +| no preamble: (and (regexp "Emacs") (todo)) | slowest | 3.512741 | 0 | 0 | + +#+BEGIN_SRC elisp + (org-ql-preamble-bench :file "~/org/inbox.org" :query (and (regexp "Emacs") (todo) (scheduled)) :times 5) +#+END_SRC + +#+RESULTS: +| Form | x faster than next | Total runtime | # of GCs | Total GC runtime | +|--------------------------------------------------------+--------------------+---------------+----------+------------------| +| preamble: (and (regexp "Emacs") (todo) (scheduled)) | 1.69 | 2.042456 | 0 | 0 | +| no preamble: (and (regexp "Emacs") (todo) (scheduled)) | slowest | 3.453756 | 0 | 0 | + +#+BEGIN_SRC elisp + (org-ql-preamble-bench :file "~/org/inbox.org" :query (todo "WAITING") :times 2) +#+END_SRC + +#+RESULTS: +| Form | x faster than next | Total runtime | # of GCs | Total GC runtime | +|-------------------------------+--------------------+---------------+----------+------------------| +| preamble: (todo "WAITING") | 15.60 | 0.070684 | 0 | 0 | +| no preamble: (todo "WAITING") | slowest | 1.102722 | 0 | 0 | + +Wow, that's a huge improvement! + ** DONE Operate on list of heading positions CLOSED: [2018-05-10 Thu 15:02] :LOGBOOK: From 6cd934114631f7b614b652a30d6cfaca9adfc264 Mon Sep 17 00:00:00 2001 From: Adam Porter Date: Thu, 15 Aug 2019 17:47:39 -0500 Subject: [PATCH 131/798] Fix: (org-ql-agenda--header-line-format) Available width Could cause an error with very long queries. --- org-ql-agenda.el | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/org-ql-agenda.el b/org-ql-agenda.el index 54644a1..be44798 100644 --- a/org-ql-agenda.el +++ b/org-ql-agenda.el @@ -296,10 +296,10 @@ the `match' item in the custom command form." (query-formatted (propertize (org-ql-agenda--font-lock-string 'emacs-lisp-mode query-formatted) 'help-echo query-formatted)) (query-width (length query-formatted)) - (available-width (- (window-width) - (length "In: ") - (length "Query: ") - query-width 4)) + (available-width (max 0 (- (window-width) + (length "In: ") + (length "Query: ") + query-width 4))) (buffers-files-formatted (format "%S" buffers-files)) (buffers-files-formatted (propertize (->> buffers-files-formatted (org-ql-agenda--font-lock-string 'emacs-lisp-mode) From da711ebb35e928f13ba83494984be928825eebb6 Mon Sep 17 00:00:00 2001 From: Adam Porter Date: Thu, 15 Aug 2019 23:34:23 -0500 Subject: [PATCH 132/798] Fix: (org-ql-search) Interactive completion --- org-ql-agenda.el | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/org-ql-agenda.el b/org-ql-agenda.el index be44798..972f59e 100644 --- a/org-ql-agenda.el +++ b/org-ql-agenda.el @@ -176,10 +176,10 @@ TITLE: An optional string displayed in the header." (read-minibuffer "Query: ") :narrow (eq current-prefix-arg '(4)) :groups (pcase (completing-read "Group by: " - (cons "Don't group" - "Global groups" - (cl-loop for type in org-super-agenda-auto-selector-keywords - collect (substring (symbol-name type) 6)))) + (append (list "Don't group" + "Global groups") + (cl-loop for type in org-super-agenda-auto-selector-keywords + collect (substring (symbol-name type) 6)))) ("Global groups" org-super-agenda-groups) ("Don't group" nil) (property (list (list (intern (concat ":auto-" property)))))) From 27e343700d6e3a2fec9ba9250617fac4d200c8ca Mon Sep 17 00:00:00 2001 From: Adam Porter Date: Thu, 15 Aug 2019 23:35:47 -0500 Subject: [PATCH 133/798] Notes: Add --- notes.org | 2 ++ 1 file changed, 2 insertions(+) diff --git a/notes.org b/notes.org index 5aab19d..b7d0b8a 100644 --- a/notes.org +++ b/notes.org @@ -11,6 +11,8 @@ e.g. (todo "NEXT")) #+END_SRC +Also, should support an ~id~ one. + ** TODO [#A] Tools for saving queries and accessing them + Added example to =examples.org=. From 62878f5d9f28ea089034e744e400a3f333bbb035 Mon Sep 17 00:00:00 2001 From: Adam Porter Date: Fri, 16 Aug 2019 11:47:04 -0500 Subject: [PATCH 134/798] Fix: Free variable warning --- org-ql-agenda.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/org-ql-agenda.el b/org-ql-agenda.el index 972f59e..ba24e1f 100644 --- a/org-ql-agenda.el +++ b/org-ql-agenda.el @@ -102,7 +102,7 @@ is used, rather than binding it locally." super-groups (plist-get ,args :super-groups) title (plist-get ,args :title)))) (let ((files '(org-agenda-files)) - query sort narrow buffer super-groups) + query sort narrow buffer super-groups title) ;; Parse args manually (so we can leave FILES nil for a default argument). ;; TODO: DRY this and org-ql, I think. (pcase args From 6aeb3030c6777822d73cb1f1b4e8f60c48b0636a Mon Sep 17 00:00:00 2001 From: Adam Porter Date: Fri, 16 Aug 2019 12:14:36 -0500 Subject: [PATCH 135/798] Add: Customization group --- README.org | 1 + org-ql-agenda.el | 3 ++- org-ql.el | 7 +++++++ 3 files changed, 10 insertions(+), 1 deletion(-) diff --git a/README.org b/README.org index dd7b76e..f570303 100644 --- a/README.org +++ b/README.org @@ -414,6 +414,7 @@ Expands into a call to ~org-ql-select~ with the same arguments. For convenience + Selectors ~(children)~ and ~(descendants)~. + Function ~org-ql-search~ and macro ~org-ql-agenda~ accept a ~:title~ argument, which is displayed in the header. + Command ~org-ql-search~ offers global ~org-super-agenda-groups~ in completion. ++ Customization group ~org-ql~. *Changed* + Function ~org-ql-query~ renamed to ~org-ql-select~. ~org-ql-query~ now refers to a new function. diff --git a/org-ql-agenda.el b/org-ql-agenda.el index ba24e1f..7a37646 100644 --- a/org-ql-agenda.el +++ b/org-ql-agenda.el @@ -52,7 +52,8 @@ (defface org-ql-agenda-due-date '((t (:slant italic :weight bold))) - "Face for due dates in `org-ql-agenda' views.") + "Face for due dates in `org-ql-agenda' views." + :group 'org-ql) ;;;; Variables diff --git a/org-ql.el b/org-ql.el index 9c5cfc7..bb9e392 100644 --- a/org-ql.el +++ b/org-ql.el @@ -95,6 +95,13 @@ hash table, keyed by arguments passed to "Plist of predicates, their corresponding functions, and their docstrings. This list should not contain any duplicates.") +;;;; Customization + +(defgroup org-ql nil + "Customization for `org-ql'." + :group 'org + :link '(url-link "https://github.com/alphapapa/org-ql")) + ;;;; Macros (cl-defmacro org-ql--defpred (name args docstring &rest body) From 429c31363445bd8237eb0e99b64e21a8b9da11f7 Mon Sep 17 00:00:00 2001 From: Adam Porter Date: Fri, 16 Aug 2019 12:27:30 -0500 Subject: [PATCH 136/798] Docs: Organize commands --- README.org | 19 +++++++++++++++---- 1 file changed, 15 insertions(+), 4 deletions(-) diff --git a/README.org b/README.org index f570303..f6044eb 100644 --- a/README.org +++ b/README.org @@ -111,13 +111,24 @@ Installing with [[https://framagit.org/steckerhalter/quelpa][Quelpa]] is easy: The functionality provided may be grouped by: -+ Interactive commands :: ~org-ql-search~ -+ Non-interactive functions and macros :: ~org-ql~ (macro), ~org-ql-select~ (function), ~org-ql-query~ (function), ~org-ql-block~ (agenda function), and ~org-ql-agenda~ (macro) ++ *Interactive commands:* ~org-ql-search~, ~org-ql-view~. ++ *Non-interactive functions and macros:* + - ~org-ql~ (macro) + - ~org-ql-select~ (function) + - ~org-ql-query~ (function) + - ~org-ql-agenda~ (macro) + - ~org-ql-block~ (agenda function) Alternatively, they may be grouped by: -+ Showing an agenda-like view :: ~org-ql-search~ (command), ~org-ql-block~ (agenda function), and ~org-ql-agenda~ (macro) -+ Returning a list of matches or acting on them :: ~org-ql~ (macro), ~org-ql-select~ (function), and ~org-ql-query~ (function) ++ *Showing an agenda-like view:* + - ~org-ql-search~ (command) + - ~org-ql-block~ (agenda function) + - ~org-ql-agenda~ (macro) ++ *Returning a list of matches or acting on them:* + - ~org-ql~ (macro) + - ~org-ql-select~ (function) + - ~org-ql-query~ (function) Feedback on these APIs is welcome. Eventually, after being tested and polished, they will be considered stable. From ae3ec62e3cddee4db3a2423debea5da15fc425ac Mon Sep 17 00:00:00 2001 From: Adam Porter Date: Fri, 16 Aug 2019 12:29:20 -0500 Subject: [PATCH 137/798] Add: org-ql-view-map --- README.org | 4 +++- org-ql-agenda.el | 12 +++++++++--- 2 files changed, 12 insertions(+), 4 deletions(-) diff --git a/README.org b/README.org index f6044eb..fe8f963 100644 --- a/README.org +++ b/README.org @@ -155,7 +155,8 @@ Read ~QUERY~ and search with ~org-ql~. Interactively, prompt for these variable ~SORT~: One or a list of ~org-ql~ sorting functions, like ~date~ or ~priority~. -Press =g= to refresh the results buffer. +*Bindings:* ++ =g=: Refresh results. [[images/org-ql-search.gif]] @@ -426,6 +427,7 @@ Expands into a call to ~org-ql-select~ with the same arguments. For convenience + Function ~org-ql-search~ and macro ~org-ql-agenda~ accept a ~:title~ argument, which is displayed in the header. + Command ~org-ql-search~ offers global ~org-super-agenda-groups~ in completion. + Customization group ~org-ql~. ++ Variable ~org-ql-view-map~, active in view buffers displayed by ~org-ql-search~, ~org-ql-agenda~, and ~org-ql-view~. *Changed* + Function ~org-ql-query~ renamed to ~org-ql-select~. ~org-ql-query~ now refers to a new function. diff --git a/org-ql-agenda.el b/org-ql-agenda.el index 7a37646..6ac4dd4 100644 --- a/org-ql-agenda.el +++ b/org-ql-agenda.el @@ -60,6 +60,14 @@ (defvar org-ql-agenda-buffer-name "*Org-QL-Agenda*" "Name of default `org-ql-agenda' buffer.") +(defvar org-ql-view-map + (let ((map (copy-keymap org-agenda-mode-map))) + (define-key map "g" #'org-ql-search-refresh) + (define-key map (kbd "C-x C-s") #'org-ql-search-save) + map) + "Keymap for `org-ql-agenda', `org-ql-search', and `org-ql-views' views. +Based on `org-agenda-mode-map'.") + ;; For refreshing results buffers. (defvar org-ql-buffers-files) (defvar org-ql-query) @@ -240,11 +248,9 @@ TITLE: An optional string displayed in the header." (string (org-ql-agenda--buffer buffer)) (null (org-ql-agenda--buffer buffer)) (buffer buffer))) - (map (copy-keymap org-agenda-mode-map)) (inhibit-read-only t)) - (define-key map "g" #'org-ql-search-refresh) (with-current-buffer buffer - (use-local-map map) + (use-local-map org-ql-view-map) ;; Prepare buffer, saving data for refreshing. (setq-local org-ql-buffers-files buffers-files) (setq-local org-ql-query query) From be92d531ecbc85d38777e82d7f2e80f4e6150070 Mon Sep 17 00:00:00 2001 From: Adam Porter Date: Fri, 16 Aug 2019 12:30:37 -0500 Subject: [PATCH 138/798] Add: org-ql-view, org-ql-views, org-ql-search-save --- README.org | 7 ++++++ examples.org | 28 ---------------------- org-ql-agenda.el | 62 ++++++++++++++++++++++++++++++++++++++++++++++++ 3 files changed, 69 insertions(+), 28 deletions(-) diff --git a/README.org b/README.org index fe8f963..9a39fdf 100644 --- a/README.org +++ b/README.org @@ -123,6 +123,7 @@ Alternatively, they may be grouped by: + *Showing an agenda-like view:* - ~org-ql-search~ (command) + - ~org-ql-view~ (command) - ~org-ql-block~ (agenda function) - ~org-ql-agenda~ (macro) + *Returning a list of matches or acting on them:* @@ -157,6 +158,7 @@ Read ~QUERY~ and search with ~org-ql~. Interactively, prompt for these variable *Bindings:* + =g=: Refresh results. ++ =C-x C-s=: Save query to variable ~org-ql-views~ (accessible with command ~org-ql-view~). [[images/org-ql-search.gif]] @@ -164,6 +166,10 @@ Here's an example of using it to generate an agenda-like view for certain files [[images/org-ql-search-snippet.png]] +*** org-ql-view + +Choose and display a view stored in ~org-ql-views~. + ** Queries A query is a lisp form which may contain arbitrary lisp forms, as well as certain built-in predicates. It is byte-compiled into a predicate function which is tested with point on each heading in an Org buffer; when it returns non-nil, the heading matches the query. @@ -427,6 +433,7 @@ Expands into a call to ~org-ql-select~ with the same arguments. For convenience + Function ~org-ql-search~ and macro ~org-ql-agenda~ accept a ~:title~ argument, which is displayed in the header. + Command ~org-ql-search~ offers global ~org-super-agenda-groups~ in completion. + Customization group ~org-ql~. ++ Command ~org-ql-view~, which displays views saved to variable ~org-ql-views~, which can be saved from ~org-ql-search~ buffers with command ~org-ql-search-save~, which is bound to =C-x C-s= in view buffers. + Variable ~org-ql-view-map~, active in view buffers displayed by ~org-ql-search~, ~org-ql-agenda~, and ~org-ql-view~. *Changed* diff --git a/examples.org b/examples.org index 1855094..759ea3e 100644 --- a/examples.org +++ b/examples.org @@ -4,38 +4,10 @@ :PROPERTIES: :TOC: this :END: - - [[#stored-views-command][Stored views command]] - [[#show-entries-with-recent-timestamps][Show entries with recent timestamps]] - [[#stuck-projects-block-agenda][Stuck projects block agenda]] - [[#listing-bills-coming-due][Listing bills coming due]] -* Stored views command - -This defines a simple list of stored views and a command to easily access them with completion, which may be more convenient than defining a command for each view. - -#+BEGIN_SRC elisp - (defun org-ql-view (&optional view) - "Choose and display a stored `org-ql' view." - (interactive (list (completing-read "View: " (mapcar #'car org-ql-views)))) - (funcall (alist-get view org-ql-views nil nil #'string=))) - - (setq org-ql-views - (list (cons "Stuck Projects" (lambda () - (org-ql-agenda (org-agenda-files) - (and (todo) - (not (todo "TO-WATCH" "TO-READ" "MAYBE" "SOMEDAY")) - (children) - (not (children (todo))) - (not (habit))) - :title "Stuck Projects" - :sort (priority date) - :super-groups ((:name "Home" :tag "home") - (:tag ("Emacs" "computer") :order 100) - (:auto-parent t) - (:todo "WAITING") - (:auto-category t))))))) -#+END_SRC - * Show entries with recent timestamps #+BEGIN_SRC elisp diff --git a/org-ql-agenda.el b/org-ql-agenda.el index 6ac4dd4..b62eeb2 100644 --- a/org-ql-agenda.el +++ b/org-ql-agenda.el @@ -27,6 +27,7 @@ ;;; Code: (require 'cl-lib) +(require 'map) (require 'org) (require 'org-element) (require 'org-agenda) @@ -76,6 +77,42 @@ Based on `org-agenda-mode-map'.") (defvar org-ql-super-groups) (defvar org-ql-title) +;;;; Customization + +(defcustom org-ql-views + (list (cons "Recent entries" (cl-function + (lambda (days &optional (type 'ts)) + (interactive (list (read-number "Days: ") + (->> '(ts ts-active ts-inactive clocked closed deadline planning scheduled) + (completing-read "Timestamp type: ") + intern))) + (let ((from (->> (ts-now) + (ts-adjust 'day (* -1 days)) + (ts-apply :hour 0 :minute 0 :second 0) + ;; Formatting isn't required, but it looks better in the header than a struct. + ts-format))) + (org-ql-search (org-agenda-files) + `(,type :from ,from :to ,(ts-format (ts-now))) + :title "Recent Entries" + :sort '(date priority todo) + :groups '((:todo "DONE") + (:auto-parent t) + (:auto-todo t))))))) + (cons "Stuck Projects" (lambda () + (interactive) + (org-ql-search (org-agenda-files) + '(and (todo) + (children) + (not (children (todo "NEXT")))) + :title "Stuck Projects" + :sort '(priority date))))) + "Alist of `org-ql-view' commands. +Each value should be a function that calls, +e.g. `org-ql-search' as desired." + :group 'org-ql + :type '(alist :key-type string + :value-type function)) + ;;;; Macros ;; FIXME: DRY these two macros. @@ -220,6 +257,31 @@ TITLE: An optional string displayed in the header." :title org-ql-title :buffer (current-buffer))) +(defun org-ql-search-save () + "Save current `org-ql-search' buffer to `org-ql-views'." + (interactive) + (let* ((name (read-string "Save view as: ")) + (buffers-files-sexp (cl-etypecase org-ql-buffers-files + (string org-ql-buffers-files) + (list `(list ,@org-ql-buffers-files)) + (null nil))) + (function `(lambda () + (interactive) + (org-ql-search ,buffers-files-sexp + ',org-ql-query + :sort ',org-ql-sort + :narrow ,org-ql-narrow + :groups ',org-ql-super-groups + :title ,name)))) + (map-put org-ql-views name function #'equal) + (customize-set-variable 'org-ql-views org-ql-views) + (customize-mark-to-save 'org-ql-views))) + +(defun org-ql-view (&optional view) + "Choose and display a view stored in `org-ql-views'." + (interactive (list (completing-read "View: " (mapcar #'car org-ql-views)))) + (call-interactively (alist-get view org-ql-views nil nil #'string=))) + ;;;; Functions ;; TODO: Move the action-fn down into --filter-buffer, so users can avoid calling the From 869ce69f1dba8d80c715193974e9c60261306852 Mon Sep 17 00:00:00 2001 From: Adam Porter Date: Fri, 16 Aug 2019 12:43:35 -0500 Subject: [PATCH 139/798] Docs: Bindings --- README.org | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/README.org b/README.org index 9a39fdf..dcb0b4a 100644 --- a/README.org +++ b/README.org @@ -156,7 +156,7 @@ Read ~QUERY~ and search with ~org-ql~. Interactively, prompt for these variable ~SORT~: One or a list of ~org-ql~ sorting functions, like ~date~ or ~priority~. -*Bindings:* +*Bindings:* Keys bound in results buffer. + =g=: Refresh results. + =C-x C-s=: Save query to variable ~org-ql-views~ (accessible with command ~org-ql-view~). From 26a8c3d5dc745181e3169c0a8185028820177a85 Mon Sep 17 00:00:00 2001 From: Adam Porter Date: Sun, 18 Aug 2019 20:27:11 -0500 Subject: [PATCH 140/798] Tests: Add convenient comment --- tests/test-org-ql.el | 2 ++ 1 file changed, 2 insertions(+) diff --git a/tests/test-org-ql.el b/tests/test-org-ql.el index df4a917..21113b6 100644 --- a/tests/test-org-ql.el +++ b/tests/test-org-ql.el @@ -125,6 +125,8 @@ RESULTS should be a list of strings as returned by (substring-no-properties (org-get-heading t t t t)))) (setq test-buffer (find-file-noselect (concat default-directory "tests/data.org")) + ;; For manual testing: + ;; test-buffer (find-file-noselect "data.org") num-headings (with-current-buffer test-buffer (org-with-wide-buffer (goto-char (point-min)) From 99a18dff2a20964a7575e73390aa39ab28b4cec1 Mon Sep 17 00:00:00 2001 From: Adam Porter Date: Sun, 18 Aug 2019 21:08:35 -0500 Subject: [PATCH 141/798] Comment: Add TODO --- org-ql.el | 3 +++ 1 file changed, 3 insertions(+) diff --git a/org-ql.el b/org-ql.el index bb9e392..0535bb0 100644 --- a/org-ql.el +++ b/org-ql.el @@ -780,6 +780,9 @@ comparator, PRIORITY should be a priority string." ;;;;;; Timestamps +;; TODO: Remove the _on vars from these arg lists. I think they're not +;; necessary, or shouldn't be, since --pre-process-query should handle them. + (org-ql--defpred clocked (&key from to _on) ;; The underscore before `on' prevents "unused lexical variable" ;; warnings, because we pre-process that argument in a macro before From ab3d1178b9ccf1bca4e157c6d88e97299a19648a Mon Sep 17 00:00:00 2001 From: Adam Porter Date: Sun, 18 Aug 2019 21:28:06 -0500 Subject: [PATCH 142/798] Add: Call some ts-type predicates with a number/auto --- README.org | 26 ++++++++++------ examples.org | 33 +++++++++----------- examples/org-bills-due.el | 2 +- org-ql.el | 64 +++++++++++++++++++++++++++++++++++++++ tests/test-org-ql.el | 41 +++++++++++++++++++++++++ 5 files changed, 136 insertions(+), 30 deletions(-) diff --git a/README.org b/README.org index dcb0b4a..9431fd7 100644 --- a/README.org +++ b/README.org @@ -44,16 +44,16 @@ More examples are available in [[examples.org]]. :action '(org-toggle-tag "Emacs" 'on)) ;; Return a list of bills coming due, searching all Org Agenda files, - ;; sorted by deadline. Deadlines are compared with - ;; `org-deadline-warning-days', which is implied by the plain `<=' in - ;; the `deadline' predicate. `org-ql-query' works like `org-ql-select' - ;; but offers arguments named like SQL queries. + ;; sorted by deadline. The `auto' argument to `deadline' means to match + ;; entries whose deadlines fall within `org-deadline-warning-days'. + ;; `org-ql-query' works like `org-ql-select' but offers arguments named + ;; like SQL queries. (org-ql-query :select #'org-get-heading :from (org-agenda-files) :where '(and (not (done)) (tags "bills") - (deadline <=)) + (deadline auto)) :order-by 'deadline) ;;=> ("TODO Electric bill" "TODO Water bill") @@ -205,17 +205,23 @@ Arguments are listed next to predicate names, where applicable. All of these selectors take optional keyword arguments ~:from~, ~:to:~, and ~:on~. If ~:from~, return non-nil if entry has a timestamp on or after ~:from~. If ~:to~, return non-nil if entry has a timestamp on or before ~:to~. If ~:on~, return non-nil if entry has a timestamp on date ~:on~. Argument values should be either ~ts~ structs, or strings parseable by ~parse-time-string~ which may omit the time value. -+ ~clocked~ :: Return non-nil if current entry was clocked in given period. If no arguments are specified, return non-nil if entry was clocked at any time. Note: Clock entries are expected to be clocked out. Currently clocked entries (i.e. with unclosed timestamp ranges) are ignored. -+ ~closed~ :: Return non-nil if current entry was closed in given period. If no arguments are specified, return non-nil if entry was closed at any time. -+ ~deadline~ :: Return non-nil if current entry has deadline in given period. If no arguments are specified, return non-nil if entry has any deadline. -+ ~planning~ :: Return non-nil if current entry has planning timestamp in given period (i.e. its deadline, scheduled, or closed timestamp). If no arguments are specified, return non-nil if entry is scheduled at any time. -+ ~scheduled~ :: Return non-nil if current entry is scheduled in given period. If no arguments are specified, return non-nil if entry is scheduled at any time. + ~ts~ :: Return non-nil if current entry has a timestamp in given period. If no arguments are specified, return non-nil if entry has any timestamp. + ~ts-active~ :: Like ~ts~, but only matches active timestamps. + ~ts-a~ :: Like ~ts~, but only matches active timestamps. + ~ts-inactive~ :: Like ~ts~, but only matches inactive timestamps. + ~ts-i~ :: Like ~ts~, but only matches inactive timestamps. +The following selectors can also take a single argument, a number, which looks backward or forward a number of days. The number can also be negative to invert the direction. + +*Backward-looking:* ++ ~clocked~ :: Return non-nil if current entry was clocked in given period. If no arguments are specified, return non-nil if entry was clocked at any time. Note: Clock entries are expected to be clocked out. Currently clocked entries (i.e. with unclosed timestamp ranges) are ignored. ++ ~closed~ :: Return non-nil if current entry was closed in given period. If no arguments are specified, return non-nil if entry was closed at any time. + +*Forward-looking:* ++ ~deadline~ :: Return non-nil if current entry has deadline in given period. If argument is =auto=, return non-nil if entry has deadline within =org-deadline-warning-days=. If no arguments are specified, return non-nil if entry has any deadline. ++ ~planning~ :: Return non-nil if current entry has planning timestamp in given period (i.e. its deadline, scheduled, or closed timestamp). If no arguments are specified, return non-nil if entry is scheduled at any time. ++ ~scheduled~ :: Return non-nil if current entry is scheduled in given period. If no arguments are specified, return non-nil if entry is scheduled at any time. + ** Functions / Macros :PROPERTIES: :TOC: ignore-children diff --git a/examples.org b/examples.org index 759ea3e..b90c9da 100644 --- a/examples.org +++ b/examples.org @@ -11,7 +11,7 @@ * Show entries with recent timestamps #+BEGIN_SRC elisp - (cl-defun org-ql-agenda-recent-items (days &optional (type 'ts)) + (cl-defun org-ql-view-recent-items (days &optional (type 'ts)) "Show items from previous DAYS days with timestamps of TYPE. TYPE may be `ts', `ts-active', `ts-inactive', `clocked', `closed', `deadline', `planning', or `scheduled'." @@ -19,28 +19,23 @@ (->> '(ts ts-active ts-inactive clocked closed deadline planning scheduled) (completing-read "Timestamp type: ") intern))) - (let ((from (->> (ts-now) - (ts-adjust 'day (* -1 days)) - (ts-apply :hour 0 :minute 0 :second 0) - ;; Formatting isn't required, but it looks better in the header than a struct. - ts-format))) - (org-ql-search (org-agenda-files) - `(,type :from ,from :to ,(ts-format (ts-now))) - :title "Recent items" - :sort '(date priority todo) - :groups '((:todo "DONE") - (:category "log" :tag "log") - (:auto-parent t) - (:auto-todo t))))) + (org-ql-search (org-agenda-files) + `(,type ,days) + :title "Recent items" + :sort '(date priority todo) + :groups '((:todo "DONE") + (:name "Log" :category "log" :tag "log") + (:auto-parent t) + (:auto-todo t)))) ;; Show entries with any timestamp from last 7 days: - (org-ql-agenda-recent-items 7) + (org-ql-view-recent-items 7) - ;; Show entries clocked in last 7 days: - (org-ql-agenda-recent-items 30 'clocked) + ;; Show entries clocked in last 30 days: + (org-ql-view-recent-items 30 'clocked) - ;; Show entries closed in last 7 days: - (org-ql-agenda-recent-items 30 'closed) + ;; Show entries closed in last 30 days: + (org-ql-view-recent-items 30 'closed) #+END_SRC * Stuck projects block agenda diff --git a/examples/org-bills-due.el b/examples/org-bills-due.el index 5c7261c..c544734 100644 --- a/examples/org-bills-due.el +++ b/examples/org-bills-due.el @@ -35,7 +35,7 @@ (-if-let* ((header "Bills due within 3 days") (items (org-ql "~/org/main.org" - (and (deadline <= (+ 3 today)) + (and (deadline 3) (tags "bills")) :action (org-get-heading 'no-tags 'no-todo))) (string (concat "