;; Last edited: Wed Oct 24 17:08:20 1990
;; provide a simple diary facility on top of rmailsum
;; Copyright (C) 1990 Henry S. Thompson

;; This file is part of GNU Emacs.

;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY.  No author or distributor
;; accepts responsibility to anyone for the consequences of using it
;; or for whether it serves any particular purpose or works at all,
;; unless he says so in writing.  Refer to the GNU Emacs General Public
;; License for full details.

;; Everyone is granted permission to copy, modify and redistribute
;; GNU Emacs, but only under the conditions described in the
;; GNU Emacs General Public License.   A copy of this license is
;; supposed to have been given to you along with GNU Emacs so you
;; can know your rights and responsibilities.  It should be in a
;; file named COPYING.  Among other things, the copyright notice
;; and this notice must be preserved on all copies.

(provide 'diary)
(require 'mail-extras)

(autoload 'sort-subr "sort")

(defvar ht-diary-file-name "~/DIARY.babyl"
  "default name of diary file")

(defvar ht-Calendar-directory "~/Calendar")

(defun xxx-date-lessp (date1 date2)
  "Return T if DATE1 is earlyer than DATE2."
  (string-lessp (gnus-comparable-date date1)
		(gnus-comparable-date date2)))

(defun xxx-comparable-date (date)
  "Make comparable string by string-lessp from DATE."
  (let ((month '(("JAN" . " 1")("FEB" . " 2")("MAR" . " 3")
		 ("APR" . " 4")("MAY" . " 5")("JUN" . " 6")
		 ("JUL" . " 7")("AUG" . " 8")("SEP" . " 9")
		 ("OCT" . "10")("NOV" . "11")("DEC" . "12")))
	(date (or date "")))
    ;; Can understand the following styles:
    ;; (1) 14 Apr 89 03:20:12 GMT
    ;; (2) Fri, 17 March 89 4:01:33 GMT
    (if (string-match
	 "\\([0-9]+\\) \\([^ ,]+\\) \\([0-9]+\\) *\\([0-9:]*\\)" date)
	(concat
	 ;; Year
	 (substring date (match-beginning 3) (match-end 3))
	 ;; Month
	 (cdr
	  (assoc
	   (upcase (substring date
			      (match-beginning 2)
			      (+ 3 (match-beginning 2))))
	   month))
	 ;; Day
	 (format "%2d" (string-to-int
			(substring date
				   (match-beginning 1) (match-end 1))))
	 ;; Time
	 (substring date (match-beginning 4) (match-end 4)))
      ;; Cannot understand DATE string.
      date
      )
    ))

(defun update-default-diary (arg) "update a diary - with arg, the one for
this file.  Without arg, the default (named in ht-diary-file-name)"
  (interactive "P")
  (if arg
      (update-diary (current-buffer))
    (require-diary)
    (update-diary (get-file-buffer ht-diary-file-name))))

(defun update-diary (buffer)
;; (setq rmail-summary-buffer (get-buffer-create "*Diary*"))
  (let ((obuf (current-buffer)))
    (set-buffer buffer)
    (if (not has-diary-summary)
	(progn (make-local-variable 'has-diary-summary)
	       (setq has-diary-summary t)))
    (rmail-summary)
    (set-buffer obuf)))

(defun do-diary-update () "rmail-summary-mode-hook calls this"
  (if (save-excursion (set-buffer rbuf)
		      has-diary-summary)
      (progn
	(make-local-variable 'diary-summary-buffer)
	(setq diary-summary-buffer t)
	(setq description (concat "Diary " description))
	(setq buffer-read-only nil)
	(sort-diary-hdrs)
	(format-diary-hdrs)
	(setq buffer-read-only t)
	(not-modified)
	(beginning-of-buffer)
	(setq mesg nil)			; to go to earliest, not first in file
	)))

(defun require-diary ()
  (if (not (get-file-buffer ht-diary-file-name))
      (progn (rmail-input ht-diary-file-name)
	     (rmail-show-message 1))
    ))

(defvar diary-summary-buffer nil "flag to identify diary summaries")
(defvar has-diary-summary nil "flag to identify buffers with diary summaries")

(defun sort-diary-hdrs ()
  (interactive)
  (goto-char (point-min))
  (sort-subr nil 'forward-line 'end-of-line 'get-diary-hdr-date nil))

(defun format-diary-hdrs ()
  (goto-char (point-min))
  (while (< (point)(point-max))
    (forward-char 5)
    (delete-char 35)
    (looking-at " *\\([0-9]*\\) *\\([a-zA-Z]*\\) *\\([0-9]*\\) *\\([0-9]*\\)")
    (if (match-beginning 0)
	(let ((day (buffer-substring (match-beginning 1)(match-end 1)))
	      (month (capitalize (buffer-substring (match-beginning 2)
						   (min (+ (match-beginning 2)
							   3)
							(match-end 2)))))
	      (year (buffer-substring (max
				       (- (match-end 3) 2)
				       (match-beginning 3))
				      (match-end 3)))
	      (time (buffer-substring (match-beginning 4)(match-end 4))))
	  (delete-char (+ 1
			  (if (= (match-end 4)
				 (match-beginning 4))
			      0		; fix for no time case
			    1)
			  (- (match-end 4)(match-beginning 1))))
	  (insert (format "  %2s %3s %2s  %4s " day month year time))))
    (forward-line 1))
  (goto-char (point-min)))    

(defun get-diary-hdr-date ()
  (looking-at " *[^ ]* *[^ ]* *[^ ]* *\\(.*\\)$")
  (xxx-comparable-date (buffer-substring (match-beginning 1)(match-end 1))))


(if (not (boundp 'rmail-edit-map))
    (load-library "rmailedit"))
(if (not (boundp 'rmail-summary-mode-map))
    (progn (load-library "rmailsum")
	   (rmail-summary-mode-fun1)))
(define-key rmail-edit-map "\C-c\C-c" 'ht-rmail-cease-edit)
(define-key rmail-edit-map "\C-c\C-]" 'ht-rmail-abort-edit)
;(defvar diary-mode-map (copy-keymap rmail-summary-mode-map))
;(define-key diary-mode-map "s" 'diary-save)
(define-key rmail-mode-map "h" 'ht-rmail-summarise)
(setq rmail-summary-mode-hook 'do-diary-update)

(defvar editing-diary-entry nil)

(defun diary-save ()
  "save parent file and update"
  (interactive)
  (set-buffer rmail-buffer)
  (rmail-expunge-and-save)
  (if has-diary-summary (update-diary (current-buffer))))

(defun ht-rmail-summarise ()
  "Display a summary of all messages, one line per message.
If file is named as ht-diary-file-name, or the summary buffer is already
a diary summary, make it a Diary summary (see
\\[describe-mode] rmail-summary-mode for info)."
  (interactive)
  (if (eq (current-buffer)
	  (get-file-buffer ht-diary-file-name))       
      (update-default-diary t)
    (rmail-summary)))

(defun edit-and-move-to-diary ()
  "try to add a date to subject field, move to diary on exit"
  (interactive)
  (make-local-variable 'editing-diary-entry)
  (setq editing-diary-entry t)
  (rmail-edit-current-message)
  (goto-char (point-min))
  (search-forward "\n\n")
  (let ((try-date (and
		   (re-search-forward
		   "[0-9][-0-9 ]*[- ][a-zA-Z][a-zA-Z]*[- 0-9]*" nil t)
		   (buffer-substring (match-beginning 0)(match-end 0)))))
    (goto-char (point-min))
    (if (and (search-forward "Subject: " nil t)
	     try-date)
	(progn (set-mark (point))
	       (insert try-date)))))

;; private copy to simulate hook
(defun ht-rmail-cease-edit ()
  "check if diary edit, move if so"
  (interactive)
  (rmail-cease-edit)
  (if editing-diary-entry
      (progn (setq editing-diary-entry nil)
	     (ht-output-to-Calendar)
	     (rmail-output-to-rmail-file ht-diary-file-name 1)
	     (ht-rmail-delete-forward))))

;; try to add a diary subject field line to the appropriate caleendar file
(defun ht-output-to-Calendar ()
  (goto-char (point-min))
  (search-forward "Subject: ")
  (or (looking-at
       "\\([0-9]+\\) \\([A-Za-z]+\\) \\([0-9]+\\) \\([0-9:]*\\) ?\\(.*\\)\n")
      (error "not a recognisable diary line"))
  (let ((day (buffer-substring (match-beginning 1) (match-end 1)))
	(month (buffer-substring (match-beginning 2) (match-end 2)))
	(year (buffer-substring (match-beginning 3) (match-end 3)))
	(time (buffer-substring (match-beginning 4) (match-end 4)))
	(message (buffer-substring (match-beginning 5) (match-end 5)))
	(mb (match-beginning 4))
	(me (match-end 5))
	t-month ends)
    (if (file-exists-p ht-Calendar-directory)
	(let* ((year (if (string-match "^19" year)
			 year
		       (concat "19" year)))
	       (dfn (concat ht-Calendar-directory
			    "/xy"
			    year
			    "/xc"
			    day
			    (setq t-month (capitalize
					   (substring month 0 3)))
			    year))
	       (buf (find-file-noselect dfn)))
	  (save-excursion
	    (set-buffer buf)
	    (goto-char (point-max))
	    (if (not (bolp))
		(insert "\n"))
	    (if time
		(insert time " "))
	    (if (string-match " -- \\(.*\\)$" message)
		(progn
		  (setq ends (substring message (match-beginning 1)
				      (match-end 1)))
		  (setq message (substring message 0 (match-beginning 0)))))
	    (insert message)
	    (let ((require-final-newline nil))
	      (save-buffer)))
	  (if ends
	      ;; an end date also given
	      (if (string-match "\\([0-9]+\\) \\([A-Za-z]+\\)" ends)
		  (let ((e-day (substring ends (match-beginning 1)
					  (match-end 1)))
			(e-month (substring ends (match-beginning 2)
					    (match-end 2)))
			t-e-month msg)
		    (setq msg (concat
			       (substring message 0
					  (string-match " " message))
			       " continues"))
		    (if (string-equal (setq t-e-month
					    (capitalize
					     (substring e-month 0 3)))
				      t-month)
			(fill-dates year t-month (1+ (car
						      (read-from-string day)))
				    (car
				     (read-from-string e-day))
				   msg)
		      (fill-dates year t-month (1+ (car
						      (read-from-string day)))
				  (cdr (assoc t-month
					      '(("Jan" . 31)
						("Feb" . 28)
						("Mar" . 31)
						("Apr" . 30)
						("May" . 31)
						("Jun" . 30)
						("Jul" . 31)
						("Aug" . 31)
						("Sep" . 30)
						("Oct" . 31)
						("Nov" . 30)
						("Dec" . 31))))
				  msg)
		      (fill-dates year t-e-month 1
				  (car (read-from-string e-day))
				  msg)))
		(message "\C-g\C-gCouldn't parse end date: %s" ends)))
	  ))))

(defun fill-dates (year month start end mesg)
  "fill the dates between start and end with message in the calendar"
  (let ((day start))
    (while (<= day end)
      (let* ((dfn (concat ht-Calendar-directory
			  "/xy"
			  year
			  "/xc"
			  day
			  month
			  year))
	     (buf (find-file-noselect dfn)))
	  (save-excursion
	    (set-buffer buf)
	    (goto-char (point-max))
	    (if (not (bolp))
		(insert "\n"))
	    (insert mesg)
	    (let ((require-final-newline nil))
	      (save-buffer))))
      (setq day (1+ day)))))

;; private copy
(defun ht-rmail-abort-edit ()
  "add a hook"
  (interactive)
  (setq editing-diary-entry nil)
  (rmail-abort-edit))

(defun rmail-edit-current-message ()
  "Edit the contents of this message."
  (interactive)
  (rmail-edit-mode)
  (make-local-variable 'rmail-old-text)
  (setq rmail-old-text (buffer-substring (point-min) (point-max)))
  (setq buffer-read-only nil)
  (set-buffer-modified-p (buffer-modified-p))
  ;; Make mode line update.
  (if (and (eq (key-binding "\C-c\C-c") 'ht-rmail-cease-edit)
	   (eq (key-binding "\C-c\C-]") 'ht-rmail-abort-edit))
      (if editing-diary-entry
	  (message "Editing: Type C-c C-c to move to diary and return to Rmail, C-c C-] to abort")
	(message "Editing: Type C-c C-c to return to Rmail, C-c C-] to abort"))
    (message (substitute-command-keys
	      "Editing: Type \\[rmail-cease-edit] to return to Rmail, \\[rmail-abort-edit] to abort"))))