;;; Code:
-(defgroup vlf nil
- "View Large Files in Emacs."
- :prefix "vlf-"
- :group 'files)
+(require 'vlf-tune)
-(defcustom vlf-batch-size 1024
- "Defines how large each batch of file data is (in bytes)."
- :group 'vlf
- :type 'integer)
-(put 'vlf-batch-size 'permanent-local t)
+(defcustom vlf-before-chunk-update nil
+ "Hook that runs before chunk update."
+ :group 'vlf :type 'hook)
+
+(defcustom vlf-after-chunk-update nil
+ "Hook that runs after chunk update."
+ :group 'vlf :type 'hook)
;;; Keep track of file position.
(defvar vlf-start-pos 0
(make-variable-buffer-local 'vlf-end-pos)
(put 'vlf-end-pos 'permanent-local t)
-(defvar vlf-file-size 0 "Total size of presented file.")
-(make-variable-buffer-local 'vlf-file-size)
-(put 'vlf-file-size 'permanent-local t)
-
(defconst vlf-sample-size 24
"Minimal number of bytes that can be properly decoded.")
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."
- (unless (and (= start vlf-start-pos)
- (= end vlf-end-pos))
- (vlf-verify-size)
- (let ((shifts (vlf-move-to-chunk-1 start end)))
- (and shifts (not minimal)
- (vlf-update-buffer-name))
- shifts)))
+ (vlf-verify-size)
+ (cond ((or (<= end start) (<= end 0)
+ (<= vlf-file-size start))
+ (when (or (not (buffer-modified-p))
+ (y-or-n-p "Chunk modified, are you sure? "))
+ (erase-buffer)
+ (set-buffer-modified-p nil)
+ (let ((place (if (<= vlf-file-size start)
+ vlf-file-size
+ 0)))
+ (setq vlf-start-pos place
+ vlf-end-pos place)
+ (or minimal (vlf-update-buffer-name))
+ (cons (- start place) (- place end)))))
+ ((or (/= start vlf-start-pos)
+ (/= end vlf-end-pos))
+ (let ((shifts (vlf-move-to-chunk-1 start end)))
+ (and shifts (not minimal)
+ (vlf-update-buffer-name))
+ shifts))))
(defun vlf-move-to-chunk-1 (start end)
"Move to chunk enclosed by START END keeping as much edits if any.
(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
- (+ vlf-start-pos
- (length (encode-coding-region
- (point-min) (point-max)
- buffer-file-coding-system t)))
- vlf-end-pos)))
- (cond
- ((or (< edit-end start) (< end vlf-start-pos)
- (not (verify-visited-file-modtime (current-buffer))))
- (when (or (not modified)
- (y-or-n-p "Chunk modified, are you sure? ")) ;full chunk renewal
- (set-buffer-modified-p nil)
- (vlf-move-to-chunk-2 start end)))
- ((and (= start vlf-start-pos) (= end edit-end))
- (or modified (vlf-move-to-chunk-2 start end)))
- ((or (and (<= start vlf-start-pos) (<= edit-end end))
- (not modified)
- (y-or-n-p "Chunk modified, are you sure? "))
- (let ((shift-start 0)
- (shift-end 0))
- (let ((pos (+ (position-bytes (point)) vlf-start-pos))
- (inhibit-read-only t))
- (cond ((< end edit-end)
- (let* ((del-pos (1+ (or (byte-to-position
- (- end vlf-start-pos))
- 0)))
- (del-len (length (encode-coding-region
- del-pos (point-max)
- buffer-file-coding-system
- t))))
- (setq end (- (if (zerop vlf-end-pos)
- vlf-file-size
- vlf-end-pos)
- del-len))
- (vlf-with-undo-disabled
- (delete-region del-pos (point-max)))))
- ((< edit-end end)
- (vlf-with-undo-disabled
- (setq shift-end (cdr (vlf-insert-file-contents
- vlf-end-pos end
- (/= start vlf-end-pos) t
- (point-max)))))))
- (cond ((< vlf-start-pos start)
- (let* ((del-pos (1+ (byte-to-position
- (- start vlf-start-pos))))
- (del-len (length (encode-coding-region
- (point-min) del-pos
- buffer-file-coding-system
- t))))
- (setq start (+ vlf-start-pos del-len))
- (vlf-with-undo-disabled
- (delete-region (point-min) del-pos))
- (vlf-shift-undo-list (- (point-min) del-pos))))
- ((< 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
- (/= end vlf-start-pos)
- 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
- vlf-end-pos (+ end shift-end)))
- (set-buffer-modified-p modified)
- (set-visited-file-modtime)
- (cons shift-start shift-end))))))
+ (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
+ ((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)))
+ ((or (and (<= start vlf-start-pos) (<= edit-end end))
+ (not modified)
+ (y-or-n-p "Chunk modified, are you sure? "))
+ (run-hooks 'vlf-before-chunk-update)
+ (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)
+ (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)
(vlf-verify-size t)
(setq vlf-start-pos (max 0 start)
vlf-end-pos (min end vlf-file-size))
(let ((inhibit-read-only t)
(pos (position-bytes (point))))
(vlf-with-undo-disabled
- (erase-buffer)
- (setq shifts (vlf-insert-file-contents vlf-start-pos
- vlf-end-pos t t)
- vlf-start-pos (- vlf-start-pos (car shifts))
- vlf-end-pos (+ vlf-end-pos (cdr shifts)))
+ (let ((hexl (derived-mode-p 'hexl-mode)))
+ (if hexl (hexl-mode-exit t))
+ (erase-buffer)
+ (setq shifts (vlf-insert-file-contents vlf-start-pos
+ vlf-end-pos t t)
+ vlf-start-pos (- vlf-start-pos (car shifts))
+ vlf-end-pos (+ vlf-end-pos (cdr shifts)))
+ (if hexl (vlf-tune-hexlify)))
(goto-char (or (byte-to-position (+ pos (car shifts)))
(point-max)))))
(set-buffer-modified-p nil)
- (setq buffer-undo-list nil)
+ (or (eq buffer-undo-list t)
+ (setq buffer-undo-list nil))
+ (run-hooks 'vlf-after-chunk-update)
shifts))
(defun vlf-insert-file-contents (start end adjust-start adjust-end
&optional position)
"Adjust chunk at absolute START to END till content can be\
-properly decoded. ADJUST-START determines if trying to prepend bytes\
- to the beginning, ADJUST-END - append to the end.
+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 shift-start (vlf-adjust-start start safe-end position
adjust-end)
start (- start shift-start))
- (vlf-insert-file-contents-safe start safe-end position))
+ (vlf-insert-file-contents-1 start safe-end))
(if adjust-end
- (setq shift-end (vlf-adjust-end start end position)))
+ (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."
+ (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.
(strict (or (= sample-end vlf-file-size)
(and (not adjust-end) (= sample-end end))))
(shift 0))
- (while (and (progn (vlf-insert-file-contents-safe
- safe-start sample-end position)
+ (while (and (progn (vlf-insert-file-contents-1 safe-start
+ sample-end)
(not (zerop safe-start)))
(< shift 3)
(let ((diff (- chunk-size
safe-start (1- safe-start)
chunk-size (1+ chunk-size))
(delete-region position (point-max)))
- (let ((cut-pos position)
- (cut-len 0))
- (while (< safe-start start)
- (setq cut-len (length (encode-coding-region
- cut-pos (1+ cut-pos)
- buffer-file-coding-system t))
- cut-pos (1+ cut-pos)
- safe-start (+ safe-start cut-len)))
- (if (< start safe-start)
- (setq safe-start (- safe-start cut-len)
- cut-pos (1- cut-pos)))
- (if (= sample-end end)
- (delete-region position cut-pos)
- (delete-region position (point-max))
- (vlf-insert-file-contents-safe safe-start end position)))
+ (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-adjust-end (start end position)
- "Adjust chunk end at absolute START to END starting at POSITION.
-Remove characters from the end until length is closest to expected.
-Return number of bytes added over expected."
- (let ((expected-size (- end start))
- (current-size (length (encode-coding-region
- position (point-max)
- buffer-file-coding-system t)))
- (cut-point (point-max))
- (cut-len 0))
- (while (< expected-size current-size)
- (setq cut-len (length (encode-coding-region
- (1- cut-point) cut-point
+(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)
- current-size (- current-size cut-len)))
- (if (< current-size expected-size)
- (setq cut-point (1+ cut-point)
- current-size (+ current-size cut-len)))
- (delete-region cut-point (point-max))
- (- current-size expected-size)))
-
-(defun vlf-insert-file-contents-safe (start end position)
- "Extract decoded file bytes START to END at POSITION."
- (let ((coding buffer-file-coding-system))
- (insert-file-contents-literally buffer-file-name nil start end)
- (let ((coding-system-for-read coding))
- (decode-coding-inserted-region position (point-max)
- buffer-file-name nil start end)))
- (setq buffer-file-coding-system last-coding-system-used))
+ cut-point (1- cut-point)
+ dist (- dist len)))
+ (while (< dist border)
+ (setq len (length (encode-coding-region
+ cut-point (1+ cut-point)
+ buffer-file-coding-system t))
+ cut-point (1+ cut-point)
+ dist (+ dist len)))
+ (or (= dist border)
+ (setq cut-point (1- cut-point)
+ dist (- dist len))))
+ (and (not from-start) (/= dist border)
+ (setq cut-point (1+ cut-point)
+ dist (+ dist len)))
+ (vlf-with-undo-disabled
+ (if from-start (delete-region position cut-point)
+ (delete-region cut-point (point-max))))
+ (cons dist (1+ cut-point))))
(defun vlf-shift-undo-list (n)
"Shift undo list element regions by N."
- (or (eq buffer-undo-list t)
+ (or (null buffer-undo-list) (eq buffer-undo-list t)
(setq buffer-undo-list
(nreverse
(let ((min (point-min))