From: Eshel Yaron <me@eshelyaron.com>
Date: Fri, 12 Jul 2024 06:27:10 +0000 (+0200)
Subject: * lisp/search.el: New file.
X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=ce105cd2a9eea01342fc40a08772071687031fae;p=emacs.git

* lisp/search.el: New file.
---

diff --git a/lisp/search.el b/lisp/search.el
new file mode 100644
index 00000000000..881743ca89b
--- /dev/null
+++ b/lisp/search.el
@@ -0,0 +1,123 @@
+;;; search.el --- Interactive text search  -*- lexical-binding: t; -*-
+
+;; Copyright (C) 2024  Eshel Yaron
+
+;; Author: Eshel Yaron <me@eshelyaron.com>
+;; Keywords: tools
+
+;; This program is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with this program.  If not, see <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; Library search.el provides advanced text searching commands, inspired
+;; by Icicles search (https://www.emacswiki.org/emacs/Icicles).
+
+;;; 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.
+;; - Isearch-to-search and vice versa.
+;; - Search non-matches.
+;; - Highlight subgroups in matches.
+;; - Improve documentation.
+;; - In minibuffer, on `C-M-o', cycle forward first and then act.
+
+;;; Code:
+
+(defgroup search nil "Text search." :group 'matching)
+
+(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))
+         (beg (or beg (point-min)))
+         (end (or end (point-max)))
+         (sfn (if (functionp re-or-fn) re-or-fn
+                (let ((r (or re-or-fn (read-regexp "Search regular expression"))))
+                  (lambda () (re-search-forward r end t)))))
+         (ovs nil)
+         (cur nil))
+    (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))))
+
+;;;###autoload
+(defun search (target)
+  "Search for TARGET."
+  (interactive
+   (list (search-read-target (use-region-beginning) (use-region-end))))
+  (let ((pos (string-to-number target)))
+    (if (zerop pos)
+        (user-error "Invalid search target")
+      (goto-char pos))))
+
+;;;###autoload
+(defun search-lines (target)
+  "Search for TARGET line."
+  (interactive
+   (list (search-read-target (use-region-beginning) (use-region-end) ".*")))
+  (search target))
+
+(provide 'search)
+;;; refactor.el ends here