comparison lisp/lazy-lock.el @ 23753:c1bedc24e8af

* lazy-lock.el (lazy-lock-unstall): (lazy-lock-fontify-after-idle): Rewritten to use with-temp-message.

23752:001e0e875d56

;;; lazy-lock.el --- Lazy demand-driven fontification for fast Font Lock mode.

;; Copyright (C) 1994, 1995, 1996, 1997 Free Software Foundation, Inc.

;; Author: Simon Marshall <[e-mail]>
;; Keywords: faces files
;; Version: 2.10

;;; This file is part of GNU Emacs.

;; GNU Emacs is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by

;; - Removed `byte-*' variables from `eval-when-compile' (Erik Naggum hint)
;; - Made various wrapping `inhibit-point-motion-hooks' (Vinicius Latorre hint)
;; - Made `lazy-lock-fontify-after-idle' wrap `minibuffer-auto-raise'
;; - Made `lazy-lock-fontify-after-defer' paranoid about deferred buffers
;; 2.09--2.10:
;; - Use `window-end' UPDATE arg for Emacs 20.3 and later.
;; - Made deferral `widen' before unfontifying (Dan Nicolaescu report)
;; - Use `lazy-lock-fontify-after-visage' for hideshow.el (Dan Nicolaescu hint)
;; - Use `other' widget where possible (Andreas Schwab fix)

;;; Code:

(require 'font-lock)

The value returned is the value of the last form in BODY."
	(` (save-excursion (set-buffer (, buffer)) (,@ body)))))
  (put 'with-current-buffer 'lisp-indent-function 1)
  ;;
  ;; We use this for compatibility with a future Emacs.
  (or (fboundp 'defcustom)
      (defmacro defcustom (symbol value doc &rest args) 
	(` (defvar (, symbol) (, value) (, doc))))))

;(defun lazy-lock-submit-bug-report ()
;  "Submit via mail a bug report on lazy-lock.el."
;  (interactive)
;  (let ((reporter-prompt-for-summary-p t))
;    (reporter-submit-bug-report "[e-mail]" "lazy-lock 2.10"
;     '(lazy-lock-minimum-size lazy-lock-defer-on-the-fly
;       lazy-lock-defer-on-scrolling lazy-lock-defer-contextually
;       lazy-lock-defer-time lazy-lock-stealth-time
;       lazy-lock-stealth-load lazy-lock-stealth-nice lazy-lock-stealth-lines
;       lazy-lock-stealth-verbose)

(defvar lazy-lock-buffers nil)			; For deferral.
(defvar lazy-lock-timers (cons nil nil))	; For deferral and stealth.

;; User Variables:

(defcustom lazy-lock-minimum-size (* 25 1024)
  "*Minimum size of a buffer for demand-driven fontification.
On-demand fontification occurs if the buffer size is greater than this value.
If nil, means demand-driven fontification is never performed.
If a list, each element should be a cons pair of the form (MAJOR-MODE . SIZE),
where MAJOR-MODE is a symbol or t (meaning the default).  For example:

  (when font-lock-mode
    (when (lazy-lock-unfontified-p)
      (let ((verbose (if (numberp font-lock-verbose)
			 (> (buffer-size) font-lock-verbose)
		       font-lock-verbose)))
	(if verbose (message "Fontifying %s..." (buffer-name)))
	;; Make sure we fontify etc. in the whole buffer.
	(save-restriction
	  (widen)
	  (lazy-lock-fontify-region (point-min) (point-max)))
	(if verbose (message "Fontifying %s...%s" (buffer-name)
			     (if (lazy-lock-unfontified-p) "quit" "done")))))
    (add-hook 'after-change-functions 'font-lock-after-change-function nil t))
  ;;
  ;; Remove the text properties.
  (lazy-lock-after-unfontify-buffer)
  ;;

	(do-while (and buffers continue)
	  (set-buffer (car buffers))
	  (if (not (and lazy-lock-mode (lazy-lock-unfontified-p)))
	      (setq continue (not (input-pending-p)))
	    ;; Fontify regions in this buffer while there is no input.
	    (do-while (and (lazy-lock-unfontified-p) continue)
	      (if (and lazy-lock-stealth-load
		       (> (car (load-average)) lazy-lock-stealth-load))
		  ;; Wait a while before continuing with the loop.
		  (progn
		    (when message
		      (message "Fontifying stealthily...suspended")
		      (setq message nil))
		    (setq continue (sit-for (or lazy-lock-stealth-time 30))))
		;; Fontify a chunk.
		(when lazy-lock-stealth-verbose
		  (if message
		      (message "Fontifying stealthily... %2d%% of %s"
			       (lazy-lock-percent-fontified) (buffer-name))
		    (message "Fontifying stealthily...")
		    (setq message t)))
		(lazy-lock-fontify-chunk)
		(setq continue (sit-for (or lazy-lock-stealth-nice 0))))))
	  (setq buffers (cdr buffers))))
      (when message
	(message "Fontifying stealthily...%s" (if continue "done" "quit"))))))

;; 4.  Special circumstances.

(defun lazy-lock-fontify-after-visage ()
  ;; Called from `outline-view-change-hook' and `hs-hide-hook'.

      (mapcar 'lazy-lock-fontify-conservatively
	      (get-buffer-window-list (pop lazy-lock-install) 'nomini t)))))

(when (if (save-match-data (string-match "Lucid\\|XEmacs" (emacs-version)))
	  nil
	(or (and (= emacs-major-version 20) (< emacs-minor-version 3))
	    (= emacs-major-version 19)))
  ;;
  ;; We use `vertical-motion' rather than `window-end' UPDATE arg.
  (defun lazy-lock-fontify-after-scroll (window window-start)
    ;; Called from `window-scroll-functions'.

  ;; In 2.06.04 and below, `lazy-lock-defer-time' could specify modes and time.
  (with-output-to-temp-buffer "*Help*"
    (princ "The value of the variable `lazy-lock-defer-time' was\n ")
    (princ lazy-lock-defer-time)
    (princ "\n")
    (princ "This variable cannot now be a list of modes and time, ")
    (princ "so instead use the forms:\n")
    (princ " (setq lazy-lock-defer-time ")
    (princ (cdr lazy-lock-defer-time))
    (princ ")\n")
    (princ " (setq lazy-lock-defer-on-the-fly '")
    (princ (car lazy-lock-defer-time))
    (princ ")\n")
    (princ "in your ~/.emacs.  ")
    (princ "The above forms have been evaluated for this editor session,\n")
    (princ "but you should change your ~/.emacs now."))
  (setq lazy-lock-defer-on-the-fly (car lazy-lock-defer-time)
	lazy-lock-defer-time (cdr lazy-lock-defer-time)))

(when (boundp 'lazy-lock-defer-driven)
  ;;

      (princ "`")
      (princ lazy-lock-defer-driven)
      (princ "'"))
    (princ ".\n")
    (princ "This variable is now called `lazy-lock-defer-on-scrolling',\n")
    (princ "so instead use the form:\n")
    (princ " (setq lazy-lock-defer-on-scrolling ")
    (unless (memq lazy-lock-defer-driven '(nil t))
      (princ "'"))
    (princ lazy-lock-defer-driven)
    (princ ")\n")
    (princ "in your ~/.emacs.  ")
    (princ "The above form has been evaluated for this editor session,\n")
    (princ "but you should change your ~/.emacs now."))
  (setq lazy-lock-defer-on-scrolling lazy-lock-defer-driven))

;; Possibly absent.

(unless (boundp 'font-lock-inhibit-thing-lock)

      (walk-windows (function (lambda (window)
				(when (eq (window-buffer window) buffer)
				  (push window windows))))
		    minibuf frame)
      windows)))

;; Install ourselves:

(add-hook 'window-size-change-functions 'lazy-lock-fontify-after-resize)
(add-hook 'redisplay-end-trigger-functions 'lazy-lock-fontify-after-trigger)

23753:c1bedc24e8af

;;; lazy-lock.el --- Lazy demand-driven fontification for fast Font Lock mode.

;; Copyright (C) 1994, 1995, 1996, 1997, 1998 Free Software Foundation, Inc.

;; Author: Simon Marshall <[e-mail]>
;; Keywords: faces files
;; Version: 2.11

;;; This file is part of GNU Emacs.

;; GNU Emacs is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by

;; - Removed `byte-*' variables from `eval-when-compile' (Erik Naggum hint)
;; - Made various wrapping `inhibit-point-motion-hooks' (Vinicius Latorre hint)
;; - Made `lazy-lock-fontify-after-idle' wrap `minibuffer-auto-raise'
;; - Made `lazy-lock-fontify-after-defer' paranoid about deferred buffers
;; 2.09--2.10:
;; - Use `window-end' UPDATE arg for Emacs 20.4 and later.
;; - Made deferral `widen' before unfontifying (Dan Nicolaescu report)
;; - Use `lazy-lock-fontify-after-visage' for hideshow.el (Dan Nicolaescu hint)
;; - Use `other' widget where possible (Andreas Schwab fix)
;; 2.10--2.11:
;; - Used `with-temp-message' where possible to make messages temporary.

;;; Code:

(require 'font-lock)

The value returned is the value of the last form in BODY."
	(` (save-excursion (set-buffer (, buffer)) (,@ body)))))
  (put 'with-current-buffer 'lisp-indent-function 1)
  ;;
  ;; We use this for compatibility with a future Emacs.
  (or (fboundp 'with-temp-message)
      (defmacro with-temp-message (message &rest body)
	(` (let ((current-message (current-message)))
	     (unwind-protect
		 (progn (message (, message)) (,@ body))
	       (message current-message))))))
  ;;
  ;; We use this for compatibility with a future Emacs.
  (or (fboundp 'defcustom)
      (defmacro defcustom (symbol value doc &rest args) 
	(` (defvar (, symbol) (, value) (, doc))))))

;(defun lazy-lock-submit-bug-report ()
;  "Submit via mail a bug report on lazy-lock.el."
;  (interactive)
;  (let ((reporter-prompt-for-summary-p t))
;    (reporter-submit-bug-report "[e-mail]" "lazy-lock 2.11"
;     '(lazy-lock-minimum-size lazy-lock-defer-on-the-fly
;       lazy-lock-defer-on-scrolling lazy-lock-defer-contextually
;       lazy-lock-defer-time lazy-lock-stealth-time
;       lazy-lock-stealth-load lazy-lock-stealth-nice lazy-lock-stealth-lines
;       lazy-lock-stealth-verbose)

(defvar lazy-lock-buffers nil)			; For deferral.
(defvar lazy-lock-timers (cons nil nil))	; For deferral and stealth.

;; User Variables:

(defcustom lazy-lock-minimum-size 25600
  "*Minimum size of a buffer for demand-driven fontification.
On-demand fontification occurs if the buffer size is greater than this value.
If nil, means demand-driven fontification is never performed.
If a list, each element should be a cons pair of the form (MAJOR-MODE . SIZE),
where MAJOR-MODE is a symbol or t (meaning the default).  For example:

  (when font-lock-mode
    (when (lazy-lock-unfontified-p)
      (let ((verbose (if (numberp font-lock-verbose)
			 (> (buffer-size) font-lock-verbose)
		       font-lock-verbose)))
	(with-temp-message
	    (if verbose
		(format "Fontifying %s..." (buffer-name))
	      (current-message))
	  ;; Make sure we fontify etc. in the whole buffer.
	  (save-restriction
	    (widen)
	    (lazy-lock-fontify-region (point-min) (point-max))))))
    (add-hook 'after-change-functions 'font-lock-after-change-function nil t))
  ;;
  ;; Remove the text properties.
  (lazy-lock-after-unfontify-buffer)
  ;;

	(do-while (and buffers continue)
	  (set-buffer (car buffers))
	  (if (not (and lazy-lock-mode (lazy-lock-unfontified-p)))
	      (setq continue (not (input-pending-p)))
	    ;; Fontify regions in this buffer while there is no input.
	    (with-temp-message
		(if lazy-lock-stealth-verbose
		    "Fontifying stealthily..."
		  (current-message))
	      (do-while (and (lazy-lock-unfontified-p) continue)
		(if (and lazy-lock-stealth-load
			 (> (car (load-average)) lazy-lock-stealth-load))
		    ;; Wait a while before continuing with the loop.
		    (progn
		      (when message
			(message "Fontifying stealthily...suspended")
			(setq message nil))
		      (setq continue (sit-for (or lazy-lock-stealth-time 30))))
		  ;; Fontify a chunk.
		  (when lazy-lock-stealth-verbose
		    (if message
			(message "Fontifying stealthily... %2d%% of %s"
				 (lazy-lock-percent-fontified) (buffer-name))
		      (message "Fontifying stealthily...")
		      (setq message t)))
		  (lazy-lock-fontify-chunk)
		  (setq continue (sit-for (or lazy-lock-stealth-nice 0)))))))
	  (setq buffers (cdr buffers)))))))

;; 4.  Special circumstances.

(defun lazy-lock-fontify-after-visage ()
  ;; Called from `outline-view-change-hook' and `hs-hide-hook'.

      (mapcar 'lazy-lock-fontify-conservatively
	      (get-buffer-window-list (pop lazy-lock-install) 'nomini t)))))

(when (if (save-match-data (string-match "Lucid\\|XEmacs" (emacs-version)))
	  nil
	(or (and (= emacs-major-version 20) (< emacs-minor-version 4))
	    (= emacs-major-version 19)))
  ;;
  ;; We use `vertical-motion' rather than `window-end' UPDATE arg.
  (defun lazy-lock-fontify-after-scroll (window window-start)
    ;; Called from `window-scroll-functions'.

  ;; In 2.06.04 and below, `lazy-lock-defer-time' could specify modes and time.
  (with-output-to-temp-buffer "*Help*"
    (princ "The value of the variable `lazy-lock-defer-time' was\n ")
    (princ lazy-lock-defer-time)
    (princ "\n")
    (princ "This variable cannot now be a list of modes and time,\n")
    (princ "so instead use ")
    (princ (substitute-command-keys "\\[customize-option]"))
    (princ " to modify the variables, or put the forms:\n")
    (princ " (setq lazy-lock-defer-time ")
    (princ (cdr lazy-lock-defer-time))
    (princ ")\n")
    (princ " (setq lazy-lock-defer-on-the-fly '")
    (princ (car lazy-lock-defer-time))
    (princ ")\n")
    (princ "in your ~/.emacs.  ")
    (princ "The above forms have been evaluated for this editor session,\n")
    (princ "but you should use ")
    (princ (substitute-command-keys "\\[customize-option]"))
    (princ " or change your ~/.emacs now."))
  (setq lazy-lock-defer-on-the-fly (car lazy-lock-defer-time)
	lazy-lock-defer-time (cdr lazy-lock-defer-time)))

(when (boundp 'lazy-lock-defer-driven)
  ;;

      (princ "`")
      (princ lazy-lock-defer-driven)
      (princ "'"))
    (princ ".\n")
    (princ "This variable is now called `lazy-lock-defer-on-scrolling',\n")
    (princ "so instead use ")
    (princ (substitute-command-keys "\\[customize-option]"))
    (princ " to modify the variable, or put the form:\n")
    (princ " (setq lazy-lock-defer-on-scrolling ")
    (unless (memq lazy-lock-defer-driven '(nil t))
      (princ "'"))
    (princ lazy-lock-defer-driven)
    (princ ")\n")
    (princ "in your ~/.emacs.  ")
    (princ "The above form has been evaluated for this editor session,\n")
    (princ "but you should use ")
    (princ (substitute-command-keys "\\[customize-option]"))
    (princ " or change your ~/.emacs now."))
  (setq lazy-lock-defer-on-scrolling lazy-lock-defer-driven))

;; Possibly absent.

(unless (boundp 'font-lock-inhibit-thing-lock)

      (walk-windows (function (lambda (window)
				(when (eq (window-buffer window) buffer)
				  (push window windows))))
		    minibuf frame)
      windows)))

(unless (fboundp 'current-message)
  (defun current-message ()
    ""))

;; Install ourselves:

(add-hook 'window-size-change-functions 'lazy-lock-fontify-after-resize)
(add-hook 'redisplay-end-trigger-functions 'lazy-lock-fontify-after-trigger)