From d0705dce0b1645e5e3e1aef261252f6bce156225 Mon Sep 17 00:00:00 2001
From: Adam Porter <adam@alphapapa.net>
Date: Sat, 7 Sep 2019 17:43:25 -0500
Subject: [PATCH] WIP

---
 org-ql-view-section.el      | 16 +++++-----------
 test-org-ql-view-section.el | 23 +++++++++++++++++++++++
 2 files changed, 28 insertions(+), 11 deletions(-)

diff --git a/org-ql-view-section.el b/org-ql-view-section.el
index d531dd8..cff02a9 100644
--- a/org-ql-view-section.el
+++ b/org-ql-view-section.el
@@ -33,6 +33,7 @@
 ;;;; 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
@@ -310,7 +311,7 @@ Does not include newline."
                                         (otherwise 1)))))
     (with-slots (header items) section
       (concat (propertize (format "%s"
-                                  (or header "Section"))
+                                  (or header "None"))
                           'face 'magit-section-heading)
               " (" (number-to-string (num-items items)) ")"))))
 
@@ -318,23 +319,16 @@ Does not include newline."
   "Insert ITEM into current buffer.
 Does not insert newline."
   (pcase-let* (((cl-struct org-ql-item todo priority heading tags) item)
-               (todo (when todo
-                       (propertize todo 'face (org-get-todo-face todo))))
-               (priority (when priority
-                           (propertize (concat "[#" priority "]") 'face (org-get-priority-face priority))))
-               (tags (when tags
-                       (propertize (s-join ":" tags) 'face 'org-tag-group)
-                       ))
                (beg (point)))
     (insert org-ql-view-item-indent)
     (when todo
-      (insert todo " "))
+      (insert (propertize todo 'face (org-get-todo-face todo)) " "))
     (when priority
-      (insert priority " "))
+      (insert (propertize (concat "[#" priority "]") 'face (org-get-priority-face priority)) " "))
     (when heading
       (insert heading " "))
     (when tags
-      (insert 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))
diff --git a/test-org-ql-view-section.el b/test-org-ql-view-section.el
index d6da8f1..80c927a 100644
--- a/test-org-ql-view-section.el
+++ b/test-org-ql-view-section.el
@@ -107,6 +107,29 @@
                                             (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 (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)))
+                                        'org-ql-item-todo
+                                        ))
+    (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)