summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorNicolas Goaziou <mail@nicolasgoaziou.fr>2016-11-25 01:51:42 +0100
committerNicolas Goaziou <mail@nicolasgoaziou.fr>2016-11-25 01:51:42 +0100
commit69ec6258b65a5d317f0dcb275ec2d5a90f72f191 (patch)
treef3b8aca184be35f7fd8c7f75511eef7501b7eb88
parent0dd024aa92a282ce28cd15ebd091b2f2b211a948 (diff)
downloadorg-mode-69ec6258b65a5d317f0dcb275ec2d5a90f72f191.tar.gz
org-agenda: Fix scheduled dates display
* lisp/org.el (org-time-string-to-absolute): Change signature. * lisp/org-agenda.el (org-agenda-get-scheduled): Fix various glitches in scheduled dates display. Also fix such dates when `org-agenda-repeating-timestamp-show-all' is nil. Apply signature change. Reported-by: Samuel Wales <samologist@gmail.com> <http://permalink.gmane.org/gmane.emacs.orgmode/110116>
-rw-r--r--lisp/org-agenda.el114
-rw-r--r--lisp/org.el4
2 files changed, 61 insertions, 57 deletions
diff --git a/lisp/org-agenda.el b/lisp/org-agenda.el
index 0a10bba..fd6d82e 100644
--- a/lisp/org-agenda.el
+++ b/lisp/org-agenda.el
@@ -6174,11 +6174,12 @@ scheduled items with an hour specification like [h]h:mm."
'done-face 'org-agenda-done
'mouse-face 'highlight
'help-echo
- (format "mouse-2 or RET jump to org file %s"
+ (format "mouse-2 or RET jump to Org file %s"
(abbreviate-file-name buffer-file-name))))
(regexp (if with-hour
org-scheduled-time-hour-regexp
org-scheduled-time-regexp))
+ (today (org-today))
(todayp (org-agenda-today-p date)) ; DATE bound by calendar.
(current (calendar-absolute-from-gregorian date))
(deadline-pos
@@ -6199,16 +6200,22 @@ scheduled items with an hour specification like [h]h:mm."
(show-all (or (eq org-agenda-repeating-timestamp-show-all t)
(member todo-state
org-agenda-repeating-timestamp-show-all)))
- ;; SCHEDULE 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 SCHEDULE.
- (last-repeat (org-agenda--timestamp-to-absolute
- s current 'past show-all (current-buffer) pos))
- (schedule (org-agenda--timestamp-to-absolute s current))
- (diff (- last-repeat current))
+ ;; SCHEDULE is the bare scheduled date, i.e., without
+ ;; any repeater. REPEAT is the closest repeat after
+ ;; CURRENT, if all repeated time stamps are to be
+ ;; shown, or after TODAY otherwise. REPEAT only
+ ;; applies to future dates.
+ (schedule (org-agenda--timestamp-to-absolute s))
+ (repeat (cond ((< current today) schedule)
+ (show-all
+ (org-agenda--timestamp-to-absolute
+ s current 'future (current-buffer) pos))
+ (t
+ (org-agenda--timestamp-to-absolute
+ s today 'future (current-buffer) pos))))
+ (diff (- current schedule))
(warntime (get-text-property (point) 'org-appt-warntime))
- (pastschedp (< schedule (org-today)))
+ (pastschedp (< schedule today))
(habitp (and (fboundp 'org-is-habit-p) (org-is-habit-p)))
(suppress-delay
(let ((deadline (and org-agenda-skip-scheduled-delay-if-deadline
@@ -6225,44 +6232,35 @@ scheduled items with an hour specification like [h]h:mm."
;; Set delay to no later than DEADLINE. If
;; DEADLINE has a repeater, compare last schedule
;; repeat and last deadline repeat.
- (min (- last-repeat
- (org-agenda--timestamp-to-absolute
- deadline current 'past show-all
- (current-buffer)
- (save-excursion
- (beginning-of-line)
- (1+ (search-forward org-deadline-string)))))
- org-scheduled-delay-days))
+ (min (- schedule deadline) org-scheduled-delay-days))
(t 0))))
(ddays
(cond
;; Nullify delay when a repeater triggered already
;; and the delay is of the form --Xd.
((and (string-match-p "--[0-9]+[hdwmy]" s)
- (/= schedule last-repeat))
+ (> current schedule))
0)
(suppress-delay
(let ((org-scheduled-delay-days suppress-delay))
(org-get-wdays s t t)))
(t (org-get-wdays s t)))))
- ;; Only show a scheduled item in the calendar if it is on or
- ;; past the current date. Skip it if it has been displayed
- ;; for more than `org-scheduled-past-days'.
- (unless (or (and (>= ddays 0) (= diff (- ddays)))
- (and (< (+ diff ddays) 0)
- (< (abs diff) org-scheduled-past-days)
- (and todayp (not org-agenda-only-exact-dates)))
- (and todayp
- habitp
- (bound-and-true-p org-habit-show-all-today)))
- (throw :skip nil))
- ;; Skip done habits, or tasks if
- ;; `org-agenda-skip-deadline-if-done' is non-nil or if it
- ;; was scheduled in the past anyway.
- (when (and donep
- (or org-agenda-skip-scheduled-if-done
- (/= schedule current)
- habitp))
+ ;; Display scheduled items at base date (SCHEDULE), today if
+ ;; scheduled before the current date, and at any repeat past
+ ;; today. However, skip delayed items and items that have
+ ;; been displayed for more than `org-scheduled-past-days'.
+ (unless (and todayp
+ habitp
+ (bound-and-true-p org-habit-show-all-today))
+ (when (or (and (> ddays 0) (< diff ddays))
+ (> diff org-scheduled-past-days)
+ (> schedule current)
+ (and (< schedule current)
+ (not todayp)
+ (/= repeat current)))
+ (throw :skip nil)))
+ ;; Possibly skip done tasks.
+ (when (and donep org-agenda-skip-scheduled-if-done)
(throw :skip nil))
;; Skip entry if it already appears as a deadline, per
;; `org-agenda-skip-scheduled-if-deadline-is-shown'. This
@@ -6273,16 +6271,16 @@ scheduled items with an hour specification like [h]h:mm."
habitp))
nil)
(`repeated-after-deadline
- (>= last-repeat
- (time-to-days (org-get-deadline-time (point)))))
+ (>= 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.
+ ;; only show them for today. Also skip done habits.
(when (and habitp
- (or (not (bound-and-true-p org-habit-show-habits))
+ (or donep
+ (not (bound-and-true-p org-habit-show-habits))
(and (not todayp)
(bound-and-true-p
org-habit-show-habits-only-for-today))))
@@ -6307,19 +6305,25 @@ scheduled items with an hour specification like [h]h:mm."
(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)
+ (item
+ (org-agenda-format-item
+ (pcase-let ((`(,first ,next) org-agenda-scheduled-leaders))
+ (cond
+ ;; If CURRENT is in the future, don't use past
+ ;; scheduled prefix.
+ ((> current today) first)
+ ;; SHOW-ALL focuses on future repeats. If one
+ ;; such repeat happens today, ignore late
+ ;; schedule reminder. However, still report
+ ;; such reminders when repeat happens later.
+ ((and (not show-all) (= repeat today)) first)
+ ;; Initial report.
+ ((= schedule current) first)
+ ;; Subsequent reminders. Count from base
+ ;; schedule.
+ (t (format next (1+ diff)))))
+ head level category tags timestr nil habitp))
+ (face (cond ((and (not habitp) (< current today))
'org-scheduled-previously)
(todayp 'org-scheduled-today)
(t 'org-scheduled)))
@@ -6335,7 +6339,7 @@ scheduled items with an hour specification like [h]h:mm."
'warntime warntime
'level level
'priority (if habitp (org-habit-get-priority habitp)
- (+ 94 (- 5 diff) (org-get-priority item)))
+ (+ 99 diff (org-get-priority item)))
'org-habit-p habitp
'todo-state todo-state)
(push item scheduled-items))))))
diff --git a/lisp/org.el b/lisp/org.el
index 1a2bf7a..d791bd9 100644
--- a/lisp/org.el
+++ b/lisp/org.el
@@ -17802,7 +17802,7 @@ days in order to avoid rounding problems."
(org-define-error 'org-diary-sexp-no-match "Unable to match diary sexp")
-(defun org-time-string-to-absolute (s &optional daynr prefer show-all buffer pos)
+(defun org-time-string-to-absolute (s &optional daynr prefer buffer pos)
"Convert time stamp S to an absolute day number.
If DAYNR in non-nil, and there is a specifier for a cyclic time
@@ -17826,7 +17826,7 @@ signalled."
(match-string 1 s) "" (calendar-gregorian-from-absolute daynr)))
daynr
(signal 'org-diary-sexp-no-match (list s))))
- ((and daynr show-all) (org-closest-date s daynr prefer))
+ (daynr (org-closest-date s daynr prefer))
(t (time-to-days
(condition-case errdata
(apply #'encode-time (org-parse-time-string s))