1 ;;; vlf-base.el --- VLF primitive operations -*- lexical-binding: t -*-
3 ;; Copyright (C) 2014 Free Software Foundation, Inc.
5 ;; Keywords: large files, chunk
6 ;; Author: Andrey Kotlarski <m00naticus@gmail.com>
7 ;; URL: https://github.com/m00natic/vlfi
9 ;; This file is free software; you can redistribute it and/or modify
10 ;; it under the terms of the GNU General Public License as published by
11 ;; the Free Software Foundation; either version 3, or (at your option)
14 ;; This file is distributed in the hope that it will be useful,
15 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
16 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
17 ;; GNU General Public License for more details.
19 ;; You should have received a copy of the GNU General Public License
20 ;; along with GNU Emacs; see the file COPYING. If not, write to
21 ;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
22 ;; Boston, MA 02111-1307, USA.
25 ;; This package provides basic chunk operations for VLF,
26 ;; most notable being the `vlf-move-to-chunk' function.
31 "View Large Files in Emacs."
35 (defcustom vlf-batch-size 1024
36 "Defines how large each batch of file data is (in bytes)."
39 (put 'vlf-batch-size 'permanent-local t)
41 ;;; Keep track of file position.
42 (defvar vlf-start-pos 0
43 "Absolute position of the visible chunk start.")
44 (make-variable-buffer-local 'vlf-start-pos)
45 (put 'vlf-start-pos 'permanent-local t)
47 (defvar vlf-end-pos 0 "Absolute position of the visible chunk end.")
48 (make-variable-buffer-local 'vlf-end-pos)
49 (put 'vlf-end-pos 'permanent-local t)
51 (defvar vlf-file-size 0 "Total size of presented file.")
52 (make-variable-buffer-local 'vlf-file-size)
53 (put 'vlf-file-size 'permanent-local t)
55 (defconst vlf-sample-size 24
56 "Minimal number of bytes that can be properly decoded.")
58 (defun vlf-get-file-size (file)
59 "Get size in bytes of FILE."
60 (or (nth 7 (file-attributes file)) 0))
62 (defun vlf-verify-size (&optional update-visited-time)
63 "Update file size information if necessary and visited file time.
64 If non-nil, UPDATE-VISITED-TIME."
65 (unless (verify-visited-file-modtime (current-buffer))
66 (setq vlf-file-size (vlf-get-file-size buffer-file-truename))
67 (if update-visited-time
68 (set-visited-file-modtime))))
70 (unless (fboundp 'file-size-human-readable)
71 (defun file-size-human-readable (file-size)
72 "Print FILE-SIZE in MB."
73 (format "%.3fMB" (/ file-size 1048576.0))))
75 (defun vlf-update-buffer-name ()
76 "Update the current buffer name."
77 (rename-buffer (format "%s(%d/%d)[%s]"
78 (file-name-nondirectory buffer-file-name)
79 (/ vlf-end-pos vlf-batch-size)
80 (/ vlf-file-size vlf-batch-size)
81 (file-size-human-readable vlf-batch-size))
84 (defmacro vlf-with-undo-disabled (&rest body)
85 "Execute BODY with temporarily disabled undo."
86 `(let ((undo-list buffer-undo-list))
87 (setq buffer-undo-list t)
88 (unwind-protect (progn ,@body)
89 (setq buffer-undo-list undo-list))))
91 (defun vlf-move-to-chunk (start end &optional minimal)
92 "Move to chunk enclosed by START END bytes.
93 When given MINIMAL flag, skip non important operations.
94 If same as current chunk is requested, do nothing.
95 Return number of bytes moved back for proper decoding and number of
96 bytes added to the end."
98 (cond ((or (<= end start) (<= end 0)
99 (<= vlf-file-size start))
100 (when (or (not (buffer-modified-p))
101 (y-or-n-p "Chunk modified, are you sure? "))
103 (set-buffer-modified-p nil)
104 (let ((place (if (<= vlf-file-size start)
107 (setq vlf-start-pos place
110 (vlf-update-buffer-name))
111 (cons (- start place) (- place end)))))
112 ((or (/= start vlf-start-pos)
113 (/= end vlf-end-pos))
114 (let ((shifts (vlf-move-to-chunk-1 start end)))
115 (and shifts (not minimal)
116 (vlf-update-buffer-name))
119 (defun vlf-move-to-chunk-1 (start end)
120 "Move to chunk enclosed by START END keeping as much edits if any.
121 Return number of bytes moved back for proper decoding and number of
122 bytes added to the end."
124 (let* ((modified (buffer-modified-p))
125 (start (max 0 start))
126 (end (min end vlf-file-size))
127 (edit-end (if modified
129 (length (encode-coding-region
130 (point-min) (point-max)
131 buffer-file-coding-system t)))
134 ((or (< edit-end start) (< end vlf-start-pos)
135 (not (verify-visited-file-modtime (current-buffer))))
136 (when (or (not modified)
137 (y-or-n-p "Chunk modified, are you sure? ")) ;full chunk renewal
138 (set-buffer-modified-p nil)
139 (vlf-move-to-chunk-2 start end)))
140 ((and (= start vlf-start-pos) (= end edit-end))
141 (or modified (vlf-move-to-chunk-2 start end)))
142 ((or (and (<= start vlf-start-pos) (<= edit-end end))
144 (y-or-n-p "Chunk modified, are you sure? "))
145 (let ((shift-start 0)
147 (let ((pos (+ (position-bytes (point)) vlf-start-pos))
148 (inhibit-read-only t))
149 (cond ((= end vlf-start-pos)
150 (or (eq buffer-undo-list t)
151 (setq buffer-undo-list nil))
152 (vlf-with-undo-disabled (erase-buffer))
155 (setq end (car (vlf-delete-region
156 (point-min) vlf-start-pos edit-end
157 end (min (or (byte-to-position
158 (- end vlf-start-pos))
163 (vlf-with-undo-disabled
164 (setq shift-end (cdr (vlf-insert-file-contents
165 vlf-end-pos end nil t
167 (setq vlf-end-pos (+ end shift-end))
168 (cond ((= start edit-end)
169 (or (eq buffer-undo-list t)
170 (setq buffer-undo-list nil))
171 (vlf-with-undo-disabled
172 (delete-region (point-min) (point)))
174 ((< vlf-start-pos start)
175 (let ((del-info (vlf-delete-region
176 (point-min) vlf-start-pos
178 (min (or (byte-to-position
179 (- start vlf-start-pos))
182 (setq start (car del-info))
183 (vlf-shift-undo-list (- (point-min)
185 ((< start vlf-start-pos)
186 (let ((edit-end-pos (point-max)))
187 (vlf-with-undo-disabled
188 (setq shift-start (car (vlf-insert-file-contents
189 start vlf-start-pos t nil
191 (goto-char (point-min))
192 (insert (delete-and-extract-region
193 edit-end-pos (point-max))))
194 (vlf-shift-undo-list (- (point-max)
196 (setq start (- start shift-start))
197 (goto-char (or (byte-to-position (- pos start))
198 (byte-to-position (- pos vlf-start-pos))
200 (setq vlf-start-pos start))
201 (set-buffer-modified-p modified)
202 (set-visited-file-modtime)
203 (cons shift-start shift-end))))))
205 (defun vlf-move-to-chunk-2 (start end)
206 "Unconditionally move to chunk enclosed by START END bytes.
207 Return number of bytes moved back for proper decoding and number of
208 bytes added to the end."
210 (setq vlf-start-pos (max 0 start)
211 vlf-end-pos (min end vlf-file-size))
213 (let ((inhibit-read-only t)
214 (pos (position-bytes (point))))
215 (vlf-with-undo-disabled
217 (setq shifts (vlf-insert-file-contents vlf-start-pos
219 vlf-start-pos (- vlf-start-pos (car shifts))
220 vlf-end-pos (+ vlf-end-pos (cdr shifts)))
221 (goto-char (or (byte-to-position (+ pos (car shifts)))
223 (set-buffer-modified-p nil)
224 (setq buffer-undo-list nil)
227 (defun vlf-insert-file-contents (start end adjust-start adjust-end
229 "Adjust chunk at absolute START to END till content can be\
230 properly decoded. ADJUST-START determines if trying to prepend bytes\
231 to the beginning, ADJUST-END - append to the end.
232 Use buffer POSITION as start if given.
233 Return number of bytes moved back for proper decoding and number of
234 bytes added to the end."
235 (setq adjust-start (and adjust-start (not (zerop start)))
236 adjust-end (and adjust-end (< end vlf-file-size))
237 position (or position (point-min)))
239 (let ((shift-start 0)
241 (safe-end (if adjust-end
242 (min vlf-file-size (+ end 4))
245 (setq shift-start (vlf-adjust-start start safe-end position
247 start (- start shift-start))
248 (vlf-insert-file-contents-1 start safe-end position))
250 (setq shift-end (- (car (vlf-delete-region position start
255 (cons shift-start shift-end)))
257 (defun vlf-insert-file-contents-1 (start end position)
258 "Extract decoded file bytes START to END at POSITION."
259 (let ((coding buffer-file-coding-system))
260 (insert-file-contents-literally buffer-file-name nil start end)
261 (let ((coding-system-for-read coding))
262 (decode-coding-inserted-region position (point-max)
263 buffer-file-name nil start end)))
264 (when (eq (detect-coding-region position (min (+ position
268 (delete-region position (point-max))
269 (insert-file-contents-literally buffer-file-name nil start end)
270 (let ((coding-system-for-read nil))
271 (decode-coding-inserted-region position (point-max)
272 buffer-file-name nil start end)))
273 (setq buffer-file-coding-system last-coding-system-used))
275 (defun vlf-adjust-start (start end position adjust-end)
276 "Adjust chunk beginning at absolute START to END till content can\
277 be properly decoded. Use buffer POSITION as start.
278 ADJUST-END is non-nil if end would be adjusted later.
279 Return number of bytes moved back for proper decoding."
280 (let* ((safe-start (max 0 (- start 4)))
281 (sample-end (min end (+ safe-start vlf-sample-size)))
282 (chunk-size (- sample-end safe-start))
283 (strict (or (= sample-end vlf-file-size)
284 (and (not adjust-end) (= sample-end end))))
286 (while (and (progn (vlf-insert-file-contents-1
287 safe-start sample-end position)
288 (not (zerop safe-start)))
290 (let ((diff (- chunk-size
292 (encode-coding-region
294 buffer-file-coding-system t)))))
297 (or (< diff -3) (< 0 diff)))))
298 (setq shift (1+ shift)
299 safe-start (1- safe-start)
300 chunk-size (1+ chunk-size))
301 (delete-region position (point-max)))
302 (setq safe-start (car (vlf-delete-region position safe-start
305 (unless (= sample-end end)
306 (delete-region position (point-max))
307 (vlf-insert-file-contents-1 safe-start end position))
308 (- start safe-start)))
310 (defun vlf-delete-region (position start end border cut-point from-start
311 &optional encode-direction)
312 "Delete from chunk starting at POSITION enclosing absolute file\
313 positions START to END at absolute position BORDER. Start search for
314 best cut at CUT-POINT. Delete from buffer beginning if FROM-START is
315 non nil or up to buffer end otherwise. ENCODE-DIRECTION determines
316 which side of the region to use to calculate cut position's absolute
317 file position. Possible values are: `start' - from the beginning;
318 `end' - from end; nil - the shorter side.
319 Return actual absolute position of new border and buffer point at
320 which deletion was performed."
321 (let* ((encode-from-end (if encode-direction
322 (eq encode-direction 'end)
323 (< (- end border) (- border start))))
324 (dist (if encode-from-end
325 (- end (length (encode-coding-region
326 cut-point (point-max)
327 buffer-file-coding-system t)))
328 (+ start (length (encode-coding-region
330 buffer-file-coding-system t)))))
333 (while (< border dist)
334 (setq len (length (encode-coding-region
335 cut-point (1- cut-point)
336 buffer-file-coding-system t))
337 cut-point (1- cut-point)
339 (while (< dist border)
340 (setq len (length (encode-coding-region
341 cut-point (1+ cut-point)
342 buffer-file-coding-system t))
343 cut-point (1+ cut-point)
346 (setq cut-point (1- cut-point)
348 (and (not from-start) (/= dist border)
349 (setq cut-point (1+ cut-point)
351 (vlf-with-undo-disabled
352 (if from-start (delete-region position cut-point)
353 (delete-region cut-point (point-max))))
354 (cons dist (1+ cut-point))))
356 (defun vlf-shift-undo-list (n)
357 "Shift undo list element regions by N."
358 (or (eq buffer-undo-list t)
359 (setq buffer-undo-list
361 (let ((min (point-min))
364 (dolist (el buffer-undo-list undo-list)
368 ((numberp el) (let ((pos (+ el n)))
370 (throw 'end undo-list)
372 (t (let ((head (car el)))
373 (cond ((numberp head)
374 (let ((beg (+ head n)))
376 (throw 'end undo-list)
377 (cons beg (+ (cdr el) n)))))
379 (let* ((pos (cdr el))
381 (new (+ (abs pos) n)))
383 (throw 'end undo-list)
384 (cons head (if positive
388 (let ((beg (+ (nth 3 el) n)))
390 (throw 'end undo-list)
400 ((and (eq head 'apply)
402 (let ((beg (+ (nth 2 el) n)))
404 (throw 'end undo-list)
414 (cdr (last el))))))))))
420 ;;; vlf-base.el ends here