Re: weekly-view, cyclic tasks and planner-appts
[email protected] (Edgar Gonçalves)
| Newsgroups | gmane.emacs.wiki.general |
|---|---|
| Message-ID | <[email protected]> |
On Thursday, René wrote:
> Edgar Gonçalves <Edgar.Goncalves <at> inesc-id.pt> writes:
>
>> These last changes are not fully tested, but when I'm comfortable with the
>> results I'll publish them here!
I haven't written a separate package with everything, yet, but I'm using my
mods since my last post everyday now!
>
> I'm running into similar questions as the ones you tackled in this thread. So I
> tried to put your various pieces of code end to end.
>
> Unfortunately I do not manage to get the expected result. I'm sure I missed
> something along the way since I did not understand everything.
>
> For instance, I don't know what you mean by:
>
>> Don't forget you have to change cal-desk's regexp recognition
>
In cal-desk-calendar.el, the function `diary-entry-times' begins with a
cond. you have to replace the military time range with something like this:
;; Military time range
((or
(string-match
"^[ ]*#[ABC] [^ ] [@!]?[ ]*\\([0-9]?[0-9]\\):?\\([0-9][0-9]\\)[ ]*[-|]?[ ]*\\([0-9]?[0-9]\\):\\([0-9][0-9]\\)\\(\\|[^ap]\\)"
s)
(string-match
"^[ ]*[@!]?[ ]*\\([0-9]?[0-9]\\):?\\([0-9][0-9]\\)[ ]*[-|]?[ ]*\\([0-9]?[0-9]\\):\\([0-9][0-9]\\)\\(\\|[^ap]\\)"
s))
(list
(+ (* 100 (string-to-number
(substring s (match-beginning 1) (match-end 1))))
(string-to-number (substring s (match-beginning 2) (match-end 2))))
(+ (* 100 (string-to-number
(substring s (match-beginning 3) (match-end 3))))
(string-to-number (substring s (match-beginning 4) (match-end 4))))
(substring s (1+ (match-end 4)))))
>
>> add the regexps I've mentioned in a previous post in this thread to
>> `diary-time-regexp-list'.
>
> I looked in your previous posts but did not find anything concerning
> `diary-time-regexp-list' either.
I think I had this on another thread, but I'll try to get everything under one
single post. `diary-time-regexp-list' needs to know about task
appointments. See the next bunch of code.
> 1. Would you mind giving me access to your whole configuration file?
>
> 2. Is your code going to be part of the planner-el package in the end?
I'll post the rest of my configuration here. About being in planner-el
eventually, I guess it will be up to the rest of the planner users and devs, if
they find this useful or not :d
I have, in my configuration, the following code. Try it out, with the changes
to cal-desk-calendar.el and use the attached weekly-view.el to gain hoover-on
tooltips that tell the start/end times of a task. (The changes are in the
function fancy-diary-display-week-graph).
;; When, in calendar, we press 'w', it shows a weekly schedule of the appointments.
(require 'weekly-view)
(setq week-graph-work-week t)
(setq weekly-graph-day-end 2030)
;; Task and planner-appt schedule entries:
(add-to-list 'diary-time-regexp-list
; military range with task schedule
"^[ ]*[@!]?\\([0-9]?[0-9]\\):?\\([0-5][0-9]\\)[ ]*[-|]?[ ]*\\([0-9]?[0-9]\\)[ ]*[:\|]?[ ]*\\([0-5][0-9]\\)\\(\\|[^ap]\\) ?|?")
(add-to-list 'diary-time-regexp-list
; military range with task schedule
"^[ ]*#[ABC] [^ ] [@!]?\\([0-9]?[0-9]\\):?\\([0-5][0-9]\\)[ ]*[-|]?[ ]*\\([0-9]?[0-9]\\)[ ]*[:\|]?[ ]*\\([0-5][0-9]\\)\\(\\|[^ap]\\) ?|?")
(defun planner-include-appt-entries (&optional days)
"Add diary entries with planner appointments for DAYS (an
integer). It defaults for the number of days in the week,
according to `week-graph-work-week'."
(declare (special date))
(let ((start-day (planner-date-to-filename date))
(number-of-days (or days (if week-graph-work-week 4 6))))
;; Cycle through forthcoming appts for all the week days:
(dolist (appt (planner-appt-forthcoming-get-appts number-of-days
start-day))
(let ((date (car appt)) ;; date : YYYY.MM.DD
(text (cadr appt))) ;; description: @START-TIME | END-TIME | TEXT
(add-to-diary-list (planner-filename-to-calendar-date date)
text
"")))))
;; Thanks to Jim Ottaway <j.ottaway[AT]lse.ac.uk> for this:
(defun planner-beginning-of-week (planner-date)
(let ((date (planner-filename-to-calendar-date planner-date)))
(planner-date-to-filename
(calendar-gregorian-from-absolute
(+ (calendar-absolute-from-gregorian date)
(- calendar-week-start-day
(calendar-day-of-week date)))))))
;;; Week view:
(defun week-graph-view-planner-appt-entries ()
"Redefinition of `week-graph-view-diary-entries', to work only with planner."
(interactive)
(if (string= "*Calendar*" (buffer-name (current-buffer)))
(save-excursion
(calendar-cursor-to-nearest-date)
(let (;;(diary-display-hook 'fancy-diary-display-week-graph)
(day (calendar-day-of-week (calendar-cursor-to-date))))
(unless (= day calendar-week-start-day)
(calendar-beginning-of-week 1))
(diary-check-diary-file)
(let* ((date (calendar-cursor-to-date t))
(diary-entries-list nil)
(date-string (calendar-date-string date)))
(planner-include-appt-entries)
(fancy-diary-display-week-graph))))
;;display current week, maximized:
(let ((day (format-time-string "%u"))
(date (planner-filename-to-calendar-date
(planner-beginning-of-week (planner-today))))
(diary-entries-list nil)
(date-string (format-time-string "%A, %d de %B de %Y")))
(planner-include-appt-entries)
(with-current-buffer (get-buffer-create "*Fancy Diary Entries*")
(fancy-diary-display-week-graph)
(fancy-diary-display-mode)
(switch-to-buffer (current-buffer))
(delete-other-windows)))))
(defalias 'week 'week-graph-view-planner-appt-entries)
;; Switch key definition to work the way I want normally:
(define-key calendar-mode-map "w" 'week-graph-view-planner-appt-entries)
(define-key calendar-mode-map "W" 'week-graph-view-diary-entries)
;; Some utilities within diary view:
(define-key fancy-diary-display-mode-map "c" 'calendar)
(defun weekly-view-toggle-weekend-display ()
(interactive)
(setq week-graph-work-week (not week-graph-work-week))
(week-graph-view-planner-appt-entries)
(message "Weekends are now %s. Press 'e' again to toggle this behaviour."
(if week-graph-work-week "hidden" "displayed")))
(define-key fancy-diary-display-mode-map "e" 'weekly-view-toggle-weekend-display)
(define-key fancy-diary-display-mode-map "w" 'week)
(defun night-week ()
"Shows a night weekly view."
(interactive)
(let ((weekly-graph-day-end 2400)
(weekly-graph-day-start 1830)
(week-graph-work-week nil))
(week)))
(define-key fancy-diary-display-mode-map "n" 'night-week)
(define-key calendar-mode-map "n" 'night-week)
(defun morning-week ()
"Shows a morning weekly view."
(interactive)
(let ((weekly-graph-day-end 1400)
(weekly-graph-day-start 600)
(week-graph-work-week nil))
(week)))
(define-key fancy-diary-display-mode-map "m" 'morning-week)
(define-key calendar-mode-map "m" 'morning-week)
;;; Day view:
(defun day-view-planner-appt-entries ()
"Fancy diary display of the current day."
(interactive)
(if (string= "*Calendar*" (buffer-name (current-buffer)))
(save-excursion
(calendar-cursor-to-nearest-date)
(let ((day (calendar-day-of-week (calendar-cursor-to-date))))
(diary-check-diary-file)
(let* ((date (calendar-cursor-to-date t))
(original-date date)
(diary-entries-list nil)
(date-string (calendar-date-string date)))
(planner-include-appt-entries 0)
(diary-include-planner-appts)
(fancy-schedule-display-desk-calendar))))
;;display current day, maximized:
(let* ((day (format-time-string "%u"))
(date (planner-filename-to-calendar-date (planner-today)))
(original-date date)
(diary-entries-list nil)
(date-string (format-time-string "%A, %d de %B de %Y")))
(planner-include-appt-entries 0)
(diary-include-planner-appts)
(with-current-buffer (get-buffer-create "*Fancy Diary Entries*")
(fancy-schedule-display-desk-calendar)
(fancy-diary-display-mode)
(switch-to-buffer (current-buffer))
(delete-other-windows)))))
(defalias 'day 'day-view-planner-appt-entries)
;; Switch key definition to work the way I want normally:
(define-key calendar-mode-map "d" 'day-view-planner-appt-entries)
(define-key calendar-mode-map "D" 'diary)
(define-key fancy-diary-display-mode-map "d" 'day-view-planner-appt-entries)
(defun planner-appt-forthcoming-get-cyclic (n &optional start-day)
(let ((appts '())
(cyclic-task-descriptions '())
(start-day (or start-day (planner-today)))
date line time text task-info task-data)
(dolist (entry (planner-list-diary-entries
planner-cyclic-diary-file
(planner-filename-to-calendar-date
(planner-calculate-date-from-day-offset
start-day 0))
(1+ n)))
(setq date (planner-date-to-filename (car entry))
line (cadr entry))
(if (string-match planner-appt-schedule-appt-regexp line)
(setq time (save-match-data
(appt-convert-time (match-string 1 line)))
text (match-string 0 line))
(when (string-match planner-appt-forthcoming-task-regexp line)
(setq task-info (planner-task-info-from-string date line))
(setq task-data (planner-appt-forthcoming-task-data task-info))
(when (and task-data
(not (string= (planner-task-status task-info) "X"))
(not (string= (planner-task-status task-info) "C")))
;; For duplicate checking: remember the description as
;; it would be transformed by planner-cyclic.
(push (format planner-cyclic-task-description-format
(planner-task-description task-info) date)
cyclic-task-descriptions)
(setq time (car task-data)
text (cdr task-data)))))
(when (and time text)
(add-to-list
'appts
(list (calendar-absolute-from-gregorian (car entry))
time date text))
(setq time nil text nil)))
(cons appts cyclic-task-descriptions)))
(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 start-day))
(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
(not (string= (planner-task-status task-info) "X"))
(not (string= (planner-task-status task-info) "C"))
;; 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))))
;; Let's add the link to the tasks appointments:
(defun planner-appt-forthcoming-task-data (info)
(let ((task-appt
(planner-appt-task-parse-task
;; right here:
(format "%s (%s)"
(planner-task-description info)
(planner-task-link-text info)))))
(when task-appt
(cons (appt-convert-time (nth 1 task-appt))
(planner-appt-forthcoming-format-appt-description
(nth 1 task-appt)
(nth 0 task-appt))))))
>
> Thanks.
>
> --
> René
--
Edgar Gonçalves
Software Engineering Group @ INESC-ID
IST/Technical University of Lisbon
Rua Alves Redol, 9, Room 635
1000-029 Lisboa, Portugal
mailto:edgar[DOT]goncalves[AT]inesc[DASH]id[DOT]pt
http://www.esw.inesc-id.pt/~eemg
_______________________________________________
emacs-wiki-discuss mailing list
[email protected]
http://lists.nongnu.org/mailman/listinfo/emacs-wiki-discuss
weekly-view.el
(application/emacs-lisp, 10.6 KB) - not displayed