From: Eshel Yaron Date: Fri, 12 Jul 2024 08:30:08 +0000 (+0200) Subject: Improvements for new search commands X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=5b654885095228542f1d59a571e2d28481912686;p=emacs.git Improvements for new search commands --- diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el index c8db1a85c65..cdd25bdb46a 100644 --- 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 881743ca89b..553eb6a9e43 100644 --- 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 cf2064b963f..99faeb6087a 100644 --- 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