X-Git-Url: http://cgit.sxemacs.org/?a=blobdiff_plain;f=lisp%2Fgnus-msg.el;h=38f99e80ddcb72f9db4d731af9ae4bf213daa1e1;hb=507b285173baa14c25dc095f5c65d05a5474a8fe;hp=04fd0585b7d68ac65ae68fb81942e04d43e79dbf;hpb=27e50870dcbd1442e8fe2d14ddfb89cd7c706495;p=gnus diff --git a/lisp/gnus-msg.el b/lisp/gnus-msg.el index 04fd0585b..38f99e80d 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,96 Free Software Foundation, Inc. +;; Copyright (C) 1995,96,97 Free Software Foundation, Inc. ;; Author: Masanobu UMEDA ;; Lars Magne Ingebrigtsen @@ -48,7 +48,7 @@ posting.") "*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 -can also be a list of group names. +can also be a list of group names. 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 @@ -61,7 +61,7 @@ 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-sent-message-ids-file +(defvar gnus-sent-message-ids-file (nnheader-concat gnus-directory "Sent-Message-IDs") "File where Gnus saves a cache of sent message ids.") @@ -86,6 +86,9 @@ Thank you. 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.") + ;;; Internal variables. (defvar gnus-message-buffer "*Mail Gnus*") @@ -132,6 +135,8 @@ Thank you for your help in stamping out bugs. "s" gnus-summary-supersede-article "r" gnus-summary-reply "R" gnus-summary-reply-with-original + "w" gnus-summary-wide-reply + "W" gnus-summary-wide-reply-with-original "n" gnus-summary-followup-to-mail "N" gnus-summary-followup-to-mail-with-original "m" gnus-summary-mail-other-window @@ -161,14 +166,16 @@ Thank you for your help in stamping out bugs. (copy-sequence message-header-setup-hook))) (add-hook 'message-header-setup-hook 'gnus-inews-insert-gcc) (add-hook 'message-header-setup-hook 'gnus-inews-insert-archive-gcc) - ,@forms - (gnus-inews-add-send-actions ,winconf ,buffer ,article) - (setq gnus-message-buffer (current-buffer)) - (make-local-variable 'gnus-newsgroup-name) + (unwind-protect + ,@forms + (gnus-inews-add-send-actions ,winconf ,buffer ,article) + (setq gnus-message-buffer (current-buffer)) + (make-local-variable 'gnus-newsgroup-name) + (run-hooks 'gnus-message-setup-hook)) (gnus-configure-windows ,config t)))) - + (defun gnus-inews-add-send-actions (winconf buffer article) - (gnus-make-local-hook 'message-sent-hook) + (make-local-hook 'message-sent-hook) (gnus-add-hook 'message-sent-hook 'gnus-inews-do-gcc nil t) (setq message-post-method `(lambda (arg) @@ -220,8 +227,8 @@ If ARG is 1, prompt for a group 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 + (interactive + (list (and current-prefix-arg (gnus-summary-work-articles 1)))) (gnus-set-global-variables) (when yank @@ -232,7 +239,7 @@ If prefix argument YANK is non-nil, original article is yanked automatically." (gnus-newsgroup-name gnus-newsgroup-name)) ;; Send a followup. (gnus-post-news nil gnus-newsgroup-name - headers gnus-article-buffer + headers gnus-article-buffer yank nil force-news))) (defun gnus-summary-followup-with-original (n &optional force-news) @@ -242,8 +249,8 @@ If prefix argument YANK is non-nil, original article is yanked automatically." (defun gnus-summary-followup-to-mail (&optional arg) "Followup to the current mail message via news." - (interactive - (list (and current-prefix-arg + (interactive + (list (and current-prefix-arg (gnus-summary-work-articles 1)))) (gnus-summary-followup arg t)) @@ -301,7 +308,11 @@ header line with the old Message-ID." (message-supersede) (push `((lambda () - (gnus-cache-possibly-remove-article ,article nil nil nil t))) + (when (buffer-name (get-buffer ,gnus-summary-buffer)) + (save-excursion + (set-buffer (get-buffer ,gnus-summary-buffer)) + (gnus-cache-possibly-remove-article ,article nil nil nil t) + (gnus-summary-mark-as-read ,article gnus-canceled-mark))))) message-send-actions)))) @@ -317,8 +328,9 @@ header line with the old Message-ID." (push gnus-article-copy gnus-buffer-list)) (let ((article-buffer (or article-buffer gnus-article-buffer)) end beg contents) - (when (and (get-buffer article-buffer) - (buffer-name (get-buffer article-buffer))) + (if (not (and (get-buffer article-buffer) + (buffer-name (get-buffer article-buffer)))) + (error "Can't find any article buffer") (save-excursion (set-buffer article-buffer) (save-restriction @@ -327,7 +339,7 @@ header line with the old Message-ID." (widen) (copy-to-buffer gnus-article-copy (point-min) (point-max)) (set-buffer gnus-article-copy) - (article-delete-text-of-type 'annotation) + (gnus-article-delete-text-of-type 'annotation) (gnus-remove-text-with-property 'gnus-prev) (gnus-remove-text-with-property 'gnus-next) (insert @@ -347,7 +359,7 @@ header line with the old Message-ID." (or (search-forward "\n\n" nil t) (point))) ;; Insert the original article headers. (insert-buffer-substring gnus-original-article-buffer beg end) - (article-decode-rfc1522))) + (gnus-article-decode-rfc1522))) gnus-article-copy))) (defun gnus-post-news (post &optional group header article-buffer yank subject @@ -360,7 +372,7 @@ header line with the old Message-ID." (t 'message)) (let* ((group (or group gnus-newsgroup-name)) (pgroup group) - to-address to-group mailing-list to-list + to-address to-group mailing-list to-list newsgroup-p) (when group (setq to-address (gnus-group-find-parameter group 'to-address) @@ -374,7 +386,7 @@ header line with the old Message-ID." (gnus-news-group-p to-group)) newsgroup-p force-news - (and (gnus-news-group-p + (and (gnus-news-group-p (or pgroup gnus-newsgroup-name) (if header (mail-header-number header) gnus-current-article)) @@ -392,7 +404,7 @@ header line with the old Message-ID." (message-mail (or to-address to-list)) ;; Arrange for mail groups that have no `to-address' to ;; get that when the user sends off the mail. - (push (list 'gnus-inews-add-to-address group) + (push (list 'gnus-inews-add-to-address pgroup) message-send-actions)) (set-buffer gnus-article-copy) (message-wide-reply to-address))) @@ -403,8 +415,8 @@ header line with the old Message-ID." "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 + (cond + ;; If the group-method is nil (which shouldn't happen) we use ;; the default method. ((null group-method) (or gnus-post-method gnus-select-method message-post-method)) @@ -434,7 +446,7 @@ If SILENT, don't prompt the user." (push method post-methods))) ;; Create a name-method alist. (setq method-alist - (mapcar + (mapcar (lambda (m) (list (concat (cadr m) " (" (symbol-name (car m)) ")") m)) post-methods)) @@ -456,16 +468,6 @@ If SILENT, don't prompt the user." ;; Use the normal select method. (t gnus-select-method)))) -(defun gnus-inews-narrow-to-headers () - (widen) - (narrow-to-region - (goto-char (point-min)) - (or (and (re-search-forward - (concat "^" (regexp-quote mail-header-separator) "$") nil t) - (match-beginning 0)) - (point-max))) - (goto-char (point-min))) - ;;; ;;; Check whether the message has been sent already. ;;; @@ -475,7 +477,7 @@ If SILENT, don't prompt the user." (defun gnus-inews-reject-message () "Check whether this message has already been sent." (when gnus-sent-message-ids-file - (let ((message-id (save-restriction (gnus-inews-narrow-to-headers) + (let ((message-id (save-restriction (message-narrow-to-headers) (mail-fetch-field "message-id"))) end) (when message-id @@ -484,12 +486,12 @@ If SILENT, don't prompt the user." (load t t t))) (if (member message-id gnus-inews-sent-ids) ;; Reject this message. - (not (gnus-yes-or-no-p + (not (gnus-yes-or-no-p (format "Message %s already sent. Send anyway? " message-id))) (push message-id gnus-inews-sent-ids) ;; Chop off the last Message-IDs. - (when (setq end (nthcdr gnus-sent-message-ids-length + (when (setq end (nthcdr gnus-sent-message-ids-length gnus-inews-sent-ids)) (setcdr end nil)) (nnheader-temp-write gnus-sent-message-ids-file @@ -515,18 +517,24 @@ If SILENT, don't prompt the user." (concat "Emacs " (substring emacs-version (match-beginning 1) (match-end 1)))) - ((string-match "\\([A-Z]*[Mm][Aa][Cc][Ss]\\)" emacs-version) + ((string-match "\\([A-Z]*[Mm][Aa][Cc][Ss]\\)[^(]*\\(\\((beta.*)\\|'\\)\\)?" + emacs-version) (concat (substring emacs-version (match-beginning 1) (match-end 1)) - (format " %d.%d" emacs-major-version emacs-minor-version))) + (format " %d.%d" emacs-major-version emacs-minor-version) + (if (match-beginning 3) + (substring emacs-version + (match-beginning 3) + (match-end 3)) + ""))) (t emacs-version)))) ;; Written by "Mr. Per Persson" . (defun gnus-inews-insert-mime-headers () (goto-char (point-min)) - (let ((mail-header-separator - (progn + (let ((mail-header-separator + (progn (goto-char (point-min)) (if (and (search-forward (concat "\n" mail-header-separator "\n") nil t) @@ -550,35 +558,51 @@ If SILENT, don't prompt the user." ;;; -;;; Gnus Mail Functions +;;; Gnus Mail Functions ;;; ;;; Mail reply commands of Gnus summary mode -(defun gnus-summary-reply (&optional yank) - "Reply mail to news author. -If prefix argument YANK is non-nil, original article is yanked automatically." - (interactive - (list (and current-prefix-arg +(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)))) - ;; Bug fix by jbw@bigbird.bu.edu (Joe Wells) ;; Stripping headers should be specified with mail-yank-ignored-headers. (gnus-set-global-variables) - (when yank + (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)) - (message-reply nil nil (gnus-group-find-parameter - gnus-newsgroup-name 'broken-reply-to)) + (message-reply nil wide (gnus-group-find-parameter + gnus-newsgroup-name 'broken-reply-to)) (when yank (gnus-inews-yank-articles yank))))) -(defun gnus-summary-reply-with-original (n) - "Reply mail to news author with original article." +(defun gnus-summary-reply-with-original (n &optional wide) + "Start composing a reply mail to the current message. +The original article will be yanked." (interactive "P") - (gnus-summary-reply (gnus-summary-work-articles n))) + (gnus-summary-reply (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 +automatically." + (interactive + (list (and current-prefix-arg + (gnus-summary-work-articles 1)))) + (gnus-summary-reply yank t)) + +(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 full-headers post) "Forward the current message to another user. @@ -592,13 +616,16 @@ If FULL-HEADERS (the prefix), include full headers when forwarding." (if full-headers "" message-included-forward-headers))) (message-forward post)))) -(defun gnus-summary-resend-message (address) +(defun gnus-summary-resend-message (address n) "Resend the current article to ADDRESS." - (interactive "sResend message to: ") - (gnus-summary-select-article) - (save-excursion - (set-buffer gnus-original-article-buffer) - (message-resend 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 full-headers) "Forward the current article to a newsgroup. @@ -606,7 +633,7 @@ If FULL-HEADERS (the prefix), include full headers when forwarding." (interactive "P") (gnus-summary-mail-forward full-headers t)) -(defvar gnus-nastygram-message +(defvar gnus-nastygram-message "The following article was inappropriately posted to %s.\n\n" "Format string to insert in nastygrams. The current group name will be inserted at \"%s\".") @@ -615,7 +642,7 @@ The current group name will be inserted at \"%s\".") "Send a nastygram to the author of the current article." (interactive "P") (when (or gnus-expert-user - (gnus-y-or-n-p + (gnus-y-or-n-p "Really send a nastygram to the author of the current article? ")) (let ((group gnus-newsgroup-name)) (gnus-summary-reply-with-original n) @@ -671,7 +698,7 @@ The current group name will be inserted at \"%s\".") (setq beg (point)) (skip-chars-forward "^,") (while (zerop - (save-excursion + (save-excursion (save-restriction (let ((i 0)) (narrow-to-region beg (point)) @@ -695,8 +722,10 @@ The current group name will be inserted at \"%s\".") (when (and to-address (gnus-alive-p)) ;; This mail group doesn't have a `to-list', so we add one - ;; here. Magic! - (gnus-group-add-parameter group (cons 'to-list to-address))))) + ;; 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 () "Put the current message in some group and return to Gnus." @@ -704,7 +733,7 @@ The current group name will be inserted at \"%s\".") (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)))) @@ -714,7 +743,7 @@ The current group name will be inserted at \"%s\".") (save-excursion (save-restriction (widen) - (gnus-inews-narrow-to-headers) + (message-narrow-to-headers) (let (gnus-deletable-headers) (if (message-news-p) (message-generate-headers message-required-news-headers) @@ -729,7 +758,7 @@ The current group name will be inserted at \"%s\".") (when (gnus-buffer-exists-p (car-safe reply)) (set-buffer (car reply)) (and (cdr reply) - (gnus-summary-mark-article-as-replied + (gnus-summary-mark-article-as-replied (cdr reply)))) (when winconf (set-window-configuration winconf))))) @@ -738,7 +767,7 @@ The current group name will be inserted at \"%s\".") "Send a reply to the address near point. If YANK is non-nil, include the original article." (interactive "P") - (let ((address + (let ((address (buffer-substring (save-excursion (re-search-backward "[ \t\n]" nil t) (1+ (point))) (save-excursion (re-search-forward "[ \t\n]" nil t) (1- (point)))))) @@ -856,15 +885,16 @@ this is a reply." (let* ((references (mail-fetch-field "references")) (parent (and references (gnus-parent-id references)))) (message-bounce) - ;; If there are references, we fetch the article we answered to. + ;; If there are references, we fetch the article we answered to. (and fetch parent (gnus-summary-refer-article parent) (gnus-summary-show-all-headers))))) ;;; Gcc handling. -;; Do Gcc handling, which copied the message over to some 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 @@ -878,11 +908,11 @@ this is a reply." (setq groups (message-tokenize-header gcc " ,")) ;; Copy the article over to some group(s). (while (setq group (pop groups)) - (gnus-check-server + (gnus-check-server (setq method (cond ((and (null (gnus-get-info group)) (eq (car gnus-message-archive-method) - (car + (car (gnus-server-to-method (gnus-group-method group))))) ;; If the group doesn't exist, we assume @@ -900,12 +930,12 @@ this is a reply." (nnheader-set-temp-buffer " *acc*") (insert-buffer-substring cur) (goto-char (point-min)) - (when (re-search-forward + (when (re-search-forward (concat "^" (regexp-quote mail-header-separator) "$") nil t) (replace-match "" t t )) (unless (gnus-request-accept-article group method t) - (gnus-message 1 "Couldn't store article in group %s: %s" + (gnus-message 1 "Couldn't store article in group %s: %s" group (gnus-status-message method)) (sit-for 2)) (kill-buffer (current-buffer)))))))))) @@ -914,9 +944,9 @@ this is a reply." "Insert Gcc headers based on `gnus-outgoing-message-group'." (save-excursion (save-restriction - (gnus-inews-narrow-to-headers) + (message-narrow-to-headers) (let* ((group gnus-outgoing-message-group) - (gcc (cond + (gcc (cond ((gnus-functionp group) (funcall group)) ((or (stringp group) (list group)) @@ -934,7 +964,7 @@ this is a reply." result gcc-self-val (groups - (cond + (cond ((null gnus-message-archive-method) ;; Ignore. nil) @@ -955,7 +985,7 @@ this is a reply." (while (and var (not (setq result - (cond + (cond ((stringp (caar var)) ;; Regexp. (when (string-match (caar var) group) @@ -973,14 +1003,14 @@ this is a reply." (setq groups (list groups))) (save-excursion (save-restriction - (gnus-inews-narrow-to-headers) + (message-narrow-to-headers) (goto-char (point-max)) (insert "Gcc: ") (if (and gnus-newsgroup-name (setq gcc-self-val (gnus-group-find-parameter gnus-newsgroup-name 'gcc-self))) - (progn + (progn (insert (if (stringp gcc-self-val) gcc-self-val @@ -993,7 +1023,7 @@ this is a reply." (while (setq name (pop groups)) (insert (if (string-match ":" name) name - (gnus-group-prefixed-name + (gnus-group-prefixed-name name gnus-message-archive-method))) (when groups (insert " "))) @@ -1004,7 +1034,7 @@ this is a reply." (interactive) (gnus-set-global-variables) (let (buf) - (if (not (setq buf (gnus-request-restore-buffer + (if (not (setq buf (gnus-request-restore-buffer (gnus-summary-article-number) gnus-newsgroup-name))) (error "Couldn't restore the article") (switch-to-buffer buf) @@ -1019,12 +1049,12 @@ this is a reply." (let ((gnus-draft-buffer (current-buffer))) (gnus-configure-windows 'draft t) (goto-char (point)))))) - + (gnus-add-shutdown 'gnus-inews-close 'gnus) (defun gnus-inews-close () (setq gnus-inews-sent-ids nil)) - + ;;; Allow redefinition of functions. (gnus-ems-redefine)