[emacs-wiki-discuss] Re: weekly-view, cyclic tasks and planner-appts

[Edgar Gonçalves]

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] [^ ] address@hidden    
]*\\([0-9]?[0-9]\\):?\\([0-9][0-9]\\)[  ]*[-|]?[        
]*\\([0-9]?[0-9]\\):\\([0-9][0-9]\\)\\(\\|[^ap]\\)"
     s)
     (string-match
     "^[        address@hidden  ]*\\([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
             "^[        address@hidden([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] [^ ] 
address@hidden([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))))))

weekly-view.el
Description: modified version of weekly-view.el

>
> 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