;;;; day-structure.el -- Use emacs to help give some structure to my working day
;;; Time-stamp: <2006-02-24 12:08:06 jcgs>

;;  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 of the License, 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 this program; if not, write to the Free Software Foundation, Inc.,
;;  59 Temple Place, Suite 330, Boston, MA 02111-1307 USA

;; todo: log these into some kind of history

(provide 'day-structure)

(defvar day-structures
  '((("joel" "mayo")
     (("08:30-9:00" "email, web")
      ("9:00-10:00" "programming")
      ("10:00-11:00" "reading")
      ("11:00-11:30" "coffee")
      ("11:30-12:30" "writing papers")
      ("12:30-12:45" "prayer")
      ("12:45-13:00" "exercise")
      ("13:00-13:30" "lunch")
      ("13:30-13:45" "walk")
      ("13:45-14:00" "fun programming")
      ("14:00-15:00" "programming")
      ("15:00-15:30" "tea")
      ("15:30-16:30" "reading")
      ("16:30-17:30" "writing papers")
      ("17:30-17:45" "language learning"))
     )
    (("micah" "hosea")
     (("9:00-10:00" "programming")
      ("10:00-11:00" "reading")
      ("11:00-11:30" "coffee")
      ("11:30-12:30" "writing papers")
      ("12:30-12:45" "prayer")
      ("12:45-13:00" "exercise")
      ("14:00-15:00" "programming")
      ("15:00-15:30" "tea")
      ("15:30-16:30" "reading")
      ("16:30-17:30" "writing papers")
      )))
  "My daily structures.
These are different according to which machine I am on, as I have a different pattern
when working at home.
Each entry is a list, in which the first element is a list of machine names,
and the second element is a list of times and things to be doing at those times.")

(defvar day-structure
  (let ((machine (downcase (system-short-name))) ; defined in $COMMON/emacs/host-setup.el
	(places day-structures))
    (catch 'found
      (while places
	(if (member machine (caar places))
	    (throw 'found (mapcar (lambda (slot)
				    (list
				     (apply 'vector
					    (mapcar 'string-to-int
						    (split-string (first slot)
								  "[-:]")))
				     (second slot)))
				  (cadar places))))
	(setq places (cdr places)))
      nil))
  "The day structure for the machine we are running on.")

