This commit is contained in:
Adam Porter 2018-01-03 10:28:40 -06:00
parent 24326c05fa
commit 8fcbd8de0f
2 changed files with 56 additions and 17 deletions

29
README.org Normal file
View file

@ -0,0 +1,29 @@
This is rudimentary, experimental, proof-of-concept alternative code for generating Org agendas. It doesn't support nearly as many features as =org-agenda.el= does. But it might be useful in some way. It uses some existing code from =org-agenda.el= and tries to be compatible with parts of it, like =org-agenda-finalize-entries= and =org-agenda-finalize=.
Here's an example of generating a kind of agenda view for today:
#+BEGIN_SRC elisp
(org-agenda-ng "~/src/emacs/org-super-agenda/test/test.org"
(and (or (date :deadline '<= (org-today))
(date :scheduled '<= (org-today)))
(not (apply #'todo org-done-keywords-for-agenda))))
#+END_SRC
Here are some other examples:
#+BEGIN_SRC elisp
(org-agenda-ng org-agenda-files
(and (todo "TODO" "SOMEDAY")
(tags "computer" "Emacs")
(category "main")))
(org-agenda-ng org-agenda-files
(habit))
(org-agenda-ng "~/org/main.org"
(or (habit)
(date :deadline '<= (org-today))
(date :scheduled '<= (org-today))
(and (todo "DONE" "CANCELLED")
(date :closed '= (org-today)))))
#+END_SRC

View file

@ -167,7 +167,8 @@
(erase-buffer) (erase-buffer)
(insert result-string) (insert result-string)
(read-only-mode 1) (read-only-mode 1)
(pop-to-buffer (current-buffer))))) (pop-to-buffer (current-buffer))
(org-agenda-finalize))))
;;;; Functions ;;;; Functions
@ -187,6 +188,7 @@ Headings should return non-nil for any ANY-PREDS and nil for all
NONE-PREDS." NONE-PREDS."
(org-agenda-ng--flet ((category (lambda (&rest args) (apply #'org-agenda-ng--category-p args))) (org-agenda-ng--flet ((category (lambda (&rest args) (apply #'org-agenda-ng--category-p args)))
(date (lambda (&rest args) (apply #'org-agenda-ng--date-p args))) (date (lambda (&rest args) (apply #'org-agenda-ng--date-p args)))
(habit (lambda (&rest args) (apply #'org-agenda-ng--habit-p args)))
(todo (lambda (&rest args) (apply #'org-agenda-ng--todo-p args))) (todo (lambda (&rest args) (apply #'org-agenda-ng--todo-p args)))
(tags (lambda (&rest args) (apply #'org-agenda-ng--tags-p args)))) (tags (lambda (&rest args) (apply #'org-agenda-ng--tags-p args))))
(let* ((our-lambda (when (or all any none) (let* ((our-lambda (when (or all any none)
@ -235,7 +237,7 @@ Its property list should be the second item in the list, as returned by `org-ele
append (list key val))) append (list key val)))
(title (--> (org-agenda-ng--add-faces element) (title (--> (org-agenda-ng--add-faces element)
(org-element-property :raw-value it) (org-element-property :raw-value it)
;; (org-link-display-format it) (org-link-display-format it)
)) ))
(todo-keyword (-some--> (org-element-property :todo-keyword element) (todo-keyword (-some--> (org-element-property :todo-keyword element)
(org-agenda-ng--add-todo-face it))) (org-agenda-ng--add-todo-face it)))
@ -259,12 +261,18 @@ Its property list should be the second item in the list, as returned by `org-ele
(char-to-string) (char-to-string)
(format "[#%s]") (format "[#%s]")
(org-agenda-ng--add-priority-face))) (org-agenda-ng--add-priority-face)))
(habit-property (org-with-point-at (org-element-property :begin element)
(when (org-is-habit-p)
(org-habit-parse-todo))))
(string (s-join " " (list todo-keyword priority-string title tag-string)))) (string (s-join " " (list todo-keyword priority-string title tag-string))))
(remove-list-of-text-properties 0 (length string) '(line-prefix) string) (remove-list-of-text-properties 0 (length string) '(line-prefix) string)
;; Add all the necessary properties and faces to the whole string ;; Add all the necessary properties and faces to the whole string
(--> string (--> string
(concat " " it) (concat " " it)
(org-add-props it properties 'tags tag-list)))) (org-add-props it properties
'todo-state todo-keyword
'tags tag-list
'org-habit-p habit-property))))
(defun org-agenda-ng--add-faces (element) (defun org-agenda-ng--add-faces (element)
(->> element (->> element
@ -413,8 +421,7 @@ With KEYWORDS, return non-nil if its keyword is one of KEYWORDS."
;; TODO: Try to use `org-make-tags-matcher' to improve performance. ;; TODO: Try to use `org-make-tags-matcher' to improve performance.
(when-let ((tags-at (org-get-tags-at (point) (when-let ((tags-at (org-get-tags-at (point)
;; FIXME: Would be nice to not check this for every heading checked. ;; FIXME: Would be nice to not check this for every heading checked.
;; (not (member 'agenda org-agenda-use-tag-inheritance)) (not (member 'agenda org-agenda-use-tag-inheritance)))))
)))
(cl-typecase tags (cl-typecase tags
(null t) (null t)
(otherwise (seq-intersection tags tags-at))))) (otherwise (seq-intersection tags tags-at)))))
@ -427,18 +434,18 @@ With COMPARATOR and TARGET-DATE, return non-nil if entry's
scheduled date compares with TARGET-DATE according to COMPARATOR. scheduled date compares with TARGET-DATE according to COMPARATOR.
TARGET-DATE may be a string like \"2017-08-05\", or an integer TARGET-DATE may be a string like \"2017-08-05\", or an integer
like one returned by `date-to-day'." like one returned by `date-to-day'."
(when-let ((entry-date (awhen (pcase type (when-let ((timestamp (pcase type
(:deadline (org-entry-get (point) "DEADLINE")) (:deadline (org-entry-get (point) "DEADLINE"))
(:scheduled (org-entry-get (point) "SCHEDULED"))) (:scheduled (org-entry-get (point) "SCHEDULED"))
(:closed (org-entry-get (point) "CLOSED"))))
(date-element (with-temp-buffer
;; FIXME: Hack: since we're using ;; FIXME: Hack: since we're using
;; (org-element-property :type entry-date) ;; (org-element-property :type date-element)
;; below, we need this date parsed into an ;; below, we need this date parsed into an
;; org-element element ;; org-element element
(with-temp-buffer (insert timestamp)
(insert it) (goto-char 0)
(goto-char 0) (org-element-timestamp-parser))))
(org-element-timestamp-parser))
)))
(pcase comparator (pcase comparator
;; Not comparing, just checking if it has one ;; Not comparing, just checking if it has one
('nil t) ('nil t)
@ -449,11 +456,14 @@ like one returned by `date-to-day'."
;; because `date-to-day' requires it ;; because `date-to-day' requires it
(string (date-to-day (concat target-date " 00:00"))) (string (date-to-day (concat target-date " 00:00")))
(integer target-date)))) (integer target-date))))
(pcase (org-element-property :type entry-date) (pcase (org-element-property :type date-element)
((or 'active 'inactive) ((or 'active 'inactive)
(funcall comparator (funcall comparator
(org-time-string-to-absolute (org-time-string-to-absolute
(org-element-timestamp-interpreter entry-date 'ignore)) (org-element-timestamp-interpreter date-element 'ignore))
target-day-number)) target-day-number))
(error "Unknown entry-date type: %s" (org-element-property :type entry-date))))) (error "Unknown date-element type: %s" (org-element-property :type date-element)))))
(otherwise (error "COMPARATOR (%s) must be a function, and DATE (%s) must be a string" comparator target-date))))) (otherwise (error "COMPARATOR (%s) must be a function, and DATE (%s) must be a string" comparator target-date)))))
(defun org-agenda-ng--habit-p ()
(org-is-habit-p))