home *** CD-ROM | disk | FTP | other *** search
/ Geek Gadgets 1 / ADE-1.bin / ade-dist / emacs-19.28-src.tgz / tar.out / fsf / emacs / lisp / replace.el < prev    next >
Lisp/Scheme  |  1996-09-28  |  24KB  |  644 lines
  1. ;;; replace.el --- replace commands for Emacs.
  2.  
  3. ;; Copyright (C) 1985, 1986, 1987, 1992, 1994 Free Software Foundation, Inc.
  4.  
  5. ;; This file is part of GNU Emacs.
  6.  
  7. ;; GNU Emacs is free software; you can redistribute it and/or modify
  8. ;; it under the terms of the GNU General Public License as published by
  9. ;; the Free Software Foundation; either version 2, or (at your option)
  10. ;; any later version.
  11.  
  12. ;; GNU Emacs is distributed in the hope that it will be useful,
  13. ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  14. ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  15. ;; GNU General Public License for more details.
  16.  
  17. ;; You should have received a copy of the GNU General Public License
  18. ;; along with GNU Emacs; see the file COPYING.  If not, write to
  19. ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
  20.  
  21. ;;; Commentary:
  22.  
  23. ;; This package supplies the string and regular-expression replace functions
  24. ;; documented in the Emacs user's manual.
  25.  
  26. ;;; Code:
  27.  
  28. (defconst case-replace t "\
  29. *Non-nil means query-replace should preserve case in replacements.")
  30.  
  31. (defvar query-replace-history nil)
  32.  
  33. (defun query-replace-read-args (string)
  34.   (let (from to)
  35.     (setq from (read-from-minibuffer (format "%s: " string)
  36.                      nil nil nil
  37.                      'query-replace-history))
  38.     (setq to (read-from-minibuffer (format "%s %s with: " string from)
  39.                    nil nil nil
  40.                    'query-replace-history))
  41.     (list from to current-prefix-arg)))
  42.  
  43. (defun query-replace (from-string to-string &optional arg)
  44.   "Replace some occurrences of FROM-STRING with TO-STRING.
  45. As each match is found, the user must type a character saying
  46. what to do with it.  For directions, type \\[help-command] at that time.
  47.  
  48. Preserves case in each replacement if `case-replace' and `case-fold-search'
  49. are non-nil and FROM-STRING has no uppercase letters.
  50. Third arg DELIMITED (prefix arg if interactive), if non-nil, means replace
  51. only matches surrounded by word boundaries.
  52.  
  53. To customize possible responses, change the \"bindings\" in `query-replace-map'."
  54.   (interactive (query-replace-read-args "Query replace"))
  55.   (perform-replace from-string to-string t nil arg)
  56.   (or unread-command-events (message "Done")))
  57. (define-key esc-map "%" 'query-replace)
  58.  
  59. (defun query-replace-regexp (regexp to-string &optional arg)
  60.   "Replace some things after point matching REGEXP with TO-STRING.
  61. As each match is found, the user must type a character saying
  62. what to do with it.  For directions, type \\[help-command] at that time.
  63.  
  64. Preserves case in each replacement if `case-replace' and `case-fold-search'
  65. are non-nil and REGEXP has no uppercase letters.
  66. Third arg DELIMITED (prefix arg if interactive), if non-nil, means replace
  67. only matches surrounded by word boundaries.
  68. In TO-STRING, `\\&' stands for whatever matched the whole of REGEXP,
  69. and `\\=\\N' (where N is a digit) stands for
  70.  whatever what matched the Nth `\\(...\\)' in REGEXP."
  71.   (interactive (query-replace-read-args "Query replace regexp"))
  72.   (perform-replace regexp to-string t t arg)
  73.   (or unread-command-events (message "Done")))
  74.  
  75. (defun map-query-replace-regexp (regexp to-strings &optional arg)
  76.   "Replace some matches for REGEXP with various strings, in rotation.
  77. The second argument TO-STRINGS contains the replacement strings, separated
  78. by spaces.  This command works like `query-replace-regexp' except
  79. that each successive replacement uses the next successive replacement string,
  80. wrapping around from the last such string to the first.
  81.  
  82. Non-interactively, TO-STRINGS may be a list of replacement strings.
  83.  
  84. A prefix argument N says to use each replacement string N times
  85. before rotating to the next."
  86.   (interactive
  87.    (let (from to)
  88.      (setq from (read-from-minibuffer "Map query replace (regexp): "
  89.                       nil nil nil
  90.                       'query-replace-history))
  91.      (setq to (read-from-minibuffer
  92.            (format "Query replace %s with (space-separated strings): "
  93.                from)
  94.            nil nil nil
  95.            'query-replace-history))
  96.      (list from to current-prefix-arg)))
  97.   (let (replacements)
  98.     (if (listp to-strings)
  99.     (setq replacements to-strings)
  100.       (while (/= (length to-strings) 0)
  101.     (if (string-match " " to-strings)
  102.         (setq replacements
  103.           (append replacements
  104.               (list (substring to-strings 0
  105.                        (string-match " " to-strings))))
  106.           to-strings (substring to-strings
  107.                        (1+ (string-match " " to-strings))))
  108.       (setq replacements (append replacements (list to-strings))
  109.         to-strings ""))))
  110.     (perform-replace regexp replacements t t nil arg))
  111.   (or unread-command-events (message "Done")))
  112.  
  113. (defun replace-string (from-string to-string &optional delimited)
  114.   "Replace occurrences of FROM-STRING with TO-STRING.
  115. Preserve case in each match if `case-replace' and `case-fold-search'
  116. are non-nil and FROM-STRING has no uppercase letters.
  117. Third arg DELIMITED (prefix arg if interactive), if non-nil, means replace
  118. only matches surrounded by word boundaries.
  119.  
  120. This function is usually the wrong thing to use in a Lisp program.
  121. What you probably want is a loop like this:
  122.   (while (search-forward FROM-STRING nil t)
  123.     (replace-match TO-STRING nil t))
  124. which will run faster and will not set the mark or print anything."
  125.   (interactive (query-replace-read-args "Replace string"))
  126.   (perform-replace from-string to-string nil nil delimited)
  127.   (or unread-command-events (message "Done")))
  128.  
  129. (defun replace-regexp (regexp to-string &optional delimited)
  130.   "Replace things after point matching REGEXP with TO-STRING.
  131. Preserve case in each match if `case-replace' and `case-fold-search'
  132. are non-nil and REGEXP has no uppercase letters.
  133. Third arg DELIMITED (prefix arg if interactive), if non-nil, means replace
  134. only matches surrounded by word boundaries.
  135. In TO-STRING, `\\&' stands for whatever matched the whole of REGEXP,
  136. and `\\=\\N' (where N is a digit) stands for
  137.  whatever what matched the Nth `\\(...\\)' in REGEXP.
  138.  
  139. This function is usually the wrong thing to use in a Lisp program.
  140. What you probably want is a loop like this:
  141.   (while (re-search-forward REGEXP nil t)
  142.     (replace-match TO-STRING nil nil))
  143. which will run faster and will not set the mark or print anything."
  144.   (interactive (query-replace-read-args "Replace regexp"))
  145.   (perform-replace regexp to-string nil t delimited)
  146.   (or unread-command-events (message "Done")))
  147.  
  148. (defvar regexp-history nil
  149.   "History list for some commands that read regular expressions.")
  150.  
  151. (defalias 'delete-non-matching-lines 'keep-lines)
  152. (defun keep-lines (regexp)
  153.   "Delete all lines except those containing matches for REGEXP.
  154. A match split across lines preserves all the lines it lies in.
  155. Applies to all lines after point."
  156.   (interactive (list (read-from-minibuffer
  157.               "Keep lines (containing match for regexp): "
  158.               nil nil nil 'regexp-history)))
  159.   (save-excursion
  160.     (or (bolp) (forward-line 1))
  161.     (let ((start (point)))
  162.       (while (not (eobp))
  163.     ;; Start is first char not preserved by previous match.
  164.     (if (not (re-search-forward regexp nil 'move))
  165.         (delete-region start (point-max))
  166.       (let ((end (save-excursion (goto-char (match-beginning 0))
  167.                      (beginning-of-line)
  168.                      (point))))
  169.         ;; Now end is first char preserved by the new match.
  170.         (if (< start end)
  171.         (delete-region start end))))
  172.     (setq start (save-excursion (forward-line 1)
  173.                     (point)))
  174.     ;; If the match was empty, avoid matching again at same place.
  175.     (and (not (eobp)) (= (match-beginning 0) (match-end 0))
  176.          (forward-char 1))))))
  177.  
  178. (defalias 'delete-matching-lines 'flush-lines)
  179. (defun flush-lines (regexp)
  180.   "Delete lines containing matches for REGEXP.
  181. If a match is split across lines, all the lines it lies in are deleted.
  182. Applies to lines after point."
  183.   (interactive (list (read-from-minibuffer
  184.               "Flush lines (containing match for regexp): "
  185.               nil nil nil 'regexp-history)))
  186.   (save-excursion
  187.     (while (and (not (eobp))
  188.         (re-search-forward regexp nil t))
  189.       (delete-region (save-excursion (goto-char (match-beginning 0))
  190.                      (beginning-of-line)
  191.                      (point))
  192.              (progn (forward-line 1) (point))))))
  193.  
  194. (defalias 'count-matches 'how-many)
  195. (defun how-many (regexp)
  196.   "Print number of matches for REGEXP following point."
  197.   (interactive (list (read-from-minibuffer
  198.               "How many matches for (regexp): "
  199.               nil nil nil 'regexp-history)))
  200.   (let ((count 0) opoint)
  201.     (save-excursion
  202.      (while (and (not (eobp))
  203.          (progn (setq opoint (point))
  204.             (re-search-forward regexp nil t)))
  205.        (if (= opoint (point))
  206.        (forward-char 1)
  207.      (setq count (1+ count))))
  208.      (message "%d occurrences" count))))
  209.  
  210. (defvar occur-mode-map ())
  211. (if occur-mode-map
  212.     ()
  213.   (setq occur-mode-map (make-sparse-keymap))
  214.   (define-key occur-mode-map [mouse-2] 'occur-mode-mouse-goto)
  215.   (define-key occur-mode-map "\C-c\C-c" 'occur-mode-goto-occurrence))
  216.  
  217. (defvar occur-buffer nil)
  218. (defvar occur-nlines nil)
  219. (defvar occur-pos-list nil)
  220.  
  221. (defun occur-mode ()
  222.   "Major mode for output from \\[occur].
  223. Move point to one of the occurrences in this buffer,
  224. then use \\[occur-mode-goto-occurrence] to go to the same occurrence
  225. in the buffer that the occurrences were found in.
  226. Or click \\<occur-mode-map>\\[occur-mode-mouse-goto] on an occurrence line.
  227. \\{occur-mode-map}"
  228.   (kill-all-local-variables)
  229.   (use-local-map occur-mode-map)
  230.   (setq major-mode 'occur-mode)
  231.   (setq mode-name "Occur")
  232.   (make-local-variable 'occur-buffer)
  233.   (make-local-variable 'occur-nlines)
  234.   (make-local-variable 'occur-pos-list)
  235.   (run-hooks 'occur-mode-hook))
  236.  
  237. (defun occur-mode-mouse-goto (event)
  238.   "In Occur mode, go to the occurrence whose line you click on."
  239.   (interactive "e")
  240.   (let (buffer pos)
  241.     (save-excursion
  242.       (set-buffer (window-buffer (posn-window (event-end event))))
  243.       (save-excursion
  244.     (goto-char (posn-point (event-end event)))
  245.     (setq pos (occur-mode-find-occurrence))
  246.     (setq buffer occur-buffer)))
  247.     (pop-to-buffer buffer)
  248.     (goto-char (marker-position pos))))
  249.  
  250. (defun occur-mode-find-occurrence ()
  251.   (if (or (null occur-buffer)
  252.       (null (buffer-name occur-buffer)))
  253.       (progn
  254.     (setq occur-buffer nil
  255.           occur-pos-list nil)
  256.     (error "Buffer in which occurrences were found is deleted")))
  257.   (let* ((line-count
  258.       (count-lines (point-min)
  259.                (save-excursion
  260.              (beginning-of-line)
  261.              (point))))
  262.      (occur-number (save-excursion
  263.              (beginning-of-line)
  264.              (/ (1- line-count)
  265.                 (cond ((< occur-nlines 0)
  266.                    (- 2 occur-nlines))
  267.                   ((> occur-nlines 0)
  268.                    (+ 2 (* 2 occur-nlines)))
  269.                   (t 1)))))
  270.      (pos (nth occur-number occur-pos-list)))
  271.     (if (< line-count 1)
  272.     (error "No occurrence on this line"))
  273.     (or pos
  274.     (error "No occurrence on this line"))
  275.     pos))
  276.  
  277. (defun occur-mode-goto-occurrence ()
  278.   "Go to the occurrence the current line describes."
  279.   (interactive)
  280.   (let ((pos (occur-mode-find-occurrence)))
  281.     (pop-to-buffer occur-buffer)
  282.     (goto-char (marker-position pos))))
  283.  
  284. (defvar list-matching-lines-default-context-lines 0
  285.   "*Default number of context lines to include around a `list-matching-lines'
  286. match.  A negative number means to include that many lines before the match.
  287. A positive number means to include that many lines both before and after.")
  288.  
  289. (defalias 'list-matching-lines 'occur)
  290.  
  291. (defun occur (regexp &optional nlines)
  292.   "Show all lines in the current buffer containing a match for REGEXP.
  293.  
  294. If a match spreads across multiple lines, all those lines are shown.
  295.  
  296. Each line is displayed with NLINES lines before and after, or -NLINES
  297. before if NLINES is negative.
  298. NLINES defaults to `list-matching-lines-default-context-lines'.
  299. Interactively it is the prefix arg.
  300.  
  301. The lines are shown in a buffer named `*Occur*'.
  302. It serves as a menu to find any of the occurrences in this buffer.
  303. \\[describe-mode] in that buffer will explain how."
  304.   (interactive (list (let* ((default (car regexp-history))
  305.                 (input 
  306.                  (read-from-minibuffer
  307.                   (if default
  308.                   (format "List lines matching regexp (default `%s'): " default)
  309.                 "List lines matching regexp: ")
  310.                   nil nil nil
  311.                   'regexp-history)))
  312.                (if (> (length input) 0) input
  313.              (setcar regexp-history default)))
  314.              current-prefix-arg))
  315.   (setq nlines (if nlines (prefix-numeric-value nlines)
  316.          list-matching-lines-default-context-lines))
  317.   (let ((first t)
  318.     (buffer (current-buffer))
  319.     (linenum 1)
  320.     (prevpos (point-min))
  321.     (final-context-start (make-marker)))
  322. ;;;    (save-excursion
  323. ;;;      (beginning-of-line)
  324. ;;;      (setq linenum (1+ (count-lines (point-min) (point))))
  325. ;;;      (setq prevpos (point)))
  326.     (with-output-to-temp-buffer "*Occur*"
  327.       (save-excursion
  328.     (set-buffer standard-output)
  329.     (insert "Lines matching ")
  330.     (prin1 regexp)
  331.     (insert " in buffer " (buffer-name buffer) ?. ?\n)
  332.     (occur-mode)
  333.     (setq occur-buffer buffer)
  334.     (setq occur-nlines nlines)
  335.     (setq occur-pos-list ()))
  336.       (if (eq buffer standard-output)
  337.       (goto-char (point-max)))
  338.       (save-excursion
  339.     (beginning-of-buffer)
  340.     ;; Find next match, but give up if prev match was at end of buffer.
  341.     (while (and (not (= prevpos (point-max)))
  342.             (re-search-forward regexp nil t))
  343.       (goto-char (match-beginning 0))
  344.       (beginning-of-line)
  345.       (save-match-data
  346.         (setq linenum (+ linenum (count-lines prevpos (point)))))
  347.       (setq prevpos (point))
  348.       (goto-char (match-end 0))
  349.       (let* ((start (save-excursion
  350.               (goto-char (match-beginning 0))
  351.               (forward-line (if (< nlines 0) nlines (- nlines)))
  352.               (point)))
  353.          (end (save-excursion
  354.             (goto-char (match-end 0))
  355.             (if (> nlines 0)
  356.                 (forward-line (1+ nlines))
  357.                 (forward-line 1))
  358.             (point)))
  359.          (tag (format "%3d" linenum))
  360.          (empty (make-string (length tag) ?\ ))
  361.          tem)
  362.         (save-excursion
  363.           (setq tem (make-marker))
  364.           (set-marker tem (point))
  365.           (set-buffer standard-output)
  366.           (setq occur-pos-list (cons tem occur-pos-list))
  367.           (or first (zerop nlines)
  368.           (insert "--------\n"))
  369.           (setq first nil)
  370.           (insert-buffer-substring buffer start end)
  371.           (backward-char (- end start))
  372.           (setq tem nlines)
  373.           (while (> tem 0)
  374.         (insert empty ?:)
  375.         (forward-line 1)
  376.         (setq tem (1- tem)))
  377.           (let ((this-linenum linenum))
  378.         (set-marker final-context-start
  379.                 (+ (point) (- (match-end 0) (match-beginning 0))))
  380.         (while (< (point) final-context-start)
  381.           (if (null tag)
  382.               (setq tag (format "%3d" this-linenum)))
  383.           (insert tag ?:)
  384.           (put-text-property (save-excursion
  385.                        (beginning-of-line)
  386.                        (point))
  387.                      (save-excursion
  388.                        (end-of-line)
  389.                        (point))
  390.                      'mouse-face 'highlight)
  391.           (setq tag nil)
  392.           (forward-line 1)
  393.           (setq this-linenum (1+ this-linenum))))
  394.           (while (< tem nlines)
  395.         (insert empty ?:)
  396.         (forward-line 1)
  397.         (setq tem (1+ tem))))                
  398.         (forward-line 1)))
  399.     (set-buffer standard-output)
  400.     ;; Put positions in increasing order to go with buffer.
  401.     (setq occur-pos-list (nreverse occur-pos-list))
  402.     (if (interactive-p)
  403.         (message "%d matching lines." (length occur-pos-list)))))))
  404.  
  405. ;; It would be nice to use \\[...], but there is no reasonable way
  406. ;; to make that display both SPC and Y.
  407. (defconst query-replace-help
  408.   "Type Space or `y' to replace one match, Delete or `n' to skip to next,
  409. RET or `q' to exit, Period to replace one match and exit,
  410. Comma to replace but not move point immediately,
  411. C-r to enter recursive edit (\\[exit-recursive-edit] to get out again),
  412. C-w to delete match and recursive edit,
  413. C-l to clear the screen, redisplay, and offer same replacement again,
  414. ! to replace all remaining matches with no more questions,
  415. ^ to move point back to previous match."
  416.   "Help message while in query-replace")
  417.  
  418. (defvar query-replace-map (make-sparse-keymap)
  419.   "Keymap that defines the responses to questions in `query-replace'.
  420. The \"bindings\" in this map are not commands; they are answers.
  421. The valid answers include `act', `skip', `act-and-show',
  422. `exit', `act-and-exit', `edit', `delete-and-edit', `recenter',
  423. `automatic', `backup', and `help'.")
  424.  
  425. (define-key query-replace-map " " 'act)
  426. (define-key query-replace-map "\d" 'skip)
  427. (define-key query-replace-map [delete] 'skip)
  428. (define-key query-replace-map [backspace] 'skip)
  429. (define-key query-replace-map "y" 'act)
  430. (define-key query-replace-map "n" 'skip)
  431. (define-key query-replace-map "," 'act-and-show)
  432. (define-key query-replace-map "q" 'exit)
  433. (define-key query-replace-map "\r" 'exit)
  434. (define-key query-replace-map [return] 'exit)
  435. (define-key query-replace-map "." 'act-and-exit)
  436. (define-key query-replace-map "\C-r" 'edit)
  437. (define-key query-replace-map "\C-w" 'delete-and-edit)
  438. (define-key query-replace-map "\C-l" 'recenter)
  439. (define-key query-replace-map "!" 'automatic)
  440. (define-key query-replace-map "^" 'backup)
  441. (define-key query-replace-map "\C-h" 'help)
  442. (define-key query-replace-map "?" 'help)
  443. (define-key query-replace-map "\C-g" 'quit)
  444. (define-key query-replace-map "\C-]" 'quit)
  445.  
  446. (defun perform-replace (from-string replacements
  447.                 query-flag regexp-flag delimited-flag
  448.             &optional repeat-count map)
  449.   "Subroutine of `query-replace'.  Its complexity handles interactive queries.
  450. Don't use this in your own program unless you want to query and set the mark
  451. just as `query-replace' does.  Instead, write a simple loop like this:
  452.   (while (re-search-forward \"foo[ \t]+bar\" nil t)
  453.     (replace-match \"foobar\" nil nil))
  454. which will run faster and probably do exactly what you want."
  455.   (or map (setq map query-replace-map))
  456.   (let ((nocasify (not (and case-fold-search case-replace
  457.                 (string-equal from-string
  458.                       (downcase from-string)))))
  459.     (literal (not regexp-flag))
  460.     (search-function (if regexp-flag 're-search-forward 'search-forward))
  461.     (search-string from-string)
  462.     (real-match-data nil)        ; the match data for the current match
  463.     (next-replacement nil)
  464.     (replacement-index 0)
  465.     (keep-going t)
  466.     (stack nil)
  467.     (next-rotate-count 0)
  468.     (replace-count 0)
  469.     (lastrepl nil)            ;Position after last match considered.
  470.     (match-again t)
  471.     (message
  472.      (if query-flag
  473.          (substitute-command-keys
  474.           "Query replacing %s with %s: (\\<query-replace-map>\\[help] for help) "))))
  475.     (if (stringp replacements)
  476.     (setq next-replacement replacements)
  477.       (or repeat-count (setq repeat-count 1)))
  478.     (if delimited-flag
  479.     (setq search-function 're-search-forward
  480.           search-string (concat "\\b"
  481.                     (if regexp-flag from-string
  482.                       (regexp-quote from-string))
  483.                     "\\b")))
  484.     (push-mark)
  485.     (undo-boundary)
  486.     (unwind-protect
  487.     ;; Loop finding occurrences that perhaps should be replaced.
  488.     (while (and keep-going
  489.             (not (eobp))
  490.             (funcall search-function search-string nil t)
  491.             ;; If the search string matches immediately after
  492.             ;; the previous match, but it did not match there
  493.             ;; before the replacement was done, ignore the match.
  494.             (if (or (eq lastrepl (point))
  495.                 (and regexp-flag
  496.                  (eq lastrepl (match-beginning 0))
  497.                  (not match-again)))
  498.             (if (eobp)
  499.                 nil
  500.               ;; Don't replace the null string 
  501.               ;; right after end of previous replacement.
  502.               (forward-char 1)
  503.               (funcall search-function search-string nil t))
  504.               t))
  505.  
  506.       ;; Save the data associated with the real match.
  507.       (setq real-match-data (match-data))
  508.  
  509.       ;; Before we make the replacement, decide whether the search string
  510.       ;; can match again just after this match.
  511.       (if regexp-flag
  512.           (setq match-again (looking-at search-string)))
  513.       ;; If time for a change, advance to next replacement string.
  514.       (if (and (listp replacements)
  515.            (= next-rotate-count replace-count))
  516.           (progn
  517.         (setq next-rotate-count
  518.               (+ next-rotate-count repeat-count))
  519.         (setq next-replacement (nth replacement-index replacements))
  520.         (setq replacement-index (% (1+ replacement-index) (length replacements)))))
  521.       (if (not query-flag)
  522.           (progn
  523.         (store-match-data real-match-data)
  524.         (replace-match next-replacement nocasify literal)
  525.         (setq replace-count (1+ replace-count)))
  526.         (undo-boundary)
  527.         (let (done replaced key def)
  528.           ;; Loop reading commands until one of them sets done,
  529.           ;; which means it has finished handling this occurrence.
  530.           (while (not done)
  531.         (store-match-data real-match-data)
  532.         (replace-highlight (match-beginning 0) (match-end 0))
  533.         (message message from-string next-replacement)
  534.         (setq key (read-event))
  535.         (setq key (vector key))
  536.         (setq def (lookup-key map key))
  537.         ;; Restore the match data while we process the command.
  538.         (cond ((eq def 'help)
  539.                (with-output-to-temp-buffer "*Help*"
  540.              (princ
  541.               (concat "Query replacing "
  542.                   (if regexp-flag "regexp " "")
  543.                   from-string " with "
  544.                   next-replacement ".\n\n"
  545.                   (substitute-command-keys
  546.                    query-replace-help)))))
  547.               ((eq def 'exit)
  548.                (setq keep-going nil)
  549.                (setq done t))
  550.               ((eq def 'backup)
  551.                (if stack
  552.                (let ((elt (car stack)))
  553.                  (goto-char (car elt))
  554.                  (setq replaced (eq t (cdr elt)))
  555.                  (or replaced
  556.                  (store-match-data (cdr elt)))
  557.                  (setq stack (cdr stack)))
  558.              (message "No previous match")
  559.              (ding 'no-terminate)
  560.              (sit-for 1)))
  561.               ((eq def 'act)
  562.                (or replaced
  563.                (replace-match next-replacement nocasify literal))
  564.                (setq done t replaced t))
  565.               ((eq def 'act-and-exit)
  566.                (or replaced
  567.                (replace-match next-replacement nocasify literal))
  568.                (setq keep-going nil)
  569.                (setq done t replaced t))
  570.               ((eq def 'act-and-show)
  571.                (if (not replaced)
  572.                (progn
  573.                  (replace-match next-replacement nocasify literal)
  574.                  (setq replaced t))))
  575.               ((eq def 'automatic)
  576.                (or replaced
  577.                (replace-match next-replacement nocasify literal))
  578.                (setq done t query-flag nil replaced t))
  579.               ((eq def 'skip)
  580.                (setq done t))
  581.               ((eq def 'recenter)
  582.                (recenter nil))
  583.               ((eq def 'edit)
  584.                (store-match-data
  585.             (prog1 (match-data)
  586.               (save-excursion (recursive-edit))))
  587.                ;; Before we make the replacement,
  588.                ;; decide whether the search string
  589.                ;; can match again just after this match.
  590.                (if regexp-flag
  591.                (setq match-again (looking-at search-string))))
  592.               ((eq def 'delete-and-edit)
  593.                (delete-region (match-beginning 0) (match-end 0))
  594.                (store-match-data
  595.             (prog1 (match-data)
  596.               (save-excursion (recursive-edit))))
  597.                (setq replaced t))
  598.               (t
  599.                (setq keep-going nil)
  600.                (setq unread-command-events
  601.                  (append (listify-key-sequence key)
  602.                      unread-command-events))
  603.                (setq done t))))
  604.           ;; Record previous position for ^ when we move on.
  605.           ;; Change markers to numbers in the match data
  606.           ;; since lots of markers slow down editing.
  607.           (setq stack
  608.             (cons (cons (point)
  609.                 (or replaced
  610.                     (mapcar (lambda (elt)
  611.                           (and elt
  612.                            (prog1 (marker-position elt)
  613.                              (set-marker elt nil))))
  614.                      (match-data))))
  615.               stack))
  616.           (if replaced (setq replace-count (1+ replace-count)))))
  617.       (setq lastrepl (point)))
  618.       (replace-dehighlight))
  619.   (and keep-going stack)))
  620.  
  621. (defvar query-replace-highlight nil
  622.   "*Non-nil means to highlight words during query replacement.")
  623.  
  624. (defvar replace-overlay nil)
  625.  
  626. (defun replace-dehighlight ()
  627.   (and replace-overlay
  628.        (progn
  629.      (delete-overlay replace-overlay)
  630.      (setq replace-overlay nil))))
  631.  
  632. (defun replace-highlight (start end)
  633.   (and query-replace-highlight
  634.        (progn
  635.      (or replace-overlay
  636.          (progn
  637.            (setq replace-overlay (make-overlay start end))
  638.            (overlay-put replace-overlay 'face
  639.                 (if (internal-find-face 'query-replace)
  640.                 'query-replace 'region))))
  641.      (move-overlay replace-overlay start end (current-buffer)))))
  642.  
  643. ;;; replace.el ends here
  644.