rmail.el

早期freebsd实现

			   regexp (rmail-msgend msg) t)))
	    (while (and (null win) (< msg rmail-total-messages))
	      (goto-char (rmail-msgbeg (setq msg (1+ msg))))
	      (setq win (re-search-forward regexp (rmail-msgend msg) t)))))
      (if win
	  (progn
	    ;; If this is a reverse search and we found a message,
	    ;; search backward thru this message to position point.
	    (if reversep
		(progn
		  (goto-char (rmail-msgend msg))
		  (re-search-backward
		   regexp (rmail-msgbeg msg) t)))
	    (setq win (point))
	    (rmail-show-message msg)
	    (message "%sRmail search for %s...done"
		     (if reversep "Reverse " "")
		     regexp)
	    (goto-char win))
	(goto-char opoint)
	(narrow-to-region omin omax)
	(ding)
	(message "Searched failed: %s" regexp)))))

;;;; *** Rmail Message Deletion Commands ***

(defun rmail-message-deleted-p (n)
  (= (aref rmail-deleted-vector n) ?D))

(defun rmail-set-message-deleted-p (n state)
  (aset rmail-deleted-vector n (if state ?D ?\ )))

(defun rmail-delete-message ()
  "Delete this message and stay on it."
  (interactive)
  (rmail-set-attribute "deleted" t))

(defun rmail-undelete-previous-message ()
  "Back up to deleted message, select it, and undelete it."
  (interactive)
  (let ((msg rmail-current-message))
    (while (and (> msg 0)
		(not (rmail-message-deleted-p msg)))
      (setq msg (1- msg)))
    (if (= msg 0)
	(error "No previous deleted message")
      (if (/= msg rmail-current-message)
	  (rmail-show-message msg))
      (rmail-set-attribute "deleted" nil))))

(defun rmail-delete-forward (&optional backward)
  "Delete this message and move to next nondeleted one.
Deleted messages stay in the file until the \\[rmail-expunge] command is given.
With prefix argument, delete and move backward."
  (interactive "P")
  (rmail-set-attribute "deleted" t)
  (rmail-next-undeleted-message (if backward -1 1)))

(defun rmail-delete-backward ()
  "Delete this message and move to previous nondeleted one.
Deleted messages stay in the file until the \\[rmail-expunge] command is given."
  (interactive)
  (rmail-delete-forward t))

