rmail.el

早期freebsd实现

  (save-buffer))

(defun rmail-quit ()
  "Quit out of RMAIL."
  (interactive)
  (rmail-expunge-and-save)
  ;; Don't switch to the summary buffer even if it was recently visible.
  (if rmail-summary-buffer
      (bury-buffer rmail-summary-buffer))
  (let ((obuf (current-buffer)))
    (switch-to-buffer (other-buffer))
    (bury-buffer obuf)))

(defun rmail-input (filename)
  "Run RMAIL on file FILENAME."
  (interactive "FRun rmail on RMAIL file: ")
  (rmail filename))


;;;; *** Rmail input ***

;; RLK feature not added in this version:
;; argument specifies inbox file or files in various ways.

(defun rmail-get-new-mail (&optional file-name)
  "Move any new mail from this RMAIL file's inbox files.
The inbox files can be specified with the file's Mail: option.
The variable rmail-primary-inbox-list specifies the inboxes for
your primary RMAIL file if it has no Mail: option.
These are normally your ~/mbox and your /usr/spool/mail/$USER.

You can also specify the file to get new mail from.  In this
case, the file of new mail is not changed or deleted.
Noninteractively, you can pass the inbox file name as an argument.
Interactively, a prefix argument causes us to read a file name
and use that file as the inbox."
  (interactive
   (list (if current-prefix-arg
	     (read-file-name "Get new mail from file: "))))
  (or (verify-visited-file-modtime (current-buffer))
      (progn
	(find-file (buffer-file-name))
	(if (verify-visited-file-modtime (current-buffer))
	    (rmail-forget-messages))))
  (rmail-maybe-set-message-counters)
  (widen)
  ;; Get rid of all undo records for this buffer.
  (or (eq buffer-undo-list t)
      (setq buffer-undo-list nil))
  (unwind-protect
      (let ((opoint (point))
	    (new-messages 0)
	    (delete-files ())
	    ;; If buffer has not changed yet, and has not been saved yet,
	    ;; don't replace the old backup file now.
	    (make-backup-files (and make-backup-files (buffer-modified-p)))
	    (buffer-read-only nil)
	    ;; Don't make undo records for what we do in getting mail.
	    (buffer-undo-list t))
	(goto-char (point-max))
	(skip-chars-backward " \t\n")	; just in case of brain damage
	(delete-region (point) (point-max))	; caused by require-final-newline
	(save-excursion
	  (save-restriction
	    (narrow-to-region (point) (point))
	    ;; Read in the contents of the inbox files,
	    ;; renaming them as necessary,
	    ;; and adding to the list of files to delete eventually.
	    (if file-name
		(rmail-insert-inbox-text (list file-name) nil)
	      (setq delete-files (rmail-insert-inbox-text rmail-inbox-list t)))
	    ;; Scan the new text and convert each message to babyl format.
	    (goto-char (point-min))
	    (save-excursion
	      (setq new-messages (rmail-convert-to-babyl-format)))
	    (or (zerop new-messages)
		(let (success)
		  (widen)
		  (search-backward "\^_")
		  (narrow-to-region (point) (point-max))
		  (goto-char (1+ (point-min)))
		  (rmail-count-new-messages)
		  (save-buffer)))
	    ;; Delete the old files, now that babyl file is saved.
	    (while delete-files
	      (condition-case ()
		  (delete-file (car delete-files))
		(file-error nil))
	      (setq delete-files (cdr delete-files)))))
	(if (= new-messages 0)
	    (progn (goto-char opoint)
		   (if (or file-name rmail-inbox-list)
		       (message "(No new mail has arrived)")))
	    (message "%d new message%s read"
		     new-messages (if (= 1 new-messages) "" "s"))))
    ;; Don't leave the buffer screwed up if we get a disk-full error.
    (rmail-show-message)))

