Sync up with Pteruductyl Gnus v0.71
[elisp/gnus.git-] / lisp / message.el
index bd35833..08564c9 100644 (file)
@@ -1,5 +1,5 @@
 ;;; message.el --- composing mail and news messages
-;; Copyright (C) 1996,97,98 Free Software Foundation, Inc.
+;; Copyright (C) 1996,97,98,99 Free Software Foundation, Inc.
 
 ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
 ;;     MORIOKA Tomohiko <morioka@jaist.ac.jp>
@@ -621,8 +621,7 @@ The function `message-supersede' runs this hook."
 
 ;;;###autoload
 (defcustom message-yank-prefix "> "
-  "*Prefix inserted on the lines of yanked messages.
-nil means use indentation."
+  "*Prefix inserted on the lines of yanked messages."
   :type 'string
   :group 'message-insertion)
 
@@ -1033,18 +1032,15 @@ The cdr of ech entry is a function for applying the face to a region.")
                 (const :tag "always" t)
                 (const :tag "ask" ask)))
 
-(defvar message-send-coding-system 'binary
-  "Coding system to encode outgoing mail.")
-
 (defvar message-draft-coding-system 
-  (if (string-match "XEmacs\\|Lucid" emacs-version)
-      'escape-quoted 'emacs-mule)
+  (cond 
+   ((not (fboundp 'find-coding-system)) nil)
+   ((find-coding-system 'emacs-mule) 'emacs-mule)
+   ((find-coding-system 'escape-quoted) 'escape-quoted)
+   ((find-coding-system 'no-conversion) 'no-conversion)
+   (t nil))
   "Coding system to compose mail.")
 
-(defvar message-default-charset 'iso-8859-1
-  "Default charset assumed to be used when viewing non-ASCII characters.
-This variable is used only in non-Mule Emacsen.")
-
 ;;; Internal variables.
 
 (defvar message-buffer-list nil)
@@ -1052,6 +1048,7 @@ This variable is used only in non-Mule Emacsen.")
 (defvar message-this-is-mail nil)
 (defvar message-draft-article nil)
 (defvar message-mime-part nil)
+(defvar message-posting-charset nil)
 
 ;; Byte-compiler warning
 (defvar gnus-active-hashtb)
@@ -1176,7 +1173,7 @@ This variable is used only in non-Mule Emacsen.")
   (cdr (assq key alist)))
 
 (defmacro message-get-parameter-with-eval (key &optional alist)
-  `(message-eval-parameter (message-get-parameter ,alist ,key)))
+  `(message-eval-parameter (message-get-parameter ,key ,alist)))
 
 (defmacro message-y-or-n-p (question show &rest text)
   "Ask QUESTION, displaying the rest of the arguments in a temp. buffer if SHOW"
@@ -1480,6 +1477,7 @@ Point is left at the beginning of the narrowed-to region."
   (define-key message-mode-map "\C-c\C-y" 'message-yank-original)
   (define-key message-mode-map "\C-c\C-q" 'message-fill-yanked-message)
   (define-key message-mode-map "\C-c\C-w" 'message-insert-signature)
+  (define-key message-mode-map "\C-c\M-h" 'message-insert-headers)
   (define-key message-mode-map "\C-c\C-r" 'message-caesar-buffer-body)
   (define-key message-mode-map "\C-c\C-o" 'message-sort-headers)
   (define-key message-mode-map "\C-c\M-r" 'message-rename-buffer)
@@ -1829,8 +1827,7 @@ With the prefix argument FORCE, insert the header anyway."
                 (eq force 0))
            (save-excursion
              (goto-char (point-max))
-             (not (re-search-backward
-                   message-signature-separator nil t))))
+             (not (re-search-backward message-signature-separator nil t))))
           ((and (null message-signature)
                 force)
            t)
@@ -2051,13 +2048,8 @@ prefix, and don't delete any headers."
           (if (listp message-indent-citation-function)
               message-indent-citation-function
             (list message-indent-citation-function)))))
-    (goto-char start)
-    ;; Quote parts.
-    (while (re-search-forward "<#/?!*\\(multipart\\|part\\|external\\)" end t)
-      (goto-char (match-beginning 1))
-      (insert "!"))
     (goto-char end)
-    (when (re-search-backward "^-- $" start t)
+    (when (re-search-backward message-signature-separator start t)
       ;; Also peel off any blank lines before the signature.
       (forward-line -1)
       (while (looking-at "^[ \t]*$")
@@ -2086,12 +2078,6 @@ prefix, and don't delete any headers."
                 message-indent-citation-function
               (list message-indent-citation-function)))))
       (goto-char start)
-      ;; Quote parts.
-      (while (re-search-forward
-             "<#/?!*\\(multipart\\|part\\|external\\)" end t)
-       (goto-char (match-beginning 1))
-       (insert "!"))
-      (goto-char start)
       (while functions
        (funcall (pop functions)))
       (when message-citation-line-function
@@ -2298,7 +2284,8 @@ the user from the mailer."
        (message-do-fcc)
        ;;(when (fboundp 'mail-hist-put-headers-into-history)
        ;; (mail-hist-put-headers-into-history))
-       (run-hooks 'message-sent-hook)
+       (save-excursion
+         (run-hooks 'message-sent-hook))
        (message "Sending...done")
        ;; Mark the buffer as unmodified and delete autosave.
        (set-buffer-modified-p nil)
@@ -2477,31 +2464,31 @@ This sub function is for exclusive use of `message-send-mail'."
        (save-excursion
          (set-buffer errbuf)
          (erase-buffer))))