(defun rmail-expunge ()
  "Actually erase all deleted messages in the file."
  (interactive)
  (message "Expunging deleted messages...")
  ;; Discard any prior undo information.
  (or (eq buffer-undo-list t)
      (setq buffer-undo-list nil))
  (rmail-maybe-set-message-counters)
  (let* ((omax (- (buffer-size) (point-max)))
	 (omin (- (buffer-size) (point-min)))
	 (opoint (if (and (> rmail-current-message 0)
			  (= ?D (aref rmail-deleted-vector rmail-current-message)))
		     0 (- (point) (point-min))))
	 (messages-head (cons (aref rmail-message-vector 0) nil))
	 (messages-tail messages-head)
	 ;; Don't make any undo records for the expunging itself.
	 (buffer-undo-list t)
	 (win))
    (unwind-protect
	(save-excursion
	  (widen)
	  (goto-char (point-min))
	  (let ((counter 0)
		(number 1)
		(total rmail-total-messages)
		(new-message-number rmail-current-message)
		(new-summary nil)
		(buffer-read-only nil)
		(messages rmail-message-vector)
		(deleted rmail-deleted-vector)
		(summary rmail-summary-vector))
	    (setq rmail-total-messages nil
		  rmail-current-message nil
		  rmail-message-vector nil
		  rmail-deleted-vector nil
		  rmail-summary-vector nil)
	    (while (<= number total)
	      (if (= (aref deleted number) ?D)
		  (progn
		    (delete-region
		      (marker-position (aref messages number))
		      (marker-position (aref messages (1+ number))))
		    (move-marker (aref messages number) nil)
		    (if (> new-message-number counter)
			(setq new-message-number (1- new-message-number))))
		(setq counter (1+ counter))
		(setq messages-tail
		      (setcdr messages-tail
			      (cons (aref messages number) nil)))
		(setq new-summary
		      (cons (if (= counter number) (aref summary (1- number)))
			    new-summary)))
	      (if (zerop (% (setq number (1+ number)) 20))
		  (message "Expunging deleted messages...%d" number)))
	    (setq messages-tail
		  (setcdr messages-tail
			  (cons (aref messages number) nil)))
	    (setq rmail-current-message new-message-number
		  rmail-total-messages counter
		  rmail-message-vector (apply 'vector messages-head)
		  rmail-deleted-vector (make-string (1+ counter) ?\ )
		  rmail-summary-vector (vconcat (nreverse new-summary))
		  win t)))
      (message "Expunging deleted messages...done")
      (if (not win)
	  (narrow-to-region (- (buffer-size) omin) (- (buffer-size) omax)))
      (rmail-show-message
       (if (zerop rmail-current-message) 1 nil))
      (forward-char opoint))))

;;;; *** Rmail Mailing Commands ***

(defun rmail-mail ()
  "Send mail in another window.
While composing the message, use \\[mail-yank-original] to yank the
original message into it."
  (interactive)
  (mail-other-window nil nil nil nil nil (current-buffer)))

(defun rmail-continue ()
  "Continue composing outgoing message previously being composed."
  (interactive)
  (mail-other-window t))

(defun rmail-reply (just-sender)
  "Reply to the current message.
Normally include CC: to all other recipients of original message;
prefix argument means ignore them.
While composing the reply, use \\[mail-yank-original] to yank the
original message into it."
  (interactive "P")
  ;;>> this gets set even if we abort. Can't do anything about it, though.
  (rmail-set-attribute "answered" t)
  (rmail-display-labels)
  (let (from reply-to cc subject date to message-id resent-reply-to)
    (save-excursion
      (save-restriction
	(widen)
	(goto-char (rmail-msgbeg rmail-current-message))
	(forward-line 1)
	(if (= (following-char) ?0)
	    (narrow-to-region
	     (progn (forward-line 2)
		    (point))
	     (progn (search-forward "\n\n" (rmail-msgend rmail-current-message)
				    'move)
		    (point)))
	  (narrow-to-region (point)
			    (progn (search-forward "\n*** EOOH ***\n")
				   (beginning-of-line) (point))))
	(setq resent-reply-to (mail-fetch-field "resent-reply-to" t)
	      from (mail-fetch-field "from")
	      reply-to (or resent-reply-to
			   (mail-fetch-field "reply-to" nil t)
			   from)
	      cc (cond (just-sender nil)
		       (resent-reply-to (mail-fetch-field "resent-cc" t))
		       (t (mail-fetch-field "cc" nil t)))
	      subject (or (and resent-reply-to
			       (mail-fetch-field "resent-subject" t))
			  (mail-fetch-field "subject"))
	      date (cond (resent-reply-to
			  (mail-fetch-field "resent-date" t))
			 ((mail-fetch-field "date")))
	      to (cond (resent-reply-to
			(mail-fetch-field "resent-to" t))
		       ((mail-fetch-field "to" nil t))
		       ;((mail-fetch-field "apparently-to")) ack gag barf
		       (t ""))
	      message-id (cond (resent-reply-to
				(mail-fetch-field "resent-message-id" t))
			       ((mail-fetch-field "message-id"))))))
    (and subject
	 (string-match "\\`Re: " subject)
	 (setq subject (substring subject 4)))
    (mail-other-window nil
      (mail-strip-quoted-names reply-to)
      subject
      (rmail-make-in-reply-to-field from date message-id)
      (if just-sender
	  nil
	(let* ((cc-list (rmail-dont-reply-to
			  (mail-strip-quoted-names
			    (if (null cc) to (concat to ", " cc))))))
	  (if (string= cc-list "") nil cc-list)))
      (current-buffer))))

(defun rmail-make-in-reply-to-field (from date message-id)
  (if mail-use-rfc822 (require 'rfc822))
  (let (field)
    (if (and mail-use-rfc822 from)
	(let ((tem (car (rfc822-addresses from))))
	  (and message-id
	       (setq field (if (string-match
				 (regexp-quote
				   (if (string-match "@[^@]*\\'" tem)
				       (substring tem
						  0 (match-beginning 0))
				       tem))
				 message-id)
			       message-id
			       (concat message-id " \"" tem "\""))
		     message-id nil date nil))
	  (or field
	      (setq field (prin1-to-string tem))))
;	(if message-id
;	    (setq field message-id message-id nil date nil)
;	    (setq field (car (rfc882-addresses from))))
	)
    (or field
	(not from)
	;; Compute the sender for the in-reply-to; prefer full name.
	(let* ((stop-pos (string-match "  *at \\|  *@ \\|  *<" from))
	       (start-pos (if stop-pos 0
			    ;;>> this loses on nested ()'s
			    (let ((pos (string-match " *(" from)))
			      (if (not pos) nil
				(setq stop-pos (string-match ")" from pos))
				(if (zerop pos) 0 (+ 2 pos)))))))
	  (setq field (if stop-pos
			  (substring from start-pos stop-pos)
			  from))))
    (if date (setq field (concat field "'s message of " date)))
    (if message-id (setq field (concat field " " message-id)))
    field))

(defun rmail-forward ()
  "Forward the current message to another user."
  (interactive)
  ;;>> this gets set even if we abort. Can't do anything about it, though.
  (rmail-set-attribute "forwarded" t)
  (let ((forward-buffer (current-buffer))
	(subject (concat "["
			 (mail-strip-quoted-names (mail-fetch-field "From"))
			 ": " (or (mail-fetch-field "Subject") "") "]")))
    ;; If only one window, use it for the mail buffer.
    ;; Otherwise, use another window for the mail buffer
    ;; so that the Rmail buffer remains visible
    ;; and sending the mail will get back to it.
    (if (if (one-window-p t)
	    (mail nil nil subject)
	  (mail-other-window nil nil subject))
	(save-excursion
	  (goto-char (point-max))
	  (forward-line 1)
	  (insert-buffer forward-buffer)))))

;;;; *** Rmail Specify Inbox Files ***

(autoload 'set-rmail-inbox-list "rmailmsc"
  "Set the inbox list of the current RMAIL file to FILE-NAME.
This may be a list of file names separated by commas.
If FILE-NAME is empty, remove any inbox list."
  t)

;;;; *** Rmail Commands for Labels ***

(autoload 'rmail-add-label "rmailkwd"
  "Add LABEL to labels associated with current RMAIL message.
Completion is performed over known labels when reading."
  t)

(autoload 'rmail-kill-label "rmailkwd"
  "Remove LABEL from labels associated with current RMAIL message.
Completion is performed over known labels when reading."
  t)

(autoload 'rmail-next-labeled-message "rmailkwd"
  "Show next message with LABEL.  Defaults to last label used.
With prefix argument N moves forward N messages with this label."
  t)

(autoload 'rmail-previous-labeled-message "rmailkwd"
  "Show previous message with LABEL.  Defaults to last label used.
With prefix argument N moves backward N messages with this label."
  t)

;;;; *** Rmail Edit Mode ***

(autoload 'rmail-edit-current-message "rmailedit"
  "Edit the contents of the current message"
  t)

;;;; *** Rmail Summary Mode ***

(autoload 'rmail-summary "rmailsum"
  "Display a summary of all messages, one line per message."
  t)

(autoload 'rmail-summary-by-labels "rmailsum"
  "Display a summary of all messages with one or more LABELS.
LABELS should be a string containing the desired labels, separated by commas."
  t)

(autoload 'rmail-summary-by-recipients "rmailsum"
  "Display a summary of all messages with the given RECIPIENTS.
Normally checks the To, From and Cc fields of headers;
but if PRIMARY-ONLY is non-nil (prefix arg given),
 only look in the To and From fields.
RECIPIENTS is a string of names separated by commas."
  t)

;;;; *** Rmail output messages to files ***

(autoload 'rmail-output-to-rmail-file "rmailout"
  "Append the current message to an Rmail file named FILE-NAME.
If the file does not exist, ask if it should be created.
If file is being visited, the message is appended to the Emacs
buffer visiting that file."
  t)

(autoload 'rmail-output "rmailout"
  "Append this message to Unix mail file named FILE-NAME."
  t)

;;;; *** Rmail undigestification ***

(autoload 'undigestify-rmail-message "undigest"
  "Break up a digest message into its constituent messages.
Leaves original message, deleted, before the undigestified messages."
  t)