New command 'search-button'

diff --git a/lisp/bindings.el b/lisp/bindings.el
index a41f113f303ac75fbeb560f9f0b24e8f3130bbb7..9a2da776fd80a09096cfa954ad5c19075640f554 100644 (file)
--- a/lisp/bindings.el
+++ b/lisp/bindings.el
@@ -1197,6 +1197,7 @@ if `inhibit-field-text-motion' is non-nil."
 
 (defvar-keymap search-map
   :doc "Keymap for search related commands."
+  "b"   #'search-button
   "o"   #'occur
   "M-s" #'search
   "M-o" #'search-lines

diff --git a/lisp/search.el b/lisp/search.el
index e8ac2130ca9822c209b288acf57987ef1a4f627f..95ecdf741c714736bffb3637d1b4f96a2b068924 100644 (file)
--- a/lisp/search.el
+++ b/lisp/search.el
@@ -58,7 +58,7 @@
 (define-minor-mode search-read-target-mode
   "Minor mode for `search-read-target' minibuffer.")
 
-(defun search--read-target (buffer beg end reg sfn init)
+(defun search--read-target (buffer beg end reg sfn init alt)
   "Prompt for search target in BUFFER between BEG and END matching REG.
 
 SFN is the search function to use for finding matches.  INIT is the
@@ -102,28 +102,41 @@ initial minibuffer input."
                          (overlay-put cur 'face 'isearch)))
                      "search"))
               (setq minibuffer-alternative-action
-                    (cons
-                     (lambda (c)
-                       (if-let ((n (string-to-number c))
-                                (d (gethash n tab)))
+                    (if alt
+                        (cons
+                         (lambda (c)
                            (with-selected-window
                                (or (get-buffer-window buffer) (display-buffer buffer))
+                             (goto-char (car (gethash (string-to-number c) tab)))
                              (when (overlayp cur) (overlay-put cur 'face 'lazy-highlight))
-                             (set-match-data d)
-                             (let ((ov (seq-some
+                             (setq cur (seq-some
                                         (lambda (ov) (and (overlay-get ov 'search) ov))
-                                        (overlays-at (match-beginning 0)))))
-                               (unless rep
-                                 (overlay-put ov 'face 'isearch)
-                                 (goto-char (match-beginning 0))
-                                 (setq rep (query-replace-read-to reg "Replace" t)))
-                               (setq ovs (delq ov ovs))
-                               (delete-overlay ov))
-                             (setq trs (delete c trs))
-                             (remhash n tab)
-                             (replace-match rep))
-                         (user-error "Already replaced")))
-                     "replace"))
+                                        (overlays-at (point))))
+                             (overlay-put cur 'face 'isearch)
+                             (funcall (car alt))))
+                         (cdr alt))
+                      (cons
+                       (lambda (c)
+                         (if-let ((n (string-to-number c))
+                                  (d (gethash n tab)))
+                             (with-selected-window
+                                 (or (get-buffer-window buffer) (display-buffer buffer))
+                               (when (overlayp cur) (overlay-put cur 'face 'lazy-highlight))
+                               (set-match-data d)
+                               (let ((ov (seq-some
+                                          (lambda (ov) (and (overlay-get ov 'search) ov))
+                                          (overlays-at (match-beginning 0)))))
+                                 (unless rep
+                                   (overlay-put ov 'face 'isearch)
+                                   (goto-char (match-beginning 0))
+                                   (setq rep (query-replace-read-to reg "Replace" t)))
+                                 (setq ovs (delq ov ovs))
+                                 (delete-overlay ov))
+                               (setq trs (delete c trs))
+                               (remhash n tab)
+                               (replace-match rep))
+                           (user-error "Already replaced")))
+                       "replace")))
               (let ((hook-fn
                      (lambda (input)
                        (unless (string-empty-p input)
@@ -164,11 +177,11 @@ initial minibuffer input."
       (mapc #'delete-overlay ovs)
       (mapc #'delete-overlay ovz))))
 
-(defun search-read-target (&optional beg end re-or-fn)
+(defun search-read-target (&optional beg end re-or-fn alt)
   "Prompt for \\[search] target between BEG and END matching RE-OR-FN."
   (let* ((buf (current-buffer))
-         (beg (or beg (point-min)))
-         (end (or end (point-max)))
+         (beg (or beg (use-region-beginning) (point-min)))
+         (end (or end (use-region-end)       (point-max)))
          reg res
          (sfn (if (functionp re-or-fn)
                   (prog1 re-or-fn (setq reg "match"))
@@ -176,7 +189,7 @@ initial minibuffer input."
                 (lambda () (re-search-forward reg end t)))))
     (deactivate-mark)
     (while (stringp (setq res (catch 'search-change
-                                (search--read-target buf beg end reg sfn res))))
+                                (search--read-target buf beg end reg sfn res alt))))
       (setq reg (read-regexp "Search regular expression")
             sfn (lambda () (re-search-forward reg end t))))
     res))
@@ -184,9 +197,7 @@ initial minibuffer input."
 ;;;###autoload
 (defun search (beg end)
   "Go to and pulse region starting at BEG and ending at END."
-  (interactive
-   (save-excursion
-     (search-read-target (use-region-beginning) (use-region-end))))
+  (interactive (save-excursion (search-read-target)))
   (push-mark)
   (goto-char beg)
   (pulse-momentary-highlight-region beg end 'isearch))
@@ -210,10 +221,33 @@ initial minibuffer input."
 ;;;###autoload
 (defun search-lines (beg end)
   "Go to and pulse line starting at BEG and ending at END."
+  (interactive (save-excursion (search-read-target nil nil ".*")))
+  (search beg end))
+
+(defun search--property (prop)
+  (lambda ()
+    (when-let ((pm (text-property-search-forward prop)))
+      (set-match-data (list (prop-match-beginning pm)
+                            (prop-match-end pm)))
+      (point))))
+
+;;;###autoload
+(defun search-property (beg end)
+  "`search' for region from BEG to END with a given text property."
   (interactive
    (save-excursion
-     (search-read-target (use-region-beginning) (use-region-end) ".*")))
+     (search-read-target nil nil (search--property (read-text-property)))))
   (search beg end))
 
+;;;###autoload
+(defun search-button (beg end)
+  "`search' for button from BEG to END."
+  (interactive
+   (save-excursion
+     (search-read-target nil nil (search--property 'button)
+                         (cons #'push-button "push"))))
+  (search beg end)
+  (push-button))
+
 (provide 'search)
 ;;; search.el ends here

diff --git a/lisp/simple.el b/lisp/simple.el
index 3858647930348ce14a81d3ce44dd3c04895a7cbf..0c4bb1ebe52512647ef3c84a97942b798b55c01e 100644 (file)
--- a/lisp/simple.el
+++ b/lisp/simple.el
@@ -11250,22 +11250,26 @@ particular action on the input you type there."
 
 (defvar read-text-property-history nil)
 
+(defun read-text-property (&optional prompt default)
+  (setq default (when default (symbol-name default)))
+  (intern
+   (completing-read
+    (format-prompt (or prompt "Property") default)
+    (completion-table-with-metadata
+     (let ((alist text-property-alist)
+           (plist (text-properties-at (point))))
+       (while plist
+         (unless (assq (car plist) alist)
+           (push (cons (car plist) "") alist))
+         (setq plist (cddr plist)))
+       (mapcar (compose #'symbol-name #'car) alist))
+     '((category . text-property)
+       (affixation-function . read-text-property-affixation)))
+    nil nil nil
+    'read-text-property-history default)))
+
 (defun read-text-property-and-value (&optional prompt)
-  (let ((prop (intern
-               (completing-read
-                (format-prompt (or prompt "Property") "face")
-                (completion-table-with-metadata
-                 (let ((alist text-property-alist)
-                       (plist (text-properties-at (point))))
-                   (while plist
-                     (unless (assq (car plist) alist)
-                       (push (cons (car plist) "") alist))
-                     (setq plist (cddr plist)))
-                   (mapcar (compose #'symbol-name #'car) alist))
-                 '((category . text-property)
-                   (affixation-function . read-text-property-affixation)))
-                nil nil nil
-                'read-text-property-history "face"))))
+  (let ((prop (read-text-property prompt 'face)))
     (list prop (read-text-property-value prop))))
 
 (defun propertize-region (beg end prop val)