1 ;;; search-form.el --- Search form
3 ;; Author: Lennart Borgman (lennart O borgman A gmail O com)
4 ;; Created: 2008-05-05T01:50:20+0200 Sun
11 ;; Features that might be required by this library:
13 ;; `cus-edit', `cus-face', `cus-load', `cus-start', `wid-edit'.
15 ;;;;;;;;;;seasfireplstring ;;
19 ;; After an idea by Eric Ludlam on Emacs Devel:
21 ;; http://lists.gnu.org/archive/html/emacs-devel/2008-05/msg00152.html
23 ;; NOT QUITE READY! Tagged files have not been tested.
25 ;; Fix-me: work on other windows buffer by default, not buffer from
26 ;; where search form was created.
28 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
33 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
35 ;; This program is free software; you can redistribute it and/or
36 ;; modify it under the terms of the GNU General Public License as
37 ;; published by the Free Software Foundation; either version 2, or
38 ;; (at your option) any later version.
40 ;; This program is distributed in the hope that it will be useful,
41 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
42 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
43 ;; General Public License for more details.
45 ;; You should have received a copy of the GNU General Public License
46 ;; along with this program; see the file COPYING. If not, write to
47 ;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth
48 ;; Floor, Boston, MA 02110-1301, USA.
50 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
54 (eval-when-compile (require 'ourcomments-util))
58 (defvar search-form-sfield nil)
59 (make-variable-buffer-local 'search-form-sfield)
60 (defvar search-form-rfield nil)
61 (make-variable-buffer-local 'search-form-rfield)
63 (defvar search-form-win-config nil)
64 (make-variable-buffer-local 'search-form-win-config)
65 (put 'search-form-win-config 'permanent-local t)
67 (defvar search-form-current-buffer nil)
69 (defun search-form-multi-occur-get-buffers ()
70 (let* ((bufs (list (read-buffer "First buffer to search: "
73 (ido-ignore-item-temp-list bufs))
74 (while (not (string-equal
75 (setq buf (read-buffer
76 (if (eq read-buffer-function 'ido-read-buffer)
77 "Next buffer to search (C-j to end): "
78 "Next buffer to search (RET to end): ")
81 (add-to-list 'bufs buf)
82 (setq ido-ignore-item-temp-list bufs))
83 (nreverse (mapcar #'get-buffer bufs))))
85 (defvar search-form-buffer) ;; dyn var, silence compiler
86 (defvar search-form-search-string) ;; dyn var, silence compiler
87 (defvar search-form-replace-string) ;; dyn var, silence compiler
89 (defun search-form-notify-1 (use-search-field
94 (let ((search-form-search-string (when use-search-field (widget-value search-form-sfield)))
95 (search-form-replace-string (when use-replace-field (widget-value search-form-rfield)))
96 (search-form-buffer (current-buffer))
97 (this-search (widget-get w :do-search))
99 (if (and use-search-field
100 (= 0 (length search-form-search-string)))
103 (message "Please specify a search string"))
104 (when (and use-replace-field
105 (= 0 (length search-form-replace-string)))
107 (message "Please specify a replace string")))
111 (set-window-configuration search-form-win-config)
112 (funcall this-search search-form-search-string)
113 ;;(kill-buffer search-form-buffer)
115 (when display-orig-buf
116 (let ((win (display-buffer search-form-current-buffer t)))
117 (select-window win t)))
118 ;;(funcall this-search search-form-search-string))
119 (funcall this-search w)
122 (defun search-form-notify-no-field (w &rest ignore)
123 (search-form-notify-1 nil nil w nil t))
125 (defun search-form-notify-sfield (w &rest ignore)
126 (search-form-notify-1 t nil w nil t))
128 (defun search-form-notify-sfield-nobuf (w &rest ignore)
129 (search-form-notify-1 t nil w nil nil))
131 (defun search-form-notify-both-fields (w &rest ignore)
132 (search-form-notify-1 t t w nil t))
134 (defun search-form-insert-button (title function descr do-search-fun)
136 (let ((button-title (format " %-15s " title)))
137 (widget-create 'push-button
138 :do-search do-search-fun
139 :notify 'search-form-notify-no-field
140 :current-buffer search-form-current-buffer
142 (widget-insert " " descr)
143 (widget-insert "\n"))
145 (defun search-form-insert-search (title search-fun descr do-search-fun no-buf)
147 (let ((button-title (format " %-15s " title)))
149 (widget-create 'push-button
150 :do-search do-search-fun
151 :notify 'search-form-notify-sfield-nobuf
152 :current-buffer search-form-current-buffer
154 (widget-create 'push-button
155 :do-search do-search-fun
156 :notify 'search-form-notify-sfield
157 :current-buffer search-form-current-buffer
160 (widget-insert " " descr " ")
161 (search-form-insert-help search-fun)
162 (widget-insert "\n"))
164 (defun search-form-insert-fb (descr
170 (widget-insert (format " %s: " descr))
171 (widget-create 'push-button
172 :do-search do-forward-fun
173 :use-sfield use-sfield
174 :notify '(lambda (widget &rest event)
175 (if (widget-get widget :use-sfield)
176 (search-form-notify-sfield widget)
177 (search-form-notify-no-field widget)))
178 :current-buffer search-form-current-buffer
181 (search-form-insert-help forward-fun)
183 (widget-create 'push-button
184 :do-search do-backward-fun
185 :use-sfield use-sfield
186 :notify '(lambda (widget &rest event)
187 (if (widget-get widget :use-sfield)
188 (search-form-notify-sfield widget)
189 (search-form-notify-no-field widget)))
190 :current-buffer search-form-current-buffer
193 (search-form-insert-help backward-fun)
194 (widget-insert "\n"))
196 (defun search-form-insert-replace (title replace-fun descr do-replace-fun)
198 (let ((button-title (format " %-15s " title)))
199 (widget-create 'push-button
200 :do-search do-replace-fun
201 :notify 'search-form-notify-both-fields
202 :current-buffer search-form-current-buffer
204 (widget-insert " " descr " ")
205 (search-form-insert-help replace-fun)
206 (widget-insert "\n"))
208 (defun search-form-insert-help (fun)
210 (widget-create 'function-link
216 (defun sf-widget-field-value-set (widget value)
217 "Set current text in editing field."
218 (let ((from (widget-field-start widget))
219 (to (widget-field-end widget))
220 (buffer (widget-field-buffer widget))
221 (size (widget-get widget :size))
222 (secret (widget-get widget :secret))
223 (old (current-buffer)))
230 (eq (char-after (1- to)) ?\s))
233 (delete-region from to)
235 (let ((result (buffer-substring-no-properties from to)))
238 (while (< (+ from index) to)
240 (get-char-property (+ from index) 'secret))
241 (setq index (1+ index)))))
244 (widget-get widget :value))))
246 (defvar search-form-form nil)
248 (defun search-form-isearch-end ()
251 (message "sfie: search-form-form=%s" (widget-value (cdr search-form-form)))
252 (remove-hook 'isearch-mode-end-hook 'search-form-isearch-end)
253 ;; enter isearch-string in field
254 (with-current-buffer (car search-form-form)
255 ;; Fix-me: trashes the widget, it disappears... - there seem
256 ;; to be know default set function.
257 ;;(widget-value-set (cdr search-form-form) isearch-string)
259 (error (message "search-form-isearch-end: %S" err))))
261 (defun search-form-isearch-forward (w)
263 (add-hook 'isearch-mode-end-hook 'search-form-isearch-end)
264 (with-current-buffer search-form-buffer
265 (setq search-form-form (cons search-form-buffer search-form-sfield))
266 (message "sfif: cb=%s field=%S" (current-buffer) (widget-value (cdr search-form-form)))
268 (call-interactively 'isearch-forward))
270 (defun search-form-isearch-backward (w)
272 (add-hook 'isearch-mode-end-hook 'search-form-isearch-end)
273 (setq search-form-form search-form-sfield)
274 (call-interactively 'isearch-backward))
277 (defun search-form ()
278 "Display a form for search and replace."
280 (let* ((buf-name "*Search Form*")
281 (cur-buf (current-buffer))
282 (buffer (get-buffer-create buf-name))
283 (win-config (current-window-configuration)))
284 (setq search-form-current-buffer (current-buffer))
285 (with-current-buffer buffer
286 (set (make-local-variable 'search-form-win-config) win-config))
287 (switch-to-buffer-other-window buffer)
289 (kill-all-local-variables) ;; why???
290 (let ((inhibit-read-only t))
295 (make-local-variable 'widget-button-face)
296 (setq widget-button-face custom-button)
297 (setq show-trailing-whitespace nil)
298 (when custom-raised-buttons
299 (set (make-local-variable 'widget-push-button-prefix) "")
300 (set (make-local-variable 'widget-push-button-suffix) "")
301 (set (make-local-variable 'widget-link-prefix) "")
302 (set (make-local-variable 'widget-link-suffix) ""))
304 (widget-insert (propertize "Search/Replace, buffer: " 'face 'font-lock-comment-face))
305 (widget-insert (format "%s" (buffer-name search-form-current-buffer)))
306 (let ((file (buffer-file-name search-form-current-buffer)))
308 (insert " (" file ")")))
309 (widget-insert "\n\n")
310 (search-form-insert-fb
311 "Incremental String Search" nil
313 'search-form-isearch-forward
315 'search-form-isearch-backward)
317 (search-form-insert-fb
318 "Incremental Regexp Search" nil
319 'isearch-forward-regexp
320 (lambda (w) (call-interactively 'isearch-forward-regexp))
321 'isearch-backward-regexp
322 (lambda (w) (call-interactively 'isearch-backward-regexp)))
324 ;; Fix-me: in multiple buffers, from buffer-list
326 (widget-insert (make-string (window-width) ?-) "\n")
328 (widget-insert "Search: ")
329 (setq search-form-sfield
330 (widget-create 'editable-field
332 (widget-insert "\n\n")
333 (widget-insert (propertize "* Buffers:" 'face 'font-lock-comment-face) "\n")
334 (search-form-insert-fb "String Search" t
336 (lambda (w) (search-forward search-form-search-string))
338 (lambda (w) (search-backward search-form-search-string)))
340 (search-form-insert-fb "Regexp Search" t
342 (lambda (w) (re-search-forward search-form-search-string))
344 (lambda (w) (re-search-backward search-form-search-string)))
347 (search-form-insert-search "Occur" 'occur
350 (with-current-buffer (widget-get w :current-buffer)
351 (occur search-form-search-string)))
355 ;; Fix-me: This should be done from buffer-list. Have juri finished that?
356 (search-form-insert-search "Multi-Occur" 'multi-occur
357 "Lines in specified buffers"
359 (let ((bufs (search-form-multi-occur-get-buffers)))
360 (multi-occur bufs search-form-search-string)))
364 (widget-insert (propertize "* Files:" 'face 'font-lock-comment-face)
367 (search-form-insert-search "Search in Dir" 'lgrep
371 (search-form-insert-search "Search in Tree" 'rgrep
372 "Grep in directory tree"
378 (search-form-insert-search "Tagged Files" 'tags-search
379 "Search files in tags table"
381 (with-current-buffer (widget-get w :current-buffer)
382 (tags-search search-form-search-string)))
385 (widget-insert (make-string (window-width) ?-) "\n")
387 (widget-insert "Replace: ")
388 (setq search-form-rfield
389 (widget-create 'editable-field
391 (widget-insert "\n\n")
393 (widget-insert (propertize "* Buffers:" 'face 'font-lock-comment-face) "\n")
394 (search-form-insert-replace "Replace String"
396 "In buffer from point"
398 (query-replace search-form-search-string search-form-replace-string)))
400 (search-form-insert-replace "Replace Regexp"
401 'query-replace-regexp
402 "In buffer from point"
404 (query-replace-regexp search-form-search-string search-form-replace-string)))
406 (widget-insert "\n" (propertize "* Files:" 'face 'font-lock-comment-face) "\n")
408 ;; fix-me: rdir-query-replace (from to file-regexp root &optional delimited)
409 (search-form-insert-replace "Replace in Dir"
411 "Replace in files in directory"
412 'search-form-ldir-replace)
413 (search-form-insert-replace "Replace in Tree"
415 "Replace in files in directory tree"
416 'search-form-rdir-replace)
420 (search-form-insert-replace "Tagged Files"
422 "Replace in files in tags tables"
424 (tags-query-replace search-form-search-string search-form-replace-string)))
426 (buffer-disable-undo)
429 (use-local-map widget-keymap)
430 (fit-window-to-buffer)
434 (defun search-form-lgrep (w)
435 (search-form-r-or-lgrep w t))
437 (defun search-form-rgrep (w)
438 (search-form-r-or-lgrep w nil))
440 (defun search-form-r-or-lgrep (w l)
441 (with-current-buffer (widget-get w :current-buffer)
442 (let* ((regexp search-form-search-string)
443 (files (grep-read-files regexp))
444 (dir (read-directory-name (if l "In directory: "
446 nil default-directory t)))
448 (lgrep regexp files dir)
449 (rgrep regexp files dir)
452 (defun search-form-ldir-replace (w)
453 (search-form-l-or-r-dir-replace w t))
455 (defun search-form-rdir-replace (w)
456 (search-form-l-or-r-dir-replace w nil))
458 (defun search-form-l-or-r-dir-replace (w l)
459 (let ((files (replace-read-files search-form-search-string search-form-replace-string))
460 (dir (read-directory-name (if l
462 "In directory tree: ")
465 (buffer-file-name search-form-current-buffer))
468 (ldir-query-replace search-form-search-string search-form-replace-string files dir)
469 (rdir-query-replace search-form-search-string search-form-replace-string files dir))))
471 (provide 'search-form)
472 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
473 ;;; search-form.el ends here