(coerce, map, maplist, cl-mapc, mapl, mapcan, mapcon, some, every, notany,
[bpt/emacs.git] / lisp / replace.el
index 8f81a53..c9c70b5 100644 (file)
@@ -1,7 +1,7 @@
 ;;; replace.el --- replace commands for Emacs
 
 ;; Copyright (C) 1985, 1986, 1987, 1992, 1994, 1996, 1997, 2000, 2001, 2002,
-;;   2003, 2004  Free Software Foundation, Inc.
+;;   2003, 2004, 2005  Free Software Foundation, Inc.
 
 ;; Maintainer: FSF
 
@@ -62,7 +62,28 @@ strings or patterns."
   "*Non-nil means `query-replace' and friends ignore read-only matches."
   :type 'boolean
   :group 'matching
-  :version "21.4")
+  :version "22.1")
+
+(defcustom query-replace-highlight t
+  "*Non-nil means to highlight matches during query replacement."
+  :type 'boolean
+  :group 'matching)
+
+(defcustom query-replace-lazy-highlight t
+  "*Controls the lazy-highlighting during query replacements.
+When non-nil, all text in the buffer matching the current match
+is highlighted lazily using isearch lazy highlighting (see
+`lazy-highlight-initial-delay' and `lazy-highlight-interval')."
+  :type 'boolean
+  :group 'lazy-highlight
+  :group 'matching
+  :version "22.1")
+
+(defface query-replace
+  '((t (:inherit isearch)))
+  "Face for highlighting query replacement matches."
+  :group 'matching
+  :version "22.1")
 
 (defun query-replace-descr (string)
   (mapconcat 'isearch-text-char-description string ""))
@@ -94,8 +115,11 @@ wants to replace FROM with TO."
               query-replace-from-history-variable
               nil t t))))
       (if (and (zerop (length from)) lastto lastfrom)
-         (cons lastfrom
-               (query-replace-compile-replacement lastto regexp-flag))
+         (progn
+           (set query-replace-from-history-variable
+                (cdr (symbol-value query-replace-from-history-variable)))
+           (cons lastfrom
+                 (query-replace-compile-replacement lastto regexp-flag)))
        ;; Warn if user types \n or \t, but don't reject the input.
        (and regexp-flag
             (string-match "\\(\\`\\|[^\\]\\)\\(\\\\\\\\\\)*\\(\\\\[nt]\\)" from)
@@ -193,7 +217,11 @@ Fourth and fifth arg START and END specify the region to operate on.
 
 To customize possible responses, change the \"bindings\" in `query-replace-map'."
   (interactive (let ((common
-                     (query-replace-read-args "Query replace" nil)))
+                     (query-replace-read-args 
+                      (if (and transient-mark-mode mark-active)
+                        "Query replace in region"
+                        "Query replace")
+                        nil)))
                 (list (nth 0 common) (nth 1 common) (nth 2 common)
                       ;; These are done separately here
                       ;; so that command-history will record these expressions
@@ -253,7 +281,11 @@ text, TO-STRING is actually made a list instead of a string.
 Use \\[repeat-complex-command] after this command for details."
   (interactive
    (let ((common
-         (query-replace-read-args "Query replace regexp" t)))
+         (query-replace-read-args 
+          (if (and transient-mark-mode mark-active)
+              "Query replace regexp in region"
+            "Query replace regexp")
+          t)))
      (list (nth 0 common) (nth 1 common) (nth 2 common)
           ;; These are done separately here
           ;; so that command-history will record these expressions
@@ -399,7 +431,11 @@ which will run faster and will not set the mark or print anything.
 and TO-STRING is also null.)"
   (interactive
    (let ((common
-         (query-replace-read-args "Replace string" nil)))
+         (query-replace-read-args 
+          (if (and transient-mark-mode mark-active)
+              "Replace string in region"
+            "Replace string")
+          nil)))
      (list (nth 0 common) (nth 1 common) (nth 2 common)
           (if (and transient-mark-mode mark-active)
               (region-beginning))
@@ -453,7 +489,11 @@ What you probably want is a loop like this:
 which will run faster and will not set the mark or print anything."
   (interactive
    (let ((common
-         (query-replace-read-args "Replace regexp" t)))
+         (query-replace-read-args 
+          (if (and transient-mark-mode mark-active)
+              "Replace regexp in region" 
+            "Replace regexp") 
+          t)))
      (list (nth 0 common) (nth 1 common) (nth 2 common)
           (if (and transient-mark-mode mark-active)
               (region-beginning))
@@ -736,9 +776,12 @@ Compatibility function for \\[next-error] invocations."
   (interactive "p")
   ;; we need to run occur-find-match from within the Occur buffer
   (with-current-buffer
+      ;; Choose the buffer and make it current.
       (if (next-error-buffer-p (current-buffer))
          (current-buffer)
-       (next-error-find-buffer nil nil (lambda() (eq major-mode 'occur-mode))))
+       (next-error-find-buffer nil nil
+                               (lambda ()
+                                 (eq major-mode 'occur-mode))))
 
     (goto-char (cond (reset (point-min))
                     ((< argp 0) (line-beginning-position))
@@ -765,7 +808,7 @@ Compatibility function for \\[next-error] invocations."
     (t :background "gray"))
   "Face used to highlight matches permanently."
   :group 'matching
-  :version "21.4")
+  :version "22.1")
 
 (defcustom list-matching-lines-default-context-lines 0
   "*Default number of context lines included around `list-matching-lines' matches.
@@ -799,9 +842,10 @@ If the value is nil, don't highlight the buffer names specially."
        (setq count (+ count (if forwardp -1 1)))
        (setq beg (line-beginning-position)
              end (line-end-position))
-       (if (and keep-props font-lock-mode
+       (if (and keep-props (if (boundp 'jit-lock-mode) jit-lock-mode)
                 (text-property-not-all beg end 'fontified t))
-           (font-lock-fontify-region beg end))
+           (if (fboundp 'jit-lock-fontify-now)
+               (jit-lock-fontify-now beg end)))
        (push
         (funcall (if keep-props
                      #'buffer-substring
@@ -918,50 +962,48 @@ See also `multi-occur'."
 (defun occur-1 (regexp nlines bufs &optional buf-name)
   (unless buf-name
     (setq buf-name "*Occur*"))
-  (let ((occur-buf (get-buffer-create buf-name))
-       (made-temp-buf nil)
+  (let (occur-buf
        (active-bufs (delq nil (mapcar #'(lambda (buf)
                                           (when (buffer-live-p buf) buf))
                                       bufs))))
     ;; Handle the case where one of the buffers we're searching is the
-    ;; *Occur* buffer itself.
-    (when (memq occur-buf bufs)
-      (setq occur-buf (with-current-buffer occur-buf
-                       (clone-buffer "*Occur-temp*"))
-           made-temp-buf t))
+    ;; output buffer.  Just rename it.
+    (when (member buf-name (mapcar 'buffer-name active-bufs))
+      (with-current-buffer (get-buffer buf-name)
+       (rename-uniquely)))
+
+    ;; Now find or create the output buffer.
+    ;; If we just renamed that buffer, we will make a new one here.
+    (setq occur-buf (get-buffer-create buf-name))
+
     (with-current-buffer occur-buf
-      (setq buffer-read-only nil)
       (occur-mode)
-      (erase-buffer)
-      (let ((count (occur-engine
-                   regexp active-bufs occur-buf
-                   (or nlines list-matching-lines-default-context-lines)
-                   (and case-fold-search
-                        (isearch-no-upper-case-p regexp t))
-                   list-matching-lines-buffer-name-face
-                   nil list-matching-lines-face t)))
-       (let* ((bufcount (length active-bufs))
-              (diff (- (length bufs) bufcount)))
-         (message "Searched %d buffer%s%s; %s match%s for `%s'"
-                  bufcount (if (= bufcount 1) "" "s")
-                  (if (zerop diff) "" (format " (%d killed)" diff))
-                  (if (zerop count) "no" (format "%d" count))
-                  (if (= count 1) "" "es")
-                  regexp))
-       ;; If we had to make a temporary buffer, make it the *Occur*
-       ;; buffer now.
-       (when made-temp-buf
-         (with-current-buffer (get-buffer buf-name)
-           (kill-buffer (current-buffer)))
-         (rename-buffer buf-name))
-       (setq occur-revert-arguments (list regexp nlines bufs)
-             buffer-read-only t)
-       (if (> count 0)
-           (progn
-             (display-buffer occur-buf)
-             (setq next-error-last-buffer occur-buf))
-         (kill-buffer occur-buf)))
-      (run-hooks 'occur-hook))))
+      (let ((inhibit-read-only t))
+       (erase-buffer)
+       (let ((count (occur-engine
+                     regexp active-bufs occur-buf
+                     (or nlines list-matching-lines-default-context-lines)
+                     (and case-fold-search
+                          (isearch-no-upper-case-p regexp t))
+                     list-matching-lines-buffer-name-face
+                     nil list-matching-lines-face t)))
+         (let* ((bufcount (length active-bufs))
+                (diff (- (length bufs) bufcount)))
+           (message "Searched %d buffer%s%s; %s match%s for `%s'"
+                    bufcount (if (= bufcount 1) "" "s")
+                    (if (zerop diff) "" (format " (%d killed)" diff))
+                    (if (zerop count) "no" (format "%d" count))
+                    (if (= count 1) "" "es")
+                    regexp))
+         (setq occur-revert-arguments (list regexp nlines bufs))
+         (if (> count 0)
+             (progn
+               (display-buffer occur-buf)
+               (setq next-error-last-buffer occur-buf))
+           (kill-buffer occur-buf)))
+       (run-hooks 'occur-hook))
+      (setq buffer-read-only t)
+      (set-buffer-modified-p nil))))
 
 (defun occur-engine-add-prefix (lines)
   (mapcar
@@ -972,7 +1014,6 @@ See also `multi-occur'."
 (defun occur-engine (regexp buffers out-buf nlines case-fold-search
                            title-face prefix-face match-face keep-props)
   (with-current-buffer out-buf
-    (setq buffer-read-only nil)
     (let ((globalcount 0)
          (coding nil))
       ;; Map over all the buffers
@@ -1008,9 +1049,11 @@ See also `multi-occur'."
                            endpt (line-end-position)))
                    (setq marker (make-marker))
                    (set-marker marker matchbeg)
-                   (if (and keep-props font-lock-mode
+                   (if (and keep-props
+                            (if (boundp 'jit-lock-mode) jit-lock-mode)
                             (text-property-not-all begpt endpt 'fontified t))
-                       (font-lock-fontify-region begpt endpt))
+                       (if (fboundp 'jit-lock-fontify-now)
+                           (jit-lock-fontify-now begpt endpt)))
                    (setq curstring (buffer-substring begpt endpt))
                    ;; Depropertize the string, and maybe
                    ;; highlight the matches
@@ -1245,14 +1288,14 @@ passed in.  If LITERAL is set, no checking is done, anyway."
     (while (string-match "\\(\\`\\|[^\\]\\)\\(\\\\\\\\\\)*\\(\\\\\\?\\)"
                         newtext)
       (setq newtext
-           (read-input "Edit replacement string: "
-                       (prog1
-                           (cons
-                            (replace-match "" t t newtext 3)
-                            (1+ (match-beginning 3)))
-                         (setq match-data
-                               (replace-match-data
-                                nil match-data match-data))))
+           (read-string "Edit replacement string: "
+                         (prog1
+                             (cons
+                              (replace-match "" t t newtext 3)
+                              (1+ (match-beginning 3)))
+                           (setq match-data
+                                 (replace-match-data
+                                  nil match-data match-data))))
            noedit nil)))
   (set-match-data match-data)
   (replace-match newtext fixedcase literal)
@@ -1301,9 +1344,6 @@ make, or the user didn't cancel the call."
        ;; (match-data); otherwise it is t if a match is possible at point.
        (match-again t)
 
-       (isearch-string isearch-string)
-       (isearch-regexp isearch-regexp)
-       (isearch-case-fold-search isearch-case-fold-search)
        (message
         (if query-flag
             (substitute-command-keys
@@ -1337,10 +1377,7 @@ make, or the user didn't cancel the call."
                                      (regexp-quote from-string))
                                    "\\b")))
     (when query-replace-lazy-highlight
-      (setq isearch-string search-string
-           isearch-regexp (or delimited-flag regexp-flag)
-           isearch-case-fold-search case-fold-search
-           isearch-lazy-highlight-last-string nil))
+      (setq isearch-lazy-highlight-last-string nil))
 
     (push-mark)
     (undo-boundary)
@@ -1410,8 +1447,10 @@ make, or the user didn't cancel the call."
                (let ((inhibit-read-only
                       query-replace-skip-read-only))
                  (unless (or literal noedit)
-                   (replace-highlight (nth 0 real-match-data)
-                                      (nth 1 real-match-data)))
+                   (replace-highlight
+                    (nth 0 real-match-data) (nth 1 real-match-data)
+                    start end search-string
+                    (or delimited-flag regexp-flag) case-fold-search))
                  (setq noedit
                        (replace-match-maybe-edit
                         next-replacement nocasify literal
@@ -1427,7 +1466,10 @@ make, or the user didn't cancel the call."
                ;; `real-match-data'.
                (while (not done)
                  (set-match-data real-match-data)
-                 (replace-highlight (match-beginning 0) (match-end 0))
+                 (replace-highlight
+                  (match-beginning 0) (match-end 0)
+                  start end search-string
+                  (or delimited-flag regexp-flag) case-fold-search)
                  ;; Bind message-log-max so we don't fill up the message log
                  ;; with a bunch of identical messages.
                  (let ((message-log-max nil))
@@ -1529,8 +1571,8 @@ make, or the user didn't cancel the call."
                                                nil real-match-data
                                                real-match-data)
                               next-replacement
-                              (read-input "Edit replacement string: "
-                                          next-replacement)
+                              (read-string "Edit replacement string: "
+                                            next-replacement)
                               noedit nil)
                         (if replaced
                             (set-match-data real-match-data)
@@ -1559,11 +1601,6 @@ make, or the user didn't cancel the call."
                                       unread-command-events))
                         (setq done t)))
                  (when query-replace-lazy-highlight
-                   ;; Restore isearch data for lazy highlighting
-                   ;; in case of isearching during recursive edit
-                   (setq isearch-string search-string
-                         isearch-regexp (or delimited-flag regexp-flag)
-                         isearch-case-fold-search case-fold-search)
                    ;; Force lazy rehighlighting only after replacements
                    (if (not (memq def '(skip backup)))
                        (setq isearch-lazy-highlight-last-string nil))))
@@ -1601,44 +1638,27 @@ make, or the user didn't cancel the call."
                 (if (= replace-count 1) "" "s")))
     (and keep-going stack)))
 
-(defcustom query-replace-highlight t
-  "*Non-nil means to highlight matches during query replacement."
-  :type 'boolean
-  :group 'matching)
-
-(defcustom query-replace-lazy-highlight t
-  "*Controls the lazy-highlighting during query replacements.
-When non-nil, all text in the buffer matching the current match
-is highlighted lazily using isearch lazy highlighting (see
-`isearch-lazy-highlight-initial-delay' and
-`isearch-lazy-highlight-interval')."
-  :type 'boolean
-  :group 'matching
-  :version "21.4")
-
-(defface query-replace
-  '((t (:inherit isearch)))
-  "Face for highlighting query replacement matches."
-  :group 'matching
-  :version "21.4")
-
 (defvar replace-overlay nil)
 
-(defun replace-highlight (beg end)
+(defun replace-highlight (match-beg match-end range-beg range-end
+                         string regexp case-fold)
   (if query-replace-highlight
       (if replace-overlay
-         (move-overlay replace-overlay beg end (current-buffer))
-       (setq replace-overlay (make-overlay beg end))
+         (move-overlay replace-overlay match-beg match-end (current-buffer))
+       (setq replace-overlay (make-overlay match-beg match-end))
        (overlay-put replace-overlay 'priority 1) ;higher than lazy overlays
        (overlay-put replace-overlay 'face 'query-replace)))
   (if query-replace-lazy-highlight
-      (isearch-lazy-highlight-new-loop)))
+      (let ((isearch-string string)
+           (isearch-regexp regexp)
+           (isearch-case-fold-search case-fold))
+       (isearch-lazy-highlight-new-loop range-beg range-end))))
 
 (defun replace-dehighlight ()
   (when replace-overlay
     (delete-overlay replace-overlay))
   (when query-replace-lazy-highlight
-    (isearch-lazy-highlight-cleanup isearch-lazy-highlight-cleanup)
+    (lazy-highlight-cleanup lazy-highlight-cleanup)
     (setq isearch-lazy-highlight-last-string nil)))
 
 ;; arch-tag: 16b4cd61-fd40-497b-b86f-b667c4cf88e4