From: Carsten Dominik <carsten.dominik@gmail.com>
To: Julien Danjou <julien@danjou.info>
Cc: emacs-orgmode@gnu.org
Subject: Re: [PATCH 2/2] org-agenda: add org-agenda-day-face-function
Date: Fri, 12 Nov 2010 09:43:03 -0600 [thread overview]
Message-ID: <A61F3511-EB52-480C-A4C2-6A6B5E7A2308@gmail.com> (raw)
In-Reply-To: <sa3lj4yblof.fsf@cigue.easter-eggs.fr>
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
next prev parent reply other threads:[~2010-11-12 15:43 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
2010-11-12 15:43 ` Carsten Dominik [this message]
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=A61F3511-EB52-480C-A4C2-6A6B5E7A2308@gmail.com \
--to=carsten.dominik@gmail.com \
--cc=emacs-orgmode@gnu.org \
--cc=julien@danjou.info \
/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).