diff options
| author | Eli Zaretskii | 2018-10-09 17:49:59 +0300 |
|---|---|---|
| committer | Eli Zaretskii | 2018-10-09 17:49:59 +0300 |
| commit | cbb674287878877abe38065d0cc5fa28b7fc577d (patch) | |
| tree | 0f7b9285e33f2dff9ebbd7548ae9907b71c856fe /lisp | |
| parent | cd7caee630f9425a1a16e4da31e892a2ec29ac09 (diff) | |
| parent | 5d1fbe25d48ba3ab663afcfe8ee8d5236e8f4cb5 (diff) | |
| download | emacs-cbb674287878877abe38065d0cc5fa28b7fc577d.tar.gz emacs-cbb674287878877abe38065d0cc5fa28b7fc577d.zip | |
Merge branch 'master' of git.savannah.gnu.org:/srv/git/emacs
Diffstat (limited to 'lisp')
| -rw-r--r-- | lisp/replace.el | 190 |
1 files changed, 91 insertions, 99 deletions
diff --git a/lisp/replace.el b/lisp/replace.el index 04e5d4273e0..7d313842c04 100644 --- a/lisp/replace.el +++ b/lisp/replace.el | |||
| @@ -1099,10 +1099,9 @@ a previously found match." | |||
| 1099 | map) | 1099 | map) |
| 1100 | "Keymap for `occur-mode'.") | 1100 | "Keymap for `occur-mode'.") |
| 1101 | 1101 | ||
| 1102 | (defvar occur-revert-arguments nil | 1102 | (defvar-local occur-revert-arguments nil |
| 1103 | "Arguments to pass to `occur-1' to revert an Occur mode buffer. | 1103 | "Arguments to pass to `occur-1' to revert an Occur mode buffer. |
| 1104 | See `occur-revert-function'.") | 1104 | See `occur-revert-function'.") |
| 1105 | (make-variable-buffer-local 'occur-revert-arguments) | ||
| 1106 | (put 'occur-revert-arguments 'permanent-local t) | 1105 | (put 'occur-revert-arguments 'permanent-local t) |
| 1107 | 1106 | ||
| 1108 | (defcustom occur-mode-hook '(turn-on-font-lock) | 1107 | (defcustom occur-mode-hook '(turn-on-font-lock) |
| @@ -1130,8 +1129,8 @@ for this is to reveal context in an outline-mode when the occurrence is hidden." | |||
| 1130 | Alternatively, click \\[occur-mode-mouse-goto] on an item to go to it. | 1129 | Alternatively, click \\[occur-mode-mouse-goto] on an item to go to it. |
| 1131 | 1130 | ||
| 1132 | \\{occur-mode-map}" | 1131 | \\{occur-mode-map}" |
| 1133 | (set (make-local-variable 'revert-buffer-function) 'occur-revert-function) | 1132 | (setq-local revert-buffer-function #'occur-revert-function) |
| 1134 | (setq next-error-function 'occur-next-error)) | 1133 | (setq next-error-function #'occur-next-error)) |
| 1135 | 1134 | ||
| 1136 | 1135 | ||
| 1137 | ;;; Occur Edit mode | 1136 | ;;; Occur Edit mode |
| @@ -1154,7 +1153,7 @@ the originating buffer. | |||
| 1154 | 1153 | ||
| 1155 | To return to ordinary Occur mode, use \\[occur-cease-edit]." | 1154 | To return to ordinary Occur mode, use \\[occur-cease-edit]." |
| 1156 | (setq buffer-read-only nil) | 1155 | (setq buffer-read-only nil) |
| 1157 | (add-hook 'after-change-functions 'occur-after-change-function nil t) | 1156 | (add-hook 'after-change-functions #'occur-after-change-function nil t) |
| 1158 | (message (substitute-command-keys | 1157 | (message (substitute-command-keys |
| 1159 | "Editing: Type \\[occur-cease-edit] to return to Occur mode."))) | 1158 | "Editing: Type \\[occur-cease-edit] to return to Occur mode."))) |
| 1160 | 1159 | ||
| @@ -1206,19 +1205,6 @@ To return to ordinary Occur mode, use \\[occur-cease-edit]." | |||
| 1206 | (move-to-column col))))))) | 1205 | (move-to-column col))))))) |
| 1207 | 1206 | ||
| 1208 | 1207 | ||
| 1209 | (defun occur--parse-occur-buffer() | ||
| 1210 | "Retrieve a list of the form (BEG END ORIG-LINE BUFFER). | ||
| 1211 | BEG and END define the region. | ||
| 1212 | ORIG-LINE and BUFFER are the line and the buffer from which | ||
| 1213 | the user called `occur'." | ||
| 1214 | (save-excursion | ||
| 1215 | (goto-char (point-min)) | ||
| 1216 | (let ((buffer (get-text-property (point) 'occur-title)) | ||
| 1217 | (beg-pos (get-text-property (point) 'region-start)) | ||
| 1218 | (end-pos (get-text-property (point) 'region-end)) | ||
| 1219 | (orig-line (get-text-property (point) 'current-line))) | ||
| 1220 | (list beg-pos end-pos orig-line buffer)))) | ||
| 1221 | |||
| 1222 | (defun occur-revert-function (_ignore1 _ignore2) | 1208 | (defun occur-revert-function (_ignore1 _ignore2) |
| 1223 | "Handle `revert-buffer' for Occur mode buffers." | 1209 | "Handle `revert-buffer' for Occur mode buffers." |
| 1224 | (if (cdr (nth 2 occur-revert-arguments)) ; multi-occur | 1210 | (if (cdr (nth 2 occur-revert-arguments)) ; multi-occur |
| @@ -1487,23 +1473,14 @@ is not modified." | |||
| 1487 | (and (use-region-p) (list (region-bounds))))) | 1473 | (and (use-region-p) (list (region-bounds))))) |
| 1488 | (let* ((start (and (caar region) (max (caar region) (point-min)))) | 1474 | (let* ((start (and (caar region) (max (caar region) (point-min)))) |
| 1489 | (end (and (cdar region) (min (cdar region) (point-max)))) | 1475 | (end (and (cdar region) (min (cdar region) (point-max)))) |
| 1490 | (in-region-p (or start end))) | 1476 | (in-region (or start end)) |
| 1491 | (when in-region-p | 1477 | (bufs (if (not in-region) (list (current-buffer)) |
| 1492 | (or start (setq start (point-min))) | 1478 | (let ((ol (make-overlay |
| 1493 | (or end (setq end (point-max)))) | 1479 | (or start (point-min)) |
| 1494 | (let ((occur--region-start start) | 1480 | (or end (point-max))))) |
| 1495 | (occur--region-end end) | 1481 | (overlay-put ol 'occur--orig-point (point)) |
| 1496 | (occur--region-start-line | 1482 | (list ol))))) |
| 1497 | (and in-region-p | 1483 | (occur-1 regexp nlines bufs))) |
| 1498 | (line-number-at-pos (min start end)))) | ||
| 1499 | (occur--orig-line | ||
| 1500 | (line-number-at-pos (point)))) | ||
| 1501 | (save-excursion ; If no matches `occur-1' doesn't restore the point. | ||
| 1502 | (and in-region-p (narrow-to-region | ||
| 1503 | (save-excursion (goto-char start) (line-beginning-position)) | ||
| 1504 | (save-excursion (goto-char end) (line-end-position)))) | ||
| 1505 | (occur-1 regexp nlines (list (current-buffer))) | ||
| 1506 | (and in-region-p (widen)))))) | ||
| 1507 | 1484 | ||
| 1508 | (defvar ido-ignore-item-temp-list) | 1485 | (defvar ido-ignore-item-temp-list) |
| 1509 | 1486 | ||
| @@ -1574,17 +1551,27 @@ See also `multi-occur'." | |||
| 1574 | (query-replace-descr regexp)))) | 1551 | (query-replace-descr regexp)))) |
| 1575 | 1552 | ||
| 1576 | (defun occur-1 (regexp nlines bufs &optional buf-name) | 1553 | (defun occur-1 (regexp nlines bufs &optional buf-name) |
| 1554 | ;; BUFS is a list of buffer-or-overlay! | ||
| 1577 | (unless (and regexp (not (equal regexp ""))) | 1555 | (unless (and regexp (not (equal regexp ""))) |
| 1578 | (error "Occur doesn't work with the empty regexp")) | 1556 | (error "Occur doesn't work with the empty regexp")) |
| 1579 | (unless buf-name | 1557 | (unless buf-name |
| 1580 | (setq buf-name "*Occur*")) | 1558 | (setq buf-name "*Occur*")) |
| 1581 | (let (occur-buf | 1559 | (let (occur-buf |
| 1582 | (active-bufs (delq nil (mapcar #'(lambda (buf) | 1560 | (active-bufs |
| 1583 | (when (buffer-live-p buf) buf)) | 1561 | (delq nil (mapcar (lambda (boo) |
| 1584 | bufs)))) | 1562 | (when (or (buffer-live-p boo) |
| 1563 | (and (overlayp boo) | ||
| 1564 | (overlay-buffer boo))) | ||
| 1565 | boo)) | ||
| 1566 | bufs)))) | ||
| 1585 | ;; Handle the case where one of the buffers we're searching is the | 1567 | ;; Handle the case where one of the buffers we're searching is the |
| 1586 | ;; output buffer. Just rename it. | 1568 | ;; output buffer. Just rename it. |
| 1587 | (when (member buf-name (mapcar 'buffer-name active-bufs)) | 1569 | (when (member buf-name |
| 1570 | ;; FIXME: Use cl-exists. | ||
| 1571 | (mapcar | ||
| 1572 | (lambda (boo) | ||
| 1573 | (buffer-name (if (overlayp boo) (overlay-buffer boo) boo))) | ||
| 1574 | active-bufs)) | ||
| 1588 | (with-current-buffer (get-buffer buf-name) | 1575 | (with-current-buffer (get-buffer buf-name) |
| 1589 | (rename-uniquely))) | 1576 | (rename-uniquely))) |
| 1590 | 1577 | ||
| @@ -1604,22 +1591,24 @@ See also `multi-occur'." | |||
| 1604 | (let ((count | 1591 | (let ((count |
| 1605 | (if (stringp nlines) | 1592 | (if (stringp nlines) |
| 1606 | ;; Treat nlines as a regexp to collect. | 1593 | ;; Treat nlines as a regexp to collect. |
| 1607 | (let ((bufs active-bufs) | 1594 | (let ((count 0)) |
| 1608 | (count 0)) | 1595 | (dolist (boo active-bufs) |
| 1609 | (while bufs | 1596 | (with-current-buffer |
| 1610 | (with-current-buffer (car bufs) | 1597 | (if (overlayp boo) (overlay-buffer boo) boo) |
| 1611 | (save-excursion | 1598 | (save-excursion |
| 1612 | (goto-char (point-min)) | 1599 | (goto-char |
| 1613 | (while (re-search-forward regexp nil t) | 1600 | (if (overlayp boo) (overlay-start boo) (point-min))) |
| 1614 | ;; Insert the replacement regexp. | 1601 | (let ((end (if (overlayp boo) (overlay-end boo)))) |
| 1615 | (let ((str (match-substitute-replacement nlines))) | 1602 | (while (re-search-forward regexp end t) |
| 1616 | (if str | 1603 | ;; Insert the replacement regexp. |
| 1617 | (with-current-buffer occur-buf | 1604 | (let ((str (match-substitute-replacement |
| 1618 | (insert str) | 1605 | nlines))) |
| 1619 | (setq count (1+ count)) | 1606 | (if str |
| 1620 | (or (zerop (current-column)) | 1607 | (with-current-buffer occur-buf |
| 1621 | (insert "\n")))))))) | 1608 | (insert str) |
| 1622 | (setq bufs (cdr bufs))) | 1609 | (setq count (1+ count)) |
| 1610 | (or (zerop (current-column)) | ||
| 1611 | (insert "\n")))))))))) | ||
| 1623 | count) | 1612 | count) |
| 1624 | ;; Perform normal occur. | 1613 | ;; Perform normal occur. |
| 1625 | (occur-engine | 1614 | (occur-engine |
| @@ -1662,49 +1651,54 @@ See also `multi-occur'." | |||
| 1662 | 1651 | ||
| 1663 | (defun occur-engine (regexp buffers out-buf nlines case-fold | 1652 | (defun occur-engine (regexp buffers out-buf nlines case-fold |
| 1664 | title-face prefix-face match-face keep-props) | 1653 | title-face prefix-face match-face keep-props) |
| 1654 | ;; BUFFERS is a list of buffer-or-overlay! | ||
| 1665 | (with-current-buffer out-buf | 1655 | (with-current-buffer out-buf |
| 1666 | (let ((global-lines 0) ;; total count of matching lines | 1656 | (let ((global-lines 0) ;; total count of matching lines |
| 1667 | (global-matches 0) ;; total count of matches | 1657 | (global-matches 0) ;; total count of matches |
| 1668 | (coding nil) | 1658 | (coding nil) |
| 1669 | (case-fold-search case-fold) | 1659 | (case-fold-search case-fold) |
| 1670 | (in-region-p (and occur--region-start occur--region-end)) | ||
| 1671 | (multi-occur-p (cdr buffers))) | 1660 | (multi-occur-p (cdr buffers))) |
| 1672 | ;; Map over all the buffers | 1661 | ;; Map over all the buffers |
| 1673 | (dolist (buf buffers) | 1662 | (dolist (boo buffers) |
| 1674 | (when (buffer-live-p buf) | 1663 | (when (if (overlayp boo) (overlay-buffer boo) (buffer-live-p boo)) |
| 1675 | (let ((lines 0) ;; count of matching lines | 1664 | (with-current-buffer (if (overlayp boo) (overlay-buffer boo) boo) |
| 1676 | (matches 0) ;; count of matches | 1665 | (let ((inhibit-field-text-motion t) |
| 1677 | (curr-line ;; line count | 1666 | (lines 0) ; count of matching lines |
| 1678 | (or occur--region-start-line 1)) | 1667 | (matches 0) ; count of matches |
| 1679 | (orig-line (or occur--orig-line 1)) | 1668 | (headerpt (with-current-buffer out-buf (point))) |
| 1680 | (orig-line-shown-p) | 1669 | ) |
| 1681 | (prev-line nil) ;; line number of prev match endpt | 1670 | (save-excursion |
| 1682 | (prev-after-lines nil) ;; context lines of prev match | 1671 | ;; begin searching in the buffer |
| 1683 | (matchbeg 0) | 1672 | (goto-char (if (overlayp boo) (overlay-start boo) (point-min))) |
| 1684 | (origpt nil) | 1673 | (forward-line 0) |
| 1685 | (begpt nil) | 1674 | (let ((limit (if (overlayp boo) (overlay-end boo) (point-max))) |
| 1686 | (endpt nil) | 1675 | (curr-line (line-number-at-pos)) ; line count |
| 1687 | (marker nil) | 1676 | (orig-line (if (not (overlayp boo)) 1 |
| 1688 | (curstring "") | 1677 | (line-number-at-pos |
| 1689 | (ret nil) | 1678 | (overlay-get boo 'occur--orig-point)))) |
| 1690 | (inhibit-field-text-motion t) | 1679 | (orig-line-shown-p) |
| 1691 | (headerpt (with-current-buffer out-buf (point)))) | 1680 | (prev-line nil) ; line number of prev match endpt |
| 1692 | (with-current-buffer buf | 1681 | (prev-after-lines nil) ; context lines of prev match |
| 1693 | ;; The following binding is for when case-fold-search | 1682 | (matchbeg 0) |
| 1694 | ;; has a local binding in the original buffer, in which | 1683 | (origpt nil) |
| 1695 | ;; case we cannot bind it globally and let that have | 1684 | (begpt nil) |
| 1696 | ;; effect in every buffer we search. | 1685 | (endpt nil) |
| 1697 | (let ((case-fold-search case-fold)) | 1686 | (marker nil) |
| 1698 | (or coding | 1687 | (curstring "") |
| 1699 | ;; Set CODING only if the current buffer locally | 1688 | (ret nil) |
| 1700 | ;; binds buffer-file-coding-system. | 1689 | ;; The following binding is for when case-fold-search |
| 1701 | (not (local-variable-p 'buffer-file-coding-system)) | 1690 | ;; has a local binding in the original buffer, in which |
| 1702 | (setq coding buffer-file-coding-system)) | 1691 | ;; case we cannot bind it globally and let that have |
| 1703 | (save-excursion | 1692 | ;; effect in every buffer we search. |
| 1704 | (goto-char (point-min)) ;; begin searching in the buffer | 1693 | (case-fold-search case-fold)) |
| 1705 | (while (not (eobp)) | 1694 | (or coding |
| 1695 | ;; Set CODING only if the current buffer locally | ||
| 1696 | ;; binds buffer-file-coding-system. | ||
| 1697 | (not (local-variable-p 'buffer-file-coding-system)) | ||
| 1698 | (setq coding buffer-file-coding-system)) | ||
| 1699 | (while (< (point) limit) | ||
| 1706 | (setq origpt (point)) | 1700 | (setq origpt (point)) |
| 1707 | (when (setq endpt (re-search-forward regexp nil t)) | 1701 | (when (setq endpt (re-search-forward regexp limit t)) |
| 1708 | (setq lines (1+ lines)) ;; increment matching lines count | 1702 | (setq lines (1+ lines)) ;; increment matching lines count |
| 1709 | (setq matchbeg (match-beginning 0)) | 1703 | (setq matchbeg (match-beginning 0)) |
| 1710 | ;; Get beginning of first match line and end of the last. | 1704 | ;; Get beginning of first match line and end of the last. |
| @@ -1878,17 +1872,14 @@ See also `multi-occur'." | |||
| 1878 | ;; Don't display regexp for multi-buffer. | 1872 | ;; Don't display regexp for multi-buffer. |
| 1879 | (if (> (length buffers) 1) | 1873 | (if (> (length buffers) 1) |
| 1880 | "" (occur-regexp-descr regexp)) | 1874 | "" (occur-regexp-descr regexp)) |
| 1881 | (buffer-name buf) | 1875 | (buffer-name (if (overlayp boo) (overlay-buffer boo) boo)) |
| 1882 | (if in-region-p | 1876 | (if (overlayp boo) |
| 1883 | (format " within region: %d-%d" | 1877 | (format " within region: %d-%d" |
| 1884 | occur--region-start | 1878 | (overlay-start boo) |
| 1885 | occur--region-end) | 1879 | (overlay-end boo)) |
| 1886 | "")) | 1880 | "")) |
| 1887 | 'read-only t)) | 1881 | 'read-only t)) |
| 1888 | (setq end (point)) | 1882 | (setq end (point)) |
| 1889 | (add-text-properties beg end `(occur-title ,buf current-line ,orig-line | ||
| 1890 | region-start ,occur--region-start | ||
| 1891 | region-end ,occur--region-end)) | ||
| 1892 | (when title-face | 1883 | (when title-face |
| 1893 | (add-face-text-property beg end title-face)) | 1884 | (add-face-text-property beg end title-face)) |
| 1894 | (goto-char (if (and list-matching-lines-jump-to-current-line | 1885 | (goto-char (if (and list-matching-lines-jump-to-current-line |
| @@ -2425,7 +2416,7 @@ characters." | |||
| 2425 | 2416 | ||
| 2426 | (message | 2417 | (message |
| 2427 | (if query-flag | 2418 | (if query-flag |
| 2428 | (apply 'propertize | 2419 | (apply #'propertize |
| 2429 | (concat "Query replacing " | 2420 | (concat "Query replacing " |
| 2430 | (if backward "backward " "") | 2421 | (if backward "backward " "") |
| 2431 | (if delimited-flag | 2422 | (if delimited-flag |
| @@ -2880,10 +2871,11 @@ characters." | |||
| 2880 | (if (= replace-count 1) "" "s") | 2871 | (if (= replace-count 1) "" "s") |
| 2881 | (if (> (+ skip-read-only-count | 2872 | (if (> (+ skip-read-only-count |
| 2882 | skip-filtered-count | 2873 | skip-filtered-count |
| 2883 | skip-invisible-count) 0) | 2874 | skip-invisible-count) |
| 2875 | 0) | ||
| 2884 | (format " (skipped %s)" | 2876 | (format " (skipped %s)" |
| 2885 | (mapconcat | 2877 | (mapconcat |
| 2886 | 'identity | 2878 | #'identity |
| 2887 | (delq nil (list | 2879 | (delq nil (list |
| 2888 | (if (> skip-read-only-count 0) | 2880 | (if (> skip-read-only-count 0) |
| 2889 | (format "%s read-only" | 2881 | (format "%s read-only" |