* [PATCH 1/2] org-agenda: introduce org-agenda-today and org-agenda-get-day-face
@ 2010-11-08 17:23 Julien Danjou
2010-11-08 17:23 ` [PATCH 2/2] org-agenda: add org-agenda-day-face-function Julien Danjou
` (2 more replies)
0 siblings, 3 replies; 10+ messages in thread
From: Julien Danjou @ 2010-11-08 17:23 UTC (permalink / raw)
To: emacs-orgmode; +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 <julien@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
^ permalink raw reply related [flat|nested] 10+ messages in thread* [PATCH 2/2] org-agenda: add org-agenda-day-face-function 2010-11-08 17:23 [PATCH 1/2] org-agenda: introduce org-agenda-today and org-agenda-get-day-face Julien Danjou @ 2010-11-08 17:23 ` Julien Danjou 2010-11-12 15:30 ` Carsten Dominik 2010-11-08 18:34 ` [PATCH 1/2] org-agenda: introduce org-agenda-today and org-agenda-get-day-face Carsten Dominik 2010-11-09 10:59 ` Julien Danjou 2 siblings, 1 reply; 10+ messages in thread From: Julien Danjou @ 2010-11-08 17:23 UTC (permalink / raw) To: emacs-orgmode; +Cc: Julien Danjou * lisp/org-agenda.el (org-agenda-day-face-function): New variable. (org-agenda-get-day-face): Use org-agenda-day-face-function. Signed-off-by: Julien Danjou <julien@danjou.info> --- lisp/org-agenda.el | 20 +++++++++++++++----- 1 files changed, 15 insertions(+), 5 deletions(-) diff --git a/lisp/org-agenda.el b/lisp/org-agenda.el index 98371e6..ffd6c90 100644 --- a/lisp/org-agenda.el +++ b/lisp/org-agenda.el @@ -1433,6 +1433,14 @@ determines if it is a foreground or a background color." (string :tag "Color") (sexp :tag "Face")))))) +(defcustom org-agenda-day-face-function nil + "Function called to determine what face should be used to display a day. +The only argument passed to that function is the day. It should +returns a face, or nil if does not want to specify a face and let +the normal rules apply." + :group 'org-agenda-line-format + :type 'function) + (defcustom org-agenda-category-icon-alist nil "Alist of category icon to be displayed in agenda views. @@ -3108,11 +3116,13 @@ no longer in use." (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))) + (or (and (functionp org-agenda-day-face-function) + (funcall org-agenda-day-face-function date)) + (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 -- 1.7.2.3 ^ permalink raw reply related [flat|nested] 10+ messages in thread
* Re: [PATCH 2/2] org-agenda: add org-agenda-day-face-function 2010-11-08 17:23 ` [PATCH 2/2] org-agenda: add org-agenda-day-face-function Julien Danjou @ 2010-11-12 15:30 ` Carsten Dominik 2010-11-12 15:34 ` Julien Danjou 0 siblings, 1 reply; 10+ messages in thread From: Carsten Dominik @ 2010-11-12 15:30 UTC (permalink / raw) To: Julien Danjou; +Cc: emacs-orgmode Hi Julien, to make sure I don't make a mistake here, could you please send a new patch which contains all the changes in a single patch. Sorry about this. - Carsten On Nov 8, 2010, at 11:23 AM, Julien Danjou wrote: > * lisp/org-agenda.el (org-agenda-day-face-function): New variable. > (org-agenda-get-day-face): Use org-agenda-day-face-function. > > Signed-off-by: Julien Danjou <julien@danjou.info> > --- > lisp/org-agenda.el | 20 +++++++++++++++----- > 1 files changed, 15 insertions(+), 5 deletions(-) > > diff --git a/lisp/org-agenda.el b/lisp/org-agenda.el > index 98371e6..ffd6c90 100644 > --- a/lisp/org-agenda.el > +++ b/lisp/org-agenda.el > @@ -1433,6 +1433,14 @@ determines if it is a foreground or a > background color." > (string :tag "Color") > (sexp :tag "Face")))))) > > +(defcustom org-agenda-day-face-function nil > + "Function called to determine what face should be used to display > a day. > +The only argument passed to that function is the day. It should > +returns a face, or nil if does not want to specify a face and let > +the normal rules apply." > + :group 'org-agenda-line-format > + :type 'function) > + > (defcustom org-agenda-category-icon-alist nil > "Alist of category icon to be displayed in agenda views. > > @@ -3108,11 +3116,13 @@ no longer in use." > > (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))) > + (or (and (functionp org-agenda-day-face-function) > + (funcall org-agenda-day-face-function date)) > + (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 > > -- > 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 ^ permalink raw reply [flat|nested] 10+ messages in thread
* Re: [PATCH 2/2] org-agenda: add org-agenda-day-face-function 2010-11-12 15:30 ` Carsten Dominik @ 2010-11-12 15:34 ` Julien Danjou 2010-11-12 15:43 ` Carsten Dominik 0 siblings, 1 reply; 10+ messages in thread From: Julien Danjou @ 2010-11-12 15:34 UTC (permalink / raw) To: Carsten Dominik; +Cc: emacs-orgmode [-- Attachment #1: Type: text/plain, Size: 223 bytes --] On Fri, Nov 12 2010, Carsten Dominik wrote: > to make sure I don't make a mistake here, could you please send a new patch > which contains all the changes in a single patch. > > Sorry about this. No problem, here it is. [-- Warning: decoded text below may be mangled, UTF-8 assumed --] [-- Attachment #2: 0001-org-agenda-introduce-org-agenda-today-org-agenda-get.patch --] [-- Type: text/x-diff, Size: 8605 bytes --] From 38567a7d7a58e523964be216f791e4c78a085c52 Mon Sep 17 00:00:00 2001 From: Julien Danjou <julien@danjou.info> Date: Mon, 8 Nov 2010 15:25:22 +0100 Subject: [PATCH] org-agenda: introduce org-agenda-today, org-agenda-get-day-face and org-agenda-day-face-function * lisp/org-agenda.el (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. (org-agenda-day-face-function): New variable. (org-agenda-get-day-face): Use org-agenda-day-face-function. Signed-off-by: Julien Danjou <julien@danjou.info> --- lisp/org-agenda.el | 75 +++++++++++++++++++++++++++++---------------------- 1 files changed, 43 insertions(+), 32 deletions(-) diff --git a/lisp/org-agenda.el b/lisp/org-agenda.el index 583e670..e2d20b5 100644 --- a/lisp/org-agenda.el +++ b/lisp/org-agenda.el @@ -1433,6 +1433,14 @@ determines if it is a foreground or a background color." (string :tag "Color") (sexp :tag "Face")))))) +(defcustom org-agenda-day-face-function nil + "Function called to determine what face should be used to display a day. +The only argument passed to that function is the day. It should +returns a face, or nil if does not want to specify a face and let +the normal rules apply." + :group 'org-agenda-line-format + :type 'function) + (defcustom org-agenda-category-icon-alist nil "Alist of category icon to be displayed in agenda views. @@ -3106,6 +3114,16 @@ 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." + (or (and (functionp org-agenda-day-face-function) + (funcall org-agenda-day-face-function date)) + (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 +3151,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 +3188,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 +3202,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 +3228,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 +3339,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 +3352,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 +3410,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 +3453,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 +3782,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 +5911,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 +6719,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 +7868,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 +7911,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 (and date (listp date)) (calendar-absolute-from-gregorian date) + date))) + (eq date today))) (provide 'org-agenda) -- 1.7.2.3 [-- Attachment #3: Type: text/plain, Size: 79 bytes --] -- Julien Danjou // ᐰ <julien@danjou.info> http://julien.danjou.info [-- Attachment #4: Type: text/plain, Size: 201 bytes --] _______________________________________________ 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 ^ permalink raw reply related [flat|nested] 10+ messages in thread
* Re: [PATCH 2/2] org-agenda: add org-agenda-day-face-function 2010-11-12 15:34 ` Julien Danjou @ 2010-11-12 15:43 ` Carsten Dominik 2010-11-12 15:50 ` Julien Danjou 0 siblings, 1 reply; 10+ messages in thread From: Carsten Dominik @ 2010-11-12 15:43 UTC (permalink / raw) To: Julien Danjou; +Cc: emacs-orgmode Applied, thanks. I did not test it myself (have grown to trust Julien...), so if someone can put this to a test, that would be nice. Cheers - Carsten On Nov 12, 2010, at 9:34 AM, Julien Danjou wrote: > On Fri, Nov 12 2010, Carsten Dominik wrote: > >> to make sure I don't make a mistake here, could you please send a >> new patch >> which contains all the changes in a single patch. >> >> Sorry about this. > > No problem, here it is. > > From 38567a7d7a58e523964be216f791e4c78a085c52 Mon Sep 17 00:00:00 2001 > From: Julien Danjou <julien@danjou.info> > Date: Mon, 8 Nov 2010 15:25:22 +0100 > Subject: [PATCH] org-agenda: introduce org-agenda-today, org-agenda- > get-day-face and org-agenda-day-face-function > > * lisp/org-agenda.el (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. > (org-agenda-day-face-function): New variable. > (org-agenda-get-day-face): Use org-agenda-day-face-function. > > Signed-off-by: Julien Danjou <julien@danjou.info> > --- > lisp/org-agenda.el | 75 ++++++++++++++++++++++++++++ > +---------------------- > 1 files changed, 43 insertions(+), 32 deletions(-) > > diff --git a/lisp/org-agenda.el b/lisp/org-agenda.el > index 583e670..e2d20b5 100644 > --- a/lisp/org-agenda.el > +++ b/lisp/org-agenda.el > @@ -1433,6 +1433,14 @@ determines if it is a foreground or a > background color." > (string :tag "Color") > (sexp :tag "Face")))))) > > +(defcustom org-agenda-day-face-function nil > + "Function called to determine what face should be used to display > a day. > +The only argument passed to that function is the day. It should > +returns a face, or nil if does not want to specify a face and let > +the normal rules apply." > + :group 'org-agenda-line-format > + :type 'function) > + > (defcustom org-agenda-category-icon-alist nil > "Alist of category icon to be displayed in agenda views. > > @@ -3106,6 +3114,16 @@ 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." > + (or (and (functionp org-agenda-day-face-function) > + (funcall org-agenda-day-face-function date)) > + (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 +3151,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 +3188,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 +3202,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 +3228,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 +3339,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 +3352,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 +3410,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 +3453,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 +3782,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 +5911,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 +6719,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 +7868,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 +7911,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 (and date (listp date)) (calendar-absolute-from- > gregorian date) > + date))) > + (eq date today))) > > (provide 'org-agenda) > > -- > 1.7.2.3 > > > -- > Julien Danjou > // ᐰ <julien@danjou.info> http://julien.danjou.info ^ permalink raw reply [flat|nested] 10+ messages in thread
* Re: [PATCH 2/2] org-agenda: add org-agenda-day-face-function 2010-11-12 15:43 ` Carsten Dominik @ 2010-11-12 15:50 ` Julien Danjou 0 siblings, 0 replies; 10+ messages in thread From: Julien Danjou @ 2010-11-12 15:50 UTC (permalink / raw) To: Carsten Dominik; +Cc: emacs-orgmode On Fri, Nov 12 2010, Carsten Dominik wrote: > Applied, thanks. > > I did not test it myself (have grown to trust Julien...), so if someone can > put this to a test, that would be nice. Thanks Carsten. If people wants to try it, here's an example of what I'm using to mark days as holidays using the weekend face. The function tests the category of all entries from all my Org files, and if the category is "Holidays" or "Vacation", I return the face used for weekend days. With that I quickly see I can stay at home and hack on org-mode. :-) (setq org-agenda-day-face-function (defun jd:org-agenda-day-face-holidays-function (date) "Compute DATE face for holidays." (unless (org-agenda-todayp date) (dolist (file (org-agenda-files nil 'ifmode)) (let ((face (dolist (entry (org-agenda-get-day-entries file date)) (let ((category (with-temp-buffer (insert entry) (org-get-category (point-min))))) (when (or (string= "Holidays" category) (string= "Vacation" category)) (return 'org-agenda-date-weekend)))))) (when face (return face))))))) -- Julien Danjou // ᐰ <julien@danjou.info> http://julien.danjou.info ^ permalink raw reply [flat|nested] 10+ messages in thread
* Re: [PATCH 1/2] org-agenda: introduce org-agenda-today and org-agenda-get-day-face 2010-11-08 17:23 [PATCH 1/2] org-agenda: introduce org-agenda-today and org-agenda-get-day-face Julien Danjou 2010-11-08 17:23 ` [PATCH 2/2] org-agenda: add org-agenda-day-face-function Julien Danjou @ 2010-11-08 18:34 ` Carsten Dominik 2010-11-08 19:28 ` Julien Danjou 2010-11-09 10:59 ` Julien Danjou 2 siblings, 1 reply; 10+ messages in thread From: Carsten Dominik @ 2010-11-08 18:34 UTC (permalink / raw) To: Julien Danjou; +Cc: emacs-orgmode Hi Julien, can you please rename org-agenda-today to org-agenda-today-p? I think it would make its use clearer. Also, couly you please specify in the docstring of org-agenda-day-face- function how the day is coming in into the user-defined function? As a day number or a calendar date list? As far as I can see, we can merge this change after these fixes. Thanks. - Carsten On Nov 8, 2010, at 11:23 AM, Julien Danjou wrote: > * 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 <julien@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 ^ permalink raw reply [flat|nested] 10+ messages in thread
* Re: [PATCH 1/2] org-agenda: introduce org-agenda-today and org-agenda-get-day-face 2010-11-08 18:34 ` [PATCH 1/2] org-agenda: introduce org-agenda-today and org-agenda-get-day-face Carsten Dominik @ 2010-11-08 19:28 ` Julien Danjou 2010-11-08 19:59 ` Carsten Dominik 0 siblings, 1 reply; 10+ messages in thread From: Julien Danjou @ 2010-11-08 19:28 UTC (permalink / raw) To: Carsten Dominik; +Cc: emacs-orgmode [-- Attachment #1: Type: text/plain, Size: 527 bytes --] On Mon, Nov 08 2010, Carsten Dominik wrote: > can you please rename org-agenda-today to org-agenda-today-p? > I think it would make its use clearer. I think you misread the function. I've added org-agenda-today which returns today, and just rewrite org-agenda-todayp to use that one. > Also, couly you please specify in the docstring of org-agenda-day-face- > function how the day is coming in into the user-defined function? As a day > number or a calendar date list? It's a calendar date list. Updated patch attached. [-- Warning: decoded text below may be mangled, UTF-8 assumed --] [-- Attachment #2: 0001-org-agenda-add-org-agenda-day-face-function.patch --] [-- Type: text/x-diff, Size: 1911 bytes --] From e59409e447f18d92eca9c8faf271901c437746ff Mon Sep 17 00:00:00 2001 From: Julien Danjou <julien@danjou.info> Date: Mon, 8 Nov 2010 18:23:07 +0100 Subject: [PATCH] org-agenda: add org-agenda-day-face-function * lisp/org-agenda.el (org-agenda-day-face-function): New variable. (org-agenda-get-day-face): Use org-agenda-day-face-function. Signed-off-by: Julien Danjou <julien@danjou.info> --- lisp/org-agenda.el | 20 +++++++++++++++----- 1 files changed, 15 insertions(+), 5 deletions(-) diff --git a/lisp/org-agenda.el b/lisp/org-agenda.el index 98371e6..aba85eb 100644 --- a/lisp/org-agenda.el +++ b/lisp/org-agenda.el @@ -1433,6 +1433,14 @@ determines if it is a foreground or a background color." (string :tag "Color") (sexp :tag "Face")))))) +(defcustom org-agenda-day-face-function nil + "Function called to determine what face should be used to display a day. +The only argument passed to that function is the day in the +calendar date list format. It should returns a face, or nil if it +does not want to specify a face and let the normal rules apply." + :group 'org-agenda-line-format + :type 'function) + (defcustom org-agenda-category-icon-alist nil "Alist of category icon to be displayed in agenda views. @@ -3108,11 +3116,13 @@ no longer in use." (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))) + (or (and (functionp org-agenda-day-face-function) + (funcall org-agenda-day-face-function date)) + (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 -- 1.7.2.3 [-- Attachment #3: Type: text/plain, Size: 79 bytes --] -- Julien Danjou // ᐰ <julien@danjou.info> http://julien.danjou.info [-- Attachment #4: Type: text/plain, Size: 201 bytes --] _______________________________________________ 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 ^ permalink raw reply related [flat|nested] 10+ messages in thread
* Re: [PATCH 1/2] org-agenda: introduce org-agenda-today and org-agenda-get-day-face 2010-11-08 19:28 ` Julien Danjou @ 2010-11-08 19:59 ` Carsten Dominik 0 siblings, 0 replies; 10+ messages in thread From: Carsten Dominik @ 2010-11-08 19:59 UTC (permalink / raw) To: Julien Danjou; +Cc: emacs-orgmode On Nov 8, 2010, at 1:28 PM, Julien Danjou wrote: > On Mon, Nov 08 2010, Carsten Dominik wrote: > >> can you please rename org-agenda-today to org-agenda-today-p? >> I think it would make its use clearer. > > I think you misread the function. I've added org-agenda-today which > returns today, and just rewrite org-agenda-todayp to use that one. Yes, you are right. Sorry about that. > >> Also, couly you please specify in the docstring of org-agenda-day- >> face- >> function how the day is coming in into the user-defined function? >> As a day >> number or a calendar date list? > > It's a calendar date list. > > Updated patch attached. Thanks! - Carsten > > From e59409e447f18d92eca9c8faf271901c437746ff Mon Sep 17 00:00:00 2001 > From: Julien Danjou <julien@danjou.info> > Date: Mon, 8 Nov 2010 18:23:07 +0100 > Subject: [PATCH] org-agenda: add org-agenda-day-face-function > > * lisp/org-agenda.el (org-agenda-day-face-function): New variable. > (org-agenda-get-day-face): Use org-agenda-day-face-function. > > Signed-off-by: Julien Danjou <julien@danjou.info> > --- > lisp/org-agenda.el | 20 +++++++++++++++----- > 1 files changed, 15 insertions(+), 5 deletions(-) > > diff --git a/lisp/org-agenda.el b/lisp/org-agenda.el > index 98371e6..aba85eb 100644 > --- a/lisp/org-agenda.el > +++ b/lisp/org-agenda.el > @@ -1433,6 +1433,14 @@ determines if it is a foreground or a > background color." > (string :tag "Color") > (sexp :tag "Face")))))) > > +(defcustom org-agenda-day-face-function nil > + "Function called to determine what face should be used to display > a day. > +The only argument passed to that function is the day in the > +calendar date list format. It should returns a face, or nil if it > +does not want to specify a face and let the normal rules apply." > + :group 'org-agenda-line-format > + :type 'function) > + > (defcustom org-agenda-category-icon-alist nil > "Alist of category icon to be displayed in agenda views. > > @@ -3108,11 +3116,13 @@ no longer in use." > > (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))) > + (or (and (functionp org-agenda-day-face-function) > + (funcall org-agenda-day-face-function date)) > + (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 > > -- > 1.7.2.3 > > > -- > Julien Danjou > // ᐰ <julien@danjou.info> http://julien.danjou.info ^ permalink raw reply [flat|nested] 10+ messages in thread
* Re: [PATCH 1/2] org-agenda: introduce org-agenda-today and org-agenda-get-day-face 2010-11-08 17:23 [PATCH 1/2] org-agenda: introduce org-agenda-today and org-agenda-get-day-face Julien Danjou 2010-11-08 17:23 ` [PATCH 2/2] org-agenda: add org-agenda-day-face-function Julien Danjou 2010-11-08 18:34 ` [PATCH 1/2] org-agenda: introduce org-agenda-today and org-agenda-get-day-face Carsten Dominik @ 2010-11-09 10:59 ` Julien Danjou 2 siblings, 0 replies; 10+ messages in thread From: Julien Danjou @ 2010-11-09 10:59 UTC (permalink / raw) To: emacs-orgmode [-- Attachment #1: Type: text/plain, Size: 163 bytes --] On Mon, Nov 08 2010, Julien Danjou wrote: I just noticed a little bug if org-agenda-todayp is called with nil as argument. Here's a fixed version of that patch. [-- Warning: decoded text below may be mangled, UTF-8 assumed --] [-- Attachment #2: 0001-org-agenda-introduce-org-agenda-today-and-org-agenda.patch --] [-- Type: text/x-diff, Size: 7748 bytes --] From c93cf37f9c41f3fb71fd44e0ce2a4c9ba30224cc Mon Sep 17 00:00:00 2001 From: Julien Danjou <julien@danjou.info> Date: Mon, 8 Nov 2010 15:25:22 +0100 Subject: [PATCH] org-agenda: introduce org-agenda-today and org-agenda-get-day-face * 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 <julien@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..b7f38ca 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 (and date (listp date)) (calendar-absolute-from-gregorian date) + date))) + (eq date today))) (provide 'org-agenda) -- 1.7.2.3 [-- Attachment #3: Type: text/plain, Size: 79 bytes --] -- Julien Danjou // ᐰ <julien@danjou.info> http://julien.danjou.info [-- Attachment #4: Type: text/plain, Size: 201 bytes --] _______________________________________________ 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 ^ permalink raw reply related [flat|nested] 10+ messages in thread
end of thread, other threads:[~2010-11-12 15:50 UTC | newest] Thread overview: 10+ messages (download: mbox.gz follow: Atom feed -- links below jump to the message on this page -- 2010-11-08 17:23 [PATCH 1/2] org-agenda: introduce org-agenda-today and org-agenda-get-day-face Julien Danjou 2010-11-08 17:23 ` [PATCH 2/2] org-agenda: add org-agenda-day-face-function Julien Danjou 2010-11-12 15:30 ` Carsten Dominik 2010-11-12 15:34 ` Julien Danjou 2010-11-12 15:43 ` Carsten Dominik 2010-11-12 15:50 ` Julien Danjou 2010-11-08 18:34 ` [PATCH 1/2] org-agenda: introduce org-agenda-today and org-agenda-get-day-face Carsten Dominik 2010-11-08 19:28 ` Julien Danjou 2010-11-08 19:59 ` Carsten Dominik 2010-11-09 10:59 ` Julien Danjou
Code repositories for project(s) associated with this public inbox https://git.savannah.gnu.org/cgit/emacs/org-mode.git This is a public inbox, see mirroring instructions for how to clone and mirror all data and code used for this inbox; as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).