>From 6b6291ce1974a363080f535b40f06d5772ffa1be Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Gr=C3=A9gory=20Mouni=C3=A9?= <Gregory.Mounie@imag.fr>
Date: Fri, 3 Aug 2018 23:08:10 +0200
Subject: [PATCH] Interactive Highlighting: prefix argument to select subexp

Use prefix-argument to highlight only the corresponding
subexpression of the regexp.

* lisp/hi-lock.el (hi-lock-face-buffer, hi-lock-set-pattern)

Copyright-paperwork-exempt: yes
---
 lisp/hi-lock.el | 67 ++++++++++++++++++++++++++-----------------------
 1 file changed, 35 insertions(+), 32 deletions(-)

diff --git a/lisp/hi-lock.el b/lisp/hi-lock.el
index 13ebffb1af..b0b4a19c6c 100644
--- a/lisp/hi-lock.el
+++ b/lisp/hi-lock.el
@@ -429,7 +429,7 @@ hi-lock-line-face-buffer
 ;;;###autoload
 (defalias 'highlight-regexp 'hi-lock-face-buffer)
 ;;;###autoload
-(defun hi-lock-face-buffer (regexp &optional face)
+(defun hi-lock-face-buffer (regexp &optional face subexp)
   "Set face of each match of REGEXP to FACE.
 Interactively, prompt for REGEXP using `read-regexp', then FACE.
 Use the global history list for FACE.
@@ -441,10 +441,11 @@ hi-lock-face-buffer
    (list
     (hi-lock-regexp-okay
      (read-regexp "Regexp to highlight" 'regexp-history-last))
-    (hi-lock-read-face-name)))
+    (hi-lock-read-face-name)
+    current-prefix-arg))
   (or (facep face) (setq face 'hi-yellow))
   (unless hi-lock-mode (hi-lock-mode 1))
-  (hi-lock-set-pattern regexp face))
+  (hi-lock-set-pattern regexp face subexp))
 
 ;;;###autoload
 (defalias 'highlight-phrase 'hi-lock-face-phrase-buffer)
@@ -686,39 +687,41 @@ hi-lock-read-face-name
       (add-to-list 'hi-lock-face-defaults face t))
     (intern face)))
 
-(defun hi-lock-set-pattern (regexp face)
+(defun hi-lock-set-pattern (regexp face &optional arg)
   "Highlight REGEXP with face FACE."
   ;; 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) 'prepend)))
-        (no-matches t))
-    ;; Refuse to highlight a text that is already highlighted.
-    (if (assoc regexp hi-lock-interactive-patterns)
-        (add-to-list 'hi-lock--unused-faces (face-name face))
-      (push pattern hi-lock-interactive-patterns)
-      (if (and font-lock-mode (font-lock-specified-p major-mode))
-	  (progn
-	    (font-lock-add-keywords nil (list pattern) t)
-	    (font-lock-flush))
-        (let* ((range-min (- (point) (/ hi-lock-highlight-range 2)))
-               (range-max (+ (point) (/ hi-lock-highlight-range 2)))
-               (search-start
-                (max (point-min)
-                     (- range-min (max 0 (- range-max (point-max))))))
-               (search-end
-                (min (point-max)
-                     (+ range-max (max 0 (- (point-min) range-min))))))
-          (save-excursion
-            (goto-char search-start)
-            (while (re-search-forward regexp search-end t)
-              (when no-matches (setq no-matches nil))
-              (let ((overlay (make-overlay (match-beginning 0) (match-end 0))))
-                (overlay-put overlay 'hi-lock-overlay t)
-                (overlay-put overlay 'hi-lock-overlay-regexp regexp)
+  (let* ((subexp (if (null arg) 0 arg))
+         (pattern (list regexp (list subexp (list 'quote face) 'prepend)))
+         (no-matches t))
+      ;; Refuse to highlight a text that is already highlighted.
+      (if (assoc regexp hi-lock-interactive-patterns)
+          (add-to-list 'hi-lock--unused-faces (face-name face))
+        (push pattern hi-lock-interactive-patterns)
+        (if (and font-lock-mode (font-lock-specified-p major-mode))
+            (progn
+              (font-lock-add-keywords nil (list pattern) t)
+              (font-lock-flush))
+          (let* ((range-min (- (point) (/ hi-lock-highlight-range 2)))
+                 (range-max (+ (point) (/ hi-lock-highlight-range 2)))
+                 (search-start
+                  (max (point-min)
+                       (- range-min (max 0 (- range-max (point-max))))))
+                 (search-end
+                  (min (point-max)
+                       (+ range-max (max 0 (- (point-min) range-min))))))
+            (save-excursion
+              (goto-char search-start)
+              (while (re-search-forward regexp search-end t)
+                (when no-matches (setq no-matches nil))
+                (let ((overlay (make-overlay (match-beginning subexp)
+                                             (match-end subexp))))
+                  (overlay-put overlay 'hi-lock-overlay t)
+                (overlay-put overlay 'hi-lock-orverlay-regexp regexp)
                 (overlay-put overlay 'face face))
-              (goto-char (match-end 0)))
-            (when no-matches
-              (add-to-list 'hi-lock--unused-faces (face-name face))
+                (goto-char (match-end 0)))
+              (when no-matches
+                (add-to-list 'hi-lock--unused-faces (face-name face))
               (setq hi-lock-interactive-patterns
                     (cdr hi-lock-interactive-patterns)))))))))
 
-- 
2.18.0