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

[Jambunathan K]

Attaching a patch.  See ChangeLog for details.

=== modified file 'lisp/ChangeLog'
--- lisp/ChangeLog      2012-12-07 16:48:42 +0000
+++ lisp/ChangeLog      2012-12-08 12:43:29 +0000
@@ -1,3 +1,11 @@
+2012-12-08  Jambunathan K  <kjambunathan@gmail.com>
+
+       * hi-lock.el (hi-lock--regexps-at-point): Use a better heuristic
+       that depends on actual faces rather than their common prefix.
+       (hi-lock-unface-buffer): Fix unhighlight all, when using overlays.
+       (hi-lock-set-pattern): Refuse to highlight an already highlighted
+       regexp.
+
 2012-12-07  Stefan Monnier  <monnier@iro.umontreal.ca>
 
        * hi-lock.el (hi-lock-unface-buffer): If there's no matching regexp at

=== modified file 'lisp/hi-lock.el'
--- lisp/hi-lock.el     2012-12-07 16:48:42 +0000
+++ lisp/hi-lock.el     2012-12-08 10:38:25 +0000
@@ -471,19 +471,19 @@
     (let ((regexp (get-char-property (point) 'hi-lock-overlay-regexp)))
       (when regexp (push regexp regexps)))
     ;; With font-locking on, check if the cursor is on an highlighted text.
-    ;; Checking for hi-lock face is a good heuristic.  FIXME: use "hi-lock-".
-    (and (string-match "\\`hi-" (face-name (face-at-point)))
-         (let* ((hi-text
-                 (buffer-substring-no-properties
-                  (previous-single-property-change (point) 'face)
-                  (next-single-property-change (point) 'face))))
-           ;; Compute hi-lock patterns that match the
-           ;; highlighted text at point.  Use this later in
-           ;; during completing-read.
-           (dolist (hi-lock-pattern hi-lock-interactive-patterns)
-             (let ((regexp (car hi-lock-pattern)))
-               (if (string-match regexp hi-text)
-                   (push regexp regexps))))))
+    (and (member (list 'quote (face-at-point))
+                (mapcar #'cadadr hi-lock-interactive-patterns))
+        (let* ((hi-text
+                (buffer-substring-no-properties
+                 (previous-single-property-change (point) 'face)
+                 (next-single-property-change (point) 'face))))
+          ;; Compute hi-lock patterns that match the
+          ;; highlighted text at point.  Use this later in
+          ;; during completing-read.
+          (dolist (hi-lock-pattern hi-lock-interactive-patterns)
+            (let ((regexp (car hi-lock-pattern)))
+              (if (string-match regexp hi-text)
+                  (push regexp regexps))))))
     regexps))
 
 (defvar-local hi-lock--last-face nil)
@@ -541,6 +541,7 @@
   (dolist (keyword (if (eq regexp t) hi-lock-interactive-patterns
                      (list (assoc regexp hi-lock-interactive-patterns))))
     (when keyword
+      (setq regexp (car keyword))
       (let ((face (cadr (cadr (cadr keyword)))))
         ;; Make `face' the next one to use by default.
         (setq hi-lock--last-face
@@ -628,7 +629,8 @@
   ;; Hashcons the regexp, so it can be passed to remove-overlays later.
   (setq regexp (hi-lock--hashcons regexp))
   (let ((pattern (list regexp (list 0 (list 'quote face) t))))
-    (unless (member pattern hi-lock-interactive-patterns)
+    ;; Refuse to highlight a text that is already highlighted.
+    (unless (assoc regexp hi-lock-interactive-patterns)
       (push pattern hi-lock-interactive-patterns)
       (if font-lock-mode
          (progn