mh-e.el

早期freebsd实现

(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-unshar-msg (dir)
  "Unpack the shar file contained in the current message into directory DIR."
  (interactive (list (read-file-name "Unshar message in directory: "
				     mh-unshar-default-directory
				     mh-unshar-default-directory nil)))
  (mh-display-msg (mh-get-msg-num t) mh-current-folder) ;update show buffer
  (mh-unshar-buffer dir))

(defun mh-unshar-buffer (dir)
  ;; Unpack the shar file contained in the current buffer into directory DIR.
  (goto-char (point-min))
  (if (or (re-search-forward "^#![ \t]*/bin/sh" nil t)
	  (and (re-search-forward "^[^a-z0-9\"]*cut here\b" nil t)
	       (forward-line 1))
	  (re-search-forward "^#" nil t)
	  (re-search-forward "^: " nil t))
      (let ((default-directory (expand-file-name dir))
	    (start (progn (beginning-of-line) (point)))
	    (log-buffer (get-buffer-create "*Unshar Output*")))
	(save-excursion
	  (set-buffer log-buffer)
	  (setq default-directory (expand-file-name dir))
	  (erase-buffer)
	  (if (file-directory-p default-directory)
	      (insert "cd " dir "\n")
	    (insert "mkdir " dir "\n")
	    (call-process "mkdir" nil log-buffer t default-directory)))
	(set-window-start (display-buffer log-buffer) 0) ;so can watch progress
	(call-process-region start (point-max) "sh" nil log-buffer t))
    (error "Cannot find start of shar.")))
	

(defun mh-visit-folder (folder &optional range)
  "Visit FOLDER and display RANGE of messages.
Assumes mh-e has already been initialized."
  (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))
  nil)


(defun mh-widen ()
  "Remove restrictions from the current folder, thereby showing all messages."
  (interactive)
  (if mh-narrowed-to-seq
      (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.  FOLDER is a symbol, not a string.
  (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))
	       (mh-exec-cmd "refile" (mh-get-msg-num t) "-link"
			    "-src" mh-current-folder
			    (symbol-name destination))
	       (message "Message not copied.")))
	  (t
	   (mh-set-folder-modified-p t)
	   (if (not (memq destination mh-refile-list))
	       (mh-push destination mh-refile-list))
	   (if (not (memq msg (mh-seq-to-msgs destination)))
	       (mh-add-msgs-to-seq msg destination t))
	   (mh-notate msg ?^ mh-cmd-note)))))


(defun mh-display-msg (msg-num folder)
  ;; Display message NUMBER of FOLDER.
  ;; Sets the current buffer to the show buffer.
  (set-buffer folder)
  ;; Bind variables in folder buffer in case they are local
  (let ((formfile mhl-formfile)
	(clean-message-header mh-clean-message-header)
	(invisible-headers mh-invisible-headers)
	(visible-headers mh-visible-headers)
	(msg-filename (mh-msg-filename msg-num))
	(show-buffer mh-show-buffer)
	(folder mh-current-folder))
    (if (not (file-exists-p msg-filename))
	(error "Message %d does not exist" msg-num))
    (switch-to-buffer show-buffer)
    (if mh-bury-show-buffer (bury-buffer (current-buffer)))
    (mh-when (not (equal msg-filename buffer-file-name))
      ;; Buffer does not yet contain message.
      (clear-visited-file-modtime)
      (unlock-buffer)
      (setq buffer-file-name nil)	; no locking during setup
      (erase-buffer)
      (if formfile
	  (if (stringp formfile)
	      (mh-exec-lib-cmd-output "mhl" "-nobell" "-noclear"
				      "-form" formfile msg-filename)
	      (mh-exec-lib-cmd-output "mhl" "-nobell" "-noclear"
				      msg-filename))
	  (insert-file-contents msg-filename))
      (goto-char (point-min))
      (cond (clean-message-header
	     (mh-clean-msg-header (point-min)
				  invisible-headers
				  visible-headers)
	     (goto-char (point-min)))
	    (t
	     (let ((case-fold-search t))
	       (re-search-forward
		"^To:\\|^From:\\|^Subject:\\|^Date:" nil t)
	       (beginning-of-line)
	       (mh-recenter 0))))
      (set-buffer-modified-p nil)
      (setq buffer-file-name msg-filename)
      (set-mark nil)
      (setq mode-line-buffer-identification
	    (list (format mh-show-buffer-mode-line-buffer-id
			  folder msg-num))))))


