:group 'message-buffers
:type '(choice (const :tag "off" nil)
(const :tag "unique" unique)
- (const :tag "unsuniqueent" unsent)
+ (const :tag "unsent" unsent)
(function fun)))
(defcustom message-kill-buffer-on-exit nil
:group 'message-forwarding
:type 'boolean)
-(defcustom message-ignored-resent-headers "^Return-receipt\\|^X-Gnus"
+(defcustom message-ignored-resent-headers "^Return-receipt\\|^X-Gnus\\|^Gnus-Warning:"
"*All headers that match this regexp will be deleted when resending a message."
:group 'message-interface
:type 'regexp)
:group 'message-various
:type 'hook)
+(defcustom message-cancel-hook nil
+ "Hook run when cancelling articles."
+ :group 'message-various
+ :type 'hook)
+
(defcustom message-signature-setup-hook nil
"Normal hook, run each time a new outgoing message is initialized.
It is run after the headers have been inserted and before
"\\([" cite-prefix "]+[" cite-suffix "]*\\)?"
"[:>|}].*")
(0 'message-cited-text-face))
- ("<#/?\\(multi\\)part.*>"
+ ("<#/?\\(multipart\\|part\\|external\\).*>"
(0 'message-mml-face))))
"Additional expressions to highlight in Message mode.")
"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 '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)
+ (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-default-charset nil)
(defvar message-buffer-list nil)
(defvar message-this-is-news nil)
(defvar message-this-is-mail nil)
(when value
(while (string-match "\n[\t ]+" value)
(setq value (replace-match " " t t value)))
- value)))
+ ;; We remove all text props.delete-region
+ (format "%s" value))))
(defun message-narrow-to-field ()
"Narrow the buffer to the header on the current line."
(goto-char (point-max)))))
number))
+(defun message-remove-first-header (header)
+ "Remove the first instance of HEADER if there is more than one."
+ (let ((count 0)
+ (regexp (concat "^" (regexp-quote header) ":")))
+ (save-excursion
+ (goto-char (point-min))
+ (while (re-search-forward regexp nil t)
+ (incf count)))
+ (while (> count 1)
+ (message-remove-header header nil t)
+ (decf count))))
+
(defun message-narrow-to-headers ()
"Narrow the buffer to the head of the message."
(widen)
(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)
(define-key message-mode-map "\C-c\C-z" 'message-kill-to-signature)
(define-key message-mode-map "\M-\r" 'message-newline-and-reformat)
- (define-key message-mode-map "\C-c\C-a" 'message-insert-mime-part)
-
+ (define-key message-mode-map "\C-c\C-a" 'message-mime-attach-file)
+ (define-key message-mode-map "\C-c\C-m\C-a" 'message-mime-attach-file)
+ (define-key message-mode-map "\C-c\C-m\C-e" 'message-mime-attach-external)
+ (define-key message-mode-map "\C-c\C-m\C-q" 'mml-quote-region)
+
(define-key message-mode-map "\t" 'message-tab))
(easy-menu-define
(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)
(if (listp message-indent-citation-function)
message-indent-citation-function
(list message-indent-citation-function)))))
- (goto-char start)
- ;; Quote parts.
- (while (re-search-forward "<#/?!*\\(multi\\|part\\)>" end t)
- (goto-char (match-beginning 1))
- (insert "!"))
+ (mml-quote-region start end)
(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]*$")
(if (listp message-indent-citation-function)
message-indent-citation-function
(list message-indent-citation-function)))))
- (goto-char start)
- ;; Quote parts.
- (while (re-search-forward "<#/?!*\\(multi\\|part\\)>" end t)
- (goto-char (match-beginning 1))
- (insert "!"))
+ (mml-quote-region start end)
(goto-char start)
(while functions
(funcall (pop functions)))
(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 auto-save.
(set-buffer-modified-p nil)
;; (funcall (intern (format "%s-request-post" (car method)))
;; (cadr method)))
(gnus-open-server method)
- (setq result (gnus-request-post method)))
+ (setq result (let ((mail-header-separator ""))
+ (gnus-request-post method))))
(kill-buffer tembuf))
(set-buffer messbuf)
(if result
(defun message-buffer-name (type &optional to group)
"Return a new (unique) buffer name based on TYPE and TO."
(cond
- ;; Check whether `message-generate-new-buffers' is a function,
- ;; and if so, call it.
- ((message-functionp message-generate-new-buffers)
- (funcall message-generate-new-buffers type to group))
;; Generate a new buffer name The Message Way.
((eq message-generate-new-buffers 'unique)
(generate-new-buffer-name
"")
(if (and group (not (string= group ""))) (concat " on " group) "")
"*")))
+ ;; Check whether `message-generate-new-buffers' is a function,
+ ;; and if so, call it.
+ ((message-functionp message-generate-new-buffers)
+ (funcall message-generate-new-buffers type to group))
((eq message-generate-new-buffers 'unsent)
(generate-new-buffer-name
(concat "*unsent " type
(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
;;;
"")
mail-header-separator "\n"
message-cancel-message)
+ (run-hooks 'message-cancel-hook)
(message "Canceling your article...")
(if (let ((message-syntax-checks
'dont-check-for-anything-just-trust-me))
;;; MIME functions
;;;
-(defun message-insert-mime-part (file type)
- "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))))
- (insert (format "<#part type=%s filename=\"%s\"><#/part>\n"
- type file)))
+ (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 (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 (lines multipart-p)
+ (let ((mm-default-charset message-default-charset)
+ lines multipart-p)
(message-goto-body)
(save-restriction
(narrow-to-region (point) (point-max))
(let ((new (mml-generate-mime)))
- (delete-region (point-min) (point-max))
- (insert new)
- (goto-char (point-min))
- (if (eq (aref new 0) ?\n)
- (delete-char 1)
- (search-forward "\n\n")
- (setq lines (buffer-substring (point-min) (1- (point))))
- (delete-region (point-min) (point)))))
+ (when new
+ (delete-region (point-min) (point-max))
+ (insert new)
+ (goto-char (point-min))
+ (if (eq (aref new 0) ?\n)
+ (delete-char 1)
+ (search-forward "\n\n")
+ (setq lines (buffer-substring (point-min) (1- (point))))
+ (delete-region (point-min) (point))))))
(save-restriction
(message-narrow-to-headers-or-head)
(message-remove-header "Mime-Version")
(goto-char (point-max))
- (insert "Mime-Version: 1.0\n")
+ (insert "MIME-Version: 1.0\n")
(when lines
(insert lines))
(setq multipart-p
(re-search-backward "^Content-Type: multipart/" 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
(message-goto-body)
(insert "This is a MIME multipart message. If you are reading\n")
projects / elisp / gnus.git- / blobdiff