mh-e.el

早期freebsd实现

      (mh-when (not (and (search-forward "\n\n" nil t)
			 (search-forward "From:" nil t)))
	(other-window -1)
	(error "No more messages")))
    ;; Go back to previous blank line, then forward to the first non-blank.
    (search-backward "\n\n" nil t)
    (forward-line 2)
    (mh-recenter 0)
    (other-window -1)))


(defun mh-page-digest-backwards ()
  "Back up displayed message to previous 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))
      (beginning-of-line)
      (mh-when (not (and (search-backward "\n\n" nil t)
			 (search-backward "From:" nil t)))
	(other-window -1)
	(error "No more messages")))
    ;; Go back to previous blank line, then forward to the first non-blank.
    (search-backward "\n\n" nil t)
    (forward-line 2)
    (mh-recenter 0)
    (other-window -1)))


(defun mh-page-msg (&optional arg)
  "Page the displayed message forwards.
Scrolls ARG lines or a full screen if no argument is supplied."
  (interactive "P")
  (scroll-other-window arg))


(defun mh-previous-page (&optional arg)
  "Page the displayed message backwards.
Scrolls ARG lines or a full screen if no argument is supplied."
  (interactive "P")
  (save-excursion
    (mh-show-message-in-other-window)
    (unwind-protect
	(scroll-down arg)
      (other-window -1))))


