On Saturday, Jim Ottaway wrote:
>>>>>> Edgar Gonçalves <[EMAIL PROTECTED]> writes:
(snip)
> I think that if you want to do this, then others probably want to too,
> so it would be good to include your changes to
> planner-appt-forthcoming-get-appts.
>
> I imagine that you have changed it so that the start date can be
> specified as well as the number of days?
I don't have my repository online, for now. I hope to have it soon. Despite
that, I'll post the new function here, along with both affected functions with
the proper changes:
(defun planner-appt-forthcoming-get-appts (n &optional start-day)
"Returns the forthcoming appts for N days, starting from START-DAY (a planner
day page name string). Omitting START-DAY means to start from today, including
todays appts."
(planner-save-buffers)
(let* ((appts '())
(start-day (or start-day (planner-today)))
(last-day (planner-calculate-date-from-day-offset
start-day n))
(pages (planner-get-day-pages start-day last-day))
cyclic-data cyclic-task-descriptions
line task-info task-data
date-absolute date time text)
;; After scanning pages and [conditionally] cyclic entries, each
;; element of appts has:
;;
;; (<absolute date>
;; <time in appt format [minutes from midnight]>
;; <date in planner format>
;; description text)
;;
;; The first two elements are used for sorting/merging; they are
;; removed from the returned list.
(when (and (featurep 'planner-cyclic)
planner-appt-forthcoming-look-at-cyclic-flag)
;; Returns (<appts> . <list of planner-cyclic-ly formatted tasks>)
(setq cyclic-data (planner-appt-forthcoming-get-cyclic n))
(setq appts (car cyclic-data)
cyclic-task-descriptions (cdr cyclic-data)))
(with-temp-buffer
(with-planner
(dolist (page pages)
(when (file-exists-p (cdr page))
(setq date (car page))
(setq date-absolute (calendar-absolute-from-gregorian
(planner-filename-to-calendar-date
date)))
(insert-file-contents (cdr page))
(goto-char (point-min))
(while (re-search-forward planner-appt-forthcoming-regexp nil t)
(setq line (match-string 0))
(if (string-match planner-appt-schedule-appt-regexp line)
(unless (planner-appt-task-schedule-item-p line)
(setq time (save-match-data
(appt-convert-time (match-string 1 line)))
text (match-string 0 line)))
(setq task-info (planner-current-task-info))
(setq task-data (planner-appt-forthcoming-task-data task-info))
(when (and task-data
;; Check for a cyclic task already added.
;; This is a bit messy, since a task id
;; won't have been added [and there might
;; be other special case that I haven't
;; anticipated].
(not (member
(if (string-match
"\\s-+{{Tasks:[0-9]+}}\\s-*"
(planner-task-description task-info))
(replace-match
"" nil t
(planner-task-description task-info))
(planner-task-description task-info))
cyclic-task-descriptions)))
(setq time (car task-data)
text (cdr task-data))))
(when (and time text)
;; Add if it is not there already [there may be a
;; duplicate if this is a schedule item derived from a
;; task item]
(add-to-list 'appts (list date-absolute time date text))
(setq time nil text nil)))
(erase-buffer)))))
(when appts
(mapcar #'cddr
(sort appts
#'(lambda (a b)
(or (< (car a) (car b))
(and (= (car a) (car b))
(< (cadr a) (cadr b))))))))))
(defun planner-appt-forthcoming-display (&optional days)
(interactive
;; TODO: I wanted to use (interactive "p"), but that defaults to
;; 1. Is this really the best way of getting nil as the default
;; for a command that takes an optional integer prefix?:
(list (cond ((consp current-prefix-arg)
(car current-prefix-arg))
((integerp current-prefix-arg)
current-prefix-arg)
(t nil))))
(unless days (setq days planner-appt-forthcoming-days))
(with-current-buffer
(get-buffer-create planner-appt-forthcoming-display-buffer)
(unless (planner-derived-mode-p 'planner-mode)
(setq muse-current-project (muse-project planner-project))
(planner-mode)
(cd (planner-directory)))
(delete-region (point-min) (point-max))
(insert "* Appointments in the next "
(number-to-string days)
(if (= days 1) " day" " days")
"\n\n"
(planner-appt-forthcoming-format
(planner-appt-forthcoming-get-appts
(or days planner-appt-forthcoming-days))))
(goto-char (point-min)))
(display-buffer planner-appt-forthcoming-display-buffer)
(fit-window-to-buffer
(get-buffer-window planner-appt-forthcoming-display-buffer)))
(defun planner-appt-forthcoming-update-section (&optional days)
(interactive
(list (cond ((consp current-prefix-arg)
(car current-prefix-arg))
((integerp current-prefix-arg)
current-prefix-arg)
(t nil))))
(with-planner-update-setup
(save-excursion
(planner-goto-today)
(planner-seek-to-first planner-appt-forthcoming-appt-section)
(delete-region (point)
(planner-appt-seek-to-end-of-current-section))
(insert (planner-appt-forthcoming-format
(planner-appt-forthcoming-get-appts
(or days planner-appt-forthcoming-days)
(planner-calculate-date-from-day-offset (planner-today) 1)))
?\n))))
I still have one problem, that is related to the weekly-view production. Right
now I have a function that collects the appts for 6 days, starting from the
beginning of the week. My problem is how to get the right Monday date from
(planner-today). There's a function that works with the calendar cursor, but
that's no good, because it messes the weekly-view code. I'd like to calculate
it, but didn't put much thought into it - I was hoping there was already a nice
elisp function to do it for me! (Btw, if you want to test this, it already
works, but only if calendar cursor is under a Monday!)
Here's my code, if someone could give me some pointers I'd appreciate it!
(defun planner-include-appt-entries ()
"Add diary entries with todays planner appointments. Only works from
calendar!"
(declare (special original-date))
;; TODO: find the beginning of the week
(let ((start-day (planner-date-to-filename original-date))
(planner-goto-hook nil))
(dolist (appt (planner-appt-forthcoming-get-appts 6 start-day))
(let ((date (car appt)) ;; date : YYYY.MM.DD
(text (cadr appt))) ;; description: @START-TIME | END-TIME | TEXT
(string-match
"\\([0-9][0-9][0-9][0-9]\\).\\([0-9][0-9]\\).\\([0-9][0-9]\\)"
date)
(let ((year (string-to-number (match-string 1 date)))
(month (string-to-number (match-string 2 date)))
(day (string-to-number (match-string 3 date))))
(add-to-diary-list (list month day year)
text ""))))))
(defadvice week-graph-view-diary-entries (around show-planner-appts activate)
(let ((list-diary-entries-hook '(planner-include-appt-entries)))
ad-do-it))
--
Edgar Gonçalves
Software Engineering Group @ INESC-ID
IST/Technical University of Lisbon
Rua Alves Redol, 9, Room 635
1000-029 Lisboa, Portugal
mailto:[EMAIL PROTECTED]
http://www.esw.inesc-id.pt/~eemg
_______________________________________________
emacs-wiki-discuss mailing list
emacs-wiki-discuss@nongnu.org
http://lists.nongnu.org/mailman/listinfo/emacs-wiki-discuss
