ADD function to format scheduled headlines
This commit is contained in:
parent
684b7c9fa2
commit
083cc9fd65
|
@ -371,27 +371,40 @@ encountered will be returned."
|
||||||
(--sort (< (cdr it) (cdr other)))
|
(--sort (< (cdr it) (cdr other)))
|
||||||
(-map #'car))))
|
(-map #'car))))
|
||||||
|
|
||||||
|
(defun org-x-dag-prepare-tags (tags)
|
||||||
|
(->> (org-x-dag-collapse-tags tags)
|
||||||
|
(org-x-dag-sort-tags)))
|
||||||
|
|
||||||
(defun org-x-dag-add-default-props (item)
|
(defun org-x-dag-add-default-props (item)
|
||||||
(org-add-props item nil
|
(org-add-props item nil
|
||||||
|
'help-echo (org-x-dag-help-echo)
|
||||||
'org-not-done-regexp org-not-done-regexp
|
'org-not-done-regexp org-not-done-regexp
|
||||||
'org-todo-regexp org-todo-regexp
|
'org-todo-regexp org-todo-regexp
|
||||||
'org-complex-heading-regexp org-complex-heading-regexp
|
'org-complex-heading-regexp org-complex-heading-regexp
|
||||||
'mouse-face 'highlight))
|
'mouse-face 'highlight))
|
||||||
|
|
||||||
|
(defun org-x-dag-id->formatted-level (id)
|
||||||
|
(-> (org-x-dag-id->metaprop id :level)
|
||||||
|
(org-reduced-level)
|
||||||
|
(make-string ?\s)))
|
||||||
|
|
||||||
|
(defun org-x-dag-help-echo ()
|
||||||
|
(->> (or (buffer-file-name (buffer-base-buffer))
|
||||||
|
(buffer-name (buffer-base-buffer)))
|
||||||
|
(abbreviate-file-name)
|
||||||
|
(format "mouse-2 or RET jump to Org file %S")))
|
||||||
|
|
||||||
|
(defun org-x-dag-headlines-get-regexp (re)
|
||||||
|
(let ((end (save-excursion (outline-next-heading))))
|
||||||
|
(-when-let (p (save-excursion (re-search-forward re end t)))
|
||||||
|
(list (1- (match-beginning 1)) (match-string 1)))))
|
||||||
|
|
||||||
(defun org-x-dag-format-tag-node (category tags key)
|
(defun org-x-dag-format-tag-node (category tags key)
|
||||||
;; ASSUME I don't use subtree-level categories
|
;; ASSUME I don't use subtree-level categories
|
||||||
(-let* (;; (category (org-get-category))
|
(-let* (;; (category (org-get-category))
|
||||||
(tags* (->> tags
|
(tags* (org-x-dag-prepare-tags tags))
|
||||||
(org-x-dag-collapse-tags)
|
|
||||||
(org-x-dag-sort-tags)))
|
|
||||||
(head (org-get-heading))
|
(head (org-get-heading))
|
||||||
(level (-> (org-x-dag-id->metaprop key :level)
|
(level (org-x-dag-id->formatted-level key))
|
||||||
(make-string ?s)))
|
|
||||||
;; no idea what this does...
|
|
||||||
(help-echo (format "mouse-2 or RET jump to Org file %S"
|
|
||||||
(abbreviate-file-name
|
|
||||||
(or (buffer-file-name (buffer-base-buffer))
|
|
||||||
(buffer-name (buffer-base-buffer))))))
|
|
||||||
(marker (org-agenda-new-marker))
|
(marker (org-agenda-new-marker))
|
||||||
;; no idea what this function actually does
|
;; no idea what this function actually does
|
||||||
((ts . ts-type) (org-agenda-entry-get-agenda-timestamp (point)))
|
((ts . ts-type) (org-agenda-entry-get-agenda-timestamp (point)))
|
||||||
|
@ -411,8 +424,103 @@ encountered will be returned."
|
||||||
'priority priority
|
'priority priority
|
||||||
'ts-date ts
|
'ts-date ts
|
||||||
;; misc
|
;; misc
|
||||||
'type (concat "tagsmatch" ts-type)
|
'type (concat "tagsmatch" ts-type)))))
|
||||||
'help-echo help-echo))))
|
|
||||||
|
;; (defun org-x-dag-format-timestamp-node (date category tags id)
|
||||||
|
;; (let* ((help-echo
|
||||||
|
;; (format "mouse-2 or RET jump to Org file %s"
|
||||||
|
;; (abbreviate-file-name buffer-file-name)))
|
||||||
|
;; (extra)
|
||||||
|
;; (head)
|
||||||
|
;; (level)
|
||||||
|
;; (tags)
|
||||||
|
;; (timestamp)
|
||||||
|
;; ;; idk if this matters, nothing we care about here will be a habit
|
||||||
|
;; (habitp)
|
||||||
|
;; (ts-marker)
|
||||||
|
;; (hd-marker (org-agenda-new-marker))
|
||||||
|
;; (item (org-agenda-format-item extra head level category tags timestamp
|
||||||
|
;; org-ts-regexp habitp))
|
||||||
|
;; ;; TODO why am I getting the priority after sending the headline
|
||||||
|
;; ;; through some crazy formatting function?
|
||||||
|
;; (priority (org-get-priority item)))
|
||||||
|
;; (-> (org-x-dag-add-default-props item)
|
||||||
|
;; (org-add-props nil
|
||||||
|
;; ;; face
|
||||||
|
;; 'face 'org-agenda-calendar-event
|
||||||
|
;; 'done-face 'org-agenda-done
|
||||||
|
;; ;; marker
|
||||||
|
;; 'org-hd-marker hd-marker
|
||||||
|
;; 'org-marker ts-marker
|
||||||
|
;; ;; headline stuff
|
||||||
|
;; 'todo-state (org-x-dag-id->todo id)
|
||||||
|
;; 'priority priority
|
||||||
|
;; 'date date
|
||||||
|
;; 'ts-date ts
|
||||||
|
;; ;; this appears to be either obsolete or such an obscure feature
|
||||||
|
;; ;; that I would never care about it
|
||||||
|
;; ;; 'warntime warntime
|
||||||
|
;; ;; misc
|
||||||
|
;; 'type "timestamp"
|
||||||
|
;; 'help-echo help-echo))))
|
||||||
|
|
||||||
|
;; TODO it might make sense to make this also parse deadline
|
||||||
|
(defun org-x-dag-format-scheduled-node (date category tags id)
|
||||||
|
(-let* (((pos ts-match) (org-x-dag-headlines-get-regexp org-scheduled-time-regexp))
|
||||||
|
(current (calendar-absolute-from-gregorian date))
|
||||||
|
(schedule (org-time-string-to-absolute ts-match))
|
||||||
|
(diff (- current schedule))
|
||||||
|
(pastschedp (< diff 0))
|
||||||
|
(futureschedp (> diff 0))
|
||||||
|
;; TODO wtf does this actually do?
|
||||||
|
(repeat (if (<= current today) schedule
|
||||||
|
(org-time-string-to-absolute s current 'future (current-buffer) pos)))
|
||||||
|
(habitp (and (fboundp 'org-is-habit-p) (org-is-habit-p)))
|
||||||
|
;; hopefully this is right...
|
||||||
|
(time (unless (and (not habitp) (/= current schedule) (/= current repeat))
|
||||||
|
(-if-let (m (s-match " \\([012]?[0-9]:[0-9][0-9]\\)" ts-match))
|
||||||
|
(concat m " ")
|
||||||
|
'time)))
|
||||||
|
(today (org-today))
|
||||||
|
(todayp (org-agenda-today-p date))
|
||||||
|
(head (org-get-heading))
|
||||||
|
(level (org-x-dag-id->formatted-level id))
|
||||||
|
(tags* (org-x-dag-prepare-tags tags))
|
||||||
|
(todo-state (org-x-dag-id->todo id))
|
||||||
|
(donep (member todo-state org-x-done-keywords))
|
||||||
|
(hd-marker (org-agenda-new-marker))
|
||||||
|
(ts-marker (org-agenda-new-marker pos))
|
||||||
|
(extra (->> (if pastschedp (format "%sd Ago" diff) "Scheduled")
|
||||||
|
(format "%s: ")))
|
||||||
|
(item (org-agenda-format-item extra head level category tags* time
|
||||||
|
nil habitp))
|
||||||
|
;; TODO why am I getting the priority after sending the headline
|
||||||
|
;; through some crazy formatting function?
|
||||||
|
(priority (org-get-priority item))
|
||||||
|
(face (cond ((and (not habitp) pastschedp) 'org-scheduled-previously)
|
||||||
|
((and habitp futureschedp) 'org-agenda-done)
|
||||||
|
(todayp 'org-scheduled-today)
|
||||||
|
(t 'org-scheduled))))
|
||||||
|
(-> (org-x-dag-add-default-props item)
|
||||||
|
(org-add-props nil
|
||||||
|
;; face
|
||||||
|
'face (if donep 'org-agenda-done face)
|
||||||
|
'undone-face face
|
||||||
|
'done-face 'org-agenda-done
|
||||||
|
;; marker
|
||||||
|
'org-hd-marker hd-marker
|
||||||
|
'org-marker ts-marker
|
||||||
|
;; headline stuff
|
||||||
|
'todo-state (org-x-dag-id->todo id)
|
||||||
|
'priority priority
|
||||||
|
'date (if pastschedp schedule date)
|
||||||
|
'ts-date schedule
|
||||||
|
'org-habit-p habitp
|
||||||
|
;; this appears to be either obsolete or such an obscure feature
|
||||||
|
;; that I would never care about it
|
||||||
|
;; 'warntime warntime
|
||||||
|
;; misc
|
||||||
|
'type (if pastschedp "past-scheduled" "scheduled")))))
|
||||||
|
|
||||||
;;; HEADLINE PREDICATES
|
;;; HEADLINE PREDICATES
|
||||||
;;
|
;;
|
||||||
|
|
Loading…
Reference in New Issue