(defun mh-previous-undeleted-msg (&optional arg)
  "Move to previous undeleted message in window."
  (interactive "p")
  (setq mh-next-direction 'backward)
  (beginning-of-line)
  (cond ((re-search-backward mh-good-msg-regexp nil 0 arg)
	 (mh-maybe-show))
	(t
	 (if (get-buffer mh-show-buffer)
	     (delete-windows-on mh-show-buffer)))))


(defun mh-print-msg (prefix-provided msg-or-seq)
  "Print MESSAGE(s) (default: displayed message) on a line printer.
If (optional) prefix argument provided, then prompt for the message sequence."
  (interactive (list current-prefix-arg
		     (if current-prefix-arg
			 (reverse (mh-seq-to-msgs
				   (mh-read-seq-default "Print" t)))
			 (mh-get-msg-num t))))
  (if prefix-provided
      (message "Printing sequence...")
      (message "Printing message..."))
  (let ((print-command
	 (if prefix-provided
	     (format "(scan -clear %s ; %s -nobell -clear %s %s) | %s"
		     (mapconcat (function (lambda (msg) msg)) msg-or-seq " ")
		     (expand-file-name "mhl" mh-lib)
		     (if (stringp mhl-formfile)
			 (format "-form %s" mhl-formfile)
		         "")
		     (mh-msg-filenames msg-or-seq)
		     (format mh-lpr-command-format
			     (if prefix-provided
				 (format "Sequence from %s" mh-current-folder)
				 (format "%s/%d" mh-current-folder
					 msg-or-seq))))
	     (format "%s -nobell -clear %s %s | %s"
		     (expand-file-name "mhl" mh-lib)
		     (mh-msg-filename msg-or-seq)
		     (if (stringp mhl-formfile)
			 (format "-form %s" mhl-formfile)
		         "")
		     (format mh-lpr-command-format
			     (if prefix-provided
				 (format "Sequence from %s" mh-current-folder)
				 (format "%s/%d" mh-current-folder
					 msg-or-seq)))))))
    (if mh-print-background
	(mh-exec-cmd-daemon shell-file-name "-c" print-command)
	(call-process shell-file-name nil nil nil "-c" print-command))
    (if prefix-provided
	(mh-notate-seq msg-or-seq ?P mh-cmd-note)
	(mh-notate msg-or-seq ?P mh-cmd-note))
    (mh-add-msgs-to-seq msg-or-seq 'printed t)
    (if prefix-provided
	(message "Printing sequence...done")
        (message "Printing message...done"))))


(defun mh-put-msg-in-seq (prefix-provided from to)
  "Add MESSAGE(s) (default: displayed message) to SEQUENCE.
If (optional) prefix argument provided, then prompt for the message sequence."
  (interactive (list current-prefix-arg
		     (if current-prefix-arg
			 (mh-seq-to-msgs
			   (mh-read-seq-default "Add messages from" t))
			 (mh-get-msg-num t))
		     (mh-read-seq-default "Add to" nil)))
  (setq mh-previous-seq to)
  (mh-add-msgs-to-seq from to))


(defun mh-rescan-folder (range)
  "Rescan a folder after optionally processing the outstanding commands.
If (optional) prefix argument is provided, prompt for the range of
messages to display.  Otherwise show the entire folder."
  (interactive (list (if current-prefix-arg
			 (mh-read-msg-range "Range to scan [all]? ")
			 nil)))
  (setq mh-next-direction 'forward)
  (mh-scan-folder mh-current-folder (or range "all")))


(defun mh-redistribute (to cc msg)
  "Redistribute a letter.
Depending on how your copy of MH was compiled, you may need to change the
setting of the variable mh-redist-full-contents.  See its documentation."
  (interactive (list (read-string "Redist-To: ")
		     (read-string "Redist-Cc: ")
		     (mh-get-msg-num t)))
  (save-window-excursion
    (let ((folder mh-current-folder)
	  (draft (mh-read-draft "redistribution"
				(if mh-redist-full-contents
				    (mh-msg-filename msg)
				    nil)
				nil)))
      (mh-goto-header-end 0)
      (insert "Resent-To: " to "\n")
      (if (not (equal cc "")) (insert "Resent-cc: " cc "\n"))
      (mh-clean-msg-header (point-min)
			   "^Message-Id:\\|^Received:\\|^Return-Path:\\|^Sender:\\|^Date:\\|^From:"
			   nil)
      (save-buffer)
      (message "Redistributing...")
      (if mh-redist-full-contents
	  (call-process "/bin/sh" nil 0 nil "-c"
			(format "mhdist=1 mhaltmsg=%s %s -push %s"
				(buffer-file-name)
				(expand-file-name "send" mh-progs)
				(buffer-file-name)))
	  (call-process "/bin/sh" nil 0 nil "-c"
			(format "mhdist=1 mhaltmsg=%s mhannotate=1 %s -push %s"
				(mh-msg-filename msg folder)
				(expand-file-name "send" mh-progs)
				(buffer-file-name))))
      (mh-annotate-msg msg folder mh-note-dist
		       "-component" "Resent:"
		       "-text" (format "\"%s %s\"" to cc))
      (kill-buffer draft)
      (message "Redistributing...done"))))


(defun mh-write-msg-to-file (msg file)
  "Append MESSAGE to the end of a FILE."
  (interactive
   (list (mh-get-msg-num t)
	 (let ((default-dir (if (eq 'write (car mh-last-destination))
				(file-name-directory (cdr mh-last-destination))
				default-directory)))
	   (read-file-name "Save message in file: " default-dir
			   (expand-file-name "mail.out" default-dir)))))
  (let ((file-name (mh-msg-filename msg))
	(output-file (mh-expand-file-name file)))
    (setq mh-last-destination (cons 'write file))
    (save-excursion
      (set-buffer (get-buffer-create " *mh-temp*"))
      (erase-buffer)
      (insert-file-contents file-name)
      (append-to-file (point-min) (point-max) output-file))))


(defun mh-search-folder (folder)
  "Search FOLDER for messages matching a pattern."
  (interactive (list (mh-prompt-for-folder "Search"
					   mh-current-folder
					   t)))
  (switch-to-buffer-other-window "pick-pattern")
  (if (or (zerop (buffer-size))
	  (not (y-or-n-p "Reuse pattern? ")))
      (mh-make-pick-template)
      (message ""))
  (setq mh-searching-folder folder))


(defun mh-send (to cc subject)
  "Compose and send a letter."
  (interactive "sTo: \nsCc: \nsSubject: ")
  (let ((config (current-window-configuration)))
    (delete-other-windows)
    (mh-send-sub to cc subject config)))


(defun mh-send-other-window (to cc subject)
  "Compose and send a letter in another window.."
  (interactive "sTo: \nsCc: \nsSubject: ")
  (let ((pop-up-windows t))
    (mh-send-sub to cc subject (current-window-configuration))))


(defun mh-send-sub (to cc subject config)
  "Do the real work of composing and sending a letter.
Expects the TO, CC, and SUBJECT fields as arguments.
CONFIG is the window configuration before sending mail."
  (let ((folder mh-current-folder)
	(msg-num (mh-get-msg-num nil)))
    (message "Composing a message...")
    (let ((draft (mh-read-draft
		  "message"
		  (if (file-exists-p
		       (expand-file-name "components" mh-user-path))
		      (expand-file-name "components" mh-user-path)
		      (if (file-exists-p
			   (expand-file-name "components" mh-lib))
			  (expand-file-name "components" mh-lib)
			  (error "Can't find components file")))
		  nil)))
      (mh-insert-fields "To:" to "Subject:" subject "Cc:" cc)
      (set-buffer-modified-p nil)
      (goto-char (point-max))
      (message "Composing a message...done")
      (mh-compose-and-send-mail draft "" folder msg-num
				to subject cc
				nil nil config))))


(defun mh-show (&optional msg)
  "Show MESSAGE (default: displayed message).
Forces a two-window display with the folder window on top (size
mh-summary-height) and the show buffer below it."
  (interactive)
  (if (not msg)
      (setq msg (mh-get-msg-num t)))
  (setq mh-showing t)
  (mh-set-mode-name "mh-e show")
  (if (not (eql (next-window (minibuffer-window)) (selected-window)))
      (delete-other-windows))		; force ourself to the top window
  (let ((folder mh-current-folder))
    (mh-show-message-in-other-window)
    (mh-display-msg msg folder))
  (other-window -1)
  (shrink-window (- (window-height) mh-summary-height))
  (mh-recenter nil)
  (if (not (memq msg mh-seen-list)) (mh-push msg mh-seen-list)))


(defun mh-sort-folder ()
  "Sort the messages in the current folder by date."
  (interactive "")
  (mh-process-or-undo-commands mh-current-folder)
  (setq mh-next-direction 'forward)
  (mh-set-folder-modified-p t)		; lock folder while sorting
  (message "Sorting folder...")
  (mh-exec-cmd "sortm" mh-current-folder)
  (message "Sorting folder...done")
  (mh-scan-folder mh-current-folder "all"))


(defun mh-toggle-showing ()
  "Toggle the scanning mode/showing mode of displaying messages."
  (interactive)
  (if mh-showing
      (mh-set-scan-mode)
      (mh-show)))


(defun mh-undo (prefix-provided msg-or-seq)
  "Undo the deletion or refile of the specified MESSAGE(s).
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 "Undo" t)
			 (mh-get-msg-num t))))

  (cond (prefix-provided
	 (mh-mapc (function mh-undo-msg) (mh-seq-to-msgs msg-or-seq)))
	((or (looking-at mh-deleted-msg-regexp)
	     (looking-at mh-refiled-msg-regexp))
	 (mh-undo-msg (mh-get-msg-num t)))
	(t
	 (error "Nothing to undo")))
  ;; update the mh-refile-list so mh-outstanding-commands-p will work
  (mh-mapc (function
	    (lambda (elt)
	      (if (not (mh-seq-to-msgs elt))
		  (setq mh-refile-list (delq elt mh-refile-list)))))
	   mh-refile-list)

  (if (not (mh-outstanding-commands-p))
      (mh-set-folder-modified-p nil)))


(defun mh-undo-msg (msg)
  ;; Undo the deletion or refile of one MESSAGE.
  (cond ((memq msg mh-delete-list)
	 (setq mh-delete-list (delq msg mh-delete-list))
	 (mh-remove-msg-from-seq msg 'deleted t)
	 (mh-notate msg ?  mh-cmd-note))
	(t
	 (mh-mapc (function (lambda (dest)
			      (mh-remove-msg-from-seq msg dest t)))
		  mh-refile-list)
	 (mh-notate msg ?  mh-cmd-note))))


(defun mh-undo-folder (&rest ignore)
  "Undo all commands in current folder."
  (interactive "")
  (cond ((or mh-do-not-confirm
	     (yes-or-no-p "Undo all commands in folder? "))
	 (setq mh-delete-list nil
	       mh-refile-list nil
	       mh-seq-list nil
	       mh-next-direction 'forward)
	 (with-mh-folder-updating (nil)
	   (mh-unmark-all-headers t)))
	(t
	 (message "Commands not undone.")
	 (sit-for 2))))


(defun mh-visit-folder (folder &optional range)
  "Visit FOLDER and display RANGE of messages."
  (interactive (list (mh-prompt-for-folder "Visit" "+inbox" t)
		     (mh-read-msg-range "Range [all]? ")))
  (let ((config (current-window-configuration)))
    (mh-scan-folder folder (or range "all"))
    (setq mh-previous-window-config config)))


(defun mh-widen ()
  "Remove restrictions from the current folder, thereby showing all messages."
  (interactive "")
  (with-mh-folder-updating (t)
    (delete-region (point-min) (point-max))
    (widen)
    (mh-make-folder-mode-line))
  (setq mh-narrowed-to-seq nil))



;;; Support routines.

(defun mh-delete-a-msg (msg)
  ;; Delete the MESSAGE.
  (save-excursion
    (mh-goto-msg msg nil t)
    (if (looking-at mh-refiled-msg-regexp)
	(error "Message %d is refiled.  Undo refile before deleting." msg))
    (if (looking-at mh-deleted-msg-regexp)
	nil
	(mh-set-folder-modified-p t)
	(mh-push msg mh-delete-list)
	(mh-add-msgs-to-seq msg 'deleted t)
	(mh-notate msg ?D mh-cmd-note))))


(defun mh-refile-a-msg (msg destination)
  ;; Refile MESSAGE in FOLDER.
  (save-excursion
    (mh-goto-msg msg nil t)
    (cond ((looking-at mh-deleted-msg-regexp)
	   (error "Message %d is deleted.  Undo delete before moving." msg))
	  ((looking-at mh-refiled-msg-regexp)
	   (if (y-or-n-p
		(format "Message %d already refiled.  Copy to %s as well? "
			msg destination))