m00natic pushed a commit to branch master
in repository elpa.
commit 9c4e6a53214392f76aac93e20bfc9d6671d5b070
Author: Andrey Kotlarski <m00nati...@gmail.com>
Date: Sat Sep 20 19:06:29 2014 +0300
* packages/vlf: Version 1.6. Automatically tune batch size to
improve user experience and performance for batch operations.
* vlf-tune.el: New profile and tune module.
* vlf.el (vlf-next-batch, vlf-prev-batch, vlf-set-batch-size)
(vlf-beginning-of-file, vlf-end-of-file, vlf-jump-to-chunk): Auto
tune batch size.
* vlf-write.el (vlf-write): Profile, tune batch size and time
save when adjusting file content.
(vlf-file-shift-back, vlf-shift-batch, vlf-file-shift-forward)
(vlf-shift-batches): Profile and tune batch size.
* vlf-search.el (vlf-re-search): Auto tune batch size and
use outside progress reporter if provided.
(vlf-goto-match): Time search.
(vlf-re-search-forward, vlf-re-search-backward): Minimize search
overlap and restore batch size if search failed.
(vlf-goto-line): Profile operations, tune batch size and time
whole search.
* vlf-occur.el (vlf-occur-visit): Profile hexl operations.
(vlf-occur-other-buffer): New function.
(vlf-occur): Auto tune batch size.
(vlf-build-occur): Auto tune batch size and time whole occur.
* vlf-base.el (vlf-move-to-chunk-1, vlf-move-to-chunk-2)
(vlf-insert-file-contents-1, vlf-delete-region): Profile primitive
operations.
(vlf-shift-undo-list): Ignore null undo list.
---
packages/vlf/vlf-base.el | 38 ++---
packages/vlf/vlf-occur.el | 141 ++++++++++-----
packages/vlf/vlf-search.el | 118 ++++++++-----
packages/vlf/vlf-tune.el | 423 ++++++++++++++++++++++++++++++++++++++++++++
packages/vlf/vlf-write.el | 97 ++++++----
packages/vlf/vlf.el | 27 +++-
6 files changed, 682 insertions(+), 162 deletions(-)
diff --git a/packages/vlf/vlf-base.el b/packages/vlf/vlf-base.el
index 30e9b27..f568202 100644
--- a/packages/vlf/vlf-base.el
+++ b/packages/vlf/vlf-base.el
@@ -27,10 +27,7 @@
;;; Code:
-(defcustom vlf-batch-size 1000000
- "Defines how large each batch of file data initially is (in bytes)."
- :group 'vlf :type 'integer)
-(put 'vlf-batch-size 'permanent-local t)
+(require 'vlf-tune)
(defcustom vlf-before-chunk-update nil
"Hook that runs before chunk update."
@@ -50,10 +47,6 @@
(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.")
@@ -133,11 +126,10 @@ bytes added to the end."
(setq restore-hexl t
hexl-undo-list buffer-undo-list
buffer-undo-list t)
- (hexl-mode-exit))
+ (vlf-tune-dehexlify))
(+ vlf-start-pos
- (length (encode-coding-region
- (point-min) (point-max)
- buffer-file-coding-system t))))
+ (vlf-tune-encode-length (point-min)
+ (point-max))))
vlf-end-pos))
(shifts
(cond
@@ -161,7 +153,7 @@ bytes added to the end."
(when (and hexl (not restore-hexl))
(if (consp buffer-undo-list)
(setq buffer-undo-list nil))
- (hexl-mode-exit))
+ (vlf-tune-dehexlify))
(let ((shift-start 0)
(shift-end 0))
(let ((pos (+ (position-bytes (point)) vlf-start-pos))
@@ -224,12 +216,12 @@ bytes added to the end."
(set-buffer-modified-p modified)
(set-visited-file-modtime)
(when hexl
- (hexl-mode)
+ (vlf-tune-hexlify)
(setq restore-hexl nil))
(run-hooks 'vlf-after-chunk-update)
(cons shift-start shift-end))))))
(when restore-hexl
- (hexl-mode)
+ (vlf-tune-hexlify)
(setq buffer-undo-list hexl-undo-list))
shifts))
@@ -252,7 +244,7 @@ bytes added to the end."
vlf-end-pos t t)
vlf-start-pos (- vlf-start-pos (car shifts))
vlf-end-pos (+ vlf-end-pos (cdr shifts)))
- (if hexl (hexl-mode)))
+ (if hexl (vlf-tune-hexlify)))
(goto-char (or (byte-to-position (+ pos (car shifts)))
(point-max)))))
(set-buffer-modified-p nil)
@@ -293,7 +285,7 @@ bytes added to the 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))
+ (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\
@@ -345,12 +337,10 @@ which deletion was performed."
(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)
@@ -378,7 +368,7 @@ which deletion was performed."
(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))
diff --git a/packages/vlf/vlf-occur.el b/packages/vlf/vlf-occur.el
index 2dac4a4..a41f448 100644
--- a/packages/vlf/vlf-occur.el
+++ b/packages/vlf/vlf-occur.el
@@ -124,7 +124,7 @@ EVENT may hold details of the invocation."
pos-relative)))
(cond (current-prefix-arg
(setq vlf-buffer (vlf file t))
- (or not-hexl (hexl-mode))
+ (or not-hexl (vlf-tune-hexlify))
(switch-to-buffer occur-buffer))
((not (buffer-live-p vlf-buffer))
(unless (catch 'found
@@ -137,72 +137,109 @@ EVENT may hold details of the invocation."
(setq vlf-buffer buf)
(throw 'found t))))
(setq vlf-buffer (vlf file t))
- (or not-hexl (hexl-mode)))
+ (or not-hexl (vlf-tune-hexlify)))
(switch-to-buffer occur-buffer)
(setq vlf-occur-vlf-buffer vlf-buffer)))
(pop-to-buffer vlf-buffer)
(vlf-move-to-chunk chunk-start chunk-end)
(goto-char match-pos)))))
+(defun vlf-occur-other-buffer (regexp)
+ "Make whole file occur style index for REGEXP branching to new buffer.
+Prematurely ending indexing will still show what's found so far."
+ (let ((vlf-buffer (current-buffer))
+ (file buffer-file-name)
+ (batch-size vlf-batch-size)
+ (is-hexl (derived-mode-p 'hexl-mode))
+ (insert-bps vlf-tune-insert-bps)
+ (encode-bps vlf-tune-encode-bps)
+ (hexl-bps vlf-tune-hexl-bps)
+ (dehexlify-bps vlf-tune-dehexlify-bps))
+ (with-temp-buffer
+ (setq buffer-file-name file
+ buffer-file-truename file
+ buffer-undo-list t)
+ (set-buffer-modified-p nil)
+ (set (make-local-variable 'vlf-batch-size) batch-size)
+ (when vlf-tune-enabled
+ (setq vlf-tune-insert-bps insert-bps
+ vlf-tune-encode-bps encode-bps)
+ (if is-hexl
+ (progn (setq vlf-tune-hexl-bps hexl-bps
+ vlf-tune-dehexlify-bps dehexlify-bps)
+ (vlf-tune-batch '(:hexl :dehexlify :insert :encode)))
+ (vlf-tune-batch '(:insert :encode))))
+ (vlf-mode 1)
+ (if is-hexl (vlf-tune-hexlify))
+ (goto-char (point-min))
+ (vlf-with-undo-disabled
+ (vlf-build-occur regexp vlf-buffer))
+ (when vlf-tune-enabled
+ (setq insert-bps vlf-tune-insert-bps
+ encode-bps vlf-tune-encode-bps)
+ (if is-hexl
+ (setq insert-bps vlf-tune-insert-bps
+ encode-bps vlf-tune-encode-bps))))
+ (when vlf-tune-enabled ;merge back tune measurements
+ (setq vlf-tune-insert-bps insert-bps
+ vlf-tune-encode-bps encode-bps)
+ (if is-hexl
+ (setq vlf-tune-insert-bps insert-bps
+ vlf-tune-encode-bps encode-bps)))))
+
(defun vlf-occur (regexp)
"Make whole file occur style index for REGEXP.
Prematurely ending indexing will still show what's found so far."
(interactive (list (read-regexp "List lines matching regexp"
(if regexp-history
(car regexp-history)))))
- (if (buffer-modified-p) ;use temporary buffer not to interfere with
modifications
- (let ((vlf-buffer (current-buffer))
- (file buffer-file-name)
- (batch-size vlf-batch-size)
- (is-hexl (derived-mode-p 'hexl-mode)))
- (with-temp-buffer
- (setq buffer-file-name file
- buffer-file-truename file
- buffer-undo-list t)
- (set-buffer-modified-p nil)
- (set (make-local-variable 'vlf-batch-size) batch-size)
- (vlf-mode 1)
- (if is-hexl
- (hexl-mode))
- (run-hook-with-args 'vlf-before-batch-functions 'occur)
- (goto-char (point-min))
- (vlf-with-undo-disabled
- (vlf-build-occur regexp vlf-buffer))
- (run-hook-with-args 'vlf-after-batch-functions 'occur)))
- (run-hook-with-args 'vlf-before-batch-functions 'occur)
+ (run-hook-with-args 'vlf-before-batch-functions 'occur)
+ (if (or (buffer-modified-p)
+ (< vlf-batch-size vlf-start-pos))
+ (vlf-occur-other-buffer regexp)
(let ((start-pos vlf-start-pos)
(end-pos vlf-end-pos)
- (pos (point)))
+ (pos (point))
+ (batch-size vlf-batch-size)
+ (is-hexl (derived-mode-p 'hexl-mode)))
+ (vlf-tune-batch (if (derived-mode-p 'hexl-mode)
+ '(:hexl :dehexlify :insert :encode)
+ '(:insert :encode)))
(vlf-with-undo-disabled
- (vlf-beginning-of-file)
+ (vlf-move-to-batch 0)
(goto-char (point-min))
(unwind-protect (vlf-build-occur regexp (current-buffer))
(vlf-move-to-chunk start-pos end-pos)
- (goto-char pos))))
- (run-hook-with-args 'vlf-after-batch-functions 'occur)))
+ (if is-hexl (vlf-tune-hexlify))
+ (goto-char pos)
+ (setq vlf-batch-size batch-size)))))
+ (run-hook-with-args 'vlf-after-batch-functions 'occur))
(defun vlf-build-occur (regexp vlf-buffer)
"Build occur style index for REGEXP over VLF-BUFFER."
- (let ((tramp-verbose (if (boundp 'tramp-verbose)
- (min tramp-verbose 2)))
- (case-fold-search t)
- (line 1)
- (last-match-line 0)
- (last-line-pos (point-min))
- (total-matches 0)
- (match-end-pos (+ vlf-start-pos (position-bytes (point))))
- (occur-buffer (generate-new-buffer
- (concat "*VLF-occur " (file-name-nondirectory
- buffer-file-name)
- "*")))
- (line-regexp (concat "\\(?5:[\n\C-m]\\)\\|\\(?10:"
- regexp "\\)"))
- (batch-step (/ vlf-batch-size 8))
- (is-hexl (derived-mode-p 'hexl-mode))
- (end-of-file nil)
- (reporter (make-progress-reporter
- (concat "Building index for " regexp "...")
- vlf-start-pos vlf-file-size)))
+ (let* ((tramp-verbose (if (boundp 'tramp-verbose)
+ (min tramp-verbose 2)))
+ (case-fold-search t)
+ (line 1)
+ (last-match-line 0)
+ (last-line-pos (point-min))
+ (total-matches 0)
+ (match-end-pos (+ vlf-start-pos (position-bytes (point))))
+ (occur-buffer (generate-new-buffer
+ (concat "*VLF-occur " (file-name-nondirectory
+ buffer-file-name)
+ "*")))
+ (line-regexp (concat "\\(?5:[\n\C-m]\\)\\|\\(?10:"
+ regexp "\\)"))
+ (batch-step (min 1024 (/ vlf-batch-size 8)))
+ (is-hexl (derived-mode-p 'hexl-mode))
+ (end-of-file nil)
+ (time (float-time))
+ (tune-types (if is-hexl '(:hexl :dehexlify :insert :encode)
+ '(:insert :encode)))
+ (reporter (make-progress-reporter
+ (concat "Building index for " regexp "...")
+ vlf-start-pos vlf-file-size)))
(with-current-buffer occur-buffer
(setq buffer-undo-list t))
(unwind-protect
@@ -255,6 +292,7 @@ Prematurely ending indexing will still show what's found so
far."
total-matches))))))))
(setq end-of-file (= vlf-end-pos vlf-file-size))
(unless end-of-file
+ (vlf-tune-batch tune-types)
(let ((batch-move (- vlf-end-pos batch-step)))
(vlf-move-to-batch (if (or is-hexl
(< match-end-pos
@@ -274,7 +312,8 @@ Prematurely ending indexing will still show what's found so
far."
(set-buffer-modified-p nil)
(if (zerop total-matches)
(progn (kill-buffer occur-buffer)
- (message "No matches for \"%s\"" regexp))
+ (message "No matches for \"%s\" (%f secs)"
+ regexp (- (float-time) time)))
(let ((file buffer-file-name)
(dir default-directory))
(with-current-buffer occur-buffer
@@ -292,10 +331,12 @@ in file: %s" total-matches line regexp file)
vlf-occur-regexp regexp
vlf-occur-hexl is-hexl
vlf-occur-lines line)))
- (display-buffer occur-buffer)))))
-
+ (display-buffer occur-buffer)
+ (message "Occur finished for \"%s\" (%f secs)"
+ regexp (- (float-time) time))))))
-;; save, load vlf-occur data
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; save, load vlf-occur data
(defun vlf-occur-save (file)
"Serialize `vlf-occur' results to FILE which can later be reloaded."
diff --git a/packages/vlf/vlf-search.el b/packages/vlf/vlf-search.el
index 3b81d57..33dcc42 100644
--- a/packages/vlf/vlf-search.el
+++ b/packages/vlf/vlf-search.el
@@ -29,12 +29,22 @@
(require 'vlf)
-(defun vlf-re-search (regexp count backward batch-step)
+(defun vlf-re-search (regexp count backward batch-step
+ &optional reporter time)
"Search for REGEXP COUNT number of times forward or BACKWARD.
-BATCH-STEP is amount of overlap between successive chunks."
+BATCH-STEP is amount of overlap between successive chunks.
+Use existing REPORTER and start TIME if given.
+Return t if search has been at least partially successful."
(if (<= count 0)
(error "Count must be positive"))
(run-hook-with-args 'vlf-before-batch-functions 'search)
+ (or reporter (setq reporter (make-progress-reporter
+ (concat "Searching for " regexp "...")
+ (if backward
+ (- vlf-file-size vlf-end-pos)
+ vlf-start-pos)
+ vlf-file-size)))
+ (or time (setq time (float-time)))
(let* ((tramp-verbose (if (boundp 'tramp-verbose)
(min tramp-verbose 2)))
(case-fold-search t)
@@ -44,13 +54,9 @@ BATCH-STEP is amount of overlap between successive chunks."
(match-end-pos match-start-pos)
(to-find count)
(is-hexl (derived-mode-p 'hexl-mode))
- (font-lock font-lock-mode)
- (reporter (make-progress-reporter
- (concat "Searching for " regexp "...")
- (if backward
- (- vlf-file-size vlf-end-pos)
- vlf-start-pos)
- vlf-file-size)))
+ (tune-types (if is-hexl '(:hexl :dehexlify :insert :encode)
+ '(:insert :encode)))
+ (font-lock font-lock-mode))
(font-lock-mode 0)
(vlf-with-undo-disabled
(unwind-protect
@@ -69,7 +75,8 @@ BATCH-STEP is amount of overlap between successive chunks."
(match-end 0)))))
((zerop vlf-start-pos)
(throw 'end-of-file nil))
- (t (let ((batch-move (- vlf-start-pos
+ (t (vlf-tune-batch tune-types)
+ (let ((batch-move (- vlf-start-pos
(- vlf-batch-size
batch-step))))
(vlf-move-to-batch
@@ -82,9 +89,9 @@ BATCH-STEP is amount of overlap between successive chunks."
match-start-pos))
(point-max)
(or (byte-to-position
- (- match-start-pos
- vlf-start-pos))
- (point-max))))
+ (- match-start-pos
+ vlf-start-pos))
+ (point-max))))
(progress-reporter-update
reporter (- vlf-file-size
vlf-start-pos)))))
@@ -101,7 +108,8 @@ BATCH-STEP is amount of overlap between successive chunks."
(match-end 0)))))
((= vlf-end-pos vlf-file-size)
(throw 'end-of-file nil))
- (t (let ((batch-move (- vlf-end-pos batch-step)))
+ (t (vlf-tune-batch tune-types)
+ (let ((batch-move (- vlf-end-pos batch-step)))
(vlf-move-to-batch
(if (or is-hexl
(< match-end-pos batch-move))
@@ -111,42 +119,49 @@ BATCH-STEP is amount of overlap between successive
chunks."
(<= match-end-pos vlf-start-pos))
(point-min)
(or (byte-to-position
- (- match-end-pos
- vlf-start-pos))
- (point-min))))
+ (- match-end-pos
+ vlf-start-pos))
+ (point-min))))
(progress-reporter-update reporter
vlf-end-pos)))))
(progress-reporter-done reporter))
(set-buffer-modified-p nil)
+ (if is-hexl (vlf-tune-hexlify))
(if font-lock (font-lock-mode 1))
- (if backward
- (vlf-goto-match match-chunk-start match-chunk-end
- match-end-pos match-start-pos
- count to-find)
- (vlf-goto-match match-chunk-start match-chunk-end
- match-start-pos match-end-pos
- count to-find))
- (run-hook-with-args 'vlf-after-batch-functions 'search)))))
+ (let ((result
+ (if backward
+ (vlf-goto-match match-chunk-start match-chunk-end
+ match-end-pos match-start-pos
+ count to-find time)
+ (vlf-goto-match match-chunk-start match-chunk-end
+ match-start-pos match-end-pos
+ count to-find time))))
+ (run-hook-with-args 'vlf-after-batch-functions 'search)
+ result)))))
(defun vlf-goto-match (match-chunk-start match-chunk-end
- match-pos-start
- match-pos-end
- count to-find)
+ match-pos-start match-pos-end
+ count to-find time)
"Move to MATCH-CHUNK-START MATCH-CHUNK-END surrounding\
MATCH-POS-START and MATCH-POS-END.
According to COUNT and left TO-FIND, show if search has been
-successful. Return nil if nothing found."
+successful. Use start TIME to report how much it took.
+Return nil if nothing found."
(if (= count to-find)
(progn (vlf-move-to-chunk match-chunk-start match-chunk-end)
(goto-char (or (byte-to-position (- match-pos-start
vlf-start-pos))
(point-max)))
- (message "Not found")
+ (message "Not found (%f secs)" (- (float-time) time))
nil)
(let ((success (zerop to-find)))
(if success
(vlf-update-buffer-name)
(vlf-move-to-chunk match-chunk-start match-chunk-end))
+ (setq vlf-batch-size (vlf-tune-optimal-load
+ (if (derived-mode-p 'hexl-mode)
+ '(:hexl :dehexlify :insert :encode)
+ '(:insert :encode))))
(let* ((match-end (or (byte-to-position (- match-pos-end
vlf-start-pos))
(point-max)))
@@ -155,10 +170,11 @@ successful. Return nil if nothing found."
vlf-start-pos))
match-end)))
(overlay-put overlay 'face 'match)
- (unless success
+ (if success
+ (message "Match found (%f secs)" (- (float-time) time))
(goto-char match-end)
- (message "Moved to the %d match which is last"
- (- count to-find)))
+ (message "Moved to the %d match which is last (%f secs)"
+ (- count to-find) (- (float-time) time)))
(unwind-protect (sit-for 3)
(delete-overlay overlay))
t))))
@@ -171,7 +187,9 @@ Search is performed chunk by chunk in `vlf-batch-size'
memory."
(if regexp-history
(car regexp-history)))
(or current-prefix-arg 1))))
- (vlf-re-search regexp count nil (/ vlf-batch-size 8)))
+ (let ((batch-size vlf-batch-size))
+ (or (vlf-re-search regexp count nil (min 1024 (/ vlf-batch-size 8)))
+ (setq vlf-batch-size batch-size))))
(defun vlf-re-search-backward (regexp count)
"Search backward for REGEXP prefix COUNT number of times.
@@ -181,7 +199,9 @@ Search is performed chunk by chunk in `vlf-batch-size'
memory."
(if regexp-history
(car regexp-history)))
(or current-prefix-arg 1))))
- (vlf-re-search regexp count t (/ vlf-batch-size 8)))
+ (let ((batch-size vlf-batch-size))
+ (or (vlf-re-search regexp count t (min 1024 (/ vlf-batch-size 8)))
+ (setq vlf-batch-size batch-size))))
(defun vlf-goto-line (n)
"Go to line N. If N is negative, count from the end of file."
@@ -193,11 +213,14 @@ Search is performed chunk by chunk in `vlf-batch-size'
memory."
(min tramp-verbose 2)))
(start-pos vlf-start-pos)
(end-pos vlf-end-pos)
+ (batch-size vlf-batch-size)
(pos (point))
(is-hexl (derived-mode-p 'hexl-mode))
(font-lock font-lock-mode)
+ (time (float-time))
(success nil))
(font-lock-mode 0)
+ (vlf-tune-batch '(:raw))
(unwind-protect
(if (< 0 n)
(let ((start 0)
@@ -213,20 +236,24 @@ Search is performed chunk by chunk in `vlf-batch-size'
memory."
(while (and (< (- end start) n)
(< n (- vlf-file-size start)))
(erase-buffer)
- (insert-file-contents-literally buffer-file-name
- nil start end)
+ (vlf-tune-insert-file-contents-literally start end)
(goto-char (point-min))
(while (re-search-forward "[\n\C-m]" nil t)
(setq n (1- n)))
(vlf-verify-size)
+ (vlf-tune-batch '(:raw))
(setq start end
end (min vlf-file-size
(+ start vlf-batch-size)))
(progress-reporter-update reporter start)))
(when (< n (- vlf-file-size end))
- (vlf-move-to-chunk-2 start end)
+ (vlf-tune-batch (if is-hexl
+ '(:hexl :dehexlify :insert :encode)
+ '(:insert :encode)))
+ (vlf-move-to-chunk-2 start (+ start vlf-batch-size))
(goto-char (point-min))
- (setq success (vlf-re-search "[\n\C-m]" n nil 0)))))
+ (setq success (vlf-re-search "[\n\C-m]" n nil 0
+ reporter time)))))
(let ((start (max 0 (- vlf-file-size vlf-batch-size)))
(end vlf-file-size)
(reporter (make-progress-reporter
@@ -239,25 +266,30 @@ Search is performed chunk by chunk in `vlf-batch-size'
memory."
(or is-hexl
(while (and (< (- end start) n) (< n end))
(erase-buffer)
- (insert-file-contents-literally buffer-file-name
- nil start end)
+ (vlf-tune-insert-file-contents-literally start end)
(goto-char (point-max))
(while (re-search-backward "[\n\C-m]" nil t)
(setq n (1- n)))
+ (vlf-tune-batch '(:raw))
(setq end start
start (max 0 (- end vlf-batch-size)))
(progress-reporter-update reporter
(- vlf-file-size end))))
(when (< n end)
- (vlf-move-to-chunk-2 start end)
+ (vlf-tune-batch (if is-hexl
+ '(:hexl :dehexlify :insert :encode)
+ '(:insert :encode)))
+ (vlf-move-to-chunk-2 (- end vlf-batch-size) end)
(goto-char (point-max))
- (setq success (vlf-re-search "[\n\C-m]" n t 0))))))
+ (setq success (vlf-re-search "[\n\C-m]" n t 0
+ reporter time))))))
(if font-lock (font-lock-mode 1))
(unless success
(vlf-with-undo-disabled
(vlf-move-to-chunk-2 start-pos end-pos))
(vlf-update-buffer-name)
(goto-char pos)
+ (setq vlf-batch-size batch-size)
(message "Unable to find line"))
(run-hook-with-args 'vlf-after-batch-functions 'goto-line))))
diff --git a/packages/vlf/vlf-tune.el b/packages/vlf/vlf-tune.el
new file mode 100644
index 0000000..adf8468
--- /dev/null
+++ b/packages/vlf/vlf-tune.el
@@ -0,0 +1,423 @@
+;;; vlf-tune.el --- VLF tuning operations -*- lexical-binding: t -*-
+
+;; Copyright (C) 2014 Free Software Foundation, Inc.
+
+;; Keywords: large files, batch size, performance
+;; Author: Andrey Kotlarski <m00nati...@gmail.com>
+;; URL: https://github.com/m00natic/vlfi
+
+;; This file is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 3, or (at your option)
+;; any later version.
+
+;; This file is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING. If not, write to
+;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+;; This package provides wrappers for basic chunk operations that add
+;; profiling and automatic tuning of `vlf-batch-size'.
+
+;;; Code:
+
+(defgroup vlf nil "View Large Files in Emacs."
+ :prefix "vlf-" :group 'files)
+
+(defcustom vlf-batch-size 1000000
+ "Defines how large each batch of file data initially is (in bytes)."
+ :group 'vlf :type 'integer)
+(put 'vlf-batch-size 'permanent-local t)
+
+(defcustom vlf-tune-enabled t
+ "Whether to allow automatic change of batch size.
+If nil, completely disable. If `stats', maintain measure statistics,
+but don't change batch size. If t, measure and change."
+ :group 'vlf :type '(choice (const :tag "Enabled" t)
+ (const :tag "Just statistics" stats)
+ (const :tag "Disabled" nil)))
+
+(defvar vlf-file-size 0 "Total size in bytes of presented file.")
+(make-variable-buffer-local 'vlf-file-size)
+(put 'vlf-file-size 'permanent-local t)
+
+(defun vlf-tune-ram-size ()
+ "Try to determine RAM size in bytes."
+ (if (executable-find "free")
+ (let* ((free (shell-command-to-string "free"))
+ (match-from (string-match "[[:digit:]]+" free)))
+ (if match-from
+ (* 1000 (string-to-number (substring free match-from
+ (match-end 0))))))))
+
+(defcustom vlf-tune-max (let ((ram-size (vlf-tune-ram-size)))
+ (if ram-size
+ (/ ram-size 20)
+ large-file-warning-threshold))
+ "Maximum batch size in bytes when auto tuning."
+ :group 'vlf :type 'integer)
+
+(defcustom vlf-tune-step (/ vlf-tune-max 1000)
+ "Step used for tuning in bytes."
+ :group 'vlf :type 'integer)
+
+(defcustom vlf-tune-load-time 1.0
+ "How many seconds should batch take to load for best user experience."
+ :group 'vlf :type 'float)
+
+(defvar vlf-tune-insert-bps nil
+ "Vector of bytes per second insert measurements.")
+(make-variable-buffer-local 'vlf-tune-insert-bps)
+(put 'vlf-tune-insert-bps 'permanent-local t)
+
+(defvar vlf-tune-insert-raw-bps nil
+ "Vector of bytes per second non-decode insert measurements.")
+(make-variable-buffer-local 'vlf-tune-insert-raw-bps)
+(put 'vlf-tune-insert-raw-bps 'permanent-local t)
+
+(defvar vlf-tune-encode-bps nil
+ "Vector of bytes per second encode measurements.")
+(make-variable-buffer-local 'vlf-tune-encode-bps)
+(put 'vlf-tune-encode-bps 'permanent-local t)
+
+(defvar vlf-tune-write-bps nil
+ "Vector of bytes per second write measurements.")
+(make-variable-buffer-local 'vlf-tune-write-bps)
+(put 'vlf-tune-write-bps 'permanent-local t)
+
+(defvar vlf-tune-hexl-bps nil
+ "Vector of bytes per second hexlify measurements.")
+(make-variable-buffer-local 'vlf-tune-hexl-bps)
+(put 'vlf-tune-hexl-bps 'permanent-local t)
+
+(defvar vlf-tune-dehexlify-bps nil
+ "Vector of bytes per second dehexlify measurements.")
+(make-variable-buffer-local 'vlf-tune-dehexlify-bps)
+(put 'vlf-tune-dehexlify-bps 'permanent-local t)
+
+(defun vlf-tune-closest-index (size)
+ "Get closest measurement index corresponding to SIZE."
+ (let ((step (float vlf-tune-step)))
+ (max 0 (1- (min (round size step) (round vlf-tune-max step))))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; profiling
+
+(defun vlf-tune-initialize-measurement ()
+ "Initialize measurement vector."
+ (make-local-variable 'vlf-tune-max)
+ (make-local-variable 'vlf-tune-step)
+ (make-vector (/ vlf-tune-max vlf-tune-step) nil))
+
+(defmacro vlf-tune-add-measurement (vec size time)
+ "Add at an appropriate position in VEC new SIZE TIME measurement.
+VEC is a vector of (mean time . count) elements ordered by size."
+ `(when (and vlf-tune-enabled (not (zerop ,size)))
+ (or ,vec (setq ,vec (vlf-tune-initialize-measurement)))
+ (let* ((idx (vlf-tune-closest-index ,size))
+ (existing (aref ,vec idx)))
+ (aset ,vec idx (if (consp existing)
+ (let ((count (1+ (cdr existing)))) ;recalculate mean
+ (cons (/ (+ (* (1- count) (car existing))
+ (/ ,size ,time))
+ count)
+ count))
+ (cons (/ ,size ,time) 1))))))
+
+(defmacro vlf-time (&rest body)
+ "Get timing consed with result of BODY execution."
+ `(if vlf-tune-enabled
+ (let* ((time (float-time))
+ (result (progn ,@body)))
+ (cons (- (float-time) time) result))
+ (let ((result (progn ,@body)))
+ (cons nil result))))
+
+(defun vlf-tune-insert-file-contents (start end)
+ "Extract decoded file bytes START to END and save time it takes."
+ (let ((result (vlf-time (insert-file-contents buffer-file-name
+ nil start end))))
+ (vlf-tune-add-measurement vlf-tune-insert-bps
+ (- end start) (car result))
+ (cdr result)))
+
+(defun vlf-tune-insert-file-contents-literally (start end)
+ "Insert raw file bytes START to END and save time it takes."
+ (let ((result (vlf-time (insert-file-contents-literally
+ buffer-file-name nil start end))))
+ (vlf-tune-add-measurement vlf-tune-insert-raw-bps
+ (- end start) (car result))
+ (cdr result)))
+
+(defun vlf-tune-encode-length (start end)
+ "Get length of encoded region START to END and save time it takes."
+ (let ((result (vlf-time (length (encode-coding-region
+ start end
+ buffer-file-coding-system t)))))
+ (vlf-tune-add-measurement vlf-tune-encode-bps
+ (cdr result) (car result))
+ (cdr result)))
+
+(defun vlf-tune-write (start end append visit size)
+ "Save buffer and save time it takes.
+START, END, APPEND, VISIT have same meaning as in `write-region'.
+SIZE is number of bytes that are saved."
+ (let ((time (car (vlf-time (write-region start end buffer-file-name
+ append visit)))))
+ (vlf-tune-add-measurement vlf-tune-write-bps size time)))
+
+(defun vlf-tune-hexlify ()
+ "Activate `hexl-mode' and save time it takes."
+ (or (derived-mode-p 'hexl-mode)
+ (let ((time (car (vlf-time (hexl-mode)))))
+ (vlf-tune-add-measurement vlf-tune-hexl-bps
+ hexl-max-address time))))
+
+(defun vlf-tune-dehexlify ()
+ "Exit `hexl-mode' and save time it takes."
+ (if (derived-mode-p 'hexl-mode)
+ (let ((time (car (vlf-time (hexl-mode-exit)))))
+ (vlf-tune-add-measurement vlf-tune-dehexlify-bps
+ hexl-max-address time))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; tuning
+
+(defun vlf-tune-approximate-nearby (vec index)
+ "VEC has value for INDEX, approximate to closest available."
+ (let ((val 0)
+ (left-idx (1- index))
+ (right-idx (1+ index))
+ (min-idx (max 0 (- index 5)))
+ (max-idx (min (+ index 6)
+ (1- (/ (min vlf-tune-max
+ (/ (1+ vlf-file-size) 2))
+ vlf-tune-step)))))
+ (while (and (zerop val) (or (<= min-idx left-idx)
+ (< right-idx max-idx)))
+ (if (<= min-idx left-idx)
+ (let ((left (aref vec left-idx)))
+ (cond ((consp left) (setq val (car left)))
+ ((numberp left) (setq val left)))))
+ (if (< right-idx max-idx)
+ (let ((right (aref vec right-idx)))
+ (if (consp right)
+ (setq right (car right)))
+ (and (numberp right) (not (zerop right))
+ (setq val (if (zerop val)
+ right
+ (/ (+ val right) 2))))))
+ (setq left-idx (1- left-idx)
+ right-idx (1+ right-idx)))
+ val))
+
+(defmacro vlf-tune-get-value (vec index &optional dont-approximate)
+ "Get value from VEC for INDEX.
+If missing, approximate from nearby measurement,
+unless DONT-APPROXIMATE is t."
+ `(if ,vec
+ (let ((val (aref ,vec ,index)))
+ (cond ((consp val) (car val))
+ ((null val)
+ ,(if dont-approximate
+ `(aset ,vec ,index 0)
+ `(vlf-tune-approximate-nearby ,vec ,index)))
+ ((zerop val) ;index has been tried before, yet still no value
+ ,(if dont-approximate
+ `(aset ,vec ,index
+ (vlf-tune-approximate-nearby ,vec ,index))
+ `(vlf-tune-approximate-nearby ,vec ,index)))
+ (t val)))))
+
+(defmacro vlf-tune-get-vector (key)
+ "Get vlf-tune vector corresponding to KEY."
+ `(cond ((eq ,key :insert) vlf-tune-insert-bps)
+ ((eq ,key :raw) vlf-tune-insert-raw-bps)
+ ((eq ,key :encode) vlf-tune-encode-bps)
+ ((eq ,key :write) vlf-tune-write-bps)
+ ((eq ,key :hexl) vlf-tune-hexl-bps)
+ ((eq ,key :dehexlify) vlf-tune-dehexlify-bps)))
+
+(defun vlf-tune-assess (type coef index &optional approximate)
+ "Get measurement value according to TYPE, COEF and INDEX.
+If APPROXIMATE is t, do approximation for missing values."
+ (* coef (or (if approximate
+ (vlf-tune-get-value (vlf-tune-get-vector type)
+ index)
+ (vlf-tune-get-value (vlf-tune-get-vector type)
+ index t))
+ 0)))
+
+(defun vlf-tune-score (types index &optional approximate time-max)
+ "Calculate cumulative speed over TYPES for INDEX.
+If APPROXIMATE is t, do approximation for missing values.
+If TIME-MAX is non nil, return cumulative time instead of speed.
+If it is number, stop as soon as cumulative time gets equal or above."
+ (catch 'result
+ (let ((time 0)
+ (size (* (1+ index) vlf-tune-step))
+ (cut-time (numberp time-max)))
+ (dolist (el types (if time-max time
+ (/ size time)))
+ (let ((bps (if (consp el)
+ (vlf-tune-assess (car el) (cadr el) index
+ approximate)
+ (vlf-tune-assess el 1 index approximate))))
+ (if (zerop bps)
+ (throw 'result nil)
+ (setq time (+ time (/ size bps)))
+ (and cut-time (<= time-max time)
+ (throw 'result nil))))))))
+
+(defun vlf-tune-conservative (types &optional index)
+ "Adjust `vlf-batch-size' to best nearby value over TYPES.
+INDEX if given, specifies search independent of current batch size."
+ (if (eq vlf-tune-enabled t)
+ (let* ((half-max (/ (1+ vlf-file-size) 2))
+ (idx (or index (vlf-tune-closest-index vlf-batch-size)))
+ (curr (if (< half-max (* idx vlf-tune-step)) t
+ (vlf-tune-score types idx))))
+ (if curr
+ (let ((prev (if (zerop idx) t
+ (vlf-tune-score types (1- idx)))))
+ (if prev
+ (let ((next (if (or (eq curr t)
+ (< half-max (* (1+ idx)
+ vlf-tune-step)))
+ t
+ (vlf-tune-score types (1+ idx)))))
+ (cond ((null next)
+ (setq vlf-batch-size (* (+ 2 idx)
+ vlf-tune-step)))
+ ((eq curr t)
+ (or (eq prev t)
+ (setq vlf-batch-size
+ (* idx vlf-tune-step))))
+ (t (let ((best-idx idx))
+ (and (numberp prev) (< curr prev)
+ (setq curr prev
+ best-idx (1- idx)))
+ (and (numberp next) (< curr next)
+ (setq best-idx (1+ idx)))
+ (setq vlf-batch-size
+ (* (1+ best-idx)
+ vlf-tune-step))))))
+ (setq vlf-batch-size (* idx vlf-tune-step))))
+ (setq vlf-batch-size (* (1+ idx) vlf-tune-step))))))
+
+(defun vlf-tune-binary (types min max)
+ "Adjust `vlf-batch-size' to optimal value using binary search, \
+optimizing over TYPES.
+MIN and MAX specify interval of indexes to search."
+ (let ((sum (+ min max)))
+ (if (< (- max min) 3)
+ (vlf-tune-conservative types (/ sum 2))
+ (let* ((left-idx (round (+ sum (* 2 min)) 4))
+ (left (vlf-tune-score types left-idx)))
+ (if left
+ (let* ((right-idx (round (+ sum (* 2 max)) 4))
+ (right (vlf-tune-score types right-idx)))
+ (cond ((null right)
+ (setq vlf-batch-size (* (1+ right-idx)
+ vlf-tune-step)))
+ ((< left right)
+ (vlf-tune-binary types (/ (1+ sum) 2) max))
+ (t (vlf-tune-binary types min (/ sum 2)))))
+ (setq vlf-batch-size (* (1+ left-idx) vlf-tune-step)))))))
+
+(defun vlf-tune-linear (types max-idx)
+ "Adjust `vlf-batch-size' to optimal value using linear search, \
+optimizing over TYPES up to MAX-IDX."
+ (let ((best-idx 0)
+ (best-bps 0)
+ (idx 0)
+ (none-missing t))
+ (while (and none-missing (< idx max-idx))
+ (let ((bps (vlf-tune-score types idx)))
+ (cond ((null bps)
+ (setq vlf-batch-size (* (1+ idx) vlf-tune-step)
+ none-missing nil))
+ ((< best-bps bps) (setq best-idx idx
+ best-bps bps))))
+ (setq idx (1+ idx)))
+ (or (not none-missing)
+ (setq vlf-batch-size (* (1+ best-idx) vlf-tune-step)))))
+
+(defun vlf-tune-batch (types &optional linear)
+ "Adjust `vlf-batch-size' to optimal value optimizing on TYPES.
+TYPES is alist of elements that may be of form (type coef) or
+non list values in which case coeficient is assumed 1.
+Types can be :insert, :raw, :encode, :write, :hexl or :dehexlify.
+If LINEAR is non nil, use brute-force. In case requested measurement
+is missing, stop search and set `vlf-batch-size' to this value.
+Suitable for multiple batch operations."
+ (if (eq vlf-tune-enabled t)
+ (let ((max-idx (1- (/ (min vlf-tune-max
+ (/ (1+ vlf-file-size) 2))
+ vlf-tune-step))))
+ (cond (linear (vlf-tune-linear types max-idx))
+ ((file-remote-p buffer-file-name)
+ (vlf-tune-conservative types))
+ ((<= 1 max-idx)
+ (if (< max-idx 3)
+ (vlf-tune-conservative types (/ max-idx 2))
+ (vlf-tune-binary types 0 max-idx)))))))
+
+(defun vlf-tune-optimal-load (types &optional min-idx max-idx)
+ "Get best batch size according to existing measurements over TYPES.
+Best considered where primitive operations total is closest to
+`vlf-tune-load-time'. If MIN-IDX and MAX-IDX are given,
+confine search to this region."
+ (if vlf-tune-enabled
+ (progn
+ (setq max-idx (min (or max-idx vlf-tune-max)
+ (1- (/ (min vlf-tune-max
+ (/ (1+ vlf-file-size) 2))
+ vlf-tune-step))))
+ (let* ((idx (max 0 (or min-idx 0)))
+ (best-idx idx)
+ (best-time-diff vlf-tune-load-time)
+ (all-less t)
+ (all-more t))
+ (while (and (not (zerop best-time-diff)) (< idx max-idx))
+ (let ((time-diff (vlf-tune-score types idx t
+ (+ vlf-tune-load-time
+ best-time-diff))))
+ (if time-diff
+ (progn
+ (setq time-diff (if (< vlf-tune-load-time time-diff)
+ (progn (setq all-less nil)
+ (- time-diff
+ vlf-tune-load-time))
+ (setq all-more nil)
+ (- vlf-tune-load-time time-diff)))
+ (if (< time-diff best-time-diff)
+ (setq best-idx idx
+ best-time-diff time-diff)))
+ (setq all-less nil)))
+ (setq idx (1+ idx)))
+ (* vlf-tune-step (1+ (cond ((or (zerop best-time-diff)
+ (eq all-less all-more))
+ best-idx)
+ (all-less max-idx)
+ (t min-idx))))))
+ vlf-batch-size))
+
+(defun vlf-tune-load (types &optional region)
+ "Adjust `vlf-batch-size' slightly to better load time.
+Optimize on TYPES on the nearby REGION. Use 2 if REGION is nil."
+ (when (eq vlf-tune-enabled t)
+ (or region (setq region 2))
+ (let ((idx (vlf-tune-closest-index vlf-batch-size)))
+ (setq vlf-batch-size (vlf-tune-optimal-load types (- idx region)
+ (+ idx 1 region))))))
+
+(provide 'vlf-tune)
+
+;;; vlf-tune.el ends here
diff --git a/packages/vlf/vlf-write.el b/packages/vlf/vlf-write.el
index 5c94113..a29e1a9 100644
--- a/packages/vlf/vlf-write.el
+++ b/packages/vlf/vlf-write.el
@@ -43,43 +43,50 @@ If changing size of chunk, shift remaining file content."
(when hexl
(if (consp buffer-undo-list)
(setq buffer-undo-list nil))
- (hexl-mode-exit))
+ (vlf-tune-dehexlify))
(if (zerop vlf-file-size) ;new file
- (progn (write-region nil nil buffer-file-name vlf-start-pos t)
+ (progn (vlf-tune-write nil nil vlf-start-pos t
+ (vlf-tune-encode-length (point-min)
+ (point-max)))
(setq vlf-file-size (vlf-get-file-size
buffer-file-truename)
vlf-end-pos vlf-file-size)
(vlf-update-buffer-name))
- (let* ((region-length (length (encode-coding-region
- (point-min) (point-max)
- buffer-file-coding-system t)))
+ (let* ((region-length (vlf-tune-encode-length (point-min)
+ (point-max)))
(size-change (- vlf-end-pos vlf-start-pos
region-length)))
(if (zerop size-change)
- (write-region nil nil buffer-file-name vlf-start-pos t)
+ (vlf-tune-write nil nil vlf-start-pos t
+ (- vlf-end-pos vlf-start-pos))
(let ((tramp-verbose (if (boundp 'tramp-verbose)
(min tramp-verbose 2)))
(pos (point))
(font-lock font-lock-mode))
(font-lock-mode 0)
- (if (< 0 size-change)
- (vlf-file-shift-back size-change)
- (vlf-file-shift-forward (- size-change)))
- (if font-lock (font-lock-mode 1))
- (vlf-move-to-chunk-2 vlf-start-pos
- (if (< (- vlf-end-pos vlf-start-pos)
- vlf-batch-size)
- (+ vlf-start-pos vlf-batch-size)
- vlf-end-pos))
- (vlf-update-buffer-name)
- (goto-char pos)))))
- (if hexl (hexl-mode)))
+ (let ((batch-size vlf-batch-size)
+ (time (float-time)))
+ (if (< 0 size-change)
+ (vlf-file-shift-back size-change region-length)
+ (vlf-file-shift-forward (- size-change) region-length))
+ (if font-lock (font-lock-mode 1))
+ (setq vlf-batch-size batch-size)
+ (vlf-move-to-chunk-2 vlf-start-pos
+ (if (< (- vlf-end-pos vlf-start-pos)
+ vlf-batch-size)
+ (+ vlf-start-pos vlf-batch-size)
+ vlf-end-pos))
+ (vlf-update-buffer-name)
+ (goto-char pos)
+ (message "Save took %f seconds" (- (float-time) time)))))))
+ (if hexl (vlf-tune-hexlify)))
(run-hook-with-args 'vlf-after-batch-functions 'write))
t)
-(defun vlf-file-shift-back (size-change)
- "Shift file contents SIZE-CHANGE bytes back."
- (write-region nil nil buffer-file-name vlf-start-pos t)
+(defun vlf-file-shift-back (size-change write-size)
+ "Shift file contents SIZE-CHANGE bytes back.
+WRITE-SIZE is byte length of saved chunk."
+ (vlf-tune-write nil nil vlf-start-pos t write-size)
(let ((read-start-pos vlf-end-pos)
(coding-system-for-write 'no-conversion)
(reporter (make-progress-reporter "Adjusting file content..."
@@ -94,8 +101,8 @@ If changing size of chunk, shift remaining file content."
(erase-buffer)
(vlf-verify-size t)
(insert-char 32 size-change))
- (write-region nil nil buffer-file-name (- vlf-file-size
- size-change) t)
+ (vlf-tune-write nil nil (- vlf-file-size size-change)
+ t size-change)
(progress-reporter-done reporter)))
(defun vlf-shift-batch (read-pos write-pos)
@@ -103,37 +110,48 @@ If changing size of chunk, shift remaining file content."
back at WRITE-POS. Return nil if EOF is reached, t otherwise."
(erase-buffer)
(vlf-verify-size t)
- (let ((read-end (+ read-pos vlf-batch-size)))
- (insert-file-contents-literally buffer-file-name nil
- read-pos
- (min vlf-file-size read-end))
- (write-region nil nil buffer-file-name write-pos 0)
+ (vlf-tune-batch '(:raw :write))
+ (let ((read-end (min (+ read-pos vlf-batch-size) vlf-file-size)))
+ (vlf-tune-insert-file-contents-literally read-pos read-end)
+ (vlf-tune-write nil nil write-pos 0 (- read-end read-pos))
(< read-end vlf-file-size)))
-(defun vlf-file-shift-forward (size-change)
+(defun vlf-file-shift-forward (size-change write-size)
"Shift file contents SIZE-CHANGE bytes forward.
+WRITE-SIZE is byte length of saved chunk.
Done by saving content up front and then writing previous batch."
- (let ((read-size (max (/ vlf-batch-size 2) size-change))
+ (vlf-tune-batch '(:raw :write))
+ (let ((read-size (max vlf-batch-size size-change))
(read-pos vlf-end-pos)
(write-pos vlf-start-pos)
(reporter (make-progress-reporter "Adjusting file content..."
vlf-start-pos
vlf-file-size)))
(vlf-with-undo-disabled
- (when (vlf-shift-batches read-size read-pos write-pos t)
+ (when (vlf-shift-batches read-size read-pos write-pos
+ write-size t)
+ (vlf-tune-batch '(:raw :write))
(setq write-pos (+ read-pos size-change)
- read-pos (+ read-pos read-size))
+ read-pos (+ read-pos read-size)
+ write-size read-size
+ read-size (max vlf-batch-size size-change))
(progress-reporter-update reporter write-pos)
(let ((coding-system-for-write 'no-conversion))
- (while (vlf-shift-batches read-size read-pos write-pos nil)
+ (while (vlf-shift-batches read-size read-pos write-pos
+ write-size nil)
+ (vlf-tune-batch '(:raw :write))
(setq write-pos (+ read-pos size-change)
- read-pos (+ read-pos read-size))
+ read-pos (+ read-pos read-size)
+ write-size read-size
+ read-size (max vlf-batch-size size-change))
(progress-reporter-update reporter write-pos)))))
(progress-reporter-done reporter)))
-(defun vlf-shift-batches (read-size read-pos write-pos hide-read)
+(defun vlf-shift-batches (read-size read-pos write-pos write-size
+ hide-read)
"Append READ-SIZE bytes of file starting at READ-POS.
Then write initial buffer content to file at WRITE-POS.
+WRITE-SIZE is byte length of saved chunk.
If HIDE-READ is non nil, temporarily hide literal read content.
Return nil if EOF is reached, t otherwise."
(vlf-verify-size t)
@@ -142,14 +160,13 @@ Return nil if EOF is reached, t otherwise."
(end-write-pos (point-max)))
(when read-more
(goto-char end-write-pos)
- (insert-file-contents-literally buffer-file-name nil read-pos
- (min vlf-file-size
- (+ read-pos read-size))))
+ (vlf-tune-insert-file-contents-literally
+ read-pos (min vlf-file-size (+ read-pos read-size))))
;; write
(if hide-read ; hide literal region if user has to choose encoding
(narrow-to-region start-write-pos end-write-pos))
- (write-region start-write-pos end-write-pos
- buffer-file-name write-pos 0)
+ (vlf-tune-write start-write-pos end-write-pos write-pos
+ (or (not read-more) 0) write-size)
(delete-region start-write-pos end-write-pos)
(if hide-read (widen))
read-more))
diff --git a/packages/vlf/vlf.el b/packages/vlf/vlf.el
index 8eb2a4c..45a6d47 100644
--- a/packages/vlf/vlf.el
+++ b/packages/vlf/vlf.el
@@ -39,8 +39,7 @@
;;; Code:
-(defgroup vlf nil "View Large Files in Emacs."
- :prefix "vlf-" :group 'files)
+(require 'vlf-base)
(defcustom vlf-before-batch-functions nil
"Hook that runs before multiple batch operations.
@@ -54,8 +53,6 @@ One argument is supplied that specifies current action.
Possible
values are: `write', `ediff', `occur', `search', `goto-line'."
:group 'vlf :type 'hook)
-(require 'vlf-base)
-
(autoload 'vlf-write "vlf-write" "Write current chunk to file." t)
(autoload 'vlf-re-search-forward "vlf-search"
"Search forward for REGEXP prefix COUNT number of times." t)
@@ -172,6 +169,9 @@ When prefix argument is negative
append next APPEND number of batches to the existing buffer."
(interactive "p")
(vlf-verify-size)
+ (vlf-tune-load (if (derived-mode-p 'hexl-mode)
+ '(:hexl :dehexlify :insert :encode)
+ '(:insert :encode)))
(let* ((end (min (+ vlf-end-pos (* vlf-batch-size (abs append)))
vlf-file-size))
(start (if (< append 0)
@@ -188,6 +188,9 @@ When prefix argument is negative
(interactive "p")
(if (zerop vlf-start-pos)
(error "Already at BOF"))
+ (vlf-tune-load (if (derived-mode-p 'hexl-mode)
+ '(:hexl :dehexlify :insert :encode)
+ '(:insert :encode)))
(let* ((start (max 0 (- vlf-start-pos (* vlf-batch-size (abs prepend)))))
(end (if (< prepend 0)
vlf-end-pos
@@ -253,19 +256,30 @@ with the prefix argument DECREASE it is halved."
(defun vlf-set-batch-size (size)
"Set batch to SIZE bytes and update chunk."
- (interactive (list (read-number "Size in bytes: " vlf-batch-size)))
+ (interactive
+ (list (read-number "Size in bytes: "
+ (vlf-tune-optimal-load
+ (if (derived-mode-p 'hexl-mode)
+ '(:hexl :dehexlify :insert :encode)
+ '(:insert :encode))))))
(setq vlf-batch-size size)
(vlf-move-to-batch vlf-start-pos))
(defun vlf-beginning-of-file ()
"Jump to beginning of file content."
(interactive)
+ (vlf-tune-load (if (derived-mode-p 'hexl-mode)
+ '(:hexl :dehexlify :insert :encode)
+ '(:insert :encode)))
(vlf-move-to-batch 0))
(defun vlf-end-of-file ()
"Jump to end of file content."
(interactive)
(vlf-verify-size)
+ (vlf-tune-load (if (derived-mode-p 'hexl-mode)
+ '(:hexl :dehexlify :insert :encode)
+ '(:insert :encode)))
(vlf-move-to-batch vlf-file-size))
(defun vlf-revert (&optional _auto noconfirm)
@@ -281,6 +295,9 @@ Ask for confirmation if NOCONFIRM is nil."
(defun vlf-jump-to-chunk (n)
"Go to to chunk N."
(interactive "nGoto to chunk: ")
+ (vlf-tune-load (if (derived-mode-p 'hexl-mode)
+ '(:hexl :dehexlify :insert :encode)
+ '(:insert :encode)))
(vlf-move-to-batch (* (1- n) vlf-batch-size)))
(defun vlf-no-modifications ()
