From: yamaoka Date: Tue, 6 Oct 1998 10:27:36 +0000 (+0000) Subject: 1998-10-06 Katsumi Yamaoka X-Git-Tag: pgnus-ichikawa-199811302358~178 X-Git-Url: http://git.chise.org/cgi-bin/gitweb.cgi?a=commitdiff_plain;h=8a41b30f27a064550cea8d98fbc7dab6d8ae89c2;p=elisp%2Fgnus.git- 1998-10-06 Katsumi Yamaoka * lisp/message.el (message-mime-insert-article): Don't refer to `mark' position. * lisp/message.el (message-mime-insert-article): If the optional arg FULL-HEADERS is non-nil, include full headers when inserting. 1998-10-06 Keiichi Suzuki * lisp/message.el (message-parameter-alist): New variable. (message-startup-parameter-alist): New variable. (message-fetch-reply-field): Get reply buffer with `message-get-reply-buffer()'. (message-yank-original): Ditto. (message-eval-parameter): New function. (message-get-reply-buffer): Ditto. (message-get-original-reply-buffer): Ditto. (message-mode): New buffer local variable `message-parameter-alist'. (message-setup): Set up `message-reply-buffer' from `message-parameter-alist'. (message-mime-insert-article): Get `Original message buffer' with `message-get-original-reply-buffer' instead of `gnus-original-article-buffer'. Remove bogus header fields for forwarding message. * lisp/gnus-msg.el (gnus-setup-message): Setup `message-startup-parameter-alist'. 1998-10-05 Yoshiki Hayashi * lisp/gnus.el (gnus-info-filename): New variable. (gnus-info-find-node): Use `gnus-info-filename' and `current-language-environment'. --- diff --git a/lisp/gnus-msg.el b/lisp/gnus-msg.el index ada07d1..33f3f25 100644 --- a/lisp/gnus-msg.el +++ b/lisp/gnus-msg.el @@ -247,7 +247,11 @@ MAX-COLUMN the optional second argument if it is specified, the return value (,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) diff --git a/lisp/gnus-start.el b/lisp/gnus-start.el index da6ea7f..66b1ac4 100644 --- a/lisp/gnus-start.el +++ b/lisp/gnus-start.el @@ -711,6 +711,8 @@ prompt the user for the name of an NNTP server to use." (gnus-group-first-unread-group) (gnus-configure-windows 'group) (gnus-group-set-mode-line) + ;; For reading Info. + (set-language-info "Japanese" 'gnus-info "gnus-ja") (gnus-run-hooks 'gnus-started-hook)))))) (defun gnus-start-draft-setup () diff --git a/lisp/gnus.el b/lisp/gnus.el index f176f24..954a30b 100644 --- a/lisp/gnus.el +++ b/lisp/gnus.el @@ -1496,14 +1496,24 @@ want." semi-gnus-ja@meadow.scphys.kyoto-u.ac.jp (In Japanese);" "The mail address of the Semi-gnus developers.") +(defcustom gnus-info-filename nil + "*Controls language of gnus Info. +If nil and current-language-environment is Japanese, go to gnus-ja. +Otherwise go to corresponding Info. +This variable can be nil, gnus or gnus-ja." + :group 'gnus-start + :type '(choice (const nil) + (const :tag "English" gnus) + (const :tag "Japanese" gnus-ja))) + (defvar gnus-info-nodes - '((gnus-group-mode "(gnus)The Group Buffer") - (gnus-summary-mode "(gnus)The Summary Buffer") - (gnus-article-mode "(gnus)The Article Buffer") - (mime/viewer-mode "(gnus)The Article Buffer") - (gnus-server-mode "(gnus)The Server Buffer") - (gnus-browse-mode "(gnus)Browse Foreign Server") - (gnus-tree-mode "(gnus)Tree Display")) + '((gnus-group-mode "The Group Buffer") + (gnus-summary-mode "The Summary Buffer") + (gnus-article-mode "The Article Buffer") + (mime/viewer-mode "The Article Buffer") + (gnus-server-mode "The Server Buffer") + (gnus-browse-mode "Browse Foreign Server") + (gnus-tree-mode "Tree Display")) "Alist of major modes and related Info nodes.") (defvar gnus-group-buffer "*Group*") @@ -2031,7 +2041,12 @@ If ARG, insert string at point." (interactive) ;; Enlarge info window if needed. (let (gnus-info-buffer) - (Info-goto-node (cadr (assq major-mode gnus-info-nodes))) + (Info-goto-node + (format "(%s)%s" + (or gnus-info-filename + (get-language-info current-language-environment 'gnus-info) + "gnus") + (cadr (assq major-mode gnus-info-nodes)))) (setq gnus-info-buffer (current-buffer)) (gnus-configure-windows 'info))) diff --git a/lisp/message.el b/lisp/message.el index 7628c44..81e5052 100644 --- a/lisp/message.el +++ b/lisp/message.el @@ -661,6 +661,8 @@ If stringp, use this; if non-nil, use no host name (user name only)." (defvar message-postpone-actions nil "A list of actions to be performed after postponing a message.") (defvar message-original-frame nil) +(defvar message-parameter-alist nil) +(defvar message-startup-parameter-alist nil) (define-widget 'message-header-lines 'text "All header lines must be LFD terminated." @@ -1174,11 +1176,12 @@ The cdr of ech entry is a function for applying the face to a region.") (defun message-fetch-reply-field (header) "Fetch FIELD from the message we're replying to." - (when (and message-reply-buffer - (buffer-name message-reply-buffer)) - (save-excursion - (set-buffer message-reply-buffer) - (message-fetch-field header)))) + (let ((buffer (message-get-reply-buffer))) + (when (and buffer + (buffer-name buffer)) + (save-excursion + (set-buffer buffer) + (message-fetch-field header))))) (defun message-set-work-buffer () (if (get-buffer " *message work*") @@ -1334,6 +1337,22 @@ Point is left at the beginning of the narrowed-to region." (1+ max))))) (message-sort-headers-1)))) +(defun message-eval-parameter (parameter) + (condition-case () + (if (symbolp parameter) + (if (functionp parameter) + (funcall parameter) + (eval parameter)) + parameter) + (error nil))) + +(defun message-get-reply-buffer () + (message-eval-parameter message-reply-buffer)) + +(defun message-get-original-reply-buffer () + (message-eval-parameter + (cdr (assq 'original-buffer message-parameter-alist)))) + ;;; @@ -1503,6 +1522,9 @@ C-c C-r message-caesar-buffer-body (rot13 the message body)." (setq message-sent-message-via nil) (make-local-variable 'message-checksum) (setq message-checksum nil) + (make-local-variable 'message-parameter-alist) + (setq message-parameter-alist + (copy-sequence message-startup-parameter-alist)) ;;(when (fboundp 'mail-hist-define-keys) ;; (mail-hist-define-keys)) (when (string-match "XEmacs\\|Lucid" emacs-version) @@ -1916,13 +1938,12 @@ This function uses `message-cite-function' to do the actual citing. Just \\[universal-argument] as argument means don't indent, insert no prefix, and don't delete any headers." (interactive "P") - (let ((modified (buffer-modified-p))) - (when (and message-reply-buffer + (let ((modified (buffer-modified-p)) + (buffer (message-get-reply-buffer))) + (when (and buffer message-cite-function) - (gnus-copy-article-buffer) - (setq message-reply-buffer gnus-article-copy) - (delete-windows-on message-reply-buffer t) - (insert-buffer message-reply-buffer) + (delete-windows-on buffer t) + (insert-buffer buffer) (funcall message-cite-function) (message-exchange-point-and-mark) (unless (bolp) @@ -3492,6 +3513,7 @@ Headers already prepared in the buffer are not modified." (nconc message-buffer-list (list (current-buffer)))))) (defvar mc-modes-alist) +(defvar message-get-reply-buffer-function nil) (defun message-setup (headers &optional replybuffer actions) (when (and (boundp 'mc-modes-alist) (not (assq 'message-mode mc-modes-alist))) @@ -3500,7 +3522,9 @@ Headers already prepared in the buffer are not modified." mc-modes-alist)) (when actions (setq message-send-actions actions)) - (setq message-reply-buffer replybuffer) + (setq message-reply-buffer + (or (cdr (assq 'reply-buffer message-parameter-alist)) + replybuffer)) (goto-char (point-min)) ;; Insert all the headers. (mail-header-format @@ -4465,14 +4489,22 @@ regexp varstr." (run-hooks 'mime-edit-exit-hook) )) -;;; XXX: currently broken; message-yank-original resets message-reply-buffer. -(defun message-mime-insert-article (&optional message) - (interactive) +(defun message-mime-insert-article (&optional full-headers) + (interactive "P") (let ((message-cite-function 'mime-edit-inserted-message-filter) - (message-reply-buffer gnus-original-article-buffer) - ) + (message-reply-buffer (message-get-original-reply-buffer)) + (start (point))) (message-yank-original nil) - )) + (save-excursion + (narrow-to-region (goto-char start) + (if (search-forward "\n\n" nil t) + (1- (point)) + (point-max))) + (goto-char (point-min)) + (let ((message-included-forward-headers + (if full-headers "" message-included-forward-headers))) + (message-remove-header message-included-forward-headers t nil t)) + (widen)))) (set-alist 'mime-edit-message-inserter-alist 'message-mode (function message-mime-insert-article))