]> code.delx.au - gnu-emacs/blobdiff - lisp/mail/rmail.el
(report-emacs-bug-text-prompt): New variable.
[gnu-emacs] / lisp / mail / rmail.el
index e35932f64df8fa37ddb5d677130572cf189fe56e..e6dd92671e170ff993370f9823d90dafec629eac 100644 (file)
@@ -40,6 +40,7 @@
 ;;
 
 (require 'mail-utils)
+(eval-when-compile (require 'mule-util)) ; for detect-coding-with-priority
 
 ; These variables now declared in paths.el.
 ;(defvar rmail-spool-directory "/usr/spool/mail/"
@@ -131,8 +132,8 @@ rather than deleted, after it is retrieved."
 
 ;;;###autoload
 (defcustom rmail-dont-reply-to-names nil "\
-*A regexp specifying names to prune of reply to messages.
-A value of nil means exclude your own login name as an address
+*A regexp specifying addresses to prune from a reply message.
+A value of nil means exclude your own email address as an address
 plus whatever is specified by `rmail-default-dont-reply-to-names'."
   :type '(choice regexp (const :tag "Your Name" nil))
   :group 'rmail-reply)
@@ -142,7 +143,7 @@ plus whatever is specified by `rmail-default-dont-reply-to-names'."
 A regular expression specifying part of the value of the default value of
 the variable `rmail-dont-reply-to-names', for when the user does not set
 `rmail-dont-reply-to-names' explicitly.  (The other part of the default
-value is the user's name.)
+value is the user's email address and name.)
 It is useful to set this variable in the site customization file.")
 
 ;;;###autoload
@@ -314,7 +315,7 @@ examples:
   :group 'rmail
   :version "21.1"
   :type '(repeat (sexp :tag "Directive")))
-  
+
 (defvar rmail-reply-prefix "Re: "
   "String to prepend to Subject line when replying to a message.")
 
@@ -419,6 +420,9 @@ until a user explicitly requires it."
                 (other :tag "when asked" ask))
   :group 'rmail)
 
+(defvar rmail-enable-mime-composing nil
+  "*If non-nil, RMAIL uses `rmail-insert-mime-forwarded-message-function' to forward.")
+
 ;;;###autoload
 (defvar rmail-show-mime-function nil
   "Function to show MIME decoded message of RMAIL file.
@@ -428,7 +432,8 @@ It is called with no argument.")
 ;;;###autoload
 (defvar rmail-insert-mime-forwarded-message-function nil
   "Function to insert a message in MIME format so it can be forwarded.
-This function is called if `rmail-enable-mime' is non-nil.
+This function is called if `rmail-enable-mime' or
+`rmail-enable-mime-composing' is non-nil.
 It is called with one argument FORWARD-BUFFER, which is a
 buffer containing the message to forward.  The current buffer
 is the outgoing mail buffer.")
@@ -541,7 +546,7 @@ The first parenthesized expression should match the MIME-charset name.")
     (let* ((cite-chars "[>|}]")
           (cite-prefix "A-Za-z")
           (cite-suffix (concat cite-prefix "0-9_.@-`'\"")))
-      (list '("^\\(From\\|Sender\\):" . font-lock-function-name-face)
+      (list '("^\\(From\\|Sender\\|Resent-[Ff]rom\\):" . font-lock-function-name-face)
            '("^Reply-To:.*$" . font-lock-function-name-face)
            '("^Subject:" . font-lock-comment-face)
            '("^\\(To\\|Apparently-To\\|Cc\\|Newsgroups\\):"
@@ -620,12 +625,14 @@ If `rmail-display-summary' is non-nil, make a summary for this RMAIL file."
                   (list (read-file-name "Run rmail on RMAIL file: "))))
   (rmail-require-mime-maybe)
   (let* ((file-name (expand-file-name (or file-name-arg rmail-file-name)))
-        (existed (get-file-buffer file-name))
-        ;; This binding is necessary because we much decide if we
+        ;; Use find-buffer-visiting, not get-file-buffer, for those users
+        ;; who have find-file-visit-truename set to t.
+        (existed (find-buffer-visiting file-name))
+        ;; This binding is necessary because we must decide if we
         ;; need code conversion while the buffer is unibyte
         ;; (i.e. enable-multibyte-characters is nil).
          (rmail-enable-multibyte
-          (if existed 
+          (if existed
              (with-current-buffer existed enable-multibyte-characters)
             (default-value 'enable-multibyte-characters)))
         ;; Since the file may contain messages of different encodings
@@ -650,7 +657,7 @@ If `rmail-display-summary' is non-nil, make a summary for this RMAIL file."
                   (eq major-mode 'rmail-mode))
              (progn (rmail-forget-messages)
                     (rmail-set-message-counters))))
-      (switch-to-buffer 
+      (switch-to-buffer
        (let ((enable-local-variables nil))
         (find-file-noselect file-name))))
     (if (eq major-mode 'rmail-edit-mode)
@@ -772,11 +779,21 @@ Note:    it means the file has no messages in it.\n\^_")))
     (setq to (point))
     (unless (and coding-system
                 (coding-system-p coding-system))
-      (setq coding-system (detect-coding-region from to t)))
+      (setq coding-system
+           ;; Emacs 21.1 and later writes RMAIL files in emacs-mule, but
+           ;; earlier versions did that with the current buffer's encoding.
+           ;; So we want to favor detection of emacs-mule (whose normal
+           ;; priority is quite low), but still allow detection of other
+           ;; encodings if emacs-mule won't fit.  The call to
+           ;; detect-coding-with-priority below achieves that.
+           (car (detect-coding-with-priority
+                 from to
+                 '((coding-category-emacs-mule . emacs-mule))))))
     (unless (memq coding-system
                  '(undecided undecided-unix))
       (set-buffer-modified-p t)                ; avoid locking when decoding
-      (decode-coding-region from to coding-system)
+      (let ((buffer-undo-list t))
+       (decode-coding-region from to coding-system))
       (setq coding-system last-coding-system-used))
     (set-buffer-modified-p modifiedp)
     (setq buffer-file-coding-system nil)
@@ -1252,8 +1269,8 @@ original copy."
                   (if (consp item)
                       (progn
                         (setq command
-                              (rmail-list-to-menu (car item) (cdr item) 
-                                                  action 
+                              (rmail-list-to-menu (car item) (cdr item)
+                                                  action
                                                   (if full-name
                                                       (concat full-name "/"
                                                               (car item))
@@ -1261,10 +1278,10 @@ original copy."
                         (setq name (car item)))
                     (progn
                       (setq name item)
-                      (setq command 
+                      (setq command
                             (list 'lambda () '(interactive)
                                   (list action
-                                        (expand-file-name 
+                                        (expand-file-name
                                          (if full-name
                                              (concat full-name "/" item)
                                            item)
@@ -1273,7 +1290,7 @@ original copy."
                     (cons name command)))))
      (reverse l))
     menu))
+
 ;; This command is always "disabled" when it appears in a menu.
 (put 'rmail-disable-menu 'menu-enable ''nil)
 
@@ -1282,13 +1299,13 @@ original copy."
     (if files
        (progn
          (define-key rmail-mode-map [menu-bar classify input-menu]
-           (cons "Input Rmail File" 
-                 (rmail-list-to-menu "Input Rmail File" 
+           (cons "Input Rmail File"
+                 (rmail-list-to-menu "Input Rmail File"
                                      files
                                      'rmail-input)))
          (define-key rmail-mode-map [menu-bar classify output-menu]
-           (cons "Output Rmail File" 
-                 (rmail-list-to-menu "Output Rmail File" 
+           (cons "Output Rmail File"
+                 (rmail-list-to-menu "Output Rmail File"
                                      files
                                      'rmail-output-to-rmail-file))))
 
@@ -1531,13 +1548,13 @@ It returns t if it got any new messages."
                   (save-excursion
                     (setq errors (generate-new-buffer " *rmail loss*"))
                     (buffer-disable-undo errors)
-                    (let ((args 
-                           (append 
+                    (let ((args
+                           (append
                             (list (or rmail-movemail-program
                                       (expand-file-name "movemail"
                                                         exec-directory))
                                   nil errors nil)
-                            (if rmail-preserve-inbox 
+                            (if rmail-preserve-inbox
                                 (list "-p")
                               nil)
                             rmail-movemail-flags
@@ -1852,7 +1869,7 @@ It returns t if it got any new messages."
                      ""
                    (concat
                     "Date: \\2, \\4 \\3 \\9 \\5 "
-                   
+
                     ;; The timezone could be matched by group 7 or group 10.
                     ;; If neither of them matched, assume EST, since only
                     ;; Easterners would be so sloppy.
@@ -2041,12 +2058,7 @@ otherwise, show it in full."
                   (recenter old-screen-line)
                   (if (and all-headers-visible
                            (not (= (window-start) (point-min))))
-                      (let ((lines-offscreen (rmail-count-screen-lines
-                                              (point-min)
-                                              (window-start window))))
-                        (recenter (min (+ old-screen-line lines-offscreen)
-                                       ;; last line of window
-                                       (- (window-height) 2))))))))))
+                      (recenter (- (window-height) 2))))))))
       (rmail-highlight-headers))))
 
 (defun rmail-narrow-to-non-pruned-header ()
@@ -2300,7 +2312,7 @@ change the invisible header text."
            (aset rmail-msgref-vector i (list i))
            (setq i (1+ i))))
        (message "Counting messages...done")))))
-       
+
 (defun rmail-set-message-counters-counter (&optional stop)
   (let ((start (point))
        next)
@@ -2379,8 +2391,12 @@ If summary buffer is currently displayed, update current message there also."
              (goto-char (point-min))
              (if (re-search-forward "^X-Coding-System: *\\(.*\\)$" nil t)
                  (let ((coding-system (intern (match-string 1))))
-                   (check-coding-system coding-system)
-                   (setq buffer-file-coding-system coding-system))
+                   (condition-case nil
+                       (progn
+                         (check-coding-system coding-system)
+                         (setq buffer-file-coding-system coding-system))
+                     (error 
+                      (setq buffer-file-coding-system nil))))
                (setq buffer-file-coding-system nil)))))
        ;; Clear the "unseen" attribute when we show a message.
        (rmail-set-attribute "unseen" nil)
@@ -2439,43 +2455,51 @@ iso-8859, koi8-r, etc."
     (or (eq major-mode 'rmail-mode)
        (switch-to-buffer rmail-buffer))
     (save-excursion
-      (unwind-protect
-         (let ((msgbeg (rmail-msgbeg rmail-current-message))
-               (msgend (rmail-msgend rmail-current-message))
-               x-coding-header)
-           (narrow-to-region msgbeg msgend)
-           (goto-char (point-min))
-           (when (search-forward "\n*** EOOH ***\n" (point-max) t)
-             (narrow-to-region msgbeg (point)))
-           (goto-char (point-min))
-           (if (re-search-forward "^X-Coding-System: *\\(.*\\)$" nil t)
-               (let ((old-coding (intern (match-string 1)))
-                     (buffer-read-only nil))
-                 (check-coding-system old-coding)
-                 ;; Make sure the new coding system uses the same EOL
-                 ;; conversion, to prevent ^M characters from popping
-                 ;; up all over the place.
-                 (setq coding
-                       (coding-system-change-eol-conversion
-                        coding
-                        (coding-system-eol-type old-coding)))
-                 (setq x-coding-header (point-marker))
-                 (narrow-to-region msgbeg msgend)
-                 (encode-coding-region (point) msgend old-coding)
-                 (decode-coding-region (point) msgend coding)
-                 (setq last-coding-system-used coding)
-                 ;; Rewrite the coding-system header according
-                 ;; to what we did.
-                 (goto-char x-coding-header)
-                 (delete-region (point)
-                                (save-excursion
-                                  (beginning-of-line)
-                                  (point)))
-                 (insert "X-Coding-System: "
-                         (symbol-name last-coding-system-used))
-                 (set-marker x-coding-header nil)
-                 (rmail-show-message))
-             (error "No X-Coding-System header found")))))))
+      (let ((pruned (rmail-msg-is-pruned)))
+       (unwind-protect
+           (let ((msgbeg (rmail-msgbeg rmail-current-message))
+                 (msgend (rmail-msgend rmail-current-message))
+                 x-coding-header)
+             ;; We need the message headers pruned (we later restore
+             ;; the pruned stat to what it was, see the end of
+             ;; unwind-protect form).
+             (or pruned
+                 (rmail-toggle-header 1))
+             (narrow-to-region msgbeg msgend)
+             (goto-char (point-min))
+             (when (search-forward "\n*** EOOH ***\n" (point-max) t)
+               (narrow-to-region msgbeg (point)))
+             (goto-char (point-min))
+             (if (re-search-forward "^X-Coding-System: *\\(.*\\)$" nil t)
+                 (let ((old-coding (intern (match-string 1)))
+                       (buffer-read-only nil))
+                   (check-coding-system old-coding)
+                   ;; Make sure the new coding system uses the same EOL
+                   ;; conversion, to prevent ^M characters from popping
+                   ;; up all over the place.
+                   (setq coding
+                         (coding-system-change-eol-conversion
+                          coding
+                          (coding-system-eol-type old-coding)))
+                   (setq x-coding-header (point-marker))
+                   (narrow-to-region msgbeg msgend)
+                   (encode-coding-region (point) msgend old-coding)
+                   (decode-coding-region (point) msgend coding)
+                   (setq last-coding-system-used coding)
+                   ;; Rewrite the coding-system header according
+                   ;; to what we did.
+                   (goto-char x-coding-header)
+                   (delete-region (point)
+                                  (save-excursion
+                                    (beginning-of-line)
+                                    (point)))
+                   (insert "X-Coding-System: "
+                           (symbol-name last-coding-system-used))
+                   (set-marker x-coding-header nil)
+                   (rmail-show-message))
+               (error "No X-Coding-System header found")))
+         (or pruned
+             (rmail-toggle-header 0)))))))
 
 ;; Find all occurrences of certain fields, and highlight them.
 (defun rmail-highlight-headers ()
@@ -2568,7 +2592,7 @@ With prefix arg N, moves forward N messages, or backward if N is negative."
   "Show previous message whether deleted or not.
 With prefix arg N, moves backward N messages, or forward if N is negative."
   (interactive "p")
-  (rmail-next-message (- n)))  
+  (rmail-next-message (- n)))
 
 (defun rmail-next-undeleted-message (n)
   "Show following non-deleted message.
@@ -2655,7 +2679,7 @@ or forward if N is negative."
                (forward-line 1))
              (setq beg (point))
              (narrow-to-region (point) end))
-           (progn 
+           (progn
              (rfc822-goto-eoh)
              (setq end (point)))
          (setq beg (point))
@@ -3243,7 +3267,7 @@ see the documentation of `rmail-resend'."
          (save-excursion
            ;; Insert after header separator--before signature if any.
            (goto-char (mail-text-start))
-           (if rmail-enable-mime
+           (if (or rmail-enable-mime rmail-enable-mime-composing)
                (funcall rmail-insert-mime-forwarded-message-function
                         forward-buffer)
              (insert "------- Start of forwarded message -------\n")
@@ -3328,6 +3352,8 @@ typically for purposes of moderating a list."
                    (if (and (not (vectorp mail-abbrevs))
                             (file-exists-p mail-personal-alias-file))
                        (build-mail-abbrevs))
+                   (unless mail-abbrev-syntax-table
+                     (mail-abbrev-make-syntax-table))
                    (set-syntax-table mail-abbrev-syntax-table)
                    (goto-char before)
                    (while (and (< (point) end)
@@ -3397,14 +3423,14 @@ specifying headers which should not be copied into the new message."
     (save-excursion
       (goto-char (point-min))
       (let ((case-fold-search t))
-       (if (and content-type 
-                (string-match 
-                 ";[\n\t ]*boundary=\"?\\([-0-9a-z'()+_,./:=? ]+\\)\"?" 
+       (if (and content-type
+                (string-match
+                 ";[\n\t ]*boundary=\"?\\([-0-9a-z'()+_,./:=? ]+\\)\"?"
                  content-type))
            ;; Handle a MIME multipart bounce message.
            (let ((codestring
                   (concat "\n--"
-                          (substring content-type (match-beginning 1) 
+                          (substring content-type (match-beginning 1)
                                      (match-end 1)))))
              (unless (re-search-forward mail-mime-unsent-header nil t)
                (error "Cannot find beginning of header in failed message"))
@@ -3525,7 +3551,7 @@ This has an effect only if a summary buffer exists."
         (setq window (get-buffer-window rmail-summary-buffer))
         ;; Don't try to change the size if just one window in frame.
         (not (eq window (frame-root-window (window-frame window))))
-        (unwind-protect 
+        (unwind-protect
             (progn
               (select-window window)
               (enlarge-window (- rmail-summary-window-size (window-height))))
@@ -3535,7 +3561,6 @@ This has an effect only if a summary buffer exists."
 
 (defun rmail-fontify-buffer-function ()
   ;; This function's symbol is bound to font-lock-fontify-buffer-function.
-  (make-local-hook 'rmail-show-message-hook)
   (add-hook 'rmail-show-message-hook 'rmail-fontify-message nil t)
   ;; If we're already showing a message, fontify it now.
   (if rmail-current-message (rmail-fontify-message))
@@ -3685,7 +3710,7 @@ TEXT and INDENT are not used."
   "Set PASSWORD to be used for retrieving mail from a POP server."
   (interactive "sPassword: ")
   (if password
-      (setq rmail-encoded-pop-password 
+      (setq rmail-encoded-pop-password
            (rmail-encode-string password (emacs-pid)))
     (setq rmail-pop-password nil)
     (setq rmail-encoded-pop-password nil)))
@@ -3711,7 +3736,7 @@ restarting at the lowest byte of the mask whenever it runs out.
 Returns the encoded string.  Calling the function again with an
 encoded string (and the same mask) will decode the string."
  (setq mask (abs mask))                        ; doesn't work if negative
- (let* ((string-vector (string-to-vector string)) (i 0) 
+ (let* ((string-vector (string-to-vector string)) (i 0)
        (len (length string-vector)) (curmask mask) charmask)
    (while (< i len)
      (if (= curmask 0)