WIP: Pad todo keywords

notes.org

@@ -2485,3 +2485,96 @@ Benchmark results:
 | uncached | slowest            |      3.386679 |        0 |                0 |
 
 
+** Padding to-do keywords
+
+Not sure if these results are quite right.  =elp-profile= shows them being nearly identical.
+
+#+BEGIN_SRC elisp
+  (bench-multi-lexical :times 1
+    :forms (("No padding" (org-ql-agenda
+                            (and (todo)
+                                 (not (done))
+                                 (tags "Emacs"))
+                            :sort (priority deadline)
+                            :super-groups t))
+                        ("Padding" (org-ql-agenda**
+                           (and (todo)
+                                (not (done))
+                                (tags "Emacs"))
+                           :sort (priority deadline)
+                           :super-groups t))))
+#+END_SRC
+
+#+RESULTS:
+| Form       | x faster than next | Total runtime | # of GCs | Total GC runtime |
+|------------+--------------------+---------------+----------+------------------|
+| No padding | 1.24               |      3.990292 |        0 |                0 |
+| Padding    | slowest            |      4.962510 |        1 |         0.731848 |
+
+#+BEGIN_SRC elisp
+  (elp-profile 5 '(format s- org-ql-)
+    (org-ql-agenda
+      (and (todo)
+           (not (done))
+           (tags "Emacs"))
+      :sort (priority deadline)
+      :super-groups t))
+#+END_SRC
+
+#+RESULTS:
+| Function                            | Times called |   Total time | Average time |
+|-------------------------------------+--------------+--------------+--------------|
+| org-ql-agenda--agenda               |            5 | 26.580556158 | 5.3161112316 |
+| org-ql-select                       |            5 | 19.675620106 | 3.9351240212 |
+| org-ql--select-cached               |           40 | 19.634117127 | 0.4908529281 |
+| org-ql--select                      |           40 | 19.630597547 | 0.4907649386 |
+| org-ql--predicate-tags              |         7315 | 10.949397690 | 0.0014968417 |
+| org-ql--get-tags                    |         7315 | 9.6837818669 | 0.0013238252 |
+| org-ql--predicate-todo              |        48230 | 3.5819731560 | 7.426...e-05 |
+| org-ql-agenda--format-element       |         2435 |  3.019326507 | 0.0012399698 |
+| org-ql--predicate-done              |        11530 | 1.0185417590 | 8.833...e-05 |
+| format                              |        23465 | 0.7703946220 | 3.283...e-05 |
+| s-join                              |         5050 | 0.0558378950 | 1.105...e-05 |
+| org-ql-agenda--add-faces            |         2435 | 0.0284022579 | 1.166...e-05 |
+| org-ql--sort-by                     |            5 | 0.0263453159 | 0.0052690631 |
+| org-ql-agenda--add-scheduled-face   |         2435 | 0.0208554550 | 8.564...e-06 |
+| org-ql--priority<                   |        12372 | 0.0069503440 | 5.617...e-07 |
+| format-time-string                  |          244 | 0.0062056230 | 2.543...e-05 |
+| org-ql-agenda--header-line-format   |            5 | 0.0058773409 | 0.0011754682 |
+| org-ql-agenda--add-todo-face        |         2435 | 0.0056749869 | 2.330...e-06 |
+| org-ql-agenda--font-lock-string     |           10 |  0.005474521 | 0.0005474521 |
+| org-ql-agenda--format-relative-date |          235 | 0.0054201809 | 2.306...e-05 |
+
+#+BEGIN_SRC elisp
+  (elp-profile 5 '(format s- org-ql-)
+    (org-ql-agenda**
+      (and (todo)
+           (not (done))
+           (tags "Emacs"))
+      :sort (todo priority date)
+      :super-groups t))
+#+END_SRC
+
+#+RESULTS:
+| Function                            | Times called |   Total time | Average time |
+|-------------------------------------+--------------+--------------+--------------|
+| org-ql-agenda--agenda**             |            5 | 26.333809735 |  5.266761947 |
+| org-ql-select                       |            5 | 17.267948398 | 3.4535896797 |
+| org-ql--select-cached               |           40 | 17.227040189 | 0.4306760047 |
+| org-ql--select                      |           40 | 17.223625576 | 0.4305906394 |
+| org-ql--predicate-tags              |         7315 | 8.9554375800 | 0.0012242566 |
+| org-ql--get-tags                    |         7315 | 8.8911675469 | 0.0012154706 |
+| org-ql-agenda--format-element*      |         2435 | 3.8197904740 | 0.0015687024 |
+| org-ql--predicate-todo              |        48230 | 3.3793621580 | 7.006...e-05 |
+| org-ql--predicate-done              |        11530 | 0.9646284939 | 8.366...e-05 |
+| s-join                              |         5050 | 0.0551078480 | 1.091...e-05 |
+| format                              |        30100 | 0.0522020250 | 1.734...e-06 |
+| org-ql-agenda--add-faces            |         2435 | 0.0287117619 | 1.179...e-05 |
+| org-ql--sort-by                     |            5 | 0.0257972720 | 0.0051594544 |
+| org-ql-agenda--add-scheduled-face   |         2435 | 0.0209146540 | 8.589...e-06 |
+| org-ql--priority<                   |        12372 | 0.0069437200 | 5.612...e-07 |
+| format-time-string                  |          244 | 0.0061829569 | 2.533...e-05 |
+| org-ql-agenda--header-line-format   |            5 | 0.0058565250 |  0.001171305 |
+| org-ql-agenda--add-todo-face        |         2435 | 0.0056821220 | 2.333...e-06 |
+| org-ql-agenda--font-lock-string     |           10 |  0.005448187 | 0.0005448187 |
+| org-ql-agenda--format-relative-date |          235 | 0.0053996679 | 2.297...e-05 |

