emacs-orgmode
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

Re: [Orgmode] [PATCH 1/2] org-agenda: introduce org-agenda-today and org


From: Carsten Dominik
Subject: Re: [Orgmode] [PATCH 1/2] org-agenda: introduce org-agenda-today and org-agenda-get-day-face
Date: Mon, 8 Nov 2010 12:34:09 -0600

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 <address@hidden>
---
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.
address@hidden
http://lists.gnu.org/mailman/listinfo/emacs-orgmode




reply via email to

[Prev in Thread] Current Thread [Next in Thread]