1 ;;; vlf.el --- View Large Files -*- lexical-binding: t -*-
3 ;; Copyright (C) 2006, 2012, 2013 Free Software Foundation, Inc.
6 ;; Keywords: large files, utilities
7 ;; Maintainer: Andrey Kotlarski <m00naticus@gmail.com>
8 ;; Authors: 2006 Mathias Dahl <mathias.dahl@gmail.com>
9 ;; 2012 Sam Steingold <sds@gnu.org>
10 ;; 2013 Andrey Kotlarski <m00naticus@gmail.com>
11 ;; URL: https://github.com/m00natic/vlfi
13 ;; This file is free software; you can redistribute it and/or modify
14 ;; it under the terms of the GNU General Public License as published by
15 ;; the Free Software Foundation; either version 2, or (at your option)
18 ;; This file is distributed in the hope that it will be useful,
19 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
20 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
21 ;; GNU General Public License for more details.
23 ;; You should have received a copy of the GNU General Public License
24 ;; along with GNU Emacs; see the file COPYING. If not, write to
25 ;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
26 ;; Boston, MA 02111-1307, USA.
30 ;; This package provides the M-x vlf command, which visits part of a
31 ;; large file without loading the entire file.
32 ;; The buffer uses VLF mode, which defines several commands for
33 ;; moving around, searching and editing selected part of file.
35 ;; This package was inspired by a snippet posted by Kevin Rodgers,
36 ;; showing how to use `insert-file-contents' to extract part of a
42 "View Large Files in Emacs."
46 (defcustom vlf-batch-size 1024
47 "Defines how large each batch of file data is (in bytes)."
50 (put 'vlf-batch-size 'permanent-local t)
52 ;;; used by the autoloaded abort-if-file-too-large advice
54 (defcustom vlf-application 'ask
55 "Determines when `vlf' will be offered on opening files.
56 Possible values are: nil to never use it;
57 `ask' offer `vlf' when file size is beyond `large-file-warning-threshold';
58 `dont-ask' automatically use `vlf' for large files;
59 `always' use `vlf' for all files."
61 :type '(radio (const :format "%v " nil)
62 (const :format "%v " ask)
63 (const :format "%v " dont-ask)
64 (const :format "%v" always)))
66 ;;; Keep track of file position.
67 (defvar vlf-start-pos 0
68 "Absolute position of the visible chunk start.")
69 (put 'vlf-start-pos 'permanent-local t)
71 (defvar vlf-end-pos 0 "Absolute position of the visible chunk end.")
72 (put 'vlf-end-pos 'permanent-local t)
74 (defvar vlf-file-size 0 "Total size of presented file.")
75 (put 'vlf-file-size 'permanent-local t)
78 (let ((map (make-sparse-keymap)))
79 (define-key map "n" 'vlf-next-batch)
80 (define-key map "p" 'vlf-prev-batch)
81 (define-key map " " 'vlf-next-batch-from-point)
82 (define-key map "+" 'vlf-change-batch-size)
84 (lambda () "Decrease vlf batch size by factor of 2."
86 (vlf-change-batch-size t)))
87 (define-key map "s" 'vlf-re-search-forward)
88 (define-key map "r" 'vlf-re-search-backward)
89 (define-key map "o" 'vlf-occur)
90 (define-key map "[" 'vlf-beginning-of-file)
91 (define-key map "]" 'vlf-end-of-file)
92 (define-key map "j" 'vlf-jump-to-chunk)
93 (define-key map "l" 'vlf-goto-line)
94 (define-key map "g" 'vlf-revert)
96 "Keymap for `vlf-mode'.")
98 (defvar vlf-prefix-map
99 (let ((map (make-sparse-keymap)))
100 (define-key map "\C-c\C-v" vlf-mode-map)
102 "Prefixed keymap for `vlf-mode'.")
104 (defmacro vlf-with-undo-disabled (&rest body)
105 "Execute BODY with temporarily disabled undo."
106 `(let ((undo-enabled (not (eq buffer-undo-list t))))
108 (buffer-disable-undo))
109 (unwind-protect (progn ,@body)
111 (buffer-enable-undo)))))
113 (define-minor-mode vlf-mode
114 "Mode to browse large files in."
117 :keymap vlf-prefix-map
120 (set (make-local-variable 'require-final-newline) nil)
121 (add-hook 'write-file-functions 'vlf-write nil t)
122 (set (make-local-variable 'revert-buffer-function)
124 (make-local-variable 'vlf-batch-size)
125 (set (make-local-variable 'vlf-file-size)
126 (vlf-get-file-size buffer-file-truename))
127 (set (make-local-variable 'vlf-start-pos) 0)
128 (set (make-local-variable 'vlf-end-pos) 0)
129 (let* ((pos (position-bytes (point)))
130 (start (* (/ pos vlf-batch-size) vlf-batch-size)))
131 (goto-char (byte-to-position (- pos start)))
132 (vlf-move-to-batch start)))
133 (kill-local-variable 'revert-buffer-function)
134 (when (or (not large-file-warning-threshold)
135 (< vlf-file-size large-file-warning-threshold)
136 (y-or-n-p (format "Load whole file (%s)? "
137 (file-size-human-readable
139 (kill-local-variable 'require-final-newline)
140 (remove-hook 'write-file-functions 'vlf-write t)
141 (let ((pos (+ vlf-start-pos (position-bytes (point)))))
142 (vlf-with-undo-disabled
143 (insert-file-contents buffer-file-name t nil nil t))
144 (goto-char (byte-to-position pos)))
145 (rename-buffer (file-name-nondirectory buffer-file-name) t))))
149 "View Large FILE in batches.
150 You can customize number of bytes displayed by customizing
152 (interactive "fFile to open: ")
153 (with-current-buffer (generate-new-buffer "*vlf*")
154 (set-visited-file-name file)
155 (set-buffer-modified-p nil)
157 (switch-to-buffer (current-buffer))))
159 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
160 ;;; integration with other packages
164 "In Dired, visit the file on this line in VLF mode."
166 (vlf (dired-get-file-for-visit)))
169 (eval-after-load "dired"
170 '(define-key dired-mode-map "V" 'dired-vlf))
172 ;;; used by the autoloaded abort-if-file-too-large advice
174 (defcustom vlf-forbidden-modes-list
175 '(archive-mode tar-mode jka-compr git-commit-mode image-mode
176 doc-view-mode doc-view-mode-maybe ebrowse-tree-mode)
177 "Major modes which VLF will not be automatically applied to."
179 :type '(list symbol))
181 ;;; used by the autoloaded abort-if-file-too-large advice
183 (defun vlf-determine-major-mode (filename)
184 "Determine major mode from FILENAME."
185 (let ((name filename)
186 (remote-id (file-remote-p filename))
188 ;; Remove backup-suffixes from file name.
189 (setq name (file-name-sans-versions name))
190 ;; Remove remote file name identification.
191 (and (stringp remote-id)
192 (string-match (regexp-quote remote-id) name)
193 (setq name (substring name (match-end 0))))
195 (if (memq system-type '(windows-nt cygwin))
196 ;; System is case-insensitive.
197 (let ((case-fold-search t))
198 (assoc-default name auto-mode-alist 'string-match))
199 ;; System is case-sensitive.
200 (or ;; First match case-sensitively.
201 (let ((case-fold-search nil))
202 (assoc-default name auto-mode-alist 'string-match))
203 ;; Fallback to case-insensitive match.
204 (and auto-mode-case-fold
205 (let ((case-fold-search t))
206 (assoc-default name auto-mode-alist
208 (if (and mode (consp mode))
212 ;;; autoload this so vlf is available as soon as file is opened
214 (defadvice abort-if-file-too-large (around vlf-if-file-too-large
216 "If file SIZE larger than `large-file-warning-threshold', \
217 allow user to view file with `vlf', open it normally, or abort.
218 OP-TYPE specifies the file operation being performed over FILENAME."
220 ((or (not size) (zerop size)))
221 ((or (not vlf-application)
223 (memq (vlf-determine-major-mode filename)
224 vlf-forbidden-modes-list))
226 ((eq vlf-application 'always)
229 ((and large-file-warning-threshold
230 (< large-file-warning-threshold size))
231 (if (eq vlf-application 'dont-ask)
232 (progn (vlf filename)
235 (while (not (memq (setq char
239 "File %s is large (%s): \
240 %s normally (o), %s with vlf (v) or abort (a)"
242 (file-name-nondirectory filename)
244 (file-size-human-readable size)
246 'face 'minibuffer-prompt)))
247 '(?o ?O ?v ?V ?a ?A))))
248 (cond ((memq char '(?v ?V))
251 ((memq char '(?a ?A))
252 (error "Aborted"))))))))
254 ;; scroll auto batching
255 (defadvice scroll-up (around vlf-scroll-up
257 "Slide to next batch if at end of buffer in `vlf-mode'."
258 (if (and vlf-mode (pos-visible-in-window-p (point-max)))
259 (progn (vlf-next-batch 1)
260 (goto-char (point-min)))
263 (defadvice scroll-down (around vlf-scroll-down
265 "Slide to previous batch if at beginning of buffer in `vlf-mode'."
266 (if (and vlf-mode (pos-visible-in-window-p (point-min)))
267 (progn (vlf-prev-batch 1)
268 (goto-char (point-max)))
273 (unless (fboundp 'file-size-human-readable)
274 (defun file-size-human-readable (file-size)
275 "Print FILE-SIZE in MB."
276 (format "%.3fMB" (/ file-size 1048576.0))))
278 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
281 (defun vlf-change-batch-size (decrease)
282 "Change the buffer-local value of `vlf-batch-size'.
283 Normally, the value is doubled;
284 with the prefix argument DECREASE it is halved."
286 (setq vlf-batch-size (if decrease
288 (* vlf-batch-size 2)))
289 (vlf-move-to-batch vlf-start-pos))
291 (defun vlf-update-buffer-name ()
292 "Update the current buffer name."
293 (rename-buffer (format "%s(%d/%d)[%s]"
294 (file-name-nondirectory buffer-file-name)
295 (/ vlf-end-pos vlf-batch-size)
296 (/ vlf-file-size vlf-batch-size)
297 (file-size-human-readable vlf-batch-size))
300 (defun vlf-get-file-size (file)
301 "Get size in bytes of FILE."
302 (or (nth 7 (file-attributes file)) 0))
304 (defun vlf-verify-size ()
305 "Update file size information if necessary and visited file time."
306 (unless (verify-visited-file-modtime (current-buffer))
307 (setq vlf-file-size (vlf-get-file-size buffer-file-truename))
308 (set-visited-file-modtime)))
310 (defun vlf-insert-file (&optional from-end)
311 "Insert first chunk of current file contents in current buffer.
312 With FROM-END prefix, start from the back."
314 (end vlf-batch-size))
316 (setq start (- vlf-file-size vlf-batch-size)
318 (setq end (min vlf-batch-size vlf-file-size)))
319 (vlf-move-to-chunk start end)))
321 (defun vlf-beginning-of-file ()
322 "Jump to beginning of file content."
326 (defun vlf-end-of-file ()
327 "Jump to end of file content."
331 (defun vlf-revert (&optional _ignore-auto noconfirm)
332 "Revert current chunk. Ignore _IGNORE-AUTO.
333 Ask for confirmation if NOCONFIRM is nil."
336 (yes-or-no-p (format "Revert buffer from file %s? "
338 (set-buffer-modified-p nil)
339 (set-visited-file-modtime)
340 (vlf-move-to-chunk-2 vlf-start-pos vlf-end-pos)))
342 (defun vlf-jump-to-chunk (n)
344 (interactive "nGoto to chunk: ")
345 (vlf-move-to-batch (* (1- n) vlf-batch-size)))
347 (defun vlf-no-modifications ()
348 "Ensure there are no buffer modifications."
349 (if (buffer-modified-p)
350 (error "Save or discard your changes first")
353 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
356 (defun vlf-next-batch (append)
357 "Display the next batch of file data.
358 When prefix argument is supplied and positive
359 jump over APPEND number of batches.
360 When prefix argument is negative
361 append next APPEND number of batches to the existing buffer."
364 (let* ((end (min (+ vlf-end-pos (* vlf-batch-size (abs append)))
366 (start (if (< append 0)
368 (- end vlf-batch-size))))
369 (vlf-move-to-chunk start end)))
371 (defun vlf-prev-batch (prepend)
372 "Display the previous batch of file data.
373 When prefix argument is supplied and positive
374 jump over PREPEND number of batches.
375 When prefix argument is negative
376 append previous PREPEND number of batches to the existing buffer."
378 (if (zerop vlf-start-pos)
379 (error "Already at BOF"))
380 (let* ((start (max 0 (- vlf-start-pos (* vlf-batch-size (abs prepend)))))
381 (end (if (< prepend 0)
383 (+ start vlf-batch-size))))
384 (vlf-move-to-chunk start end)))
386 (defun vlf-move-to-batch (start &optional minimal)
387 "Move to batch determined by START.
388 Adjust according to file start/end and show `vlf-batch-size' bytes.
389 When given MINIMAL flag, skip non important operations."
391 (let* ((start (max 0 start))
392 (end (min (+ start vlf-batch-size) vlf-file-size)))
393 (if (= vlf-file-size end) ; re-adjust start
394 (setq start (max 0 (- end vlf-batch-size))))
395 (vlf-move-to-chunk start end minimal)))
397 (defun vlf-next-batch-from-point ()
398 "Display batch of file data starting from current point."
400 (let ((start (+ vlf-start-pos (position-bytes (point)) -1)))
401 (vlf-move-to-chunk start (+ start vlf-batch-size)))
402 (goto-char (point-min)))
404 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
405 ;;; primitive chunk operations
407 (defun vlf-move-to-chunk (start end &optional minimal)
408 "Move to chunk determined by START END.
409 When given MINIMAL flag, skip non important operations.
410 If same as current chunk is requested, do nothing."
411 (unless (and (= start vlf-start-pos)
414 (if (vlf-move-to-chunk-1 start end)
415 (or minimal (vlf-update-buffer-name)))))
417 (defun vlf-move-to-chunk-1 (start end)
418 "Move to chunk determined by START END keeping as much edits if any.
419 Return t if move hasn't been canceled."
420 (let ((modified (buffer-modified-p))
421 (start (max 0 start))
422 (end (min end vlf-file-size))
423 (edit-end (+ (position-bytes (point-max)) vlf-start-pos)))
425 ((and (= start vlf-start-pos) (= end edit-end))
427 (vlf-move-to-chunk-2 start end)
429 ((or (<= edit-end start) (<= end vlf-start-pos))
430 (when (or (not modified)
431 (y-or-n-p "Chunk modified, are you sure? ")) ;full chunk renewal
432 (set-buffer-modified-p nil)
433 (vlf-move-to-chunk-2 start end)
435 ((or (and (<= start vlf-start-pos) (<= edit-end end))
437 (y-or-n-p "Chunk modified, are you sure? "))
438 (let ((pos (+ (position-bytes (point)) vlf-start-pos))
441 (inhibit-read-only t))
442 (cond ((< end edit-end)
443 (let* ((del-pos (1+ (byte-to-position
444 (- end vlf-start-pos))))
445 (del-len (length (encode-coding-region
447 buffer-file-coding-system
449 (setq end (- (if (zerop vlf-end-pos)
453 (vlf-with-undo-disabled
454 (delete-region del-pos (point-max)))))
456 (let ((edit-end-pos (point-max)))
457 (goto-char edit-end-pos)
458 (vlf-with-undo-disabled
459 (insert-file-contents buffer-file-name nil
461 (setq shift-end (cdr (vlf-adjust-chunk
462 vlf-end-pos end nil t
464 (cond ((< vlf-start-pos start)
465 (let* ((del-pos (1+ (byte-to-position
466 (- start vlf-start-pos))))
467 (del-len (length (encode-coding-region
469 buffer-file-coding-system
471 (setq start (+ vlf-start-pos del-len))
472 (vlf-with-undo-disabled
473 (delete-region (point-min) del-pos))))
474 ((< start vlf-start-pos)
475 (let ((edit-end-pos (point-max)))
476 (goto-char edit-end-pos)
477 (vlf-with-undo-disabled
478 (insert-file-contents buffer-file-name nil
480 (setq shift-start (car
481 (vlf-adjust-chunk start
485 (goto-char (point-min))
486 (insert (delete-and-extract-region edit-end-pos
488 (setq start (- start shift-start))
489 (goto-char (or (byte-to-position (- pos start))
490 (byte-to-position (- pos vlf-start-pos))
492 (setq vlf-start-pos start
493 vlf-end-pos (+ end shift-end)))
494 (set-buffer-modified-p modified)
497 (defun vlf-move-to-chunk-2 (start end)
498 "Unconditionally move to chunk determined by START END."
499 (setq vlf-start-pos (max 0 start)
500 vlf-end-pos (min end vlf-file-size))
501 (let ((inhibit-read-only t)
502 (pos (position-bytes (point))))
503 (vlf-with-undo-disabled
505 (insert-file-contents buffer-file-name nil
506 vlf-start-pos vlf-end-pos)
507 (let ((shifts (vlf-adjust-chunk vlf-start-pos vlf-end-pos t
509 (setq vlf-start-pos (- vlf-start-pos (car shifts))
510 vlf-end-pos (+ vlf-end-pos (cdr shifts)))
511 (goto-char (or (byte-to-position (+ pos (car shifts)))
513 (set-buffer-modified-p nil)
514 (set-visited-file-modtime))
516 (defun vlf-adjust-chunk (start end &optional adjust-start adjust-end
518 "Adjust chunk at absolute START to END till content can be\
519 properly decoded. ADJUST-START determines if trying to prepend bytes\
520 to the beginning, ADJUST-END - append to the end.
521 Use buffer POSITION as start if given.
522 Return number of bytes moved back for proper decoding and number of
523 bytes added to the end."
524 (let ((shift-start 0)
527 (let ((position (or position (point-min)))
528 (chunk-size (- end start)))
529 (while (and (not (zerop start))
531 (< 4 (abs (- chunk-size
532 (length (encode-coding-region
534 buffer-file-coding-system
536 (setq shift-start (1+ shift-start)
538 chunk-size (1+ chunk-size))
539 (delete-region position (point-max))
541 (insert-file-contents buffer-file-name nil start end))))
543 (cond ((vlf-partial-decode-shown-p) ;remove raw bytes from end
544 (goto-char (point-max))
545 (while (eq (char-charset (preceding-char)) 'eight-bit)
546 (setq shift-end (1- shift-end))
548 ((< end vlf-file-size) ;add bytes until new character is displayed
549 (let ((position (or position (point-min)))
550 (expected-size (buffer-size)))
552 (setq shift-end (1+ shift-end)
554 (delete-region position (point-max))
556 (insert-file-contents buffer-file-name
558 (< end vlf-file-size))
559 (= expected-size (buffer-size))))))))
560 (cons shift-start shift-end)))
562 (defun vlf-partial-decode-shown-p ()
563 "Determine if partial decode codes are displayed.
564 This seems to be the case with GNU/Emacs before 24.4."
565 (cond ((< emacs-major-version 24) t)
566 ((< 24 emacs-major-version) nil)
567 (t ;; TODO: use (< emacs-minor-version 4) after 24.4 release
568 (string-lessp emacs-version "24.3.5"))))
570 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
573 (defun vlf-re-search (regexp count backward batch-step)
574 "Search for REGEXP COUNT number of times forward or BACKWARD.
575 BATCH-STEP is amount of overlap between successive chunks."
577 (error "Count must be positive"))
578 (let* ((case-fold-search t)
579 (match-chunk-start vlf-start-pos)
580 (match-chunk-end vlf-end-pos)
581 (match-start-pos (+ vlf-start-pos (position-bytes (point))))
582 (match-end-pos match-start-pos)
584 (reporter (make-progress-reporter
585 (concat "Searching for " regexp "...")
587 (- vlf-file-size vlf-end-pos)
590 (vlf-with-undo-disabled
594 (while (not (zerop to-find))
595 (cond ((re-search-backward regexp nil t)
596 (setq to-find (1- to-find)
597 match-chunk-start vlf-start-pos
598 match-chunk-end vlf-end-pos
599 match-start-pos (+ vlf-start-pos
601 (match-beginning 0)))
602 match-end-pos (+ vlf-start-pos
605 ((zerop vlf-start-pos)
606 (throw 'end-of-file nil))
607 (t (let ((batch-move (- vlf-start-pos
611 (if (< match-start-pos batch-move)
612 (- match-start-pos vlf-batch-size)
614 (goto-char (if (< match-start-pos
616 (or (byte-to-position
621 (progress-reporter-update
622 reporter (- vlf-file-size
624 (while (not (zerop to-find))
625 (cond ((re-search-forward regexp nil t)
626 (setq to-find (1- to-find)
627 match-chunk-start vlf-start-pos
628 match-chunk-end vlf-end-pos
629 match-start-pos (+ vlf-start-pos
631 (match-beginning 0)))
632 match-end-pos (+ vlf-start-pos
635 ((= vlf-end-pos vlf-file-size)
636 (throw 'end-of-file nil))
637 (t (let ((batch-move (- vlf-end-pos batch-step)))
639 (if (< batch-move match-end-pos)
642 (goto-char (if (< vlf-start-pos match-end-pos)
643 (or (byte-to-position
648 (progress-reporter-update reporter
650 (progress-reporter-done reporter))
651 (set-buffer-modified-p nil)
653 (vlf-goto-match match-chunk-start match-chunk-end
654 match-end-pos match-start-pos
656 (vlf-goto-match match-chunk-start match-chunk-end
657 match-start-pos match-end-pos
660 (defun vlf-goto-match (match-chunk-start match-chunk-end
664 "Move to MATCH-CHUNK-START MATCH-CHUNK-END surrounding \
665 MATCH-POS-START and MATCH-POS-END.
666 According to COUNT and left TO-FIND, show if search has been
667 successful. Return nil if nothing found."
668 (if (= count to-find)
669 (progn (vlf-move-to-chunk match-chunk-start match-chunk-end)
670 (goto-char (or (byte-to-position (- match-pos-start
673 (message "Not found")
675 (let ((success (zerop to-find)))
677 (vlf-update-buffer-name)
678 (vlf-move-to-chunk match-chunk-start match-chunk-end))
679 (let* ((match-end (or (byte-to-position (- match-pos-end
682 (overlay (make-overlay (byte-to-position
686 (overlay-put overlay 'face 'match)
688 (goto-char match-end)
689 (message "Moved to the %d match which is last"
691 (unwind-protect (sit-for 3)
692 (delete-overlay overlay))
695 (defun vlf-re-search-forward (regexp count)
696 "Search forward for REGEXP prefix COUNT number of times.
697 Search is performed chunk by chunk in `vlf-batch-size' memory."
698 (interactive (if (vlf-no-modifications)
699 (list (read-regexp "Search whole file"
701 (car regexp-history)))
702 (or current-prefix-arg 1))))
703 (vlf-re-search regexp count nil (/ vlf-batch-size 8)))
705 (defun vlf-re-search-backward (regexp count)
706 "Search backward for REGEXP prefix COUNT number of times.
707 Search is performed chunk by chunk in `vlf-batch-size' memory."
708 (interactive (if (vlf-no-modifications)
709 (list (read-regexp "Search whole file backward"
711 (car regexp-history)))
712 (or current-prefix-arg 1))))
713 (vlf-re-search regexp count t (/ vlf-batch-size 8)))
715 (defun vlf-goto-line (n)
716 "Go to line N. If N is negative, count from the end of file."
717 (interactive (if (vlf-no-modifications)
718 (list (read-number "Go to line: "))))
719 (let ((start-pos vlf-start-pos)
720 (end-pos vlf-end-pos)
725 (progn (vlf-beginning-of-file)
726 (goto-char (point-min))
727 (setq success (vlf-re-search "[\n\C-m]" (1- n)
730 (goto-char (point-max))
731 (setq success (vlf-re-search "[\n\C-m]" (- n) t 0)))
733 (message "Onto line %s" n)
734 (vlf-move-to-chunk start-pos end-pos)
737 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
740 (defvar vlf-occur-mode-map
741 (let ((map (make-sparse-keymap)))
742 (define-key map "n" 'vlf-occur-next-match)
743 (define-key map "p" 'vlf-occur-prev-match)
744 (define-key map "\C-m" 'vlf-occur-visit)
745 (define-key map "\M-\r" 'vlf-occur-visit-new-buffer)
746 (define-key map [mouse-1] 'vlf-occur-visit)
747 (define-key map "o" 'vlf-occur-show)
749 "Keymap for command `vlf-occur-mode'.")
751 (define-derived-mode vlf-occur-mode special-mode "VLF[occur]"
752 "Major mode for showing occur matches of VLF opened files.")
754 (defun vlf-occur-next-match ()
755 "Move cursor to next match."
757 (if (eq (get-char-property (point) 'face) 'match)
758 (goto-char (next-single-property-change (point) 'face)))
759 (goto-char (or (text-property-any (point) (point-max) 'face 'match)
760 (text-property-any (point-min) (point)
763 (defun vlf-occur-prev-match ()
764 "Move cursor to previous match."
766 (if (eq (get-char-property (point) 'face) 'match)
767 (goto-char (previous-single-property-change (point) 'face)))
768 (while (not (eq (get-char-property (point) 'face) 'match))
769 (goto-char (or (previous-single-property-change (point) 'face)
772 (defun vlf-occur-show (&optional event)
773 "Visit current `vlf-occur' link in a vlf buffer but stay in the \
774 occur buffer. If original VLF buffer has been killed,
775 open new VLF session each time.
776 EVENT may hold details of the invocation."
777 (interactive (list last-nonmenu-event))
778 (let ((occur-buffer (if event
779 (window-buffer (posn-window
782 (vlf-occur-visit event)
783 (pop-to-buffer occur-buffer)))
785 (defun vlf-occur-visit-new-buffer ()
786 "Visit `vlf-occur' link in new vlf buffer."
788 (let ((current-prefix-arg t))
791 (defun vlf-occur-visit (&optional event)
792 "Visit current `vlf-occur' link in a vlf buffer.
793 With prefix argument or if original VLF buffer has been killed,
794 open new VLF session.
795 EVENT may hold details of the invocation."
796 (interactive (list last-nonmenu-event))
798 (set-buffer (window-buffer (posn-window (event-end event))))
799 (goto-char (posn-point (event-end event))))
801 (pos-relative (- pos (line-beginning-position) 1))
802 (file (get-char-property pos 'file)))
804 (let ((chunk-start (get-char-property pos 'chunk-start))
805 (chunk-end (get-char-property pos 'chunk-end))
806 (vlf-buffer (get-char-property pos 'buffer))
807 (occur-buffer (current-buffer))
808 (match-pos (+ (get-char-property pos 'line-pos)
810 (cond (current-prefix-arg
811 (setq vlf-buffer (vlf file))
812 (switch-to-buffer occur-buffer))
813 ((not (buffer-live-p vlf-buffer))
815 (dolist (buf (buffer-list))
817 (and vlf-mode (equal file buffer-file-name)
818 (setq vlf-buffer buf)
820 (setq vlf-buffer (vlf file)))
821 (switch-to-buffer occur-buffer)))
822 (pop-to-buffer vlf-buffer)
823 (vlf-move-to-chunk chunk-start chunk-end)
824 (goto-char match-pos)))))
826 (defun vlf-occur (regexp)
827 "Make whole file occur style index for REGEXP.
828 Prematurely ending indexing will still show what's found so far."
829 (interactive (list (read-regexp "List lines matching regexp"
831 (car regexp-history)))))
832 (if (buffer-modified-p) ;use temporary buffer not to interfere with modifications
833 (let ((vlf-buffer (current-buffer))
834 (file buffer-file-name)
835 (batch-size vlf-batch-size))
837 (setq buffer-file-name file)
838 (set-buffer-modified-p nil)
839 (set (make-local-variable 'vlf-batch-size) batch-size)
841 (goto-char (point-min))
842 (vlf-with-undo-disabled
843 (vlf-build-occur regexp vlf-buffer))))
844 (let ((start-pos vlf-start-pos)
845 (end-pos vlf-end-pos)
847 (vlf-beginning-of-file)
848 (goto-char (point-min))
849 (vlf-with-undo-disabled
850 (unwind-protect (vlf-build-occur regexp (current-buffer))
851 (vlf-move-to-chunk start-pos end-pos)
854 (defun vlf-build-occur (regexp vlf-buffer)
855 "Build occur style index for REGEXP over VLF-BUFFER."
856 (let ((case-fold-search t)
859 (last-line-pos (point-min))
860 (file buffer-file-name)
862 (match-end-pos (+ vlf-start-pos (position-bytes (point))))
863 (occur-buffer (generate-new-buffer
864 (concat "*VLF-occur " (file-name-nondirectory
867 (line-regexp (concat "\\(?5:[\n\C-m]\\)\\|\\(?10:"
869 (batch-step (/ vlf-batch-size 8))
871 (reporter (make-progress-reporter
872 (concat "Building index for " regexp "...")
873 vlf-start-pos vlf-file-size)))
876 (while (not end-of-file)
877 (if (re-search-forward line-regexp nil t)
879 (setq match-end-pos (+ vlf-start-pos
883 (setq line (1+ line) ; line detected
884 last-line-pos (point))
885 (let* ((chunk-start vlf-start-pos)
886 (chunk-end vlf-end-pos)
887 (line-pos (line-beginning-position))
888 (line-text (buffer-substring
889 line-pos (line-end-position))))
890 (with-current-buffer occur-buffer
891 (unless (= line last-match-line) ;new match line
892 (insert "\n:") ; insert line number
893 (let* ((overlay-pos (1- (point)))
894 (overlay (make-overlay
897 (overlay-put overlay 'before-string
899 (number-to-string line)
901 (insert (propertize line-text ; insert line
904 'chunk-start chunk-start
906 'mouse-face '(highlight)
909 (format "Move to line %d"
911 (setq last-match-line line
912 total-matches (1+ total-matches))
913 (let ((line-start (1+
914 (line-beginning-position)))
915 (match-pos (match-beginning 10)))
916 (add-text-properties ; mark match
917 (+ line-start match-pos (- last-line-pos))
918 (+ line-start (match-end 10)
922 (format "Move to match %d"
923 total-matches))))))))
924 (setq end-of-file (= vlf-end-pos vlf-file-size))
926 (let ((batch-move (- vlf-end-pos batch-step)))
927 (vlf-move-to-batch (if (< batch-move match-end-pos)
930 (goto-char (if (< vlf-start-pos match-end-pos)
931 (or (byte-to-position (- match-end-pos
935 (setq last-match-line 0
936 last-line-pos (line-beginning-position))
937 (progress-reporter-update reporter vlf-end-pos))))
938 (progress-reporter-done reporter))
939 (set-buffer-modified-p nil)
940 (if (zerop total-matches)
941 (progn (with-current-buffer occur-buffer
942 (set-buffer-modified-p nil))
943 (kill-buffer occur-buffer)
944 (message "No matches for \"%s\"" regexp))
945 (with-current-buffer occur-buffer
946 (goto-char (point-min))
948 (format "%d matches in %d lines for \"%s\" \
949 in file: %s" total-matches line regexp file)
951 (set-buffer-modified-p nil)
954 (display-buffer occur-buffer)))))
956 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
960 "Write current chunk to file. Always return true to disable save.
961 If changing size of chunk, shift remaining file content."
963 (and (buffer-modified-p)
964 (or (verify-visited-file-modtime (current-buffer))
965 (y-or-n-p "File has changed since visited or saved. \
967 (if (zerop vlf-file-size) ;new file
969 (write-region nil nil buffer-file-name vlf-start-pos t)
970 (setq vlf-file-size (vlf-get-file-size
971 buffer-file-truename)
972 vlf-end-pos vlf-file-size)
973 (vlf-update-buffer-name))
974 (let* ((region-length (length (encode-coding-region
975 (point-min) (point-max)
976 buffer-file-coding-system t)))
977 (size-change (- vlf-end-pos vlf-start-pos
979 (if (zerop size-change)
980 (write-region nil nil buffer-file-name vlf-start-pos t)
982 (if (< 0 size-change)
983 (vlf-file-shift-back size-change)
984 (vlf-file-shift-forward (- size-change))
986 (vlf-move-to-chunk-2 vlf-start-pos
987 (if (< (- vlf-end-pos vlf-start-pos)
989 (+ vlf-start-pos vlf-batch-size)
991 (vlf-update-buffer-name)
995 (defun vlf-file-shift-back (size-change)
996 "Shift file contents SIZE-CHANGE bytes back."
997 (write-region nil nil buffer-file-name vlf-start-pos t)
998 (let ((read-start-pos vlf-end-pos)
999 (coding-system-for-write 'no-conversion)
1000 (reporter (make-progress-reporter "Adjusting file content..."
1003 (vlf-with-undo-disabled
1004 (while (vlf-shift-batch read-start-pos (- read-start-pos
1006 (setq read-start-pos (+ read-start-pos vlf-batch-size))
1007 (progress-reporter-update reporter read-start-pos))
1008 ;; pad end with space
1011 (insert-char 32 size-change))
1012 (write-region nil nil buffer-file-name (- vlf-file-size
1014 (progress-reporter-done reporter)))
1016 (defun vlf-shift-batch (read-pos write-pos)
1017 "Read `vlf-batch-size' bytes from READ-POS and write them \
1018 back at WRITE-POS. Return nil if EOF is reached, t otherwise."
1021 (let ((read-end (+ read-pos vlf-batch-size)))
1022 (insert-file-contents-literally buffer-file-name nil
1024 (min vlf-file-size read-end))
1025 (write-region nil nil buffer-file-name write-pos 0)
1026 (< read-end vlf-file-size)))
1028 (defun vlf-file-shift-forward (size-change)
1029 "Shift file contents SIZE-CHANGE bytes forward.
1030 Done by saving content up front and then writing previous batch."
1031 (let ((read-size (max (/ vlf-batch-size 2) size-change))
1032 (read-pos vlf-end-pos)
1033 (write-pos vlf-start-pos)
1034 (reporter (make-progress-reporter "Adjusting file content..."
1037 (vlf-with-undo-disabled
1038 (when (vlf-shift-batches read-size read-pos write-pos t)
1039 (setq write-pos (+ read-pos size-change)
1040 read-pos (+ read-pos read-size))
1041 (progress-reporter-update reporter write-pos)
1042 (let ((coding-system-for-write 'no-conversion))
1043 (while (vlf-shift-batches read-size read-pos write-pos nil)
1044 (setq write-pos (+ read-pos size-change)
1045 read-pos (+ read-pos read-size))
1046 (progress-reporter-update reporter write-pos)))))
1047 (progress-reporter-done reporter)))
1049 (defun vlf-shift-batches (read-size read-pos write-pos hide-read)
1050 "Append READ-SIZE bytes of file starting at READ-POS.
1051 Then write initial buffer content to file at WRITE-POS.
1052 If HIDE-READ is non nil, temporarily hide literal read content.
1053 Return nil if EOF is reached, t otherwise."
1055 (let ((read-more (< read-pos vlf-file-size))
1056 (start-write-pos (point-min))
1057 (end-write-pos (point-max)))
1059 (goto-char end-write-pos)
1060 (insert-file-contents-literally buffer-file-name nil read-pos
1062 (+ read-pos read-size))))
1064 (if hide-read ; hide literal region if user has to choose encoding
1065 (narrow-to-region start-write-pos end-write-pos))
1066 (write-region start-write-pos end-write-pos
1067 buffer-file-name write-pos 0)
1068 (delete-region start-write-pos end-write-pos)
1069 (if hide-read (widen))
1074 ;;; vlf.el ends here