aboutsummaryrefslogtreecommitdiffstats
path: root/lisp
diff options
context:
space:
mode:
Diffstat (limited to 'lisp')
-rw-r--r--lisp/replace.el190
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.
1104See `occur-revert-function'.") 1104See `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."
1130Alternatively, click \\[occur-mode-mouse-goto] on an item to go to it. 1129Alternatively, 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
1155To return to ordinary Occur mode, use \\[occur-cease-edit]." 1154To 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).
1211BEG and END define the region.
1212ORIG-LINE and BUFFER are the line and the buffer from which
1213the 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"