From mboxrd@z Thu Jan 1 00:00:00 1970 X-Msuck: nntp://news.gmane.io/gmane.emacs.gnus.general/19085 Path: main.gmane.org!not-for-mail From: Felix Lee Newsgroups: gmane.emacs.gnus.general Subject: gnus-async fix Date: Mon, 23 Nov 1998 14:17:39 -0800 Sender: owner-ding@hpc.uh.edu Message-ID: <199811232217.RAA07621@sclp3.sclp.com> NNTP-Posting-Host: coloc-standby.netfonds.no X-Trace: main.gmane.org 1035157499 9755 80.91.224.250 (20 Oct 2002 23:44:59 GMT) X-Complaints-To: usenet@main.gmane.org NNTP-Posting-Date: Sun, 20 Oct 2002 23:44:59 +0000 (UTC) Return-Path: Original-Received: from karazm.math.uh.edu (karazm.math.uh.edu [129.7.128.1]) by sclp3.sclp.com (8.8.5/8.8.5) with ESMTP id RAA07644 for ; Mon, 23 Nov 1998 17:19:02 -0500 (EST) Original-Received: from sina.hpc.uh.edu (lists@Sina.HPC.UH.EDU [129.7.3.5]) by karazm.math.uh.edu (8.9.1/8.9.1) with ESMTP id QAB21012; Mon, 23 Nov 1998 16:18:26 -0600 (CST) Original-Received: by sina.hpc.uh.edu (TLB v0.09a (1.20 tibbs 1996/10/09 22:03:07)); Mon, 23 Nov 1998 16:18:18 -0600 (CST) Original-Received: from sclp3.sclp.com (root@sclp3.sclp.com [204.252.123.139]) by sina.hpc.uh.edu (8.7.3/8.7.3) with ESMTP id QAA19982 for ; Mon, 23 Nov 1998 16:18:00 -0600 (CST) Original-Received: from mail1.teleport.com (mail1.teleport.com [192.108.254.26]) by sclp3.sclp.com (8.8.5/8.8.5) with SMTP id RAA07621 for ; Mon, 23 Nov 1998 17:17:47 -0500 (EST) Original-Received: (qmail 7991 invoked from network); 23 Nov 1998 22:17:41 -0000 Original-Received: from pdx56-i48-07.teleport.com (HELO teleport.com) (204.202.167.21) by mail1.teleport.com with SMTP; 23 Nov 1998 22:17:41 -0000 Original-To: ding@gnus.org Precedence: list X-Majordomo: 1.94.jlt7 Xref: main.gmane.org gmane.emacs.gnus.general:19085 X-Report-Spam: http://spam.gmane.org/gmane.emacs.gnus.general:19085 "it works for me". pgnus-0.52 and pgnus-0.53 with emacs 20.2 and 20.3. haven't tried it with xemacs. this adds a new variable, nntp-async-needs-kluge, which makes nntp.el do once-a-second polling when it thinks it needs to. by default, it's turned on only for emacs 20.3. 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/. *** gnus-async.el 1998/11/23 00:39:15 1.1 --- gnus-async.el 1998/11/23 15:02:38 *************** *** 108,115 **** ,@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)) ;;; ;;; Article prefetch --- 108,115 ---- ,@forms) (gnus-async-release-semaphore 'gnus-async-article-semaphore))) ! (put 'gnus-async-with-semaphore 'lisp-indent-function 0) ! (put 'gnus-async-with-semaphore 'edebug-form-spec '(body)) ;;; ;;; Article prefetch *************** *** 241,258 **** (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 --- 241,249 ---- (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 (equal group gnus-async-current-prefetch-group) (eq article gnus-async-current-prefetch-article)) ! (gnus-async-wait-for-article article)) (let ((entry (gnus-async-prefetched-article-entry group article))) (when entry (save-excursion *************** *** 262,267 **** --- 253,288 ---- (when (memq 'read gnus-prefetched-article-deletion-strategy) (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." *** nntp.el 1998/11/23 00:39:08 1.1 --- nntp.el 1998/11/23 20:52:40 *************** *** 209,214 **** --- 209,224 ---- (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,341 **** ((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))) t) (wait-for (nntp-wait-for process wait-for buffer decode)) --- 335,341 ---- ((eq callback 'ignore) t) ((and callback wait-for) ! (nntp-async-wait process wait-for buffer decode callback) t) (wait-for (nntp-wait-for process wait-for buffer decode)) *************** *** 904,950 **** (eval (cadr entry)) (funcall (cadr entry))))))) ! (defun nntp-after-change-function-callback (beg end len) (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 ! (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." --- 904,998 ---- (eval (cadr entry)) (funcall (cadr entry))))))) ! (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)) ! (unless 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 ! ;; we only care about insertions at eob ! (when (and (eq 0 len) (eq (point-max) end)) (save-match-data ! (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 '(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." *************** *** 954,960 **** (nnheader-report 'nntp message) message)) ! (defun nntp-accept-process-output (process) "Wait for output from PROCESS and message some dots." (save-excursion (set-buffer (or (nntp-find-connection-buffer nntp-server-buffer) --- 1002,1008 ---- (nnheader-report 'nntp message) message)) ! (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) *************** *** 964,970 **** (unless (< len 10) (setq nntp-have-messaged t) (nnheader-message 7 "nntp read: %dk" len))) ! (accept-process-output process 1))) (defun nntp-accept-response () "Wait for output from the process that outputs to BUFFER." --- 1012,1018 ---- (unless (< len 10) (setq nntp-have-messaged t) (nnheader-message 7 "nntp read: %dk" len))) ! (accept-process-output process (or timeout 1)))) (defun nntp-accept-response () "Wait for output from the process that outputs to BUFFER."