Mercurial > emacs
changeset 11332:c9c652970786
New version from author.
| author | Karl Heuer <kwzh@gnu.org> |
|---|---|
| date | Sun, 09 Apr 1995 22:31:08 +0000 |
| parents | 730a7c669a73 |
| children | 53174cfc29fa |
| files | lisp/mail/mh-comp.el lisp/mail/mh-e.el lisp/mail/mh-funcs.el lisp/mail/mh-mime.el lisp/mail/mh-pick.el lisp/mail/mh-seq.el |
| diffstat | 6 files changed, 841 insertions(+), 480 deletions(-) [+] |
line wrap: on
line diff
--- a/lisp/mail/mh-comp.el Sun Apr 09 22:29:08 1995 +0000 +++ b/lisp/mail/mh-comp.el Sun Apr 09 22:31:08 1995 +0000 @@ -1,7 +1,7 @@ ;;; mh-comp --- mh-e functions for composing messages -;; Time-stamp: <94/03/08 10:05:20 gildea> +;; Time-stamp: <94/12/31 14:07:28 gildea> -;; Copyright 1993 Free Software Foundation, Inc. +;; Copyright (C) 1993, 1995 Free Software Foundation, Inc. ;; This file is part of mh-e. @@ -23,11 +23,27 @@ ;; Internal support for mh-e package. +;;; Change Log: + +;; $Id: mh-comp.el,v 1.8 94/12/31 19:11:42 gildea Exp $ + ;;; Code: (provide 'mh-comp) (require 'mh-utils) +;;; Site customization (see also mh-utils.el): + +(defvar mh-send-prog "send" + "Name of the MH send program. +Some sites need to change this because of a name conflict.") + +(defvar mh-redist-full-contents nil + "Non-nil if the `dist' command needs whole letter for redistribution. +This is the case only when `send' is compiled with the BERK option. +If MH will not allow you to redist a previously redist'd msg, set to nil.") + + (defvar mh-note-repl "-" "String whose first character is used to notate replied to messages.") @@ -37,10 +53,6 @@ (defvar mh-note-dist "R" "String whose first character is used to notate redistributed messages.") -(defvar mh-send-prog "send" - "Name of the MH send program. -Some sites need to change this because of a name conflict.") - (defvar mh-yank-hooks nil "Obsolete hook for modifying a citation just inserted in the mail buffer. Each hook function can find the citation between point and mark. @@ -80,10 +92,16 @@ following the point. If the show buffer has a region, this variable is ignored.") +(defvar mh-ins-buf-prefix "> " + "*String to put before each non-blank line of a yanked or inserted message. +\\<mh-letter-mode-map>Used when the message is inserted into an outgoing letter +by \\[mh-insert-letter] or \\[mh-yank-cur-msg].") + (defvar mh-reply-default-reply-to nil "*Sets the person or persons to whom a reply will be sent. If nil, prompt for recipient. If non-nil, then \\<mh-folder-mode-map>`\\[mh-reply]' will use this -value and it should be one of \"from\", \"to\", or \"cc\".") +value and it should be one of \"from\", \"to\", \"cc\", or \"all\". +The values \"cc\" and \"all\" do the same thing.") (defvar mh-signature-file-name "~/.signature" "*Name of file containing the user's signature. @@ -100,13 +118,19 @@ is searched for first in the user's MH directory, then in the system MH lib directory.") +(defvar mh-repl-formfile "replcomps" + "Name of file to be used as a skeleton for replying to messages. +Default is \"replcomps\". If not a complete path name, the file +is searched for first in the user's MH directory, then in the +system MH lib directory.") + ;;; Hooks: (defvar mh-letter-mode-hook nil "Invoked in `mh-letter-mode' on a new letter.") (defvar mh-compose-letter-function nil - "Invoked in `mh-compose-and-send-mail' on a draft letter. + "Invoked when setting up a letter draft. It is passed three arguments: TO recipients, SUBJECT, and CC recipients.") (defvar mh-before-send-letter-hook nil @@ -114,21 +138,25 @@ (defvar mh-rejected-letter-start - (concat "^ ----- Unsent message follows -----$" ;from mail system - "\\|^------- Unsent Draft$" ;from MH itself + (concat "^ ----- Unsent message follows -----$" ;from sendmail V5 + "\\|^ ----- Original message follows -----$" ;from sendmail V8 + "\\|^------- Unsent Draft$" ;from MH itself "\\|^---------- Original Message ----------$" ;from zmailer - "\\|^ --- The unsent message follows ---$" ;from AIX mail system - "\\|^ Your message follows:$") ;from MMDF-II + "\\|^ --- The unsent message follows ---$" ;from AIX mail system + "\\|^ Your message follows:$" ;from MMDF-II + "\\|^Content-Description: Returned Content$" ;1993 KJ sendmail + ) "Regexp specifying the beginning of the wrapper around a returned letter. This wrapper is generated by the mail system when rejecting a letter.") (defvar mh-new-draft-cleaned-headers - "^Date:\\|^Received:\\|^Message-Id:\\|^From:\\|^Sender:\\|^Delivery-Date:\\|^Return-Path:" + "^Date:\\|^Received:\\|^Message-Id:\\|^From:\\|^Sender:\\|^Errors-To:\\|^Delivery-Date:\\|^Return-Path:" "Regexp of header lines to remove before offering a message as a new draft. Used by the \\<mh-folder-mode-map>`\\[mh-edit-again]' and `\\[mh-extract-rejected-mail]' commands.") -(defvar mh-to-field-choices '((?t . "To:") (?s . "Subject:") (?c . "Cc:") - (?b . "Bcc:") (?f . "Fcc:")) +(defvar mh-to-field-choices '(("t" . "To:") ("s" . "Subject:") ("c" . "Cc:") + ("b" . "Bcc:") ("f" . "Fcc:") ("r" . "From:") + ("d" . "Dcc:")) "Alist of (final-character . field-name) choices for mh-to-field.") (defvar mh-letter-mode-map (copy-keymap text-mode-map) @@ -148,7 +176,9 @@ (defun mh-smail () "Compose and send mail with the MH mail system. This function is an entry point to mh-e, the Emacs front end -to the MH mail system." +to the MH mail system. + +See documentation of `\\[mh-send]' for more details on composing mail." (interactive) (mh-find-path) (call-interactively 'mh-send)) @@ -156,6 +186,7 @@ (defun mh-edit-again (msg) "Clean-up a draft or a message previously sent and make it resendable. +Default is the current message. The variable mh-new-draft-cleaned-headers specifies the headers to remove. See also documentation for `\\[mh-send]' function." (interactive (list (mh-get-msg-num t))) @@ -177,7 +208,7 @@ (defun mh-extract-rejected-mail (msg) "Extract a letter returned by the mail system and make it resendable. -Default is the displayed message. The variable mh-new-draft-cleaned-headers +Default is the current message. The variable mh-new-draft-cleaned-headers gives the headers to clean out of the original message. See also documentation for `\\[mh-send]' function." (interactive (list (mh-get-msg-num t))) @@ -193,8 +224,10 @@ (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:") + (mh-compose-and-send-mail draft "" from-folder msg + (mh-get-header-field "To:") + (mh-get-header-field "From:") + (mh-get-header-field "Cc:") nil nil config))) @@ -206,7 +239,7 @@ (mh-read-address "Cc: ") (if current-prefix-arg (mh-read-seq-default "Forward" t) - (mh-get-msg-num t)))) + (mh-get-msg-num t)))) (or msg-or-seq (setq msg-or-seq (mh-get-msg-num t))) (let* ((folder mh-current-folder) @@ -215,32 +248,38 @@ (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) + (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 ((orig-from (save-excursion (mh-get-field "From:"))) - (orig-subject (save-excursion (mh-get-field "Subject:")))) - (widen) + (let (orig-from + orig-subject) + (goto-char (point-min)) + (re-search-forward "^------- Forwarded Message") + (forward-line 1) + (skip-chars-forward " \t\n") + (save-restriction + (narrow-to-region (point) (point-max)) + (setq orig-from (mh-get-header-field "From:")) + (setq orig-subject (mh-get-header-field "Subject:"))) (let ((forw-subject (mh-forwarded-letter-subject orig-from orig-subject))) - (save-excursion (mh-insert-fields "Subject:" forw-subject)) - (delete-other-windows) - (if (numberp msg-or-seq) - (mh-add-msgs-to-seq msg-or-seq 'forwarded t) + (mh-insert-fields "Subject:" forw-subject) + (goto-char (point-min)) + (re-search-forward "^------- Forwarded Message") + (forward-line -1) + (delete-other-windows) + (if (numberp msg-or-seq) + (mh-add-msgs-to-seq msg-or-seq 'forwarded t) (mh-add-msgs-to-seq (mh-seq-to-msgs msg-or-seq) 'forwarded t)) - (mh-compose-and-send-mail draft "" folder msg-or-seq - to forw-subject cc - mh-note-forw "Forwarded:" - config))))) + (mh-compose-and-send-mail draft "" folder msg-or-seq + to forw-subject cc + mh-note-forw "Forwarded:" + config))))) (defun mh-forwarded-letter-subject (from subject) ;; Return a Subject suitable for a forwarded message. @@ -260,7 +299,9 @@ (defun mh-smail-other-window () "Compose and send mail in other window with the MH mail system. This function is an entry point to mh-e, the Emacs front end -to the MH mail system." +to the MH mail system. + +See documentation of `\\[mh-send]' for more details on composing mail." (interactive) (mh-find-path) (call-interactively 'mh-send-other-window)) @@ -293,14 +334,14 @@ (if mh-redist-full-contents (call-process "/bin/sh" nil 0 nil "-c" (format "mhdist=1 mhaltmsg=%s %s -push %s" - (buffer-file-name) + buffer-file-name (expand-file-name mh-send-prog mh-progs) - (buffer-file-name))) + 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 mh-send-prog mh-progs) - (buffer-file-name)))) + buffer-file-name))) (mh-annotate-msg msg folder mh-note-dist "-component" "Resent:" "-text" (format "\"%s %s\"" to cc)) @@ -308,15 +349,16 @@ (message "Redistributing...done")))) -(defun mh-reply (msg &optional includep) - "Reply to a MESSAGE (default: displayed message). +(defun mh-reply (message &optional includep) + "Reply to MESSAGE (default: current message). If optional prefix argument INCLUDEP provided, then include the message in the reply using filter mhl.reply in your MH directory. Prompts for type of addresses to reply to: from sender only, to sender and primary recipients, cc/all sender and all recipients. -See also documentation for `\\[mh-send]' function." +If the file named by `mh-repl-formfile' exists, it is used as a skeleton +for the reply. See also documentation for `\\[mh-send]' function." (interactive (list (mh-get-msg-num t) current-prefix-arg)) (let ((minibuffer-help-form "from => Sender only\nto => Sender and primary recipients\ncc or all => Sender and all recipients")) @@ -330,7 +372,9 @@ (config (current-window-configuration))) (message "Composing a reply...") (mh-exec-cmd "repl" "-build" "-noquery" "-nodraftfolder" - mh-current-folder msg + (if (stringp mh-repl-formfile) ;must be string, but we're paranoid + (list "-form" mh-repl-formfile)) + mh-current-folder message (cond ((or (equal reply-to "from") (equal reply-to "")) '("-nocc" "all")) ((equal reply-to "to") @@ -345,27 +389,28 @@ (delete-other-windows) (set-buffer-modified-p nil) - (let ((to (mh-get-field "To:")) - (subject (mh-get-field "Subject:")) - (cc (mh-get-field "Cc:"))) + (let ((to (mh-get-header-field "To:")) + (subject (mh-get-header-field "Subject:")) + (cc (mh-get-header-field "Cc:"))) (goto-char (point-min)) (mh-goto-header-end 1) (or includep (mh-in-show-buffer (show-buffer) - (mh-display-msg msg folder))) - (mh-add-msgs-to-seq msg 'answered t) + (mh-display-msg message folder))) + (mh-add-msgs-to-seq message 'answered t) (message "Composing a reply...done") - (mh-compose-and-send-mail draft "" folder msg to subject cc + (mh-compose-and-send-mail draft "" folder message to subject cc mh-note-repl "Replied:" config)))))) (defun mh-send (to cc subject) "Compose and send a letter. The file named by `mh-comp-formfile' will be used as the form. +Do not call this function from outside mh-e; use \\[mh-smail] instead. + The letter is composed in mh-letter-mode; see its documentation for more details. If `mh-compose-letter-function' is defined, it is called on the -draft and passed three arguments: to, subject, and cc. -Do not call this function from outside mh-e; use \\[mh-smail] instead." +draft and passed three arguments: to, subject, and cc." (interactive (list (mh-read-address "To: ") (mh-read-address "Cc: ") @@ -389,9 +434,9 @@ (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." + ;; 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...") @@ -507,18 +552,45 @@ ;; Move to end of entire header if FIELD not found. ;; Returns non-nil iff FIELD was found. ;; The optional second arg is for pre-version 4 compatibility. - (let ((case-fold-search t)) - (goto-char (point-min)) - (mh-goto-header-end 0) - (if (re-search-backward (format "^%s" field) nil t) - (progn - (forward-line 1) - (while (looking-at "^[ \t]") - (forward-line 1)) - (backward-char 1) ;to end of previous line - t) - nil))) + (if (mh-goto-header-field field) + (progn + (mh-header-field-end) + t))) + + +(defun mh-get-header-field (field) + ;; Find and return the body of FIELD in the mail header. + ;; Returns the empty string if the field is not in the header of the + ;; current buffer. + (if (mh-goto-header-field field) + (progn + (skip-chars-forward " \t") ;strip leading white space in body + (let ((start (point))) + (mh-header-field-end) + (buffer-substring start (point)))) + "")) + +(fset 'mh-get-field 'mh-get-header-field) ;mh-e 4 compatibility +(defun mh-goto-header-field (field) + ;; Move to FIELD in the message header. + ;; Move to the end of the FIELD name, which should end in a colon. + ;; Returns T if found, NIL if not. + (goto-char (point-min)) + (let ((case-fold-search t) + (headers-end (save-excursion + (mh-goto-header-end 0) + (point)))) + (re-search-forward (format "^%s" field) headers-end t))) + +(defun mh-header-field-end () + ;; Move to the end of the current header field. + ;; Handles RFC 822 continuation lines. + (forward-line 1) + (while (looking-at "^[ \t]") + (forward-line 1)) + (backward-char 1)) ;to end of previous line + (defun mh-goto-header-end (arg) ;; Find the end of the message header in the current buffer and position @@ -536,27 +608,25 @@ ;;; 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-folder nil) ;Folder of msg assoc with this letter. -(defvar mh-sent-from-msg nil - "Number of msg associated with this letter.") +(defvar mh-sent-from-msg nil) ;Number of msg assoc with this letter. -(defvar mh-send-args nil - "Extra arguments to pass to \"send\" command.") +(defvar mh-send-args nil) ;Extra args to pass to "send" command. -(defvar mh-annotate-char nil - "Character to use to annotate mh-sent-from-msg.") +(defvar mh-annotate-char nil) ;Character to use to annotate mh-sent-from-msg. -(defvar mh-annotate-field nil - "Field name for message annotation.") +(defvar mh-annotate-field nil) ;Field name for message annotation. (put 'mh-letter-mode 'mode-class 'special) ;;;###autoload (defun mh-letter-mode () "Mode for composing letters in mh-e.\\<mh-letter-mode-map> -When you have finished composing, type \\[mh-send-letter] to send the letter. +When you have finished composing, type \\[mh-send-letter] to send the message +using the MH mail handling system. +See the documentation for \\[mh-edit-mhn] for information on composing MIME +messages. \\{mh-letter-mode-map} @@ -572,6 +642,10 @@ If nil, only the portion of the message following the point will be yanked. If there is a region, this variable is ignored. + mh-ins-buf-prefix (\"> \") + String to insert before each non-blank line of a message as it is + inserted in a draft letter. + mh-signature-file-name (\"~/.signature\") File to be inserted into message by \\[mh-insert-signature]. @@ -580,12 +654,11 @@ (interactive) (or mh-user-path (mh-find-path)) - (kill-all-local-variables) (make-local-variable 'paragraph-start) - (setq paragraph-start (concat "[ \t]*[-_][-_][-_]+$\\|" paragraph-start)) + (setq paragraph-start (concat "^[ \t]*[-_][-_][-_]+$\\|" paragraph-start)) (make-local-variable 'paragraph-separate) (setq paragraph-separate - (concat "[ \t]*[-_][-_][-_]+$\\|" paragraph-separate)) + (concat "^[ \t]*[-_][-_][-_]+$\\|" paragraph-separate)) (make-local-variable 'mh-send-args) (make-local-variable 'mh-annotate-char) (make-local-variable 'mh-annotate-field) @@ -631,11 +704,14 @@ (defun mh-to-field () "Move point to the end of a specified header field. The field is indicated by the previous keystroke (the last keystroke -of the command) according to the list in mh-to-field-choices. +of the command) according to the list in the variable mh-to-field-choices. 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))) + (let ((target (cdr (or (assoc (char-to-string (logior last-input-char ?`)) + mh-to-field-choices) + ;; also look for a char for version 4 compat + (assoc (logior last-input-char ?`) mh-to-field-choices)))) (case-fold-search t)) (push-mark) (cond ((mh-position-on-field target) @@ -662,10 +738,10 @@ (or folder (setq folder (mh-prompt-for-folder "Fcc" - (or (and mh-msg-folder-hook + (or (and mh-default-folder-for-message-function (save-excursion (goto-char (point-min)) - (funcall mh-msg-folder-hook))) + (funcall mh-default-folder-for-message-function))) "") t))) (let ((last-input-char ?\C-f)) @@ -685,9 +761,9 @@ (defun mh-check-whom () - "Verify recipients of the current letter." + "Verify recipients of the current letter, showing expansion of any aliases." (interactive) - (let ((file-name (buffer-file-name))) + (let ((file-name buffer-file-name)) (save-buffer) (message "Checking recipients...") (mh-in-show-buffer ("*Recipients*") @@ -726,9 +802,9 @@ (setq mh-previous-window-config config) (setq mode-line-buffer-identification (list "{%b}")) (if (and (boundp 'mh-compose-letter-function) - (symbol-value 'mh-compose-letter-function)) + mh-compose-letter-function) ;; run-hooks will not pass arguments. - (let ((value (symbol-value 'mh-compose-letter-function))) + (let ((value mh-compose-letter-function)) (if (and (listp value) (not (eq (car value) 'lambda))) (while value (funcall (car value) to subject cc) @@ -746,7 +822,7 @@ (save-buffer) (message "Sending...") (let ((draft-buffer (current-buffer)) - (file-name (buffer-file-name)) + (file-name buffer-file-name) (config mh-previous-window-config)) (cond (arg (pop-to-buffer "MH mail delivery") @@ -765,8 +841,8 @@ mh-annotate-char "-component" mh-annotate-field "-text" (format "\"%s %s\"" - (mh-get-field "To:") - (mh-get-field "Cc:")))) + (mh-get-header-field "To:") + (mh-get-header-field "Cc:")))) (cond ((or (not arg) (y-or-n-p "Kill draft buffer? ")) @@ -778,27 +854,27 @@ (message "Sending...backgrounded")))) -(defun mh-insert-letter (msg folder verbatum) - "Insert a MESSAGE from any FOLDER into the current letter. -Removes the message's headers using mh-invisible-headers. -Prefixes each non-blank line with mh-ins-buf-prefix (default \"> \"). -If prefix argument VERBATUM provided, do not indent and do not delete -headers. Leaves the mark before the letter and point after it." +(defun mh-insert-letter (folder message verbatim) + "Insert a message into the current letter. +Removes the message's headers using mh-invisible-headers. Prefixes +each non-blank line with mh-ins-buf-prefix. Prompts for FOLDER and +MESSAGE. If prefix argument VERBATIM provided, do not indent and do +not delete headers. Leaves the mark before the letter and point after it." (interactive - (list (read-input (format "Message number%s: " + (list (mh-prompt-for-folder "Message from" mh-sent-from-folder nil) + (read-input (format "Message number%s: " (if mh-sent-from-msg (format " [%d]" mh-sent-from-msg) - ""))) - (mh-prompt-for-folder "Message from" mh-sent-from-folder nil) + ""))) current-prefix-arg)) (save-restriction (narrow-to-region (point) (point)) (let ((start (point-min))) - (if (equal msg "") (setq msg (int-to-string mh-sent-from-msg))) + (if (equal message "") (setq message (int-to-string mh-sent-from-msg))) (mh-exec-lib-cmd-output "mhl" "-nobell" "-noclear" - (expand-file-name msg + (expand-file-name message (mh-expand-file-name folder))) - (cond ((not verbatum) + (cond ((not verbatim) (mh-clean-msg-header start mh-invisible-headers mh-visible-headers) (set-mark start) ; since mh-clean-msg-header moves it (mh-insert-prefix-string mh-ins-buf-prefix)))))) @@ -822,8 +898,8 @@ (delete-windows-on mh-show-buffer)) (set-buffer mh-show-buffer) ; Find displayed message (let ((mh-ins-str (cond ((if (boundp 'mark-active) - mark-active ;Emacs 19 - (mark)) ;Emacs 18 + mark-active ;Emacs 19 + (mark)) ;Emacs 18 (buffer-substring (region-beginning) (region-end))) ((eq 'body mh-yank-from-start-of-msg) @@ -838,27 +914,27 @@ (t (buffer-substring (point) (point-max)))))) (set-buffer to-buffer) - (narrow-to-region to-point to-point) - (push-mark) - (insert mh-ins-str) - (mh-insert-prefix-string mh-ins-buf-prefix) - (insert "\n") - (widen))) - (error "There is no current message"))) + (save-restriction + (narrow-to-region to-point to-point) + (push-mark) + (insert mh-ins-str) + (mh-insert-prefix-string mh-ins-buf-prefix) + (insert "\n")))) + (error "There is no current message"))) (defun mh-insert-prefix-string (mh-ins-string) - ;; Run MAIL-CITATION-HOOK to insert a prefix string before each line + ;; Run mail-citation-hook to insert a prefix string before each line ;; in the buffer. Generality for supercite users. - (save-excursion - (set-mark (point-max)) - (goto-char (point-min)) - (cond (mail-citation-hook - (run-hooks 'mail-citation-hook)) - (mh-yank-hooks ;old hook name - (run-hooks 'mh-yank-hooks)) - (t - (or (bolp) (forward-line 1)) + (set-mark (point-max)) + (goto-char (point-min)) + (cond (mail-citation-hook + (run-hooks 'mail-citation-hook)) + (mh-yank-hooks ;old hook name + (run-hooks 'mh-yank-hooks)) + (t + (or (bolp) (forward-line 1)) + (let ((zmacs-regions nil)) ;so "(mark)" works in XEmacs (while (< (point) (mark)) (insert mh-ins-string) (forward-line 1)))))) @@ -870,8 +946,8 @@ (interactive) (if (y-or-n-p "Kill draft message? ") (let ((config mh-previous-window-config)) - (if (file-exists-p (buffer-file-name)) - (delete-file (buffer-file-name))) + (if (file-exists-p buffer-file-name) + (delete-file buffer-file-name)) (set-buffer-modified-p nil) (kill-buffer (buffer-name)) (message "") @@ -879,23 +955,30 @@ (set-window-configuration config))) (error "Message not killed"))) + ;;; Build the letter-mode keymap: (define-key mh-letter-mode-map "\C-c\C-f\C-b" 'mh-to-field) (define-key mh-letter-mode-map "\C-c\C-f\C-c" 'mh-to-field) +(define-key mh-letter-mode-map "\C-c\C-f\C-d" 'mh-to-field) (define-key mh-letter-mode-map "\C-c\C-f\C-f" 'mh-to-fcc) +(define-key mh-letter-mode-map "\C-c\C-f\C-r" 'mh-to-field) (define-key mh-letter-mode-map "\C-c\C-f\C-s" 'mh-to-field) (define-key mh-letter-mode-map "\C-c\C-f\C-t" 'mh-to-field) (define-key mh-letter-mode-map "\C-c\C-fb" 'mh-to-field) (define-key mh-letter-mode-map "\C-c\C-fc" 'mh-to-field) +(define-key mh-letter-mode-map "\C-c\C-fd" 'mh-to-field) (define-key mh-letter-mode-map "\C-c\C-ff" 'mh-to-fcc) +(define-key mh-letter-mode-map "\C-c\C-fr" 'mh-to-field) (define-key mh-letter-mode-map "\C-c\C-fs" 'mh-to-field) (define-key mh-letter-mode-map "\C-c\C-ft" 'mh-to-field) +(define-key mh-letter-mode-map "\C-c\C-i" 'mh-insert-letter) (define-key mh-letter-mode-map "\C-c\C-q" 'mh-fully-kill-draft) +(define-key mh-letter-mode-map "\C-c\C-\\" 'mh-fully-kill-draft) ;if no C-q +(define-key mh-letter-mode-map "\C-c\C-s" 'mh-insert-signature) +(define-key mh-letter-mode-map "\C-c\C-^" 'mh-insert-signature) ;if no C-s (define-key mh-letter-mode-map "\C-c\C-w" 'mh-check-whom) -(define-key mh-letter-mode-map "\C-c\C-i" 'mh-insert-letter) (define-key mh-letter-mode-map "\C-c\C-y" 'mh-yank-cur-msg) -(define-key mh-letter-mode-map "\C-c\C-s" 'mh-insert-signature) (define-key mh-letter-mode-map "\C-c\C-c" 'mh-send-letter) (define-key mh-letter-mode-map "\C-c\C-m\C-f" 'mh-mhn-compose-forw) (define-key mh-letter-mode-map "\C-c\C-m\C-e" 'mh-mhn-compose-anon-ftp) @@ -908,21 +991,36 @@ ;;; autoloads from mh-mime (autoload 'mh-mhn-compose-insertion "mh-mime" - "Add a directive to insert a message part from a file." t) + "Add a directive to insert a message part from a file. +This is the typical way to insert non-text parts in a message. +See also \\[mh-edit-mhn]." t) + (autoload 'mh-mhn-compose-anon-ftp "mh-mime" - "Add a directive for an anonymous ftp external body part." t) + "Add a directive for an anonymous ftp external body part. +This directive tells MH to include a reference to a +message/external-body part retrievable by anonymous FTP. +See also \\[mh-edit-mhn]." t) + (autoload 'mh-mhn-compose-external-compressed-tar "mh-mime" - "Add a directive to include a reference to a compressed tar file." t) + "Add a directive to include a reference to a compressed tar file. +The file should be available via anonymous ftp. This directive +tells MH to include a reference to a message/external-body part. +See also \\[mh-edit-mhn]." t) + (autoload 'mh-mhn-compose-forw "mh-mime" - "Add a forw directive to this message." t) + "Add a forw directive to this message. +This directive tells MH to include another message in this one. +See also \\[mh-edit-mhn]." t) + (autoload 'mh-edit-mhn "mh-mime" - "Filter the current draft through the mhn program for MIME formatting. -Using directives already inserted in the draft, fills in + "Format the current draft for MIME, expanding any mhn directives. +Process the current draft with the mhn program, which, +using directives already inserted in the draft, fills in all the MIME components and header fields. This step should be done last just before sending the message. The mhn program is part of MH version 6.8 or later. The `\\[mh-revert-mhn-edit]' command undoes this command. -For assistance with creating MIME directives to insert +For assistance with creating mhn directives to insert various types of components in a message, see \\[mh-mhn-compose-insertion] (generic insertion from a file), \\[mh-mhn-compose-anon-ftp] (external reference to file via anonymous ftp), @@ -931,4 +1029,5 @@ \\[mh-mhn-compose-forw] (forward message)." t) (autoload 'mh-revert-mhn-edit "mh-mime" - "Undoes the effect of \\[mh-edit-mhn] by reverting to the backup file." t) + "Undoes the effect of \\[mh-edit-mhn] by reverting to the backup file. +Optional non-nil argument means don't ask for confirmation." t)
--- a/lisp/mail/mh-e.el Sun Apr 09 22:29:08 1995 +0000 +++ b/lisp/mail/mh-e.el Sun Apr 09 22:31:08 1995 +0000 @@ -1,14 +1,15 @@ ;;; mh-e.el --- GNU Emacs interface to the MH mail system -;;; Copyright 1985,86,87,88,90,92,93,94 Free Software Foundation, Inc. +;;; Copyright (C) 1985,86,87,88,90,92,93,94,95 Free Software Foundation, Inc. -(defconst mh-e-time-stamp "Time-stamp: <94/04/13 11:30:48 gildea>") -(defconst mh-e-version "4.1" +(defconst mh-e-time-stamp "Time-stamp: <95/03/05 23:39:29 gildea>") +(defconst mh-e-version "5.0" "Version numbers of this version of mh-e.") ;; Maintainer: Stephen Gildea <gildea@lcs.mit.edu> -;; Version: 4.1 +;; Version: 5.0 ;; Keywords: mail +;; Bug-reports: include `M-x mh-version' output in any correspondence ;; mh-e is free software; you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by @@ -30,29 +31,37 @@ ;;; M-x mh-rmail to read mail. Type C-h m there for a list of commands. ;;; C-u M-x mh-rmail to visit any folder. ;;; M-x mh-smail to send mail. From within the mail reader, "m" works, too. -;;; Your .emacs might benefit from these bindings: -;;; (global-set-key "\C-cr" 'mh-rmail) -;;; (global-set-key "\C-xm" 'mh-smail) -;;; (global-set-key "\C-x4m" 'mh-smail-other-window) ;;; MH (Message Handler) is a powerful mail reader. The MH newsgroup ;;; is comp.mail.mh; the mailing list is mh-users@ics.uci.edu (send to ;;; mh-users-request to be added). See the monthly Frequently Asked -;;; Questions posting there for information on getting MH. +;;; Questions posting there for information on getting MH and mh-e. -;;; mh-e works with Emacs 18 or 19, and MH 5 or 6. +;;; mh-e is an Emacs interface to the MH mail system. +;;; The mailing list mh-e@x.org is for discussion of mh-e and +;;; announcements of new versions. Send a "subscribe" message to +;;; mh-e-request@x.org to be added. Do not report bugs here; mail +;;; them directly to the author (see top of mh-e.el source). +;;; Include the output of M-x mh-version in any bug report. + +;;; mh-e works with GNU Emacs 18 or 19, and MH 6. ;;; NB. MH must have been compiled with the MHE compiler flag or several -;;; features necessary mh-e will be missing from MH commands, specifically +;;; features necessary for mh-e will be missing from MH commands, specifically ;;; the -build switch to repl and forw. +;;; Your .emacs might benefit from these bindings: +;;; (global-set-key "\C-cr" 'mh-rmail) +;;; (global-set-key "\C-xm" 'mh-smail) +;;; (global-set-key "\C-x4m" 'mh-smail-other-window) + ;;; Change Log: ;;; Original version for Gosling emacs by Brian Reid, Stanford, 1982. ;;; Modified by James Larus, BBN, July 1984 and UCB, 1984 & 1985. ;;; Rewritten for GNU Emacs, James Larus 1985. larus@ginger.berkeley.edu ;;; Modified by Stephen Gildea 1988. gildea@lcs.mit.edu -(defconst mh-e-RCS-id "$Header: /home/fsf/rms/e19/lisp/RCS/mh-e.el,v 1.3 1994/07/18 18:04:45 rms Exp rms $") +(defconst mh-e-RCS-id "$Id: mh-e.el,v 3.21 95/03/06 19:11:17 gildea Exp $") ;;; Code: @@ -60,13 +69,6 @@ (require 'mh-utils) -;;; Site customization (see also mh-utils.el): - -(defvar mh-redist-full-contents nil - "Non-nil if the `dist' command needs whole letter for redistribution. -This is the case only when `send' is compiled with the BERK option. -If MH will not allow you to redist a previously redist'd msg, set to nil.") - ;;; Hooks: (defvar mh-folder-mode-hook nil @@ -97,7 +99,7 @@ ;;; Personal preferences: -(defvar mh-lpr-command-format "lpr -p -J '%s'" +(defvar mh-lpr-command-format "lpr -J '%s'" "*Format for Unix command that prints a message. The string should be a Unix command line, with the string '%s' where the job's name (folder and message number) should appear. The formatted @@ -123,11 +125,6 @@ (defvar mh-recenter-summary-p nil "*Recenter summary window when the show window is toggled off if non-nil.") -(defvar mh-ins-buf-prefix "> " - "*String to put before each non-blank line of a yanked or inserted message. -\\<mh-letter-mode-map>Used when the message is inserted into an outgoing letter -by \\[mh-insert-letter] or \\[mh-yank-cur-msg].") - (defvar mh-do-not-confirm nil "*Non-nil means do not prompt for confirmation before some mh-e commands. Affects non-recoverable commands such as mh-kill-folder and mh-undo-folder.") @@ -152,16 +149,17 @@ (defvar mh-valid-scan-line "^ *[0-9]" "Regexp matching scan lines for messages (not error messages).") -(defvar mh-flagged-scan-msg-regexp "^....\\D\\|^....\\^\\|^....\\+\\|^.....%" - "Regexp matching flagged scan lines. -Matches lines marked as deleted, refiled, in a sequence, or the cur message.") - (defvar mh-cur-scan-msg-regexp "^....\\+" "Regexp matching scan line for the cur message.") -(defvar mh-show-buffer-mode-line-buffer-id "{show-%s} %d" - "Format string to produce `mode-line-buffer-identification' for show buffers. -First argument is folder name. Second is message number.") +(defvar mh-note-deleted "D" + "String whose first character is used to notate deleted messages.") + +(defvar mh-note-refiled "^" + "String whose first character is used to notate refiled messages.") + +(defvar mh-note-cur "+" + "String whose first character is used to notate the current message.") (defvar mh-partial-folder-mode-line-annotation "select" "Annotation when displaying part of a folder. @@ -170,33 +168,24 @@ ;;; Internal variables: -(defvar mh-last-destination nil - "Destination of last refile or write command.") +(defvar mh-last-destination nil) ;Destination of last refile or write command. (defvar mh-folder-mode-map (make-keymap) "Keymap for MH folders.") -(defvar mh-next-seq-num nil - "Index of free sequence id.") +(defvar mh-delete-list nil) ;List of msg numbers to delete. -(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-refile-list nil - "List of folder names in mh-seq-list.") +(defvar mh-next-direction 'forward) ;Direction to move to next message. -(defvar mh-next-direction 'forward - "Direction to move to next message.") +(defvar mh-narrowed-to-seq nil) ;Sequence display is narrowed to or nil if not narrowed. -(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-first-msg-num nil - "Number of first msg in buffer.") +(defvar mh-last-msg-num nil) ;Number of last msg in buffer. -(defvar mh-last-msg-num nil - "Number of last msg in buffer.") - +(defvar mh-mode-line-annotation nil) ;Indiction this is not the full folder. ;;; Macros and generic functions: @@ -280,13 +269,15 @@ (mh-set-scan-mode) (mh-goto-cur-msg) ; after mh-set-scan-mode for efficiency (mh-make-folder-mode-line) - t) ; return t for local-write-file-hooks + t) ; return t for [local-]write-file-hooks (defun mh-first-msg () "Move to the first message." (interactive) - (goto-char (point-min))) + (goto-char (point-min)) + (while (and (not (eobp)) (not (looking-at mh-valid-scan-line))) + (forward-line 1))) (defun mh-header-display () @@ -309,10 +300,11 @@ (defun mh-inc-folder (&optional maildrop-name) - "Inc(orporate)s new mail into +inbox. + "Inc(orporate)s new mail into the Inbox folder. Optional prefix argument specifies an alternate maildrop from the default. -If this is given, incorporates mail into the current folder, rather -than +inbox. Runs `mh-inc-folder-hook' after incorporating new mail. +If the prefix argument is given, incorporates mail into the current +folder, otherwise uses the folder named by `mh-inbox'. +Runs `mh-inc-folder-hook' after incorporating new mail. Do not call this function from outside mh-e; use \\[mh-rmail] instead." (interactive (list (if current-prefix-arg (expand-file-name @@ -320,11 +312,11 @@ mh-user-path))))) (let ((config (current-window-configuration))) (if (not maildrop-name) - (cond ((not (get-buffer "+inbox")) - (mh-make-folder "+inbox") + (cond ((not (get-buffer mh-inbox)) + (mh-make-folder mh-inbox) (setq mh-previous-window-config config)) - ((not (eq (current-buffer) (get-buffer "+inbox"))) - (switch-to-buffer "+inbox") + ((not (eq (current-buffer) (get-buffer mh-inbox))) + (switch-to-buffer mh-inbox) (setq mh-previous-window-config config))))) (mh-get-new-mail maildrop-name) (run-hooks 'mh-inc-folder-hook)) @@ -339,10 +331,10 @@ (defun mh-next-undeleted-msg (&optional arg) - "Move to next undeleted message in window." - (interactive "P") - (forward-line (prefix-numeric-value arg)) + "Move to the NTH next undeleted message in window." + (interactive "p") (setq mh-next-direction 'forward) + (forward-line 1) (cond ((re-search-forward mh-good-msg-regexp nil 0 arg) (beginning-of-line) (mh-maybe-show)) @@ -352,8 +344,8 @@ (delete-windows-on mh-show-buffer))))) -(defun mh-refile-msg (msg-or-seq dest) - "Refile MESSAGE(s) (default: displayed message) in FOLDER. +(defun mh-refile-msg (msg-or-seq folder) + "Refile MESSAGE(s) (default: displayed message) into FOLDER. If optional prefix argument provided, then prompt for message sequence." (interactive (list (if current-prefix-arg @@ -362,26 +354,26 @@ (intern (mh-prompt-for-folder "Destination" - (or (and mh-msg-folder-hook - (let ((file-name (mh-msg-filename (mh-get-msg-num t)))) + (or (and mh-default-folder-for-message-function + (let ((refile-file (mh-msg-filename (mh-get-msg-num t)))) (save-excursion - (set-buffer (get-buffer-create " *mh-temp*")) + (set-buffer (get-buffer-create mh-temp-buffer)) (erase-buffer) - (insert-file-contents file-name) - (let ((buffer-file-name file-name)) - (funcall mh-msg-folder-hook))))) + (insert-file-contents refile-file) + (let ((buffer-file-name refile-file)) + (funcall mh-default-folder-for-message-function))))) (and (eq 'refile (car mh-last-destination)) (symbol-name (cdr mh-last-destination))) "") t)))) - (setq mh-last-destination (cons 'refile dest)) + (setq mh-last-destination (cons 'refile folder)) (if (numberp msg-or-seq) - (mh-refile-a-msg msg-or-seq dest) - (mh-map-to-seq-msgs 'mh-refile-a-msg msg-or-seq dest)) + (mh-refile-a-msg msg-or-seq folder) + (mh-map-to-seq-msgs 'mh-refile-a-msg msg-or-seq folder)) (mh-next-msg)) -(defun mh-refile-or-write-again (msg) +(defun mh-refile-or-write-again (message) "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." @@ -389,21 +381,21 @@ (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)) + (mh-refile-a-msg message (cdr mh-last-destination)) (message "Destination folder: %s" (cdr mh-last-destination))) (t - (apply 'mh-write-msg-to-file msg (cdr mh-last-destination)) + (apply 'mh-write-msg-to-file message (cdr mh-last-destination)) (message "Destination: %s" (cdr mh-last-destination)))) (mh-next-msg)) (defun mh-quit () - "Quit mh-e. + "Quit the current mh-e folder. Start by running mh-before-quit-hook. Restore the previous window configuration, if one exists. Finish by running mh-quit-hook." (interactive) (run-hooks 'mh-before-quit-hook) - (mh-update-unseen) + (mh-update-sequences) (mh-invalidate-show-buffer) (bury-buffer (current-buffer)) (if (get-buffer mh-show-buffer) @@ -428,7 +420,7 @@ (defun mh-previous-undeleted-msg (&optional arg) - "Move to previous undeleted message in window." + "Move to the NTH previous undeleted message in window." (interactive "p") (setq mh-next-direction 'backward) (beginning-of-line) @@ -459,16 +451,20 @@ (let ((default-dir (if (eq 'write (car mh-last-destination)) (file-name-directory (car (cdr mh-last-destination))) default-directory))) - (read-file-name "Save message in file: " default-dir - (expand-file-name "mail.out" default-dir))) + (read-file-name (format "Save message%s in file: " + (if current-prefix-arg " body" "")) + default-dir + (if (eq 'write (car mh-last-destination)) + (car (cdr mh-last-destination)) + (expand-file-name "mail.out" default-dir)))) current-prefix-arg)) - (let ((file-name (mh-msg-filename msg)) + (let ((msg-file-to-output (mh-msg-filename msg)) (output-file (mh-expand-file-name file))) - (setq mh-last-destination (list 'write file no-headers)) + (setq mh-last-destination (list 'write file (if no-headers 'no-headers))) (save-excursion - (set-buffer (get-buffer-create " *mh-temp*")) + (set-buffer (get-buffer-create mh-temp-buffer)) (erase-buffer) - (insert-file-contents file-name) + (insert-file-contents msg-file-to-output) (goto-char (point-min)) (if no-headers (search-forward "\n\n")) (append-to-file (point) (point-max) output-file)))) @@ -483,7 +479,7 @@ (defun mh-undo (msg-or-seq) - "Undo the deletion or refile of the specified MESSAGE(s). + "Undo the pending 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 (if current-prefix-arg @@ -506,7 +502,7 @@ (goto-char original-position) (error "Nothing to undo")))) (t - (mh-mapc (function mh-undo-msg) (mh-seq-to-msgs msg-or-seq)))) + (mh-map-to-seq-msgs 'mh-undo-msg msg-or-seq))) ;; update the mh-refile-list so mh-outstanding-commands-p will work (mh-mapc (function (lambda (elt) @@ -517,11 +513,12 @@ (mh-set-folder-modified-p nil))) +;;;###autoload (defun mh-version () - "Display version information about mh-e and MH." + "Display version information about mh-e and the MH mail handling system." (interactive) (mh-find-progs) - (set-buffer (get-buffer-create " *mh-temp*")) + (set-buffer (get-buffer-create mh-temp-buffer)) (erase-buffer) (insert " mh-e info:\n\nversion: " mh-e-version "\n" mh-e-time-stamp "\nEmacs: " emacs-version " on " (symbol-name system-type) " ") @@ -538,14 +535,13 @@ (beginning-of-line) (delete-region help-start (point)) (goto-char (point-min))) - (display-buffer " *mh-temp*")) + (display-buffer mh-temp-buffer)) (defun mh-visit-folder (folder &optional range) - "Visits FOLDER and displays RANGE of messages. -Assumes mh-e has already been initialized. + "Visit FOLDER and display RANGE of messages. Do not call this function from outside mh-e; see \\[mh-rmail] instead." - (interactive (list (mh-prompt-for-folder "Visit" "+inbox" t) + (interactive (list (mh-prompt-for-folder "Visit" mh-inbox t) (mh-read-msg-range "Range [all]? "))) (let ((config (current-window-configuration))) (mh-scan-folder folder (or range "all")) @@ -554,13 +550,37 @@ (defun mh-compat-quit () - "\"b\" reserved for future use as mh-burst-digest; will assume you want \"\\[mh-quit]\" ..." - ;; This is a temporary compatibility function + "The \"b\" key is obsolescent; will assume you want \"\\[mh-quit]\" ..." + ;; Was going to make it run mh-burst-digest, but got complaint that + ;; 'b' should mean 'back', as it does in info, less, and rn. + ;; This is a temporary compatibility function. (interactive) (message "%s" (documentation this-command)) (sit-for 1) (call-interactively 'mh-quit)) + +(defun mh-update-sequences () + "Update MH's Unseen sequence and current folder and message. +Flush mh-e's state out to MH. The message at the cursor becomes current." + (interactive) + ;; mh-update-sequences is the opposite of mh-read-folder-sequences, + ;; which updates mh-e's state from MH. + (let ((folder-set (mh-update-unseen)) + (new-cur (mh-get-msg-num nil))) + (if new-cur + (let ((seq-entry (mh-find-seq 'cur))) + (mh-remove-cur-notation) + (setcdr seq-entry (list new-cur)) ;delete-seq-locally, add-msgs-to-seq + (mh-define-sequence 'cur (list new-cur)) + (beginning-of-line) + (if (looking-at mh-good-msg-regexp) + (mh-notate nil mh-note-cur mh-cmd-note))) + (or folder-set + (save-excursion + (mh-exec-cmd-quiet t "folder" mh-current-folder "-fast")))))) + + ;;; Support routines. @@ -576,7 +596,7 @@ (mh-set-folder-modified-p t) (setq mh-delete-list (cons msg mh-delete-list)) (mh-add-msgs-to-seq msg 'deleted t) - (mh-notate msg ?D mh-cmd-note) + (mh-notate msg mh-note-deleted mh-cmd-note) (run-hooks 'mh-delete-msg-hook)))) (defun mh-refile-a-msg (msg destination) @@ -599,7 +619,7 @@ (setq mh-refile-list (cons 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) + (mh-notate msg mh-note-refiled mh-cmd-note) (run-hooks 'mh-refile-msg-hook))))) @@ -645,7 +665,8 @@ (setq buffer-read-only t) (mh-folder-mode) (mh-set-folder-modified-p nil) - (setq buffer-file-name mh-folder-filename)) + (setq buffer-file-name mh-folder-filename) + (mh-make-folder-mode-line)) ;;; Ensure new buffers won't get this mode if default-major-mode is nil. @@ -666,14 +687,14 @@ standard keys so the other keys can perhaps someday be put to new uses. t toggle show or scan-only mode -. show message, or back to top if already showing +RET show message, or back to top if already showing -SPC page forward -DEL page back +SPC page message forward +DEL page message back n next message p previous message -j jump to message by number +g go to message by number d mark for deletion o, ^ mark for output (refile) to another folder @@ -743,23 +764,18 @@ 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-Folder") - (make-local-vars + (mh-make-local-vars 'mh-current-folder (buffer-name) ; Name of folder, a string '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 @@ -768,12 +784,15 @@ '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-mode-line-annotation nil ; Indiction this is not the full folder 'mh-previous-window-config nil) ; Previous window configuration (setq truncate-lines t) (auto-save-mode -1) (setq buffer-offer-save t) - (make-local-variable 'local-write-file-hooks) - (setq local-write-file-hooks '(mh-execute-commands)) + (if (boundp 'local-write-file-hooks) + (setq local-write-file-hooks '(mh-execute-commands)) ;Emacs 19 + (make-local-variable 'write-file-hooks) + (setq write-file-hooks '(mh-execute-commands))) ;Emacs 18 (make-local-variable 'revert-buffer-function) (setq revert-buffer-function 'mh-undo-folder) (or (assq 'mh-showing minor-mode-alist) @@ -782,8 +801,8 @@ (run-hooks 'mh-folder-mode-hook)) -(defun make-local-vars (&rest pairs) - ;; Take VARIABLE-VALUE pairs and makes local variables initialized to the +(defun mh-make-local-vars (&rest pairs) + ;; Take VARIABLE-VALUE pairs and make local variables initialized to the ;; value. (while pairs (make-variable-buffer-local (car pairs)) @@ -807,28 +826,35 @@ (mh-goto-cur-msg)) -(defun mh-regenerate-headers (range) - ;; Replace buffer with scan of its contents over range RANGE. - (let ((folder mh-current-folder)) +(defun mh-regenerate-headers (range &optional update) + ;; scan folder over range RANGE. + ;; If UPDATE, append the scan lines, otherwise replace. + (let ((folder mh-current-folder) + scan-start) (message "Scanning %s..." folder) (with-mh-folder-updating (nil) - (erase-buffer) + (if update + (goto-char (point-max)) + (erase-buffer)) + (setq scan-start (point)) (mh-exec-cmd-output mh-scan-prog nil "-noclear" "-noheader" "-width" (window-width) folder range) - (goto-char (point-min)) + (goto-char scan-start) (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))) + (or update + (setq mh-mode-line-annotation + (if (equal range "all") + nil + mh-partial-folder-mode-line-annotation))) + (mh-make-folder-mode-line)) (message "Scanning %s...done" folder))) @@ -846,33 +872,29 @@ (goto-char (point-max)) (let ((start-of-inc (point))) (if maildrop-name + ;; I think MH 5 used "-ms-file" instead of "-file", + ;; which would make inc'ing from maildrops fail. (mh-exec-cmd-output mh-inc-prog nil folder "-file" (expand-file-name maildrop-name) "-width" (window-width) "-truncate") - (mh-exec-cmd-output mh-inc-prog nil - "-width" (window-width))) + (mh-exec-cmd-output mh-inc-prog 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") + (cond ((save-excursion + (re-search-forward "^inc: no mail" nil t)) (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 - ;; remove old cur notation (cf mh-goto-cur-msg code) - (let ((cur-msg (car (mh-seq-to-msgs 'cur)))) - (save-excursion - (and cur-msg - (mh-goto-msg cur-msg t nil) - (looking-at mh-cur-scan-msg-regexp) - (mh-notate nil ? mh-cmd-note)))) + (mh-remove-cur-notation) (setq new-mail-p 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 t)) (mh-notate-user-sequences) (if new-mail-p @@ -882,9 +904,11 @@ (goto-char point-before-inc)))))) -(defun mh-make-folder-mode-line (&optional annotation) +(defun mh-make-folder-mode-line (&optional ignored) ;; Set the fields of the mode line for a folder buffer. - ;; The optional ANNOTATION string is displayed after the folder's name. + ;; The optional argument is now obsolete. It used to be used to pass + ;; in what is now stored in the buffer-local variable + ;; mh-mode-line-annotation. (save-excursion (mh-first-msg) (setq mh-first-msg-num (mh-get-msg-num nil)) @@ -893,7 +917,9 @@ (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) "") + (if mh-mode-line-annotation + (format "/%s" mh-mode-line-annotation) + "") lines (if (zerop lines) "s" @@ -909,29 +935,44 @@ ;; Optimized for speed (i.e., no regular expressions). (save-excursion (let ((case-fold-search nil) - (last-line (- (point-max) mh-cmd-note)) + (last-line (1- (point-max))) 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 ?+)) + (or (eql char (aref mh-note-deleted 0)) + (eql char (aref mh-note-refiled 0)))) + (eql char (aref mh-note-cur 0))) (progn (delete-char 1) (insert " "))) + (if remove-all-flags + (progn + (forward-char 1) + (if (eql (following-char) (aref mh-note-seq 0)) + (progn + (delete-char 1) + (insert " "))))) (forward-line))))) +(defun mh-remove-cur-notation () + ;; Remove old cur notation (cf mh-goto-cur-msg code). + (let ((cur-msg (car (mh-seq-to-msgs 'cur)))) + (save-excursion + (and cur-msg + (mh-goto-msg cur-msg t t) + (looking-at mh-cur-scan-msg-regexp) + (mh-notate nil ? mh-cmd-note))))) + (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-goto-msg cur-msg t t)) + (mh-notate nil mh-note-cur mh-cmd-note) (mh-recenter 0) (mh-maybe-show cur-msg)) (t @@ -968,14 +1009,16 @@ (let ((msgs (mh-seq-to-msgs dest))) (cond (msgs (apply 'mh-exec-cmd "refile" - "-src" folder (symbol-name dest) msgs) + "-src" folder (symbol-name dest) + (mh-coalesce-msg-list msgs)) (mh-delete-scan-msgs msgs)))))) mh-refile-list) (setq mh-refile-list nil) ;; Now delete messages (cond (mh-delete-list - (apply 'mh-exec-cmd "rmm" folder mh-delete-list) + (apply 'mh-exec-cmd "rmm" folder + (mh-coalesce-msg-list mh-delete-list)) (mh-delete-scan-msgs mh-delete-list) (setq mh-delete-list nil))) @@ -983,7 +1026,7 @@ ;; Mark cur message (if (> (buffer-size) 0) - (mh-define-sequence 'cur (or (mh-get-msg-num nil) "last"))) + (mh-define-sequence 'cur (list (or (mh-get-msg-num nil) "last")))) (and (buffer-file-name (get-buffer mh-show-buffer)) (not (file-exists-p (buffer-file-name (get-buffer mh-show-buffer)))) @@ -998,18 +1041,26 @@ (defun mh-update-unseen () - ;; Push updates to the Unseen sequence out to MH. + ;; Flush updates to the Unseen sequence out to MH. + ;; Return non-NIL iff set the MH folder. (if mh-seen-list - (progn - (if (mh-seq-to-msgs mh-unseen-seq) - (mh-undefine-sequence mh-unseen-seq mh-seen-list)) - (setq mh-seen-list nil)))) + (let* ((unseen-seq (mh-find-seq mh-unseen-seq)) + (unseen-msgs (mh-seq-msgs unseen-seq))) + (if unseen-msgs + (progn + (mh-undefine-sequence mh-unseen-seq mh-seen-list) + (while mh-seen-list + (setq unseen-msgs (delq (car mh-seen-list) unseen-msgs)) + (setq mh-seen-list (cdr mh-seen-list))) + (setcdr unseen-seq unseen-msgs) + t) ;since we set the folder + (setq mh-seen-list nil))))) (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 + (setq msgs (sort msgs '<)) ;okay to clobber msgs (save-excursion (mh-first-msg) (while (and msgs (< (point) (point-max))) @@ -1024,6 +1075,42 @@ ;; Returns non-nil if there are outstanding deletes or refiles. (or mh-delete-list mh-refile-list)) + +(defun mh-coalesce-msg-list (messages) + ;; Give a list of MESSAGES, return a list of message number ranges. + ;; Sort of the opposite of mh-read-msg-list, which expands ranges. + ;; Message lists passed to MH programs go through this so + ;; command line arguments won't exceed system limits. + (let ((msgs (sort (copy-sequence messages) 'mh-greaterp)) + (range-high nil) + (prev -1) + (ranges nil)) + (while prev + (if range-high + (if (or (not (numberp prev)) + (not (eql (car msgs) (1- prev)))) + (progn ;non-sequential, flush old range + (if (eql prev range-high) + (setq ranges (cons range-high ranges)) + (setq ranges (cons (format "%s-%s" prev range-high) ranges))) + (setq range-high nil)))) + (or range-high + (setq range-high (car msgs))) ;start new or first range + (setq prev (car msgs)) + (setq msgs (cdr msgs))) + ranges)) + +(defun mh-greaterp (msg1 msg2) + ;; Sort two message indicators. Strings are "smaller" than numbers. + ;; Legal values are things like "cur", "last", 1, and 1820. + (if (numberp msg1) + (if (numberp msg2) + (> msg1 msg2) + t) + (if (numberp msg2) + nil + (string-lessp msg2 msg1)))) + ;;; Basic sequence handling @@ -1058,7 +1145,7 @@ (defun mh-read-msg-list () ;; Return a list of message numbers from the current point to the end of - ;; the line. + ;; the line. Expands ranges into set of individual numbers. (let ((msgs ()) (end-of-line (save-excursion (end-of-line) (point))) num) @@ -1075,7 +1162,8 @@ (while (<= num num2) (setq msgs (cons num msgs)) (setq num (1+ num))))) - ((not (zerop num)) (setq msgs (cons num msgs))))) + ((not (zerop num)) ;"pick" outputs "0" to mean no match + (setq msgs (cons num msgs))))) msgs)) (defun mh-notate-user-sequences () @@ -1085,7 +1173,7 @@ (while seqs (setq name (mh-seq-name (car seqs))) (if (not (mh-internal-seq name)) - (mh-notate-seq name ?% (1+ mh-cmd-note))) + (mh-notate-seq name mh-note-seq (1+ mh-cmd-note))) (setq seqs (cdr seqs))))) @@ -1097,26 +1185,26 @@ (mh-folder-name-p name))) -(defun mh-delete-msg-from-seq (msg seq &optional internal-flag) +(defun mh-delete-msg-from-seq (message sequence &optional internal-flag) "Delete MESSAGE from SEQUENCE. MESSAGE defaults to displayed message. - From Lisp, optional third arg INTERNAL non-nil means do not - inform MH of the change." +From Lisp, optional third arg INTERNAL-FLAG non-nil means do not +inform MH of the change." (interactive (list (mh-get-msg-num t) (mh-read-seq-default "Delete from" t) nil)) - (let ((entry (mh-find-seq seq))) + (let ((entry (mh-find-seq sequence))) (cond (entry - (mh-notate-if-in-one-seq msg ? (1+ mh-cmd-note) (mh-seq-name entry)) + (mh-notate-if-in-one-seq message ? (1+ mh-cmd-note) sequence) (if (not internal-flag) - (mh-undefine-sequence seq msg)) - (setcdr entry (delq msg (mh-seq-msgs entry))))))) + (mh-undefine-sequence sequence (list message))) + (setcdr entry (delq message (mh-seq-msgs entry))))))) (defun mh-undefine-sequence (seq msgs) - ;; Remove from the SEQUENCE the MSGS, which may be a list or single msg. + ;; Remove from the SEQUENCE the list of MSGS. (mh-exec-cmd "mark" mh-current-folder "-delete" "-sequence" (symbol-name seq) - msgs)) + (mh-coalesce-msg-list msgs))) (defun mh-define-sequence (seq msgs) @@ -1128,12 +1216,7 @@ (save-excursion (mh-exec-cmd-error nil "mark" mh-current-folder "-add" "-zero" "-sequence" (symbol-name seq) - msgs)))) - - -(defun mh-define-sequences (seq-list) - ;; Define the sequences in SEQ-LIST. - (mh-map-over-seqs 'mh-define-sequence seq-list)) + (mh-coalesce-msg-list msgs))))) (defun mh-map-over-seqs (func seq-list) @@ -1148,18 +1231,21 @@ ;; If the MESSAGE is in only the SEQUENCE, then mark the scan listing of the ;; message with the CHARACTER at the given OFFSET from the beginning of the ;; listing line. - (let ((in-seqs (mh-seq-containing-msg msg))) + (let ((in-seqs (mh-seq-containing-msg msg nil))) (if (and (eq seq (car in-seqs)) (null (cdr in-seqs))) (mh-notate msg notation offset)))) -(defun mh-seq-containing-msg (msg) +(defun mh-seq-containing-msg (msg &optional include-internal-p) ;; Return a list of the sequences containing MESSAGE. + ;; If INCLUDE-INTERNAL-P non-nil, include mh-e internal sequences in list. (let ((l mh-seq-list) (seqs ())) (while l - (if (memq msg (mh-seq-msgs (car l))) - (setq seqs (cons (mh-seq-name (car l)) seqs))) + (and (memq msg (mh-seq-msgs (car l))) + (or include-internal-p + (not (mh-internal-seq (mh-seq-name (car l))))) + (setq seqs (cons (mh-seq-name (car l)) seqs))) (setq l (cdr l))) seqs)) @@ -1223,9 +1309,11 @@ (define-key mh-folder-mode-map "a" 'mh-reply) (define-key mh-folder-mode-map "j" 'mh-goto-msg) (define-key mh-folder-mode-map "g" 'mh-goto-msg) +(define-key mh-folder-mode-map "\e<" 'mh-first-msg) (define-key mh-folder-mode-map "\e>" 'mh-last-msg) (define-key mh-folder-mode-map "\177" 'mh-previous-page) (define-key mh-folder-mode-map " " 'mh-page-msg) +(define-key mh-folder-mode-map "\r" 'mh-show) (define-key mh-folder-mode-map "." 'mh-show) (define-key mh-folder-mode-map "," 'mh-header-display) (define-key mh-folder-mode-map "u" 'mh-undo) @@ -1246,68 +1334,140 @@ ;;; mh-comp (autoload 'mh-smail "mh-comp" - "Compose and send mail with the MH mail system." t) + "Compose and send mail with the MH mail system. +This function is an entry point to mh-e, the Emacs front end +to the MH mail system. +See documentation of `\\[mh-send]' for more details on composing mail." t) + (autoload 'mh-smail-other-window "mh-comp" - "Compose and send mail in other window with the MH mail system." t) + "Compose and send mail in other window with the MH mail system. +This function is an entry point to mh-e, the Emacs front end +to the MH mail system. +See documentation of `\\[mh-send]' for more details on composing mail." t) + (autoload 'mh-edit-again "mh-comp" - "Clean-up a draft or a message previously sent and make it resendable." t) + "Clean-up a draft or a message previously sent and make it resendable. +Default is the current message. +The variable mh-new-draft-cleaned-headers specifies the headers to remove. +See also documentation for `\\[mh-send]' function." t) + (autoload 'mh-extract-rejected-mail "mh-comp" - "Extract a letter returned by the mail system and make it resendable." t) + "Extract a letter returned by the mail system and make it resendable. +Default is the current message. The variable mh-new-draft-cleaned-headers +gives the headers to clean out of the original message. +See also documentation for `\\[mh-send]' function." t) + (autoload 'mh-forward "mh-comp" - "Forward MESSAGE(s) (default: displayed message)." t) + "Forward a message or message sequence. Defaults to displayed message. +If optional prefix argument provided, then prompt for the message sequence. +See also documentation for `\\[mh-send]' function." t) + (autoload 'mh-redistribute "mh-comp" - "Redistribute a letter." t) + "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." t) + (autoload 'mh-reply "mh-comp" - "Reply to a MESSAGE (default: displayed message)." t) + "Reply to a MESSAGE (default: displayed message). +If optional prefix argument INCLUDEP provided, then include the message +in the reply using filter mhl.reply in your MH directory. +Prompts for type of addresses to reply to: + from sender only, + to sender and primary recipients, + cc/all sender and all recipients. +If the file named by `mh-repl-formfile' exists, it is used as a skeleton +for the reply. See also documentation for `\\[mh-send]' function." t) + (autoload 'mh-send "mh-comp" - "Compose and send a letter." t) + "Compose and send a letter. +The file named by `mh-comp-formfile' will be used as the form. +Do not call this function from outside mh-e; use \\[mh-smail] instead. +The letter is composed in mh-letter-mode; see its documentation for more +details. If `mh-compose-letter-function' is defined, it is called on the +draft and passed three arguments: to, subject, and cc." t) + (autoload 'mh-send-other-window "mh-comp" - "Compose and send a letter in another window." t) + "Compose and send a letter in another window. +Do not call this function from outside mh-e; +use \\[mh-smail-other-window] instead. +See also documentation for `\\[mh-send]' function." t) + (autoload 'mh-letter-mode "mh-comp" - "Mode for composing letters in mh-e." t) + "Mode for composing letters in mh-e. +For more details, type \\[describe-mode] while in MH-Letter mode." t) ;;; mh-funcs (autoload 'mh-burst-digest "mh-funcs" - "Burst apart the current message, which should be a digest." t) + "Burst apart the current message, which should be a digest. +The message is replaced by its table of contents and the messages from the +digest are inserted into the folder after that message." t) + (autoload 'mh-copy-msg "mh-funcs" - "Copy specified MESSAGE(s) to another FOLDER without deleting them." t) + "Copy to another FOLDER the specified MESSAGE(s) without deleting them. +Default is the displayed message. If optional prefix argument is +provided, then prompt for the message sequence." t) + (autoload 'mh-kill-folder "mh-funcs" "Remove the current folder." t) + (autoload 'mh-list-folders "mh-funcs" "List mail folders." t) + (autoload 'mh-pack-folder "mh-funcs" - "Renumber the messages of a folder to be 1..n." t) + "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." t) + (autoload 'mh-pipe-msg "mh-funcs" - "Pipe the current message through the given shell COMMAND." t) + "Pipe the current message through the given shell COMMAND. +If INCLUDE-HEADERS (prefix argument) is provided, send the entire message. +Otherwise just send the message's body without the headers." t) + (autoload 'mh-page-digest "mh-funcs" "Advance displayed message to next digested message." t) + (autoload 'mh-page-digest-backwards "mh-funcs" "Back up displayed message to previous digested message." t) + (autoload 'mh-print-msg "mh-funcs" - "Print MESSAGE(s) (default: displayed message) on a line printer." t) + "Print MESSAGE(s) (default: displayed message) on printer. +If optional prefix argument provided, then prompt for the message sequence. +The variable mh-lpr-command-format is used to generate the print command. +The messages are formatted by mhl. See the variable mhl-formfile." t) + (autoload 'mh-sort-folder "mh-funcs" - "Sort the messages in the current folder by date." t) + "Sort the messages in the current folder by date. +Calls the MH program sortm to do the work. +The arguments in the list mh-sortm-args are passed to sortm +if this function is passed an argument." t) + (autoload 'mh-undo-folder "mh-funcs" "Undo all commands in current folder." t) + (autoload 'mh-store-msg "mh-funcs" "Store the file(s) contained in the current message into DIRECTORY. -The message can contain a shar file or uuencoded file." t) +The message can contain a shar file or uuencoded file. +Default directory is the last directory used, or initially the value of +mh-store-default-directory or the current directory." t) + (autoload 'mh-store-buffer "mh-funcs" "Store the file(s) contained in the current buffer into DIRECTORY. -The buffer can contain a shar file or uuencoded file." t) +The buffer can contain a shar file or uuencoded file. +Default directory is the last directory used, or initially the value of +`mh-store-default-directory' or the current directory." t) ;;; mh-pick (autoload 'mh-search-folder "mh-pick" - "Search FOLDER for messages matching a pattern." t) + "Search FOLDER for messages matching a pattern. +Add the messages found to the sequence named `search'." t) ;;; mh-seq -(autoload 'mh-put-msg-in-seq "mh-seq" - "Add MESSAGE(s) (default: displayed message) to SEQUENCE." t) (autoload 'mh-delete-seq "mh-seq" "Delete the SEQUENCE." t) (autoload 'mh-list-sequences "mh-seq" @@ -1315,10 +1475,14 @@ (autoload 'mh-msg-is-in-seq "mh-seq" "Display the sequences that contain MESSAGE (default: displayed message)." t) (autoload 'mh-narrow-to-seq "mh-seq" - "Restrict display of this folder to just messages in a sequence." t) + "Restrict display of this folder to just messages in SEQUENCE +Use \\[mh-widen] to undo this command." t) +(autoload 'mh-put-msg-in-seq "mh-seq" + "Add MESSAGE(s) (default: displayed message) to SEQUENCE. +If optional prefix argument provided, then prompt for the message sequence." t) (autoload 'mh-widen "mh-seq" "Remove restrictions from current folder, thereby showing all messages." t) (autoload 'mh-rename-seq "mh-seq" - "Rename a SEQUENCE to have a new NAME." t) + "Rename SEQUENCE to have NEW-NAME." t) ;;; mh-e.el ends here
--- a/lisp/mail/mh-funcs.el Sun Apr 09 22:29:08 1995 +0000 +++ b/lisp/mail/mh-funcs.el Sun Apr 09 22:31:08 1995 +0000 @@ -1,7 +1,7 @@ ;;; mh-funcs --- mh-e functions not everyone will use right away -;; Time-stamp: <94/03/08 16:00:54 gildea> +;; Time-stamp: <95/01/25 16:35:24 gildea> -;; Copyright 1993 Free Software Foundation, Inc. +;; Copyright (C) 1993, 1995 Free Software Foundation, Inc. ;; This file is part of mh-e. @@ -25,18 +25,35 @@ ;;; Putting these functions in a separate file lets mh-e start up faster, ;;; since less Lisp code needs to be loaded all at once. +;;; Change Log: + +;; $Id: mh-funcs.el,v 1.9 95/03/02 04:53:58 gildea Exp $ + ;;; Code: (provide 'mh-funcs) (require 'mh-e) +;;; customization + (defvar mh-sortm-args nil "Extra arguments to have \\[mh-sort-folder] pass to the \"sortm\" command. +The arguments are passed to sortm if \\[mh-sort-folder] is given a +prefix argument. Normally default arguments to sortm are specified in the +MH profile. For example, '(\"-nolimit\" \"-textfield\" \"subject\") is a useful setting.") +(defvar mh-note-copied "C" + "String whose first character is used to notate copied messages.") + +(defvar mh-note-printed "P" + "String whose first character is used to notate printed messages.") + +;;; functions + (defun mh-burst-digest () "Burst apart the current message, which should be a digest. -The message is replaced by its table of contents and the letters from the +The message is replaced by its table of contents and the messages from the digest are inserted into the folder after that message." (interactive) (let ((digest (mh-get-msg-num t))) @@ -44,22 +61,26 @@ (mh-set-folder-modified-p t) ; lock folder while bursting (message "Bursting digest...") (mh-exec-cmd "burst" mh-current-folder digest "-inplace") - (mh-scan-folder mh-current-folder (format "%d-last" mh-first-msg-num)) + (with-mh-folder-updating (t) + (beginning-of-line) + (delete-region (point) (point-max))) + (mh-regenerate-headers (format "%d-last" digest) t) + (mh-goto-cur-msg) (message "Bursting digest...done"))) -(defun mh-copy-msg (dest msg-or-seq) - "Copy to another FOLDER the specified MESSAGE(s) without deleting them. +(defun mh-copy-msg (msg-or-seq folder) + "Copy the specified MESSAGE(s) to another FOLDER without deleting them. Default is the displayed message. If optional prefix argument is provided, then prompt for the message sequence." - (interactive (list (mh-prompt-for-folder "Copy to" "" t) - (if current-prefix-arg + (interactive (list (if current-prefix-arg (mh-read-seq-default "Copy" t) - (mh-get-msg-num t)))) - (mh-exec-cmd "refile" msg-or-seq "-link" "-src" mh-current-folder dest) + (mh-get-msg-num t)) + (mh-prompt-for-folder "Copy to" "" t))) + (mh-exec-cmd "refile" msg-or-seq "-link" "-src" mh-current-folder folder) (if (numberp msg-or-seq) - (mh-notate msg-or-seq ?C mh-cmd-note) - (mh-notate-seq msg-or-seq ?C mh-cmd-note))) + (mh-notate msg-or-seq mh-note-copied mh-cmd-note) + (mh-notate-seq msg-or-seq mh-note-copied mh-cmd-note))) (defun mh-kill-folder () "Remove the current folder." @@ -73,6 +94,7 @@ (mh-exec-cmd-daemon "rmf" folder) (setq mh-folder-list (delq (assoc folder mh-folder-list) mh-folder-list)) + (run-hooks 'mh-folder-list-change-hook) (message "Folder %s removed" folder) (mh-set-folder-modified-p nil) ; so kill-buffer doesn't complain (if (get-buffer mh-show-buffer) @@ -84,9 +106,9 @@ (defun mh-list-folders () "List mail folders." (interactive) - (with-output-to-temp-buffer " *mh-temp*" + (with-output-to-temp-buffer mh-temp-buffer (save-excursion - (switch-to-buffer " *mh-temp*") + (switch-to-buffer mh-temp-buffer) (erase-buffer) (message "Listing folders...") (mh-exec-cmd-output "folders" t (if mh-recursive-folders @@ -99,7 +121,7 @@ (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 +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 @@ -116,7 +138,8 @@ (message "Packing folder...") (mh-set-folder-modified-p t) ; lock folder while packing (save-excursion - (mh-exec-cmd-quiet t "folder" mh-current-folder "-pack")) + (mh-exec-cmd-quiet t "folder" mh-current-folder "-pack" + "-norecurse" "-fast")) (mh-regenerate-headers range)) @@ -126,14 +149,16 @@ Otherwise just send the message's body without the headers." (interactive (list (read-string "Shell command on message: ") current-prefix-arg)) - (let ((file-name (mh-msg-filename (mh-get-msg-num t)))) + (let ((msg-file-to-pipe (mh-msg-filename (mh-get-msg-num t))) + (message-directory default-directory)) (save-excursion - (set-buffer (get-buffer-create " *mh-temp*")) + (set-buffer (get-buffer-create mh-temp-buffer)) (erase-buffer) - (insert-file-contents file-name) + (insert-file-contents msg-file-to-pipe) (goto-char (point-min)) (if (not include-headers) (search-forward "\n\n")) - (shell-command-on-region (point) (point-max) command nil)))) + (let ((default-directory message-directory)) + (shell-command-on-region (point) (point-max) command nil))))) (defun mh-page-digest () @@ -145,7 +170,7 @@ (let ((case-fold-search nil)) ;; Search for blank line and then for From: (or (and (search-forward "\n\n" nil t) - (search-forward "From:" nil t)) + (re-search-forward "^From:" nil t)) (error "No more messages in digest"))) ;; Go back to previous blank line, then forward to the first non-blank. (search-backward "\n\n" nil t) @@ -162,7 +187,7 @@ (let ((case-fold-search nil)) (beginning-of-line) (or (and (search-backward "\n\n" nil t) - (search-backward "From:" nil t)) + (re-search-backward "^From:" nil t)) (error "No previous message in digest"))) ;; Go back to previous blank line, then forward to the first non-blank. (if (search-backward "\n\n" nil t) @@ -212,8 +237,8 @@ (mh-exec-cmd-daemon shell-file-name "-c" print-command) (call-process shell-file-name nil nil nil "-c" print-command)) (if (numberp msg-or-seq) - (mh-notate msg-or-seq ?P mh-cmd-note) - (mh-notate-seq msg-or-seq ?P mh-cmd-note)) + (mh-notate msg-or-seq mh-note-printed mh-cmd-note) + (mh-notate-seq msg-or-seq mh-note-printed mh-cmd-note)) (mh-add-msgs-to-seq msg-or-seq 'printed t) (if (numberp msg-or-seq) (message "Printing message...done") @@ -225,23 +250,23 @@ (mapconcat (function (lambda (msg) (mh-msg-filename msg folder))) msgs " ")) -(defun mh-sort-folder (&optional no-args) +(defun mh-sort-folder (&optional extra-args) "Sort the messages in the current folder by date. Calls the MH program sortm to do the work. The arguments in the list mh-sortm-args are passed to sortm -unless this function is passed an argument." +if this function is passed an argument." (interactive "P") (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 (if (not no-args) mh-sortm-args)) + (mh-exec-cmd "sortm" mh-current-folder (if extra-args mh-sortm-args)) (message "Sorting folder...done") (mh-scan-folder mh-current-folder "all")) (defun mh-undo-folder (&rest ignore) - "Undo all commands in current folder." + "Undo all pending deletes and refiles in current folder." (interactive) (cond ((or mh-do-not-confirm (yes-or-no-p "Undo all commands in folder? ")) @@ -256,7 +281,7 @@ (sit-for 2)))) -(defun mh-store-msg (dir) +(defun mh-store-msg (directory) "Store the file(s) contained in the current message into DIRECTORY. The message can contain a shar file or uuencoded file. Default directory is the last directory used, or initially the value of @@ -264,48 +289,65 @@ (interactive (list (let ((udir (or mh-store-default-directory default-directory))) (read-file-name "Store message in directory: " udir udir nil)))) - (let ((file-name (mh-msg-filename (mh-get-msg-num t)))) + (let ((msg-file-to-store (mh-msg-filename (mh-get-msg-num t)))) (save-excursion - (set-buffer (get-buffer-create " *mh-temp*")) + (set-buffer (get-buffer-create mh-temp-buffer)) (erase-buffer) - (insert-file-contents file-name) - (mh-store-buffer dir)))) + (insert-file-contents msg-file-to-store) + (mh-store-buffer directory)))) -(defun mh-store-buffer (dir) +(defun mh-store-buffer (directory) "Store the file(s) contained in the current buffer into DIRECTORY. The buffer can contain a shar file or uuencoded file. Default directory is the last directory used, or initially the value of `mh-store-default-directory' or the current directory." (interactive (list (let ((udir (or mh-store-default-directory default-directory))) - (read-file-name "Store buffer in directory: " - udir udir nil)))) - (let ((store-directory (expand-file-name dir)) - (start (save-excursion - (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) + (read-file-name "Store buffer in directory: " + udir udir nil)))) + (let ((store-directory (expand-file-name directory)) + (sh-start (save-excursion + (goto-char (point-min)) + (if (re-search-forward + "^#![ \t]*/bin/sh\\|^#\\|^: " nil t) + (progn + ;; The "cut here" pattern was removed from above + ;; because it seemed to hurt more than help. + ;; But keep this to make it easier to put it back. + (if (looking-at "^[^a-z0-9\"]*cut here\\b") (forward-line 1)) - (re-search-forward "^#" nil t) - (re-search-forward "^: " nil t)) - (progn (beginning-of-line) (point))))) + (beginning-of-line) + (if (looking-at "^[#:]....+\n\\( ?\n\\)?end$") + nil ;most likely end of a uuencode + (point)))))) (log-buffer (get-buffer-create "*Store Output*")) - (command "sh")) + (command "sh") + (uudecode-filename "(unknown filename)")) + (if (not sh-start) + (save-excursion + (goto-char (point-min)) + (if (re-search-forward "^begin [0-7]+ " nil t) + (setq uudecode-filename + (buffer-substring (point) + (progn (end-of-line) (point))))))) (save-excursion (set-buffer log-buffer) (erase-buffer) (if (not (file-directory-p store-directory)) (progn - (insert "mkdir " dir "\n") + (insert "mkdir " directory "\n") (call-process "mkdir" nil log-buffer t store-directory))) - (insert "cd " dir "\n") - (if (not start) + (insert "cd " directory "\n") + (setq mh-store-default-directory directory) + (if (not sh-start) (progn (setq command "uudecode") - (insert "uudecoding...\n")))) + (insert uudecode-filename " being uudecoded...\n")))) (set-window-start (display-buffer log-buffer) 0) ;watch progress - (let ((default-directory (file-name-as-directory store-directory))) - (call-process-region start (point-max) command nil log-buffer t)) - (setq mh-store-default-directory dir) - (set-buffer log-buffer) + (let (value) + (let ((default-directory (file-name-as-directory store-directory))) + (setq value (call-process-region sh-start (point-max) command + nil log-buffer t))) + (set-buffer log-buffer) + (mh-handle-process-error command value)) (insert "\n(mh-store finished)\n")))
--- a/lisp/mail/mh-mime.el Sun Apr 09 22:29:08 1995 +0000 +++ b/lisp/mail/mh-mime.el Sun Apr 09 22:31:08 1995 +0000 @@ -1,7 +1,7 @@ ;;; mh-mime --- mh-e support for composing MIME messages -;; Time-stamp: <94/03/08 08:41:27 gildea> +;; Time-stamp: <94/11/18 17:48:19 gildea> -;; Copyright 1993 Free Software Foundation, Inc. +;; Copyright (C) 1993, 1995 Free Software Foundation, Inc. ;; This file is part of mh-e. @@ -25,6 +25,10 @@ ;;; Support for generating an mhn composition file. ;;; MIME is supported only by MH 6.8 or later. +;;; Change Log: + +;; $Id: mh-mime.el,v 1.5 94/12/27 22:38:10 gildea Exp $ + ;;; Code: (provide 'mh-mime) @@ -40,6 +44,15 @@ ;; MIME option to mh-forward ;; command to move to content-description insertion point +(defvar mh-mhn-args nil + "Extra arguments to have \\[mh-edit-mhn] pass to the \"mhn\" command. +The arguments are passed to mhn if \\[mh-edit-mhn] is given a +prefix argument. Normally default arguments to mhn are specified in the +MH profile.") + +(defvar mh-edit-mhn-hook nil + "Invoked on the formatted letter by \\<mh-letter-mode-map>\\[mh-edit-mhn].") + (defvar mh-mime-content-types '(("text/plain") ("text/richtext") ("multipart/mixed") ("multipart/alternative") ("multipart/digest") @@ -54,7 +67,9 @@ (defun mh-mhn-compose-insertion (pathname type description) "Add a directive to insert a message part from a file. This is the typical way to insert non-text parts in a message. -See also \\[mh-edit-mhn]." +Arguments are PATHNAME, which tells where to find the file, TYPE, the +MIME content type, and DESCRIPTION, a line of text for the +Content-description header. See also \\[mh-edit-mhn]." (interactive (list (read-file-name "Insert contents of: ") (completing-read "Content-type: " @@ -79,8 +94,11 @@ (defun mh-mhn-compose-anon-ftp (host pathname type description) "Add a directive for an anonymous ftp external body part. -This directive tells MH to include a reference to a message/external-body part -retrievable by anonymous FTP. See also \\[mh-edit-mhn]." +This directive tells MH to include a reference to a +message/external-body part retrievable by anonymous FTP. Arguments +are HOST and PATHNAME, which tell where to find the file, TYPE, the +MIME content type, and DESCRIPTION, a line of text for the +Content-description header. See also \\[mh-edit-mhn]." (interactive (list (read-string "Remote host: ") (read-string "Remote pathname: ") @@ -92,8 +110,10 @@ (defun mh-mhn-compose-external-compressed-tar (host pathname description) "Add a directive to include a reference to a compressed tar file. -The file should be available via anonymous ftp. -This directive tells MH to include a reference to a message/external-body part. +The file should be available via anonymous ftp. This directive +tells MH to include a reference to a message/external-body part. +Arguments are HOST and PATHNAME, which tell where to find the file, and +DESCRIPTION, a line of text for the Content-description header. See also \\[mh-edit-mhn]." (interactive (list (read-string "Remote host: ") @@ -127,19 +147,19 @@ (insert "; " extra-params)) (insert "\n")) -(defun mh-mhn-compose-forw (&optional description msgs folder) +(defun mh-mhn-compose-forw (&optional description folder messages) "Add a forw directive to this message. This directive tells MH to include the named messages in this one. Arguments are DESCRIPTION, a line of text for the Content-description header, -MESSAGES and FOLDER, which name the message(s) to be forwarded. +FOLDER and MESSAGES, which name the message(s) to be forwarded. See also \\[mh-edit-mhn]." (interactive (list (read-string "Forw Content-description: ") + (mh-prompt-for-folder "Message from" mh-sent-from-folder nil) (read-string (format "Messages%s: " (if mh-sent-from-msg (format " [%d]" mh-sent-from-msg) - ""))) - (mh-prompt-for-folder "Message from" mh-sent-from-folder nil))) + ""))))) (beginning-of-line) (insert "#forw [") (and description @@ -149,41 +169,46 @@ (and folder (not (string= folder "")) (insert " " folder)) - (if (and msgs - (not (string= msgs ""))) + (if (and messages + (not (string= messages ""))) (let ((start (point))) - (insert " " msgs) + (insert " " messages) (subst-char-in-region start (point) ?, ? )) (if mh-sent-from-msg (insert " " (int-to-string mh-sent-from-msg)))) (insert "\n")) -(defun mh-edit-mhn () - "Filter the current draft through the mhn program for MIME formatting. -Using directives already inserted in the draft, fills in +(defun mh-edit-mhn (&optional extra-args) + "Format the current draft for MIME, expanding any mhn directives. +Process the current draft with the mhn program, which, +using directives already inserted in the draft, fills in all the MIME components and header fields. This step should be done last just before sending the message. The mhn program is part of MH version 6.8 or later. The `\\[mh-revert-mhn-edit]' command undoes this command. -For assistance with creating MIME directives to insert +The arguments in the list `mh-mhn-args' are passed to mhn +if this function is passed an argument. + +For assistance with creating mhn directives to insert various types of components in a message, see \\[mh-mhn-compose-insertion] (generic insertion from a file), \\[mh-mhn-compose-anon-ftp] (external reference to file via anonymous ftp), \\[mh-mhn-compose-external-compressed-tar] \ \(reference to compressed tar file via anonymous ftp), and \\[mh-mhn-compose-forw] (forward message)." - (interactive "*") + (interactive "*P") (save-buffer) (message "mhn editing...") - (mh-exec-cmd-error (format "mhdraft=%s" (buffer-file-name)) - "mhn" (buffer-file-name)) + (mh-exec-cmd-error (format "mhdraft=%s" buffer-file-name) + "mhn" (if extra-args mh-mhn-args) buffer-file-name) (revert-buffer t t) - (message "mhn editing...done")) + (message "mhn editing...done") + (run-hooks 'mh-edit-mhn-hook)) (defun mh-revert-mhn-edit (noconfirm) "Undoes the effect of \\[mh-edit-mhn] by reverting to the backup file. -Argument (optional) non-nil means don't ask for confirmation." +Optional non-nil argument means don't ask for confirmation." (interactive "*P") (if (null buffer-file-name) (error "Buffer does not seem to be associated with any file"))
--- a/lisp/mail/mh-pick.el Sun Apr 09 22:29:08 1995 +0000 +++ b/lisp/mail/mh-pick.el Sun Apr 09 22:31:08 1995 +0000 @@ -1,7 +1,7 @@ ;;; mh-pick --- make a search pattern and search for a message in mh-e -;; Time-stamp: <93/08/22 22:56:53 gildea> +;; Time-stamp: <94/12/22 20:34:51 gildea> -;; Copyright 1993 Free Software Foundation, Inc. +;; Copyright (C) 1993, 1995 Free Software Foundation, Inc. ;; This file is part of mh-e. @@ -23,22 +23,28 @@ ;; Internal support for mh-e package. +;;; Change Log: + +;; $Id: mh-pick.el,v 1.4 94/12/27 22:38:10 gildea Exp $ + ;;; Code: (provide 'mh-pick) (require 'mh-e) -(defvar mh-pick-mode-map (make-sparse-keymap) - "Keymap for searching folder.") - (defvar mh-pick-mode-hook nil "Invoked in `mh-pick-mode' on a new pattern.") -(defvar mh-searching-folder nil - "Folder this pick is searching.") +;;; Internal variables: + +(defvar mh-pick-mode-map (make-sparse-keymap) + "Keymap for searching folder.") + +(defvar mh-searching-folder nil) ;Folder this pick is searching. (defun mh-search-folder (folder) - "Search FOLDER for messages matching a pattern." + "Search FOLDER for messages matching a pattern. +Add the messages found to the sequence named `search'." (interactive (list (mh-prompt-for-folder "Search" mh-current-folder t))) @@ -66,8 +72,11 @@ (defun mh-pick-mode () "Mode for creating search templates in mh-e.\\<mh-pick-mode-map> -After each field name, enter the pattern to search for. To search -the entire message, supply the pattern in the \"body\" of the template. +After each field name, enter the pattern to search for. If a field's +value does not matter for the search, leave it empty. To search the +entire message, supply the pattern in the \"body\" of the template. +Each non-empty field must be matched for a message to be selected. +To effect a logical \"or\", use \\[mh-search-folder] multiple times. When you have finished, type \\[mh-do-pick-search] to do the search. \\{mh-pick-mode-map} Turning on mh-pick-mode calls the value of the variable mh-pick-mode-hook @@ -84,38 +93,41 @@ (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. -Add messages found to the sequence named `search'." +Add the messages found to the sequence named `search'." (interactive) (let ((pattern-buffer (buffer-name)) (searching-buffer mh-searching-folder) - range msgs + range + msgs + (finding-messages t) (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))) + (setq range (list (format "%d-%d" + mh-first-msg-num mh-last-msg-num)))) (t (mh-make-folder searching-buffer) - (setq range "all") + (setq range '("all")) (setq new-buffer t)))) (message "Searching...") (goto-char (point-min)) - (while (setq pattern (mh-next-pick-field pattern-buffer)) + (while (and range + (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")) + (mh-list-to-string + (list "pick" pattern searching-buffer + "-list" + (mh-coalesce-msg-list range))))) + (setq range msgs)) ;restrict the pick range for next pass (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)))) + (mh-add-msgs-to-seq msgs 'search) + (delete-other-windows))) (defun mh-seq-from-command (folder seq seq-command) @@ -128,18 +140,20 @@ (save-excursion (save-window-excursion (if (eq 0 (apply 'mh-exec-cmd-quiet nil seq-command)) + ;; "pick" outputs one number per line (while (setq msg (car (mh-read-msg-list))) (setq msgs (cons msg msgs)) (forward-line 1)))) (set-buffer folder) - (setq msgs (nreverse msgs)) ; Put in ascending order - (setq mh-seq-list (cons (mh-make-seq seq msgs) mh-seq-list)) + (setq msgs (nreverse msgs)) ;put in ascending order msgs))) (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. + ;; BUFFER. + ;; Return a list like ("--fieldname" "pattern") or ("-search" "bodypat") + ;; or NIL if no pieces remain. (set-buffer buffer) (let ((case-fold-search t)) (cond ((eobp) @@ -166,12 +180,15 @@ (define-key mh-pick-mode-map "\C-c\C-c" 'mh-do-pick-search) (define-key mh-pick-mode-map "\C-c\C-f\C-b" 'mh-to-field) (define-key mh-pick-mode-map "\C-c\C-f\C-c" 'mh-to-field) +(define-key mh-pick-mode-map "\C-c\C-f\C-d" 'mh-to-field) (define-key mh-pick-mode-map "\C-c\C-f\C-f" 'mh-to-field) +(define-key mh-pick-mode-map "\C-c\C-f\C-r" 'mh-to-field) (define-key mh-pick-mode-map "\C-c\C-f\C-s" 'mh-to-field) (define-key mh-pick-mode-map "\C-c\C-f\C-t" 'mh-to-field) (define-key mh-pick-mode-map "\C-c\C-fb" 'mh-to-field) (define-key mh-pick-mode-map "\C-c\C-fc" 'mh-to-field) +(define-key mh-pick-mode-map "\C-c\C-fd" 'mh-to-field) (define-key mh-pick-mode-map "\C-c\C-ff" 'mh-to-field) +(define-key mh-pick-mode-map "\C-c\C-fr" 'mh-to-field) (define-key mh-pick-mode-map "\C-c\C-fs" 'mh-to-field) (define-key mh-pick-mode-map "\C-c\C-ft" 'mh-to-field) -(define-key mh-pick-mode-map "\C-c\C-w" 'mh-check-whom)
--- a/lisp/mail/mh-seq.el Sun Apr 09 22:29:08 1995 +0000 +++ b/lisp/mail/mh-seq.el Sun Apr 09 22:31:08 1995 +0000 @@ -1,7 +1,7 @@ ;;; mh-seq --- mh-e sequences support -;; Time-stamp: <93/12/02 09:36:09 gildea> +;; Time-stamp: <94/12/22 20:34:50 gildea> -;; Copyright 1993 Free Software Foundation, Inc. +;; Copyright (C) 1993, 1995 Free Software Foundation, Inc. ;; This file is part of mh-e. @@ -23,28 +23,36 @@ ;; Internal support for mh-e package. +;;; Change Log: + +;; $Id: mh-seq.el,v 1.5 94/12/27 22:38:10 gildea Exp $ + ;;; Code: (provide 'mh-seq) (require 'mh-e) -(defvar mh-last-seq-used nil - "Name of the sequence to which a message was last added.") +;;; Internal variables: + +(defvar mh-last-seq-used nil) ;Name of seq to which a msg was last added. + +(defvar mh-non-seq-mode-line-annotation nil) ;Saved value of mh-mode-line-annotation when narrowed to a seq. -(defun mh-delete-seq (seq) +(defun mh-delete-seq (sequence) "Delete the SEQUENCE." (interactive (list (mh-read-seq-default "Delete" t))) - (mh-map-to-seq-msgs 'mh-notate-if-in-one-seq seq ? (1+ mh-cmd-note) seq) - (mh-undefine-sequence seq "all") - (mh-delete-seq-locally seq)) + (mh-map-to-seq-msgs 'mh-notate-if-in-one-seq sequence ? (1+ mh-cmd-note) + sequence) + (mh-undefine-sequence sequence '("all")) + (mh-delete-seq-locally sequence)) (defun mh-list-sequences (folder) "List the sequences defined in FOLDER." (interactive (list (mh-prompt-for-folder "List sequences in" mh-current-folder t))) - (let ((temp-buffer " *mh-temp*") + (let ((temp-buffer mh-temp-buffer) (seq-list mh-seq-list)) (with-output-to-temp-buffer temp-buffer (save-excursion @@ -72,44 +80,49 @@ (message "Listing sequences...done"))))) -(defun mh-msg-is-in-seq (msg) - "Display the sequences that contain MESSAGE (default: displayed message)." +(defun mh-msg-is-in-seq (message) + "Display the sequences that contain MESSAGE (default: current message)." (interactive (list (mh-get-msg-num t))) (message "Message %d is in sequences: %s" - msg + message (mapconcat 'concat - (mh-list-to-string (mh-seq-containing-msg msg)) + (mh-list-to-string (mh-seq-containing-msg message t)) " "))) -(defun mh-narrow-to-seq (seq) - "Restrict display of this folder to just messages in a sequence. -Reads which sequence.\\<mh-folder-mode-map> Use \\[mh-widen] to undo this command." +(defun mh-narrow-to-seq (sequence) + "Restrict display of this folder to just messages in SEQUENCE. +Use \\<mh-folder-mode-map>\\[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) + (with-mh-folder-updating (t) + (cond ((mh-seq-to-msgs sequence) + (mh-widen) + (let ((eob (point-max))) + (mh-copy-seq-to-point sequence eob) (narrow-to-region eob (point-max)) - (mh-make-folder-mode-line (symbol-name seq)) + (make-variable-buffer-local 'mh-non-seq-mode-line-annotation) + (setq mh-non-seq-mode-line-annotation mh-mode-line-annotation) + (setq mh-mode-line-annotation (symbol-name sequence)) + (mh-make-folder-mode-line) (mh-recenter nil) - (setq mh-narrowed-to-seq seq)) - (t - (error "No messages in sequence `%s'" (symbol-name seq))))))) + (setq mh-narrowed-to-seq sequence))) + (t + (error "No messages in sequence `%s'" (symbol-name sequence)))))) -(defun mh-put-msg-in-seq (msg-or-seq to) +(defun mh-put-msg-in-seq (msg-or-seq sequence) "Add MESSAGE(s) (default: displayed message) to SEQUENCE. If optional prefix argument provided, then prompt for the message sequence." (interactive (list (if current-prefix-arg (mh-read-seq-default "Add messages from" t) (mh-get-msg-num t)) (mh-read-seq-default "Add to" nil))) - (setq mh-last-seq-used to) + (if (not (mh-internal-seq sequence)) + (setq mh-last-seq-used sequence)) (mh-add-msgs-to-seq (if (numberp msg-or-seq) msg-or-seq (mh-seq-to-msgs msg-or-seq)) - to)) + sequence)) (defun mh-widen () @@ -119,6 +132,7 @@ (with-mh-folder-updating (t) (delete-region (point-min) (point-max)) (widen) + (setq mh-mode-line-annotation mh-non-seq-mode-line-annotation) (mh-make-folder-mode-line))) (setq mh-narrowed-to-seq nil)) @@ -131,7 +145,10 @@ (defun mh-read-seq-default (prompt not-empty) ;; Read and return sequence name with default narrowed or previous sequence. - (mh-read-seq prompt not-empty (or mh-narrowed-to-seq mh-last-seq-used))) + (mh-read-seq prompt not-empty + (or mh-narrowed-to-seq + mh-last-seq-used + (car (mh-seq-containing-msg (mh-get-msg-num nil) nil))))) (defun mh-read-seq (prompt not-empty &optional default) @@ -145,7 +162,8 @@ (format "[%s] " default) "")) (mh-seq-names mh-seq-list))) - (seq (cond ((equal input "%") (mh-msg-to-seq (mh-get-msg-num t))) + (seq (cond ((equal input "%") + (car (mh-seq-containing-msg (mh-get-msg-num t) nil))) ((equal input "") default) (t (intern input)))) (msgs (mh-seq-to-msgs seq))) @@ -154,27 +172,22 @@ seq)) -(defun mh-msg-to-seq (msg) - ;; Given a MESSAGE number, return the first sequence in which it occurs. - (car (mh-seq-containing-msg msg))) - - (defun mh-seq-names (seq-list) ;; Return an alist containing the names of the SEQUENCES. (mapcar (function (lambda (entry) (list (symbol-name (mh-seq-name entry))))) seq-list)) -(defun mh-rename-seq (seq new-name) - "Rename a SEQUENCE to have a new NAME." +(defun mh-rename-seq (sequence new-name) + "Rename SEQUENCE to have NEW-NAME." (interactive (list (mh-read-seq "Old" t) (intern (read-string "New sequence name: ")))) - (let ((old-seq (mh-find-seq seq))) + (let ((old-seq (mh-find-seq sequence))) (or old-seq - (error "Sequence %s does not exist" seq)) - ;; create new seq first, since it might raise an error. + (error "Sequence %s does not exist" sequence)) + ;; create new sequence first, since it might raise an error. (mh-define-sequence new-name (mh-seq-msgs old-seq)) - (mh-undefine-sequence seq (mh-seq-msgs old-seq)) + (mh-undefine-sequence sequence (mh-seq-msgs old-seq)) (rplaca old-seq new-name))) @@ -201,7 +214,7 @@ (if msgs (apply 'mh-exec-cmd "mark" mh-current-folder "-add" "-sequence" (symbol-name seq) - msgs)))) + (mh-coalesce-msg-list msgs))))) (defun mh-copy-seq-to-point (seq location) @@ -213,10 +226,11 @@ (defun mh-copy-line-to-point (msg location) ;; Copy the current line to the LOCATION in the current buffer. (beginning-of-line) - (let ((beginning-of-line (point))) - (forward-line 1) - (copy-region-as-kill beginning-of-line (point)) - (goto-char location) - (yank) - (goto-char beginning-of-line))) + (save-excursion + (let ((beginning-of-line (point)) + end) + (forward-line 1) + (setq end (point)) + (goto-char location) + (insert-buffer-substring (current-buffer) beginning-of-line end))))