bug#6227: Color isearch regexp submatches differently

[Lennart Borgman <lennart.borgman@gmail.com>]

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

On Sun, May 23, 2010 at 6:40 PM, Lennart Borgman
<lennart.borgman@gmail.com> wrote:
> On Sun, May 23, 2010 at 6:12 PM, Juri Linkov <juri@jurta.org> wrote:
>>>> I think `reb-update-overlays' should be completely rewritten
>>>> for isearch.el.
>>>
>>> You surely know this things much better than me, but is there any
>>> reason to double the code?
>>
>> `reb-update-overlays' highlights all matches in the buffer.
>> This is like what lazy-highlighting does.  But we agreed
>> that it should affect only the current isearch match,
>> not all lazy-highlighted matches.
>>
>>> If it is rewritten why not let re-builder share the same code?
>>
>> Yes, and query-replace highlighting could share it too.
>
>>>> The only thing we need from re-builder.el are faces
>>>> reb-match-1, reb-match-2, reb-match-3.  We should try
>>>> using the existing faces for the same functionality.

Here is a patch for the submatches highlighting. (It includes a bug
fix for the prompt face too and a help window scrolling I think is
useful.)

The current faces does not look very well together so that must be fixed.

[-- Attachment #2: isearch-hisub-1.diff --]
[-- Type: text/x-patch, Size: 6077 bytes --]

=== modified file 'lisp/isearch.el'
--- trunk/lisp/isearch.el	2010-05-20 22:33:09 +0000
+++ patched/lisp/isearch.el	2010-06-08 13:28:37 +0000
@@ -223,6 +223,12 @@
   :type 'boolean
   :group 'isearch)
 
+(defcustom search-highlight-submatches t
+  "Non-nil means incremental search highlights submatches.
+This is only done for the current hit."
+  :type 'boolean
+  :group 'isearch)
+
 (defface isearch
   '((((class color) (min-colors 88) (background light))
      ;; The background must not be too dark, for that means
@@ -1911,6 +1917,18 @@
 	  ((eq search-exit-option 'edit)
 	   (apply 'isearch-unread keylist)
 	   (isearch-edit-string))
+          ;; Always scroll other window if help buffer
+          ((let ((binding (key-binding key))
+                 other-buffer-is-help)
+             (when (or (eq binding 'scroll-other-window-down)
+                       (eq binding 'scroll-other-window))
+               (save-selected-window
+                 (other-window 1)
+                 (setq other-buffer-is-help (equal (buffer-name) "*Help*")))
+               (when other-buffer-is-help
+                 (command-execute binding)
+                 (isearch-update)
+                 t))))
           ;; Handle a scrolling function.
           ((and isearch-allow-scroll
                 (progn (setq key (isearch-reread-key-sequence-naturally keylist))
@@ -2182,9 +2200,12 @@
 		   (if current-input-method
 		       (concat " [" current-input-method-title "]: ")
 		     ": ")
-		   )))
-    (propertize (concat (upcase (substring m 0 1)) (substring m 1))
-		'face 'minibuffer-prompt)))
+                   ))
+        m2)
+    (setq m2 (apply 'propertize
+                    (concat (upcase (substring m 0 1)) (substring m 1))
+                    minibuffer-prompt-properties))
+    (propertize m2 'read-only nil)))
 
 (defun isearch-message-suffix (&optional c-q-hack ellipsis)
   (concat (if c-q-hack "^Q" "")
@@ -2526,9 +2547,80 @@
 ;; Highlighting
 
 (defvar isearch-overlay nil)
+(defvar isearch-submatches-overlays nil)
+
+(defun isearch-count-subexps (re)
+  "Return max possible subexp number for the regexp RE."
+  (save-match-data
+    (let ((i 0) (beg 0) (max-n 0))
+      ;;(while (string-match "\\\\(" re beg)
+      ;; (string-match "\\\\(" "")
+      ;; (string-match "\\\\(\\(\?[0-9]+:\\)?" "")
+      ;; (string-match "\\\\(\\(\\?[0-9]+:\\)?" "")
+      ;; (string-match "\\\\(\\(\\?[0-9]+:\\)?" "\\(?9:\\)")
+      (while (string-match "\\\\(\\(\\?[0-9]+:\\)?" re beg)
+        (setq i (1+ (max max-n i)))
+        (setq beg (match-end 0))
+        (let ((sub (match-string-no-properties 1 re)))
+          (when sub
+            (setq sub (substring sub 1))
+            (setq max-n (max max-n (string-to-number sub))))))
+      (max max-n i))))
+
+(defun isearch-unhighlight-submatches ()
+  (dolist (subovl isearch-submatches-overlays)
+    (delete-overlay subovl)))
+
+(defvar isearch-submatch-count nil) ;; For rebuilder
+(defvar isearch-subexp-to-mark nil
+  "If non-nil mark only the corresponding submatch.
+This variable must be nil or a positive integer.")
+
+(defun isearch-highlight-submatches ()
+  (isearch-unhighlight-submatches)
+  (setq isearch-submatches-overlays nil)
+  (when search-highlight-submatches
+    (require 're-builder) ;; fix-me
+    (let ((subexps (isearch-count-subexps isearch-string))
+          (subexp isearch-subexp-to-mark)
+          (submatches 0)
+          (ii 1)
+          suffix max-suffix)
+      (while (<= ii subexps)
+        (when (and (or (not subexp) (= subexp ii))
+                   (match-beginning ii))
+          (let ((overlay (make-overlay (match-beginning ii)
+                                       (match-end ii)))
+                ;; When we have exceeded the number of provided faces,
+                ;; cycle thru them where `max-suffix' denotes the maximum
+                ;; suffix for `reb-match-*' that has been defined and
+                ;; `suffix' the suffix calculated for the current match.
+                (face
+                 (cond
+                  (max-suffix
+                   (if (= suffix max-suffix)
+                       (setq suffix 1)
+                     (setq suffix (1+ suffix)))
+                   (intern-soft (format "reb-match-%d" suffix)))
+                  ((intern-soft (format "reb-match-%d" ii)))
+                  ((setq max-suffix (1- ii))
+                   (setq suffix 1)
+                   ;; `reb-match-1' must exist.
+                   'reb-match-1))))
+            ;; (unless firstmatch (setq firstmatch (match-data)))
+            ;; (unless firstmatch-after-here
+            ;;   (when (> (point) here)
+            ;;     (setq firstmatch-after-here (match-data))))
+            (setq isearch-submatches-overlays
+                  (cons overlay isearch-submatches-overlays))
+            (setq submatches (1+ submatches))
+            (overlay-put overlay 'face face)
+            ;; Priority must be higher than isearch base overlay.
+            (overlay-put overlay 'priority (+ ii 1001))))
+        (setq ii (1+ ii))))))
 
 (defun isearch-highlight (beg end)
-  (if search-highlight
+  (when search-highlight
       (if isearch-overlay
 	  ;; Overlay already exists, just move it.
 	  (move-overlay isearch-overlay beg end (current-buffer))
@@ -2536,11 +2628,14 @@
 	(setq isearch-overlay (make-overlay beg end))
 	;; 1001 is higher than lazy's 1000 and ediff's 100+
 	(overlay-put isearch-overlay 'priority 1001)
-	(overlay-put isearch-overlay 'face isearch))))
+      (overlay-put isearch-overlay 'face isearch))
+    (when isearch-regexp
+      (isearch-highlight-submatches))))
 
 (defun isearch-dehighlight ()
   (when isearch-overlay
-    (delete-overlay isearch-overlay)))
+    (delete-overlay isearch-overlay))
+  (isearch-unhighlight-submatches))
 \f
 ;; isearch-lazy-highlight feature
 ;; by Bob Glickstein <http://www.zanshin.com/~bobg/>