X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=lisp%2Fgnus-msg.el;h=fe632fc4276096bc6ec2a931bc8b8c0d6cf4b3db;hb=c3e1fa9581a5bfd59386b25a438fbb6650441f79;hp=de18679f87f27ec1664f96202e01501f746012a1;hpb=e87407501e7c2a3600fcebb7bab052b92dfe7753;p=elisp%2Fgnus.git- diff --git a/lisp/gnus-msg.el b/lisp/gnus-msg.el index de18679..fe632fc 100644 --- a/lisp/gnus-msg.el +++ b/lisp/gnus-msg.el @@ -1,10 +1,9 @@ -;;; gnus-msg.el --- mail and post interface for Semi-gnus -;; Copyright (C) 1995,96,97 Free Software Foundation, Inc. +;;; gnus-msg.el --- mail and post interface for Gnus +;; Copyright (C) 1995,96,97,98,99 Free Software Foundation, Inc. ;; Author: Masanobu UMEDA -;; Lars Magne Ingebrigtsen -;; MORIOKA Tomohiko -;; Keywords: mail, news, MIME +;; Lars Magne Ingebrigtsen +;; Keywords: news ;; This file is part of GNU Emacs. @@ -34,18 +33,25 @@ (require 'message) (require 'gnus-art) -;; Added by Sudish Joseph . -(defvar gnus-post-method nil +(defcustom gnus-post-method nil "*Preferred method for posting USENET news. -If this variable is nil, Gnus will use the current method to decide -which method to use when posting. If it is non-nil, it will override -the current method. This method will not be used in mail groups and -the like, only in \"real\" newsgroups. -The value must be a valid method as discussed in the documentation of -`gnus-select-method'. It can also be a list of methods. If that is -the case, the user will be queried for what select method to use when -posting.") +If this variable is `current', Gnus will use the \"current\" select +method when posting. If it is nil (which is the default), Gnus will +use the native posting method of the server. + +This method will not be used in mail groups and the like, only in +\"real\" newsgroups. + +If not nil nor `native', the value must be a valid method as discussed +in the documentation of `gnus-select-method'. It can also be a list of +methods. If that is the case, the user will be queried for what select +method to use when posting." + :group 'gnus-group-foreign + :type `(choice (const nil) + (const current) + (const native) + (sexp :tag "Methods" ,gnus-select-method))) (defvar gnus-outgoing-message-group nil "*All outgoing messages will be put in this group. @@ -67,13 +73,6 @@ the group.") (defvar gnus-add-to-list nil "*If non-nil, add a `to-list' parameter automatically.") -(defvar gnus-sent-message-ids-file - (nnheader-concat gnus-directory "Sent-Message-IDs") - "File where Gnus saves a cache of sent message ids.") - -(defvar gnus-sent-message-ids-length 1000 - "The number of sent Message-IDs to save.") - (defvar gnus-crosspost-complaint "Hi, @@ -95,8 +94,27 @@ the second with the current group name.") (defvar gnus-message-setup-hook nil "Hook run after setting up a message buffer.") +(defvar gnus-bug-create-help-buffer t + "*Should we create the *Gnus Help Bug* buffer?") + +(defvar gnus-posting-styles nil + "*Alist of styles to use when posting.") + +(defcustom gnus-group-posting-charset-alist + '(("^no\\." iso-8859-1) + (message-this-is-mail nil) + (".*" iso-8859-1) + (message-this-is-news iso-8859-1)) + "Alist of regexps (to match group names) and default charsets to be unencoded when posting." + :type '(repeat (list (regexp :tag "Group") + (symbol :tag "Charset"))) + :group 'gnus-charset) + ;;; Internal variables. +(defvar gnus-inhibit-posting-styles nil + "Inhibit the use of posting styles.") + (defvar gnus-message-buffer "*Mail Gnus*") (defvar gnus-article-copy nil) (defvar gnus-last-posting-server nil) @@ -109,9 +127,10 @@ the second with the current group name.") The buffer below is a mail buffer. When you press `C-c C-c', it will be sent to the Gnus Bug Exterminators. -At the bottom of the buffer you'll see lots of variable settings. -Please do not delete those. They will tell the Bug People what your -environment is, so that it will be easier to locate the bugs. +The thing near the bottom of the buffer is how the environment +settings will be included in the mail. Please do not delete that. +They will tell the Bug People what your environment is, so that it +will be easier to locate the bugs. If you have found a bug that makes Emacs go \"beep\", set debug-on-error to t (`M-x set-variable RET debug-on-error RET t RET') @@ -165,26 +184,48 @@ Thank you for your help in stamping out bugs. (defmacro gnus-setup-message (config &rest forms) (let ((winconf (make-symbol "gnus-setup-message-winconf")) (buffer (make-symbol "gnus-setup-message-buffer")) - (article (make-symbol "gnus-setup-message-article"))) + (article (make-symbol "gnus-setup-message-article")) + (group (make-symbol "gnus-setup-message-group"))) `(let ((,winconf (current-window-configuration)) (,buffer (buffer-name (current-buffer))) (,article (and gnus-article-reply (gnus-summary-article-number))) + (,group gnus-newsgroup-name) (message-header-setup-hook - (copy-sequence message-header-setup-hook))) + (copy-sequence message-header-setup-hook)) + (message-mode-hook (copy-sequence message-mode-hook))) (add-hook 'message-header-setup-hook 'gnus-inews-insert-gcc) (add-hook 'message-header-setup-hook 'gnus-inews-insert-archive-gcc) + (add-hook 'message-mode-hook 'gnus-configure-posting-styles) (unwind-protect (progn ,@forms) (gnus-inews-add-send-actions ,winconf ,buffer ,article) (setq gnus-message-buffer (current-buffer)) (set (make-local-variable 'gnus-message-group-art) - (cons ,gnus-newsgroup-name ,article)) - (make-local-variable 'gnus-newsgroup-name) - (run-hooks 'gnus-message-setup-hook)) + (cons ,group ,article)) + (set (make-local-variable 'gnus-newsgroup-name) ,group) + (set (make-local-variable 'message-posting-charset) + (gnus-setup-posting-charset ,group)) + (gnus-run-hooks 'gnus-message-setup-hook)) + (gnus-add-buffer) (gnus-configure-windows ,config t) (set-buffer-modified-p nil)))) +(defun gnus-setup-posting-charset (group) + (let ((alist gnus-group-posting-charset-alist) + (group (or group "")) + elem) + (when group + (catch 'found + (while (setq elem (pop alist)) + (when (or (and (stringp (car elem)) + (string-match (car elem) group)) + (and (gnus-functionp (car elem)) + (funcall (car elem) group)) + (and (symbolp (car elem)) + (symbol-value (car elem)))) + (throw 'found (cadr elem)))))))) + (defun gnus-inews-add-send-actions (winconf buffer article) (make-local-hook 'message-sent-hook) (add-hook 'message-sent-hook 'gnus-inews-do-gcc nil t) @@ -195,9 +236,9 @@ Thank you for your help in stamping out bugs. (message-add-action `(set-window-configuration ,winconf) 'exit 'postpone 'kill) (message-add-action - `(when (buffer-name (get-buffer ,buffer)) + `(when (gnus-buffer-exists-p ,buffer) (save-excursion - (set-buffer (get-buffer ,buffer)) + (set-buffer ,buffer) ,(when article `(gnus-summary-mark-article-as-replied ,article)))) 'send)) @@ -207,11 +248,29 @@ Thank you for your help in stamping out bugs. ;;; Post news commands of Gnus group mode and summary mode -(defun gnus-group-mail () - "Start composing a mail." - (interactive) - (gnus-setup-message 'message - (message-mail))) +(defun gnus-group-mail (&optional arg) + "Start composing a mail. +If ARG, use the group under the point to find a posting style. +If ARG is 1, prompt for a group name to find the posting style." + (interactive "P") + ;; We can't `let' gnus-newsgroup-name here, since that leads + ;; to local variables leaking. + (let ((group gnus-newsgroup-name) + (buffer (current-buffer))) + (unwind-protect + (progn + (setq gnus-newsgroup-name + (if arg + (if (= 1 (prefix-numeric-value arg)) + (completing-read "Use posting style of group: " + gnus-active-hashtb nil + (gnus-read-active-file-p)) + (gnus-group-group-name)) + "")) + (gnus-setup-message 'message (message-mail))) + (save-excursion + (set-buffer buffer) + (setq gnus-newsgroup-name group))))) (defun gnus-group-post-news (&optional arg) "Start composing a news message. @@ -298,10 +357,8 @@ post using the current select method." article) (while (setq article (pop articles)) (when (gnus-summary-select-article t nil nil article) - (when (gnus-eval-in-buffer-window gnus-article-buffer - (save-excursion - (set-buffer gnus-original-article-buffer) - (message-cancel-news))) + (when (gnus-eval-in-buffer-window gnus-original-article-buffer + (message-cancel-news)) (gnus-summary-mark-as-read article gnus-canceled-mark) (gnus-cache-remove-article 1)) (gnus-article-hide-headers-if-wanted)) @@ -319,9 +376,9 @@ header line with the old Message-ID." (message-supersede) (push `((lambda () - (when (buffer-name (get-buffer ,gnus-summary-buffer)) + (when (gnus-buffer-exists-p ,gnus-summary-buffer) (save-excursion - (set-buffer (get-buffer ,gnus-summary-buffer)) + (set-buffer ,gnus-summary-buffer) (gnus-cache-possibly-remove-article ,article nil nil nil t) (gnus-summary-mark-as-read ,article gnus-canceled-mark))))) message-send-actions)))) @@ -333,14 +390,14 @@ header line with the old Message-ID." ;; this copy is in the buffer gnus-article-copy. ;; if ARTICLE-BUFFER is nil, gnus-article-buffer is used ;; this buffer should be passed to all mail/news reply/post routines. - (setq gnus-article-copy (get-buffer-create " *gnus article copy*")) - (buffer-disable-undo gnus-article-copy) - (or (memq gnus-article-copy gnus-buffer-list) - (push gnus-article-copy gnus-buffer-list)) + (setq gnus-article-copy (gnus-get-buffer-create " *gnus article copy*")) + (save-excursion + (set-buffer gnus-article-copy) + (mm-enable-multibyte)) (let ((article-buffer (or article-buffer gnus-article-buffer)) - end beg contents) + end beg) (if (not (and (get-buffer article-buffer) - (buffer-name (get-buffer article-buffer)))) + (gnus-buffer-exists-p article-buffer))) (error "Can't find any article buffer") (save-excursion (set-buffer article-buffer) @@ -367,10 +424,10 @@ header line with the old Message-ID." ;; Delete the headers from the displayed articles. (set-buffer gnus-article-copy) (delete-region (goto-char (point-min)) - (or (search-forward "\n\n" nil t) (point))) + (or (search-forward "\n\n" nil t) (point-max))) ;; Insert the original article headers. (insert-buffer-substring gnus-original-article-buffer beg end) - (gnus-article-decode-rfc1522))) + (article-decode-encoded-words))) gnus-article-copy))) (defun gnus-post-news (post &optional group header article-buffer yank subject @@ -409,6 +466,7 @@ header line with the old Message-ID." (if post (message-news (or to-group group)) (set-buffer gnus-article-copy) + (gnus-msg-treat-broken-reply-to) (message-followup (if (or newsgroup-p force-news) nil to-group))) ;; The is mail. (if post @@ -422,12 +480,19 @@ header line with the old Message-ID." (push (list 'gnus-inews-add-to-address pgroup) message-send-actions))) (set-buffer gnus-article-copy) - (message-wide-reply to-address - (gnus-group-find-parameter - gnus-newsgroup-name 'broken-reply-to)))) + (gnus-msg-treat-broken-reply-to) + (message-wide-reply to-address))) (when yank (gnus-inews-yank-articles yank)))))) +(defun gnus-msg-treat-broken-reply-to () + "Remove the Reply-to header iff broken-reply-to." + (when (gnus-group-find-parameter + gnus-newsgroup-name 'broken-reply-to) + (save-restriction + (message-narrow-to-head) + (message-remove-header "reply-to")))) + (defun gnus-post-method (arg group &optional silent) "Return the posting method based on GROUP and ARG. If SILENT, don't prompt the user." @@ -436,30 +501,38 @@ If SILENT, don't prompt the user." ;; If the group-method is nil (which shouldn't happen) we use ;; the default method. ((null group-method) - (or gnus-post-method gnus-select-method message-post-method)) - ;; We want this group's method. + (or (and (null (eq gnus-post-method 'active)) gnus-post-method) + gnus-select-method message-post-method)) + ;; We want the inverse of the default ((and arg (not (eq arg 0))) - group-method) + (if (eq gnus-post-method 'active) + gnus-select-method + group-method)) ;; We query the user for a post method. ((or arg (and gnus-post-method + (not (eq gnus-post-method 'current)) (listp (car gnus-post-method)))) (let* ((methods ;; Collect all methods we know about. (append - (when gnus-post-method + (when (and gnus-post-method + (not (eq gnus-post-method 'current))) (if (listp (car gnus-post-method)) gnus-post-method (list gnus-post-method))) gnus-secondary-select-methods + (mapcar 'cdr gnus-server-alist) + (mapcar 'car gnus-opened-servers) (list gnus-select-method) (list group-method))) method-alist post-methods method) ;; Weed out all mail methods. (while methods (setq method (gnus-server-get-method "" (pop methods))) - (when (or (gnus-method-option-p method 'post) - (gnus-method-option-p method 'post-mail)) + (when (and (or (gnus-method-option-p method 'post) + (gnus-method-option-p method 'post-mail)) + (not (member method post-methods))) (push method post-methods))) ;; Create a name-method alist. (setq method-alist @@ -480,84 +553,43 @@ If SILENT, don't prompt the user." (cons (or gnus-last-posting-server "") 0)))) method-alist)))) ;; Override normal method. - (gnus-post-method + ((and (eq gnus-post-method 'current) + (not (eq (car group-method) 'nndraft)) + (not arg)) + group-method) + ((and gnus-post-method + (not (eq gnus-post-method 'current))) gnus-post-method) ;; Use the normal select method. (t gnus-select-method)))) -;;; -;;; Check whether the message has been sent already. -;;; - -(defvar gnus-inews-sent-ids nil) - -(defun gnus-inews-reject-message () - "Check whether this message has already been sent." - (when gnus-sent-message-ids-file - (let ((message-id (save-restriction (message-narrow-to-headers) - (mail-fetch-field "message-id"))) - end) - (when message-id - (unless gnus-inews-sent-ids - (ignore-errors - (load t t t))) - (if (member message-id gnus-inews-sent-ids) - ;; Reject this message. - (not (gnus-yes-or-no-p - (format "Message %s already sent. Send anyway? " - message-id))) - (push message-id gnus-inews-sent-ids) - ;; Chop off the last Message-IDs. - (when (setq end (nthcdr gnus-sent-message-ids-length - gnus-inews-sent-ids)) - (setcdr end nil)) - (nnheader-temp-write gnus-sent-message-ids-file - (gnus-prin1 `(setq gnus-inews-sent-ids ',gnus-inews-sent-ids))) - nil))))) - -;; Dummy to avoid byte-compile warning. +;; Dummies to avoid byte-compile warning. (defvar nnspool-rejected-article-hook) (defvar xemacs-codename) -;;; Since the X-Newsreader/X-Mailer are ``vanity'' headers, they might -;;; as well include the Emacs version as well. -;;; The following function works with later GNU Emacs, and XEmacs. (defun gnus-extended-version () - "Stringified Gnus version" + "Stringified Gnus version and Emacs version." (interactive) - gnus-version) - -;; Written by "Mr. Per Persson" . -;; (defun gnus-inews-insert-mime-headers () -;; "Insert MIME headers. -;; Assumes ISO-Latin-1 is used iff 8-bit characters are present." -;; (goto-char (point-min)) -;; (let ((mail-header-separator -;; (progn -;; (goto-char (point-min)) -;; (if (and (search-forward (concat "\n" mail-header-separator "\n") -;; nil t) -;; (not (search-backward "\n\n" nil t))) -;; mail-header-separator -;; "")))) -;; (or (mail-position-on-field "Mime-Version") -;; (insert "1.0") -;; (cond ((save-restriction -;; (widen) -;; (goto-char (point-min)) -;; (re-search-forward "[^\000-\177]" nil t)) -;; (or (mail-position-on-field "Content-Type") -;; (insert "text/plain; charset=ISO-8859-1")) -;; (or (mail-position-on-field "Content-Transfer-Encoding") -;; (insert "8bit"))) -;; (t (or (mail-position-on-field "Content-Type") -;; (insert "text/plain; charset=US-ASCII")) -;; (or (mail-position-on-field "Content-Transfer-Encoding") -;; (insert "7bit"))))))) - -;; (custom-add-option 'message-header-hook 'gnus-inews-insert-mime-headers) + (concat + "Gnus/" (prin1-to-string (gnus-continuum-version gnus-version) t) + " (" gnus-version ")" + " " + (cond + ((string-match "^\\(\\([.0-9]+\\)*\\)\\.[0-9]+$" emacs-version) + (concat "Emacs/" (match-string 1 emacs-version))) + ((string-match "\\([A-Z]*[Mm][Aa][Cc][Ss]\\)[^(]*\\(\\((beta.*)\\|'\\)\\)?" + emacs-version) + (concat (match-string 1 emacs-version) + (format "/%d.%d" emacs-major-version emacs-minor-version) + (if (match-beginning 3) + (match-string 3 emacs-version) + "") + (if (boundp 'xemacs-codename) + (concat " (" xemacs-codename ")") + ""))) + (t emacs-version)))) ;;; @@ -580,8 +612,8 @@ automatically." (gnus-setup-message (if yank 'reply-yank 'reply) (gnus-summary-select-article) (set-buffer (gnus-copy-article-buffer)) - (message-reply nil wide (gnus-group-find-parameter - gnus-newsgroup-name 'broken-reply-to)) + (gnus-msg-treat-broken-reply-to) + (message-reply nil wide) (when yank (gnus-inews-yank-articles yank))))) @@ -606,15 +638,24 @@ The original article will be yanked." (interactive "P") (gnus-summary-reply-with-original n t)) -(defun gnus-summary-mail-forward (&optional full-headers post) +(defun gnus-summary-mail-forward (&optional not-used post) "Forward the current message to another user. -If FULL-HEADERS (the prefix), include full headers when forwarding." +If POST, post instead of mail." (interactive "P") (gnus-setup-message 'forward (gnus-summary-select-article) - (set-buffer gnus-original-article-buffer) - (let ((message-included-forward-headers - (if full-headers "" message-included-forward-headers))) + (let (text) + (save-excursion + (set-buffer gnus-original-article-buffer) + (setq text (buffer-string))) + (set-buffer (gnus-get-buffer-create + (generate-new-buffer-name " *Gnus forward*"))) + (erase-buffer) + (insert text) + (goto-char (point-min)) + (when (looking-at "From ") + (replace-match "X-From-Line: ") ) + (run-hooks 'gnus-article-decode-hook) (message-forward post)))) (defun gnus-summary-resend-message (address n) @@ -665,7 +706,8 @@ The current group name will be inserted at \"%s\".") (gnus-summary-select-article) (set-buffer gnus-original-article-buffer) (if (and (<= (length (message-tokenize-header - (setq newsgroups (mail-fetch-field "newsgroups")) + (setq newsgroups + (mail-fetch-field "newsgroups")) ", ")) 1) (or (not (setq followup-to (mail-fetch-field "followup-to"))) @@ -786,23 +828,28 @@ If YANK is non-nil, include the original article." (error "Gnus has been shut down")) (gnus-setup-message 'bug (delete-other-windows) - (switch-to-buffer (get-buffer-create "*Gnus Help Bug*")) - (erase-buffer) - (insert gnus-bug-message) - (goto-char (point-min)) + (when gnus-bug-create-help-buffer + (switch-to-buffer "*Gnus Help Bug*") + (erase-buffer) + (insert gnus-bug-message) + (goto-char (point-min))) (message-pop-to-buffer "*Gnus Bug*") (message-setup `((To . ,gnus-maintainer) (Subject . ""))) - (push `(gnus-bug-kill-buffer) message-send-actions) + (when gnus-bug-create-help-buffer + (push `(gnus-bug-kill-buffer) message-send-actions)) (goto-char (point-min)) (re-search-forward (concat "^" (regexp-quote mail-header-separator) "$")) (forward-line 1) - (insert (gnus-version) "\n") - (insert (emacs-version) "\n") + (insert (gnus-version) "\n" + (emacs-version) "\n") (when (and (boundp 'nntp-server-type) (stringp nntp-server-type)) (insert nntp-server-type)) (insert "\n\n\n\n\n") - (gnus-debug) + (save-excursion + (set-buffer (gnus-get-buffer-create " *gnus environment info*")) + (gnus-debug)) + (insert "<#part type=application/x-emacs-lisp buffer=\" *gnus environment info*\" disposition=inline description=\"User settings\"><#/part>") (goto-char (point-min)) (search-forward "Subject: " nil t) (message ""))) @@ -825,8 +872,7 @@ The source file has to be in the Emacs load path." (sit-for 0) ;; Go through all the files looking for non-default values for variables. (save-excursion - (set-buffer (get-buffer-create " *gnus bug info*")) - (buffer-disable-undo (current-buffer)) + (set-buffer (gnus-get-buffer-create " *gnus bug info*")) (while files (erase-buffer) (when (and (setq file (locate-library (pop files))) @@ -904,7 +950,7 @@ this is a reply." (save-restriction (message-narrow-to-headers) (let ((gcc (or gcc (mail-fetch-field "gcc" nil t))) - (coding-system-for-write 'raw-text) + (cur (current-buffer)) groups group method) (when gcc (message-remove-header "gcc") @@ -932,14 +978,17 @@ this is a reply." (gnus-request-create-group group method)) (save-excursion (nnheader-set-temp-buffer " *acc*") - (insert-buffer-substring message-encoding-buffer) - (run-hooks 'gnus-before-do-gcc-hook) + (insert-buffer-substring cur) + (message-encode-message-body) + (save-restriction + (message-narrow-to-headers) + (mail-encode-encoded-word-buffer)) (goto-char (point-min)) (when (re-search-forward (concat "^" (regexp-quote mail-header-separator) "$") nil t) (replace-match "" t t )) - (unless (gnus-request-accept-article group method t) + (unless (gnus-request-accept-article group method t t) (gnus-message 1 "Couldn't store article in group %s: %s" group (gnus-status-message method)) (sit-for 2)) @@ -970,7 +1019,7 @@ this is a reply." (and gnus-newsgroup-name (gnus-group-find-parameter gnus-newsgroup-name 'gcc-self))) - result + result (groups (cond ((null gnus-message-archive-method) @@ -1036,10 +1085,120 @@ this is a reply." (insert " "))) (insert "\n"))))))) -(gnus-add-shutdown 'gnus-inews-close 'gnus) - -(defun gnus-inews-close () - (setq gnus-inews-sent-ids nil)) +;;; Posting styles. + +(defun gnus-configure-posting-styles () + "Configure posting styles according to `gnus-posting-styles'." + (unless gnus-inhibit-posting-styles + (let ((group (or gnus-newsgroup-name "")) + (styles gnus-posting-styles) + style match variable attribute value v styles results + filep name address element) + ;; If the group has a posting-style parameter, add it at the end with a + ;; regexp matching everything, to be sure it takes precedence over all + ;; the others. + (when gnus-newsgroup-name + (let ((tmp-style (gnus-group-find-parameter group 'posting-style t))) + (when tmp-style + (setq styles (append styles (list (cons ".*" tmp-style))))))) + ;; Go through all styles and look for matches. + (dolist (style styles) + (setq match (pop style)) + (when (cond + ((stringp match) + ;; Regexp string match on the group name. + (string-match match group)) + ((or (symbolp match) + (gnus-functionp match)) + (cond + ((gnus-functionp match) + ;; Function to be called. + (funcall match)) + ((boundp match) + ;; Variable to be checked. + (symbol-value match)))) + ((listp match) + ;; This is a form to be evaled. + (eval match))) + ;; We have a match, so we set the variables. + (dolist (attribute style) + (setq element (pop attribute) + variable nil + filep nil) + (setq value + (cond + ((eq (car attribute) :file) + (setq filep t) + (cadr attribute)) + ((eq (car attribute) :value) + (cadr attribute)) + (t + (car attribute)))) + ;; We get the value. + (setq v + (cond + ((stringp value) + value) + ((or (symbolp value) + (gnus-functionp value)) + (cond ((gnus-functionp value) + (funcall value)) + ((boundp value) + (symbol-value value)))) + ((listp value) + (eval value)))) + ;; Translate obsolescent value. + (when (eq element 'signature-file) + (setq element 'signature + filep t)) + ;; Get the contents of file elems. + (when filep + (setq v (with-temp-buffer + (insert-file-contents v) + (buffer-string)))) + (setq results (delq (assoc element results) results)) + (push (cons element v) results)))) + ;; Now we have all the styles, so we insert them. + (setq name (assq 'name results) + address (assq 'address results)) + (setq results (delq name (delq address results))) + (make-local-variable 'message-setup-hook) + (dolist (result results) + (when (cdr result) + (add-hook 'message-setup-hook + (cond + ((eq 'body (car result)) + `(lambda () + (save-excursion + (message-goto-body) + (insert ,(cdr result))))) + ((eq 'signature (car result)) + (set (make-local-variable 'message-signature) nil) + (set (make-local-variable 'message-signature-file) nil) + `(lambda () + (save-excursion + (let ((message-signature ,(cdr result))) + (message-insert-signature))))) + (t + (let ((header + (if (symbolp (car result)) + (capitalize (symbol-name (car result))) + (car result)))) + `(lambda () + (save-excursion + (message-remove-header ,header) + (message-goto-eoh) + (insert ,header ": " ,(cdr result) "\n"))))))))) + (when (or name address) + (add-hook 'message-setup-hook + `(lambda () + (let ((user-full-name ,(or (cdr name) user-full-name)) + (user-mail-address + ,(or (cdr address) user-mail-address))) + (save-excursion + (message-remove-header "From") + (message-goto-eoh) + (insert "From: " (message-make-from) "\n"))))))))) ;;; Allow redefinition of functions.