(defun rmail-insert-inbox-text (files renamep)
  (let (file tofile delete-files movemail popmail)
    (while files
      (setq file (expand-file-name (substitute-in-file-name (car files)))
	    ;;>> un*x specific <<
	    tofile (concat file "~"))
      ;; If getting from mail spool directory,
      ;; use movemail to move rather than renaming.
      (setq movemail (equal (file-name-directory file) rmail-spool-directory))
      (setq popmail (string-match "^po:" (file-name-nondirectory file)))
      (if popmail (setq file (file-name-nondirectory file)
			renamep t))
      (if movemail
	  (progn
	    (setq tofile (expand-file-name
			   ".newmail"
			   ;; Use the directory of this rmail file
			   ;; because it's a nuisance to use the homedir
			   ;; if that is on a full disk and this rmail
			   ;; file isn't.
			   (file-name-directory
			     (expand-file-name buffer-file-name))))
	    ;; On some systems, /usr/spool/mail/foo is a directory
	    ;; and the actual inbox is /usr/spool/mail/foo/foo.
	    (if (file-directory-p file)
		(setq file (expand-file-name (or (getenv "LOGNAME")
						 (getenv "USER")
						 (user-login-name))
					     file)))))
      (if popmail
	  (message "Getting mail from post office ...")
	(if (or (file-exists-p tofile) (file-exists-p file))
	    (message "Getting mail from %s..." file)))
      ;; Set TOFILE if have not already done so, and
      ;; rename or copy the file FILE to TOFILE if and as appropriate.
      (cond ((not renamep)
	     (setq tofile file))
	    ((or (file-exists-p tofile) (and (not popmail)
					     (not (file-exists-p file))))
	     nil)
	    ((and (not movemail) (not popmail))
	     (rename-file file tofile nil))
	    (t
	     (let ((errors nil))
	       (unwind-protect
		   (save-excursion
		     (setq errors (generate-new-buffer " *rmail loss*"))
		     (buffer-flush-undo errors)
		     (call-process
		       (expand-file-name "movemail" exec-directory)
		       nil errors nil file tofile)
		     (if (not (buffer-modified-p errors))
			 ;; No output => movemail won
			 nil
		       (set-buffer errors)
		       (subst-char-in-region (point-min) (point-max)
					     ?\n ?\  )
		       (goto-char (point-max))
		       (skip-chars-backward " \t")
		       (delete-region (point) (point-max))
		       (goto-char (point-min))
		       (if (looking-at "movemail: ")
			   (delete-region (point-min) (match-end 0)))
		       (beep t)
		       (message (concat "movemail: "
					(buffer-substring (point-min)
							  (point-max))))
		       (sit-for 3)
		       nil))
		 (if errors (kill-buffer errors))))))
      ;; At this point, TOFILE contains the name to read:
      ;; Either the alternate name (if we renamed)
      ;; or the actual inbox (if not renaming).
      (if (file-exists-p tofile)
	  (progn (goto-char (point-max))
		 (insert-file-contents tofile)
		 (goto-char (point-max))
		 (or (= (preceding-char) ?\n)
		     (insert ?\n))
		 (setq delete-files (cons tofile delete-files))))
      (message "")
      (setq files (cdr files)))
    delete-files))

;; the  rmail-break-forwarded-messages  feature is not implemented
(defun rmail-convert-to-babyl-format ()
  (let ((count 0) start
	(case-fold-search nil))
    (goto-char (point-min))
    (save-restriction
      (while (not (eobp))
	(cond ((looking-at "BABYL OPTIONS:");Babyl header
	       (search-forward "\n\^_")
	       (delete-region (point-min) (point)))
	      ;; Babyl format message
	      ((looking-at "\^L")
	       (or (search-forward "\n\^_" nil t)
		   (progn
		     (message "Invalid Babyl format in inbox!")
		     (sit-for 1)
		     (goto-char (point-max))))
	       (setq count (1+ count))
	       ;; Make sure there is no extra white space after the ^_
	       ;; at the end of the message.
	       ;; Narrowing will make sure that whatever follows the junk
	       ;; will be treated properly.
	       (delete-region (point)
			      (save-excursion
				(skip-chars-forward " \t\n")
				(point)))
	       (narrow-to-region (point) (point-max)))
	      ;;*** MMDF format
	      ((let ((case-fold-search t))
		 (looking-at mmdf-delim1))
	       (let ((case-fold-search t))
		 (replace-match "\^L\n0, unseen,,\n*** EOOH ***\n")
		 (setq start (point))
		 (re-search-forward mmdf-delim2 nil t)
		 (replace-match "\^_"))
	       (save-excursion
		 (save-restriction
		   (narrow-to-region start (1- (point)))
		   (goto-char (point-min))
		   (while (search-forward "\n\^_" nil t) ; single char "\^_"
		     (replace-match "\n^_")))) ; 2 chars: "^" and "_"
	       (narrow-to-region (point) (point-max))
	       (setq count (1+ count)))
	      ;;*** Mail format
	      ((looking-at "^From ")
	       (setq start (point))
	       (insert "\^L\n0, unseen,,\n*** EOOH ***\n")
	       (rmail-nuke-pinhead-header)
	       (if (re-search-forward
		    (concat "^[\^_]?\\("
			    "From [^ \n]*\\(\\|\".*\"[^ \n]*\\)  ?[^ \n]* [^ \n]* *"
			    "[0-9]* [0-9:]*\\( ?[A-Z]?[A-Z][A-Z]T\\| ?[-+]?[0-9][0-9][0-9][0-9]\\|\\) " ; EDT, -0500
			    "19[0-9]* *\\(remote from .*\\)?$\\|"
			    mmdf-delim1 "\\|"
			    "^BABYL OPTIONS:\\|"
			    "\^L\n[01],\\)") nil t)
		   (goto-char (match-beginning 1))
		 (goto-char (point-max)))
	       (setq count (1+ count))
	       (save-excursion
		 (save-restriction
		   (narrow-to-region start (point))
		   (goto-char (point-min))
		   (while (search-forward "\n\^_" nil t); single char
		     (replace-match "\n^_")))); 2 chars: "^" and "_"
	       (insert ?\^_)
	       (narrow-to-region (point) (point-max)))
	      ;;
	      ;;This is a kludge, in case we're wrong about mmdf not
	      ;;allowing anything in between.  If it loses, we'll have
	      ;;to look for something else
	      (t (delete-char 1)))))
    count))

