From 81dc5714545cad6c19a8ea961087544d21db23f0 Mon Sep 17 00:00:00 2001 From: Juri Linkov Date: Fri, 23 Dec 2005 16:20:58 +0000 Subject: (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. --- lisp/ChangeLog | 12 +++++++++++ lisp/hi-lock.el | 67 ++++++++++++++++++++++++++++++++++++++++++++++----------- 2 files changed, 66 insertions(+), 13 deletions(-) (limited to 'lisp') diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 320b6ec940..960e304f2e 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,15 @@ +2005-12-23 David Koppelman + + * 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 * menu-bar.el (menu-find-file-existing): New function. diff --git a/lisp/hi-lock.el b/lisp/hi-lock.el index c3e2d81476..03f4a265ba 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 -- cgit v1.2.3