mh-e.el

早期freebsd实现

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))
	 (draft
	  (cond ((and mh-draft-folder (equal from-folder mh-draft-folder))
		 (find-file (mh-msg-filename msg))
		 (rename-buffer (format "draft-%d" msg))
		 (buffer-name))
		(t
		 (mh-read-draft "clean-up" (mh-msg-filename msg) nil)))))
    (mh-clean-msg-header (point-min)
			 "^Date:\\|^Received:\\|^Message-Id:\\|^From:"
			 nil)
    (goto-char (point-min))
    (set-buffer-modified-p nil)
    (mh-compose-and-send-mail draft "" from-folder nil nil nil nil nil nil
			      config)))


(defun mh-execute-commands ()
  "Process outstanding delete and refile requests."
  (interactive)
  (if mh-narrowed-to-seq (mh-widen))
  (mh-process-commands mh-current-folder)
  (mh-set-scan-mode)
  (mh-goto-cur-msg)			; after mh-set-scan-mode for efficiency
  (mh-make-folder-mode-line)
  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)
				"^Date:\\|^Received:\\|^Message-Id:\\|^From:\\|^Sender:"
				nil))
	  (t
	   (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."
  (interactive)
  (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)
		       (prog1
			   (mh-read-draft "" draft-name t)
			 (mh-insert-fields "To:" to "Cc:" cc)
			 (set-buffer-modified-p nil)))
		      (t
		       (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))))
      (widen)
      (save-excursion
	(mh-insert-fields "Subject:" (format "[%s: %s]" subject forw-subject)))
      (delete-other-windows)
      (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:"
				config))))


(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)))
	    (beginning-of-line)
	    (if (not dont-show) (mh-maybe-show number))
	    t)
	  (t
	   (goto-char starting-place)
	   (if (not no-error-if-no-message)
	       (error "No message %d" number))
	   nil))))


(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
			 (expand-file-name
			  (read-file-name "inc mail from file: "
					  mh-user-path)))))
  (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."
  (interactive)
  (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."
  (interactive)
  (goto-char (point-max))
  (while (and (not (bobp)) (looking-at "^$"))
    (forward-line -1)))


(defun mh-list-folders ()
  "List mail folders."
  (interactive)
  (with-output-to-temp-buffer " *mh-temp*"
    (save-excursion
      (switch-to-buffer " *mh-temp*")
      (erase-buffer)
      (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"
	   msg
	   (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))
	    (t
	     (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)
	 (beginning-of-line)
	 (mh-maybe-show))
	(t
	 (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
			 (mh-read-msg-range
			  "Range to scan after packing [all]? ")
			 "all")))
  (mh-pack-folder-1 range)
  (mh-goto-cur-msg)
  (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."
  (interactive
   (list current-prefix-arg (read-string "Shell command on message: ")))
  (save-excursion
    (set-buffer mh-show-buffer)
    (goto-char (point-min))
    (if (not prefix-provided) (search-forward "\n\n"))
    (shell-command-on-region (point) (point-max) command nil)))


(defun mh-refile-msg (prefix-provided msg-or-seq dest)
  "Refile MESSAGE(s) (default: displayed message) in FOLDER.
If (optional) prefix argument provided, then prompt for message sequence."
  (interactive
   (list current-prefix-arg
	 (if current-prefix-arg
	     (mh-read-seq-default "Refile" t)
	     (mh-get-msg-num t))
	 (intern
	  (mh-prompt-for-folder "Destination"
				(if (eq 'refile (car mh-last-destination))
				    (symbol-name (cdr mh-last-destination))
				    "")
				t))))
  (setq mh-last-destination (cons 'refile dest))
  (if prefix-provided
      (mh-map-to-seq-msgs 'mh-refile-a-msg msg-or-seq dest)
      (mh-refile-a-msg msg-or-seq dest))
  (mh-next-msg))


(defun mh-refile-or-write-again (msg)
  "Re-execute the last refile or write command on the given MESSAGE.
Default is the displayed message.  Use the same folder or file as the
previous refile or write command."
  (interactive (list (mh-get-msg-num t)))
  (if (null mh-last-destination)
      (error "No previous refile or write"))
  (cond ((eq (car mh-last-destination) 'refile)
	 (mh-refile-a-msg msg (cdr mh-last-destination))
	 (message "Destination folder: %s" (cdr mh-last-destination)))
	(t
	 (mh-write-msg-to-file msg (cdr mh-last-destination))
	 (message "Destination: %s" (cdr mh-last-destination))))
  (mh-next-msg))


(defun mh-reply (prefix-provided msg)
  "Reply to a MESSAGE (default: displayed message).
If (optional) prefix argument provided, then include the message in the reply
using filter mhl.reply in your MH directory."
  (interactive (list current-prefix-arg (mh-get-msg-num t)))
  (let ((minibuffer-help-form
	 "from => Sender only\nto => Sender and primary recipients\ncc or all => Sender and all recipients"))
    (let ((reply-to (or mh-reply-default-reply-to
			(completing-read "Reply to whom: "
					 '(("from") ("to") ("cc") ("all"))
					 nil
					 t)))
	  (folder mh-current-folder)
	  (show-buffer mh-show-buffer)
	  (config (current-window-configuration)))
      (message "Composing a reply...")
      (cond ((or (equal reply-to "from") (equal reply-to ""))
	     (apply 'mh-exec-cmd
		    "repl" "-build"
		    "-nodraftfolder" mh-current-folder
		    msg
		    "-nocc" "all"
		    (if prefix-provided
			(list "-filter" "mhl.reply"))))
	    ((equal reply-to "to")
	     (apply 'mh-exec-cmd
		    "repl" "-build"
		    "-nodraftfolder" mh-current-folder
		    msg
		    "-cc" "to"
		    (if prefix-provided
			(list "-filter" "mhl.reply"))))
	    ((or (equal reply-to "cc") (equal reply-to "all"))
	     (apply 'mh-exec-cmd
		    "repl" "-build"
		    "-nodraftfolder" mh-current-folder
		    msg
		    "-cc" "all" "-nocc" "me"
		    (if prefix-provided
			(list "-filter" "mhl.reply")))))

      (let ((draft (mh-read-draft "reply"
				  (expand-file-name "reply" mh-user-path)
				  t)))
	(delete-other-windows)
	(set-buffer-modified-p nil)

	(let ((to (mh-get-field "To:"))
	      (subject (mh-get-field "Subject:"))
	      (cc (mh-get-field "Cc:")))
	  (goto-char (point-min))
	  (mh-goto-header-end 1)
	  (if (not prefix-provided)
	      (mh-display-msg msg folder))
	  (mh-add-msgs-to-seq msg 'answered t)
	  (message "Composing a reply...done")
	  (mh-compose-and-send-mail draft "" folder msg to subject cc
				    mh-note-repl "Replied:" config))))))


(defun mh-quit ()
  "Restore the previous window configuration, if one exists.
Finish by running mh-quit-hook."
  (interactive)
  (if mh-previous-window-config
      (set-window-configuration mh-previous-window-config))
  (run-hooks 'mh-quit-hook))


(defun mh-page-digest ()
  "Advance displayed message to next digested message."
  (interactive)
  (save-excursion
    (mh-show-message-in-other-window)
    ;; Go to top of screen (in case user moved point).
    (move-to-window-line 0)
    (let ((case-fold-search nil))
      ;; Search for blank line and then for From: