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

And more

Browse source
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
Download patch file Download diff file Expand all files Collapse all files

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

44
org-agenda-ng.el
View file

@ -167,7 +167,8 @@
(erase-buffer)
(insert result-string)
(read-only-mode 1)
(pop-to-buffer (current-buffer)))))
(pop-to-buffer (current-buffer))
(org-agenda-finalize))))
;;;; Functions
@ -187,6 +188,7 @@ Headings should return non-nil for any ANY-PREDS and nil for all
NONE-PREDS."
(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)))
(habit (lambda (&rest args) (apply #'org-agenda-ng--habit-p args)))
(todo (lambda (&rest args) (apply #'org-agenda-ng--todo-p args)))
(tags (lambda (&rest args) (apply #'org-agenda-ng--tags-p args))))
(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)))
(title (--> (org-agenda-ng--add-faces element)
(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)
(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)
(format "[#%s]")
(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))))
(remove-list-of-text-properties 0 (length string) '(line-prefix) string)
;; Add all the necessary properties and faces to the whole string
(--> string
(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)
(->> 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.
(when-let ((tags-at (org-get-tags-at (point)
;; 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
(null t)
(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.
TARGET-DATE may be a string like \"2017-08-05\", or an integer
like one returned by `date-to-day'."
(when-let ((entry-date (awhen (pcase type
(:deadline (org-entry-get (point) "DEADLINE"))
(:scheduled (org-entry-get (point) "SCHEDULED")))
(when-let ((timestamp (pcase type
(:deadline (org-entry-get (point) "DEADLINE"))
(:scheduled (org-entry-get (point) "SCHEDULED"))
(:closed (org-entry-get (point) "CLOSED"))))
(date-element (with-temp-buffer
;; 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
;; org-element element
(with-temp-buffer
(insert it)
(goto-char 0)
(org-element-timestamp-parser))
)))
(insert timestamp)
(goto-char 0)
(org-element-timestamp-parser))))
(pcase comparator
;; Not comparing, just checking if it has one
('nil t)
@ -449,11 +456,14 @@ like one returned by `date-to-day'."
;; because `date-to-day' requires it
(string (date-to-day (concat target-date " 00:00")))
(integer target-date))))
(pcase (org-element-property :type entry-date)
(pcase (org-element-property :type date-element)
((or 'active 'inactive)
(funcall comparator
(org-time-string-to-absolute
(org-element-timestamp-interpreter entry-date 'ignore))
(org-element-timestamp-interpreter date-element 'ignore))
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)))))
(defun org-agenda-ng--habit-p ()
(org-is-habit-p))