sascha/vlfi
1
0
Fork 0
mirror of https://github.com/m00natic/vlfi.git synced 2025-01-18 20:10:47 +00:00
Code Issues Releases Wiki Activity

Optimize chunk jumping for current GNU Emacs releases. Fix moving by

Browse Source 
just few bytes.
This commit is contained in:
Andrey Kotlarski 2013-12-25 03:18:29 +02:00
parent 386d85656c
commit e36492b82f
1 changed files with 195 additions and 83 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

278
vlf.el
View File

@ -79,6 +79,16 @@ Possible values are: nil to never use it;
continuously recenter.") continuously recenter.")
(put 'vlf-follow-timer 'permanent-local t) (put 'vlf-follow-timer 'permanent-local t)
(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.")
(defconst vlf-min-chunk-size 8
"Minimal number of bytes that can be properly decoded.")
(defvar vlf-mode-map (defvar vlf-mode-map
(let ((map (make-sparse-keymap))) (let ((map (make-sparse-keymap)))
(define-key map "n" 'vlf-next-batch) (define-key map "n" 'vlf-next-batch)
@ -428,111 +438,210 @@ When given MINIMAL flag, skip non important operations."
(defun vlf-move-to-chunk (start end &optional minimal) (defun vlf-move-to-chunk (start end &optional minimal)
"Move to chunk determined by START END. "Move to chunk determined by START END.
When given MINIMAL flag, skip non important operations. When given MINIMAL flag, skip non important operations.
If same as current chunk is requested, do nothing." 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) (unless (and (= start vlf-start-pos)
(= end vlf-end-pos)) (= end vlf-end-pos))
(vlf-verify-size) (vlf-verify-size)
(if (vlf-move-to-chunk-1 start end) (let ((shifts (vlf-move-to-chunk-1 start end)))
(or minimal (vlf-update-buffer-name))))) (and shifts (not minimal)
(vlf-update-buffer-name))
shifts)))
(defun vlf-move-to-chunk-1 (start end) (defun vlf-move-to-chunk-1 (start end)
"Move to chunk determined by START END keeping as much edits if any. "Move to chunk determined by START END keeping as much edits if any.
Return t if move hasn't been canceled." Return number of bytes moved back for proper decoding and number of
(let ((modified (buffer-modified-p)) bytes added to the end."
(start (max 0 start)) (let* ((modified (buffer-modified-p))
(end (min end vlf-file-size)) (start (max 0 start))
(edit-end (+ (position-bytes (point-max)) vlf-start-pos))) (end (min end vlf-file-size))
(edit-end (if modified
(+ vlf-start-pos
(length (encode-coding-region
(point-min) (point-max)
buffer-file-coding-system t)))
vlf-end-pos)))
(cond (cond
((and (= start vlf-start-pos) (= end edit-end)) ((and (= start vlf-start-pos) (= end edit-end))
(unless modified (or modified (vlf-move-to-chunk-2 start end)))
(vlf-move-to-chunk-2 start end)
t))
((or (<= edit-end start) (<= end vlf-start-pos)) ((or (<= edit-end start) (<= end vlf-start-pos))
(when (or (not modified) (when (or (not modified)
(y-or-n-p "Chunk modified, are you sure? ")) ;full chunk renewal (y-or-n-p "Chunk modified, are you sure? ")) ;full chunk renewal
(set-buffer-modified-p nil) (set-buffer-modified-p nil)
(vlf-move-to-chunk-2 start end) (vlf-move-to-chunk-2 start end)))
t))
((or (and (<= start vlf-start-pos) (<= edit-end end)) ((or (and (<= start vlf-start-pos) (<= edit-end end))
(not modified) (not modified)
(y-or-n-p "Chunk modified, are you sure? ")) (y-or-n-p "Chunk modified, are you sure? "))
(let ((pos (+ (position-bytes (point)) vlf-start-pos)) (let ((shift-start 0)
(shift-start 0) (shift-end 0))
(shift-end 0) (let ((pos (+ (position-bytes (point)) vlf-start-pos))
(inhibit-read-only t)) (inhibit-read-only t))
(cond ((< end edit-end) (cond ((< end edit-end)
(let* ((del-pos (1+ (byte-to-position (let* ((del-pos (1+ (byte-to-position
(- end vlf-start-pos)))) (- end vlf-start-pos))))
(del-len (length (encode-coding-region (del-len (length (encode-coding-region
del-pos (point-max) del-pos (point-max)
buffer-file-coding-system buffer-file-coding-system
t)))) t))))
(setq end (- (if (zerop vlf-end-pos) (setq end (- (if (zerop vlf-end-pos)
vlf-file-size vlf-file-size
vlf-end-pos) vlf-end-pos)
del-len)) del-len))
(vlf-with-undo-disabled
(delete-region del-pos (point-max)))))
((< edit-end end)
(vlf-with-undo-disabled (vlf-with-undo-disabled
(delete-region del-pos (point-max))))) (setq shift-end (cdr (vlf-insert-file-contents
((< edit-end end)
(let ((edit-end-pos (point-max)))
(goto-char edit-end-pos)
(vlf-with-undo-disabled
(insert-file-contents buffer-file-name nil
vlf-end-pos end)
(setq shift-end (cdr (vlf-adjust-chunk
vlf-end-pos end nil t vlf-end-pos end nil t
edit-end-pos))))))) (point-max)))))))
(cond ((< vlf-start-pos start) (cond ((< vlf-start-pos start)
(let* ((del-pos (1+ (byte-to-position (let* ((del-pos (1+ (byte-to-position
(- start vlf-start-pos)))) (- start vlf-start-pos))))
(del-len (length (encode-coding-region (del-len (length (encode-coding-region
(point-min) del-pos (point-min) del-pos
buffer-file-coding-system buffer-file-coding-system
t)))) t))))
(setq start (+ vlf-start-pos del-len)) (setq start (+ vlf-start-pos del-len))
(vlf-with-undo-disabled (vlf-with-undo-disabled
(delete-region (point-min) del-pos)))) (delete-region (point-min) del-pos))))
((< start vlf-start-pos) ((< start vlf-start-pos)
(let ((edit-end-pos (point-max))) (let ((edit-end-pos (point-max)))
(goto-char edit-end-pos) (vlf-with-undo-disabled
(vlf-with-undo-disabled (setq shift-start (car (vlf-insert-file-contents
(insert-file-contents buffer-file-name nil start vlf-start-pos
start vlf-start-pos) t nil edit-end-pos)))
(setq shift-start (car (goto-char (point-min))
(vlf-adjust-chunk start (insert (delete-and-extract-region edit-end-pos
vlf-start-pos (point-max)))))))
t nil (setq start (- start shift-start))
edit-end-pos))) (goto-char (or (byte-to-position (- pos start))
(goto-char (point-min)) (byte-to-position (- pos vlf-start-pos))
(insert (delete-and-extract-region edit-end-pos (point-max)))
(point-max))))))) (setq vlf-start-pos start
(setq start (- start shift-start)) vlf-end-pos (+ end shift-end)))
(goto-char (or (byte-to-position (- pos start)) (set-buffer-modified-p modified)
(byte-to-position (- pos vlf-start-pos)) (cons shift-start shift-end))))))
(point-max)))
(setq vlf-start-pos start
vlf-end-pos (+ end shift-end)))
(set-buffer-modified-p modified)
t))))
(defun vlf-move-to-chunk-2 (start end) (defun vlf-move-to-chunk-2 (start end)
"Unconditionally move to chunk determined by START END." "Unconditionally move to chunk determined by START END.
Return number of bytes moved back for proper decoding and number of
bytes added to the end."
(setq vlf-start-pos (max 0 start) (setq vlf-start-pos (max 0 start)
vlf-end-pos (min end vlf-file-size)) vlf-end-pos (min end vlf-file-size))
(let ((inhibit-read-only t) (let (shifts)
(pos (position-bytes (point)))) (let ((inhibit-read-only t)
(vlf-with-undo-disabled (pos (position-bytes (point))))
(erase-buffer) (vlf-with-undo-disabled
(insert-file-contents buffer-file-name nil (erase-buffer)
vlf-start-pos vlf-end-pos) (setq shifts (vlf-insert-file-contents vlf-start-pos
(let ((shifts (vlf-adjust-chunk vlf-start-pos vlf-end-pos t vlf-end-pos t t)
t))) vlf-start-pos (- vlf-start-pos (car shifts))
(setq vlf-start-pos (- vlf-start-pos (car shifts))
vlf-end-pos (+ vlf-end-pos (cdr shifts))) vlf-end-pos (+ vlf-end-pos (cdr shifts)))
(goto-char (or (byte-to-position (+ pos (car shifts))) (goto-char (or (byte-to-position (+ pos (car shifts)))
(point-max)))))) (point-max)))))
(set-buffer-modified-p nil) (set-buffer-modified-p nil)
(set-visited-file-modtime)) (set-visited-file-modtime)
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-start (and adjust-start (not (zerop start)))
adjust-end (and adjust-end (< end vlf-file-size))
position (or position (point-min)))
(let ((shift-start 0)
(shift-end 0))
(if adjust-start
(setq shift-start (vlf-adjust-start start end position
adjust-end)
start (- start shift-start))
(vlf-insert-content-safe start end position))
(if adjust-end
(setq shift-end (vlf-adjust-end start end position)))
(cons shift-start shift-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* ((shift 0)
(min-end (min end (+ start vlf-min-chunk-size)))
(chunk-size (- min-end start))
(strict (and (not adjust-end) (= min-end end))))
(vlf-insert-content-safe start min-end position)
(while (and (not (zerop start))
(< shift 3)
(or (= position (point-max))
(let ((diff (- chunk-size
(length
(encode-coding-region
position (point-max)
buffer-file-coding-system t)))))
(and (not (zerop diff))
(cond (strict t)
(vlf-partial-decode-shown
(or (< diff -3) (< 0 diff)))
(t (or (< diff 0) (< 3 diff))))))))
(setq shift (1+ shift)
start (1- start)
chunk-size (1+ chunk-size))
(delete-region position (point-max))
(vlf-insert-content-safe start min-end position))
(unless (= min-end end)
(delete-region position (point-max))
(insert-file-contents buffer-file-name nil start end))
shift))
(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)
(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))
(if vlf-partial-decode-shown
(let ((chunk-size (- end start)))
(goto-char (point-max))
(while (and (< end vlf-file-size)
(< shift 3)
(or (= position (point-max))
(if vlf-partial-decode-shown
(eq (char-charset (preceding-char))
'eight-bit))
(/= chunk-size
(length (encode-coding-region
position (point-max)
buffer-file-coding-system
t)))))
(setq shift (1+ shift)
end (1+ end)
chunk-size (1+ chunk-size))
(delete-region position (point-max))
(vlf-insert-content-safe start end position))))
shift))
(defun vlf-insert-content-safe (start end position)
"Insert file content from absolute START to END of file at\
POSITION. Clean up if no characters are inserted."
(goto-char position)
(let ((tiny (and (not vlf-partial-decode-shown)
(< (- end start) 4))))
(if tiny (insert "|"))
(cond ((zerop (cadr (insert-file-contents buffer-file-name
nil start end)))
(delete-region position (point-max)))
(tiny (delete-region position (1+ position))))))
(defun vlf-adjust-chunk (start end &optional adjust-start adjust-end (defun vlf-adjust-chunk (start end &optional adjust-start adjust-end
position) position)
@ -542,6 +651,8 @@ properly decoded. ADJUST-START determines if trying to prepend bytes\
Use buffer POSITION as start if given. Use buffer POSITION as start if given.
Return number of bytes moved back for proper decoding and number of Return number of bytes moved back for proper decoding and number of
bytes added to the end." bytes added to the end."
(if position (goto-char position))
(insert-file-contents buffer-file-name nil start end)
(let ((shift-start 0) (let ((shift-start 0)
(shift-end 0)) (shift-end 0))
(if adjust-start (if adjust-start
@ -612,7 +723,8 @@ This seems to be the case with GNU/Emacs before 24.4."
(vlf-move-to-batch (- current-pos half-batch)) (vlf-move-to-batch (- current-pos half-batch))
(and (< half-batch current-pos) (and (< half-batch current-pos)
(< half-batch (- vlf-file-size current-pos)) (< half-batch (- vlf-file-size current-pos))
(goto-char (byte-to-position half-batch))))))) (goto-char (byte-to-position (- current-pos
vlf-start-pos))))))))
(defun vlf-stop-following () (defun vlf-stop-following ()
"Stop continuous recenter." "Stop continuous recenter."