(defvar day-structure-show-item-hook nil
  "Functions to return further description of an activity.
They take the activity name, as a string, and return a string, or nil if uninterested.")

(defun day-structure-show (&optional marked)
  "Show what you mean to be doing at various times of day.
If a slot is eq to the optional argument, mark it."
  (interactive)
  (let ((slots day-structure))
    (with-output-to-temp-buffer "*Activity slots*"
      (while slots
	(let* ((slot (car slots))
	       (times (car slot)))
	  (princ (format "%s%02d:%02d-%02d:%02d: %s%s%s\n"
			 (if (eq slot marked) "--> " "    ")
			 (aref times 0) (aref times 1) (aref times 2) (aref times 3)
			 (second slot)
			 (or (run-hook-with-args-until-success 'day-structure-show-item-hook
							       (second slot))
			     "")
			 (if (eq slot marked) " <--" "    "))))
	(setq slots (cdr slots))))))

(defun day-structure-possible-activities ()
  "Return an alist of the possible activities.
The result is suitable for use with completing-read."
  (let ((result nil))
    (mapcar (lambda (activity)
	      (or (assoc (second activity) result)
		  (setq result (cons (list (second activity) activity) result))))
	    day-structure)
    result))

(defvar day-structure-offset nil
  "Adjustment to the time.
Use this if you start late, for example.")

(defvar running-late-string ""
  "String corresponding to day-structure-offset.")

(defvar day-structure-offset-rounding-minutes 5
  "Round the offset to this number of minutes.")

(defvar day-structure-use-offset nil
  "Whether to use offsets (see day-structure-offset).")

(defun day-structure-update-offset (&optional force)
  "Set up day-structure-offset, if it has not been set."
  (interactive)
  (if (or force
	  (null day-structure-offset))
      (let* ((first-thing (car (car day-structure)))
	     (hour-first-thing (aref first-thing 0))
	     (minute-first-thing (aref first-thing 1))
	     (minutes-first-thing (+ minute-first-thing
				     (* 60 hour-first-thing)))
	     (time (decode-time))
	     (hour-now (third time))
	     (minute-now (second time))
	     (minutes-now (+ minute-now (* 60 hour-now))))
	;; (message "Now: %d:%d --> %d; First-thing: %d:%d --> %d" hour-now minute-now minutes-now hour-first-thing minute-first-thing minutes-first-thing)
	(setq day-structure-offset
	      (if (and day-structure-use-offset
		       (> minutes-now minutes-first-thing)
		       (or force
			   (yes-or-no-p "Offset day times for changing activities? ")))
		  (list 0 (* 60 (* day-structure-offset-rounding-minutes
				   (/ (- minutes-now minutes-first-thing)
				      day-structure-offset-rounding-minutes))) 0)
		(list 0 0 0))
	      running-late-string (if day-structure-use-offset
				      (format " (running %d minutes late)" (/ (second day-structure-offset) 60))
				    "")))))

(defun day-structure-find-current-activity ()
  "Find which activity you normally aim to be doing now."
  (day-structure-update-offset)
  ;; todo: make it use the offset only for some items, leaving some invariant
  (let* ((time (decode-time (subtract-time (current-time) day-structure-offset)))
	 (hour (third time))
	 (minute (second time))
	 (slots day-structure))
    (catch 'found
      (while slots
	(let ((timespan (caar slots)))
	  (if (and (or (> hour (aref timespan 0))
		       (and (= hour (aref timespan 0))
			    (>= minute (aref timespan 1))))			     
		   (or  (< hour (aref timespan 2))
			(and (= hour (aref timespan 2))
			     (<= minute (aref timespan 3)))))
	      (throw 'found (cadar slots))))
	(setq slots (cdr slots)))
      nil)))

(defvar day-structure-current-activity (day-structure-find-current-activity)
  "What you should be doing now, according to your declared day structure.")

(defvar change-activity-hook nil
  "Functions to run on changing activity.
Each is called with two args: the old activity and the new one.")

(defvar day-structure-activities-history-hack nil
  "Variable for TMM-style hack on reading activity names.")

(defun day-structure-set-current-activity (activity)
  "Switch to ACTIVITY.
Returns ACTIVITY, for convenience of day-structure-update-current-activity.
Calls the functions in change-activity-hook, passing the old and new activities."
  (interactive
   (let ((activities (day-structure-possible-activities)))
     (setq day-structure-activities-history-hack (mapcar 'car activities))
     (list (completing-read "Activity: " activities nil t nil 'day-structure-activities-history-hack))))
  ;; todo: remember current buffer for each activity?
  (message "Running change-activity-hook")
  (run-hook-with-args 'change-activity-hook day-structure-current-activity activity)
  (message "Done change-activity-hook")
  (setq day-structure-current-activity activity)
  (force-mode-line-update)
  (message "Now doing %s" activity)
  activity)

(defvar day-structure-automatic-update nil
  "*Whether to update the current activity at certain times.
If nil, the user is just reminded that they should be doing something else now.")

(defun day-structure-update-current-activity ()
  "Remind you to start doing a different activity, if you are now in a different slot.
The slots are defined in day-structures, which see.
Returns whether it changed the activity."
  (interactive)
  (message "Updating current activity")
  (let ((new-activity (day-structure-find-current-activity)))
    (message "according to defined timetable, you should now be doing %S" new-activity)
    (unless (equal new-activity day-structure-current-activity)
      (save-window-excursion
	(day-structure-show new-activity)
	(let ((activity-change-string (if day-structure-current-activity
					  (if new-activity
					      (format "switch from %s to %s%s"
						      day-structure-current-activity new-activity running-late-string)
					    (format "stop %s%s" day-structure-current-activity running-late-string))
					(format "start %s%s" new-activity running-late-string))))
	  (if day-structure-automatic-update
	      (when (yes-or-no-p (format "%s? " (capitalize activity-change-string)))
		(day-structure-set-current-activity new-activity))
	    (message "You should now %s" activity-change-string)
	    nil))))))

(if (not (memq 'day-structure-current-activity global-mode-string))
    (setq global-mode-string (append global-mode-string
				     '("{" day-structure-current-activity "} "))))

;;; end of day-structure.el