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

199 Commits
0.9 ... master

Author SHA1 Message Date
Damien Cassou
cc02f25337 Fix typos
Typos found with codespell.
2019-11-27 00:50:22 +02:00
Troy Hinckley
31b292dc85 fixed large-file-warning-threshold error 2018-02-02 00:54:59 +02:00
Andrey Kotlarski
a01e9ed416 Minor README additions. 2017-11-20 23:25:27 +02:00
George D. Plymale II
25e16ef85d Fix broken link in README
This fixes the link to the ELPA page.
2017-11-20 23:24:33 +02:00
Dan Harms
df677c128f Issue 35: make mode-line batch indicators more accurate 2017-08-30 21:48:26 +03:00
Dan Harms
b62bc04612 Issue 31 Make vlf-batch-size configurable in the remote case 2017-07-14 02:52:01 +03:00
Andrey Kotlarski
55e0c404c8 Explicitly set coding-system-for-read to the current coding when not
inserting from the beginning.
2017-05-01 19:32:18 +03:00
Nil Geisweiller
eaa3629227 Fix cursor position after search
After searching forward (resp. backward) the cursor should be at the
end (resp. the beginning) of the match. That way one can jump to the
next match by running again the command.
2017-03-31 02:13:14 +03:00
Andrey Kotlarski
a8ba8363b2 Fix issue where tramp-verbose is bound to nil. 2016-10-30 17:40:59 +02:00
Andrey Kotlarski
4eaf763cad Rename vlf-integrate.el to vlf-setup.el 2015-01-01 17:18:35 +02:00
Andrey Kotlarski
ac1aa160e6 Standard naming for chunk update hooks. 2015-01-01 16:18:45 +02:00
Andrey Kotlarski
fd90b3a6b1 Use xdigit regex class in vlf-hexl-adjust-addresses. 2014-12-27 02:34:57 +02:00
Andrey Kotlarski
726f50bf34 Fix byte-compilation warnings on install. 2014-12-27 02:34:04 +02:00
Andrey Kotlarski
86be48302e Improve search precision. 2014-12-27 02:31:47 +02:00
Andrey Kotlarski
b300137941 Encode smaller region to detect cut point overall offset in vlf-occur
when moving to next batch and be more precise with hexl-mode active.
2014-12-27 02:27:18 +02:00
Andrey Kotlarski
bc398d6053 - don't adjust start on next occur batch
- don't gather profile info for adjustment insert as it's too small
2014-12-17 01:46:33 +02:00
Andrey Kotlarski
b14c912afb Copy around buffer specific profile vectors when forking new buffers. 2014-12-17 01:42:05 +02:00
Andrey Kotlarski
68d6c1bc33 vlf-occur changes:
- support multi-line matches
- divide user regex search from line counting
- fix wrong last match overall position
- fix edge cases of incorrect line numbers, matches in last chunk line
which is incomplete
2014-12-13 18:49:37 +02:00
Andrey Kotlarski
0fa624837a Optimize unconditional chunk loading and prefer it in more cases of
overlapping batch moves.
2014-12-13 18:46:57 +02:00
Andrey Kotlarski
f4526a1492 Forbid short-cutting in line search. 2014-12-13 18:41:14 +02:00
Andrey Kotlarski
bd5f9ca6fe Back to using per buffer profiling for encode speed. 2014-12-13 18:39:35 +02:00
Andrey Kotlarski
1c961f45b2 Fix whole file reload in read-only buffer on vlf-mode exit. 2014-12-13 18:37:31 +02:00
Andrey Kotlarski
d1a6800b5b Move vlf information from buffer name to the mode line. 2014-12-13 02:03:58 +02:00
Andrey Kotlarski
a7be7136be Set vlf-tune-max with proper value in case RAM size is wrongly
determined.
2014-11-18 12:02:24 +02:00
Andrey Kotlarski
f43ada1173 Fix byte compilation warnings. 2014-10-16 02:56:34 +03:00
Andrey Kotlarski
5dd9e2cd02 Adjust address parts of hexlified buffer according to vlf-start-pos. 2014-10-16 02:56:34 +03:00
Andrey Kotlarski
305d8022c4 Use shared profiling info for encode, write and hexl operations. 2014-10-08 19:33:59 +03:00
Andrey Kotlarski
d579b7b3e2 Workaround local maximum in batch tune. 2014-10-07 14:18:34 +03:00
Andrey Kotlarski
ce13609f14 Fix vlf-ediff at the borders of hexl buffers. 2014-10-07 13:20:04 +03:00
Andrey Kotlarski
673ae08848 Lower tramp verbosity level. 2014-10-07 13:19:40 +03:00
Andrey Kotlarski
ac8d4008bd Fixes to hexl-mode activation. 2014-10-07 01:42:33 +03:00
Andrey Kotlarski
7b9befe81a - don't load unnecessary data at the end of search or occur
- don't flood profile vector with approximations in linear search
2014-10-07 01:33:21 +03:00
Andrey Kotlarski
61599a007f Change linear tune to search only known measures and use it to
initialize occur indexing.  Make default tune step smaller.
2014-10-02 13:49:42 +03:00
Andrey Kotlarski
3cfa9b1935 Refactor vlf-query-replace and don't adjust batch size if only
statistics are enabled.
2014-09-26 15:22:25 +03:00
Andrey Kotlarski
f63ea96c2b Document new query replace and save options. 2014-09-26 14:14:16 +03:00
Andrey Kotlarski
c3a308c835 Optimize save performance over the temp file if such is used. Add
customization option whether to use temp file.
2014-09-26 14:00:01 +03:00
Andrey Kotlarski
842569ae07 Add ability to use temporary file when adjusting content on save. 2014-09-26 01:56:12 +03:00
Andrey Kotlarski
2c660b064f Fix positive goto-line search and make highlighting of match optional. 2014-09-25 19:15:12 +03:00
Andrey Kotlarski
a9c14e2d4c Add regexp query replace over whole file command. 2014-09-25 17:54:42 +03:00
Andrey Kotlarski
023ee704e7 Declare hexl functions to please byte compiler. 2014-09-25 17:53:21 +03:00
Andrey Kotlarski
e4a2e806c9 Optimize goto-line for hexl-mode, no need to search. 2014-09-25 01:25:48 +03:00
Andrey Kotlarski
b9187918f7 Improve vlf performance with hexl-mode. Align batches to hexl-bits
width.
2014-09-25 01:23:08 +03:00
Andrey Kotlarski
d9cc6fb65e Fix vlf-tune-optimal-load in case best value prunes slower times leaving
all-less flag on.
2014-09-08 14:32:02 +03:00
Andrey Kotlarski
199209fe15 Fix vlf-tune-optimal-load with no optional arguments supplied. 2014-09-08 12:36:35 +03:00
Andrey Kotlarski
06b4f856ac Respect disabled tune settings and move custom options. 2014-09-08 02:21:09 +03:00
Andrey Kotlarski
ff06509caa Document tune functionality. 2014-09-08 02:19:29 +03:00
Andrey Kotlarski
9b6657bcc5 Replace usage of conservative tune in single batch operations with load
tuning.
2014-09-07 22:10:56 +03:00
Andrey Kotlarski
ca564988e0 Change vlf-tune-get-optimal to optimize on total time of primitive
operations, also fix hexl timing functions not to book in cases where
hexl is already (not) active.
2014-09-07 18:05:13 +03:00
Andrey Kotlarski
0d2c096ed6 Restore batch size and hexl mode in case of failed search or occur. 2014-09-07 18:04:17 +03:00
Andrey Kotlarski
d526ea8ef8 Apply and restore batch size in more cases. 2014-09-07 16:25:36 +03:00
Andrey Kotlarski
9271f68c05 Add function to linearly search best batch size according to existing
measurements and offer it when interactively changing batch size.
2014-09-07 00:08:32 +03:00
Andrey Kotlarski
35ede9403c Restore batch size after save with adjustment. 2014-09-07 00:07:21 +03:00
Andrey Kotlarski
ee7409bfa5 Tune batch size in more cases. 2014-09-07 00:06:10 +03:00
Andrey Kotlarski
11c7af4b04 Change handling of measurement values to support approximations. 2014-09-07 00:02:14 +03:00
Andrey Kotlarski
5651ee3d61 Rename vlf-tune-optimal to vlf-tune-batch. 2014-09-06 23:59:32 +03:00
Andrey Kotlarski
f3212ec9a6 Fix measure approximation and allow tuning to just over half file
batch.
2014-09-05 19:11:48 +03:00
Andrey Kotlarski
48a014f3bc Fix write measuring and endless loop in nearby approximation. 2014-09-05 14:44:24 +03:00
Andrey Kotlarski
facdb9f6bc Fix binary tune base case and add approximation after access to
previously queried measure that is still missing.
2014-09-05 13:52:46 +03:00
Andrey Kotlarski
e8bb4a91da Apply batch size tuning on adjacent moves, search, save adjusting and
report total times.
2014-09-05 02:52:32 +03:00
Andrey Kotlarski
e18a05b7cb Add linear search for tuning and prefer smaller batches. 2014-09-05 02:49:55 +03:00
Andrey Kotlarski
d85f3d43fc Fix access to uninitialized measurements when tuning. 2014-09-04 15:43:37 +03:00
Andrey Kotlarski
0d9cc8e488 Don't measure encoding of too small region when adjusting chunk start
and fix passing of elements to tune in vlf-occur.
2014-09-04 15:26:25 +03:00
Andrey Kotlarski
d67825c4cd Move back to using average speed when measuring and tuning. Be more
precise when choosing index for measurement.
2014-09-04 15:25:44 +03:00
Andrey Kotlarski
70a81077ab Add vlf-batch-size tuning in vlf-occur. 2014-09-04 03:34:27 +03:00
Andrey Kotlarski
5379943cd7 Save times instead of speeds, compare on cumulative speed when tuning. 2014-09-04 03:33:05 +03:00
Andrey Kotlarski
fb0503064d Add basic tune strategies. 2014-09-03 02:35:20 +03:00
Andrey Kotlarski
069b2f55d4 Replace operations with respective vlf-tune wrappers. 2014-08-31 02:38:14 +03:00
Andrey Kotlarski
32ff2cb067 Add bookkeeping module. 2014-08-31 02:10:28 +03:00
Andrey Kotlarski
2e9ff70d56 Enlarge default batch size but keep is small on initial load of remote
files and on demand.
2014-08-23 00:09:44 +03:00
Andrey Kotlarski
569e4b2523 Don't ask needles questions on changing helm batch and restore undo
information when possible.
2014-08-23 00:01:13 +03:00
Andrey Kotlarski
557d751f78 Be more precise on restoring hexl-mode after chunk update has been
canceled.
2014-08-18 01:19:59 +03:00
Andrey Kotlarski
694d1de495 Allow vlf-occur results be saved to file and later reused. 2014-08-17 22:45:09 +03:00
Andrey Kotlarski
86223ed46c Fixes to hexl-mode integration. 2014-08-17 22:27:36 +03:00
Andrey Kotlarski
274c5ab903 Perform search, occur and ediff operations over hexl content instead
over raw data when hexl-mode is active.
2014-08-12 23:31:09 +03:00
Andrey Kotlarski
a1ca1e3428 Don't launch vlf when file size is less than vlf-batch-size. 2014-08-12 03:18:03 +03:00
Andrey Kotlarski
ece554a3bd Wording. 2014-08-10 18:48:36 +03:00
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
Andrey Kotlarski
371c560f4b Bump version and remove warning - save is now reliable. 2013-12-11 01:11:13 +02:00
Andrey Kotlarski
a3901b8f1a Fix deletion when moving to partially overlapping chunk and enable more
intelligent behaviour in cases of overlapping and modifications.
2013-12-09 01:55:41 +02:00
Andrey Kotlarski
f4ee23c07f Fix chunk end adjustment and save for current and older Emacsen. 2013-12-08 21:11:08 +02:00
Andrey Kotlarski
959bbc7661 Disable undo in cases of partial chunk move. 2013-12-08 17:22:23 +02:00
Andrey Kotlarski
0080991fa9 Fix chunk end adjustment and save for trunk Emacs. 2013-12-08 17:21:34 +02:00
Andrey Kotlarski
46e39a0fd8 Version 1.0. 2013-12-07 20:20:41 +02:00
Andrey Kotlarski
51d95ec0a3 Add command to display batch starting from point. 2013-12-07 20:18:07 +02:00
Andrey Kotlarski
d6c722376c Delete obsolete vlfi.el. 2013-12-07 19:50:19 +02:00
Andrey Kotlarski
a42247cac4 Automatically scroll to adjacent batch when start or end of chunk is
visible.
2013-12-04 15:11:04 +02:00
Andrey Kotlarski
3e8098af61 Rename vlf-discard-edit -> vlf-refresh. 2013-12-04 14:44:11 +02:00
Andrey Kotlarski
28646fbfee Reduce scope of vlf-with-undo-disabled usages. 2013-12-04 14:40:07 +02:00
Andrey Kotlarski
177c680288 Revert to showing batch size in buffer name instead of the mode-line. 2013-12-04 14:00:24 +02:00
Andrey Kotlarski
2ac3e7d577 Fix prematurely ending search/occur not to ask for modified buffer
confirmation.
2013-12-04 13:59:08 +02:00
Andrey Kotlarski
931ca52688 Stylistic refinements. 2013-12-04 00:20:02 +02:00
Andrey Kotlarski
42e581da61 Add command to unconditionally open fresh VLF buffer to visit occur
match.
2013-12-04 00:15:31 +02:00
Andrey Kotlarski
a65f3a431d Check for unsaved changes before search query and don't enable undo if
it was previously disabled.
2013-12-04 00:03:29 +02:00
Andrey Kotlarski
f34986a9b8 Update README. 2013-12-03 02:54:33 +02:00
Andrey Kotlarski
452b7eb42d Ensure there are no modifications when executing searches. 2013-12-03 02:37:13 +02:00
Andrey Kotlarski
2dba838015 In case original VLF buffer has been killed, try to find existing VLF
buffer for the same file when visiting occur results.
2013-12-03 02:04:27 +02:00
Andrey Kotlarski
cb47e19128 Use temporary buffer for occur in case of modifications. 2013-12-03 01:50:03 +02:00
Andrey Kotlarski
efae918a83 Turn vlf into minor mode. 2013-12-02 02:08:24 +02:00
Andrey Kotlarski
7a141091c8 Fix search for GNU Emacs 23 (no assert). 2013-08-26 12:29:39 +03:00
Andrey Kotlarski
8ab1c6a4f2 Disable undo and mark buffer as not modified when invoking search or
indexing.
2013-08-26 12:03:18 +03:00
Andrey Kotlarski
ae2237d7ea Minor adjustments:
- fix batch position formatting
- unconditionally update chunk on revert
- do nothing if same chunk is requested in `vlf-move-to-chunk'
2013-08-26 00:39:51 +03:00
Andrey Kotlarski
9b22b74f21 Add gitignore. 2013-08-25 23:01:55 +03:00
Andrey Kotlarski
025399a644 Merge branch 'master' into keep-edit
Conflicts:
	README.org
	vlfi.el
2013-08-25 19:17:04 +03:00
Andrey Kotlarski
bfcbfd33cb Make error message more descriptive. 2013-08-25 18:23:06 +03:00
Andrey Kotlarski
bc68eed5a2 Add dummy vlfi.el that urges move to the vlf package. 2013-08-25 18:14:53 +03:00
Andrey Kotlarski
17c66122d9 Rename anything vlfi -> vlf. 2013-08-25 17:57:43 +03:00
Andrey Kotlarski
4c631bcbe5 Rename vlfi.el to vlf.el. 2013-08-25 17:51:34 +03:00
Andrey Kotlarski
e5457690fb Fix adjusting of end chunk bytes. 2013-08-25 17:48:28 +03:00
Andrey Kotlarski
d1b34dcefb Add autoload cookie for `file-size-human-readable' not to break GNU
Emacs 23 opening of large files.
2013-08-13 12:39:55 +03:00
Andrey Kotlarski
737c1e9979 Remove encode size bookkeeping. 2013-08-09 02:00:34 +03:00
Andrey Kotlarski
2d71996d9e Add end character shift when adjusting chunk. Apply partial chunk
update when buffer is not modified too.
2013-08-09 01:59:32 +03:00
Andrey Kotlarski
0ecb40a5ee Keep as much editing as possible when moving to intersecting chunk. 2013-08-08 12:43:00 +03:00
Andrey Kotlarski
02a37c4192 Merge branch 'master' into chunk-opt2 2013-08-07 01:19:26 +03:00
Andrey Kotlarski
7cb047407d Add forgotten vlfi-encode-size local variable creation. 2013-08-06 16:41:16 +03:00
Andrey Kotlarski
34dfbd202d Use set-visited-file-name and abstract getting current file size and
updating visited time.
2013-08-06 16:23:04 +03:00
Andrey Kotlarski
ce9441fc83 Update info as VLFI is merging back to VLF. Bump version. 2013-08-06 02:14:39 +03:00
Andrey Kotlarski
563d9ca423 Fix vlfi-revert to revert on user confirmation. 2013-08-06 02:13:01 +03:00
Andrey Kotlarski
298d8f59d9 Keep track of current batch encoded size and allow fluctuation when
searching for proper decoding.
2013-08-06 02:11:21 +03:00
Andrey Kotlarski
8ed919209a Review fixes:
- move put statements to top level
- add write-file-functions hook locally
- vlfi-if-file-too-large becomes around advice
- minor style changes
2013-08-06 02:07:36 +03:00
Andrey Kotlarski
c1aedbc307 Update README: VLFI is now development version of VLF. 2013-08-06 02:02:02 +03:00
Andrey Kotlarski
a0b8d5f67a Merge pull request #3 from danlamanna/master
Alters vlfi to respect the default-directory variable when opening
files.
2013-07-25 01:17:35 -07:00
Dan LaManna
616d676330 Alters vlfi to respect the default-directory variable when opening
files.
2013-07-24 21:49:14 -04:00
Andrey Kotlarski
3c2fb6b93e Merge branch 'master' into chunk-opt2 2013-05-05 15:57:16 +03:00
Andrey Kotlarski
de1948ed36 Merge branch 'master' into chunk-opt2 2013-05-02 14:19:50 +03:00
Andrey Kotlarski
bbda9abc7d Merge branch 'master' into chunk-opt2
Conflicts:
	vlfi.el
