mh-e.el

早期freebsd实现

;;;  mh-e.el	(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 $")
(provide 'mh-e)

;;;  Copyright (C) 1985-89 Free Software Foundation
;;;     Author:  James Larus ([e-mail] 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.

;; This file is part of GNU Emacs.

;; GNU Emacs is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 1, or (at your option)
;; any later version.

;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.

;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING.  If not, write to
;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.


;;;  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.  [e-mail]
;;;  Modified by Stephen Gildea 1988.  [e-mail]


;;;  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 ()
    (save-excursion
      (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
ignored.")

(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.")


;;; 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)))
       (prog1
	   (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")
  (mh-find-path)
  (if arg
      (call-interactively 'mh-visit-folder)
      (mh-inc-folder)))


(defun mh-smail ()
  "Compose and send mail with the MH mail system."
  (interactive)
  (mh-find-path)
  (call-interactively 'mh-send))


(defun mh-smail-other-window ()
  "Compose and send mail in other window with the MH mail system."
  (interactive)
  (mh-find-path)
  (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."
  (interactive)
  (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
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))
  (mh-next-msg))


(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