xemacs: shared/mail-extras.el comparison

comparison shared/mail-extras.el @ 0:107d592c5f4a

DICE versions, used by pers/common, recursive, I think/hope

author	Henry S. Thompson <ht@inf.ed.ac.uk>
date	Mon, 08 Feb 2021 11:44:37 +0000
parents
children	0a81352bd7d0

comparison

equal deleted inserted replaced

--1:000000000000
+:107d592c5f4a
+;; 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.
+(provide 'mail-extras)
+(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")
+;; 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*")
+)
+;; see message-citation-line-function in message.el
+(defun safe-citation ()
+(when message-reply-headers
+(let ((from (mail-header-from message-reply-headers)))
+(cond ((string-match "^\"?\\([^\"]*\\)\"? <.*>$" from)
+	     (insert (match-string 1 from) " writes:\n\n"))
+	    ((string-match "^\\([^<@]*\\)@" from)
+	     (insert (match-string 1 from) " writes:\n\n"))
+	    (t
+	     (insert "[anon] writes:\n\n"))))))
+(setq message-citation-line-function (function safe-citation))
+;(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)))))

Mercurial > hg > xemacs

comparison shared/mail-extras.el @ 0:107d592c5f4a