(defun mh-invalidate-show-buffer ()
  ;; Invalidate the show buffer so we must update it to use it.
  (if (get-buffer mh-show-buffer)
      (save-excursion
	(set-buffer mh-show-buffer)
	(setq buffer-file-name nil))))


(defun mh-show-message-in-other-window ()
  (switch-to-buffer-other-window mh-show-buffer)
  (if mh-bury-show-buffer (bury-buffer (current-buffer))))


(defun mh-clean-msg-header (start invisible-headers visible-headers)
  ;; Flush extraneous lines in a message header, from the given POINT to the
  ;; end of the message header.  If VISIBLE-HEADERS is non-nil, it contains a
  ;; regular expression specifying the lines to display, otherwise
  ;; INVISIBLE-HEADERS contains a regular expression specifying lines to
  ;; delete from the header.
  (let ((case-fold-search t))
    (save-restriction
      (goto-char start)
      (if (search-forward "\n\n" nil t)
	  (backward-char 1))
      (narrow-to-region start (point))
      (goto-char (point-min))
      (if visible-headers
	  (while (< (point) (point-max))
	    (beginning-of-line)
	    (cond ((looking-at visible-headers)
		   (forward-line 1)
		   (while (looking-at "^[ \t]+") (forward-line 1)))
		  (t
		    (mh-delete-line 1)
		    (while (looking-at "^[ \t]+")
		      (beginning-of-line)
		      (mh-delete-line 1)))))
	  (while (re-search-forward invisible-headers nil t)
	    (beginning-of-line)
	    (mh-delete-line 1)
	    (while (looking-at "^[ \t]+")
	      (beginning-of-line)
	      (mh-delete-line 1))))
      (unlock-buffer))))


(defun mh-delete-line (lines)
  ;; Delete version of kill-line.
  (delete-region (point) (save-excursion (forward-line lines) (point))))


(defun mh-read-draft (use initial-contents delete-contents-file)
  ;; Read draft file into a draft buffer and make that buffer the current one.
  ;; USE is a message used for prompting about the intended use of the message.
  ;; INITIAL-CONTENTS is filename that is read into an empty buffer, or NIL
  ;; if buffer should not be modified.  Delete the initial-contents file if
  ;; DELETE-CONTENTS-FILE flag is set.
  ;; Returns the draft folder's name.
  ;; If the draft folder facility is enabled in ~/.mh_profile, a new buffer is
  ;; used each time and saved in the draft folder.  The draft file can then be
  ;; reused.
  (cond (mh-draft-folder
	 (let ((orig-default-dir default-directory))
	   (pop-to-buffer (find-file-noselect (mh-new-draft-name)) t)
	   (rename-buffer (format "draft-%s" (buffer-name)))
	   (setq default-directory orig-default-dir)))
	(t
	 (let ((draft-name (expand-file-name "draft" mh-user-path)))
	   (pop-to-buffer "draft")	; Create if necessary
	   (if (buffer-modified-p)
	       (if (y-or-n-p "Draft has been modified; kill anyway? ")
		   (set-buffer-modified-p nil)
		   (error "Draft preserved")))
	   (setq buffer-file-name draft-name)
	   (clear-visited-file-modtime)
	   (unlock-buffer)
	   (mh-when (and (file-exists-p draft-name)
			 (not (equal draft-name initial-contents)))
	     (insert-file-contents draft-name)
	     (delete-file draft-name)))))
  (mh-when (and initial-contents
		(or (zerop (buffer-size))
		    (not (y-or-n-p
			  (format "A draft exists.  Use for %s? " use)))))
    (erase-buffer)
    (insert-file-contents initial-contents)
    (if delete-contents-file (delete-file initial-contents)))
  (auto-save-mode 1)
  (if mh-draft-folder
      (save-buffer))			; Do not reuse draft name
  (buffer-name))


(defun mh-new-draft-name ()
  ;; Returns the pathname of folder for draft messages.
  (save-excursion
    (set-buffer (get-buffer-create " *mh-temp*"))
    (erase-buffer)
    (mh-exec-cmd-output "mhpath" nil mh-draft-folder "new")
    (buffer-substring (point) (1- (mark)))))


