X-Git-Url: http://git.hcoop.net/bpt/emacs.git/blobdiff_plain/2ced751f95a58e00bd6d97adadff824dc539d385..1c1da4184c3870e9f207d8a35a519850b9f36d6a:/lisp/replace.el

diff --git a/lisp/replace.el b/lisp/replace.el
index d40ff80346..474e6158e8 100644
--- a/lisp/replace.el
+++ b/lisp/replace.el
@@ -1,4 +1,4 @@
-;;; replace.el --- replace commands for Emacs.
+;;; replace.el --- replace commands for Emacs
 
 ;; Copyright (C) 1985, 86, 87, 92, 94, 96, 1997, 2000, 2001
 ;;  Free Software Foundation, Inc.
@@ -56,14 +56,31 @@ strings or patterns."
   :type 'symbol
   :version "20.3")
 
+(defcustom query-replace-skip-read-only nil
+  "*Non-nil means `query-replace' and friends ignore read-only matches."
+  :type 'boolean
+  :group 'matching
+  :version "21.3")
+
 (defun query-replace-read-args (string regexp-flag)
+  (barf-if-buffer-read-only)
   (let (from to)
     (if query-replace-interactive
 	(setq from (car (if regexp-flag regexp-search-ring search-ring)))
       (setq from (read-from-minibuffer (format "%s: " string)
 				       nil nil nil
 				       query-replace-from-history-variable
-				       nil t)))
+				       nil t))
+      ;; Warn if user types \n or \t, but don't reject the input.
+      (if (string-match "\\\\[nt]" from)
+	  (let ((match (match-string 0 from)))
+	    (cond
+	     ((string= match "\\n")
+	      (message "Note: `\\n' here doesn't match a newline; to do that, type C-q C-j instead"))
+	     ((string= match "\\t")
+	      (message "Note: `\\t' here doesn't match a tab; to do that, just type TAB")))
+	    (sit-for 2))))
+
     (setq to (read-from-minibuffer (format "%s %s with: " string from)
 				   nil nil nil
 				   query-replace-to-history-variable from t))
