Commit 53b0a6f8 authored by Jim Blandy's avatar Jim Blandy

Initial revision

parent 9371315a
;;; mh-e.el --- GNU Emacs interface to the MH mailer
;;; (Version: 3.7 for GNU Emacs Version 18 and MH.5 and MH.6)
(defvar mh-e-RCS-id)
(setq mh-e-RCS-id "$Header: /var/home/larus/lib/emacs/RCS/mh-e.el,v 3.1 90/09/28 15:47:58 larus Exp Locker: larus $")
;;; Copyright (C) 1985-89 Free Software Foundation
;;; Author: James Larus (larus@ginger.Berkeley.EDU or ucbvax!larus)
;;; Please send suggestions and corrections to the above address.
;;; This file contains mh-e, a GNU Emacs front end to the MH mail system.
;; 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.
;; Everyone is granted permission to copy, modify and redistribute
;; GNU Emacs, but only under the conditions described in the
;; document "GNU Emacs copying permission notice". An exact copy
;; of the document is supposed to have been given to you along with
;; GNU Emacs so that you can know how you may redistribute it all.
;; It should be in a file named COPYING. Among other things, the
;; copyright notice and this notice must be preserved on all copies.
;;; Original version for Gosling emacs by Brian Reid, Stanford, 1982.
;;; Modified by James Larus, BBN, July 1984 and UCB, 1984 & 1985.
;;; Rewritten for GNU Emacs, James Larus 1985.
;;; Modified by Stephen Gildea 1988.
;;; NB. MH must have been compiled with the MHE compiler flag or several
;;; features necessary mh-e will be missing from MH commands, specifically
;;; the -build switch to repl and forw.
;;; Constants:
;;; Set for local environment:
;;;* These are now in paths.el.
;;;(defvar mh-progs "/usr/new/mh/" "Directory containing MH commands.")
;;;(defvar mh-lib "/usr/new/lib/mh/" "Directory of MH library.")
(defvar mh-redist-full-contents t
"Non-nil if the `dist' command needs whole letter for redistribution.
This is the case when `send' is compiled with the BERK option.")
;;; Hooks:
(defvar mh-folder-mode-hook nil
"Invoked in `mh-folder mode' on a new folder.")
(defvar mh-letter-mode-hook nil
"Invoked in `mh-letter-mode' on a new letter.")
(defvar mh-compose-letter-function nil
"Invoked in `mh-compose-and-send-mail' on a draft letter.
It is passed three arguments: TO recipients, SUBJECT, and CC recipients.")
(defvar mh-before-send-letter-hook nil
"Invoked at the beginning of the \\[mh-send-letter] command.")
(defvar mh-inc-folder-hook nil
"Invoked after incorporating mail into a folder with \\[mh-inc-folder].")
(defvar mh-quit-hook nil
"Invoked after quitting mh-e with \\[mh-quit].")
(defvar mh-ins-string nil
"Temporarily set by `mh-insert-prefix' prior to running `mh-yank-hooks'.")
(defvar mh-yank-hooks
'(lambda ()
(goto-char (point))
(or (bolp) (forward-line 1))
(while (< (point) (mark))
(insert mh-ins-string)
(forward-line 1))))
"Hook to run citation function.
Expects POINT and MARK to be set to the region to cite.")
;;; Personal preferences:
(defvar mh-clean-message-header nil
"*Non-nil means clean headers of messages that are displayed or inserted.
The variables `mh-visible-headers' and `mh-invisible-headers' control what
is removed.")
(defvar mh-visible-headers nil
"*If non-nil, contains a regexp specifying the headers to keep when cleaning.
Only used if `mh-clean-message-header' is non-nil. Setting this variable
overrides `mh-invisible-headers'.")
(defvar mhl-formfile nil
"*Name of format file to be used by mhl to show messages.
A value of T means use the default format file.
Nil means don't use mhl to format messages.")
(defvar mh-lpr-command-format "lpr -p -J '%s'"
"*Format for Unix command that prints a message.
The string should be a Unix command line, with the string '%s' where
the job's name (folder and message number) should appear. The message text
is piped to this command.")
(defvar mh-print-background nil
"*Print messages in the background if non-nil.
WARNING: do not delete the messages until printing is finished;
otherwise, your output may be truncated.")
(defvar mh-summary-height 4
"*Number of lines in summary window.")
(defvar mh-recenter-summary-p nil
"*Recenter summary window when the show window is toggled off if non-nil.")
(defvar mh-ins-buf-prefix ">> "
"*String to put before each non-blank line of a yanked or inserted message.
Used when the message is inserted in an outgoing letter.")
(defvar mh-do-not-confirm nil
"*Non-nil means do not prompt for confirmation before some commands.
Only affects certain innocuous commands.")
(defvar mh-bury-show-buffer t
"*Non-nil means that the displayed show buffer for a folder is buried.")
(defvar mh-delete-yanked-msg-window nil
"*Controls window display when a message is yanked by \\[mh-yank-cur-msg].
If non-nil, yanking the current message into a draft letter deletes any
windows displaying the message.")
(defvar mh-yank-from-start-of-msg t
"*Controls which part of a message is yanked by \\[mh-yank-cur-msg].
If non-nil, include the entire message. If the symbol `body, then yank the
message minus the header. If nil, yank only the portion of the message
following the point. If the show buffer has a region, this variable is
(defvar mh-reply-default-reply-to nil
"*Sets the person or persons to whom a reply will be sent.
If nil, prompt for recipient. If non-nil, then \\[mh-reply] will use this
value and it should be one of \"from\", \"to\", or \"cc\".")
(defvar mh-recursive-folders nil
"*If non-nil, then commands which operate on folders do so recursively.")
;;; Parameterize mh-e to work with different scan formats. The defaults work
;;; the standard MH scan listings.
(defvar mh-cmd-note 4
"Offset to insert notation.")
(defvar mh-note-repl "-"
"String whose first character is used to notate replied to messages.")
(defvar mh-note-forw "F"
"String whose first character is used to notate forwarded messages.")
(defvar mh-note-dist "R"
"String whose first character is used to notate redistributed messages.")
(defvar mh-good-msg-regexp "^....[^D^]"
"Regexp specifiying the scan lines that are 'good' messages.")
(defvar mh-deleted-msg-regexp "^....D"
"Regexp matching scan lines of deleted messages.")
(defvar mh-refiled-msg-regexp "^....\\^"
"Regexp matching scan lines of refiled messages.")
(defvar mh-valid-scan-line "^ *[0-9]"
"Regexp matching scan lines for messages (not error messages).")
(defvar mh-msg-number-regexp "^ *\\([0-9]+\\)"
"Regexp to find the number of a message in a scan line.
The message's number must be surrounded with \\( \\)")
(defvar mh-msg-search-regexp "^[^0-9]*%d[^0-9]"
"Format string containing a regexp matching the scan listing for a message.
The desired message's number will be an argument to format.")
(defvar mh-flagged-scan-msg-regexp "^....\\D\\|^....\\^\\|^....\\+\\|^.....%"
"Regexp matching flagged scan lines.
Matches lines marked as deleted, refiled, in a sequence, or the cur message.")
(defvar mh-cur-scan-msg-regexp "^....\\+"
"Regexp matching scan line for the cur message.")
(defvar mh-show-buffer-mode-line-buffer-id "{%%b} %s/%d"
"Format string to produce `mode-line-buffer-id' for show buffers.
First argument is folder name. Second is message number.")
(defvar mh-partial-folder-mode-line-annotation "select"
"Annotation when displaying part of a folder.
The string is displayed after the folder's name. NIL for no annotation.")
;;; Real constants:
(defvar mh-invisible-headers
"^Received: \\|^Message-Id: \\|^Remailed-\\|^Via: \\|^Mail-from: \\|^Return-Path: \\|^In-Reply-To: \\|^Resent-"
"Regexp matching lines in a message header that are not to be shown.
If `mh-visible-headers' is non-nil, it is used instead to specify what
to keep.")
(defvar mh-rejected-letter-start "^ ----- Unsent message follows -----$"
"Regexp specifying the beginning of the wrapper around a returned letter.
This wrapper is generated by the mail system when rejecting a letter.")
(defvar mh-to-field-choices '((?t . "To:") (?s . "Subject:") (?c . "Cc:")
(?b . "Bcc:") (?f . "Fcc:"))
"A-list of (character . field name) strings for mh-to-field.")
;;; Global variables:
(defvar mh-user-path ""
"User's mail folder.")
(defvar mh-last-destination nil
"Destination of last refile or write command.")
(defvar mh-folder-mode-map (make-keymap)
"Keymap for MH folders.")
(defvar mh-letter-mode-map (copy-keymap text-mode-map)
"Keymap for composing mail.")
(defvar mh-pick-mode-map (make-sparse-keymap)
"Keymap for searching folder.")
(defvar mh-letter-mode-syntax-table nil
"Syntax table used while in mh-e letter mode.")
(if mh-letter-mode-syntax-table
(setq mh-letter-mode-syntax-table
(make-syntax-table text-mode-syntax-table))
(set-syntax-table mh-letter-mode-syntax-table)
(modify-syntax-entry ?% "." mh-letter-mode-syntax-table))
(defvar mh-folder-list nil
"List of folder names for completion.")
(defvar mh-draft-folder nil
"Name of folder containing draft messages.
NIL means do not use draft folder.")
(defvar mh-unseen-seq nil
"Name of the unseen sequence.")
(defvar mh-previous-window-config nil
"Window configuration before mh-e command.")
(defvar mh-previous-seq nil
"Name of the sequence to which a message was last added.")
(defvar mh-signature-file-name "~/.signature"
"Name of file containing the user's signature.")
;;; Macros and generic functions:
(defmacro mh-push (v l)
(list 'setq l (list 'cons v l)))
(defmacro mh-when (pred &rest body)
(list 'cond (cons pred body)))
(defmacro with-mh-folder-updating (save-modification-flag-p &rest body)
;; Format is (with-mh-folder-updating (SAVE-MODIFICATION-FLAG-P) &body BODY).
;; Execute BODY, which can modify the folder buffer without having to
;; worry about file locking or the read-only flag, and return its result.
;; If SAVE-MODIFICATION-FLAG-P is non-nil, the buffer's modification
;; flag is unchanged, otherwise it is cleared.
(setq save-modification-flag-p (car save-modification-flag-p)) ; CL style
(` (let ((folder-updating-mod-flag (buffer-modified-p)))
(let ((buffer-read-only nil)
(buffer-file-name nil)) ; don't let the buffer get locked
(,@ body))
(, (if save-modification-flag-p
'(mh-set-folder-modified-p folder-updating-mod-flag)
'(mh-set-folder-modified-p nil)))))))
(defun mh-mapc (func list)
(while list
(funcall func (car list))
(setq list (cdr list))))
;;; Entry points:
(defun mh-rmail (&optional arg)
"Inc(orporate) new mail (no arg) or scan a MH mail box (arg given).
This front end uses the MH mail system, which uses different conventions
from the usual mail system."
(interactive "P")
(if arg
(call-interactively 'mh-visit-folder)
(defun mh-smail ()
"Compose and send mail with the MH mail system."
(call-interactively 'mh-send))
(defun mh-smail-other-window ()
"Compose and send mail in other window with the MH mail system."
(call-interactively 'mh-send-other-window))
;;; User executable mh-e commands:
(defun mh-burst-digest ()
"Burst apart the current message, which should be a digest.
The message is replaced by its table of contents and the letters from the
digest are inserted into the folder after that message."
(let ((digest (mh-get-msg-num t)))
(mh-process-or-undo-commands mh-current-folder)
(mh-set-folder-modified-p t) ; lock folder while bursting
(message "Bursting digest...")
(mh-exec-cmd "burst" mh-current-folder digest "-inplace")
(mh-scan-folder mh-current-folder (format "%d-last" mh-first-msg-num))
(message "Bursting digest...done")))
(defun mh-copy-msg (prefix-provided msg-or-seq dest)
"Copy specified MESSAGE(s) to another FOLDER without deleting them.
Default is the displayed message. If optional prefix argument is
provided, then prompt for the message sequence."
(interactive (list current-prefix-arg
(if current-prefix-arg
(mh-read-seq-default "Copy" t)
(mh-get-msg-num t))
(mh-prompt-for-folder "Copy to" "" t)))
(mh-exec-cmd "refile" msg-or-seq "-link" "-src" mh-current-folder dest)
(if prefix-provided
(mh-notate-seq msg-or-seq ?C mh-cmd-note)
(mh-notate msg-or-seq ?C mh-cmd-note)))
(defun mh-delete-msg (msg-or-seq)
"Mark the specified MESSAGE(s) for subsequent deletion and move to the next.
Default is the displayed message. If optional prefix argument is
given then prompt for the message sequence."
(interactive (list (if current-prefix-arg
(mh-read-seq-default "Delete" t)
(mh-get-msg-num t))))
(if (numberp msg-or-seq)
(mh-delete-a-msg msg-or-seq)
(mh-map-to-seq-msgs 'mh-delete-a-msg msg-or-seq))
(defun mh-delete-msg-no-motion (msg-or-seq)
"Mark the specified MESSAGE(s) for subsequent deletion.
Default is the displayed message. If optional prefix argument is
provided, then prompt for the message sequence."
(interactive (list (if current-prefix-arg
(mh-read-seq-default "Delete" t)
(mh-get-msg-num t))))
(if (numberp msg-or-seq)
(mh-delete-a-msg msg-or-seq)
(mh-map-to-seq-msgs 'mh-delete-a-msg msg-or-seq)))
(defun mh-delete-msg-from-seq (prefix-provided msg-or-seq &optional from-seq)
"Delete MESSAGE (default: displayed message) from SEQUENCE.
If optional prefix argument provided, then delete all messages
from a sequence."
(interactive (let ((argp current-prefix-arg))
(list argp
(if argp
(mh-read-seq-default "Delete" t)
(mh-get-msg-num t))
(if (not argp)
(mh-read-seq-default "Delete from" t)))))
(if prefix-provided
(mh-remove-seq msg-or-seq)
(mh-remove-msg-from-seq msg-or-seq from-seq)))
(defun mh-edit-again (msg)
"Clean-up a draft or a message previously sent and make it resendable."
(interactive (list (mh-get-msg-num t)))
(let* ((from-folder mh-current-folder)
(config (current-window-configuration))
(cond ((and mh-draft-folder (equal from-folder mh-draft-folder))
(find-file (mh-msg-filename msg))
(rename-buffer (format "draft-%d" msg))
(mh-read-draft "clean-up" (mh-msg-filename msg) nil)))))
(mh-clean-msg-header (point-min)
(goto-char (point-min))
(set-buffer-modified-p nil)
(mh-compose-and-send-mail draft "" from-folder nil nil nil nil nil nil
(defun mh-execute-commands ()
"Process outstanding delete and refile requests."
(if mh-narrowed-to-seq (mh-widen))
(mh-process-commands mh-current-folder)
(mh-goto-cur-msg) ; after mh-set-scan-mode for efficiency
t) ; return t for write-file-hooks
(defun mh-extract-rejected-mail (msg)
"Extract a letter returned by the mail system and make it resendable.
Default is the displayed message."
(interactive (list (mh-get-msg-num t)))
(let ((from-folder mh-current-folder)
(config (current-window-configuration))
(draft (mh-read-draft "extraction" (mh-msg-filename msg) nil)))
(goto-char (point-min))
(cond ((re-search-forward mh-rejected-letter-start nil t)
(forward-char 1)
(delete-region (point-min) (point))
(mh-clean-msg-header (point-min)
(message "Does not appear to be a rejected letter.")))
(goto-char (point-min))
(set-buffer-modified-p nil)
(mh-compose-and-send-mail draft "" from-folder msg (mh-get-field "To")
(mh-get-field "From") (mh-get-field "cc")
nil nil config)))
(defun mh-first-msg ()
"Move to the first message."
(goto-char (point-min)))
(defun mh-forward (prefix-provided msg-or-seq to cc)
"Forward MESSAGE(s) (default: displayed message).
If optional prefix argument provided, then prompt for the message sequence."
(interactive (list current-prefix-arg
(if current-prefix-arg
(mh-read-seq-default "Forward" t)
(mh-get-msg-num t))
(read-string "To: ")
(read-string "Cc: ")))
(let* ((folder mh-current-folder)
(config (current-window-configuration))
;; forw always leaves file in "draft" since it doesn't have -draft
(draft-name (expand-file-name "draft" mh-user-path))
(draft (cond ((or (not (file-exists-p draft-name))
(y-or-n-p "The file 'draft' exists. Discard it? "))
(mh-exec-cmd "forw"
"-build" mh-current-folder msg-or-seq)
(mh-read-draft "" draft-name t)
(mh-insert-fields "To:" to "Cc:" cc)
(set-buffer-modified-p nil)))
(mh-read-draft "" draft-name nil)))))
(goto-char (point-min))
(re-search-forward "^------- Forwarded Message")
(forward-line -1)
(narrow-to-region (point) (point-max))
(let* ((subject (save-excursion (mh-get-field "From:")))
(trim (string-match "<" subject))
(forw-subject (save-excursion (mh-get-field "Subject:"))))
(if trim
(setq subject (substring subject 0 (1- trim))))
(mh-insert-fields "Subject:" (format "[%s: %s]" subject forw-subject)))
(if prefix-provided
(mh-add-msgs-to-seq (mh-seq-to-msgs msg-or-seq) 'forwarded t)
(mh-add-msgs-to-seq msg-or-seq 'forwarded t))
(mh-compose-and-send-mail draft "" folder msg-or-seq
to subject cc
mh-note-forw "Forwarded:"
(defun mh-goto-msg (number &optional no-error-if-no-message dont-show)
"Position the cursor at message NUMBER.
Non-nil second argument means do not signal an error if message does not exist.
Non-nil third argument means not to show the message.
Return non-nil if cursor is at message."
(interactive "NMessage number? ")
(let ((cur-msg (mh-get-msg-num nil))
(starting-place (point))
(msg-pattern (mh-msg-search-pat number)))
(cond ((cond ((and cur-msg (= cur-msg number)) t)
((and cur-msg
(< cur-msg number)
(re-search-forward msg-pattern nil t)) t)
((and cur-msg
(> cur-msg number)
(re-search-backward msg-pattern nil t)) t)
(t ; Do thorough search of buffer
(goto-char (point-max))
(re-search-backward msg-pattern nil t)))
(if (not dont-show) (mh-maybe-show number))
(goto-char starting-place)
(if (not no-error-if-no-message)
(error "No message %d" number))
(defun mh-inc-folder (&optional maildrop-name)
"Inc(orporate) new mail into +inbox.
Optional prefix argument specifies an alternate maildrop from the default.
If this is given, mail is incorporated into the current folder, rather
than +inbox. Run `mh-inc-folder-hook' after incorporating new mail."
(interactive (list (if current-prefix-arg
(read-file-name "inc mail from file: "
(let ((config (current-window-configuration)))
(if (not maildrop-name)
(cond ((not (get-buffer "+inbox"))
(mh-make-folder "+inbox")
(setq mh-previous-window-config config))
((not (eq (current-buffer) (get-buffer "+inbox")))
(switch-to-buffer "+inbox")
(setq mh-previous-window-config config)))))
(mh-get-new-mail maildrop-name)
(run-hooks 'mh-inc-folder-hook))
(defun mh-kill-folder ()
"Remove the current folder."
(if (or mh-do-not-confirm
(yes-or-no-p (format "Remove folder %s? " mh-current-folder)))
(let ((folder mh-current-folder))
(mh-set-folder-modified-p t) ; lock folder to kill it
(mh-exec-cmd-daemon "rmf" folder)
(mh-remove-folder-from-folder-list folder)
(message "Folder %s removed" folder)
(mh-set-folder-modified-p nil) ; so kill-buffer doesn't complain
(kill-buffer mh-show-buffer)
(kill-buffer folder))
(message "Folder not removed")))
(defun mh-last-msg ()
"Move to the last message."
(goto-char (point-max))
(while (and (not (bobp)) (looking-at "^$"))
(forward-line -1)))
(defun mh-list-folders ()
"List mail folders."
(with-output-to-temp-buffer " *mh-temp*"
(switch-to-buffer " *mh-temp*")
(message "Listing folders...")
(mh-exec-cmd-output "folders" t)
(goto-char (point-min))
(message "Listing folders...done"))))
(defun mh-msg-is-in-seq (msg)
"Display the sequences that contain MESSAGE (default: displayed message)."
(interactive (list (mh-get-msg-num t)))
(message "Message %d is in sequences: %s"
(mapconcat 'concat
(mh-list-to-string (mh-seq-containing-msg msg))
" ")))
(defun mh-narrow-to-seq (seq)
"Restrict display of this folder to just messages in a sequence.
Reads which sequence. Use \\[mh-widen] to undo this command."
(interactive (list (mh-read-seq "Narrow to" t)))
(let ((eob (point-max)))
(with-mh-folder-updating (t)
(cond ((mh-seq-to-msgs seq)
(mh-copy-seq-to-point seq eob)
(narrow-to-region eob (point-max))
(mh-make-folder-mode-line (symbol-name seq))
(mh-recenter nil)
(setq mh-narrowed-to-seq seq))
(error "No messages in sequence `%s'" (symbol-name seq)))))))
(defun mh-next-undeleted-msg (&optional arg)
"Move to next undeleted message in window."
(interactive "P")
(forward-line (prefix-numeric-value arg))
(setq mh-next-direction 'forward)
(cond ((re-search-forward mh-good-msg-regexp nil 0 arg)
(forward-line -1)
(if (get-buffer mh-show-buffer)
(delete-windows-on mh-show-buffer)))))
(defun mh-pack-folder (range)
"Renumber the messages of a folder to be 1..n.
First, offer to execute any outstanding commands for the current folder.
If optional prefix argument provided, prompt for the range of messages
to display after packing. Otherwise, show the entire folder."
(interactive (list (if current-prefix-arg
"Range to scan after packing [all]? ")
(mh-pack-folder-1 range)
(message "Packing folder...done"))
(defun mh-pipe-msg (prefix-provided command)
"Pipe the current message through the given shell COMMAND.
If optional prefix argument is provided, send the entire message.
Otherwise just send the message's body."
(list current-prefix-arg (read-string "Shell command on message: ")))
(set-buffer mh-show-buffer)
(goto-char (point-min))
(if (not prefix-provided) (search-forward "\n\n"))