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: 49 bytes --]


Attaching a patch.  See ChangeLog for details.


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

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