1 ;;; vlf-occur.el --- Occur-like functionality for VLF -*- lexical-binding: t -*-
3 ;; Copyright (C) 2014 Free Software Foundation, Inc.
5 ;; Keywords: large files, indexing, occur
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 the `vlf-occur' command which builds
26 ;; index of search occurrences in large file just like occur.
32 (defvar vlf-occur-vlf-file nil "VLF file that is searched.")
33 (make-variable-buffer-local 'vlf-occur-vlf-file)
35 (defvar vlf-occur-vlf-buffer nil "VLF buffer that is scanned.")
36 (make-variable-buffer-local 'vlf-occur-vlf-buffer)
38 (defvar vlf-occur-regexp)
39 (make-variable-buffer-local 'vlf-occur-regexp)
41 (defvar vlf-occur-hexl nil "Is `hexl-mode' active?")
42 (make-variable-buffer-local 'vlf-occur-hexl)
44 (defvar vlf-occur-lines 0 "Number of lines scanned by `vlf-occur'.")
45 (make-variable-buffer-local 'vlf-occur-lines)
47 (defvar vlf-occur-mode-map
48 (let ((map (make-sparse-keymap)))
49 (define-key map "n" 'vlf-occur-next-match)
50 (define-key map "p" 'vlf-occur-prev-match)
51 (define-key map "\C-m" 'vlf-occur-visit)
52 (define-key map "\M-\r" 'vlf-occur-visit-new-buffer)
53 (define-key map [mouse-1] 'vlf-occur-visit)
54 (define-key map "o" 'vlf-occur-show)
55 (define-key map [remap save-buffer] 'vlf-occur-save)
57 "Keymap for command `vlf-occur-mode'.")
59 (define-derived-mode vlf-occur-mode special-mode "VLF[occur]"
60 "Major mode for showing occur matches of VLF opened files."
61 (add-hook 'write-file-functions 'vlf-occur-save nil t))
63 (defun vlf-occur-next-match ()
64 "Move cursor to next match."
66 (if (eq (get-text-property (point) 'face) 'match)
67 (goto-char (next-single-property-change (point) 'face)))
68 (goto-char (or (text-property-any (point) (point-max) 'face 'match)
69 (text-property-any (point-min) (point)
72 (defun vlf-occur-prev-match ()
73 "Move cursor to previous match."
75 (if (eq (get-text-property (point) 'face) 'match)
76 (goto-char (previous-single-property-change (point) 'face)))
77 (while (not (eq (get-text-property (point) 'face) 'match))
78 (goto-char (or (previous-single-property-change (point) 'face)
81 (defun vlf-occur-show (&optional event)
82 "Visit current `vlf-occur' link in a vlf buffer but stay in the \
83 occur buffer. If original VLF buffer has been killed,
84 open new VLF session each time.
85 EVENT may hold details of the invocation."
86 (interactive (list last-nonmenu-event))
87 (let ((occur-buffer (if event
88 (window-buffer (posn-window
91 (vlf-occur-visit event)
92 (pop-to-buffer occur-buffer)))
94 (defun vlf-occur-visit-new-buffer ()
95 "Visit `vlf-occur' link in new vlf buffer."
97 (let ((current-prefix-arg t))
100 (defun vlf-occur-visit (&optional event)
101 "Visit current `vlf-occur' link in a vlf buffer.
102 With prefix argument or if original VLF buffer has been killed,
103 open new VLF session.
104 EVENT may hold details of the invocation."
105 (interactive (list last-nonmenu-event))
107 (set-buffer (window-buffer (posn-window (event-end event))))
108 (goto-char (posn-point (event-end event))))
110 (pos-relative (- pos (line-beginning-position) 1))
111 (chunk-start (get-text-property pos 'chunk-start)))
113 (let ((chunk-end (get-text-property pos 'chunk-end))
114 (file (if (file-exists-p vlf-occur-vlf-file)
116 (setq vlf-occur-vlf-file
118 (concat vlf-occur-vlf-file
119 " doesn't exist, locate it: ")))))
120 (vlf-buffer vlf-occur-vlf-buffer)
121 (not-hexl (not vlf-occur-hexl))
122 (occur-buffer (current-buffer))
123 (match-pos (+ (get-text-property pos 'line-pos)
125 (cond (current-prefix-arg
126 (setq vlf-buffer (vlf file t))
127 (or not-hexl (vlf-tune-hexlify))
128 (switch-to-buffer occur-buffer))
129 ((not (buffer-live-p vlf-buffer))
130 (unless (catch 'found
131 (dolist (buf (buffer-list))
134 (equal file buffer-file-name)
135 (eq (not (derived-mode-p 'hexl-mode))
137 (setq vlf-buffer buf)
139 (setq vlf-buffer (vlf file t))
140 (or not-hexl (vlf-tune-hexlify)))
141 (switch-to-buffer occur-buffer)
142 (setq vlf-occur-vlf-buffer vlf-buffer)))
143 (pop-to-buffer vlf-buffer)
144 (vlf-move-to-chunk chunk-start chunk-end)
145 (goto-char match-pos)))))
147 (defun vlf-occur-other-buffer (regexp)
148 "Make whole file occur style index for REGEXP branching to new buffer.
149 Prematurely ending indexing will still show what's found so far."
150 (let ((vlf-buffer (current-buffer))
151 (file buffer-file-name)
152 (batch-size vlf-batch-size)
153 (is-hexl (derived-mode-p 'hexl-mode))
154 (insert-bps vlf-tune-insert-bps)
155 (encode-bps vlf-tune-encode-bps)
156 (hexl-bps vlf-tune-hexl-bps)
157 (dehexlify-bps vlf-tune-dehexlify-bps))
159 (setq buffer-file-name file
160 buffer-file-truename file
162 (set-buffer-modified-p nil)
163 (set (make-local-variable 'vlf-batch-size) batch-size)
164 (when vlf-tune-enabled
165 (setq vlf-tune-insert-bps insert-bps
166 vlf-tune-encode-bps encode-bps)
168 (progn (setq vlf-tune-hexl-bps hexl-bps
169 vlf-tune-dehexlify-bps dehexlify-bps)
170 (vlf-tune-batch '(:hexl :dehexlify :insert :encode)))
171 (vlf-tune-batch '(:insert :encode))))
173 (if is-hexl (vlf-tune-hexlify))
174 (goto-char (point-min))
175 (vlf-with-undo-disabled
176 (vlf-build-occur regexp vlf-buffer))
177 (when vlf-tune-enabled
178 (setq insert-bps vlf-tune-insert-bps
179 encode-bps vlf-tune-encode-bps)
181 (setq insert-bps vlf-tune-insert-bps
182 encode-bps vlf-tune-encode-bps))))
183 (when vlf-tune-enabled ;merge back tune measurements
184 (setq vlf-tune-insert-bps insert-bps
185 vlf-tune-encode-bps encode-bps)
187 (setq vlf-tune-insert-bps insert-bps
188 vlf-tune-encode-bps encode-bps)))))
190 (defun vlf-occur (regexp)
191 "Make whole file occur style index for REGEXP.
192 Prematurely ending indexing will still show what's found so far."
193 (interactive (list (read-regexp "List lines matching regexp"
195 (car regexp-history)))))
196 (run-hook-with-args 'vlf-before-batch-functions 'occur)
197 (if (or (buffer-modified-p)
198 (< vlf-batch-size vlf-start-pos))
199 (vlf-occur-other-buffer regexp)
200 (let ((start-pos vlf-start-pos)
201 (end-pos vlf-end-pos)
203 (batch-size vlf-batch-size)
204 (is-hexl (derived-mode-p 'hexl-mode)))
205 (vlf-tune-batch (if (derived-mode-p 'hexl-mode)
206 '(:hexl :dehexlify :insert :encode)
208 (vlf-with-undo-disabled
209 (vlf-move-to-batch 0)
210 (goto-char (point-min))
211 (unwind-protect (vlf-build-occur regexp (current-buffer))
212 (vlf-move-to-chunk start-pos end-pos)
213 (if is-hexl (vlf-tune-hexlify))
215 (setq vlf-batch-size batch-size)))))
216 (run-hook-with-args 'vlf-after-batch-functions 'occur))
218 (defvar tramp-verbose)
220 (defun vlf-build-occur (regexp vlf-buffer)
221 "Build occur style index for REGEXP over VLF-BUFFER."
222 (let* ((tramp-verbose (if (boundp 'tramp-verbose)
223 (min tramp-verbose 2)))
227 (last-line-pos (point-min))
229 (match-end-pos (+ vlf-start-pos (position-bytes (point))))
230 (occur-buffer (generate-new-buffer
231 (concat "*VLF-occur " (file-name-nondirectory
234 (line-regexp (concat "\\(?5:[\n\C-m]\\)\\|\\(?10:"
236 (batch-step (min 1024 (/ vlf-batch-size 8)))
237 (is-hexl (derived-mode-p 'hexl-mode))
240 (tune-types (if is-hexl '(:hexl :dehexlify :insert :encode)
242 (reporter (make-progress-reporter
243 (concat "Building index for " regexp "...")
244 vlf-start-pos vlf-file-size)))
245 (with-current-buffer occur-buffer
246 (setq buffer-undo-list t))
249 (while (not end-of-file)
250 (if (re-search-forward line-regexp nil t)
252 (setq match-end-pos (+ vlf-start-pos
256 (setq line (1+ line) ; line detected
257 last-line-pos (point))
258 (let* ((chunk-start vlf-start-pos)
259 (chunk-end vlf-end-pos)
260 (line-pos (line-beginning-position))
261 (line-text (buffer-substring
262 line-pos (line-end-position))))
263 (with-current-buffer occur-buffer
264 (unless (= line last-match-line) ;new match line
265 (insert "\n:") ; insert line number
266 (let* ((overlay-pos (1- (point)))
267 (overlay (make-overlay
270 (overlay-put overlay 'before-string
272 (number-to-string line)
274 (insert (propertize line-text ; insert line
275 'chunk-start chunk-start
277 'mouse-face '(highlight)
280 (format "Move to line %d"
282 (setq last-match-line line
283 total-matches (1+ total-matches))
284 (let ((line-start (1+
285 (line-beginning-position)))
286 (match-pos (match-beginning 10)))
287 (add-text-properties ; mark match
288 (+ line-start match-pos (- last-line-pos))
289 (+ line-start (match-end 10)
293 (format "Move to match %d"
294 total-matches))))))))
295 (setq end-of-file (= vlf-end-pos vlf-file-size))
297 (vlf-tune-batch tune-types)
298 (let ((batch-move (- vlf-end-pos batch-step)))
299 (vlf-move-to-batch (if (or is-hexl
304 (goto-char (if (or is-hexl
305 (<= match-end-pos vlf-start-pos))
307 (or (byte-to-position (- match-end-pos
310 (setq last-match-line 0
311 last-line-pos (line-beginning-position))
312 (progress-reporter-update reporter vlf-end-pos))))
313 (progress-reporter-done reporter))
314 (set-buffer-modified-p nil)
315 (if (zerop total-matches)
316 (progn (kill-buffer occur-buffer)
317 (message "No matches for \"%s\" (%f secs)"
318 regexp (- (float-time) time)))
319 (let ((file buffer-file-name)
320 (dir default-directory))
321 (with-current-buffer occur-buffer
322 (goto-char (point-min))
324 (format "%d matches from %d lines for \"%s\" \
325 in file: %s" total-matches line regexp file)
327 (set-buffer-modified-p nil)
330 (setq default-directory dir
331 vlf-occur-vlf-file file
332 vlf-occur-vlf-buffer vlf-buffer
333 vlf-occur-regexp regexp
334 vlf-occur-hexl is-hexl
335 vlf-occur-lines line)))
336 (display-buffer occur-buffer)
337 (message "Occur finished for \"%s\" (%f secs)"
338 regexp (- (float-time) time))))))
340 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
341 ;;; save, load vlf-occur data
343 (defun vlf-occur-save (file)
344 "Serialize `vlf-occur' results to FILE which can later be reloaded."
345 (interactive (list (or buffer-file-name
346 (read-file-name "Save vlf-occur results in: "
349 (file-name-nondirectory
352 (setq buffer-file-name file)
353 (let ((vlf-occur-save-buffer
354 (generate-new-buffer (concat "*VLF-occur-save "
355 (file-name-nondirectory file)
357 (with-current-buffer vlf-occur-save-buffer
358 (setq buffer-file-name file
360 (insert ";; -*- eval: (vlf-occur-load) -*-\n"))
361 (prin1 (list vlf-occur-vlf-file vlf-occur-regexp vlf-occur-hexl
363 vlf-occur-save-buffer)
365 (goto-char (point-min))
366 (while (zerop (forward-line))
367 (let* ((pos (1+ (point)))
368 (line (get-char-property (1- pos) 'before-string)))
370 (prin1 (list (string-to-number line)
371 (get-text-property pos 'chunk-start)
372 (get-text-property pos 'chunk-end)
373 (get-text-property pos 'line-pos)
374 (buffer-substring-no-properties
375 pos (line-end-position)))
376 vlf-occur-save-buffer)))))
377 (with-current-buffer vlf-occur-save-buffer
379 (kill-buffer vlf-occur-save-buffer))
383 (defun vlf-occur-load ()
384 "Load serialized `vlf-occur' results from current buffer."
386 (goto-char (point-min))
387 (let* ((vlf-occur-data-buffer (current-buffer))
388 (header (read vlf-occur-data-buffer))
389 (vlf-file (nth 0 header))
390 (regexp (nth 1 header))
391 (all-lines (nth 3 header))
392 (file buffer-file-name)
394 (generate-new-buffer (concat "*VLF-occur "
395 (file-name-nondirectory file)
397 (switch-to-buffer vlf-occur-buffer)
398 (setq buffer-file-name file
400 (goto-char (point-min))
401 (let ((match-count 0)
403 (while (setq form (ignore-errors (read vlf-occur-data-buffer)))
404 (goto-char (point-max))
406 (let* ((overlay-pos (1- (point)))
407 (overlay (make-overlay overlay-pos (1+ overlay-pos)))
408 (line (number-to-string (nth 0 form)))
410 (overlay-put overlay 'before-string
411 (propertize line 'face 'shadow))
412 (insert (propertize (nth 4 form) 'chunk-start (nth 1 form)
413 'chunk-end (nth 2 form)
414 'mouse-face '(highlight)
415 'line-pos (nth 3 form)
416 'help-echo (concat "Move to line "
419 (while (re-search-forward regexp nil t)
421 (match-beginning 0) (match-end 0)
422 (list 'face 'match 'help-echo
423 (format "Move to match %d"
424 (setq match-count (1+ match-count))))))))
425 (kill-buffer vlf-occur-data-buffer)
426 (goto-char (point-min))
428 (format "%d matches from %d lines for \"%s\" in file: %s"
429 match-count all-lines regexp vlf-file)
431 (set-buffer-modified-p nil)
433 (setq vlf-occur-vlf-file vlf-file
434 vlf-occur-regexp regexp
435 vlf-occur-hexl (nth 2 header)
436 vlf-occur-lines all-lines)))
440 ;;; vlf-occur.el ends here