X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=lisp%2Fgnus-msg.el;h=116ad3454d375d2a66d7324909145adac73b5593;hb=0a676cddd8ea50d8a08d60ed2c6280a1f67c0c11;hp=1330288e966410f1ddbaa7646ce762d9d3f9cd9f;hpb=cda270b73d89201b8072b013dfde919798b168d6;p=elisp%2Fgnus.git- diff --git a/lisp/gnus-msg.el b/lisp/gnus-msg.el index 1330288..116ad34 100644 --- a/lisp/gnus-msg.el +++ b/lisp/gnus-msg.el @@ -1,9 +1,11 @@ -;;; gnus-msg.el --- mail and post interface for Gnus +;;; gnus-msg.el --- mail and post interface for Semi-gnus ;; Copyright (C) 1995,96,97,98 Free Software Foundation, Inc. ;; Author: Masanobu UMEDA ;; Lars Magne Ingebrigtsen -;; Keywords: news +;; MORIOKA Tomohiko +;; Shuhei KOBAYASHI +;; Keywords: mail, news, MIME ;; This file is part of GNU Emacs. @@ -119,7 +121,13 @@ the second with the current group name.") (defvar gnus-message-group-art nil) (defconst gnus-bug-message - "Sending a bug report to the Gnus Towers. + (format "Sending a bug report to the Gnus Towers. +======================================== + +This gnus is the %s%s. +If you think the bug is a Semi-gnus bug, send a bug report to Semi-gnus +Developers. (the addresses below are mailing list addresses) + ======================================== The buffer below is a mail buffer. When you press `C-c C-c', it will @@ -136,7 +144,12 @@ and include the backtrace in your bug report. Please describe the bug in annoying, painstaking detail. Thank you for your help in stamping out bugs. -") +" + + gnus-product-name + (if (string= gnus-product-name "Semi-gnus") + "" + ", a modified version of Semi-gnus"))) (eval-and-compile (autoload 'gnus-uu-post-news "gnus-uu" nil t) @@ -167,8 +180,8 @@ Thank you for your help in stamping out bugs. "\M-c" gnus-summary-mail-crosspost-complaint "om" gnus-summary-mail-forward "op" gnus-summary-post-forward - "Om" gnus-uu-digest-mail-forward - "Op" gnus-uu-digest-post-forward) + "Om" gnus-summary-mail-digest + "Op" gnus-summary-post-digest) (gnus-define-keys (gnus-send-bounce-map "D" gnus-summary-send-map) "b" gnus-summary-resend-bounced-mail @@ -189,7 +202,11 @@ Thank you for your help in stamping out bugs. (,group gnus-newsgroup-name) (message-header-setup-hook (copy-sequence message-header-setup-hook)) - (message-mode-hook (copy-sequence message-mode-hook))) + (message-mode-hook (copy-sequence message-mode-hook)) + (message-startup-parameter-alist + '((reply-buffer . gnus-copy-article-buffer) + (original-buffer . gnus-original-article-buffer) + (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) @@ -212,9 +229,10 @@ Thank you for your help in stamping out bugs. (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) + (setq message-user-agent (gnus-extended-version)) + (when (not message-use-multi-frames) + (message-add-action + `(set-window-configuration ,winconf) 'exit 'postpone 'kill)) (message-add-action `(when (gnus-buffer-exists-p ,buffer) (save-excursion @@ -228,20 +246,11 @@ Thank you for your help in stamping out bugs. ;;; Post news commands of Gnus group mode and summary mode -(defun gnus-group-mail (&optional arg) - "Start composing a mail. -If ARG, use the group under the point to find a posting style. -If ARG is 1, prompt for a group name to find the posting style." - (interactive "P") - (let ((gnus-newsgroup-name - (if arg - (if (= 1 (prefix-numeric-value arg)) - (completing-read "Use style of group: " gnus-active-hashtb nil - (gnus-read-active-file-p)) - (gnus-group-group-name)) - ""))) - (gnus-setup-message 'message (message-mail)) - )) +(defun gnus-group-mail () + "Start composing a mail." + (interactive) + (gnus-setup-message 'message + (message-mail))) (defun gnus-group-post-news (&optional arg) "Start composing a news message. @@ -328,8 +337,10 @@ post using the current select method." article) (while (setq article (pop articles)) (when (gnus-summary-select-article t nil nil article) - (when (gnus-eval-in-buffer-window gnus-original-article-buffer - (message-cancel-news)) + (when (gnus-eval-in-buffer-window gnus-article-buffer + (save-excursion + (set-buffer gnus-original-article-buffer) + (message-cancel-news))) (gnus-summary-mark-as-read article gnus-canceled-mark) (gnus-cache-remove-article 1)) (gnus-article-hide-headers-if-wanted)) @@ -340,7 +351,8 @@ post using the current select method." This is done simply by taking the old article and adding a Supersedes header line with the old Message-ID." (interactive) - (let ((article (gnus-summary-article-number))) + (let ((article (gnus-summary-article-number)) + gnus-message-setup-hook) (gnus-setup-message 'reply-yank (gnus-summary-select-article t) (set-buffer gnus-original-article-buffer) @@ -363,9 +375,6 @@ header line with the old Message-ID." ;; this buffer should be passed to all mail/news reply/post routines. (setq gnus-article-copy (gnus-get-buffer-create " *gnus article copy*")) (buffer-disable-undo gnus-article-copy) - (save-excursion - (set-buffer gnus-article-copy) - (mm-enable-multibyte)) (let ((article-buffer (or article-buffer gnus-article-buffer)) end beg) (if (not (and (get-buffer article-buffer) @@ -495,16 +504,14 @@ If SILENT, don't prompt the user." (list gnus-post-method))) gnus-secondary-select-methods (mapcar 'cdr gnus-server-alist) - (mapcar 'car gnus-opened-servers) (list gnus-select-method) (list group-method))) method-alist post-methods method) ;; Weed out all mail methods. (while methods (setq method (gnus-server-get-method "" (pop methods))) - (when (and (or (gnus-method-option-p method 'post) - (gnus-method-option-p method 'post-mail)) - (not (member method post-methods))) + (when (or (gnus-method-option-p method 'post) + (gnus-method-option-p method 'post-mail)) (push method post-methods))) ;; Create a name-method alist. (setq method-alist @@ -541,34 +548,51 @@ If SILENT, don't prompt the user." (defvar nnspool-rejected-article-hook) (defvar xemacs-codename) -;;; Since the X-Newsreader/X-Mailer are ``vanity'' headers, they might -;;; as well include the Emacs version as well. -;;; The following function works with later GNU Emacs, and XEmacs. (defun gnus-extended-version () - "Stringified Gnus version and Emacs version." + "Stringified gnus version." (interactive) - (concat - gnus-version - "/" - (cond - ((string-match "^\\([0-9]+\\.[0-9]+\\)\\.[.0-9]+$" emacs-version) - (concat "Emacs " (substring emacs-version - (match-beginning 1) - (match-end 1)))) - ((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) - (if (match-beginning 3) - (substring emacs-version - (match-beginning 3) - (match-end 3)) - "") - (if (boundp 'xemacs-codename) - (concat " - \"" xemacs-codename "\"")))) - (t emacs-version)))) + (concat gnus-product-name "/" gnus-version-number)) + +(defun gnus-message-make-user-agent (&optional include-mime-info max-column) + "Return user-agent info. +INCLUDE-MIME-INFO the optional first argument if it is non-nil and the variable + `mime-edit-user-agent-value' exists, the return value will include it. +MAX-COLUMN the optional second argument if it is specified, the return value + will be folded up in the proper way." + (let ((user-agent (if (and include-mime-info + (boundp 'mime-edit-user-agent-value)) + (concat (gnus-extended-version) + " " + mime-edit-user-agent-value) + (gnus-extended-version)))) + (if max-column + (let (boundary) + (unless (natnump max-column) (setq max-column 76)) + (with-temp-buffer + (insert " " user-agent) + (goto-char 13) + (while (re-search-forward "[\n\t ]+" nil t) + (replace-match " ")) + (goto-char 13) + (while (re-search-forward "[^ ()/]+\\(/[^ ()/]+\\)? ?" nil t) + (while (eq ?\( (char-after (point))) + (forward-list) + (skip-chars-forward " ")) + (skip-chars-backward " ") + (if (> (current-column) max-column) + (progn + (if (or (not boundary) (eq ?\n (char-after boundary))) + (progn + (setq boundary (point)) + (unless (eobp) + (delete-char 1) + (insert "\n "))) + (goto-char boundary) + (delete-char 1) + (insert "\n "))) + (setq boundary (point)))) + (buffer-substring 13 (point-max)))) + user-agent))) ;;; @@ -623,11 +647,48 @@ If FULL-HEADERS (the prefix), include full headers when forwarding." (interactive "P") (gnus-setup-message 'forward (gnus-summary-select-article) - (set-buffer gnus-original-article-buffer) + (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)))) +(defun gnus-summary-post-forward (&optional full-headers) + "Forward the current article to a newsgroup. +If FULL-HEADERS (the prefix), include full headers when forwarding." + (interactive "P") + (gnus-summary-mail-forward full-headers t)) + +;;; XXX: generate Subject and ``Topics''? +(defun gnus-summary-mail-digest (&optional n post) + "Digests and forwards all articles in this series." + (interactive "P") + (let ((subject "Digested Articles") + (articles (gnus-summary-work-articles n)) + article) + (gnus-setup-message 'forward + (gnus-summary-select-article) + (if post (message-news nil subject) (message-mail nil subject)) + (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)) + (insert (mime-make-tag "message" "rfc822") "\n") + (insert-buffer-substring gnus-original-article-buffer)) + (push-mark) + (message-goto-body) + (mime-edit-enclose-digest-region (point)(mark t))))) + +(defun gnus-summary-post-digest (&optional n) + "Digest and forwards all articles in this series to a newsgroup." + (interactive "P") + (gnus-summary-mail-digest n t)) + (defun gnus-summary-resend-message (address n) "Resend the current article to ADDRESS." (interactive "sResend message(s) to: \nP") @@ -639,12 +700,6 @@ If FULL-HEADERS (the prefix), include full headers when forwarding." (set-buffer gnus-original-article-buffer) (message-resend address))))) -(defun gnus-summary-post-forward (&optional full-headers) - "Forward the current article to a newsgroup. -If FULL-HEADERS (the prefix), include full headers when forwarding." - (interactive "P") - (gnus-summary-mail-forward full-headers t)) - (defvar gnus-nastygram-message "The following article was inappropriately posted to %s.\n\n" "Format string to insert in nastygrams. @@ -803,7 +858,8 @@ If YANK is non-nil, include the original article." (insert gnus-bug-message) (goto-char (point-min))) (message-pop-to-buffer "*Gnus Bug*") - (message-setup `((To . ,gnus-maintainer) (Subject . ""))) + (message-setup + `((To . ,gnus-maintainer) (Cc . ,semi-gnus-developers) (Subject . ""))) (when gnus-bug-create-help-buffer (push `(gnus-bug-kill-buffer) message-send-actions)) (goto-char (point-min)) @@ -898,14 +954,15 @@ this is a reply." (interactive "P") (gnus-summary-select-article t) (set-buffer gnus-original-article-buffer) - (gnus-setup-message 'compose-bounce - (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. - (and fetch parent - (gnus-summary-refer-article parent) - (gnus-summary-show-all-headers))))) + (let (gnus-message-setup-hook) + (gnus-setup-message 'compose-bounce + (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. + (and fetch parent + (gnus-summary-refer-article parent) + (gnus-summary-show-all-headers)))))) ;;; Gcc handling. @@ -917,7 +974,7 @@ this is a reply." (save-restriction (message-narrow-to-headers) (let ((gcc (or gcc (mail-fetch-field "gcc" nil t))) - (cur (current-buffer)) + (coding-system-for-write 'raw-text) groups group method) (when gcc (message-remove-header "gcc") @@ -945,7 +1002,8 @@ this is a reply." (gnus-request-create-group group method)) (save-excursion (nnheader-set-temp-buffer " *acc*") - (insert-buffer-substring cur) + (insert-buffer-substring message-encoding-buffer) + (gnus-run-hooks 'gnus-before-do-gcc-hook) (goto-char (point-min)) (when (re-search-forward (concat "^" (regexp-quote mail-header-separator) "$")