1 ;;; vlf-search.el --- Search functionality for VLF -*- lexical-binding: t -*-
3 ;; Copyright (C) 2014 Free Software Foundation, Inc.
5 ;; Keywords: large files, search
6 ;; Author: Andrey Kotlarski <m00naticus@gmail.com>
7 ;; URL: https://github.com/m00natic/vlfi
9 ;; This file is free software; you can redistribute it and/or modify
10 ;; it under the terms of the GNU General Public License as published by
11 ;; the Free Software Foundation; either version 3, or (at your option)
14 ;; This file is distributed in the hope that it will be useful,
15 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
16 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
17 ;; GNU General Public License for more details.
19 ;; You should have received a copy of the GNU General Public License
20 ;; along with GNU Emacs; see the file COPYING. If not, write to
21 ;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
22 ;; Boston, MA 02111-1307, USA.
25 ;; This package provides search utilities for dealing with large files
26 ;; in constant memory.
33 (defvar tramp-verbose)
35 (defun vlf-re-search (regexp count backward
36 &optional reporter time highlight)
37 "Search for REGEXP COUNT number of times forward or BACKWARD.
38 Use existing REPORTER and start TIME if given.
39 Highlight match if HIGHLIGHT is non nil.
40 Return t if search has been at least partially successful."
42 (error "Count must be positive"))
43 (run-hook-with-args 'vlf-before-batch-functions 'search)
44 (or reporter (setq reporter (make-progress-reporter
45 (concat "Searching for " regexp "...")
47 (- vlf-file-size vlf-end-pos)
50 (or time (setq time (float-time)))
51 (let* ((tramp-verbose (if (boundp 'tramp-verbose)
52 (min tramp-verbose 1)))
54 (match-chunk-start vlf-start-pos)
55 (match-chunk-end vlf-end-pos)
56 (match-start-pos (point))
57 (match-end-pos match-start-pos)
58 (last-match-pos match-start-pos)
60 (is-hexl (derived-mode-p 'hexl-mode))
61 (tune-types (if is-hexl '(:hexl :raw)
63 (font-lock font-lock-mode))
65 (vlf-with-undo-disabled
69 (while (not (zerop to-find))
70 (cond ((re-search-backward regexp nil t)
71 (setq to-find (1- to-find)
72 match-chunk-start vlf-start-pos
73 match-chunk-end vlf-end-pos
74 match-start-pos (match-beginning 0)
75 match-end-pos (match-end 0)
76 last-match-pos match-start-pos))
77 ((zerop vlf-start-pos)
78 (throw 'end-of-file nil))
82 (goto-char (point-min))
84 (if (< last-match-pos (point))
85 (goto-char last-match-pos))
87 (* (- 10 (forward-line -10))
90 (min 1024 (/ (point-max) 10)
92 (vlf-tune-batch tune-types)
93 (setq vlf-start-pos end) ;don't adjust end
94 (vlf-move-to-chunk (- end vlf-batch-size)
96 (let ((pmax (point-max)))
98 (setq last-match-pos pmax))
99 (progress-reporter-update
100 reporter (- vlf-file-size
102 (while (not (zerop to-find))
103 (cond ((re-search-forward regexp nil t)
104 (setq to-find (1- to-find)
105 match-chunk-start vlf-start-pos
106 match-chunk-end vlf-end-pos
107 match-start-pos (match-beginning 0)
108 match-end-pos (match-end 0)
109 last-match-pos match-end-pos))
110 ((>= vlf-end-pos vlf-file-size)
111 (throw 'end-of-file nil))
112 (t (let* ((pmax (point-max))
118 (if (< (point) last-match-pos)
119 (goto-char last-match-pos))
121 (* (- 10 (forward-line 10))
127 (vlf-tune-batch tune-types)
128 (setq vlf-end-pos start) ;don't adjust start
129 (vlf-move-to-chunk start (+ start
131 (let ((pmin (point-min)))
133 (setq last-match-pos pmin))
134 (progress-reporter-update reporter
136 (progress-reporter-done reporter))
137 (set-buffer-modified-p nil)
138 (if font-lock (font-lock-mode 1))
141 (vlf-goto-match match-chunk-start match-chunk-end
142 match-end-pos match-start-pos
143 count to-find time highlight)
144 (vlf-goto-match match-chunk-start match-chunk-end
145 match-start-pos match-end-pos
146 count to-find time highlight))))
147 (run-hook-with-args 'vlf-after-batch-functions 'search)
150 (defun vlf-goto-match (match-chunk-start match-chunk-end
151 match-start-pos match-end-pos
154 "Move to MATCH-CHUNK-START MATCH-CHUNK-END surrounding\
155 MATCH-START-POS and MATCH-END-POS.
156 According to COUNT and left TO-FIND, show if search has been
157 successful. Use start TIME to report how much it took.
158 Highlight match if HIGHLIGHT is non nil.
159 Return nil if nothing found."
160 (vlf-move-to-chunk match-chunk-start match-chunk-end)
161 (goto-char match-start-pos)
162 (setq vlf-batch-size (vlf-tune-optimal-load
163 (if (derived-mode-p 'hexl-mode)
165 '(:insert :encode))))
166 (if (= count to-find)
167 (progn (message "Not found (%f secs)" (- (float-time) time))
169 (let ((success (zerop to-find))
170 (overlay (make-overlay match-start-pos match-end-pos)))
171 (overlay-put overlay 'face 'match)
173 (message "Match found (%f secs)" (- (float-time) time))
174 (message "Moved to the %d match which is last (%f secs)"
175 (- count to-find) (- (float-time) time)))
177 (unwind-protect (sit-for 1)
178 (delete-overlay overlay))
179 (delete-overlay overlay)))
182 (defun vlf-re-search-forward (regexp count)
183 "Search forward for REGEXP prefix COUNT number of times.
184 Search is performed chunk by chunk in `vlf-batch-size' memory."
185 (interactive (if (vlf-no-modifications)
186 (list (read-regexp "Search whole file"
188 (car regexp-history)))
189 (or current-prefix-arg 1))))
190 (let ((batch-size vlf-batch-size)
193 (setq success (vlf-re-search regexp count nil nil nil t))
194 (or success (setq vlf-batch-size batch-size)))))
196 (defun vlf-re-search-backward (regexp count)
197 "Search backward for REGEXP prefix COUNT number of times.
198 Search is performed chunk by chunk in `vlf-batch-size' memory."
199 (interactive (if (vlf-no-modifications)
200 (list (read-regexp "Search whole file backward"
202 (car regexp-history)))
203 (or current-prefix-arg 1))))
204 (let ((batch-size vlf-batch-size)
207 (setq success (vlf-re-search regexp count t nil nil t))
208 (or success (setq vlf-batch-size batch-size)))))
210 (defun vlf-goto-line (n)
211 "Go to line N. If N is negative, count from the end of file."
212 (interactive (if (vlf-no-modifications)
213 (list (read-number "Go to line: "))))
214 (if (derived-mode-p 'hexl-mode)
215 (vlf-goto-line-hexl n)
216 (run-hook-with-args 'vlf-before-batch-functions 'goto-line)
218 (let ((tramp-verbose (if (boundp 'tramp-verbose)
219 (min tramp-verbose 1)))
220 (start-pos vlf-start-pos)
221 (end-pos vlf-end-pos)
222 (batch-size vlf-batch-size)
224 (font-lock font-lock-mode)
228 (vlf-tune-batch '(:raw))
232 (end (min vlf-batch-size vlf-file-size))
233 (reporter (make-progress-reporter
234 (concat "Searching for line "
235 (number-to-string n) "...")
237 (inhibit-read-only t))
239 (vlf-with-undo-disabled
240 ;; (while (and (< (- end start) n)
241 ;; (< n (- vlf-file-size start)))
243 ;; (vlf-tune-insert-file-contents-literally start end)
244 ;; (goto-char (point-min))
245 ;; (while (re-search-forward "[\n\C-m]" nil t)
248 ;; (vlf-tune-batch '(:raw))
250 ;; end (min vlf-file-size (+ start
252 ;; (progress-reporter-update reporter start))
253 (when (< n (- vlf-file-size end))
254 (vlf-tune-batch '(:insert :encode))
255 (vlf-move-to-chunk start (+ start vlf-batch-size))
256 (goto-char (point-min))
259 (when (vlf-re-search "[\n\C-m]" n nil
261 (forward-char) t))))))
262 (let ((end vlf-file-size)
263 (reporter (make-progress-reporter
264 (concat "Searching for line -"
265 (number-to-string n) "...")
267 (inhibit-read-only t))
269 (vlf-with-undo-disabled
270 ;; (let ((start (max 0 (- vlf-file-size vlf-batch-size))))
271 ;; (while (and (< (- end start) n) (< n end))
273 ;; (vlf-tune-insert-file-contents-literally start end)
274 ;; (goto-char (point-max))
275 ;; (while (re-search-backward "[\n\C-m]" nil t)
277 ;; (vlf-tune-batch '(:raw))
279 ;; start (max 0 (- end vlf-batch-size)))
280 ;; (progress-reporter-update reporter
281 ;; (- vlf-file-size end))))
283 (vlf-tune-batch '(:insert :encode))
284 (vlf-move-to-chunk (- end vlf-batch-size) end)
285 (goto-char (point-max))
286 (setq success (vlf-re-search "[\n\C-m]" n t
288 (if font-lock (font-lock-mode 1))
290 (vlf-with-undo-disabled
291 (vlf-move-to-chunk start-pos end-pos))
293 (setq vlf-batch-size batch-size)
294 (message "Unable to find line"))
295 (run-hook-with-args 'vlf-after-batch-functions 'goto-line)))))
297 (defun vlf-goto-line-hexl (n)
298 "Go to line N. If N is negative, count from the end of file.
299 Assume `hexl-mode' is active."
300 (vlf-tune-load '(:hexl :raw))
302 (let ((hidden-bytes (+ vlf-file-size (* n hexl-bits))))
303 (setq hidden-bytes (- hidden-bytes (mod hidden-bytes
305 (vlf-move-to-batch hidden-bytes)
306 (goto-char (point-max))
307 (forward-line (+ (round (- vlf-file-size
313 (let ((hidden-bytes (1- (* n hexl-bits))))
314 (setq hidden-bytes (- hidden-bytes (mod hidden-bytes
316 (vlf-move-to-batch hidden-bytes)
317 (goto-char (point-min))
318 (forward-line (- n 1 (/ hidden-bytes hexl-bits))))))
320 (defun vlf-query-replace (regexp to-string &optional delimited backward)
321 "Query replace over whole file matching REGEXP with TO-STRING.
322 Third arg DELIMITED (prefix arg if interactive), if non-nil, replace
323 only matches surrounded by word boundaries. A negative prefix arg means
325 (interactive (let ((common (query-replace-read-args
326 (concat "Query replace over whole file"
327 (if current-prefix-arg
328 (if (eq current-prefix-arg '-)
334 (list (nth 0 common) (nth 1 common) (nth 2 common)
336 (let ((not-automatic t))
337 (while (vlf-re-search regexp 1 backward)
339 (query-replace-regexp regexp to-string delimited
341 (if (eq 'automatic (lookup-key query-replace-map
342 (vector last-input-event)))
343 (setq not-automatic nil)))
344 (backward (while (re-search-backward regexp nil t)
345 (replace-match to-string)))
346 (t (while (re-search-forward regexp nil t)
347 (replace-match to-string))))
348 (if (buffer-modified-p)
351 (provide 'vlf-search)
353 ;;; vlf-search.el ends here