diff options
Diffstat (limited to 'emacs.d/nxhtml/util/search-form.el')
| -rw-r--r-- | emacs.d/nxhtml/util/search-form.el | 473 |
1 files changed, 0 insertions, 473 deletions
diff --git a/emacs.d/nxhtml/util/search-form.el b/emacs.d/nxhtml/util/search-form.el deleted file mode 100644 index b7b6dd2..0000000 --- a/emacs.d/nxhtml/util/search-form.el +++ /dev/null @@ -1,473 +0,0 @@ -;;; 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 |