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/vlf
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 ;;; Keep track of file position.
53 (defvar vlf-start-pos 0
54 "Absolute position of the visible chunk start.")
55 (put 'vlf-start-pos 'permanent-local t)
57 (defvar vlf-end-pos 0 "Absolute position of the visible chunk end.")
58 (put 'vlf-end-pos 'permanent-local t)
60 (defvar vlf-file-size 0 "Total size of presented file.")
61 (put 'vlf-file-size 'permanent-local t)
63 (defvar vlf-encode-size 0 "Size in bytes of current batch decoded.")
64 (put 'vlf-encode-size 'permanent-local t)
67 (let ((map (make-sparse-keymap)))
68 (define-key map [M-next] 'vlf-next-batch)
69 (define-key map [M-prior] 'vlf-prev-batch)
70 (define-key map "+" 'vlf-change-batch-size)
72 (lambda () "Decrease vlf batch size by factor of 2."
74 (vlf-change-batch-size t)))
75 (define-key map "s" 'vlf-re-search-forward)
76 (define-key map "r" 'vlf-re-search-backward)
77 (define-key map "o" 'vlf-occur)
78 (define-key map "[" 'vlf-beginning-of-file)
79 (define-key map "]" 'vlf-end-of-file)
80 (define-key map "e" 'vlf-edit-mode)
81 (define-key map "j" 'vlf-jump-to-chunk)
82 (define-key map "l" 'vlf-goto-line)
84 "Keymap for `vlf-mode'.")
86 (define-derived-mode vlf-mode special-mode "VLF"
87 "Mode to browse large files in."
88 (setq buffer-read-only t)
89 (set-buffer-modified-p nil)
91 (add-hook 'write-file-functions 'vlf-write nil t)
92 (make-local-variable 'revert-buffer-function)
93 (setq revert-buffer-function 'vlf-revert)
94 (make-local-variable 'vlf-batch-size)
95 (make-local-variable 'vlf-start-pos)
96 (make-local-variable 'vlf-end-pos)
97 (make-local-variable 'vlf-file-size)
98 (make-local-variable 'vlf-encode-size))
103 Batches of the file data from FILE will be displayed in a read-only
104 buffer. You can customize number of bytes displayed by customizing
106 (interactive "fFile to open: ")
107 (with-current-buffer (generate-new-buffer "*vlf*")
108 (set-visited-file-name file)
110 (setq vlf-file-size (vlf-get-file-size buffer-file-name))
112 (switch-to-buffer (current-buffer))))
114 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
115 ;;; integration with other packages
119 "In Dired, visit the file on this line in VLF mode."
121 (vlf (dired-get-file-for-visit)))
124 (eval-after-load "dired"
125 '(define-key dired-mode-map "V" 'dired-vlf))
128 (defadvice abort-if-file-too-large (around vlf-if-file-too-large
132 "If file SIZE larger than `large-file-warning-threshold', \
133 allow user to view file with `vlf', open it normally, or abort.
134 OP-TYPE specifies the file operation being performed over FILENAME."
135 (and large-file-warning-threshold size
136 (> size large-file-warning-threshold)
138 (while (not (memq (setq char
142 "File %s is large (%s): \
143 %s normally (o), %s with vlf (v) or abort (a)"
145 (file-name-nondirectory filename)
147 (file-size-human-readable size)
149 'face 'minibuffer-prompt)))
150 '(?o ?O ?v ?V ?a ?A))))
151 (cond ((memq char '(?o ?O)))
152 ((memq char '(?v ?V))
155 ((memq char '(?a ?A))
156 (error "Aborted"))))))
159 ;; scroll auto batching
160 (defadvice scroll-up (around vlf-scroll-up
162 "Slide to next batch if at end of buffer in `vlf-mode'."
163 (if (and (derived-mode-p 'vlf-mode)
165 (progn (vlf-next-batch 1)
166 (goto-char (point-min)))
169 (defadvice scroll-down (around vlf-scroll-down
171 "Slide to previous batch if at beginning of buffer in `vlf-mode'."
172 (if (and (derived-mode-p 'vlf-mode)
174 (progn (vlf-prev-batch 1)
175 (goto-char (point-max)))
180 (unless (fboundp 'file-size-human-readable)
181 (defun file-size-human-readable (file-size)
182 "Print FILE-SIZE in MB."
183 (format "%.1fMB" (/ file-size 1048576.0))))
185 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
188 (defun vlf-change-batch-size (decrease)
189 "Change the buffer-local value of `vlf-batch-size'.
190 Normally, the value is doubled;
191 with the prefix argument DECREASE it is halved."
193 (setq vlf-batch-size (if decrease
195 (* vlf-batch-size 2)))
196 (vlf-move-to-batch vlf-start-pos))
198 (defun vlf-format-buffer-name ()
199 "Return format for vlf buffer name."
200 (format "%s(%s)[%d/%d](%d)"
201 (file-name-nondirectory buffer-file-name)
202 (file-size-human-readable vlf-file-size)
203 (/ vlf-end-pos vlf-batch-size)
204 (/ vlf-file-size vlf-batch-size)
207 (defun vlf-update-buffer-name ()
208 "Update the current buffer name."
209 (rename-buffer (vlf-format-buffer-name) t))
211 (defun vlf-get-file-size (file)
212 "Get size in bytes of FILE."
213 (nth 7 (file-attributes file)))
215 (defun vlf-verify-size ()
216 "Update file size information if necessary and visited file time."
217 (unless (verify-visited-file-modtime (current-buffer))
218 (setq vlf-file-size (vlf-get-file-size buffer-file-name))
219 (set-visited-file-modtime)))
221 (defun vlf-insert-file (&optional from-end)
222 "Insert first chunk of current file contents in current buffer.
223 With FROM-END prefix, start from the back."
225 (setq vlf-start-pos (max 0 (- vlf-file-size vlf-batch-size))
226 vlf-end-pos vlf-file-size)
227 (setq vlf-start-pos 0
228 vlf-end-pos (min vlf-batch-size vlf-file-size)))
229 (vlf-move-to-chunk vlf-start-pos vlf-end-pos))
231 (defun vlf-beginning-of-file ()
232 "Jump to beginning of file content."
236 (defun vlf-end-of-file ()
237 "Jump to end of file content."
241 (defun vlf-revert (&optional _ignore-auto noconfirm)
242 "Revert current chunk. Ignore _IGNORE-AUTO.
243 Ask for confirmation if NOCONFIRM is nil."
245 (yes-or-no-p (format "Revert buffer from file %s? "
247 (vlf-move-to-chunk vlf-start-pos vlf-end-pos)))
249 (defun vlf-jump-to-chunk (n)
251 (interactive "nGoto to chunk: ")
252 (vlf-move-to-batch (* (1- n) vlf-batch-size)))
254 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
257 (defun vlf-next-batch (append)
258 "Display the next batch of file data.
259 When prefix argument is supplied and positive
260 jump over APPEND number of batches.
261 When prefix argument is negative
262 append next APPEND number of batches to the existing buffer."
265 (let ((end (min (+ vlf-end-pos (* vlf-batch-size
268 (let ((inhibit-read-only t)
269 (do-append (< append 0))
270 (pos (position-bytes (point))))
272 (goto-char (point-max))
273 (setq vlf-start-pos (- end vlf-batch-size))
275 (insert-file-contents buffer-file-name nil (if do-append
279 (setq vlf-end-pos end)
280 (goto-char (or (byte-to-position (+ pos (vlf-adjust-chunk)))
282 (set-visited-file-modtime)
283 (set-buffer-modified-p nil)
284 (vlf-update-buffer-name))
286 (defun vlf-prev-batch (prepend)
287 "Display the previous batch of file data.
288 When prefix argument is supplied and positive
289 jump over PREPEND number of batches.
290 When prefix argument is negative
291 append previous PREPEND number of batches to the existing buffer."
293 (if (zerop vlf-start-pos)
294 (error "Already at BOF"))
296 (let ((inhibit-read-only t)
297 (start (max 0 (- vlf-start-pos (* vlf-batch-size
299 (do-prepend (< prepend 0))
300 (pos (- (position-bytes (point-max))
301 (position-bytes (point)))))
303 (goto-char (point-min))
304 (setq vlf-end-pos (min (+ start vlf-batch-size)
307 (insert-file-contents buffer-file-name nil start
311 (setq vlf-start-pos start
312 pos (+ pos (vlf-adjust-chunk)))
313 (goto-char (or (byte-to-position (- (position-bytes (point-max))
316 (set-visited-file-modtime)
317 (set-buffer-modified-p nil)
318 (vlf-update-buffer-name))
320 (defun vlf-move-to-batch (start &optional minimal)
321 "Move to batch determined by START.
322 Adjust according to file start/end and show `vlf-batch-size' bytes.
323 When given MINIMAL flag, skip non important operations."
325 (setq vlf-start-pos (max 0 start)
326 vlf-end-pos (min (+ vlf-start-pos vlf-batch-size)
328 (if (= vlf-file-size vlf-end-pos) ; re-check file size
329 (setq vlf-start-pos (max 0 (- vlf-end-pos vlf-batch-size))))
330 (let ((inhibit-read-only t)
331 (pos (position-bytes (point))))
333 (insert-file-contents buffer-file-name nil
334 vlf-start-pos vlf-end-pos)
335 (goto-char (or (byte-to-position (+ pos (vlf-adjust-chunk)))
337 (set-buffer-modified-p nil)
338 (set-visited-file-modtime)
339 (or minimal(vlf-update-buffer-name)))
341 (defun vlf-move-to-chunk (start end &optional minimal)
342 "Move to chunk determined by START END.
343 When given MINIMAL flag, skip non important operations."
345 (setq vlf-start-pos (max 0 start)
346 vlf-end-pos (min end vlf-file-size))
347 (let ((inhibit-read-only t)
348 (pos (position-bytes (point))))
350 (insert-file-contents buffer-file-name nil
351 vlf-start-pos vlf-end-pos)
352 (goto-char (or (byte-to-position (+ pos (vlf-adjust-chunk)))
354 (set-buffer-modified-p nil)
355 (set-visited-file-modtime)
356 (or minimal (vlf-update-buffer-name)))
358 (defun vlf-adjust-chunk ()
359 "Adjust chunk beginning until content can be properly decoded.
360 Set `vlf-encode-size' to size of buffer when encoded.
361 Return number of bytes moved back for this to happen."
363 (chunk-size (- vlf-end-pos vlf-start-pos)))
364 (while (and (< shift 4)
365 (< 4 (abs (- chunk-size
366 (setq vlf-encode-size
367 (length (encode-coding-region
368 (point-min) (point-max)
369 buffer-file-coding-system
371 (not (zerop vlf-start-pos)))
372 (setq shift (1+ shift)
373 vlf-start-pos (1- vlf-start-pos)
374 chunk-size (1+ chunk-size))
375 (let ((inhibit-read-only t))
377 (insert-file-contents buffer-file-name nil
378 vlf-start-pos vlf-end-pos)))
379 (set-buffer-modified-p nil)
382 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
385 (defun vlf-re-search (regexp count backward batch-step)
386 "Search for REGEXP COUNT number of times forward or BACKWARD.
387 BATCH-STEP is amount of overlap between successive chunks."
389 (let* ((match-chunk-start vlf-start-pos)
390 (match-chunk-end vlf-end-pos)
391 (match-start-pos (+ vlf-start-pos (position-bytes (point))))
392 (match-end-pos match-start-pos)
394 (reporter (make-progress-reporter
395 (concat "Searching for " regexp "...")
397 (- vlf-file-size vlf-end-pos)
403 (while (not (zerop to-find))
404 (cond ((re-search-backward regexp nil t)
405 (setq to-find (1- to-find)
406 match-chunk-start vlf-start-pos
407 match-chunk-end vlf-end-pos
408 match-start-pos (+ vlf-start-pos
410 (match-beginning 0)))
411 match-end-pos (+ vlf-start-pos
414 ((zerop vlf-start-pos)
415 (throw 'end-of-file nil))
416 (t (let ((batch-move (- vlf-start-pos
420 (if (< match-start-pos batch-move)
421 (- match-start-pos vlf-batch-size)
423 (goto-char (if (< match-start-pos
425 (or (byte-to-position
430 (progress-reporter-update
431 reporter (- vlf-file-size
433 (while (not (zerop to-find))
434 (cond ((re-search-forward regexp nil t)
435 (setq to-find (1- to-find)
436 match-chunk-start vlf-start-pos
437 match-chunk-end vlf-end-pos
438 match-start-pos (+ vlf-start-pos
440 (match-beginning 0)))
441 match-end-pos (+ vlf-start-pos
444 ((= vlf-end-pos vlf-file-size)
445 (throw 'end-of-file nil))
446 (t (let ((batch-move (- vlf-end-pos batch-step)))
448 (if (< batch-move match-end-pos)
451 (goto-char (if (< vlf-start-pos match-end-pos)
452 (or (byte-to-position
457 (progress-reporter-update reporter
459 (progress-reporter-done reporter))
461 (vlf-goto-match match-chunk-start match-chunk-end
462 match-end-pos match-start-pos
464 (vlf-goto-match match-chunk-start match-chunk-end
465 match-start-pos match-end-pos
468 (defun vlf-goto-match (match-chunk-start match-chunk-end
472 "Move to MATCH-CHUNK-START MATCH-CHUNK-END surrounding \
473 MATCH-POS-START and MATCH-POS-END.
474 According to COUNT and left TO-FIND, show if search has been
475 successful. Return nil if nothing found."
476 (if (= count to-find)
477 (progn (vlf-move-to-chunk match-chunk-start match-chunk-end)
478 (goto-char (or (byte-to-position (- match-pos-start
481 (message "Not found")
483 (let ((success (zerop to-find)))
485 (vlf-update-buffer-name)
486 (vlf-move-to-chunk match-chunk-start match-chunk-end))
487 (let* ((match-end (or (byte-to-position (- match-pos-end
490 (overlay (make-overlay (byte-to-position
494 (overlay-put overlay 'face 'match)
496 (goto-char match-end)
497 (message "Moved to the %d match which is last"
500 (delete-overlay overlay)
503 (defun vlf-re-search-forward (regexp count)
504 "Search forward for REGEXP prefix COUNT number of times.
505 Search is performed chunk by chunk in `vlf-batch-size' memory."
506 (interactive (list (read-regexp "Search whole file"
508 (car regexp-history)))
509 (or current-prefix-arg 1)))
510 (vlf-re-search regexp count nil (/ vlf-batch-size 8)))
512 (defun vlf-re-search-backward (regexp count)
513 "Search backward for REGEXP prefix COUNT number of times.
514 Search is performed chunk by chunk in `vlf-batch-size' memory."
515 (interactive (list (read-regexp "Search whole file backward"
517 (car regexp-history)))
518 (or current-prefix-arg 1)))
519 (vlf-re-search regexp count t (/ vlf-batch-size 8)))
521 (defun vlf-goto-line (n)
522 "Go to line N. If N is negative, count from the end of file."
523 (interactive "nGo to line: ")
524 (let ((start-pos vlf-start-pos)
525 (end-pos vlf-end-pos)
530 (progn (vlf-beginning-of-file)
531 (goto-char (point-min))
532 (setq success (vlf-re-search "[\n\C-m]" (1- n)
535 (goto-char (point-max))
536 (setq success (vlf-re-search "[\n\C-m]" (- n) t 0)))
538 (message "Onto line %s" n)
539 (vlf-move-to-chunk start-pos end-pos)
542 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
545 (defvar vlf-occur-mode-map
546 (let ((map (make-sparse-keymap)))
547 (define-key map "n" 'vlf-occur-next-match)
548 (define-key map "p" 'vlf-occur-prev-match)
549 (define-key map "\C-m" 'vlf-occur-visit)
550 (define-key map [mouse-1] 'vlf-occur-visit)
551 (define-key map "o" 'vlf-occur-show)
553 "Keymap for command `vlf-occur-mode'.")
555 (define-derived-mode vlf-occur-mode special-mode "VLF[occur]"
556 "Major mode for showing occur matches of VLF opened files.")
558 (defun vlf-occur-next-match ()
559 "Move cursor to next match."
561 (if (eq (get-char-property (point) 'face) 'match)
562 (goto-char (next-single-property-change (point) 'face)))
563 (goto-char (or (text-property-any (point) (point-max) 'face 'match)
564 (text-property-any (point-min) (point)
567 (defun vlf-occur-prev-match ()
568 "Move cursor to previous match."
570 (if (eq (get-char-property (point) 'face) 'match)
571 (goto-char (previous-single-property-change (point) 'face)))
572 (while (not (eq (get-char-property (point) 'face) 'match))
573 (goto-char (or (previous-single-property-change (point) 'face)
576 (defun vlf-occur-show (&optional event)
577 "Visit current `vlf-occur' link in a vlf buffer but stay in the \
578 occur buffer. If original VLF buffer has been killed,
579 open new VLF session each time.
580 EVENT may hold details of the invocation."
581 (interactive (list last-nonmenu-event))
582 (let ((occur-buffer (if event
583 (window-buffer (posn-window
586 (vlf-occur-visit event)
587 (pop-to-buffer occur-buffer)))
589 (defun vlf-occur-visit (&optional event)
590 "Visit current `vlf-occur' link in a vlf buffer.
591 If original VLF buffer has been killed,
592 open new VLF session each time.
593 EVENT may hold details of the invocation."
594 (interactive (list last-nonmenu-event))
596 (set-buffer (window-buffer (posn-window (event-end event))))
597 (goto-char (posn-point (event-end event))))
599 (pos-relative (- pos (line-beginning-position) 1))
600 (file (get-char-property pos 'file)))
602 (let ((chunk-start (get-char-property pos 'chunk-start))
603 (chunk-end (get-char-property pos 'chunk-end))
604 (buffer (get-char-property pos 'buffer))
605 (match-pos (+ (get-char-property pos 'line-pos)
607 (or (buffer-live-p buffer)
608 (let ((occur-buffer (current-buffer)))
609 (setq buffer (vlf file))
610 (switch-to-buffer occur-buffer)))
611 (pop-to-buffer buffer)
612 (if (buffer-modified-p)
613 (cond ((and (= vlf-start-pos chunk-start)
614 (= vlf-end-pos chunk-end))
615 (goto-char match-pos))
616 ((y-or-n-p "VLF buffer has been modified. \
617 Really jump to new chunk? ")
618 (vlf-move-to-chunk chunk-start chunk-end)
619 (goto-char match-pos)))
620 (vlf-move-to-chunk chunk-start chunk-end)
621 (goto-char match-pos))))))
623 (defun vlf-occur (regexp)
624 "Make whole file occur style index for REGEXP.
625 Prematurely ending indexing will still show what's found so far."
626 (interactive (list (read-regexp "List lines matching regexp"
628 (car regexp-history)))))
629 (let ((start-pos vlf-start-pos)
630 (end-pos vlf-end-pos)
632 (vlf-beginning-of-file)
633 (goto-char (point-min))
634 (unwind-protect (vlf-build-occur regexp)
635 (vlf-move-to-chunk start-pos end-pos)
638 (defun vlf-build-occur (regexp)
639 "Build occur style index for REGEXP."
642 (last-line-pos (point-min))
643 (file buffer-file-name)
645 (match-end-pos (+ vlf-start-pos (position-bytes (point))))
646 (occur-buffer (generate-new-buffer
647 (concat "*VLF-occur " (file-name-nondirectory
650 (line-regexp (concat "\\(?5:[\n\C-m]\\)\\|\\(?10:"
652 (batch-step (/ vlf-batch-size 8))
654 (reporter (make-progress-reporter
655 (concat "Building index for " regexp "...")
656 vlf-start-pos vlf-file-size)))
659 (while (not end-of-file)
660 (if (re-search-forward line-regexp nil t)
662 (setq match-end-pos (+ vlf-start-pos
666 (setq line (1+ line) ; line detected
667 last-line-pos (point))
668 (let* ((chunk-start vlf-start-pos)
669 (chunk-end vlf-end-pos)
670 (vlf-buffer (current-buffer))
671 (line-pos (line-beginning-position))
672 (line-text (buffer-substring
673 line-pos (line-end-position))))
674 (with-current-buffer occur-buffer
675 (unless (= line last-match-line) ;new match line
676 (insert "\n:") ; insert line number
677 (let* ((overlay-pos (1- (point)))
678 (overlay (make-overlay
681 (overlay-put overlay 'before-string
683 (number-to-string line)
685 (insert (propertize line-text ; insert line
688 'chunk-start chunk-start
690 'mouse-face '(highlight)
693 (format "Move to line %d"
695 (setq last-match-line line
696 total-matches (1+ total-matches))
697 (let ((line-start (1+
698 (line-beginning-position)))
699 (match-pos (match-beginning 10)))
700 (add-text-properties ; mark match
701 (+ line-start match-pos (- last-line-pos))
702 (+ line-start (match-end 10)
706 (format "Move to match %d"
707 total-matches))))))))
708 (setq end-of-file (= vlf-end-pos vlf-file-size))
710 (let ((batch-move (- vlf-end-pos batch-step)))
711 (vlf-move-to-batch (if (< batch-move match-end-pos)
714 (goto-char (if (< vlf-start-pos match-end-pos)
715 (or (byte-to-position (- match-end-pos
719 (setq last-match-line 0
720 last-line-pos (line-beginning-position))
721 (progress-reporter-update reporter vlf-end-pos))))
722 (progress-reporter-done reporter))
723 (if (zerop total-matches)
724 (progn (with-current-buffer occur-buffer
725 (set-buffer-modified-p nil))
726 (kill-buffer occur-buffer)
727 (message "No matches for \"%s\"" regexp))
728 (with-current-buffer occur-buffer
729 (goto-char (point-min))
731 (format "%d matches from %d lines for \"%s\" \
732 in file: %s" total-matches line regexp file)
734 (set-buffer-modified-p nil)
737 (display-buffer occur-buffer)))))
739 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
742 (defvar vlf-edit-mode-map
743 (let ((map (make-sparse-keymap)))
744 (set-keymap-parent map text-mode-map)
745 (define-key map "\C-c\C-c" 'vlf-write)
746 (define-key map "\C-c\C-q" 'vlf-discard-edit)
747 (define-key map "\C-v" vlf-mode-map)
749 "Keymap for command `vlf-edit-mode'.")
751 (define-derived-mode vlf-edit-mode vlf-mode "VLF[edit]"
752 "Major mode for editing large file chunks."
753 (setq buffer-read-only nil)
755 (message (substitute-command-keys
756 "Editing: Type \\[vlf-write] to write chunk \
757 or \\[vlf-discard-edit] to discard changes.")))
759 (defun vlf-discard-edit ()
760 "Discard edit and refresh chunk from file."
762 (set-buffer-modified-p nil)
763 (vlf-move-to-chunk vlf-start-pos vlf-end-pos)
765 (message "Switched to VLF mode."))
767 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
771 "Write current chunk to file. Always return true to disable save.
772 If changing size of chunk, shift remaining file content."
774 (when (and (buffer-modified-p)
775 (or (verify-visited-file-modtime (current-buffer))
776 (y-or-n-p "File has changed since visited or saved. \
779 (size-change (- vlf-encode-size
780 (setq vlf-encode-size
781 (length (encode-coding-region
782 (point-min) (point-max)
783 buffer-file-coding-system
785 (cond ((zerop size-change)
786 (write-region nil nil buffer-file-name vlf-start-pos t))
788 (vlf-file-shift-back size-change))
789 (t (vlf-file-shift-forward (- size-change))))
790 (vlf-move-to-chunk vlf-start-pos vlf-end-pos)
795 (defun vlf-file-shift-back (size-change)
796 "Shift file contents SIZE-CHANGE bytes back."
797 (write-region nil nil buffer-file-name vlf-start-pos t)
798 (buffer-disable-undo)
799 (let ((read-start-pos vlf-end-pos)
800 (coding-system-for-write 'no-conversion)
801 (reporter (make-progress-reporter "Adjusting file content..."
804 (while (vlf-shift-batch read-start-pos (- read-start-pos
806 (setq read-start-pos (+ read-start-pos vlf-batch-size))
807 (progress-reporter-update reporter read-start-pos))
808 ;; pad end with space
811 (insert-char 32 size-change)
812 (write-region nil nil buffer-file-name (- vlf-file-size
814 (progress-reporter-done reporter)))
816 (defun vlf-shift-batch (read-pos write-pos)
817 "Read `vlf-batch-size' bytes from READ-POS and write them \
818 back at WRITE-POS. Return nil if EOF is reached, t otherwise."
821 (let ((read-end (+ read-pos vlf-batch-size)))
822 (insert-file-contents-literally buffer-file-name nil
824 (min vlf-file-size read-end))
825 (write-region nil nil buffer-file-name write-pos 0)
826 (< read-end vlf-file-size)))
828 (defun vlf-file-shift-forward (size-change)
829 "Shift file contents SIZE-CHANGE bytes forward.
830 Done by saving content up front and then writing previous batch."
831 (buffer-disable-undo)
832 (let ((size (+ vlf-batch-size size-change))
833 (read-pos vlf-end-pos)
834 (write-pos vlf-start-pos)
835 (reporter (make-progress-reporter "Adjusting file content..."
838 (when (vlf-shift-batches size read-pos write-pos t)
839 (setq write-pos (+ read-pos size-change)
840 read-pos (+ read-pos size))
841 (progress-reporter-update reporter write-pos)
842 (let ((coding-system-for-write 'no-conversion))
843 (while (vlf-shift-batches size read-pos write-pos nil)
844 (setq write-pos (+ read-pos size-change)
845 read-pos (+ read-pos size))
846 (progress-reporter-update reporter write-pos))))
847 (progress-reporter-done reporter)))
849 (defun vlf-shift-batches (size read-pos write-pos hide-read)
850 "Append SIZE bytes of file starting at READ-POS.
851 Then write initial buffer content to file at WRITE-POS.
852 If HIDE-READ is non nil, temporarily hide literal read content.
853 Return nil if EOF is reached, t otherwise."
855 (let ((read-more (< read-pos vlf-file-size))
856 (start-write-pos (point-min))
857 (end-write-pos (point-max)))
859 (goto-char end-write-pos)
860 (insert-file-contents-literally buffer-file-name nil read-pos
861 (min vlf-file-size (+ read-pos
864 (if hide-read ; hide literal region if user has to choose encoding
865 (narrow-to-region start-write-pos end-write-pos))
866 (write-region start-write-pos end-write-pos
867 buffer-file-name write-pos 0)
868 (delete-region start-write-pos end-write-pos)
869 (if hide-read (widen))