Re: Nested sit-for's

[martin rudalics <rudalics@gmx.at>]

[-- Attachment #1: Type: text/plain, Size: 505 bytes --]

 > If we simply document that "timers (and process filters) should avoid
 > using sit-for", it should be clear to the reader that rare exceptions
 > may exist (especially if we add a comment to jit-lock-stealth-fontify
 > stating this).  After the release, we can probably rework
 > jit-lock-stealth-fontify to avoid using sit-for, but I don't think the
 > current situation is bad enough to block the release.

If you accept a pre-command-hook the attached patch would be a first
step in that direction.

[-- Attachment #2: jit-lock.patch --]
[-- Type: text/plain, Size: 7871 bytes --]

*** jit-lock.el.~1.53.~	Tue Aug 15 10:00:50 2006
--- jit-lock.el	Thu Aug 17 17:52:02 2006
***************
*** 220,229 ****
  	 (jit-lock-refontify)

  	 ;; Install an idle timer for stealth fontification.
! 	 (when (and jit-lock-stealth-time (null jit-lock-stealth-timer))
! 	   (setq jit-lock-stealth-timer
! 		 (run-with-idle-timer jit-lock-stealth-time t
! 				      'jit-lock-stealth-fontify)))

  	 ;; Init deferred fontification timer.
  	 (when (and jit-lock-defer-time (null jit-lock-defer-timer))
--- 220,231 ----
  	 (jit-lock-refontify)

  	 ;; Install an idle timer for stealth fontification.
! 	 (when jit-lock-stealth-time
! 	   (add-hook 'pre-command-hook 'jit-lock-reset-stealth-buffers nil t)
! 	   (when (null jit-lock-stealth-timer)
! 	     (setq jit-lock-stealth-timer
! 		   (run-with-idle-timer
! 		    jit-lock-stealth-time t 'jit-lock-stealth-fontify))))

  	 ;; Init deferred fontification timer.
  	 (when (and jit-lock-defer-time (null jit-lock-defer-timer))
***************
*** 265,270 ****
--- 267,273 ----
  	     (setq jit-lock-defer-timer nil)))

  	 ;; Remove hooks.
+ 	 (remove-hook 'pre-command-hook 'jit-lock-reset-stealth-buffers t)
  	 (remove-hook 'after-change-functions 'jit-lock-after-change t)
  	 (remove-hook 'fontification-functions 'jit-lock-function))))

***************
*** 386,399 ****
             ;; eagerly extend the refontified region with
             ;; jit-lock-after-change-extend-region-functions.
             (when (< start orig-start)
!              (lexical-let ((start start)
                             (orig-start orig-start)
                             (buf (current-buffer)))
                 (run-with-timer
                  0 nil (lambda ()
!                         (with-buffer-prepared-for-jit-lock
!                             (put-text-property start orig-start
!                                                'fontified t buf))))))

  	   ;; Find the start of the next chunk, if any.
  	   (setq start (text-property-any next end 'fontified nil))))))))
--- 389,403 ----
             ;; eagerly extend the refontified region with
             ;; jit-lock-after-change-extend-region-functions.
             (when (< start orig-start)
! 	     (lexical-let ((start start)
                             (orig-start orig-start)
                             (buf (current-buffer)))
                 (run-with-timer
                  0 nil (lambda ()
! 			(with-current-buffer buf
! 			  (with-buffer-prepared-for-jit-lock
! 			   (put-text-property start orig-start
! 					      'fontified t)))))))

  	   ;; Find the start of the next chunk, if any.
  	   (setq start (text-property-any next end 'fontified nil))))))))
***************
*** 402,408 ****
  ;;; Stealth fontification.

  (defsubst jit-lock-stealth-chunk-start (around)
!   "Return the start of the next chunk to fontify around position AROUND..
  Value is nil if there is nothing more to fontify."
    (if (zerop (buffer-size))
        nil
--- 406,412 ----
  ;;; Stealth fontification.

  (defsubst jit-lock-stealth-chunk-start (around)
!   "Return the start of the next chunk to fontify around position AROUND.
  Value is nil if there is nothing more to fontify."
    (if (zerop (buffer-size))
        nil
***************
*** 442,513 ****
  			   (t next))))
  	result))))


  (defun jit-lock-stealth-fontify ()
    "Fontify buffers stealthily.
  This functions is called after Emacs has been idle for
  `jit-lock-stealth-time' seconds."
!   ;; I used to check `inhibit-read-only' here, but I can't remember why.  -stef
!   (unless (or executing-kbd-macro
  	      memory-full
  	      (window-minibuffer-p (selected-window)))
!     (let ((buffers (buffer-list))
! 	  (outer-buffer (current-buffer))
  	  minibuffer-auto-raise
! 	  message-log-max)
!       (with-local-quit
! 	(while (and buffers (not (input-pending-p)))
! 	  (with-current-buffer (pop buffers)
! 	    (when jit-lock-mode
! 	      ;; This is funny.  Calling sit-for with 3rd arg non-nil
! 	      ;; so that it doesn't redisplay, internally calls
! 	      ;; wait_reading_process_input also with a parameter
! 	      ;; saying "don't redisplay."  Since this function here
! 	      ;; is called periodically, this effectively leads to
! 	      ;; process output not being redisplayed at all because
! 	      ;; redisplay_internal is never called.  (That didn't
! 	      ;; work in the old redisplay either.)  So, we learn that
! 	      ;; we mustn't call sit-for that way here.  But then, we
! 	      ;; have to be cautious not to call sit-for in a widened
! 	      ;; buffer, since this could display hidden parts of that
! 	      ;; buffer.  This explains the seemingly weird use of
! 	      ;; save-restriction/widen here.
! 
! 	      (with-temp-message (if jit-lock-stealth-verbose
! 				     (concat "JIT stealth lock "
! 					     (buffer-name)))
! 
! 		;; In the following code, the `sit-for' calls cause a
! 		;; redisplay, so it's required that the
! 		;; buffer-modified flag of a buffer that is displayed
! 		;; has the right value---otherwise the mode line of
! 		;; an unmodified buffer would show a `*'.
! 		(let (start
! 		      (nice (or jit-lock-stealth-nice 0))
! 		      (point (point-min)))
! 		  (while (and (setq start
! 				    (jit-lock-stealth-chunk-start point))
! 			      ;; In case sit-for runs any timers,
! 			      ;; give them the expected current buffer.
! 			      (with-current-buffer outer-buffer
! 				(sit-for nice)))
! 
! 		    ;; fontify a block.
! 		    (jit-lock-fontify-now start (+ start jit-lock-chunk-size))
! 		    ;; If stealth jit-locking is done backwards, this leads to
! 		    ;; excessive O(n^2) refontification.   -stef
! 		    ;; (when (>= jit-lock-context-unfontify-pos start)
! 		    ;;   (setq jit-lock-context-unfontify-pos end))
! 
! 		    ;; Wait a little if load is too high.
! 		    (when (and jit-lock-stealth-load
! 			       (> (car (load-average)) jit-lock-stealth-load))
! 		      ;; In case sit-for runs any timers,
! 		      ;; give them the expected current buffer.
! 		      (with-current-buffer outer-buffer
! 			(sit-for (or jit-lock-stealth-time 30))))))))))))))
! 
! 
  \f
  ;;; Deferred fontification.

--- 446,492 ----
  			   (t next))))
  	result))))

+ (defvar jit-lock-stealth-buffers nil
+   "List of buffers that should be fontified stealthily.
+ Installed in `pre-command-hook' when `jit-lock-stealth-time' is non-nil
+ and JIT lock is turned on.")
+ 
+ (defun jit-lock-reset-stealth-buffers ()
+   "Reset `jit-lock-stealth-buffers' to nil."
+   (setq jit-lock-stealth-buffers nil))

  (defun jit-lock-stealth-fontify ()
    "Fontify buffers stealthily.
  This functions is called after Emacs has been idle for
  `jit-lock-stealth-time' seconds."
!   (unless (or (input-pending-p)
! 	      (eq jit-lock-stealth-buffers t)
! 	      executing-kbd-macro
  	      memory-full
  	      (window-minibuffer-p (selected-window)))
!     (unless jit-lock-stealth-buffers
!       (setq jit-lock-stealth-buffers (or (buffer-list) t)))
!     (let ((buffer (car jit-lock-stealth-buffers))
  	  minibuffer-auto-raise
! 	  message-log-max
! 	  start)
!       (when (and buffer
! 		 (or (not jit-lock-stealth-load)
! 		     (<= (car (load-average)) jit-lock-stealth-load)))
! 	(with-local-quit
! 	  (with-current-buffer buffer
! 	    (if (and jit-lock-mode
! 		     (setq start (jit-lock-stealth-chunk-start (point))))
! 		;; fontify a block.
! 		(with-temp-message (if jit-lock-stealth-verbose
! 				       (concat "JIT stealth lock "
! 					       (buffer-name)))
! 		  (jit-lock-fontify-now start (+ start jit-lock-chunk-size)))
! 	      (setq jit-lock-stealth-buffers
! 		    (or (cdr jit-lock-stealth-buffers) t)))))))
!     (unless (eq jit-lock-stealth-buffers t)
!       (run-at-time (min jit-lock-stealth-nice 0.1) nil
! 		   'jit-lock-stealth-fontify))))
  \f
  ;;; Deferred fontification.


[-- Attachment #3: Type: text/plain, Size: 142 bytes --]

_______________________________________________
Emacs-devel mailing list
Emacs-devel@gnu.org
http://lists.gnu.org/mailman/listinfo/emacs-devel