Merge branch 'master' into improve-date-merged

Author: zaeph

README.org

@@ -168,6 +168,7 @@ Every selector requires an argument, even if it's just ~t~, e.g. ~:anything~, ~:
 +  =:anything= :: Select every item, no matter what.  This is probably most useful with ~:discard~, because it doesn't actually test anything, so it's faster than, e.g. ~:regexp "."~, which has to get the entry text for every item.
 +  =:auto-category= :: This automatically groups items by their category (usually the filename it's in, without the =.org= suffix).
 +  ~:auto-dir-name~ :: This automatically groups items by the directory name of their source buffer.
++  =:auto-date= :: This automatically groups items by their earliest of scheduled date or deadline, formatted according to variable ~org-super-agenda-date-format~.
 +  =:auto-group= :: This selects items that have the =agenda-group= Org property set.  By setting this property for a subtree, every item in it will be sorted into an agenda group by that name and placed into the agenda where the ~:auto-group~ selector is ([[examples.org#automatically-by-group][example]]).
 +  ~:auto-map~ :: This automatically groups items by the value returned when applying each item to the given function as a string from the agenda buffer ([[examples.org#automatically-by-mapping-a-function][example]]).  The function should return a string to be used as the grouping key and as the header for its group.
 +  ~:auto-parent~ :: This automatically groups items by their parent heading.  This is surprisingly handy, especially if you group tasks hierarchically by project and use agenda restrictions to limit the agenda to a subtree.
@@ -218,6 +219,14 @@ These selectors take one argument alone, or multiple arguments in a list.
 
 ** 1.2-pre
 
+*Added*
++  Selector ~:auto-date~, which groups items by their earliest of scheduled date or deadline, formatted according to variable ~org-super-agenda-date-format~.
++  Option ~org-super-agenda-date-format~, used to format date headers in the ~:auto-date~ selector.
++  To-do keyword faces are applied to keywords in group headers.
+
+*Changed*
++  Group headers face is now appended to face list instead of overriding it.
+
 *Fixed*
 +  =:children todo= group selection ([[https://github.com/alphapapa/org-super-agenda/issues/75][#75]]).  (Thanks to [[https://github.com/bleggett][Ben Leggett]].)
 +  =:children= group headings.

examples.org

@@ -152,17 +152,18 @@ This example groups items by the value of their =ProjectId= property (a more fle
 You can also use one or more arbitrary predicate functions, including lambdas.  Note that, since the group list is already quoted, function name symbols are not quoted again, nor is ~#'~ used.
 
 #+BEGIN_SRC elisp
-  (defun pizza-p (item)
-    (s-matches? "pizza" item))
+  (defun emacs-p (item)
+    (s-matches? "emacs" item))
 
   (let ((org-super-agenda-groups
-         '((:pred pizza-p))))
+         '((:pred emacs-p))))
     (org-agenda-list))
 
   (let ((org-super-agenda-groups
-         '((:pred (pizza-p
-                   (lambda (item)
-                     (s-matches? "Skype" item)))))))
+         '((:pred
+            ;; A list of two functions
+            (emacs-p (lambda (item)
+                       (s-matches? "Lisp" item)))))))
     (org-agenda-list))
 #+END_SRC
 

notes.org

@@ -1260,7 +1260,7 @@ CLOSED: [2017-07-28 Fri 00:02]
 -  State "DONE"       from "TODO"       [2017-07-28 Fri 00:02]
 :END:
 
-#+BEGIN_SRC elisp
+#+BEGIN_SRC elisp :results silent
   (defun osa/describe-groupers ()
     (require 'dash-functional)
     (let ((groups (cl-loop for (group-type fn) on org-super-agenda-group-types by 'cddr

org-super-agenda.el

@@ -142,6 +142,8 @@ only with point on the group headers (e.g. use `origami' to fold
 group headings by binding a key to `origami-toggle-node' in this
 map).")
 
+;;;; Customization
+
 (defgroup org-super-agenda nil
   "Settings for `org-super-agenda'."
   :group 'org
@@ -183,6 +185,11 @@ making it stretch across the screen."
   "String inserted before group headers."
   :type 'string)
 
+(defcustom org-super-agenda-date-format "%e %B %Y"
+  "Format string for date headers.
+See `format-time-string'."
+  :type 'string)
+
 ;;;; Faces
 
 (defface org-super-agenda-header '((t (:inherit org-agenda-structure)))
@@ -222,6 +229,20 @@ If ANY is non-nil, return as soon as FORM returns non-nil."
 
 ;;;; Support functions
 
+(defun org-super-agenda--org-timestamp-element< (a b)
+  "Return non-nil if A's date element is earlier than B's.
+A and B are Org timestamp elements."
+  ;; Copied from `org-ql'.
+  (cl-macrolet ((ts (ts)
+                    `(when ,ts
+                       (org-timestamp-format ,ts "%s"))))
+    (let* ((a-ts (ts a))
+           (b-ts (ts b)))
+      (cond ((and a-ts b-ts)
+             (string< a-ts b-ts))
+            (a-ts t)
+            (b-ts nil)))))
+
 (defsubst org-super-agenda--get-marker (s)
   "Return `org-marker' text properties of string S."
   (org-find-text-property-in-string 'org-marker s))
@@ -240,12 +261,13 @@ Prepended with `org-super-agenda-header-separator'."
   (pcase s
     ('none "")
     (_ (setq s (concat " " s))
-       (org-add-props s nil 'face 'org-super-agenda-header
-                      'keymap org-super-agenda-header-map
-                      ;; NOTE: According to the manual, only `keymap' should be necessary, but in my
-                      ;; testing, it only takes effect in Agenda buffers when `local-map' is set, so
-                      ;; we'll use both.
-                      'local-map org-super-agenda-header-map)
+       (add-face-text-property 0 (length s) 'org-super-agenda-header t s)
+       (org-add-props s nil
+         'keymap org-super-agenda-header-map
+         ;; NOTE: According to the manual, only `keymap' should be necessary, but in my
+         ;; testing, it only takes effect in Agenda buffers when `local-map' is set, so
+         ;; we'll use both.
+         'local-map org-super-agenda-header-map)
        (concat org-super-agenda-header-separator s))))
 
 (defsubst org-super-agenda--get-priority-cookie (s)
@@ -641,7 +663,9 @@ Argument may be a string or list of strings, or `t' to match any
 keyword, or `nil' to match only non-todo items."
   :section-name (pcase (car args)
                   ((pred stringp) ;; To-do keyword given
-                   (concat (s-join " and " args) " items"))
+                   (concat (s-join " and " (--map (propertize it 'face (org-get-todo-face it))
+                                                  args))
+                           " items"))
                   ('t ;; Test for any to-do keyword
                    "Any TODO keyword")
                   ('nil ;; Test for not having a to-do keyword
@@ -777,7 +801,8 @@ The string should be the priority cookie letter, e.g. \"A\".")
 ;;;;; Auto-grouping
 
 (cl-defmacro org-super-agenda--def-auto-group (name docstring-ending
-                                                    &key keyword key-form (header-form 'key))
+                                                    &key keyword key-form
+                                                    (header-form 'key) (key-sort-fn #'string<))
   "Define an auto-grouping function.
 
 The function will be named `org-super-agenda--auto-group-NAME'.
@@ -790,6 +815,9 @@ Items will be grouped by the value of KEY-FORM evaluated for each
 item, with the variable `item' bound to the string from the
 agenda buffer.
 
+Group headers will be sorted by KEY-SORT-FN; usually the default
+will suffice.
+
 The groups' headers will be the value of HEADER-FORM, evaluated
 for each group after items are grouped, with the variable `key'
 bound to the group's key.  The form defaults to `key'.
@@ -821,14 +849,48 @@ of the arguments to the function."
                     else collect item into non-matching
                     finally return (list ,keyword
                                          non-matching
-                                         (cl-loop for key in (sort (ht-keys groups) #'string<)
+                                         (cl-loop for key in (sort (ht-keys groups) #',key-sort-fn)
                                                   for name = ,header-form
                                                   collect (list :name name
                                                                 :items (nreverse (ht-get groups key)))))))
          (setq org-super-agenda-group-types (plist-put org-super-agenda-group-types
                                                        ,keyword #',fn-name))
          (add-to-list 'org-super-agenda-auto-selector-keywords ,keyword)))))
 
+;; TODO: auto-year and auto-month groups.  Maybe also auto-quarter, auto-week, etc.  Maybe also auto-next-7-days, something like that.
+
+(org-super-agenda--def-auto-group date
+  "their earliest deadline or scheduled date (formatted according to `org-super-agenda-date-format', which see)"
+  :keyword :auto-date
+  ;; This is convoluted, mainly because dates and times in Emacs are kind of
+  ;; insane.  Good luck parsing a simple "%e %B %Y"-formatted time back to a
+  ;; time value that can be compared.  It's virtually impossible, at least
+  ;; without a lot of work (hence my ts.el package, but it's not yet mature
+  ;; enough to use here).  So we store the Org timestamp element in the text
+  ;; properties of the formatted time.
+  :key-form (cl-flet ((get-date-type (type)
+                                     (when-let* ((date-string (org-entry-get (point) type)))
+                                       (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 date-string)
+                                         (goto-char 0)
+                                         (org-element-timestamp-parser)))))
+              (org-super-agenda--when-with-marker-buffer (org-super-agenda--get-marker item)
+                ;; MAYBE: Also check CLOSED date.
+                (let ((earliest-ts (car (sort (list (get-date-type "SCHEDULED")
+                                                    (get-date-type "DEADLINE"))
+                                              #'org-super-agenda--org-timestamp-element<))))
+                  (pcase earliest-ts
+                    ('nil nil)
+                    (_ (propertize (org-timestamp-format earliest-ts org-super-agenda-date-format)
+                                   'org-super-agenda-ts earliest-ts))))))
+  :key-sort-fn (lambda (a b)
+                 (org-super-agenda--org-timestamp-element<
+                  (get-text-property 0 'org-super-agenda-ts a)
+                  (get-text-property 0 'org-super-agenda-ts b))))
+
 (org-super-agenda--def-auto-group items "their AGENDA-GROUP property"
   :keyword :auto-group
   :key-form (org-entry-get (org-super-agenda--get-marker item)
@@ -857,7 +919,8 @@ of the arguments to the function."
 
 (org-super-agenda--def-auto-group todo "their to-do keyword"
   :keyword :auto-todo
-  :key-form (org-find-text-property-in-string 'todo-state item)
+  :key-form (when-let* ((keyword (org-find-text-property-in-string 'todo-state item)))
+              (propertize keyword 'face (org-get-todo-face keyword)))
   :header-form (concat "To-do: " key))
 
 (org-super-agenda--def-auto-group dir-name "their parent heading"

org-super-agenda.info

@@ -310,6 +310,10 @@ Every selector requires an argument, even if it’s just ‘t’, e.g.
 ‘:auto-dir-name’
      This automatically groups items by the directory name of their
      source buffer.
+‘:auto-date’
+     This automatically groups items by their earliest of scheduled date
+     or deadline, formatted according to variable
+     ‘org-super-agenda-date-format’.
 ‘:auto-group’
      This selects items that have the ‘agenda-group’ Org property set.
      By setting this property for a subtree, every item in it will be
@@ -488,8 +492,20 @@ File: README.info,  Node: 12-pre,  Next: 111,  Up: Changelog
 6.1 1.2-pre
 ===========
 
-*Fixed*
-   • ‘:children todo’ group selection (#75
+*Added*
+   • Selector ‘:auto-date’, which groups items by their earliest of
+     scheduled date or deadline, formatted according to variable
+     ‘org-super-agenda-date-format’.
+   • Option ‘org-super-agenda-date-format’, used to format date headers
+     in the ‘:auto-date’ selector.
+   • To-do keyword faces are applied to keywords in group headers.
+
+   *Changed*
+   • Group headers face is now appended to face list instead of
+     overriding it.
+
+   *Fixed*
+   • :children todo group selection (#75
      (https://github.com/alphapapa/org-super-agenda/issues/75)).
      (Thanks to Ben Leggett (https://github.com/bleggett).)
    • ‘:children’ group headings.
@@ -642,31 +658,31 @@ File: README.info,  Node: Credits,  Prev: Development,  Up: Top
 
 Tag Table:
 Node: Top222
-Node: Introduction802
-Node: Contents2214
-Node: Screenshots2367
-Node: Installation2608
-Node: MELPA2769
-Node: Manual installation2922
-Node: Usage3355
-Node: Examples4337
-Node: Group selectors7906
-Node: Keywords9095
-Node: Special selectors9824
-Node: Normal selectors12479
-Node: Tips17402
-Node: Changelog18283
-Node: 12-pre18501
-Node: 11118862
-Node: 1119041
-Node: 10320625
-Node: 10220836
-Node: 10120970
-Node: 10021308
-Node: Development21413
-Node: Bugs21815
-Node: Tests22509
-Node: Credits22846
+Node: Introduction824
+Node: Contents2232
+Node: Screenshots2385
+Node: Installation2622
+Node: MELPA2783
+Node: Manual installation2930
+Node: Usage3321
+Node: Examples4297
+Node: Group selectors7782
+Node: Keywords8971
+Node: Special selectors9712
+Node: Normal selectors12555
+Node: Tips17186
+Node: Changelog18037
+Node: 12-pre18262
+Node: 11119089
+Node: 1119262
+Node: 10320834
+Node: 10221045
+Node: 10121179
+Node: 10021517
+Node: Development21622
+Node: Bugs22024
+Node: Tests22677
+Node: Credits22996
 
 End Tag Table
 

test/results.el

@@ -1830,4 +1830,51 @@ Wednesday   5 July 2017
   ideas:      Scheduled:  SOMEDAY Rewrite Emacs in Common Lisp                            :Emacs:elisp:computers:software:programming:
   test:       In  16 d.:  TODO [#B] Internet                                                                                   :bills:
   test:       Scheduled:  TODO [#C] Get haircut                                                                       :personal:@town:
+" "415e1172e603da0549cd21c3d9ecf418" "Day-agenda (W27):
+Wednesday   5 July 2017
+
+  4 July 2017
+  ambition:   Sched. 1x:  TODO [#A] Skype with president of Antarctica                             :universe:ambition:world::meetings:
+
+  5 July 2017
+  test:       18:00...... Scheduled:  TODO Order a pizza                                                                 :food:dinner:
+  test:       Scheduled:  TODO [#B] Fix flux capacitor                                                  :spaceship:shopping:@computer:
+  test:       Scheduled:  TODO Shop for groceries                                                                :food:shopping:@town:
+  ideas:      Scheduled:  SOMEDAY Rewrite Emacs in Common Lisp                            :Emacs:elisp:computers:software:programming:
+  test:       Deadline:   CHECK /r/emacs                                                                               :website:Emacs:
+  test:       Scheduled:  TODO [#C] Get haircut                                                                       :personal:@town:
+  ambition:   TODO Practice leaping tall                     !                                           :universe:ambition::personal:
+
+  7 July 2017
+  ambition:   In   2 d.:  TODO [#A] Take over the world                                                     :universe:ambition::world:
+
+ 10 July 2017
+  ambition:   In   5 d.:  TODO [#B] Renew membership in supervillain club                                         :universe:ambition::
+
+ 15 July 2017
+  ambition:   In  10 d.:  TODO [#A] Take over the universe                                                         :universe:ambition:
+
+ 21 July 2017
+  test:       In  16 d.:  TODO [#B] Internet                                                                                   :bills:
+
+  1 August 2017
+  test:       In  27 d.:  TODO [#A] Spaceship lease                                                                  :bills:spaceship:
+
+ 27 August 2017
+  ambition:   In  53 d.:  WAITING Visit the moon                                                     :universe:ambition::space:travel:
+
+ 20 September 2017
+  ambition:   In  77 d.:  TODO Visit Mars                                                     :universe:ambition::space:travel:planet:
+
+ Other items
+  test:        7:02...... Sunrise (12:04 of daylight)
+               8:00...... ----------------
+              10:00...... ----------------
+              12:00...... now - - - - - - - - - - - - - - - - - - - - - - - - -
+              12:00...... ----------------
+              14:00...... ----------------
+              16:00...... ----------------
+              18:00...... ----------------
+  test:       19:07...... Sunset 
+              20:00...... ----------------
 "))

test/test.el

@@ -625,6 +625,11 @@ buffer and do not save the results."
   (should (org-super-agenda--test-run
            :groups '((:auto-category t)))))
 
+(ert-deftest org-super-agenda--test-:auto-date ()
+  ;; DONE: Works.
+  (should (org-super-agenda--test-run
+           :groups '((:auto-date t)))))
+
 (ert-deftest org-super-agenda--test-:auto-group ()
   ;; DONE: Works.
   (should (org-super-agenda--test-run