forked from mirrors/org-mode
org-agenda: Small refactoring
* lisp/org-agenda.el (org-agenda-get-deadlines): (org-agenda-get-scheduled):
This commit is contained in:
Nicolas Goaziou
parent
e6ac458988
commit
7f20175807
|
|
@ -6052,131 +6052,124 @@ specification like [h]h:mm."
|
|||
(regexp (if with-hour
|
||||
org-deadline-time-hour-regexp
|
||||
org-deadline-time-regexp))
|
||||
(todayp (org-agenda-today-p date)) ; DATE bound by calendar
|
||||
(d1 (calendar-absolute-from-gregorian date)) ; DATE bound by calendar
|
||||
(dl0 (car org-agenda-deadline-leaders))
|
||||
(dl1 (nth 1 org-agenda-deadline-leaders))
|
||||
(dl2 (or (nth 2 org-agenda-deadline-leaders) dl1))
|
||||
d2 diff dfrac wdays pos pos1 category level
|
||||
tags suppress-prewarning ee txt head face s todo-state
|
||||
show-all upcomingp donep timestr warntime inherited-tags ts-date)
|
||||
(todayp (org-agenda-today-p date)) ; DATE bound by calendar.
|
||||
(current (calendar-absolute-from-gregorian date))
|
||||
deadline-items)
|
||||
(goto-char (point-min))
|
||||
(while (re-search-forward regexp nil t)
|
||||
(catch :skip
|
||||
(unless (save-match-data (org-at-planning-p)) (throw :skip nil))
|
||||
(org-agenda-skip)
|
||||
(setq s (match-string 1)
|
||||
txt nil
|
||||
pos (1- (match-beginning 1))
|
||||
todo-state (save-match-data (org-get-todo-state))
|
||||
show-all (or (eq org-agenda-repeating-timestamp-show-all t)
|
||||
(member todo-state
|
||||
org-agenda-repeating-timestamp-show-all))
|
||||
d2 (org-agenda--timestamp-to-absolute
|
||||
s d1 'past show-all (current-buffer) pos)
|
||||
diff (- d2 d1))
|
||||
(setq suppress-prewarning
|
||||
(let ((ds (and org-agenda-skip-deadline-prewarning-if-scheduled
|
||||
(let ((item (buffer-substring (point-at-bol)
|
||||
(point-at-eol))))
|
||||
(save-match-data
|
||||
(and (string-match
|
||||
org-scheduled-time-regexp item)
|
||||
(match-string 1 item)))))))
|
||||
(cond
|
||||
((not ds) nil)
|
||||
;; The current item has a scheduled date (in ds), so
|
||||
;; evaluate its prewarning lead time.
|
||||
((integerp org-agenda-skip-deadline-prewarning-if-scheduled)
|
||||
;; Use global prewarning-restart lead time.
|
||||
org-agenda-skip-deadline-prewarning-if-scheduled)
|
||||
((eq org-agenda-skip-deadline-prewarning-if-scheduled
|
||||
'pre-scheduled)
|
||||
;; Set prewarning to no earlier than scheduled.
|
||||
(min (- d2 (org-agenda--timestamp-to-absolute
|
||||
ds d1 'past show-all (current-buffer) pos))
|
||||
org-deadline-warning-days))
|
||||
;; Set prewarning to deadline.
|
||||
(t 0))))
|
||||
(setq wdays (if suppress-prewarning
|
||||
(let ((org-deadline-warning-days suppress-prewarning))
|
||||
(org-get-wdays s))
|
||||
(org-get-wdays s))
|
||||
dfrac (- 1 (/ (* 1.0 diff) (max wdays 1)))
|
||||
upcomingp (and todayp (> diff 0)))
|
||||
;; When to show a deadline in the calendar:
|
||||
;; If the expiration is within wdays warning time.
|
||||
;; Past-due deadlines are only shown on the current date
|
||||
(if (and (or (and (<= diff wdays)
|
||||
(and todayp (not org-agenda-only-exact-dates)))
|
||||
(= diff 0)))
|
||||
(save-excursion
|
||||
;; (setq todo-state (org-get-todo-state))
|
||||
(setq donep (member todo-state org-done-keywords))
|
||||
(if (and donep
|
||||
(or org-agenda-skip-deadline-if-done
|
||||
(not (= diff 0))))
|
||||
(setq txt nil)
|
||||
(setq category (org-get-category)
|
||||
warntime (get-text-property (point) 'org-appt-warntime))
|
||||
(if (not (re-search-backward "^\\*+[ \t]+" nil t))
|
||||
(throw :skip nil)
|
||||
(goto-char (match-end 0))
|
||||
(setq pos1 (match-beginning 0))
|
||||
(setq level (make-string (org-reduced-level (org-outline-level)) ? ))
|
||||
(setq inherited-tags
|
||||
(or (eq org-agenda-show-inherited-tags 'always)
|
||||
(and (listp org-agenda-show-inherited-tags)
|
||||
(memq 'agenda org-agenda-show-inherited-tags))
|
||||
(and (eq org-agenda-show-inherited-tags t)
|
||||
(or (eq org-agenda-use-tag-inheritance t)
|
||||
(memq 'agenda org-agenda-use-tag-inheritance))))
|
||||
tags (org-get-tags-at pos1 (not inherited-tags)))
|
||||
(setq head (buffer-substring
|
||||
(point)
|
||||
(progn (skip-chars-forward "^\r\n")
|
||||
(point))))
|
||||
(if (string-match " \\([012]?[0-9]:[0-9][0-9]\\)" s)
|
||||
(setq timestr
|
||||
(concat (substring s (match-beginning 1)) " "))
|
||||
(setq timestr 'time))
|
||||
(setq txt
|
||||
(org-agenda-format-item
|
||||
;; For past deadlines, make sure to report
|
||||
;; time difference since date S, not since
|
||||
;; closest repeater.
|
||||
(let ((diff (if (< (org-today) d1) diff
|
||||
(- (org-agenda--timestamp-to-absolute s)
|
||||
d1))))
|
||||
(cond ((= diff 0) dl0)
|
||||
((> diff 0)
|
||||
(if (functionp dl1)
|
||||
(funcall dl1 diff date)
|
||||
(format dl1 diff)))
|
||||
(t
|
||||
(if (functionp dl2)
|
||||
(funcall dl2 diff date)
|
||||
(format dl2 (if (string= dl2 dl1)
|
||||
diff (abs diff)))))))
|
||||
head level category tags
|
||||
(and (= diff 0) timestr)))))
|
||||
(when txt
|
||||
(setq face (org-agenda-deadline-face dfrac))
|
||||
(org-add-props txt props
|
||||
'org-marker (org-agenda-new-marker pos)
|
||||
'warntime warntime
|
||||
'level level
|
||||
'ts-date d2
|
||||
'org-hd-marker (org-agenda-new-marker pos1)
|
||||
'priority (+ (- diff)
|
||||
(org-get-priority txt))
|
||||
'todo-state todo-state
|
||||
'type (if upcomingp "upcoming-deadline" "deadline")
|
||||
'date (if upcomingp date d2)
|
||||
'face (if donep 'org-agenda-done face)
|
||||
'undone-face face 'done-face 'org-agenda-done)
|
||||
(push txt ee))))))
|
||||
(nreverse ee)))
|
||||
(let* ((s (match-string 1))
|
||||
(pos (1- (match-beginning 1)))
|
||||
(todo-state (save-match-data (org-get-todo-state)))
|
||||
(donep (member todo-state org-done-keywords))
|
||||
(show-all (or (eq org-agenda-repeating-timestamp-show-all t)
|
||||
(member todo-state
|
||||
org-agenda-repeating-timestamp-show-all)))
|
||||
;; DEADLINE is the current scheduled date. When it
|
||||
;; contains a repeater and SHOW-ALL is non-nil,
|
||||
;; LAST-REPEAT is the repeat closest to CURRENT.
|
||||
;; Otherwise, LAST-REPEAT is equal to DEADLINE.
|
||||
(last-repeat (org-agenda--timestamp-to-absolute
|
||||
s current 'past show-all (current-buffer) pos))
|
||||
(deadline (org-agenda--timestamp-to-absolute s current))
|
||||
(diff (- last-repeat current))
|
||||
(suppress-prewarning
|
||||
(let ((scheduled
|
||||
(and org-agenda-skip-deadline-prewarning-if-scheduled
|
||||
(org-entry-get nil "SCHEDULED"))))
|
||||
(cond
|
||||
((not scheduled) nil)
|
||||
;; The current item has a scheduled date, so
|
||||
;; evaluate its prewarning lead time.
|
||||
((integerp org-agenda-skip-deadline-prewarning-if-scheduled)
|
||||
;; Use global prewarning-restart lead time.
|
||||
org-agenda-skip-deadline-prewarning-if-scheduled)
|
||||
((eq org-agenda-skip-deadline-prewarning-if-scheduled
|
||||
'pre-scheduled)
|
||||
;; Set pre-warning to no earlier than SCHEDULED.
|
||||
(min (- last-repeat
|
||||
(org-agenda--timestamp-to-absolute
|
||||
scheduled current 'past show-all
|
||||
(current-buffer)
|
||||
(save-excursion
|
||||
(beginning-of-line)
|
||||
(1+ (search-forward org-deadline-string)))))
|
||||
org-deadline-warning-days))
|
||||
;; Set pre-warning to deadline.
|
||||
(t 0))))
|
||||
(wdays (if suppress-prewarning
|
||||
(let ((org-deadline-warning-days suppress-prewarning))
|
||||
(org-get-wdays s))
|
||||
(org-get-wdays s))))
|
||||
;; When to show a deadline in the calendar: if the
|
||||
;; expiration is within WDAYS warning time. Past-due
|
||||
;; deadlines are only shown on the current date
|
||||
(unless (or (and (<= diff wdays)
|
||||
(and todayp (not org-agenda-only-exact-dates)))
|
||||
(= diff 0))
|
||||
(throw :skip nil))
|
||||
;; Skip done tasks if `org-agenda-skip-deadline-if-done' is
|
||||
;; non-nil or if it isn't applicable to CURRENT deadline.
|
||||
(when (and donep
|
||||
(or org-agenda-skip-deadline-if-done
|
||||
(/= deadline current)))
|
||||
(throw :skip nil))
|
||||
(save-excursion
|
||||
(re-search-backward "^\\*+[ \t]+" nil t)
|
||||
(goto-char (match-end 0))
|
||||
(let* ((category (org-get-category))
|
||||
(level
|
||||
(make-string (org-reduced-level (org-outline-level)) ?\s))
|
||||
(head (buffer-substring (point) (line-end-position)))
|
||||
(inherited-tags
|
||||
(or (eq org-agenda-show-inherited-tags 'always)
|
||||
(and (listp org-agenda-show-inherited-tags)
|
||||
(memq 'agenda org-agenda-show-inherited-tags))
|
||||
(and (eq org-agenda-show-inherited-tags t)
|
||||
(or (eq org-agenda-use-tag-inheritance t)
|
||||
(memq 'agenda
|
||||
org-agenda-use-tag-inheritance)))))
|
||||
(tags (org-get-tags-at nil (not inherited-tags)))
|
||||
(timestr
|
||||
(if (string-match " \\([012]?[0-9]:[0-9][0-9]\\)" s)
|
||||
(concat (substring s (match-beginning 1)) " ")
|
||||
'time))
|
||||
(item
|
||||
(org-agenda-format-item
|
||||
;; For past deadlines, make sure to report time
|
||||
;; difference since date S, not since closest
|
||||
;; repeater.
|
||||
(let ((diff (if (< (org-today) current) diff
|
||||
(- deadline current))))
|
||||
(if (= diff 0) (car org-agenda-deadline-leaders)
|
||||
(let ((future (nth 1 org-agenda-deadline-leaders))
|
||||
(past (nth 2 org-agenda-deadline-leaders)))
|
||||
(cond ((> diff 0) (format future diff))
|
||||
((string= future past) (format past diff))
|
||||
(t (format past (abs diff)))))))
|
||||
head level category tags
|
||||
(and (= diff 0) timestr)))
|
||||
(face (org-agenda-deadline-face
|
||||
(- 1 (/ (float (- deadline current)) (max wdays 1)))))
|
||||
(upcomingp (and todayp (> diff 0)))
|
||||
(warntime (get-text-property (point) 'org-appt-warntime)))
|
||||
(org-add-props item props
|
||||
'org-marker (org-agenda-new-marker pos)
|
||||
'org-hd-marker (org-agenda-new-marker (line-beginning-position))
|
||||
'warntime warntime
|
||||
'level level
|
||||
'ts-date deadline
|
||||
'priority (- (org-get-priority item) diff)
|
||||
'todo-state todo-state
|
||||
'type (if upcomingp "upcoming-deadline" "deadline")
|
||||
'date (if upcomingp date deadline)
|
||||
'face (if donep 'org-agenda-done face)
|
||||
'undone-face face
|
||||
'done-face 'org-agenda-done)
|
||||
(push item deadline-items))))))
|
||||
(nreverse deadline-items)))
|
||||
|
||||
(defun org-agenda-deadline-face (fraction)
|
||||
"Return the face to displaying a deadline item.
|
||||
|
|
@ -6218,6 +6211,7 @@ scheduled items with an hour specification like [h]h:mm."
|
|||
(let* ((s (match-string 1))
|
||||
(pos (1- (match-beginning 1)))
|
||||
(todo-state (save-match-data (org-get-todo-state)))
|
||||
(donep (member todo-state org-done-keywords))
|
||||
(show-all (or (eq org-agenda-repeating-timestamp-show-all t)
|
||||
(member todo-state
|
||||
org-agenda-repeating-timestamp-show-all)))
|
||||
|
|
@ -6281,90 +6275,86 @@ scheduled items with an hour specification like [h]h:mm."
|
|||
;; Skip done habits, or tasks if
|
||||
;; `org-agenda-skip-deadline-if-done' is non-nil or if it
|
||||
;; was scheduled in the past anyway.
|
||||
(let ((donep (member todo-state org-done-keywords)))
|
||||
(when (and donep
|
||||
(or org-agenda-skip-scheduled-if-done
|
||||
(/= schedule current)
|
||||
habitp))
|
||||
(throw :skip nil))
|
||||
;; Skip entry if it already appears as a deadline, per
|
||||
;; `org-agenda-skip-scheduled-if-deadline-is-shown'. This
|
||||
;; doesn't apply to habits.
|
||||
(when (pcase org-agenda-skip-scheduled-if-deadline-is-shown
|
||||
((guard
|
||||
(or (not (assq (line-beginning-position 0) deadline-pos))
|
||||
habitp))
|
||||
nil)
|
||||
(`repeated-after-deadline
|
||||
(>= last-repeat
|
||||
(time-to-days (org-get-deadline-time (point)))))
|
||||
(`not-today pastschedp)
|
||||
(`t t)
|
||||
(_ nil))
|
||||
(throw :skip nil))
|
||||
;; Skip habits if `org-habit-show-habits' is nil, or if we
|
||||
;; only show them for today.
|
||||
(when (and habitp
|
||||
(or (not (bound-and-true-p org-habit-show-habits))
|
||||
(and (not todayp)
|
||||
(bound-and-true-p
|
||||
org-habit-show-habits-only-for-today))))
|
||||
(throw :skip nil))
|
||||
(save-excursion
|
||||
(re-search-backward "^\\*+[ \t]+" nil t)
|
||||
(goto-char (match-end 0))
|
||||
(let* ((category (org-get-category))
|
||||
(inherited-tags
|
||||
(or (eq org-agenda-show-inherited-tags 'always)
|
||||
(and (listp org-agenda-show-inherited-tags)
|
||||
(memq 'agenda org-agenda-show-inherited-tags))
|
||||
(and (eq org-agenda-show-inherited-tags t)
|
||||
(or (eq org-agenda-use-tag-inheritance t)
|
||||
(memq 'agenda
|
||||
org-agenda-use-tag-inheritance)))))
|
||||
(tags (org-get-tags-at nil (not inherited-tags)))
|
||||
(level
|
||||
(make-string (org-reduced-level (org-outline-level))
|
||||
?\s))
|
||||
(head (buffer-substring (point) (line-end-position)))
|
||||
(timestr
|
||||
(if (string-match " \\([012]?[0-9]:[0-9][0-9]\\)" s)
|
||||
(concat (substring s (match-beginning 1)) " ")
|
||||
'time))
|
||||
(item (org-agenda-format-item
|
||||
;; For past scheduled dates, make sure to
|
||||
;; report time difference since SCHEDULE,
|
||||
;; not since closest repeater.
|
||||
(let ((diff (if (< (org-today) current) diff
|
||||
(- schedule current))))
|
||||
(if (= diff 0) (car org-agenda-scheduled-leaders)
|
||||
(format (nth 1 org-agenda-scheduled-leaders)
|
||||
(- 1 diff))))
|
||||
head level category tags
|
||||
(and (= diff 0) timestr)
|
||||
nil habitp)))
|
||||
(when item
|
||||
(let ((face (cond ((and (not habitp) pastschedp)
|
||||
'org-scheduled-previously)
|
||||
(todayp 'org-scheduled-today)
|
||||
(t 'org-scheduled)))
|
||||
(habitp (and habitp (org-habit-parse-todo))))
|
||||
(org-add-props item props
|
||||
'undone-face face
|
||||
'face (if donep 'org-agenda-done face)
|
||||
'org-marker (org-agenda-new-marker pos)
|
||||
'org-hd-marker (org-agenda-new-marker
|
||||
(line-beginning-position))
|
||||
'type (if pastschedp "past-scheduled" "scheduled")
|
||||
'date (if pastschedp schedule date)
|
||||
'ts-date schedule
|
||||
'warntime warntime
|
||||
'level level
|
||||
'priority (if habitp (org-habit-get-priority habitp)
|
||||
(+ 94 (- 5 diff) (org-get-priority item)))
|
||||
'org-habit-p habitp
|
||||
'todo-state todo-state))
|
||||
(push item scheduled-items))))))))
|
||||
(when (and donep
|
||||
(or org-agenda-skip-scheduled-if-done
|
||||
(/= schedule current)
|
||||
habitp))
|
||||
(throw :skip nil))
|
||||
;; Skip entry if it already appears as a deadline, per
|
||||
;; `org-agenda-skip-scheduled-if-deadline-is-shown'. This
|
||||
;; doesn't apply to habits.
|
||||
(when (pcase org-agenda-skip-scheduled-if-deadline-is-shown
|
||||
((guard
|
||||
(or (not (assq (line-beginning-position 0) deadline-pos))
|
||||
habitp))
|
||||
nil)
|
||||
(`repeated-after-deadline
|
||||
(>= last-repeat
|
||||
(time-to-days (org-get-deadline-time (point)))))
|
||||
(`not-today pastschedp)
|
||||
(`t t)
|
||||
(_ nil))
|
||||
(throw :skip nil))
|
||||
;; Skip habits if `org-habit-show-habits' is nil, or if we
|
||||
;; only show them for today.
|
||||
(when (and habitp
|
||||
(or (not (bound-and-true-p org-habit-show-habits))
|
||||
(and (not todayp)
|
||||
(bound-and-true-p
|
||||
org-habit-show-habits-only-for-today))))
|
||||
(throw :skip nil))
|
||||
(save-excursion
|
||||
(re-search-backward "^\\*+[ \t]+" nil t)
|
||||
(goto-char (match-end 0))
|
||||
(let* ((category (org-get-category))
|
||||
(inherited-tags
|
||||
(or (eq org-agenda-show-inherited-tags 'always)
|
||||
(and (listp org-agenda-show-inherited-tags)
|
||||
(memq 'agenda org-agenda-show-inherited-tags))
|
||||
(and (eq org-agenda-show-inherited-tags t)
|
||||
(or (eq org-agenda-use-tag-inheritance t)
|
||||
(memq 'agenda
|
||||
org-agenda-use-tag-inheritance)))))
|
||||
(tags (org-get-tags-at nil (not inherited-tags)))
|
||||
(level
|
||||
(make-string (org-reduced-level (org-outline-level)) ?\s))
|
||||
(head (buffer-substring (point) (line-end-position)))
|
||||
(timestr
|
||||
(if (string-match " \\([012]?[0-9]:[0-9][0-9]\\)" s)
|
||||
(concat (substring s (match-beginning 1)) " ")
|
||||
'time))
|
||||
(item (org-agenda-format-item
|
||||
;; For past scheduled dates, make sure to
|
||||
;; report time difference since SCHEDULE,
|
||||
;; not since closest repeater.
|
||||
(let ((diff (if (< (org-today) current) diff
|
||||
(- schedule current))))
|
||||
(if (= diff 0) (car org-agenda-scheduled-leaders)
|
||||
(format (nth 1 org-agenda-scheduled-leaders)
|
||||
(- 1 diff))))
|
||||
head level category tags
|
||||
(and (= diff 0) timestr)
|
||||
nil habitp))
|
||||
(face (cond ((and (not habitp) pastschedp)
|
||||
'org-scheduled-previously)
|
||||
(todayp 'org-scheduled-today)
|
||||
(t 'org-scheduled)))
|
||||
(habitp (and habitp (org-habit-parse-todo))))
|
||||
(org-add-props item props
|
||||
'undone-face face
|
||||
'face (if donep 'org-agenda-done face)
|
||||
'org-marker (org-agenda-new-marker pos)
|
||||
'org-hd-marker (org-agenda-new-marker (line-beginning-position))
|
||||
'type (if pastschedp "past-scheduled" "scheduled")
|
||||
'date (if pastschedp schedule date)
|
||||
'ts-date schedule
|
||||
'warntime warntime
|
||||
'level level
|
||||
'priority (if habitp (org-habit-get-priority habitp)
|
||||
(+ 94 (- 5 diff) (org-get-priority item)))
|
||||
'org-habit-p habitp
|
||||
'todo-state todo-state)
|
||||
(push item scheduled-items))))))
|
||||
(nreverse scheduled-items)))
|
||||
|
||||
(defun org-agenda-get-blocks ()
|
||||
|
|
|
|||
Loading…
Reference in New Issue