1
0
mirror of https://github.com/m00natic/vlfi.git synced 2025-11-07 10:31:36 +00:00

72 Commits
1.1 ... 1.5

Author SHA1 Message Date
Andrey Kotlarski
1f9ba7ce5f Use derived-mode-p. 2014-02-23 18:18:26 +02:00
Andrey Kotlarski
8ba5bead36 Don't run vlf-after-batch-functions hook in vlf-build-occur. 2014-02-23 17:18:07 +02:00
Andrey Kotlarski
ee19f811ae Load hexl advices after load and move vlf group definition. 2014-02-23 00:40:20 +02:00
Andrey Kotlarski
6476c1be6a Update README, wording, add links and information on hooks. 2014-02-23 00:32:11 +02:00
Andrey Kotlarski
2c231dfb15 Disable hexl-save-buffer and hexl revert when vlf-mode is active. 2014-02-15 02:40:31 +02:00
Andrey Kotlarski
6bb60b72ad Fix hexl scroll up called from scroll down behavior. 2014-02-15 02:35:46 +02:00
Andrey Kotlarski
b235cf907c Execute vlf-after-batch-functions hook even on user quit command before
end of search.  Update buffer name after unsuccessful goto line.
2014-02-15 02:32:43 +02:00
Andrey Kotlarski
859c1e4c45 Fix hook names. 2014-02-15 02:32:05 +02:00
Andrey Kotlarski
8c61b776d6 Fix when batch hooks are run for occur and save. 2014-02-14 12:34:31 +02:00
Andrey Kotlarski
074f9e960d Play nicely with hexl-mode. 2014-02-14 02:49:02 +02:00
Andrey Kotlarski
b05255b225 Add hooks to run around chunk moves and batch operations. Don't err
when tramp hasn't been loaded yet.
2014-02-14 02:47:37 +02:00
Andrey Kotlarski
924d6b18fa Revert to using insert-file-contents instead of manual decoding. 2014-02-14 02:44:43 +02:00
Andrey Kotlarski
0199c2468a Lower tramp verbosity level when dealing with multiple batches. 2014-01-30 01:58:57 +02:00
Andrey Kotlarski
ffac6972ed Keep undo list after occur or unsuccessful line search. 2014-01-27 02:15:56 +02:00
Andrey Kotlarski
a71ee32508 Skip adjustment in some cases of overlapping chunk. 2014-01-27 01:18:07 +02:00
Andrey Kotlarski
9510c70860 Retry decoding when the initial attempt seems wrong. 2014-01-27 01:16:00 +02:00
Andrey Kotlarski
cc9b115486 Update docstring for vlf-ediff-adjust. 2014-01-23 02:30:02 +02:00
Andrey Kotlarski
f83a212c52 Temporarily disable font-lock during multiple batch operations. 2014-01-23 02:11:44 +02:00
Andrey Kotlarski
1a1ce27d37 Add progress reporters for the optimized part of line search. 2014-01-23 02:10:52 +02:00
Andrey Kotlarski
5c604c48a4 Optimize vlf-goto-line not to decode batches as long as possible. 2014-01-22 02:42:52 +02:00
Andrey Kotlarski
0fa8e8d6bf Update buffer name on user interruption during ediff. 2014-01-22 02:40:53 +02:00
Andrey Kotlarski
d7766f2a3b Update documentation and mark autoloaded functions as interactive. 2014-01-21 01:34:32 +02:00
Andrey Kotlarski
30d2bb0d25 VLF buffer ediff now starts from the current chunks. 2014-01-21 01:33:04 +02:00
Andrey Kotlarski
c533bce956 Add command to set batch size explicitly. 2014-01-21 01:32:21 +02:00
Andrey Kotlarski
5d30eb4826 Use single ediff pass to adjust borders. Protect against user
interruption while searching for difference.
2014-01-21 01:29:37 +02:00
Andrey Kotlarski
d5d9cd71ee Improve refining of differences and readjustment. 2014-01-20 02:40:26 +02:00
Andrey Kotlarski
e747de4495 Unify and optimize deletion. 2014-01-20 02:37:51 +02:00
Andrey Kotlarski
82fd5b943b Refine diff adjustment and in case of equality after it - make another
search for difference.
2014-01-18 16:26:25 +02:00
Andrey Kotlarski
9646b00215 Adjust chunk borders to minimize shift differences and optimize
detection of identical batches when ediff-ing.
2014-01-17 03:01:41 +02:00
Andrey Kotlarski
27e3bbb320 Reuse initial ediff session for all chunks. 2014-01-15 02:17:33 +02:00
Andrey Kotlarski
117935db98 Add progress reporter when searching for difference. 2014-01-14 01:11:59 +02:00
Andrey Kotlarski
38e8f6c4e1 Update file size when moving to end of buffer. 2014-01-14 01:11:07 +02:00
Andrey Kotlarski
98ddc3afd9 Add by batch Ediff functionality. 2014-01-13 01:36:20 +02:00
Andrey Kotlarski
4d82c781b8 - don't nullify default buffer coding system
- make vlf return the newly created VLF buffer
- simplify beginning and end jumps
2014-01-13 01:15:08 +02:00
Andrey Kotlarski
429a8ff016 Widen region when measuring encoded content length. 2014-01-11 19:00:00 +02:00
Andrey Kotlarski
88dba8bb25 Remove unnecessary addition to load-path on compile. 2014-01-07 23:49:56 +02:00
Andrey Kotlarski
47c154cc1f Fix detection of good chunk start. 2014-01-07 13:57:17 +02:00
Andrey Kotlarski
9343095096 Fix installation interfile dependencies and fix setting of local
variables for GNU Emasc 23.
2014-01-07 13:38:24 +02:00
Andrey Kotlarski
dd43af51ff Manually decode and use several bytes buffer when loading chunk. 2014-01-07 01:55:27 +02:00
Andrey Kotlarski
df8c9ea5dd Detect change of file when loading chunk and act more cautiously. Move
some functions around.
2014-01-07 01:54:00 +02:00
Andrey Kotlarski
0dc6d0643e Completely decouple vlf integration from other functionality. 2014-01-07 01:47:39 +02:00
Andrey Kotlarski
66db665d82 Fix follow functionality and explicitly set variable as buffer local. 2014-01-07 01:43:14 +02:00
Andrey Kotlarski
95e625938e Add convenience macro to disable VLF application during execution of
specific function.
2014-01-01 16:47:04 +02:00
Andrey Kotlarski
516584e6c9 Break VLF into components. 2014-01-01 16:42:45 +02:00
Andrey Kotlarski
deec75dfc9 Enlarge minimum sample chunk for decoding size. 2014-01-01 00:41:06 +02:00
Andrey Kotlarski
7794b2cab6 Merge branch 'shift-undo' into chunk-move
Conflicts:
	vlf.el