(defun rmail-nuke-pinhead-header ()
  (save-excursion
    (save-restriction
      (let ((start (point))
  	    (end (progn
		   (condition-case ()
		       (search-forward "\n\n")
		     (error
		      (goto-char (point-max))
		      (insert "\n\n")))
		   (point)))
	    has-from has-date)
	(narrow-to-region start end)
	(let ((case-fold-search t))
	  (goto-char start)
	  (setq has-from (search-forward "\nFrom:" nil t))
	  (goto-char start)
	  (setq has-date (and (search-forward "\nDate:" nil t) (point)))
	  (goto-char start))
	(let ((case-fold-search nil))
	  (if (re-search-forward
	       "^From \\([^ ]*\\(\\|\".*\"[^ ]*\\)\\)  ?\\([^ ]*\\) \\([^ ]*\\) *\\([0-9]*\\) \\([0-9:]*\\)\\( ?[A-Z]?[A-Z][A-Z]T\\| ?[-+]?[0-9][0-9][0-9][0-9]\\|\\) 19\\([0-9]*\\) *\\(remote from [^\n]*\\)?\n" nil t)
	      (replace-match
		(concat
		  ;; Keep and reformat the date if we don't
		  ;;  have a Date: field.
		  (if has-date
		      ""
		    ;; If no time zone specified, assume est.
		    (if (= (match-beginning 7) (match-end 7))
			"Date: \\3, \\5 \\4 \\8 \\6 EST\n"
			"Date: \\3, \\5 \\4 \\8 \\6\\7\n"))
		  ;; Keep and reformat the sender if we don't
		  ;; have a From: field.
		  (if has-from
		      ""
		    "From: \\1\n")))))))))

;;;; *** Rmail Message Formatting and Header Manipulation ***

(defun rmail-reformat-message (beg end)
  (goto-char beg)
  (forward-line 1)
  (if (/= (following-char) ?0)
      (error "Bad format in RMAIL file."))
  (let ((buffer-read-only nil)
	(delta (- (buffer-size) end)))
    (delete-char 1)
    (insert ?1)
    (forward-line 1)
    (if (looking-at "Summary-line: ")
	(forward-line 1))
    (if (looking-at "\\*\\*\\* EOOH \\*\\*\\*\n")
	(delete-region (point)
		       (progn (forward-line 1) (point))))
    (let ((str (buffer-substring (point)
				 (save-excursion (search-forward "\n\n" end 'move)
						 (point)))))
      (insert str "*** EOOH ***\n")
      (narrow-to-region (point) (- (buffer-size) delta)))
    (goto-char (point-min))
    (if rmail-ignored-headers (rmail-clear-headers))
    (if rmail-message-filter (funcall rmail-message-filter))))

(defun rmail-clear-headers ()
  (if (search-forward "\n\n" nil t)
      (save-restriction
        (narrow-to-region (point-min) (point))
	(let ((buffer-read-only nil))
	  (while (let ((case-fold-search t))
		   (goto-char (point-min))
		   (re-search-forward rmail-ignored-headers nil t))
	    (beginning-of-line)
	    (delete-region (point)
			   (progn (re-search-forward "\n[^ \t]")
				  (forward-char -1)
				  (point))))))))

(defun rmail-toggle-header ()
  "Show original message header if pruned header currently shown, or vice versa."
  (interactive)
  (rmail-maybe-set-message-counters)
  (narrow-to-region (rmail-msgbeg rmail-current-message) (point-max))
  (let ((buffer-read-only nil))
    (goto-char (point-min))
    (forward-line 1)
    (if (= (following-char) ?1)
	(progn (delete-char 1)
	       (insert ?0)
	       (forward-line 1)
	       (if (looking-at "Summary-Line:")
		   (forward-line 1))
	       (insert "*** EOOH ***\n")