More

org-agenda-ng.el

@@ -19,10 +19,9 @@
 
 ;;;; Commands
 
-(cl-defun org-agenda-ng--agenda (&key match-fns)
-  (with-current-buffer (find-buffer-visiting "~/org/main.org")
+(cl-defun org-agenda-ng--agenda (&key match-fns filter-fns)
   (let* ((tree (cddr (org-element-parse-buffer 'headline)))
-           (entries (--> (org-agenda-ng--filter-tree tree :match-fns match-fns)
+         (entries (--> (org-agenda-ng--filter-tree tree :match-fns match-fns :filter-fns filter-fns)
                        (mapcar #'org-agenda-ng--format-element it)))
          (result-string (org-agenda-finalize-entries entries 'agenda))
          (target-buffer (get-buffer-create "test-agenda-ng")))
@@ -31,30 +30,48 @@
       (erase-buffer)
       (insert result-string)
       (read-only-mode 1)
-        (pop-to-buffer (current-buffer))))))
+      (pop-to-buffer (current-buffer)))))
+
+(defmacro org-agenda-ng--test (&rest args)
+  `(with-current-buffer (find-buffer-visiting "~/org/main.org")
+     (org-agenda-ng--agenda
+      ,@args)))
 
 (defun org-agenda-ng--test-agenda ()
   (interactive)
-  (org-agenda-ng--agenda
+  (org-agenda-ng--test
    :match-fns '((org-agenda-ng--todo-p "TODO")
                 (org-agenda-ng--date-p :deadline < "2017-08-05"))))
 
-(defun org-agenda-ng--todo-list ()
+(defun org-agenda-ng--test-agenda-today ()
   (interactive)
-  (org-agenda-ng--agenda
-   :match-fns '((org-agenda-ng--todo-p "TODO"))))
+  (org-agenda-ng--test
+   :match-fns `((org-agenda-ng--date-p :deadline <= ,(org-today))
+                (org-agenda-ng--date-p :scheduled <= ,(org-today)))
+   :filter-fns `((org-agenda-ng--todo-p ,org-done-keywords))))
+
+(defun org-agenda-ng--test-todo-list ()
+  (interactive)
+  (org-agenda-ng--test
+   :match-fns '(org-agenda-ng--todo-p)
+   :filter-fns `((org-agenda-ng--todo-p ,org-done-keywords))))
 
 ;;;; Functions
 
-(defun org-agenda-ng--filter-tree (tree &key match-fns)
+(cl-defun org-agenda-ng--filter-tree (tree &key match-fns filter-fns)
   (let* ((types '(headline))
          (info nil)
          (first-match nil)
          (fun (lambda (element)
-                (when (--all? (cl-typecase it
+                (when (and (--any? (cl-typecase it
                                      (function (funcall it element))
                                      (cons (apply (car it) element (cdr it))))
                                    match-fns)
+                           (or (null filter-fns)
+                               (--none? (cl-typecase it
+                                          (function (funcall it element))
+                                          (cons (apply (car it) element (cdr it))))
+                                        filter-fns)))
                   element))))
     (org-element-map tree types fun info first-match)))
 
@@ -126,32 +143,42 @@ Its property list should be the second item in the list, as returned by `org-ele
 
 ;;;; Predicates
 
-(defun org-agenda-ng--todo-p (element &optional keyword)
+(defun org-agenda-ng--todo-p (element &optional keywords)
   "Return non-nil if ELEMENT is a TODO item.
-With KEYWORD, return non-nil if it has the same TODO keyword."
+With KEYWORDS, return non-nil if its keyword is one of KEYWORDS."
   (when-let ((element-keyword (org-element-property :todo-keyword element)))
-    (pcase keyword
+    (pcase keywords
       ('nil t)
       ((pred stringp)
-       (string= element-keyword keyword))
+       (string= element-keyword keywords))
+      ((pred listp)
+       (member element-keyword keywords))
       (otherwise (error "Invalid keyword argument: %s" otherwise)))))
 
 (defun org-agenda-ng--date-p (entry type &optional comparator target-date)
   "Return non-nil if ENTRY has a date property of TYPE.
 TYPE should be a keyword symbol, like :scheduled or :deadline.
-With COMPARATOR and DATE, return non-nil if entry's scheduled
-date compares with TARGET-DATE according to COMPARATOR."
+
+With COMPARATOR and TARGET-DATE, return non-nil if entry's
+scheduled date compares with TARGET-DATE according to COMPARATOR.
+TARGET-DATE may be a string like \"2017-08-05\", or an integer
+like one returned by `date-to-day'."
   (when-let ((entry-date (org-element-property type entry)))
-    ;; Append time to target-date because `date-to-day' requires it
-    (setq target-date (concat target-date " 00:00"))
-    (setq target-day-number (date-to-day target-date))
     (pcase comparator
+      ;; Not comparing, just checking if it has one
       ('nil t)
-      ((and (pred functionp) (guard target-day-number))
+      ;; Compare dates
+      ((and (pred functionp) (guard target-date))
+       (let ((target-day-number (cl-typecase target-date
+                                  ;; Append time to target-date
+                                  ;; because `date-to-day' requires it
+                                  (string (date-to-day (concat target-date " 00:00")))
+                                  (integer target-date))))
          (pcase (org-element-property :type entry-date)
            ((or 'active 'inactive)
             (funcall comparator
                      (org-time-string-to-absolute
                       (org-element-timestamp-interpreter entry-date 'ignore))
-                   target-day-number))))
+                     target-day-number))
+           (error "Unknown entry-date type: %s" (org-element-property :type entry-date)))))
       (otherwise (error "COMPARATOR (%s) must be a function, and DATE (%s) must be a string" comparator target-date)))))