--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/mail-extras.el	Wed Dec 20 17:58:34 2023 +0000
@@ -0,0 +1,492 @@
+;; Last edited: Fri Nov  2 10:26:24 1990
+;; extra widgets for rmail and 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.
+
+(require 'rmail)
+(require 'sendmail)
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; mods and fixes for reading mail ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defvar ht-last-file (expand-file-name "~/XMAIL")
+  "default for moving mail to")
+(make-variable-buffer-local 'ht-last-file)
+
+(defvar rmht-always-recompress t
+  "If non-nil, when saving into compressed babyl file,
+always recompress and save immediately")
+
+(defvar rmht-allow-autosave t
+  "if non-nil, leaves autosave alone for compressed babyl files,
+otherwise turns it off")
+
+(add-hook 'rmail-mode-hook 'rmail-mode-fun1)
+(add-hook 'rmail-mode-hook 'rmail-mode-fun2)
+
+;; run the first time in to RMAIL
+(defun rmail-mode-fun1 ()
+  "add ht's mods to RMAIL"
+  (define-key rmail-mode-map "R" 'reply-w/o-cc)
+  (define-key rmail-mode-map "M" 'rmht-output)
+  (define-key rmail-mode-map "H" 'print-buffer)
+  (define-key rmail-mode-map "W" 'edit-and-move-to-diary)
+  (define-key rmail-mode-map "D" 'update-default-diary)
+  (define-key rmail-mode-map "F" 're-post-failed-mail)
+  (define-key rmail-mode-map "B" 'ht-write-body-to-file)
+  (define-key rmail-mode-map "E" 'extract-attachment)
+  ;; fix the doc string
+  (repl-comment 'rmail-mode
+	"Rmail Mode is used by \\[rmail] for editing Rmail files.
+All normal editing commands are turned off.
+Instead, these commands are available (additions from ht's mail-extras.el
+indicated by *:
+
+.	Move point to front of this message (same as \\[beginning-of-buffer]).
+SPC	Scroll to next screen of this message.
+DEL	Scroll to previous screen of this message.
+n	Move to Next non-deleted message.
+p	Move to Previous non-deleted message.
+M-n	Move to Next message whether deleted or not.
+M-p	Move to Previous message whether deleted or not.
+>	Move to the last message in Rmail file.
+j	Jump to message specified by numeric position in file.
+M-s	Search for string and show message it is found in.
+d	Delete this message, move to next nondeleted.
+C-d	Delete this message, move to previous nondeleted.
+u	Undelete message.  Tries current message, then earlier messages
+	till a deleted message is found.
+e	Expunge deleted messages.
+s	Expunge and save the file.
+q       Quit Rmail: expunge, save, then switch to another buffer.
+C-x C-s Save without expunging.
+g	Move new mail from system spool directory or mbox into this file.
+m	Mail a message (same as \\[mail-other-window]).
+c	Continue composing outgoing message started before.
+r	Reply to this message.  Like m but initializes some fields.
+R	* Like r, but reply to originator only.
+f	Forward this message to another user.
+F	* like f, but assumes message is \"failed mail\" for re-sending
+o       Output this message to an Rmail file (append it).
+C-o	Output this message to a Unix-format mail file (append it).
+M	* Output this message to a file,
+	  in format determined by extension (babyl for RMAIL/msg for Unix).
+B	* Write the body of the message to a file, leaving a pointer
+H	* Print the message (same as \\<global-map>\\[print-buffer]).\\<rmail-mode-map>
+i	Input Rmail file.  Run Rmail on that file.
+a	Add label to message.  It will be displayed in the mode line.
+k	Kill label.  Remove a label from current message.
+C-M-n   Move to Next message with specified label
+          (label defaults to last one specified).
+          Standard labels: filed, unseen, answered, forwarded, deleted.
+          Any other label is present only if you add it with `a'.
+C-M-p   Move to Previous message with specified label
+h, C-M-h Show headers buffer, with a one line summary of each message.
+l, C-M-l Like h only just messages with particular label(s) are summarized.
+C-M-r   Like h only just messages with particular recipient(s) are summarized.
+t	Toggle header, show Rmail header if unformatted or vice versa.
+w	Edit the current message.  C-c C-c to return to Rmail.
+W	* Edit the subject field.  C-c C-c to move the message to the Diary.
+D	* Update the Diary.
+
+Messages for the diary (see also \\[describe-mode] in rmail-summary mode
+or \\[describe-function] rmail-summary-mode) should have a subject field
+which begins with the date and optional time of the event described therein.
+These must be in the form
+     d m y t
+where d is one or two digits for the day,
+m is either the full month name or the first three letters thereof,
+y is two digits for the year,
+and t, if present, is 4 digits for the time,
+thus for example
+     31 Jun 91 1530
+")
+  (remove-hook 'rmail-mode-hook 'rmail-mode-fun1))
+
+(defun rmail-mode-fun2 ()
+  "always run in RMAIL mode"
+  (setq case-fold-search t))
+
+(defun reply-w/o-cc ()
+  "Reply as r, but without sending to other recipients"
+  (interactive)
+  (rmail-reply t))
+
+(defun rmht-output (&optional file-name gnus)
+  "Move to a file, determining format by extension (babyl/msg)"
+  (interactive)
+  (if (not file-name)
+      (setq file-name (car (get-move-file-name))))
+  (if (string-match "\\.g?[zZ]$" file-name)
+      (let ((clean-file-name (substring file-name 0 (match-beginning 0)))
+	    there)
+	(if (setq there (get-file-buffer clean-file-name))
+	    nil
+	  (save-window-excursion (rmail clean-file-name)
+				 (setq there
+				       (get-file-buffer clean-file-name))))
+	(rmht-output clean-file-name gnus)
+	(if rmht-always-recompress
+	    (save-excursion
+	      (set-buffer there)
+	      (save-buffer))
+	  (if (not rmht-allow-autosave)
+	      (save-excursion
+		(set-buffer there)
+		(auto-save-mode -1)))))
+    (setq file-name (expand-file-name file-name))
+    (save-excursion
+      (if (string-match "\\.babyl$" file-name)
+	  (if gnus
+	      (gnus-output-to-rmail file-name)
+	    (rmail-output-to-rmail-file file-name 1))
+	(if (string-match "\\.msg$" file-name)
+	    (if (or (get-file-buffer file-name)
+		    (file-exists-p file-name)
+		    (yes-or-no-p
+		     (concat "\"" file-name "\" does not exist, create it? ")))
+		(rmail-output file-name 1)
+	      (error "Output file does not exist"))
+	  (error "not a valid mail file: %s" file-name))))
+    (setq ht-last-file file-name)
+    (if (not gnus) (ht-rmail-delete-forward))))
+
+(defun get-move-file-name ()
+  "get a file name for moving a message to"
+  (list (read-file-name
+	 (concat "Output message to file: (default "
+		 (file-name-nondirectory ht-last-file)
+		 ") ")
+	 (file-name-directory ht-last-file)
+	 ht-last-file)))
+
+(defun re-post-failed-mail ()
+  "try to salvage the original from failed mail and prepare to resend it"
+  (interactive)
+  (rmail-forward nil)
+  (let ((top (point))
+	subjp textp)
+    (re-search-forward "^Subject: ")
+    (kill-line nil)
+    (setq subjp (point))
+    (re-search-forward "^From: ") ; the bouncer
+    (re-search-forward "^From: ") ; should be us
+    (re-search-forward "^Subject: ")
+    (kill-line nil)
+    (save-excursion (goto-char subjp)
+		    (yank))
+    (beginning-of-line 3)
+    (setq textp (point))
+    (goto-char top)
+    (re-search-forward (concat "^" (regexp-quote mail-header-separator) "$"))
+    (beginning-of-line 2)
+    (delete-region (point) textp)
+    (goto-char top)))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; mods and fixes for mail summaries ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(add-hook 'rmail-summary-mode-hook 'rmail-summary-mode-fun1)
+ 
+;; run the first time we make a summary window
+(defun rmail-summary-mode-fun1 ()
+  "install ht's mods"
+  (define-key rmail-summary-mode-map "r" 'rms-reply-w-cc)
+  (define-key rmail-summary-mode-map "R" 'rms-reply-w/o-cc)
+  (define-key rmail-summary-mode-map "s" 'diary-save)
+  (define-key rmail-summary-mode-map "m" 'rms-move)
+  (define-key rmail-summary-mode-map "d" 'rms-delete)
+  (define-key rmail-summary-mode-map "h" 'rms-hardcopy)
+  (define-key rmail-summary-mode-map " " 'ht-rmailsum-scroll-msg-up)
+  (define-key rmail-summary-mode-map "\177" 'ht-rmailsum-scroll-msg-down)
+  ;; fix the doc string
+  (repl-comment 'rmail-summary-mode
+	"Major mode in effect in Rmail summary buffer.
+A subset of the Rmail mode commands are supported in this mode. 
+As commands are issued in the summary buffer the corresponding
+mail message is displayed in the rmail buffer.
+Modifications from ht's mail-extras.el indicated with *:
+
+n       Move to next undeleted message, or arg messages.
+p       Move to previous undeleted message, or arg messages.
+C-n	Move to next, or forward arg messages.
+C-p	Move to previous, or previous arg messages.
+j       Jump to the message at the cursor location.
+d       Delete the message at the cursor location and move to next message.
+u	Undelete this or previous deleted message.
+q	Quit Rmail.
+x	Exit and kill the summary window.
+space   * If cursor is on line of current message,
+	  scroll message window forward.  Otherwise, jump to indicated message.
+delete  * same as space, but scrolls backward.
+r	* Same as r in rmail window.  Reply to current message.
+R	* Same as R in rmail window. Reply to current message, originator only.
+s	* Update and save the rmail file, and re-summarise.  Re-sorts if Diary.
+m	* Same as M in rmail window.  Moves message to file.
+h	* Same as H in rmail window.  Prints message on line printer.
+
+Entering this mode calls value of hook variable rmail-summary-mode-hook.
+
+If the file summarised is called by the name given in ht-diary-file-name,
+which defaults to diary.babyl,
+then the summary will be called *Diary*, sorted in date order and
+formated in a special way.
+
+Messages in the diary should have a subject field
+which begins with the date and optional time of the event described therein.
+These must be in the form
+     d m y t
+where d is one or two digits for the day,
+m is either the full month name or the first three letters thereof,
+y is two digits for the year,
+and t, if present, is 4 digits for the time,
+thus for example
+Subject: 31 Jun 91 1530 Hades freezing ceremony followed by champagne reception
+")
+  (remove-hook 'rmail-summary-mode-hook 'rmail-summary-mode-fun1))
+
+(defun rmht-sum-reply (sender-only)
+  "reply to current message"
+  (rmail-summary-goto-msg)
+  (pop-to-buffer rmail-buffer)
+  (rmail-reply sender-only)
+  (switch-to-buffer rmail-summary-buffer)
+  (switch-to-buffer "*mail*")
+)
+
+(defun rms-reply-w-cc ()
+  "Do r in RMAIL - reply to everybody"
+  (interactive)
+  (rmht-sum-reply nil))
+
+(defun rms-reply-w/o-cc ()
+  "Do R in RMAIL - reply to sender only"
+  (interactive)
+  (rmht-sum-reply t))
+
+(defun rms-save ()
+  "expunge deleted messages, save RMAIL file and re-display headers"
+  (interactive)
+  (pop-to-buffer rmail-buffer)
+  (rmail-expunge-and-save)
+  (rmail-summary))
+
+(defun rms-delete ()
+  "delete current and move down to next in summary buffer"
+  (interactive)
+  (rmail-summary-goto-msg)
+  (save-excursion
+    (rmail-summary-delete-forward nil))
+  (rms-del))
+
+(defun rms-move ()
+  "Move to a file, mode determined by file extension (babyl/msg)"
+  (interactive)
+  (rmail-summary-goto-msg)
+  (save-excursion
+    (set-buffer rmail-buffer)
+    (rmht-output))
+  (rms-del))
+
+(defun rms-del ()
+  "mark current summary line as deleted and move down"
+  (let ((buffer-read-only nil))
+    (skip-chars-forward " ")
+    (skip-chars-forward "[0-9]")
+    (delete-char 1)
+    (insert "D"))
+  (forward-line 1))
+
+(defun rms-hardcopy ()
+  "hardcopy the current message"
+  (interactive)
+  (pop-to-buffer rmail-buffer)
+  (print-buffer)
+  (pop-to-buffer rmail-summary-buffer))
+
+
+;; fix interpretation of SPACE and DEL in summary windows to
+;; 1) scroll the right window regardless of how many panes are up;
+;; 2) go to the message associated with the current line if not already there,
+;;    a la gnus, for instance
+
+(defun ht-rmailsum-normalise ()
+  "if not already showing message named on current line, go to it & return t"
+  (beginning-of-line)
+  (let ((current-msg-num (cdr (assoc 'rmail-current-message
+				     (buffer-local-variables
+				      (or rmail-buffer
+					  (error
+					   "not in a summary buffer"))))))
+	(line-message-num (string-to-int
+			   (buffer-substring
+			    (point)
+			    (min (point-max)(+ 5 (point)))))))
+    (if (= current-msg-num line-message-num)
+	nil
+      (rmail-summary-goto-msg line-message-num)
+      t)))
+
+(defun ht-rmailsum-scroll-msg-up (&optional dist)
+  "goto other message or scroll current message forward"
+  (interactive "P")
+  (if (ht-rmailsum-normalise)
+      nil
+    (pop-to-buffer rmail-buffer)
+    (scroll-up dist)
+    (pop-to-buffer rmail-summary-buffer)))
+
+(defun ht-rmailsum-scroll-msg-down (&optional dist)
+  "goto other message or scroll current message backward"
+  (interactive "P")
+  (if (ht-rmailsum-normalise)
+      nil
+    (pop-to-buffer rmail-buffer)
+    (scroll-down dist)
+    (pop-to-buffer rmail-summary-buffer)))
+
+(autoload 'edit-and-move-to-diary "diary")
+(autoload 'update-diary "diary")
+(autoload 'diary-save "diary")
+
+;;; I _think_ (almost?) everything above here is diary-related, so belongs
+;;; in diary.el.
+
+;; unfortunately, gnus mucks about with the buffers before calling
+;; mail, so we have to intervene to make the about-to-mail-hook work right
+
+(defun ht-Subject-mode-fun ()
+  "fix the map to save window state"
+;  (define-key gnus-summary-mode-map "r" 'ht-Subject-mail-reply)
+;  (define-key gnus-summary-mode-map "R" 'ht-Subject-mail-reply-with-original)
+;  (define-key gnus-summary-mode-map "m" 'ht-Subject-mail-other-window)
+  (define-key gnus-summary-save-map "M" 'ht-Subject-move)
+  (remove-hook 'gnus-summary-mode-hook 'ht-Subject-mode-fun))
+
+(add-hook 'gnus-summary-mode-hook 'ht-Subject-mode-fun)
+
+(defun ht-Subject-mail-reply (yank)
+  "Runs about-to-mail-hook, then calls gnus-summary-mail-reply"
+  (interactive "P")
+  (require 'sendmail)
+  (run-hooks 'about-to-mail-hook)
+  (let (about-to-mail-hook)
+    (gnus-summary-reply yank)))
+
+(defun ht-Subject-mail-reply-with-original ()
+  "Runs about-to-mail-hook, then calls gnus-summary-mail-reply-with-original"
+  (interactive)
+  (require 'sendmail)
+  (run-hooks 'about-to-mail-hook)
+  (let (about-to-mail-hook)
+    (gnus-summary-reply-with-original)))
+
+(defun ht-Subject-mail-other-window ()
+  "Runs about-to-mail-hook, then calls gnus-summary-mail-other-window"
+  (interactive)
+  (require 'sendmail)
+  (run-hooks 'about-to-mail-hook)
+  (let (about-to-mail-hook)
+    (gnus-summary-mail-other-window)))
+
+(defun ht-Subject-move ()
+  "Move article to a file, mode determined by file extension (babyl/msg)"
+  (interactive)
+  (gnus-summary-select-article)
+  (save-excursion
+    (set-buffer gnus-article-buffer)
+    (rmht-output nil t)))
+
+
+(defun ht-write-body-to-file (file)
+  "Write the body of the message to a file and replace it with a pointer"
+  (interactive "FFile to save in: ")
+  (goto-char (point-min))
+  (or (search-forward "\n\n" nil t)
+      (error "Can't find text"))
+  (write-region (point)(point-max) file)
+  (rmail-edit-current-message)
+  (delete-region (point)(point-max))
+  (insert "\n>> " file "\n")
+  (rmail-cease-edit)
+  (rmht-output))
+
+(defun extract-attachment ()
+  "extract attachments from a multi-part mime message"
+  (interactive)
+  (rmail-toggle-header)
+  (mime/viewer-mode)
+  (let ((pt 0))
+    (while (progn
+	     (mime-viewer/next-content)
+	     (and
+	      (equal "*Preview-RMAIL*" (buffer-name (current-buffer)))
+	      (not (= pt (point)))))
+      (setq pt (point))
+      (if (looking-at "^\\[[0-9]* [^ ]+ <")
+	  (mime-viewer/extract-content))))
+  (if (not (equal "*Preview-RMAIL*" (buffer-name (current-buffer))))
+      ;; we fell off the end
+      (rmail-previous-undeleted-message 1))
+  (kill-buffer "*Preview-RMAIL*")
+  )
+
+;(load-library "mailcrypt") ; provides "mc-setversion"
+;(mc-setversion "gpg")    ; for PGP 2.6 (default); also "5.0" and "gpg"
+;(autoload 'mc-install-write-mode "mailcrypt" nil t)
+;(autoload 'mc-install-read-mode "mailcrypt" nil t)
+;(add-hook 'mail-mode-hook 'mc-install-write-mode)
+;(add-hook 'gnus-summary-mode-hook 'mc-install-read-mode)
+;(add-hook 'message-mode-hook 'mc-install-write-mode)
+;(add-hook 'news-reply-mode-hook 'mc-install-write-mode)
+;(setq mc-passwd-timeout 6000)
+;;; Key server at Cambridge University (Cambridge, England)
+;(setq mc-pgp-fetch-methods      '(mc-pgp-fetch-from-keyrings
+;				  mc-pgp-fetch-from-http))
+;(require 'pgg)
+;(add-hook 'message-send-hook 'my-sign-message)
+(setq hack-yn-map (copy-keymap query-replace-map))
+(define-key hack-yn-map 'return 'act)
+
+(defun my-sign-message ()
+  (goto-char (point-min))
+  (unless
+      (or
+       (re-search-forward "<#\\(part\\|mml\\) " nil t)
+					; signing attachments doesn't seem
+                                        ; to work well
+       (search-forward "\n-- \nHenry S. Thompson, Central Edinburgh LM" nil t)
+					; Don't sign Quaker mail
+       )
+    (let* ((headers (mail-header-extract-no-properties))
+	   (cc (mail-header 'cc))
+	   (to (mail-header 'to)))
+      (if (and to
+	       (not (string-match "htcalendar[@]markup\.co\.uk" to))
+	       (not (string-match "^ht$" to))
+	       (or 
+		(string-match "w3.org" to)
+		(and cc (string-match "w3.org" cc))
+		(let ((query-replace-map hack-yn-map))
+		  (y-or-n-p "Sign message? "))))
+	  (mml-secure-message-sign-pgp)))))
+
+(provide 'mail-extras)