From: keiichi Date: Thu, 23 Dec 1999 10:11:20 +0000 (+0000) Subject: Sync with Nana-gnus 6.13. X-Git-Tag: nana-gnus-7_1_0_16~99 X-Git-Url: http://git.chise.org/cgi-bin/gitweb.cgi?a=commitdiff_plain;h=116c738e10d0ad72d3c1bb095f7ecd4097f4e65a;p=elisp%2Fgnus.git- Sync with Nana-gnus 6.13. --- diff --git a/lisp/gnus-draft.el b/lisp/gnus-draft.el index 13830b7..cbce8f8 100644 --- a/lisp/gnus-draft.el +++ b/lisp/gnus-draft.el @@ -73,7 +73,6 @@ (when (gnus-visual-p 'draft-menu 'menu) (gnus-draft-make-menu-bar)) (gnus-add-minor-mode 'gnus-draft-mode " Draft" gnus-draft-mode-map) - (mml-mode) (gnus-run-hooks 'gnus-draft-mode-hook)))) ;;; Commands @@ -95,7 +94,7 @@ (interactive) (let ((article (gnus-summary-article-number))) (gnus-summary-mark-as-read article gnus-canceled-mark) - (gnus-draft-setup article gnus-newsgroup-name) + (gnus-draft-setup-for-editing article gnus-newsgroup-name) (set-buffer-modified-p t) (save-buffer) (let ((gnus-verbose-backends nil)) @@ -121,12 +120,9 @@ (defun gnus-draft-send (article &optional group interactive) "Send message ARTICLE." - (gnus-draft-setup article (or group "nndraft:queue")) + (gnus-draft-setup-for-sending article (or group "nndraft:queue")) (let ((message-syntax-checks (if interactive nil 'dont-check-for-anything-just-trust-me)) - (message-inhibit-body-encoding (or (not group) - (equal group "nndraft:queue") - message-inhibit-body-encoding)) (message-send-hook (and group (not (equal group "nndraft:queue")) message-send-hook)) type method) @@ -140,18 +136,37 @@ (setq type (ignore-errors (read (current-buffer))) method (ignore-errors (read (current-buffer)))) (message-remove-header gnus-agent-meta-information-header))) + ;; We read the meta-information that says how and where + ;; this message is to be sent. + (save-restriction + (message-narrow-to-head) + (when (re-search-forward + (concat "^" (regexp-quote gnus-agent-meta-information-header) ":") + nil t) + (setq type (ignore-errors (read (current-buffer))) + method (ignore-errors (read (current-buffer)))) + (message-remove-header gnus-agent-meta-information-header))) ;; Then we send it. If we have no meta-information, we just send ;; it and let Message figure out how. - (when (and (or (null method) - (gnus-server-opened method) - (gnus-open-server method)) - (if type - (let ((message-this-is-news (eq type 'news)) - (message-this-is-mail (eq type 'mail)) - (gnus-post-method method) - (message-post-method method)) - (message-send-and-exit)) - (message-send-and-exit))) + (when (let ((mail-header-separator "")) + (cond ((eq type 'news) + (mime-edit-maybe-split-and-send + (function + (lambda () + (interactive) + (funcall message-send-news-function method) + ))) + (funcall message-send-news-function method) + ) + ((eq type 'mail) + (mime-edit-maybe-split-and-send + (function + (lambda () + (interactive) + (funcall message-send-mail-function) + ))) + (funcall message-send-mail-function) + t))) (let ((gnus-verbose-backends nil)) (gnus-request-expire-articles (list article) (or group "nndraft:queue") t))))) @@ -179,13 +194,18 @@ ;;; Utility functions +(defcustom gnus-draft-decoding-function + #'mime-edit-decode-message-in-buffer + "*Function called to decode the message from network representation." + :group 'gnus-agent + :type 'function) + ;;;!!!If this is byte-compiled, it fails miserably. ;;;!!!This is because `gnus-setup-message' uses uninterned symbols. ;;;!!!This has been fixed in recent versions of Emacs and XEmacs, ;;;!!!but for the time being, we'll just run this tiny function uncompiled. -(progn -(defun gnus-draft-setup (narticle group) +(defun gnus-draft-setup-for-editing (narticle group) (gnus-setup-message 'forward (let ((article narticle)) (message-mail) @@ -193,12 +213,23 @@ (if (not (gnus-request-restore-buffer article group)) (error "Couldn't restore the article") ;; Insert the separator. + (funcall gnus-draft-decoding-function) (goto-char (point-min)) (search-forward "\n\n") (forward-char -1) (insert mail-header-separator) (forward-line 1) - (message-set-auto-save-file-name)))))) + (message-set-auto-save-file-name))))) + +(defvar gnus-draft-send-draft-buffer " *send draft*") +(defun gnus-draft-setup-for-sending (narticle group) + (let ((article narticle)) + (if (not (get-buffer gnus-draft-send-draft-buffer)) + (get-buffer-create gnus-draft-send-draft-buffer)) + (set-buffer gnus-draft-send-draft-buffer) + (erase-buffer) + (if (not (gnus-request-restore-buffer article group)) + (error "Couldn't restore the article")))) (defun gnus-draft-article-sendable-p (article) "Say whether ARTICLE is sendable." diff --git a/lisp/gnus-msg.el b/lisp/gnus-msg.el index 55fdbbf..bfc8915 100644 --- a/lisp/gnus-msg.el +++ b/lisp/gnus-msg.el @@ -194,7 +194,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) @@ -205,8 +209,8 @@ Thank you for your help in stamping out bugs. (setq gnus-message-buffer (current-buffer)) (set (make-local-variable 'gnus-message-group-art) (cons ,group ,article)) - (set (make-local-variable 'gnus-newsgroup-name) ,group) - (set (make-local-variable 'message-posting-charset) + (make-local-variable 'gnus-newsgroup-name) + (set (make-local-variable 'default-mime-charset) (gnus-setup-posting-charset ,group)) (gnus-run-hooks 'gnus-message-setup-hook)) (gnus-add-buffer) @@ -226,7 +230,8 @@ Thank you for your help in stamping out bugs. (funcall (car elem) group)) (and (symbolp (car elem)) (symbol-value (car elem)))) - (throw 'found (cadr elem)))))))) + (throw 'found (cadr elem)))) + default-mime-charset)))) (defun gnus-inews-add-send-actions (winconf buffer article) (make-local-hook 'message-sent-hook) @@ -234,9 +239,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 (concat gnus-product-name "/" gnus-version-number)) + (unless 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 @@ -329,13 +335,24 @@ If prefix argument YANK is non-nil, original article is yanked automatically." (gnus-summary-followup (gnus-summary-work-articles arg) t)) (defun gnus-inews-yank-articles (articles) - (let (beg article) + (let* ((more-than-one (cdr articles)) + (frame (when (and message-use-multi-frames more-than-one) + (window-frame (get-buffer-window (current-buffer))))) + beg article refs) (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)) + (when frame + (select-frame frame)) + ;; Gathering references. + (when more-than-one + (setq refs (message-list-references + refs + (mail-header-references gnus-current-headers) + (mail-header-message-id gnus-current-headers)))) (gnus-copy-article-buffer) (let ((message-reply-buffer gnus-article-copy) (message-reply-headers gnus-current-headers)) @@ -344,6 +361,23 @@ If prefix argument YANK is non-nil, original article is yanked automatically." (when articles (insert "\n"))) (push-mark) + ;; Replace with the gathered references. + (when refs + (push-mark beg) + (save-restriction + (message-narrow-to-headers) + (let ((case-fold-search t)) + (if (re-search-forward "^References:\\([\t ]+.+\n\\)+" nil t) + (replace-match "") + (goto-char (point-max)))) + (mail-header-format + (list (or (assq 'References message-header-format-alist) + '(References . message-fill-references))) + (list (cons 'References + (mapconcat 'identity (nreverse refs) " ")))) + (backward-delete-char 1)) + (setq beg (mark t)) + (pop-mark)) (goto-char beg))) (defun gnus-summary-cancel-article (&optional n symp) @@ -418,6 +452,7 @@ header line with the old Message-ID." (erase-buffer))) ;; Find the original headers. (set-buffer gnus-original-article-buffer) + (widen) (goto-char (point-min)) (while (looking-at message-unix-mail-delimiter) (forward-line 1)) @@ -525,7 +560,6 @@ 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) @@ -567,34 +601,6 @@ If SILENT, don't prompt the user." (t gnus-select-method)))) - -;; Dummies to avoid byte-compile warning. -(defvar nnspool-rejected-article-hook) -(defvar xemacs-codename) - -(defun gnus-extended-version () - "Stringified Gnus version and Emacs version." - (interactive) - (concat - "Gnus/" (prin1-to-string (gnus-continuum-version gnus-version) t) - " (" gnus-version ")" - " " - (cond - ((string-match "^\\(\\([.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 Mail Functions ;;; @@ -661,6 +667,37 @@ If POST, post instead of mail." (run-hooks 'gnus-article-decode-hook) (message-forward post)))) +;;; 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 frame) + (gnus-setup-message 'forward + (gnus-summary-select-article) + (if post (message-news nil subject) (message-mail nil subject)) + (when (and message-use-multi-frames (cdr articles)) + (setq frame (window-frame (get-buffer-window (current-buffer))))) + (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)) + (when frame + (select-frame frame)) + (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") @@ -837,7 +874,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 . ,semi-gnus-developers) (Subject . ""))) (when gnus-bug-create-help-buffer (push `(gnus-bug-kill-buffer) message-send-actions)) (goto-char (point-min)) @@ -849,10 +887,9 @@ If YANK is non-nil, include the original article." (stringp nntp-server-type)) (insert nntp-server-type)) (insert "\n\n\n\n\n") - (save-excursion - (set-buffer (gnus-get-buffer-create " *gnus environment info*")) - (gnus-debug)) - (insert "<#part type=application/x-emacs-lisp buffer=\" *gnus environment info*\" disposition=inline description=\"User settings\"><#/part>") + (insert (mime-make-tag "text" "plane") "\n") + (gnus-debug) + (insert (mime-make-tag "text" "plane") "\n") (goto-char (point-min)) (search-forward "Subject: " nil t) (message ""))) @@ -966,7 +1003,6 @@ this is a reply." (save-restriction (message-narrow-to-headers) (let ((gcc (or gcc (mail-fetch-field "gcc" nil t))) - (cur (current-buffer)) groups group method) (when gcc (message-remove-header "gcc") @@ -994,11 +1030,7 @@ this is a reply." (gnus-request-create-group group method)) (save-excursion (nnheader-set-temp-buffer " *acc*") - (insert-buffer-substring cur) - (message-encode-message-body) - (save-restriction - (message-narrow-to-headers) - (mail-encode-encoded-word-buffer)) + (insert-buffer-substring message-encoding-buffer) (goto-char (point-min)) (when (re-search-forward (concat "^" (regexp-quote mail-header-separator) "$") diff --git a/lisp/gnus-spec.el b/lisp/gnus-spec.el index 5cf3fda..8e7c888 100644 --- a/lisp/gnus-spec.el +++ b/lisp/gnus-spec.el @@ -169,7 +169,10 @@ ;; See whether all the stored info needs to be flushed. (when (or force (not (equal emacs-version - (cdr (assq 'version gnus-format-specs))))) + (cdr (assq 'version gnus-format-specs)))) + (not (equal gnus-version + (cdr (assq 'gnus-version gnus-format-specs))))) + (message "%s" "Force update format specs.") (setq gnus-format-specs nil)) ;; Go through all the formats and see whether they need updating. @@ -212,7 +215,9 @@ (set (intern (format "gnus-%s-line-format-spec" type)) val))))) (unless (assq 'version gnus-format-specs) - (push (cons 'version emacs-version) gnus-format-specs))) + (push (cons 'version emacs-version) gnus-format-specs)) + (unless (assq 'gnus-version gnus-format-specs) + (push (cons 'gnus-version gnus-version) gnus-format-specs))) (defvar gnus-mouse-face-0 'highlight) (defvar gnus-mouse-face-1 'highlight) @@ -420,9 +425,16 @@ (user-defined (setq elem (list - (list (intern (format "gnus-user-format-function-%c" - user-defined)) - 'gnus-tmp-header) + (list 'condition-case 'err + (list (intern (format "gnus-user-format-function-%c" + user-defined)) + 'gnus-tmp-header) + (list 'error + (list 'gnus-error 1 + (format + "Error occured in `gnus-user-format-function-%c: %%s" + user-defined) + 'err) "")) ?s))) ;; Find the specification from `spec-alist'. ((setq elem (cdr (assq spec spec-alist))))