From db857b4d28af9b2cacb93c1017afb70184375ca4 Mon Sep 17 00:00:00 2001 From: ichikawa Date: Tue, 1 Dec 1998 02:30:20 +0000 Subject: [PATCH] Importing pgnus-0.57 --- lisp/ChangeLog | 72 +++++++++++++++++++++++++ lisp/binhex.el | 2 +- lisp/gnus-art.el | 56 +++++++++++++++---- lisp/gnus-async.el | 47 +++++++++++----- lisp/gnus-sum.el | 49 ++++++++++------- lisp/gnus-util.el | 15 ++++-- lisp/gnus.el | 2 +- lisp/mm-bodies.el | 4 ++ lisp/mm-decode.el | 46 +++++++++++----- lisp/mml.el | 6 ++- lisp/nndb.el | 4 +- lisp/nnfolder.el | 6 ++- lisp/nnmail.el | 5 ++ lisp/nnml.el | 6 ++- lisp/nntp.el | 151 ++++++++++++++++++++++++++++++++++------------------ lisp/uudecode.el | 2 +- texi/message.texi | 6 +-- 17 files changed, 354 insertions(+), 125 deletions(-) diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 79cbebc..3becb7b 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,75 @@ +Mon Nov 30 21:57:00 1998 Lars Magne Ingebrigtsen + + * gnus.el: Pterodactyl Gnus v0.57 is released. + +1998-11-23 Felix Lee + + * nntp.el (nntp-async-needs-kluge): new setting. + (nntp-async-timer): new var. + (nntp-async-process-list): new var. + (nntp-async-kluge): new function. + (nntp-async-timer-handler): new function. + (nntp-async-wait): new function. + (nntp-async-stop): new function. + (nntp-after-change-function): renamed, and split apart. + (nntp-async-trigger): new function. + (nntp-do-callback): new function. + (nntp-accept-process-output): add optional timeout arg. + + * gnus-async.el (gnus-async-request-fetched-article): fixed. + (gnus-async-wait-for-article): new function. + (gnus-async-with-semaphore): s/asynch/async/. + +1998-11-30 16:54:56 Lars Magne Ingebrigtsen + + * gnus-art.el (gnus-with-article): Don't encode. + (gnus-insert-mime-button): Fall back on filename from C-D. + (gnus-mime-display-single): Have dots right on text/plain + attachments. + + * mm-decode.el (mm-dissect-buffer): Respect Content-Disposition in + broken parts. + + * gnus-art.el (gnus-with-article): Flush cache and backlog. + + * mm-bodies.el (mm-decode-content-transfer-encoding): Also do + binhex. + + * gnus-sum.el (gnus-summary-reparent-thread): Use new macro. + (gnus-summary-repair-multipart): New command and keystroke. + + * gnus-art.el (gnus-with-article-buffer): New macro. + +Sun Nov 29 23:51:57 1998 Shenghuo ZHU + + * gnus-art.el (gnus-mime-inline-part): Do not get part when + undisplay the part. + +1998-11-30 03:38:35 Lars Magne Ingebrigtsen + + * gnus-util.el (gnus-make-sort-function-1): Allow lambdas. + + * mml.el (mml-read-part): Partition right. + + * mm-decode.el (mm-handle-set-cache): New macro. + (mm-handle-cache): Ditto. + (mm-make-handle): Ditto. + (mm-dissect-singlepart): Use it. + (mm-get-image): Use the cache. + +1998-11-29 23:44:44 Lars Magne Ingebrigtsen + + * gnus-art.el (gnus-mime-display-mixed): Rewrite. + (gnus-mime-display-single): Don't insert lines between parts. + +Sun Nov 29 04:55:40 1998 Shenghuo ZHU + + * nnmail.el (nnmail-file-coding-system-1): New variable. + * nnfolder.el (nnfolder-file-coding-system): Ditto. + (nnfolder-read-folder): Use nnfolder-file-coding-system. + * nnml.el (nnml-file-coding-system): New variable. + (nnml-request-article): Use nnml-file-coding-system. + Sun Nov 29 15:12:52 1998 Lars Magne Ingebrigtsen * gnus.el: Pterodactyl Gnus v0.56 is released. diff --git a/lisp/binhex.el b/lisp/binhex.el index 3017479..6d5a659 100644 --- a/lisp/binhex.el +++ b/lisp/binhex.el @@ -3,7 +3,7 @@ ;; Author: Shenghuo Zhu ;; Create Date: Oct 1, 1998 -;; $Revision: 1.1.1.3 $ +;; $Revision: 1.1.1.4 $ ;; Time-stamp: ;; Keywords: binhex diff --git a/lisp/gnus-art.el b/lisp/gnus-art.el index 7ea2327..b912b57 100644 --- a/lisp/gnus-art.el +++ b/lisp/gnus-art.el @@ -636,6 +636,38 @@ Initialized from `text-mode-syntax-table.") (max (1- b) (point-min)) b 'intangible (cddr (memq 'intangible props))))) +(defmacro gnus-with-article (article &rest forms) + "Select ARTICLE, copy the contents of the original article buffer to a new buffer, and then perform FORMS there. +Then replace the article with the result." + `(progn + ;; We don't want the article to be marked as read. + (let (gnus-mark-article-hook) + (gnus-summary-select-article t t nil ,article)) + (set-buffer gnus-original-article-buffer) + (let ((buf (format "%s" (buffer-string)))) + (with-temp-buffer + (insert buf) + ,@forms + (unless (gnus-request-replace-article + ,article (car gnus-article-current) + (current-buffer) t) + (error "Couldn't replace article")) + ;; The cache and backlog have to be flushed somewhat. + (when gnus-keep-backlog + (gnus-backlog-remove-article + (car gnus-article-current) (cdr gnus-article-current))) + ;; Flush original article as well. + (save-excursion + (when (get-buffer gnus-original-article-buffer) + (set-buffer gnus-original-article-buffer) + (setq gnus-original-article nil))) + (when gnus-use-cache + (gnus-cache-update-article + (car gnus-article-current) (cdr gnus-article-current))))))) + +(put 'gnus-with-article 'lisp-indent-function 1) +(put 'gnus-with-article 'edebug-form-spec '(form body)) + (defsubst gnus-article-unhide-text (b e) "Remove hidden text properties from region between B and E." (remove-text-properties b e gnus-hidden-properties) @@ -2350,12 +2382,13 @@ If ALL-HEADERS is non-nil, no headers are hidden." (interactive "P") ; For compatibility reasons we are not using "z". (gnus-article-check-buffer) (let* ((data (get-text-property (point) 'gnus-data)) - (contents (mm-get-part data)) + contents ;(url-standalone-mode (not gnus-plugged)) (b (point)) buffer-read-only) (if (mm-handle-undisplayer data) (mm-remove-part data) + (setq contents (mm-get-part data)) (forward-line 2) (when charset (unless (symbolp charset) @@ -2455,6 +2488,8 @@ If ALL-HEADERS is non-nil, no headers are hidden." (defun gnus-insert-mime-button (handle gnus-tmp-id &optional displayed) (let ((gnus-tmp-name (mail-content-type-get (mm-handle-type handle) 'name)) + (filename (mail-content-type-get (mm-handle-disposition handle) + 'filename)) (gnus-tmp-type (car (mm-handle-type handle))) (gnus-tmp-description (mm-handle-description handle)) (gnus-tmp-dots @@ -2465,6 +2500,7 @@ If ALL-HEADERS is non-nil, no headers are hidden." (set-buffer (mm-handle-buffer handle)) (buffer-size))) b e) + (setq gnus-tmp-name (or gnus-tmp-name filename)) (setq gnus-tmp-name (if gnus-tmp-name (concat " (" gnus-tmp-name ")") @@ -2544,14 +2580,13 @@ If ALL-HEADERS is non-nil, no headers are hidden." (funcall gnus-article-mime-part-function handles))) (defun gnus-mime-display-mixed (handles) - (let (handle) - (while (setq handle (pop handles)) - (gnus-mime-display-part handle)))) + (mapcar 'gnus-mime-display-part handles)) (defun gnus-mime-display-single (handle) (let ((type (car (mm-handle-type handle))) (ignored gnus-ignored-mime-types) (not-attachment t) + (move nil) display text) (catch 'ignored (progn @@ -2575,19 +2610,22 @@ If ALL-HEADERS is non-nil, no headers are hidden." (gnus-article-insert-newline) (gnus-insert-mime-button handle id (list (or display - (and (not not-attachment) text)))) - (gnus-article-insert-newline))) - (gnus-article-insert-newline) + (and not-attachment text)))) + (gnus-article-insert-newline) + (gnus-article-insert-newline) + (setq move t))) (cond (display - (forward-line -2) + (when move + (forward-line -2)) (let ((rfc2047-default-charset gnus-newsgroup-default-charset) (mm-charset-iso-8859-1-forced gnus-newsgroup-iso-8859-1-forced)) (mm-display-part handle t)) (goto-char (point-max))) ((and text not-attachment) - (forward-line -2) + (when move + (forward-line -2)) (gnus-article-insert-newline) (mm-insert-inline handle (mm-get-part handle)) (goto-char (point-max)))))))) diff --git a/lisp/gnus-async.el b/lisp/gnus-async.el index e880fa4..64ad755 100644 --- a/lisp/gnus-async.el +++ b/lisp/gnus-async.el @@ -108,8 +108,8 @@ It should return non-nil if the article is to be prefetched." ,@forms) (gnus-async-release-semaphore 'gnus-async-article-semaphore))) -(put 'gnus-asynch-with-semaphore 'lisp-indent-function 0) -(put 'gnus-asynch-with-semaphore 'edebug-form-spec '(body)) +(put 'gnus-async-with-semaphore 'lisp-indent-function 0) +(put 'gnus-async-with-semaphore 'edebug-form-spec '(body)) ;;; ;;; Article prefetch @@ -241,18 +241,9 @@ 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) + (when (and (equal 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"))) + (gnus-async-wait-for-article article)) (let ((entry (gnus-async-prefetched-article-entry group article))) (when entry (save-excursion @@ -263,6 +254,36 @@ It should return non-nil if the article is to be prefetched." (gnus-async-delete-prefetched-entry entry)) t))))) +(defun gnus-async-wait-for-article (article) + "Wait until ARTICLE is no longer the currently-being-fetched article." + (save-excursion + (gnus-async-set-buffer) + (let ((proc (nntp-find-connection (current-buffer))) + (nntp-server-buffer (current-buffer)) + (nntp-have-messaged nil) + (tries 0)) + (condition-case nil + ;; FIXME: we could stop waiting after some + ;; timeout, but this is the wrong place to do it. + ;; rather than checking time-spent-waiting, we + ;; should check time-since-last-output, which + ;; needs to be done in nntp.el. + (while (eq article gnus-async-current-prefetch-article) + (incf tries) + (when (nntp-accept-process-output proc 1) + (setq tries 0)) + (when (and (not nntp-have-messaged) (eq 3 tries)) + (gnus-message 5 "Waiting for async article...") + (setq nntp-have-messaged t))) + (quit + ;; if the user interrupted on a slow/hung connection, + ;; do something friendly. + (when (< 3 tries) + (setq gnus-async-current-prefetch-article nil)) + (signal 'quit nil))) + (when nntp-have-messaged + (gnus-message 5 ""))))) + (defun gnus-async-delete-prefetched-entry (entry) "Delete ENTRY from buffer and alist." (ignore-errors diff --git a/lisp/gnus-sum.el b/lisp/gnus-sum.el index aedd26d..2198a03 100644 --- a/lisp/gnus-sum.el +++ b/lisp/gnus-sum.el @@ -1542,6 +1542,7 @@ increase the score of each group you read." (gnus-define-keys (gnus-summary-mime-map "K" gnus-summary-mode-map) "b" gnus-summary-display-buttonized + "m" gnus-summary-repair-multipart "v" gnus-article-view-part "o" gnus-article-save-part "c" gnus-article-copy-part @@ -8348,25 +8349,15 @@ is non-nil or the Subject: of both articles are the same." (gnus-summary-article-header parent-article)))) (unless (and message-id (not (equal message-id ""))) (error "No message-id in desired parent")) - ;; We don't want the article to be marked as read. - (let (gnus-mark-article-hook) - (gnus-summary-select-article t t nil current-article)) - (set-buffer gnus-original-article-buffer) - (let ((buf (format "%s" (buffer-string)))) - (with-temp-buffer - (insert buf) - (goto-char (point-min)) - (if (re-search-forward "^References: " nil t) - (progn - (re-search-forward "^[^ \t]" nil t) - (forward-line -1) - (end-of-line) - (insert " " message-id)) - (insert "References: " message-id "\n")) - (unless (gnus-request-replace-article - current-article (car gnus-article-current) - (current-buffer)) - (error "Couldn't replace article")))) + (gnus-with-article current-article + (goto-char (point-min)) + (if (re-search-forward "^References: " nil t) + (progn + (re-search-forward "^[^ \t]" nil t) + (forward-line -1) + (end-of-line) + (insert " " message-id)) + (insert "References: " message-id "\n"))) (set-buffer gnus-summary-buffer) (gnus-summary-unmark-all-processable) (gnus-summary-update-article current-article) @@ -9205,7 +9196,25 @@ save those articles instead." (require 'gnus-art) (let ((gnus-unbuttonized-mime-types nil)) (gnus-summary-show-article))) - + +(defun gnus-summary-repair-multipart (article) + "Add a Content-Type header to a multipart article without one." + (interactive (list (gnus-summary-article-number))) + (gnus-with-article article + (message-narrow-to-head) + (goto-char (point-max)) + (widen) + (when (search-forward "\n--" nil t) + (let ((separator (buffer-substring (point) (gnus-point-at-eol)))) + (message-narrow-to-head) + (message-remove-header "Mime-Version") + (message-remove-header "Content-Type") + (goto-char (point-max)) + (insert (format "Content-Type: multipart/mixed; boundary=\"%s\"\n" + separator)) + (insert "Mime-Version: 1.0\n") + (widen))))) + (defun gnus-summary-toggle-display-buttonized () "Toggle the buttonizing of the article buffer." (interactive) diff --git a/lisp/gnus-util.el b/lisp/gnus-util.el index 7ac42e7..510f0db 100644 --- a/lisp/gnus-util.el +++ b/lisp/gnus-util.el @@ -497,11 +497,16 @@ If N, return the Nth ancestor instead." (first 't1) (last 't2)) (when (consp function) - (if (eq (car function) 'not) - (setq function (cadr function) - first 't2 - last 't1) - (error "Invalid sort spec: %s" function))) + (cond + ;; Reversed spec. + ((eq (car function) 'not) + (setq function (cadr function) + first 't2 + last 't1)) + ((gnus-functionp function) + ) + (t + (error "Invalid sort spec: %s" function))))if (if (cdr funs) `(or (,function ,first ,last) (and (not (,function ,last ,first)) diff --git a/lisp/gnus.el b/lisp/gnus.el index db8d2e7..b614576 100644 --- a/lisp/gnus.el +++ b/lisp/gnus.el @@ -254,7 +254,7 @@ is restarted, and sometimes reloaded." :link '(custom-manual "(gnus)Exiting Gnus") :group 'gnus) -(defconst gnus-version-number "0.56" +(defconst gnus-version-number "0.57" "Version number for this version of Gnus.") (defconst gnus-version (format "Pterodactyl Gnus v%s" gnus-version-number) diff --git a/lisp/mm-bodies.el b/lisp/mm-bodies.el index 2cf5a4f..c209d36 100644 --- a/lisp/mm-bodies.el +++ b/lisp/mm-bodies.el @@ -137,6 +137,10 @@ If no encoding was done, nil is returned." (condition-case () (uudecode-decode-region (point-min) (point-max)) (error nil))) + ((eq encoding 'x-binhex) + (condition-case () + (binhex-decode-region (point-min) (point-max)) + (error nil))) ((functionp encoding) (condition-case () (funcall encoding (point-min) (point-max)) diff --git a/lisp/mm-decode.el b/lisp/mm-decode.el index 565c520..a1385fe 100644 --- a/lisp/mm-decode.el +++ b/lisp/mm-decode.el @@ -44,6 +44,14 @@ `(nth 4 ,handle)) (defmacro mm-handle-description (handle) `(nth 5 ,handle)) +(defmacro mm-handle-cache (handle) + `(nth 6 ,handle)) +(defmacro mm-handle-set-cache (handle contents) + `(setcar (nthcdr 6 ,handle) ,contents)) +(defmacro mm-make-handle (&optional buffer type encoding undisplayer + disposition description cache) + `(list ,buffer ,type ,encoding ,undisplayer + ,disposition ,description ,cache)) (defvar mm-inline-media-tests '(("image/jpeg" mm-inline-image @@ -105,10 +113,10 @@ (let (ct ctl type subtype cte cd description id result) (save-restriction (mail-narrow-to-head) - (when (and (or no-strict-mime - (mail-fetch-field "mime-version")) - (setq ct (mail-fetch-field "content-type"))) - (setq ctl (condition-case () (mail-header-parse-content-type ct) + (when (or no-strict-mime + (mail-fetch-field "mime-version")) + (setq ct (mail-fetch-field "content-type") + ctl (condition-case () (mail-header-parse-content-type ct) (error nil)) cte (mail-fetch-field "content-transfer-encoding") cd (mail-fetch-field "content-disposition") @@ -116,7 +124,11 @@ id (mail-fetch-field "content-id")))) (if (not ctl) (mm-dissect-singlepart - '("text/plain") nil no-strict-mime nil description) + '("text/plain") nil no-strict-mime + (and cd (condition-case () + (mail-header-parse-content-disposition cd) + (error nil))) + description) (setq type (split-string (car ctl) "/")) (setq subtype (cadr type) type (pop type)) @@ -145,7 +157,8 @@ (defun mm-dissect-singlepart (ctl cte &optional force cdl description) (when (or force (not (equal "text/plain" (car ctl)))) - (let ((res (list (mm-copy-to-buffer) ctl cte nil cdl description))) + (let ((res (mm-make-handle + (mm-copy-to-buffer) ctl cte nil cdl description))) (push (car res) mm-dissection-list) res))) @@ -512,14 +525,19 @@ This overrides entries in the mailcap file." (defun mm-get-image (handle) "Return an image instance based on HANDLE." - (let ((type (cadr (split-string (car (mm-handle-type handle)) "/")))) - (mm-with-unibyte-buffer - (insert-buffer-substring (mm-handle-buffer handle)) - (mm-decode-content-transfer-encoding - (mm-handle-encoding handle) - (car (mm-handle-type handle))) - (make-image-specifier - (vector (intern type) :data (buffer-string)))))) + (let ((type (cadr (split-string (car (mm-handle-type handle)) "/"))) + spec) + (or (mm-handle-cache handle) + (mm-with-unibyte-buffer + (insert-buffer-substring (mm-handle-buffer handle)) + (mm-decode-content-transfer-encoding + (mm-handle-encoding handle) + (car (mm-handle-type handle))) + (prog1 + (setq spec + (make-image-specifier + (vector (intern type) :data (buffer-string)))) + (mm-handle-set-cache handle spec)))))) (defun mm-image-fit-p (handle) "Say whether the image in HANDLE will fit the current window." diff --git a/lisp/mml.el b/lisp/mml.el index a7f7ffc..6eaf391 100644 --- a/lisp/mml.el +++ b/lisp/mml.el @@ -97,10 +97,12 @@ ;; If the tag ended at the end of the line, we go to the next line. (when (looking-at "[ \t]*\n") (forward-line 1)) - (if (re-search-forward "<#/?\\(multipart\\|part\\|external\\)." nil t) + (if (re-search-forward + "<#\\(/\\)?\\(multipart\\|part\\|external\\)." nil t) (prog1 (buffer-substring beg (match-beginning 0)) - (if (equal (match-string 0) "<#/multipart>") + (if (or (not (match-beginning 1)) + (equal (match-string 2) "multipart")) (goto-char (match-beginning 0)) (when (looking-at "[ \t]*\n") (forward-line 1)))) diff --git a/lisp/nndb.el b/lisp/nndb.el index 17f5359..5244cb5 100644 --- a/lisp/nndb.el +++ b/lisp/nndb.el @@ -291,7 +291,7 @@ Optional LAST is ignored." (nntp-send-buffer "^[23].*\n")) (set-buffer nntp-server-buffer) - (setq msg (buffer-string (point-min) (point-max))) + (setq msg (buffer-substring (point-min) (point-max))) (or (string-match "^\\([0-9]+\\)" msg) (error "nndb: %s" msg)) (setq art (substring msg (match-beginning 1) (match-end 1))) @@ -318,7 +318,7 @@ with the contents of the BUFFER." (deffoo nndb-status-message (&optional server) "Return server status as a string." (set-buffer nntp-server-buffer) - (buffer-string (point-min) (point-max))) + (buffer-substring (point-min) (point-max))) ;; Import stuff from nntp diff --git a/lisp/nnfolder.el b/lisp/nnfolder.el index 5d0d80f..c6ad8e5 100644 --- a/lisp/nnfolder.el +++ b/lisp/nnfolder.el @@ -90,6 +90,7 @@ time saver for large mailboxes.") (defvoo nnfolder-buffer-alist nil) (defvoo nnfolder-scantime-alist nil) (defvoo nnfolder-active-timestamp nil) +(defvoo nnfolder-file-coding-system nnmail-file-coding-system-1) @@ -682,7 +683,10 @@ deleted. Point is left where the deleted region was." (defun nnfolder-read-folder (group) (let* ((file (nnfolder-group-pathname group)) - (buffer (set-buffer (nnheader-find-file-noselect file)))) + (buffer (set-buffer + (let ((nnmail-file-coding-system + nnfolder-file-coding-system)) + (nnheader-find-file-noselect file))))) (if (equal (cadr (assoc group nnfolder-scantime-alist)) (nth 5 (file-attributes file))) ;; This looks up-to-date, so we don't do any scanning. diff --git a/lisp/nnmail.el b/lisp/nnmail.el index c852ad8..d9e4707 100644 --- a/lisp/nnmail.el +++ b/lisp/nnmail.el @@ -496,6 +496,11 @@ parameter. It should return nil, `warn' or `delete'." (defvar nnmail-file-coding-system 'binary "Coding system used in nnmail.") +(defvar nnmail-file-coding-system-1 + (if (string-match "nt" system-configuration) + 'raw-text-dos 'binary) + "Another coding system used in nnmail.") + (defun nnmail-find-file (file) "Insert FILE in server buffer safely." (set-buffer nntp-server-buffer) diff --git a/lisp/nnml.el b/lisp/nnml.el index 4e847bf..0ed3c34 100644 --- a/lisp/nnml.el +++ b/lisp/nnml.el @@ -86,6 +86,8 @@ all. This may very well take some time.") (defvar nnml-nov-buffer-file-name nil) +(defvoo nnml-file-coding-system nnmail-file-coding-system-1) + ;;; Interface functions. @@ -183,7 +185,9 @@ all. This may very well take some time.") (nnheader-report 'nnml "No such file: %s" path)) ((file-directory-p path) (nnheader-report 'nnml "File is a directory: %s" path)) - ((not (save-excursion (nnmail-find-file path))) + ((not (save-excursion (let ((nnmail-file-coding-system + nnml-file-coding-system)) + (nnmail-find-file path)))) (nnheader-report 'nnml "Couldn't read file: %s" path)) (t (nnheader-report 'nnml "Article %s retrieved" id) diff --git a/lisp/nntp.el b/lisp/nntp.el index 237c04a..f6d06d3 100644 --- a/lisp/nntp.el +++ b/lisp/nntp.el @@ -209,6 +209,16 @@ If this variable is nil, which is the default, no timers are set.") (defvoo nntp-server-xover 'try) (defvoo nntp-server-list-active-group 'try) +(defvar nntp-async-needs-kluge + (string-match "^GNU Emacs 20\\.3\\." (emacs-version)) + "*When non-nil, nntp will poll asynchronous connections +once a second. By default, this is turned on only for Emacs +20.3, which has a bug that breaks nntp's normal method of +noticing asynchronous data.") + +(defvar nntp-async-timer nil) +(defvar nntp-async-process-list nil) + (eval-and-compile (autoload 'nnmail-read-passwd "nnmail") (autoload 'open-ssl-stream "ssl")) @@ -325,17 +335,7 @@ If this variable is nil, which is the default, no timers are set.") ((eq callback 'ignore) t) ((and callback wait-for) - (save-excursion - (set-buffer (process-buffer process)) - (unless nntp-inside-change-function - (erase-buffer)) - (setq nntp-process-decode decode - nntp-process-to-buffer buffer - nntp-process-wait-for wait-for - nntp-process-callback callback - nntp-process-start-point (point-max) - after-change-functions - (list 'nntp-after-change-function-callback))) + (nntp-async-wait process wait-for buffer decode callback) t) (wait-for (nntp-wait-for process wait-for buffer decode)) @@ -904,48 +904,95 @@ password contained in '~/.nntp-authinfo'." (eval (cadr entry)) (funcall (cadr entry))))))) -(defun nntp-after-change-function-callback (beg end len) +(defun nntp-async-wait (process wait-for buffer decode callback) + (save-excursion + (set-buffer (process-buffer process)) + (unless nntp-inside-change-function + (erase-buffer)) + (setq nntp-process-wait-for wait-for + nntp-process-to-buffer buffer + nntp-process-decode decode + nntp-process-callback callback + nntp-process-start-point (point-max)) + (setq after-change-functions '(nntp-after-change-function)) + (if nntp-async-needs-kluge + (nntp-async-kluge process)))) + +(defun nntp-async-kluge (process) + ;; emacs 20.3 bug: process output with encoding 'binary + ;; doesn't trigger after-change-functions. + (unless nntp-async-timer + (setq nntp-async-timer + (nnheader-run-at-time 1 1 'nntp-async-timer-handler))) + (add-to-list 'nntp-async-process-list process)) + +(defun nntp-async-timer-handler () + (mapcar + (lambda (proc) + (if (memq (process-status proc) '(open run)) + (nntp-async-trigger proc) + (nntp-async-stop proc))) + nntp-async-process-list)) + +(defun nntp-async-stop (proc) + (setq nntp-async-process-list (delq proc nntp-async-process-list)) + (when (and nntp-async-timer (not nntp-async-process-list)) + (nnheader-cancel-timer nntp-async-timer) + (setq nntp-async-timer nil))) + +(defun nntp-after-change-function (beg end len) (unwind-protect - (when nntp-process-callback + ;; we only care about insertions at eob + (when (and (eq 0 len) (eq (point-max) end)) (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)) - (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. + (nntp-async-trigger (get-buffer-process (current-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))))) + (setq after-change-functions '(nntp-after-change-function))))) + +(defun nntp-async-trigger (process) + (save-excursion + (set-buffer (process-buffer process)) + (when nntp-process-callback + ;; do we have an error message? + (goto-char nntp-process-start-point) + (if (memq (following-char) '(?4 ?5)) + ;; wants credentials? + (if (looking-at "480") + (nntp-handle-authinfo nntp-process-to-buffer) + ;; report error message. + (nntp-snarf-error-message) + (nntp-do-callback nil)) + + ;; got what we expect? + (goto-char (point-max)) + (when (re-search-backward + nntp-process-wait-for nntp-process-start-point t) + (nntp-async-stop process) + ;; convert it. + (when (gnus-buffer-exists-p nntp-process-to-buffer) + (let ((buf (current-buffer)) + (start nntp-process-start-point) + (decode nntp-process-decode)) + (save-excursion + (set-buffer nntp-process-to-buffer) + (goto-char (point-max)) + (save-restriction + (narrow-to-region (point) (point)) + (insert-buffer-substring buf start) + (when decode + (nntp-decode-text)))))) + ;; report it. + (goto-char (point-max)) + (nntp-do-callback + (buffer-name (get-buffer nntp-process-to-buffer)))))))) + +(defun nntp-do-callback (arg) + (let ((callback nntp-process-callback) + (nntp-inside-change-function t)) + (setq nntp-process-callback nil) + (funcall callback arg))) (defun nntp-snarf-error-message () "Save the error message in the current buffer." @@ -955,7 +1002,7 @@ password contained in '~/.nntp-authinfo'." (nnheader-report 'nntp message) message)) -(defun nntp-accept-process-output (process) +(defun nntp-accept-process-output (process &optional timeout) "Wait for output from PROCESS and message some dots." (save-excursion (set-buffer (or (nntp-find-connection-buffer nntp-server-buffer) @@ -965,7 +1012,7 @@ password contained in '~/.nntp-authinfo'." (unless (< len 10) (setq nntp-have-messaged t) (nnheader-message 7 "nntp read: %dk" len))) - (accept-process-output process 1))) + (accept-process-output process (or timeout 1)))) (defun nntp-accept-response () "Wait for output from the process that outputs to BUFFER." diff --git a/lisp/uudecode.el b/lisp/uudecode.el index eb97109..3b548a3 100644 --- a/lisp/uudecode.el +++ b/lisp/uudecode.el @@ -2,7 +2,7 @@ ;; Copyright (c) 1998 by Shenghuo Zhu ;; Author: Shenghuo Zhu -;; $Revision: 5.2 $ +;; $Revision: 5.3 $ ;; Keywords: uudecode ;; This file is not part of GNU Emacs, but the same permissions diff --git a/texi/message.texi b/texi/message.texi index 651d2a7..f3d0e15 100644 --- a/texi/message.texi +++ b/texi/message.texi @@ -1,7 +1,7 @@ \input texinfo @c -*-texinfo-*- @setfilename message -@settitle Pterodactyl Message 0.56 Manual +@settitle Pterodactyl Message 0.57 Manual @synindex fn cp @synindex vr cp @synindex pg cp @@ -42,7 +42,7 @@ into another language, under the above conditions for modified versions. @tex @titlepage -@title Pterodactyl Message 0.56 Manual +@title Pterodactyl Message 0.57 Manual @author by Lars Magne Ingebrigtsen @page @@ -83,7 +83,7 @@ Message mode buffers. * Key Index:: List of Message mode keys. @end menu -This manual corresponds to Pterodactyl Message 0.56. Message is +This manual corresponds to Pterodactyl Message 0.57. Message is distributed with the Gnus distribution bearing the same version number as this manual. -- 1.7.10.4