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

Change: (org-ql-agenda--format-element) Return empty string if nil

Browse source 
This allows mapping the function across elements which may be nil,
helping to separate items in agenda views by inserting nil between
them.
This commit is contained in:
Adam Porter 2019-08-08 10:52:33 -05:00
parent 7829238988
commit 4970d441cc
1 changed files with 69 additions and 65 deletions
Download patch file Download diff file Expand all files Collapse all files

134
org-ql-agenda.el
View file

@ -326,72 +326,76 @@ dates in the past, and negative for dates in the future."
;; 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.
"Return ELEMENT as a string with text-properties set by its property list. "Return ELEMENT as a string with text-properties set by its property list.
Its property list should be the second item in the list, as returned by `org-element-parse-buffer'." Its property list should be the second item in the list, as
(let* ((properties (cadr element)) returned by `org-element-parse-buffer'. If ELEMENT is nil,
;; Remove the :parent property, which so bloats the size of return an empty string."
;; the properties list that it makes it essentially (if (not element)
;; impossible to debug, because Emacs takes approximately ""
;; forever to show it in the minibuffer or with (let* ((properties (cadr element))
;; `describe-text-properties'. FIXME: Shouldn't be necessary ;; Remove the :parent property, which so bloats the size of
;; anymore since we're not parsing the whole buffer. ;; 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'. FIXME: Shouldn't be necessary
;; anymore since we're not parsing the whole buffer.
;; Also, remove ":" from key symbols. FIXME: It would be ;; Also, remove ":" from key symbols. FIXME: It would be
;; better to avoid this somehow. At least, we should use a ;; better to avoid this somehow. At least, we should use a
;; function to convert plists to alists, if possible. ;; function to convert plists to alists, if possible.
(properties (cl-loop for (key val) on properties by #'cddr (properties (cl-loop for (key val) on properties by #'cddr
for symbol = (intern (cl-subseq (symbol-name key) 1)) for symbol = (intern (cl-subseq (symbol-name key) 1))
unless (member symbol '(parent)) unless (member symbol '(parent))
append (list symbol val))) append (list symbol val)))
;; TODO: --add-faces is used to add the :relative-due-date property, but that fact is ;; TODO: --add-faces is used to add the :relative-due-date property, but that fact is
;; hidden by doing it through --add-faces (which calls --add-scheduled-face and ;; hidden by doing it through --add-faces (which calls --add-scheduled-face and
;; --add-deadline-face), and doing it in this form that gets the title hides it even more. ;; --add-deadline-face), and doing it in this form that gets the title hides it even more.
;; Adding the relative due date property should probably be done explicitly and separately ;; Adding the relative due date property should probably be done explicitly and separately
;; (which would also make it easier to do it independently of faces, etc). ;; (which would also make it easier to do it independently of faces, etc).
(title (--> (org-ql-agenda--add-faces element) (title (--> (org-ql-agenda--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-ql-agenda--add-todo-face it))) (org-ql-agenda--add-todo-face it)))
;; FIXME: Figure out whether I should use `org-agenda-use-tag-inheritance' or `org-use-tag-inheritance', etc. ;; FIXME: Figure out whether I should use `org-agenda-use-tag-inheritance' or `org-use-tag-inheritance', etc.
(tag-list (if org-use-tag-inheritance (tag-list (if org-use-tag-inheritance
;; FIXME: Note that tag inheritance cannot be used here unless markers are ;; FIXME: Note that tag inheritance cannot be used here unless markers are
;; added, otherwise we can't go to the item's buffer to look for inherited ;; added, otherwise we can't go to the item's buffer to look for inherited
;; tags. (Or does `org-element-headline-parser' parse inherited tags too? I ;; tags. (Or does `org-element-headline-parser' parse inherited tags too? I
;; forget...) ;; forget...)
(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))))
(with-current-buffer (marker-buffer marker) (with-current-buffer (marker-buffer marker)
;; I wish `org-get-tags' used the correct buffer automatically. ;; I wish `org-get-tags' used the correct buffer automatically.
(org-get-tags marker (not org-use-tag-inheritance))) (org-get-tags marker (not org-use-tag-inheritance)))
;; No marker found ;; No marker found
(warn "No marker found for item: %s" title) (warn "No marker found for item: %s" title)
(org-element-property :tags element)) (org-element-property :tags element))
(org-element-property :tags element))) (org-element-property :tags element)))
(tag-string (-some--> tag-list (tag-string (-some--> tag-list
(s-join ":" it) (s-join ":" it)
(s-wrap it ":") (s-wrap it ":")
(org-add-props it nil 'face 'org-tag))) (org-add-props it nil 'face 'org-tag)))
;; (category (org-element-property :category element)) ;; (category (org-element-property :category element))
(priority-string (-some->> (org-element-property :priority element) (priority-string (-some->> (org-element-property :priority element)
(char-to-string) (char-to-string)
(format "[#%s]") (format "[#%s]")
(org-ql-agenda--add-priority-face))) (org-ql-agenda--add-priority-face)))
(habit-property (org-with-point-at (org-element-property :begin element) (habit-property (org-with-point-at (org-element-property :begin element)
(when (org-is-habit-p) (when (org-is-habit-p)
(org-habit-parse-todo)))) (org-habit-parse-todo))))
(due-string (pcase (org-element-property :relative-due-date element) (due-string (pcase (org-element-property :relative-due-date element)
('nil "") ('nil "")
(string (format " %s " (org-add-props string nil 'face 'underline))))) (string (format " %s " (org-add-props string nil 'face 'underline)))))
(string (s-join " " (-non-nil (list todo-keyword priority-string title due-string tag-string))))) (string (s-join " " (-non-nil (list todo-keyword priority-string title due-string 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
;; FIXME: Use proper prefix ;; FIXME: Use proper prefix
(concat " " it) (concat " " it)
(org-add-props it properties (org-add-props it properties
'todo-state todo-keyword 'todo-state todo-keyword
'tags tag-list 'tags tag-list
'org-habit-p habit-property)))) 'org-habit-p habit-property)))))
(defun org-ql-agenda--add-faces (element) (defun org-ql-agenda--add-faces (element)
"Return ELEMENT with deadline and scheduled faces added." "Return ELEMENT with deadline and scheduled faces added."