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

More

Browse source
This commit is contained in:
Adam Porter 2017-08-05 05:42:06 -05:00
parent cec536b793
commit aa722987b0
1 changed files with 26 additions and 25 deletions
Download patch file Download diff file Expand all files Collapse all files

45
org-agenda-ng.el
View file

@ -19,10 +19,10 @@
;;;; Commands ;;;; Commands
(cl-defun org-agenda-ng--agenda (&key match-fns filter-fns) (cl-defun org-agenda-ng--agenda (&key any-fns none-fns)
(let* ((org-use-tag-inheritance t) (let* ((org-use-tag-inheritance t)
(tree (cddr (org-element-parse-buffer 'headline))) (tree (cddr (org-element-parse-buffer 'headline)))
(entries (--> (org-agenda-ng--filter-tree tree :match-fns match-fns :filter-fns filter-fns) (entries (--> (org-agenda-ng--filter-tree tree :any-fns any-fns :none-fns none-fns)
(mapcar #'org-agenda-ng--format-element it))) (mapcar #'org-agenda-ng--format-element 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")))
@ -41,26 +41,26 @@
(defun org-agenda-ng--test-agenda () (defun org-agenda-ng--test-agenda ()
(interactive) (interactive)
(org-agenda-ng--test (org-agenda-ng--test
:match-fns '((org-agenda-ng--todo-p "TODO") :any-fns '((org-agenda-ng--todo-p "TODO")
(org-agenda-ng--date-p :deadline < "2017-08-05")))) (org-agenda-ng--date-p :deadline < "2017-08-05"))))
(defun org-agenda-ng--test-agenda-today () (defun org-agenda-ng--test-agenda-today ()
(interactive) (interactive)
(org-agenda-ng--test (org-agenda-ng--test
:match-fns `((org-agenda-ng--date-p :date <= ,(org-today)) :any-fns `((org-agenda-ng--date-p :date <= ,(org-today))
(org-agenda-ng--date-p :deadline <= ,(+ org-deadline-warning-days (org-today))) (org-agenda-ng--date-p :deadline <= ,(+ org-deadline-warning-days (org-today)))
(org-agenda-ng--date-p :scheduled <= ,(org-today))) (org-agenda-ng--date-p :scheduled <= ,(org-today)))
:filter-fns `((org-agenda-ng--todo-p ,org-done-keywords)))) :none-fns `((org-agenda-ng--todo-p ,org-done-keywords))))
(defun org-agenda-ng--test-todo-list () (defun org-agenda-ng--test-todo-list ()
(interactive) (interactive)
(org-agenda-ng--test (org-agenda-ng--test
:match-fns '(org-agenda-ng--todo-p) :any-fns '(org-agenda-ng--todo-p)
:filter-fns `((org-agenda-ng--todo-p ,org-done-keywords)))) :none-fns `((org-agenda-ng--todo-p ,org-done-keywords))))
;;;; Functions ;;;; Functions
(cl-defun org-agenda-ng--filter-tree (tree &key match-fns filter-fns) (cl-defun org-agenda-ng--filter-tree (tree &key any-fns none-fns)
(let* ((types '(headline)) (let* ((types '(headline))
(info nil) (info nil)
(first-match nil) (first-match nil)
@ -68,25 +68,29 @@
(when (and (--any? (cl-typecase it (when (and (--any? (cl-typecase it
(function (funcall it element)) (function (funcall it element))
(cons (apply (car it) element (cdr it)))) (cons (apply (car it) element (cdr it))))
match-fns) any-fns)
(or (null filter-fns) ;; Don't return if any filters match
(or (null none-fns)
(--none? (cl-typecase it (--none? (cl-typecase it
(function (funcall it element)) (function (funcall it element))
(cons (apply (car it) element (cdr it)))) (cons (apply (car it) element (cdr it))))
filter-fns))) none-fns)))
;; Add marker to element properties
;; TODO: Probably want to use a list of transforming functions here
(let* ((marker (org-agenda-new-marker (org-element-property :begin element)))
(properties (second element))
(properties (plist-put properties :org-hd-marker marker)))
(setf (second element) properties))
;; Return element ;; Return element
element)))) (->> element
(org-agenda-ng--add-markers))))))
(org-element-map tree types fun info first-match))) (org-element-map tree types fun info first-match)))
;;;; Faces/properties ;;;; Faces/properties
(defun org-agenda-ng--add-markers (element)
"Return ELEMENT with marker properties added."
(let* ((marker (org-agenda-new-marker (org-element-property :begin element)))
(properties (--> (second element)
(plist-put it :org-marker marker)
(plist-put it :org-hd-marker marker))))
(setf (second element) properties)
element))
(defun org-agenda-ng--format-element (element) (defun org-agenda-ng--format-element (element)
;; This essentially needs to do what `org-agenda-format-item' does, ;; This essentially needs to do what `org-agenda-format-item' does,
;; which is a lot. We are a long way from that, but it's a start. ;; which is a lot. We are a long way from that, but it's a start.
@ -112,7 +116,6 @@ Its property list should be the second item in the list, as returned by `org-ele
(if-let ((marker (or (org-element-property :org-hd-marker element) (if-let ((marker (or (org-element-property :org-hd-marker element)
(org-element-property :org-marker element)))) (org-element-property :org-marker element))))
(org-with-point-at marker (org-with-point-at marker
(message "Getting tags for: %s" title)
(org-get-tags-at)) (org-get-tags-at))
;; No marker found ;; No marker found
(warn "No marker found for item: %s" title) (warn "No marker found for item: %s" title)
@ -192,8 +195,6 @@ Its property list should be the second item in the list, as returned by `org-ele
;; No deadline ;; No deadline
element)) element))
(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)))