1;;; replace.el --- replace commands for Emacs 2 3;; Copyright (C) 1985, 1986, 1987, 1992, 1994, 1996, 1997, 2000, 2001, 4;; 2002, 2003, 2004, 2005, 2006, 2007 Free Software Foundation, Inc. 5 6;; Maintainer: FSF 7 8;; This file is part of GNU Emacs. 9 10;; GNU Emacs is free software; you can redistribute it and/or modify 11;; it under the terms of the GNU General Public License as published by 12;; the Free Software Foundation; either version 2, or (at your option) 13;; any later version. 14 15;; GNU Emacs is distributed in the hope that it will be useful, 16;; but WITHOUT ANY WARRANTY; without even the implied warranty of 17;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 18;; GNU General Public License for more details. 19 20;; You should have received a copy of the GNU General Public License 21;; along with GNU Emacs; see the file COPYING. If not, write to the 22;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, 23;; Boston, MA 02110-1301, USA. 24 25;;; Commentary: 26 27;; This package supplies the string and regular-expression replace functions 28;; documented in the Emacs user's manual. 29 30;;; Code: 31 32(defcustom case-replace t 33 "*Non-nil means `query-replace' should preserve case in replacements." 34 :type 'boolean 35 :group 'matching) 36 37(defvar query-replace-history nil) 38 39(defvar query-replace-defaults nil 40 "Default values of FROM-STRING and TO-STRING for `query-replace'. 41This is a cons cell (FROM-STRING . TO-STRING), or nil if there is 42no default value.") 43 44(defvar query-replace-interactive nil 45 "Non-nil means `query-replace' uses the last search string. 46That becomes the \"string to replace\".") 47 48(defcustom query-replace-from-history-variable 'query-replace-history 49 "History list to use for the FROM argument of `query-replace' commands. 50The value of this variable should be a symbol; that symbol 51is used as a variable to hold a history list for the strings 52or patterns to be replaced." 53 :group 'matching 54 :type 'symbol 55 :version "20.3") 56 57(defcustom query-replace-to-history-variable 'query-replace-history 58 "History list to use for the TO argument of `query-replace' commands. 59The value of this variable should be a symbol; that symbol 60is used as a variable to hold a history list for replacement 61strings or patterns." 62 :group 'matching 63 :type 'symbol 64 :version "20.3") 65 66(defcustom query-replace-skip-read-only nil 67 "*Non-nil means `query-replace' and friends ignore read-only matches." 68 :type 'boolean 69 :group 'matching 70 :version "22.1") 71 72(defcustom query-replace-highlight t 73 "*Non-nil means to highlight matches during query replacement." 74 :type 'boolean 75 :group 'matching) 76 77(defcustom query-replace-lazy-highlight t 78 "*Controls the lazy-highlighting during query replacements. 79When non-nil, all text in the buffer matching the current match 80is highlighted lazily using isearch lazy highlighting (see 81`lazy-highlight-initial-delay' and `lazy-highlight-interval')." 82 :type 'boolean 83 :group 'lazy-highlight 84 :group 'matching 85 :version "22.1") 86 87(defface query-replace 88 '((t (:inherit isearch))) 89 "Face for highlighting query replacement matches." 90 :group 'matching 91 :version "22.1") 92 93(defun query-replace-descr (string) 94 (mapconcat 'isearch-text-char-description string "")) 95 96(defun query-replace-read-from (prompt regexp-flag) 97 "Query and return the `from' argument of a query-replace operation. 98The return value can also be a pair (FROM . TO) indicating that the user 99wants to replace FROM with TO." 100 (if query-replace-interactive 101 (car (if regexp-flag regexp-search-ring search-ring)) 102 (let* ((history-add-new-input nil) 103 (from 104 ;; The save-excursion here is in case the user marks and copies 105 ;; a region in order to specify the minibuffer input. 106 ;; That should not clobber the region for the query-replace itself. 107 (save-excursion 108 (read-from-minibuffer 109 (if query-replace-defaults 110 (format "%s (default %s -> %s): " prompt 111 (query-replace-descr (car query-replace-defaults)) 112 (query-replace-descr (cdr query-replace-defaults))) 113 (format "%s: " prompt)) 114 nil nil nil 115 query-replace-from-history-variable 116 nil t)))) 117 (if (and (zerop (length from)) query-replace-defaults) 118 (cons (car query-replace-defaults) 119 (query-replace-compile-replacement 120 (cdr query-replace-defaults) regexp-flag)) 121 (add-to-history query-replace-from-history-variable from nil t) 122 ;; Warn if user types \n or \t, but don't reject the input. 123 (and regexp-flag 124 (string-match "\\(\\`\\|[^\\]\\)\\(\\\\\\\\\\)*\\(\\\\[nt]\\)" from) 125 (let ((match (match-string 3 from))) 126 (cond 127 ((string= match "\\n") 128 (message "Note: `\\n' here doesn't match a newline; to do that, type C-q C-j instead")) 129 ((string= match "\\t") 130 (message "Note: `\\t' here doesn't match a tab; to do that, just type TAB"))) 131 (sit-for 2))) 132 from)))) 133 134(defun query-replace-compile-replacement (to regexp-flag) 135 "Maybe convert a regexp replacement TO to Lisp. 136Returns a list suitable for `perform-replace' if necessary, 137the original string if not." 138 (if (and regexp-flag 139 (string-match "\\(\\`\\|[^\\]\\)\\(\\\\\\\\\\)*\\\\[,#]" to)) 140 (let (pos list char) 141 (while 142 (progn 143 (setq pos (match-end 0)) 144 (push (substring to 0 (- pos 2)) list) 145 (setq char (aref to (1- pos)) 146 to (substring to pos)) 147 (cond ((eq char ?\#) 148 (push '(number-to-string replace-count) list)) 149 ((eq char ?\,) 150 (setq pos (read-from-string to)) 151 (push `(replace-quote ,(car pos)) list) 152 (let ((end 153 ;; Swallow a space after a symbol 154 ;; if there is a space. 155 (if (and (or (symbolp (car pos)) 156 ;; Swallow a space after 'foo 157 ;; but not after (quote foo). 158 (and (eq (car-safe (car pos)) 'quote) 159 (not (= ?\( (aref to 0))))) 160 (eq (string-match " " to (cdr pos)) 161 (cdr pos))) 162 (1+ (cdr pos)) 163 (cdr pos)))) 164 (setq to (substring to end))))) 165 (string-match "\\(\\`\\|[^\\]\\)\\(\\\\\\\\\\)*\\\\[,#]" to))) 166 (setq to (nreverse (delete "" (cons to list)))) 167 (replace-match-string-symbols to) 168 (cons 'replace-eval-replacement 169 (if (cdr to) 170 (cons 'concat to) 171 (car to)))) 172 to)) 173 174 175(defun query-replace-read-to (from prompt regexp-flag) 176 "Query and return the `to' argument of a query-replace operation." 177 (query-replace-compile-replacement 178 (save-excursion 179 (let* ((history-add-new-input nil) 180 (to (read-from-minibuffer 181 (format "%s %s with: " prompt (query-replace-descr from)) 182 nil nil nil 183 query-replace-to-history-variable from t))) 184 (add-to-history query-replace-to-history-variable to nil t) 185 (setq query-replace-defaults (cons from to)) 186 to)) 187 regexp-flag)) 188 189(defun query-replace-read-args (prompt regexp-flag &optional noerror) 190 (unless noerror 191 (barf-if-buffer-read-only)) 192 (let* ((from (query-replace-read-from prompt regexp-flag)) 193 (to (if (consp from) (prog1 (cdr from) (setq from (car from))) 194 (query-replace-read-to from prompt regexp-flag)))) 195 (list from to current-prefix-arg))) 196 197(defun query-replace (from-string to-string &optional delimited start end) 198 "Replace some occurrences of FROM-STRING with TO-STRING. 199As each match is found, the user must type a character saying 200what to do with it. For directions, type \\[help-command] at that time. 201 202In Transient Mark mode, if the mark is active, operate on the contents 203of the region. Otherwise, operate from point to the end of the buffer. 204 205If `query-replace-interactive' is non-nil, the last incremental search 206string is used as FROM-STRING--you don't have to specify it with the 207minibuffer. 208 209Matching is independent of case if `case-fold-search' is non-nil and 210FROM-STRING has no uppercase letters. Replacement transfers the case 211pattern of the old text to the new text, if `case-replace' and 212`case-fold-search' are non-nil and FROM-STRING has no uppercase 213letters. \(Transferring the case pattern means that if the old text 214matched is all caps, or capitalized, then its replacement is upcased 215or capitalized.) 216 217Third arg DELIMITED (prefix arg if interactive), if non-nil, means replace 218only matches surrounded by word boundaries. 219Fourth and fifth arg START and END specify the region to operate on. 220 221To customize possible responses, change the \"bindings\" in `query-replace-map'." 222 (interactive (let ((common 223 (query-replace-read-args 224 (if (and transient-mark-mode mark-active) 225 "Query replace in region" 226 "Query replace") 227 nil))) 228 (list (nth 0 common) (nth 1 common) (nth 2 common) 229 ;; These are done separately here 230 ;; so that command-history will record these expressions 231 ;; rather than the values they had this time. 232 (if (and transient-mark-mode mark-active) 233 (region-beginning)) 234 (if (and transient-mark-mode mark-active) 235 (region-end))))) 236 (perform-replace from-string to-string t nil delimited nil nil start end)) 237 238(define-key esc-map "%" 'query-replace) 239 240(defun query-replace-regexp (regexp to-string &optional delimited start end) 241 "Replace some things after point matching REGEXP with TO-STRING. 242As each match is found, the user must type a character saying 243what to do with it. For directions, type \\[help-command] at that time. 244 245In Transient Mark mode, if the mark is active, operate on the contents 246of the region. Otherwise, operate from point to the end of the buffer. 247 248If `query-replace-interactive' is non-nil, the last incremental search 249regexp is used as REGEXP--you don't have to specify it with the 250minibuffer. 251 252Matching is independent of case if `case-fold-search' is non-nil and 253REGEXP has no uppercase letters. Replacement transfers the case 254pattern of the old text to the new text, if `case-replace' and 255`case-fold-search' are non-nil and REGEXP has no uppercase letters. 256\(Transferring the case pattern means that if the old text matched is 257all caps, or capitalized, then its replacement is upcased or 258capitalized.) 259 260Third arg DELIMITED (prefix arg if interactive), if non-nil, means replace 261only matches surrounded by word boundaries. 262Fourth and fifth arg START and END specify the region to operate on. 263 264In TO-STRING, `\\&' stands for whatever matched the whole of REGEXP, 265and `\\=\\N' (where N is a digit) stands for 266whatever what matched the Nth `\\(...\\)' in REGEXP. 267`\\?' lets you edit the replacement text in the minibuffer 268at the given position for each replacement. 269 270In interactive calls, the replacement text can contain `\\,' 271followed by a Lisp expression. Each 272replacement evaluates that expression to compute the replacement 273string. Inside of that expression, `\\&' is a string denoting the 274whole match as a string, `\\N' for a partial match, `\\#&' and `\\#N' 275for the whole or a partial match converted to a number with 276`string-to-number', and `\\#' itself for the number of replacements 277done so far (starting with zero). 278 279If the replacement expression is a symbol, write a space after it 280to terminate it. One space there, if any, will be discarded. 281 282When using those Lisp features interactively in the replacement 283text, TO-STRING is actually made a list instead of a string. 284Use \\[repeat-complex-command] after this command for details." 285 (interactive 286 (let ((common 287 (query-replace-read-args 288 (if (and transient-mark-mode mark-active) 289 "Query replace regexp in region" 290 "Query replace regexp") 291 t))) 292 (list (nth 0 common) (nth 1 common) (nth 2 common) 293 ;; These are done separately here 294 ;; so that command-history will record these expressions 295 ;; rather than the values they had this time. 296 (if (and transient-mark-mode mark-active) 297 (region-beginning)) 298 (if (and transient-mark-mode mark-active) 299 (region-end))))) 300 (perform-replace regexp to-string t t delimited nil nil start end)) 301 302(define-key esc-map [?\C-%] 'query-replace-regexp) 303 304(defun query-replace-regexp-eval (regexp to-expr &optional delimited start end) 305 "Replace some things after point matching REGEXP with the result of TO-EXPR. 306 307Interactive use of this function is deprecated in favor of the 308`\\,' feature of `query-replace-regexp'. For non-interactive use, a loop 309using `search-forward-regexp' and `replace-match' is preferred. 310 311As each match is found, the user must type a character saying 312what to do with it. For directions, type \\[help-command] at that time. 313 314TO-EXPR is a Lisp expression evaluated to compute each replacement. It may 315reference `replace-count' to get the number of replacements already made. 316If the result of TO-EXPR is not a string, it is converted to one using 317`prin1-to-string' with the NOESCAPE argument (which see). 318 319For convenience, when entering TO-EXPR interactively, you can use `\\&' or 320`\\0' to stand for whatever matched the whole of REGEXP, and `\\N' (where 321N is a digit) to stand for whatever matched the Nth `\\(...\\)' in REGEXP. 322Use `\\#&' or `\\#N' if you want a number instead of a string. 323In interactive use, `\\#' in itself stands for `replace-count'. 324 325In Transient Mark mode, if the mark is active, operate on the contents 326of the region. Otherwise, operate from point to the end of the buffer. 327 328If `query-replace-interactive' is non-nil, the last incremental search 329regexp is used as REGEXP--you don't have to specify it with the 330minibuffer. 331 332Preserves case in each replacement if `case-replace' and `case-fold-search' 333are non-nil and REGEXP has no uppercase letters. 334 335Third arg DELIMITED (prefix arg if interactive), if non-nil, means replace 336only matches that are surrounded by word boundaries. 337Fourth and fifth arg START and END specify the region to operate on." 338 (interactive 339 (progn 340 (barf-if-buffer-read-only) 341 (let* ((from 342 ;; Let-bind the history var to disable the "foo -> bar" default. 343 ;; Maybe we shouldn't disable this default, but for now I'll 344 ;; leave it off. --Stef 345 (let ((query-replace-to-history-variable nil)) 346 (query-replace-read-from "Query replace regexp" t))) 347 (to (list (read-from-minibuffer 348 (format "Query replace regexp %s with eval: " 349 (query-replace-descr from)) 350 nil nil t query-replace-to-history-variable from t)))) 351 ;; We make TO a list because replace-match-string-symbols requires one, 352 ;; and the user might enter a single token. 353 (replace-match-string-symbols to) 354 (list from (car to) current-prefix-arg 355 (if (and transient-mark-mode mark-active) 356 (region-beginning)) 357 (if (and transient-mark-mode mark-active) 358 (region-end)))))) 359 (perform-replace regexp (cons 'replace-eval-replacement to-expr) 360 t 'literal delimited nil nil start end)) 361 362(make-obsolete 'query-replace-regexp-eval 363 "for interactive use, use the special `\\,' feature of 364`query-replace-regexp' instead. Non-interactively, a loop 365using `search-forward-regexp' and `replace-match' is preferred." "22.1") 366 367(defun map-query-replace-regexp (regexp to-strings &optional n start end) 368 "Replace some matches for REGEXP with various strings, in rotation. 369The second argument TO-STRINGS contains the replacement strings, 370separated by spaces. Third arg DELIMITED (prefix arg if interactive), 371if non-nil, means replace only matches surrounded by word boundaries. 372This command works like `query-replace-regexp' except that each 373successive replacement uses the next successive replacement string, 374wrapping around from the last such string to the first. 375 376In Transient Mark mode, if the mark is active, operate on the contents 377of the region. Otherwise, operate from point to the end of the buffer. 378 379Non-interactively, TO-STRINGS may be a list of replacement strings. 380 381If `query-replace-interactive' is non-nil, the last incremental search 382regexp is used as REGEXP--you don't have to specify it with the minibuffer. 383 384A prefix argument N says to use each replacement string N times 385before rotating to the next. 386Fourth and fifth arg START and END specify the region to operate on." 387 (interactive 388 (let* ((from (if query-replace-interactive 389 (car regexp-search-ring) 390 (read-from-minibuffer "Map query replace (regexp): " 391 nil nil nil 392 'query-replace-history nil t))) 393 (to (read-from-minibuffer 394 (format "Query replace %s with (space-separated strings): " 395 (query-replace-descr from)) 396 nil nil nil 397 'query-replace-history from t))) 398 (list from to 399 (and current-prefix-arg 400 (prefix-numeric-value current-prefix-arg)) 401 (if (and transient-mark-mode mark-active) 402 (region-beginning)) 403 (if (and transient-mark-mode mark-active) 404 (region-end))))) 405 (let (replacements) 406 (if (listp to-strings) 407 (setq replacements to-strings) 408 (while (/= (length to-strings) 0) 409 (if (string-match " " to-strings) 410 (setq replacements 411 (append replacements 412 (list (substring to-strings 0 413 (string-match " " to-strings)))) 414 to-strings (substring to-strings 415 (1+ (string-match " " to-strings)))) 416 (setq replacements (append replacements (list to-strings)) 417 to-strings "")))) 418 (perform-replace regexp replacements t t nil n nil start end))) 419 420(defun replace-string (from-string to-string &optional delimited start end) 421 "Replace occurrences of FROM-STRING with TO-STRING. 422Preserve case in each match if `case-replace' and `case-fold-search' 423are non-nil and FROM-STRING has no uppercase letters. 424\(Preserving case means that if the string matched is all caps, or capitalized, 425then its replacement is upcased or capitalized.) 426 427In Transient Mark mode, if the mark is active, operate on the contents 428of the region. Otherwise, operate from point to the end of the buffer. 429 430Third arg DELIMITED (prefix arg if interactive), if non-nil, means replace 431only matches surrounded by word boundaries. 432Fourth and fifth arg START and END specify the region to operate on. 433 434If `query-replace-interactive' is non-nil, the last incremental search 435string is used as FROM-STRING--you don't have to specify it with the 436minibuffer. 437 438This function is usually the wrong thing to use in a Lisp program. 439What you probably want is a loop like this: 440 (while (search-forward FROM-STRING nil t) 441 (replace-match TO-STRING nil t)) 442which will run faster and will not set the mark or print anything. 443\(You may need a more complex loop if FROM-STRING can match the null string 444and TO-STRING is also null.)" 445 (interactive 446 (let ((common 447 (query-replace-read-args 448 (if (and transient-mark-mode mark-active) 449 "Replace string in region" 450 "Replace string") 451 nil))) 452 (list (nth 0 common) (nth 1 common) (nth 2 common) 453 (if (and transient-mark-mode mark-active) 454 (region-beginning)) 455 (if (and transient-mark-mode mark-active) 456 (region-end))))) 457 (perform-replace from-string to-string nil nil delimited nil nil start end)) 458 459(defun replace-regexp (regexp to-string &optional delimited start end) 460 "Replace things after point matching REGEXP with TO-STRING. 461Preserve case in each match if `case-replace' and `case-fold-search' 462are non-nil and REGEXP has no uppercase letters. 463 464In Transient Mark mode, if the mark is active, operate on the contents 465of the region. Otherwise, operate from point to the end of the buffer. 466 467Third arg DELIMITED (prefix arg if interactive), if non-nil, means replace 468only matches surrounded by word boundaries. 469Fourth and fifth arg START and END specify the region to operate on. 470 471In TO-STRING, `\\&' stands for whatever matched the whole of REGEXP, 472and `\\=\\N' (where N is a digit) stands for 473whatever what matched the Nth `\\(...\\)' in REGEXP. 474`\\?' lets you edit the replacement text in the minibuffer 475at the given position for each replacement. 476 477In interactive calls, the replacement text may contain `\\,' 478followed by a Lisp expression used as part of the replacement 479text. Inside of that expression, `\\&' is a string denoting the 480whole match, `\\N' a partial match, `\\#&' and `\\#N' the respective 481numeric values from `string-to-number', and `\\#' itself for 482`replace-count', the number of replacements occurred so far. 483 484If your Lisp expression is an identifier and the next letter in 485the replacement string would be interpreted as part of it, you 486can wrap it with an expression like `\\,(or \\#)'. Incidentally, 487for this particular case you may also enter `\\#' in the 488replacement text directly. 489 490When using those Lisp features interactively in the replacement 491text, TO-STRING is actually made a list instead of a string. 492Use \\[repeat-complex-command] after this command for details. 493 494If `query-replace-interactive' is non-nil, the last incremental search 495regexp is used as REGEXP--you don't have to specify it with the minibuffer. 496 497This function is usually the wrong thing to use in a Lisp program. 498What you probably want is a loop like this: 499 (while (re-search-forward REGEXP nil t) 500 (replace-match TO-STRING nil nil)) 501which will run faster and will not set the mark or print anything." 502 (interactive 503 (let ((common 504 (query-replace-read-args 505 (if (and transient-mark-mode mark-active) 506 "Replace regexp in region" 507 "Replace regexp") 508 t))) 509 (list (nth 0 common) (nth 1 common) (nth 2 common) 510 (if (and transient-mark-mode mark-active) 511 (region-beginning)) 512 (if (and transient-mark-mode mark-active) 513 (region-end))))) 514 (perform-replace regexp to-string nil t delimited nil nil start end)) 515 516 517(defvar regexp-history nil 518 "History list for some commands that read regular expressions.") 519 520 521(defalias 'delete-non-matching-lines 'keep-lines) 522(defalias 'delete-matching-lines 'flush-lines) 523(defalias 'count-matches 'how-many) 524 525 526(defun keep-lines-read-args (prompt) 527 "Read arguments for `keep-lines' and friends. 528Prompt for a regexp with PROMPT. 529Value is a list, (REGEXP)." 530 (list (read-from-minibuffer prompt nil nil nil 531 'regexp-history nil t) 532 nil nil t)) 533 534(defun keep-lines (regexp &optional rstart rend interactive) 535 "Delete all lines except those containing matches for REGEXP. 536A match split across lines preserves all the lines it lies in. 537When called from Lisp (and usually interactively as well, see below) 538applies to all lines starting after point. 539 540If REGEXP contains upper case characters (excluding those preceded by `\\'), 541the matching is case-sensitive. 542 543Second and third arg RSTART and REND specify the region to operate on. 544This command operates on (the accessible part of) all lines whose 545accessible part is entirely contained in the region determined by RSTART 546and REND. (A newline ending a line counts as part of that line.) 547 548Interactively, in Transient Mark mode when the mark is active, operate 549on all lines whose accessible part is entirely contained in the region. 550Otherwise, the command applies to all lines starting after point. 551When calling this function from Lisp, you can pretend that it was 552called interactively by passing a non-nil INTERACTIVE argument. 553 554This function starts looking for the next match from the end of 555the previous match. Hence, it ignores matches that overlap 556a previously found match." 557 558 (interactive 559 (progn 560 (barf-if-buffer-read-only) 561 (keep-lines-read-args "Keep lines (containing match for regexp): "))) 562 (if rstart 563 (progn 564 (goto-char (min rstart rend)) 565 (setq rend 566 (progn 567 (save-excursion 568 (goto-char (max rstart rend)) 569 (unless (or (bolp) (eobp)) 570 (forward-line 0)) 571 (point-marker))))) 572 (if (and interactive transient-mark-mode mark-active) 573 (setq rstart (region-beginning) 574 rend (progn 575 (goto-char (region-end)) 576 (unless (or (bolp) (eobp)) 577 (forward-line 0)) 578 (point-marker))) 579 (setq rstart (point) 580 rend (point-max-marker))) 581 (goto-char rstart)) 582 (save-excursion 583 (or (bolp) (forward-line 1)) 584 (let ((start (point)) 585 (case-fold-search (and case-fold-search 586 (isearch-no-upper-case-p regexp t)))) 587 (while (< (point) rend) 588 ;; Start is first char not preserved by previous match. 589 (if (not (re-search-forward regexp rend 'move)) 590 (delete-region start rend) 591 (let ((end (save-excursion (goto-char (match-beginning 0)) 592 (forward-line 0) 593 (point)))) 594 ;; Now end is first char preserved by the new match. 595 (if (< start end) 596 (delete-region start end)))) 597 598 (setq start (save-excursion (forward-line 1) (point))) 599 ;; If the match was empty, avoid matching again at same place. 600 (and (< (point) rend) 601 (= (match-beginning 0) (match-end 0)) 602 (forward-char 1))))) 603 (set-marker rend nil) 604 nil) 605 606 607(defun flush-lines (regexp &optional rstart rend interactive) 608 "Delete lines containing matches for REGEXP. 609When called from Lisp (and usually when called interactively as 610well, see below), applies to the part of the buffer after point. 611The line point is in is deleted if and only if it contains a 612match for regexp starting after point. 613 614If REGEXP contains upper case characters (excluding those preceded by `\\'), 615the matching is case-sensitive. 616 617Second and third arg RSTART and REND specify the region to operate on. 618Lines partially contained in this region are deleted if and only if 619they contain a match entirely contained in it. 620 621Interactively, in Transient Mark mode when the mark is active, operate 622on the contents of the region. Otherwise, operate from point to the 623end of (the accessible portion of) the buffer. When calling this function 624from Lisp, you can pretend that it was called interactively by passing 625a non-nil INTERACTIVE argument. 626 627If a match is split across lines, all the lines it lies in are deleted. 628They are deleted _before_ looking for the next match. Hence, a match 629starting on the same line at which another match ended is ignored." 630 631 (interactive 632 (progn 633 (barf-if-buffer-read-only) 634 (keep-lines-read-args "Flush lines (containing match for regexp): "))) 635 (if rstart 636 (progn 637 (goto-char (min rstart rend)) 638 (setq rend (copy-marker (max rstart rend)))) 639 (if (and interactive transient-mark-mode mark-active) 640 (setq rstart (region-beginning) 641 rend (copy-marker (region-end))) 642 (setq rstart (point) 643 rend (point-max-marker))) 644 (goto-char rstart)) 645 (let ((case-fold-search (and case-fold-search 646 (isearch-no-upper-case-p regexp t)))) 647 (save-excursion 648 (while (and (< (point) rend) 649 (re-search-forward regexp rend t)) 650 (delete-region (save-excursion (goto-char (match-beginning 0)) 651 (forward-line 0) 652 (point)) 653 (progn (forward-line 1) (point)))))) 654 (set-marker rend nil) 655 nil) 656 657 658(defun how-many (regexp &optional rstart rend interactive) 659 "Print and return number of matches for REGEXP following point. 660When called from Lisp and INTERACTIVE is omitted or nil, just return 661the number, do not print it; if INTERACTIVE is t, the function behaves 662in all respects has if it had been called interactively. 663 664If REGEXP contains upper case characters (excluding those preceded by `\\'), 665the matching is case-sensitive. 666 667Second and third arg RSTART and REND specify the region to operate on. 668 669Interactively, in Transient Mark mode when the mark is active, operate 670on the contents of the region. Otherwise, operate from point to the 671end of (the accessible portion of) the buffer. 672 673This function starts looking for the next match from the end of 674the previous match. Hence, it ignores matches that overlap 675a previously found match." 676 677 (interactive 678 (keep-lines-read-args "How many matches for (regexp): ")) 679 (save-excursion 680 (if rstart 681 (progn 682 (goto-char (min rstart rend)) 683 (setq rend (max rstart rend))) 684 (if (and interactive transient-mark-mode mark-active) 685 (setq rstart (region-beginning) 686 rend (region-end)) 687 (setq rstart (point) 688 rend (point-max))) 689 (goto-char rstart)) 690 (let ((count 0) 691 opoint 692 (case-fold-search (and case-fold-search 693 (isearch-no-upper-case-p regexp t)))) 694 (while (and (< (point) rend) 695 (progn (setq opoint (point)) 696 (re-search-forward regexp rend t))) 697 (if (= opoint (point)) 698 (forward-char 1) 699 (setq count (1+ count)))) 700 (when interactive (message "%d occurrence%s" 701 count 702 (if (= count 1) "" "s"))) 703 count))) 704 705 706(defvar occur-mode-map 707 (let ((map (make-sparse-keymap))) 708 ;; We use this alternative name, so we can use \\[occur-mode-mouse-goto]. 709 (define-key map [mouse-2] 'occur-mode-mouse-goto) 710 (define-key map "\C-c\C-c" 'occur-mode-goto-occurrence) 711 (define-key map "\C-m" 'occur-mode-goto-occurrence) 712 (define-key map "o" 'occur-mode-goto-occurrence-other-window) 713 (define-key map "\C-o" 'occur-mode-display-occurrence) 714 (define-key map "\M-n" 'occur-next) 715 (define-key map "\M-p" 'occur-prev) 716 (define-key map "r" 'occur-rename-buffer) 717 (define-key map "c" 'clone-buffer) 718 (define-key map "g" 'revert-buffer) 719 (define-key map "q" 'quit-window) 720 (define-key map "z" 'kill-this-buffer) 721 (define-key map "\C-c\C-f" 'next-error-follow-minor-mode) 722 map) 723 "Keymap for `occur-mode'.") 724 725(defvar occur-revert-arguments nil 726 "Arguments to pass to `occur-1' to revert an Occur mode buffer. 727See `occur-revert-function'.") 728 729(defcustom occur-mode-hook '(turn-on-font-lock) 730 "Hook run when entering Occur mode." 731 :type 'hook 732 :group 'matching) 733 734(defcustom occur-hook nil 735 "Hook run by Occur when there are any matches." 736 :type 'hook 737 :group 'matching) 738 739(put 'occur-mode 'mode-class 'special) 740(defun occur-mode () 741 "Major mode for output from \\[occur]. 742\\<occur-mode-map>Move point to one of the items in this buffer, then use 743\\[occur-mode-goto-occurrence] to go to the occurrence that the item refers to. 744Alternatively, click \\[occur-mode-mouse-goto] on an item to go to it. 745 746\\{occur-mode-map}" 747 (interactive) 748 (kill-all-local-variables) 749 (use-local-map occur-mode-map) 750 (setq major-mode 'occur-mode) 751 (setq mode-name "Occur") 752 (set (make-local-variable 'revert-buffer-function) 'occur-revert-function) 753 (make-local-variable 'occur-revert-arguments) 754 (add-hook 'change-major-mode-hook 'font-lock-defontify nil t) 755 (setq next-error-function 'occur-next-error) 756 (run-mode-hooks 'occur-mode-hook)) 757 758(defun occur-revert-function (ignore1 ignore2) 759 "Handle `revert-buffer' for Occur mode buffers." 760 (apply 'occur-1 (append occur-revert-arguments (list (buffer-name))))) 761 762(defun occur-mode-find-occurrence () 763 (let ((pos (get-text-property (point) 'occur-target))) 764 (unless pos 765 (error "No occurrence on this line")) 766 (unless (buffer-live-p (marker-buffer pos)) 767 (error "Buffer for this occurrence was killed")) 768 pos)) 769 770(defalias 'occur-mode-mouse-goto 'occur-mode-goto-occurrence) 771(defun occur-mode-goto-occurrence (&optional event) 772 "Go to the occurrence the current line describes." 773 (interactive (list last-nonmenu-event)) 774 (let ((pos 775 (if (null event) 776 ;; Actually `event-end' works correctly with a nil argument as 777 ;; well, so we could dispense with this test, but let's not 778 ;; rely on this undocumented behavior. 779 (occur-mode-find-occurrence) 780 (with-current-buffer (window-buffer (posn-window (event-end event))) 781 (save-excursion 782 (goto-char (posn-point (event-end event))) 783 (occur-mode-find-occurrence))))) 784 same-window-buffer-names 785 same-window-regexps) 786 (pop-to-buffer (marker-buffer pos)) 787 (goto-char pos))) 788 789(defun occur-mode-goto-occurrence-other-window () 790 "Go to the occurrence the current line describes, in another window." 791 (interactive) 792 (let ((pos (occur-mode-find-occurrence))) 793 (switch-to-buffer-other-window (marker-buffer pos)) 794 (goto-char pos))) 795 796(defun occur-mode-display-occurrence () 797 "Display in another window the occurrence the current line describes." 798 (interactive) 799 (let ((pos (occur-mode-find-occurrence)) 800 window 801 ;; Bind these to ensure `display-buffer' puts it in another window. 802 same-window-buffer-names 803 same-window-regexps) 804 (setq window (display-buffer (marker-buffer pos))) 805 ;; This is the way to set point in the proper window. 806 (save-selected-window 807 (select-window window) 808 (goto-char pos)))) 809 810(defun occur-find-match (n search message) 811 (if (not n) (setq n 1)) 812 (let ((r)) 813 (while (> n 0) 814 (setq r (funcall search (point) 'occur-match)) 815 (and r 816 (get-text-property r 'occur-match) 817 (setq r (funcall search r 'occur-match))) 818 (if r 819 (goto-char r) 820 (error message)) 821 (setq n (1- n))))) 822 823(defun occur-next (&optional n) 824 "Move to the Nth (default 1) next match in an Occur mode buffer." 825 (interactive "p") 826 (occur-find-match n #'next-single-property-change "No more matches")) 827 828(defun occur-prev (&optional n) 829 "Move to the Nth (default 1) previous match in an Occur mode buffer." 830 (interactive "p") 831 (occur-find-match n #'previous-single-property-change "No earlier matches")) 832 833(defun occur-next-error (&optional argp reset) 834 "Move to the Nth (default 1) next match in an Occur mode buffer. 835Compatibility function for \\[next-error] invocations." 836 (interactive "p") 837 ;; we need to run occur-find-match from within the Occur buffer 838 (with-current-buffer 839 ;; Choose the buffer and make it current. 840 (if (next-error-buffer-p (current-buffer)) 841 (current-buffer) 842 (next-error-find-buffer nil nil 843 (lambda () 844 (eq major-mode 'occur-mode)))) 845 846 (goto-char (cond (reset (point-min)) 847 ((< argp 0) (line-beginning-position)) 848 ((> argp 0) (line-end-position)) 849 ((point)))) 850 (occur-find-match 851 (abs argp) 852 (if (> 0 argp) 853 #'previous-single-property-change 854 #'next-single-property-change) 855 "No more matches") 856 ;; In case the *Occur* buffer is visible in a nonselected window. 857 (let ((win (get-buffer-window (current-buffer) t))) 858 (if win (set-window-point win (point)))) 859 (occur-mode-goto-occurrence))) 860 861(defface match 862 '((((class color) (min-colors 88) (background light)) 863 :background "yellow") 864 (((class color) (min-colors 88) (background dark)) 865 :background "RoyalBlue3") 866 (((class color) (min-colors 8) (background light)) 867 :background "yellow" :foreground "black") 868 (((class color) (min-colors 8) (background dark)) 869 :background "blue" :foreground "white") 870 (((type tty) (class mono)) 871 :inverse-video t) 872 (t :background "gray")) 873 "Face used to highlight matches permanently." 874 :group 'matching 875 :version "22.1") 876 877(defcustom list-matching-lines-default-context-lines 0 878 "*Default number of context lines included around `list-matching-lines' matches. 879A negative number means to include that many lines before the match. 880A positive number means to include that many lines both before and after." 881 :type 'integer 882 :group 'matching) 883 884(defalias 'list-matching-lines 'occur) 885 886(defcustom list-matching-lines-face 'match 887 "*Face used by \\[list-matching-lines] to show the text that matches. 888If the value is nil, don't highlight the matching portions specially." 889 :type 'face 890 :group 'matching) 891 892(defcustom list-matching-lines-buffer-name-face 'underline 893 "*Face used by \\[list-matching-lines] to show the names of buffers. 894If the value is nil, don't highlight the buffer names specially." 895 :type 'face 896 :group 'matching) 897 898(defcustom occur-excluded-properties 899 '(read-only invisible intangible field mouse-face help-echo local-map keymap 900 yank-handler follow-link) 901 "*Text properties to discard when copying lines to the *Occur* buffer. 902The value should be a list of text properties to discard or t, 903which means to discard all text properties." 904 :type '(choice (const :tag "All" t) (repeat symbol)) 905 :group 'matching 906 :version "22.1") 907 908(defun occur-accumulate-lines (count &optional keep-props) 909 (save-excursion 910 (let ((forwardp (> count 0)) 911 result beg end) 912 (while (not (or (zerop count) 913 (if forwardp 914 (eobp) 915 (bobp)))) 916 (setq count (+ count (if forwardp -1 1))) 917 (setq beg (line-beginning-position) 918 end (line-end-position)) 919 (if (and keep-props (if (boundp 'jit-lock-mode) jit-lock-mode) 920 (text-property-not-all beg end 'fontified t)) 921 (if (fboundp 'jit-lock-fontify-now) 922 (jit-lock-fontify-now beg end))) 923 (push 924 (if (and keep-props (not (eq occur-excluded-properties t))) 925 (let ((str (buffer-substring beg end))) 926 (remove-list-of-text-properties 927 0 (length str) occur-excluded-properties str) 928 str) 929 (buffer-substring-no-properties beg end)) 930 result) 931 (forward-line (if forwardp 1 -1))) 932 (nreverse result)))) 933 934(defun occur-read-primary-args () 935 (list (let* ((default (car regexp-history)) 936 (input 937 (read-from-minibuffer 938 (if default 939 (format "List lines matching regexp (default %s): " 940 (query-replace-descr default)) 941 "List lines matching regexp: ") 942 nil 943 nil 944 nil 945 'regexp-history 946 default))) 947 (if (equal input "") 948 default 949 input)) 950 (when current-prefix-arg 951 (prefix-numeric-value current-prefix-arg)))) 952 953(defun occur-rename-buffer (&optional unique-p interactive-p) 954 "Rename the current *Occur* buffer to *Occur: original-buffer-name*. 955Here `original-buffer-name' is the buffer name were Occur was originally run. 956When given the prefix argument, or called non-interactively, the renaming 957will not clobber the existing buffer(s) of that name, but use 958`generate-new-buffer-name' instead. You can add this to `occur-hook' 959if you always want a separate *Occur* buffer for each buffer where you 960invoke `occur'." 961 (interactive "P\np") 962 (with-current-buffer 963 (if (eq major-mode 'occur-mode) (current-buffer) (get-buffer "*Occur*")) 964 (rename-buffer (concat "*Occur: " 965 (mapconcat #'buffer-name 966 (car (cddr occur-revert-arguments)) "/") 967 "*") 968 (or unique-p (not interactive-p))))) 969 970(defun occur (regexp &optional nlines) 971 "Show all lines in the current buffer containing a match for REGEXP. 972This function can not handle matches that span more than one line. 973 974Each line is displayed with NLINES lines before and after, or -NLINES 975before if NLINES is negative. 976NLINES defaults to `list-matching-lines-default-context-lines'. 977Interactively it is the prefix arg. 978 979The lines are shown in a buffer named `*Occur*'. 980It serves as a menu to find any of the occurrences in this buffer. 981\\<occur-mode-map>\\[describe-mode] in that buffer will explain how. 982 983If REGEXP contains upper case characters (excluding those preceded by `\\'), 984the matching is case-sensitive." 985 (interactive (occur-read-primary-args)) 986 (occur-1 regexp nlines (list (current-buffer)))) 987 988(defun multi-occur (bufs regexp &optional nlines) 989 "Show all lines in buffers BUFS containing a match for REGEXP. 990This function acts on multiple buffers; otherwise, it is exactly like 991`occur'. When you invoke this command interactively, you must specify 992the buffer names that you want, one by one." 993 (interactive 994 (cons 995 (let* ((bufs (list (read-buffer "First buffer to search: " 996 (current-buffer) t))) 997 (buf nil) 998 (ido-ignore-item-temp-list bufs)) 999 (while (not (string-equal 1000 (setq buf (read-buffer 1001 (if (eq read-buffer-function 'ido-read-buffer) 1002 "Next buffer to search (C-j to end): " 1003 "Next buffer to search (RET to end): ") 1004 nil t)) 1005 "")) 1006 (add-to-list 'bufs buf) 1007 (setq ido-ignore-item-temp-list bufs)) 1008 (nreverse (mapcar #'get-buffer bufs))) 1009 (occur-read-primary-args))) 1010 (occur-1 regexp nlines bufs)) 1011 1012(defun multi-occur-in-matching-buffers (bufregexp regexp &optional allbufs) 1013 "Show all lines matching REGEXP in buffers specified by BUFREGEXP. 1014Normally BUFREGEXP matches against each buffer's visited file name, 1015but if you specify a prefix argument, it matches against the buffer name. 1016See also `multi-occur'." 1017 (interactive 1018 (cons 1019 (let* ((default (car regexp-history)) 1020 (input 1021 (read-from-minibuffer 1022 (if current-prefix-arg 1023 "List lines in buffers whose names match regexp: " 1024 "List lines in buffers whose filenames match regexp: ") 1025 nil 1026 nil 1027 nil 1028 'regexp-history))) 1029 (if (equal input "") 1030 default 1031 input)) 1032 (occur-read-primary-args))) 1033 (when bufregexp 1034 (occur-1 regexp nil 1035 (delq nil 1036 (mapcar (lambda (buf) 1037 (when (if allbufs 1038 (string-match bufregexp 1039 (buffer-name buf)) 1040 (and (buffer-file-name buf) 1041 (string-match bufregexp 1042 (buffer-file-name buf)))) 1043 buf)) 1044 (buffer-list)))))) 1045 1046(defun occur-1 (regexp nlines bufs &optional buf-name) 1047 (unless buf-name 1048 (setq buf-name "*Occur*")) 1049 (let (occur-buf 1050 (active-bufs (delq nil (mapcar #'(lambda (buf) 1051 (when (buffer-live-p buf) buf)) 1052 bufs)))) 1053 ;; Handle the case where one of the buffers we're searching is the 1054 ;; output buffer. Just rename it. 1055 (when (member buf-name (mapcar 'buffer-name active-bufs)) 1056 (with-current-buffer (get-buffer buf-name) 1057 (rename-uniquely))) 1058 1059 ;; Now find or create the output buffer. 1060 ;; If we just renamed that buffer, we will make a new one here. 1061 (setq occur-buf (get-buffer-create buf-name)) 1062 1063 (with-current-buffer occur-buf 1064 (occur-mode) 1065 (let ((inhibit-read-only t) 1066 ;; Don't generate undo entries for creation of the initial contents. 1067 (buffer-undo-list t)) 1068 (erase-buffer) 1069 (let ((count (occur-engine 1070 regexp active-bufs occur-buf 1071 (or nlines list-matching-lines-default-context-lines) 1072 (and case-fold-search 1073 (isearch-no-upper-case-p regexp t)) 1074 list-matching-lines-buffer-name-face 1075 nil list-matching-lines-face 1076 (not (eq occur-excluded-properties t))))) 1077 (let* ((bufcount (length active-bufs)) 1078 (diff (- (length bufs) bufcount))) 1079 (message "Searched %d buffer%s%s; %s match%s for `%s'" 1080 bufcount (if (= bufcount 1) "" "s") 1081 (if (zerop diff) "" (format " (%d killed)" diff)) 1082 (if (zerop count) "no" (format "%d" count)) 1083 (if (= count 1) "" "es") 1084 regexp)) 1085 (setq occur-revert-arguments (list regexp nlines bufs)) 1086 (if (= count 0) 1087 (kill-buffer occur-buf) 1088 (display-buffer occur-buf) 1089 (setq next-error-last-buffer occur-buf) 1090 (setq buffer-read-only t) 1091 (set-buffer-modified-p nil) 1092 (run-hooks 'occur-hook))))))) 1093 1094(defun occur-engine-add-prefix (lines) 1095 (mapcar 1096 #'(lambda (line) 1097 (concat " :" line "\n")) 1098 lines)) 1099 1100(defun occur-engine (regexp buffers out-buf nlines case-fold-search 1101 title-face prefix-face match-face keep-props) 1102 (with-current-buffer out-buf 1103 (let ((globalcount 0) 1104 (coding nil)) 1105 ;; Map over all the buffers 1106 (dolist (buf buffers) 1107 (when (buffer-live-p buf) 1108 (let ((matches 0) ;; count of matched lines 1109 (lines 1) ;; line count 1110 (matchbeg 0) 1111 (origpt nil) 1112 (begpt nil) 1113 (endpt nil) 1114 (marker nil) 1115 (curstring "") 1116 (inhibit-field-text-motion t) 1117 (headerpt (with-current-buffer out-buf (point)))) 1118 (with-current-buffer buf 1119 (or coding 1120 ;; Set CODING only if the current buffer locally 1121 ;; binds buffer-file-coding-system. 1122 (not (local-variable-p 'buffer-file-coding-system)) 1123 (setq coding buffer-file-coding-system)) 1124 (save-excursion 1125 (goto-char (point-min)) ;; begin searching in the buffer 1126 (while (not (eobp)) 1127 (setq origpt (point)) 1128 (when (setq endpt (re-search-forward regexp nil t)) 1129 (setq matches (1+ matches)) ;; increment match count 1130 (setq matchbeg (match-beginning 0)) 1131 (setq lines (+ lines (1- (count-lines origpt endpt)))) 1132 (save-excursion 1133 (goto-char matchbeg) 1134 (setq begpt (line-beginning-position) 1135 endpt (line-end-position))) 1136 (setq marker (make-marker)) 1137 (set-marker marker matchbeg) 1138 (if (and keep-props 1139 (if (boundp 'jit-lock-mode) jit-lock-mode) 1140 (text-property-not-all begpt endpt 'fontified t)) 1141 (if (fboundp 'jit-lock-fontify-now) 1142 (jit-lock-fontify-now begpt endpt))) 1143 (if (and keep-props (not (eq occur-excluded-properties t))) 1144 (progn 1145 (setq curstring (buffer-substring begpt endpt)) 1146 (remove-list-of-text-properties 1147 0 (length curstring) occur-excluded-properties curstring)) 1148 (setq curstring (buffer-substring-no-properties begpt endpt))) 1149 ;; Highlight the matches 1150 (let ((len (length curstring)) 1151 (start 0)) 1152 (while (and (< start len) 1153 (string-match regexp curstring start)) 1154 (add-text-properties 1155 (match-beginning 0) (match-end 0) 1156 (append 1157 `(occur-match t) 1158 (when match-face 1159 ;; Use `face' rather than `font-lock-face' here 1160 ;; so as to override faces copied from the buffer. 1161 `(face ,match-face))) 1162 curstring) 1163 (setq start (match-end 0)))) 1164 ;; Generate the string to insert for this match 1165 (let* ((out-line 1166 (concat 1167 ;; Using 7 digits aligns tabs properly. 1168 (apply #'propertize (format "%7d:" lines) 1169 (append 1170 (when prefix-face 1171 `(font-lock-face prefix-face)) 1172 `(occur-prefix t mouse-face (highlight) 1173 occur-target ,marker follow-link t 1174 help-echo "mouse-2: go to this occurrence"))) 1175 ;; We don't put `mouse-face' on the newline, 1176 ;; because that loses. And don't put it 1177 ;; on context lines to reduce flicker. 1178 (propertize curstring 'mouse-face (list 'highlight) 1179 'occur-target marker 1180 'follow-link t 1181 'help-echo 1182 "mouse-2: go to this occurrence") 1183 ;; Add marker at eol, but no mouse props. 1184 (propertize "\n" 'occur-target marker))) 1185 (data 1186 (if (= nlines 0) 1187 ;; The simple display style 1188 out-line 1189 ;; The complex multi-line display 1190 ;; style. Generate a list of lines, 1191 ;; concatenate them all together. 1192 (apply #'concat 1193 (nconc 1194 (occur-engine-add-prefix (nreverse (cdr (occur-accumulate-lines (- (1+ (abs nlines))) keep-props)))) 1195 (list out-line) 1196 (if (> nlines 0) 1197 (occur-engine-add-prefix 1198 (cdr (occur-accumulate-lines (1+ nlines) keep-props))))))))) 1199 ;; Actually insert the match display data 1200 (with-current-buffer out-buf 1201 (let ((beg (point)) 1202 (end (progn (insert data) (point)))) 1203 (unless (= nlines 0) 1204 (insert "-------\n"))))) 1205 (goto-char endpt)) 1206 (if endpt 1207 (progn 1208 (setq lines (1+ lines)) 1209 ;; On to the next match... 1210 (forward-line 1)) 1211 (goto-char (point-max)))))) 1212 (when (not (zerop matches)) ;; is the count zero? 1213 (setq globalcount (+ globalcount matches)) 1214 (with-current-buffer out-buf 1215 (goto-char headerpt) 1216 (let ((beg (point)) 1217 end) 1218 (insert (format "%d match%s for \"%s\" in buffer: %s\n" 1219 matches (if (= matches 1) "" "es") 1220 regexp (buffer-name buf))) 1221 (setq end (point)) 1222 (add-text-properties beg end 1223 (append 1224 (when title-face 1225 `(font-lock-face ,title-face)) 1226 `(occur-title ,buf)))) 1227 (goto-char (point-min))))))) 1228 (if coding 1229 ;; CODING is buffer-file-coding-system of the first buffer 1230 ;; that locally binds it. Let's use it also for the output 1231 ;; buffer. 1232 (set-buffer-file-coding-system coding)) 1233 ;; Return the number of matches 1234 globalcount))) 1235 1236 1237;; It would be nice to use \\[...], but there is no reasonable way 1238;; to make that display both SPC and Y. 1239(defconst query-replace-help 1240 "Type Space or `y' to replace one match, Delete or `n' to skip to next, 1241RET or `q' to exit, Period to replace one match and exit, 1242Comma to replace but not move point immediately, 1243C-r to enter recursive edit (\\[exit-recursive-edit] to get out again), 1244C-w to delete match and recursive edit, 1245C-l to clear the screen, redisplay, and offer same replacement again, 1246! to replace all remaining matches with no more questions, 1247^ to move point back to previous match, 1248E to edit the replacement string" 1249 "Help message while in `query-replace'.") 1250 1251(defvar query-replace-map 1252 (let ((map (make-sparse-keymap))) 1253 (define-key map " " 'act) 1254 (define-key map "\d" 'skip) 1255 (define-key map [delete] 'skip) 1256 (define-key map [backspace] 'skip) 1257 (define-key map "y" 'act) 1258 (define-key map "n" 'skip) 1259 (define-key map "Y" 'act) 1260 (define-key map "N" 'skip) 1261 (define-key map "e" 'edit-replacement) 1262 (define-key map "E" 'edit-replacement) 1263 (define-key map "," 'act-and-show) 1264 (define-key map "q" 'exit) 1265 (define-key map "\r" 'exit) 1266 (define-key map [return] 'exit) 1267 (define-key map "." 'act-and-exit) 1268 (define-key map "\C-r" 'edit) 1269 (define-key map "\C-w" 'delete-and-edit) 1270 (define-key map "\C-l" 'recenter) 1271 (define-key map "!" 'automatic) 1272 (define-key map "^" 'backup) 1273 (define-key map "\C-h" 'help) 1274 (define-key map [f1] 'help) 1275 (define-key map [help] 'help) 1276 (define-key map "?" 'help) 1277 (define-key map "\C-g" 'quit) 1278 (define-key map "\C-]" 'quit) 1279 (define-key map "\e" 'exit-prefix) 1280 (define-key map [escape] 'exit-prefix) 1281 map) 1282 "Keymap that defines the responses to questions in `query-replace'. 1283The \"bindings\" in this map are not commands; they are answers. 1284The valid answers include `act', `skip', `act-and-show', 1285`exit', `act-and-exit', `edit', `delete-and-edit', `recenter', 1286`automatic', `backup', `exit-prefix', and `help'.") 1287 1288(defun replace-match-string-symbols (n) 1289 "Process a list (and any sub-lists), expanding certain symbols. 1290Symbol Expands To 1291N (match-string N) (where N is a string of digits) 1292#N (string-to-number (match-string N)) 1293& (match-string 0) 1294#& (string-to-number (match-string 0)) 1295# replace-count 1296 1297Note that these symbols must be preceeded by a backslash in order to 1298type them using Lisp syntax." 1299 (while (consp n) 1300 (cond 1301 ((consp (car n)) 1302 (replace-match-string-symbols (car n))) ;Process sub-list 1303 ((symbolp (car n)) 1304 (let ((name (symbol-name (car n)))) 1305 (cond 1306 ((string-match "^[0-9]+$" name) 1307 (setcar n (list 'match-string (string-to-number name)))) 1308 ((string-match "^#[0-9]+$" name) 1309 (setcar n (list 'string-to-number 1310 (list 'match-string 1311 (string-to-number (substring name 1)))))) 1312 ((string= "&" name) 1313 (setcar n '(match-string 0))) 1314 ((string= "#&" name) 1315 (setcar n '(string-to-number (match-string 0)))) 1316 ((string= "#" name) 1317 (setcar n 'replace-count)))))) 1318 (setq n (cdr n)))) 1319 1320(defun replace-eval-replacement (expression replace-count) 1321 (let ((replacement (eval expression))) 1322 (if (stringp replacement) 1323 replacement 1324 (prin1-to-string replacement t)))) 1325 1326(defun replace-quote (replacement) 1327 "Quote a replacement string. 1328This just doubles all backslashes in REPLACEMENT and 1329returns the resulting string. If REPLACEMENT is not 1330a string, it is first passed through `prin1-to-string' 1331with the `noescape' argument set. 1332 1333`match-data' is preserved across the call." 1334 (save-match-data 1335 (replace-regexp-in-string "\\\\" "\\\\" 1336 (if (stringp replacement) 1337 replacement 1338 (prin1-to-string replacement t)) 1339 t t))) 1340 1341(defun replace-loop-through-replacements (data replace-count) 1342 ;; DATA is a vector contaning the following values: 1343 ;; 0 next-rotate-count 1344 ;; 1 repeat-count 1345 ;; 2 next-replacement 1346 ;; 3 replacements 1347 (if (= (aref data 0) replace-count) 1348 (progn 1349 (aset data 0 (+ replace-count (aref data 1))) 1350 (let ((next (cdr (aref data 2)))) 1351 (aset data 2 (if (consp next) next (aref data 3)))))) 1352 (car (aref data 2))) 1353 1354(defun replace-match-data (integers reuse &optional new) 1355 "Like `match-data', but markers in REUSE get invalidated. 1356If NEW is non-nil, it is set and returned instead of fresh data, 1357but coerced to the correct value of INTEGERS." 1358 (or (and new 1359 (progn 1360 (set-match-data new) 1361 (and (eq new reuse) 1362 (eq (null integers) (markerp (car reuse))) 1363 new))) 1364 (match-data integers reuse t))) 1365 1366(defun replace-match-maybe-edit (newtext fixedcase literal noedit match-data) 1367 "Make a replacement with `replace-match', editing `\\?'. 1368NEWTEXT, FIXEDCASE, LITERAL are just passed on. If NOEDIT is true, no 1369check for `\\?' is made to save time. MATCH-DATA is used for the 1370replacement. In case editing is done, it is changed to use markers. 1371 1372The return value is non-nil if there has been no `\\?' or NOEDIT was 1373passed in. If LITERAL is set, no checking is done, anyway." 1374 (unless (or literal noedit) 1375 (setq noedit t) 1376 (while (string-match "\\(\\`\\|[^\\]\\)\\(\\\\\\\\\\)*\\(\\\\\\?\\)" 1377 newtext) 1378 (setq newtext 1379 (read-string "Edit replacement string: " 1380 (prog1 1381 (cons 1382 (replace-match "" t t newtext 3) 1383 (1+ (match-beginning 3))) 1384 (setq match-data 1385 (replace-match-data 1386 nil match-data match-data)))) 1387 noedit nil))) 1388 (set-match-data match-data) 1389 (replace-match newtext fixedcase literal) 1390 noedit) 1391 1392(defun perform-replace (from-string replacements 1393 query-flag regexp-flag delimited-flag 1394 &optional repeat-count map start end) 1395 "Subroutine of `query-replace'. Its complexity handles interactive queries. 1396Don't use this in your own program unless you want to query and set the mark 1397just as `query-replace' does. Instead, write a simple loop like this: 1398 1399 (while (re-search-forward \"foo[ \\t]+bar\" nil t) 1400 (replace-match \"foobar\" nil nil)) 1401 1402which will run faster and probably do exactly what you want. Please 1403see the documentation of `replace-match' to find out how to simulate 1404`case-replace'. 1405 1406This function returns nil if and only if there were no matches to 1407make, or the user didn't cancel the call." 1408 (or map (setq map query-replace-map)) 1409 (and query-flag minibuffer-auto-raise 1410 (raise-frame (window-frame (minibuffer-window)))) 1411 (let ((nocasify (not (and case-fold-search case-replace 1412 (string-equal from-string 1413 (downcase from-string))))) 1414 (case-fold-search (and case-fold-search 1415 (string-equal from-string 1416 (downcase from-string)))) 1417 (literal (or (not regexp-flag) (eq regexp-flag 'literal))) 1418 (search-function (if regexp-flag 're-search-forward 'search-forward)) 1419 (search-string from-string) 1420 (real-match-data nil) ; the match data for the current match 1421 (next-replacement nil) 1422 ;; This is non-nil if we know there is nothing for the user 1423 ;; to edit in the replacement. 1424 (noedit nil) 1425 (keep-going t) 1426 (stack nil) 1427 (replace-count 0) 1428 (nonempty-match nil) 1429 1430 ;; If non-nil, it is marker saying where in the buffer to stop. 1431 (limit nil) 1432 1433 ;; Data for the next match. If a cons, it has the same format as 1434 ;; (match-data); otherwise it is t if a match is possible at point. 1435 (match-again t) 1436 1437 (message 1438 (if query-flag 1439 (apply 'propertize 1440 (substitute-command-keys 1441 "Query replacing %s with %s: (\\<query-replace-map>\\[help] for help) ") 1442 minibuffer-prompt-properties)))) 1443 1444 ;; If region is active, in Transient Mark mode, operate on region. 1445 (when start 1446 (setq limit (copy-marker (max start end))) 1447 (goto-char (min start end)) 1448 (deactivate-mark)) 1449 1450 ;; REPLACEMENTS is either a string, a list of strings, or a cons cell 1451 ;; containing a function and its first argument. The function is 1452 ;; called to generate each replacement like this: 1453 ;; (funcall (car replacements) (cdr replacements) replace-count) 1454 ;; It must return a string. 1455 (cond 1456 ((stringp replacements) 1457 (setq next-replacement replacements 1458 replacements nil)) 1459 ((stringp (car replacements)) ; If it isn't a string, it must be a cons 1460 (or repeat-count (setq repeat-count 1)) 1461 (setq replacements (cons 'replace-loop-through-replacements 1462 (vector repeat-count repeat-count 1463 replacements replacements))))) 1464 1465 (if delimited-flag 1466 (setq search-function 're-search-forward 1467 search-string (concat "\\b" 1468 (if regexp-flag from-string 1469 (regexp-quote from-string)) 1470 "\\b"))) 1471 (when query-replace-lazy-highlight 1472 (setq isearch-lazy-highlight-last-string nil)) 1473 1474 (push-mark) 1475 (undo-boundary) 1476 (unwind-protect 1477 ;; Loop finding occurrences that perhaps should be replaced. 1478 (while (and keep-going 1479 (not (or (eobp) (and limit (>= (point) limit)))) 1480 ;; Use the next match if it is already known; 1481 ;; otherwise, search for a match after moving forward 1482 ;; one char if progress is required. 1483 (setq real-match-data 1484 (cond ((consp match-again) 1485 (goto-char (nth 1 match-again)) 1486 (replace-match-data 1487 t real-match-data match-again)) 1488 ;; MATCH-AGAIN non-nil means accept an 1489 ;; adjacent match. 1490 (match-again 1491 (and 1492 (funcall search-function search-string 1493 limit t) 1494 ;; For speed, use only integers and 1495 ;; reuse the list used last time. 1496 (replace-match-data t real-match-data))) 1497 ((and (< (1+ (point)) (point-max)) 1498 (or (null limit) 1499 (< (1+ (point)) limit))) 1500 ;; If not accepting adjacent matches, 1501 ;; move one char to the right before 1502 ;; searching again. Undo the motion 1503 ;; if the search fails. 1504 (let ((opoint (point))) 1505 (forward-char 1) 1506 (if (funcall 1507 search-function search-string 1508 limit t) 1509 (replace-match-data 1510 t real-match-data) 1511 (goto-char opoint) 1512 nil)))))) 1513 1514 ;; Record whether the match is nonempty, to avoid an infinite loop 1515 ;; repeatedly matching the same empty string. 1516 (setq nonempty-match 1517 (/= (nth 0 real-match-data) (nth 1 real-match-data))) 1518 1519 ;; If the match is empty, record that the next one can't be 1520 ;; adjacent. 1521 1522 ;; Otherwise, if matching a regular expression, do the next 1523 ;; match now, since the replacement for this match may 1524 ;; affect whether the next match is adjacent to this one. 1525 ;; If that match is empty, don't use it. 1526 (setq match-again 1527 (and nonempty-match 1528 (or (not regexp-flag) 1529 (and (looking-at search-string) 1530 (let ((match (match-data))) 1531 (and (/= (nth 0 match) (nth 1 match)) 1532 match)))))) 1533 1534 ;; Optionally ignore matches that have a read-only property. 1535 (unless (and query-replace-skip-read-only 1536 (text-property-not-all 1537 (nth 0 real-match-data) (nth 1 real-match-data) 1538 'read-only nil)) 1539 1540 ;; Calculate the replacement string, if necessary. 1541 (when replacements 1542 (set-match-data real-match-data) 1543 (setq next-replacement 1544 (funcall (car replacements) (cdr replacements) 1545 replace-count))) 1546 (if (not query-flag) 1547 (let ((inhibit-read-only 1548 query-replace-skip-read-only)) 1549 (unless (or literal noedit) 1550 (replace-highlight 1551 (nth 0 real-match-data) (nth 1 real-match-data) 1552 start end search-string 1553 (or delimited-flag regexp-flag) case-fold-search)) 1554 (setq noedit 1555 (replace-match-maybe-edit 1556 next-replacement nocasify literal 1557 noedit real-match-data) 1558 replace-count (1+ replace-count))) 1559 (undo-boundary) 1560 (let (done replaced key def) 1561 ;; Loop reading commands until one of them sets done, 1562 ;; which means it has finished handling this 1563 ;; occurrence. Any command that sets `done' should 1564 ;; leave behind proper match data for the stack. 1565 ;; Commands not setting `done' need to adjust 1566 ;; `real-match-data'. 1567 (while (not done) 1568 (set-match-data real-match-data) 1569 (replace-highlight 1570 (match-beginning 0) (match-end 0) 1571 start end search-string 1572 (or delimited-flag regexp-flag) case-fold-search) 1573 ;; Bind message-log-max so we don't fill up the message log 1574 ;; with a bunch of identical messages. 1575 (let ((message-log-max nil)) 1576 (message message 1577 (query-replace-descr from-string) 1578 (query-replace-descr next-replacement))) 1579 (setq key (read-event)) 1580 ;; Necessary in case something happens during read-event 1581 ;; that clobbers the match data. 1582 (set-match-data real-match-data) 1583 (setq key (vector key)) 1584 (setq def (lookup-key map key)) 1585 ;; Restore the match data while we process the command. 1586 (cond ((eq def 'help) 1587 (with-output-to-temp-buffer "*Help*" 1588 (princ 1589 (concat "Query replacing " 1590 (if regexp-flag "regexp " "") 1591 from-string " with " 1592 next-replacement ".\n\n" 1593 (substitute-command-keys 1594 query-replace-help))) 1595 (with-current-buffer standard-output 1596 (help-mode)))) 1597 ((eq def 'exit) 1598 (setq keep-going nil) 1599 (setq done t)) 1600 ((eq def 'backup) 1601 (if stack 1602 (let ((elt (pop stack))) 1603 (goto-char (nth 0 elt)) 1604 (setq replaced (nth 1 elt) 1605 real-match-data 1606 (replace-match-data 1607 t real-match-data 1608 (nth 2 elt)))) 1609 (message "No previous match") 1610 (ding 'no-terminate) 1611 (sit-for 1))) 1612 ((eq def 'act) 1613 (or replaced 1614 (setq noedit 1615 (replace-match-maybe-edit 1616 next-replacement nocasify literal 1617 noedit real-match-data) 1618 replace-count (1+ replace-count))) 1619 (setq done t replaced t)) 1620 ((eq def 'act-and-exit) 1621 (or replaced 1622 (setq noedit 1623 (replace-match-maybe-edit 1624 next-replacement nocasify literal 1625 noedit real-match-data) 1626 replace-count (1+ replace-count))) 1627 (setq keep-going nil) 1628 (setq done t replaced t)) 1629 ((eq def 'act-and-show) 1630 (if (not replaced) 1631 (setq noedit 1632 (replace-match-maybe-edit 1633 next-replacement nocasify literal 1634 noedit real-match-data) 1635 replace-count (1+ replace-count) 1636 real-match-data (replace-match-data 1637 t real-match-data) 1638 replaced t))) 1639 ((eq def 'automatic) 1640 (or replaced 1641 (setq noedit 1642 (replace-match-maybe-edit 1643 next-replacement nocasify literal 1644 noedit real-match-data) 1645 replace-count (1+ replace-count))) 1646 (setq done t query-flag nil replaced t)) 1647 ((eq def 'skip) 1648 (setq done t)) 1649 ((eq def 'recenter) 1650 (recenter nil)) 1651 ((eq def 'edit) 1652 (let ((opos (point-marker))) 1653 (setq real-match-data (replace-match-data 1654 nil real-match-data 1655 real-match-data)) 1656 (goto-char (match-beginning 0)) 1657 (save-excursion 1658 (save-window-excursion 1659 (recursive-edit))) 1660 (goto-char opos) 1661 (set-marker opos nil)) 1662 ;; Before we make the replacement, 1663 ;; decide whether the search string 1664 ;; can match again just after this match. 1665 (if (and regexp-flag nonempty-match) 1666 (setq match-again (and (looking-at search-string) 1667 (match-data))))) 1668 ;; Edit replacement. 1669 ((eq def 'edit-replacement) 1670 (setq real-match-data (replace-match-data 1671 nil real-match-data 1672 real-match-data) 1673 next-replacement 1674 (read-string "Edit replacement string: " 1675 next-replacement) 1676 noedit nil) 1677 (if replaced 1678 (set-match-data real-match-data) 1679 (setq noedit 1680 (replace-match-maybe-edit 1681 next-replacement nocasify literal noedit 1682 real-match-data) 1683 replaced t)) 1684 (setq done t)) 1685 1686 ((eq def 'delete-and-edit) 1687 (replace-match "" t t) 1688 (setq real-match-data (replace-match-data 1689 nil real-match-data)) 1690 (replace-dehighlight) 1691 (save-excursion (recursive-edit)) 1692 (setq replaced t)) 1693 ;; Note: we do not need to treat `exit-prefix' 1694 ;; specially here, since we reread 1695 ;; any unrecognized character. 1696 (t 1697 (setq this-command 'mode-exited) 1698 (setq keep-going nil) 1699 (setq unread-command-events 1700 (append (listify-key-sequence key) 1701 unread-command-events)) 1702 (setq done t))) 1703 (when query-replace-lazy-highlight 1704 ;; Force lazy rehighlighting only after replacements 1705 (if (not (memq def '(skip backup))) 1706 (setq isearch-lazy-highlight-last-string nil)))) 1707 ;; Record previous position for ^ when we move on. 1708 ;; Change markers to numbers in the match data 1709 ;; since lots of markers slow down editing. 1710 (push (list (point) replaced 1711;;; If the replacement has already happened, all we need is the 1712;;; current match start and end. We could get this with a trivial 1713;;; match like 1714;;; (save-excursion (goto-char (match-beginning 0)) 1715;;; (search-forward (match-string 0)) 1716;;; (match-data t)) 1717;;; if we really wanted to avoid manually constructing match data. 1718;;; Adding current-buffer is necessary so that match-data calls can 1719;;; return markers which are appropriate for editing. 1720 (if replaced 1721 (list 1722 (match-beginning 0) 1723 (match-end 0) 1724 (current-buffer)) 1725 (match-data t))) 1726 stack))))) 1727 1728 (replace-dehighlight)) 1729 (or unread-command-events 1730 (message "Replaced %d occurrence%s" 1731 replace-count 1732 (if (= replace-count 1) "" "s"))) 1733 (and keep-going stack))) 1734 1735(defvar replace-overlay nil) 1736 1737(defun replace-highlight (match-beg match-end range-beg range-end 1738 string regexp case-fold) 1739 (if query-replace-highlight 1740 (if replace-overlay 1741 (move-overlay replace-overlay match-beg match-end (current-buffer)) 1742 (setq replace-overlay (make-overlay match-beg match-end)) 1743 (overlay-put replace-overlay 'priority 1001) ;higher than lazy overlays 1744 (overlay-put replace-overlay 'face 'query-replace))) 1745 (if query-replace-lazy-highlight 1746 (let ((isearch-string string) 1747 (isearch-regexp regexp) 1748 (search-whitespace-regexp nil) 1749 (isearch-case-fold-search case-fold)) 1750 (isearch-lazy-highlight-new-loop range-beg range-end)))) 1751 1752(defun replace-dehighlight () 1753 (when replace-overlay 1754 (delete-overlay replace-overlay)) 1755 (when query-replace-lazy-highlight 1756 (lazy-highlight-cleanup lazy-highlight-cleanup) 1757 (setq isearch-lazy-highlight-last-string nil))) 1758 1759;; arch-tag: 16b4cd61-fd40-497b-b86f-b667c4cf88e4 1760;;; replace.el ends here 1761