2013-05-01 02:25:39 +03:00
Andrey Kotlarski
ca13beac24 Try utf-8 and if not successful, auto detect when adjusting chunk for
proper decoding.
2013-04-28 01:12:07 +03:00
Andrey Kotlarski
d2bd47c2b4 More attempts to optimize decoding. 2013-04-24 01:32:50 +03:00
Andrey Kotlarski
57eb4c270a Initial attempt at optimizing chunk access. 2013-04-24 01:32:50 +03:00
12 changed files with 3061 additions and 925 deletions

2
.gitignore vendored Normal file
View File

@@ -0,0 +1,2 @@
*.elc
*~

View File

@@ -1,105 +1,202 @@
* View Large Files Improved
* View Large Files
An Emacs mode that allows viewing, editing and searching in large
files in chunks. 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, trading memory for processor time. 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 mode builds on the bare bones GNU ELPA vlf.el. It adds the
following improvements:
This is development version of the GNU ELPA [[https://elpa.gnu.org/packages/vlf.html][VLF]] package. Here's what
it offers in a nutshell:
- proper dealing with Unicode
- 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
- automatic adjustment of batch size for optimal performance and
responsiveness
- regular expression search and replace over whole file
- [[http://www.emacswiki.org/emacs/OccurMode][Occur]] like indexing
- by batch [[http://www.emacswiki.org/emacs/EdiffMode][Ediff]] comparison
- automatic scrolling of batches
- chunk editing (save is immediate if size hasn't changed, done in
constant memory determined by current batch size otherwise)
- options to jump to beginning, end or arbitrary file chunk
- ability to jump/insert given number of batches at once
- proper dealing with multibyte encodings
- smooth integration with [[http://www.emacswiki.org/emacs/HexlMode][hexl-mode]], just turn it on and the HEX
editing will work in batches just the same
- works with [[http://www.emacswiki.org/emacs/TrampMode][TRAMP]] so accessing network files is fine and quick
- newly added content is acknowledged if file has changed size
meanwhile
- automatic scrolling of batches
- VLFI is added as an option when opening large files
- as it's a minor mode, font locking and functionality of the
respective major mode and other minor modes is also present
- can be added as option to automatically open large files
GNU Emacs 23 and 24 are supported.
* Overview and tips
M-x vlfi PATH-TO-FILE
M-x vlf PATH-TO-FILE
** Unicode
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), VLFI will probably not quite work.
** Memory control
*vlfi-batch-size* bounds the memory used for all operations.
** Special mode
VLFI is derived from special-mode and keeps all its properties. For
example you can directly press digits to enter prefix arguments.
** Changing major mode
You can (temporarily) change major mode to whatever you like (for
example hexl-mode). Saving will insert contents as intended. You can
return to *vlfi-mode* too.
bignum support, *VLF* will not work with files over 512 MB (maximum
integer value).
* Detail usage
** Controlling batch size
** Applicability
*+* and *-* control current batch size by factors of 2.
To have *vlf* offered as choice when opening large files:
You can also set by hand local variable *vlfi-batch-size* and then
refresh with *g*.
#+BEGIN_SRC emacs-lisp
(require 'vlf-setup)
#+END_SRC
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_SRC emacs-lisp
(custom-set-variables
'(vlf-application 'dont-ask))
#+END_SRC
*** 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_SRC emacs-lisp
(vlf-disable-for-function func "file")
#+END_SRC
** 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_SRC emacs-lisp
(eval-after-load "vlf"
'(define-key vlf-prefix-map "\C-xv" vlf-mode-map))
#+END_SRC
** Overall position indicators
To see which part of the file is currently visited and how many
batches there are in overall (using the current batch size), look at
the VLF section in the mode line, file size is also there.
** Batch size control
By default *VLF* gathers statistics over how primitive operations
perform over file and gradually adjusts batch size for better user
experience. Operations involving multiple batches are tuned more
adventurously. Overall the more jumping around, searching, indexing,
the better performance should get.
The *vlf-tune-max* option specifies maximum size in bytes a batch
could eventually get while tuning.
Profiling and tuning can be disabled by:
#+BEGIN_SRC emacs-lisp
(custom-set-variables
'(vlf-tune-enabled nil))
#+END_SRC
Or set *vlf-tune-enabled* to '*stats* to profile but not change batch
size.
Use *M-x vlf-set-batch-size* to change batch size and update chunk
immediately. Default size offered is the best according to tune
statistics so far.
*C-c C-v +* and *C-c C-v -* control current batch size by factors
of 2.
** Move around
*M-PgUp* and *M-PgDn* move chunk by chunk. With positive prefix
argument they move prefix number of batches. With negative - append
prefix number of batches.
Scrolling automatically triggers move to previous or next chunk at the
beginning or end respectively of the current one.
*[* and *]* take you to the beginning and end of file respectively.
*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.
*j* jumps to given chunk. To see where you are in file and how many chunks
there are (using the current batch size), look at the bracketed part
of the buffer name, batch size is also there - at the end.
*C-c C-v SPC* displays batch starting from current point.
** Search whole file
*C-c C-v [* and *C-c C-v ]* take you to the beginning and end of file
respectively.
*s* and *r* search forward and backward respectively over the whole
file. This is done chunk by chunk so if you have really huge file -
you'd better set somewhat bigger batch size beforehand.
*C-c C-v j* jumps to particular batch number.
** Follow point
Continuous chunk recenter around point in current buffer can be
toggled with *C-c C-v f*.
** Search and/or replace whole file
*C-c C-v s* and *C-c C-v r* search forward and backward respectively
over the whole file, batch by batch. *C-c C-v %* does search and
query replace saving intermediate changes.
** Occur over whole file
*o* builds index for given regular expression just like occur-mode.
It does this chunk by chunk 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 over whole file for given regular expression
just like *M-x occur*. Note that even if you prematurely stop it with
*C-g*, it will still show what's found so far.
Result buffer uses *vlf-occur-mode* which allows to optionally open
new *VLF* buffer on jump to match (using *C-u* before hitting RET or
*o*), thus having multiple simultaneous views of the same file. Also
results can be serialized to file for later reuse.
** Jump to line
*l* jumps to given line in file. This is done by searching from the
beginning, so again the bigger current batch size, the quicker. With
negative argument, lines are counted from the end of file.
*C-c C-v l* jumps to given line in file. With negative argument,
lines are counted from the end of file.
** Edit
** Edit and save
*e* enters VLFI in edit mode. If editing doesn't change size of
the chunk, only this chunk is saved. Otherwise the remaining part of
the file is adjusted chunk by chunk, so again you'd better have bigger
current batch size. If chunk has been expanded the memory used is
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.
*vlf-save-in-place* customization option controls if temporary file
should be used in such case.
#+BEGIN_EXAMPLE
(batch size + difference to the original chunk size) x 2
#+END_EXAMPLE
** 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.
* Extend
** Move hooks
A couple of hooks are run whenever updating chunk:
*vlf-before-chunk-update-hook* and *vlf-after-chunk-update-hook*.
** 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 which
specifies type of operation that runs. Possible values are the
symbols: *write*, *ediff*, *occur*, *search* and *goto-line*.

456
vlf-base.el Normal file
View File

@@ -0,0 +1,456 @@
;;; vlf-base.el --- VLF primitive operations -*- lexical-binding: t -*-
;; Copyright (C) 2014-2017 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:
(require 'vlf-tune)
(defcustom vlf-before-chunk-update-hook nil
"Hook that runs before chunk update."
:group 'vlf :type 'hook)
(defcustom vlf-after-chunk-update-hook 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 hexl-bits)
(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 file)
"Update file size information if necessary and visited file time.
If non-nil, UPDATE-VISITED-TIME.
FILE if given is filename to be used, otherwise `buffer-file-truename'."
(unless (verify-visited-file-modtime (current-buffer))
(setq vlf-file-size (vlf-get-file-size (or file
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))))
(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)
"Move to chunk enclosed by START END bytes.
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)
(if (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)
(cons (- start place) (- place end))))
(if (derived-mode-p 'hexl-mode)
(setq start (- start (mod start hexl-bits))
end (+ end (- hexl-bits (mod end hexl-bits)))))
(if (or (/= start vlf-start-pos)
(/= end vlf-end-pos))
(vlf-move-to-chunk-1 start end))))
(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))
(hexl (derived-mode-p 'hexl-mode))
restore-hexl hexl-undo-list
(edit-end (if modified
(progn
(when hexl
(setq restore-hexl t
hexl-undo-list buffer-undo-list
buffer-undo-list t)
(vlf-tune-dehexlify))
(+ vlf-start-pos
(vlf-tune-encode-length (point-min)
(point-max))))
vlf-end-pos))
(shifts
(cond
((and hexl (not modified)) (vlf-move-to-chunk-2 start end))
((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)
(if (consp hexl-undo-list)
(setq hexl-undo-list nil))
(vlf-move-to-chunk-2 start end)))
((and (= start vlf-start-pos) (= end edit-end))
(unless modified
(if (consp hexl-undo-list)
(setq hexl-undo-list nil))
(vlf-move-to-chunk-2 start end)))
((and (not modified)
(not (consp buffer-undo-list)))
(vlf-move-to-chunk-2 start end))
((or (not modified)
(and (<= start vlf-start-pos) (<= edit-end end))
(y-or-n-p "Chunk modified, are you sure? "))
(run-hooks 'vlf-before-chunk-update-hook)
(when (and hexl (not restore-hexl))
(if (consp buffer-undo-list)
(setq buffer-undo-list nil))
(vlf-tune-dehexlify))
(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)
(when hexl
(vlf-tune-hexlify)
(setq restore-hexl nil))
(run-hooks 'vlf-after-chunk-update-hook)
(cons shift-start shift-end))))))
(when restore-hexl
(vlf-tune-hexlify)
(setq buffer-undo-list hexl-undo-list))
shifts))
(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-hook)
(let ((adjust-start t)
(adjust-end t)
(is-hexl (derived-mode-p 'hexl-mode)))
(and (not is-hexl)
(verify-visited-file-modtime (current-buffer))
(setq adjust-start (and (/= start vlf-start-pos)
(/= start vlf-end-pos))
adjust-end (and (/= end vlf-start-pos)
(/= end vlf-end-pos))))
(vlf-verify-size t)
(setq vlf-start-pos (max 0 start)
vlf-end-pos (min end vlf-file-size))
(let ((shifts '(0 . 0)))
(let ((inhibit-read-only t)
(pos (position-bytes (point))))
(vlf-with-undo-disabled
(erase-buffer)
(if is-hexl
(progn (vlf-tune-insert-file-contents-literally
vlf-start-pos vlf-end-pos)
(vlf-tune-hexlify))
(setq shifts (vlf-insert-file-contents vlf-start-pos
vlf-end-pos
adjust-start
adjust-end)
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-hook)
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-end (and adjust-end (/= end vlf-file-size))
position (or position (point-min)))
(and adjust-start (<= start 4)
(setq adjust-start nil
start 0))
(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."
(if (zerop start)
(vlf-tune-insert-file-contents start end)
(let ((coding-system-for-read buffer-file-coding-system))
(vlf-tune-insert-file-contents 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 (let ((coding-system-for-read buffer-file-coding-system))
(insert-file-contents buffer-file-name
nil 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 (vlf-tune-encode-length cut-point
(point-max)))
(+ start (vlf-tune-encode-length position
cut-point))))
(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-byte-position (point)
"Determine global byte position of POINT."
(let ((pmax (point-max)))
(if (< (/ pmax 2) point)
(- vlf-end-pos (vlf-tune-encode-length (min (1+ point) pmax)
pmax))
(+ vlf-start-pos (vlf-tune-encode-length (point-min) point)))))
(defun vlf-shift-undo-list (n)
"Shift undo list element regions by N."
(or (null buffer-undo-list) (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

331
vlf-ediff.el Normal file
View File

@@ -0,0 +1,331 @@
;;; 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)
(defvar tramp-verbose)
(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 t)))
(set-buffer buffer-A)
(vlf-set-batch-size batch-size)
(let ((buffer-B (vlf file-B t)))
(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)))
(defun vlf-prev-chunk ()
"Move to previous chunk."
(vlf-move-to-chunk (- vlf-start-pos vlf-batch-size) vlf-start-pos))
(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))
(is-hexl (derived-mode-p 'hexl-mode)))
(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)
is-hexl (or is-hexl (derived-mode-p 'hexl-mode)))
(let ((tramp-verbose (if (and (boundp 'tramp-verbose)
tramp-verbose)
(min tramp-verbose 1)))
(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) (not is-hexl)
(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)
(when (and end-A end-B)
(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-move-to-batch 0)
(set-buffer buffer-A)
(vlf-move-to-batch 0))
(set-buffer ediff-buffer)
(ediff-update-diffs)
(or is-hexl
(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)
(or is-hexl
(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

481
vlf-occur.el Normal file
View File

@@ -0,0 +1,481 @@
;;; 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-vlf-file nil "VLF file that is searched.")
(make-variable-buffer-local 'vlf-occur-vlf-file)
(defvar vlf-occur-vlf-buffer nil "VLF buffer that is scanned.")
(make-variable-buffer-local 'vlf-occur-vlf-buffer)
(defvar vlf-occur-regexp)
(make-variable-buffer-local 'vlf-occur-regexp)
(defvar vlf-occur-hexl nil "Is `hexl-mode' active?")
(make-variable-buffer-local 'vlf-occur-hexl)
(defvar vlf-occur-lines 0 "Number of lines scanned by `vlf-occur'.")
(make-variable-buffer-local 'vlf-occur-lines)
(defvar tramp-verbose)
(defvar hexl-bits)
(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)
(define-key map [remap save-buffer] 'vlf-occur-save)
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."
(add-hook 'write-file-functions 'vlf-occur-save nil t))
(defun vlf-occur-next-match ()
"Move cursor to next match."
(interactive)
(if (eq (get-text-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-text-property (point) 'face) 'match)
(goto-char (previous-single-property-change (point) 'face)))
(while (not (eq (get-text-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 (previous-single-char-property-change
pos 'vlf-match)))
(chunk-start (get-text-property pos 'chunk-start)))
(if chunk-start
(let ((chunk-end (get-text-property pos 'chunk-end))
(file (if (file-exists-p vlf-occur-vlf-file)
vlf-occur-vlf-file
(setq vlf-occur-vlf-file
(read-file-name
(concat vlf-occur-vlf-file
" doesn't exist, locate it: ")))))
(vlf-buffer vlf-occur-vlf-buffer)
(not-hexl (not vlf-occur-hexl))
(occur-buffer (current-buffer))
(match-pos (+ (get-text-property pos 'line-pos)
pos-relative)))
(cond (current-prefix-arg
(let ((original-occur-buffer vlf-occur-vlf-buffer))
(setq vlf-buffer (vlf file t))
(if (buffer-live-p original-occur-buffer)
(vlf-tune-copy-profile original-occur-buffer)))
(or not-hexl (hexl-mode))
(switch-to-buffer occur-buffer))
((not (buffer-live-p vlf-buffer))
(unless (catch 'found
(dolist (buf (buffer-list))
(set-buffer buf)
(and vlf-mode
(equal file buffer-file-name)
(eq (not (derived-mode-p 'hexl-mode))
not-hexl)
(setq vlf-buffer buf)
(throw 'found t))))
(setq vlf-buffer (vlf file t))
(or not-hexl (hexl-mode)))
(switch-to-buffer occur-buffer)
(setq vlf-occur-vlf-buffer vlf-buffer)))
(pop-to-buffer vlf-buffer)
(vlf-move-to-chunk chunk-start chunk-end)
(goto-char match-pos)))))
(defun vlf-occur-other-buffer (regexp)
"Make whole file occur style index for REGEXP branching to new buffer.
Prematurely ending indexing will still show what's found so far."
(let ((vlf-buffer (current-buffer))
(file buffer-file-name)
(file-size vlf-file-size)
(batch-size vlf-batch-size)
(is-hexl (derived-mode-p 'hexl-mode)))
(with-temp-buffer
(setq buffer-file-name file
buffer-file-truename file
buffer-undo-list t
vlf-file-size file-size)
(set-buffer-modified-p nil)
(set (make-local-variable 'vlf-batch-size) batch-size)
(when vlf-tune-enabled
(vlf-tune-copy-profile vlf-buffer)
(vlf-tune-batch (if is-hexl
'(:hexl :raw)
'(:insert :encode)) t))
(vlf-mode 1)
(if is-hexl (hexl-mode))
(goto-char (point-min))
(vlf-build-occur regexp vlf-buffer)
(if vlf-tune-enabled
(vlf-tune-copy-profile (current-buffer) vlf-buffer)))))
(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)))))
(run-hook-with-args 'vlf-before-batch-functions 'occur)
(if (or (buffer-modified-p)
(consp buffer-undo-list)
(< vlf-batch-size vlf-start-pos))
(vlf-occur-other-buffer regexp)
(let ((start-pos vlf-start-pos)
(end-pos vlf-end-pos)
(pos (point))
(batch-size vlf-batch-size))
(vlf-tune-batch (if (derived-mode-p 'hexl-mode)
'(:hexl :raw)
'(:insert :encode)) t)
(vlf-move-to-batch 0)
(goto-char (point-min))
(unwind-protect (vlf-build-occur regexp (current-buffer))
(vlf-move-to-chunk start-pos end-pos)
(goto-char pos)
(setq vlf-batch-size batch-size))))
(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 (and (boundp 'tramp-verbose)
tramp-verbose)
(min tramp-verbose 1)))
(case-fold-search t)
(line 1)
(last-match-line 0)
(total-matches 0)
(first-line-offset 0)
(first-line-incomplete nil)
(match-start-point (point-min))
(match-end-point match-start-point)
(last-match-insert-point nil)
(occur-buffer (generate-new-buffer
(concat "*VLF-occur " (file-name-nondirectory
buffer-file-name)
"*")))
(is-hexl (derived-mode-p 'hexl-mode))
(end-of-file nil)
(time (float-time))
(tune-types (if is-hexl '(:hexl :raw)
'(:insert :encode)))
(reporter (make-progress-reporter
(concat "Building index for " regexp "...")
vlf-start-pos vlf-file-size)))
(with-current-buffer occur-buffer
(setq buffer-undo-list t))
(unwind-protect
(progn
(while (not end-of-file)
(if (re-search-forward regexp nil t)
(progn
(setq line (+ line -1
(count-lines match-start-point
(1+ (match-beginning 0))))
match-start-point (match-beginning 0)
match-end-point (match-end 0))
(let* ((chunk-start vlf-start-pos)
(chunk-end vlf-end-pos)
(line-pos (save-excursion
(goto-char match-start-point)
(line-beginning-position)))
(line-text (buffer-substring
line-pos (line-end-position))))
(if (/= line-pos (point-min))
(setq first-line-offset 0
first-line-incomplete nil))
(with-current-buffer occur-buffer
(unless (= line last-match-line) ;new match line
(insert "\n:") ; insert line number
(let* ((column-point (1- (point)))
(overlay-pos column-point)
(overlay (make-overlay
overlay-pos
(1+ overlay-pos))))
(overlay-put overlay 'before-string
(propertize
(number-to-string line)
'face 'shadow))
(overlay-put overlay 'vlf-match t)
(setq last-match-insert-point column-point
first-line-offset 0)))
(when (or first-line-incomplete
(/= line last-match-line))
(insert (propertize
(if first-line-incomplete
(substring line-text
first-line-incomplete)
line-text)
'chunk-start chunk-start
'chunk-end chunk-end
'mouse-face '(highlight)
'line-pos line-pos
'help-echo
(format "Move to line %d"
line)))
(setq first-line-incomplete nil))
(setq last-match-line line
total-matches (1+ total-matches))
(let ((line-start (+ last-match-insert-point
first-line-offset 1
(- line-pos))))
(add-text-properties ; mark match
(+ line-start match-start-point)
(+ line-start match-end-point)
(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 ((start
(if is-hexl
(progn
(goto-char (point-max))
(forward-line -10)
(setq line
(+ line
(if (< match-end-point (point))
(count-lines match-start-point
(point))
(goto-char match-end-point)
(1- (count-lines match-start-point
match-end-point)))))
(- vlf-end-pos (* (- 10 (forward-line 10))
hexl-bits)))
(let* ((pmax (point-max))
(batch-step (min 1024 (/ vlf-batch-size
10)))
(batch-point
(max match-end-point
(or
(byte-to-position
(- vlf-batch-size batch-step))
(progn
(goto-char pmax)
(let ((last (line-beginning-position)))
(if (= last (point-min))
(1- (point))
last)))))))
(goto-char batch-point)
(setq first-line-offset
(- batch-point (line-beginning-position))
line
(+ line
(count-lines match-start-point
batch-point)
(if (< 0 first-line-offset) -1 0)))
;; last match is on the last line?
(goto-char match-end-point)
(forward-line)
(setq first-line-incomplete
(if (= (point) pmax)
(- pmax match-end-point)))
(vlf-byte-position batch-point)))))
(vlf-tune-batch tune-types)
(setq vlf-end-pos start) ;not to adjust start
(vlf-move-to-chunk start (+ start vlf-batch-size)))
(setq match-start-point (point-min)
match-end-point match-start-point)
(goto-char match-end-point)
(progress-reporter-update reporter vlf-start-pos))))
(progress-reporter-done reporter))
(set-buffer-modified-p nil)
(if (zerop total-matches)
(progn (kill-buffer occur-buffer)
(message "No matches for \"%s\" (%f secs)"
regexp (- (float-time) time)))
(let ((file buffer-file-name)
(dir default-directory))
(with-current-buffer occur-buffer
(insert "\n")
(goto-char (point-min))
(insert (propertize
(format "%d matches from %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)
(setq default-directory dir
vlf-occur-vlf-file file
vlf-occur-vlf-buffer vlf-buffer
vlf-occur-regexp regexp
vlf-occur-hexl is-hexl
vlf-occur-lines line)))
(display-buffer occur-buffer)
(message "Occur finished for \"%s\" (%f secs)"
regexp (- (float-time) time))))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; save, load vlf-occur data
(defun vlf-occur-save (file)
"Serialize `vlf-occur' results to FILE which can later be reloaded."
(interactive (list (or buffer-file-name
(read-file-name "Save vlf-occur results in: "
nil nil nil
(concat
(file-name-nondirectory
vlf-occur-vlf-file)
".vlfo")))))
(setq buffer-file-name file)
(let ((vlf-occur-save-buffer
(generate-new-buffer (concat "*VLF-occur-save "
(file-name-nondirectory file)
"*"))))
(with-current-buffer vlf-occur-save-buffer
(setq buffer-file-name file
buffer-undo-list t)
(insert ";; -*- eval: (vlf-occur-load) -*-\n"))
(prin1 (list vlf-occur-vlf-file vlf-occur-regexp vlf-occur-hexl
vlf-occur-lines)
vlf-occur-save-buffer)
(save-excursion
(goto-char (point-min))
(let ((pmax (point-max)))
(while (/= pmax (goto-char (next-single-char-property-change
(1+ (point)) 'vlf-match)))
(let* ((pos (1+ (point)))
(line (get-char-property (1- pos) 'before-string)))
(if line
(prin1 (list (string-to-number line)
(get-text-property pos 'chunk-start)
(get-text-property pos 'chunk-end)
(get-text-property pos 'line-pos)
(buffer-substring-no-properties
pos (1- (next-single-char-property-change
pos 'vlf-match))))
vlf-occur-save-buffer))))))
(with-current-buffer vlf-occur-save-buffer
(save-buffer))
(kill-buffer vlf-occur-save-buffer))
t)
;;;###autoload
(defun vlf-occur-load ()
"Load serialized `vlf-occur' results from current buffer."
(interactive)
(goto-char (point-min))
(let* ((vlf-occur-data-buffer (current-buffer))
(header (read vlf-occur-data-buffer))
(vlf-file (nth 0 header))
(regexp (nth 1 header))
(all-lines (nth 3 header))
(file buffer-file-name)
(vlf-occur-buffer
(generate-new-buffer (concat "*VLF-occur "
(file-name-nondirectory file)
"*"))))
(switch-to-buffer vlf-occur-buffer)
(setq buffer-file-name file
buffer-undo-list t)
(goto-char (point-min))
(let ((match-count 0)
(form 0))
(while (setq form (ignore-errors (read vlf-occur-data-buffer)))
(goto-char (point-max))
(insert "\n:")
(let* ((overlay-pos (1- (point)))
(overlay (make-overlay overlay-pos (1+ overlay-pos)))
(line (number-to-string (nth 0 form)))
(pos (point)))
(overlay-put overlay 'before-string
(propertize line 'face 'shadow))
(overlay-put overlay 'vlf-match t)
(insert (propertize (nth 4 form) 'chunk-start (nth 1 form)
'chunk-end (nth 2 form)
'mouse-face '(highlight)
'line-pos (nth 3 form)
'help-echo (concat "Move to line "
line)))
(goto-char pos)
(while (re-search-forward regexp nil t)
(add-text-properties
(match-beginning 0) (match-end 0)
(list 'face 'match 'help-echo
(format "Move to match %d"
(setq match-count (1+ match-count))))))))
(kill-buffer vlf-occur-data-buffer)
(goto-char (point-min))
(insert (propertize
(format "%d matches from %d lines for \"%s\" in file: %s"
match-count all-lines regexp vlf-file)
'face 'underline)))
(set-buffer-modified-p nil)
(vlf-occur-mode)
(setq vlf-occur-vlf-file vlf-file
vlf-occur-regexp regexp
vlf-occur-hexl (nth 2 header)
vlf-occur-lines all-lines)))
(provide 'vlf-occur)
;;; vlf-occur.el ends here

355
vlf-search.el Normal file
View File

@@ -0,0 +1,355 @@
;;; 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)
(defvar hexl-bits)
(defvar tramp-verbose)
(defun vlf-re-search (regexp count backward
&optional reporter time highlight)
"Search for REGEXP COUNT number of times forward or BACKWARD.
Use existing REPORTER and start TIME if given.
Highlight match if HIGHLIGHT is non nil.
Return t if search has been at least partially successful."
(if (<= count 0)
(error "Count must be positive"))
(run-hook-with-args 'vlf-before-batch-functions 'search)
(or reporter (setq reporter (make-progress-reporter
(concat "Searching for " regexp "...")
(if backward
(- vlf-file-size vlf-end-pos)
vlf-start-pos)
vlf-file-size)))
(or time (setq time (float-time)))
(let* ((tramp-verbose (if (and (boundp 'tramp-verbose)
tramp-verbose)
(min tramp-verbose 1)))
(case-fold-search t)
(match-chunk-start vlf-start-pos)
(match-chunk-end vlf-end-pos)
(match-start-pos (point))
(match-end-pos match-start-pos)
(last-match-pos match-start-pos)
(to-find count)
(is-hexl (derived-mode-p 'hexl-mode))
(tune-types (if is-hexl '(:hexl :raw)
'(:insert :encode)))
(font-lock font-lock-mode))
(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 (match-beginning 0)
match-end-pos (match-end 0)
last-match-pos match-start-pos))
((zerop vlf-start-pos)
(throw 'end-of-file nil))
(t (let ((end
(if is-hexl
(progn
(goto-char (point-min))
(forward-line 10)
(if (< last-match-pos (point))
(goto-char last-match-pos))
(+ vlf-start-pos
(* (- 10 (forward-line -10))
hexl-bits)))
(vlf-byte-position
(min 1024 (/ (point-max) 10)
last-match-pos)))))
(vlf-tune-batch tune-types)
(setq vlf-start-pos end) ;don't adjust end
(vlf-move-to-chunk (- end vlf-batch-size)
end))
(let ((pmax (point-max)))
(goto-char pmax)
(setq last-match-pos pmax))
(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 (match-beginning 0)
match-end-pos (match-end 0)
last-match-pos match-end-pos))
((>= vlf-end-pos vlf-file-size)
(throw 'end-of-file nil))
(t (let* ((pmax (point-max))
(start
(if is-hexl
(progn
(goto-char pmax)
(forward-line -10)
(if (< (point) last-match-pos)
(goto-char last-match-pos))
(- vlf-end-pos
(* (- 10 (forward-line 10))
hexl-bits)))
(vlf-byte-position
(max (- pmax 1024)
(- pmax (/ pmax 10))
last-match-pos)))))
(vlf-tune-batch tune-types)
(setq vlf-end-pos start) ;don't adjust start
(vlf-move-to-chunk start (+ start
vlf-batch-size)))
(let ((pmin (point-min)))
(goto-char pmin)
(setq last-match-pos pmin))
(progress-reporter-update reporter
vlf-end-pos)))))
(progress-reporter-done reporter))
(set-buffer-modified-p nil)
(if font-lock (font-lock-mode 1))
(let ((result
(if backward
(vlf-goto-match match-chunk-start match-chunk-end
match-start-pos match-end-pos
count to-find time highlight)
(vlf-goto-match match-chunk-start match-chunk-end
match-end-pos match-start-pos
count to-find time highlight))))
(run-hook-with-args 'vlf-after-batch-functions 'search)
result)))))
(defun vlf-goto-match (match-chunk-start match-chunk-end
match-start-pos match-end-pos
count to-find time
highlight)
"Move to MATCH-CHUNK-START MATCH-CHUNK-END surrounding\
MATCH-START-POS and MATCH-END-POS.
According to COUNT and left TO-FIND, show if search has been
successful. Use start TIME to report how much it took.
Highlight match if HIGHLIGHT is non nil.
Return nil if nothing found."
(vlf-move-to-chunk match-chunk-start match-chunk-end)
(goto-char match-start-pos)
(setq vlf-batch-size (vlf-tune-optimal-load
(if (derived-mode-p 'hexl-mode)
'(:hexl :raw)
'(:insert :encode))))
(if (= count to-find)
(progn (message "Not found (%f secs)" (- (float-time) time))
nil)
(let ((success (zerop to-find))
(overlay (make-overlay match-start-pos match-end-pos)))
(overlay-put overlay 'face 'match)
(if success
(message "Match found (%f secs)" (- (float-time) time))
(message "Moved to the %d match which is last (%f secs)"
(- count to-find) (- (float-time) time)))
(if highlight
(unwind-protect (sit-for 1)
(delete-overlay overlay))
(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))))
(let ((batch-size vlf-batch-size)
success)
(unwind-protect
(setq success (vlf-re-search regexp count nil nil nil t))
(or success (setq vlf-batch-size batch-size)))))
(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))))
(let ((batch-size vlf-batch-size)
success)
(unwind-protect
(setq success (vlf-re-search regexp count t nil nil t))
(or success (setq vlf-batch-size batch-size)))))
(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: "))))
(if (derived-mode-p 'hexl-mode)
(vlf-goto-line-hexl n)
(run-hook-with-args 'vlf-before-batch-functions 'goto-line)
(vlf-verify-size)
(let ((tramp-verbose (if (and (boundp 'tramp-verbose)
tramp-verbose)
(min tramp-verbose 1)))
(start-pos vlf-start-pos)
(end-pos vlf-end-pos)
(batch-size vlf-batch-size)
(pos (point))
(font-lock font-lock-mode)
(time (float-time))
(success nil))
(font-lock-mode 0)
(vlf-tune-batch '(:raw))
(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)
;; (vlf-tune-insert-file-contents-literally start end)
;; (goto-char (point-min))
;; (while (re-search-forward "[\n\C-m]" nil t)
;; (setq n (1- n)))
;; (vlf-verify-size)
;; (vlf-tune-batch '(:raw))
;; (setq start end
;; end (min vlf-file-size (+ start
;; vlf-batch-size)))
;; (progress-reporter-update reporter start))
(when (< n (- vlf-file-size end))
(vlf-tune-batch '(:insert :encode))
(vlf-move-to-chunk start (+ start vlf-batch-size))
(goto-char (point-min))
(setq success
(or (zerop n)
(when (vlf-re-search "[\n\C-m]" n nil
reporter time)
(forward-char) t))))))
(let ((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
;; (let ((start (max 0 (- vlf-file-size vlf-batch-size))))
;; (while (and (< (- end start) n) (< n end))
;; (erase-buffer)
;; (vlf-tune-insert-file-contents-literally start end)
;; (goto-char (point-max))
;; (while (re-search-backward "[\n\C-m]" nil t)
;; (setq n (1- n)))
;; (vlf-tune-batch '(:raw))
;; (setq end start
;; start (max 0 (- end vlf-batch-size)))
;; (progress-reporter-update reporter
;; (- vlf-file-size end))))
(when (< n end)
(vlf-tune-batch '(:insert :encode))
(vlf-move-to-chunk (- end vlf-batch-size) end)
(goto-char (point-max))
(setq success (vlf-re-search "[\n\C-m]" n t
reporter time))))))
(if font-lock (font-lock-mode 1))
(unless success
(vlf-with-undo-disabled
(vlf-move-to-chunk start-pos end-pos))
(goto-char pos)
(setq vlf-batch-size batch-size)
(message "Unable to find line"))
(run-hook-with-args 'vlf-after-batch-functions 'goto-line)))))
(defun vlf-goto-line-hexl (n)
"Go to line N. If N is negative, count from the end of file.
Assume `hexl-mode' is active."
(vlf-tune-load '(:hexl :raw))
(if (< n 0)
(let ((hidden-bytes (+ vlf-file-size (* n hexl-bits))))
(setq hidden-bytes (- hidden-bytes (mod hidden-bytes
vlf-batch-size)))
(vlf-move-to-batch hidden-bytes)
(goto-char (point-max))
(forward-line (+ (round (- vlf-file-size
(min vlf-file-size
(+ hidden-bytes
vlf-batch-size)))
hexl-bits)
n)))
(let ((hidden-bytes (1- (* n hexl-bits))))
(setq hidden-bytes (- hidden-bytes (mod hidden-bytes
vlf-batch-size)))
(vlf-move-to-batch hidden-bytes)
(goto-char (point-min))
(forward-line (- n 1 (/ hidden-bytes hexl-bits))))))
(defun vlf-query-replace (regexp to-string &optional delimited backward)
"Query replace over whole file matching REGEXP with TO-STRING.
Third arg DELIMITED (prefix arg if interactive), if non-nil, replace
only matches surrounded by word boundaries. A negative prefix arg means
replace BACKWARD."
(interactive (let ((common (query-replace-read-args
(concat "Query replace over whole file"
(if current-prefix-arg
(if (eq current-prefix-arg '-)
" backward"
" word")
"")
" regexp")
t)))
(list (nth 0 common) (nth 1 common) (nth 2 common)
(nth 3 common))))
(let ((not-automatic t))
(while (vlf-re-search regexp 1 backward)
(cond (not-automatic
(query-replace-regexp regexp to-string delimited
nil nil backward)
(if (eq 'automatic (lookup-key query-replace-map
(vector last-input-event)))
(setq not-automatic nil)))
(backward (while (re-search-backward regexp nil t)
(replace-match to-string)))
(t (while (re-search-forward regexp nil t)
(replace-match to-string))))
(if (buffer-modified-p)
(save-buffer)))))
(provide 'vlf-search)
;;; vlf-search.el ends here

160
vlf-setup.el Normal file
View File

@@ -0,0 +1,160 @@
;;; vlf-setup.el --- VLF integration with other packages -*- lexical-binding: t -*-
;; Copyright (C) 2014-2015 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-batch-size 1000000
"Defines how large each batch of file data initially is (in bytes)."
:group 'vlf :type 'integer)
(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))
(defvar dired-mode-map)
(declare-function dired-get-file-for-visit "dired")
(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)
(< vlf-batch-size 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-setup)
;;; vlf-setup.el ends here

464
vlf-tune.el Normal file
View File

@@ -0,0 +1,464 @@
;;; vlf-tune.el --- VLF tuning operations -*- lexical-binding: t -*-
;; Copyright (C) 2014 Free Software Foundation, Inc.
;; Keywords: large files, batch size, performance
;; 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 wrappers for basic chunk operations that add
;; profiling and automatic tuning of `vlf-batch-size'.
;;; Code:
(defgroup vlf nil "View Large Files in Emacs."
:prefix "vlf-" :group 'files)
(defcustom vlf-batch-size 1000000
"Defines how large each batch of file data initially is (in bytes)."
:group 'vlf :type 'integer)
(put 'vlf-batch-size 'permanent-local t)
(defcustom vlf-tune-enabled t
"Whether to allow automatic change of batch size.
If nil, completely disable. If `stats', maintain measure statistics,
but don't change batch size. If t, measure and change."
:group 'vlf :type '(choice (const :tag "Enabled" t)
(const :tag "Just statistics" stats)
(const :tag "Disabled" nil)))
(defvar vlf-file-size 0 "Total size in bytes of presented file.")
(make-variable-buffer-local 'vlf-file-size)
(put 'vlf-file-size 'permanent-local t)
(defun vlf-tune-ram-size ()
"Try to determine RAM size in bytes."
(if (executable-find "free")
(let* ((free (shell-command-to-string "free"))
(match-from (string-match "[[:digit:]]+" free)))
(if match-from
(* 1000 (string-to-number (substring free match-from
(match-end 0))))))))
(defcustom vlf-tune-max (max (let ((ram-size (vlf-tune-ram-size)))
(if ram-size
(/ ram-size 20)
0))
(if large-file-warning-threshold
large-file-warning-threshold
0))
"Maximum batch size in bytes when auto tuning.
Avoid increasing this after opening file with VLF."
:group 'vlf :type 'integer)
(defcustom vlf-tune-step (/ vlf-tune-max 10000)
"Step used for tuning in bytes.
Avoid decreasing this after opening file with VLF."
:group 'vlf :type 'integer)
(defcustom vlf-tune-load-time 1.0
"How many seconds should batch take to load for best user experience."
:group 'vlf :type 'float)
(defvar vlf-tune-insert-bps nil
"Vector of bytes per second insert measurements.")
(make-variable-buffer-local 'vlf-tune-insert-bps)
(put 'vlf-tune-insert-bps 'permanent-local t)
(defvar vlf-tune-insert-raw-bps nil
"Vector of bytes per second non-decode insert measurements.")
(make-variable-buffer-local 'vlf-tune-insert-raw-bps)
(put 'vlf-tune-insert-raw-bps 'permanent-local t)
(defvar vlf-tune-encode-bps nil
"Vector of bytes per second encode measurements.")
(make-variable-buffer-local 'vlf-tune-encode-bps)
(put 'vlf-tune-encode-bps 'permanent-local t)
(defvar vlf-tune-write-bps nil
"Vector of bytes per second write measurements.")
(defvar vlf-tune-hexl-bps nil
"Vector of bytes per second hexlify measurements.")
(defvar vlf-tune-dehexlify-bps nil
"Vector of bytes per second dehexlify measurements.")
(defvar vlf-start-pos)
(defvar hexl-bits)
(defvar hexl-max-address)
(declare-function hexl-line-displen "hexl")
(declare-function dehexlify-buffer "hexl")
(defun vlf-tune-copy-profile (from-buffer &optional to-buffer)
"Copy specific profile vectors of FROM-BUFFER to TO-BUFFER.
If TO-BUFFER is nil, copy to current buffer."
(let (insert-bps insert-raw-bps encode-bps)
(with-current-buffer from-buffer
(setq insert-bps vlf-tune-insert-bps
insert-raw-bps vlf-tune-insert-raw-bps
encode-bps vlf-tune-encode-bps))
(if to-buffer
(with-current-buffer to-buffer
(setq vlf-tune-insert-bps insert-bps
vlf-tune-insert-raw-bps insert-raw-bps
vlf-tune-encode-bps encode-bps))
(setq vlf-tune-insert-bps insert-bps
vlf-tune-insert-raw-bps insert-raw-bps
vlf-tune-encode-bps encode-bps))))
(defun vlf-tune-closest-index (size)
"Get closest measurement index corresponding to SIZE."
(let ((step (float vlf-tune-step)))
(max 0 (1- (min (round size step) (round vlf-tune-max step))))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; profiling
(defun vlf-tune-initialize-measurement ()
"Initialize measurement vector."
(make-vector (1- (/ vlf-tune-max vlf-tune-step)) nil))
(defmacro vlf-tune-add-measurement (vec size time)
"Add at an appropriate position in VEC new SIZE TIME measurement.
VEC is a vector of (mean time . count) elements ordered by size."
`(when (and vlf-tune-enabled (not (zerop ,size)))
(or ,vec (setq ,vec (vlf-tune-initialize-measurement)))
(let* ((idx (vlf-tune-closest-index ,size))
(existing (aref ,vec idx)))
(aset ,vec idx (if (consp existing)
(let ((count (1+ (cdr existing)))) ;recalculate mean
(cons (/ (+ (* (1- count) (car existing))
(/ ,size ,time))
count)
count))
(cons (/ ,size ,time) 1))))))
(defmacro vlf-time (&rest body)
"Get timing consed with result of BODY execution."
`(if vlf-tune-enabled
(let* ((time (float-time))
(result (progn ,@body)))
(cons (- (float-time) time) result))
(let ((result (progn ,@body)))
(cons nil result))))
(defun vlf-tune-insert-file-contents (start end)
"Extract decoded file bytes START to END and save time it takes."
(let ((result (vlf-time (insert-file-contents buffer-file-name
nil start end))))
(vlf-tune-add-measurement vlf-tune-insert-bps
(- end start) (car result))
(cdr result)))
(defun vlf-tune-insert-file-contents-literally (start end &optional file)
"Insert raw file bytes START to END and save time it takes.
FILE if given is filename to be used, otherwise `buffer-file-name'."
(let ((result (vlf-time (insert-file-contents-literally
(or file buffer-file-name) nil start end))))
(vlf-tune-add-measurement vlf-tune-insert-raw-bps
(- end start) (car result))
(cdr result)))
(defun vlf-tune-encode-length (start end)
"Get length of encoded region START to END and save time it takes."
(let ((result (vlf-time (length (encode-coding-region
start end
buffer-file-coding-system t)))))
(vlf-tune-add-measurement vlf-tune-encode-bps
(cdr result) (car result))
(cdr result)))
(defun vlf-tune-write (start end append visit size &optional file-name)
"Save buffer and save time it takes.
START, END, APPEND, VISIT have same meaning as in `write-region'.
SIZE is number of bytes that are saved.
FILE-NAME if given is to be used instead of `buffer-file-name'."
(let* ((file (or file-name buffer-file-name))
(time (car (vlf-time (write-region start end file append
visit)))))
(or (file-remote-p file) ;writing to remote files can include network copying
(vlf-tune-add-measurement vlf-tune-write-bps size time))))
(defun vlf-hexl-adjust-addresses ()
"Adjust hexl address indicators according to `vlf-start-pos'."
(let ((pos (point))
(address vlf-start-pos))
(goto-char (point-min))
(while (re-search-forward "^[[:xdigit:]]+" nil t)
(replace-match (format "%08x" address))
(setq address (+ address hexl-bits)))
(goto-char pos)))
(defun vlf-tune-hexlify ()
"Activate `hexl-mode' and save time it takes."
(let* ((no-adjust (zerop vlf-start-pos))
(time (car (vlf-time (hexlify-buffer)
(or no-adjust
(vlf-hexl-adjust-addresses))))))
(setq hexl-max-address (+ (* (/ (1- (buffer-size))
(hexl-line-displen)) 16) 15))
(or no-adjust
(vlf-tune-add-measurement vlf-tune-hexl-bps
hexl-max-address time))))
(defun vlf-tune-dehexlify ()
"Exit `hexl-mode' and save time it takes."
(let ((time (car (vlf-time (dehexlify-buffer)))))
(vlf-tune-add-measurement vlf-tune-dehexlify-bps
hexl-max-address time)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; tuning
(defun vlf-tune-approximate-nearby (vec index)
"VEC has value for INDEX, approximate to closest available."
(let ((val 0)
(left-idx (1- index))
(right-idx (1+ index))
(min-idx (max 0 (- index 5)))
(max-idx (min (+ index 6)
(1- (/ (min vlf-tune-max
(/ (1+ vlf-file-size) 2))
vlf-tune-step)))))
(while (and (zerop val) (or (<= min-idx left-idx)
(< right-idx max-idx)))
(if (<= min-idx left-idx)
(let ((left (aref vec left-idx)))
(cond ((consp left) (setq val (car left)))
((numberp left) (setq val left)))))
(if (< right-idx max-idx)
(let ((right (aref vec right-idx)))
(if (consp right)
(setq right (car right)))
(and (numberp right) (not (zerop right))
(setq val (if (zerop val)
right
(/ (+ val right) 2))))))
(setq left-idx (1- left-idx)
right-idx (1+ right-idx)))
val))
(defmacro vlf-tune-get-value (vec index &optional dont-approximate)
"Get value from VEC for INDEX.
If missing, approximate from nearby measurement,
unless DONT-APPROXIMATE is t."
`(if ,vec
(let ((val (aref ,vec ,index)))
(cond ((consp val) (car val))
((null val)
,(if dont-approximate
`(aset ,vec ,index 0)
`(vlf-tune-approximate-nearby ,vec ,index)))
((zerop val) ;index has been tried before, yet still no value
,(if dont-approximate
`(aset ,vec ,index
(vlf-tune-approximate-nearby ,vec ,index))
`(vlf-tune-approximate-nearby ,vec ,index)))
(t val)))
most-positive-fixnum))
(defmacro vlf-tune-get-vector (key)
"Get vlf-tune vector corresponding to KEY."
`(cond ((eq ,key :insert) vlf-tune-insert-bps)
((eq ,key :raw) vlf-tune-insert-raw-bps)
((eq ,key :encode) vlf-tune-encode-bps)
((eq ,key :write) vlf-tune-write-bps)
((eq ,key :hexl) vlf-tune-hexl-bps)
((eq ,key :dehexlify) vlf-tune-dehexlify-bps)))
(defun vlf-tune-assess (type coef index &optional approximate)
"Get measurement value according to TYPE, COEF and INDEX.
If APPROXIMATE is t, do approximation for missing values."
(* coef (or (if approximate
(vlf-tune-get-value (vlf-tune-get-vector type)
index)
(vlf-tune-get-value (vlf-tune-get-vector type)
index t))
0)))
(defun vlf-tune-score (types index &optional approximate time-max)
"Calculate cumulative speed over TYPES for INDEX.
If APPROXIMATE is t, do approximation for missing values.
If TIME-MAX is non nil, return cumulative time instead of speed.
If it is number, stop as soon as cumulative time gets equal or above."
(catch 'result
(let ((time 0)
(size (* (1+ index) vlf-tune-step))
(cut-time (numberp time-max)))
(dolist (el types (if time-max time
(/ size time)))
(let ((bps (if (consp el)
(vlf-tune-assess (car el) (cadr el) index
approximate)
(vlf-tune-assess el 1.0 index approximate))))
(if (zerop bps)
(throw 'result nil)
(setq time (+ time (/ size bps)))
(and cut-time (<= time-max time)
(throw 'result nil))))))))
(defun vlf-tune-conservative (types &optional index)
"Adjust `vlf-batch-size' to best nearby value over TYPES.
INDEX if given, specifies search independent of current batch size."
(if (eq vlf-tune-enabled t)
(let* ((half-max (/ (1+ vlf-file-size) 2))
(idx (or index (vlf-tune-closest-index vlf-batch-size)))
(curr (if (< half-max (* idx vlf-tune-step)) t
(vlf-tune-score types idx))))
(if curr
(let ((prev (if (zerop idx) t
(vlf-tune-score types (1- idx)))))
(if prev
(let ((next (if (or (eq curr t)
(< half-max (* (1+ idx)
vlf-tune-step)))
t
(vlf-tune-score types (1+ idx)))))
(cond ((null next)
(setq vlf-batch-size (* (+ 2 idx)
vlf-tune-step)))
((eq curr t)
(or (eq prev t)
(setq vlf-batch-size
(* idx vlf-tune-step))))
(t (let ((best-idx idx))
(and (numberp prev) (< curr prev)
(setq curr prev
best-idx (1- idx)))
(and (numberp next) (< curr next)
(setq best-idx (1+ idx)))
(setq vlf-batch-size
(* (1+ best-idx)
vlf-tune-step))))))
(setq vlf-batch-size (* idx vlf-tune-step))))
(setq vlf-batch-size (* (1+ idx) vlf-tune-step))))))
(defun vlf-tune-binary (types min max)
"Adjust `vlf-batch-size' to optimal value using binary search, \
optimizing over TYPES.
MIN and MAX specify interval of indexes to search."
(let ((sum (+ min max)))
(if (< (- max min) 3)
(vlf-tune-conservative types (/ sum 2))
(let* ((left-idx (round (+ sum (* 2 min)) 4))
(left (vlf-tune-score types left-idx)))
(if left
(let* ((right-idx (round (+ sum (* 2 max)) 4))
(right (vlf-tune-score types right-idx)))
(cond ((null right)
(setq vlf-batch-size (* (1+ right-idx)
vlf-tune-step)))
((< left right)
(vlf-tune-binary types (/ (1+ sum) 2) max))
(t (vlf-tune-binary types min (/ sum 2)))))
(setq vlf-batch-size (* (1+ left-idx) vlf-tune-step)))))))
(defun vlf-tune-linear (types max-idx)
"Adjust `vlf-batch-size' to optimal known value using linear search.
Optimize over TYPES up to MAX-IDX."
(let ((best-idx 0)
(best-bps 0)
(idx 0))
(while (< idx max-idx)
(let ((bps (vlf-tune-score types idx t)))
(and bps (< best-bps bps)
(setq best-idx idx
best-bps bps)))
(setq idx (1+ idx)))
(setq vlf-batch-size (* (1+ best-idx) vlf-tune-step))))
(defun vlf-tune-batch (types &optional linear file)
"Adjust `vlf-batch-size' to optimal value optimizing on TYPES.
TYPES is alist of elements that may be of form (type coef) or
non list values in which case coefficient is assumed 1.
Types can be :insert, :raw, :encode, :write, :hexl or :dehexlify.
If LINEAR is non nil, use brute-force. In case requested measurement
is missing, stop search and set `vlf-batch-size' to this value.
FILE if given is filename to be used, otherwise `buffer-file-name'.
Suitable for multiple batch operations."
(if (eq vlf-tune-enabled t)
(let ((max-idx (1- (/ (min vlf-tune-max
(/ (1+ vlf-file-size) 2))
vlf-tune-step))))
(if linear
(vlf-tune-linear types max-idx)
(let ((batch-size vlf-batch-size))
(cond ((file-remote-p (or file buffer-file-name))
(vlf-tune-conservative types))
((<= 1 max-idx)
(if (< max-idx 3)
(vlf-tune-conservative types (/ max-idx 2))
(vlf-tune-binary types 0 max-idx))))
(if (= batch-size vlf-batch-size) ;local maxima?
(vlf-tune-linear types max-idx)))))))
(defun vlf-tune-optimal-load (types &optional min-idx max-idx)
"Get best batch size according to existing measurements over TYPES.
Best considered where primitive operations total is closest to
`vlf-tune-load-time'. If MIN-IDX and MAX-IDX are given,
confine search to this region."
(if (eq vlf-tune-enabled t)
(progn
(setq min-idx (max 0 (or min-idx 0))
max-idx (min (or max-idx vlf-tune-max)
(1- (/ (min vlf-tune-max
(/ (1+ vlf-file-size) 2))
vlf-tune-step))))
(let* ((idx min-idx)
(best-idx idx)
(best-time-diff vlf-tune-load-time)
(all-less t)
(all-more t))
(while (and (not (zerop best-time-diff)) (< idx max-idx))
(let ((time-diff (vlf-tune-score types idx t
(+ vlf-tune-load-time
best-time-diff))))
(if time-diff
(progn
(setq time-diff (if (< vlf-tune-load-time time-diff)
(progn (setq all-less nil)
(- time-diff
vlf-tune-load-time))
(setq all-more nil)
(- vlf-tune-load-time time-diff)))
(if (< time-diff best-time-diff)
(setq best-idx idx
best-time-diff time-diff)))
(setq all-less nil)))
(setq idx (1+ idx)))
(* vlf-tune-step (1+ (cond ((or (zerop best-time-diff)
(eq all-less all-more))
best-idx)
(all-less max-idx)
(t min-idx))))))
vlf-batch-size))
(defun vlf-tune-load (types &optional region)
"Adjust `vlf-batch-size' slightly to better load time.
Optimize on TYPES on the nearby REGION. Use 2 if REGION is nil."
(when (eq vlf-tune-enabled t)
(or region (setq region 2))
(let ((idx (vlf-tune-closest-index vlf-batch-size)))
(setq vlf-batch-size (vlf-tune-optimal-load types (- idx region)
(+ idx 1 region))))))
(provide 'vlf-tune)
;;; vlf-tune.el ends here

202
vlf-write.el Normal file
View File

@@ -0,0 +1,202 @@
;;; 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)
(defcustom vlf-save-in-place 'ask
"Should VLF save in place when additional adjustment of file content\
is needed."
:group 'vlf :type '(choice (const :tag "Always when applicable" t)
(const :tag "Ask when applicable" 'ask)
(const :tag "Never" nil)))
(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? ")))
(widen)
(run-hook-with-args 'vlf-before-batch-functions 'write)
(let ((hexl (derived-mode-p 'hexl-mode)))
(when hexl
(if (consp buffer-undo-list)
(setq buffer-undo-list nil))
(vlf-tune-dehexlify))
(if (zerop vlf-file-size) ;new file
(progn (vlf-tune-write nil nil vlf-start-pos t
(vlf-tune-encode-length (point-min)
(point-max)))
(if hexl (vlf-tune-hexlify))
(setq vlf-file-size (vlf-get-file-size
buffer-file-truename)
vlf-end-pos vlf-file-size))
(let* ((region-length (vlf-tune-encode-length (point-min)
(point-max)))
(size-change (- vlf-end-pos vlf-start-pos
region-length)))
(if (zerop size-change)
(progn (vlf-tune-write nil nil vlf-start-pos t
(- vlf-end-pos vlf-start-pos))
(if hexl (vlf-tune-hexlify)))
(let ((pos (point))
(font-lock font-lock-mode)
(batch-size vlf-batch-size)
time)
(font-lock-mode 0)
(if (or (file-remote-p buffer-file-name)
(if (eq vlf-save-in-place 'ask)
(y-or-n-p "File content needs be adjusted\
till end. Use temporary copy of the whole file (slower but safer)? ")
(not vlf-save-in-place)))
(let ((file-tmp (make-temp-file "vlf")))
(setq time (float-time))
(copy-file buffer-file-name file-tmp t t t t)
(if (< 0 size-change)
(vlf-file-shift-back size-change region-length
file-tmp)
(vlf-file-shift-forward (- size-change)
region-length file-tmp))
(rename-file file-tmp buffer-file-name t))
(setq time (float-time))
(if (< 0 size-change)
(vlf-file-shift-back size-change region-length)
(vlf-file-shift-forward (- size-change)
region-length)))
(if font-lock (font-lock-mode 1))
(setq vlf-batch-size batch-size)
(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))
(goto-char pos)
(message "Save took %f seconds" (- (float-time) time)))))))
(run-hook-with-args 'vlf-after-batch-functions 'write))
t)
(defun vlf-file-shift-back (size-change write-size &optional file)
"Shift file contents SIZE-CHANGE bytes back.
WRITE-SIZE is byte length of saved chunk.
FILE if given is filename to be used, otherwise `buffer-file-name'."
(vlf-tune-write nil nil vlf-start-pos (if file nil t) write-size file)
(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)
file)
(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 file)
(insert-char 32 size-change))
(vlf-tune-write nil nil (- vlf-file-size size-change)
(if file nil t) size-change file)
(progress-reporter-done reporter)))
(defun vlf-shift-batch (read-pos write-pos file)
"Read `vlf-batch-size' bytes from READ-POS and write them \
back at WRITE-POS using FILE.
Return nil if EOF is reached, t otherwise."
(erase-buffer)
(vlf-verify-size t file)
(vlf-tune-batch '(:raw :write) nil file) ;insert speed over temp write file may defer wildly
(let ((read-end (min (+ read-pos vlf-batch-size) vlf-file-size))) ;compared to the original file
(vlf-tune-insert-file-contents-literally read-pos read-end file)
(vlf-tune-write nil nil write-pos 0 (- read-end read-pos) file)
(< read-end vlf-file-size)))
(defun vlf-file-shift-forward (size-change write-size &optional file)
"Shift file contents SIZE-CHANGE bytes forward.
WRITE-SIZE is byte length of saved chunk.
FILE if given is filename to be used, otherwise `buffer-file-name'.
Done by saving content up front and then writing previous batch."
(vlf-tune-batch '(:raw :write) nil file)
(let ((read-size (max vlf-batch-size 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
write-size t file)
(vlf-tune-batch '(:raw :write) nil file)
(setq write-pos (+ read-pos size-change)
read-pos (+ read-pos read-size)
write-size read-size
read-size (max vlf-batch-size size-change))
(progress-reporter-update reporter write-pos)
(let ((coding-system-for-write 'no-conversion))
(while (vlf-shift-batches read-size read-pos write-pos
write-size nil file)
(vlf-tune-batch '(:raw :write) nil file)
(setq write-pos (+ read-pos size-change)
read-pos (+ read-pos read-size)
write-size read-size
read-size (max vlf-batch-size size-change))
(progress-reporter-update reporter write-pos)))))
(progress-reporter-done reporter)))
(defun vlf-shift-batches (read-size read-pos write-pos write-size
hide-read file)
"Append READ-SIZE bytes of file starting at READ-POS.
Then write initial buffer content to file at WRITE-POS.
WRITE-SIZE is byte length of saved chunk.
If HIDE-READ is non nil, temporarily hide literal read content.
FILE if given is filename to be used, otherwise `buffer-file-name'.
Return nil if EOF is reached, t otherwise."
(vlf-verify-size t file)
(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)
(vlf-tune-insert-file-contents-literally
read-pos (min vlf-file-size (+ read-pos read-size)) file))
;; write
(if hide-read ; hide literal region if user has to choose encoding
(narrow-to-region start-write-pos end-write-pos))
(vlf-tune-write start-write-pos end-write-pos write-pos
(or (and (not read-more) (not file)) 0)
write-size file)
(delete-region start-write-pos end-write-pos)
(if hide-read (widen))
read-more))
(provide 'vlf-write)
;;; vlf-write.el ends here

364
vlf.el Normal file
View File

@@ -0,0 +1,364 @@
;;; vlf.el --- View Large Files -*- lexical-binding: t -*-
;; Copyright (C) 2006, 2012-2015 Free Software Foundation, Inc.
;; Version: 1.7
;; Keywords: large files, utilities
;; Maintainer: Andrey Kotlarski <m00naticus@gmail.com>
;; Authors: 2006 Mathias Dahl <mathias.dahl@gmail.com>
;; 2012 Sam Steingold <sds@gnu.org>
;; 2013-2015 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 2, 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 M-x vlf command, which visits part of
;; large file without loading it entirely. The buffer uses VLF mode,
;; which provides several commands for moving around, searching,
;; comparing and editing selected part of file.
;; To have it offered when opening large files:
;; (require 'vlf-setup)
;; This package was inspired by a snippet posted by Kevin Rodgers,
;; showing how to use `insert-file-contents' to extract part of a
;; file.
;;; Code:
(require 'vlf-base)
(defcustom vlf-before-batch-functions nil
"Hook that runs before multiple batch operations.
One argument is supplied that specifies current action. Possible
values are: `write', `ediff', `occur', `search', `goto-line'."
:group 'vlf :type 'hook)
(defcustom vlf-after-batch-functions nil
"Hook that runs after multiple batch operations.
One argument is supplied that specifies current action. Possible
values are: `write', `ediff', `occur', `search', `goto-line'."
:group 'vlf :type 'hook)
(defcustom vlf-batch-size-remote 1024
"Defines size (in bytes) of a batch of file data when accessed remotely."
:group 'vlf :type 'integer)
(defvar hexl-bits)
(autoload 'vlf-write "vlf-write" "Write current chunk to file." t)
(autoload 'vlf-re-search-forward "vlf-search"
"Search forward for REGEXP prefix COUNT number of times." t)
(autoload 'vlf-re-search-backward "vlf-search"
"Search backward for REGEXP prefix COUNT number of times." t)
(autoload 'vlf-goto-line "vlf-search" "Go to line." t)
(autoload 'vlf-query-replace "vlf-search"
"Query replace regexp over whole file." t)
(autoload 'vlf-occur "vlf-occur"
"Make whole file occur style index for REGEXP." t)
(autoload 'vlf-toggle-follow "vlf-follow"
"Toggle continuous chunk recenter around current point." t)
(autoload 'vlf-stop-follow "vlf-follow" "Stop continuous recenter." t)
(autoload 'vlf-ediff-buffers "vlf-ediff"
"Run batch by batch ediff over VLF buffers." t)
(defvar vlf-mode-map
(let ((map (make-sparse-keymap)))
(define-key map "n" 'vlf-next-batch)
(define-key map "p" 'vlf-prev-batch)
(define-key map " " 'vlf-next-batch-from-point)
(define-key map "+" 'vlf-change-batch-size)
(define-key map "-"
(lambda () "Decrease vlf batch size by factor of 2."
(interactive)
(vlf-change-batch-size t)))
(define-key map "s" 'vlf-re-search-forward)
(define-key map "r" 'vlf-re-search-backward)
(define-key map "%" 'vlf-query-replace)
(define-key map "o" 'vlf-occur)
(define-key map "[" 'vlf-beginning-of-file)
(define-key map "]" 'vlf-end-of-file)
(define-key map "j" 'vlf-jump-to-chunk)
(define-key map "l" 'vlf-goto-line)
(define-key map "e" 'vlf-ediff-buffers)
(define-key map "f" 'vlf-toggle-follow)
(define-key map "g" 'vlf-revert)
map)
"Keymap for `vlf-mode'.")
(defvar vlf-prefix-map
(let ((map (make-sparse-keymap)))
(define-key map "\C-c\C-v" vlf-mode-map)
map)
"Prefixed keymap for `vlf-mode'.")
(define-minor-mode vlf-mode
"Mode to browse large files in."
:group 'vlf :keymap vlf-prefix-map
:lighter (:eval (format " VLF[%d/%d](%s)"
(ceiling vlf-end-pos vlf-batch-size)
(ceiling vlf-file-size vlf-batch-size)
(file-size-human-readable vlf-file-size)))
(cond (vlf-mode
(set (make-local-variable 'require-final-newline) nil)
(add-hook 'write-file-functions 'vlf-write nil t)
(set (make-local-variable 'revert-buffer-function)
'vlf-revert)
(make-local-variable 'vlf-batch-size)
(setq vlf-file-size (vlf-get-file-size buffer-file-truename)
vlf-start-pos 0
vlf-end-pos 0)
(let* ((pos (position-bytes (point)))
(start (* (/ pos vlf-batch-size) vlf-batch-size)))
(goto-char (byte-to-position (- pos start)))
(vlf-move-to-batch start))
(add-hook 'after-change-major-mode-hook 'vlf-keep-alive t t)
(vlf-keep-alive))
((or (not large-file-warning-threshold)
(< vlf-file-size large-file-warning-threshold)
(y-or-n-p (format "Load whole file (%s)? "
(file-size-human-readable
vlf-file-size))))
(kill-local-variable 'revert-buffer-function)
(vlf-stop-follow)
(kill-local-variable 'require-final-newline)
(remove-hook 'write-file-functions 'vlf-write t)
(remove-hook 'after-change-major-mode-hook
'vlf-keep-alive t)
(if (derived-mode-p 'hexl-mode)
(let ((line (/ (1+ vlf-start-pos) hexl-bits))
(pos (point)))
(if (consp buffer-undo-list)
(setq buffer-undo-list nil))
(vlf-with-undo-disabled
(let ((inhibit-read-only t))
(insert-file-contents-literally buffer-file-name
t nil nil t)
(hexlify-buffer)))
(set-buffer-modified-p nil)
(goto-char (point-min))
(forward-line line)
(forward-char pos))
(let ((pos (+ vlf-start-pos (position-bytes (point))))
(inhibit-read-only t))
(vlf-with-undo-disabled
(insert-file-contents buffer-file-name t nil nil t))
(goto-char (byte-to-position pos)))))
(t (setq vlf-mode t))))
(defun vlf-keep-alive ()
"Keep `vlf-mode' on major mode change."
(if (derived-mode-p 'hexl-mode)
(set (make-local-variable 'revert-buffer-function) 'vlf-revert))
(setq vlf-mode t))
;;;###autoload
(defun vlf (file &optional minimal)
"View Large FILE in batches. When MINIMAL load just a few bytes.
You can customize number of bytes displayed by customizing
`vlf-batch-size'.
Return newly created buffer."
(interactive (list (read-file-name "File to open: ") nil))
(let ((vlf-buffer (generate-new-buffer "*vlf*")))
(set-buffer vlf-buffer)
(set-visited-file-name file)
(set-buffer-modified-p nil)
(cond (minimal
(set (make-local-variable 'vlf-batch-size) 1024))
((file-remote-p file)
(set (make-local-variable 'vlf-batch-size) vlf-batch-size-remote)))
(vlf-mode 1)
(when minimal ;restore batch size to default value
(kill-local-variable 'vlf-batch-size)
(make-local-variable 'vlf-batch-size))
(switch-to-buffer vlf-buffer)
vlf-buffer))
(defun vlf-next-batch (append)
"Display the next batch of file data.
When prefix argument is supplied and positive
jump over APPEND number of batches.
When prefix argument is negative
append next APPEND number of batches to the existing buffer."
(interactive "p")
(vlf-verify-size)
(vlf-tune-load (if (derived-mode-p 'hexl-mode)
'(:hexl :raw)
'(:insert :encode)))
(let* ((end (min (+ vlf-end-pos (* vlf-batch-size (abs append)))
vlf-file-size))
(start (if (< append 0)
vlf-start-pos
(- end vlf-batch-size))))
(vlf-move-to-chunk start end)))
(defun vlf-prev-batch (prepend)
"Display the previous batch of file data.
When prefix argument is supplied and positive
jump over PREPEND number of batches.
When prefix argument is negative
append previous PREPEND number of batches to the existing buffer."
(interactive "p")
(if (zerop vlf-start-pos)
(error "Already at BOF"))
(vlf-tune-load (if (derived-mode-p 'hexl-mode)
'(:hexl :raw)
'(:insert :encode)))
(let* ((start (max 0 (- vlf-start-pos (* vlf-batch-size (abs prepend)))))
(end (if (< prepend 0)
vlf-end-pos
(+ start vlf-batch-size))))
(vlf-move-to-chunk start end)))
;; scroll auto batching
(defadvice scroll-up (around vlf-scroll-up
activate compile)
"Slide to next batch if at end of buffer in `vlf-mode'."
(if (and vlf-mode (pos-visible-in-window-p (point-max)))
(progn (vlf-next-batch 1)
(goto-char (point-min)))
ad-do-it))
(defadvice scroll-down (around vlf-scroll-down
activate compile)
"Slide to previous batch if at beginning of buffer in `vlf-mode'."
(if (and vlf-mode (pos-visible-in-window-p (point-min)))
(progn (vlf-prev-batch 1)
(goto-char (point-max)))
ad-do-it))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; hexl mode integration
(eval-after-load "hexl"
'(progn
(defadvice hexl-save-buffer (around vlf-hexl-save
activate compile)
"Prevent hexl save if `vlf-mode' is active."
(if vlf-mode
(vlf-write)
ad-do-it))
(defadvice hexl-scroll-up (around vlf-hexl-scroll-up
activate compile)
"Slide to next batch if at end of buffer in `vlf-mode'."
(if (and vlf-mode (pos-visible-in-window-p (point-max))
(or (not (numberp arg)) (< 0 arg)))
(progn (vlf-next-batch 1)
(goto-char (point-min)))
ad-do-it))
(defadvice hexl-scroll-down (around vlf-hexl-scroll-down
activate compile)
"Slide to previous batch if at beginning of buffer in `vlf-mode'."
(if (and vlf-mode (pos-visible-in-window-p (point-min)))
(progn (vlf-prev-batch 1)
(goto-char (point-max)))
ad-do-it))
(defadvice hexl-mode-exit (around vlf-hexl-mode-exit
activate compile)
"Exit `hexl-mode' gracefully in case `vlf-mode' is active."
(if (and vlf-mode (not (buffer-modified-p)))
(vlf-with-undo-disabled
(erase-buffer)
ad-do-it
(vlf-move-to-chunk-2 vlf-start-pos vlf-end-pos))
ad-do-it))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; utilities
(defun vlf-change-batch-size (decrease)
"Change the buffer-local value of `vlf-batch-size'.
Normally, the value is doubled;
with the prefix argument DECREASE it is halved."
(interactive "P")
(vlf-set-batch-size (if decrease (/ vlf-batch-size 2)
(* vlf-batch-size 2))))
(defun vlf-set-batch-size (size)
"Set batch to SIZE bytes and update chunk."
(interactive
(list (read-number "Size in bytes: "
(vlf-tune-optimal-load
(if (derived-mode-p 'hexl-mode)
'(:hexl :raw)
'(:insert :encode))))))
(setq vlf-batch-size size)
(vlf-move-to-batch vlf-start-pos))
(defun vlf-beginning-of-file ()
"Jump to beginning of file content."
(interactive)
(vlf-tune-load (if (derived-mode-p 'hexl-mode)
'(:hexl :raw)
'(:insert :encode)))
(vlf-move-to-batch 0))
(defun vlf-end-of-file ()
"Jump to end of file content."
(interactive)
(vlf-verify-size)
(vlf-tune-load (if (derived-mode-p 'hexl-mode)
'(:hexl :raw)
'(:insert :encode)))
(vlf-move-to-batch vlf-file-size))
(defun vlf-revert (&optional _auto noconfirm)
"Revert current chunk. Ignore _AUTO.
Ask for confirmation if NOCONFIRM is nil."
(interactive)
(when (or noconfirm
(yes-or-no-p (format "Revert buffer from file %s? "
buffer-file-name)))
(set-buffer-modified-p nil)
(vlf-move-to-chunk-2 vlf-start-pos vlf-end-pos)))
(defun vlf-jump-to-chunk (n)
"Go to to chunk N."
(interactive "nGoto to chunk: ")
(vlf-tune-load (if (derived-mode-p 'hexl-mode)
'(:hexl :raw)
'(:insert :encode)))
(vlf-move-to-batch (* (1- n) vlf-batch-size)))
(defun vlf-no-modifications ()
"Ensure there are no buffer modifications."
(if (buffer-modified-p)
(error "Save or discard your changes first")
t))
(defun vlf-move-to-batch (start)
"Move to batch determined by START.
Adjust according to file start/end and show `vlf-batch-size' bytes."
(vlf-verify-size)
(let* ((start (max 0 start))
(end (min (+ start vlf-batch-size) vlf-file-size)))
(if (= vlf-file-size end) ; re-adjust start
(setq start (max 0 (- end vlf-batch-size))))
(vlf-move-to-chunk start end)))
(defun vlf-next-batch-from-point ()
"Display batch of file data starting from current point."
(interactive)
(let ((start (+ vlf-start-pos (position-bytes (point)) -1)))
(vlf-move-to-chunk start (+ start vlf-batch-size)))
(goto-char (point-min)))
(provide 'vlf)
;;; vlf.el ends here

861
vlfi.el
View File

@@ -1,861 +0,0 @@
;;; vlfi.el --- View Large Files Improved -*- lexical-binding: t -*-
;; Copyright (C) 2006, 2012, 2013 Free Software Foundation, Inc.
;; Version: 0.9
;; Keywords: large files, utilities
;; Authors: 2006 Mathias Dahl <mathias.dahl@gmail.com>
;; 2012 Sam Steingold <sds@gnu.org>
;; 2013 Andrey Kotlarski <m00naticus@gmail.com>
;; 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 2, 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 M-x vlfi command, which visits part of a
;; large file without loading the entire file.
;; The buffer uses VLFI mode, which defines several commands for
;; moving around, searching and editing selected part of file.
;; This package is upgraded version of the vlf.el package.
;;; Code:
(defgroup vlfi nil
"View Large Files in Emacs."
:prefix "vlfi-"
:group 'files)
(defcustom vlfi-batch-size 1024
"Defines how large each batch of file data is (in bytes)."
:type 'integer
:group 'vlfi)
;;; Keep track of file position.
(defvar vlfi-start-pos 0
"Absolute position of the visible chunk start.")
(defvar vlfi-end-pos 0 "Absolute position of the visible chunk end.")
(defvar vlfi-file-size 0 "Total size of presented file.")
(defvar vlfi-mode-map
(let ((map (make-sparse-keymap)))
(define-key map [M-next] 'vlfi-next-batch)
(define-key map [M-prior] 'vlfi-prev-batch)
(define-key map "+" 'vlfi-change-batch-size)
(define-key map "-"
(lambda () "Decrease vlfi batch size by factor of 2."
(interactive)
(vlfi-change-batch-size t)))
(define-key map "s" 'vlfi-re-search-forward)
(define-key map "r" 'vlfi-re-search-backward)
(define-key map "o" 'vlfi-occur)
(define-key map "[" 'vlfi-beginning-of-file)
(define-key map "]" 'vlfi-end-of-file)
(define-key map "e" 'vlfi-edit-mode)
(define-key map "j" 'vlfi-jump-to-chunk)
(define-key map "l" 'vlfi-goto-line)
map)
"Keymap for `vlfi-mode'.")
(define-derived-mode vlfi-mode special-mode "VLFI"
"Mode to browse large files in."
(setq buffer-read-only t)
(set-buffer-modified-p nil)
(buffer-disable-undo)
(make-local-variable 'write-file-functions)
(add-hook 'write-file-functions 'vlfi-write)
(make-local-variable 'revert-buffer-function)
(setq revert-buffer-function 'vlfi-revert)
(make-local-variable 'vlfi-batch-size)
(put 'vlfi-batch-size 'permanent-local t)
(make-local-variable 'vlfi-start-pos)
(put 'vlfi-start-pos 'permanent-local t)
(make-local-variable 'vlfi-end-pos)
(put 'vlfi-end-pos 'permanent-local t)
(make-local-variable 'vlfi-file-size)
(put 'vlfi-file-size 'permanent-local t))
;;;###autoload
(defun vlfi (file)
"View Large FILE.
Batches of the file data from FILE will be displayed in a read-only
buffer. You can customize number of bytes displayed by customizing
`vlfi-batch-size'."
(interactive "fFile to open: ")
(with-current-buffer (generate-new-buffer "*vlfi*")
(vlfi-mode)
(setq buffer-file-name file
vlfi-file-size (vlfi-get-file-size file))
(vlfi-insert-file)
(switch-to-buffer (current-buffer))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; integration with other packages
;;;###autoload
(defun dired-vlfi ()
"In Dired, visit the file on this line in VLFI mode."
(interactive)
(vlfi (dired-get-file-for-visit)))
;;;###autoload
(eval-after-load "dired"
'(define-key dired-mode-map "V" 'dired-vlfi))
;;;###autoload
(defun vlfi-if-file-too-large (size op-type &optional filename)
"If file SIZE larger than `large-file-warning-threshold', \
allow user to view file with `vlfi', open it normally or abort.
OP-TYPE specifies the file operation being performed over FILENAME."
(and large-file-warning-threshold size
(> size large-file-warning-threshold)
(let ((char nil))
(while (not (memq (setq char
(read-event
(propertize
(format
"File %s is large (%s): \
%s normally (o), %s with vlfi (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 '(?o ?O)))
((memq char '(?v ?V))
(vlfi filename)
(error ""))
((memq char '(?a ?A))
(error "Aborted"))))))
;; hijack `abort-if-file-too-large'
;;;###autoload
(fset 'abort-if-file-too-large 'vlfi-if-file-too-large)
;; scroll auto batching
(defadvice scroll-up (around vlfi-scroll-up
activate compile)
"Slide to next batch if at end of buffer in `vlfi-mode'."
(if (and (eq major-mode 'vlfi-mode)
(eobp))
(progn (vlfi-next-batch 1)
(goto-char (point-min)))
ad-do-it))
(defadvice scroll-down (around vlfi-scroll-down
activate compile)
"Slide to previous batch if at beginning of buffer in `vlfi-mode'."
(if (and (eq major-mode 'vlfi-mode)
(bobp))
(progn (vlfi-prev-batch 1)
(goto-char (point-max)))
ad-do-it))
;; non-recent Emacs
(unless (fboundp 'file-size-human-readable)
(defun file-size-human-readable (file-size)
"Print FILE-SIZE in MB."
(format "%.1fMB" (/ file-size 1048576.0))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; utilities
(defun vlfi-change-batch-size (decrease)
"Change the buffer-local value of `vlfi-batch-size'.
Normally, the value is doubled;
with the prefix argument DECREASE it is halved."
(interactive "P")
(or (assq 'vlfi-batch-size (buffer-local-variables))
(error "%s is not local in this buffer" 'vlfi-batch-size))
(setq vlfi-batch-size (if decrease
(/ vlfi-batch-size 2)
(* vlfi-batch-size 2)))
(vlfi-move-to-batch vlfi-start-pos))
(defun vlfi-format-buffer-name ()
"Return format for vlfi buffer name."
(format "%s(%s)[%d/%d](%d)"
(file-name-nondirectory buffer-file-name)
(file-size-human-readable vlfi-file-size)
(/ vlfi-end-pos vlfi-batch-size)
(/ vlfi-file-size vlfi-batch-size)
vlfi-batch-size))
(defun vlfi-update-buffer-name ()
"Update the current buffer name."
(rename-buffer (vlfi-format-buffer-name) t))
(defun vlfi-get-file-size (file)
"Get size in bytes of FILE."
(nth 7 (file-attributes file)))
(defun vlfi-insert-file (&optional from-end)
"Insert first chunk of current file contents in current buffer.
With FROM-END prefix, start from the back."
(if from-end
(setq vlfi-start-pos (max 0 (- vlfi-file-size vlfi-batch-size))
vlfi-end-pos vlfi-file-size)
(setq vlfi-start-pos 0
vlfi-end-pos (min vlfi-batch-size vlfi-file-size)))
(vlfi-move-to-chunk vlfi-start-pos vlfi-end-pos))
(defun vlfi-beginning-of-file ()
"Jump to beginning of file content."
(interactive)
(vlfi-insert-file))
(defun vlfi-end-of-file ()
"Jump to end of file content."
(interactive)
(vlfi-insert-file t))
(defun vlfi-revert (&optional ignore-auto noconfirm)
"Revert current chunk. Ignore IGNORE-AUTO.
Ask for confirmation if NOCONFIRM is nil."
(ignore ignore-auto)
(or noconfirm
(yes-or-no-p (format "Revert buffer from file %s? "
buffer-file-name))
(vlfi-move-to-chunk vlfi-start-pos vlfi-end-pos)))
(defun vlfi-jump-to-chunk (n)
"Go to to chunk N."
(interactive "nGoto to chunk: ")
(vlfi-move-to-batch (* (1- n) vlfi-batch-size)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; batch movement
(defun vlfi-next-batch (append)
"Display the next batch of file data.
When prefix argument is supplied and positive
jump over APPEND number of batches.
When prefix argument is negative
append next APPEND number of batches to the existing buffer."
(interactive "p")
(or (verify-visited-file-modtime (current-buffer))
(setq vlfi-file-size (vlfi-get-file-size buffer-file-name)))
(let ((end (min (+ vlfi-end-pos (* vlfi-batch-size
(abs append)))
vlfi-file-size)))
(let ((inhibit-read-only t)
(do-append (< append 0))
(pos (position-bytes (point))))
(if do-append
(goto-char (point-max))
(setq vlfi-start-pos (- end vlfi-batch-size))
(erase-buffer))
(insert-file-contents buffer-file-name nil (if do-append
vlfi-end-pos
vlfi-start-pos)
end)
(setq vlfi-end-pos end)
(goto-char (or (byte-to-position (+ pos (vlfi-adjust-chunk)))
(point-max)))))
(set-visited-file-modtime)
(set-buffer-modified-p nil)
(vlfi-update-buffer-name))
(defun vlfi-prev-batch (prepend)
"Display the previous batch of file data.
When prefix argument is supplied and positive
jump over PREPEND number of batches.
When prefix argument is negative
append previous PREPEND number of batches to the existing buffer."
(interactive "p")
(if (zerop vlfi-start-pos)
(error "Already at BOF"))
(or (verify-visited-file-modtime (current-buffer))
(setq vlfi-file-size (vlfi-get-file-size buffer-file-name)))
(let ((inhibit-read-only t)
(start (max 0 (- vlfi-start-pos (* vlfi-batch-size
(abs prepend)))))
(do-prepend (< prepend 0))
(pos (- (position-bytes (point-max))
(position-bytes (point)))))
(if do-prepend
(goto-char (point-min))
(setq vlfi-end-pos (min (+ start vlfi-batch-size)
vlfi-file-size))
(erase-buffer))
(insert-file-contents buffer-file-name nil start
(if do-prepend
vlfi-start-pos
vlfi-end-pos))
(setq vlfi-start-pos start)
(setq pos (+ pos (vlfi-adjust-chunk)))
(goto-char (or (byte-to-position (- (position-bytes (point-max))
pos))
(point-max))))
(set-visited-file-modtime)
(set-buffer-modified-p nil)
(vlfi-update-buffer-name))
(defun vlfi-move-to-batch (start &optional minimal)
"Move to batch determined by START.
Adjust according to file start/end and show `vlfi-batch-size' bytes.
When given MINIMAL flag, skip non important operations."
(or (verify-visited-file-modtime (current-buffer))
(setq vlfi-file-size (vlfi-get-file-size buffer-file-name)))
(setq vlfi-start-pos (max 0 start)
vlfi-end-pos (min (+ vlfi-start-pos vlfi-batch-size)
vlfi-file-size))
(if (= vlfi-file-size vlfi-end-pos) ; re-check file size
(setq vlfi-start-pos (max 0 (- vlfi-end-pos vlfi-batch-size))))
(let ((inhibit-read-only t)
(pos (position-bytes (point))))
(erase-buffer)
(insert-file-contents buffer-file-name nil
vlfi-start-pos vlfi-end-pos)
(goto-char (or (byte-to-position (+ pos (vlfi-adjust-chunk)))
(point-max))))
(set-buffer-modified-p nil)
(set-visited-file-modtime)
(or minimal(vlfi-update-buffer-name)))
(defun vlfi-move-to-chunk (start end &optional minimal)
"Move to chunk determined by START END.
When given MINIMAL flag, skip non important operations."
(or (verify-visited-file-modtime (current-buffer))
(setq vlfi-file-size (vlfi-get-file-size buffer-file-name)))
(setq vlfi-start-pos (max 0 start)
vlfi-end-pos (min end vlfi-file-size))
(let ((inhibit-read-only t)
(pos (position-bytes (point))))
(erase-buffer)
(insert-file-contents buffer-file-name nil
vlfi-start-pos vlfi-end-pos)
(goto-char (or (byte-to-position (+ pos (vlfi-adjust-chunk)))
(point-max))))
(set-buffer-modified-p nil)
(set-visited-file-modtime)
(or minimal (vlfi-update-buffer-name)))
(defun vlfi-adjust-chunk ()
"Adjust chunk beginning until content can be properly decoded.
Return number of bytes moved back for this to happen."
(let ((shift 0)
(chunk-size (- vlfi-end-pos vlfi-start-pos)))
(while (and (not (zerop vlfi-start-pos))
(< shift 4)
(/= chunk-size
(length (encode-coding-region
(point-min) (point-max)
buffer-file-coding-system t))))
(setq shift (1+ shift)
vlfi-start-pos (1- vlfi-start-pos)
chunk-size (1+ chunk-size))
(let ((inhibit-read-only t))
(erase-buffer)
(insert-file-contents buffer-file-name nil
vlfi-start-pos vlfi-end-pos)))
(set-buffer-modified-p nil)
shift))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; search
(defun vlfi-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."
(assert (< 0 count))
(let* ((match-chunk-start vlfi-start-pos)
(match-chunk-end vlfi-end-pos)
(match-start-pos (+ vlfi-start-pos (position-bytes (point))))
(match-end-pos match-start-pos)
(to-find count)
(reporter (make-progress-reporter
(concat "Searching for " regexp "...")
(if backward
(- vlfi-file-size vlfi-end-pos)
vlfi-start-pos)
vlfi-file-size)))
(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 vlfi-start-pos
match-chunk-end vlfi-end-pos
match-start-pos (+ vlfi-start-pos
(position-bytes
(match-beginning 0)))
match-end-pos (+ vlfi-start-pos
(position-bytes
(match-end 0)))))
((zerop vlfi-start-pos)
(throw 'end-of-file nil))
(t (let ((batch-move (- vlfi-start-pos
(- vlfi-batch-size
batch-step))))
(vlfi-move-to-batch
(if (< match-start-pos batch-move)
(- match-start-pos vlfi-batch-size)
batch-move) t))
(goto-char (if (< match-start-pos
vlfi-end-pos)
(or (byte-to-position
(- match-start-pos
vlfi-start-pos))
(point-max))
(point-max)))
(progress-reporter-update
reporter (- vlfi-file-size
vlfi-start-pos)))))
(while (not (zerop to-find))
(cond ((re-search-forward regexp nil t)
(setq to-find (1- to-find)
match-chunk-start vlfi-start-pos
match-chunk-end vlfi-end-pos
match-start-pos (+ vlfi-start-pos
(position-bytes
(match-beginning 0)))
match-end-pos (+ vlfi-start-pos
(position-bytes
(match-end 0)))))
((= vlfi-end-pos vlfi-file-size)
(throw 'end-of-file nil))
(t (let ((batch-move (- vlfi-end-pos batch-step)))
(vlfi-move-to-batch
(if (< batch-move match-end-pos)
match-end-pos
batch-move) t))
(goto-char (if (< vlfi-start-pos match-end-pos)
(or (byte-to-position
(- match-end-pos
vlfi-start-pos))
(point-min))
(point-min)))
(progress-reporter-update reporter
vlfi-end-pos)))))
(progress-reporter-done reporter))
(if backward
(vlfi-goto-match match-chunk-start match-chunk-end
match-end-pos match-start-pos
count to-find)
(vlfi-goto-match match-chunk-start match-chunk-end
match-start-pos match-end-pos
count to-find)))))
(defun vlfi-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 (vlfi-move-to-chunk match-chunk-start match-chunk-end)
(goto-char (or (byte-to-position (- match-pos-start
vlfi-start-pos))
(point-max)))
(message "Not found")
nil)
(let ((success (zerop to-find)))
(if success
(vlfi-update-buffer-name)
(vlfi-move-to-chunk match-chunk-start match-chunk-end))
(let* ((match-end (or (byte-to-position (- match-pos-end
vlfi-start-pos))
(point-max)))
(overlay (make-overlay (byte-to-position
(- match-pos-start
vlfi-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)))
(sit-for 0.1)
(delete-overlay overlay)
t))))
(defun vlfi-re-search-forward (regexp count)
"Search forward for REGEXP prefix COUNT number of times.
Search is performed chunk by chunk in `vlfi-batch-size' memory."
(interactive (list (read-regexp "Search whole file"
(if regexp-history
(car regexp-history)))
(or current-prefix-arg 1)))
(vlfi-re-search regexp count nil (/ vlfi-batch-size 8)))
(defun vlfi-re-search-backward (regexp count)
"Search backward for REGEXP prefix COUNT number of times.
Search is performed chunk by chunk in `vlfi-batch-size' memory."
(interactive (list (read-regexp "Search whole file backward"
(if regexp-history
(car regexp-history)))
(or current-prefix-arg 1)))
(vlfi-re-search regexp count t (/ vlfi-batch-size 8)))
(defun vlfi-goto-line (n)
"Go to line N. If N is negative, count from the end of file."
(interactive "nGo to line: ")
(let ((start-pos vlfi-start-pos)
(end-pos vlfi-end-pos)
(pos (point))
(success nil))
(unwind-protect
(if (< 0 n)
(progn (vlfi-beginning-of-file)
(goto-char (point-min))
(setq success (vlfi-re-search "[\n\C-m]" (1- n)
nil 0)))
(vlfi-end-of-file)
(goto-char (point-max))
(setq success (vlfi-re-search "[\n\C-m]" (- n) t 0)))
(if success
(message "Onto line %s" n)
(vlfi-move-to-chunk start-pos end-pos)
(goto-char pos)))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; occur
(defvar vlfi-occur-mode-map
(let ((map (make-sparse-keymap)))
(define-key map "n" 'vlfi-occur-next-match)
(define-key map "p" 'vlfi-occur-prev-match)
(define-key map "\C-m" 'vlfi-occur-visit)
(define-key map [mouse-1] 'vlfi-occur-visit)
(define-key map "o" 'vlfi-occur-show)
map)
"Keymap for command `vlfi-occur-mode'.")
(define-derived-mode vlfi-occur-mode special-mode "VLFI[occur]"
"Major mode for showing occur matches of VLFI opened files.")
(defun vlfi-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 vlfi-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 vlfi-occur-show (&optional event)
"Visit current `vlfi-occur' link in a vlfi buffer but stay in the \
occur buffer. If original VLFI buffer has been killed,
open new VLFI 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))))
(vlfi-occur-visit event)
(pop-to-buffer occur-buffer)))
(defun vlfi-occur-visit (&optional event)
"Visit current `vlfi-occur' link in a vlfi buffer.
If original VLFI buffer has been killed,
open new VLFI session each time.
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))
(buffer (get-char-property pos 'buffer))
(match-pos (+ (get-char-property pos 'line-pos)
pos-relative)))
(or (buffer-live-p buffer)
(let ((occur-buffer (current-buffer)))
(setq buffer (vlfi file))
(switch-to-buffer occur-buffer)))
(pop-to-buffer buffer)
(if (buffer-modified-p)
(cond ((and (= vlfi-start-pos chunk-start)
(= vlfi-end-pos chunk-end))
(goto-char match-pos))
((y-or-n-p "VLFI buffer has been modified. \
Really jump to new chunk? ")
(vlfi-move-to-chunk chunk-start chunk-end)
(goto-char match-pos)))
(vlfi-move-to-chunk chunk-start chunk-end)
(goto-char match-pos))))))
(defun vlfi-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)))))
(let ((start-pos vlfi-start-pos)
(end-pos vlfi-end-pos)
(pos (point)))
(vlfi-beginning-of-file)
(goto-char (point-min))
(unwind-protect (vlfi-build-occur regexp)
(vlfi-move-to-chunk start-pos end-pos)
(goto-char pos))))
(defun vlfi-build-occur (regexp)
"Build occur style index for REGEXP."
(let ((line 1)
(last-match-line 0)
(last-line-pos (point-min))
(file buffer-file-name)
(total-matches 0)
(match-end-pos (+ vlfi-start-pos (position-bytes (point))))
(occur-buffer (generate-new-buffer
(concat "*VLFI-occur " (file-name-nondirectory
buffer-file-name)
"*")))
(line-regexp (concat "\\(?5:[\n\C-m]\\)\\|\\(?10:"
regexp "\\)"))
(batch-step (/ vlfi-batch-size 8))
(end-of-file nil)
(reporter (make-progress-reporter
(concat "Building index for " regexp "...")
vlfi-start-pos vlfi-file-size)))
(unwind-protect
(progn
(while (not end-of-file)
(if (re-search-forward line-regexp nil t)
(progn
(setq match-end-pos (+ vlfi-start-pos
(position-bytes
(match-end 0))))
(if (match-string 5)
(setq line (1+ line) ; line detected
last-line-pos (point))
(let* ((chunk-start vlfi-start-pos)
(chunk-end vlfi-end-pos)
(vlfi-buffer (current-buffer))
(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 vlfi-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 (= vlfi-end-pos vlfi-file-size))
(unless end-of-file
(let ((batch-move (- vlfi-end-pos batch-step)))
(vlfi-move-to-batch (if (< batch-move match-end-pos)
match-end-pos
batch-move) t))
(goto-char (if (< vlfi-start-pos match-end-pos)
(or (byte-to-position (- match-end-pos
vlfi-start-pos))
(point-min))
(point-min)))
(setq last-match-line 0
last-line-pos (line-beginning-position))
(progress-reporter-update reporter vlfi-end-pos))))
(progress-reporter-done reporter))
(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 from %d lines for \"%s\" \
in file: %s" total-matches line regexp file)
'face 'underline))
(set-buffer-modified-p nil)
(forward-char 2)
(vlfi-occur-mode))
(display-buffer occur-buffer)))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; editing
(defvar vlfi-edit-mode-map
(let ((map (make-sparse-keymap)))
(set-keymap-parent map text-mode-map)
(define-key map "\C-c\C-c" 'vlfi-write)
(define-key map "\C-c\C-q" 'vlfi-discard-edit)
(define-key map "\C-v" vlfi-mode-map)
map)
"Keymap for command `vlfi-edit-mode'.")
(define-derived-mode vlfi-edit-mode vlfi-mode "VLFI[edit]"
"Major mode for editing large file chunks."
(setq buffer-read-only nil)
(buffer-enable-undo)
(message (substitute-command-keys
"Editing: Type \\[vlfi-write] to write chunk \
or \\[vlfi-discard-edit] to discard changes.")))
(defun vlfi-discard-edit ()
"Discard edit and refresh chunk from file."
(interactive)
(set-buffer-modified-p nil)
(vlfi-move-to-chunk vlfi-start-pos vlfi-end-pos)
(vlfi-mode)
(message "Switched to VLFI mode."))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; saving
(defun vlfi-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? ")))
(let ((pos (point))
(size-change (- vlfi-end-pos vlfi-start-pos
(length (encode-coding-region
(point-min) (point-max)
buffer-file-coding-system t)))))
(cond ((zerop size-change)
(write-region nil nil buffer-file-name vlfi-start-pos t))
((< 0 size-change)
(vlfi-file-shift-back size-change))
(t (vlfi-file-shift-forward (- size-change))))
(vlfi-move-to-chunk vlfi-start-pos vlfi-end-pos)
(goto-char pos))
(vlfi-mode))
t)
(defun vlfi-file-shift-back (size-change)
"Shift file contents SIZE-CHANGE bytes back."
(write-region nil nil buffer-file-name vlfi-start-pos t)
(buffer-disable-undo)
(let ((read-start-pos vlfi-end-pos)
(coding-system-for-write 'no-conversion)
(reporter (make-progress-reporter "Adjusting file content..."
vlfi-end-pos
vlfi-file-size)))
(while (vlfi-shift-batch read-start-pos (- read-start-pos
size-change))
(setq read-start-pos (+ read-start-pos vlfi-batch-size))
(progress-reporter-update reporter read-start-pos))
;; pad end with space
(erase-buffer)
(insert-char 32 size-change)
(write-region nil nil buffer-file-name (- vlfi-file-size
size-change) t)
(progress-reporter-done reporter)))
(defun vlfi-shift-batch (read-pos write-pos)
"Read `vlfi-batch-size' bytes from READ-POS and write them \
back at WRITE-POS. Return nil if EOF is reached, t otherwise."
(erase-buffer)
(or (verify-visited-file-modtime (current-buffer))
(setq vlfi-file-size (vlfi-get-file-size buffer-file-name)))
(let ((read-end (+ read-pos vlfi-batch-size)))
(insert-file-contents-literally buffer-file-name nil
read-pos
(min vlfi-file-size read-end))
(write-region nil nil buffer-file-name write-pos 0)
(< read-end vlfi-file-size)))
(defun vlfi-file-shift-forward (size-change)
"Shift file contents SIZE-CHANGE bytes forward.
Done by saving content up front and then writing previous batch."
(buffer-disable-undo)
(let ((size (+ vlfi-batch-size size-change))
(read-pos vlfi-end-pos)
(write-pos vlfi-start-pos)
(reporter (make-progress-reporter "Adjusting file content..."
vlfi-start-pos
vlfi-file-size)))
(when (vlfi-shift-batches size read-pos write-pos t)
(setq write-pos (+ read-pos size-change)
read-pos (+ read-pos size))
(progress-reporter-update reporter write-pos)
(let ((coding-system-for-write 'no-conversion))
(while (vlfi-shift-batches size read-pos write-pos nil)
(setq write-pos (+ read-pos size-change)
read-pos (+ read-pos size))
(progress-reporter-update reporter write-pos))))
(progress-reporter-done reporter)))
(defun vlfi-shift-batches (size read-pos write-pos hide-read)
"Append 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."
(or (verify-visited-file-modtime (current-buffer))
(setq vlfi-file-size (vlfi-get-file-size buffer-file-name)))
(let ((read-more (< read-pos vlfi-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 vlfi-file-size (+ read-pos
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 'vlfi)
;;; vlfi.el ends here