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

[Jambunathan K <kjambunathan@gmail.com>]

[-- Attachment #1: Type: text/plain, Size: 3336 bytes --]

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.


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: bug11095-rev111175.patch --]
[-- Type: text/x-diff, Size: 3087 bytes --]

=== 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)))


[-- Attachment #3: Type: text/plain, Size: 159 bytes --]




> - 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