;; Boston, MA 02111-1307, USA.
;;; Commentary:
-;; This package provides basic chunk operations for VLF
+;; This package provides basic chunk operations for VLF,
+;; most notable being the `vlf-move-to-chunk' function.
;;; Code:
-(defconst vlf-min-chunk-size 16
+(defcustom vlf-batch-size 1024
+ "Defines how large each batch of file data is (in bytes)."
+ :group 'vlf :type 'integer)
+(put 'vlf-batch-size 'permanent-local t)
+
+(defcustom vlf-before-chunk-update nil
+ "Hook that runs before chunk update."
+ :group 'vlf :type 'hook)
+
+(defcustom vlf-after-chunk-update nil
+ "Hook that runs after chunk update."
+ :group 'vlf :type 'hook)
+
+;;; Keep track of file position.
+(defvar vlf-start-pos 0
+ "Absolute position of the visible chunk start.")
+(make-variable-buffer-local 'vlf-start-pos)
+(put 'vlf-start-pos 'permanent-local t)
+
+(defvar vlf-end-pos 0 "Absolute position of the visible chunk end.")
+(make-variable-buffer-local 'vlf-end-pos)
+(put 'vlf-end-pos 'permanent-local t)
+
+(defvar vlf-file-size 0 "Total size of presented file.")
+(make-variable-buffer-local 'vlf-file-size)
+(put 'vlf-file-size 'permanent-local t)
+
+(defconst vlf-sample-size 24
"Minimal number of bytes that can be properly decoded.")
-(defconst vlf-partial-decode-shown
- (cond ((< emacs-major-version 24) t)
- ((< 24 emacs-major-version) nil)
- (t ;; TODO: use (< emacs-minor-version 4) after 24.4 release
- (string-lessp emacs-version "24.3.5")))
- "Indicates whether partial decode codes are displayed.")
+(defun vlf-get-file-size (file)
+ "Get size in bytes of FILE."
+ (or (nth 7 (file-attributes file)) 0))
+
+(defun vlf-verify-size (&optional update-visited-time)
+ "Update file size information if necessary and visited file time.
+If non-nil, UPDATE-VISITED-TIME."
+ (unless (verify-visited-file-modtime (current-buffer))
+ (setq vlf-file-size (vlf-get-file-size buffer-file-truename))
+ (if update-visited-time
+ (set-visited-file-modtime))))
+
+(unless (fboundp 'file-size-human-readable)
+ (defun file-size-human-readable (file-size)
+ "Print FILE-SIZE in MB."
+ (format "%.3fMB" (/ file-size 1048576.0))))
+
+(defun vlf-update-buffer-name ()
+ "Update the current buffer name."
+ (rename-buffer (format "%s(%d/%d)[%s]"
+ (file-name-nondirectory buffer-file-name)
+ (/ vlf-end-pos vlf-batch-size)
+ (/ vlf-file-size vlf-batch-size)
+ (file-size-human-readable vlf-batch-size))
+ t))
+
+(defmacro vlf-with-undo-disabled (&rest body)
+ "Execute BODY with temporarily disabled undo."
+ `(let ((undo-list buffer-undo-list))
+ (setq buffer-undo-list t)
+ (unwind-protect (progn ,@body)
+ (setq buffer-undo-list undo-list))))
(defun vlf-move-to-chunk (start end &optional minimal)
- "Move to chunk determined by 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."
- (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)
+ (if (not minimal)
+ (vlf-update-buffer-name))
+ (cons (- start place) (- place end)))))
+ ((or (/= start vlf-start-pos)
+ (/= end vlf-end-pos))
+ (let ((shifts (vlf-move-to-chunk-1 start end)))
+ (and shifts (not minimal)
+ (vlf-update-buffer-name))
+ shifts))))
(defun vlf-move-to-chunk-1 (start end)
- "Move to chunk determined by START END keeping as much edits if any.
+ "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))
buffer-file-coding-system t)))
vlf-end-pos)))
(cond
- ((and (= start vlf-start-pos) (= end edit-end))
- (or modified (vlf-move-to-chunk-2 start end)))
- ((or (<= edit-end start) (<= end vlf-start-pos))
+ ((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 edit-end)
- (let* ((del-pos (1+ (byte-to-position
- (- end vlf-start-pos))))
- (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)))))
+ (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)
- (if (and (not vlf-partial-decode-shown)
- (< (- end vlf-end-pos) 4))
- (setq end vlf-end-pos)
- (vlf-with-undo-disabled
- (setq shift-end (cdr (vlf-insert-file-contents
- vlf-end-pos end nil 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 (- 1 del-pos))))
+ (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)
- (if (and (not vlf-partial-decode-shown)
- (< (- vlf-start-pos start) 4))
- (setq 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))))))
+ (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
- vlf-end-pos (+ end shift-end)))
+ (setq vlf-start-pos start))
(set-buffer-modified-p modified)
+ (set-visited-file-modtime)
+ (run-hooks 'vlf-after-chunk-update)
(cons shift-start shift-end))))))
(defun vlf-move-to-chunk-2 (start end)
- "Unconditionally move to chunk determined by 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)
(goto-char (or (byte-to-position (+ pos (car shifts)))
(point-max)))))
(set-buffer-modified-p nil)
- (setq buffer-undo-list nil)
- (set-visited-file-modtime)
+ (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 adjust-start (and adjust-start (not (zerop start)))
adjust-end (and adjust-end (< end vlf-file-size))
position (or position (point-min)))
+ (goto-char position)
(let ((shift-start 0)
- (shift-end 0))
+ (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 end position
+ (setq shift-start (vlf-adjust-start start safe-end position
adjust-end)
start (- start shift-start))
- (setq shift-end (vlf-insert-content-safe start end position)
- end (+ end shift-end)))
+ (vlf-insert-file-contents-1 start safe-end))
(if adjust-end
- (setq shift-end (+ 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."
+ (insert-file-contents buffer-file-name nil start end))
+
(defun vlf-adjust-start (start end position adjust-end)
"Adjust chunk beginning at absolute START to END till content can\
be properly decoded. Use buffer POSITION as start.
ADJUST-END is non-nil if end would be adjusted later.
Return number of bytes moved back for proper decoding."
- (let* ((min-end (min end (+ start vlf-min-chunk-size)))
- (chunk-size (- min-end start))
- (strict (and (not adjust-end) (= min-end end)))
- (shift (vlf-insert-content-safe start min-end position t)))
- (setq start (- start shift))
- (while (and (not (zerop start))
+ (let* ((safe-start (max 0 (- start 4)))
+ (sample-end (min end (+ safe-start vlf-sample-size)))
+ (chunk-size (- sample-end safe-start))
+ (strict (or (= sample-end vlf-file-size)
+ (and (not adjust-end) (= sample-end end))))
+ (shift 0))
+ (while (and (progn (vlf-insert-file-contents-1 safe-start
+ sample-end)
+ (not (zerop safe-start)))
(< shift 3)
(let ((diff (- chunk-size
(length
(encode-coding-region
position (point-max)
buffer-file-coding-system t)))))
- (cond (strict (not (zerop diff)))
- (vlf-partial-decode-shown
- (or (< diff -3) (< 0 diff)))
- (t (or (< diff 0) (< 3 diff))))))
+ (if strict
+ (not (zerop diff))
+ (or (< diff -3) (< 0 diff)))))
(setq shift (1+ shift)
- start (1- start)
+ 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))
- (insert-file-contents buffer-file-name nil start min-end))
- (unless (= min-end end)
- (delete-region position (point-max))
- (insert-file-contents buffer-file-name nil start end))
- shift))
+ (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 till content can be\
-properly decoded starting at POSITION.
-Return number of bytes added for proper decoding."
- (let ((shift 0))
- (if vlf-partial-decode-shown
- (let ((new-pos (max position
- (- (point-max) vlf-min-chunk-size))))
- (if (< position new-pos)
- (setq start (+ start (length (encode-coding-region
- position new-pos
- buffer-file-coding-system
- t)))
- position new-pos))))
- (let ((chunk-size (- end start)))
- (goto-char (point-max))
- (while (and (< shift 3)
- (< end vlf-file-size)
- (or (eq (char-charset (preceding-char)) 'eight-bit)
- (/= chunk-size
- (length (encode-coding-region
- position (point-max)
+(defun vlf-delete-region (position start end border cut-point from-start
+ &optional encode-direction)
+ "Delete from chunk starting at POSITION enclosing absolute file\
+positions START to END at absolute position BORDER. Start search for
+best cut at CUT-POINT. Delete from buffer beginning if FROM-START is
+non nil or up to buffer end otherwise. ENCODE-DIRECTION determines
+which side of the region to use to calculate cut position's absolute
+file position. Possible values are: `start' - from the beginning;
+`end' - from end; nil - the shorter side.
+Return actual absolute position of new border and buffer point at
+which deletion was performed."
+ (let* ((encode-from-end (if encode-direction
+ (eq encode-direction 'end)
+ (< (- end border) (- border start))))
+ (dist (if encode-from-end
+ (- end (length (encode-coding-region
+ cut-point (point-max)
+ buffer-file-coding-system t)))
+ (+ start (length (encode-coding-region
+ position cut-point
buffer-file-coding-system t)))))
- (setq shift (1+ shift)
- end (1+ end)
- chunk-size (1+ chunk-size))
- (delete-region position (point-max))
- (insert-file-contents buffer-file-name nil start end)
- (goto-char (point-max))))
- shift))
-
-(defun vlf-insert-content-safe (start end position &optional shift-start)
- "Insert file content from absolute START to END of file at\
-POSITION. Adjust start if SHIFT-START is non nil, end otherwise.
-Clean up if no characters are inserted."
- (goto-char position)
- (let ((shift 0))
- (while (and (< shift 3)
- (zerop (cadr (insert-file-contents buffer-file-name
- nil start end)))
- (if shift-start
- (not (zerop start))
- (< end vlf-file-size)))
- ;; TODO: this seems like regression after Emacs 24.3
- (message "Buffer content may be broken")
- (setq shift (1+ shift))
- (if shift-start
- (setq start (1- start))
- (setq end (1+ end)))
- (delete-region position (point-max)))
- shift))
+ (len 0))
+ (if (< border dist)
+ (while (< border dist)
+ (setq len (length (encode-coding-region
+ cut-point (1- cut-point)
+ buffer-file-coding-system t))
+ cut-point (1- cut-point)
+ dist (- dist len)))
+ (while (< dist border)
+ (setq len (length (encode-coding-region
+ cut-point (1+ cut-point)
+ buffer-file-coding-system t))
+ cut-point (1+ cut-point)
+ dist (+ dist len)))
+ (or (= dist border)
+ (setq cut-point (1- cut-point)
+ dist (- dist len))))
+ (and (not from-start) (/= dist border)
+ (setq cut-point (1+ cut-point)
+ dist (+ dist len)))
+ (vlf-with-undo-disabled
+ (if from-start (delete-region position cut-point)
+ (delete-region cut-point (point-max))))
+ (cons dist (1+ cut-point))))
(defun vlf-shift-undo-list (n)
"Shift undo list element regions by N."