[Top][All Lists]
[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Emacs-diffs] Changes to emacs/lisp/gnus/gnus-msg.el [lexbind]
From: |
Miles Bader |
Subject: |
[Emacs-diffs] Changes to emacs/lisp/gnus/gnus-msg.el [lexbind] |
Date: |
Wed, 15 Sep 2004 20:37:37 -0400 |
Index: emacs/lisp/gnus/gnus-msg.el
diff -c emacs/lisp/gnus/gnus-msg.el:1.16.4.2
emacs/lisp/gnus/gnus-msg.el:1.16.4.3
*** emacs/lisp/gnus/gnus-msg.el:1.16.4.2 Tue Oct 14 23:34:50 2003
--- emacs/lisp/gnus/gnus-msg.el Thu Sep 16 00:12:16 2004
***************
*** 1,5 ****
;;; gnus-msg.el --- mail and post interface for Gnus
! ;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000
;; Free Software Foundation, Inc.
;; Author: Masanobu UMEDA <address@hidden>
--- 1,5 ----
;;; gnus-msg.el --- mail and post interface for Gnus
! ;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004
;; Free Software Foundation, Inc.
;; Author: Masanobu UMEDA <address@hidden>
***************
*** 33,38 ****
--- 33,39 ----
(require 'gnus-ems)
(require 'message)
(require 'gnus-art)
+ (require 'gnus-util)
(defcustom gnus-post-method 'current
"*Preferred method for posting USENET news.
***************
*** 54,60 ****
(const current)
(sexp :tag "Methods" ,gnus-select-method)))
! (defvar gnus-outgoing-message-group nil
"*All outgoing messages will be put in this group.
If you want to store all your outgoing mail and articles in the group
\"nnml:archive\", you set this variable to that value. This variable
--- 55,61 ----
(const current)
(sexp :tag "Methods" ,gnus-select-method)))
! (defcustom gnus-outgoing-message-group nil
"*All outgoing messages will be put in this group.
If you want to store all your outgoing mail and articles in the group
\"nnml:archive\", you set this variable to that value. This variable
***************
*** 63,80 ****
If you want to have greater control over what group to put each
message in, you can set this variable to a function that checks the
current newsgroup name and then returns a suitable group name (or list
! of names).")
! (defvar gnus-mailing-list-groups nil
! "*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.")
! (defvar gnus-add-to-list nil
! "*If non-nil, add a `to-list' parameter automatically.")
!
! (defvar gnus-crosspost-complaint
"Hi,
You posted the article below with the following Newsgroups header:
--- 64,89 ----
If you want to have greater control over what group to put each
message in, you can set this variable to a function that checks the
current newsgroup name and then returns a suitable group name (or list
! of names)."
! :group 'gnus-message
! :type '(choice (string :tag "Group")
! (function)))
! (defcustom gnus-mailing-list-groups nil
! "*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 '(choice (regexp)
! (const nil)))
!
! (defcustom gnus-add-to-list nil
! "*If non-nil, add a `to-list' parameter automatically."
! :group 'gnus-message
! :type 'boolean)
! (defcustom gnus-crosspost-complaint
"Hi,
You posted the article below with the following Newsgroups header:
***************
*** 90,111 ****
"
"Format string to be inserted when complaining about crossposts.
The first %s will be replaced by the Newsgroups header;
! 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\\|fr\\)\\.[^,]*\\(,[ \t\n]*\\(no\\|fr\\)\\.[^,]*\\)*$"
iso-8859-1 (iso-8859-1))
("^\\(fido7\\|relcom\\)\\.[^,]*\\(,[
\t\n]*\\(fido7\\|relcom\\)\\.[^,]*\\)*$" koi8-r (koi8-r))
(message-this-is-mail nil nil)
(message-this-is-news nil t))
"Alist of regexps and permitted unencoded charsets for posting.
Each element of the alist has the form (TEST HEADER BODY-LIST), where
TEST is either a regular expression matching the newsgroup header or a
--- 99,177 ----
"
"Format string to be inserted when complaining about crossposts.
The first %s will be replaced by the Newsgroups header;
! the second with the current group name."
! :group 'gnus-message
! :type 'string)
!
! (defcustom gnus-message-setup-hook nil
! "Hook run after setting up a message buffer."
! :group 'gnus-message
! :type 'hook)
!
! (defcustom gnus-bug-create-help-buffer t
! "*Should we create the *Gnus Help Bug* buffer?"
! :group 'gnus-message
! :type 'boolean)
!
! (defcustom gnus-posting-styles nil
! "*Alist of styles to use when posting.
! See Info node `(gnus)Posting Styles'."
! :group 'gnus-message
! :link '(custom-manual "(gnus)Posting Styles")
! :type '(repeat (cons (choice (regexp)
! (variable)
! (list (const header)
! (string :tag "Header")
! (regexp :tag "Regexp"))
! (function)
! (sexp))
! (repeat (list
! (choice (const signature)
! (const signature-file)
! (const organization)
! (const address)
! (const x-face-file)
! (const name)
! (const body)
! (symbol)
! (string :tag "Header"))
! (choice (string)
! (function)
! (variable)
! (sexp)))))))
!
! (defcustom gnus-gcc-mark-as-read nil
! "If non-nil, automatically mark Gcc articles as read."
! :version "21.1"
! :group 'gnus-message
! :type 'boolean)
!
! (make-obsolete-variable 'gnus-inews-mark-gcc-as-read
! 'gnus-gcc-mark-as-read)
!
! (defcustom gnus-gcc-externalize-attachments nil
! "Should local-file attachments be included as external parts in Gcc copies?
! If it is `all', attach files as external parts;
! if a regexp and matches the Gcc group name, attach files as external parts;
! if nil, attach files as normal parts."
! :version "21.1"
! :group 'gnus-message
! :type '(choice (const nil :tag "None")
! (const all :tag "Any")
! (string :tag "Regexp")))
!
! (gnus-define-group-parameter
! posting-charset-alist
! :type list
! :function-document
! "Return the permitted unencoded charsets for posting of GROUP."
! :variable gnus-group-posting-charset-alist
! :variable-default
'(("^\\(no\\|fr\\)\\.[^,]*\\(,[ \t\n]*\\(no\\|fr\\)\\.[^,]*\\)*$"
iso-8859-1 (iso-8859-1))
("^\\(fido7\\|relcom\\)\\.[^,]*\\(,[
\t\n]*\\(fido7\\|relcom\\)\\.[^,]*\\)*$" koi8-r (koi8-r))
(message-this-is-mail nil nil)
(message-this-is-news nil t))
+ :variable-document
"Alist of regexps and permitted unencoded charsets for posting.
Each element of the alist has the form (TEST HEADER BODY-LIST), where
TEST is either a regular expression matching the newsgroup header or a
***************
*** 118,148 ****
Note that any value other than nil for HEADER infringes some RFCs, so
use this option with care."
! :type '(repeat (list :tag "Permitted unencoded charsets"
! (choice :tag "Where"
! (regexp :tag "Group")
! (const :tag "Mail message" :value message-this-is-mail)
! (const :tag "News article" :value message-this-is-news))
! (choice :tag "Header"
! (const :tag "None" nil)
! (symbol :tag "Charset"))
! (choice :tag "Body"
! (const :tag "Any" :value t)
! (const :tag "None" :value nil)
! (repeat :tag "Charsets"
! (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)
(defvar gnus-message-group-art nil)
(defconst gnus-bug-message
"Sending a bug report to the Gnus Towers.
========================================
--- 184,301 ----
Note that any value other than nil for HEADER infringes some RFCs, so
use this option with care."
! :variable-group gnus-charset
! :variable-type
! '(repeat (list :tag "Permitted unencoded charsets"
! (choice :tag "Where"
! (regexp :tag "Group")
! (const :tag "Mail message" :value message-this-is-mail)
! (const :tag "News article" :value message-this-is-news))
! (choice :tag "Header"
! (const :tag "None" nil)
! (symbol :tag "Charset"))
! (choice :tag "Body"
! (const :tag "Any" :value t)
! (const :tag "None" :value nil)
! (repeat :tag "Charsets"
! (symbol :tag "Charset")))))
! :parameter-type '(choice :tag "Permitted unencoded charsets"
! :value nil
! (repeat (symbol)))
! :parameter-document "\
! List of charsets that are permitted to be unencoded.")
!
! (defcustom gnus-debug-files
! '("gnus.el" "gnus-sum.el" "gnus-group.el"
! "gnus-art.el" "gnus-start.el" "gnus-async.el"
! "gnus-msg.el" "gnus-score.el" "gnus-win.el" "gnus-topic.el"
! "gnus-agent.el" "gnus-cache.el" "gnus-srvr.el"
! "mm-util.el" "mm-decode.el" "nnmail.el" "message.el")
! "Files whose variables will be reported in `gnus-bug'."
! :version "21.1"
! :group 'gnus-message
! :type '(repeat (string :tag "File")))
!
! (defcustom gnus-debug-exclude-variables
! '(mm-mime-mule-charset-alist
! nnmail-split-fancy message-minibuffer-local-map)
! "Variables that should not be reported in `gnus-bug'."
! :version "21.1"
! :group 'gnus-message
! :type '(repeat (symbol :tag "Variable")))
!
! (defcustom gnus-discouraged-post-methods
! '(nndraft nnml nnimap nnmaildir nnmh nnfolder nndir)
! "A list of back ends that are not used in \"real\" newsgroups.
! This variable is used only when `gnus-post-method' is `current'."
! :version "21.3"
! :group 'gnus-group-foreign
! :type '(repeat (symbol :tag "Back end")))
!
! (defcustom gnus-message-replysign
! nil
! "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 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 encrypted messages to also be signed."
! :group 'gnus-message
! :type 'boolean)
!
! (defcustom gnus-confirm-mail-reply-to-news nil
! "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 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" t)
! (regexp :tag "Iff group matches regexp")
! (function :tag "Iff function evaluates to non-nil")))
!
! (defcustom gnus-confirm-treat-mail-like-news
! nil
! "If non-nil, Gnus will treat mail like news with regard to confirmation
! when replying by mail. See the `gnus-confirm-mail-reply-to-news' variable
! for fine-tuning this.
! If nil, Gnus will never ask for confirmation if replying to mail."
! :group 'gnus-message
! :type 'boolean)
!
! (defcustom gnus-summary-resend-default-address t
! "If non-nil, Gnus tries to suggest a default address to resend to.
! If nil, the address field will always be empty after invoking
! `gnus-summary-resend-message'."
! :group 'gnus-message
! :type 'boolean)
;;; Internal variables.
(defvar gnus-inhibit-posting-styles nil
"Inhibit the use of posting styles.")
+ (defvar gnus-article-yanked-articles nil)
(defvar gnus-message-buffer "*Mail Gnus*")
(defvar gnus-article-copy nil)
+ (defvar gnus-check-before-posting nil)
(defvar gnus-last-posting-server nil)
(defvar gnus-message-group-art nil)
+ (defvar gnus-msg-force-broken-reply-to nil)
+
(defconst gnus-bug-message
"Sending a bug report to the Gnus Towers.
========================================
***************
*** 166,171 ****
--- 319,326 ----
(eval-and-compile
(autoload 'gnus-uu-post-news "gnus-uu" nil t)
+ (autoload 'news-setup "rnewspost")
+ (autoload 'news-reply-mode "rnewspost")
(autoload 'rmail-dont-reply-to "mail-utils")
(autoload 'rmail-output "rmailout"))
***************
*** 176,181 ****
--- 331,337 ----
(gnus-define-keys (gnus-summary-send-map "S" gnus-summary-mode-map)
"p" gnus-summary-post-news
+ "i" gnus-summary-news-other-window
"f" gnus-summary-followup
"F" gnus-summary-followup-with-original
"c" gnus-summary-cancel-article
***************
*** 185,195 ****
--- 341,355 ----
"R" gnus-summary-reply-with-original
"w" gnus-summary-wide-reply
"W" gnus-summary-wide-reply-with-original
+ "v" gnus-summary-very-wide-reply
+ "V" gnus-summary-very-wide-reply-with-original
"n" gnus-summary-followup-to-mail
"N" gnus-summary-followup-to-mail-with-original
"m" gnus-summary-mail-other-window
"u" gnus-uu-post-news
"\M-c" gnus-summary-mail-crosspost-complaint
+ "Br" gnus-summary-reply-broken-reply-to
+ "BR" gnus-summary-reply-broken-reply-to-with-original
"om" gnus-summary-mail-forward
"op" gnus-summary-post-forward
"Om" gnus-uu-digest-mail-forward
***************
*** 198,216 ****
(gnus-define-keys (gnus-send-bounce-map "D" gnus-summary-send-map)
"b" gnus-summary-resend-bounced-mail
;; "c" gnus-summary-send-draft
! "r" gnus-summary-resend-message)
;;; Internal functions.
(defvar gnus-article-reply nil)
(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"))
(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))
--- 358,384 ----
(gnus-define-keys (gnus-send-bounce-map "D" gnus-summary-send-map)
"b" gnus-summary-resend-bounced-mail
;; "c" gnus-summary-send-draft
! "r" gnus-summary-resend-message
! "e" gnus-summary-resend-message-edit)
;;; Internal functions.
+ (defun gnus-inews-make-draft ()
+ `(lambda ()
+ (gnus-inews-make-draft-meta-information
+ ,gnus-newsgroup-name ',gnus-article-reply)))
+
(defvar gnus-article-reply nil)
(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"))
+ (yanked (make-symbol "gnus-setup-yanked-articles"))
(group (make-symbol "gnus-setup-message-group")))
`(let ((,winconf (current-window-configuration))
(,buffer (buffer-name (current-buffer)))
! (,article gnus-article-reply)
! (,yanked gnus-article-yanked-articles)
(,group gnus-newsgroup-name)
(message-header-setup-hook
(copy-sequence message-header-setup-hook))
***************
*** 219,229 ****
(setq mml-buffer-list nil)
(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 ,group ,article))
--- 387,420 ----
(setq mml-buffer-list nil)
(add-hook 'message-header-setup-hook 'gnus-inews-insert-gcc)
(add-hook 'message-header-setup-hook 'gnus-inews-insert-archive-gcc)
! ;; #### FIXME: for a reason that I did not manage to identify yet,
! ;; the variable `gnus-newsgroup-name' does not honor a dynamically
! ;; scoped or setq'ed value from a caller like `C-u gnus-summary-mail'.
! ;; After evaluation of @forms below, it gets the value we actually want
! ;; to override, and the posting styles are used. For that reason, I've
! ;; added an optional argument to `gnus-configure-posting-styles' to
! ;; make sure that the correct value for the group name is used. -- drv
! (add-hook 'message-mode-hook
! (if (memq ,config '(reply-yank reply))
! (lambda ()
! (gnus-configure-posting-styles ,group))
! (lambda ()
! ;; There may be an old " *gnus article copy*" buffer.
! (let (gnus-article-copy)
! (gnus-configure-posting-styles ,group)))))
! (gnus-pull ',(intern gnus-draft-meta-information-header)
! message-required-headers)
! (when (and ,group
! (not (string= ,group "")))
! (push (cons
! (intern gnus-draft-meta-information-header)
! (gnus-inews-make-draft))
! message-required-headers))
(unwind-protect
(progn
,@forms)
! (gnus-inews-add-send-actions ,winconf ,buffer ,article ,config
! ,yanked)
(setq gnus-message-buffer (current-buffer))
(set (make-local-variable 'gnus-message-group-art)
(cons ,group ,article))
***************
*** 233,261 ****
(let ((mbl1 mml-buffer-list))
(setq mml-buffer-list mbl) ;; Global value
(set (make-local-variable 'mml-buffer-list) mbl1);; Local value
(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)))
(gnus-add-buffer)
(gnus-configure-windows ,config t)
(set-buffer-modified-p nil))))
;;;###autoload
! (defun gnus-msg-mail (&rest args)
"Start editing a mail message to be sent.
Like `message-mail', but with Gnus paraphernalia, particularly the
Gcc: header for archiving purposes."
(interactive)
! (gnus-setup-message 'message
! (apply 'message-mail args))
;; COMPOSEFUNC should return t if succeed. Undocumented ???
t)
;;;###autoload
(define-mail-user-agent 'gnus-user-agent
! 'gnus-msg-mail 'message-send-and-exit
! 'message-kill-buffer 'message-send-hook)
(defun gnus-setup-posting-charset (group)
(let ((alist gnus-group-posting-charset-alist)
--- 424,494 ----
(let ((mbl1 mml-buffer-list))
(setq mml-buffer-list mbl) ;; Global value
(set (make-local-variable 'mml-buffer-list) mbl1);; Local value
+ (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)
(set-buffer-modified-p nil))))
+ (defun gnus-inews-make-draft-meta-information (group article)
+ (concat "(\"" group "\" "
+ (if article (number-to-string
+ (if (listp article)
+ (car article)
+ article)) "\"\"")
+ ")"))
+
;;;###autoload
! (defun gnus-msg-mail (&optional to subject other-headers continue
! switch-action yank-action send-actions)
"Start editing a mail message to be sent.
Like `message-mail', but with Gnus paraphernalia, particularly the
Gcc: header for archiving purposes."
(interactive)
! (let ((buf (current-buffer))
! mail-buf)
! (gnus-setup-message 'message
! (message-mail to subject other-headers continue
! nil yank-action send-actions))
! (when switch-action
! (setq mail-buf (current-buffer))
! (switch-to-buffer buf)
! (apply switch-action mail-buf nil)))
;; COMPOSEFUNC should return t if succeed. Undocumented ???
t)
+ (defvar save-selected-window-window)
+
+ ;;;###autoload
+ (defun gnus-button-mailto (address)
+ "Mail to ADDRESS."
+ (set-buffer (gnus-copy-article-buffer))
+ (gnus-setup-message 'message
+ (message-reply address))
+ (and (boundp 'save-selected-window-window)
+ (not (window-live-p save-selected-window-window))
+ (setq save-selected-window-window (selected-window))))
+
+ ;;;###autoload
+ (defun gnus-button-reply (&optional to-address wide)
+ "Like `message-reply'."
+ (interactive)
+ (gnus-setup-message 'message
+ (message-reply to-address wide))
+ (and (boundp 'save-selected-window-window)
+ (not (window-live-p save-selected-window-window))
+ (setq save-selected-window-window (selected-window))))
+
;;;###autoload
(define-mail-user-agent 'gnus-user-agent
! 'gnus-msg-mail 'message-send-and-exit
! 'message-kill-buffer 'message-send-hook)
(defun gnus-setup-posting-charset (group)
(let ((alist gnus-group-posting-charset-alist)
***************
*** 266,297 ****
(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 (cons (cadr elem) (caddr elem)))))))))
! (defun gnus-inews-add-send-actions (winconf buffer article)
! (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)
(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
! `(gnus-summary-mark-article-as-replied ,article))))
! 'send))
(put 'gnus-setup-message 'lisp-indent-function 1)
(put 'gnus-setup-message 'edebug-form-spec '(form body))
--- 499,541 ----
(while (setq elem (pop alist))
(when (or (and (stringp (car elem))
(string-match (car elem) group))
! (and (functionp (car elem))
(funcall (car elem) group))
(and (symbolp (car elem))
(symbol-value (car elem))))
(throw 'found (cons (cadr elem) (caddr elem)))))))))
! (defun gnus-inews-add-send-actions (winconf buffer article
! &optional config yanked)
! (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
! (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
`(when (gnus-buffer-exists-p ,buffer)
! (set-window-configuration ,winconf))
! 'exit 'postpone 'kill)
! (let ((to-be-marked (cond
! (yanked
! (mapcar
! (lambda (x) (if (listp x) (car x) x)) 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))
***************
*** 306,311 ****
--- 550,557 ----
;; We can't `let' gnus-newsgroup-name here, since that leads
;; to local variables leaking.
(let ((group gnus-newsgroup-name)
+ ;; make sure last viewed article doesn't affect posting styles:
+ (gnus-article-copy)
(buffer (current-buffer)))
(unwind-protect
(progn
***************
*** 317,331 ****
(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.
! If ARG, post to the group under point.
! If ARG is 1, prompt for a group name."
(interactive "P")
;; Bind this variable here to make message mode hooks work ok.
(let ((gnus-newsgroup-name
--- 563,611 ----
(gnus-read-active-file-p))
(gnus-group-group-name))
""))
+ ;; #### see comment in gnus-setup-message -- drv
(gnus-setup-message 'message (message-mail)))
(save-excursion
(set-buffer buffer)
(setq gnus-newsgroup-name group)))))
+ (defun gnus-group-news (&optional arg)
+ "Start composing a news.
+ If ARG, post to group under point.
+ If ARG is 1, prompt for group name to post to.
+
+ 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 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.
+ (let ((group gnus-newsgroup-name)
+ ;; make sure last viewed article doesn't affect posting styles:
+ (gnus-article-copy)
+ (buffer (current-buffer)))
+ (unwind-protect
+ (progn
+ (setq gnus-newsgroup-name
+ (if arg
+ (if (= 1 (prefix-numeric-value arg))
+ (completing-read "Use group: "
+ gnus-active-hashtb nil
+ (gnus-read-active-file-p))
+ (gnus-group-group-name))
+ ""))
+ ;; #### see comment in gnus-setup-message -- drv
+ (gnus-setup-message 'message
+ (message-news (gnus-group-real-name gnus-newsgroup-name))))
+ (save-excursion
+ (set-buffer buffer)
+ (setq gnus-newsgroup-name group)))))
+
(defun gnus-group-post-news (&optional arg)
! "Start composing a message (a news by default).
! If ARG, post to group under point. If ARG is 1, prompt for group name.
! Depending on the selected group, the message might be either a mail or
! a news."
(interactive "P")
;; Bind this variable here to make message mode hooks work ok.
(let ((gnus-newsgroup-name
***************
*** 334,355 ****
(completing-read "Newsgroup: " gnus-active-hashtb nil
(gnus-read-active-file-p))
(gnus-group-group-name))
! "")))
(gnus-post-news 'post gnus-newsgroup-name)))
- (defun gnus-summary-post-news ()
- "Start composing a news message."
- (interactive)
- (gnus-post-news 'post gnus-newsgroup-name))
(defun gnus-summary-followup (yank &optional force-news)
"Compose a followup to an article.
! If prefix argument YANK is non-nil, original article is yanked automatically."
(interactive
(list (and current-prefix-arg
(gnus-summary-work-articles 1))))
(when yank
! (gnus-summary-goto-subject (car yank)))
(save-window-excursion
(gnus-summary-select-article))
(let ((headers (gnus-summary-article-header (gnus-summary-article-number)))
--- 614,723 ----
(completing-read "Newsgroup: " gnus-active-hashtb nil
(gnus-read-active-file-p))
(gnus-group-group-name))
! ""))
! ;; make sure last viewed article doesn't affect posting styles:
! (gnus-article-copy))
! (gnus-post-news 'post gnus-newsgroup-name nil nil nil nil
! (string= gnus-newsgroup-name ""))))
!
! (defun gnus-summary-mail-other-window (&optional arg)
! "Start composing a mail in another window.
! Use the posting of the current group by default.
! If ARG, don't do that. If ARG is 1, prompt for 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)
! ;; make sure last viewed article doesn't affect posting styles:
! (gnus-article-copy)
! (buffer (current-buffer)))
! (unwind-protect
! (progn
! (setq gnus-newsgroup-name
! (if arg
! (if (= 1 (prefix-numeric-value arg))
! (completing-read "Use group: "
! gnus-active-hashtb nil
! (gnus-read-active-file-p))
! "")
! gnus-newsgroup-name))
! ;; #### see comment in gnus-setup-message -- drv
! (gnus-setup-message 'message (message-mail)))
! (save-excursion
! (set-buffer buffer)
! (setq gnus-newsgroup-name group)))))
!
! (defun gnus-summary-news-other-window (&optional arg)
! "Start composing a news in another window.
! Post to the current group by default.
! If ARG, don't do that. If ARG is 1, prompt for group name to post to.
!
! 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 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.
! (let ((group gnus-newsgroup-name)
! ;; make sure last viewed article doesn't affect posting styles:
! (gnus-article-copy)
! (buffer (current-buffer)))
! (unwind-protect
! (progn
! (setq gnus-newsgroup-name
! (if arg
! (if (= 1 (prefix-numeric-value arg))
! (completing-read "Use group: "
! gnus-active-hashtb nil
! (gnus-read-active-file-p))
! "")
! gnus-newsgroup-name))
! ;; #### see comment in gnus-setup-message -- drv
! (gnus-setup-message 'message
! (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)))))
!
! (defun gnus-summary-post-news (&optional arg)
! "Start composing a message. Post to the current group by default.
! If ARG, don't do that. If ARG is 1, prompt for a group name to post to.
! Depending on the selected group, the message might be either a mail or
! a news."
! (interactive "P")
! ;; Bind this variable here to make message mode hooks work ok.
! (let ((gnus-newsgroup-name
! (if arg
! (if (= 1 (prefix-numeric-value arg))
! (completing-read "Newsgroup: " gnus-active-hashtb nil
! (gnus-read-active-file-p))
! "")
! gnus-newsgroup-name))
! ;; make sure last viewed article doesn't affect posting styles:
! (gnus-article-copy))
(gnus-post-news 'post gnus-newsgroup-name)))
(defun gnus-summary-followup (yank &optional force-news)
"Compose a followup to an article.
! If prefix argument YANK is non-nil, the original article is yanked
! automatically.
! YANK is a list of elements, where the car of each element is the
! article number, and the cdr is the string to be yanked."
(interactive
(list (and current-prefix-arg
(gnus-summary-work-articles 1))))
(when yank
! (gnus-summary-goto-subject
! (if (listp (car yank))
! (caar yank)
! (car yank))))
(save-window-excursion
(gnus-summary-select-article))
(let ((headers (gnus-summary-article-header (gnus-summary-article-number)))
***************
*** 357,366 ****
;; Send a followup.
(gnus-post-news nil gnus-newsgroup-name
headers gnus-article-buffer
! yank nil force-news)))
(defun gnus-summary-followup-with-original (n &optional force-news)
! "Compose a followup to an article and include the original article."
(interactive "P")
(gnus-summary-followup (gnus-summary-work-articles n) force-news))
--- 725,737 ----
;; Send a followup.
(gnus-post-news nil gnus-newsgroup-name
headers gnus-article-buffer
! yank nil force-news)
! (gnus-summary-handle-replysign)))
(defun gnus-summary-followup-with-original (n &optional force-news)
! "Compose a followup to an article and include the original article.
! The text in the region will be yanked. If the region isn't
! active, the entire article will be yanked."
(interactive "P")
(gnus-summary-followup (gnus-summary-work-articles n) force-news))
***************
*** 377,392 ****
(gnus-summary-followup (gnus-summary-work-articles arg) t))
(defun gnus-inews-yank-articles (articles)
! (let (beg article)
(message-goto-body)
(while (setq article (pop articles))
(save-window-excursion
(set-buffer gnus-summary-buffer)
(gnus-summary-select-article nil nil nil article)
(gnus-summary-remove-process-mark article))
! (gnus-copy-article-buffer)
(let ((message-reply-buffer gnus-article-copy)
! (message-reply-headers gnus-current-headers))
(message-yank-original)
(setq beg (or beg (mark t))))
(when articles
--- 748,771 ----
(gnus-summary-followup (gnus-summary-work-articles arg) t))
(defun gnus-inews-yank-articles (articles)
! (let (beg article yank-string)
(message-goto-body)
(while (setq article (pop articles))
+ (when (listp article)
+ (setq yank-string (nth 1 article)
+ article (nth 0 article)))
(save-window-excursion
(set-buffer gnus-summary-buffer)
(gnus-summary-select-article nil nil nil article)
(gnus-summary-remove-process-mark article))
! (gnus-copy-article-buffer nil yank-string)
(let ((message-reply-buffer gnus-article-copy)
! (message-reply-headers
! ;; The headers are decoded.
! (with-current-buffer gnus-article-copy
! (save-restriction
! (nnheader-narrow-to-headers)
! (nnheader-parse-naked-head)))))
(message-yank-original)
(setq beg (or beg (mark t))))
(when articles
***************
*** 403,409 ****
(let ((articles (gnus-summary-work-articles n))
(message-post-method
`(lambda (arg)
! (gnus-post-method (not (eq symp 'a)) ,gnus-newsgroup-name)))
article)
(while (setq article (pop articles))
(when (gnus-summary-select-article t nil nil article)
--- 782,788 ----
(let ((articles (gnus-summary-work-articles n))
(message-post-method
`(lambda (arg)
! (gnus-post-method (eq ',symp 'a) ,gnus-newsgroup-name)))
article)
(while (setq article (pop articles))
(when (gnus-summary-select-article t nil nil article)
***************
*** 435,441 ****
! (defun gnus-copy-article-buffer (&optional article-buffer)
;; make a copy of the article buffer with all text properties removed
;; this copy is in the buffer gnus-article-copy.
;; if ARTICLE-BUFFER is nil, gnus-article-buffer is used
--- 814,820 ----
! (defun gnus-copy-article-buffer (&optional article-buffer yank-string)
;; make a copy of the article buffer with all text properties removed
;; this copy is in the buffer gnus-article-copy.
;; if ARTICLE-BUFFER is nil, gnus-article-buffer is used
***************
*** 451,490 ****
(error "Can't find any article buffer")
(save-excursion
(set-buffer article-buffer)
! (save-restriction
! ;; Copy over the (displayed) article buffer, delete
! ;; hidden text and remove text properties.
! (widen)
! (copy-to-buffer gnus-article-copy (point-min) (point-max))
! (set-buffer gnus-article-copy)
! (gnus-article-delete-text-of-type 'annotation)
! (gnus-remove-text-with-property 'gnus-prev)
! (gnus-remove-text-with-property 'gnus-next)
! (insert
! (prog1
! (buffer-substring-no-properties (point-min) (point-max))
! (erase-buffer)))
! ;; Find the original headers.
! (set-buffer gnus-original-article-buffer)
! (goto-char (point-min))
! (while (looking-at message-unix-mail-delimiter)
! (forward-line 1))
! (setq beg (point))
! (setq end (or (search-forward "\n\n" nil t) (point)))
! ;; 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-max)))
! ;; Insert the original article headers.
! (insert-buffer-substring gnus-original-article-buffer beg end)
! (article-decode-encoded-words)))
gnus-article-copy)))
(defun gnus-post-news (post &optional group header article-buffer yank subject
force-news)
(when article-buffer
(gnus-copy-article-buffer))
! (let ((gnus-article-reply article-buffer)
(add-to-list gnus-add-to-list))
(gnus-setup-message (cond (yank 'reply-yank)
(article-buffer 'reply)
--- 830,888 ----
(error "Can't find any article buffer")
(save-excursion
(set-buffer article-buffer)
! (let ((gnus-newsgroup-charset (or gnus-article-charset
! gnus-newsgroup-charset))
! (gnus-newsgroup-ignored-charsets
! (or gnus-article-ignored-charsets
! gnus-newsgroup-ignored-charsets)))
! (save-restriction
! ;; Copy over the (displayed) article buffer, delete
! ;; hidden text and remove text properties.
! (widen)
! (copy-to-buffer gnus-article-copy (point-min) (point-max))
! (set-buffer gnus-article-copy)
! (when yank-string
! (message-goto-body)
! (delete-region (point) (point-max))
! (insert yank-string))
! (gnus-article-delete-text-of-type 'annotation)
! (gnus-remove-text-with-property 'gnus-prev)
! (gnus-remove-text-with-property 'gnus-next)
! (gnus-remove-text-with-property 'gnus-decoration)
! (insert
! (prog1
! (buffer-substring-no-properties (point-min) (point-max))
! (erase-buffer)))
! ;; Find the original headers.
! (set-buffer gnus-original-article-buffer)
! (goto-char (point-min))
! (while (looking-at message-unix-mail-delimiter)
! (forward-line 1))
! (let ((mail-header-separator ""))
! (setq beg (point)
! 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 ""))
! (delete-region (goto-char (point-min))
! (or (message-goto-body) (point-max))))
! ;; Insert the original article headers.
! (insert-buffer-substring gnus-original-article-buffer beg end)
! ;; Decode charsets.
! (let ((gnus-article-decode-hook
! (delq 'article-decode-charset
! (copy-sequence gnus-article-decode-hook))))
! (run-hooks 'gnus-article-decode-hook)))))
gnus-article-copy)))
(defun gnus-post-news (post &optional group header article-buffer yank subject
force-news)
(when article-buffer
(gnus-copy-article-buffer))
! (let ((gnus-article-reply (and article-buffer
(gnus-summary-article-number)))
! (gnus-article-yanked-articles yank)
(add-to-list gnus-add-to-list))
(gnus-setup-message (cond (yank 'reply-yank)
(article-buffer 'reply)
***************
*** 495,503 ****
to-address to-group mailing-list to-list
newsgroup-p)
(when group
! (setq to-address (gnus-group-find-parameter group 'to-address)
to-group (gnus-group-find-parameter group 'to-group)
! to-list (gnus-group-find-parameter group 'to-list)
newsgroup-p (gnus-group-find-parameter group 'newsgroup)
mailing-list (when gnus-mailing-list-groups
(string-match gnus-mailing-list-groups group))
--- 893,901 ----
to-address to-group mailing-list to-list
newsgroup-p)
(when group
! (setq to-address (gnus-parameter-to-address group)
to-group (gnus-group-find-parameter group 'to-group)
! to-list (gnus-parameter-to-list group)
newsgroup-p (gnus-group-find-parameter group 'newsgroup)
mailing-list (when gnus-mailing-list-groups
(string-match gnus-mailing-list-groups group))
***************
*** 509,516 ****
force-news
(and (gnus-news-group-p
(or pgroup gnus-newsgroup-name)
! (if header (mail-header-number header)
! gnus-current-article))
(not mailing-list)
(not to-list)
(not to-address)))
--- 907,913 ----
force-news
(and (gnus-news-group-p
(or pgroup gnus-newsgroup-name)
! (or header gnus-current-article))
(not mailing-list)
(not to-list)
(not to-address)))
***************
*** 519,525 ****
(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
(progn
--- 916,928 ----
(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)
! (if (save-restriction
! (article-narrow-to-head)
! (message-fetch-field "newsgroups"))
! nil
! "")
! to-group)))
;; The is mail.
(if post
(progn
***************
*** 537,546 ****
(when yank
(gnus-inews-yank-articles yank))))))
! (defun gnus-msg-treat-broken-reply-to ()
"Remove the Reply-to header if 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"))))
--- 940,950 ----
(when yank
(gnus-inews-yank-articles yank))))))
! (defun gnus-msg-treat-broken-reply-to (&optional force)
"Remove the Reply-to header if broken-reply-to."
! (when (or force
! (gnus-group-find-parameter
! gnus-newsgroup-name 'broken-reply-to))
(save-restriction
(message-narrow-to-head)
(message-remove-header "reply-to"))))
***************
*** 548,575 ****
(defun gnus-post-method (arg group &optional silent)
"Return the posting method based on GROUP and ARG.
If SILENT, don't prompt the user."
! (let ((group-method (gnus-find-method-for-group group)))
(cond
;; If the group-method is nil (which shouldn't happen) we use
;; the default method.
((null group-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)))
! (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 (and gnus-post-method
! (not (eq gnus-post-method 'current)))
(if (listp (car gnus-post-method))
gnus-post-method
(list gnus-post-method)))
--- 952,982 ----
(defun gnus-post-method (arg group &optional silent)
"Return the posting method based on GROUP and ARG.
If SILENT, don't prompt the user."
! (let ((gnus-post-method (or (gnus-parameter-post-method group)
! gnus-post-method))
! (group-method (gnus-find-method-for-group group)))
(cond
;; If the group-method is nil (which shouldn't happen) we use
;; the default method.
((null group-method)
! (or (and (listp gnus-post-method) ;If not current/native/nil
! (not (listp (car gnus-post-method))) ; and not a list of methods
! gnus-post-method) ;then use it.
! gnus-select-method
! message-post-method))
;; We want the inverse of the default
((and arg (not (eq arg 0)))
! (if (eq gnus-post-method 'current)
gnus-select-method
group-method))
;; We query the user for a post method.
((or arg
! (and (listp gnus-post-method)
(listp (car gnus-post-method))))
(let* ((methods
;; Collect all methods we know about.
(append
! (when (listp gnus-post-method)
(if (listp (car gnus-post-method))
gnus-post-method
(list gnus-post-method)))
***************
*** 590,596 ****
(setq method-alist
(mapcar
(lambda (m)
! (list (concat (cadr m) " (" (symbol-name (car m)) ")") m))
post-methods))
;; Query the user.
(cadr
--- 997,1005 ----
(setq method-alist
(mapcar
(lambda (m)
! (if (equal (cadr m) "")
! (list (symbol-name (car m)) m)
! (list (concat (cadr m) " (" (symbol-name (car m)) ")") m)))
post-methods))
;; Query the user.
(cadr
***************
*** 606,649 ****
method-alist))))
;; Override normal method.
((and (eq gnus-post-method 'current)
! (not (eq (car group-method) 'nndraft))
! (gnus-get-function group-method 'request-post t)
! (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))))
- ;; Dummies to avoid byte-compile warning.
- (eval-when-compile
- (defvar nnspool-rejected-article-hook)
- (defvar xemacs-codename))
-
(defun gnus-extended-version ()
! "Stringified Gnus version and Emacs version."
(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)))
! ((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))))
;;;
--- 1015,1048 ----
method-alist))))
;; Override normal method.
((and (eq gnus-post-method 'current)
! (not (memq (car group-method) gnus-discouraged-post-methods))
! (gnus-get-function group-method 'request-post t))
! (assert (not arg))
group-method)
! ;; Use gnus-post-method.
! ((listp gnus-post-method) ;A method...
! (assert (not (listp (car gnus-post-method)))) ;... not a list of
methods.
gnus-post-method)
! ;; Use the normal select method (nil or native).
(t gnus-select-method))))
(defun gnus-extended-version ()
! "Stringified Gnus version and Emacs version.
! See the variable `gnus-user-agent'."
(interactive)
! (let* ((float-output-format nil)
! (gnus-v
! (concat "Gnus/"
! (prin1-to-string (gnus-continuum-version gnus-version) t)
! " (" gnus-version ")"))
! (emacs-v (gnus-emacs-version)))
! (if (stringp gnus-user-agent)
! gnus-user-agent
! (concat gnus-v
! (when emacs-v
! (concat " " emacs-v))))))
;;;
***************
*** 652,679 ****
;;; Mail reply commands of Gnus summary mode
! (defun gnus-summary-reply (&optional yank wide)
! "Start composing a reply mail to the current message.
If prefix argument YANK is non-nil, the original article is yanked
! automatically."
(interactive
(list (and current-prefix-arg
(gnus-summary-work-articles 1))))
! ;; Stripping headers should be specified with mail-yank-ignored-headers.
! (when yank
! (gnus-summary-goto-subject (car yank)))
! (let ((gnus-article-reply t))
! (gnus-setup-message (if yank 'reply-yank 'reply)
! (gnus-summary-select-article)
! (set-buffer (gnus-copy-article-buffer))
! (gnus-msg-treat-broken-reply-to)
! (save-restriction
! (message-narrow-to-head)
! (goto-char (point-max)))
! (mml-quote-region (point) (point-max))
! (message-reply nil wide)
(when yank
! (gnus-inews-yank-articles yank)))))
(defun gnus-summary-reply-with-original (n &optional wide)
"Start composing a reply mail to the current message.
--- 1051,1127 ----
;;; Mail reply commands of Gnus summary mode
! (defun gnus-summary-reply (&optional yank wide very-wide)
! "Start composing a mail reply to the current message.
If prefix argument YANK is non-nil, the original article is yanked
! automatically.
! If WIDE, make a wide reply.
! If VERY-WIDE, make a very wide reply."
(interactive
(list (and current-prefix-arg
(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
! (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))
! ((functionp 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
! (if (listp (car yank))
! (caar yank)
! (car yank)))
! (gnus-article-reply (or article (gnus-summary-article-number)))
! (gnus-article-yanked-articles yank)
! (headers ""))
! ;; Stripping headers should be specified with mail-yank-ignored-headers.
(when yank
! (gnus-summary-goto-subject article))
! (gnus-setup-message (if yank 'reply-yank 'reply)
! (if (not very-wide)
! (gnus-summary-select-article)
! (dolist (article very-wide)
! (gnus-summary-select-article nil nil nil article)
! (save-excursion
! (set-buffer (gnus-copy-article-buffer))
! (gnus-msg-treat-broken-reply-to)
! (save-restriction
! (message-narrow-to-head)
! (setq headers (concat headers (buffer-string)))))))
! (set-buffer (gnus-copy-article-buffer))
! (gnus-msg-treat-broken-reply-to gnus-msg-force-broken-reply-to)
! (save-restriction
! (message-narrow-to-head)
! (when very-wide
! (erase-buffer)
! (insert headers))
! (goto-char (point-max)))
! (mml-quote-region (point) (point-max))
! (message-reply nil wide)
! (when yank
! (gnus-inews-yank-articles yank))
! (gnus-summary-handle-replysign)))))
!
! (defun gnus-summary-handle-replysign ()
! "Check the various replysign variables and take action accordingly."
! (when (or gnus-message-replysign gnus-message-replyencrypt)
! (let (signed encrypted)
! (save-excursion
! (set-buffer gnus-article-buffer)
! (setq signed (memq 'signed gnus-article-wash-types))
! (setq encrypted (memq 'encrypted gnus-article-wash-types)))
! (cond ((and gnus-message-replyencrypt encrypted)
! (mml-secure-message mml-default-encrypt-method
! (if gnus-message-replysignencrypted
! 'signencrypt
! 'encrypt)))
! ((and gnus-message-replysign signed)
! (mml-secure-message mml-default-sign-method 'sign))))))
(defun gnus-summary-reply-with-original (n &optional wide)
"Start composing a reply mail to the current message.
***************
*** 681,686 ****
--- 1129,1152 ----
(interactive "P")
(gnus-summary-reply (gnus-summary-work-articles n) wide))
+ (defun gnus-summary-reply-broken-reply-to (&optional yank wide very-wide)
+ "Like `gnus-summary-reply' except removing reply-to field.
+ If prefix argument YANK is non-nil, the original article is yanked
+ automatically.
+ If WIDE, make a wide reply.
+ If VERY-WIDE, make a very wide reply."
+ (interactive
+ (list (and current-prefix-arg
+ (gnus-summary-work-articles 1))))
+ (let ((gnus-msg-force-broken-reply-to t))
+ (gnus-summary-reply yank wide very-wide)))
+
+ (defun gnus-summary-reply-broken-reply-to-with-original (n &optional wide)
+ "Like `gnus-summary-reply-with-original' except removing reply-to field.
+ The original article will be yanked."
+ (interactive "P")
+ (gnus-summary-reply-broken-reply-to (gnus-summary-work-articles n) wide))
+
(defun gnus-summary-wide-reply (&optional yank)
"Start composing a wide reply mail to the current message.
If prefix argument YANK is non-nil, the original article is yanked
***************
*** 692,741 ****
(defun gnus-summary-wide-reply-with-original (n)
"Start composing a wide reply mail to the current message.
! The original article will be yanked."
(interactive "P")
(gnus-summary-reply-with-original n t))
(defun gnus-summary-mail-forward (&optional arg post)
! "Forward the current message to another user.
! If ARG is nil, see `message-forward-as-mime' and `message-forward-show-mml';
if ARG is 1, decode the message and forward directly inline;
if ARG is 2, forward message as an rfc822 MIME section;
if ARG is 3, decode message and forward as an rfc822 MIME section;
if ARG is 4, forward message directly inline;
otherwise, use flipped `message-forward-as-mime'.
! If POST, post instead of mail."
(interactive "P")
! (let ((message-forward-as-mime message-forward-as-mime)
! (message-forward-show-mml message-forward-show-mml))
! (cond
! ((null arg))
! ((eq arg 1) (setq message-forward-as-mime nil
! message-forward-show-mml t))
! ((eq arg 2) (setq message-forward-as-mime t
! message-forward-show-mml nil))
! ((eq arg 3) (setq message-forward-as-mime t
! message-forward-show-mml t))
! ((eq arg 4) (setq message-forward-as-mime nil
! message-forward-show-mml nil))
! (t (setq message-forward-as-mime (not message-forward-as-mime))))
! (gnus-setup-message 'forward
! (gnus-summary-select-article)
! (let ((mail-parse-charset gnus-newsgroup-charset)
! (mail-parse-ignored-charsets gnus-newsgroup-ignored-charsets))
! (set-buffer gnus-original-article-buffer)
! (message-forward post)))))
(defun gnus-summary-resend-message (address n)
"Resend the current article to ADDRESS."
! (interactive "sResend message(s) to: \nP")
(let ((articles (gnus-summary-work-articles n))
article)
(while (setq article (pop articles))
(gnus-summary-select-article nil nil nil article)
(save-excursion
(set-buffer gnus-original-article-buffer)
! (message-resend address)))))
(defun gnus-summary-post-forward (&optional arg)
"Forward the current article to a newsgroup.
--- 1158,1283 ----
(defun gnus-summary-wide-reply-with-original (n)
"Start composing a wide reply mail to the current message.
! The original article will be yanked.
! Uses the process/prefix convention."
(interactive "P")
(gnus-summary-reply-with-original n t))
+ (defun gnus-summary-very-wide-reply (&optional yank)
+ "Start composing a very wide reply mail to the current message.
+ If prefix argument YANK is non-nil, the original article is yanked
+ automatically."
+ (interactive
+ (list (and current-prefix-arg
+ (gnus-summary-work-articles 1))))
+ (gnus-summary-reply yank t (gnus-summary-work-articles yank)))
+
+ (defun gnus-summary-very-wide-reply-with-original (n)
+ "Start composing a very wide reply mail to the current message.
+ The original article will be yanked."
+ (interactive "P")
+ (gnus-summary-reply
+ (gnus-summary-work-articles n) t (gnus-summary-work-articles n)))
+
(defun gnus-summary-mail-forward (&optional arg post)
! "Forward the current message(s) to another user.
! If process marks exist, forward all marked messages;
! if ARG is nil, see `message-forward-as-mime' and `message-forward-show-mml';
if ARG is 1, decode the message and forward directly inline;
if ARG is 2, forward message as an rfc822 MIME section;
if ARG is 3, decode message and forward as an rfc822 MIME section;
if ARG is 4, forward message directly inline;
otherwise, use flipped `message-forward-as-mime'.
! If POST, post instead of mail.
! For the `inline' alternatives, also see the variable
! `message-forward-ignored-headers'."
(interactive "P")
! (if (cdr (gnus-summary-work-articles nil))
! ;; Process marks are given.
! (gnus-uu-digest-mail-forward arg post)
! ;; No process marks.
! (let ((message-forward-as-mime message-forward-as-mime)
! (message-forward-show-mml message-forward-show-mml))
! (cond
! ((null arg))
! ((eq arg 1)
! (setq message-forward-as-mime nil
! message-forward-show-mml t))
! ((eq arg 2)
! (setq message-forward-as-mime t
! message-forward-show-mml nil))
! ((eq arg 3)
! (setq message-forward-as-mime t
! message-forward-show-mml t))
! ((eq arg 4)
! (setq message-forward-as-mime nil
! message-forward-show-mml nil))
! (t
! (setq message-forward-as-mime (not message-forward-as-mime))))
! (let* ((gnus-article-reply (gnus-summary-article-number))
! (gnus-article-yanked-articles (list gnus-article-reply)))
! (gnus-setup-message 'forward
! (gnus-summary-select-article)
! (let ((mail-parse-charset
! (or (and (gnus-buffer-live-p gnus-article-buffer)
! (with-current-buffer gnus-article-buffer
! gnus-article-charset))
! gnus-newsgroup-charset))
! (mail-parse-ignored-charsets
! gnus-newsgroup-ignored-charsets))
! (set-buffer gnus-original-article-buffer)
! (message-forward post)))))))
(defun gnus-summary-resend-message (address n)
"Resend the current article to ADDRESS."
! (interactive
! (list (message-read-from-minibuffer
! "Resend message(s) to: "
! (when (and gnus-summary-resend-default-address
! (gnus-buffer-live-p gnus-original-article-buffer))
! ;; If some other article is currently selected, the
! ;; initial-contents is wrong. Whatever, it is just the
! ;; initial-contents.
! (with-current-buffer gnus-original-article-buffer
! (nnmail-fetch-field "to"))))
! current-prefix-arg))
(let ((articles (gnus-summary-work-articles n))
article)
(while (setq article (pop articles))
(gnus-summary-select-article nil nil nil article)
(save-excursion
(set-buffer gnus-original-article-buffer)
! (message-resend address))
! (gnus-summary-mark-article-as-forwarded article))))
!
! ;; From: Matthieu Moy <address@hidden>
! (defun gnus-summary-resend-message-edit ()
! "Resend an article that has already been sent.
! A new buffer will be created to allow the user to modify body and
! contents of the message, and then, everything will happen as when
! composing a new message."
! (interactive)
! (let ((article (gnus-summary-article-number)))
! (gnus-setup-message 'reply-yank
! (gnus-summary-select-article t)
! (set-buffer gnus-original-article-buffer)
! (let ((cur (current-buffer))
! (to (message-fetch-field "to")))
! ;; Get a normal message buffer.
! (message-pop-to-buffer (message-buffer-name "Resend" to))
! (insert-buffer-substring cur)
! (mime-to-mml)
! (message-narrow-to-head-1)
! ;; Gnus will generate a new one when sending.
! (message-remove-header "Message-ID")
! (message-remove-header message-ignored-resent-headers t)
! ;; Remove unwanted headers.
! (goto-char (point-max))
! (insert mail-header-separator)
! (goto-char (point-min))
! (when (re-search-forward "^To:\\|^Newsgroups:" nil 'move)
! (forward-char 1))
! (widen)))))
(defun gnus-summary-post-forward (&optional arg)
"Forward the current article to a newsgroup.
***************
*** 796,807 ****
(when (gnus-y-or-n-p "Send this complaint? ")
(message-send-and-exit)))))))
- (defun gnus-summary-mail-other-window ()
- "Compose mail in other window."
- (interactive)
- (gnus-setup-message 'message
- (message-mail)))
-
(defun gnus-mail-parse-comma-list ()
(let (accumulated
beg)
--- 1338,1343 ----
***************
*** 836,842 ****
;; 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))
(gnus-group-add-parameter group (cons 'to-list to-address))))))
(defun gnus-put-message ()
--- 1372,1378 ----
;; 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))
(gnus-group-add-parameter group (cons 'to-list to-address))))))
(defun gnus-put-message ()
***************
*** 845,879 ****
(let ((reply gnus-article-reply)
(winconf gnus-prev-winconf)
(group gnus-newsgroup-name))
- (or (and group (not (gnus-group-read-only-p group)))
- (setq group (read-string "Put in group: " nil
- (gnus-writable-groups))))
(when (gnus-gethash group gnus-newsrc-hashtb)
(error "No such group: %s" group))
-
(save-excursion
(save-restriction
(widen)
(message-narrow-to-headers)
! (let (gnus-deletable-headers)
! (if (message-news-p)
! (message-generate-headers message-required-news-headers)
! (message-generate-headers message-required-mail-headers)))
(goto-char (point-max))
! (insert "Gcc: " group "\n")
(widen)))
-
(gnus-inews-do-gcc)
!
! (when (get-buffer gnus-group-buffer)
! (when (gnus-buffer-exists-p (car-safe reply))
! (set-buffer (car reply))
! (and (cdr reply)
! (gnus-summary-mark-article-as-replied
! (cdr reply))))
! (when winconf
! (set-window-configuration winconf)))))
(defun gnus-article-mail (yank)
"Send a reply to the address near point.
--- 1381,1414 ----
(let ((reply gnus-article-reply)
(winconf gnus-prev-winconf)
(group gnus-newsgroup-name))
+ (unless (and group
+ (not (gnus-group-read-only-p group)))
+ (setq group (read-string "Put in group: " nil (gnus-writable-groups))))
(when (gnus-gethash group gnus-newsrc-hashtb)
(error "No such group: %s" group))
(save-excursion
(save-restriction
(widen)
(message-narrow-to-headers)
! (let ((gnus-deletable-headers nil))
! (message-generate-headers
! (if (message-news-p)
! message-required-news-headers
! message-required-mail-headers)))
(goto-char (point-max))
! (if (string-match " " group)
! (insert "Gcc: \"" group "\"\n")
! (insert "Gcc: " group "\n"))
(widen)))
(gnus-inews-do-gcc)
! (when (and (get-buffer gnus-group-buffer)
! (gnus-buffer-exists-p (car-safe reply))
! (cdr reply))
! (set-buffer (car reply))
! (gnus-summary-mark-article-as-replied (cdr reply)))
! (when winconf
! (set-window-configuration winconf))))
(defun gnus-article-mail (yank)
"Send a reply to the address near point.
***************
*** 884,890 ****
(save-excursion (re-search-backward "[ \t\n]" nil t) (1+ (point)))
(save-excursion (re-search-forward "[ \t\n]" nil t) (1- (point))))))
(when address
! (message-reply address)
(when yank
(gnus-inews-yank-articles (list (cdr gnus-article-current)))))))
--- 1419,1425 ----
(save-excursion (re-search-backward "[ \t\n]" nil t) (1+ (point)))
(save-excursion (re-search-forward "[ \t\n]" nil t) (1- (point))))))
(when address
! (gnus-msg-mail address)
(when yank
(gnus-inews-yank-articles (list (cdr gnus-article-current)))))))
***************
*** 919,927 ****
(let (text)
(save-excursion
(set-buffer (gnus-get-buffer-create " *gnus environment info*"))
(gnus-debug)
(setq text (buffer-string)))
! (insert "<#part type=application/x-emacs-lisp disposition=inline
description=\"User settings\">\n" text "\n<#/part>"))
(goto-char (point-min))
(search-forward "Subject: " nil t)
(message "")))
--- 1454,1463 ----
(let (text)
(save-excursion
(set-buffer (gnus-get-buffer-create " *gnus environment info*"))
+ (erase-buffer)
(gnus-debug)
(setq text (buffer-string)))
! (insert "<#part type=application/emacs-lisp disposition=inline
description=\"User settings\">\n" text "\n<#/part>"))
(goto-char (point-min))
(search-forward "Subject: " nil t)
(message "")))
***************
*** 936,943 ****
(list (completing-read "Buffer: " (mapcar 'list (message-buffers)) nil t)
current-prefix-arg))
(gnus-summary-iterate n
! (let ((gnus-display-mime-function nil)
! (gnus-inhibit-treatment t))
(gnus-summary-select-article))
(save-excursion
(set-buffer buffer)
--- 1472,1478 ----
(list (completing-read "Buffer: " (mapcar 'list (message-buffers)) nil t)
current-prefix-arg))
(gnus-summary-iterate n
! (let ((gnus-inhibit-treatment t))
(gnus-summary-select-article))
(save-excursion
(set-buffer buffer)
***************
*** 947,956 ****
"Attempts to go through the Gnus source file and report what variables have
been changed.
The source file has to be in the Emacs load path."
(interactive)
! (let ((files '("gnus.el" "gnus-sum.el" "gnus-group.el"
! "gnus-art.el" "gnus-start.el" "gnus-async.el"
! "gnus-msg.el" "gnus-score.el" "gnus-win.el" "gnus-topic.el"
! "nnmail.el" "message.el"))
(point (point))
file expr olist sym)
(gnus-message 4 "Please wait while we snoop your variables...")
--- 1482,1488 ----
"Attempts to go through the Gnus source file and report what variables have
been changed.
The source file has to be in the Emacs load path."
(interactive)
! (let ((files gnus-debug-files)
(point (point))
file expr olist sym)
(gnus-message 4 "Please wait while we snoop your variables...")
***************
*** 973,978 ****
--- 1505,1511 ----
(and (or (eq (car expr) 'defvar)
(eq (car expr) 'defcustom))
(stringp (nth 3 expr))
+ (not (memq (nth 1 expr) gnus-debug-exclude-variables))
(or (not (boundp (nth 1 expr)))
(not (equal (eval (nth 2 expr))
(symbol-value (nth 1 expr)))))
***************
*** 982,998 ****
(insert "------------------ Environment follows
------------------\n\n"))
(while olist
(if (boundp (car olist))
! (condition-case ()
! (pp `(setq ,(car olist)
! ,(if (or (consp (setq sym (symbol-value (car olist))))
! (and (symbolp sym)
! (not (or (eq sym nil)
! (eq sym t)))))
! (list 'quote (symbol-value (car olist)))
! (symbol-value (car olist))))
! (current-buffer))
! (error
! (format "(setq %s 'whatever)\n" (car olist))))
(insert ";; (makeunbound '" (symbol-name (car olist)) ")\n"))
(setq olist (cdr olist)))
(insert "\n\n")
--- 1515,1529 ----
(insert "------------------ Environment follows
------------------\n\n"))
(while olist
(if (boundp (car olist))
! (ignore-errors
! (gnus-pp
! `(setq ,(car olist)
! ,(if (or (consp (setq sym (symbol-value (car olist))))
! (and (symbolp sym)
! (not (or (eq sym nil)
! (eq sym t)))))
! (list 'quote (symbol-value (car olist)))
! (symbol-value (car olist))))))
(insert ";; (makeunbound '" (symbol-name (car olist)) ")\n"))
(setq olist (cdr olist)))
(insert "\n\n")
***************
*** 1008,1014 ****
(defun gnus-summary-resend-bounced-mail (&optional fetch)
"Re-mail the current message.
! This only makes sense if the current message is a bounce message than
contains some mail you have written which has been bounced back to
you.
If FETCH, try to fetch the article that this is a reply to, if indeed
--- 1539,1545 ----
(defun gnus-summary-resend-bounced-mail (&optional fetch)
"Re-mail the current message.
! This only makes sense if the current message is a bounce message that
contains some mail you have written which has been bounced back to
you.
If FETCH, try to fetch the article that this is a reply to, if indeed
***************
*** 1028,1089 ****
;;; Gcc handling.
(defun gnus-inews-group-method (group)
! (cond ((and (null (gnus-get-info group))
! (eq (car gnus-message-archive-method)
! (car
! (gnus-server-to-method
! (gnus-group-method group)))))
! ;; If the group doesn't exist, we assume
! ;; it's an archive group...
! gnus-message-archive-method)
! ;; Use the method.
! ((gnus-info-method (gnus-get-info group))
! (gnus-info-method (gnus-get-info group)))
! ;; Find the method.
! (t (gnus-group-method group))))
;; Do Gcc handling, which copied the message over to some group.
(defun gnus-inews-do-gcc (&optional gcc)
(interactive)
! (when (gnus-alive-p)
! (save-excursion
! (save-restriction
! (message-narrow-to-headers)
! (let ((gcc (or gcc (mail-fetch-field "gcc" nil t)))
! (cur (current-buffer))
! groups group method)
! (when gcc
! (message-remove-header "gcc")
! (widen)
! (setq groups (message-unquote-tokens
! (message-tokenize-header gcc " ,")))
! ;; Copy the article over to some group(s).
! (while (setq group (pop groups))
! (gnus-check-server
! (setq method (gnus-inews-group-method group)))
! (unless (gnus-request-group group t method)
! (gnus-request-create-group group method))
! (save-excursion
! (nnheader-set-temp-buffer " *acc*")
! (insert-buffer-substring cur)
! (message-encode-message-body)
! (save-restriction
! (message-narrow-to-headers)
! (let ((mail-parse-charset message-default-charset)
! (rfc2047-header-encoding-alist
! (cons '("Newsgroups" . default)
! rfc2047-header-encoding-alist)))
! (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 t)
! (gnus-message 1 "Couldn't store article in group %s: %s"
! group (gnus-status-message method))
! (sit-for 2))
! (kill-buffer (current-buffer))))))))))
(defun gnus-inews-insert-gcc ()
"Insert Gcc headers based on `gnus-outgoing-message-group'."
--- 1559,1656 ----
;;; Gcc handling.
(defun gnus-inews-group-method (group)
! (cond
! ;; If the group doesn't exist, we assume
! ;; it's an archive group...
! ((and (null (gnus-get-info group))
! (eq (car (gnus-server-to-method gnus-message-archive-method))
! (car (gnus-server-to-method (gnus-group-method group)))))
! gnus-message-archive-method)
! ;; Use the method.
! ((gnus-info-method (gnus-get-info group))
! (gnus-info-method (gnus-get-info group)))
! ;; Find the method.
! (t (gnus-server-to-method (gnus-group-method group)))))
;; Do Gcc handling, which copied the message over to some group.
(defun gnus-inews-do-gcc (&optional gcc)
(interactive)
! (save-excursion
! (save-restriction
! (message-narrow-to-headers)
! (let ((gcc (or gcc (mail-fetch-field "gcc" nil t)))
! (cur (current-buffer))
! groups group method group-art
! mml-externalize-attachments)
! (when gcc
! (message-remove-header "gcc")
! (widen)
! (setq groups (message-unquote-tokens
! (message-tokenize-header gcc " ,")))
! ;; Copy the article over to some group(s).
! (while (setq group (pop groups))
! (unless (gnus-check-server
! (setq method (gnus-inews-group-method group)))
! (error "Can't open server %s" (if (stringp method) method
! (car method))))
! (unless (gnus-request-group group nil method)
! (gnus-request-create-group group method))
! (setq mml-externalize-attachments
! (if (stringp gnus-gcc-externalize-attachments)
! (string-match gnus-gcc-externalize-attachments group)
! gnus-gcc-externalize-attachments))
! (save-excursion
! (nnheader-set-temp-buffer " *acc*")
! (insert-buffer-substring cur)
! (message-encode-message-body)
! (save-restriction
! (message-narrow-to-headers)
! (let* ((mail-parse-charset message-default-charset)
! (newsgroups-field (save-restriction
! (message-narrow-to-headers-or-head)
! (message-fetch-field "Newsgroups")))
! (followup-field (save-restriction
! (message-narrow-to-headers-or-head)
! (message-fetch-field "Followup-To")))
! ;; BUG: We really need to get the charset for
! ;; each name in the Newsgroups and Followup-To
! ;; lines to allow crossposting between group
! ;; namess with incompatible character sets.
! ;; -- Per Abrahamsen <address@hidden> 2001-10-08.
! (group-field-charset
! (gnus-group-name-charset
! method (or newsgroups-field "")))
! (followup-field-charset
! (gnus-group-name-charset
! method (or followup-field "")))
! (rfc2047-header-encoding-alist
! (append
! (when group-field-charset
! (list (cons "Newsgroups" group-field-charset)))
! (when followup-field-charset
! (list (cons "Followup-To" followup-field-charset)))
! rfc2047-header-encoding-alist)))
! (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 (setq group-art
! (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))
! (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
! (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)))))))))
(defun gnus-inews-insert-gcc ()
"Insert Gcc headers based on `gnus-outgoing-message-group'."
***************
*** 1092,1105 ****
(message-narrow-to-headers)
(let* ((group gnus-outgoing-message-group)
(gcc (cond
! ((gnus-functionp group)
(funcall group))
((or (stringp group) (list group))
group))))
(when gcc
(insert "Gcc: "
! (if (stringp gcc) gcc
! (mapconcat 'identity gcc " "))
"\n"))))))
(defun gnus-inews-insert-archive-gcc (&optional group)
--- 1659,1679 ----
(message-narrow-to-headers)
(let* ((group gnus-outgoing-message-group)
(gcc (cond
! ((functionp group)
(funcall group))
((or (stringp group) (list group))
group))))
(when gcc
(insert "Gcc: "
! (if (stringp gcc)
! (if (string-match " " gcc)
! (concat "\"" gcc "\"")
! gcc)
! (mapconcat (lambda (group)
! (if (string-match " " group)
! (concat "\"" group "\"")
! group))
! gcc " "))
"\n"))))))
(defun gnus-inews-insert-archive-gcc (&optional group)
***************
*** 1126,1132 ****
((and (listp var) (stringp (car var)))
;; A list of groups.
var)
! ((gnus-functionp var)
;; A function.
(funcall var group))
(t
--- 1700,1706 ----
((and (listp var) (stringp (car var)))
;; A list of groups.
var)
! ((functionp var)
;; A function.
(funcall var group))
(t
***************
*** 1139,1145 ****
;; Regexp.
(when (string-match (caar var) group)
(cdar var)))
! ((gnus-functionp (car var))
;; Function.
(funcall (car var) group))
(t
--- 1713,1719 ----
;; Regexp.
(when (string-match (caar var) group)
(cdar var)))
! ((functionp (car var))
;; Function.
(funcall (car var) group))
(t
***************
*** 1160,1190 ****
(progn
(insert
(if (stringp gcc-self-val)
! gcc-self-val
! group))
(if (not (eq gcc-self-val 'none))
(insert "\n")
! (progn
! (beginning-of-line)
! (kill-line))))
;; Use the list of groups.
(while (setq name (pop groups))
! (insert (if (string-match ":" name)
! name
! (gnus-group-prefixed-name
! name gnus-message-archive-method)))
(when groups
(insert " ")))
(insert "\n")))))))
;;; 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 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
--- 1734,1784 ----
(progn
(insert
(if (stringp gcc-self-val)
! (if (string-match " " gcc-self-val)
! (concat "\"" gcc-self-val "\"")
! gcc-self-val)
! ;; In nndoc groups, we use the parent group name
! ;; instead of the current group.
! (let ((group (or (gnus-group-find-parameter
! gnus-newsgroup-name 'parent-group)
! group)))
! (if (string-match " " group)
! (concat "\"" group "\"")
! group))))
(if (not (eq gcc-self-val 'none))
(insert "\n")
! (gnus-delete-line)))
;; Use the list of groups.
(while (setq name (pop groups))
! (let ((str (if (string-match ":" name)
! name
! (gnus-group-prefixed-name
! name gnus-message-archive-method))))
! (insert (if (string-match " " str)
! (concat "\"" str "\"")
! str)))
(when groups
(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)
"Configure posting styles according to `gnus-posting-styles'."
(unless gnus-inhibit-posting-styles
! (let ((group (or group-name gnus-newsgroup-name ""))
(styles gnus-posting-styles)
! 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
***************
*** 1202,1226 ****
;; Regexp string match on the group name.
(string-match match group))
((eq match 'header)
! (let ((header (message-fetch-field (pop style))))
! (and header
! (string-match (pop style) header))))
((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
--- 1796,1831 ----
;; Regexp string match on the group name.
(string-match match group))
((eq match 'header)
! ;; Obsolete format of header match.
! (and (gnus-buffer-live-p gnus-article-copy)
! (with-current-buffer gnus-article-copy
! (let ((header (message-fetch-field (pop style))))
! (and header
! (string-match (pop style) header))))))
((or (symbolp match)
! (functionp match))
(cond
! ((functionp match)
;; Function to be called.
(funcall match))
((boundp match)
;; Variable to be checked.
(symbol-value match))))
((listp match)
! (cond
! ((eq (car match) 'header)
! ;; New format of header match.
! (and (gnus-buffer-live-p gnus-article-copy)
! (with-current-buffer gnus-article-copy
! (let ((header (message-fetch-field (nth 1 match))))
! (and header
! (string-match (nth 2 match) header))))))
! (t
! ;; 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)
filep nil)
(setq value
(cond
***************
*** 1237,1257 ****
((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 (and filep v)
(setq v (with-temp-buffer
(insert-file-contents v)
(buffer-string))))
(setq results (delq (assoc element results) results))
(push (cons element v) results))))
--- 1842,1869 ----
((stringp value)
value)
((or (symbolp value)
! (functionp value))
! (cond ((functionp value)
(funcall value))
((boundp value)
(symbol-value value))))
((listp value)
(eval value))))
;; Translate obsolescent value.
! (cond
! ((eq element 'signature-file)
(setq element 'signature
filep t))
+ ((eq element 'x-face-file)
+ (setq element 'x-face
+ filep t)))
;; Get the contents of file elems.
(when (and filep v)
(setq v (with-temp-buffer
(insert-file-contents v)
+ (goto-char (point-max))
+ (while (bolp)
+ (delete-char -1))
(buffer-string))))
(setq results (delq (assoc element results) results))
(push (cons element v) results))))
***************
*** 1259,1265 ****
(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)
(add-hook 'message-setup-hook
(cond
--- 1871,1879 ----
(setq name (assq 'name results)
address (assq 'address results))
(setq results (delq name (delq address results)))
! (gnus-make-local-hook 'message-setup-hook)
! (setq results (sort results (lambda (x y)
! (string-lessp (car x) (car y)))))
(dolist (result results)
(add-hook 'message-setup-hook
(cond
***************
*** 1291,1309 ****
(let ((value ,(cdr result)))
(when value
(message-goto-eoh)
! (insert ,header ": " value "\n"))))))))))
(when (or name address)
(add-hook 'message-setup-hook
`(lambda ()
! (set (make-local-variable 'user-mail-address)
! ,(or (cdr address) user-mail-address))
(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.
--- 1905,1927 ----
(let ((value ,(cdr result)))
(when value
(message-goto-eoh)
! (insert ,header ": " value)
! (unless (bolp)
! (insert "\n")))))))))
! nil 'local))
(when (or name address)
(add-hook 'message-setup-hook
`(lambda ()
! (set (make-local-variable 'user-mail-address)
! ,(or (cdr address) user-mail-address))
(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"))))
! nil 'local)))))
;;; Allow redefinition of functions.
[Prev in Thread] |
Current Thread |
[Next in Thread] |
- [Emacs-diffs] Changes to emacs/lisp/gnus/gnus-msg.el [lexbind],
Miles Bader <=