diff options
Diffstat (limited to 'lisp/replace.el')
| -rw-r--r-- | lisp/replace.el | 186 |
1 files changed, 96 insertions, 90 deletions
diff --git a/lisp/replace.el b/lisp/replace.el index 7c26f1ed063..86956a614cd 100644 --- a/lisp/replace.el +++ b/lisp/replace.el | |||
| @@ -1838,6 +1838,68 @@ It is used by `query-replace-regexp', `replace-regexp', | |||
| 1838 | It is called with three arguments, as if it were | 1838 | It is called with three arguments, as if it were |
| 1839 | `re-search-forward'.") | 1839 | `re-search-forward'.") |
| 1840 | 1840 | ||
| 1841 | (defun replace-search (search-string limit regexp-flag delimited-flag | ||
| 1842 | case-fold-search) | ||
| 1843 | "Search for the next occurence of SEARCH-STRING to replace." | ||
| 1844 | ;; Let-bind global isearch-* variables to values used | ||
| 1845 | ;; to search the next replacement. These let-bindings | ||
| 1846 | ;; should be effective both at the time of calling | ||
| 1847 | ;; `isearch-search-fun-default' and also at the | ||
| 1848 | ;; time of funcalling `search-function'. | ||
| 1849 | ;; These isearch-* bindings can't be placed higher | ||
| 1850 | ;; outside of this function because then another I-search | ||
| 1851 | ;; used after `recursive-edit' might override them. | ||
| 1852 | (let* ((isearch-regexp regexp-flag) | ||
| 1853 | (isearch-word delimited-flag) | ||
| 1854 | (isearch-lax-whitespace | ||
| 1855 | replace-lax-whitespace) | ||
| 1856 | (isearch-regexp-lax-whitespace | ||
| 1857 | replace-regexp-lax-whitespace) | ||
| 1858 | (isearch-case-fold-search case-fold-search) | ||
| 1859 | (isearch-adjusted nil) | ||
| 1860 | (isearch-nonincremental t) ; don't use lax word mode | ||
| 1861 | (isearch-forward t) | ||
| 1862 | (search-function | ||
| 1863 | (or (if regexp-flag | ||
| 1864 | replace-re-search-function | ||
| 1865 | replace-search-function) | ||
| 1866 | (isearch-search-fun-default)))) | ||
| 1867 | (funcall search-function search-string limit t))) | ||
| 1868 | |||
| 1869 | (defvar replace-overlay nil) | ||
| 1870 | |||
| 1871 | (defun replace-highlight (match-beg match-end range-beg range-end | ||
| 1872 | search-string regexp-flag delimited-flag | ||
| 1873 | case-fold-search) | ||
| 1874 | (if query-replace-highlight | ||
| 1875 | (if replace-overlay | ||
| 1876 | (move-overlay replace-overlay match-beg match-end (current-buffer)) | ||
| 1877 | (setq replace-overlay (make-overlay match-beg match-end)) | ||
| 1878 | (overlay-put replace-overlay 'priority 1001) ;higher than lazy overlays | ||
| 1879 | (overlay-put replace-overlay 'face 'query-replace))) | ||
| 1880 | (if query-replace-lazy-highlight | ||
| 1881 | (let ((isearch-string search-string) | ||
| 1882 | (isearch-regexp regexp-flag) | ||
| 1883 | (isearch-word delimited-flag) | ||
| 1884 | (isearch-lax-whitespace | ||
| 1885 | replace-lax-whitespace) | ||
| 1886 | (isearch-regexp-lax-whitespace | ||
| 1887 | replace-regexp-lax-whitespace) | ||
| 1888 | (isearch-case-fold-search case-fold-search) | ||
| 1889 | (isearch-forward t) | ||
| 1890 | (isearch-other-end match-beg) | ||
| 1891 | (isearch-error nil)) | ||
| 1892 | (isearch-lazy-highlight-new-loop range-beg range-end)))) | ||
| 1893 | |||
| 1894 | (defun replace-dehighlight () | ||
| 1895 | (when replace-overlay | ||
| 1896 | (delete-overlay replace-overlay)) | ||
| 1897 | (when query-replace-lazy-highlight | ||
| 1898 | (lazy-highlight-cleanup lazy-highlight-cleanup) | ||
| 1899 | (setq isearch-lazy-highlight-last-string nil)) | ||
| 1900 | ;; Close overlays opened by `isearch-range-invisible' in `perform-replace'. | ||
| 1901 | (isearch-clean-overlays)) | ||
| 1902 | |||
| 1841 | (defun perform-replace (from-string replacements | 1903 | (defun perform-replace (from-string replacements |
| 1842 | query-flag regexp-flag delimited-flag | 1904 | query-flag regexp-flag delimited-flag |
| 1843 | &optional repeat-count map start end) | 1905 | &optional repeat-count map start end) |
| @@ -1925,62 +1987,40 @@ make, or the user didn't cancel the call." | |||
| 1925 | ;; Loop finding occurrences that perhaps should be replaced. | 1987 | ;; Loop finding occurrences that perhaps should be replaced. |
| 1926 | (while (and keep-going | 1988 | (while (and keep-going |
| 1927 | (not (or (eobp) (and limit (>= (point) limit)))) | 1989 | (not (or (eobp) (and limit (>= (point) limit)))) |
| 1928 | ;; Let-bind global isearch-* variables to values used | 1990 | ;; Use the next match if it is already known; |
| 1929 | ;; to search the next replacement. These let-bindings | 1991 | ;; otherwise, search for a match after moving forward |
| 1930 | ;; should be effective both at the time of calling | 1992 | ;; one char if progress is required. |
| 1931 | ;; `isearch-search-fun-default' and also at the | 1993 | (setq real-match-data |
| 1932 | ;; time of funcalling `search-function'. | 1994 | (cond ((consp match-again) |
| 1933 | ;; These isearch-* bindings can't be placed higher | 1995 | (goto-char (nth 1 match-again)) |
| 1934 | ;; outside of this loop because then another I-search | 1996 | (replace-match-data |
| 1935 | ;; used after `recursive-edit' might override them. | 1997 | t real-match-data match-again)) |
| 1936 | (let* ((isearch-regexp regexp-flag) | 1998 | ;; MATCH-AGAIN non-nil means accept an |
| 1937 | (isearch-word delimited-flag) | 1999 | ;; adjacent match. |
| 1938 | (isearch-lax-whitespace | 2000 | (match-again |
| 1939 | replace-lax-whitespace) | 2001 | (and |
| 1940 | (isearch-regexp-lax-whitespace | 2002 | (replace-search search-string limit |
| 1941 | replace-regexp-lax-whitespace) | 2003 | regexp-flag delimited-flag |
| 1942 | (isearch-case-fold-search case-fold-search) | 2004 | case-fold-search) |
| 1943 | (isearch-adjusted nil) | 2005 | ;; For speed, use only integers and |
| 1944 | (isearch-nonincremental t) ; don't use lax word mode | 2006 | ;; reuse the list used last time. |
| 1945 | (isearch-forward t) | 2007 | (replace-match-data t real-match-data))) |
| 1946 | (search-function | 2008 | ((and (< (1+ (point)) (point-max)) |
| 1947 | (or (if regexp-flag | 2009 | (or (null limit) |
| 1948 | replace-re-search-function | 2010 | (< (1+ (point)) limit))) |
| 1949 | replace-search-function) | 2011 | ;; If not accepting adjacent matches, |
| 1950 | (isearch-search-fun-default)))) | 2012 | ;; move one char to the right before |
| 1951 | ;; Use the next match if it is already known; | 2013 | ;; searching again. Undo the motion |
| 1952 | ;; otherwise, search for a match after moving forward | 2014 | ;; if the search fails. |
| 1953 | ;; one char if progress is required. | 2015 | (let ((opoint (point))) |
| 1954 | (setq real-match-data | 2016 | (forward-char 1) |
| 1955 | (cond ((consp match-again) | 2017 | (if (replace-search search-string limit |
| 1956 | (goto-char (nth 1 match-again)) | 2018 | regexp-flag delimited-flag |
| 1957 | (replace-match-data | 2019 | case-fold-search) |
| 1958 | t real-match-data match-again)) | 2020 | (replace-match-data |
| 1959 | ;; MATCH-AGAIN non-nil means accept an | 2021 | t real-match-data) |
| 1960 | ;; adjacent match. | 2022 | (goto-char opoint) |
| 1961 | (match-again | 2023 | nil)))))) |
| 1962 | (and | ||
| 1963 | (funcall search-function search-string | ||
| 1964 | limit t) | ||
| 1965 | ;; For speed, use only integers and | ||
| 1966 | ;; reuse the list used last time. | ||
| 1967 | (replace-match-data t real-match-data))) | ||
| 1968 | ((and (< (1+ (point)) (point-max)) | ||
| 1969 | (or (null limit) | ||
| 1970 | (< (1+ (point)) limit))) | ||
| 1971 | ;; If not accepting adjacent matches, | ||
| 1972 | ;; move one char to the right before | ||
| 1973 | ;; searching again. Undo the motion | ||
| 1974 | ;; if the search fails. | ||
| 1975 | (let ((opoint (point))) | ||
| 1976 | (forward-char 1) | ||
| 1977 | (if (funcall | ||
| 1978 | search-function search-string | ||
| 1979 | limit t) | ||
| 1980 | (replace-match-data | ||
| 1981 | t real-match-data) | ||
| 1982 | (goto-char opoint) | ||
| 1983 | nil))))))) | ||
| 1984 | 2024 | ||
| 1985 | ;; Record whether the match is nonempty, to avoid an infinite loop | 2025 | ;; Record whether the match is nonempty, to avoid an infinite loop |
| 1986 | ;; repeatedly matching the same empty string. | 2026 | ;; repeatedly matching the same empty string. |
| @@ -2229,38 +2269,4 @@ make, or the user didn't cancel the call." | |||
| 2229 | (if (= replace-count 1) "" "s"))) | 2269 | (if (= replace-count 1) "" "s"))) |
| 2230 | (or (and keep-going stack) multi-buffer))) | 2270 | (or (and keep-going stack) multi-buffer))) |
| 2231 | 2271 | ||
| 2232 | (defvar replace-overlay nil) | ||
| 2233 | |||
| 2234 | (defun replace-highlight (match-beg match-end range-beg range-end | ||
| 2235 | search-string regexp-flag delimited-flag | ||
| 2236 | case-fold-search) | ||
| 2237 | (if query-replace-highlight | ||
| 2238 | (if replace-overlay | ||
| 2239 | (move-overlay replace-overlay match-beg match-end (current-buffer)) | ||
| 2240 | (setq replace-overlay (make-overlay match-beg match-end)) | ||
| 2241 | (overlay-put replace-overlay 'priority 1001) ;higher than lazy overlays | ||
| 2242 | (overlay-put replace-overlay 'face 'query-replace))) | ||
| 2243 | (if query-replace-lazy-highlight | ||
| 2244 | (let ((isearch-string search-string) | ||
| 2245 | (isearch-regexp regexp-flag) | ||
| 2246 | (isearch-word delimited-flag) | ||
| 2247 | (isearch-lax-whitespace | ||
| 2248 | replace-lax-whitespace) | ||
| 2249 | (isearch-regexp-lax-whitespace | ||
| 2250 | replace-regexp-lax-whitespace) | ||
| 2251 | (isearch-case-fold-search case-fold-search) | ||
| 2252 | (isearch-forward t) | ||
| 2253 | (isearch-other-end match-beg) | ||
| 2254 | (isearch-error nil)) | ||
| 2255 | (isearch-lazy-highlight-new-loop range-beg range-end)))) | ||
| 2256 | |||
| 2257 | (defun replace-dehighlight () | ||
| 2258 | (when replace-overlay | ||
| 2259 | (delete-overlay replace-overlay)) | ||
| 2260 | (when query-replace-lazy-highlight | ||
| 2261 | (lazy-highlight-cleanup lazy-highlight-cleanup) | ||
| 2262 | (setq isearch-lazy-highlight-last-string nil)) | ||
| 2263 | ;; Close overlays opened by `isearch-range-invisible' in `perform-replace'. | ||
| 2264 | (isearch-clean-overlays)) | ||
| 2265 | |||
| 2266 | ;;; replace.el ends here | 2272 | ;;; replace.el ends here |