mh-e.el

早期freebsd实现

   'mh-show-buffer (format "show-%s" (buffer-name)) ; Buffer that displays msgs
   'mh-folder-filename			; e.g. "/usr/foobar/Mail/inbox/"
   (file-name-as-directory (mh-expand-file-name (buffer-name)))
   'mh-showing nil			; Show message also?
   'mh-next-seq-num 0			; Index of free sequence id
   'mh-delete-list nil			; List of msgs nums to delete
   'mh-refile-list nil			; List of folder names in mh-seq-list
   'mh-seq-list nil			; Alist of (seq . msgs) nums
   'mh-seen-list nil			; List of displayed messages
   'mh-next-direction 'forward		; Direction to move to next message
   'mh-narrowed-to-seq nil		; Sequence display is narrowed to
   'mh-first-msg-num nil		; Number of first msg in buffer
   'mh-last-msg-num nil			; Number of last msg in buffer
   'mh-previous-window-config nil)	; Previous window configuration
  (setq truncate-lines t)
  (auto-save-mode -1)
  (setq buffer-offer-save t)
  (make-local-variable 'write-file-hooks)
  (setq write-file-hooks '(mh-execute-commands))
  (make-local-variable 'revert-buffer-function)
  (setq revert-buffer-function 'mh-undo-folder)
  (run-hooks 'mh-folder-mode-hook))


(defun make-local-vars (&rest pairs)
  ;; Take VARIABLE-VALUE pairs and makes local variables initialized to the
  ;; value.
  (while pairs
    (make-variable-buffer-local (car pairs))
    (set (car pairs) (car (cdr pairs)))
    (setq pairs (cdr (cdr pairs)))))


(defun mh-scan-folder (folder range)
  ;; Scan the FOLDER over the RANGE.  Return in the folder's buffer.
  (cond ((null (get-buffer folder))
	 (mh-make-folder folder))
	(t
	 (mh-process-or-undo-commands folder)
	 (switch-to-buffer folder)))
  (mh-regenerate-headers range)
  (mh-when (zerop (buffer-size))
    (if (equal range "all")
	(message "Folder %s is empty" folder)
	(message "No messages in %s, range %s" folder range))
    (sit-for 5))
  (mh-goto-cur-msg))


(defun mh-regenerate-headers (range)
  ;; Replace buffer with scan of its contents over range RANGE.
  (let ((folder mh-current-folder))
    (message "Scanning %s..." folder)
    (with-mh-folder-updating (nil)
      (erase-buffer)
      (mh-exec-cmd-output "scan" nil
			  "-noclear" "-noheader"
			  "-width" (window-width)
			  folder range)
      (goto-char (point-min))
      (cond ((looking-at "scan: no messages in")
	     (keep-lines mh-valid-scan-line)) ; Flush random scan lines
	    ((looking-at "scan: "))	; Keep error messages
	    (t
	     (keep-lines mh-valid-scan-line))) ; Flush random scan lines
      (mh-delete-seq-locally 'cur)	; To pick up new one
      (setq mh-seq-list (mh-read-folder-sequences folder nil))
      (mh-notate-user-sequences)
      (mh-make-folder-mode-line (if (equal range "all")
				    nil
				    mh-partial-folder-mode-line-annotation)))
    (message "Scanning %s...done" folder)))


(defun mh-get-new-mail (maildrop-name)
  ;; Read new mail from a maildrop into the current buffer.
  ;; Return T if there was new mail, NIL otherwise.  Return in the current
  ;; buffer.
  (let ((point-before-inc (point))
	(folder mh-current-folder)
	(return-value t))
    (with-mh-folder-updating (t)
      (message (if maildrop-name
		   (format "inc %s -file %s..." folder maildrop-name)
		   (format "inc %s..." folder)))
      (mh-unmark-all-headers nil)
      (setq mh-next-direction 'forward)
      (goto-char (point-max))
      (let ((start-of-inc (point)))
	(if maildrop-name
	    (mh-exec-cmd-output "inc" nil folder
				"-file" (expand-file-name maildrop-name)
				"-width" (window-width)
				"-truncate")
	    (mh-exec-cmd-output "inc" nil
				"-width" (window-width)))
	(message
	 (if maildrop-name
	     (format "inc %s -file %s...done" folder maildrop-name)
	     (format "inc %s...done" folder)))
	(goto-char start-of-inc)
	(cond ((looking-at "inc: no mail")
	       (keep-lines mh-valid-scan-line) ; Flush random scan lines
	       (goto-char point-before-inc)
	       (message "No new mail%s%s" (if maildrop-name " in " "")
			(if maildrop-name maildrop-name "")))
	      ((re-search-forward "^inc:" nil t) ; Error messages
	       (error "inc error"))
	      (t
	       (mh-delete-seq-locally 'cur) ; To pick up new one
	       (setq mh-seq-list (mh-read-folder-sequences folder t))
	       (mh-notate-user-sequences)
	       (keep-lines mh-valid-scan-line)
	       (mh-make-folder-mode-line)
	       (mh-goto-cur-msg)
	       (setq return-value t))))
      return-value)))


(defun mh-make-folder-mode-line (&optional annotation)
  ;; Set the fields of the mode line for a folder buffer.
  ;; The optional ANNOTATION string is displayed after the folder's name.
  (save-excursion
    (mh-first-msg)
    (setq mh-first-msg-num (mh-get-msg-num nil))
    (mh-last-msg)
    (setq mh-last-msg-num (mh-get-msg-num nil))
    (let ((lines (count-lines (point-min) (point-max))))
      (setq mode-line-buffer-identification
	    (list (format "{%%b%s}  %d msg%s"
			  (if annotation (format "/%s" annotation) "")
			  lines
			  (if (zerop lines)
			      "s"
			      (if (> lines 1)
				  (format "s (%d-%d)" mh-first-msg-num
					  mh-last-msg-num)
				  (format " (%d)" mh-first-msg-num)))))))))


(defun mh-unmark-all-headers (remove-all-flags)
  ;; Remove all '+' flags from the headers, and if called with a non-nil
  ;; argument, remove all 'D', '^' and '%' flags too.
  ;; Optimized for speed (i.e., no regular expressions).
  (save-excursion
    (let ((case-fold-search nil)
	  (last-line (- (point-max) mh-cmd-note))
	  char)
      (mh-first-msg)
      (while (<= (point) last-line)
	(forward-char mh-cmd-note)
	(setq char (following-char))
	(if (or (and remove-all-flags
		     (or (eql char ?D)
			 (eql char ?^)
			 (eql char ?%)))
		(eql char ?+))
	    (progn
	      (delete-char 1)
	      (insert " ")))
	(forward-line)))))


(defun mh-goto-cur-msg ()
  ;; Position the cursor at the current message.
  (let ((cur-msg (car (mh-seq-to-msgs 'cur))))
    (cond ((and cur-msg
		(mh-goto-msg cur-msg t nil))
	   (mh-notate nil ?+ mh-cmd-note)
	   (mh-recenter 0)
	   (mh-maybe-show cur-msg))
	  (t
	   (mh-last-msg)
	   (message "No current message")))))


(defun mh-pack-folder-1 (range)
  ;; Close and pack the current folder.
  (mh-process-or-undo-commands mh-current-folder)
  (message "Packing folder...")
  (mh-set-folder-modified-p t)		; lock folder while packing
  (save-excursion
    (mh-exec-cmd-quiet " *mh-temp*" "folder" mh-current-folder "-pack"))
  (mh-regenerate-headers range))


(defun mh-process-or-undo-commands (folder)
  ;; If FOLDER has outstanding commands, then either process or discard them.
  (set-buffer folder)
  (if (mh-outstanding-commands-p)
      (if (or mh-do-not-confirm
	      (y-or-n-p
		"Process outstanding deletes and refiles (or lose them)? "))
	  (mh-process-commands folder)
	  (mh-undo-folder))
      (mh-invalidate-show-buffer)))


(defun mh-process-commands (folder)
  ;; Process outstanding commands for the folder FOLDER.
  (message "Processing deletes and refiles for %s..." folder)
  (set-buffer folder)
  (with-mh-folder-updating (nil)
    ;; Update the unseen sequence if it exists
    (if (and mh-seen-list (mh-seq-to-msgs mh-unseen-seq))
	(mh-undefine-sequence mh-unseen-seq mh-seen-list))

    ;; Then refile messages
    (mh-mapc
     (function
      (lambda (dest)
	(let ((msgs (mh-seq-to-msgs dest)))
	  (mh-when msgs
	    (apply 'mh-exec-cmd "refile"
		   "-src" folder (symbol-name dest) msgs)
	    (mh-delete-scan-msgs msgs)))))
     mh-refile-list)

    ;; Now delete messages
    (mh-when mh-delete-list
      (apply 'mh-exec-cmd "rmm" folder mh-delete-list)
      (mh-delete-scan-msgs mh-delete-list))

    ;; Don't need to remove sequences since delete and refile do so.

    ;; Mark cur message
    (if (> (buffer-size) 0)
	(mh-define-sequence 'cur (list (or (mh-get-msg-num nil) "last"))))

    (mh-invalidate-show-buffer)

    (setq mh-delete-list nil
	  mh-refile-list nil
	  mh-seq-list (mh-read-folder-sequences mh-current-folder nil)
	  mh-seen-list nil)
    (mh-unmark-all-headers t)
    (mh-notate-user-sequences)
    (message "Processing deletes and refiles for %s...done" folder)))


(defun mh-delete-scan-msgs (msgs)
  ;; Delete the scan listing lines for each of the msgs in the LIST.
  ;; Optimized for speed (i.e., no regular expressions).
  (setq msgs (sort msgs (function <)))	;okay to clobber msgs
  (save-excursion
    (mh-first-msg)
    (while (and msgs (< (point) (point-max)))
      (cond ((equal (mh-get-msg-num nil) (car msgs))
	     (delete-region (point) (save-excursion (forward-line) (point)))
	     (setq msgs (cdr msgs)))
	    (t
	     (forward-line))))))


(defun mh-set-folder-modified-p (flag)
  "Mark current folder as modified or unmodified according to FLAG."
  (set-buffer-modified-p flag))


(defun mh-outstanding-commands-p ()
  ;; Returns non-nil if there are outstanding deletes or refiles.
  (or mh-delete-list mh-refile-list))



;;; Mode for composing and sending a draft message.

(defvar mh-sent-from-folder nil
  "Folder of msg associated with this letter.")

(defvar mh-sent-from-msg nil
  "Number of msg associated with this letter.")

(defvar mh-send-args nil
  "Extra arguments to pass to \"send\" command.")

(defvar mh-annotate-char nil
  "Character to use to annotate mh-sent-from-msg.")

(defvar mh-annotate-field nil
  "Field name for message annotation.")

(defun mh-letter-mode ()
  "Mode for composing letters in mh-e.
When you have finished composing, type \\[mh-send-letter] to send the letter.

Variables controlling this mode (defaults in parentheses):

 mh-delete-yanked-msg-window (nil)
    If non-nil, \\[mh-yank-cur-msg] will delete any windows displaying
    the yanked message.

 mh-yank-from-start-of-msg (t)
    If non-nil, \\[mh-yank-cur-msg] will include the entire message.
    If `body', just yank the body (no header).
    If nil, only the portion of the message following the point will be yanked.
    If there is a region, this variable is ignored.

Upon invoking mh-letter-mode, text-mode-hook and mh-letter-mode-hook are
invoked with no args, if those values are non-nil.

\\{mh-letter-mode-map}"
  (interactive)
  (kill-all-local-variables)
  (make-local-variable 'paragraph-start)
  (setq paragraph-start (concat "^[ \t]*[-_][-_][-_]+$\\|" paragraph-start))
  (make-local-variable 'paragraph-separate)
  (setq paragraph-separate
	(concat "^[ \t]*[-_][-_][-_]+$\\|" paragraph-separate))
  (make-local-variable 'mh-send-args)
  (make-local-variable 'mh-annotate-char)
  (make-local-variable 'mh-annotate-field)
  (make-local-variable 'mh-previous-window-config)
  (make-local-variable 'mh-sent-from-folder)
  (make-local-variable 'mh-sent-from-msg)
  (use-local-map mh-letter-mode-map)
  (setq major-mode 'mh-letter-mode)
  (mh-set-mode-name "mh-e letter")
  (set-syntax-table mh-letter-mode-syntax-table)
  (run-hooks 'text-mode-hook 'mh-letter-mode-hook)
  (mh-when auto-fill-hook
    (make-local-variable 'auto-fill-hook)
    (setq auto-fill-hook 'mh-auto-fill-for-letter)))


(defun mh-auto-fill-for-letter ()
  ;; Auto-fill in letters treats the header specially by inserting a tab
  ;; before continuation line.
  (do-auto-fill)
  (if (mh-in-header-p)
      (save-excursion
	(beginning-of-line nil)
	(insert-char ?\t 1))))


(defun mh-in-header-p ()
  ;; Return non-nil if the point is in the header of a draft message.
  (save-excursion
    (let ((cur-point (point)))
      (goto-char (dot-min))
      (re-search-forward "^--------" nil t)
      (< cur-point (point)))))


(defun mh-to-field ()
  "Move point to the end of a specified header field.
The field is indicated by the previous keystroke.  Create the field if
it does not exist.  Set the mark to point before moving."
  (interactive)
  (expand-abbrev)
  (let ((target (cdr (assoc (logior last-input-char ?`) mh-to-field-choices)))
	(case-fold-search t))
    (cond ((mh-position-on-field target t)
	   (let ((eol (point)))
	     (skip-chars-backward " \t")
	     (delete-region (point) eol))
	   (if (and (not (eq (logior last-input-char ?`) ?s))
		    (save-excursion
		      (backward-char 1)
		      (not (looking-at "[:,]"))))
	       (insert ", ")
	       (insert " ")))
	  (t
	   (goto-char (dot-min))
	   (re-search-forward "^To:")
	   (forward-line 1)
	   (while (looking-at "^[ \t]") (forward-line 1))
	   (insert (format "%s \n" target))
	   (backward-char 1)))))


(defun mh-to-fcc ()
  "Insert an Fcc: field in the current message.
Prompt for the field name with a completion list of the current folders."
  (interactive)
  (let ((last-input-char ?\C-f)