;; -*- mode: emacs-lisp; unibyte: t; -*- ;; ekreplace.el - front end for non-incremental search and replace ;; Copyright (C) 1992-2005 Ehud karni ;; This file is NOT part of GNU Emacs, distribution conditions below. ;; ;; EHUD KARNI ינרק דוהא ;; Ben Gurion st' 14 ןוירוג ןב 'חר ;; Kfar - Sava 44 257 אבס - רפכ ;; =================================== ;; 972-(0)9-7659599 ;; =================================== ;; RCS: $Id: ekreplace.el,v 1.102 2000/03/05 15:05:56 ehud Exp $ ;; $Log: ekreplace.el,v $ ;; Revision 1.102 2000/03/05 15:05:56 ehud ;; Updated perform-replace (20.5), user \\W for word search. ;; Better \# handling (in get-replace-string replace-this-one) ;; ;; Revision 1.101 1998/11/11 12:45:46 ehud ;; No change. Last revision for 19.34. ;; ;; Revision 1.100 1996/02/19 10:32:48 ehud ;; Initial RCS revision ;; 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 of the License, 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; if not, write to the Free Software ;; Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA ;; (require 'replace) - replace.el does not provide it !! ;;hacked perform-replace from 20.5/lisp/replace.el (defun perform-replace-20 (from-string replacements query-flag regexp-flag delimited-flag &optional repeat-count map) "Hacked by Ehud Karni to allow a function name in `replacements' 23/12/96. Subroutine of `query-replace'. Its complexity handles interactive queries. Don't use this in your own program unless you want to query and set the mark just as `query-replace' does. Instead, write a simple loop like this: (while (re-search-forward \"foo[ \\t]+bar\" nil t) (replace-match \"foobar\" nil nil)) which will run faster and probably do exactly what you want. If `replacements' is a function, it is called with 3 arguments - FIXEDCASE LITERAL COUNT. FIXEDCASE & LITERAL are the same as for `replace-match', COUNT is replacement count, it is <0 if last replacement was not really done (query-replace), else it is the real next count (1st=0)." (or map (setq map query-replace-map)) (and query-flag minibuffer-auto-raise (raise-frame (window-frame (minibuffer-window)))) (let ((nocasify (not (and case-fold-search case-replace (string-equal from-string (downcase from-string))))) (case-fold-search (and case-fold-search (string-equal from-string (downcase from-string)))) (literal (not regexp-flag)) (search-function (if regexp-flag 're-search-forward 'search-forward)) (search-string from-string) (real-match-data nil) ; the match data for the current match (next-replacement nil) (replacement-index 0) (keep-going t) (stack nil) (next-rotate-count 0) (replace-count 0) (nonempty-match nil) (limit nil) ; If non-nil, it is marker saying where in the buffer to stop. (match-again t) ; Data for the next match. If a cons, it has the same format as ;; (match-data); otherwise it is t if a match is possible at point. (message (if query-flag (substitute-command-keys "Query replacing %s with %s: (\\\\[help] for help) ")))) ;; If region is active, in Transient Mark mode, operate on region. (if (and transient-mark-mode mark-active) (progn (setq limit (copy-marker (region-end))) (goto-char (region-beginning)) (deactivate-mark))) (if (stringp replacements) (setq next-replacement replacements) (or repeat-count (setq repeat-count 1))) (if delimited-flag (setq search-function 're-search-forward search-string (concat "\\b" (if regexp-flag from-string (regexp-quote from-string)) "\\b"))) (push-mark) (undo-boundary) (unwind-protect ;; Loop finding occurrences that perhaps should be replaced. (while (and keep-going (not (eobp)) ;; Use the next match if it is already known; ;; otherwise, search for a match after moving forward ;; one char if progress is required. (setq real-match-data (if (consp match-again) (progn (goto-char (nth 1 match-again)) match-again) (and (or match-again (progn (forward-char 1) (not (eobp)))) (funcall search-function search-string limit t) ;; For speed, use only integers and ;; reuse the list used last time. (match-data t real-match-data))))) ;; Record whether the match is nonempty, to avoid an infinite loop ;; repeatedly matching the same empty string. (setq nonempty-match (/= (nth 0 real-match-data) (nth 1 real-match-data))) ;; If the match is empty, record that the next one can't be adjacent. ;; Otherwise, if matching a regular expression, do the next ;; match now, since the replacement for this match may ;; affect whether the next match is adjacent to this one. (setq match-again (and nonempty-match (or (not regexp-flag) (and (looking-at search-string) (match-data))))) ;; If time for a change, advance to next replacement string. ;; my addition, check if `replacements' is a function and call it (if (and (symbolp replacements) (fboundp replacements)) (progn (setq next-replacement (funcall replacements (vector next-rotate-count) replace-count)) (if (= next-rotate-count replace-count) (setq next-rotate-count (1+ next-rotate-count))))) ;; end of my changes -------------------------------------------------- (if (and (listp replacements) (= next-rotate-count replace-count)) (progn (setq next-rotate-count (+ next-rotate-count repeat-count)) (setq next-replacement (nth replacement-index replacements)) (setq replacement-index (% (1+ replacement-index) (length replacements))))) (if (not query-flag) (progn (set-match-data real-match-data) (replace-match next-replacement nocasify literal) (setq replace-count (1+ replace-count))) (undo-boundary) (let (done replaced key def) ;; Loop reading commands until one of them sets done, ;; which means it has finished handling this occurrence. (while (not done) (set-match-data real-match-data) (replace-highlight (match-beginning 0) (match-end 0)) ;; Bind message-log-max so we don't fill up the message log ;; with a bunch of identical messages. (let ((message-log-max nil)) (message message from-string next-replacement)) (setq key (read-event)) ;; Necessary in case something happens during read-event ;; that clobbers the match data. (set-match-data real-match-data) (setq key (vector key)) (setq def (lookup-key map key)) ;; Restore the match data while we process the command. (cond ((eq def 'help) (with-output-to-temp-buffer "*Help*" (princ (concat "Query replacing " (if regexp-flag "regexp " "") from-string " with " next-replacement ".\n\n" (substitute-command-keys query-replace-help))) (save-excursion (set-buffer standard-output) (help-mode)))) ((eq def 'exit) (setq keep-going nil) (setq done t)) ((eq def 'backup) (if stack (let ((elt (car stack))) (goto-char (car elt)) (setq replaced (eq t (cdr elt))) (or replaced (set-match-data (cdr elt))) (setq stack (cdr stack))) (message "No previous match") (ding 'no-terminate) (sit-for 1))) ((eq def 'act) (or replaced (progn (replace-match next-replacement nocasify literal) (setq replace-count (1+ replace-count)))) (setq done t replaced t)) ((eq def 'act-and-exit) (or replaced (progn (replace-match next-replacement nocasify literal) (setq replace-count (1+ replace-count)))) (setq keep-going nil) (setq done t replaced t)) ((eq def 'act-and-show) (if (not replaced) (progn (replace-match next-replacement nocasify literal) (setq replace-count (1+ replace-count)) (setq replaced t)))) ((eq def 'automatic) (or replaced (progn (replace-match next-replacement nocasify literal) (setq replace-count (1+ replace-count)))) (setq done t query-flag nil replaced t)) ((eq def 'skip) (setq done t)) ((eq def 'recenter) (recenter nil)) ((eq def 'edit) (let ((opos (point-marker))) (goto-char (match-beginning 0)) (save-excursion (funcall search-function search-string limit t) (setq real-match-data (match-data))) (save-excursion (recursive-edit)) (goto-char opos)) (set-match-data real-match-data) ;; Before we make the replacement, ;; decide whether the search string ;; can match again just after this match. (if (and regexp-flag nonempty-match) (setq match-again (and (looking-at search-string) (match-data))))) ((eq def 'delete-and-edit) (delete-region (match-beginning 0) (match-end 0)) (set-match-data (prog1 (match-data) (save-excursion (recursive-edit)))) (setq replaced t)) ;; Note: we do not need to treat `exit-prefix' ;; specially here, since we reread ;; any unrecognized character. (t (setq this-command 'mode-exited) (setq keep-going nil) (setq unread-command-events (append (listify-key-sequence key) unread-command-events)) (setq done t)))) ;; Record previous position for ^ when we move on. ;; Change markers to numbers in the match data ;; since lots of markers slow down editing. (setq stack (cons (cons (point) (or replaced (match-data t))) stack))))) (replace-dehighlight)) (or unread-command-events (message "Replaced %d occurrence%s" replace-count (if (= replace-count 1) "" "s"))) (and keep-going stack))) (if (< emacs-major-version 21) (defalias 'perform-replace 'perform-replace-20)) ;;======================= real start of ekreplace.el ========================== (require 'ring) (defvar search-string "" "Saved search string for search/replace operartions") (defvar search-indicator nil "*Search indicator for locate / replace (nil=string 0=word 1=reg-exp)") (defvar search-prompt "" "Search / Replace prompt (string word reg-exp)") (defvar repl-string "" "Saved replacment string for replace operartions. When it contain \\# it is special. In each successive replacement all the \# are changed to number according to user parameter (see description of `repl-num-values')") (defvar repl-num-values '(nil " " "%d" 1 0) "A list of 5 elements for incremental numeric replacement. 1st element is the current numeric value to replace the \\# in `repl-string'. 2nd element is the expression to compute the next numeric value. If it contains `#', the `#' is replaced with the current value, else the current value is prepended to the expression. The computation is done with `compute'. 3rd element is the format to output the number. Usually %d but maybe any string. 4th element is the cycle count: how many times to use the current numeric value before computing the next one. 5th element is the replacement count within the cycle, normally 0.") (defvar search-history nil "history list for searches") (defvar replace-history nil "history list for replacements") (defun set-search-prompt (arg) "Set prompt for search / replace get string according to prefix arg. it may be: 0-word, 1-regular expression, else-simple string" (interactive "P") (if arg (cond ((= arg 0) (setq search-prompt "Word ") (setq search-indicator 0)) ((= arg 1) (setq search-prompt "Reg-Exp ") (setq search-indicator 1)) (t (setq search-prompt "") (setq search-indicator nil))))) (defun get-search-string (arg) "get and save user-specified text string in search string variable. prefix arg may be: 0-word, 1-regular expression, else-simple string" (interactive "P") (set-search-prompt arg) (setq search-string (read-string (concat search-prompt "Search: ") search-string '(search-history . 1)))) (defun locate-text (arg) "Locate string input by the user. prefix arg may be: 0-word search, 1-regular expression, else-simple string" (interactive "P") (get-search-string arg) (locate-next arg)) (defun locate-next (arg &optional noerr) "Locate next occurrence of search string. Optional 2nd NOERR argument. If not nil just return nil with no error." (interactive "P") (if (string-equal search-string "") (get-search-string arg)) (if search-indicator (if (= search-indicator 0) (re-search-forward (concat "\\W" (regexp-quote search-string) "\\W") nil noerr) (re-search-forward search-string nil noerr)) (search-forward search-string nil noerr))) (defun locate-previous (arg) "Locate previous occurrence of search string" (interactive "P") (if (string-equal search-string "") (get-search-string arg)) (if search-indicator (if (= search-indicator 0) (re-search-backward (concat "\\W" (regexp-quote search-string) "\\W")) (re-search-backward search-string)) (search-backward search-string))) (defun locate-all (arg) "Locate all occurrence of string (in other window)" (interactive "P") (let ((src-i 9) ;; (hysyn (char-syntax ?-)) oc-src) (if (string-equal (buffer-name) "*Occur*") (other-window 1)) (get-search-string arg) (if search-indicator (setq src-i search-indicator)) (if (= src-i 1) ;; 1=reg_exp, leave as is (setq oc-src search-string) (and (setq oc-src (regexp-quote search-string)) ;;0,other-quote regexp (= src-i 0) ;; word: add delimitors (setq oc-src (concat "\\W" oc-src "\\W")))) (occur oc-src) ;; (modify-syntax-entry ?- (char-to-string hysyn)) (other-window 1) (define-key occur-mode-map "\r" 'occur-mode-goto-occurrence))) (defun get-replace-string (arg) "get and save both user-specified text string to search (search-string) and replacement text string (repl-string) variables. prefix arg may be: 0-word replace, 1-regular expression, else-string" (interactive "P") (set-search-prompt arg) (setq search-string (read-string (concat search-prompt "Replace: ") search-string '(search-history . 1))) (setq repl-string (read-string "Replace with: " repl-string '(replace-history . 1))) (if (not (string-match "[^\\]\\\\#" (concat " " repl-string " "))) (setq repl-num-values (cons nil (cdr repl-num-values))) (let ((curr (nth 0 repl-num-values)) (expr (nth 1 repl-num-values)) (fmt (nth 2 repl-num-values)) (cycl (nth 3 repl-num-values)) (cldn (nth 4 repl-num-values))) (or (setq curr (compute (read-string "1st numeric value to replace the `\\#': " (format "%g" (or curr 0))) 'nomsg)) (error "entered value is not numeric. Error !")) (or (and expr (stringp expr)) (setq expr " ")) (while (string-match "\376" expr) (aset expr (match-beginning 0) ?#)) (setq expr (concat " " (read-string "expression to compute next numeric value (# represent current value): " expr))) (or (string-match "[^\\]#" expr) (error "Expression does not contain unquoted # (representing current value). Error !")) (while (string-match "[^\\]#" expr) (aset expr (1+ (match-beginning 0)) ?\376)) (setq expr (substring expr 1)) (setq fmt (read-string "format of the replacing number: " fmt)) (setq cycl (string-to-int (read-string "How many times before computing new value (cycle): " (format "%d" (or cycl 1))))) (setq cldn (string-to-int (read-string "Where in the cycle are we now (full cycle = 0): " (format "%d" (or cldn 0))))) (setq repl-num-values (list curr expr fmt cycl cldn))))) (defun get-replace-what () "get option for query replace: All, 1, None or Veto (all)" (interactive "P") (aref (downcase (read-string "(A)ll lines, (1), (N)one, (V)eto-all: ")) 0)) (defun replace-this-one (DONE COUNT) "Create replacement for this one. Used when replacement string contains \\#. See help for variables: `repl-string' & `repl-num-values'. This function gets 2 arguments: DONE is nil or vector containing number of replacements done, COUNT is next replacement count (from perform-replace) If DONE > COUNT last replacement was not really done (query-replace), else it is the real next count (1st=0)." (let ((curr (nth 0 repl-num-values)) (expr (nth 1 repl-num-values)) (fmt (nth 2 repl-num-values)) (cycl (nth 3 repl-num-values)) (cldn (nth 4 repl-num-values)) (last (nth 5 repl-num-values)) ;; last replacement string or nil (saved-match (match-data)) ;; save match data (must !!) (comp-tmp (intern "\376")) ;; next value in compute p1 p2 rplc) ;; temp for compute (and (or (null DONE) (>= COUNT (aref DONE 0)) ;; last was replaced (null last)) ;; there was not last (progn (or (null DONE) (aset DONE 0 (1+ (aref DONE 0)))) ;; next replacement done (setq cldn (1+ cldn)) ;; place within the cycle (setq p2 (format fmt curr)) ;; new replace string (setq rplc repl-string) (setq last "") ;; NEW last (while (setq p1 (string-match "[^\\]\\\\#" (concat " " rplc))) (setq last (concat last (substring rplc 0 p1) p2)) (setq rplc (substring rplc (+ p1 2)))) (setq last (concat last rplc)) (if (>= cldn cycl) ;; end of cycle reached ? (progn (setq cldn 0) ;; next cycle start (set comp-tmp curr) ;; for intermediate computation (setq curr (compute expr 'NOMSG)))) ;; new value (setq repl-num-values (list curr expr fmt cycl cldn last)) (set-match-data saved-match))) ;; restore match data (must !) ;; (message "replacing string |%s|" last) last)) ;; return last as replacement (defun replace-txt (arg) "get search & replace strings, and replace option, then do replacement prefix arg may be: 0-word replace, 1-regular expression, else-string" (interactive "P") (get-replace-string arg) (let ((all-lines (get-replace-what)) (rplc (if (car repl-num-values) (if (>= emacs-major-version 21) (cons (function replace-this-one) (vector 0)) ;; use this for each replace (21.1 +) (function replace-this-one)) ;; call this function for each replace (20.x) repl-string))) ;; normal replacing string (cond ((= all-lines ?a) (if search-indicator (if (= search-indicator 0) (replace-string search-string rplc t) (replace-regexp search-string rplc)) (replace-string search-string rplc))) ((= all-lines ?1) (replace-next arg)) ((= all-lines ?v) (if search-indicator (if (= search-indicator 0) (query-replace search-string rplc t) (query-replace-regexp search-string rplc)) (query-replace search-string rplc))) (t (message "Replace requested was %c (%d) - not A(ll) 1 or V(erify). " all-lines all-lines))) )) (defun replace-next (arg) "Repeat last replace foreward (once, no query). Can be undone by UNDO only" (interactive "P") (locate-next arg) (replace-match (if (car repl-num-values) (replace-this-one nil 0) repl-string) t)) (defun replace-previous (arg) "Repeat last replace backward (once, no query). Can be undone by UNDO only" (interactive "P") (locate-previous arg) (replace-match (if (car repl-num-values) (replace-this-one nil 0) repl-string) t)) (defun replace-all (arg) "Repeat last replace on the whole file without asking. Can be undone by UNDO only !" (interactive "P") (if (string-equal search-string "") (progn (get-search-string arg) (get-replace-string arg))) (let ((rplc (if (car repl-num-values) (if (>= emacs-major-version 21) (cons (function replace-this-one) (vector 0)) ;; use this for each replace (21.1 +) (function replace-this-one)) ;; call this function for each replace (20.x) repl-string))) ;; normal replacing string (if search-indicator (if (= search-indicator 0) (replace-string search-string rplc t) (replace-regexp search-string rplc)) (replace-string search-string rplc)))) ;; (defun replace-regexp-whole-buffer (REGEXP TO-STRING) ;; "Replace REGEXP in the whole buffer with TO-STRING (exactly as is). ;; Saves cursor position. Can be undone by UNDO only !" ;; (let ((pos (point-marker))) ;; (goto-char (point-min)) ;; (while (re-search-forward REGEXP nil t) ;; (replace-match TO-STRING t t)) ;; (goto-char pos))) (defun replace-string-whole-buffer (STRING TO-STRING &optional REGEX) "Replace STRING in the whole buffer with TO-STRING (exactly as is). Saves cursor position. Can be undone by UNDO only !" (let ((pos (point-marker)) (search-function (if REGEX 're-search-forward 'search-forward)) (literal (not REGEX))) (goto-char (point-min)) (while (funcall search-function STRING nil t) (replace-match TO-STRING t literal)) (goto-char pos))) (defun unix2pc-lf () "Translate all LF (\\n) to CR-LF (\\r\\n) - for the WHOLE buffer." (interactive) (replace-string-whole-buffer "\n" "\r\n")) (defun pc2unix-crlf () "Translate all CR-LF (\\r\\n) to LF (\\n) - for the WHOLE buffer. Drop ^Z (\\032) if it is the last char of the (MSDOG) file." (interactive) (replace-string-whole-buffer "\r\n" "\n") (and (= (char-after (1- (point-max))) 26) ;;is it ^Z ? (delete-region (1- (point-max)) (point-max)))) ;;------------- changes to query-replace-map ----------------- (define-key query-replace-map "?" 'help) (define-key query-replace-map "Y" 'act) (define-key query-replace-map "N" 'skip) (define-key query-replace-map "Q" 'exit) (define-key query-replace-map "r" 'act-and-show) (define-key query-replace-map "R" 'act-and-show) (define-key query-replace-map "s" 'act-and-show) (define-key query-replace-map "S" 'act-and-show) (define-key query-replace-map "a" 'automatic) (define-key query-replace-map "A" 'automatic) (define-key query-replace-map "p" 'backup) (define-key query-replace-map "P" 'backup) (define-key query-replace-map "b" 'backup) (define-key query-replace-map "B" 'backup) (setq query-replace-help (concat query-replace-help " \n added options: previous match: ^, b, B, p, P replace: space, y, Y replace & wait: \",\", r, R, s, S replace all: !, a, A skip: Backspace, n, N")) ;;=========================== end of ekreplace.el ======================