ADD dagified agenda view

local/lib/org-x/org-x-dag.el

@@ -417,16 +417,16 @@ encountered will be returned."
           ('month value)
           (_ (if islongp
                  ;; TODO make these messages not suck
-                (pcase unit
-                  ('week (* 7 value))
-                  ('day value)
-                  ((or 'hour 'minute) (message "WARNING: ..."))
-                  (_ (error)))
                  (pcase unit
                    ('week (* 7 1440 value))
                    ('day (* 1440 value))
                    ('hour (* 60 value))
                    ('minute value)
+                   (_ (error)))
+               (pcase unit
+                 ('week (* 7 value))
+                 ('day value)
+                 ((or 'hour 'minute) (message "WARNING: ..."))
                  (_ (error)))))))
        (convert-unit
         (unit)
@@ -494,7 +494,8 @@ encountered will be returned."
          ('month (enc-dec-long y (+ m shift) d H M))
          ('submonth (enc-dec-long y m d H (+ M shift))))))))
 
-(defun org-x-dag-repeater-get-next (cur time shift shifttype reptype)
+(defun org-x-dag-repeater-get-next (sel-datetime datetime shift shifttype reptype)
+  "Return the next timestamp repeater of DATETIME."
   (pcase reptype
     ('catch-up
      ;; Next time is a multiple of repeater in the future relative to the base
@@ -502,31 +503,36 @@ encountered will be returned."
      ;; (DST, leap year, different days in each month, etc). Think of this like
      ;; a path function from p-chem; shifting 3 months once might be different
      ;; than shifting by 1 month three times.
-     (let ((next time))
+     (let ((next datetime)
-       (while (org-x-dag-date< next cur)
+           (pastp t))
-         (setq next (org-x-dag-time-shift next shift shifttype)))
+       (while pastp
+         (setq next (org-x-dag-time-shift next shift shifttype)
+               pastp (org-x-dag-date< next sel-datetime)))
        next))
     ('restart
      ;; Next time is one repeater interval after now
      ;;
-     ;; TODO cur needs to match the length of time
+     ;; ASSUME cur needs to match the length of time
-     (org-x-dag-time-shift cur shift shifttype))
+     (org-x-dag-time-shift sel-datetime shift shifttype))
     ('cumulate
      ;; Next time is one repeater interval after the base timestamp
-     (org-x-dag-time-shift time shift shifttype))))
+     (org-x-dag-time-shift datetime shift shifttype))))
 
-(defun org-x-dag-unfold-timestamp (cur time rep future-limit)
+(defun org-x-dag-unfold-timestamp (cur datetime rep future-limit)
+  "Return all timestamps associated with DATETIME.
+
+If REP is nil, return a singleton list just containing DATETIME.
+If REP is non-nil, return DATETIME and all repeaters up until
+FUTURE-LIMIT in a list."
   ;; ASSUME pts and future-limit are both long or short timestamps
+  (unless (org-x-dag-date< future-limit datetime)
     (pcase rep
-    (`nil
+      (`nil `(,datetime))
-     (unless (org-x-dag-date< future-limit time)
-       (list time)))
       (`(,value ,unit ,reptype)
-     (->> (org-x-dag-repeater-get-next cur time value unit reptype)
+       (->> (org-x-dag-repeater-get-next cur datetime value unit reptype)
-          (--unfold (let ((next (org-x-dag-time-shift it value unit)))
+            (--unfold (unless (org-x-dag-date< future-limit it)
-                      (unless (org-x-dag-date< future-limit next)
+                        (cons it (org-x-dag-time-shift it value unit))))
-                        (cons next next))))
+            (cons datetime))))))
-          (cons time)))))
 
 (defun org-x-dag-date-add-time (date)
   (-let (((_ M H) (decode-time (current-time))))
@@ -1127,18 +1133,20 @@ encountered will be returned."
       ((format-timestamps
         (sel-date cat id pts get-datetimes-fun format-datetime-fun)
         (-when-let (datetimes (funcall get-datetimes-fun sel-date pts))
+          (let ((tags (org-x-dag-id->tags t org-file-tags id)))
+            (unless (member org-x-tag-incubated tags)
               (-let (((&plist :pos) pts)
-                 (tags (org-x-dag-id->tags t org-file-tags id))
                      (donep (org-x-dag-id->is-done-p id)))
                 (->> datetimes
                      (--remove (and donep (not (org-x-dag-date= (-take 3 it) sel-date))))
-                 (--map (funcall format-datetime-fun sel-date pos it cat tags id))))))
+                     (--map (funcall format-datetime-fun sel-date pos it cat tags id))))))))
        (format-id
         (cat id)
         (org-x-dag-with-key id
           (-when-let (res (org-x-dag-headline-get-planning))
             (-let (((dead sched) res))
-              (append (when dead
+              (append
+               (when dead
                  (format-timestamps sel-date cat id dead
                                     #'org-x-dag-get-deadlines-at
                                     #'org-x-dag-format-deadline-node))
@@ -1148,8 +1156,7 @@ encountered will be returned."
                                     #'org-x-dag-format-scheduled-node))))))))
     (org-x-dag-with-files (org-x-get-action-files)
         nil
-      (org-x-dag-with-key it
+      (format-id it-category it))))
-        (format-id it-category it)))))
 
 ;;; AGENDA VIEWS
 
@@ -1191,5 +1198,49 @@ encountered will be returned."
         (org-agenda-finalize)
         (setq buffer-read-only t)))))
 
+;; make the signature exactly like `org-agenda-list' ...for now
+(defun org-x-dag-show-daily-nodes (&optional arg start-day span with-hour)
+  (org-x-dag-sync)
+  ;; TODO not sure if this is actually necessary
+  (when org-agenda-overriding-arguments
+    (-setq (arg start-day span) org-agenda-overriding-arguments))
+  (let* ((org-tags-match-list-sublevels org-tags-match-list-sublevels)
+         (completion-ignore-case t))
+    (catch 'exit
+      (org-agenda-prepare "DAG-DAILY")
+      (org-compile-prefix-format 'agenda)
+      (org-set-sorting-strategy 'agenda)
+      (-let* ((today (org-today))
+              (sd (or start-day today))
+              (org-agenda-redo-command `(org-x-dag-show-daily-nodes
+                                         ',arg ,start-day ',span ,with-hour))
+              ((m d y) (calendar-gregorian-from-absolute sd))
+              (rtnall (org-x-dag-scan-agenda `(,y ,m ,d))))
+        (setq-local org-starting-day sd)
+        (setq-local org-arg-loc arg)
+        ;; TODO just day (for now)
+        (setq-local org-agenda-current-span 'day)
+        (org-agenda--insert-overriding-header
+          (with-temp-buffer
+            (insert (format "Agenda for %d-%02d-%02d: \n" y m d))
+            (add-text-properties (point-min) (1- (point))
+                                 (list 'face 'org-agenda-structure))
+            (buffer-string)))
+        (org-agenda-mark-header-line (point-min))
+        ;; TODO handle time grid here somehow
+        (-some--> (org-agenda-add-time-grid-maybe rtnall 1 (= sd today))
+          (org-agenda-finalize-entries it 'agenda)
+          (insert it "\n"))
+        (goto-char (point-min))
+        (or org-agenda-multi (org-agenda-fit-window-to-buffer))
+        (add-text-properties
+         (point-min) (point-max)
+         `(org-agenda-type agenda
+                           org-last-args (,arg ,start-day ,span)
+                           org-redo-cmd ,org-agenda-redo-command
+                           org-series-cmd ,org-cmd))
+        (org-agenda-finalize)
+        (setq buffer-read-only t)))))
+
 (provide 'org-x-dag)
 ;;; org-x-dag.el ends here