From: morioka Date: Tue, 29 Sep 1998 16:03:41 +0000 (+0000) Subject: Merge User-Agent related features of Shoe-gnus. X-Git-Tag: chao-gnus-6_9_0~2 X-Git-Url: http://git.chise.org/gitweb/?a=commitdiff_plain;h=69867c81309f33c5c2531624df1115aa8296bd89;p=elisp%2Fgnus.git- Merge User-Agent related features of Shoe-gnus. --- diff --git a/lisp/gnus-msg.el b/lisp/gnus-msg.el index 29943ae..b1e5714 100644 --- a/lisp/gnus-msg.el +++ b/lisp/gnus-msg.el @@ -121,7 +121,13 @@ the second with the current group name.") (defvar gnus-message-group-art nil) (defconst gnus-bug-message - "Sending a bug report to the Gnus Towers. + (format "Sending a bug report to the Gnus Towers. +======================================== + +This gnus is the %s%s. +If you think the bug is a Semi-gnus bug, send a bug report to Semi-gnus +Developers. (the addresses below are mailing list addresses) + ======================================== The buffer below is a mail buffer. When you press `C-c C-c', it will @@ -138,7 +144,11 @@ and include the backtrace in your bug report. Please describe the bug in annoying, painstaking detail. Thank you for your help in stamping out bugs. -") +" + gnus-product-name + (if (string= gnus-product-name "Semi-gnus") + "" + ", a modified version of Semi-gnus"))) (eval-and-compile (autoload 'gnus-uu-post-news "gnus-uu" nil t) @@ -214,7 +224,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 @@ -531,13 +541,11 @@ If SILENT, don't prompt the user." (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. +;;; Since the User-Agent is ``vanity'' headers. (defun gnus-extended-version () "Stringified gnus version." (interactive) - gnus-version) + (concat gnus-product-name "/" gnus-version-number)) ;;; @@ -803,7 +811,8 @@ If YANK is non-nil, include the original article." (insert gnus-bug-message) (goto-char (point-min))) (message-pop-to-buffer "*Gnus Bug*") - (message-setup `((To . ,gnus-maintainer) (Subject . ""))) + (message-setup + `((To . ,gnus-maintainer) (Cc . ,semi-gnus-developers) (Subject . ""))) (when gnus-bug-create-help-buffer (push `(gnus-bug-kill-buffer) message-send-actions)) (goto-char (point-min)) diff --git a/lisp/gnus-soup.el b/lisp/gnus-soup.el index 08f8176..3d97829 100644 --- a/lisp/gnus-soup.el +++ b/lisp/gnus-soup.el @@ -540,8 +540,7 @@ Return whether the unpacking was successful." (search-forward "\n\n") (forward-char -1) (insert mail-header-separator) - (setq message-newsreader (setq message-mailer - (gnus-extended-version))) + (setq message-user-agent (gnus-extended-version)) (cond ((string= (gnus-soup-reply-kind (car replies)) "news") (gnus-message 5 "Sending news message to %s..." diff --git a/lisp/gnus.el b/lisp/gnus.el index 871b70f..02e58fa 100644 --- a/lisp/gnus.el +++ b/lisp/gnus.el @@ -250,12 +250,15 @@ is restarted, and sometimes reloaded." :link '(custom-manual "(gnus)Exiting Gnus") :group 'gnus) -(defconst gnus-version-number "6.8.19" +(defconst gnus-product-name "Chao-gnus" + "Product name of this version of gnus.") + +(defconst gnus-version-number "6.9.0" "Version number for this version of gnus.") (defconst gnus-version - (format "Semi-gnus %s (based on Gnus 5.6.44; for SEMI 1.8, FLIM 1.8/1.9)" - gnus-version-number) + (format "%s %s (based on Gnus 5.6.44; for SEMI 1.8, FLIM 1.8-1.10)" + gnus-product-name gnus-version-number) "Version string for this version of gnus.") (defcustom gnus-inhibit-startup-message nil @@ -1481,6 +1484,12 @@ want." "bugs@gnus.org (The Gnus Bugfixing Girls + Boys)" "The mail address of the Gnus maintainers.") +(defconst semi-gnus-developers + "Semi-gnus Developers: + semi-gnus-en@meadow.scphys.kyoto-u.ac.jp (In English),\ + semi-gnus-ja@meadow.scphys.kyoto-u.ac.jp (In Japanese);" + "The mail address of the Semi-gnus developers.") + (defvar gnus-info-nodes '((gnus-group-mode "(gnus)The Group Buffer") (gnus-summary-mode "(gnus)The Summary Buffer") diff --git a/lisp/message.el b/lisp/message.el index cd6ca1d..945eabc 100644 --- a/lisp/message.el +++ b/lisp/message.el @@ -3,6 +3,7 @@ ;; Author: Lars Magne Ingebrigtsen ;; MORIOKA Tomohiko +;; Shuhei KOBAYASHI ;; Keiichi Suzuki ;; Keywords: mail, news, MIME @@ -187,11 +188,11 @@ shorten-followup-to existing-newsgroups buffer-file-name unchanged." (defcustom message-required-news-headers '(From Newsgroups Subject Date Message-ID (optional . Organization) Lines - (optional . X-Newsreader)) + (optional . User-Agent)) "*Headers to be generated or prompted for when posting an article. RFC977 and RFC1036 require From, Date, Newsgroups, Subject, Message-ID. Organization, Lines, In-Reply-To, Expires, and -X-Newsreader are optional. If don't you want message to insert some +User-Agent are optional. If don't you want message to insert some header, remove it from this list." :group 'message-news :group 'message-headers @@ -199,15 +200,15 @@ header, remove it from this list." (defcustom message-required-mail-headers '(From Subject Date (optional . In-Reply-To) Message-ID Lines - (optional . X-Mailer)) + (optional . User-Agent)) "*Headers to be generated or prompted for when mailing a message. RFC822 required that From, Date, To, Subject and Message-ID be -included. Organization, Lines and X-Mailer are optional." +included. Organization, Lines and User-Agent are optional." :group 'message-mail :group 'message-headers :type '(repeat sexp)) -(defcustom message-deletable-headers '(Message-ID Date Lines) +(defcustom message-deletable-headers '(Message-ID Date Lines User-Agent) "Headers to be deleted if they already exist and were generated by message previously." :group 'message-headers :type 'sexp) @@ -631,6 +632,10 @@ actually occur." :group 'message-sending :type 'sexp) +;;; XXX: This symbol is overloaded! See below. +(defvar message-user-agent nil + "String of the form of PRODUCT/VERSION. Used for User-Agent header field.") + ;; Ignore errors in case this is used in Emacs 19. ;; Don't use ignore-errors because this is copied into loaddefs.el. ;;;###autoload @@ -967,8 +972,7 @@ The cdr of ech entry is a function for applying the face to a region.") (Expires) (Message-ID) (References . message-fill-references) - (X-Mailer) - (X-Newsreader)) + (User-Agent)) "Alist used for formatting headers.") (eval-and-compile @@ -1369,8 +1373,7 @@ C-c C-r message-caesar-buffer-body (rot13 the message body)." (setq paragraph-separate paragraph-start) (make-local-variable 'message-reply-headers) (setq message-reply-headers nil) - (make-local-variable 'message-newsreader) - (make-local-variable 'message-mailer) + (make-local-variable 'message-user-agent) (make-local-variable 'message-post-method) (make-local-variable 'message-sent-message-via) (setq message-sent-message-via nil) @@ -3076,6 +3079,24 @@ give as trustworthy answer as possible." (or mail-host-address (message-make-fqdn))) +(defun message-make-user-agent () + "Return user-agent info." + (if message-user-agent + (save-excursion + (goto-char (point-min)) + (let ((case-fold-search t) + user-agent beg p end) + (if (re-search-forward "^User-Agent:[ \t]*" nil t) + (progn + (setq beg (match-beginning 0) + p (match-end 0) + end (std11-field-end) + user-agent (buffer-substring p end)) + (delete-region beg (1+ end)) + (concat message-user-agent " " user-agent) + ) + message-user-agent))))) + (defun message-generate-headers (headers) "Prepare article HEADERS. Headers already prepared in the buffer are not modified." @@ -3092,9 +3113,7 @@ Headers already prepared in the buffer are not modified." (To nil) (Distribution (message-make-distribution)) (Lines (message-make-lines)) - (X-Newsreader message-newsreader) - (X-Mailer (and (not (message-fetch-field "X-Newsreader")) - message-mailer)) + (User-Agent (message-make-user-agent)) (Expires (message-make-expires)) (case-fold-search t) header value elem)