diff --git a/org-ql-agenda.el b/org-ql-agenda.el index 73e734b..5423887 100644 --- a/org-ql-agenda.el +++ b/org-ql-agenda.el @@ -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, ;; 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. -Its property list should be the second item in the list, as returned by `org-element-parse-buffer'." - (let* ((properties (cadr element)) - ;; Remove the :parent property, which so bloats the size of - ;; 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. +Its property list should be the second item in the list, as +returned by `org-element-parse-buffer'. If ELEMENT is nil, +return an empty string." + (if (not element) + "" + (let* ((properties (cadr element)) + ;; Remove the :parent property, which so bloats the size of + ;; 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 - ;; better to avoid this somehow. At least, we should use a - ;; function to convert plists to alists, if possible. - (properties (cl-loop for (key val) on properties by #'cddr - for symbol = (intern (cl-subseq (symbol-name key) 1)) - unless (member symbol '(parent)) - append (list symbol val))) - ;; 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 - ;; --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 - ;; (which would also make it easier to do it independently of faces, etc). - (title (--> (org-ql-agenda--add-faces element) - (org-element-property :raw-value it) - (org-link-display-format it))) - (todo-keyword (-some--> (org-element-property :todo-keyword element) - (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. - (tag-list (if org-use-tag-inheritance - ;; 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 - ;; tags. (Or does `org-element-headline-parser' parse inherited tags too? I - ;; forget...) - (if-let ((marker (or (org-element-property :org-hd-marker element) - (org-element-property :org-marker element)))) - (with-current-buffer (marker-buffer marker) - ;; I wish `org-get-tags' used the correct buffer automatically. - (org-get-tags marker (not org-use-tag-inheritance))) - ;; No marker found - (warn "No marker found for item: %s" title) - (org-element-property :tags element)) - (org-element-property :tags element))) - (tag-string (-some--> tag-list - (s-join ":" it) - (s-wrap it ":") - (org-add-props it nil 'face 'org-tag))) - ;; (category (org-element-property :category element)) - (priority-string (-some->> (org-element-property :priority element) - (char-to-string) - (format "[#%s]") - (org-ql-agenda--add-priority-face))) - (habit-property (org-with-point-at (org-element-property :begin element) - (when (org-is-habit-p) - (org-habit-parse-todo)))) - (due-string (pcase (org-element-property :relative-due-date element) - ('nil "") - (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))))) - (remove-list-of-text-properties 0 (length string) '(line-prefix) string) - ;; Add all the necessary properties and faces to the whole string - (--> string - ;; FIXME: Use proper prefix - (concat " " it) - (org-add-props it properties - 'todo-state todo-keyword - 'tags tag-list - 'org-habit-p habit-property)))) + ;; Also, remove ":" from key symbols. FIXME: It would be + ;; better to avoid this somehow. At least, we should use a + ;; function to convert plists to alists, if possible. + (properties (cl-loop for (key val) on properties by #'cddr + for symbol = (intern (cl-subseq (symbol-name key) 1)) + unless (member symbol '(parent)) + append (list symbol val))) + ;; 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 + ;; --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 + ;; (which would also make it easier to do it independently of faces, etc). + (title (--> (org-ql-agenda--add-faces element) + (org-element-property :raw-value it) + (org-link-display-format it))) + (todo-keyword (-some--> (org-element-property :todo-keyword element) + (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. + (tag-list (if org-use-tag-inheritance + ;; 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 + ;; tags. (Or does `org-element-headline-parser' parse inherited tags too? I + ;; forget...) + (if-let ((marker (or (org-element-property :org-hd-marker element) + (org-element-property :org-marker element)))) + (with-current-buffer (marker-buffer marker) + ;; I wish `org-get-tags' used the correct buffer automatically. + (org-get-tags marker (not org-use-tag-inheritance))) + ;; No marker found + (warn "No marker found for item: %s" title) + (org-element-property :tags element)) + (org-element-property :tags element))) + (tag-string (-some--> tag-list + (s-join ":" it) + (s-wrap it ":") + (org-add-props it nil 'face 'org-tag))) + ;; (category (org-element-property :category element)) + (priority-string (-some->> (org-element-property :priority element) + (char-to-string) + (format "[#%s]") + (org-ql-agenda--add-priority-face))) + (habit-property (org-with-point-at (org-element-property :begin element) + (when (org-is-habit-p) + (org-habit-parse-todo)))) + (due-string (pcase (org-element-property :relative-due-date element) + ('nil "") + (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))))) + (remove-list-of-text-properties 0 (length string) '(line-prefix) string) + ;; Add all the necessary properties and faces to the whole string + (--> string + ;; FIXME: Use proper prefix + (concat " " it) + (org-add-props it properties + 'todo-state todo-keyword + 'tags tag-list + 'org-habit-p habit-property))))) (defun org-ql-agenda--add-faces (element) "Return ELEMENT with deadline and scheduled faces added."