mh-e.el

早期freebsd实现

	      (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 ((= (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 (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)
        (folder (mh-prompt-for-folder "Fcc" "" t)))
    (expand-abbrev)
    (save-excursion
      (mh-to-field)
      (insert (substring folder 1 nil)))))


(defun mh-insert-signature ()
  "Insert the file ~/.signature at the current point."
  (interactive "")
  (insert-file-contents "~/.signature")
  (set-buffer-modified-p (buffer-modified-p))) ; force mode line update


(defun mh-check-whom ()
  "Verify recipients of the current letter."
  (interactive)
  (let ((file-name (buffer-file-name)))
    (set-buffer-modified-p t)		; Force writing of contents
    (save-buffer)
    (message "Checking recipients...")
    (switch-to-buffer-other-window "*Mail Recipients*")
    (bury-buffer (current-buffer))
    (erase-buffer)
    (mh-exec-cmd-output "whom" t file-name)
    (other-window -1)
    (message "Checking recipients...done")))



;;; Routines to make a search pattern and search for a message.

(defvar mh-searching-folder nil "Folder this pick is searching.")


(defun mh-make-pick-template ()
  ;; Initialize the current buffer with a template for a pick pattern.
  (erase-buffer)
  (kill-all-local-variables)
  (make-local-variable 'mh-searching-folder)
  (insert "From: \n"
	  "To: \n"
	  "Cc: \n"
	  "Date: \n"
	  "Subject: \n"
	  "---------\n")
  (mh-letter-mode)
  (use-local-map mh-pick-mode-map)
  (goto-char (point-min))
  (end-of-line))


(defun mh-do-pick-search ()
  "Find messages that match the qualifications in the current pattern buffer.
Messages are searched for in the folder named in mh-searching-folder.
Put messages found in a sequence named `search'."
  (interactive)
  (let ((pattern-buffer (buffer-name))
	(searching-buffer mh-searching-folder)
	(range)
	(pattern nil)
	(new-buffer nil))
    (save-excursion
      (cond ((get-buffer searching-buffer)
	     (set-buffer searching-buffer)
	     (setq range (format "%d-%d" mh-first-msg-num mh-last-msg-num)))
	    (t
	     (mh-make-folder searching-buffer)
	     (setq range "all")
	     (setq new-buffer t))))
    (message "Searching...")
    (goto-char (point-min))
    (while (setq pattern (mh-next-pick-field pattern-buffer))
      (setq msgs (mh-seq-from-command searching-buffer
				      'search
				      (nconc (cons "pick" pattern)
					     (list searching-buffer
						   range
						   "-sequence" "search"
						   "-list"))))
      (setq range "search"))
    (message "Searching...done")
    (if new-buffer
	(mh-scan-folder searching-buffer msgs)
	(switch-to-buffer searching-buffer))
    (delete-other-windows)
    (mh-notate-seq 'search ?% (1+ mh-cmd-note))))


(defun mh-next-pick-field (buffer)
  ;; Return the next piece of a pick argument that can be extracted from the
  ;; BUFFER.  Returns nil if no pieces remain.
  (set-buffer buffer)
  (let ((case-fold-search t))
    (cond ((eobp)
	   nil)
	  ((re-search-forward "^\\([a-z].*\\):[ \t]*\\([a-z0-9].*\\)$" nil t)
	   (let* ((component
		   (format "--%s"
			   (downcase (buffer-substring (match-beginning 1)
						       (match-end 1)))))
		  (pat (buffer-substring (match-beginning 2) (match-end 2))))
	       (forward-line 1)
	       (list component pat)))
	  ((re-search-forward "^-*$" nil t)
	   (forward-char 1)
	   (let ((body (buffer-substring (point) (point-max))))
	     (if (and (> (length body) 0) (not (equal body "\n")))
		 (list "-search" body)
		 nil)))
	  (t
	   nil))))



;;; Routines to compose and send a letter.

(defun mh-compose-and-send-mail (draft send-args
				       sent-from-folder sent-from-msg
				       to subject cc
				       annotate-ch