Mercurial > hg > xemacs-beta
annotate lisp/replace.el @ 5894:23178aa71f8b
Define ALIGNOF using C11 and C++11 operators.
See <CAHCOHQmG51R61KwGUNY7T5t9tXxzbyg=aGijUKYstbE+wL2-6Q@mail.gmail.com> in
xemacs-patches for more information.
| author | Jerry James <james@xemacs.org> |
|---|---|
| date | Mon, 20 Apr 2015 15:09:11 -0600 |
| parents | bbe4146603db |
| children |
| rev | line source |
|---|---|
| 428 | 1 ;;; replace.el --- search and replace commands for XEmacs. |
| 2 | |
|
5686
c6b1500299a7
recenter-top-bottom synced from GNU and new default for C-l
Mats Lidell <mats.lidell@cag.se>
parents:
5473
diff
changeset
|
3 ;; Copyright (C) 1985-7, 1992, 1994, 1997, 2003, 2012 Free Software Foundation, Inc. |
| 428 | 4 |
| 5 ;; Maintainer: XEmacs Development Team | |
| 6 ;; Keywords: dumped, matching | |
| 7 | |
| 8 ;; This file is part of XEmacs. | |
| 9 | |
|
5402
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
3000
diff
changeset
|
10 ;; XEmacs is free software: you can redistribute it and/or modify it |
|
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
3000
diff
changeset
|
11 ;; under the terms of the GNU General Public License as published by the |
|
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
3000
diff
changeset
|
12 ;; Free Software Foundation, either version 3 of the License, or (at your |
|
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
3000
diff
changeset
|
13 ;; option) any later version. |
| 428 | 14 |
|
5402
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
3000
diff
changeset
|
15 ;; XEmacs is distributed in the hope that it will be useful, but WITHOUT |
|
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
3000
diff
changeset
|
16 ;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or |
|
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
3000
diff
changeset
|
17 ;; FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License |
|
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
3000
diff
changeset
|
18 ;; for more details. |
| 428 | 19 |
| 20 ;; You should have received a copy of the GNU General Public License | |
|
5402
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
3000
diff
changeset
|
21 ;; along with XEmacs. If not, see <http://www.gnu.org/licenses/>. |
| 428 | 22 |
| 23 ;;; Synched up with: FSF 19.34 [Partially]. | |
| 24 | |
| 25 ;;; Commentary: | |
| 26 | |
| 27 ;; This file is dumped with XEmacs. | |
| 28 | |
| 29 ;; This package supplies the string and regular-expression replace functions | |
| 30 ;; documented in the XEmacs Reference Manual. | |
| 31 | |
| 32 ;; All the gettext calls are for XEmacs I18N3 message catalog support. | |
| 33 ;; (This is hopelessly broken and we should remove it. -sb) | |
| 34 | |
| 35 ;;; Code: | |
| 36 | |
| 37 (defvar case-replace t "\ | |
| 38 *Non-nil means `query-replace' should preserve case in replacements. | |
| 39 What this means is that `query-replace' will change the case of the | |
| 40 replacement text so that it matches the text that was replaced. | |
| 41 If this variable is nil, the replacement text will be inserted | |
| 42 exactly as it was specified by the user, irrespective of the case | |
| 43 of the text that was replaced. | |
| 44 | |
| 45 Note that this flag has no effect if `case-fold-search' is nil, | |
| 46 or if the replacement text has any uppercase letters in it.") | |
| 47 | |
| 48 (defvar query-replace-history nil) | |
| 49 | |
| 50 (defvar query-replace-interactive nil | |
| 51 "Non-nil means `query-replace' uses the last search string. | |
| 52 That becomes the \"string to replace\".") | |
| 53 | |
| 54 (defvar replace-search-function | |
| 55 (lambda (str limit) | |
| 56 (search-forward str limit t)) | |
| 444 | 57 "Function used by perform-replace to search forward for a string. It will be |
| 428 | 58 called with two arguments: the string to search for and a limit bounding the |
| 59 search.") | |
| 60 | |
| 61 (defvar replace-re-search-function | |
| 62 (lambda (regexp limit) | |
| 63 (re-search-forward regexp limit t)) | |
| 64 "Function used by perform-replace to search forward for a regular | |
| 65 expression. It will be called with two arguments: the regexp to search for and | |
| 66 a limit bounding the search.") | |
| 67 | |
| 68 (defun query-replace-read-args (string regexp-flag) | |
| 69 (let (from to) | |
| 70 (if query-replace-interactive | |
| 71 (setq from (car (if regexp-flag regexp-search-ring search-ring))) | |
| 72 (setq from (read-from-minibuffer (format "%s: " (gettext string)) | |
| 73 nil nil nil | |
| 74 'query-replace-history))) | |
| 75 (setq to (read-from-minibuffer (format "%s %s with: " (gettext string) | |
| 76 from) | |
| 77 nil nil nil | |
| 78 'query-replace-history)) | |
| 79 (list from to current-prefix-arg))) | |
| 80 | |
| 81 ;; As per suggestion from Per Abrahamsen, limit replacement to the region | |
| 82 ;; if the region is active. | |
| 83 (defun query-replace (from-string to-string &optional delimited) | |
| 84 "Replace some occurrences of FROM-STRING with TO-STRING. | |
| 85 As each match is found, the user must type a character saying | |
| 86 what to do with it. For directions, type \\[help-command] at that time. | |
| 87 | |
| 88 If `query-replace-interactive' is non-nil, the last incremental search | |
| 89 string is used as FROM-STRING--you don't have to specify it with the | |
| 90 minibuffer. | |
| 91 | |
| 92 Preserves case in each replacement if `case-replace' and `case-fold-search' | |
| 93 are non-nil and FROM-STRING has no uppercase letters. | |
| 94 \(Preserving case means that if the string matched is all caps, or capitalized, | |
| 95 then its replacement is upcased or capitalized.) | |
| 96 | |
| 97 Third arg DELIMITED (prefix arg if interactive), if non-nil, means replace | |
| 98 only matches surrounded by word boundaries. | |
| 99 | |
| 100 To customize possible responses, change the \"bindings\" in `query-replace-map'." | |
| 101 (interactive (query-replace-read-args "Query replace" nil)) | |
| 102 (perform-replace from-string to-string t nil delimited)) | |
| 103 | |
| 104 (defun query-replace-regexp (regexp to-string &optional delimited) | |
| 105 "Replace some things after point matching REGEXP with TO-STRING. | |
| 106 As each match is found, the user must type a character saying | |
| 107 what to do with it. For directions, type \\[help-command] at that time. | |
| 108 | |
| 109 If `query-replace-interactive' is non-nil, the last incremental search | |
| 110 regexp is used as REGEXP--you don't have to specify it with the | |
| 111 minibuffer. | |
| 112 | |
| 113 Preserves case in each replacement if `case-replace' and `case-fold-search' | |
| 114 are non-nil and REGEXP has no uppercase letters. | |
| 115 Third arg DELIMITED (prefix arg if interactive), if non-nil, means replace | |
| 116 only matches surrounded by word boundaries. | |
| 117 In TO-STRING, `\\&' stands for whatever matched the whole of REGEXP, | |
| 118 and `\\=\\N' (where N is a digit) stands for | |
| 119 whatever what matched the Nth `\\(...\\)' in REGEXP." | |
| 120 (interactive (query-replace-read-args "Query replace regexp" t)) | |
| 121 (perform-replace regexp to-string t t delimited)) | |
| 122 | |
| 123 ;;#### Not patently useful | |
| 124 (defun map-query-replace-regexp (regexp to-strings &optional arg) | |
| 125 "Replace some matches for REGEXP with various strings, in rotation. | |
| 126 The second argument TO-STRINGS contains the replacement strings, separated | |
| 127 by spaces. This command works like `query-replace-regexp' except | |
| 128 that each successive replacement uses the next successive replacement string, | |
| 129 wrapping around from the last such string to the first. | |
| 130 | |
| 131 Non-interactively, TO-STRINGS may be a list of replacement strings. | |
| 132 | |
| 133 If `query-replace-interactive' is non-nil, the last incremental search | |
| 134 regexp is used as REGEXP--you don't have to specify it with the minibuffer. | |
| 135 | |
| 136 A prefix argument N says to use each replacement string N times | |
| 137 before rotating to the next." | |
| 138 (interactive | |
| 139 (let (from to) | |
| 140 (setq from (if query-replace-interactive | |
| 141 (car regexp-search-ring) | |
| 142 (read-from-minibuffer "Map query replace (regexp): " | |
| 143 nil nil nil | |
| 144 'query-replace-history))) | |
| 145 (setq to (read-from-minibuffer | |
| 146 (format "Query replace %s with (space-separated strings): " | |
| 147 from) | |
| 148 nil nil nil | |
| 149 'query-replace-history)) | |
| 150 (list from to current-prefix-arg))) | |
|
5882
bbe4146603db
Reduce regexp usage, now CL-oriented non-regexp code available, core Lisp
Aidan Kehoe <kehoea@parhasard.net>
parents:
5855
diff
changeset
|
151 (perform-replace regexp (if (listp to-strings) |
|
bbe4146603db
Reduce regexp usage, now CL-oriented non-regexp code available, core Lisp
Aidan Kehoe <kehoea@parhasard.net>
parents:
5855
diff
changeset
|
152 to-strings |
|
bbe4146603db
Reduce regexp usage, now CL-oriented non-regexp code available, core Lisp
Aidan Kehoe <kehoea@parhasard.net>
parents:
5855
diff
changeset
|
153 (split-string-by-char to-strings ?\ )) |
|
bbe4146603db
Reduce regexp usage, now CL-oriented non-regexp code available, core Lisp
Aidan Kehoe <kehoea@parhasard.net>
parents:
5855
diff
changeset
|
154 t t nil arg)) |
| 428 | 155 |
| 156 (defun replace-string (from-string to-string &optional delimited) | |
| 157 "Replace occurrences of FROM-STRING with TO-STRING. | |
| 158 Preserve case in each match if `case-replace' and `case-fold-search' | |
| 159 are non-nil and FROM-STRING has no uppercase letters. | |
| 160 \(Preserving case means that if the string matched is all caps, or capitalized, | |
| 161 then its replacement is upcased or capitalized.) | |
| 162 | |
| 163 Third arg DELIMITED (prefix arg if interactive), if non-nil, means replace | |
| 164 only matches surrounded by word boundaries. | |
| 165 | |
| 166 If `query-replace-interactive' is non-nil, the last incremental search | |
| 167 string is used as FROM-STRING--you don't have to specify it with the | |
| 168 minibuffer. | |
| 169 | |
| 170 This function is usually the wrong thing to use in a Lisp program. | |
| 171 What you probably want is a loop like this: | |
| 172 (while (search-forward FROM-STRING nil t) | |
| 173 (replace-match TO-STRING nil t)) | |
| 174 which will run faster and will not set the mark or print anything." | |
| 175 (interactive (query-replace-read-args "Replace string" nil)) | |
| 176 (perform-replace from-string to-string nil nil delimited)) | |
| 177 | |
| 178 (defun replace-regexp (regexp to-string &optional delimited) | |
| 179 "Replace things after point matching REGEXP with TO-STRING. | |
| 180 Preserve case in each match if `case-replace' and `case-fold-search' | |
| 181 are non-nil and REGEXP has no uppercase letters. | |
| 182 \(Preserving case means that if the string matched is all caps, or capitalized, | |
| 183 then its replacement is upcased or capitalized.) | |
| 184 | |
| 185 Third arg DELIMITED (prefix arg if interactive), if non-nil, means replace | |
| 186 only matches surrounded by word boundaries. | |
| 187 In TO-STRING, `\\&' stands for whatever matched the whole of REGEXP, | |
| 188 and `\\=\\N' (where N is a digit) stands for | |
| 189 whatever what matched the Nth `\\(...\\)' in REGEXP. | |
| 190 | |
| 191 If `query-replace-interactive' is non-nil, the last incremental search | |
| 192 regexp is used as REGEXP--you don't have to specify it with the minibuffer. | |
| 193 | |
| 194 This function is usually the wrong thing to use in a Lisp program. | |
| 195 What you probably want is a loop like this: | |
| 196 (while (re-search-forward REGEXP nil t) | |
| 197 (replace-match TO-STRING nil nil)) | |
| 198 which will run faster and will not set the mark or print anything." | |
| 199 (interactive (query-replace-read-args "Replace regexp" t)) | |
| 200 (perform-replace regexp to-string nil t delimited)) | |
| 201 | |
| 202 | |
| 1069 | 203 |
| 204 ;; gse wonders: Is there a better place for this to go? Might other packages | |
| 205 ;; want to use it? | |
| 428 | 206 (defvar regexp-history nil |
| 207 "History list for some commands that read regular expressions.") | |
| 208 | |
| 1069 | 209 (defun operate-on-non-matching-lines (regexp delete kill &optional beg end) |
| 210 "Internal function used by delete-non-matching-lines, | |
| 211 kill-non-matching-lines, and copy-matching-lines. | |
| 212 | |
| 213 REGEXP is a regular expression to *not* match when performing | |
| 214 operations. | |
| 215 | |
| 216 If DELETE is non-nil, the lines of text are deleted. It doesn't make | |
| 217 sense to set this to nil if KILL is nil -- nothing will happen. | |
| 218 | |
| 219 If KILL is non-nil, the lines of text are stored in the kill ring (as | |
| 220 one block of text). | |
| 221 | |
| 222 BEG and END, if non-nil, specify the start and end locations to work | |
| 223 within. If these are nil, point and point-max are used. | |
| 224 | |
| 225 A match split across lines preserves all the lines it lies in. | |
| 226 Applies to all lines after point. | |
| 227 | |
| 228 Returns the number of lines matched." | |
| 229 (with-search-caps-disable-folding regexp t | |
| 230 (save-excursion | |
| 231 ;; Move to a beginning point if specified. | |
| 232 (when beg (goto-char beg)) | |
| 233 ;; Always start on the beginning of a line. | |
| 234 (or (bolp) (forward-line 1)) | |
| 235 | |
| 236 (let ((matched-text nil) | |
| 237 (curmatch-start (point)) | |
| 2610 | 238 (limit (copy-marker (point-max))) |
| 239 (matched-text-buffer (generate-new-buffer " *matched-text*")) | |
| 240 lines-matched) | |
| 1069 | 241 ;; Limit search if limits were specified. |
| 242 (when end (setq limit (copy-marker end))) | |
| 243 | |
| 244 ;; Search. Stop if we are at end of buffer or outside the | |
| 245 ;; limit. | |
| 246 (while (not (or | |
| 247 (eobp) | |
| 248 (and limit (>= (point) limit)))) | |
| 249 ;; curmatch-start is first char not preserved by previous match. | |
| 250 (if (not (re-search-forward regexp limit 'move)) | |
| 251 (let ((curmatch-end limit)) | |
| 2610 | 252 (append-to-buffer matched-text-buffer curmatch-start curmatch-end) |
| 1069 | 253 (if delete (delete-region curmatch-start curmatch-end))) |
| 254 (let ((curmatch-end (save-excursion (goto-char (match-beginning 0)) | |
| 2610 | 255 (beginning-of-line) |
| 256 (point)))) | |
| 1069 | 257 ;; Now curmatch-end is first char preserved by the new match. |
| 258 (if (< curmatch-start curmatch-end) | |
| 259 (progn | |
| 2610 | 260 (append-to-buffer matched-text-buffer curmatch-start curmatch-end) |
| 1069 | 261 (if delete (delete-region curmatch-start curmatch-end)))))) |
| 262 (setq curmatch-start (save-excursion (forward-line 1) | |
| 2610 | 263 (point))) |
| 1069 | 264 ;; If the match was empty, avoid matching again at same place. |
| 265 (and (not (eobp)) (= (match-beginning 0) (match-end 0)) | |
| 266 (forward-char 1))) | |
| 267 | |
| 268 ;; If any lines were matched and KILL is non-nil, insert the | |
| 269 ;; matched lines into the kill ring. | |
| 2610 | 270 (setq matched-text (buffer-string matched-text-buffer)) |
| 1069 | 271 (if (and matched-text kill) (kill-new matched-text)) |
| 272 | |
| 273 ;; Return the number of matched lines. | |
| 2610 | 274 (setq lines-matched |
| 275 (with-current-buffer matched-text-buffer | |
| 276 (count-lines (point-min) (point-max)))) | |
| 277 (kill-buffer matched-text-buffer) | |
| 278 lines-matched)))) | |
| 1069 | 279 |
| 428 | 280 (define-function 'keep-lines 'delete-non-matching-lines) |
| 281 (defun delete-non-matching-lines (regexp) | |
| 1069 | 282 "Delete lines that do not match REGEXP, from point to the end of the |
| 283 buffer (or within the region, if it is active)." | |
| 428 | 284 (interactive (list (read-from-minibuffer |
| 285 "Keep lines (containing match for regexp): " | |
| 286 nil nil nil 'regexp-history))) | |
| 1069 | 287 (let ((beg nil) |
| 288 (end nil) | |
| 289 (count nil)) | |
| 290 (when (region-active-p) | |
| 291 (setq beg (region-beginning)) | |
| 292 (setq end (region-end))) | |
| 293 (setq count (operate-on-non-matching-lines regexp t nil beg end)) | |
| 1476 | 294 (when (interactive-p) |
| 295 (message "%i lines deleted" count)))) | |
| 1069 | 296 |
| 297 (defun kill-non-matching-lines (regexp) | |
| 298 "Delete the lines that do not match REGEXP, from point to the end of | |
| 299 the buffer (or within the region, if it is active). The deleted lines | |
| 300 are placed in the kill ring as one block of text." | |
| 301 (interactive (list (read-from-minibuffer | |
| 302 "Kill non-matching lines (regexp): " | |
| 303 nil nil nil 'regexp-history))) | |
| 304 (let ((beg nil) | |
| 305 (end nil) | |
| 306 (count nil)) | |
| 307 (when (region-active-p) | |
| 308 (setq beg (region-beginning)) | |
| 309 (setq end (region-end))) | |
| 310 (setq count (operate-on-non-matching-lines regexp t t beg end)) | |
| 1476 | 311 (when (interactive-p) |
| 312 (message "%i lines killed" count)))) | |
| 1069 | 313 |
| 314 (defun copy-non-matching-lines (regexp) | |
| 315 "Find all lines that do not match REGEXP from point to the end of the | |
| 316 buffer (or within the region, if it is active), and place them in the | |
| 317 kill ring as one block of text." | |
| 318 (interactive (list (read-from-minibuffer | |
| 319 "Copy non-matching lines (regexp): " | |
| 320 nil nil nil 'regexp-history))) | |
| 321 (let ((beg nil) | |
| 322 (end nil) | |
| 323 (count nil)) | |
| 324 (when (region-active-p) | |
| 325 (setq beg (region-beginning)) | |
| 326 (setq end (region-end))) | |
| 327 (setq count (operate-on-non-matching-lines regexp nil t beg end)) | |
| 1476 | 328 (when (interactive-p) |
| 329 (message "%i lines copied" count)))) | |
| 1069 | 330 |
| 331 (defun operate-on-matching-lines (regexp delete kill &optional beg end) | |
| 332 "Internal function used by delete-matching-lines, kill-matching-lines, | |
| 333 and copy-matching-lines. | |
| 334 | |
| 335 If DELETE is non-nil, the lines of text are deleted. It doesn't make | |
| 336 sense to set this to nil if KILL is nil -- nothing will happen. | |
| 337 | |
| 338 If KILL is non-nil, the lines of text are stored in the kill ring (as | |
| 339 one block of text). | |
| 340 | |
| 341 BEG and END, if non-nil, specify the start and end locations to work | |
| 342 within. If these are nil, point and point-max are used. | |
| 343 | |
| 344 If a match is split across lines, all the lines it lies in are deleted. | |
| 345 Applies to lines after point. | |
| 346 Returns the number of lines matched." | |
| 347 (with-search-caps-disable-folding regexp t | |
| 428 | 348 (save-excursion |
| 1069 | 349 (let ((matched-text nil) |
| 350 (curmatch-start nil) | |
| 351 (curmatch-end nil) | |
| 2610 | 352 (limit nil) |
| 353 (matched-text-buffer (generate-new-buffer " *matched-text*")) | |
| 354 lines-matched) | |
| 1069 | 355 ;; Limit search if limits were specified. |
| 356 (when beg (goto-char beg)) | |
| 357 (when end (setq limit (copy-marker end))) | |
| 358 | |
| 359 (while (and (not (eobp)) | |
| 360 (re-search-forward regexp limit t)) | |
| 361 (setq curmatch-start (save-excursion (goto-char (match-beginning 0)) | |
| 362 (beginning-of-line) | |
| 363 (point))) | |
| 364 (setq curmatch-end (progn (forward-line 1) (point))) | |
| 2610 | 365 (append-to-buffer matched-text-buffer curmatch-start curmatch-end) |
| 1069 | 366 (if delete (delete-region curmatch-start curmatch-end))) |
| 2610 | 367 (setq matched-text (buffer-string matched-text-buffer)) |
| 1069 | 368 (if (and matched-text kill) (kill-new matched-text)) |
| 369 | |
| 370 ;; Return the number of matched lines. | |
| 2610 | 371 (setq lines-matched |
| 372 (with-current-buffer matched-text-buffer | |
| 373 (count-lines (point-min) (point-max)))) | |
| 374 (kill-buffer matched-text-buffer) | |
| 375 lines-matched)))) | |
| 428 | 376 |
| 377 (define-function 'flush-lines 'delete-matching-lines) | |
| 378 (defun delete-matching-lines (regexp) | |
| 1069 | 379 "Delete the lines that match REGEXP, from point to the end of the |
| 380 buffer (or within the region, if it is active)." | |
| 428 | 381 (interactive (list (read-from-minibuffer |
| 382 "Flush lines (containing match for regexp): " | |
| 383 nil nil nil 'regexp-history))) | |
| 1069 | 384 (let ((beg nil) |
| 385 (end nil) | |
| 386 (count nil)) | |
| 387 (when (region-active-p) | |
| 388 (setq beg (region-beginning)) | |
| 389 (setq end (region-end))) | |
| 390 (setq count (operate-on-matching-lines regexp t nil beg end)) | |
| 1476 | 391 (when (interactive-p) |
| 392 (message "%i lines deleted" count)))) | |
| 1069 | 393 |
| 394 (defun kill-matching-lines (regexp) | |
| 395 "Delete the lines that match REGEXP, from point to the end of the | |
| 396 buffer (or within the region, if it is active). The deleted lines are | |
| 397 placed in the kill ring as one block of text." | |
| 398 (interactive (list (read-from-minibuffer | |
| 399 "Kill lines (containing match for regexp): " | |
| 400 nil nil nil 'regexp-history))) | |
| 401 (let ((beg nil) | |
| 402 (end nil) | |
| 403 (count nil)) | |
| 404 (when (region-active-p) | |
| 405 (setq beg (region-beginning)) | |
| 406 (setq end (region-end))) | |
| 407 (setq count (operate-on-matching-lines regexp t t beg end)) | |
| 1476 | 408 (when (interactive-p) |
| 409 (message "%i lines killed" count)))) | |
| 1069 | 410 |
| 411 (defun copy-matching-lines (regexp) | |
| 412 "Find all lines that match REGEXP from point to the end of the | |
| 413 buffer (or within the region, if it is active), and place them in the | |
| 414 kill ring as one block of text." | |
| 415 (interactive (list (read-from-minibuffer | |
| 416 "Copy lines (containing match for regexp): " | |
| 417 nil nil nil 'regexp-history))) | |
| 418 (let ((beg nil) | |
| 419 (end nil) | |
| 420 (count nil)) | |
| 421 (when (region-active-p) | |
| 422 (setq beg (region-beginning)) | |
| 423 (setq end (region-end))) | |
| 424 (setq count (operate-on-matching-lines regexp nil t beg end)) | |
| 1476 | 425 (when (interactive-p) |
| 426 (message "%i lines copied" count)))) | |
| 428 | 427 |
| 428 (define-function 'how-many 'count-matches) | |
| 429 (defun count-matches (regexp) | |
| 430 "Print number of matches for REGEXP following point." | |
| 431 (interactive (list (read-from-minibuffer | |
| 432 "How many matches for (regexp): " | |
| 433 nil nil nil 'regexp-history))) | |
| 434 (with-interactive-search-caps-disable-folding regexp t | |
| 435 (let ((count 0) opoint) | |
| 436 (save-excursion | |
| 437 (while (and (not (eobp)) | |
| 438 (progn (setq opoint (point)) | |
| 439 (re-search-forward regexp nil t))) | |
| 440 (if (= opoint (point)) | |
| 441 (forward-char 1) | |
| 442 (setq count (1+ count)))) | |
| 443 (message "%d occurrences" count))))) | |
| 444 | |
| 445 | |
| 3000 | 446 ;;; occur code moved to occur.el |
| 428 | 447 |
| 448 ;; It would be nice to use \\[...], but there is no reasonable way | |
| 449 ;; to make that display both SPC and Y. | |
| 450 (defconst query-replace-help | |
| 444 | 451 "Type Space or `y' to replace one match, Delete or `n' to skip to next, |
| 428 | 452 RET or `q' to exit, Period to replace one match and exit, |
| 453 Comma to replace but not move point immediately, | |
| 454 C-r to enter recursive edit (\\[exit-recursive-edit] to get out again), | |
| 455 C-w to delete match and recursive edit, | |
| 456 C-l to clear the frame, redisplay, and offer same replacement again, | |
| 457 ! to replace all remaining matches with no more questions, | |
| 458 ^ to move point back to previous match." | |
| 444 | 459 |
| 428 | 460 "Help message while in query-replace") |
| 461 | |
| 462 (defvar query-replace-map nil | |
| 463 "Keymap that defines the responses to questions in `query-replace'. | |
| 464 The \"bindings\" in this map are not commands; they are answers. | |
| 465 The valid answers include `act', `skip', `act-and-show', | |
| 466 `exit', `act-and-exit', `edit', `delete-and-edit', `recenter', | |
| 467 `automatic', `backup', `exit-prefix', and `help'.") | |
| 468 | |
| 469 ;; Why does it seem that ever file has a different method of doing this? | |
| 470 (if query-replace-map | |
| 471 nil | |
| 472 (let ((map (make-sparse-keymap))) | |
| 473 (set-keymap-name map 'query-replace-map) | |
| 474 (define-key map " " 'act) | |
| 475 (define-key map "\d" 'skip) | |
| 476 (define-key map [delete] 'skip) | |
| 477 (define-key map [backspace] 'skip) | |
| 478 (define-key map "y" 'act) | |
| 479 (define-key map "n" 'skip) | |
| 480 (define-key map "Y" 'act) | |
| 481 (define-key map "N" 'skip) | |
| 482 (define-key map "," 'act-and-show) | |
| 483 (define-key map [escape] 'exit) | |
| 484 (define-key map "q" 'exit) | |
| 485 (define-key map [return] 'exit) | |
| 486 (define-key map "." 'act-and-exit) | |
| 487 (define-key map "\C-r" 'edit) | |
| 488 (define-key map "\C-w" 'delete-and-edit) | |
| 489 (define-key map "\C-l" 'recenter) | |
| 490 (define-key map "!" 'automatic) | |
| 491 (define-key map "^" 'backup) | |
| 492 (define-key map [(control h)] 'help) ;; XEmacs change | |
| 493 (define-key map [f1] 'help) | |
| 494 (define-key map [help] 'help) | |
| 495 (define-key map "?" 'help) | |
| 496 (define-key map "\C-g" 'quit) | |
| 497 (define-key map "\C-]" 'quit) | |
| 498 ;FSFmacs (define-key map "\e" 'exit-prefix) | |
| 499 (define-key map [escape] 'exit-prefix) | |
| 444 | 500 |
| 428 | 501 (setq query-replace-map map))) |
| 502 | |
| 503 ;; isearch-mode is dumped, so don't autoload. | |
| 504 ;(autoload 'isearch-highlight "isearch") | |
| 505 | |
| 506 ;; XEmacs | |
| 507 (defun perform-replace-next-event (event) | |
| 442 | 508 (if search-highlight |
| 428 | 509 (let ((aborted t)) |
| 510 (unwind-protect | |
| 511 (progn | |
| 512 (if (match-beginning 0) | |
| 513 (isearch-highlight (match-beginning 0) (match-end 0))) | |
| 514 (next-command-event event) | |
| 515 (setq aborted nil)) | |
| 516 (isearch-dehighlight aborted))) | |
| 517 (next-command-event event))) | |
| 518 | |
| 519 (defun perform-replace (from-string replacements | |
| 520 query-flag regexp-flag delimited-flag | |
| 521 &optional repeat-count map) | |
| 522 "Subroutine of `query-replace'. Its complexity handles interactive queries. | |
| 523 Don't use this in your own program unless you want to query and set the mark | |
| 524 just as `query-replace' does. Instead, write a simple loop like this: | |
| 525 (while (re-search-forward \"foo[ \t]+bar\" nil t) | |
| 526 (replace-match \"foobar\" nil nil)) | |
| 527 which will run faster and probably do exactly what you want. | |
| 444 | 528 When searching for a match, this function uses |
| 529 `replace-search-function' and `replace-re-search-function'." | |
| 428 | 530 (or map (setq map query-replace-map)) |
| 531 (let* ((event (make-event)) | |
| 532 (nocasify (not (and case-fold-search case-replace | |
| 533 (string-equal from-string | |
| 534 (downcase from-string))))) | |
| 535 (literal (not regexp-flag)) | |
| 444 | 536 (search-function (if regexp-flag |
| 537 replace-re-search-function | |
| 428 | 538 replace-search-function)) |
| 539 (search-string from-string) | |
| 540 (real-match-data nil) ; the match data for the current match | |
| 541 (next-replacement nil) | |
| 542 (replacement-index 0) | |
| 543 (keep-going t) | |
| 544 (stack nil) | |
| 545 (next-rotate-count 0) | |
| 546 (replace-count 0) | |
| 547 (lastrepl nil) ;Position after last match considered. | |
| 548 ;; If non-nil, it is marker saying where in the buffer to | |
| 549 ;; stop. | |
| 550 (limit nil) | |
| 551 (match-again t) | |
|
5686
c6b1500299a7
recenter-top-bottom synced from GNU and new default for C-l
Mats Lidell <mats.lidell@cag.se>
parents:
5473
diff
changeset
|
552 (recenter-last-op nil) ; Start cycling order with initial position. |
| 428 | 553 ;; XEmacs addition |
| 554 (qr-case-fold-search | |
| 555 (if (and case-fold-search search-caps-disable-folding) | |
|
5855
0bddb59072b6
Look for cased character classes when deciding on case-fold-search, #'isearch
Aidan Kehoe <kehoea@parhasard.net>
parents:
5686
diff
changeset
|
556 (if regexp-flag |
|
0bddb59072b6
Look for cased character classes when deciding on case-fold-search, #'isearch
Aidan Kehoe <kehoea@parhasard.net>
parents:
5686
diff
changeset
|
557 (no-case-regexp-p search-string) |
|
0bddb59072b6
Look for cased character classes when deciding on case-fold-search, #'isearch
Aidan Kehoe <kehoea@parhasard.net>
parents:
5686
diff
changeset
|
558 (save-match-data |
|
0bddb59072b6
Look for cased character classes when deciding on case-fold-search, #'isearch
Aidan Kehoe <kehoea@parhasard.net>
parents:
5686
diff
changeset
|
559 (let (case-fold-search) |
|
0bddb59072b6
Look for cased character classes when deciding on case-fold-search, #'isearch
Aidan Kehoe <kehoea@parhasard.net>
parents:
5686
diff
changeset
|
560 (not (string-match "[[:upper:]]" search-string))))) |
| 428 | 561 case-fold-search)) |
| 562 (message | |
| 563 (if query-flag | |
| 564 (substitute-command-keys | |
| 565 "Query replacing %s with %s: (\\<query-replace-map>\\[help] for help) ")))) | |
| 566 ;; If the region is active, operate on region. | |
| 567 (when (region-active-p) | |
| 568 ;; Original Per Abrahamsen's code simply narrowed the region, | |
| 569 ;; thus providing a visual indication of the search boundary. | |
| 570 ;; Stallman, on the other hand, handles it like this. | |
| 571 (setq limit (copy-marker (region-end))) | |
| 572 (goto-char (region-beginning)) | |
| 573 (zmacs-deactivate-region)) | |
| 574 (if (stringp replacements) | |
| 575 (setq next-replacement replacements) | |
| 576 (or repeat-count (setq repeat-count 1))) | |
| 577 (if delimited-flag | |
| 578 (setq search-function replace-re-search-function | |
| 579 search-string (concat "\\b" | |
| 580 (if regexp-flag from-string | |
| 581 (regexp-quote from-string)) | |
| 582 "\\b"))) | |
| 583 (push-mark) | |
| 584 (undo-boundary) | |
| 585 (unwind-protect | |
| 586 ;; Loop finding occurrences that perhaps should be replaced. | |
| 587 (while (and keep-going | |
| 588 (not (eobp)) | |
| 589 (or (null limit) (< (point) limit)) | |
| 590 (let ((case-fold-search qr-case-fold-search)) | |
| 591 (funcall search-function search-string limit)) | |
| 592 ;; If the search string matches immediately after | |
| 593 ;; the previous match, but it did not match there | |
| 594 ;; before the replacement was done, ignore the match. | |
| 595 (if (or (eq lastrepl (point)) | |
| 596 (and regexp-flag | |
| 597 (eq lastrepl (match-beginning 0)) | |
| 598 (not match-again))) | |
| 599 (if (or (eobp) | |
| 600 (and limit (>= (point) limit))) | |
| 601 nil | |
| 444 | 602 ;; Don't replace the null string |
| 428 | 603 ;; right after end of previous replacement. |
| 604 (forward-char 1) | |
| 605 (let ((case-fold-search qr-case-fold-search)) | |
| 606 (funcall search-function search-string limit))) | |
| 607 t)) | |
| 608 | |
| 609 ;; Save the data associated with the real match. | |
| 610 (setq real-match-data (match-data)) | |
| 611 | |
| 612 ;; Before we make the replacement, decide whether the search string | |
| 613 ;; can match again just after this match. | |
| 614 (if regexp-flag | |
| 444 | 615 (progn |
| 428 | 616 (setq match-again (looking-at search-string)) |
| 617 ;; XEmacs addition | |
| 618 (store-match-data real-match-data))) | |
| 619 ;; If time for a change, advance to next replacement string. | |
| 620 (if (and (listp replacements) | |
| 621 (= next-rotate-count replace-count)) | |
| 622 (progn | |
| 623 (setq next-rotate-count | |
| 624 (+ next-rotate-count repeat-count)) | |
| 625 (setq next-replacement (nth replacement-index replacements)) | |
| 626 (setq replacement-index (% (1+ replacement-index) (length replacements))))) | |
| 627 (if (not query-flag) | |
| 628 (progn | |
| 629 (store-match-data real-match-data) | |
| 630 (replace-match next-replacement nocasify literal) | |
| 631 (setq replace-count (1+ replace-count))) | |
| 632 (undo-boundary) | |
| 633 (let ((help-form | |
| 634 '(concat (format "Query replacing %s%s with %s.\n\n" | |
| 635 (if regexp-flag (gettext "regexp ") "") | |
| 636 from-string next-replacement) | |
| 637 (substitute-command-keys query-replace-help))) | |
| 638 done replaced def) | |
| 639 ;; Loop reading commands until one of them sets done, | |
| 640 ;; which means it has finished handling this occurrence. | |
| 641 (while (not done) | |
| 642 ;; Don't fill up the message log | |
| 643 ;; with a bunch of identical messages. | |
| 644 ;; XEmacs change | |
| 645 (display-message 'prompt | |
| 646 (format message from-string next-replacement)) | |
| 647 (perform-replace-next-event event) | |
| 648 (setq def (lookup-key map (vector event))) | |
| 649 ;; Restore the match data while we process the command. | |
| 650 (store-match-data real-match-data) | |
| 651 (cond ((eq def 'help) | |
| 652 (with-output-to-temp-buffer (gettext "*Help*") | |
| 653 (princ (concat | |
| 654 (format "Query replacing %s%s with %s.\n\n" | |
| 655 (if regexp-flag "regexp " "") | |
| 656 from-string next-replacement) | |
| 657 (substitute-command-keys | |
| 658 query-replace-help))) | |
| 659 (save-excursion | |
| 660 (set-buffer standard-output) | |
| 661 (help-mode)))) | |
| 662 ((eq def 'exit) | |
| 663 (setq keep-going nil) | |
| 664 (setq done t)) | |
| 665 ((eq def 'backup) | |
| 666 (if stack | |
| 667 (let ((elt (car stack))) | |
| 668 (goto-char (car elt)) | |
| 669 (setq replaced (eq t (cdr elt))) | |
| 670 (or replaced | |
| 671 (store-match-data (cdr elt))) | |
| 672 (setq stack (cdr stack))) | |
| 673 (message "No previous match") | |
| 674 (ding 'no-terminate) | |
| 675 (sit-for 1))) | |
| 676 ((eq def 'act) | |
| 677 (or replaced | |
| 678 (replace-match next-replacement nocasify literal)) | |
| 679 (setq done t replaced t)) | |
| 680 ((eq def 'act-and-exit) | |
| 681 (or replaced | |
| 682 (replace-match next-replacement nocasify literal)) | |
| 683 (setq keep-going nil) | |
| 684 (setq done t replaced t)) | |
| 685 ((eq def 'act-and-show) | |
| 686 (if (not replaced) | |
| 687 (progn | |
| 688 (replace-match next-replacement nocasify literal) | |
| 689 (store-match-data nil) | |
| 690 (setq replaced t)))) | |
| 691 ((eq def 'automatic) | |
| 692 (or replaced | |
| 693 (replace-match next-replacement nocasify literal)) | |
| 694 (setq done t query-flag nil replaced t)) | |
| 695 ((eq def 'skip) | |
| 696 (setq done t)) | |
| 697 ((eq def 'recenter) | |
|
5686
c6b1500299a7
recenter-top-bottom synced from GNU and new default for C-l
Mats Lidell <mats.lidell@cag.se>
parents:
5473
diff
changeset
|
698 ;; `this-command' has the value `query-replace', |
|
c6b1500299a7
recenter-top-bottom synced from GNU and new default for C-l
Mats Lidell <mats.lidell@cag.se>
parents:
5473
diff
changeset
|
699 ;; so we need to bind it to `recenter-top-bottom' |
|
c6b1500299a7
recenter-top-bottom synced from GNU and new default for C-l
Mats Lidell <mats.lidell@cag.se>
parents:
5473
diff
changeset
|
700 ;; to allow it to detect a sequence of `C-l'. |
|
c6b1500299a7
recenter-top-bottom synced from GNU and new default for C-l
Mats Lidell <mats.lidell@cag.se>
parents:
5473
diff
changeset
|
701 (let ((this-command 'recenter-top-bottom) |
|
c6b1500299a7
recenter-top-bottom synced from GNU and new default for C-l
Mats Lidell <mats.lidell@cag.se>
parents:
5473
diff
changeset
|
702 (last-command 'recenter-top-bottom)) |
|
c6b1500299a7
recenter-top-bottom synced from GNU and new default for C-l
Mats Lidell <mats.lidell@cag.se>
parents:
5473
diff
changeset
|
703 (recenter-top-bottom))) |
| 428 | 704 ((eq def 'edit) |
| 705 (store-match-data | |
| 706 (prog1 (match-data) | |
| 707 (save-excursion (recursive-edit)))) | |
| 708 ;; Before we make the replacement, | |
| 709 ;; decide whether the search string | |
| 710 ;; can match again just after this match. | |
| 711 (if regexp-flag | |
| 712 (setq match-again (looking-at search-string)))) | |
| 713 ((eq def 'delete-and-edit) | |
| 714 (delete-region (match-beginning 0) (match-end 0)) | |
| 715 (store-match-data (prog1 (match-data) | |
| 716 (save-excursion (recursive-edit)))) | |
| 717 (setq replaced t)) | |
| 718 ;; Note: we do not need to treat `exit-prefix' | |
| 719 ;; specially here, since we reread | |
| 720 ;; any unrecognized character. | |
| 721 (t | |
| 722 (setq this-command 'mode-exited) | |
| 723 (setq keep-going nil) | |
| 724 (setq unread-command-events | |
| 725 (cons event unread-command-events)) | |
| 726 (setq done t)))) | |
|
5686
c6b1500299a7
recenter-top-bottom synced from GNU and new default for C-l
Mats Lidell <mats.lidell@cag.se>
parents:
5473
diff
changeset
|
727 (unless (eq def 'recenter) |
|
c6b1500299a7
recenter-top-bottom synced from GNU and new default for C-l
Mats Lidell <mats.lidell@cag.se>
parents:
5473
diff
changeset
|
728 ;; Reset recenter cycling order to initial position. |
|
c6b1500299a7
recenter-top-bottom synced from GNU and new default for C-l
Mats Lidell <mats.lidell@cag.se>
parents:
5473
diff
changeset
|
729 (setq recenter-last-op nil)) |
| 428 | 730 ;; Record previous position for ^ when we move on. |
| 731 ;; Change markers to numbers in the match data | |
| 732 ;; since lots of markers slow down editing. | |
| 733 (setq stack | |
| 734 (cons (cons (point) | |
| 735 (or replaced | |
| 736 (match-data t))) | |
| 737 stack)) | |
| 738 (if replaced (setq replace-count (1+ replace-count))))) | |
| 739 (setq lastrepl (point))) | |
| 740 ;; Useless in XEmacs. We handle (de)highlighting through | |
| 741 ;; perform-replace-next-event. | |
| 742 ;(replace-dehighlight) | |
| 743 ) | |
| 744 (or unread-command-events | |
| 745 (message "Replaced %d occurrence%s" | |
| 746 replace-count | |
| 747 (if (= replace-count 1) "" "s"))) | |
| 748 (and keep-going stack))) | |
| 749 | |
| 750 ;; FSFmacs code: someone should port it. | |
| 751 | |
| 752 ;(defvar query-replace-highlight nil | |
| 753 ; "*Non-nil means to highlight words during query replacement.") | |
| 754 | |
| 755 ;(defvar replace-overlay nil) | |
| 756 | |
| 757 ;(defun replace-dehighlight () | |
| 758 ; (and replace-overlay | |
| 759 ; (progn | |
| 760 ; (delete-overlay replace-overlay) | |
| 761 ; (setq replace-overlay nil)))) | |
| 762 | |
| 763 ;(defun replace-highlight (start end) | |
| 764 ; (and query-replace-highlight | |
| 765 ; (progn | |
| 766 ; (or replace-overlay | |
| 767 ; (progn | |
| 768 ; (setq replace-overlay (make-overlay start end)) | |
| 769 ; (overlay-put replace-overlay 'face | |
| 770 ; (if (internal-find-face 'query-replace) | |
| 771 ; 'query-replace 'region)))) | |
| 772 ; (move-overlay replace-overlay start end (current-buffer))))) | |
| 773 | |
| 774 ;;; replace.el ends here |