* org-agenda (org-agenda-today): New function.
(org-agenda-get-day-face): New function.
(org-timeline): Use org-agenda-today and org-agenda-get-day-face.
(org-agenda-list): Use org-agenda-today and org-agenda-get-day-face.
(org-todo-list): Use org-agenda-today.
(org-get-all-dates): Use org-agenda-today.
Signed-off-by: Julien Danjou <jul...@danjou.info>
---
lisp/org-agenda.el | 65 ++++++++++++++++++++++++++-------------------------
1 files changed, 33 insertions(+), 32 deletions(-)
diff --git a/lisp/org-agenda.el b/lisp/org-agenda.el
index 583e670..98371e6 100644
--- a/lisp/org-agenda.el
+++ b/lisp/org-agenda.el
@@ -3106,6 +3106,14 @@ no longer in use."
(progn (delete-overlay o) t)))
(overlays-in (point-min) (point-max)))))
+(defun org-agenda-get-day-face (date)
+ "Return the face DATE should be displayed with."
+ (cond ((org-agenda-todayp date)
+ 'org-agenda-date-today)
+ ((member (calendar-day-of-week date) org-agenda-weekend-days)
+ 'org-agenda-date-weekend)
+ (t 'org-agenda-date)))
+
;;; Agenda timeline
(defvar org-agenda-only-exact-dates nil) ; dynamically scoped
@@ -3133,10 +3141,10 @@ dates."
org-timeline-show-empty-dates))
(org-deadline-warning-days 0)
(org-agenda-only-exact-dates t)
- (today (time-to-days (current-time)))
+ (today (org-agenda-today))
(past t)
args
- s e rtn d emptyp wd)
+ s e rtn d emptyp)
(setq org-agenda-redo-command
(list 'progn
(list 'org-switch-to-buffer-other-window (current-buffer))
@@ -3170,8 +3178,7 @@ dates."
(progn
(setq past nil)
(insert (make-string 79 ?-) "\n")))
- (setq date (calendar-gregorian-from-absolute d)
- wd (calendar-day-of-week date))
+ (setq date (calendar-gregorian-from-absolute d))
(setq s (point))
(setq rtn (and (not emptyp)
(apply 'org-agenda-get-day-entries entry
@@ -3185,9 +3192,7 @@ dates."
(funcall org-agenda-format-date date))
"\n")
(put-text-property s (1- (point)) 'face
- (if (member wd org-agenda-weekend-days)
- 'org-agenda-date-weekend
- 'org-agenda-date))
+ (org-agenda-get-day-face date))
(put-text-property s (1- (point)) 'org-date-line t)
(put-text-property s (1- (point)) 'org-agenda-date-header t)
(if (equal d today)
@@ -3213,7 +3218,7 @@ When EMPTY is non-nil, also include days without any
entries."
(if inactive org-ts-regexp-both org-ts-regexp)))
dates dates1 date day day1 day2 ts1 ts2)
(if force-today
- (setq dates (list (time-to-days (current-time)))))
+ (setq dates (list (org-agenda-today))))
(save-excursion
(goto-char beg)
(while (re-search-forward re end t)
@@ -3324,9 +3329,7 @@ given in `org-agenda-start-on-weekday'."
org-agenda-start-on-weekday nil))
(thefiles (org-agenda-files nil 'ifmode))
(files thefiles)
- (today (time-to-days
- (time-subtract (current-time)
- (list 0 (* 3600 org-extend-today-until) 0))))
+ (today (org-agenda-today))
(sd (or start-day today))
(start (if (or (null org-agenda-start-on-weekday)
(< org-agenda-ndays 7))
@@ -3339,7 +3342,7 @@ given in `org-agenda-start-on-weekday'."
(day-numbers (list start))
(day-cnt 0)
(inhibit-redisplay (not debug-on-error))
- s e rtn rtnall file date d start-pos end-pos todayp nd wd
+ s e rtn rtnall file date d start-pos end-pos todayp nd
clocktable-start clocktable-end filter)
(setq org-agenda-redo-command
(list 'org-agenda-list (list 'quote include-all) start-day ndays))
@@ -3397,7 +3400,6 @@ given in `org-agenda-start-on-weekday'."
(org-agenda-mark-header-line s))
(while (setq d (pop day-numbers))
(setq date (calendar-gregorian-from-absolute d)
- wd (calendar-day-of-week date)
s (point))
(if (or (setq todayp (= d today))
(and (not start-pos) (= d sd)))
@@ -3441,15 +3443,12 @@ given in `org-agenda-start-on-weekday'."
(funcall org-agenda-format-date date))
"\n")
(put-text-property s (1- (point)) 'face
- (if (member wd org-agenda-weekend-days)
- 'org-agenda-date-weekend
- 'org-agenda-date))
+ (org-agenda-get-day-face date))
(put-text-property s (1- (point)) 'org-date-line t)
(put-text-property s (1- (point)) 'org-agenda-date-header t)
(put-text-property s (1- (point)) 'org-day-cnt day-cnt)
(when todayp
- (put-text-property s (1- (point)) 'org-today t)
- (put-text-property s (1- (point)) 'face 'org-agenda-date-today))
+ (put-text-property s (1- (point)) 'org-today t))
(if rtnall (insert
(org-finalize-agenda-entries
(org-agenda-add-time-grid-maybe
@@ -3773,7 +3772,7 @@ for a keyword. A numeric prefix directly selects the Nth
keyword in
(org-set-sorting-strategy 'todo)
(org-prepare-agenda "TODO")
(if (and (stringp arg) (not (string-match "\\S-" arg))) (setq arg nil))
- (let* ((today (time-to-days (current-time)))
+ (let* ((today (org-agenda-today))
(date (calendar-gregorian-from-absolute today))
(kwds org-todo-keywords-for-agenda)
(completion-ignore-case t)
@@ -5902,9 +5901,7 @@ Negative selection means regexp must not match for
selection of an entry."
(cond
(tdpos (goto-char tdpos))
((eq org-agenda-type 'agenda)
- (let* ((sd (time-to-days
- (time-subtract (current-time)
- (list 0 (* 3600 org-extend-today-until) 0))))
+ (let* ((sd (org-agenda-today))
(comp (org-agenda-compute-time-span sd org-agenda-span))
(org-agenda-overriding-arguments org-agenda-last-arguments))
(setf (nth 1 org-agenda-overriding-arguments) (car comp))
@@ -6712,8 +6709,7 @@ the same tree node, and the headline of the tree node in
the Org-mode file."
(buffer (marker-buffer marker))
(pos (marker-position marker))
(hdmarker (org-get-at-bol 'org-hd-marker))
- (todayp (equal (org-get-at-bol 'day)
- (time-to-days (current-time))))
+ (todayp (org-agenda-todayp (org-get-at-bol 'day)))
(inhibit-read-only t)
org-agenda-headline-snapshot-before-repeat newhead just-one)
(org-with-remote-undo buffer
@@ -7862,6 +7858,9 @@ belonging to the \"Work\" category."
(let* ((cnt 0) ; count added events
(org-agenda-new-buffers nil)
(org-deadline-warning-days 0)
+ ;; Do not use `org-agenda-today' here because appt only takes
+ ;; time and without date as argument, so it may pass wrong
+ ;; information otherwise
(today (org-date-to-gregorian
(time-to-days (current-time))))
(org-agenda-restrict nil)
@@ -7902,16 +7901,18 @@ belonging to the \"Work\" category."
(message "No event to add")
(message "Added %d event%s for today" cnt (if (> cnt 1) "s" "")))))
+(defun org-agenda-today ()
+ "Return today date, considering `org-extend-today-until'."
+ (time-to-days
+ (time-subtract (current-time)
+ (list 0 (* 3600 org-extend-today-until) 0))))
+
(defun org-agenda-todayp (date)
"Does DATE mean today, when considering `org-extend-today-until'?"
- (let (today h)
- (if (listp date) (setq date (calendar-absolute-from-gregorian date)))
- (setq today (calendar-absolute-from-gregorian (calendar-current-date)))
- (setq h (nth 2 (decode-time (current-time))))
- (or (and (>= h org-extend-today-until)
- (= date today))
- (and (< h org-extend-today-until)
- (= date (1- today))))))
+ (let ((today (org-agenda-today))
+ (date (if (listp date) (calendar-absolute-from-gregorian date)
+ date)))
+ (eq date today)))
(provide 'org-agenda)
--
1.7.2.3
_______________________________________________
Emacs-orgmode mailing list
Please use `Reply All' to send replies to the list.
Emacs-orgmode@gnu.org
http://lists.gnu.org/mailman/listinfo/emacs-orgmode