@@ -95,7 +112,7 @@ 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 (query-replace-read-args "Query replace" nil))
-  (perform-replace from-string to-string start end t nil delimited))
+  (perform-replace from-string to-string t nil delimited nil nil start end))
 
 (define-key esc-map "%" 'query-replace)
 
@@ -122,7 +139,7 @@ In TO-STRING, `\\&' stands for whatever matched the whole of REGEXP,
 and `\\=\\N' (where N is a digit) stands for
  whatever what matched the Nth `\\(...\\)' in REGEXP."
   (interactive (query-replace-read-args "Query replace regexp" t))
-  (perform-replace regexp to-string start end t t delimited))
+  (perform-replace regexp to-string t t delimited nil nil start end))
 (define-key esc-map [?\C-%] 'query-replace-regexp)
 
 (defun query-replace-regexp-eval (regexp to-expr &optional delimited start end)
@@ -170,9 +187,9 @@ Fourth and fifth arg START and END specify the region to operate on."
      ;; We make TO a list because replace-match-string-symbols requires one,
      ;; and the user might enter a single token.
      (replace-match-string-symbols to)
-     (list from (car to) start end current-prefix-arg)))
+     (list from (car to) current-prefix-arg start end)))
   (perform-replace regexp (cons 'replace-eval-replacement to-expr)
-		   start end t t delimited))
+		   t t delimited nil nil start end))
 
 (defun map-query-replace-regexp (regexp to-strings &optional n start end)
   "Replace some matches for REGEXP with various strings, in rotation.
@@ -223,7 +240,7 @@ Fourth and fifth arg START and END specify the region to operate on."
 				       (1+ (string-match " " to-strings))))
 	  (setq replacements (append replacements (list to-strings))
 		to-strings ""))))
-    (perform-replace regexp replacements start end t t nil n)))
+    (perform-replace regexp replacements t t nil n nil start end)))
 
 (defun replace-string (from-string to-string &optional delimited start end)
   "Replace occurrences of FROM-STRING with TO-STRING.
@@ -251,7 +268,7 @@ which will run faster and will not set the mark or print anything.
 \(You may need a more complex loop if FROM-STRING can match the null string
 and TO-STRING is also null.)"
   (interactive (query-replace-read-args "Replace string" nil))
-  (perform-replace from-string to-string start end nil nil delimited))
+  (perform-replace from-string to-string nil nil delimited nil nil start end))
 
 (defun replace-regexp (regexp to-string &optional delimited start end)
   "Replace things after point matching REGEXP with TO-STRING.
@@ -278,7 +295,7 @@ What you probably want is a loop like this:
     (replace-match TO-STRING nil nil))
 which will run faster and will not set the mark or print anything."
   (interactive (query-replace-read-args "Replace regexp" t))
-  (perform-replace regexp to-string start end nil t delimited))
+  (perform-replace regexp to-string nil t delimited nil nil start end))
 
 
 (defvar regexp-history nil
@@ -420,6 +437,7 @@ end of the buffer."
     (define-key map [mouse-2] 'occur-mode-mouse-goto)
     (define-key map "\C-c\C-c" 'occur-mode-goto-occurrence)
     (define-key map "\C-m" 'occur-mode-goto-occurrence)
+    (define-key map "\C-o" 'occur-mode-display-occurrence)
     (define-key map "\M-n" 'occur-next)
     (define-key map "\M-p" 'occur-prev)
     (define-key map "g" 'revert-buffer)
@@ -439,17 +457,24 @@ end of the buffer."
 
 (put 'occur-mode 'mode-class 'special)
 
-(define-derived-mode occur-mode nil "Occur"
+(defun occur-mode ()
   "Major mode for output from \\[occur].
 \\<occur-mode-map>Move point to one of the items in this buffer, then use
 \\[occur-mode-goto-occurrence] to go to the occurrence that the item refers to.
 Alternatively, click \\[occur-mode-mouse-goto] on an item to go to it.
 
 \\{occur-mode-map}"
+  (kill-all-local-variables)
+  (use-local-map occur-mode-map)
+  (setq major-mode 'occur-mode)
+  (setq mode-name "Occur")
+  (make-local-variable 'revert-buffer-function)
+  (setq revert-buffer-function 'occur-revert-function)
   (set (make-local-variable 'revert-buffer-function) 'occur-revert-function)
   (make-local-variable 'occur-buffer)
   (make-local-variable 'occur-nlines)
-  (make-local-variable 'occur-command-arguments))
+  (make-local-variable 'occur-command-arguments)
+  (run-hooks 'occur-mode-hook))
 
 (defun occur-revert-function (ignore1 ignore2)
   "Handle `revert-buffer' for *Occur* buffers."
@@ -489,6 +514,19 @@ Alternatively, click \\[occur-mode-mouse-goto] on an item to go to it.
     (pop-to-buffer occur-buffer)
     (goto-char (marker-position pos))))
 
+(defun occur-mode-display-occurrence ()
+  "Display in another window the occurrence the current line describes."
+  (interactive)
+  (let ((pos (occur-mode-find-occurrence))
+	same-window-buffer-names
+	same-window-regexps
+	window)
+    (setq window (display-buffer occur-buffer))
+    ;; This is the way to set point in the proper window.
+    (save-selected-window
+      (select-window window)
+      (goto-char (marker-position pos)))))
+
 (defun occur-next (&optional n)
   "Move to the Nth (default 1) next match in the *Occur* buffer."
   (interactive "p")
@@ -568,6 +606,7 @@ the matching is case-sensitive."
 		     (prefix-numeric-value nlines)
 		   list-matching-lines-default-context-lines))
 	 (current-tab-width tab-width)
