Gnus development mailing list
 help / color / mirror / Atom feed
* gnus-async fix
@ 1998-11-23 22:17 Felix Lee
  1998-11-23 22:34 ` Karl Kleinpaste
  1998-11-24 10:17 ` Lars Magne Ingebrigtsen
  0 siblings, 2 replies; 6+ messages in thread
From: Felix Lee @ 1998-11-23 22:17 UTC (permalink / raw)


"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  <flee@cygnus.com>

	* 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."


^ permalink raw reply	[flat|nested] 6+ messages in thread

* Re: gnus-async fix
  1998-11-23 22:17 gnus-async fix Felix Lee
@ 1998-11-23 22:34 ` Karl Kleinpaste
  1998-11-23 22:49   ` Felix Lee
  1998-11-24 10:17 ` Lars Magne Ingebrigtsen
  1 sibling, 1 reply; 6+ messages in thread
From: Karl Kleinpaste @ 1998-11-23 22:34 UTC (permalink / raw)


Felix Lee <flee@teleport.com> writes:
> "it works for me".  pgnus-0.52 and pgnus-0.53 with emacs
> 20.2 and 20.3.  haven't tried it with xemacs.

Fails for XEmacs 20.4 and 0.53:

Signaling: (wrong-type-argument string-or-itimer-p nil)
  signal(wrong-type-argument (string-or-itimer-p nil))
  nnheader-cancel-timer(nil)
  nntp-async-stop(#<network connection "nntpd<2>" ("nntp" . "news") state:run>)
  nntp-async-trigger(#<network connection "nntpd<2>" ("nntp" . "news") state:run>)
  nntp-after-change-function(1025 1382 0)

I'll be trying to trace the code.

Is there any reason that the timer should have become involved at all,
for XEmacs?


^ permalink raw reply	[flat|nested] 6+ messages in thread

* Re: gnus-async fix
  1998-11-23 22:34 ` Karl Kleinpaste
@ 1998-11-23 22:49   ` Felix Lee
  1998-11-23 22:59     ` Karl Kleinpaste
  0 siblings, 1 reply; 6+ messages in thread
From: Felix Lee @ 1998-11-23 22:49 UTC (permalink / raw)
  Cc: ding

Karl Kleinpaste <karl@justresearch.com>:
> Felix Lee <flee@teleport.com> writes:
> > "it works for me".  pgnus-0.52 and pgnus-0.53 with emacs
> > 20.2 and 20.3.  haven't tried it with xemacs.
> 
> Fails for XEmacs 20.4 and 0.53:

oops.  silly me.  it's trying to cancel a nonexistent timer.

add this patch too.

*** nntp.el	1998/11/23 22:46:48	1.2
--- nntp.el	1998/11/23 22:47:17
***************
*** 936,942 ****
  
  (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)))
  
--- 936,942 ----
  
  (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)))
  



^ permalink raw reply	[flat|nested] 6+ messages in thread

* Re: gnus-async fix
  1998-11-23 22:49   ` Felix Lee
@ 1998-11-23 22:59     ` Karl Kleinpaste
  0 siblings, 0 replies; 6+ messages in thread
From: Karl Kleinpaste @ 1998-11-23 22:59 UTC (permalink / raw)


With the 2nd patch, it appears to work in XEmacs 20.4.  Thanx.


^ permalink raw reply	[flat|nested] 6+ messages in thread

* Re: gnus-async fix
  1998-11-23 22:17 gnus-async fix Felix Lee
  1998-11-23 22:34 ` Karl Kleinpaste
@ 1998-11-24 10:17 ` Lars Magne Ingebrigtsen
  1998-11-24 12:24   ` Felix Lee
  1 sibling, 1 reply; 6+ messages in thread
From: Lars Magne Ingebrigtsen @ 1998-11-24 10:17 UTC (permalink / raw)


Felix Lee <flee@teleport.com> writes:

> !   ;; emacs 20.3 bug: process output with encoding 'binary
> !   ;; doesn't trigger after-change-functions.

Have you reported this bug to RMS?

-- 
(domestic pets only, the antidote for overdose, milk.)
  larsi@gnus.org * Lars Magne Ingebrigtsen


^ permalink raw reply	[flat|nested] 6+ messages in thread

* Re: gnus-async fix
  1998-11-24 10:17 ` Lars Magne Ingebrigtsen
@ 1998-11-24 12:24   ` Felix Lee
  0 siblings, 0 replies; 6+ messages in thread
From: Felix Lee @ 1998-11-24 12:24 UTC (permalink / raw)
  Cc: ding

yap.

Lars Magne Ingebrigtsen <larsi@gnus.org>:
> Felix Lee <flee@teleport.com> writes:
> > !   ;; emacs 20.3 bug: process output with encoding 'binary
> > !   ;; doesn't trigger after-change-functions.
> Have you reported this bug to RMS?


^ permalink raw reply	[flat|nested] 6+ messages in thread

end of thread, other threads:[~1998-11-24 12:24 UTC | newest]

Thread overview: 6+ messages (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
1998-11-23 22:17 gnus-async fix Felix Lee
1998-11-23 22:34 ` Karl Kleinpaste
1998-11-23 22:49   ` Felix Lee
1998-11-23 22:59     ` Karl Kleinpaste
1998-11-24 10:17 ` Lars Magne Ingebrigtsen
1998-11-24 12:24   ` Felix Lee

This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for NNTP newsgroup(s).