-    (let ((default-directory "/")
-         (coding-system-for-write message-send-coding-system))
-      (apply 'call-process-region
-            (append (list (point-min) (point-max)
-                          (if (boundp 'sendmail-program)
-                              sendmail-program
-                            "/usr/lib/sendmail")
-                          nil errbuf nil "-oi")
-                    ;; Always specify who from,
-                    ;; since some systems have broken sendmails.
-                    ;; But some systems are more broken with -f, so
-                    ;; we'll let users override this.
-                    (if (null message-sendmail-f-is-evil)
-                        (list "-f" (user-login-name)))
-                    ;; These mean "report errors by mail"
-                    ;; and "deliver in background".
-                    (if (null message-interactive) '("-oem" "-odb"))
-                    ;; Get the addresses from the message
-                    ;; unless this is a resend.
-                    ;; We must not do that for a resend
-                    ;; because we would find the original addresses.
-                    ;; For a resend, include the specific addresses.
-                    (if resend-to-addresses
-                        (list resend-to-addresses)
-                      '("-t")))))
+    (let ((default-directory "/"))
+      (as-binary-process
+       (apply 'call-process-region
+             (append (list (point-min) (point-max)
+                           (if (boundp 'sendmail-program)
+                               sendmail-program
+                             "/usr/lib/sendmail")
+                           nil errbuf nil "-oi")
+                     ;; Always specify who from,
+                     ;; since some systems have broken sendmails.
+                     ;; But some systems are more broken with -f, so
+                     ;; we'll let users override this.
+                     (if (null message-sendmail-f-is-evil)
+                         (list "-f" (user-login-name)))
+                     ;; These mean "report errors by mail"
+                     ;; and "deliver in background".
+                     (if (null message-interactive) '("-oem" "-odb"))
+                     ;; Get the addresses from the message
+                     ;; unless this is a resend.
+                     ;; We must not do that for a resend
+                     ;; because we would find the original addresses.
+                     ;; For a resend, include the specific addresses.
+                     (if resend-to-addresses
+                         (list resend-to-addresses)
+                       '("-t"))))))
     (when message-interactive
       (save-excursion
        (set-buffer errbuf)
@@ -2527,28 +2514,28 @@ to find out how to use this."
   (run-hooks 'message-send-mail-hook)
   ;; send the message
   (case
-      (let ((coding-system-for-write message-send-coding-system))
-       (apply
-        'call-process-region 1 (point-max) message-qmail-inject-program
-        nil nil nil
-        ;; qmail-inject's default behaviour is to look for addresses on the
-        ;; command line; if there're none, it scans the headers.
-        ;; yes, it does The Right Thing w.r.t. Resent-To and it's kin.
-        ;;
-        ;; in general, ALL of qmail-inject's defaults are perfect for simply
-        ;; reading a formatted (i. e., at least a To: or Resent-To header)
-        ;; message from stdin.
-        ;;
-        ;; qmail also has the advantage of not having been raped by
-        ;; various vendors, so we don't have to allow for that, either --
-        ;; compare this with message-send-mail-with-sendmail and weep
-        ;; for sendmail's lost innocence.
-        ;;
-        ;; all this is way cool coz it lets us keep the arguments entirely
-        ;; free for -inject-arguments -- a big win for the user and for us
-        ;; since we don't have to play that double-guessing game and the user
-        ;; gets full control (no gestapo'ish -f's, for instance).  --sj
-        message-qmail-inject-args))
+      (as-binary-process
+       (apply
+       'call-process-region 1 (point-max) message-qmail-inject-program
+       nil nil nil
+       ;; qmail-inject's default behaviour is to look for addresses on the
+       ;; command line; if there're none, it scans the headers.
+       ;; yes, it does The Right Thing w.r.t. Resent-To and it's kin.
+       ;;
+       ;; in general, ALL of qmail-inject's defaults are perfect for simply
+       ;; reading a formatted (i. e., at least a To: or Resent-To header)
+       ;; message from stdin.
+       ;;
+       ;; qmail also has the advantage of not having been raped by
+       ;; various vendors, so we don't have to allow for that, either --
+       ;; compare this with message-send-mail-with-sendmail and weep
+       ;; for sendmail's lost innocence.
+       ;;
+       ;; all this is way cool coz it lets us keep the arguments entirely
+       ;; free for -inject-arguments -- a big win for the user and for us
+       ;; since we don't have to play that double-guessing game and the user
+       ;; gets full control (no gestapo'ish -f's, for instance).  --sj
+       message-qmail-inject-args))
     ;; qmail-inject doesn't say anything on it's stdout/stderr,
     ;; we have to look at the retval instead
     (0 nil)
@@ -3830,6 +3817,23 @@ Headers already prepared in the buffer are not modified."
     (nndraft-request-expire-articles
      (list message-draft-article) "drafts" nil t)))
 
+(defun message-insert-headers ()
+  "Generate the headers for the article."
+  (interactive)
+  (save-excursion
+    (save-restriction
+      (message-narrow-to-headers)
+      (when (message-news-p)
+       (message-generate-headers
+        (delq 'Lines
+              (delq 'Subject
+                    (copy-sequence message-required-news-headers)))))
+      (when (message-mail-p)
+       (message-generate-headers
+        (delq 'Lines
+              (delq 'Subject
+                    (copy-sequence message-required-mail-headers))))))))
+
 \f
 
 ;;;
@@ -4777,42 +4781,74 @@ regexp varstr."
 ;;; MIME functions
 ;;;
 
-(defun message-insert-mime-part (file type description)
-  "Insert a multipart/alternative part into the buffer."
+(defun message-mime-query-file (prompt)
+  (let ((file (read-file-name prompt nil nil t)))
+    ;; Prevent some common errors.  This is inspired by similar code in
+    ;; VM.
+    (when (file-directory-p file)
+      (error "%s is a directory, cannot attach" file))
+    (unless (file-exists-p file)
+      (error "No such file: %s" file))
+    (unless (file-readable-p file)
+      (error "Permission denied: %s" file))
+    file))
+
+(defun message-mime-query-type (file)
+  (let* ((default (or (mm-default-file-encoding file)
+                     ;; Perhaps here we should check what the file
+                     ;; looks like, and offer text/plain if it looks
+                     ;; like text/plain.
+                     "application/octet-stream"))
+        (string (completing-read
+                 (format "Content type (default %s): " default)
+                 (delete-duplicates
+                  (mapcar (lambda (m) (list (cdr m))) mailcap-mime-extensions)
+                  :test 'equal))))
+    (if (not (equal string ""))
+       string
+      default)))
+
+(defun message-mime-query-description ()
+  (let ((description (read-string "One line description: ")))
+    (when (string-match "\\`[ \t]*\\'" description)
+      (setq description nil))
+    description))
+
+(defun message-mime-attach-file (file &optional type description)
+  "Attach a file to the outgoing MIME message.
+The file is not inserted or encoded until you send the message with
+`\\[message-send-and-exit]' or `\\[message-send]'.
+
+FILE is the name of the file to attach.  TYPE is its content-type, a
+string of the form \"type/subtype\".  DESCRIPTION is a one-line
+description of the attachment."
   (interactive
-   (let* ((file (read-file-name "Insert file: " nil nil t))
-         (type (mm-default-file-encoding file)))
-     (list file
-          (completing-read
-           (format "MIME type for %s: " file)
-           (delete-duplicates
-            (mapcar (lambda (m) (list (cdr m))) mailcap-mime-extensions))
-           nil nil type)
-          (read-string "Description: "))))
-  (insert (format "<#part type=%s filename=\"%s\"%s><#/part>\n"
-                 type file
-                 (if (zerop (length description))
-                     ""
-                   (format " description=%s"
-                           (prin1-to-string description))))))
-
-(defun message-mime-insert-external (file type)
-  "Insert a message/external-body part into the buffer."
+   (let* ((file (message-mime-query-file "Attach file: "))
+         (type (message-mime-query-type file))
+         (description (message-mime-query-description)))
+     (list file type description)))
+  (insert (format
+          "<#part type=%s filename=%s%s disposition=attachment><#/part>\n"
+          type (prin1-to-string file)
+          (if description
+              (format " description=%s" (prin1-to-string description))
+            ""))))
+
+(defun message-mime-attach-external (file &optional type description)
+  "Attach an external file into the buffer.
+FILE is an ange-ftp/efs specification of the part location.
+TYPE is the MIME type to use."
   (interactive
-   (let* ((file (read-file-name "Insert file: "))
-         (type (mm-default-file-encoding file)))
-     (list file
-          (completing-read
-           (format "MIME type for %s: " file)
-           (delete-duplicates
-            (mapcar (lambda (m) (list (cdr m))) mailcap-mime-extensions))
-           nil nil type))))
-  (insert (format "<#external type=%s name=\"%s\"><#/external>\n"
-                 type file)))
+   (let* ((file (message-mime-query-file "Attach external file: "))
+         (type (message-mime-query-type file))
+         (description (message-mime-query-description)))
+     (list file type description)))
+  (insert (format
+          "<#external type=%s name=%s disposition=attachment><#/external>\n"
+          type (prin1-to-string file))))
 
 (defun message-encode-message-body ()
-  (let ((mm-default-charset message-default-charset)
-       lines multipart-p)
+  (let (lines multipart-p content-type-p)
     (message-goto-body)
     (save-restriction
       (narrow-to-region (point) (point-max))
@@ -4834,7 +4870,14 @@ regexp varstr."
       (when lines
        (insert lines))
       (setq multipart-p
-           (re-search-backward "^Content-Type: multipart/" nil t)))
+           (re-search-backward "^Content-Type: multipart/" nil t))
+      (goto-char (point-max))
+      (setq content-type-p
+           (re-search-backward "^Content-Type:" nil t)))
+    (save-restriction
+      (message-narrow-to-headers-or-head)
+      (message-remove-first-header "Content-Type")
+      (message-remove-first-header "Content-Transfer-Encoding"))
     (when multipart-p
       (save-restriction
        (message-narrow-to-headers-or-head)
@@ -4842,7 +4885,17 @@ regexp varstr."
        (message-remove-first-header "Content-Transfer-Encoding"))
       (message-goto-body)
       (insert "This is a MIME multipart message.  If you are reading\n")
-      (insert "this, you shouldn't.\n"))))
+      (insert "this, you shouldn't.\n"))
+    ;; We always make sure that the message has a Content-Type header.
+    ;; This is because some broken MTAs and MUAs get awfully confused
+    ;; when confronted with a message with a MIME-Version header and
+    ;; without a Content-Type header.  For instance, Solaris'
+    ;; /usr/bin/mail.
+    (unless content-type-p
+      (goto-char (point-min))
+      (re-search-forward "^MIME-Version:")
+      (forward-line 1)
+      (insert "Content-Type: text/plain; charset=us-ascii\n"))))
 
 (defvar message-save-buffer " *encoding")
 (defun message-save-drafts ()