From mboxrd@z Thu Jan 1 00:00:00 1970 From: Julien Danjou Subject: [PATCH 1/2] org-agenda: introduce org-agenda-today and org-agenda-get-day-face Date: Mon, 8 Nov 2010 18:23:06 +0100 Message-ID: <1289236987-21552-1-git-send-email-julien@danjou.info> Return-path: Received: from [140.186.70.92] (port=52059 helo=eggs.gnu.org) by lists.gnu.org with esmtp (Exim 4.43) id 1PFVSP-0000we-Cm for emacs-orgmode@gnu.org; Mon, 08 Nov 2010 12:24:40 -0500 Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1PFVR1-0003xQ-Rf for emacs-orgmode@gnu.org; Mon, 08 Nov 2010 12:23:13 -0500 Received: from coquelicot-s.easter-eggs.com ([213.215.37.94]:47025) by eggs.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1PFVR1-0003wx-Fj for emacs-orgmode@gnu.org; Mon, 08 Nov 2010 12:23:11 -0500 List-Id: "General discussions about Org-mode." List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Sender: emacs-orgmode-bounces+geo-emacs-orgmode=m.gmane.org@gnu.org Errors-To: emacs-orgmode-bounces+geo-emacs-orgmode=m.gmane.org@gnu.org To: emacs-orgmode@gnu.org Cc: Julien Danjou * 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 --- 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