emacs-orgmode@gnu.org archives
 help / color / mirror / code / Atom feed
From: Carsten Dominik <carsten.dominik@gmail.com>
To: Julien Danjou <julien@danjou.info>
Cc: emacs-orgmode@gnu.org
Subject: Re: [PATCH 1/2] org-agenda: introduce org-agenda-today and org-agenda-get-day-face
Date: Mon, 8 Nov 2010 12:34:09 -0600	[thread overview]
Message-ID: <629899F4-DD71-4710-8492-367FB443A0DB@gmail.com> (raw)
In-Reply-To: <1289236987-21552-1-git-send-email-julien@danjou.info>

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

  parent reply	other threads:[~2010-11-08 18: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
2010-11-12 15:43       ` Carsten Dominik
2010-11-12 15:50         ` Julien Danjou
2010-11-08 18:34 ` Carsten Dominik [this message]
2010-11-08 19:28   ` [PATCH 1/2] org-agenda: introduce org-agenda-today and org-agenda-get-day-face 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=629899F4-DD71-4710-8492-367FB443A0DB@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).