From 9dfb9b98c06c8f00e8812b31d6af873ad78435ea Mon Sep 17 00:00:00 2001 From: Adam Porter Date: Sat, 5 Aug 2017 03:42:15 -0500 Subject: [PATCH] This is starting to show potential But the Org agenda codebase is massive, and reimplementing all of it is crazy --- org-agenda-ng.el | 125 ++++++++++++++++++++++------------------------- 1 file changed, 59 insertions(+), 66 deletions(-) diff --git a/org-agenda-ng.el b/org-agenda-ng.el index 887f75f..63526ca 100644 --- a/org-agenda-ng.el +++ b/org-agenda-ng.el @@ -3,14 +3,16 @@ (require 'dash) (require 'cl-lib) +;;;; Commands + (defun org-agenda-ng--test-agenda () (interactive) (with-current-buffer (find-buffer-visiting "~/org/main.org") (let* ((tree (cddr (org-element-parse-buffer 'headline))) (filter-fns '((org-agenda-ng--todo-p "TODO") - (org-agenda-ng--scheduled-p < "2017-08-04"))) + (org-agenda-ng--date-p :deadline < "2017-08-05"))) (entries (--> (org-agenda-ng--filter-tree tree :filter-fns filter-fns) - (mapcar #'org-agenda-ng--add-text-properties it))) + (mapcar #'org-agenda-ng--element-to-string it))) (result-string (org-agenda-finalize-entries entries 'agenda)) (target-buffer (get-buffer-create "test-agenda-ng"))) (with-current-buffer target-buffer @@ -20,6 +22,8 @@ (read-only-mode 1) (pop-to-buffer (current-buffer)))))) +;;;; Functions + (defun org-agenda-ng--filter-tree (tree &key filter-fns) (let* ((types '(headline)) (info nil) @@ -32,35 +36,31 @@ element)))) (org-element-map tree types fun info first-match))) -(defun org-agenda-ng--todo-p (element &optional keyword) - "Return non-nil if ELEMENT is a TODO item. -With KEYWORD, return non-nil if it has the same TODO keyword." - (when-let ((element-keyword (org-element-property :todo-keyword element))) - (pcase keyword - ('nil t) - ((pred stringp) - (string= element-keyword keyword)) - (otherwise (error "Invalid keyword argument: %s" otherwise))))) +;;;; Faces/properties -(defun org-agenda-ng--scheduled-p (entry &optional comparator target-date) - "Return non-nil if ENTRY is scheduled. -With COMPARATOR and DATE, return non-nil if entry's scheduled -date compares with TARGET-DATE according to COMPARATOR." - - (when-let ((scheduled-date (org-element-property :scheduled 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 - ('nil t) - ((and (pred functionp) (guard target-day-number)) - (pcase (org-element-property :type scheduled-date) - ((or 'active 'inactive) - (funcall comparator - (org-time-string-to-absolute - (org-element-timestamp-interpreter scheduled-date 'ignore)) - target-day-number)))) - (otherwise (error "COMPARATOR (%s) must be a function, and DATE (%s) must be a string" comparator target-date))))) +(defun org-agenda-ng--element-to-string (element) + "Return ELEMENT as a string with its text-properties set according to its property list. +Its property list should be the second item in the list, as returned by `org-element-parse-buffer'." + (let* ((properties (second element)) + ;; Remove the :parent property, which so bloats the size of + ;; the properties list that it makes it essentially + ;; impossible to debug, because Emacs takes approximately + ;; forever to show it in the minibuffer or with + ;; `describe-text-properties'. Also, remove ":" from key + ;; symbols. + (properties (cl-loop for (key val) on properties by #'cddr + for key = (intern (cl-subseq (symbol-name key) 1)) + unless (member key '(parent)) + append (list key val))) + (title (--> (org-agenda-ng--add-faces element) + (org-element-property :title it) + (org-link-display-format it))) + (todo-keyword (--> (org-element-property :todo-keyword element) + (org-agenda-ng--add-todo-face it))) + (string (s-join " " (list todo-keyword title)))) + ;; Add all the necessary properties and faces to the whole string + (--> string + (org-add-props it properties)))) (defun org-agenda-ng--add-faces (element) (org-agenda-ng--add-scheduled-faces element)) @@ -88,45 +88,38 @@ date compares with TARGET-DATE according to COMPARATOR." ;; Not scheduled element)) -(defun org-agenda-ng--add-text-properties (element) - "Return ELEMENT as a string with its text-properties set according to its property list. -Its property list should be the second item in the list, as returned by `org-element-parse-buffer'." - (let* ((properties (second element)) - ;; Remove the :parent property, which so bloats the size of - ;; the properties list that it makes it essentially - ;; impossible to debug, because Emacs takes approximately - ;; forever to show it in the minibuffer or with - ;; `describe-text-properties'. Also, remove ":" from key - ;; symbols. - (properties (cl-loop for (key val) on properties by #'cddr - for key = (intern (cl-subseq (symbol-name key) 1)) - unless (member key '(parent)) - append (list key val))) - (title (--> (org-agenda-ng--add-faces element) - (org-element-property :title it) - (org-link-display-format it))) - (todo-keyword (--> (org-element-property :todo-keyword element) - (org-agenda-ng--add-todo-face it))) - (string (s-join " " (list todo-keyword title)))) - ;; Add all the necessary properties and faces to the whole string - (--> string - (org-add-props it properties)))) - (defun org-agenda-ng--add-todo-face (keyword) (when-let ((face (org-get-todo-face keyword))) (org-add-props keyword nil 'face face))) -;; (find-file-noselect "~/org/main.org") -;; (let ((buffer (find-buffer-visiting "~/org/main.org"))) -;; (with-current-buffer buffer -;; (length (org-agenda-ng--test)))) +;;;; Predicates +(defun org-agenda-ng--todo-p (element &optional keyword) + "Return non-nil if ELEMENT is a TODO item. +With KEYWORD, return non-nil if it has the same TODO keyword." + (when-let ((element-keyword (org-element-property :todo-keyword element))) + (pcase keyword + ('nil t) + ((pred stringp) + (string= element-keyword keyword)) + (otherwise (error "Invalid keyword argument: %s" otherwise))))) - -;; (with-current-buffer (find-file "~/src/org-agenda-ng/org-agenda-ng.el") -;; (eval-buffer)) - -;; (decode-time (days-to-time 730119)) -;; (date-to-day "2017-08-04") - -;; (date-to-day "2017-08-03") +(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." + (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 + ('nil t) + ((and (pred functionp) (guard target-day-number)) + (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)))) + (otherwise (error "COMPARATOR (%s) must be a function, and DATE (%s) must be a string" comparator target-date)))))