From 8f5529f342b4285cd167494a3f9c470c614b85ce Mon Sep 17 00:00:00 2001 From: yamaoka Date: Fri, 20 Nov 1998 06:38:01 +0000 Subject: [PATCH] Sync up with Pterodactyl Gnus v0.52. --- lisp/ChangeLog | 71 ++++++++++++++++++++++++++++++++++++++++++++++++++ lisp/gnus-art.el | 73 +++++++++++++++++++++++++++++++++++++++++----------- lisp/gnus-async.el | 69 ++++++++++++++++++++++++++++++++----------------- lisp/gnus-start.el | 16 ++++++------ lisp/gnus-sum.el | 6 ++++- lisp/gnus.el | 22 +++++++++++++--- lisp/message.el | 4 +-- lisp/mm-decode.el | 17 +++++++----- lisp/mm-view.el | 4 +-- lisp/nntp.el | 71 +++++++++++++++++++++++++++----------------------- lisp/rfc2047.el | 5 +++- 11 files changed, 262 insertions(+), 96 deletions(-) diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 2dcd382..450803f 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,74 @@ +Fri Nov 20 05:30:26 1998 Lars Magne Ingebrigtsen + + * gnus.el: Pterodactyl Gnus v0.52 is released. + +1998-11-20 04:32:23 Lars Magne Ingebrigtsen + + * rfc2047.el (rfc2047-encode-message-header): Encode the default + encoding. + + * gnus-art.el (gnus-mime-display-single): Insert buttons for + undisplayed text types. + + * mm-decode.el (mm-automatic-display-p): Only prefer inlinable + types. + +1998-11-19 Felix Lee + + * nntp.el (nntp-after-change-function-callback): recover from C-g. + +1998-11-19 Felix Lee + + * gnus-async.el (gnus-asynch-obarray): rename to + gnus-async-hashtb, and don't buffer-local it. + + (gnus-async-article-callback): new function. + (gnus-make-async-article-function): use it. + + (gnus-async-current-prefetch-group): new var. + (gnus-async-current-prefetch-article): new var. + (gnus-async-request-fetched-article): are we fetching it already? + + (gnus-async-delete-prefected-entry): s/prefected/prefetched/ + +1998-11-20 02:49:21 Lars Magne Ingebrigtsen + + * gnus-sum.el (gnus-summary-show-article): Require. + + * message.el: Provide before hooks. + (message-send-news): Do MIME before headers. + + * gnus-art.el (gnus-article-check-buffer): New function. + (gnus-article-read-summary-keys): Use it. + + * mm-decode.el (mm-user-automatic-display): Display all inline + images. + + * gnus-art.el (gnus-mime-display-single): Don't buttonize so + much. + (gnus-unbuttonized-mime-types): New variable. + +1998-11-19 06:29:03 Lars Magne Ingebrigtsen + + * gnus-sum.el (gnus-inhibit-user-auto-expire): Changed to t. + + * mm-decode.el (mm-quote-arg): Quote semicolons. + + * gnus-art.el (gnus-mime-display-single): Don't display + attachments. + (gnus-mime-externalize-part): New command and keystroke. + + * mm-decode.el (mm-dissect-buffer): Pass on the description info. + (mm-alternative-precedence): Changed order. + +1998-11-07 17:41:47 Simon Josefsson + + * gnus.el (gnus-method-simplify): New function. + (gnus-native-method-p): New function. + (gnus-secondary-method-p): Use gnus-method-equal. + + * gnus-start.el (gnus-group-change-level): Shorten select method. + Thu Nov 19 04:48:42 1998 Lars Magne Ingebrigtsen * gnus.el: Pterodactyl Gnus v0.51 is released. diff --git a/lisp/gnus-art.el b/lisp/gnus-art.el index 03d0aa5..bacf915 100644 --- a/lisp/gnus-art.el +++ b/lisp/gnus-art.el @@ -564,7 +564,7 @@ displayed by the first non-nil matching CONTENT face." (defcustom gnus-display-mime-function 'gnus-display-mime "Function to display MIME articles." - :group 'gnus-article-headers + :group 'gnus-article-mime :type 'function) (defvar gnus-decode-header-function 'mail-decode-encoded-word-region @@ -593,7 +593,12 @@ displayed by the first non-nil matching CONTENT face." (defcustom gnus-ignored-mime-types nil "List of MIME types that should be ignored by Gnus." - :group 'gnus-mime + :group 'gnus-article-mime + :type '(repeat regexp)) + +(defcustom gnus-unbuttonized-mime-types '(".*/.*") + "List of MIME types that should not be given buttons when rendered." + :group 'gnus-article-mime :type '(repeat regexp)) (defcustom gnus-treat-body-highlight-signature t @@ -607,7 +612,7 @@ displayed by the first non-nil matching CONTENT face." (defcustom gnus-article-mime-part-function nil "Function called with a MIME handle as the argument." - :group 'gnus-article + :group 'gnus-article-mime :type 'function) ;;; Internal variables @@ -2307,6 +2312,7 @@ If ALL-HEADERS is non-nil, no headers are hidden." (gnus-mime-save-part "o" "Save...") (gnus-mime-copy-part "c" "View In Buffer") (gnus-mime-inline-part "i" "View Inline") + (gnus-mime-externalize-part "e" "View Externally") (gnus-mime-pipe-part "|" "Pipe To Command..."))) (defvar gnus-mime-button-map nil) @@ -2322,6 +2328,7 @@ If ALL-HEADERS is non-nil, no headers are hidden." (defun gnus-mime-button-menu (event) "Construct a context-sensitive menu of MIME commands." (interactive "e") + (gnus-article-check-buffer) (let ((response (x-popup-menu t `("MIME Part" ("" ,@(mapcar (lambda (c) @@ -2336,6 +2343,7 @@ If ALL-HEADERS is non-nil, no headers are hidden." (defun gnus-mime-view-all-parts () "View all the MIME parts." (interactive) + (gnus-article-check-buffer) (let ((handles gnus-article-mime-handles)) (while handles (mm-display-part (pop handles))))) @@ -2343,18 +2351,21 @@ If ALL-HEADERS is non-nil, no headers are hidden." (defun gnus-mime-save-part () "Save the MIME part under point." (interactive) + (gnus-article-check-buffer) (let ((data (get-text-property (point) 'gnus-data))) (mm-save-part data))) (defun gnus-mime-pipe-part () "Pipe the MIME part under point to a process." (interactive) + (gnus-article-check-buffer) (let ((data (get-text-property (point) 'gnus-data))) (mm-pipe-part data))) (defun gnus-mime-view-part () "Interactively choose a view method for the MIME part under point." (interactive) + (gnus-article-check-buffer) (let ((data (get-text-property (point) 'gnus-data)) (url-standalone-mode (not gnus-plugged))) (mm-interactively-view-part data))) @@ -2362,6 +2373,7 @@ If ALL-HEADERS is non-nil, no headers are hidden." (defun gnus-mime-copy-part () "Put the the MIME part under point into a new buffer." (interactive) + (gnus-article-check-buffer) (let* ((handle (get-text-property (point) 'gnus-data)) (contents (mm-get-part handle)) (buffer (generate-new-buffer @@ -2379,6 +2391,7 @@ If ALL-HEADERS is non-nil, no headers are hidden." (defun gnus-mime-inline-part () "Insert the MIME part under point into the current buffer." (interactive) + (gnus-article-check-buffer) (let* ((data (get-text-property (point) 'gnus-data)) (contents (mm-get-part data)) (url-standalone-mode (not gnus-plugged)) @@ -2390,6 +2403,17 @@ If ALL-HEADERS is non-nil, no headers are hidden." (mm-insert-inline data contents) (goto-char b)))) +(defun gnus-mime-externalize-part () + "Insert the MIME part under point into the current buffer." + (interactive) + (gnus-article-check-buffer) + (let* ((handle (get-text-property (point) 'gnus-data)) + (url-standalone-mode (not gnus-plugged)) + (mm-user-display-methods nil)) + (if (mm-handle-undisplayer handle) + (mm-remove-part handle) + (mm-display-part handle)))) + (defun gnus-article-view-part (n) "View MIME part N, which is the numerical prefix." (interactive "p") @@ -2518,6 +2542,7 @@ If ALL-HEADERS is non-nil, no headers are hidden." (defun gnus-mime-display-single (handle) (let ((type (car (mm-handle-type handle))) (ignored gnus-ignored-mime-types) + (not-attachment t) display text) (catch 'ignored (progn @@ -2525,24 +2550,33 @@ If ALL-HEADERS is non-nil, no headers are hidden." (when (string-match (pop ignored) type) (throw 'ignored nil))) (if (and (mm-automatic-display-p type) - (mm-inlinable-part-p type) - (or (not (mm-handle-disposition handle)) - (equal (car (mm-handle-disposition handle)) - "inline"))) + (mm-inlinable-part-p type) + (setq not-attachment + (or (not (mm-handle-disposition handle)) + (equal (car (mm-handle-disposition handle)) + "inline")))) (setq display t) (when (equal (car (split-string type "/")) "text") (setq text t))) (let ((id (1+ (length gnus-article-mime-handle-alist)))) (push (cons id handle) gnus-article-mime-handle-alist) - (gnus-insert-mime-button handle id (list (or display text)))) + (when (or (not display) + (not (catch 'found + (let ((types gnus-unbuttonized-mime-types)) + (while types + (when (string-match (pop types) type) + (throw 'found t))))))) + (gnus-insert-mime-button + handle id (list (or display + (and (not not-attachment) text)))))) (insert "\n\n") (cond (display (forward-line -2) (mm-display-part handle t) (goto-char (point-max))) - (text + ((and text not-attachment) (forward-line -2) (insert "\n") (mm-insert-inline handle (mm-get-part handle)) @@ -2569,9 +2603,11 @@ If ALL-HEADERS is non-nil, no headers are hidden." (point)) `(gnus-callback (lambda (handles) + (unless ,(not ibegend) + (setq gnus-article-mime-handle-alist + ',gnus-article-mime-handle-alist)) (gnus-mime-display-alternative - ',ihandles ',not-pref - ',begend ,id)) + ',ihandles ',not-pref ',begend ,id)) local-map ,gnus-mime-button-map ,gnus-mouse-face-prop ,gnus-article-mouse-face face ,gnus-article-button-face @@ -2594,9 +2630,10 @@ If ALL-HEADERS is non-nil, no headers are hidden." (point)) `(gnus-callback (lambda (handles) - (gnus-mime-display-alternative - ',ihandles ',handle - ',begend ,id)) + (unless ,(not ibegend) + (setq gnus-article-mime-handle-alist + ',gnus-article-mime-handle-alist)) + (gnus-mime-display-alternative ',ihandles ',handle ',begend ,id)) local-map ,gnus-mime-button-map ,gnus-mouse-face-prop ,gnus-article-mouse-face face ,gnus-article-button-face @@ -2612,7 +2649,7 @@ If ALL-HEADERS is non-nil, no headers are hidden." (if (stringp (car preferred)) (gnus-display-mime preferred) (mm-display-part preferred) - (goto-char (point-max))) + (goto-char (point-max))) (setcdr begend (point-marker)))) (when ibegend (goto-char point)))) @@ -2811,9 +2848,15 @@ Argument LINES specifies lines to be scrolled down." (setq func (lookup-key (current-local-map) (this-command-keys))) (call-interactively func))) +(defun gnus-article-check-buffer () + "Beep if not in an article buffer." + (unless (equal major-mode 'gnus-article-mode) + (error "Command invoked outside of a Gnus article buffer"))) + (defun gnus-article-read-summary-keys (&optional arg key not-restore-window) "Read a summary buffer key sequence and execute it from the article buffer." (interactive "P") + (gnus-article-check-buffer) (let ((nosaves '("q" "Q" "c" "r" "R" "\C-c\C-f" "m" "a" "f" "F" "Zc" "ZC" "ZE" "ZQ" "ZZ" "Zn" "ZR" "ZG" "ZN" "ZP" diff --git a/lisp/gnus-async.el b/lisp/gnus-async.el index 870192f..e880fa4 100644 --- a/lisp/gnus-async.el +++ b/lisp/gnus-async.el @@ -77,7 +77,9 @@ It should return non-nil if the article is to be prefetched." (defvar gnus-async-article-alist nil) (defvar gnus-async-article-semaphore '(nil)) (defvar gnus-async-fetch-list nil) -(defvar gnus-asynch-obarray nil) +(defvar gnus-async-hashtb nil) +(defvar gnus-async-current-prefetch-group nil) +(defvar gnus-async-current-prefetch-article nil) (defvar gnus-async-prefetch-headers-buffer " *Async Prefetch Headers*") (defvar gnus-async-header-prefetched nil) @@ -117,14 +119,14 @@ It should return non-nil if the article is to be prefetched." (defun gnus-async-close () (gnus-kill-buffer gnus-async-prefetch-article-buffer) (gnus-kill-buffer gnus-async-prefetch-headers-buffer) - (setq gnus-async-article-alist nil + (setq gnus-async-hashtb nil + gnus-async-article-alist nil gnus-async-header-prefetched nil)) (defun gnus-async-set-buffer () (nnheader-set-temp-buffer gnus-async-prefetch-article-buffer t) - (unless gnus-asynch-obarray - (set (make-local-variable 'gnus-asynch-obarray) - (gnus-make-hashtable 1023)))) + (unless gnus-async-hashtb + (setq gnus-async-hashtb (gnus-make-hashtable 1023)))) (defun gnus-async-halt-prefetch () "Stop prefetching." @@ -204,26 +206,33 @@ It should return non-nil if the article is to be prefetched." (when do-message (gnus-message 9 "Prefetching article %d in group %s" article group)) + (setq gnus-async-current-prefetch-group group) + (setq gnus-async-current-prefetch-article article) (gnus-request-article article group)))))))))) (defun gnus-make-async-article-function (group article mark summary next) "Return a callback function." `(lambda (arg) - (save-excursion - (when arg - (gnus-async-set-buffer) - (gnus-async-with-semaphore - (setq - gnus-async-article-alist - (cons (list ',(intern (format "%s-%d" group article) - gnus-asynch-obarray) - ,mark (set-marker (make-marker) (point-max)) - ,group ,article) - gnus-async-article-alist)))) - (if (not (gnus-buffer-live-p ,summary)) - (gnus-async-with-semaphore - (setq gnus-async-fetch-list nil)) - (gnus-async-prefetch-article ,group ,next ,summary t))))) + (gnus-async-article-callback arg ,group ,article ,mark ,summary ,next))) + +(defun gnus-async-article-callback (arg group article mark summary next) + "Function called when an async article is done being fetched." + (save-excursion + (setq gnus-async-current-prefetch-article nil) + (when arg + (gnus-async-set-buffer) + (gnus-async-with-semaphore + (setq + gnus-async-article-alist + (cons (list (intern (format "%s-%d" group article) + gnus-async-hashtb) + mark (set-marker (make-marker) (point-max)) + group article) + gnus-async-article-alist)))) + (if (not (gnus-buffer-live-p summary)) + (gnus-async-with-semaphore + (setq gnus-async-fetch-list nil)) + (gnus-async-prefetch-article group next summary t)))) (defun gnus-async-unread-p (data) "Return non-nil if DATA represents an unread article." @@ -232,6 +241,18 @@ It should return non-nil if the article is to be prefetched." (defun gnus-async-request-fetched-article (group article buffer) "See whether we have ARTICLE from GROUP and put it in BUFFER." (when (numberp article) + (when (and gnus-async-current-prefetch-group + (string= group gnus-async-current-prefetch-group) + (eq article gnus-async-current-prefetch-article)) + (save-excursion + (gnus-async-set-buffer) + (gnus-message 5 "Waiting for async article...") + (let ((proc (nntp-find-connection (current-buffer))) + (nntp-server-buffer (current-buffer)) + (nntp-have-messaged nil)) + (while (eq article (car gnus-async-fetch-list)) + (nntp-accept-process-output proc))) + (gnus-message 5 "Waiting for async article...done"))) (let ((entry (gnus-async-prefetched-article-entry group article))) (when entry (save-excursion @@ -239,10 +260,10 @@ It should return non-nil if the article is to be prefetched." (copy-to-buffer buffer (cadr entry) (caddr entry)) ;; Remove the read article from the prefetch buffer. (when (memq 'read gnus-prefetched-article-deletion-strategy) - (gnus-async-delete-prefected-entry entry)) + (gnus-async-delete-prefetched-entry entry)) t))))) -(defun gnus-async-delete-prefected-entry (entry) +(defun gnus-async-delete-prefetched-entry (entry) "Delete ENTRY from buffer and alist." (ignore-errors (delete-region (cadr entry) (caddr entry)) @@ -261,7 +282,7 @@ It should return non-nil if the article is to be prefetched." (gnus-async-set-buffer) (while alist (when (equal group (nth 3 (car alist))) - (gnus-async-delete-prefected-entry (car alist))) + (gnus-async-delete-prefetched-entry (car alist))) (pop alist)))))) (defun gnus-async-prefetched-article-entry (group article) @@ -269,7 +290,7 @@ It should return non-nil if the article is to be prefetched." (let ((entry (save-excursion (gnus-async-set-buffer) (assq (intern (format "%s-%d" group article) - gnus-asynch-obarray) + gnus-async-hashtb) gnus-async-article-alist)))) ;; Perhaps something has emptied the buffer? (if (and entry diff --git a/lisp/gnus-start.el b/lisp/gnus-start.el index 45b80e1..3738ed9 100644 --- a/lisp/gnus-start.el +++ b/lisp/gnus-start.el @@ -1248,14 +1248,14 @@ for new groups, and subscribe the new groups as zombies." (setq active (gnus-active group)) (setq num (if active (- (1+ (cdr active)) (car active)) t)) - ;; Check whether the group is foreign. If so, the - ;; foreign select method has to be entered into the - ;; info. - (let ((method (or gnus-override-subscribe-method - (gnus-group-method group)))) - (if (eq method gnus-select-method) - (setq info (list group level nil)) - (setq info (list group level nil nil method))))) + ;; Shorten the select method if possible, if we need to + ;; store it at all (native groups). + (let ((method (gnus-method-simplify + (or gnus-override-subscribe-method + (gnus-group-method group))))) + (if method + (setq info (list group level nil nil method)) + (setq info (list group level nil))))) (unless previous (setq previous (let ((p gnus-newsrc-alist)) diff --git a/lisp/gnus-sum.el b/lisp/gnus-sum.el index 39ccda8..01d45d2 100644 --- a/lisp/gnus-sum.el +++ b/lisp/gnus-sum.el @@ -499,7 +499,7 @@ It uses the same syntax as the `gnus-split-methods' variable." :group 'gnus-summary :type '(repeat character)) -(defcustom gnus-inhibit-user-auto-expire nil +(defcustom gnus-inhibit-user-auto-expire t "*If non-nil, user marking commands will not mark an article as expirable, even if the group has auto-expire turned on." :group 'gnus-summary :type 'boolean) @@ -6905,6 +6905,10 @@ article massaging functions being run." (if (not arg) ;; Select the article the normal way. (gnus-summary-select-article nil 'force) + ;; We have to require this here to make sure that the following + ;; dynamic binding isn't shadowed by autoloading. + (require 'gnus-async) + (require 'gnus-art) ;; Bind the article treatment functions to nil. (let ((gnus-have-all-headers t) gnus-article-display-hook diff --git a/lisp/gnus.el b/lisp/gnus.el index cb1d9bf..50cc038 100644 --- a/lisp/gnus.el +++ b/lisp/gnus.el @@ -259,10 +259,10 @@ is restarted, and sometimes reloaded." (defconst gnus-product-name "T-gnus" "Product name of this version of gnus.") -(defconst gnus-version-number "6.10.037" +(defconst gnus-version-number "6.10.038" "Version number for this version of gnus.") -(defconst gnus-original-version-number "0.51" +(defconst gnus-original-version-number "0.52" "Version number for this version of Gnus.") (defconst gnus-original-product-name "Pterodactyl Gnus" @@ -2500,16 +2500,30 @@ You should probably use `gnus-find-method-for-group' instead." possible (list backend server)))))) +(defsubst gnus-native-method-p (method) + "Return whether METHOD is the native select method." + (gnus-method-equal method gnus-select-method)) + (defsubst gnus-secondary-method-p (method) "Return whether METHOD is a secondary select method." (let ((methods gnus-secondary-select-methods) (gmethod (gnus-server-get-method nil method))) (while (and methods - (not (equal (gnus-server-get-method nil (car methods)) - gmethod))) + (not (gnus-method-equal + (gnus-server-get-method nil (car methods)) + gmethod))) (setq methods (cdr methods))) methods)) +(defun gnus-method-simplify (method) + "Return the shortest uniquely identifying string or method for METHOD." + (cond ((gnus-native-method-p method) + nil) + ((gnus-secondary-method-p method) + (format "%s:%s" (nth 0 method) (nth 1 method))) + (t + method))) + (defun gnus-groups-from-server (server) "Return a list of all groups that are fetched from SERVER." (let ((alist (cdr gnus-newsrc-alist)) diff --git a/lisp/message.el b/lisp/message.el index 699d01f..1881daf 100644 --- a/lisp/message.el +++ b/lisp/message.el @@ -4788,8 +4788,8 @@ regexp varstr." (set-buffer buffer) (set-buffer-modified-p nil))) -(run-hooks 'message-load-hook) - (provide 'message) +(run-hooks 'message-load-hook) + ;;; message.el ends here diff --git a/lisp/mm-decode.el b/lisp/mm-decode.el index 04151e0..3ae0f30 100644 --- a/lisp/mm-decode.el +++ b/lisp/mm-decode.el @@ -73,11 +73,11 @@ ("message/delivery-status" . inline))) (defvar mm-user-automatic-display - '("text/plain" "text/enriched" "text/richtext" "text/html" "image/gif" - "image/jpeg" "message/delivery-status" "multipart/.*")) + '("text/plain" "text/enriched" "text/richtext" "text/html" + "image/.*" "message/delivery-status" "multipart/.*")) (defvar mm-alternative-precedence - '("text/plain" "text/enriched" "text/richtext" "text/html") + '("text/html" "text/enriched" "text/richtext" "text/plain") "List that describes the precedence of alternative parts.") (defvar mm-tmp-directory "/tmp/" @@ -107,7 +107,8 @@ description (mail-fetch-field "content-description") id (mail-fetch-field "content-id")))) (if (not ctl) - (mm-dissect-singlepart '("text/plain") nil no-strict-mime nil nil) + (mm-dissect-singlepart + '("text/plain") nil no-strict-mime nil description) (setq type (split-string (car ctl) "/")) (setq subtype (cadr type) type (pop type)) @@ -125,7 +126,8 @@ no-strict-mime (and cd (condition-case () (mail-header-parse-content-disposition cd) - (error nil))))))) + (error nil))) + description)))) (when id (push (cons id result) mm-content-id-alist)) result)))) @@ -369,7 +371,8 @@ external if displayed external." (let ((methods mm-user-automatic-display) method result) (while (setq method (pop methods)) - (when (string-match method type) + (when (and (string-match method type) + (mm-inlinable-p type)) (setq result t methods nil))) result)) @@ -394,7 +397,7 @@ This overrides entries in the mailcap file." "Return a version of ARG that is safe to evaluate in a shell." (let ((pos 0) new-pos accum) ;; *** bug: we don't handle newline characters properly - (while (setq new-pos (string-match "[!`\"$\\& \t{} ]" arg pos)) + (while (setq new-pos (string-match "[;!`\"$\\& \t{} ]" arg pos)) (push (substring arg pos new-pos) accum) (push "\\" accum) (push (list (aref arg new-pos)) accum) diff --git a/lisp/mm-view.el b/lisp/mm-view.el index bea8c6f..3433a68 100644 --- a/lisp/mm-view.el +++ b/lisp/mm-view.el @@ -43,9 +43,9 @@ (setq image (make-image-specifier (vector (intern type) :data (buffer-string))))) (let ((annot (make-annotation image nil 'text))) + (mm-insert-inline handle ".\n") (set-extent-property annot 'mm t) - (set-extent-property annot 'duplicable t) - (mm-insert-inline handle " \n")))) + (set-extent-property annot 'duplicable t)))) (defun mm-inline-text (handle) (let ((type (cadr (split-string (car (mm-handle-type handle)) "/"))) diff --git a/lisp/nntp.el b/lisp/nntp.el index d532a93..32cb196 100644 --- a/lisp/nntp.el +++ b/lisp/nntp.el @@ -904,39 +904,46 @@ password contained in '~/.nntp-authinfo'." (funcall (cadr entry))))))) (defun nntp-after-change-function-callback (beg end len) - (when nntp-process-callback - (save-match-data - (if (and (= beg (point-min)) - (memq (char-after beg) '(?4 ?5))) - ;; Report back error messages. - (save-excursion - (goto-char beg) - (if (looking-at "480") - (nntp-handle-authinfo nntp-process-to-buffer) - (nntp-snarf-error-message) - (funcall nntp-process-callback nil))) - (goto-char end) - (when (and (> (point) nntp-process-start-point) - (re-search-backward nntp-process-wait-for - nntp-process-start-point t)) - (when (gnus-buffer-exists-p nntp-process-to-buffer) - (let ((cur (current-buffer)) - (start nntp-process-start-point)) + (unwind-protect + (when nntp-process-callback + (save-match-data + (if (and (= beg (point-min)) + (memq (char-after beg) '(?4 ?5))) + ;; Report back error messages. (save-excursion - (set-buffer nntp-process-to-buffer) - (goto-char (point-max)) - (let ((b (point))) - (insert-buffer-substring cur start) - (narrow-to-region b (point-max)) - (nntp-decode-text) - (widen))))) - (goto-char end) - (let ((callback nntp-process-callback) - (nntp-inside-change-function t)) - (setq nntp-process-callback nil) - (save-excursion - (funcall callback (buffer-name - (get-buffer nntp-process-to-buffer)))))))))) + (goto-char beg) + (if (looking-at "480") + (nntp-handle-authinfo nntp-process-to-buffer) + (nntp-snarf-error-message) + (funcall nntp-process-callback nil))) + (goto-char end) + (when (and (> (point) nntp-process-start-point) + (re-search-backward nntp-process-wait-for + nntp-process-start-point t)) + (when (gnus-buffer-exists-p nntp-process-to-buffer) + (let ((cur (current-buffer)) + (start nntp-process-start-point)) + (save-excursion + (set-buffer nntp-process-to-buffer) + (goto-char (point-max)) + (let ((b (point))) + (insert-buffer-substring cur start) + (narrow-to-region b (point-max)) + (nntp-decode-text) + (widen))))) + (goto-char end) + (let ((callback nntp-process-callback) + (nntp-inside-change-function t)) + (setq nntp-process-callback nil) + (save-excursion + (funcall callback (buffer-name + (get-buffer nntp-process-to-buffer))))))))) + + ;; any throw from after-change-functions will leave it + ;; set to nil. so we reset it here, if necessary. + (when quit-flag + (setq after-change-functions + (list 'nntp-after-change-function-callback))))) (defun nntp-snarf-error-message () "Save the error message in the current buffer." diff --git a/lisp/rfc2047.el b/lisp/rfc2047.el index 4c2a8d1..d3eb033 100644 --- a/lisp/rfc2047.el +++ b/lisp/rfc2047.el @@ -129,7 +129,10 @@ Should be called narrowed to the head of the message." (rfc2047-encode-region (point-min) (point-max))) ;; Hm. (t)))) - (goto-char (point-max)))))))) + (goto-char (point-max))))) + (when rfc2047-default-charset + (encode-coding-region (point-min) (point-max) + rfc2047-default-charset))))) (defun rfc2047-encodable-p () "Say whether the current (narrowed) buffer contains characters that need encoding." -- 1.7.10.4