(require 'gnus-ems)
(require 'message)
(require 'gnus-art)
+(require 'gnus-util)
(defcustom gnus-post-method 'current
"*Preferred method for posting USENET news.
(function)))
(defcustom gnus-mailing-list-groups nil
- "*Regexp matching groups that are really mailing lists.
+ "*If non-nil a regexp matching groups that are really mailing lists.
This is useful when you're reading a mailing list that has been
gatewayed to a newsgroup, and you want to followup to an article in
the group."
:group 'gnus-message
- :type 'regexp)
+ :type '(choice (regexp)
+ (const nil)))
(defcustom gnus-add-to-list nil
"*If non-nil, add a `to-list' parameter automatically."
:group 'gnus-message
:type 'boolean)
-(defvar gnus-inews-mark-gcc-as-read nil
- "Obsolete variable. Use `gnus-gcc-mark-as-read' instead.")
-
(make-obsolete-variable 'gnus-inews-mark-gcc-as-read
'gnus-gcc-mark-as-read)
(defcustom gnus-message-replysign
nil
- "Automatically sign replys to signed messages.
+ "Automatically sign replies to signed messages.
See also the `mml-default-sign-method' variable."
:group 'gnus-message
:type 'boolean)
(defcustom gnus-message-replyencrypt
nil
- "Automatically encrypt replys to encrypted messages.
+ "Automatically encrypt replies to encrypted messages.
See also the `mml-default-encrypt-method' variable."
:group 'gnus-message
:type 'boolean)
(defcustom gnus-message-replysignencrypted
t
- "Setting this causes automatically encryped messages to also be signed."
+ "Setting this causes automatically encrypted messages to also be signed."
:group 'gnus-message
:type 'boolean)
"If non-nil, Gnus requests confirmation when replying to news.
This is done because new users often reply by mistake when reading
news.
-This can also be a function which should return non-nil iff a
-confirmation is needed, or a regexp, in which case a confirmation is
-asked if the group name matches the regexp."
+This can also be a function receiving the group name as the only
+parameter which should return non-nil iff a confirmation is needed, or
+a regexp, in which case a confirmation is asked for iff the group name
+matches the regexp."
:group 'gnus-message
:type '(choice (const :tag "No" nil)
- (const :tag "Yes" nil)
+ (const :tag "Yes" t)
(regexp :tag "Iff group matches regexp")
(function :tag "Iff function evaluates to non-nil")))
:group 'gnus-message
:type 'boolean)
+(defcustom gnus-user-agent 'emacs-gnus-type
+ "Which information should be exposed in the User-Agent header.
+
+It can be one of the symbols `gnus' \(show only Gnus version\), `emacs-gnus'
+\(show only Emacs and Gnus versions\), `emacs-gnus-config' \(same as
+`emacs-gnus' plus system configuration\), `emacs-gnus-type' \(same as
+`emacs-gnus' plus system type\) or a custom string. If you set it to a
+string, be sure to use a valid format, see RFC 2616."
+ :group 'gnus-message
+ :type '(choice
+ (item :tag "Show Gnus and Emacs versions and system type"
+ emacs-gnus-type)
+ (item :tag "Show Gnus and Emacs versions and system configuration"
+ emacs-gnus-config)
+ (item :tag "Show Gnus and Emacs versions" emacs-gnus)
+ (item :tag "Show only Gnus version" gnus)
+ (string :tag "Other")))
+
;;; Internal variables.
(defvar gnus-inhibit-posting-styles nil
(let ((mbl1 mml-buffer-list))
(setq mml-buffer-list mbl) ;; Global value
(set (make-local-variable 'mml-buffer-list) mbl1);; Local value
- ;; LOCAL argument of add-hook differs between GNU Emacs
- ;; and XEmacs. make-local-hook makes sure they are local.
- (make-local-hook 'kill-buffer-hook)
- (make-local-hook 'change-major-mode-hook)
+ (gnus-make-local-hook 'kill-buffer-hook)
+ (gnus-make-local-hook 'change-major-mode-hook)
(add-hook 'change-major-mode-hook 'mml-destroy-buffers nil t)
(add-hook 'kill-buffer-hook 'mml-destroy-buffers t t))
(mml-destroy-buffers)
(setq mml-buffer-list mbl)))
+ (message-hide-headers)
(gnus-add-buffer)
(gnus-configure-windows ,config t)
(run-hooks 'post-command-hook)
(while (setq elem (pop alist))
(when (or (and (stringp (car elem))
(string-match (car elem) group))
- (and (gnus-functionp (car elem))
+ (and (functionp (car elem))
(funcall (car elem) group))
(and (symbolp (car elem))
(symbol-value (car elem))))
(defun gnus-inews-add-send-actions (winconf buffer article
&optional config yanked)
- (make-local-hook 'message-sent-hook)
+ (gnus-make-local-hook 'message-sent-hook)
(add-hook 'message-sent-hook (if gnus-agent 'gnus-agent-possibly-do-gcc
'gnus-inews-do-gcc) nil t)
(when gnus-agent
- (make-local-hook 'message-header-hook)
+ (gnus-make-local-hook 'message-header-hook)
(add-hook 'message-header-hook 'gnus-agent-possibly-save-gcc nil t))
(setq message-post-method
`(lambda (arg)
(gnus-post-method arg ,gnus-newsgroup-name)))
(setq message-newsreader (setq message-mailer (gnus-extended-version)))
- (message-add-action
- `(set-window-configuration ,winconf) 'exit 'postpone 'kill)
(message-add-action
`(when (gnus-buffer-exists-p ,buffer)
- (save-excursion
- (set-buffer ,buffer)
- ,(when article
- (if (eq config 'forward)
- `(gnus-summary-mark-article-as-forwarded ',yanked)
- `(gnus-summary-mark-article-as-replied ',yanked)))))
- 'send))
+ (set-window-configuration ,winconf))
+ 'exit 'postpone 'kill)
+ (let ((to-be-marked (cond
+ (yanked yanked)
+ (article (if (listp article) article (list article)))
+ (t nil))))
+ (message-add-action
+ `(when (gnus-buffer-exists-p ,buffer)
+ (save-excursion
+ (set-buffer ,buffer)
+ ,(when to-be-marked
+ (if (eq config 'forward)
+ `(gnus-summary-mark-article-as-forwarded ',to-be-marked)
+ `(gnus-summary-mark-article-as-replied ',to-be-marked)))))
+ 'send)))
(put 'gnus-setup-message 'lisp-indent-function 1)
(put 'gnus-setup-message 'edebug-form-spec '(form body))
This function prepares a news even when using mail groups. This is useful
for posting messages to mail groups without actually sending them over the
-network. The corresponding backend must have a 'request-post method."
+network. The corresponding back end must have a 'request-post method."
(interactive "P")
;; We can't `let' gnus-newsgroup-name here, since that leads
;; to local variables leaking.
This function prepares a news even when using mail groups. This is useful
for posting messages to mail groups without actually sending them over the
-network. The corresponding backend must have a 'request-post method."
+network. The corresponding back end must have a 'request-post method."
(interactive "P")
;; We can't `let' gnus-newsgroup-name here, since that leads
;; to local variables leaking.
gnus-newsgroup-name))
;; #### see comment in gnus-setup-message -- drv
(gnus-setup-message 'message
- (message-news (gnus-group-real-name gnus-newsgroup-name))))
+ (progn
+ (message-news (gnus-group-real-name gnus-newsgroup-name))
+ (set (make-local-variable 'gnus-discouraged-post-methods)
+ (delq
+ (car (gnus-find-method-for-group gnus-newsgroup-name))
+ (copy-sequence gnus-discouraged-post-methods))))))
(save-excursion
(set-buffer buffer)
(setq gnus-newsgroup-name group)))))
(forward-line 1))
(let ((mail-header-separator ""))
(setq beg (point)
- end (or (message-goto-body) beg)))
+ end (or (message-goto-body)
+ ;; There may be just a header.
+ (point-max))))
;; Delete the headers from the displayed articles.
(set-buffer gnus-article-copy)
(let ((mail-header-separator ""))
(defvar xemacs-codename))
(defun gnus-extended-version ()
- "Stringified Gnus version and Emacs version."
+ "Stringified Gnus version and Emacs version.
+See the variable `gnus-user-agent'."
(interactive)
- (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)
- " (" system-configuration ")"))
- ((string-match "\\([A-Z]*[Mm][Aa][Cc][Ss]\\)[^(]*\\(\\((beta.*)\\|'\\)\\)?"
- emacs-version)
- (concat (match-string 1 emacs-version)
+ (let* ((gnus-v
+ (concat "Gnus/"
+ (prin1-to-string (gnus-continuum-version gnus-version) t)
+ " (" gnus-version ")"))
+ (system-v
+ (cond
+ ((eq gnus-user-agent 'emacs-gnus-config)
+ system-configuration)
+ ((eq gnus-user-agent 'emacs-gnus-type)
+ (symbol-name system-type))
+ (t nil)))
+ (emacs-v
+ (cond
+ ((eq gnus-user-agent 'gnus)
+ nil)
+ ((string-match "^\\(\\([.0-9]+\\)*\\)\\.[0-9]+$" emacs-version)
+ (concat "Emacs/" (match-string 1 emacs-version)
+ (if system-v
+ (concat " (" system-v ")")
+ "")))
+ ((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 ", " system-configuration ")")
+ (concat
+ " (" xemacs-codename
+ (if system-v
+ (concat ", " system-v ")")
+ ")"))
"")))
- (t emacs-version))))
+ (t emacs-version))))
+ (if (stringp gnus-user-agent)
+ gnus-user-agent
+ (concat gnus-v
+ (when emacs-v
+ (concat " " emacs-v))))))
\f
;;;
(gnus-summary-work-articles 1))))
;; Allow user to require confirmation before replying by mail to the
;; author of a news article (or mail message).
- (when (or
+ (when (or
(not (or (gnus-news-group-p gnus-newsgroup-name)
gnus-confirm-treat-mail-like-news))
(not (cond ((stringp gnus-confirm-mail-reply-to-news)
- (string-match gnus-confirm-mail-reply-to-news gnus-newsgroup-name))
+ (string-match gnus-confirm-mail-reply-to-news
+ gnus-newsgroup-name))
((functionp gnus-confirm-mail-reply-to-news)
- (funcall gnus-confirm-mail-reply-to-news))
+ (funcall gnus-confirm-mail-reply-to-news gnus-newsgroup-name))
(t gnus-confirm-mail-reply-to-news)))
(y-or-n-p "Really reply by mail to article author? "))
(let* ((article
(defun gnus-summary-wide-reply-with-original (n)
"Start composing a wide reply mail to the current message.
-The original article will be yanked."
+The original article will be yanked.
+Uses the process/prefix convention."
(interactive "P")
(gnus-summary-reply-with-original n t))
;; This mail group doesn't have a `to-list', so we add one
;; here. Magic!
(when (gnus-y-or-n-p
- (format "Do you want to add this as `to-list': %s " to-address))
+ (format "Do you want to add this as `to-list': %s? " to-address))
(gnus-group-add-parameter group (cons 'to-list to-address))))))
(defun gnus-put-message ()
group (gnus-status-message method))
(sit-for 2))
(when (and group-art
+ ;; FIXME: Should gcc-mark-as-read work when
+ ;; Gnus is not running?
(gnus-alive-p)
(or gnus-gcc-mark-as-read
- gnus-inews-mark-gcc-as-read))
+ (and
+ (boundp 'gnus-inews-mark-gcc-as-read)
+ (symbol-value 'gnus-inews-mark-gcc-as-read))))
(gnus-group-mark-article-read group (cdr group-art)))
(kill-buffer (current-buffer)))))))))
(message-narrow-to-headers)
(let* ((group gnus-outgoing-message-group)
(gcc (cond
- ((gnus-functionp group)
+ ((functionp group)
(funcall group))
((or (stringp group) (list group))
group))))
((and (listp var) (stringp (car var)))
;; A list of groups.
var)
- ((gnus-functionp var)
+ ((functionp var)
;; A function.
(funcall var group))
(t
;; Regexp.
(when (string-match (caar var) group)
(cdar var)))
- ((gnus-functionp (car var))
+ ((functionp (car var))
;; Function.
(funcall (car var) group))
(t
group)))
(if (not (eq gcc-self-val 'none))
(insert "\n")
- (progn
- (beginning-of-line)
- (kill-line))))
+ (gnus-delete-line)))
;; Use the list of groups.
(while (setq name (pop groups))
(let ((str (if (string-match ":" name)
(insert " ")))
(insert "\n")))))))
+(defun gnus-mailing-list-followup-to ()
+ "Look at the headers in the current buffer and return a Mail-Followup-To address."
+ (let ((x-been-there (gnus-fetch-original-field "x-beenthere"))
+ (list-post (gnus-fetch-original-field "list-post")))
+ (when (and list-post
+ (string-match "mailto:\\([^>]+\\)" list-post))
+ (setq list-post (match-string 1 list-post)))
+ (or list-post
+ x-been-there)))
+
;;; Posting styles.
(defun gnus-configure-posting-styles (&optional group-name)
(unless gnus-inhibit-posting-styles
(let ((group (or group-name gnus-newsgroup-name ""))
(styles gnus-posting-styles)
- style match variable attribute value v results
+ style match attribute value v 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
(and header
(string-match (pop style) header))))))
((or (symbolp match)
- (gnus-functionp match))
+ (functionp match))
(cond
- ((gnus-functionp match)
+ ((functionp match)
;; Function to be called.
(funcall match))
((boundp match)
;; We have a match, so we set the variables.
(dolist (attribute style)
(setq element (pop attribute)
- variable nil
filep nil)
(setq value
(cond
((stringp value)
value)
((or (symbolp value)
- (gnus-functionp value))
- (cond ((gnus-functionp value)
+ (functionp value))
+ (cond ((functionp value)
(funcall value))
((boundp value)
(symbol-value value))))
(setq name (assq 'name results)
address (assq 'address results))
(setq results (delq name (delq address results)))
- ;; make-local-hook is not obsolete in Emacs 20 or XEmacs.
- (make-local-hook 'message-setup-hook)
+ (gnus-make-local-hook 'message-setup-hook)
(setq results (sort results (lambda (x y)
(string-lessp (car x) (car y)))))
(dolist (result results)
projects / gnus / blobdiff