GNU bug report logs - #11095
24.0.94; hi-lock-face-buffer/unhighlight-regexp': Augment?

Previous Next

Full log

Message #97 received at 11095 <at> debbugs.gnu.org (full text, mbox):

From: Jambunathan K <kjambunathan <at> gmail.com>
To: Stefan Monnier <monnier <at> iro.umontreal.ca>
Cc: 11095 <at> debbugs.gnu.org
Subject: Re: bug#11095: [PATCH] Re: bug#11095: 24.0.94;
	hi-lock-face-buffer/unhighlight-regexp': Augment?
Date: Mon, 10 Dec 2012 09:56:47 +0530

[Message part 1 (text/plain, inline)]

This patch which /improves/ status quo. Applies cleanly on top of
earlier patch at http://debbugs.gnu.org/cgi/bugreport.cgi?bug=11095#94

This patch makes sure that faces used for highlighting are always
distinct and recycles them only when it is inevitable.

[bug11095-rev111152-2.diff (text/x-diff, inline)]

=== modified file 'lisp/ChangeLog'
--- lisp/ChangeLog	2012-12-10 04:18:24 +0000
+++ lisp/ChangeLog	2012-12-10 04:18:59 +0000
@@ -1,3 +1,11 @@
+2012-12-10  Jambunathan K  <kjambunathan <at> gmail.com>
+
+	* hi-lock.el (hi-lock--last-face): Remove it.
+	(hi-lock--unused-faces): New variable, a free list of faces
+	available for highlighting text.
+	(hi-lock-unface-buffer, hi-lock-read-face-name): Propagate above
+	changes.
+
 2012-12-08  Jambunathan K  <kjambunathan <at> gmail.com>
 
 	* hi-lock.el (hi-lock--regexps-at-point): Use a better heuristic

=== modified file 'lisp/hi-lock.el'
--- lisp/hi-lock.el	2012-12-08 13:06:46 +0000
+++ lisp/hi-lock.el	2012-12-10 04:06:21 +0000
@@ -486,7 +486,9 @@ updated as you type."
 		   (push regexp regexps))))))
     regexps))
 
-(defvar-local hi-lock--last-face nil)
+(defvar-local hi-lock--unused-faces nil
+  "List of faces that is not used and is available for highlighting new text.
+Face names from this list come from `hi-lock-face-defaults'.")
 
 ;;;###autoload
 (defalias 'unhighlight-regexp 'hi-lock-unface-buffer)
@@ -544,9 +546,7 @@ then remove all hi-lock highlighting."
       (setq regexp (car keyword))
       (let ((face (cadr (cadr (cadr keyword)))))
         ;; Make `face' the next one to use by default.
-        (setq hi-lock--last-face
-              (cadr (member (symbol-name face)
-                            (reverse hi-lock-face-defaults)))))
+	(add-to-list 'hi-lock--unused-faces (face-name face)))
       (font-lock-remove-keywords nil (list keyword))
       (setq hi-lock-interactive-patterns
             (delq keyword hi-lock-interactive-patterns))
@@ -609,20 +609,26 @@ not suitable."
   "Return face for interactive highlighting.
 When `hi-lock-auto-select-face' is non-nil, just return the next face.
 Otherwise, read face name from minibuffer with completion and history."
-  (let ((default (or (cadr (member hi-lock--last-face hi-lock-face-defaults))
-                      (car hi-lock-face-defaults))))
-    (setq hi-lock--last-face
+  (unless hi-lock-interactive-patterns
+    (setq hi-lock--unused-faces hi-lock-face-defaults))
+  (let* ((last-used-face
+	  (when hi-lock-interactive-patterns
+	    (face-name (cadar (cdar (cdar hi-lock-interactive-patterns))))))
+	 (defaults (append hi-lock--unused-faces
+			   (cdr (member last-used-face hi-lock-face-defaults))
+			   hi-lock-face-defaults))
+	 face)
           (if (and hi-lock-auto-select-face (not current-prefix-arg))
-              default
-            (completing-read
-             (format "Highlight using face (default %s): " default)
-             obarray 'facep t nil 'face-name-history
-             (append (member default hi-lock-face-defaults)
-                     hi-lock-face-defaults))))
-    (unless (member hi-lock--last-face hi-lock-face-defaults)
-      (setq hi-lock-face-defaults
-            (append hi-lock-face-defaults (list hi-lock--last-face))))
-    (intern hi-lock--last-face)))
+	(setq face (or (pop hi-lock--unused-faces) (car defaults)))
+      (setq face (completing-read
+		  (format "Highlight using face (default %s): "
+			  (car defaults))
+		  obarray 'facep t nil 'face-name-history defaults))
+      ;; Update list of un-used faces.
+      (setq hi-lock--unused-faces (delete face hi-lock--unused-faces))
+      ;; Grow the list of defaults.
+      (add-to-list 'hi-lock-face-defaults face t))
+    (intern face)))
 
 (defun hi-lock-set-pattern (regexp face)
   "Highlight REGEXP with face FACE."

Previous Next

GNU bug tracking system
Copyright (C) 1999 Darren O. Benham, 1997,2003 nCipher Corporation Ltd, 1994-97 Ian Jackson.