bug#11095: [PATCH] Re: bug#11095: 24.0.94; hi-lock-face-buffer/unhighlight-regexp': Augment?

[Jambunathan K]

Stefan Monnier <monnier@IRO.UMontreal.CA> writes:

>> This patch makes sure that faces used for highlighting are always
>> distinct and recycles them only when it is inevitable.
>
> Installed with 2 changes:
> - replace "delete" with "remove" because it was applied to a list which
>   is reachable from other places (basically, from other buffer's
>   hi-lock--unused-faces).

Attaching a patch with following changes.  (This is the last lap)

1. Fix following bug when `font-lock-mode' is disabled.

    ,----
    | Debugger entered--Lisp error: (wrong-type-argument integer-or-marker-p 
nil)
    |   buffer-substring-no-properties(nil nil)
    |   (let* ((hi-text (buffer-substring-no-properties 
(previous-single-property-change (point) (quote face)) 
(next-single-property-change (point) (quote face))))) (progn (let 
((--dolist-tail-- hi-lock-interactive-patterns)) (while --dolist-tail-- (let 
((hi-lock-pattern (car --dolist-tail--))) (let ((regexp ...)) (if (string-match 
regexp hi-text) (setq regexps ...))) (setq --dolist-tail-- (cdr 
--dolist-tail--)))))))
    |   (and (memq (face-at-point) (mapcar (function hi-lock-keyword->face) 
hi-lock-interactive-patterns)) (let* ((hi-text (buffer-substring-no-properties 
(previous-single-property-change (point) (quote face)) 
(next-single-property-change (point) (quote face))))) (progn (let 
((--dolist-tail-- hi-lock-interactive-patterns)) (while --dolist-tail-- (let 
((hi-lock-pattern ...)) (let (...) (if ... ...)) (setq --dolist-tail-- (cdr 
--dolist-tail--))))))))
    |   (let ((regexps (quote nil))) (let ((regexp (get-char-property (point) 
(quote hi-lock-overlay-regexp)))) (if regexp (progn (setq regexps (cons regexp 
regexps))))) (and (memq (face-at-point) (mapcar (function 
hi-lock-keyword->face) hi-lock-interactive-patterns)) (let* ((hi-text 
(buffer-substring-no-properties (previous-single-property-change (point) (quote 
face)) (next-single-property-change (point) (quote face))))) (progn (let 
((--dolist-tail-- hi-lock-interactive-patterns)) (while --dolist-tail-- (let 
(...) (let ... ...) (setq --dolist-tail-- ...))))))) regexps)
    |   hi-lock--regexps-at-point()
    |   (or (hi-lock--regexps-at-point) (mapcar (function car) 
hi-lock-interactive-patterns))
    |   (let* ((defaults (or (hi-lock--regexps-at-point) (mapcar (function car) 
hi-lock-interactive-patterns)))) (list (completing-read (if (null defaults) 
"Regexp to unhighlight: " (format "Regexp to unhighlight (default %s): " (car 
defaults))) hi-lock-interactive-patterns nil t nil nil defaults)))
    |   (cond (current-prefix-arg (list t)) ((and (display-popup-menus-p) 
(listp last-nonmenu-event) use-dialog-box) (catch (quote snafu) (or 
(x-popup-menu t (cons (quote keymap) (cons "Select Pattern to Unhighlight" 
(mapcar ... hi-lock-interactive-patterns)))) (throw (quote snafu) (quote 
("")))))) (t (if hi-lock-interactive-patterns nil (error "No highlighting to 
remove")) (let* ((defaults (or (hi-lock--regexps-at-point) (mapcar (function 
car) hi-lock-interactive-patterns)))) (list (completing-read (if (null 
defaults) "Regexp to unhighlight: " (format "Regexp to unhighlight (default 
%s): " (car defaults))) hi-lock-interactive-patterns nil t nil nil defaults)))))
    |   call-interactively(unhighlight-regexp nil nil)
    `----

2. Add a NEWS entry.
3. Re-works how hi-lock--unused-faces is allocated.

=== modified file 'etc/NEWS'
--- etc/NEWS    2012-12-10 12:38:49 +0000
+++ etc/NEWS    2012-12-10 20:08:35 +0000
@@ -92,6 +92,12 @@ when its arg ADJACENT is non-nil (when c
 it works like the utility `uniq'.  Otherwise by default it deletes
 duplicate lines everywhere in the region without regard to adjacency.
 
+** Interactive highlighting
+*** New user variable `hi-lock-auto-select-face'.
+*** Unhighlighting command (`hi-lock-unface-buffer') now un-highlights
+text at point.  When called interactively with a non-nil prefix,
+removes all highlighting in current buffer.
+
 ** Tramp
 +++
 *** New connection method "adb", which allows to access Android

=== modified file 'lisp/ChangeLog'
--- lisp/ChangeLog      2012-12-10 18:33:59 +0000
+++ lisp/ChangeLog      2012-12-10 20:19:36 +0000
@@ -1,5 +1,14 @@
 2012-12-10  Jambunathan K  <kjambunathan@gmail.com>
 
+       * hi-lock.el (hi-lock--regexps-at-point): When `font-lock-mode' is
+       disabled, highlighting will use overlays.  So use
+       `*-single-char-property-change' instead of
+       ``*-single-property-change'.
+       (hi-lock-read-face-name): Initialize `hi-lock--unused-faces' only
+       once.
+
+2012-12-10  Jambunathan K  <kjambunathan@gmail.com>
+
        * hi-lock.el: Refine the choice of default face.
        (hi-lock-keyword->face): New function.  Use it wherever we used
        cadadadr instead.

=== modified file 'lisp/hi-lock.el'
--- lisp/hi-lock.el     2012-12-10 18:33:59 +0000
+++ lisp/hi-lock.el     2012-12-10 19:42:51 +0000
@@ -478,8 +478,8 @@ updated as you type."
                (mapcar #'hi-lock-keyword->face hi-lock-interactive-patterns))
         (let* ((hi-text
                 (buffer-substring-no-properties
-                 (previous-single-property-change (point) 'face)
-                 (next-single-property-change (point) 'face))))
+                 (previous-single-char-property-change (point) 'face)
+                 (next-single-char-property-change (point) 'face))))
           ;; Compute hi-lock patterns that match the
           ;; highlighted text at point.  Use this later in
           ;; during completing-read.
@@ -611,8 +611,10 @@ 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."
-  (unless hi-lock-interactive-patterns
-    (setq hi-lock--unused-faces hi-lock-face-defaults))
+  (unless (or hi-lock-interactive-patterns hi-lock--unused-faces)
+    ;; This is the very first request for interactive highlighting.
+    ;; Initialize unused faces list.
+    (setq hi-lock--unused-faces (copy-sequence hi-lock-face-defaults)))
   (let* ((last-used-face
          (when hi-lock-interactive-patterns
            (face-name (hi-lock-keyword->face
@@ -628,7 +630,7 @@ Otherwise, read face name from minibuffe
                          (car defaults))
                  obarray 'facep t nil 'face-name-history defaults))
       ;; Update list of un-used faces.
-      (setq hi-lock--unused-faces (remove face hi-lock--unused-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)))



> - introduced a helper hi-lock-keyword->face to get rid of those cadadadr
>   (some of which needed `cl' even it was not `require'd).
>
>
>         Stefan