: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
"Face used for displaying cited text names."
:group 'message-faces)
+(defface message-mml-face
+ '((((class color)
+ (background dark))
+ (:foreground "ForestGreen"))
+ (((class color)
+ (background light))
+ (:foreground "ForestGreen"))
+ (t
+ (:bold t)))
+ "Face used for displaying MML."
+ :group 'message-faces)
+
(defvar message-font-lock-keywords
(let* ((cite-prefix "A-Za-z")
(cite-suffix (concat cite-prefix "0-9_.@-"))
(,(concat "^[ \t]*"
"\\([" cite-prefix "]+[" cite-suffix "]*\\)?"
"[:>|}].*")
- (0 'message-cited-text-face))))
+ (0 'message-cited-text-face))
+ ("<#/?\\(multipart\\|part\\|external\\).*>"
+ (0 'message-mml-face))))
"Additional expressions to highlight in Message mode.")
;; XEmacs does it like this. For Emacs, we have to set the
(defvar message-send-coding-system 'binary
"Coding system to encode outgoing mail.")
+(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)
+ (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."
(forward-line 1)
(if (re-search-forward "^[^ \t]" nil t)
(goto-char (match-beginning 0))
- (point-max))))
+ (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-insert-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
(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)
;; Also peel off any blank lines before the signature.
(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)
message-syntax-checks)
message-syntax-checks))
result)
- (save-restriction
- (message-narrow-to-headers)
- ;; Insert some headers.
- (message-generate-headers message-required-news-headers)
- (mail-encode-encoded-word-buffer)
- ;; Let the user do all of the above.
- (run-hooks 'message-header-hook))
- (message-cleanup-headers)
- (if (not (message-check-news-syntax))
+ (if (not (message-check-news-body-syntax))
nil
+ (save-restriction
+ (message-narrow-to-headers)
+ ;; Insert some headers.
+ (message-generate-headers message-required-news-headers)
+ (mail-encode-encoded-word-buffer)
+ ;; Let the user do all of the above.
+ (run-hooks 'message-header-hook))
(message-encode-message-body)
- (unwind-protect
- (save-excursion
- (set-buffer tembuf)
- (buffer-disable-undo)
- (erase-buffer)
- ;; Avoid copying text props.
- (insert (format
- "%s" (save-excursion
- (set-buffer messbuf)
- (buffer-string))))
- ;; Remove some headers.
- (save-restriction
- (message-narrow-to-headers)
+ (message-cleanup-headers)
+ (if (not (message-check-news-syntax))
+ nil
+ (unwind-protect
+ (save-excursion
+ (set-buffer tembuf)
+ (buffer-disable-undo)
+ (erase-buffer)
+ ;; Avoid copying text props.
+ (insert (format
+ "%s" (save-excursion
+ (set-buffer messbuf)
+ (buffer-string))))
;; Remove some headers.
- (message-remove-header message-ignored-news-headers t))
- (goto-char (point-max))
- ;; require one newline at the end.
- (or (= (preceding-char) ?\n)
- (insert ?\n))
- (let ((case-fold-search t))
- ;; Remove the delimiter.
- (goto-char (point-min))
- (re-search-forward
- (concat "^" (regexp-quote mail-header-separator) "\n"))
- (replace-match "\n")
- (backward-char 1))
- (run-hooks 'message-send-news-hook)
- ;;(require (car method))
- ;;(funcall (intern (format "%s-open-server" (car method)))
- ;;(cadr method) (cddr method))
- ;;(setq result
- ;; (funcall (intern (format "%s-request-post" (car method)))
- ;; (cadr method)))
- (gnus-open-server method)
- (setq result (gnus-request-post method)))
- (kill-buffer tembuf))
- (set-buffer messbuf)
- (if result
- (push 'news message-sent-message-via)
- (message "Couldn't send message via news: %s"
- (nnheader-get-report (car method)))
- nil))))
+ (save-restriction
+ (message-narrow-to-headers)
+ ;; Remove some headers.
+ (message-remove-header message-ignored-news-headers t))
+ (goto-char (point-max))
+ ;; require one newline at the end.
+ (or (= (preceding-char) ?\n)
+ (insert ?\n))
+ (let ((case-fold-search t))
+ ;; Remove the delimiter.
+ (goto-char (point-min))
+ (re-search-forward
+ (concat "^" (regexp-quote mail-header-separator) "\n"))
+ (replace-match "\n")
+ (backward-char 1))
+ (run-hooks 'message-send-news-hook)
+ ;;(require (car method))
+ ;;(funcall (intern (format "%s-open-server" (car method)))
+ ;;(cadr method) (cddr method))
+ ;;(setq result
+ ;; (funcall (intern (format "%s-request-post" (car method)))
+ ;; (cadr method)))
+ (gnus-open-server method)
+ (setq result (gnus-request-post method)))
+ (kill-buffer tembuf))
+ (set-buffer messbuf)
+ (if result
+ (push 'news message-sent-message-via)
+ (message "Couldn't send message via news: %s"
+ (nnheader-get-report (car method)))
+ nil)))))
;;;
;;; Header generation & syntax checking.
(save-excursion
(save-restriction
(widen)
- (and
- ;; We narrow to the headers and check them first.
- (save-excursion
- (save-restriction
- (message-narrow-to-headers)
- (message-check-news-header-syntax)))
- ;; Check the body.
- (message-check-news-body-syntax)))))
+ ;; We narrow to the headers and check them first.
+ (save-excursion
+ (save-restriction
+ (message-narrow-to-headers)
+ (message-check-news-header-syntax))))))
(defun message-check-news-header-syntax ()
(and
(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
(setq buffer-file-name (expand-file-name "*message*"
message-auto-save-directory))
(setq buffer-auto-save-file-name (make-auto-save-file-name)))
- (clear-visited-file-modtime)))
+ (clear-visited-file-modtime)
+ (setq buffer-file-coding-system message-draft-coding-system)))
(defun message-disassociate-draft ()
"Disassociate the message buffer from the drafts directory."
(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."
+
+;; I really think this function should be renamed. It is only useful
+;; for inserting file attachments.
+
+(defun message-mime-attach-file (file 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 "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: ")))
+ (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."
(interactive
- (let* ((file (read-file-name "Insert file: " nil nil t))
+ (let* ((file (read-file-name "Insert file: "))
(type (mm-default-file-encoding file)))
(list file
(completing-read
(format "MIME type for %s: " file)
- (mapcar (lambda (m) (list (cdr m))) mailcap-mime-extensions)
+ (delete-duplicates
+ (mapcar (lambda (m) (list (cdr m))) mailcap-mime-extensions))
nil nil type))))
- (insert (format "<#part type=%s filename=\"%s\"><#/part>\n"
+ (insert (format "<#external type=%s name=\"%s\"><#/external>\n"
type file)))
(defun message-encode-message-body ()
- (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))
- (widen)
- (forward-line -1)
- (let ((beg (point))
- (line (buffer-substring (point) (progn (forward-line 1) (point)))))
- (delete-region beg (point))
- (insert "Mime-Version: 1.0\n")
- (search-forward "\n\n")
- (insert line)
- (when (save-excursion
- (re-search-backward "^Content-Type: multipart/" nil t))
- (insert "This is a MIME multipart message. If you are reading\n")
- (insert "this, you shouldn't.\n\n"))))))
-
-(run-hooks 'message-load-hook)
+ (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)))
+ (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")
+ (when lines
+ (insert lines))
+ (setq multipart-p
+ (re-search-backward "^Content-Type: multipart/" nil t)))
+ (when multipart-p
+ (save-restriction
+ (message-narrow-to-headers-or-head)
+ (message-remove-first-header "Content-Type")
+ (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"))))
(provide 'message)
+(run-hooks 'message-load-hook)
+
;;; message.el ends here
projects / elisp / gnus.git- / blobdiff