;;; 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>
;;;###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)
(defvar message-draft-coding-system
(cond
- ((not (fboundp 'coding-system-p)) nil)
- ((coding-system-p 'emacs-mule) 'emacs-mule)
- ((coding-system-p 'escape-quoted) 'escape-quoted)
- ((coding-system-p 'no-conversion) 'no-conversion)
+ ((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)
(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)
(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)
(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)
message-indent-citation-function
(list message-indent-citation-function)))))
(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]*$")
(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
;;;
;;; MIME functions
;;;
-
-;; I really think this function should be renamed. It is only useful
-;; for inserting file attachments.
-
-(defun message-mime-attach-file (file type description)
+(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]'.
string of the form \"type/subtype\". DESCRIPTION is a one-line
description of the attachment."
(interactive
- (let* ((file (read-file-name "Attach file: " nil nil t))
- (type (completing-read
- (format "Content type (default %s): "
- (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"))
- (delete-duplicates
- (mapcar (lambda (m) (list (cdr m))) mailcap-mime-extensions)
- :test 'equal)))
- (description (read-string "One line description: ")))
+ (let* ((file (message-mime-query-file "Attach file: "))
+ (type (message-mime-query-type file))
+ (description (message-mime-query-description)))
(list file type description)))
- (when (string-match "\\`[ \t]*\\'" description)
- (setq description nil))
- (when (string-match "\\`[ \t]*\\'" type)
- (setq type (mm-default-file-encoding file))) nil
- ;; 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))
- (insert (format "<#part type=%s filename=%s%s><#/part>\n"
- type (prin1-to-string file)
- (if description
- (format " description=%s" (prin1-to-string description))
- ""))))
-
-(defun message-mime-insert-external (file type)
- "Insert a message/external-body part into the buffer."
+ (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))
(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)
(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 ()
projects / elisp / gnus.git- / blobdiff