+	 (inhibit-read-only t)
 	 ;; Minimum width of line number plus trailing colon.
 	 (min-line-number-width 6)
 	 ;; Width of line number prefix without the colon.  Choose a
@@ -749,9 +788,10 @@ the matching is case-sensitive."
 		  ;; Add text properties.  The `occur' prop is used to
 		  ;; store the marker of the matching text in the
 		  ;; source buffer.
-		  (put-text-property (marker-position text-beg)
-				     (- (marker-position text-end) 1)
-				     'mouse-face 'highlight)
+		  (add-text-properties
+		   (marker-position text-beg) (- (marker-position text-end) 1)
+		   '(mouse-face highlight
+		     help-echo "mouse-2: go to this occurence"))
 		  (put-text-property (marker-position text-beg)
 				     (marker-position text-end)
 				     'occur occur-marker)
@@ -868,15 +908,19 @@ type them."
           (aset data 2 (if (consp next) next (aref data 3))))))
   (car (aref data 2)))
 
-(defun perform-replace (from-string replacements start end
+(defun perform-replace (from-string replacements 
 		        query-flag regexp-flag delimited-flag
-			&optional repeat-count map)
+			&optional repeat-count map start end)
   "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)
+
+  (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."
+
+which will run faster and probably do exactly what you want.  Please
+see the documentation of `replace-match' to find out how to simulate
+`case-replace'."
   (or map (setq map query-replace-map))
   (and query-flag minibuffer-auto-raise
        (raise-frame (window-frame (minibuffer-window))))
@@ -961,158 +1005,163 @@ which will run faster and probably do exactly what you want."
 				 ;; 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.
-	  ;; If that match is empty, don't use it.
-	  (setq match-again
-		(and nonempty-match
-		     (or (not regexp-flag)
-			 (and (looking-at search-string)
-			      (let ((match (match-data)))
-				(and (/= (nth 0 match) (nth 1 match))
-				     match))))))
-
-	  ;; Calculate the replacement string, if necessary.
-	  (when replacements
-            (set-match-data real-match-data)
-            (setq next-replacement
-                  (funcall (car replacements) (cdr replacements)
-                           replace-count)))
-	  (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)))
-			 (with-current-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)))))
+	  ;; Optionally ignore matches that have a read-only property.
+	  (unless (and query-replace-skip-read-only
+		       (text-property-not-all
+			(match-beginning 0) (match-end 0)
+			'read-only nil))
+
+	    ;; 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.
+	    ;; If that match is empty, don't use it.
+	    (setq match-again
+		  (and nonempty-match
+		       (or (not regexp-flag)
+			   (and (looking-at search-string)
+				(let ((match (match-data)))
+				  (and (/= (nth 0 match) (nth 1 match))
+				       match))))))
+
+	    ;; Calculate the replacement string, if necessary.
+	    (when replacements
+	      (set-match-data real-match-data)
+	      (setq next-replacement
+		    (funcall (car replacements) (cdr replacements)
+			     replace-count)))
+	    (if (not query-flag)
+		(let ((inhibit-read-only query-replace-skip-read-only))
+		  (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)))
+			   (with-current-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)))))
 		      
-		      ;; Edit replacement.
-		      ((eq def 'edit-replacement)
-		       (setq next-replacement
-			     (read-input "Edit replacement string: "
-					 next-replacement))
-		       (or replaced
-			   (replace-match next-replacement nocasify literal))
-		       (setq done t))
+			;; Edit replacement.
+			((eq def 'edit-replacement)
+			 (setq next-replacement
+			       (read-input "Edit replacement string: "
+					   next-replacement))
+			 (or replaced
+			     (replace-match next-replacement nocasify literal))
+			 (setq done t))
 		      
-		      ((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)))))
+			((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))))))
 
       ;; The code preventing adjacent regexp matches in the condition
       ;; of the while-loop above will haven taken us one character