(hi-lock-highlight-range): New variable.

(hi-lock-mode, hi-lock-unface-buffer): Call font-lock-fontify-buffer
only if font-lock-fontified is non-nil.  Remove overlays.
(hi-lock-set-pattern): Call font-lock-fontify-buffer if
font-lock-fontified is non-nil, otherwise use overlays (instead of
text properties).
(hi-lock-string-serialize-hash, hi-lock-string-serialize-serial):
New variables.
(hi-lock-string-serialize) New function.

2 files changed, 66 insertions, 13 deletions

diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index 320b6ec940f..960e304f2e3 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,15 @@
+2005-12-23  David Koppelman  <koppel@ece.lsu.edu>
+
+        * hi-lock.el (hi-lock-highlight-range): New variable.
+        (hi-lock-mode, hi-lock-unface-buffer): Call font-lock-fontify-buffer
+        only if font-lock-fontified is non-nil.  Remove overlays.
+        (hi-lock-set-pattern): Call font-lock-fontify-buffer if
+        font-lock-fontified is non-nil, otherwise use overlays (instead of
+        text properties).
+        (hi-lock-string-serialize-hash, hi-lock-string-serialize-serial):
+        New variables.
+        (hi-lock-string-serialize) New function.
+
 2005-12-23  Jan Dj,Ad(Brv  <jan.h.d@swipnet.se>
 
         * menu-bar.el (menu-find-file-existing): New function.
diff --git a/lisp/hi-lock.el b/lisp/hi-lock.el
index c3e2d814767..03f4a265bab 100644
--- a/lisp/hi-lock.el
+++ b/lisp/hi-lock.el
@@ -97,6 +97,16 @@ of functions `hi-lock-mode' and `hi-lock-find-patterns'."
   :type 'integer
   :group 'hi-lock)
 
+(defcustom hi-lock-highlight-range 200000
+  "Size of area highlighted by hi-lock when font-lock not active.
+Font-lock is not active in buffers that do their own highlighting,
+such as the buffer created by `list-colors-display'.  In those buffers
+hi-lock patterns will only be applied over a range of
+`hi-lock-highlight-range' characters.  If font-lock is active then
+highlighting will be applied throughout the buffer."
+  :type 'integer
+  :group 'hi-lock)
+
 (defcustom hi-lock-exclude-modes
   '(rmail-mode mime/viewer-mode gnus-article-mode)
   "List of major modes in which hi-lock will not run.
@@ -330,8 +340,8 @@ versions before 22 use the following in your .emacs file:
       (when hi-lock-file-patterns
         (font-lock-remove-keywords nil hi-lock-file-patterns)
         (setq hi-lock-file-patterns nil))
-      (if font-lock-mode
-          (font-lock-fontify-buffer)))
+      (remove-overlays nil nil 'hi-lock-overlay t)
+      (when font-lock-fontified (font-lock-fontify-buffer)))
     (define-key-after menu-bar-edit-menu [hi-lock] nil)
     (remove-hook 'font-lock-mode-hook 'hi-lock-font-lock-hook t)))
 
@@ -461,7 +471,9 @@ interactive functions.  \(See `hi-lock-interactive-patterns'.\)
       (font-lock-remove-keywords nil (list keyword))
       (setq hi-lock-interactive-patterns
             (delq keyword hi-lock-interactive-patterns))
-      (font-lock-fontify-buffer))))
+      (remove-overlays
+       nil nil 'hi-lock-overlay-regexp (hi-lock-string-serialize regexp))
+      (when font-lock-fontified (font-lock-fontify-buffer)))))
 
 ;;;###autoload
 (defun hi-lock-write-interactive-patterns ()
@@ -528,16 +540,25 @@ not suitable."
     (unless (member pattern hi-lock-interactive-patterns)
       (font-lock-add-keywords nil (list pattern))
       (push pattern hi-lock-interactive-patterns)
-      (let ((buffer-undo-list t)
-            (inhibit-read-only t)
-            (mod (buffer-modified-p)))
-        (save-excursion
-          (goto-char (point-min))
-          (while (re-search-forward regexp (point-max) t)
-            (put-text-property
-             (match-beginning 0) (match-end 0) 'face face)
-            (goto-char (match-end 0))))
-        (set-buffer-modified-p mod)))))
+      (if font-lock-fontified
+          (font-lock-fontify-buffer)
+        (let* ((serial (hi-lock-string-serialize regexp))
+               (range-min (- (point) (/ hi-lock-highlight-range 2)))
+               (range-max (+ (point) (/ hi-lock-highlight-range 2)))
+               (search-start
+                (max (point-min)
+                     (- range-min (max 0 (- range-max (point-max))))))
+               (search-end
+                (min (point-max)
+                     (+ range-max (max 0 (- (point-min) range-min))))))
+          (save-excursion
+            (goto-char search-start)
+            (while (re-search-forward regexp search-end t)
+              (let ((overlay (make-overlay (match-beginning 0) (match-end 0))))
+                (overlay-put overlay 'hi-lock-overlay t)
+                (overlay-put overlay 'hi-lock-overlay-regexp serial)
+                (overlay-put overlay 'face face))
+              (goto-char (match-end 0)))))))))
 
 (defun hi-lock-set-file-patterns (patterns)
   "Replace file patterns list with PATTERNS and refontify."
@@ -577,6 +598,26 @@ not suitable."
              (font-lock-add-keywords nil hi-lock-interactive-patterns))
     (hi-lock-mode -1)))
 
+(defvar hi-lock-string-serialize-hash
+  (make-hash-table :test 'equal)
+  "Hash table used to assign unique numbers to strings.")
+
+(defvar hi-lock-string-serialize-serial 1
+  "Number assigned to last new string in call to `hi-lock-string-serialize'.
+A string is considered new if it had not previously been used in a call to
+`hi-lock-string-serialize'.")
+
+(defun hi-lock-string-serialize (string)
+  "Return unique serial number for STRING."
+  (interactive)
+  (let ((val (gethash string hi-lock-string-serialize-hash)))
+    (if val val
+      (puthash string
+               (setq hi-lock-string-serialize-serial
+                     (1+ hi-lock-string-serialize-serial))
+               hi-lock-string-serialize-hash)
+      hi-lock-string-serialize-serial)))
+
 (provide 'hi-lock)
 
 ;; arch-tag: d2e8fd07-4cc9-4c6f-a200-1e729bc54066