home *** CD-ROM | disk | FTP | other *** search
/ Usenet 1994 October / usenetsourcesnewsgroupsinfomagicoctober1994disk2.iso / unix / volume11 / templates / part05 / tplreplace.el < prev   
Lisp/Scheme  |  1987-10-04  |  3KB  |  107 lines
  1. ;;; tplreplace.el -- Replace commands for Emacs.
  2. ;;; Copyright (C) 1985 Richard M. Stallman.
  3. ;;; Modified by Mark Ardis, Wang Institute, 12/14/86 for template-mode
  4.  
  5. (provide 'tplreplace)
  6.  
  7. (defun perform-replace-tpl (from-string to-string
  8.                 query-flag regexp-flag delimited-flag
  9.             search-function position-function replace-function
  10.             &optional reposition-function)
  11.   (let ((nocasify (not (and case-fold-search case-replace
  12.                 (string-equal from-string
  13.                       (downcase from-string)))))
  14.     (literal (not regexp-flag))
  15.     (search-string from-string)
  16.     (keep-going t)
  17.     (lastrepl nil)            ;Position after last match considered.
  18.     (help-form
  19.      '(concat "Query replacing "
  20.           from-string " with " to-string ".\n\n"
  21.           (substitute-command-keys query-replace-help))))
  22.     (push-mark)
  23.     (push-mark)
  24.     (while (and keep-going
  25.         (not (eobp))
  26.         (progn
  27.          (set-mark (point))
  28.          (funcall search-function search-string nil t)))
  29.       ;; Don't replace the null string 
  30.       ;; right after end of previous replacement.
  31.       (if (eq lastrepl (point))
  32.       (forward-char 1)
  33.     (undo-boundary)
  34.     (if (not query-flag)
  35.         (progn
  36.           (setq tpl-query-flag nil)
  37.           (funcall position-function)
  38.           (funcall replace-function from-string to-string)
  39.           )
  40.       (let (done replaced)
  41.         (setq tpl-query-flag t)
  42.         (while (not done)
  43.           (message "Query replacing %s with %s: " from-string to-string)
  44.           ;; Preserve the match data.  Process filters and sentinels
  45.           ;; could run inside read-char..
  46.           (let ((data (match-data)))
  47.         (setq char (read-char))
  48.         (store-match-data data))
  49.           (cond ((not (memq char '(?\e ?\ ?\, ?\. ?! ?\177 ?\C-r ?\C-w ?^)))
  50.              (setq keep-going nil)
  51.              (setq unread-command-char char)
  52.              (setq done t))
  53.             ((= char ?\e)
  54.              (setq keep-going nil)
  55.              (setq done t))
  56.             ((= char ?^)
  57.              (goto-char (mark))
  58.              (setq replaced t))
  59.             ((= char ?\ )
  60.              (or replaced
  61.              (progn
  62.                (funcall position-function)
  63.                (funcall replace-function from-string to-string)
  64.                ))
  65.              (setq done t))
  66.             ((= char ?\.)
  67.              (or replaced
  68.              (progn
  69.                (funcall position-function)
  70.                (funcall replace-function from-string to-string)
  71.                ))
  72.              (setq keep-going nil)
  73.              (setq done t))
  74.             ((and (not replaced) (= char ?\,))
  75.              (progn
  76.                (funcall position-function)
  77.                (funcall replace-function from-string to-string)
  78.                )
  79.              (setq replaced t))
  80.             ((= char ?!)
  81.              (or replaced
  82.              (progn
  83.                (funcall position-function)
  84.                (funcall replace-function from-string to-string)
  85.                ))
  86.              (setq done t query-flag nil))
  87.             ((= char ?\177)
  88.              (setq done t))
  89.             ((= char ?\C-r)
  90.              (store-match-data
  91.                (prog1 (match-data)
  92.              (save-excursion (recursive-edit)))))
  93.             ((= char ?\C-w)
  94.              (delete-region (point) (mark))
  95.              (save-excursion (recursive-edit))
  96.              (setq replaced t)))
  97.           )))
  98.     (setq lastrepl (point)))
  99.       (if reposition-function
  100.       (funcall reposition-function)
  101.     ) ; if
  102.       )
  103.     (pop-mark)
  104.     (message "Done")
  105.     (setq tpl-query-flag t)
  106.     keep-going))
  107.