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

[Edgar Gonçalves]

On Saturday, Jim Ottaway wrote:
>>>>>> Edgar Gonçalves <address@hidden> 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:address@hidden
http://www.esw.inesc-id.pt/~eemg