474 lines
18 KiB
EmacsLisp
474 lines
18 KiB
EmacsLisp
|
;;; search-form.el --- Search form
|
||
|
|
;;
|
||
|
|
;; Author: Lennart Borgman (lennart O borgman A gmail O com)
|
||
|
|
;; Created: 2008-05-05T01:50:20+0200 Sun
|
||
|
|
;; Version: 0.11
|
||
|
|
;; Last-Updated:
|
||
|
|
;; URL:
|
||
|
|
;; Keywords:
|
||
|
|
;; Compatibility:
|
||
|
|
;;
|
||
|
|
;; Features that might be required by this library:
|
||
|
|
;;
|
||
|
|
;; `cus-edit', `cus-face', `cus-load', `cus-start', `wid-edit'.
|
||
|
|
;;
|
||
|
|
;;;;;;;;;;seasfireplstring ;;
|
||
|
|
;;
|
||
|
|
;;; Commentary:
|
||
|
|
;;
|
||
|
|
;; After an idea by Eric Ludlam on Emacs Devel:
|
||
|
|
;;
|
||
|
|
;; http://lists.gnu.org/archive/html/emacs-devel/2008-05/msg00152.html
|
||
|
|
;;
|
||
|
|
;; NOT QUITE READY! Tagged files have not been tested.
|
||
|
|
;;
|
||
|
|
;; Fix-me: work on other windows buffer by default, not buffer from
|
||
|
|
;; where search form was created.
|
||
|
|
;;
|
||
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||
|
|
;;
|
||
|
|
;;; Change log:
|
||
|
|
;;
|
||
|
|
;;
|
||
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||
|
|
;;
|
||
|
|
;; 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 2, 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; see the file COPYING. If not, write to
|
||
|
|
;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth
|
||
|
|
;; Floor, Boston, MA 02110-1301, USA.
|
||
|
|
;;
|
||
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||
|
|
;;
|
||
|
|
;;; Code:
|
||
|
|
|
||
|
|
(eval-when-compile (require 'ourcomments-util))
|
||
|
|
(require 'cus-edit)
|
||
|
|
(require 'grep)
|
||
|
|
|
||
|
|
(defvar search-form-sfield nil)
|
||
|
|
(make-variable-buffer-local 'search-form-sfield)
|
||
|
|
(defvar search-form-rfield nil)
|
||
|
|
(make-variable-buffer-local 'search-form-rfield)
|
||
|
|
|
||
|
|
(defvar search-form-win-config nil)
|
||
|
|
(make-variable-buffer-local 'search-form-win-config)
|
||
|
|
(put 'search-form-win-config 'permanent-local t)
|
||
|
|
|
||
|
|
(defvar search-form-current-buffer nil)
|
||
|
|
|
||
|
|
(defun search-form-multi-occur-get-buffers ()
|
||
|
|
(let* ((bufs (list (read-buffer "First buffer to search: "
|
||
|
|
(current-buffer) t)))
|
||
|
|
(buf nil)
|
||
|
|
(ido-ignore-item-temp-list bufs))
|
||
|
|
(while (not (string-equal
|
||
|
|
(setq buf (read-buffer
|
||
|
|
(if (eq read-buffer-function 'ido-read-buffer)
|
||
|
|
"Next buffer to search (C-j to end): "
|
||
|
|
"Next buffer to search (RET to end): ")
|
||
|
|
nil t))
|
||
|
|
""))
|
||
|
|
(add-to-list 'bufs buf)
|
||
|
|
(setq ido-ignore-item-temp-list bufs))
|
||
|
|
(nreverse (mapcar #'get-buffer bufs))))
|
||
|
|
|
||
|
|
(defvar search-form-buffer) ;; dyn var, silence compiler
|
||
|
|
(defvar search-form-search-string) ;; dyn var, silence compiler
|
||
|
|
(defvar search-form-replace-string) ;; dyn var, silence compiler
|
||
|
|
|
||
|
|
(defun search-form-notify-1 (use-search-field
|
||
|
|
use-replace-field
|
||
|
|
w
|
||
|
|
hide-form
|
||
|
|
display-orig-buf)
|
||
|
|
(let ((search-form-search-string (when use-search-field (widget-value search-form-sfield)))
|
||
|
|
(search-form-replace-string (when use-replace-field (widget-value search-form-rfield)))
|
||
|
|
(search-form-buffer (current-buffer))
|
||
|
|
(this-search (widget-get w :do-search))
|
||
|
|
(do-it t))
|
||
|
|
(if (and use-search-field
|
||
|
|
(= 0 (length search-form-search-string)))
|
||
|
|
(progn
|
||
|
|
(setq do-it nil)
|
||
|
|
(message "Please specify a search string"))
|
||
|
|
(when (and use-replace-field
|
||
|
|
(= 0 (length search-form-replace-string)))
|
||
|
|
(setq do-it nil)
|
||
|
|
(message "Please specify a replace string")))
|
||
|
|
(when do-it
|
||
|
|
(if hide-form
|
||
|
|
(progn
|
||
|
|
(set-window-configuration search-form-win-config)
|
||
|
|
(funcall this-search search-form-search-string)
|
||
|
|
;;(kill-buffer search-form-buffer)
|
||
|
|
)
|
||
|
|
(when display-orig-buf
|
||
|
|
(let ((win (display-buffer search-form-current-buffer t)))
|
||
|
|
(select-window win t)))
|
||
|
|
;;(funcall this-search search-form-search-string))
|
||
|
|
(funcall this-search w)
|
||
|
|
))))
|
||
|
|
|
||
|
|
(defun search-form-notify-no-field (w &rest ignore)
|
||
|
|
(search-form-notify-1 nil nil w nil t))
|
||
|
|
|
||
|
|
(defun search-form-notify-sfield (w &rest ignore)
|
||
|
|
(search-form-notify-1 t nil w nil t))
|
||
|
|
|
||
|
|
(defun search-form-notify-sfield-nobuf (w &rest ignore)
|
||
|
|
(search-form-notify-1 t nil w nil nil))
|
||
|
|
|
||
|
|
(defun search-form-notify-both-fields (w &rest ignore)
|
||
|
|
(search-form-notify-1 t t w nil t))
|
||
|
|
|
||
|
|
(defun search-form-insert-button (title function descr do-search-fun)
|
||
|
|
(widget-insert " ")
|
||
|
|
(let ((button-title (format " %-15s " title)))
|
||
|
|
(widget-create 'push-button
|
||
|
|
:do-search do-search-fun
|
||
|
|
:notify 'search-form-notify-no-field
|
||
|
|
:current-buffer search-form-current-buffer
|
||
|
|
button-title))
|
||
|
|
(widget-insert " " descr)
|
||
|
|
(widget-insert "\n"))
|
||
|
|
|
||
|
|
(defun search-form-insert-search (title search-fun descr do-search-fun no-buf)
|
||
|
|
(widget-insert " ")
|
||
|
|
(let ((button-title (format " %-15s " title)))
|
||
|
|
(if no-buf
|
||
|
|
(widget-create 'push-button
|
||
|
|
:do-search do-search-fun
|
||
|
|
:notify 'search-form-notify-sfield-nobuf
|
||
|
|
:current-buffer search-form-current-buffer
|
||
|
|
button-title)
|
||
|
|
(widget-create 'push-button
|
||
|
|
:do-search do-search-fun
|
||
|
|
:notify 'search-form-notify-sfield
|
||
|
|
:current-buffer search-form-current-buffer
|
||
|
|
button-title)
|
||
|
|
))
|
||
|
|
(widget-insert " " descr " ")
|
||
|
|
(search-form-insert-help search-fun)
|
||
|
|
(widget-insert "\n"))
|
||
|
|
|
||
|
|
(defun search-form-insert-fb (descr
|
||
|
|
use-sfield
|
||
|
|
forward-fun
|
||
|
|
do-forward-fun
|
||
|
|
backward-fun
|
||
|
|
do-backward-fun)
|
||
|
|
(widget-insert (format " %s: " descr))
|
||
|
|
(widget-create 'push-button
|
||
|
|
:do-search do-forward-fun
|
||
|
|
:use-sfield use-sfield
|
||
|
|
:notify '(lambda (widget &rest event)
|
||
|
|
(if (widget-get widget :use-sfield)
|
||
|
|
(search-form-notify-sfield widget)
|
||
|
|
(search-form-notify-no-field widget)))
|
||
|
|
:current-buffer search-form-current-buffer
|
||
|
|
" Forward ")
|
||
|
|
(widget-insert " ")
|
||
|
|
(search-form-insert-help forward-fun)
|
||
|
|
(widget-insert " ")
|
||
|
|
(widget-create 'push-button
|
||
|
|
:do-search do-backward-fun
|
||
|
|
:use-sfield use-sfield
|
||
|
|
:notify '(lambda (widget &rest event)
|
||
|
|
(if (widget-get widget :use-sfield)
|
||
|
|
(search-form-notify-sfield widget)
|
||
|
|
(search-form-notify-no-field widget)))
|
||
|
|
:current-buffer search-form-current-buffer
|
||
|
|
" Backward ")
|
||
|
|
(widget-insert " ")
|
||
|
|
(search-form-insert-help backward-fun)
|
||
|
|
(widget-insert "\n"))
|
||
|
|
|
||
|
|
(defun search-form-insert-replace (title replace-fun descr do-replace-fun)
|
||
|
|
(widget-insert " ")
|
||
|
|
(let ((button-title (format " %-15s " title)))
|
||
|
|
(widget-create 'push-button
|
||
|
|
:do-search do-replace-fun
|
||
|
|
:notify 'search-form-notify-both-fields
|
||
|
|
:current-buffer search-form-current-buffer
|
||
|
|
button-title))
|
||
|
|
(widget-insert " " descr " ")
|
||
|
|
(search-form-insert-help replace-fun)
|
||
|
|
(widget-insert "\n"))
|
||
|
|
|
||
|
|
(defun search-form-insert-help (fun)
|
||
|
|
(widget-insert "(")
|
||
|
|
(widget-create 'function-link
|
||
|
|
:value fun
|
||
|
|
:tag "help"
|
||
|
|
:button-face 'link)
|
||
|
|
(widget-insert ")"))
|
||
|
|
|
||
|
|
(defun sf-widget-field-value-set (widget value)
|
||
|
|
"Set current text in editing field."
|
||
|
|
(let ((from (widget-field-start widget))
|
||
|
|
(to (widget-field-end widget))
|
||
|
|
(buffer (widget-field-buffer widget))
|
||
|
|
(size (widget-get widget :size))
|
||
|
|
(secret (widget-get widget :secret))
|
||
|
|
(old (current-buffer)))
|
||
|
|
(if (and from to)
|
||
|
|
(progn
|
||
|
|
(set-buffer buffer)
|
||
|
|
(while (and size
|
||
|
|
(not (zerop size))
|
||
|
|
(> to from)
|
||
|
|
(eq (char-after (1- to)) ?\s))
|
||
|
|
(setq to (1- to)))
|
||
|
|
(goto-char to)
|
||
|
|
(delete-region from to)
|
||
|
|
(insert value)
|
||
|
|
(let ((result (buffer-substring-no-properties from to)))
|
||
|
|
(when secret
|
||
|
|
(let ((index 0))
|
||
|
|
(while (< (+ from index) to)
|
||
|
|
(aset result index
|
||
|
|
(get-char-property (+ from index) 'secret))
|
||
|
|
(setq index (1+ index)))))
|
||
|
|
(set-buffer old)
|
||
|
|
result))
|
||
|
|
(widget-get widget :value))))
|
||
|
|
|
||
|
|
(defvar search-form-form nil)
|
||
|
|
|
||
|
|
(defun search-form-isearch-end ()
|
||
|
|
(condition-case err
|
||
|
|
(progn
|
||
|
|
(message "sfie: search-form-form=%s" (widget-value (cdr search-form-form)))
|
||
|
|
(remove-hook 'isearch-mode-end-hook 'search-form-isearch-end)
|
||
|
|
;; enter isearch-string in field
|
||
|
|
(with-current-buffer (car search-form-form)
|
||
|
|
;; Fix-me: trashes the widget, it disappears... - there seem
|
||
|
|
;; to be know default set function.
|
||
|
|
;;(widget-value-set (cdr search-form-form) isearch-string)
|
||
|
|
))
|
||
|
|
(error (message "search-form-isearch-end: %S" err))))
|
||
|
|
|
||
|
|
(defun search-form-isearch-forward (w)
|
||
|
|
(interactive)
|
||
|
|
(add-hook 'isearch-mode-end-hook 'search-form-isearch-end)
|
||
|
|
(with-current-buffer search-form-buffer
|
||
|
|
(setq search-form-form (cons search-form-buffer search-form-sfield))
|
||
|
|
(message "sfif: cb=%s field=%S" (current-buffer) (widget-value (cdr search-form-form)))
|
||
|
|
)
|
||
|
|
(call-interactively 'isearch-forward))
|
||
|
|
|
||
|
|
(defun search-form-isearch-backward (w)
|
||
|
|
(interactive)
|
||
|
|
(add-hook 'isearch-mode-end-hook 'search-form-isearch-end)
|
||
|
|
(setq search-form-form search-form-sfield)
|
||
|
|
(call-interactively 'isearch-backward))
|
||
|
|
|
||
|
|
;;;###autoload
|
||
|
|
(defun search-form ()
|
||
|
|
"Display a form for search and replace."
|
||
|
|
(interactive)
|
||
|
|
(let* ((buf-name "*Search Form*")
|
||
|
|
(cur-buf (current-buffer))
|
||
|
|
(buffer (get-buffer-create buf-name))
|
||
|
|
(win-config (current-window-configuration)))
|
||
|
|
(setq search-form-current-buffer (current-buffer))
|
||
|
|
(with-current-buffer buffer
|
||
|
|
(set (make-local-variable 'search-form-win-config) win-config))
|
||
|
|
(switch-to-buffer-other-window buffer)
|
||
|
|
|
||
|
|
(kill-all-local-variables) ;; why???
|
||
|
|
(let ((inhibit-read-only t))
|
||
|
|
(erase-buffer))
|
||
|
|
;;(Custom-mode)
|
||
|
|
(remove-overlays)
|
||
|
|
|
||
|
|
(make-local-variable 'widget-button-face)
|
||
|
|
(setq widget-button-face custom-button)
|
||
|
|
(setq show-trailing-whitespace nil)
|
||
|
|
(when custom-raised-buttons
|
||
|
|
(set (make-local-variable 'widget-push-button-prefix) "")
|
||
|
|
(set (make-local-variable 'widget-push-button-suffix) "")
|
||
|
|
(set (make-local-variable 'widget-link-prefix) "")
|
||
|
|
(set (make-local-variable 'widget-link-suffix) ""))
|
||
|
|
|
||
|
|
(widget-insert (propertize "Search/Replace, buffer: " 'face 'font-lock-comment-face))
|
||
|
|
(widget-insert (format "%s" (buffer-name search-form-current-buffer)))
|
||
|
|
(let ((file (buffer-file-name search-form-current-buffer)))
|
||
|
|
(when file
|
||
|
|
(insert " (" file ")")))
|
||
|
|
(widget-insert "\n\n")
|
||
|
|
(search-form-insert-fb
|
||
|
|
"Incremental String Search" nil
|
||
|
|
'isearch-forward
|
||
|
|
'search-form-isearch-forward
|
||
|
|
'isearch-backward
|
||
|
|
'search-form-isearch-backward)
|
||
|
|
|
||
|
|
(search-form-insert-fb
|
||
|
|
"Incremental Regexp Search" nil
|
||
|
|
'isearch-forward-regexp
|
||
|
|
(lambda (w) (call-interactively 'isearch-forward-regexp))
|
||
|
|
'isearch-backward-regexp
|
||
|
|
(lambda (w) (call-interactively 'isearch-backward-regexp)))
|
||
|
|
|
||
|
|
;; Fix-me: in multiple buffers, from buffer-list
|
||
|
|
|
||
|
|
(widget-insert (make-string (window-width) ?-) "\n")
|
||
|
|
|
||
|
|
(widget-insert "Search: ")
|
||
|
|
(setq search-form-sfield
|
||
|
|
(widget-create 'editable-field
|
||
|
|
:size 58))
|
||
|
|
(widget-insert "\n\n")
|
||
|
|
(widget-insert (propertize "* Buffers:" 'face 'font-lock-comment-face) "\n")
|
||
|
|
(search-form-insert-fb "String Search" t
|
||
|
|
'search-forward
|
||
|
|
(lambda (w) (search-forward search-form-search-string))
|
||
|
|
'search-backward
|
||
|
|
(lambda (w) (search-backward search-form-search-string)))
|
||
|
|
|
||
|
|
(search-form-insert-fb "Regexp Search" t
|
||
|
|
're-search-forward
|
||
|
|
(lambda (w) (re-search-forward search-form-search-string))
|
||
|
|
're-search-backward
|
||
|
|
(lambda (w) (re-search-backward search-form-search-string)))
|
||
|
|
|
||
|
|
;; occur
|
||
|
|
(search-form-insert-search "Occur" 'occur
|
||
|
|
"Lines in buffer"
|
||
|
|
(lambda (w)
|
||
|
|
(with-current-buffer (widget-get w :current-buffer)
|
||
|
|
(occur search-form-search-string)))
|
||
|
|
t)
|
||
|
|
|
||
|
|
;; multi-occur
|
||
|
|
;; Fix-me: This should be done from buffer-list. Have juri finished that?
|
||
|
|
(search-form-insert-search "Multi-Occur" 'multi-occur
|
||
|
|
"Lines in specified buffers"
|
||
|
|
(lambda (w)
|
||
|
|
(let ((bufs (search-form-multi-occur-get-buffers)))
|
||
|
|
(multi-occur bufs search-form-search-string)))
|
||
|
|
t)
|
||
|
|
;;
|
||
|
|
(widget-insert "\n")
|
||
|
|
(widget-insert (propertize "* Files:" 'face 'font-lock-comment-face)
|
||
|
|
"\n")
|
||
|
|
|
||
|
|
(search-form-insert-search "Search in Dir" 'lgrep
|
||
|
|
"Grep in directory"
|
||
|
|
'search-form-lgrep
|
||
|
|
t)
|
||
|
|
(search-form-insert-search "Search in Tree" 'rgrep
|
||
|
|
"Grep in directory tree"
|
||
|
|
'search-form-rgrep
|
||
|
|
t)
|
||
|
|
|
||
|
|
(widget-insert "\n")
|
||
|
|
|
||
|
|
(search-form-insert-search "Tagged Files" 'tags-search
|
||
|
|
"Search files in tags table"
|
||
|
|
(lambda (w)
|
||
|
|
(with-current-buffer (widget-get w :current-buffer)
|
||
|
|
(tags-search search-form-search-string)))
|
||
|
|
t)
|
||
|
|
|
||
|
|
(widget-insert (make-string (window-width) ?-) "\n")
|
||
|
|
|
||
|
|
(widget-insert "Replace: ")
|
||
|
|
(setq search-form-rfield
|
||
|
|
(widget-create 'editable-field
|
||
|
|
:size 58))
|
||
|
|
(widget-insert "\n\n")
|
||
|
|
|
||
|
|
(widget-insert (propertize "* Buffers:" 'face 'font-lock-comment-face) "\n")
|
||
|
|
(search-form-insert-replace "Replace String"
|
||
|
|
'query-replace
|
||
|
|
"In buffer from point"
|
||
|
|
(lambda (w)
|
||
|
|
(query-replace search-form-search-string search-form-replace-string)))
|
||
|
|
|
||
|
|
(search-form-insert-replace "Replace Regexp"
|
||
|
|
'query-replace-regexp
|
||
|
|
"In buffer from point"
|
||
|
|
(lambda (w)
|
||
|
|
(query-replace-regexp search-form-search-string search-form-replace-string)))
|
||
|
|
|
||
|
|
(widget-insert "\n" (propertize "* Files:" 'face 'font-lock-comment-face) "\n")
|
||
|
|
|
||
|
|
;; fix-me: rdir-query-replace (from to file-regexp root &optional delimited)
|
||
|
|
(search-form-insert-replace "Replace in Dir"
|
||
|
|
'ldir-query-replace
|
||
|
|
"Replace in files in directory"
|
||
|
|
'search-form-ldir-replace)
|
||
|
|
(search-form-insert-replace "Replace in Tree"
|
||
|
|
'rdir-query-replace
|
||
|
|
"Replace in files in directory tree"
|
||
|
|
'search-form-rdir-replace)
|
||
|
|
|
||
|
|
(widget-insert "\n")
|
||
|
|
|
||
|
|
(search-form-insert-replace "Tagged Files"
|
||
|
|
'tags-query-replace
|
||
|
|
"Replace in files in tags tables"
|
||
|
|
(lambda (w)
|
||
|
|
(tags-query-replace search-form-search-string search-form-replace-string)))
|
||
|
|
|
||
|
|
(buffer-disable-undo)
|
||
|
|
(widget-setup)
|
||
|
|
(buffer-enable-undo)
|
||
|
|
(use-local-map widget-keymap)
|
||
|
|
(fit-window-to-buffer)
|
||
|
|
(widget-forward 1)
|
||
|
|
))
|
||
|
|
|
||
|
|
(defun search-form-lgrep (w)
|
||
|
|
(search-form-r-or-lgrep w t))
|
||
|
|
|
||
|
|
(defun search-form-rgrep (w)
|
||
|
|
(search-form-r-or-lgrep w nil))
|
||
|
|
|
||
|
|
(defun search-form-r-or-lgrep (w l)
|
||
|
|
(with-current-buffer (widget-get w :current-buffer)
|
||
|
|
(let* ((regexp search-form-search-string)
|
||
|
|
(files (grep-read-files regexp))
|
||
|
|
(dir (read-directory-name (if l "In directory: "
|
||
|
|
"Base directory: ")
|
||
|
|
nil default-directory t)))
|
||
|
|
(if l
|
||
|
|
(lgrep regexp files dir)
|
||
|
|
(rgrep regexp files dir)
|
||
|
|
))))
|
||
|
|
|
||
|
|
(defun search-form-ldir-replace (w)
|
||
|
|
(search-form-l-or-r-dir-replace w t))
|
||
|
|
|
||
|
|
(defun search-form-rdir-replace (w)
|
||
|
|
(search-form-l-or-r-dir-replace w nil))
|
||
|
|
|
||
|
|
(defun search-form-l-or-r-dir-replace (w l)
|
||
|
|
(let ((files (replace-read-files search-form-search-string search-form-replace-string))
|
||
|
|
(dir (read-directory-name (if l
|
||
|
|
"In directory: "
|
||
|
|
"In directory tree: ")
|
||
|
|
nil
|
||
|
|
(file-name-directory
|
||
|
|
(buffer-file-name search-form-current-buffer))
|
||
|
|
t)))
|
||
|
|
(if l
|
||
|
|
(ldir-query-replace search-form-search-string search-form-replace-string files dir)
|
||
|
|
(rdir-query-replace search-form-search-string search-form-replace-string files dir))))
|
||
|
|
|
||
|
|
(provide 'search-form)
|
||
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||
|
|
;;; search-form.el ends here
|