jiri/org-ql
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

This is starting to show potential

Browse source 
But the Org agenda codebase is massive, and reimplementing all of it is crazy
This commit is contained in:
Adam Porter 2017-08-05 03:42:15 -05:00
parent a40b00532d
commit 9dfb9b98c0
1 changed files with 59 additions and 66 deletions
Download patch file Download diff file Expand all files Collapse all files

125
org-agenda-ng.el
View file

@ -3,14 +3,16 @@
(require 'dash) (require 'dash)
(require 'cl-lib) (require 'cl-lib)
;;;; Commands
(defun org-agenda-ng--test-agenda () (defun org-agenda-ng--test-agenda ()
(interactive) (interactive)
(with-current-buffer (find-buffer-visiting "~/org/main.org") (with-current-buffer (find-buffer-visiting "~/org/main.org")
(let* ((tree (cddr (org-element-parse-buffer 'headline))) (let* ((tree (cddr (org-element-parse-buffer 'headline)))
(filter-fns '((org-agenda-ng--todo-p "TODO") (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) (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)) (result-string (org-agenda-finalize-entries entries 'agenda))
(target-buffer (get-buffer-create "test-agenda-ng"))) (target-buffer (get-buffer-create "test-agenda-ng")))
(with-current-buffer target-buffer (with-current-buffer target-buffer
@ -20,6 +22,8 @@
(read-only-mode 1) (read-only-mode 1)
(pop-to-buffer (current-buffer)))))) (pop-to-buffer (current-buffer))))))
;;;; Functions
(defun org-agenda-ng--filter-tree (tree &key filter-fns) (defun org-agenda-ng--filter-tree (tree &key filter-fns)
(let* ((types '(headline)) (let* ((types '(headline))
(info nil) (info nil)
@ -32,35 +36,31 @@
element)))) element))))
(org-element-map tree types fun info first-match))) (org-element-map tree types fun info first-match)))
(defun org-agenda-ng--todo-p (element &optional keyword) ;;;; Faces/properties
"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)))))
(defun org-agenda-ng--scheduled-p (entry &optional comparator target-date) (defun org-agenda-ng--element-to-string (element)
"Return non-nil if ENTRY is scheduled. "Return ELEMENT as a string with its text-properties set according to its property list.
With COMPARATOR and DATE, return non-nil if entry's scheduled Its property list should be the second item in the list, as returned by `org-element-parse-buffer'."
date compares with TARGET-DATE according to COMPARATOR." (let* ((properties (second element))
;; Remove the :parent property, which so bloats the size of
(when-let ((scheduled-date (org-element-property :scheduled entry))) ;; the properties list that it makes it essentially
;; Append time to target-date because `date-to-day' requires it ;; impossible to debug, because Emacs takes approximately
(setq target-date (concat target-date " 00:00")) ;; forever to show it in the minibuffer or with
(setq target-day-number (date-to-day target-date)) ;; `describe-text-properties'. Also, remove ":" from key
(pcase comparator ;; symbols.
('nil t) (properties (cl-loop for (key val) on properties by #'cddr
((and (pred functionp) (guard target-day-number)) for key = (intern (cl-subseq (symbol-name key) 1))
(pcase (org-element-property :type scheduled-date) unless (member key '(parent))
((or 'active 'inactive) append (list key val)))
(funcall comparator (title (--> (org-agenda-ng--add-faces element)
(org-time-string-to-absolute (org-element-property :title it)
(org-element-timestamp-interpreter scheduled-date 'ignore)) (org-link-display-format it)))
target-day-number)))) (todo-keyword (--> (org-element-property :todo-keyword element)
(otherwise (error "COMPARATOR (%s) must be a function, and DATE (%s) must be a string" comparator target-date))))) (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) (defun org-agenda-ng--add-faces (element)
(org-agenda-ng--add-scheduled-faces element)) (org-agenda-ng--add-scheduled-faces element))
@ -88,45 +88,38 @@ date compares with TARGET-DATE according to COMPARATOR."
;; Not scheduled ;; Not scheduled
element)) 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) (defun org-agenda-ng--add-todo-face (keyword)
(when-let ((face (org-get-todo-face keyword))) (when-let ((face (org-get-todo-face keyword)))
(org-add-props keyword nil 'face face))) (org-add-props keyword nil 'face face)))
;; (find-file-noselect "~/org/main.org") ;;;; Predicates
;; (let ((buffer (find-buffer-visiting "~/org/main.org")))
;; (with-current-buffer buffer
;; (length (org-agenda-ng--test))))
(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)))))
(defun org-agenda-ng--date-p (entry type &optional comparator target-date)
;; (with-current-buffer (find-file "~/src/org-agenda-ng/org-agenda-ng.el") "Return non-nil if ENTRY has a date property of TYPE.
;; (eval-buffer)) TYPE should be a keyword symbol, like :scheduled or :deadline.
With COMPARATOR and DATE, return non-nil if entry's scheduled
;; (decode-time (days-to-time 730119)) date compares with TARGET-DATE according to COMPARATOR."
;; (date-to-day "2017-08-04") (when-let ((entry-date (org-element-property type entry)))
;; Append time to target-date because `date-to-day' requires it
;; (date-to-day "2017-08-03") (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)))))