Improvements for new search commands

diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el
index c8db1a85c6553472e6b0de6fee1be24ab7d07066..cdd25bdb46aa9c6ef88aab60f2fd5997ee997943 100644 (file)
--- a/lisp/minibuffer.el
+++ b/lisp/minibuffer.el
@@ -1172,6 +1172,7 @@ styles for specific categories, such as files, buffers, etc."
     (symbol-help (styles basic shorthand substring))
     (multiple-choice (styles basic substring) (sort-function . identity))
     (calendar-month (sort-function . identity))
+    (search (sort-function . identity))
     (keybinding (sort-function . minibuffer-sort-alphabetically))
     (function (sort-function . minibuffer-sort-alphabetically)
               (affixation-function . minibuffer-function-affixation))
@@ -1750,7 +1751,8 @@ when the buffer's text is already an exact match."
            (,res (progn ,@body)))
        (unless (and (equal ,cnt (minibuffer-contents))
                     (equal ,pos (point)))
-         (push (cons ,cnt ,pos) completion-history))
+         (prog1 (push (cons ,cnt ,pos) completion-history)
+           (run-hooks 'minibuffer-new-completion-input-hook)))
        ,res)))
 
 (defun minibuffer-complete ()
@@ -6635,7 +6637,6 @@ interactions is customizable via `minibuffer-regexp-prompts'."
 
 (defvar minibuffer-export-history nil)
 
-;;;###autoload
 (defun minibuffer-export (&optional export-fn top-level-p)
   "Create a category-specific export buffer with current completion candidates.
 
@@ -6677,5 +6678,9 @@ TOP-LEVEL-P is non-nil."
 
 (put 'minibuffer-export 'minibuffer-action "export")
 
+(defcustom minibuffer-new-completion-input-hook nil
+  "Hook run in minibuffer after pushing new input to `completion-history'."
+  :type 'hook)
+
 (provide 'minibuffer)
 ;;; minibuffer.el ends here

diff --git a/lisp/search.el b/lisp/search.el
index 881743ca89b94f936b8ff051e1e733e4417e8062..553eb6a9e437f0e545d9c72bdd7f0337b12c60f5 100644 (file)
--- a/lisp/search.el
+++ b/lisp/search.el
@@ -25,12 +25,8 @@
 
 ;;; Todo:
 
-;; - Use `{regexp-}search-ring' for minibuffer history.
 ;; - Support multi-buffer `search'.
-;; - Highlight minibuffer completion input differently.
-;; - Highlight matches before first completion.
 ;; - Add regexp completion style and use it for `search' completion.
-;; - Deactivate mark on quit.
 ;; - Restore initial position on quit.
 ;; - Place mark at initial position.
 ;; - Add replace support.
@@ -39,11 +35,16 @@
 ;; - Highlight subgroups in matches.
 ;; - Improve documentation.
 ;; - In minibuffer, on `C-M-o', cycle forward first and then act.
+;; - Pulse final selection.
 
 ;;; Code:
 
 (defgroup search nil "Text search." :group 'matching)
 
+(defface search-highlight
+  '((t :inherit highlight :foreground "black"))
+  "Foo.")
+
 (defun search-read-target (&optional beg end re-or-fn)
   "Prompt for \\[search] target between BEG and END matching RE-OR-FN."
   (let* ((buffer (current-buffer))
@@ -53,54 +54,78 @@
                 (let ((r (or re-or-fn (read-regexp "Search regular expression"))))
                   (lambda () (re-search-forward r end t)))))
          (ovs nil)
-         (cur nil))
+         (ovz nil)
+         (cur nil)
+         (trs nil))
+    (deactivate-mark)
+    (save-excursion
+      (goto-char beg)
+      (let ((pos beg) done)
+        (while (not done)
+          (if (not (and (< (point) end) (funcall sfn)))
+              (setq done t)
+            (if (<= (point) pos)
+                (forward-char)
+              (push (format "%d:%d:%s"
+                            (match-beginning 0)
+                            (match-end 0)
+                            (match-string 0))
+                    trs)
+              (push (make-overlay (match-beginning 0)
+                                  (match-end 0))
+                    ovs)
+              (overlay-put (car ovs) 'face 'lazy-highlight)
+              (overlay-put (car ovs) 'search t)
+              (overlay-put (car ovs) 'priority '(nil . 1)))
+            (setq pos (point))))))
     (unwind-protect
-        (minibuffer-with-setup-hook
-            (lambda ()
-              (setq minibuffer-action
-                    (cons
-                     (lambda (c)
-                       (with-selected-window (minibuffer-selected-window)
-                         (search c)
-                         (when (overlayp cur) (overlay-put cur 'face 'lazy-highlight))
-                         (setq cur (seq-some
-                                    (lambda (ov) (and (overlay-get ov 'search) ov))
-                                    (overlays-at (point))))
-                         (overlay-put cur 'face 'isearch)))
-                     "search")))
-          (completing-read
-           "Search: "
-           (completion-table-with-metadata
-            (completion-table-dynamic
-             (lambda (&rest _)
-               (with-current-buffer buffer
-                 (mapc #'delete-overlay ovs)
-                 (setq ovs nil)
-                 (save-excursion
-                   (goto-char beg)
-                   (let ((pos beg) targets done)
-                     (while (not done)
-                       (if (not (and (< (point) end) (funcall sfn)))
-                           (setq done t)
-                         (if (<= (point) pos)
-                             (forward-char)
-                           (push (format "%d:%d:%s"
-                                         (match-beginning 0)
-                                         (match-end 0)
-                                         (match-string 0))
-                                 targets)
-                           (push (make-overlay (match-beginning 0)
-                                               (match-end 0))
-                                 ovs)
-                           (overlay-put (car ovs) 'face 'lazy-highlight)
-                           (overlay-put (car ovs) 'search t))
-                         (setq pos (point))))
-                     (nreverse targets))))))
-            `((category . search)
-              (group-function
-               . ,(lambda (string &optional transform)
-                    (when transform (nth 2 (string-split string ":")))))))))
-      (mapc #'delete-overlay ovs))))
+        (progn
+          (minibuffer-with-setup-hook
+              (lambda ()
+                (setq minibuffer-action
+                      (cons
+                       (lambda (c)
+                         (with-selected-window (minibuffer-selected-window)
+                           (search c)
+                           (when (overlayp cur) (overlay-put cur 'face 'lazy-highlight))
+                           (setq cur (seq-some
+                                      (lambda (ov) (and (overlay-get ov 'search) ov))
+                                      (overlays-at (point))))
+                           (overlay-put cur 'face 'isearch)))
+                       "search"))
+                (let ((hook-fn
+                       (lambda (input)
+                         (mapc #'delete-overlay ovz)
+                         (setq ovz nil)
+                         (with-current-buffer buffer
+                           (dolist (ov ovs)
+                             (save-excursion
+                               (goto-char (overlay-start ov))
+                               (let ((r (regexp-quote input))
+                                     (e (overlay-end ov)))
+                                 (while (re-search-forward r e t)
+                                   (push (make-overlay (match-beginning 0)
+                                                       (match-end 0))
+                                         ovz)
+                                   (overlay-put (car ovz) 'face 'search-highlight)
+                                   (overlay-put (car ovz) 'search-input t)
+                                   (overlay-put (car ovz) 'priority '(nil . 10))))))))))
+                  (add-hook 'minibuffer-new-completion-input-hook
+                            (lambda () (funcall hook-fn (caar completion-history)))
+                            nil t)
+                  (add-hook 'completion-setup-hook
+                            (lambda () (funcall hook-fn (minibuffer-contents)))
+                            nil t)))
+            (completing-read
+             "Search: "
+             (completion-table-with-metadata
+              (nreverse trs)
+              `((category . search)
+                (group-function
+                 . ,(lambda (string &optional transform)
+                      (when transform (nth 2 (string-split string ":"))))))))))
+      (mapc #'delete-overlay ovs)
+      (mapc #'delete-overlay ovz))))
 
 ;;;###autoload
 (defun search (target)

diff --git a/lisp/simple.el b/lisp/simple.el
index cf2064b963fd8efd4ae0a1e4f87bd4b0793e3b89..99faeb6087ade30e15dcaad0c143ca8a4b090777 100644 (file)
--- a/lisp/simple.el
+++ b/lisp/simple.el
@@ -10020,7 +10020,8 @@ minibuffer, but don't quit the completions window."
            insert-function)
           (or (null mstate)
               (equal mstate (car completion-history))
-              (push mstate completion-history))))
+              (prog1 (push mstate completion-history)
+                (run-hooks 'minibuffer-new-completion-input-hook)))))
       (setq completions-minibuffer-state nil))))
 
 ;; Delete the longest partial match for STRING