emacs-orgmode@gnu.org archives
 help / color / mirror / code / Atom feed
From: Julien Danjou <julien@danjou.info>
To: Carsten Dominik <carsten.dominik@gmail.com>
Cc: emacs-orgmode@gnu.org
Subject: Re: [PATCH 2/2] org-agenda: add org-agenda-day-face-function
Date: Fri, 12 Nov 2010 16:34:24 +0100	[thread overview]
Message-ID: <sa3lj4yblof.fsf@cigue.easter-eggs.fr> (raw)
In-Reply-To: <DCCF9884-F160-43C5-9E3B-780625C46E93@gmail.com> (Carsten Dominik's message of "Fri, 12 Nov 2010 09:30:13 -0600")

[-- 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

  reply	other threads:[~2010-11-12 15:34 UTC|newest]

Thread overview: 10+ messages / expand[flat|nested]  mbox.gz  Atom feed  top
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 [this message]
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

Reply instructions:

You may reply publicly to this message via plain-text email
using any one of the following methods:

* Save the following mbox file, import it into your mail client,
  and reply-to-all from there: mbox

  Avoid top-posting and favor interleaved quoting:
  https://en.wikipedia.org/wiki/Posting_style#Interleaved_style

  List information: https://www.orgmode.org/

* Reply using the --to, --cc, and --in-reply-to
  switches of git-send-email(1):

  git send-email \
    --in-reply-to=sa3lj4yblof.fsf@cigue.easter-eggs.fr \
    --to=julien@danjou.info \
    --cc=carsten.dominik@gmail.com \
    --cc=emacs-orgmode@gnu.org \
    /path/to/YOUR_REPLY

  https://kernel.org/pub/software/scm/git/docs/git-send-email.html

* If your mail client supports setting the In-Reply-To header
  via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line before the message body. 
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).