X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=lisp%2Fgnus-msg.el;h=3a11671a6147b8f1ea97953b69945b46c974411f;hb=04dd7f60c8b498fb77fd4de6e5bea13806eff076;hp=955dbfaa802333ddb10f379d6abc09671890227c;hpb=a2caf5dd39a1ad513bf9e3dc01c43f7225846d75;p=elisp%2Fgnus.git- diff --git a/lisp/gnus-msg.el b/lisp/gnus-msg.el index 955dbfa..3a11671 100644 --- a/lisp/gnus-msg.el +++ b/lisp/gnus-msg.el @@ -98,6 +98,17 @@ the second with the current group name.") (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.") + +(defvar gnus-posting-style-alist + '((organization . message-user-organization) + (signature . message-signature) + (signature-file . message-signature-file) + (address . user-mail-address) + (name . user-full-name)) + "*Mapping from style parameters to variables.") + ;;; Internal variables. (defvar gnus-message-buffer "*Mail Gnus*") @@ -178,6 +189,7 @@ Thank you for your help in stamping out bugs. (copy-sequence message-header-setup-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) @@ -196,7 +208,7 @@ Thank you for your help in stamping out bugs. (setq message-post-method `(lambda (arg) (gnus-post-method arg ,gnus-newsgroup-name))) - (setq message-newsreader (setq message-mailer (gnus-extended-version))) + (setq message-user-agent (gnus-extended-version)) (message-add-action `(set-window-configuration ,winconf) 'exit 'postpone 'kill) (message-add-action @@ -414,6 +426,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 @@ -427,12 +440,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." @@ -462,6 +482,7 @@ If SILENT, don't prompt the user." gnus-post-method (list gnus-post-method))) gnus-secondary-select-methods + (mapcar 'cdr gnus-server-alist) (list gnus-select-method) (list group-method))) method-alist post-methods method) @@ -502,66 +523,33 @@ If SILENT, don't prompt the user." ;; Dummy to avoid byte-compile warning. (defvar nnspool-rejected-article-hook) +(defvar mule-version) (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 and Emacs version." (interactive) (concat - gnus-version - "/" + "Semi-gnus/" gnus-version-number " " (cond - ((string-match "^\\([0-9]+\\.[0-9]+\\)\\.[.0-9]+$" emacs-version) - (concat "Emacs " (substring emacs-version - (match-beginning 1) - (match-end 1)))) - ((string-match "\\([A-Z]*[Mm][Aa][Cc][Ss]\\)[^(]*\\(\\((beta.*)\\|'\\)\\)?" - emacs-version) - (concat (substring emacs-version - (match-beginning 1) - (match-end 1)) - (format " %d.%d" emacs-major-version emacs-minor-version) - (if (match-beginning 3) - (substring emacs-version - (match-beginning 3) - (match-end 3)) - "") + ((featurep 'xemacs) + (concat (format "XEmacs/%d.%d" emacs-major-version emacs-minor-version) + ;; XXX: include beta version? + (if (featurep 'mule) + "-mule") (if (boundp 'xemacs-codename) - (concat " - \"" xemacs-codename "\"")))) - (t emacs-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 " (" xemacs-codename ")")) + )) + (t + (concat (format "Emacs/%d.%d" emacs-major-version emacs-minor-version) + ;; XXX: include unibyte/multibyte env. info. + (if (boundp 'mule-version) + (concat " Mule/" mule-version)) + ;; XXX: convert (Meadow-version) -> PRODUCT/VERSION. + (if (featurep 'meadow) + (concat " " (Meadow-version))) + )) + ))) ;;; @@ -584,8 +572,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))))) @@ -1046,6 +1034,68 @@ this is a reply." (insert " "))) (insert "\n"))))))) +;;; Posting styles. + +(defun gnus-configure-posting-styles () + "Configure posting styles according to `gnus-posting-styles'." + (let ((styles gnus-posting-styles) + (gnus-newsgroup-name (or gnus-newsgroup-name "")) + style match variable attribute value value-value) + ;; Go through all styles and look for matches. + (while styles + (setq style (pop styles) + match (pop style)) + (when (cond ((stringp match) + ;; Regexp string match on the group name. + (string-match match gnus-newsgroup-name)) + ((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. + (while style + (setq attribute (pop style) + value (cadr attribute) + variable nil) + ;; We find the variable that is to be modified. + (if (and (not (stringp (car attribute))) + (not (setq variable (cdr (assq (car attribute) + gnus-posting-style-alist))))) + (message "Couldn't find attribute %s" (car attribute)) + ;; We get the value. + (setq value-value + (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)))) + (if variable + (progn + ;; This is an ordinary variable. + (make-local-variable variable) + (set variable value-value)) + ;; This is a header to be added to the headers when + ;; posting. + (when value-value + (make-local-variable message-required-mail-headers) + (make-local-variable message-required-news-headers) + (push (cons (car attribute) value-value) + message-required-mail-headers) + (push (cons (car attribute) value-value) + message-required-news-headers))))))))) + ;;; Allow redefinition of functions. (gnus-ems-redefine)