aboutsummaryrefslogtreecommitdiffstats
path: root/lisp/replace.el
diff options
context:
space:
mode:
authorJoakim Verona2013-06-12 12:32:25 +0200
committerJoakim Verona2013-06-12 12:32:25 +0200
commite6fa6da6899bf1b4877b96c450eae3934085d560 (patch)
tree48e6fda463d24a792ec8428fb8044a250ee2ff82 /lisp/replace.el
parent4f0994366d33f8f76db4662cc126720866df3461 (diff)
parent84d6f46535554f9f51aae3314313112e8d755c65 (diff)
downloademacs-e6fa6da6899bf1b4877b96c450eae3934085d560.tar.gz
emacs-e6fa6da6899bf1b4877b96c450eae3934085d560.zip
Merge branch 'trunk' into xwidget
Conflicts: src/Makefile.in src/keyboard.c src/termhooks.h
Diffstat (limited to 'lisp/replace.el')
-rw-r--r--lisp/replace.el166
1 files changed, 114 insertions, 52 deletions
diff --git a/lisp/replace.el b/lisp/replace.el
index 86956a614cd..24cfccf60fd 100644
--- a/lisp/replace.el
+++ b/lisp/replace.el
@@ -246,10 +246,14 @@ Matching is independent of case if `case-fold-search' is non-nil and
246FROM-STRING has no uppercase letters. Replacement transfers the case 246FROM-STRING has no uppercase letters. Replacement transfers the case
247pattern of the old text to the new text, if `case-replace' and 247pattern of the old text to the new text, if `case-replace' and
248`case-fold-search' are non-nil and FROM-STRING has no uppercase 248`case-fold-search' are non-nil and FROM-STRING has no uppercase
249letters. \(Transferring the case pattern means that if the old text 249letters. (Transferring the case pattern means that if the old text
250matched is all caps, or capitalized, then its replacement is upcased 250matched is all caps, or capitalized, then its replacement is upcased
251or capitalized.) 251or capitalized.)
252 252
253Ignore read-only matches if `query-replace-skip-read-only' is non-nil,
254ignore hidden matches if `search-invisible' is nil, and ignore more
255matches using a non-nil `isearch-filter-predicates'.
256
253If `replace-lax-whitespace' is non-nil, a space or spaces in the string 257If `replace-lax-whitespace' is non-nil, a space or spaces in the string
254to be replaced will match a sequence of whitespace chars defined by the 258to be replaced will match a sequence of whitespace chars defined by the
255regexp in `search-whitespace-regexp'. 259regexp in `search-whitespace-regexp'.
@@ -300,6 +304,10 @@ pattern of the old text to the new text, if `case-replace' and
300all caps, or capitalized, then its replacement is upcased or 304all caps, or capitalized, then its replacement is upcased or
301capitalized.) 305capitalized.)
302 306
307Ignore read-only matches if `query-replace-skip-read-only' is non-nil,
308ignore hidden matches if `search-invisible' is nil, and ignore more
309matches using a non-nil `isearch-filter-predicates'.
310
303If `replace-regexp-lax-whitespace' is non-nil, a space or spaces in the regexp 311If `replace-regexp-lax-whitespace' is non-nil, a space or spaces in the regexp
304to be replaced will match a sequence of whitespace chars defined by the 312to be replaced will match a sequence of whitespace chars defined by the
305regexp in `search-whitespace-regexp'. 313regexp in `search-whitespace-regexp'.
@@ -380,6 +388,10 @@ that reads REGEXP.
380Preserves case in each replacement if `case-replace' and `case-fold-search' 388Preserves case in each replacement if `case-replace' and `case-fold-search'
381are non-nil and REGEXP has no uppercase letters. 389are non-nil and REGEXP has no uppercase letters.
382 390
391Ignore read-only matches if `query-replace-skip-read-only' is non-nil,
392ignore hidden matches if `search-invisible' is nil, and ignore more
393matches using a non-nil `isearch-filter-predicates'.
394
383If `replace-regexp-lax-whitespace' is non-nil, a space or spaces in the regexp 395If `replace-regexp-lax-whitespace' is non-nil, a space or spaces in the regexp
384to be replaced will match a sequence of whitespace chars defined by the 396to be replaced will match a sequence of whitespace chars defined by the
385regexp in `search-whitespace-regexp'. 397regexp in `search-whitespace-regexp'.
@@ -470,6 +482,10 @@ are non-nil and FROM-STRING has no uppercase letters.
470\(Preserving case means that if the string matched is all caps, or capitalized, 482\(Preserving case means that if the string matched is all caps, or capitalized,
471then its replacement is upcased or capitalized.) 483then its replacement is upcased or capitalized.)
472 484
485Ignore read-only matches if `query-replace-skip-read-only' is non-nil,
486ignore hidden matches if `search-invisible' is nil, and ignore more
487matches using a non-nil `isearch-filter-predicates'.
488
473If `replace-lax-whitespace' is non-nil, a space or spaces in the string 489If `replace-lax-whitespace' is non-nil, a space or spaces in the string
474to be replaced will match a sequence of whitespace chars defined by the 490to be replaced will match a sequence of whitespace chars defined by the
475regexp in `search-whitespace-regexp'. 491regexp in `search-whitespace-regexp'.
@@ -512,6 +528,10 @@ and TO-STRING is also null.)"
512Preserve case in each match if `case-replace' and `case-fold-search' 528Preserve case in each match if `case-replace' and `case-fold-search'
513are non-nil and REGEXP has no uppercase letters. 529are non-nil and REGEXP has no uppercase letters.
514 530
531Ignore read-only matches if `query-replace-skip-read-only' is non-nil,
532ignore hidden matches if `search-invisible' is nil, and ignore more
533matches using a non-nil `isearch-filter-predicates'.
534
515If `replace-regexp-lax-whitespace' is non-nil, a space or spaces in the regexp 535If `replace-regexp-lax-whitespace' is non-nil, a space or spaces in the regexp
516to be replaced will match a sequence of whitespace chars defined by the 536to be replaced will match a sequence of whitespace chars defined by the
517regexp in `search-whitespace-regexp'. 537regexp in `search-whitespace-regexp'.
@@ -1155,8 +1175,8 @@ is called only during interactive use.
1155 1175
1156For example, to check for occurrence of symbol at point use 1176For example, to check for occurrence of symbol at point use
1157 1177
1158 \(setq occur-read-regexp-defaults-function 1178 (setq occur-read-regexp-defaults-function
1159 'find-tag-default-as-regexp\).") 1179 'find-tag-default-as-regexp).")
1160 1180
1161(defun occur-read-regexp-defaults () 1181(defun occur-read-regexp-defaults ()
1162 "Return the latest regexp from `regexp-history'. 1182 "Return the latest regexp from `regexp-history'.
@@ -1369,16 +1389,18 @@ See also `multi-occur'."
1369(defun occur-engine (regexp buffers out-buf nlines case-fold 1389(defun occur-engine (regexp buffers out-buf nlines case-fold
1370 title-face prefix-face match-face keep-props) 1390 title-face prefix-face match-face keep-props)
1371 (with-current-buffer out-buf 1391 (with-current-buffer out-buf
1372 (let ((globalcount 0) 1392 (let ((global-lines 0) ;; total count of matching lines
1393 (global-matches 0) ;; total count of matches
1373 (coding nil) 1394 (coding nil)
1374 (case-fold-search case-fold)) 1395 (case-fold-search case-fold))
1375 ;; Map over all the buffers 1396 ;; Map over all the buffers
1376 (dolist (buf buffers) 1397 (dolist (buf buffers)
1377 (when (buffer-live-p buf) 1398 (when (buffer-live-p buf)
1378 (let ((matches 0) ;; count of matched lines 1399 (let ((lines 0) ;; count of matching lines
1379 (lines 1) ;; line count 1400 (matches 0) ;; count of matches
1380 (prev-after-lines nil) ;; context lines of prev match 1401 (curr-line 1) ;; line count
1381 (prev-lines nil) ;; line number of prev match endpt 1402 (prev-line nil) ;; line number of prev match endpt
1403 (prev-after-lines nil) ;; context lines of prev match
1382 (matchbeg 0) 1404 (matchbeg 0)
1383 (origpt nil) 1405 (origpt nil)
1384 (begpt nil) 1406 (begpt nil)
@@ -1399,7 +1421,7 @@ See also `multi-occur'."
1399 (while (not (eobp)) 1421 (while (not (eobp))
1400 (setq origpt (point)) 1422 (setq origpt (point))
1401 (when (setq endpt (re-search-forward regexp nil t)) 1423 (when (setq endpt (re-search-forward regexp nil t))
1402 (setq matches (1+ matches)) ;; increment match count 1424 (setq lines (1+ lines)) ;; increment matching lines count
1403 (setq matchbeg (match-beginning 0)) 1425 (setq matchbeg (match-beginning 0))
1404 ;; Get beginning of first match line and end of the last. 1426 ;; Get beginning of first match line and end of the last.
1405 (save-excursion 1427 (save-excursion
@@ -1408,7 +1430,7 @@ See also `multi-occur'."
1408 (goto-char endpt) 1430 (goto-char endpt)
1409 (setq endpt (line-end-position))) 1431 (setq endpt (line-end-position)))
1410 ;; Sum line numbers up to the first match line. 1432 ;; Sum line numbers up to the first match line.
1411 (setq lines (+ lines (count-lines origpt begpt))) 1433 (setq curr-line (+ curr-line (count-lines origpt begpt)))
1412 (setq marker (make-marker)) 1434 (setq marker (make-marker))
1413 (set-marker marker matchbeg) 1435 (set-marker marker matchbeg)
1414 (setq curstring (occur-engine-line begpt endpt keep-props)) 1436 (setq curstring (occur-engine-line begpt endpt keep-props))
@@ -1417,6 +1439,7 @@ See also `multi-occur'."
1417 (start 0)) 1439 (start 0))
1418 (while (and (< start len) 1440 (while (and (< start len)
1419 (string-match regexp curstring start)) 1441 (string-match regexp curstring start))
1442 (setq matches (1+ matches))
1420 (add-text-properties 1443 (add-text-properties
1421 (match-beginning 0) (match-end 0) 1444 (match-beginning 0) (match-end 0)
1422 (append 1445 (append
@@ -1430,7 +1453,7 @@ See also `multi-occur'."
1430 ;; Generate the string to insert for this match 1453 ;; Generate the string to insert for this match
1431 (let* ((match-prefix 1454 (let* ((match-prefix
1432 ;; Using 7 digits aligns tabs properly. 1455 ;; Using 7 digits aligns tabs properly.
1433 (apply #'propertize (format "%7d:" lines) 1456 (apply #'propertize (format "%7d:" curr-line)
1434 (append 1457 (append
1435 (when prefix-face 1458 (when prefix-face
1436 `(font-lock-face ,prefix-face)) 1459 `(font-lock-face ,prefix-face))
@@ -1470,7 +1493,7 @@ See also `multi-occur'."
1470 ;; The complex multi-line display style. 1493 ;; The complex multi-line display style.
1471 (setq ret (occur-context-lines 1494 (setq ret (occur-context-lines
1472 out-line nlines keep-props begpt endpt 1495 out-line nlines keep-props begpt endpt
1473 lines prev-lines prev-after-lines 1496 curr-line prev-line prev-after-lines
1474 prefix-face)) 1497 prefix-face))
1475 ;; Set first elem of the returned list to `data', 1498 ;; Set first elem of the returned list to `data',
1476 ;; and the second elem to `prev-after-lines'. 1499 ;; and the second elem to `prev-after-lines'.
@@ -1483,28 +1506,34 @@ See also `multi-occur'."
1483 (if endpt 1506 (if endpt
1484 (progn 1507 (progn
1485 ;; Sum line numbers between first and last match lines. 1508 ;; Sum line numbers between first and last match lines.
1486 (setq lines (+ lines (count-lines begpt endpt) 1509 (setq curr-line (+ curr-line (count-lines begpt endpt)
1487 ;; Add 1 for empty last match line since 1510 ;; Add 1 for empty last match line since
1488 ;; count-lines returns 1 line less. 1511 ;; count-lines returns 1 line less.
1489 (if (and (bolp) (eolp)) 1 0))) 1512 (if (and (bolp) (eolp)) 1 0)))
1490 ;; On to the next match... 1513 ;; On to the next match...
1491 (forward-line 1)) 1514 (forward-line 1))
1492 (goto-char (point-max))) 1515 (goto-char (point-max)))
1493 (setq prev-lines (1- lines))) 1516 (setq prev-line (1- curr-line)))
1494 ;; Flush remaining context after-lines. 1517 ;; Flush remaining context after-lines.
1495 (when prev-after-lines 1518 (when prev-after-lines
1496 (with-current-buffer out-buf 1519 (with-current-buffer out-buf
1497 (insert (apply #'concat (occur-engine-add-prefix 1520 (insert (apply #'concat (occur-engine-add-prefix
1498 prev-after-lines prefix-face))))))) 1521 prev-after-lines prefix-face)))))))
1499 (when (not (zerop matches)) ;; is the count zero? 1522 (when (not (zerop lines)) ;; is the count zero?
1500 (setq globalcount (+ globalcount matches)) 1523 (setq global-lines (+ global-lines lines)
1524 global-matches (+ global-matches matches))
1501 (with-current-buffer out-buf 1525 (with-current-buffer out-buf
1502 (goto-char headerpt) 1526 (goto-char headerpt)
1503 (let ((beg (point)) 1527 (let ((beg (point))
1504 end) 1528 end)
1505 (insert (propertize 1529 (insert (propertize
1506 (format "%d match%s%s in buffer: %s\n" 1530 (format "%d match%s%s%s in buffer: %s\n"
1507 matches (if (= matches 1) "" "es") 1531 matches (if (= matches 1) "" "es")
1532 ;; Don't display the same number of lines
1533 ;; and matches in case of 1 match per line.
1534 (if (= lines matches)
1535 "" (format " in %d line%s"
1536 lines (if (= lines 1) "" "s")))
1508 ;; Don't display regexp for multi-buffer. 1537 ;; Don't display regexp for multi-buffer.
1509 (if (> (length buffers) 1) 1538 (if (> (length buffers) 1)
1510 "" (format " for \"%s\"" 1539 "" (format " for \"%s\""
@@ -1519,12 +1548,17 @@ See also `multi-occur'."
1519 `(occur-title ,buf)))) 1548 `(occur-title ,buf))))
1520 (goto-char (point-min))))))) 1549 (goto-char (point-min)))))))
1521 ;; Display total match count and regexp for multi-buffer. 1550 ;; Display total match count and regexp for multi-buffer.
1522 (when (and (not (zerop globalcount)) (> (length buffers) 1)) 1551 (when (and (not (zerop global-lines)) (> (length buffers) 1))
1523 (goto-char (point-min)) 1552 (goto-char (point-min))
1524 (let ((beg (point)) 1553 (let ((beg (point))
1525 end) 1554 end)
1526 (insert (format "%d match%s total for \"%s\":\n" 1555 (insert (format "%d match%s%s total for \"%s\":\n"
1527 globalcount (if (= globalcount 1) "" "es") 1556 global-matches (if (= global-matches 1) "" "es")
1557 ;; Don't display the same number of lines
1558 ;; and matches in case of 1 match per line.
1559 (if (= global-lines global-matches)
1560 "" (format " in %d line%s"
1561 global-lines (if (= global-lines 1) "" "s")))
1528 (query-replace-descr regexp))) 1562 (query-replace-descr regexp)))
1529 (setq end (point)) 1563 (setq end (point))
1530 (add-text-properties beg end (when title-face 1564 (add-text-properties beg end (when title-face
@@ -1536,7 +1570,7 @@ See also `multi-occur'."
1536 ;; buffer. 1570 ;; buffer.
1537 (set-buffer-file-coding-system coding)) 1571 (set-buffer-file-coding-system coding))
1538 ;; Return the number of matches 1572 ;; Return the number of matches
1539 globalcount))) 1573 global-matches)))
1540 1574
1541(defun occur-engine-line (beg end &optional keep-props) 1575(defun occur-engine-line (beg end &optional keep-props)
1542 (if (and keep-props (if (boundp 'jit-lock-mode) jit-lock-mode) 1576 (if (and keep-props (if (boundp 'jit-lock-mode) jit-lock-mode)
@@ -1579,13 +1613,13 @@ See also `multi-occur'."
1579;; Generate context display for occur. 1613;; Generate context display for occur.
1580;; OUT-LINE is the line where the match is. 1614;; OUT-LINE is the line where the match is.
1581;; NLINES and KEEP-PROPS are args to occur-engine. 1615;; NLINES and KEEP-PROPS are args to occur-engine.
1582;; LINES is line count of the current match, 1616;; CURR-LINE is line count of the current match,
1583;; PREV-LINES is line count of the previous match, 1617;; PREV-LINE is line count of the previous match,
1584;; PREV-AFTER-LINES is a list of after-context lines of the previous match. 1618;; PREV-AFTER-LINES is a list of after-context lines of the previous match.
1585;; Generate a list of lines, add prefixes to all but OUT-LINE, 1619;; Generate a list of lines, add prefixes to all but OUT-LINE,
1586;; then concatenate them all together. 1620;; then concatenate them all together.
1587(defun occur-context-lines (out-line nlines keep-props begpt endpt 1621(defun occur-context-lines (out-line nlines keep-props begpt endpt
1588 lines prev-lines prev-after-lines 1622 curr-line prev-line prev-after-lines
1589 &optional prefix-face) 1623 &optional prefix-face)
1590 ;; Find after- and before-context lines of the current match. 1624 ;; Find after- and before-context lines of the current match.
1591 (let ((before-lines 1625 (let ((before-lines
@@ -1601,22 +1635,22 @@ See also `multi-occur'."
1601 1635
1602 (when prev-after-lines 1636 (when prev-after-lines
1603 ;; Don't overlap prev after-lines with current before-lines. 1637 ;; Don't overlap prev after-lines with current before-lines.
1604 (if (>= (+ prev-lines (length prev-after-lines)) 1638 (if (>= (+ prev-line (length prev-after-lines))
1605 (- lines (length before-lines))) 1639 (- curr-line (length before-lines)))
1606 (setq prev-after-lines 1640 (setq prev-after-lines
1607 (butlast prev-after-lines 1641 (butlast prev-after-lines
1608 (- (length prev-after-lines) 1642 (- (length prev-after-lines)
1609 (- lines prev-lines (length before-lines) 1)))) 1643 (- curr-line prev-line (length before-lines) 1))))
1610 ;; Separate non-overlapping context lines with a dashed line. 1644 ;; Separate non-overlapping context lines with a dashed line.
1611 (setq separator "-------\n"))) 1645 (setq separator "-------\n")))
1612 1646
1613 (when prev-lines 1647 (when prev-line
1614 ;; Don't overlap current before-lines with previous match line. 1648 ;; Don't overlap current before-lines with previous match line.
1615 (if (<= (- lines (length before-lines)) 1649 (if (<= (- curr-line (length before-lines))
1616 prev-lines) 1650 prev-line)
1617 (setq before-lines 1651 (setq before-lines
1618 (nthcdr (- (length before-lines) 1652 (nthcdr (- (length before-lines)
1619 (- lines prev-lines 1)) 1653 (- curr-line prev-line 1))
1620 before-lines)) 1654 before-lines))
1621 ;; Separate non-overlapping before-context lines. 1655 ;; Separate non-overlapping before-context lines.
1622 (unless (> nlines 0) 1656 (unless (> nlines 0)
@@ -1840,7 +1874,7 @@ It is called with three arguments, as if it were
1840 1874
1841(defun replace-search (search-string limit regexp-flag delimited-flag 1875(defun replace-search (search-string limit regexp-flag delimited-flag
1842 case-fold-search) 1876 case-fold-search)
1843 "Search for the next occurence of SEARCH-STRING to replace." 1877 "Search for the next occurrence of SEARCH-STRING to replace."
1844 ;; Let-bind global isearch-* variables to values used 1878 ;; Let-bind global isearch-* variables to values used
1845 ;; to search the next replacement. These let-bindings 1879 ;; to search the next replacement. These let-bindings
1846 ;; should be effective both at the time of calling 1880 ;; should be effective both at the time of calling
@@ -1934,6 +1968,9 @@ make, or the user didn't cancel the call."
1934 (keep-going t) 1968 (keep-going t)
1935 (stack nil) 1969 (stack nil)
1936 (replace-count 0) 1970 (replace-count 0)
1971 (skip-read-only-count 0)
1972 (skip-filtered-count 0)
1973 (skip-invisible-count 0)
1937 (nonempty-match nil) 1974 (nonempty-match nil)
1938 (multi-buffer nil) 1975 (multi-buffer nil)
1939 (recenter-last-op nil) ; Start cycling order with initial position. 1976 (recenter-last-op nil) ; Start cycling order with initial position.
@@ -2042,20 +2079,27 @@ make, or the user didn't cancel the call."
2042 (and (/= (nth 0 match) (nth 1 match)) 2079 (and (/= (nth 0 match) (nth 1 match))
2043 match)))))) 2080 match))))))
2044 2081
2045 ;; Optionally ignore matches that have a read-only property. 2082 (cond
2046 (when (and (or (not query-replace-skip-read-only) 2083 ;; Optionally ignore matches that have a read-only property.
2047 (not (text-property-not-all 2084 ((not (or (not query-replace-skip-read-only)
2048 (nth 0 real-match-data) (nth 1 real-match-data) 2085 (not (text-property-not-all
2049 'read-only nil))) 2086 (nth 0 real-match-data) (nth 1 real-match-data)
2050 ;; Optionally filter out matches. 2087 'read-only nil))))
2051 (run-hook-with-args-until-failure 2088 (setq skip-read-only-count (1+ skip-read-only-count)))
2052 'isearch-filter-predicates 2089 ;; Optionally filter out matches.
2053 (nth 0 real-match-data) (nth 1 real-match-data)) 2090 ((not (run-hook-with-args-until-failure
2054 ;; Optionally ignore invisible matches. 2091 'isearch-filter-predicates
2055 (or (eq search-invisible t) 2092 (nth 0 real-match-data) (nth 1 real-match-data)))
2056 (not (isearch-range-invisible 2093 (setq skip-filtered-count (1+ skip-filtered-count)))
2057 (nth 0 real-match-data) (nth 1 real-match-data))))) 2094 ;; Optionally ignore invisible matches.
2058 2095 ((not (or (eq search-invisible t)
2096 ;; Don't open overlays for automatic replacements.
2097 (and (not query-flag) search-invisible)
2098 ;; Open hidden overlays for interactive replacements.
2099 (not (isearch-range-invisible
2100 (nth 0 real-match-data) (nth 1 real-match-data)))))
2101 (setq skip-invisible-count (1+ skip-invisible-count)))
2102 (t
2059 ;; Calculate the replacement string, if necessary. 2103 ;; Calculate the replacement string, if necessary.
2060 (when replacements 2104 (when replacements
2061 (set-match-data real-match-data) 2105 (set-match-data real-match-data)
@@ -2260,13 +2304,31 @@ make, or the user didn't cancel the call."
2260 (match-end 0) 2304 (match-end 0)
2261 (current-buffer)) 2305 (current-buffer))
2262 (match-data t))) 2306 (match-data t)))
2263 stack))))) 2307 stack))))))
2264 2308
2265 (replace-dehighlight)) 2309 (replace-dehighlight))
2266 (or unread-command-events 2310 (or unread-command-events
2267 (message "Replaced %d occurrence%s" 2311 (message "Replaced %d occurrence%s%s"
2268 replace-count 2312 replace-count
2269 (if (= replace-count 1) "" "s"))) 2313 (if (= replace-count 1) "" "s")
2314 (if (> (+ skip-read-only-count
2315 skip-filtered-count
2316 skip-invisible-count) 0)
2317 (format " (skipped %s)"
2318 (mapconcat
2319 'identity
2320 (delq nil (list
2321 (if (> skip-read-only-count 0)
2322 (format "%s read-only"
2323 skip-read-only-count))
2324 (if (> skip-invisible-count 0)
2325 (format "%s invisible"
2326 skip-invisible-count))
2327 (if (> skip-filtered-count 0)
2328 (format "%s filtered out"
2329 skip-filtered-count))))
2330 ", "))
2331 "")))
2270 (or (and keep-going stack) multi-buffer))) 2332 (or (and keep-going stack) multi-buffer)))
2271 2333
2272;;; replace.el ends here 2334;;; replace.el ends here