X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;ds=sidebyside;f=lisp%2Fgnus-msg.el;h=0c830cb7d74b131ab7562af6d758e936b0ef9b4a;hb=3fc9d5f194e101969129b567bb75d7cd700d06d3;hp=9077b90364b71b290343cb53782004e97e309d5f;hpb=e7b89fdbd5b964b512e70e7d89b4a0248e2e550e;p=elisp%2Fgnus.git- diff --git a/lisp/gnus-msg.el b/lisp/gnus-msg.el index 9077b90..0c830cb 100644 --- a/lisp/gnus-msg.el +++ b/lisp/gnus-msg.el @@ -1,9 +1,10 @@ -;;; 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 +;; Lars Magne Ingebrigtsen +;; MORIOKA Tomohiko +;; Keywords: mail, news, MIME ;; This file is part of GNU Emacs. @@ -97,22 +98,8 @@ the second with the current group name.") (defvar gnus-bug-create-help-buffer t "*Should we create the *Gnus Help Bug* buffer?") -(defvar gnus-posting-styles nil - "*Alist of styles to use when posting.") - -(defvar gnus-posting-style-alist - '((organization . message-user-organization) - (signature . message-signature) - (signature-file . message-signature-file) - (address . user-mail-address) - (name . user-full-name)) - "*Mapping from style parameters to variables.") - ;;; Internal variables. -(defvar gnus-inhibit-posting-styles nil - "Inhibit the use of posting styles.") - (defvar gnus-message-buffer "*Mail Gnus*") (defvar gnus-article-copy nil) (defvar gnus-last-posting-server nil) @@ -188,11 +175,9 @@ Thank you for your help in stamping out bugs. (,article (and gnus-article-reply (gnus-summary-article-number))) (,group gnus-newsgroup-name) (message-header-setup-hook - (copy-sequence message-header-setup-hook)) - (message-mode-hook (copy-sequence message-mode-hook))) + (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) - (add-hook 'message-mode-hook 'gnus-configure-posting-styles) (unwind-protect (progn ,@forms) @@ -202,7 +187,6 @@ Thank you for your help in stamping out bugs. (cons ,group ,article)) (make-local-variable 'gnus-newsgroup-name) (gnus-run-hooks 'gnus-message-setup-hook)) - (gnus-add-buffer) (gnus-configure-windows ,config t) (set-buffer-modified-p nil)))) @@ -228,20 +212,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 +303,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)) @@ -361,12 +338,12 @@ header line with the old Message-ID." ;; this copy is in the buffer gnus-article-copy. ;; if ARTICLE-BUFFER is nil, gnus-article-buffer is used ;; this buffer should be passed to all mail/news reply/post routines. - (setq gnus-article-copy (gnus-get-buffer-create " *gnus article copy*")) - (save-excursion - (set-buffer gnus-article-copy) - (mm-enable-multibyte)) + (setq gnus-article-copy (get-buffer-create " *gnus article copy*")) + (buffer-disable-undo gnus-article-copy) + (or (memq gnus-article-copy gnus-buffer-list) + (push gnus-article-copy gnus-buffer-list)) (let ((article-buffer (or article-buffer gnus-article-buffer)) - end beg) + end beg contents) (if (not (and (get-buffer article-buffer) (gnus-buffer-exists-p article-buffer))) (error "Can't find any article buffer") @@ -398,7 +375,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-encoded-words))) + (gnus-article-decode-rfc1522))) gnus-article-copy))) (defun gnus-post-news (post &optional group header article-buffer yank subject @@ -494,16 +471,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 @@ -525,42 +500,26 @@ If SILENT, don't prompt the user." method-alist)))) ;; Override normal method. ((and (eq gnus-post-method 'current) - (not (eq (car group-method) 'nndraft)) (not arg)) group-method) - ((and gnus-post-method - (not (eq gnus-post-method 'current))) + (gnus-post-method gnus-post-method) ;; Use the normal select method. (t gnus-select-method)))) -;; Dummies to avoid byte-compile warning. +;; Dummy to avoid byte-compile warning. (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/" (prin1-to-string (gnus-continuum-version gnus-version) t) - " (" gnus-version ")" - " " - (cond - ((string-match "^\\([0-9]+\\.[0-9]+\\)\\.[.0-9]+$" emacs-version) - (concat "Emacs/" (match-string 1 emacs-version))) - ((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 ")") - ""))) - (t emacs-version)))) + gnus-version) ;;; @@ -615,7 +574,11 @@ 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)))) @@ -830,7 +793,8 @@ The source file has to be in the Emacs load path." (sit-for 0) ;; Go through all the files looking for non-default values for variables. (save-excursion - (set-buffer (gnus-get-buffer-create " *gnus bug info*")) + (set-buffer (get-buffer-create " *gnus bug info*")) + (buffer-disable-undo (current-buffer)) (while files (erase-buffer) (when (and (setq file (locate-library (pop files))) @@ -908,7 +872,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") @@ -936,13 +900,14 @@ 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) "$") nil t) (replace-match "" t t )) - (unless (gnus-request-accept-article group method t t) + (unless (gnus-request-accept-article group method t) (gnus-message 1 "Couldn't store article in group %s: %s" group (gnus-status-message method)) (sit-for 2)) @@ -1039,89 +1004,6 @@ this is a reply." (insert " "))) (insert "\n"))))))) -;;; Posting styles. - -(defvar gnus-message-style-insertions nil) - -(defun gnus-configure-posting-styles () - "Configure posting styles according to `gnus-posting-styles'." - (unless gnus-inhibit-posting-styles - (let ((styles gnus-posting-styles) - (gnus-newsgroup-name (or gnus-newsgroup-name "")) - style match variable attribute value value-value) - (make-local-variable 'gnus-message-style-insertions) - ;; Go through all styles and look for matches. - (while styles - (setq style (pop styles) - match (pop style)) - (when (cond ((stringp match) - ;; Regexp string match on the group name. - (string-match match gnus-newsgroup-name)) - ((or (symbolp match) - (gnus-functionp match)) - (cond ((gnus-functionp match) - ;; Function to be called. - (funcall match)) - ((boundp match) - ;; Variable to be checked. - (symbol-value match)))) - ((listp match) - ;; This is a form to be evaled. - (eval match))) - ;; We have a match, so we set the variables. - (while style - (setq attribute (pop style) - value (cadr attribute) - variable nil) - ;; We find the variable that is to be modified. - (if (and (not (stringp (car attribute))) - (not (eq 'body (car attribute))) - (not (setq variable - (cdr (assq (car attribute) - gnus-posting-style-alist))))) - (message "Couldn't find attribute %s" (car attribute)) - ;; We get the value. - (setq value-value - (cond ((stringp value) - value) - ((or (symbolp value) - (gnus-functionp value)) - (cond ((gnus-functionp value) - (funcall value)) - ((boundp value) - (symbol-value value)))) - ((listp value) - (eval value)))) - (if variable - ;; This is an ordinary variable. - (set (make-local-variable variable) value-value) - ;; This is either a body or a header to be inserted in the - ;; message. - (when value-value - (let ((attr (car attribute))) - (make-local-variable 'message-setup-hook) - (if (eq 'body attr) - (add-hook 'message-setup-hook - `(lambda () - (save-excursion - (message-goto-body) - (insert ,value-value)))) - (add-hook 'message-setup-hook - 'gnus-message-insert-stylings) - (push (cons (if (stringp attr) attr - (symbol-name attr)) - value-value) - gnus-message-style-insertions)))))))))))) - -(defun gnus-message-insert-stylings () - (let (val) - (save-excursion - (message-goto-eoh) - (while (setq val (pop gnus-message-style-insertions)) - (when (cdr val) - (insert (car val) ": " (cdr val) "\n")) - (gnus-pull (car val) gnus-message-style-insertions))))) - ;;; Allow redefinition of functions. (gnus-ems-redefine)