And more
This commit is contained in:
parent
24326c05fa
commit
8fcbd8de0f
2 changed files with 56 additions and 17 deletions
29
README.org
Normal file
29
README.org
Normal 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
|
||||||
|
|
@ -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))
|
||||||
|
|
|
||||||
Loading…
Add table
Add a link
Reference in a new issue