X-Git-Url: http://cgit.sxemacs.org/?p=gnus;a=blobdiff_plain;f=lisp%2Fgnus-msg.el;h=556bb40e3f86e087b01b29b4983a09a5cc456112;hp=a2787315bed9f36f89eceec9101247bffa7927bb;hb=bbaa6736e285258f29be9409b7b75751bb847e96;hpb=2e78be47110b77320bbe476cbac4f4ee8058cc18 diff --git a/lisp/gnus-msg.el b/lisp/gnus-msg.el index a2787315b..556bb40e3 100644 --- a/lisp/gnus-msg.el +++ b/lisp/gnus-msg.el @@ -1,5 +1,5 @@ ;;; gnus-msg.el --- mail and post interface for Gnus -;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003 +;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004 ;; Free Software Foundation, Inc. ;; Author: Masanobu UMEDA @@ -146,9 +146,6 @@ See Info node `(gnus)Posting Styles'." :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) @@ -251,7 +248,7 @@ See also the `mml-default-encrypt-method' variable." (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) @@ -285,24 +282,6 @@ If nil, the address field will always be empty after invoking :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 @@ -339,11 +318,7 @@ Thank you for your help in stamping out bugs. ") (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")) + (autoload 'gnus-uu-post-news "gnus-uu" nil t)) ;;; @@ -384,10 +359,10 @@ Thank you for your help in stamping out bugs. ;;; Internal functions. -(defun gnus-inews-make-draft () +(defun gnus-inews-make-draft (articles) `(lambda () (gnus-inews-make-draft-meta-information - ,gnus-newsgroup-name ',gnus-article-reply))) + ,gnus-newsgroup-name ',articles))) (defvar gnus-article-reply nil) (defmacro gnus-setup-message (config &rest forms) @@ -416,15 +391,20 @@ Thank you for your help in stamping out bugs. ;; 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))) + (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)) + (gnus-inews-make-draft ,yanked)) message-required-headers)) (unwind-protect (progn @@ -440,10 +420,8 @@ Thank you for your help in stamping out bugs. (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) @@ -454,12 +432,19 @@ Thank you for your help in stamping out bugs. (run-hooks 'post-command-hook) (set-buffer-modified-p nil)))) -(defun gnus-inews-make-draft-meta-information (group article) +(defun gnus-inews-make-draft-meta-information (group articles) + (when (numberp articles) + (setq articles (list articles))) (concat "(\"" group "\" " - (if article (number-to-string - (if (listp article) - (car article) - article)) "\"\"") + (if articles + (mapconcat + (lambda (elem) + (number-to-string + (if (consp elem) + (car elem) + elem))) + articles " ") + "") ")")) ;;;###autoload @@ -517,7 +502,7 @@ Gcc: header for archiving purposes." (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)))) @@ -525,11 +510,11 @@ Gcc: header for archiving purposes." (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) @@ -540,7 +525,9 @@ Gcc: header for archiving purposes." (set-window-configuration ,winconf)) 'exit 'postpone 'kill) (let ((to-be-marked (cond - (yanked yanked) + (yanked + (mapcar + (lambda (x) (if (listp x) (car x) x)) yanked)) (article (if (listp article) article (list article))) (t nil)))) (message-add-action @@ -592,7 +579,7 @@ 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." +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. @@ -671,7 +658,7 @@ 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." +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. @@ -725,8 +712,7 @@ a news." 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 two following numbers is the region to be -yanked." +article number, and the cdr is the string to be yanked." (interactive (list (and current-prefix-arg (gnus-summary-work-articles 1)))) @@ -746,7 +732,9 @@ yanked." (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." + "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)) @@ -928,7 +916,9 @@ header line with the old Message-ID." (not to-address))) ;; This is news. (if post - (message-news (or to-group group)) + (message-news + (or to-group + (and (not (gnus-virtual-group-p pgroup)) group))) (set-buffer gnus-article-copy) (gnus-msg-treat-broken-reply-to) (message-followup (if (or newsgroup-p force-news) @@ -1043,52 +1033,16 @@ If SILENT, don't prompt the user." -;; 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. See the variable `gnus-user-agent'." (interactive) - (let* ((gnus-v + (let* ((float-output-format nil) + (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 - (if system-v - (concat ", " system-v ")") - ")")) - ""))) - (t emacs-version)))) + (emacs-v (gnus-emacs-version))) (if (stringp gnus-user-agent) gnus-user-agent (concat gnus-v @@ -1113,7 +1067,7 @@ If VERY-WIDE, make a very wide reply." (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) @@ -1209,7 +1163,8 @@ automatically." (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)) @@ -1325,8 +1280,8 @@ composing a new message." (goto-char (point-max)) (insert mail-header-separator) (goto-char (point-min)) - (re-search-forward "^To:\\|^Newsgroups:" nil 'move) - (forward-char 1) + (when (re-search-forward "^To:\\|^Newsgroups:" nil 'move) + (forward-char 1)) (widen))))) (defun gnus-summary-post-forward (&optional arg) @@ -1422,7 +1377,7 @@ The current group name will be inserted at \"%s\".") ;; 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 () @@ -1435,7 +1390,7 @@ The current group name will be inserted at \"%s\".") (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) + (when (gnus-group-entry group) (error "No such group: %s" group)) (save-excursion (save-restriction @@ -1522,8 +1477,7 @@ If YANK is non-nil, include the original article." (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)) + (let ((gnus-inhibit-treatment t)) (gnus-summary-select-article)) (save-excursion (set-buffer buffer) @@ -1567,14 +1521,14 @@ The source file has to be in the Emacs load path." (while olist (if (boundp (car olist)) (ignore-errors - (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))) + (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") @@ -1590,7 +1544,7 @@ The source file has to be in the Emacs load path." (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 +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 @@ -1687,17 +1641,21 @@ this is a reply." (concat "^" (regexp-quote mail-header-separator) "$") nil t) (replace-match "" t t )) - (unless (setq group-art - (gnus-request-accept-article group method t t)) + (when (or (not (gnus-check-backend-function + 'request-accept-article group)) + (not (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)) + group (gnus-status-message method))) (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))))))))) @@ -1708,7 +1666,7 @@ this is a reply." (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)))) @@ -1749,7 +1707,7 @@ this is a reply." ((and (listp var) (stringp (car var))) ;; A list of groups. var) - ((gnus-functionp var) + ((functionp var) ;; A function. (funcall var group)) (t @@ -1762,7 +1720,7 @@ this is a reply." ;; Regexp. (when (string-match (caar var) group) (cdar var))) - ((gnus-functionp (car var)) + ((functionp (car var)) ;; Function. (funcall (car var) group)) (t @@ -1786,9 +1744,14 @@ this is a reply." (if (string-match " " gcc-self-val) (concat "\"" gcc-self-val "\"") gcc-self-val) - (if (string-match " " group) - (concat "\"" group "\"") - group))) + ;; 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))) @@ -1822,7 +1785,7 @@ this is a reply." (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 @@ -1847,9 +1810,9 @@ this is a reply." (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) @@ -1870,7 +1833,6 @@ this is a reply." ;; We have a match, so we set the variables. (dolist (attribute style) (setq element (pop attribute) - variable nil filep nil) (setq value (cond @@ -1887,8 +1849,8 @@ this is a reply." ((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)))) @@ -1916,8 +1878,7 @@ this is a reply." (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) @@ -1975,4 +1936,5 @@ this is a reply." (provide 'gnus-msg) +;;; arch-tag: 9f22b2f5-1c0a-49de-916e-4c88e984852b ;;; gnus-msg.el ends here