Notes: Add about direx-el

Rename org-ql-view.el back to org-ql-view-section.el, and bring back
org-ql-view.el from before rebasing on master.

notes.org

@@ -282,10 +282,16 @@ One of the things in that branch is =org-ql-item=, which is a struct used to car
 
 Another idea for it is to simply store the element from =org-element-headline-parser= in one of its slots, and populate all of the other slots lazily, like =ts=.  It already does that for a couple of slots, but I think it makes sense to do it for all of them, to reduce the overhead of making the struct for every query result.
 
+[2019-10-09 Wed 19:17]  (re?)Discovered [[https://github.com/m2ym/direx-el][GitHub - m2ym/direx-el: Directory Explorer for GNU Emacs]], which uses EIEIO to implement expandable sections that look much like the ones in Magit, with depth-based indentation like in =magit-todos=.
+
 *** TODO Experiment with =widget=
 
 The code that powers the customization UI.  Has collapsible and customizable widgets.  Might be perfect.  Might even enable editing items in the list, with functions to make the changes in the source  buffers.
 
+*** TODO Experiment with =hierarchy=
+
+[[https://github.com/DamienCassou/hierarchy][hierarchy.el]] might be very helpful for implementing a hierarchy UI.  Maybe the =parentfn= could be used to create sections easily.
+
 *** Code idea
 
 Inserting items into a view could look something like this:

org-ql-item.el

@@ -0,0 +1,124 @@
+;;; org-ql-item.el --- Item parsing for org-ql results  -*- lexical-binding: t; -*-
+
+;; Copyright (C) 2019  Adam Porter
+
+;; Author: Adam Porter <adam@alphapapa.net>
+
+;; 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/>.
+
+;;; Commentary:
+
+;;
+
+;;; Code:
+
+;;;; Requirements
+
+(require 'cl-lib)
+(require 'org)
+(require 'org-element)
+
+(require 'dash)
+
+(require 'org-ql-macros)
+
+;;;; Structs
+
+(org-ql-defstruct org-ql-item
+  buffer marker beg category level todo priority heading tags deadline-element scheduled-element properties
+  (deadline-ts nil :accessor-init (when-let* ((element (org-ql-item-deadline-element struct)))
+                                    (ts-parse-org-element element)))
+  (scheduled-ts nil :accessor-init (when-let* ((element (org-ql-item-scheduled-element struct)))
+                                     (ts-parse-org-element element))))
+
+;;;; Variables
+
+
+;;;; Customization
+
+
+;;;; Commands
+
+
+;;;; Functions
+
+(defun org-ql-item-at ()
+  "Return `org-ql-item' for entry at point."
+  (-let* (((_ (&plist :begin :level :raw-value :priority :tags :todo-keyword :deadline :scheduled :CATEGORY))
+           (org-element-headline-parser (line-end-position))))
+    (make-org-ql-item :beg begin
+                      :category CATEGORY
+                      :level level
+                      :todo todo-keyword
+                      :priority (when priority
+                                  (char-to-string priority))
+                      :heading raw-value
+                      :tags tags
+                      :deadline-element deadline
+                      :scheduled-element scheduled)))
+
+;;;;; Sorting
+
+(defun org-ql-item--sort-planning (items)
+  "Return ITEMS sorted by planning date."
+  (cl-flet ((planning-ts (item)
+                         (or (org-ql-item-deadline-ts item) (org-ql-item-scheduled-ts item))))
+    (sort items (lambda (a b)
+                  (let ((a-ts (planning-ts a))
+                        (b-ts (planning-ts b)))
+                    (cond ((and a-ts b-ts)
+                           (ts< a-ts b-ts))
+                          (a-ts t)
+                          (b-ts nil)))))))
+
+(defun org-ql-item--sort-todo (items)
+  "Return ITEMS sorted by to-do keyword, in to-do keyword order.
+Uses `org-todo-keywords', which does not include buffer-local
+keywords."
+  (cl-flet ((keyword (string)
+                     ;; Return keyword without parenthesized options.
+                     (unless (string= string "|")
+                       (if (string-match (rx (group (minimal-match (1+ anything)))
+                                             "(" (1+ anything) ")")
+                                         string)
+                           (match-string 1 string)
+                         string))))
+    (let ((keywords (cl-loop with non-done-keywords with done-keywords
+                             for (_type . keywords) in (reverse org-todo-keywords)
+                             for non-done = (->> keywords
+                                                 (--take-while (not (string= it "|")))
+                                                 (-map #'keyword))
+                             for done = (-map #'keyword
+                                              (-slice keywords
+                                                      (1+ (or (--find-index (string= it "|")
+                                                                            keywords)
+                                                              -1))))
+                             do (progn
+                                  (setf non-done-keywords (append non-done non-done-keywords))
+                                  (setf done-keywords (append done done-keywords)))
+                             finally return (append non-done-keywords done-keywords))))
+      (-sort (lambda (a b)
+               (cond ((and (org-ql-item-todo a)
+                           (org-ql-item-todo b))
+                      (< (or (cl-position (org-ql-item-todo a) keywords :test #'string=) 0)
+                         (or (cl-position (org-ql-item-todo b) keywords :test #'string=) 0)))
+                     ((org-ql-item-todo a) t)
+                     ((org-ql-item-todo b) nil)))
+             items))))
+
+;;;; Footer
+
+(provide 'org-ql-item)
+
+;;; org-ql-item.el ends here

org-ql-macros.el

@@ -0,0 +1,164 @@
+;;; org-ql-macros.el --- Macros used in org-ql       -*- lexical-binding: t; -*-
+
+;; Copyright (C) 2019  Adam Porter
+
+;; Author: Adam Porter <adam@alphapapa.net>
+
+;; 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/>.
+
+;;; Commentary:
+
+;;
+
+;;; Code:
+
+;;;; Requirements
+
+(require 'cl-lib)
+(require 'eieio)
+
+(require 'dash)
+
+;;;; Macros
+
+(defmacro org-ql-defkeymap (name copy docstring &rest maps)
+  ;; Copied from `defkeymap' in elexandria.el.
+  "Define a new keymap variable (using `defvar').
+
+NAME is a symbol, which will be the new variable's symbol.  COPY
+may be a keymap which will be copied, or nil, in which case the
+new keymap will be sparse.  DOCSTRING is the docstring for
+`defvar'.
+
+MAPS is a sequence of alternating key-value pairs.  The keys may
+be a string, in which case they will be passed as arguments to
+`kbd', or a raw key sequence vector.  The values may be lambdas
+or function symbols, as would be normally passed to
+`define-key'."
+  (declare (indent defun))
+  (let* ((map (if copy
+                  (copy-keymap copy)
+                (make-sparse-keymap (prin1-to-string name)))))
+    (cl-loop for (key fn) on maps by #'cddr
+             do (progn
+                  (when (stringp key)
+                    (setq key (kbd key)))
+                  (define-key map key fn)))
+    `(defvar ,name ',map ,docstring)))
+
+(defmacro org-ql-defclass (name superclasses slots &rest options-and-doc)
+  ;; Copied from `defclass*' in elexandria.el.
+  ;; MAYBE: Change instance-initform to instance-init.  This would no longer set
+  ;; the slot to the value of the expression, but would just evaluate it.  The
+  ;; expression could set the slot value with `setq' if necessary.
+  "Like `defclass', but supports instance initforms.
+Each slot may have an `:instance-initform', which is evaluated in
+the context of the object's slots when each instance is
+initialized, similar to Python's __init__ method."
+  ;; TODO: Add option to set all slots' initforms (e.g. to set them all to nil).
+  (declare (indent defun))
+  (let* ((slot-inits (-non-nil (--map (let ((name (car it))
+                                            (initer (plist-get (cdr it) :instance-initform)))
+                                        (when initer
+                                          (list 'setq name initer)))
+                                      slots)))
+         (slot-names (mapcar #'car slots))
+         ;; FIXME: `around-fn-name' is unused.
+         ;; (around-fn-name (intern (concat (symbol-name name) "-initialize")))
+         (docstring (format "Inititalize instance of %s." name)))
+    `(progn
+       (defclass ,name ,superclasses ,slots ,@options-and-doc)
+       (when (> (length ',slot-inits) 0)
+         (cl-defmethod initialize-instance :after ((this ,name) &rest _)
+           ,docstring
+           (with-slots ,slot-names this
+             ,@slot-inits))))))
+
+(cl-defmacro org-ql-defstruct (&rest args)
+  ;; Copied from `ts-defstruct'.
+  "Like `cl-defstruct', but with additional slot options.
+
+Additional slot options and values:
+
+`:accessor-init': a sexp that initializes the slot in the
+accessor if the slot is nil.  The symbol `struct' will be bound
+to the current struct.  The accessor is defined after the struct
+is fully defined, so it may refer to the struct
+definition (e.g. by using the `cl-struct' `pcase' macro).
+
+`:aliases': A list of symbols which will be aliased to the slot
+accessor, prepended with the struct name (e.g. a struct `ts' with
+slot `year' and alias `y' would create an alias `ts-y')."
+  (declare (indent defun))
+  ;; FIXME: Compiler warnings about accessors defined multiple times.  Not sure if we can fix this
+  ;; except by ignoring warnings.
+  (let* ((struct-name (car args))
+         (struct-slots (cdr args))
+         (cl-defstruct-expansion (macroexpand `(cl-defstruct ,struct-name ,@struct-slots)))
+         accessor-forms alias-forms)
+    (cl-loop for slot in struct-slots
+             for pos from 1
+             when (listp slot)
+             do (-let* (((slot-name _slot-default . slot-options) slot)
+                        ((&keys :accessor-init :aliases) slot-options)
+                        (accessor-name (intern (concat (symbol-name struct-name) "-" (symbol-name slot-name))))
+                        (accessor-docstring (format "Access slot \"%s\" of `%s' struct STRUCT."
+                                                    slot-name struct-name))
+                        (struct-pred (intern (concat (symbol-name struct-name) "-p")))
+                        ;; Accessor form copied from macro expansion of `cl-defstruct'.
+                        (accessor-form `(cl-defsubst ,accessor-name (struct)
+                                          ,accessor-docstring
+                                          ;; FIXME: side-effect-free is probably not true here, but what about error-free?
+                                          ;;  (declare (side-effect-free error-free))
+                                          (or (,struct-pred struct)
+                                              (signal 'wrong-type-argument
+                                                      (list ',struct-name struct)))
+                                          ,(when accessor-init
+                                             `(unless (aref struct ,pos)
+                                                (aset struct ,pos ,accessor-init)))
+                                          ;; NOTE: It's essential that this `aref' form be last
+                                          ;; so the gv-setter works in the compiler macro.
+                                          (aref struct ,pos))))
+                  (push accessor-form accessor-forms)
+                  ;; Remove accessor forms from `cl-defstruct' expansion.  This may be distasteful,
+                  ;; but it would seem more distasteful to copy all of `cl-defstruct' and potentially
+                  ;; have the implementations diverge in the future when Emacs changes (e.g. the new
+                  ;; record type).
+                  (cl-loop for form in-ref cl-defstruct-expansion
+                           do (pcase form
+                                (`(cl-defsubst ,(and accessor (guard (eq accessor accessor-name)))
+                                      . ,_)
+                                 accessor ; Silence "unused lexical variable" warning.
+                                 (setf form nil))))
+                  ;; Alias definitions.
+                  (cl-loop for alias in aliases
+                           for alias-name = (intern (concat (symbol-name struct-name) "-" (symbol-name alias)))
+                           do (push `(defalias ',alias-name ',accessor-name) alias-forms))
+                  ;; TODO: Setter
+                  ;; ,(when (plist-get slot-options :reset)
+                  ;;    `(gv-define-setter ,accessor-name (ts value)
+                  ;;       `(progn
+                  ;;          (aset ,ts ,,pos ,value)
+                  ;;          (setf (ts-unix ts) ni))))
+                  ))
+    `(progn
+       ,cl-defstruct-expansion
+       ,@accessor-forms
+       ,@alias-forms)))
+
+;;;; Footer
+
+(provide 'org-ql-macros)
+
+;;; org-ql-macros.el ends here

org-ql-view-section.el

@@ -0,0 +1,221 @@
+;;; org-ql-view.el --- Views for org-ql results  -*- lexical-binding: t; -*-
+
+;; Copyright (C) 2019  Adam Porter
+
+;; Author: Adam Porter <adam@alphapapa.net>
+
+;; 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/>.
+
+;;; Commentary:
+
+;; Inspired by `magit-section'.
+
+;;; Code:
+
+;;;; Requirements
+
+(require 'cl-lib)
+(require 'eieio)
+
+(require 'dash)
+(require 's)
+
+(require 'org-ql-macros)
+
+;;;; Variables
+
+(defvar org-ql-view-depth -1
+  "Depth of current section.
+Used in `org-ql-view-string'.")
+
+(org-ql-defkeymap org-ql-view-map nil
+  "Map for `org-ql-view' maps."
+  [tab] org-ql-view-section-toggle)
+
+;;;; Faces
+
+(defface org-ql-view-heading
+  `((t (:height 1.2 :weight bold)))
+  "Face for headings in `org-ql-view' buffers.")
+
+;;;; Classes
+
+(org-ql-defclass org-ql-view-section ()
+  ;; TODO: Decide/clarify whether beg/end should/can be markers.
+  ;; NOTE: Not using initforms for now.
+  ((beg :initarg :beg
+        :documentation "Position or marker at which section begins in buffer.")
+   (end :initarg :end
+        :documentation "Position or marker at which section ends in buffer.")
+   (header :initarg :header
+           :documention "Optional header string.")
+   (contents-beg :initarg :contents-beg
+                 :documentation "Position or marker at which section's contents begins in buffer (i.e. where the header ends).")
+   (items :initarg :items
+          :documentation "List of items the section contains.")
+   (keymap :initarg :keymap
+           :instance-initform org-ql-view-map
+           :documentation "Keymap used inside section.")
+   (collapsed :initarg :collapsed
+              :initform nil
+              :documentation "Whether the section is collapsed.")))
+
+;;;; Customization
+
+(defgroup org-ql-view nil
+  "Options for `org-ql' views."
+  :group 'org-ql)
+
+(defcustom org-ql-view-item-indent "  "
+  "String used to indent individual items."
+  :type 'string)
+
+(defcustom org-ql-view-item-indent-per-level 3
+  "Number of spaces used to indent items at each level."
+  :type 'integer)
+
+;;;; Commands
+
+(defun org-ql-view-section-toggle (section)
+  "Toggle SECTION, or section at point."
+  (interactive (list (org-ql-view-section-at)))
+  (when section
+    (with-slots (collapsed) section
+      (if collapsed
+          (org-ql-section-expand section)
+        (org-ql-section-collapse section)))))
+
+(defun org-ql-section-collapse (section)
+  "Collapse SECTION, or section at point."
+  (interactive (list (org-ql-view-section-at)))
+  (when section
+    (with-slots (collapsed contents-beg end) section
+      (setf collapsed t)
+      (let ((ov (make-overlay contents-beg end)))
+        ;; I don't know if `evaporate' is necessary, but `magit-section' does it.
+        (overlay-put ov 'evaporate t)
+        (overlay-put ov 'invisible t)))))
+
+(defun org-ql-section-expand (section)
+  "Expand SECTION, or section at point."
+  (interactive (list (org-ql-view-section-at)))
+  (when section
+    (with-slots (collapsed contents-beg end) section
+      (setf collapsed nil)
+      (remove-overlays contents-beg end 'invisible t))))
+
+;;;; Methods
+
+(cl-defmethod org-ql-view-insert ((section org-ql-view-section) &key group-by)
+  "Insert SECTION into current buffer."
+  (cl-labels ((group (items fns)
+                     (setf items (-group-by (car fns) items))
+                     (if (cdr fns)
+                         (--map (org-ql-view-section
+                                 :header (car it)
+                                 :items (group (cdr it) (cdr fns)))
+                                items)
+                       (cond ((assoc nil items)
+                              (append (--map (org-ql-view-section
+                                              :header (car it)
+                                              :items (cdr it))
+                                             (butlast items))
+                                      (cdr (assoc nil items))))
+                             (t (--map (org-ql-view-section
+                                        :header (car it)
+                                        :items (cdr it))
+                                       items))))))
+    (with-slots (beg end header contents-beg items keymap) section
+      (let* ((org-ql-view-depth (1+ org-ql-view-depth))
+             (org-ql-view-item-indent (s-repeat (* org-ql-view-item-indent-per-level
+                                                   org-ql-view-depth)
+                                                " ")))
+        (when group-by
+          (setf items (group items group-by)))
+        (setf beg (point))
+        (insert org-ql-view-item-indent (org-ql-view-header section))
+        (put-text-property beg (point) :org-ql-view-section section)
+        (setf contents-beg (point))
+        (let* ((org-ql-view-item-indent (s-repeat (* org-ql-view-item-indent-per-level
+                                                     (1+ org-ql-view-depth))
+                                                  " ")))
+          (dolist (item items)
+            (insert "\n")
+            (cl-typecase item
+              (org-ql-view-section (org-ql-view-insert item))
+              (list (--each item
+                      (insert "\n")
+                      (org-ql-view-insert it)))
+              (otherwise (org-ql-view-insert item))
+              )))
+        (setf end (point))
+        (put-text-property beg (point) 'keymap keymap)))))
+
+;; (cl-defmethod org-ql-view-insert ((sections list))
+;;   "Insert SECTIONS into current buffer."
+;;   (let* ((org-ql-view-depth (1+ org-ql-view-depth)))
+;;     (dolist (section sections)
+;;       (insert "\n")
+;;       (org-ql-view-insert section))))
+;; (cl-defmethod org-ql-view-insert ((sections list))
+;;   "Insert SECTIONS into current buffer."
+;;   (error "OOPS"))
+
+(cl-defmethod org-ql-view-header ((section org-ql-view-section))
+  "Return header string for SECTION.
+Does not include newline."
+  (cl-labels ((num-items (items)
+                         (cl-loop for item in items
+                                  sum (cl-typecase item
+                                        (org-ql-view-section (num-items (oref item items)))
+                                        (list (cl-loop for section in item
+                                                       sum (num-items (oref section items))))
+                                        (otherwise 1)))))
+    (with-slots (header items) section
+      (concat (propertize (format "%s"
+                                  (or header "None"))
+                          'face 'org-ql-view-heading)
+              " (" (number-to-string (num-items items)) ")"))))
+
+(cl-defmethod org-ql-view-insert ((item org-ql-item))
+  "Insert ITEM into current buffer.
+Does not insert newline."
+  (pcase-let* (((cl-struct org-ql-item todo priority heading tags) item)
+               (beg (point)))
+    (insert org-ql-view-item-indent)
+    (when todo
+      (insert (propertize todo 'face (org-get-todo-face todo)) " "))
+    (when priority
+      (insert (propertize (concat "[#" priority "]") 'face (org-get-priority-face priority)) " "))
+    (when heading
+      (insert heading " "))
+    (when tags
+      (insert (propertize (s-join ":" tags) 'face 'org-tag-group)))
+    (put-text-property beg (point) :org-ql-view-section item)))
+
+(cl-defmethod org-ql-view-insert ((item string))
+  "Insert ITEM into current buffer."
+  (insert item))
+
+;;;; Functions
+
+(cl-defun org-ql-view-section-at (&optional (pos (point-at-bol)))
+  "Return section at POS or point."
+  (get-text-property pos :org-ql-view-section))
+
+;;;; Footer
+
+(provide 'org-ql-view)
+
+;;; org-ql-view.el ends here

test-org-ql-view-section.el

@@ -0,0 +1,177 @@
+(require 'org-ql-item)
+(require 'org-ql-view)
+
+(let* ((buffer (get-buffer-create "test-org-ql-view-section"))
+       (sub-section1 (org-ql-view-section
+                      :items (list (make-org-ql-item :level 1
+                                                     :todo "TODO"
+                                                     :priority "A"
+                                                     :heading "Alpha"
+                                                     :tags '("one" "two"))
+                                   (make-org-ql-item :level 1
+                                                     :todo "NEXT"
+                                                     :priority "B"
+                                                     :heading "Bravo"
+                                                     :tags '("one" "two" "three")))))
+       (sub-section2 (org-ql-view-section
+                      :items (list (make-org-ql-item :level 1
+                                                     :todo "MAYBE"
+                                                     :heading "Charlie"
+                                                     :tags '("one" "two"))
+                                   (make-org-ql-item :level 1
+                                                     :todo "SOMEDAY"
+                                                     :heading "Delta"
+                                                     :tags '("one" "two" "three")))))
+       (top-section (org-ql-view-section
+                     :items (list sub-section1 sub-section2)))
+       (inhibit-read-only t))
+  (with-current-buffer buffer
+    (read-only-mode 1)
+    (erase-buffer)
+    (org-ql-view-insert top-section)
+    (pop-to-buffer buffer)))
+
+(let* ((buffer (get-buffer-create "test-org-ql-view-section"))
+       (items (->> (org-ql-select "~/src/emacs/org-ql/tests/data.org"
+                     '(todo)
+                     :action #'org-ql-item-at)
+                   (-sort (-on #'string< #'org-ql-item-priority))
+                   (org-ql-view-sort-todo)))
+       (top-section (org-ql-view-section
+                     :header (format "To-Do (%s)" (length items))
+                     :items items))
+       (inhibit-read-only t))
+  (with-current-buffer buffer
+    (read-only-mode 1)
+    (erase-buffer)
+    (org-ql-view-insert top-section
+                        :group-by '(org-ql-item-todo org-ql-item-priority))
+    (pop-to-buffer buffer)))
+
+(let* ((buffer (get-buffer-create "test-org-ql-view-section"))
+       (items (->> (org-ql-select "~/src/emacs/org-ql/tests/data.org"
+                     '(todo)
+                     :action #'org-ql-item-at)
+                   (-sort (-on #'string< #'org-ql-item-priority))
+                   (org-ql-view-sort-planning)))
+       (top-section (org-ql-view-section
+                     :header (format "To-Do (%s)" (length items))
+                     :items items))
+       (inhibit-read-only t))
+  (with-current-buffer buffer
+    (read-only-mode 1)
+    (erase-buffer)
+    (org-ql-view-insert top-section
+                        :group-by (list (lambda (item)
+                                          (awhen (or (org-ql-item-deadline-ts item) (org-ql-item-scheduled-ts item))
+                                            (ts-format "%Y-%m-%d" it)))))
+    (pop-to-buffer buffer)))
+(let* ((buffer (get-buffer-create "test-org-ql-view-section"))
+       (items (->> (org-ql-select "~/src/emacs/org-ql/tests/data.org"
+                     '(todo)
+                     :action #'org-ql-item-at)
+                   (-sort (-on #'string< #'org-ql-item-priority))
+                   (org-ql-view-sort-planning)))
+       (top-section (org-ql-view-section
+                     :header "To-Do by Planning Date"
+                     :items items))
+       (inhibit-read-only t))
+  (with-current-buffer buffer
+    (read-only-mode 1)
+    (erase-buffer)
+    (org-ql-view-insert top-section
+                        :group-by (list (lambda (item)
+                                          (awhen (or (org-ql-item-deadline-ts item) (org-ql-item-scheduled-ts item))
+                                            (ts-format "%B %Y" it)))
+                                        (lambda (item)
+                                          (awhen (or (org-ql-item-deadline-ts item) (org-ql-item-scheduled-ts item))
+                                            (ts-format "%d %B" it)))))
+    (pop-to-buffer buffer)))
+(let* ((buffer (get-buffer-create "test-org-ql-view-section"))
+       (items (->> (org-ql-select "~/src/emacs/org-ql/tests/data.org"
+                     '(todo)
+                     :action #'org-ql-item-at)
+                   (-sort (-on #'string< #'org-ql-item-priority))
+                   (org-ql-view-sort-planning)))
+       (top-section (org-ql-view-section
+                     :header "To-Do by Planning Date"
+                     :items items))
+       (inhibit-read-only t))
+  (with-current-buffer buffer
+    (read-only-mode 1)
+    (erase-buffer)
+    (org-ql-view-insert top-section
+                        :group-by (list 'org-ql-item-todo
+                                        (lambda (item)
+                                          (awhen (or (org-ql-item-deadline-ts item) (org-ql-item-scheduled-ts item))
+                                            (ts-format "%B %Y" it)))
+                                        (lambda (item)
+                                          (awhen (or (org-ql-item-deadline-ts item) (org-ql-item-scheduled-ts item))
+                                            (ts-format "%d %B" it)))
+                                        ))
+    (pop-to-buffer buffer)))
+(let* ((buffer (get-buffer-create "test-org-ql-view-section"))
+       (items (->> (org-ql-select "~/src/emacs/org-ql/tests/data.org"
+                     '(todo)
+                     :action #'org-ql-item-at)
+                   (-sort (-on #'string< #'org-ql-item-priority))
+                   (org-ql-view-sort-planning)
+                   (org-ql-view-sort-todo)))
+       (top-section (org-ql-view-section
+                     :header "To-Do by Planning Date"
+                     :items items))
+       (inhibit-read-only t))
+  (with-current-buffer buffer
+    (read-only-mode 1)
+    (erase-buffer)
+    (org-ql-view-insert top-section
+                        :group-by (list (lambda (item)
+                                          (awhen (or (org-ql-item-deadline-ts item) (org-ql-item-scheduled-ts item))
+                                            (ts-format "%B %Y" it)))
+                                        (lambda (item)
+                                          (awhen (or (org-ql-item-deadline-ts item) (org-ql-item-scheduled-ts item))
+                                            (ts-format "%d %A" it)))
+                                        ))
+    (pop-to-buffer buffer)))
+(let* ((buffer (get-buffer-create "test-org-ql-view-section"))
+       (items (->> (org-ql-select "~/src/emacs/org-ql/tests/data.org"
+                     '(todo)
+                     :action #'org-ql-item-at)
+                   (-sort (-on #'string< #'org-ql-item-priority))
+                   (org-ql-view-sort-planning)))
+       (top-section (org-ql-view-section
+                     :header "To-Do by Planning Date"
+                     :items items))
+       (inhibit-read-only t))
+  (with-current-buffer buffer
+    (read-only-mode 1)
+    (erase-buffer)
+    (org-ql-view-insert top-section
+                        :group-by (list 'org-ql-item-todo
+                                        (lambda (item)
+                                          (awhen (or (org-ql-item-deadline-ts item) (org-ql-item-scheduled-ts item))
+                                            (ts-format "%B %Y" it)))
+                                        'org-ql-item-priority
+
+                                        ))
+    (pop-to-buffer buffer)))
+
+(let* ((buffer (get-buffer-create "test-org-ql-view-section"))
+       (items (->> (org-ql-select "~/src/emacs/org-ql/tests/data.org"
+                     '(todo)
+                     :action #'org-ql-item-at)
+                   (-sort (-on #'string< #'org-ql-item-priority))
+                   (org-ql-view-sort-planning)))
+       (top-section (org-ql-view-section
+                     :header "To-Do by Planning Date"
+                     :items items))
+       (inhibit-read-only t))
+  (with-current-buffer buffer
+    (read-only-mode 1)
+    (erase-buffer)
+    (org-ql-view-insert top-section
+                        :group-by (list 'org-ql-item-priority
+                                        'org-ql-item-todo
+
+                                        ))
+    (pop-to-buffer buffer)))