2013-12-31 22:21:51 +02:00
Andrey Kotlarski
161a4ec76e Prevent inserting of too small file regions for GNU Emacs later than
24.3.
2013-12-31 20:46:06 +02:00
Andrey Kotlarski
4f99eaa5e7 Fixes to tiny chunk moves. 2013-12-31 19:55:21 +02:00
Andrey Kotlarski
e36492b82f Optimize chunk jumping for current GNU Emacs releases. Fix moving by
just few bytes.
2013-12-25 03:18:29 +02:00
Andrey Kotlarski
2470fc0f67 Fix vlf-shift-undo-list to reverse resulting list. 2013-12-21 00:18:36 +02:00
Andrey Kotlarski
c58d0d84ff Shift buffer-undo-list elements when chunk beginning moves. 2013-12-18 02:24:02 +02:00
Andrey Kotlarski
386d85656c Restore undo information after temporarily disabling it. 2013-12-18 00:04:54 +02:00
Andrey Kotlarski
d88080f436 Don't apply VLF over ebrowse and TAGS databases. 2013-12-17 23:49:20 +02:00
Andrey Kotlarski
4134de068f Add intelligent recenter chunk around point functionality. 2013-12-13 17:23:16 +02:00
Andrey Kotlarski
290c4ac885 Fix save with adjustment. 2013-12-13 17:08:13 +02:00
Andrey Kotlarski
db1da304d5 Use buffer-file-truename for file size determination and remove
superfluous checks to vlf-verify-size when saving.  Fix vlf-revert not
to ask unnecessary.
2013-12-13 02:32:30 +02:00
Andrey Kotlarski
655805ce48 Fix vlf-next-batch-from-point behaviour near end of file. 2013-12-13 02:30:29 +02:00
Andrey Kotlarski
bb482f0b0f Fix file size determination for symbolic links. 2013-12-12 16:16:32 +02:00
Andrey Kotlarski
9ffb968793 Remove defadvice abort-if-file-too-large argument list so it works
correctly with GNU Emacs 23.
2013-12-12 14:47:28 +02:00
Andrey Kotlarski
099adab959 Fix abort-if-file-too-large advice not to activate VLF in case of empty
file.
2013-12-12 13:47:49 +02:00
Andrey Kotlarski
65b4d7413f Refactor vlf-write. 2013-12-12 02:20:03 +02:00
Andrey Kotlarski
2e2bca6999 Fix file size determination after save and move vlf-with-undo-disabled
macro before vlf-mode declaration.
2013-12-12 02:07:25 +02:00
Andrey Kotlarski
ea46386cbc Don't apply VLF by default over image and pdf files. 2013-12-11 16:15:26 +02:00
Andrey Kotlarski
d1af56d776 Fix opening of files for GNU Emacs 23. 2013-12-11 16:07:14 +02:00
Andrey Kotlarski
152462a654 Fix autoloads in last commit. 2013-12-11 16:01:12 +02:00
Andrey Kotlarski
9c50487982 Introduce list of major modes where VLF will not activate. 2013-12-11 15:58:35 +02:00
Andrey Kotlarski
88924f9c05 Fix vlf-write behaviour for newly created file. 2013-12-11 13:07:51 +02:00
Andrey Kotlarski
2aea17ab38 Fix behaviour when size is missing (creating file) in
abort-if-file-too-large, vlf-mode is started over existing buffer.
Rename default vlf-application value to `ask'.
2013-12-11 12:01:26 +02:00
Andrey Kotlarski
72fec35f44 Update README and bump version. 2013-12-11 03:21:08 +02:00
Andrey Kotlarski
a0cafa71ea Explicitly offer vlf-prefix-map so user can easily define another prefix
for vlf-mode-map.  Remove vlf-refresh and refine vlf-revert.
2013-12-11 02:56:01 +02:00
Andrey Kotlarski
c68c34ea90 Add vlf-application customization which refines control over when
vlf-mode is automatically invoked or offered.
2013-12-11 02:54:44 +02:00
Andrey Kotlarski
c0a85cdcfe Fix position when moving to overlapping chunk. 2013-12-11 02:51:46 +02:00
9 changed files with 1935 additions and 881 deletions

View File

@@ -1,23 +1,31 @@
* View Large Files
Emacs minor mode that allows viewing, editing and searching large
files in batches. Batch size can be adjusted on the fly and bounds
the memory that is to be used for operations on the file.
Emacs minor mode that allows viewing, editing, searching and comparing
large files in batches. Batch size can be adjusted on the fly and
bounds the memory that is to be used for operations on the file. This
way multiple large files (like terabytes or whatever) can be instantly
and simultaneously accessed without swapping and degraded
performance.
This is development version of the GNU ELPA [[http://elpa.gnu.org/packages/vlf][vlf.el]] package. Here's
what it does in a nutshell:
This is development version of the GNU ELPA [[http://elpa.gnu.org/packages/vlf][VLF]] package. Here's what
it offers in a nutshell:
- regular expression search on whole file (in constant memory
determined by current batch size)
- chunk editing (if size has changed, saving is done in constant
memory determined by current batch size)
- occur like indexing
- [[http://www.emacswiki.org/emacs/OccurMode][Occur]] like indexing
- options to jump to beginning, end or arbitrary file chunk
- ability to jump/insert given number of batches at once
- newly added content is acknowledged if file has changed size
meanwhile
- automatic scrolling of batches
- VLF is added as an option when opening large files
- as a minor mode, font locking and functionality of the respective
major mode is also present
- by batch [[http://www.emacswiki.org/emacs/EdiffMode][Ediff]] comparison
- can be added as option to automatically open large files
- smooth integration with [[http://www.emacswiki.org/emacs/HexlMode][hexl-mode]]
- works with [[http://www.emacswiki.org/emacs/TrampMode][TRAMP]] so accessing network files is fine
GNU Emacs 23 and 24 are supported.
@@ -29,13 +37,13 @@ M-x vlf PATH-TO-FILE
Emacs' Unicode support is leveraged so you'll not see bare bytes but
characters decoded as if file is normally opened. This holds for
editing, search and indexing.
editing, search, indexing and comparison.
** 32-bit GNU Emacs
Regular Emacs integers are used, so if you use 32-bit Emacs without
bignum support and have really huge file (with size beyond the maximum
integer value), VLF will probably not quite work.
bignum support, *VLF* will not work with files over 512 MB (maximum
integer value).
** Memory control
@@ -43,21 +51,68 @@ integer value), VLF will probably not quite work.
* Detail usage
** Applicability
To have *vlf* offered as choice when opening large files:
#+BEGIN_EXAMPLE
(require 'vlf-integrate)
#+END_EXAMPLE
You can control when *vlf-mode* is invoked or offered with the
*vlf-application* customization option. By default it will offer
*VLF* when opening large files. There are also options to never use
it (you can still call *vlf* command explicitly); to use it without
asking for large files or to invoke it on all files. Here's example
setup such that *vlf-mode* automatically launches for large files:
#+BEGIN_EXAMPLE
(custom-set-variables
'(vlf-application 'dont-ask))
#+END_EXAMPLE
*** Disable for specific mode
To disable automatic usage of *VLF* for a major mode, add it to
*vlf-forbidden-modes-list*.
*** Disable for specific function
To disable automatic usage of *VLF* for a function, for example named
*func* defined in file *file.el*:
#+BEGIN_EXAMPLE
(vlf-disable-for-function func "file")
#+END_EXAMPLE
** Keymap
All *VLF* operations are grouped under the *C-c C-v* prefix by
default. Here's example how to add another prefix (*C-x v*):
#+BEGIN_EXAMPLE
(eval-after-load "vlf"
'(define-key vlf-prefix-map "\C-xv" vlf-mode-map))
#+END_EXAMPLE
** Control batch size
Use *M-x vlf-set-batch-size* to change batch size and update chunk
immediately.
*C-c C-v +* and *C-c C-v -* control current batch size by factors
of 2.
You can also set by hand local variable *vlf-batch-size* and then
refresh with *C-c C-v g*.
** Move around
*C-c C-v PgUp* and *C-c C-v PgDn* move batch by batch. With positive
Scrolling automatically triggers moving to previous or next chunk at
the beginning or end respectively of the current one.
*C-c C-v n* and *C-c C-v p* move batch by batch. With positive
prefix argument they move prefix number of batches. With negative -
append prefix number of batches.
*C-c C-v n* displays batch starting from current point.
*C-c C-v SPC* displays batch starting from current point.
*C-c C-v [* and *C-c C-v ]* take you to the beginning and end of file
respectively.
@@ -67,6 +122,11 @@ how many chunks there are (using the current batch size), look at the
parenthesized part of the buffer name, batch size is also indicated at
the end.
** Follow point
Continuous chunk recenter around point in current buffer can be
toggled with *C-c C-v f*.
** Search whole file
*C-c C-v s* and *C-c C-v r* search forward and backward respectively
@@ -76,10 +136,10 @@ beforehand.
** Occur over whole file
*C-c C-v o* builds index for given regular expression just like
*M-x occur*. It does this batch by batch over the whole file. Note
that even if you prematurely stop it with *C-g*, it will still show
index of what's found so far.
*C-c C-v o* builds index for given regular expression just like M-x
occur*. It does so batch by batch over the whole file. Note that
even if you prematurely stop it with *C-g*, it will still show index
of what's found so far.
** Jump to line
@@ -88,12 +148,32 @@ from the beginning, so again the bigger current batch size, the
quicker. With negative argument, lines are counted from the end of
file.
** Reload
*C-c C-v g* discards modifications (if such) and reloads chunk.
** Edit and save
If editing doesn't change size of the chunk, only this chunk is saved.
Otherwise the remaining part of the file is adjusted batch by batch,
so again you'd better have bigger current batch size.
** By batch Ediff
Use *M-x vlf-ediff-files* and *M-x vlf-ediff-buffers* to compare
files/buffers batch by batch (batch size is queried in case of files
or taken from the first buffer in case of buffers). Moving after the
last difference in current chunk searches for following one with
difference. The other way around if looking for difference before the
first one.
* Extending
** Move hooks
A couple of hooks are run whenever updating chunk:
*vlf-before-chunk-update* and *vlf-after-chunk-update*.
** Batch move hooks
Some operations may trigger multiple chunk moves. There are a couple
of hooks that run in such cases: *vlf-before-batch-functions* and
*vlf-after-batch-functions*. They are passed one argument that
specifies type of operation that runs. Possible values are the
symbols: *write*, *ediff*, *occur*, *search* and *goto-line*.

413
vlf-base.el Normal file
View File

@@ -0,0 +1,413 @@
;;; vlf-base.el --- VLF primitive operations -*- lexical-binding: t -*-
;; Copyright (C) 2014 Free Software Foundation, Inc.
;; Keywords: large files, chunk
;; Author: Andrey Kotlarski <m00naticus@gmail.com>
;; URL: https://github.com/m00natic/vlfi
;; This file is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 3, or (at your option)
;; any later version.
;; This file is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING. If not, write to
;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.
;;; Commentary:
;; This package provides basic chunk operations for VLF,
;; most notable being the `vlf-move-to-chunk' function.
;;; Code:
(defcustom vlf-batch-size 1024
"Defines how large each batch of file data is (in bytes)."
:group 'vlf :type 'integer)
(put 'vlf-batch-size 'permanent-local t)
(defcustom vlf-before-chunk-update nil
"Hook that runs before chunk update."
:group 'vlf :type 'hook)
(defcustom vlf-after-chunk-update nil
"Hook that runs after chunk update."
:group 'vlf :type 'hook)
;;; Keep track of file position.
(defvar vlf-start-pos 0
"Absolute position of the visible chunk start.")
(make-variable-buffer-local 'vlf-start-pos)
(put 'vlf-start-pos 'permanent-local t)
(defvar vlf-end-pos 0 "Absolute position of the visible chunk end.")
(make-variable-buffer-local 'vlf-end-pos)
(put 'vlf-end-pos 'permanent-local t)
(defvar vlf-file-size 0 "Total size of presented file.")
(make-variable-buffer-local 'vlf-file-size)
(put 'vlf-file-size 'permanent-local t)
(defconst vlf-sample-size 24
"Minimal number of bytes that can be properly decoded.")
(defun vlf-get-file-size (file)
"Get size in bytes of FILE."
(or (nth 7 (file-attributes file)) 0))
(defun vlf-verify-size (&optional update-visited-time)
"Update file size information if necessary and visited file time.
If non-nil, UPDATE-VISITED-TIME."
(unless (verify-visited-file-modtime (current-buffer))
(setq vlf-file-size (vlf-get-file-size buffer-file-truename))
(if update-visited-time
(set-visited-file-modtime))))
(unless (fboundp 'file-size-human-readable)
(defun file-size-human-readable (file-size)
"Print FILE-SIZE in MB."
(format "%.3fMB" (/ file-size 1048576.0))))
(defun vlf-update-buffer-name ()
"Update the current buffer name."
(rename-buffer (format "%s(%d/%d)[%s]"
(file-name-nondirectory buffer-file-name)
(/ vlf-end-pos vlf-batch-size)
(/ vlf-file-size vlf-batch-size)
(file-size-human-readable vlf-batch-size))
t))
(defmacro vlf-with-undo-disabled (&rest body)
"Execute BODY with temporarily disabled undo."
`(let ((undo-list buffer-undo-list))
(setq buffer-undo-list t)
(unwind-protect (progn ,@body)
(setq buffer-undo-list undo-list))))
(defun vlf-move-to-chunk (start end &optional minimal)
"Move to chunk enclosed by START END bytes.
When given MINIMAL flag, skip non important operations.
If same as current chunk is requested, do nothing.
Return number of bytes moved back for proper decoding and number of
bytes added to the end."
(vlf-verify-size)
(cond ((or (<= end start) (<= end 0)
(<= vlf-file-size start))
(when (or (not (buffer-modified-p))
(y-or-n-p "Chunk modified, are you sure? "))
(erase-buffer)
(set-buffer-modified-p nil)
(let ((place (if (<= vlf-file-size start)
vlf-file-size
0)))
(setq vlf-start-pos place
vlf-end-pos place)
(if (not minimal)
(vlf-update-buffer-name))
(cons (- start place) (- place end)))))
((or (/= start vlf-start-pos)
(/= end vlf-end-pos))
(let ((shifts (vlf-move-to-chunk-1 start end)))
(and shifts (not minimal)
(vlf-update-buffer-name))
shifts))))
(defun vlf-move-to-chunk-1 (start end)
"Move to chunk enclosed by START END keeping as much edits if any.
Return number of bytes moved back for proper decoding and number of
bytes added to the end."
(widen)
(let* ((modified (buffer-modified-p))
(start (max 0 start))
(end (min end vlf-file-size))
(edit-end (if modified
(+ vlf-start-pos
(length (encode-coding-region
(point-min) (point-max)
buffer-file-coding-system t)))
vlf-end-pos)))
(cond
((or (< edit-end start) (< end vlf-start-pos)
(not (verify-visited-file-modtime (current-buffer))))
(when (or (not modified)
(y-or-n-p "Chunk modified, are you sure? ")) ;full chunk renewal
(set-buffer-modified-p nil)
(vlf-move-to-chunk-2 start end)))
((and (= start vlf-start-pos) (= end edit-end))
(or modified (vlf-move-to-chunk-2 start end)))
((or (and (<= start vlf-start-pos) (<= edit-end end))
(not modified)
(y-or-n-p "Chunk modified, are you sure? "))
(run-hooks 'vlf-before-chunk-update)
(let ((shift-start 0)
(shift-end 0))
(let ((pos (+ (position-bytes (point)) vlf-start-pos))
(inhibit-read-only t))
(cond ((= end vlf-start-pos)
(or (eq buffer-undo-list t)
(setq buffer-undo-list nil))
(vlf-with-undo-disabled (erase-buffer))
(setq modified nil))
((< end edit-end)
(setq end (car (vlf-delete-region
(point-min) vlf-start-pos edit-end
end (min (or (byte-to-position
(- end vlf-start-pos))
(point-min))
(point-max))
nil))))
((< edit-end end)
(vlf-with-undo-disabled
(setq shift-end (cdr (vlf-insert-file-contents
vlf-end-pos end nil t
(point-max)))))))
(setq vlf-end-pos (+ end shift-end))
(cond ((= start edit-end)
(or (eq buffer-undo-list t)
(setq buffer-undo-list nil))
(vlf-with-undo-disabled
(delete-region (point-min) (point)))
(setq modified nil))
((< vlf-start-pos start)
(let ((del-info (vlf-delete-region
(point-min) vlf-start-pos
vlf-end-pos start
(min (or (byte-to-position
(- start vlf-start-pos))
(point))
(point-max)) t)))
(setq start (car del-info))
(vlf-shift-undo-list (- (point-min)
(cdr del-info)))))
((< start vlf-start-pos)
(let ((edit-end-pos (point-max)))
(vlf-with-undo-disabled
(setq shift-start (car (vlf-insert-file-contents
start vlf-start-pos t nil
edit-end-pos)))
(goto-char (point-min))
(insert (delete-and-extract-region
edit-end-pos (point-max))))
(vlf-shift-undo-list (- (point-max)
edit-end-pos)))))
(setq start (- start shift-start))
(goto-char (or (byte-to-position (- pos start))
(byte-to-position (- pos vlf-start-pos))
(point-max)))
(setq vlf-start-pos start))
(set-buffer-modified-p modified)
(set-visited-file-modtime)
(run-hooks 'vlf-after-chunk-update)
(cons shift-start shift-end))))))
(defun vlf-move-to-chunk-2 (start end)
"Unconditionally move to chunk enclosed by START END bytes.
Return number of bytes moved back for proper decoding and number of
bytes added to the end."
(run-hooks 'vlf-before-chunk-update)
(vlf-verify-size t)
(setq vlf-start-pos (max 0 start)
vlf-end-pos (min end vlf-file-size))
(let (shifts)
(let ((inhibit-read-only t)
(pos (position-bytes (point))))
(vlf-with-undo-disabled
(erase-buffer)
(setq shifts (vlf-insert-file-contents vlf-start-pos
vlf-end-pos t t)
vlf-start-pos (- vlf-start-pos (car shifts))
vlf-end-pos (+ vlf-end-pos (cdr shifts)))
(goto-char (or (byte-to-position (+ pos (car shifts)))
(point-max)))))
(set-buffer-modified-p nil)
(or (eq buffer-undo-list t)
(setq buffer-undo-list nil))
(run-hooks 'vlf-after-chunk-update)
shifts))
(defun vlf-insert-file-contents (start end adjust-start adjust-end
&optional position)
"Adjust chunk at absolute START to END till content can be\
properly decoded. ADJUST-START determines if trying to prepend bytes
to the beginning, ADJUST-END - append to the end.
Use buffer POSITION as start if given.
Return number of bytes moved back for proper decoding and number of
bytes added to the end."
(setq adjust-start (and adjust-start (not (zerop start)))
adjust-end (and adjust-end (< end vlf-file-size))
position (or position (point-min)))
(goto-char position)
(let ((shift-start 0)
(shift-end 0)
(safe-end (if adjust-end
(min vlf-file-size (+ end 4))
end)))
(if adjust-start
(setq shift-start (vlf-adjust-start start safe-end position
adjust-end)
start (- start shift-start))
(vlf-insert-file-contents-1 start safe-end))
(if adjust-end
(setq shift-end (- (car (vlf-delete-region position start
safe-end end
(point-max)
nil 'start))
end)))
(cons shift-start shift-end)))
(defun vlf-insert-file-contents-1 (start end)
"Extract decoded file bytes START to END."
(insert-file-contents buffer-file-name nil start end))
(defun vlf-adjust-start (start end position adjust-end)
"Adjust chunk beginning at absolute START to END till content can\
be properly decoded. Use buffer POSITION as start.
ADJUST-END is non-nil if end would be adjusted later.
Return number of bytes moved back for proper decoding."
(let* ((safe-start (max 0 (- start 4)))
(sample-end (min end (+ safe-start vlf-sample-size)))
(chunk-size (- sample-end safe-start))
(strict (or (= sample-end vlf-file-size)
(and (not adjust-end) (= sample-end end))))
(shift 0))
(while (and (progn (vlf-insert-file-contents-1 safe-start
sample-end)
(not (zerop safe-start)))
(< shift 3)
(let ((diff (- chunk-size
(length
(encode-coding-region
position (point-max)
buffer-file-coding-system t)))))
(if strict
(not (zerop diff))
(or (< diff -3) (< 0 diff)))))
(setq shift (1+ shift)
safe-start (1- safe-start)
chunk-size (1+ chunk-size))
(delete-region position (point-max)))
(setq safe-start (car (vlf-delete-region position safe-start
sample-end start
position t 'start)))
(unless (= sample-end end)
(delete-region position (point-max))
(vlf-insert-file-contents-1 safe-start end))
(- start safe-start)))
(defun vlf-delete-region (position start end border cut-point from-start
&optional encode-direction)
"Delete from chunk starting at POSITION enclosing absolute file\
positions START to END at absolute position BORDER. Start search for
best cut at CUT-POINT. Delete from buffer beginning if FROM-START is
non nil or up to buffer end otherwise. ENCODE-DIRECTION determines
which side of the region to use to calculate cut position's absolute
file position. Possible values are: `start' - from the beginning;
`end' - from end; nil - the shorter side.
Return actual absolute position of new border and buffer point at
which deletion was performed."
(let* ((encode-from-end (if encode-direction
(eq encode-direction 'end)
(< (- end border) (- border start))))
(dist (if encode-from-end
(- end (length (encode-coding-region
cut-point (point-max)
buffer-file-coding-system t)))
(+ start (length (encode-coding-region
position cut-point
buffer-file-coding-system t)))))
(len 0))
(if (< border dist)
(while (< border dist)
(setq len (length (encode-coding-region
cut-point (1- cut-point)
buffer-file-coding-system t))
cut-point (1- cut-point)
dist (- dist len)))
(while (< dist border)
(setq len (length (encode-coding-region
cut-point (1+ cut-point)
buffer-file-coding-system t))
cut-point (1+ cut-point)
dist (+ dist len)))
(or (= dist border)
(setq cut-point (1- cut-point)
dist (- dist len))))
(and (not from-start) (/= dist border)
(setq cut-point (1+ cut-point)
dist (+ dist len)))
(vlf-with-undo-disabled
(if from-start (delete-region position cut-point)
(delete-region cut-point (point-max))))
(cons dist (1+ cut-point))))
(defun vlf-shift-undo-list (n)
"Shift undo list element regions by N."
(or (eq buffer-undo-list t)
(setq buffer-undo-list
(nreverse
(let ((min (point-min))
undo-list)
(catch 'end
(dolist (el buffer-undo-list undo-list)
(push
(cond
((null el) nil)
((numberp el) (let ((pos (+ el n)))
(if (< pos min)
(throw 'end undo-list)
pos)))
(t (let ((head (car el)))
(cond ((numberp head)
(let ((beg (+ head n)))
(if (< beg min)
(throw 'end undo-list)
(cons beg (+ (cdr el) n)))))
((stringp head)
(let* ((pos (cdr el))
(positive (< 0 pos))
(new (+ (abs pos) n)))
(if (< new min)
(throw 'end undo-list)
(cons head (if positive
new
(- new))))))
((null head)
(let ((beg (+ (nth 3 el) n)))
(if (< beg min)
(throw 'end undo-list)
(cons
nil
(cons
(cadr el)
(cons
(nth 2 el)
(cons beg
(+ (cddr
(cddr el)) n))))))))
((and (eq head 'apply)
(numberp (cadr el)))
(let ((beg (+ (nth 2 el) n)))
(if (< beg min)
(throw 'end undo-list)
(cons
'apply
(cons
(cadr el)
(cons
beg
(cons
(+ (nth 3 el) n)
(cons (nth 4 el)
(cdr (last el))))))))))
(t el)))))
undo-list))))))))
(provide 'vlf-base)
;;; vlf-base.el ends here

328
vlf-ediff.el Normal file
View File

@@ -0,0 +1,328 @@
;;; vlf-ediff.el --- VLF ediff functionality -*- lexical-binding: t -*-
;; Copyright (C) 2014 Free Software Foundation, Inc.
;; Keywords: large files, compare, ediff
;; Author: Andrey Kotlarski <m00naticus@gmail.com>
;; URL: https://github.com/m00natic/vlfi
;; This file is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 3, or (at your option)
;; any later version.
;; This file is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING. If not, write to
;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.
;;; Commentary:
;; This package provides ediff functionality for VLF managed buffers
;; in face of the `vlf-ediff-buffers' and `vlf-ediff-files' commands.
;;; Code:
(require 'vlf)
(require 'ediff)
(defvar vlf-ediff-session nil
"If non nil, specifies that ediff is done over VLF buffers.")
(make-variable-buffer-local 'vlf-ediff-session)
;;;###autoload
(defun vlf-ediff-buffers (buffer-A buffer-B)
"Run batch by batch ediff over VLF buffers BUFFER-A and BUFFER-B.
Batch size is determined by the size in BUFFER-A.
Requesting next or previous difference at the end or beginning
respectively of difference list, runs ediff over the adjacent chunks."
(interactive
(let (bf)
(list (setq bf (read-buffer "Buffer A to compare: "
(ediff-other-buffer "") t))
(read-buffer "Buffer B to compare: "
(progn
;; realign buffers so that two visible bufs will be
;; at the top
(save-window-excursion (other-window 1))
(ediff-other-buffer bf))
t))))
(set-buffer buffer-A)
(setq buffer-A (current-buffer)) ;names change, so reference by buffer object
(let ((batch-size vlf-batch-size))
(set-buffer buffer-B)
(setq buffer-B (current-buffer))
(vlf-set-batch-size batch-size))
(ediff-buffers buffer-A buffer-B
'((lambda () (setq vlf-ediff-session t)
(vlf-ediff-next ediff-buffer-A ediff-buffer-B
ediff-control-buffer
'vlf-next-chunk)))))
;;;###autoload
(defun vlf-ediff-files (file-A file-B batch-size)
"Run batch by batch ediff over FILE-A and FILE-B.
Files are processed with VLF with BATCH-SIZE chunks.
Requesting next or previous difference at the end or beginning
respectively of difference list, runs ediff over the adjacent chunks."
(interactive
(let ((dir-A (if ediff-use-last-dir
ediff-last-dir-A
default-directory))
dir-B f)
(list (setq f (ediff-read-file-name
"File A to compare"
dir-A
(ediff-get-default-file-name)
'no-dirs))
(ediff-read-file-name "File B to compare"
(setq dir-B
(if ediff-use-last-dir
ediff-last-dir-B
(file-name-directory f)))
(progn
(ediff-add-to-history
'file-name-history
(ediff-abbreviate-file-name
(expand-file-name
(file-name-nondirectory f)
dir-B)))
(ediff-get-default-file-name f 1)))
(read-number "Batch size (in bytes): " vlf-batch-size))))
(let ((buffer-A (vlf file-A)))
(set-buffer buffer-A)
(vlf-set-batch-size batch-size)
(let ((buffer-B (vlf file-B)))
(vlf-ediff-buffers buffer-A buffer-B))))
(defadvice ediff-next-difference (around vlf-ediff-next-difference
compile activate)
"Move to the next VLF chunk and search for difference if at the end\
of difference list."
(if (and vlf-ediff-session
(<= (1- ediff-number-of-differences)
ediff-current-difference))
(let ((buffer-A ediff-buffer-A)
(buffer-B ediff-buffer-B)
(ediff-buffer (current-buffer)))
(save-excursion
(set-buffer buffer-A)
(vlf-next-chunk)
(set-buffer buffer-B)
(vlf-next-chunk)
(vlf-ediff-next buffer-A buffer-B ediff-buffer
'vlf-next-chunk))
(or (zerop ediff-number-of-differences)
(ediff-jump-to-difference 1)))
ad-do-it))
(defadvice ediff-previous-difference (around vlf-ediff-prev-difference
compile activate)
"Move to the previous VLF chunk and search for difference if at the\
beginning of difference list."
(if (and vlf-ediff-session
(<= ediff-current-difference 0))
(let ((buffer-A ediff-buffer-A)
(buffer-B ediff-buffer-B)
(ediff-buffer (current-buffer)))
(save-excursion
(set-buffer buffer-A)
(vlf-prev-chunk)
(set-buffer buffer-B)
(vlf-prev-chunk)
(vlf-ediff-next buffer-A buffer-B ediff-buffer
'vlf-prev-chunk))
(or (zerop ediff-number-of-differences)
(ediff-jump-to-difference -1)))
ad-do-it))
(defun vlf-next-chunk ()
"Move to next chunk."
(vlf-move-to-chunk vlf-end-pos (+ vlf-end-pos vlf-batch-size) t))
(defun vlf-prev-chunk ()
"Move to previous chunk."
(vlf-move-to-chunk (- vlf-start-pos vlf-batch-size) vlf-start-pos t))
(defun vlf-ediff-next (buffer-A buffer-B ediff-buffer
&optional next-func)
"Find next pair of chunks that differ in BUFFER-A and BUFFER-B\
governed by EDIFF-BUFFER. NEXT-FUNC is used to jump to the next
logical chunks in case there is no difference at the current ones."
(set-buffer buffer-A)
(run-hook-with-args 'vlf-before-batch-functions 'ediff)
(setq buffer-A (current-buffer)) ;names change, so reference by buffer object
(let ((end-A (= vlf-start-pos vlf-end-pos))
(chunk-A (cons vlf-start-pos vlf-end-pos))
(point-max-A (point-max))
(font-lock-A font-lock-mode)
(min-file-size vlf-file-size)
(forward-p (eq next-func 'vlf-next-chunk)))
(font-lock-mode 0)
(set-buffer buffer-B)
(run-hook-with-args 'vlf-before-batch-functions 'ediff)
(setq buffer-B (current-buffer)
min-file-size (min min-file-size vlf-file-size))
(let ((tramp-verbose (if (boundp 'tramp-verbose)
(min tramp-verbose 2)))
(end-B (= vlf-start-pos vlf-end-pos))
(chunk-B (cons vlf-start-pos vlf-end-pos))
(font-lock-B font-lock-mode)
(done nil)
(reporter (make-progress-reporter
"Searching for difference..."
(if forward-p vlf-start-pos
(- min-file-size vlf-end-pos))
min-file-size)))
(font-lock-mode 0)
(unwind-protect
(progn
(while (and (or (not end-A) (not end-B))
(or (zerop (compare-buffer-substrings
buffer-A (point-min) point-max-A
buffer-B (point-min) (point-max)))
(with-current-buffer ediff-buffer
(ediff-update-diffs)
(and (not end-A) (not end-B)
(vlf-ediff-refine buffer-A
buffer-B))
(zerop ediff-number-of-differences))))
(funcall next-func)
(setq end-B (= vlf-start-pos vlf-end-pos))
(with-current-buffer buffer-A
(funcall next-func)
(setq end-A (= vlf-start-pos vlf-end-pos)
point-max-A (point-max)))
(progress-reporter-update reporter
(if forward-p vlf-end-pos
(- vlf-file-size
vlf-start-pos))))
(progress-reporter-done reporter)
(if (or (not end-A) (not end-B))
(progn (vlf-update-buffer-name)
(set-buffer buffer-A)
(vlf-update-buffer-name))
(if forward-p
(let ((max-file-size vlf-file-size))
(vlf-move-to-chunk (- max-file-size vlf-batch-size)
max-file-size)
(set-buffer buffer-A)
(setq max-file-size (max max-file-size
vlf-file-size))
(vlf-move-to-chunk (- max-file-size
vlf-batch-size)
max-file-size))
(vlf-beginning-of-file)
(set-buffer buffer-A)
(vlf-beginning-of-file))
(set-buffer ediff-buffer)
(ediff-update-diffs)
(if (or (not forward-p)
(and (not end-A) (not end-B)))
(vlf-ediff-refine buffer-A buffer-B)))
(setq done t))
(unless done
(set-buffer buffer-A)
(set-buffer-modified-p nil)
(vlf-move-to-chunk (car chunk-A) (cdr chunk-A))
(set-buffer buffer-B)
(set-buffer-modified-p nil)
(vlf-move-to-chunk (car chunk-B) (cdr chunk-B))
(set-buffer ediff-buffer)
(ediff-update-diffs)
(vlf-ediff-refine buffer-A buffer-B))
(set-buffer buffer-A)
(if font-lock-A (font-lock-mode 1))
(run-hook-with-args 'vlf-after-batch-functions 'ediff)
(set-buffer buffer-B)
(if font-lock-B (font-lock-mode 1))
(run-hook-with-args 'vlf-after-batch-functions 'ediff)))))
(defun vlf-ediff-refine (buffer-A buffer-B)
"Try to minimize differences between BUFFER-A and BUFFER-B.
This can happen if first or last difference is at the start/end of
buffer."
(or (zerop ediff-number-of-differences)
(let ((adjust-p (vlf-ediff-adjust buffer-A buffer-B)))
(setq adjust-p (or (vlf-ediff-adjust buffer-A buffer-B t)
adjust-p))
(if adjust-p (ediff-update-diffs)))))
(defun vlf-ediff-adjust (buf-A buf-B &optional end)
"Additionally adjust buffer borders for BUF-A and BUF-B.
Adjust beginning if END is nil. Return t if refining is needed,
nil otherwise."
(let* ((diff-num (if end (1- ediff-number-of-differences) 0))
(diff-A (ediff-get-diff-overlay diff-num 'A))
(diff-B (ediff-get-diff-overlay diff-num 'B))
diff-A-str diff-B-str adjust-p)
(with-current-buffer buf-A
(setq adjust-p (if end (= (overlay-end diff-A) (point-max))
(= (overlay-start diff-A) (point-min)))
diff-A-str (and adjust-p (buffer-substring-no-properties
(overlay-start diff-A)
(overlay-end diff-A))))
(set-buffer buf-B)
(setq adjust-p (and adjust-p
(if end (= (overlay-end diff-B) (point-max))
(= (overlay-start diff-B) (point-min))))
diff-B-str (and adjust-p (buffer-substring-no-properties
(overlay-start diff-B)
(overlay-end diff-B))))
(if adjust-p
(let ((len-A (length diff-A-str))
(len-B (length diff-B-str))
(adjust-func (if end 'vlf-ediff-adjust-end
'vlf-ediff-adjust-start)))
(cond
((< len-A len-B)
(or (funcall adjust-func diff-A-str diff-B-str buf-B)
(setq adjust-p nil)))
((< len-B len-A)
(or (funcall adjust-func diff-B-str diff-A-str buf-A)
(setq adjust-p nil)))
(t (setq adjust-p nil))))))
adjust-p))
(defun vlf-ediff-adjust-start (diff-short diff-long vlf-buffer)
"Remove difference between DIFF-SHORT and DIFF-LONG from beginning\
of VLF-BUFFER."
(when (string-suffix-p diff-short diff-long)
(set-buffer vlf-buffer)
(vlf-move-to-chunk (+ vlf-start-pos
(length (encode-coding-string
(substring diff-long 0
(- (length diff-long)
(length diff-short)))
buffer-file-coding-system t)))
vlf-end-pos)))
(defun vlf-ediff-adjust-end (diff-short diff-long vlf-buffer)
"Remove difference between DIFF-SHORT and DIFF-LONG from the end of\
VLF-BUFFER."
(when (string-prefix-p diff-short diff-long)
(set-buffer vlf-buffer)
(vlf-move-to-chunk vlf-start-pos
(- vlf-end-pos
(length (encode-coding-string
(substring diff-long
(length diff-short))
buffer-file-coding-system t))))))
(unless (fboundp 'string-suffix-p)
(defun string-suffix-p (suffix string &optional ignore-case)
"Return non-nil if SUFFIX is a suffix of STRING.
If IGNORE-CASE is non-nil, the comparison is done without paying
attention to case differences."
(let ((start-pos (- (length string) (length suffix))))
(and (>= start-pos 0)
(eq t (compare-strings suffix nil nil string start-pos nil
ignore-case))))))
(provide 'vlf-ediff)
;;; vlf-ediff.el ends here

85
vlf-follow.el Normal file
View File

@@ -0,0 +1,85 @@
;;; vlf-follow.el --- VLF chunk follows point functionality -*- lexical-binding: t -*-
;; Copyright (C) 2014 Free Software Foundation, Inc.
;; Keywords: large files, follow, recenter
;; Author: Andrey Kotlarski <m00naticus@gmail.com>
;; URL: https://github.com/m00natic/vlfi
;; This file is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 3, or (at your option)
;; any later version.
;; This file is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING. If not, write to
;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.
;;; Commentary:
;; This package provides `vlf-toggle-follow' command which toggles
;; continuous recenter of chunk around current point.
;;; Code:
(require 'vlf)
(defvar vlf-follow-timer nil
"Contains timer if vlf buffer is set to continuously recenter.")
(make-variable-buffer-local 'vlf-follow-timer)
(put 'vlf-follow-timer 'permanent-local t)
(defun vlf-recenter (vlf-buffer)
"Recenter chunk around current point in VLF-BUFFER."
(and vlf-follow-timer
(eq (current-buffer) vlf-buffer)
(or (pos-visible-in-window-p (point-min))
(pos-visible-in-window-p (point-max)))
(let ((current-pos (+ vlf-start-pos (position-bytes (point))))
(half-batch (/ vlf-batch-size 2)))
(if (buffer-modified-p)
(progn
(let ((edit-end (+ (position-bytes (point-max))
vlf-start-pos)))
(vlf-move-to-chunk (min vlf-start-pos
(- current-pos half-batch))
(max edit-end
(+ current-pos half-batch))))
(goto-char (byte-to-position (- current-pos
vlf-start-pos))))
(vlf-move-to-batch (- current-pos half-batch))
(and (< half-batch current-pos)
(< half-batch (- vlf-file-size current-pos))
(goto-char (byte-to-position (- current-pos
vlf-start-pos))))))))
(defun vlf-stop-follow ()
"Stop continuous recenter."
(when vlf-follow-timer
(cancel-timer vlf-follow-timer)
(setq vlf-follow-timer nil)))
(defun vlf-start-follow (interval)
"Continuously recenter chunk around point every INTERVAL seconds."
(setq vlf-follow-timer (run-with-idle-timer interval interval
'vlf-recenter
(current-buffer)))
(add-hook 'kill-buffer-hook 'vlf-stop-follow nil t))
(defun vlf-toggle-follow ()
"Toggle continuous chunk recenter around current point."
(interactive)
(if vlf-mode
(if vlf-follow-timer
(progn (vlf-stop-follow)
(message "Following stopped"))
(vlf-start-follow (read-number "Number of seconds: " 1)))))
(provide 'vlf-follow)
;;; vlf-follow.el ends here

152
vlf-integrate.el Normal file
View File

@@ -0,0 +1,152 @@
;;; vlf-integrate.el --- VLF integration with other packages -*- lexical-binding: t -*-
;; Copyright (C) 2014 Free Software Foundation, Inc.
;; Keywords: large files, integration
;; Author: Andrey Kotlarski <m00naticus@gmail.com>
;; URL: https://github.com/m00natic/vlfi
;; This file is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 3, or (at your option)
;; any later version.
;; This file is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING. If not, write to
;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.
;;; Commentary:
;; This package enables VLF play seamlessly with rest of Emacs.
;;; Code:
(defgroup vlf nil "View Large Files in Emacs."
:prefix "vlf-" :group 'files)
(defcustom vlf-application 'ask
"Determines when `vlf' will be offered on opening files.
Possible values are: nil to never use it;
`ask' offer `vlf' when file size is beyond `large-file-warning-threshold';
`dont-ask' automatically use `vlf' for large files;
`always' use `vlf' for all files."
:group 'vlf :type '(radio (const :format "%v " nil)
(const :format "%v " ask)
(const :format "%v " dont-ask)
(const :format "%v" always)))
(defcustom vlf-forbidden-modes-list
'(archive-mode tar-mode jka-compr git-commit-mode image-mode
doc-view-mode doc-view-mode-maybe ebrowse-tree-mode)
"Major modes which VLF will not be automatically applied to."
:group 'vlf :type '(list symbol))
(unless (fboundp 'file-size-human-readable)
(defun file-size-human-readable (file-size)
"Print FILE-SIZE in MB."
(format "%.3fMB" (/ file-size 1048576.0))))
(defun vlf-determine-major-mode (filename)
"Determine major mode from FILENAME."
(let ((name filename)
(remote-id (file-remote-p filename))
mode)
;; Remove backup-suffixes from file name.
(setq name (file-name-sans-versions name))
;; Remove remote file name identification.
(and (stringp remote-id)
(string-match (regexp-quote remote-id) name)
(setq name (substring name (match-end 0))))
(setq mode
(if (memq system-type '(windows-nt cygwin))
;; System is case-insensitive.
(let ((case-fold-search t))
(assoc-default name auto-mode-alist 'string-match))
;; System is case-sensitive.
(or ;; First match case-sensitively.
(let ((case-fold-search nil))
(assoc-default name auto-mode-alist 'string-match))
;; Fallback to case-insensitive match.
(and auto-mode-case-fold
(let ((case-fold-search t))
(assoc-default name auto-mode-alist
'string-match))))))
(if (and mode (consp mode))
(cadr mode)
mode)))
(autoload 'vlf "vlf" "View Large FILE in batches." t)
(defadvice abort-if-file-too-large (around vlf-if-file-too-large
compile activate)
"If file SIZE larger than `large-file-warning-threshold', \
allow user to view file with `vlf', open it normally, or abort.
OP-TYPE specifies the file operation being performed over FILENAME."
(cond
((or (not size) (zerop size)))
((or (not vlf-application)
(not filename)
(memq (vlf-determine-major-mode filename)
vlf-forbidden-modes-list))
ad-do-it)
((eq vlf-application 'always)
(vlf filename)
(error ""))
((and large-file-warning-threshold
(< large-file-warning-threshold size))
(if (eq vlf-application 'dont-ask)
(progn (vlf filename)
(error ""))
(let ((char nil))
(while (not (memq (setq char
(read-event
(propertize
(format
"File %s is large (%s): \
%s normally (o), %s with vlf (v) or abort (a)"
(if filename
(file-name-nondirectory filename)
"")
(file-size-human-readable size)
op-type op-type)
'face 'minibuffer-prompt)))
'(?o ?O ?v ?V ?a ?A))))
(cond ((memq char '(?v ?V))
(vlf filename)
(error ""))
((memq char '(?a ?A))
(error "Aborted"))))))))
;; disable for some functions
(defmacro vlf-disable-for-function (func file)
"Build advice to disable VLF during execution of FUNC\
defined in FILE."
`(eval-after-load ,file
'(defadvice ,func (around ,(intern (concat "vlf-"
(symbol-name func)))
compile activate)
"Temporarily disable `vlf-mode'."
(let ((vlf-application nil))
ad-do-it))))
(vlf-disable-for-function tags-verify-table "etags")
(vlf-disable-for-function tag-find-file-of-tag-noselect "etags")
(vlf-disable-for-function helm-etags-create-buffer "helm-tags")
;; dired
(defun dired-vlf ()
"In Dired, visit the file on this line in VLF mode."
(interactive)
(vlf (dired-get-file-for-visit)))
(eval-after-load "dired"
'(define-key dired-mode-map "V" 'dired-vlf))
(provide 'vlf-integrate)
;;; vlf-integrate.el ends here

256
vlf-occur.el Normal file
View File

@@ -0,0 +1,256 @@
;;; vlf-occur.el --- Occur-like functionality for VLF -*- lexical-binding: t -*-
;; Copyright (C) 2014 Free Software Foundation, Inc.
;; Keywords: large files, indexing, occur
;; Author: Andrey Kotlarski <m00naticus@gmail.com>
;; URL: https://github.com/m00natic/vlfi
;; This file is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 3, or (at your option)
;; any later version.
;; This file is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING. If not, write to
;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.
;;; Commentary:
;; This package provides the `vlf-occur' command which builds
;; index of search occurrences in large file just like occur.
;;; Code:
(require 'vlf)
(defvar vlf-occur-mode-map
(let ((map (make-sparse-keymap)))
(define-key map "n" 'vlf-occur-next-match)
(define-key map "p" 'vlf-occur-prev-match)
(define-key map "\C-m" 'vlf-occur-visit)
(define-key map "\M-\r" 'vlf-occur-visit-new-buffer)
(define-key map [mouse-1] 'vlf-occur-visit)
(define-key map "o" 'vlf-occur-show)
map)
"Keymap for command `vlf-occur-mode'.")
(define-derived-mode vlf-occur-mode special-mode "VLF[occur]"
"Major mode for showing occur matches of VLF opened files.")
(defun vlf-occur-next-match ()
"Move cursor to next match."
(interactive)
(if (eq (get-char-property (point) 'face) 'match)
(goto-char (next-single-property-change (point) 'face)))
(goto-char (or (text-property-any (point) (point-max) 'face 'match)
(text-property-any (point-min) (point)
'face 'match))))
(defun vlf-occur-prev-match ()
"Move cursor to previous match."
(interactive)
(if (eq (get-char-property (point) 'face) 'match)
(goto-char (previous-single-property-change (point) 'face)))
(while (not (eq (get-char-property (point) 'face) 'match))
(goto-char (or (previous-single-property-change (point) 'face)
(point-max)))))
(defun vlf-occur-show (&optional event)
"Visit current `vlf-occur' link in a vlf buffer but stay in the \
occur buffer. If original VLF buffer has been killed,
open new VLF session each time.
EVENT may hold details of the invocation."
(interactive (list last-nonmenu-event))
(let ((occur-buffer (if event
(window-buffer (posn-window
(event-end event)))
(current-buffer))))
(vlf-occur-visit event)
(pop-to-buffer occur-buffer)))
(defun vlf-occur-visit-new-buffer ()
"Visit `vlf-occur' link in new vlf buffer."
(interactive)
(let ((current-prefix-arg t))
(vlf-occur-visit)))
(defun vlf-occur-visit (&optional event)
"Visit current `vlf-occur' link in a vlf buffer.
With prefix argument or if original VLF buffer has been killed,
open new VLF session.
EVENT may hold details of the invocation."
(interactive (list last-nonmenu-event))
(when event
(set-buffer (window-buffer (posn-window (event-end event))))
(goto-char (posn-point (event-end event))))
(let* ((pos (point))
(pos-relative (- pos (line-beginning-position) 1))
(file (get-char-property pos 'file)))
(if file
(let ((chunk-start (get-char-property pos 'chunk-start))
(chunk-end (get-char-property pos 'chunk-end))
(vlf-buffer (get-char-property pos 'buffer))
(occur-buffer (current-buffer))
(match-pos (+ (get-char-property pos 'line-pos)
pos-relative)))
(cond (current-prefix-arg
(setq vlf-buffer (vlf file))
(switch-to-buffer occur-buffer))
((not (buffer-live-p vlf-buffer))
(or (catch 'found
(dolist (buf (buffer-list))
(set-buffer buf)
(and vlf-mode (equal file buffer-file-name)
(setq vlf-buffer buf)
(throw 'found t))))
(setq vlf-buffer (vlf file)))
(switch-to-buffer occur-buffer)))
(pop-to-buffer vlf-buffer)
(vlf-move-to-chunk chunk-start chunk-end)
(goto-char match-pos)))))
(defun vlf-occur (regexp)
"Make whole file occur style index for REGEXP.
Prematurely ending indexing will still show what's found so far."
(interactive (list (read-regexp "List lines matching regexp"
(if regexp-history
(car regexp-history)))))
(if (buffer-modified-p) ;use temporary buffer not to interfere with modifications
(let ((vlf-buffer (current-buffer))
(file buffer-file-name)
(batch-size vlf-batch-size))
(with-temp-buffer
(setq buffer-file-name file)
(set-buffer-modified-p nil)
(set (make-local-variable 'vlf-batch-size) batch-size)
(vlf-mode 1)
(goto-char (point-min))
(run-hook-with-args 'vlf-before-batch-functions 'occur)
(vlf-with-undo-disabled
(vlf-build-occur regexp vlf-buffer))
(run-hook-with-args 'vlf-after-batch-functions 'occur)))
(run-hook-with-args 'vlf-before-batch-functions 'occur)
(let ((start-pos vlf-start-pos)
(end-pos vlf-end-pos)
(pos (point)))
(vlf-with-undo-disabled
(vlf-beginning-of-file)
(goto-char (point-min))
(unwind-protect (vlf-build-occur regexp (current-buffer))
(vlf-move-to-chunk start-pos end-pos)
(goto-char pos))))
(run-hook-with-args 'vlf-after-batch-functions 'occur)))
(defun vlf-build-occur (regexp vlf-buffer)
"Build occur style index for REGEXP over VLF-BUFFER."
(let ((tramp-verbose (if (boundp 'tramp-verbose)
(min tramp-verbose 2)))
(case-fold-search t)
(line 1)
(last-match-line 0)
(last-line-pos (point-min))
(file buffer-file-name)
(total-matches 0)
(match-end-pos (+ vlf-start-pos (position-bytes (point))))
(occur-buffer (generate-new-buffer
(concat "*VLF-occur " (file-name-nondirectory
buffer-file-name)
"*")))
(line-regexp (concat "\\(?5:[\n\C-m]\\)\\|\\(?10:"
regexp "\\)"))
(batch-step (/ vlf-batch-size 8))
(end-of-file nil)
(reporter (make-progress-reporter
(concat "Building index for " regexp "...")
vlf-start-pos vlf-file-size)))
(unwind-protect
(progn
(while (not end-of-file)
(if (re-search-forward line-regexp nil t)
(progn
(setq match-end-pos (+ vlf-start-pos
(position-bytes
(match-end 0))))
(if (match-string 5)
(setq line (1+ line) ; line detected
last-line-pos (point))
(let* ((chunk-start vlf-start-pos)
(chunk-end vlf-end-pos)
(line-pos (line-beginning-position))
(line-text (buffer-substring
line-pos (line-end-position))))
(with-current-buffer occur-buffer
(unless (= line last-match-line) ;new match line
(insert "\n:") ; insert line number
(let* ((overlay-pos (1- (point)))
(overlay (make-overlay
overlay-pos
(1+ overlay-pos))))
(overlay-put overlay 'before-string
(propertize
(number-to-string line)
'face 'shadow)))
(insert (propertize line-text ; insert line
'file file
'buffer vlf-buffer
'chunk-start chunk-start
'chunk-end chunk-end
'mouse-face '(highlight)
'line-pos line-pos
'help-echo
(format "Move to line %d"
line))))
(setq last-match-line line
total-matches (1+ total-matches))
(let ((line-start (1+
(line-beginning-position)))
(match-pos (match-beginning 10)))
(add-text-properties ; mark match
(+ line-start match-pos (- last-line-pos))
(+ line-start (match-end 10)
(- last-line-pos))
(list 'face 'match
'help-echo
(format "Move to match %d"
total-matches))))))))
(setq end-of-file (= vlf-end-pos vlf-file-size))
(unless end-of-file
(let ((batch-move (- vlf-end-pos batch-step)))
(vlf-move-to-batch (if (< batch-move match-end-pos)
match-end-pos
batch-move) t))
(goto-char (if (< vlf-start-pos match-end-pos)
(or (byte-to-position (- match-end-pos
vlf-start-pos))
(point-min))
(point-min)))
(setq last-match-line 0
last-line-pos (line-beginning-position))
(progress-reporter-update reporter vlf-end-pos))))
(progress-reporter-done reporter))
(set-buffer-modified-p nil)
(if (zerop total-matches)
(progn (with-current-buffer occur-buffer
(set-buffer-modified-p nil))
(kill-buffer occur-buffer)
(message "No matches for \"%s\"" regexp))
(with-current-buffer occur-buffer
(goto-char (point-min))
(insert (propertize
(format "%d matches in %d lines for \"%s\" \
in file: %s" total-matches line regexp file)
'face 'underline))
(set-buffer-modified-p nil)
(forward-char 2)
(vlf-occur-mode))
(display-buffer occur-buffer)))))
(provide 'vlf-occur)
;;; vlf-occur.el ends here

258
vlf-search.el Normal file
View File

@@ -0,0 +1,258 @@
;;; vlf-search.el --- Search functionality for VLF -*- lexical-binding: t -*-
;; Copyright (C) 2014 Free Software Foundation, Inc.
;; Keywords: large files, search
;; Author: Andrey Kotlarski <m00naticus@gmail.com>
;; URL: https://github.com/m00natic/vlfi
;; This file is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 3, or (at your option)
;; any later version.
;; This file is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING. If not, write to
;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.
;;; Commentary:
;; This package provides search utilities for dealing with large files
;; in constant memory.
;;; Code:
(require 'vlf)
(defun vlf-re-search (regexp count backward batch-step)
"Search for REGEXP COUNT number of times forward or BACKWARD.
BATCH-STEP is amount of overlap between successive chunks."
(if (<= count 0)
(error "Count must be positive"))
(run-hook-with-args 'vlf-before-batch-functions 'search)
(let* ((tramp-verbose (if (boundp 'tramp-verbose)
(min tramp-verbose 2)))
(case-fold-search t)
(match-chunk-start vlf-start-pos)
(match-chunk-end vlf-end-pos)
(match-start-pos (+ vlf-start-pos (position-bytes (point))))
(match-end-pos match-start-pos)
(to-find count)
(font-lock font-lock-mode)
(reporter (make-progress-reporter
(concat "Searching for " regexp "...")
(if backward
(- vlf-file-size vlf-end-pos)
vlf-start-pos)
vlf-file-size)))
(font-lock-mode 0)
(vlf-with-undo-disabled
(unwind-protect
(catch 'end-of-file
(if backward
(while (not (zerop to-find))
(cond ((re-search-backward regexp nil t)
(setq to-find (1- to-find)
match-chunk-start vlf-start-pos
match-chunk-end vlf-end-pos
match-start-pos (+ vlf-start-pos
(position-bytes
(match-beginning 0)))
match-end-pos (+ vlf-start-pos
(position-bytes
(match-end 0)))))
((zerop vlf-start-pos)
(throw 'end-of-file nil))
(t (let ((batch-move (- vlf-start-pos
(- vlf-batch-size
batch-step))))
(vlf-move-to-batch
(if (< match-start-pos batch-move)
(- match-start-pos vlf-batch-size)
batch-move) t))
(goto-char (if (< match-start-pos
vlf-end-pos)
(or (byte-to-position
(- match-start-pos
vlf-start-pos))
(point-max))
(point-max)))
(progress-reporter-update
reporter (- vlf-file-size
vlf-start-pos)))))
(while (not (zerop to-find))
(cond ((re-search-forward regexp nil t)
(setq to-find (1- to-find)
match-chunk-start vlf-start-pos
match-chunk-end vlf-end-pos
match-start-pos (+ vlf-start-pos
(position-bytes
(match-beginning 0)))
match-end-pos (+ vlf-start-pos
(position-bytes
(match-end 0)))))
((= vlf-end-pos vlf-file-size)
(throw 'end-of-file nil))
(t (let ((batch-move (- vlf-end-pos batch-step)))
(vlf-move-to-batch
(if (< batch-move match-end-pos)
match-end-pos
batch-move) t))
(goto-char (if (< vlf-start-pos match-end-pos)
(or (byte-to-position
(- match-end-pos
vlf-start-pos))
(point-min))
(point-min)))
(progress-reporter-update reporter
vlf-end-pos)))))
(progress-reporter-done reporter))
(set-buffer-modified-p nil)
(if font-lock (font-lock-mode 1))
(if backward
(vlf-goto-match match-chunk-start match-chunk-end
match-end-pos match-start-pos
count to-find)
(vlf-goto-match match-chunk-start match-chunk-end
match-start-pos match-end-pos
count to-find))
(run-hook-with-args 'vlf-after-batch-functions 'search)))))
(defun vlf-goto-match (match-chunk-start match-chunk-end
match-pos-start
match-pos-end
count to-find)
"Move to MATCH-CHUNK-START MATCH-CHUNK-END surrounding\
MATCH-POS-START and MATCH-POS-END.
According to COUNT and left TO-FIND, show if search has been
successful. Return nil if nothing found."
(if (= count to-find)
(progn (vlf-move-to-chunk match-chunk-start match-chunk-end)
(goto-char (or (byte-to-position (- match-pos-start
vlf-start-pos))
(point-max)))
(message "Not found")
nil)
(let ((success (zerop to-find)))
(if success
(vlf-update-buffer-name)
(vlf-move-to-chunk match-chunk-start match-chunk-end))
(let* ((match-end (or (byte-to-position (- match-pos-end
vlf-start-pos))
(point-max)))
(overlay (make-overlay (byte-to-position
(- match-pos-start
vlf-start-pos))
match-end)))
(overlay-put overlay 'face 'match)
(unless success
(goto-char match-end)
(message "Moved to the %d match which is last"
(- count to-find)))
(unwind-protect (sit-for 3)
(delete-overlay overlay))
t))))
(defun vlf-re-search-forward (regexp count)
"Search forward for REGEXP prefix COUNT number of times.
Search is performed chunk by chunk in `vlf-batch-size' memory."
(interactive (if (vlf-no-modifications)
(list (read-regexp "Search whole file"
(if regexp-history
(car regexp-history)))
(or current-prefix-arg 1))))
(vlf-re-search regexp count nil (/ vlf-batch-size 8)))
(defun vlf-re-search-backward (regexp count)
"Search backward for REGEXP prefix COUNT number of times.
Search is performed chunk by chunk in `vlf-batch-size' memory."
(interactive (if (vlf-no-modifications)
(list (read-regexp "Search whole file backward"
(if regexp-history
(car regexp-history)))
(or current-prefix-arg 1))))
(vlf-re-search regexp count t (/ vlf-batch-size 8)))
(defun vlf-goto-line (n)
"Go to line N. If N is negative, count from the end of file."
(interactive (if (vlf-no-modifications)
(list (read-number "Go to line: "))))
(run-hook-with-args 'vlf-before-batch-functions 'goto-line)
(vlf-verify-size)
(let ((tramp-verbose (if (boundp 'tramp-verbose)
(min tramp-verbose 2)))
(start-pos vlf-start-pos)
(end-pos vlf-end-pos)
(pos (point))
(font-lock font-lock-mode)
(success nil))
(font-lock-mode 0)
(unwind-protect
(if (< 0 n)
(let ((start 0)
(end (min vlf-batch-size vlf-file-size))
(reporter (make-progress-reporter
(concat "Searching for line "
(number-to-string n) "...")
0 vlf-file-size))
(inhibit-read-only t))
(setq n (1- n))
(vlf-with-undo-disabled
(while (and (< (- end start) n)
(< n (- vlf-file-size start)))
(erase-buffer)
(insert-file-contents-literally buffer-file-name
nil start end)
(goto-char (point-min))
(while (re-search-forward "[\n\C-m]" nil t)
(setq n (1- n)))
(vlf-verify-size)
(setq start end
end (min vlf-file-size
(+ start vlf-batch-size)))
(progress-reporter-update reporter start))
(when (< n (- vlf-file-size end))
(vlf-move-to-chunk-2 start end)
(goto-char (point-min))
(setq success (vlf-re-search "[\n\C-m]" n nil 0)))))
(let ((start (max 0 (- vlf-file-size vlf-batch-size)))
(end vlf-file-size)
(reporter (make-progress-reporter
(concat "Searching for line -"
(number-to-string n) "...")
0 vlf-file-size))
(inhibit-read-only t))
(setq n (- n))
(vlf-with-undo-disabled
(while (and (< (- end start) n) (< n end))
(erase-buffer)
(insert-file-contents-literally buffer-file-name nil
start end)
(goto-char (point-max))
(while (re-search-backward "[\n\C-m]" nil t)
(setq n (1- n)))
(setq end start
start (max 0 (- end vlf-batch-size)))
(progress-reporter-update reporter
(- vlf-file-size end)))
(when (< n end)
(vlf-move-to-chunk-2 start end)
(goto-char (point-max))
(setq success (vlf-re-search "[\n\C-m]" n t 0))))))
(if font-lock (font-lock-mode 1))
(unless success
(vlf-with-undo-disabled
(vlf-move-to-chunk-2 start-pos end-pos))
(vlf-update-buffer-name)
(goto-char pos)
(message "Unable to find line"))
(run-hook-with-args 'vlf-after-batch-functions 'goto-line))))
(provide 'vlf-search)
;;; vlf-search.el ends here

153
vlf-write.el Normal file
View File

@@ -0,0 +1,153 @@
;;; vlf-write.el --- Saving functionality for VLF -*- lexical-binding: t -*-
;; Copyright (C) 2014 Free Software Foundation, Inc.
;; Keywords: large files, saving
;; Author: Andrey Kotlarski <m00naticus@gmail.com>
;; URL: https://github.com/m00natic/vlfi
;; This file is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 3, or (at your option)
;; any later version.
;; This file is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING. If not, write to
;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.
;;; Commentary:
;; This package provides the `vlf-write' command which takes care of
;; saving changes where only part of file is viewed and updated.
;;; Code:
(require 'vlf-base)
(defun vlf-write ()
"Write current chunk to file. Always return true to disable save.
If changing size of chunk, shift remaining file content."
(interactive)
(when (and (buffer-modified-p)
(or (verify-visited-file-modtime (current-buffer))
(y-or-n-p "File has changed since visited or saved.\
Save anyway? ")))
(run-hook-with-args 'vlf-before-batch-functions 'write)
(if (zerop vlf-file-size) ;new file
(progn (write-region nil nil buffer-file-name vlf-start-pos t)
(setq vlf-file-size (vlf-get-file-size
buffer-file-truename)
vlf-end-pos vlf-file-size)
(vlf-update-buffer-name))
(widen)
(let* ((region-length (length (encode-coding-region
(point-min) (point-max)
buffer-file-coding-system t)))
(size-change (- vlf-end-pos vlf-start-pos
region-length)))
(if (zerop size-change)
(write-region nil nil buffer-file-name vlf-start-pos t)
(let ((tramp-verbose (if (boundp 'tramp-verbose)
(min tramp-verbose 2)))
(pos (point))
(font-lock font-lock-mode))
(font-lock-mode 0)
(if (< 0 size-change)
(vlf-file-shift-back size-change)
(vlf-file-shift-forward (- size-change)))
(if font-lock (font-lock-mode 1))
(vlf-move-to-chunk-2 vlf-start-pos
(if (< (- vlf-end-pos vlf-start-pos)
vlf-batch-size)
(+ vlf-start-pos vlf-batch-size)
vlf-end-pos))
(vlf-update-buffer-name)
(goto-char pos)))))
(run-hook-with-args 'vlf-after-batch-functions 'write))
t)
(defun vlf-file-shift-back (size-change)
"Shift file contents SIZE-CHANGE bytes back."
(write-region nil nil buffer-file-name vlf-start-pos t)
(let ((read-start-pos vlf-end-pos)
(coding-system-for-write 'no-conversion)
(reporter (make-progress-reporter "Adjusting file content..."
vlf-end-pos
vlf-file-size)))
(vlf-with-undo-disabled
(while (vlf-shift-batch read-start-pos (- read-start-pos
size-change))
(setq read-start-pos (+ read-start-pos vlf-batch-size))
(progress-reporter-update reporter read-start-pos))
;; pad end with space
(erase-buffer)
(vlf-verify-size t)
(insert-char 32 size-change))
(write-region nil nil buffer-file-name (- vlf-file-size
size-change) t)
(progress-reporter-done reporter)))
(defun vlf-shift-batch (read-pos write-pos)
"Read `vlf-batch-size' bytes from READ-POS and write them \
back at WRITE-POS. Return nil if EOF is reached, t otherwise."
(erase-buffer)
(vlf-verify-size t)
(let ((read-end (+ read-pos vlf-batch-size)))
(insert-file-contents-literally buffer-file-name nil
read-pos
(min vlf-file-size read-end))
(write-region nil nil buffer-file-name write-pos 0)
(< read-end vlf-file-size)))
(defun vlf-file-shift-forward (size-change)
"Shift file contents SIZE-CHANGE bytes forward.
Done by saving content up front and then writing previous batch."
(let ((read-size (max (/ vlf-batch-size 2) size-change))
(read-pos vlf-end-pos)
(write-pos vlf-start-pos)
(reporter (make-progress-reporter "Adjusting file content..."
vlf-start-pos
vlf-file-size)))
(vlf-with-undo-disabled
(when (vlf-shift-batches read-size read-pos write-pos t)
(setq write-pos (+ read-pos size-change)
read-pos (+ read-pos read-size))
(progress-reporter-update reporter write-pos)
(let ((coding-system-for-write 'no-conversion))
(while (vlf-shift-batches read-size read-pos write-pos nil)
(setq write-pos (+ read-pos size-change)
read-pos (+ read-pos read-size))
(progress-reporter-update reporter write-pos)))))
(progress-reporter-done reporter)))
(defun vlf-shift-batches (read-size read-pos write-pos hide-read)
"Append READ-SIZE bytes of file starting at READ-POS.
Then write initial buffer content to file at WRITE-POS.
If HIDE-READ is non nil, temporarily hide literal read content.
Return nil if EOF is reached, t otherwise."
(vlf-verify-size t)
(let ((read-more (< read-pos vlf-file-size))
(start-write-pos (point-min))
(end-write-pos (point-max)))
(when read-more
(goto-char end-write-pos)
(insert-file-contents-literally buffer-file-name nil read-pos
(min vlf-file-size
(+ read-pos read-size))))
;; write
(if hide-read ; hide literal region if user has to choose encoding
(narrow-to-region start-write-pos end-write-pos))
(write-region start-write-pos end-write-pos
buffer-file-name write-pos 0)
(delete-region start-write-pos end-write-pos)
(if hide-read (widen))
read-more))
(provide 'vlf-write)
;;; vlf-write.el ends here

1045
vlf.el

File diff suppressed because it is too large Load Diff