--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/emacs/diary.el	Tue May 25 13:57:42 2021 -0400
@@ -0,0 +1,341 @@
+;; 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"))))