org-ql-agenda.el

@@ -72,6 +72,8 @@ Based on `org-agenda-mode-map'.")
 (defvar org-ql-block-header nil
   "A string to override the default header in `org-ql-block' agenda blocks.")
 
+(defvar org-ql-todo-keyword-length nil)
+
 ;; For refreshing results buffers.
 (defvar org-ql-buffers-files)
 (defvar org-ql-query)
@@ -188,6 +190,130 @@ is used, rather than binding it locally."
          :super-groups ',super-groups
          :title ,title))))
 
+(cl-defmacro org-ql-agenda* (&rest args)
+  "Display an agenda-like buffer of entries in FILES that match QUERY.
+
+FILES-OR-QUERY is a sexp that is evaluated to get the list of
+buffers and files to scan.
+
+QUERY is an `org-ql' query.  The query may be passed as
+FILES-OR-QUERY and QUERY may be left nil, in which case the list
+of files will automatically be set to the value of calling
+`org-agenda-files'.
+
+SORT is passed to `org-ql', which see..
+
+NARROW, when non-nil, means to respect narrowing in buffers.
+When nil, buffers are widened before being searched.
+
+BUFFER, when non-nil, is a buffer or buffer name to display the
+agenda in, rather than the default.
+
+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))
+  (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))))
+    (let ((files '(org-agenda-files))
+          query sort narrow buffer super-groups)
+      ;; Parse args manually (so we can leave FILES nil for a default argument).
+      ;; TODO: DRY this and org-ql, I think.
+      (pcase args
+        (`(,arg-files ,arg-pred . ,(and rest (guard (keywordp (car rest)))))
+         ;; Files, query, and keyword args (FIXME: Can I combine this and the next one?  Does it
+         ;; matter if rest is nil or starts with a keyword?)
+         (setq files arg-files
+               query arg-pred)
+         (set-keyword-args rest))
+        (`(,arg-pred . ,(and rest (guard (keywordp (car rest)))))
+         ;; Query and keyword args, no files
+         (setq query arg-pred)
+         (set-keyword-args rest))
+        (`(,arg-files ,arg-pred)
+         ;; Files and query, no keywords
+         (setq files arg-files
+               query arg-pred))
+        (`(,arg-pred)
+         ;; Only query
+         (setq query arg-pred)))
+      (when (eq super-groups t)
+        (setq super-groups org-super-agenda-groups))
+      ;; Call --agenda
+      `(org-ql-agenda--agenda* ,files
+         ;; TODO: Probably better to just use eval on org-ql rather than reimplementing parts of it here.
+         ',query
+         :sort ',sort
+         :buffer ,buffer
+         :narrow ,narrow
+         :super-groups ',super-groups))))
+
+(cl-defmacro org-ql-agenda** (&rest args)
+  "Display an agenda-like buffer of entries in FILES that match QUERY.
+
+FILES-OR-QUERY is a sexp that is evaluated to get the list of
+buffers and files to scan.
+
+QUERY is an `org-ql' query.  The query may be passed as
+FILES-OR-QUERY and QUERY may be left nil, in which case the list
+of files will automatically be set to the value of calling
+`org-agenda-files'.
+
+SORT is passed to `org-ql', which see..
+
+NARROW, when non-nil, means to respect narrowing in buffers.
+When nil, buffers are widened before being searched.
+
+BUFFER, when non-nil, is a buffer or buffer name to display the
+agenda in, rather than the default.
+
+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))
+  (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))))
+    (let ((files '(org-agenda-files))
+          query sort narrow buffer super-groups)
+      ;; Parse args manually (so we can leave FILES nil for a default argument).
+      ;; TODO: DRY this and org-ql, I think.
+      (pcase args
+        (`(,arg-files ,arg-pred . ,(and rest (guard (keywordp (car rest)))))
+         ;; Files, query, and keyword args (FIXME: Can I combine this and the next one?  Does it
+         ;; matter if rest is nil or starts with a keyword?)
+         (setq files arg-files
+               query arg-pred)
+         (set-keyword-args rest))
+        (`(,arg-pred . ,(and rest (guard (keywordp (car rest)))))
+         ;; Query and keyword args, no files
+         (setq query arg-pred)
+         (set-keyword-args rest))
+        (`(,arg-files ,arg-pred)
+         ;; Files and query, no keywords
+         (setq files arg-files
+               query arg-pred))
+        (`(,arg-pred)
+         ;; Only query
+         (setq query arg-pred)))
+      (when (eq super-groups t)
+        (setq super-groups org-super-agenda-groups))
+      ;; Call --agenda
+      `(org-ql-agenda--agenda** ,files
+                                ;; TODO: Probably better to just use eval on org-ql rather than reimplementing parts of it here.
+                                ',query
+                                :sort ',sort
+                                :buffer ,buffer
+                                :narrow ,narrow
+                                :super-groups ',super-groups))))
+
 ;;;; Commands
 
 ;; TODO: This is called `org-ql-search' but it's in org-ql-agenda.el because
@@ -409,6 +535,109 @@ Runs `org-occur-hook' after making the sparse tree."
       (org-agenda-finalize)
       (goto-char (point-min)))))
 
+(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 (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))))))
+         (org-ql-todo-keyword-length (cl-loop for e in entries
+                                              for todo-keyword = (org-element-property :todo-keyword e)
+                                              when todo-keyword
+                                              maximizing (length todo-keyword)))
+         (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))
+                   (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)
+      (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))
+      ;; Clear buffer, insert entries, etc.
+      (erase-buffer)
+      (insert string)
+      (pop-to-buffer (current-buffer))
+      (org-agenda-finalize)
+      (goto-char (point-min)))))
+
+(defun org-ql-agenda-todo-keyword-max-length ()
+  "FIXME: Docstring."
+  (->> org-todo-keywords
+       (-map #'cdr)
+       -flatten
+       (--remove (string= "|" it))
+       (--map (progn
+                (string-match (rx (1+ (not (in "(")))) it)
+                (length (match-string 0 it))))
+       (apply #'max)))
+
+(defvar org-ql-agenda-todo-format)
+
+(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 (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))))))
+         (org-ql-todo-keyword-length (org-ql-agenda-todo-keyword-max-length))
+         (org-ql-agenda-todo-format (concat "%" (number-to-string org-ql-todo-keyword-length) "s"))
+         (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))
+                   (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)
+      (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))
+      ;; Clear buffer, insert entries, etc.
+      (erase-buffer)
+      (insert string)
+      (pop-to-buffer (current-buffer))
+      (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.  Intended to be used as a
@@ -576,6 +805,83 @@ return an empty string."
              'tags tag-list
              'org-habit-p habit-property)))))
 
+(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 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'.  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)
+                                   (format org-ql-agenda-todo-format 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 (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)
+                                      (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 "%8s" (org-add-props string nil 'face 'org-ql-agenda-due-date)))))
+           (string (s-join " " (-non-nil (list due-string todo-keyword priority-string title 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."
   (->> element

org-ql-search.el

@@ -0,0 +1,202 @@
+;;; org-ql-search.el --- Search commands for org-ql  -*- lexical-binding: t; -*-
+
+;; Author: Adam Porter <adam@alphapapa.net>
+;; Url: https://github.com/alphapapa/org-ql
+
+;;; Commentary:
+
+;; 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.
+
+;;; 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 <https://www.gnu.org/licenses/>.
+
+;;; Code:
+
+(require 'cl-lib)
+
+(require 'dash)
+(require 's)
+
+(require 'org-ql)
+(require 'org-ql-view)
+
+;;;; Variables
+
+(defvar org-ql-views)
+
+;; From `org-super-agenda'.
+(defvar org-super-agenda-mode)
+(defvar org-super-agenda-groups)
+(defvar org-super-agenda-auto-selector-keywords)
+(declare-function org-super-agenda--group-items "ext:org-super-agenda")
+
+;; For refreshing results buffers.
+(defvar org-ql-view-buffers-files)
+(defvar org-ql-view-query)
+(defvar org-ql-view-sort)
+(defvar org-ql-view-narrow)
+(defvar org-ql-view-super-groups)
+(defvar org-ql-view-title)
+
+;;;; Commands
+
+;;;###autoload
+(cl-defun org-ql-search (buffers-files query &key buffer narrow super-groups sort title)
+  "Read QUERY and search with `org-ql'.
+Interactively, prompt for these variables:
+
+BUFFERS-FILES: A list of buffers and/or files to search.
+Interactively, may also be:
+
+- `buffer': search the current buffer
+- `all': search all Org buffers
+- `agenda': search buffers returned by the function `org-agenda-files'
+- An expression which evaluates to a list of files/buffers
+- A space-separated list of file or buffer names
+
+SUPER-GROUPS: An `org-super-agenda' group set.  See variable
+`org-super-agenda-groups'.
+
+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'.
+
+TITLE: An optional string displayed in the header.
+
+BUFFER: Optionally, a buffer or name of a buffer in which to
+display the results.  Set automatically when nil."
+  (declare (indent defun))
+  (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)
+                                        (buffer-list)))
+                       ("buffer" (current-buffer))
+                       ((and form (guard (rx bos "("))) (-flatten (eval (read form))))
+                       (else (s-split (rx (1+ space)) else)))
+                     (read-minibuffer "Query: ")
+                     :narrow (eq current-prefix-arg '(4))
+                     :super-groups (when (bound-and-true-p org-super-agenda-auto-selector-keywords)
+                                     (pcase (completing-read "Group by: "
+                                                             (append (list "Don't group"
+                                                                           "Global super-groups")
+                                                                     (cl-loop for type in org-super-agenda-auto-selector-keywords
+                                                                              collect (substring (symbol-name type) 6))))
+                                       ("Global super-groups" org-super-agenda-groups)
+                                       ("Don't group" nil)
+                                       (property (list (list (intern (concat ":auto-" property)))))))
+                     :sort (pcase (completing-read "Sort by: "
+                                                   (list "Don't sort"
+                                                         "date"
+                                                         "deadline"
+                                                         "priority"
+                                                         "scheduled"
+                                                         "todo"))
+                             ("Don't sort" nil)
+                             (sort (intern sort)))))
+  (let* ((results (org-ql-select buffers-files query
+                    :action 'element-with-markers
+                    :narrow narrow
+                    :sort sort))
+         (strings (-map #'org-ql-view--format-element results))
+         ;; Bind variables for `org-ql-view--display' to set.
+         (org-ql-view-buffers-files buffers-files)
+         (org-ql-view-query query)
+         (org-ql-view-sort sort)
+         (org-ql-view-narrow narrow)
+         (org-ql-view-super-groups super-groups)
+         (org-ql-view-title title))
+    (when super-groups
+      (setf strings (org-super-agenda--group-items strings)))
+    (org-ql-view--display
+      :buffer (or buffer
+                  (format "*Org QL Search: %s*"
+                          (or title
+                              (format "%S in %S" query buffers-files))))
+      :header (org-ql-view--header-line-format buffers-files query title)
+      :string (s-join "\n" strings))))
+
+(defun org-ql-search-refresh ()
+  "Refresh current `org-ql-search' buffer."
+  (interactive)
+  (let ((old-pos (point)))
+    (org-ql-search org-ql-view-buffers-files
+      org-ql-view-query
+      :sort org-ql-view-sort
+      :narrow org-ql-view-narrow
+      :super-groups org-ql-view-super-groups
+      :title org-ql-view-title
+      :buffer (current-buffer))
+    (goto-char old-pos)))
+
+(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-view-buffers-files
+                               (string org-ql-view-buffers-files)
+                               (list `(list ,@org-ql-view-buffers-files))
+                               (null nil)))
+         (function `(lambda ()
+                      (interactive)
+                      (org-ql-search ,buffers-files-sexp
+                        ',org-ql-view-query
+                        :sort ',org-ql-view-sort
+                        :narrow ,org-ql-view-narrow
+                        :groups ',org-ql-view-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-search-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.  Inserts a newline
+after the block."
+  (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-search--header-line-format from query))
+    (insert (org-add-props (org-ql-view--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-view--format-element)
+         org-agenda-finalize-entries
+         insert)
+    (insert "\n")))
+
+;;;###autoload
+(defalias 'org-ql-block 'org-ql-search-block)
+
+;;;; Footer
+
+(provide 'org-ql-search)
+
+;;; org-ql-search.el ends here

org-ql-view.el

@@ -0,0 +1,362 @@
+;;; org-ql-view.el --- Agenda-like view based on org-ql  -*- lexical-binding: t; -*-
+
+;; Author: Adam Porter <adam@alphapapa.net>
+;; Url: https://github.com/alphapapa/org-ql
+
+;;; Commentary:
+
+;; This library is part of the package `org-ql'; it's not a standalone
+;; library.  It displays strings in buffers similar to Org Agenda
+;; buffers.
+
+;;; 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 <https://www.gnu.org/licenses/>.
+
+;;; Code:
+
+(require 'cl-lib)
+(require 'map)
+(require 'org)
+(require 'org-element)
+(require 'org-agenda)
+(require 'seq)
+(require 'rx)
+
+(require 'org-ql)
+
+(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 "ext:org-super-agenda")
+
+(when (version< org-version "9.2")
+  (defalias 'org-get-tags #'org-get-tags-at))
+
+;;;; Faces
+
+(defface org-ql-view-due-date
+  '((t (:slant italic :weight bold)))
+  "Face for due dates in `org-ql-view' views."
+  :group 'org-ql)
+
+;;;; Variables
+
+(defvar org-ql-view-buffer-name "*Org-QL View*"
+  "Name of default `org-ql-view' buffer.")
+
+(defvar org-ql-view-map
+  ;; FIXME: Discrepancy between org-ql-search and org-ql-view here.
+  (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-view', `org-ql-search', and `org-ql-views' views.
+Based on `org-agenda-mode-map'.")
+
+;; For refreshing results buffers.
+(defvar-local org-ql-view-buffers-files nil)
+(defvar-local org-ql-view-query nil)
+(defvar-local org-ql-view-sort nil)
+(defvar-local org-ql-view-narrow nil)
+(defvar-local org-ql-view-super-groups nil)
+(defvar-local org-ql-view-title nil)
+
+;;;; Functions
+
+(cl-defun org-ql-view--display (&key buffer header string)
+  "Display STRING in `org-ql-view' BUFFER.
+
+BUFFER may be a buffer, or a string naming a buffer, which is
+reused if it already exists.
+
+HEADER is a string displayed in the buffer's header line.
+
+The following special variables, if non-nil, are set
+buffer-locally to preserve their value in the buffer for
+subsequent refreshing of the buffer: `org-ql-view-buffers-files',
+`org-ql-view-query', `org-ql-view-sort', `org-ql-view-narrow',
+`org-ql-view-super-groups', `org-ql-title.'"
+  ;; TODO: Rename `entries' to `elements'.
+  (declare (indent defun))
+  (let* ((buffer (cl-etypecase buffer
+                   (string (org-ql-view--buffer buffer))
+                   (null (org-ql-view--buffer buffer))
+                   (buffer buffer))))
+    (with-current-buffer buffer
+      (use-local-map org-ql-view-map)
+      ;; Prepare buffer, saving data for refreshing.
+      (cl-loop for symbol in (list 'org-ql-view-buffers-files 'org-ql-view-query
+                                   'org-ql-view-sort 'org-ql-view-narrow
+                                   'org-ql-view-super-groups 'org-ql-view-title)
+               do (set (make-local-variable symbol) (symbol-value symbol)))
+      (setq-local header-line-format header)
+      ;; Clear buffer, insert entries, etc.
+      (let ((inhibit-read-only t))
+        (erase-buffer)
+        (insert string)
+        (pop-to-buffer (current-buffer))
+        (org-agenda-finalize)
+        (goto-char (point-min))))))
+
+(defun org-ql-view--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)
+                            title " ")
+                  ""))
+         (query-formatted (format "%S" query))
+         (query-formatted (propertize (org-ql-view--font-lock-string 'emacs-lisp-mode query-formatted)
+                                      'help-echo query-formatted))
+         (query-width (length query-formatted))
+         (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-view--font-lock-string 'emacs-lisp-mode)
+                                                   (s-truncate available-width))
+                                              'help-echo buffers-files-formatted)))
+    (concat title
+            (propertize "Query:" 'face 'org-agenda-structure)
+            query-formatted "  "
+            (propertize "In:" 'face 'org-agenda-structure)
+            buffers-files-formatted)))
+
+(defun org-ql-view--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...
+  (with-temp-buffer
+    (delay-mode-hooks
+      (insert s)
+      (funcall mode)
+      (font-lock-ensure)
+      (buffer-string))))
+
+(defun org-ql-view--buffer (&optional name)
+  "Return Agenda NG buffer, creating it if necessary.
+If NAME is non-nil, return buffer by that name instead of using
+default buffer."
+  (with-current-buffer (get-buffer-create (or name org-ql-view-buffer-name))
+    (unless (eq major-mode 'org-agenda-mode)
+      (org-agenda-mode))
+    (current-buffer)))
+
+(defun org-ql-view--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."
+  (cond ((> difference 0)
+         (format "%sd ago" difference))
+        ((< difference 0)
+         (format "in %sd" (* -1 difference)))
+        (t "today")))
+
+;;;; Faces/properties
+
+(defun org-ql-view--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 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'.  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-view--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-view--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 (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)
+                                      (format "[#%s]")
+                                      (org-ql-view--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 'org-ql-view-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
+      (--> 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-view--add-faces (element)
+  "Return ELEMENT with deadline and scheduled faces added."
+  (->> element
+       (org-ql-view--add-scheduled-face)
+       (org-ql-view--add-deadline-face)))
+
+(defun org-ql-view--add-priority-face (string)
+  "Return STRING with priority face added."
+  (when (string-match "\\(\\[#\\(.\\)\\]\\)" string)
+    (let ((face (org-get-priority-face (string-to-char (match-string 2 string)))))
+      (org-add-props string nil 'face face 'font-lock-fontified t))))
+
+(defun org-ql-view--add-scheduled-face (element)
+  "Add faces to ELEMENT's title for its scheduled status."
+  ;; NOTE: Also adding prefix
+  (if-let ((scheduled-date (org-element-property :scheduled element)))
+      (let* ((todo-keyword (org-element-property :todo-keyword element))
+             (today-day-number (org-today))
+             ;; (current-day-number
+             ;; NOTE: Not currently used, but if we ever implement a more "traditional" agenda that
+             ;; shows perspective of multiple days at once, we'll need this, so I'll leave it for now.
+             ;;  ;; FIXME: This is supposed to be the, shall we say,
+             ;;  ;; pretend, or perspective, day number that this pass
+             ;;  ;; through the agenda is being made for.  We need to
+             ;;  ;; either set this in the calling function, set it here,
+             ;;  ;; or accomplish this in a different way.  See
+             ;;  ;; `org-agenda-get-scheduled' and where `date' is set in
+             ;;  ;; `org-agenda-list'.
+             ;;  today-day-number)
+             (scheduled-day-number (org-time-string-to-absolute
+                                    (org-element-timestamp-interpreter scheduled-date 'ignore)))
+             (difference-days (- today-day-number scheduled-day-number))
+             (relative-due-date (org-add-props (org-ql-view--format-relative-date difference-days) nil
+                                  'help-echo (org-element-property :raw-value scheduled-date)))
+             ;; FIXME: Unused for now:
+             ;; (show-all (or (eq org-agenda-repeating-timestamp-show-all t)
+             ;;               (member todo-keyword org-agenda-repeating-timestamp-show-all)))
+             ;; FIXME: Unused for now: (sexp-p (string-prefix-p "%%" raw-value))
+             ;; FIXME: Unused for now: (raw-value (org-element-property :raw-value scheduled-date))
+             ;; FIXME: I don't remember what `repeat-day-number' was for, but we aren't using it.
+             ;; But I'll leave it here for now.
+             ;; (repeat-day-number (cond (sexp-p (org-time-string-to-absolute scheduled-date))
+             ;;                          ((< today-day-number scheduled-day-number) scheduled-day-number)
+             ;;                          (t (org-time-string-to-absolute
+             ;;                              raw-value
+             ;;                              (if show-all
+             ;;                                  current-day-number
+             ;;                                today-day-number)
+             ;;                              'future
+             ;;                              ;; FIXME: I don't like
+             ;;                              ;; calling `current-buffer'
+             ;;                              ;; here.  If the element has
+             ;;                              ;; a marker, we should use
+             ;;                              ;; that.
+             ;;                              (current-buffer)
+             ;;                              (org-element-property :begin element)))))
+             (face (cond ((member todo-keyword org-done-keywords) 'org-agenda-done)
+                         ((= today-day-number scheduled-day-number) 'org-scheduled-today)
+                         ((> today-day-number scheduled-day-number) 'org-scheduled-previously)
+                         (t 'org-scheduled)))
+             (title (--> (org-element-property :raw-value element)
+                         (org-add-props it nil
+                           'face face)))
+             (properties (--> (cadr element)
+                              (plist-put it :title title)
+                              (plist-put it :relative-due-date relative-due-date))))
+        (list (car element)
+              properties))
+    ;; Not scheduled
+    element))
+
+(defun org-ql-view--add-deadline-face (element)
+  "Add faces to ELEMENT's title for its deadline status.
+Also store relative due date as string in `:relative-due-date'
+property."
+  ;; FIXME: In my config, doesn't apply orange for approaching deadline the same way the Org Agenda does.
+  (if-let ((deadline-date (org-element-property :deadline element)))
+      (let* ((today-day-number (org-today))
+             (deadline-day-number (org-time-string-to-absolute
+                                   (org-element-timestamp-interpreter deadline-date 'ignore)))
+             (difference-days (- today-day-number deadline-day-number))
+             (relative-due-date (org-add-props (org-ql-view--format-relative-date difference-days) nil
+                                  'help-echo (org-element-property :raw-value deadline-date)))
+             ;; FIXME: Unused for now: (todo-keyword (org-element-property :todo-keyword element))
+             ;; FIXME: Unused for now: (done-p (member todo-keyword org-done-keywords))
+             ;; FIXME: Unused for now: (today-p (= today-day-number deadline-day-number))
+             (deadline-passed-fraction (--> (- deadline-day-number today-day-number)
+                                            (float it)
+                                            (/ it (max org-deadline-warning-days 1))
+                                            (- 1 it)))
+             (face (org-agenda-deadline-face deadline-passed-fraction))
+             (title (--> (org-element-property :raw-value element)
+                         (org-add-props it nil
+                           'face face)))
+             (properties (--> (cadr element)
+                              (plist-put it :title title)
+                              (plist-put it :relative-due-date relative-due-date))))
+        (list (car element)
+              properties))
+    ;; No deadline
+    element))
+
+(defun org-ql-view--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)))
+
+;;;; Footer
+
+(provide 'org-ql-view)
+
+;;; org-ql-view.el ends here