aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorJuri Linkov2013-05-28 02:38:56 +0300
committerJuri Linkov2013-05-28 02:38:56 +0300
commit3a52ccf7c2effeba40fb15950495ccdf8e32ef12 (patch)
treef2f175767daac16953b2a765c9391e41c7be6369
parentf1a60a0f07666582843f324767f740b75c071fb9 (diff)
downloademacs-3a52ccf7c2effeba40fb15950495ccdf8e32ef12.tar.gz
emacs-3a52ccf7c2effeba40fb15950495ccdf8e32ef12.zip
* lisp/replace.el (replace-search): New function with code moved out
from `perform-replace'. (replace-highlight, replace-dehighlight): Move function definitions up closer to `replace-search'. Fixes: debbugs:11746
-rw-r--r--lisp/ChangeLog7
-rw-r--r--lisp/replace.el186
2 files changed, 103 insertions, 90 deletions
diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index ecdeb49f254..084afe4f31a 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,5 +1,12 @@
12013-05-27 Juri Linkov <juri@jurta.org> 12013-05-27 Juri Linkov <juri@jurta.org>
2 2
3 * replace.el (replace-search): New function with code moved out
4 from `perform-replace'.
5 (replace-highlight, replace-dehighlight): Move function definitions
6 up closer to `replace-search'. (Bug#11746)
7
82013-05-27 Juri Linkov <juri@jurta.org>
9
3 * replace.el (perform-replace): Ignore invisible matches. 10 * replace.el (perform-replace): Ignore invisible matches.
4 In addition to checking `query-replace-skip-read-only', also 11 In addition to checking `query-replace-skip-read-only', also
5 filter out matches by calling `run-hook-with-args-until-failure' 12 filter out matches by calling `run-hook-with-args-until-failure'
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',
1838It is called with three arguments, as if it were 1838It 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