;;; vlf-base.el --- VLF primitive operations -*- lexical-binding: t -*-
-;; Copyright (C) 2014 Free Software Foundation, Inc.
+;; Copyright (C) 2014-2015 Free Software Foundation, Inc.
;; Keywords: large files, chunk
;; Author: Andrey Kotlarski <m00naticus@gmail.com>
;;; Code:
-(defcustom vlf-batch-size 1024
- "Defines how large each batch of file data is (in bytes)."
- :group 'vlf :type 'integer)
-(put 'vlf-batch-size 'permanent-local t)
+(require 'vlf-tune)
-(defcustom vlf-before-chunk-update nil
+(defcustom vlf-before-chunk-update-hook nil
"Hook that runs before chunk update."
:group 'vlf :type 'hook)
-(defcustom vlf-after-chunk-update nil
+(defcustom vlf-after-chunk-update-hook nil
"Hook that runs after chunk update."
:group 'vlf :type 'hook)
(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)
+(defvar hexl-bits)
(defconst vlf-sample-size 24
"Minimal number of bytes that can be properly decoded.")
"Get size in bytes of FILE."
(or (nth 7 (file-attributes file)) 0))
-(defun vlf-verify-size (&optional update-visited-time)
+(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."
+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 buffer-file-truename))
+ (setq vlf-file-size (vlf-get-file-size (or file
+ buffer-file-truename)))
(if update-visited-time
(set-visited-file-modtime))))
"Print FILE-SIZE in MB."
(format "%.3fMB" (/ file-size 1048576.0))))
-(defun vlf-update-buffer-name ()
- "Update the current buffer name."
- (rename-buffer (format "%s(%d/%d)[%s]"
- (file-name-nondirectory buffer-file-name)
- (/ vlf-end-pos vlf-batch-size)
- (/ vlf-file-size vlf-batch-size)
- (file-size-human-readable vlf-batch-size))
- t))
-
(defmacro vlf-with-undo-disabled (&rest body)
"Execute BODY with temporarily disabled undo."
`(let ((undo-list buffer-undo-list))
(unwind-protect (progn ,@body)
(setq buffer-undo-list undo-list))))
-(defun vlf-move-to-chunk (start end &optional minimal)
+(defun vlf-move-to-chunk (start end)
"Move to chunk enclosed by START END bytes.
-When given MINIMAL flag, skip non important operations.
If same as current chunk is requested, do nothing.
Return number of bytes moved back for proper decoding and number of
bytes added to the end."
(vlf-verify-size)
- (cond ((or (<= end start) (<= end 0)
- (<= vlf-file-size start))
- (when (or (not (buffer-modified-p))
- (y-or-n-p "Chunk modified, are you sure? "))
- (erase-buffer)
- (set-buffer-modified-p nil)
- (let ((place (if (<= vlf-file-size start)
- vlf-file-size
- 0)))
- (setq vlf-start-pos place
- vlf-end-pos place)
- (if (not minimal)
- (vlf-update-buffer-name))
- (cons (- start place) (- place end)))))
- ((or (/= start vlf-start-pos)
- (/= end vlf-end-pos))
- (let ((shifts (vlf-move-to-chunk-1 start end)))
- (and shifts (not minimal)
- (vlf-update-buffer-name))
- shifts))))
+ (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.
(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? "))
- (run-hooks 'vlf-before-chunk-update)
- (let ((shift-start 0)
- (shift-end 0))
- (let ((pos (+ (position-bytes (point)) vlf-start-pos))
- (inhibit-read-only t))
- (cond ((= end vlf-start-pos)
- (or (eq buffer-undo-list t)
- (setq buffer-undo-list nil))
- (vlf-with-undo-disabled (erase-buffer))
- (setq modified nil))
- ((< end edit-end)
- (setq end (car (vlf-delete-region
- (point-min) vlf-start-pos edit-end
- end (min (or (byte-to-position
- (- end vlf-start-pos))
- (point-min))
- (point-max))
- nil))))
- ((< edit-end end)
- (vlf-with-undo-disabled
- (setq shift-end (cdr (vlf-insert-file-contents
- vlf-end-pos end nil t
- (point-max)))))))
- (setq vlf-end-pos (+ end shift-end))
- (cond ((= start edit-end)
- (or (eq buffer-undo-list t)
- (setq buffer-undo-list nil))
- (vlf-with-undo-disabled
- (delete-region (point-min) (point)))
- (setq modified nil))
- ((< vlf-start-pos start)
- (let ((del-info (vlf-delete-region
- (point-min) vlf-start-pos
- vlf-end-pos start
- (min (or (byte-to-position
- (- start vlf-start-pos))
- (point))
- (point-max)) t)))
- (setq start (car del-info))
- (vlf-shift-undo-list (- (point-min)
- (cdr del-info)))))
- ((< start vlf-start-pos)
- (let ((edit-end-pos (point-max)))
- (vlf-with-undo-disabled
- (setq shift-start (car (vlf-insert-file-contents
- start vlf-start-pos t nil
- edit-end-pos)))
- (goto-char (point-min))
- (insert (delete-and-extract-region
- edit-end-pos (point-max))))
- (vlf-shift-undo-list (- (point-max)
- edit-end-pos)))))
- (setq start (- start shift-start))
- (goto-char (or (byte-to-position (- pos start))
- (byte-to-position (- pos vlf-start-pos))
- (point-max)))
- (setq vlf-start-pos start))
- (set-buffer-modified-p modified)
- (set-visited-file-modtime)
- (run-hooks 'vlf-after-chunk-update)
- (cons shift-start shift-end))))))
+ (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)
- (vlf-verify-size t)
- (setq vlf-start-pos (max 0 start)
- vlf-end-pos (min end vlf-file-size))
- (let (shifts)
- (let ((inhibit-read-only t)
- (pos (position-bytes (point))))
- (vlf-with-undo-disabled
- (erase-buffer)
- (setq shifts (vlf-insert-file-contents vlf-start-pos
- vlf-end-pos t t)
- vlf-start-pos (- vlf-start-pos (car shifts))
- vlf-end-pos (+ vlf-end-pos (cdr shifts)))
- (goto-char (or (byte-to-position (+ pos (car shifts)))
- (point-max)))))
- (set-buffer-modified-p nil)
- (or (eq buffer-undo-list t)
- (setq buffer-undo-list nil))
- (run-hooks 'vlf-after-chunk-update)
- shifts))
+ (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)
Return number of bytes moved back for proper decoding and number of
bytes added to the end."
(setq adjust-start (and adjust-start (not (zerop start)))
- adjust-end (and adjust-end (< end vlf-file-size))
+ adjust-end (and adjust-end (/= end vlf-file-size))
position (or position (point-min)))
(goto-char position)
(let ((shift-start 0)
(defun vlf-insert-file-contents-1 (start end)
"Extract decoded file bytes START to END."
- (insert-file-contents buffer-file-name nil start 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\
(strict (or (= sample-end vlf-file-size)
(and (not adjust-end) (= sample-end end))))
(shift 0))
- (while (and (progn (vlf-insert-file-contents-1 safe-start
- sample-end)
+ (while (and (progn (insert-file-contents buffer-file-name
+ nil safe-start sample-end)
(not (zerop safe-start)))
(< shift 3)
(let ((diff (- chunk-size
(eq encode-direction 'end)
(< (- end border) (- border start))))
(dist (if encode-from-end
- (- end (length (encode-coding-region
- cut-point (point-max)
- buffer-file-coding-system t)))
- (+ start (length (encode-coding-region
- position cut-point
- buffer-file-coding-system t)))))
+ (- 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)
(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 (eq buffer-undo-list t)
+ (or (null buffer-undo-list) (eq buffer-undo-list t)
(setq buffer-undo-list
(nreverse
(let ((min (point-min))