;;; weekly-view.el --- bar graph view of the week's diary events

;; Copyright (C) 2003 Doug Alcorn <doug@lathi.net>

;; Author: Doug Alcorn <doug@lathi.net>
;; Keywords: calendar, diary, week, view

;; This program is NOT part of GNU Emacs

;; This program is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 2, or (at your option)
;; any later version.
;;
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.
;;
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING.  If not, write to the
;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.

;;; Commentary:

;; Version: 2
;; X-URL: http://www.lathi.net/twiki-bin/view/Main/EmacsWeeklyView

;; This package makes a bar graph of the week's diary events
;;
;; Usage:
;;   (require 'weekly-view)
;;   (add-hook 'diary-display-hook 'fancy-diary-display-week-graph)

;; Now when you view your diary it will display the weekly graph.

;;; History:
;; version 1: original code, mostly worked
;; version 2: patch from Nemeth Felician <f_nemeth@index.hu> fixes lots of bugs

;;; Code:

(require 'cal-desk-calendar)

(define-key calendar-mode-map "w" 'week-graph-view-diary-entries)


;;; User Variables:

(defcustom week-graph-work-week nil
  "*If non-nil, only the 5 workdays are displayed (instead of 7)."
  :type 'boolean)

(defcustom week-graph-dynamic-width t
  "*If non-nil, the graph fully fills the window.
If nil, `weekly-graph-day-width' is used."
  :type 'boolean)


;;; Compatibility:
;; 
;; emacs doesn't have replace-in-string
;; from gnus-util.el
(eval-and-compile
  (cond
   ((fboundp 'replace-in-string)
    (defalias 'weekly-view-replace-in-string 'replace-in-string))
   ((fboundp 'replace-regexp-in-string)
    (defun replace-in-string  (string regexp newtext &optional literal)
      (replace-regexp-in-string regexp newtext string nil literal)))
   (t
    (defun replace-in-string (string regexp newtext &optional literal)
      (let ((start 0) tail)
	(while (string-match regexp string start)
	  (setq tail (- (length string) (match-end 0)))
	  (setq string (replace-match newtext nil literal string))
	  (setq start (- (length string) tail))))
      string))))


;;;###autoload
(defun week-graph-view-diary-entries ()
  "Prepare and display a buffer with diary entries of the current week.
See `view-diary-entries' for more."
  (interactive)
  (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))
      (view-diary-entries 7))))

(defun week-graph-convert-time (time)
  (let ((hour (/ time 100))
	(mins (% time 100)))
    (+ (* hour 3600) (* mins 60))))

(defun weekly-graph-display-time-format (time)
  (format "%2d:%02d" (/ cur 3600) (% (/ cur 60) 60)))

(defun week-graph-day-titles (&optional width)
  "Return of a vector whose members are the day names.  If WIDTH is
non-nil and non-zero, truncate the day name to that width."
  (mapcar
   (lambda (s)
     (let* ((extra (- width (length s)))
	    (pre (/ extra 2))
	    (post (- extra pre)))
       (cond
	((= extra 0) s)
	((> extra 0) (format (format "%%%ds%%%ds" (- width post) post) s ""))
	(t (substring s 0 width)))))
   calendar-day-name-array))

(defvar weekly-graph-day-width 10
  "Width of the each day in the bar graph")

(defvar weekly-graph-day-start  800
  "Time to start each day's view in military style integers (i.e. \"8:00am\" is 800)")
(defvar weekly-graph-day-end 1800
  "Time to end each day's view in military style integers (i.e. \"8:00am\" is 800)")
(defvar weekly-graph-increment 30
  "Increment in minutes for each row on the weekly graph of diary entries")
(defvar weekly-graph-use-hash-marks t
  "If non-nill use hash marks '\#' to graph events rather than pertinent event text")
(defvar weekly-graph-default-event-length 60
  "Length of events that don't specify an end time in minutes.")

(defvar diary-time-regexp-list
  `(

    "^[ 	]*\\([0-9]?[0-9]\\)-\\([0-9]?[0-9]\\)\\([ap]\\)m\\>" ; HH-HH[ap]m
    "^[ 	]*\\([0-9]?[0-9]\\):?\\([0-9][0-9]\\)-\\([0-9]?[0-9]\\):?\\([0-9][0-9]\\)\\(\\|[^ap]\\)" ; military range
    "^[ 	]*\\([0-9]?[0-9]\\):?\\([0-9][0-9]\\)\\(\\>\\|[^ap]\\)"	; military time
    "^[ 	]*\\([0-9]?[0-9]\\):\\([0-9][0-9]\\)-\\([0-9]?[0-9]\\):\\([0-9][0-9]\\)\\([ap]\\)m\\>" ; hh:mm range
    "^[ 	]*\\([0-9]?[0-9]\\):\\([0-9][0-9]\\)\\([ap]\\)m-\\([0-9]?[0-9]\\):\\([0-9][0-9]\\)\\([ap]\\)m\\>"
    "^[ 	]*\\([0-9]?[0-9]\\):\\([0-9][0-9]\\)\\([ap]\\)m-\\([0-9]?[0-9]\\):\\([0-9][0-9]\\)\\([ap]\\)m\\>" ; h/m range
    "^[ 	]*\\([0-9]?[0-9]\\):\\([0-9][0-9]\\)\\([ap]\\)m\\>" ; hh:mm
    "^[ 	]*\\([0-9]?[0-9]\\)\\([ap]\\)m-\\([0-9]?[0-9]\\)\\([ap]\\)m\\>" ; HH[ap]m-HH[ap]m
    "^[ 	]*\\([0-9]?[0-9]\\)\\([ap]\\)m\\>" ; hour only
    ,diary-schedule-sunrise-sunset-pattern
    ,diary-schedule-lunar-phase-pattern
    ,diary-schedule-equinox-solstice-pattern
    ,diary-schedule-morning-pattern
    ;,diary-schedule-afternoon-patern
    ,diary-schedule-workday-pattern
    ,diary-schedule-all-day-pattern))

(defun fancy-diary-display-week-graph ()
  "Given a set of appointment DATA, draw a weekly bar graph of it.
DATA must be a vector of seven elements (for each day of the week),
where each element is a list of cons cells representing the beginning
and ending seconds of each appointment within the day, where midnight
begins at 0 seconds.  For example, an appointment for one hour on
Monday at 10am would look like:

  [nil ((36000 . 39600)) nil nil nil nil nil]"
  (save-excursion ;; Prepare the fancy diary buffer.
    ;; setup
    (message "Preparing diary...")
    (set-buffer (get-buffer-create fancy-diary-buffer))
    (setq buffer-read-only nil)
    (make-local-variable 'mode-line-format)
    (calendar-set-mode-line " Desk Calendar ")
    (erase-buffer)

    ;; get ready to insert schedule
    (let* ((num-days (if week-graph-work-week 5 7))
 	   (day-width (if week-graph-dynamic-width
 			  (/ (- (window-width) 7 num-days) num-days)
 			weekly-graph-day-width))
	   (begin (week-graph-convert-time weekly-graph-day-start))
	   (end (week-graph-convert-time weekly-graph-day-end))
 	   (incr (* weekly-graph-increment 60))
	   (cur begin)
	   (day-titles (vconcat (week-graph-day-titles day-width)))
	   (data (make-vector 7 nil)))
      ;; "cook" the diary-entries-list into a more regular form
      (dolist (elem diary-entries-list)
	(let* ((dow (calendar-day-of-week (car elem)))
	       (day-of-week-ref (aref data dow))
	       (entry-times (diary-entry-times (cadr elem)))
	       (entry-text (cadr elem))
	       (beginning-time (week-graph-convert-time (car entry-times)))
	       (ending-time (week-graph-convert-time (cadr entry-times)))
	       entry-alist)
	  (if (= beginning-time ending-time)
	      (setq ending-time (+ ending-time (* weekly-graph-default-event-length 60))))
	  (mapcar (lambda (regexp) (setq entry-text (replace-in-string entry-text regexp "")))
		  diary-time-regexp-list)
	  (setq entry-text (replace-in-string entry-text "^[ 	]+" ""))
	  (setq entry-text (replace-in-string entry-text "[ \t\n]+" " "))
	  (setq entry-text (replace-in-string entry-text "[ \t]+$" ""))
	  (setq entry-plist `(:beginning ,beginning-time
			      :ending ,ending-time
			      :text ,entry-text
			      :marker ,(nth 3 elem)))
	  (unless (= (car entry-times) -9999)
	    (if day-of-week-ref
		(nconc day-of-week-ref (list entry-plist))
	      (aset data dow (list entry-plist))))))

      ;; insert day of week headers
      (dotimes (j 7)
	(if (= j 0)
	    (insert "     "))
	(setq i (% (+ j calendar-week-start-day) 7))
	(unless (and week-graph-work-week (or (= i 0) (= i 6)))
	  (insert "|" (aref day-titles i))))
      (insert "|\n"
	      (make-string (+ 6 (* day-width num-days) num-days) ?-) ?\n)

      ;; now handle entries
      (while (< cur end)
	(dotimes (j 7)
	  (setq i (% (+ j calendar-week-start-day) 7))
	  ;; insert time on lieft
	  (if (= j 0) (insert (weekly-graph-display-time-format cur)))
	  (unless (and week-graph-work-week (or (= i 0) (= i 6)))
	    (insert "|")
	    (let ((day-of-week-list (aref data i)) (print-text nil) (print-marker nil))
	      (setq day-of-week-list
		    (mapcar
		     (lambda (appt)
		       (let* ((appt-text (plist-get appt :text))
			      (beginning (plist-get appt :beginning))
			      (ending (plist-get appt :ending))
			      (times-printed (plist-get appt :times-printed))
			      (start (if times-printed (* times-printed day-width) 0))
			      (end (if times-printed (* (1+ times-printed) day-width) day-width)))
			 (message "times printed: %s start: %s end: %s appt: %s" times-printed start end appt-text)
			 (if (and (>= cur beginning) (< cur ending))
			     (progn
			       (unless times-printed
				 (setq print-marker (plist-get appt :marker)))
			       (setq print-text
				     (if (> (length appt-text) end)
					 (substring appt-text start end)
				       (if (> start (length appt-text))
					   (make-string day-width ?#)
					 (concat
					  (substring appt-text start (length appt-text))
					  (make-string (- day-width (- (length appt-text) start)) ?#)))))
			       
			       (setq appt (plist-put appt :times-printed (if times-printed (1+ times-printed) 1))))
					;(setq print-text nil)
			   )
			 appt))
		     day-of-week-list))
	      (aset data i day-of-week-list)
	      (if print-text
		  (if print-marker
		      (insert-button print-text 'marker print-marker :type 'diary-entry)
		    (insert print-text))
		(insert (make-string day-width ? ))))))
	(insert "|\n")
	(setq cur (+ cur incr)))
      (insert (make-string (+ 6 (* day-width num-days) num-days) ?-) ?\n))
    
    ;; clean-up
    (set-buffer-modified-p nil)
    (setq buffer-read-only t)
    (display-buffer fancy-diary-buffer)
    (message "Preparing diary...done")))

(provide 'weekly-view)

;;; weekly-view.el ends here