X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=lisp%2Fgnus-msg.el;h=51d8a535f818a8d86c27eb815f9c000423a02e1e;hb=36bd162f4f7cd40453b8683e796730836c352b2a;hp=0e1c8537dbe17173e3540995348c78b4204267bd;hpb=4887fff915a27fe13c6aed50d5a68ae3704aeb6c;p=elisp%2Fgnus.git- diff --git a/lisp/gnus-msg.el b/lisp/gnus-msg.el index 0e1c853..51d8a53 100644 --- a/lisp/gnus-msg.el +++ b/lisp/gnus-msg.el @@ -43,20 +43,20 @@ "*Preferred method for posting USENET news. If this variable is `current' (which is the default), Gnus will use -the \"current\" select method when posting. If it is nil, Gnus will -use the native select method when posting. +the \"current\" select method when posting. If it is `native', Gnus +will use the native select method when posting. This method will not be used in mail groups and the like, only in \"real\" newsgroups. -If not nil nor `native', the value must be a valid method as discussed +If not `native' nor `current', the value must be a valid method as discussed in the documentation of `gnus-select-method'. It can also be a list of methods. If that is the case, the user will be queried for what select method to use when posting." :group 'gnus-group-foreign - :type `(choice (const nil) + :link '(custom-manual "(gnus)Posting Server") + :type `(choice (const native) (const current) - (const native) (sexp :tag "Methods" ,gnus-select-method))) (defcustom gnus-outgoing-message-group nil @@ -117,7 +117,8 @@ the second with the current group name." :type 'boolean) (defcustom gnus-posting-styles nil - "*Alist of styles to use when posting." + "*Alist of styles to use when posting. +See Info node `(gnus)Posting Styles'." :group 'gnus-message :type '(repeat (cons (choice (regexp) (function) @@ -233,6 +234,7 @@ Thank you for your help in stamping out bugs. (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 @@ -282,7 +284,16 @@ Thank you for your help in stamping out bugs. (user-agent . Gnus)))) (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) + ;; #### 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 + (lambda () + (gnus-configure-posting-styles ,group))) (unwind-protect (progn ,@forms) @@ -295,6 +306,7 @@ Thank you for your help in stamping out bugs. (gnus-run-hooks 'gnus-message-setup-hook)) (gnus-add-buffer) (gnus-configure-windows ,config t) + (run-hooks 'post-command-hook) (set-buffer-modified-p nil)))) (defun gnus-inews-insert-draft-meta-information (group article) @@ -419,15 +431,47 @@ If ARG is 1, prompt for a group name to find the posting style." (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 backend 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) + (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 news message. -If ARG, post to the group under point. -If ARG is 1, prompt for a group name." + "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 @@ -439,10 +483,78 @@ If ARG is 1, prompt for a 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-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) + (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 backend 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) + (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-news (gnus-group-real-name gnus-newsgroup-name)))) + (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))) + (gnus-post-news 'post gnus-newsgroup-name))) + (defun gnus-summary-followup (yank &optional force-news) "Compose a followup to an article. @@ -633,7 +745,8 @@ header line with the old Message-ID." (insert-buffer-substring gnus-original-article-buffer beg end) ;; Decode charsets. (let ((gnus-article-decode-hook - (delq 'article-decode-charset gnus-article-decode-hook))) + (delq 'article-decode-charset + (copy-sequence gnus-article-decode-hook)))) ;; Needed for T-gnus. (add-hook 'gnus-article-decode-hook 'article-decode-encoded-words) @@ -669,8 +782,7 @@ header line with the old Message-ID." force-news (and (gnus-news-group-p (or pgroup gnus-newsgroup-name) - (if header (mail-header-number header) - gnus-current-article)) + (or header gnus-current-article)) (not mailing-list) (not to-list) (not to-address))) @@ -722,23 +834,24 @@ If SILENT, don't prompt the user." ;; If the group-method is nil (which shouldn't happen) we use ;; the default method. ((null group-method) - (or (and (null (eq gnus-post-method 'active)) gnus-post-method) - gnus-select-method message-post-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 'active) + (if (eq gnus-post-method 'current) 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)) + (and (listp gnus-post-method) (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))) + (when (listp gnus-post-method) (if (listp (car gnus-post-method)) gnus-post-method (list gnus-post-method))) @@ -778,13 +891,14 @@ If SILENT, don't prompt the user." ;; 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)) + (gnus-get-function group-method 'request-post t)) + (assert (not arg)) group-method) - ((and gnus-post-method - (not (eq gnus-post-method 'current))) + ;; 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. + ;; Use the normal select method (nil or native). (t gnus-select-method)))) @@ -974,18 +1088,21 @@ The original article will be yanked." (gnus-summary-work-articles n) t (gnus-summary-work-articles n))) (defun gnus-summary-mail-forward (&optional full-headers post) - "Forward the current message to another user. + "Forward the current message(s) to another user. +If process marks exist, forward all marked messages; If FULL-HEADERS (the prefix), include full headers when forwarding." (interactive "P") - (gnus-setup-message 'forward - (gnus-summary-select-article) - (let ((charset default-mime-charset)) - (set-buffer gnus-original-article-buffer) - (make-local-variable 'default-mime-charset) - (setq default-mime-charset charset)) - (let ((message-included-forward-headers - (if full-headers "" message-included-forward-headers))) - (message-forward post)))) + (if (null (cdr (gnus-summary-work-articles nil))) + (gnus-setup-message 'forward + (gnus-summary-select-article) + (let ((charset default-mime-charset)) + (set-buffer gnus-original-article-buffer) + (make-local-variable 'default-mime-charset) + (setq default-mime-charset charset)) + (let ((message-included-forward-headers + (if full-headers "" message-included-forward-headers))) + (message-forward post))) + (gnus-summary-digest-mail-forward nil post))) (defun gnus-summary-digest-mail-forward (&optional n post) "Digests and forwards all articles in this series. @@ -1118,12 +1235,6 @@ The current group name will be inserted at \"%s\".") (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) @@ -1525,10 +1636,10 @@ this is a reply." ;;; Posting styles. -(defun gnus-configure-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 gnus-newsgroup-name "")) + (let ((group (or group-name gnus-newsgroup-name "")) (styles gnus-posting-styles) style match variable attribute value v results filep name address element) @@ -1607,7 +1718,8 @@ this is a reply." (setq name (assq 'name results) address (assq 'address results)) (setq results (delq name (delq address results))) - (make-local-variable 'message-setup-hook) + ;; make-local-hook is not obsolete in Emacs 20 or XEmacs. + (make-local-hook 'message-setup-hook) (dolist (result results) (add-hook 'message-setup-hook (cond @@ -1639,7 +1751,8 @@ this is a reply." (let ((value ,(cdr result))) (when value (message-goto-eoh) - (insert ,header ": " value "\n")))))))))) + (insert ,header ": " value "\n")))))))) + nil 'local)) (when (or name address) (add-hook 'message-setup-hook `(lambda () @@ -1651,7 +1764,8 @@ this is a reply." (save-excursion (message-remove-header "From") (message-goto-eoh) - (insert "From: " (message-make-from) "\n"))))))))) + (insert "From: " (message-make-from) "\n")))) + nil 'local))))) ;;; @ for MIME Edit mode