From 7ea3d89afd6b580873ce8c7188a2f660ace6e14e Mon Sep 17 00:00:00 2001 From: Eshel Yaron Date: Sun, 1 Dec 2024 08:34:51 +0100 Subject: [PATCH] New command 'search-button' --- lisp/bindings.el | 1 + lisp/search.el | 88 +++++++++++++++++++++++++++++++++--------------- lisp/simple.el | 34 ++++++++++--------- 3 files changed, 81 insertions(+), 42 deletions(-) diff --git a/lisp/bindings.el b/lisp/bindings.el index a41f113f303..9a2da776fd8 100644 --- 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 e8ac2130ca9..95ecdf741c7 100644 --- 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 38586479303..0c4bb1ebe52 100644 --- 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) -- 2.39.2