(defun mh-next-msg ()
  ;; Move backward or forward to the next undeleted message in the buffer.
  (if (eq mh-next-direction 'forward)
      (mh-next-undeleted-msg 1)
      (mh-previous-undeleted-msg 1)))


(defun mh-set-scan-mode ()
  ;; Display the scan listing buffer, but do not show a message.
  (if (get-buffer mh-show-buffer)
      (delete-windows-on mh-show-buffer))
  (mh-set-mode-name "mh-e scan")
  (setq mh-showing nil)
  (if mh-recenter-summary-p
      (mh-recenter nil)))


(defun mh-maybe-show (&optional msg)
  ;; If in showing mode, then display the message pointed to by the cursor.
  (if mh-showing (mh-show msg)))


(defun mh-set-mode-name (mode-name-string)
  ;; Set the mode-name and ensure that the mode line is updated.
  (setq mode-name mode-name-string)
  ;; Force redisplay of all buffers' mode lines to be considered.
  (save-excursion (set-buffer (other-buffer)))
  (set-buffer-modified-p (buffer-modified-p)))



;;; The folder data abstraction.

(defvar mh-current-folder nil "Name of current folder, a string.")
(defvar mh-show-buffer nil "Buffer that displays mesage for this folder.")
(defvar mh-folder-filename nil "Full path of directory for this folder.")
(defvar mh-showing nil "If non-nil, show the message in a separate window.")
(defvar mh-next-seq-num nil "Index of free sequence id.")
(defvar mh-delete-list nil "List of msg numbers to delete.")
(defvar mh-refile-list nil "List of folder names in mh-seq-list.")
(defvar mh-seq-list nil "Alist of (seq . msgs) numbers.")
(defvar mh-seen-list nil "List of displayed messages.")
(defvar mh-next-direction 'forward "Direction to move to next message.")
(defvar mh-narrowed-to-seq nil "Sequence display is narrowed to.")
(defvar mh-first-msg-num nil "Number of first msg in buffer.")
(defvar mh-last-msg-num nil "Number of last msg in buffer.")


(defun mh-make-folder (name)
  ;; Create and initialize a new mail folder called NAME and make it the
  ;; current folder.
  (switch-to-buffer name)
  (setq buffer-read-only nil)
  (erase-buffer)
  (setq buffer-read-only t)
  (mh-folder-mode)
  (mh-set-folder-modified-p nil)
  (setq buffer-file-name mh-folder-filename)
  (mh-set-mode-name "mh-e scan"))


;;; Don't use this mode when creating buffers if default-major-mode is nil.
(put 'mh-folder-mode 'mode-class 'special)

(defun mh-folder-mode ()
  "Major mode for \"editing\" an MH folder scan listing.
Messages can be marked for refiling and deletion.  However, both actions
are deferred until you request execution with \\[mh-execute-commands].
\\{mh-folder-mode-map}
  A prefix argument (\\[universal-argument]) to delete, refile, list, or undo
applies the action to a message sequence.

Variables controlling mh-e operation are (defaults in parentheses):

 mh-bury-show-buffer (t)
    Non-nil means that the buffer used to display message is buried.
    It will never be offered as the default other buffer.

 mh-clean-message-header (nil)
    Non-nil means remove header lines matching the regular expression
    specified in mh-invisible-headers from messages.

 mh-visible-headers (nil)
    If non-nil, it contains a regexp specifying the headers that are shown in
    a message if mh-clean-message-header is non-nil.  Setting this variable
    overrides mh-invisible-headers.

 mh-do-not-confirm (nil)
    Non-nil means do not prompt for confirmation before executing some
    non-recoverable commands such as mh-kill-folder and mh-undo-folder.

 mhl-formfile (nil)
    Name of format file to be used by mhl to show messages.
    A value of T means use the default format file.
    Nil means don't use mhl to format messages.

 mh-lpr-command-format (\"lpr -p -J '%s'\")
    Format for command used to print a message on a system printer.

 mh-recenter-summary-p (nil)
    If non-nil, then the scan listing is recentered when the window displaying
    a messages is toggled off.

 mh-summary-height (4)
    Number of lines in the summary window including the mode line.

 mh-ins-buf-prefix (\"> \")
    String to insert before each non-blank line of a message as it is
    inserted in a draft letter.

The value of mh-folder-mode-hook is called when a new folder is set up."

  (kill-all-local-variables)
  (use-local-map mh-folder-mode-map)
  (setq major-mode 'mh-folder-mode)
  (mh-set-mode-name "mh-e folder")
  (make-local-vars
   'mh-current-folder (buffer-name)	; Name of folder, a string