rmail.el

早期freebsd实现

;; "RMAIL" mail reader for Emacs.
;; Copyright (C) 1985, 1986, 1987, 1988, 1990 Free Software Foundation, Inc.

;; 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.


;; Souped up by shane@mit-ajax based on ideas of [e-mail]
;;   New features include attribute and keyword support, message
;;   selection by dispatch table, summary by attributes and keywords,
;;   expunging by dispatch table, sticky options for file commands.

(require 'mail-utils)
(provide 'rmail)

; these variables now declared in loaddefs or paths.el
;(defvar rmail-spool-directory "/usr/spool/mail/"
;  "This is the name of the directory used by the system mailer for\n\
;delivering new mail.  It's name should end with a slash.")
;(defvar rmail-dont-reply-to-names
;  nil
;  "*A regexp specifying names to prune of reply to messages.
;nil means dont reply to yourself.")
;(defvar rmail-ignored-headers
;   "^via:\\|^mail-from:\\|^origin:\\|^status:\\|^received:\\|^message-id:\\|^summary-line:"
;   "*Gubbish headers one would rather not see.")
;(defvar rmail-file-name
;  (expand-file-name "~/RMAIL")
;  "")
;
;(defvar rmail-delete-after-output nil
;  "*Non-nil means automatically delete a message that is copied to a file.")
;
;(defvar rmail-primary-inbox-list 
;  '("/usr/spool/mail/$USER" "~/mbox")
; "")

;; these may be altered by site-init.el to match the format of mmdf files
;;  delimitation used on a given host (delim1 and delim2 from the config
;;  files)

(defvar mmdf-delim1 "^\001\001\001\001\n"
  "Regexp marking the start of an mmdf message")
(defvar mmdf-delim2 "^\001\001\001\001\n"
  "Regexp marking the end of an mmdf message")

(defvar rmail-message-filter nil
  "If non nil, is a filter function for new headers in RMAIL.
Called with region narrowed to unformatted header.")

(defvar rmail-mode-map nil)

;; Message counters and markers.  Deleted flags.

(defvar rmail-current-message nil)
(defvar rmail-total-messages nil)
(defvar rmail-message-vector nil)
(defvar rmail-deleted-vector nil)

;; These are used by autoloaded rmail-summary.

(defvar rmail-summary-buffer nil)
(defvar rmail-summary-vector nil)

;; `Sticky' default variables.

;; Last individual label specified to a or k.
(defvar rmail-last-label nil)
;; Last set of labels specified to C-M-n or C-M-p or C-M-l.
(defvar rmail-last-multi-labels nil)
(defvar rmail-last-file nil)
(defvar rmail-last-rmail-file nil)

;;;; *** Rmail Mode ***

(defun rmail (&optional file-name-arg)
  "Read and edit incoming mail.
Moves messages into file named by  rmail-file-name  (a babyl format file)
 and edits that file in RMAIL Mode.
Type \\[describe-mode] once editing that file, for a list of RMAIL commands.

May be called with filename as argument;
then performs rmail editing on that file,
but does not copy any new mail into the file."
  (interactive (if current-prefix-arg
		   (list (read-file-name "Run rmail on RMAIL file: "
					 nil nil t))))
  (or rmail-last-file
      (setq rmail-last-file (expand-file-name "~/xmail")))
  (or rmail-last-rmail-file
      (setq rmail-last-rmail-file (expand-file-name "~/XMAIL")))
  (let* ((file-name (expand-file-name (or file-name-arg rmail-file-name)))
	 (existed (get-file-buffer file-name))
	 ;; Don't be confused by apparent local-variables spec
	 ;; in the last message in the RMAIL file.
	 (inhibit-local-variables t))
    ;; Like find-file, but in the case where a buffer existed
    ;; and the file was reverted, recompute the message-data.
    (if (and existed (not (verify-visited-file-modtime existed)))
	(progn
	  (find-file file-name)
	  (if (and (verify-visited-file-modtime existed)
		   (eq major-mode 'rmail-mode))
	      (progn (rmail-forget-messages)
		     (rmail-set-message-counters))))
      (find-file file-name))
    (if (eq major-mode 'rmail-edit-mode)
	(error "exit rmail-edit-mode before getting new mail"))
    (if (and existed (eq major-mode 'rmail-mode))
	nil
      (rmail-mode)
      ;; Provide default set of inboxes for primary mail file ~/RMAIL.
      (and (null rmail-inbox-list)
	   (null file-name-arg)
	   (setq rmail-inbox-list
		 (or rmail-primary-inbox-list
		     (list "~/mbox"
			   (concat rmail-spool-directory
				   (or (getenv "LOGNAME")
				       (getenv "USER")
				       (user-login-name)))))))
      ;; Convert all or part to Babyl file if possible.
      (rmail-convert-file)
      (goto-char (point-max))
      (if (null rmail-inbox-list)
	  (progn
	    (rmail-set-message-counters)
	    (rmail-show-message))))
    (rmail-get-new-mail)))

(defun rmail-convert-file ()
  (let (convert)
    (widen)
    (goto-char (point-min))
    ;; If file doesn't start like a Babyl file,
    ;; convert it to one, by adding a header and converting each message.
    (cond ((looking-at "BABYL OPTIONS:"))
	  ((looking-at "Version: 5\n")
	   ;; Losing babyl file made by old version of Rmail.
	   ;; Just fix the babyl file header; don't make a new one,
	   ;; so we don't lose the Labels: file attribute, etc.
	   (let ((buffer-read-only nil))
	     (insert "BABYL OPTIONS:\n")))
	  (t
	   (setq convert t)
	   (rmail-insert-rmail-file-header)))
    ;; If file was not a Babyl file or if there are
    ;; Unix format messages added at the end,
    ;; convert file as necessary.
    (if (or convert
	    (progn (goto-char (point-max))
		   (search-backward "\^_")
		   (forward-char 1)
		   (looking-at "\n*From ")))
	(let ((buffer-read-only nil))
	  (message "Converting to Babyl format...")
	  (narrow-to-region (point) (point-max))
	  (rmail-convert-to-babyl-format)
	  (message "Converting to Babyl format...done")))))

(defun rmail-insert-rmail-file-header ()
  (let ((buffer-read-only nil))
    (insert "BABYL OPTIONS:
Version: 5
Labels:
Note:   This is the header of an rmail file.
Note:   If you are seeing it in rmail,
Note:    it means the file has no messages in it.\n\^_")))

(if rmail-mode-map
    nil
  (setq rmail-mode-map (make-keymap))
  (suppress-keymap rmail-mode-map)
  (define-key rmail-mode-map "." 'rmail-beginning-of-message)
  (define-key rmail-mode-map " " 'scroll-up)
  (define-key rmail-mode-map "\177" 'scroll-down)
  (define-key rmail-mode-map "n" 'rmail-next-undeleted-message)
  (define-key rmail-mode-map "p" 'rmail-previous-undeleted-message)
  (define-key rmail-mode-map "\en" 'rmail-next-message)
  (define-key rmail-mode-map "\ep" 'rmail-previous-message)
  (define-key rmail-mode-map "\e\C-n" 'rmail-next-labeled-message)
  (define-key rmail-mode-map "\e\C-p" 'rmail-previous-labeled-message)
  (define-key rmail-mode-map "a" 'rmail-add-label)
  (define-key rmail-mode-map "k" 'rmail-kill-label)
  (define-key rmail-mode-map "d" 'rmail-delete-forward)
  (define-key rmail-mode-map "u" 'rmail-undelete-previous-message)
  (define-key rmail-mode-map "e" 'rmail-expunge)
  (define-key rmail-mode-map "x" 'rmail-expunge)
  (define-key rmail-mode-map "s" 'rmail-expunge-and-save)
  (define-key rmail-mode-map "g" 'rmail-get-new-mail)
  (define-key rmail-mode-map "h" 'rmail-summary)
  (define-key rmail-mode-map "\e\C-h" 'rmail-summary)
  (define-key rmail-mode-map "l" 'rmail-summary-by-labels)
  (define-key rmail-mode-map "\e\C-l" 'rmail-summary-by-labels)
  (define-key rmail-mode-map "\e\C-r" 'rmail-summary-by-recipients)
  (define-key rmail-mode-map "t" 'rmail-toggle-header)
  (define-key rmail-mode-map "m" 'rmail-mail)
  (define-key rmail-mode-map "r" 'rmail-reply)
  (define-key rmail-mode-map "c" 'rmail-continue)
  (define-key rmail-mode-map "f" 'rmail-forward)
  (define-key rmail-mode-map "\es" 'rmail-search)
  (define-key rmail-mode-map "j" 'rmail-show-message)
  (define-key rmail-mode-map "o" 'rmail-output-to-rmail-file)
  (define-key rmail-mode-map "\C-o" 'rmail-output)
  (define-key rmail-mode-map "i" 'rmail-input)
  (define-key rmail-mode-map "q" 'rmail-quit)
  (define-key rmail-mode-map ">" 'rmail-last-message)
  (define-key rmail-mode-map "?" 'describe-mode)
  (define-key rmail-mode-map "w" 'rmail-edit-current-message)
  (define-key rmail-mode-map "\C-d" 'rmail-delete-backward))

;; Rmail mode is suitable only for specially formatted data.
(put 'rmail-mode 'mode-class 'special)

(defun rmail-mode ()
  "Rmail Mode is used by \\[rmail] for editing Rmail files.
All normal editing commands are turned off.
Instead, these commands are available:

.	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.
f	Forward this message to another user.
o       Output this message to an Rmail file (append it).
C-o	Output this message to a Unix-format mail file (append it).
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
C-M-h	Show headers buffer, with a one line summary of each message.
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."
  (interactive)
  (kill-all-local-variables)
  (rmail-mode-1)
  (rmail-variables)
  (run-hooks 'rmail-mode-hook))

(defun rmail-mode-1 ()
  (setq major-mode 'rmail-mode)
  (setq mode-name "RMAIL")
  (setq buffer-read-only t)
  ;; No need to auto save RMAIL files.
  (setq buffer-auto-save-file-name nil)
  (if (boundp 'mode-line-modified)
      (setq mode-line-modified "--- ")
    (setq mode-line-format
	  (cons "--- " (cdr (default-value 'mode-line-format)))))
  (use-local-map rmail-mode-map)
  (set-syntax-table text-mode-syntax-table)
  (setq local-abbrev-table text-mode-abbrev-table))

(defun rmail-variables ()
  (make-local-variable 'revert-buffer-function)
  (setq revert-buffer-function 'rmail-revert)
  (make-local-variable 'rmail-last-label)
  (make-local-variable 'rmail-deleted-vector)
  (make-local-variable 'rmail-keywords)
  (make-local-variable 'rmail-summary-buffer)
  (make-local-variable 'rmail-summary-vector)
  (make-local-variable 'rmail-current-message)
  (make-local-variable 'rmail-total-messages)
  (make-local-variable 'require-final-newline)
  (setq require-final-newline nil)
  (make-local-variable 'version-control)
  (setq version-control 'never)
  (make-local-variable 'file-precious-flag)
  (setq file-precious-flag t)
  (make-local-variable 'rmail-message-vector)
  (make-local-variable 'rmail-last-file)
  (make-local-variable 'rmail-inbox-list)
  (setq rmail-inbox-list (rmail-parse-file-inboxes))
  (make-local-variable 'rmail-keywords)
  ;; this gets generated as needed
  (setq rmail-keywords nil))

;; Handle M-x revert-buffer done in an rmail-mode buffer.
(defun rmail-revert (arg noconfirm)
  (let (revert-buffer-function)
    ;; Call our caller again, but this time it does the default thing.
    (if (revert-buffer arg noconfirm)
	;; If the user said "yes", and we changed something,
	;; reparse the messages.
	(progn
	  (rmail-convert-file)
	  (goto-char (point-max))
	  (rmail-set-message-counters)
	  (rmail-show-message)))))

;; Return a list of files from this buffer's Mail: option.
;; Does not assume that messages have been parsed.
;; Just returns nil if buffer does not look like Babyl format.
(defun rmail-parse-file-inboxes ()
  (save-excursion
    (save-restriction
      (widen)
      (goto-char 1)
      (cond ((looking-at "BABYL OPTIONS:")
	     (search-forward "\^_" nil 'move)
	     (narrow-to-region 1 (point))
	     (goto-char 1)
	     (if (search-forward "\nMail:" nil t)
		 (progn
		   (narrow-to-region (point) (progn (end-of-line) (point)))
		   (goto-char (point-min))
		   (mail-parse-comma-list))))))))

(defun rmail-expunge-and-save ()
  "Expunge and save RMAIL file."
  (interactive)
  (rmail-expunge)