1 ;;; vlf-write.el --- Saving functionality for VLF -*- lexical-binding: t -*-
3 ;; Copyright (C) 2014 Free Software Foundation, Inc.
5 ;; Keywords: large files, saving
6 ;; Author: Andrey Kotlarski <m00naticus@gmail.com>
7 ;; URL: https://github.com/m00natic/vlfi
9 ;; This file is free software; you can redistribute it and/or modify
10 ;; it under the terms of the GNU General Public License as published by
11 ;; the Free Software Foundation; either version 3, or (at your option)
14 ;; This file is distributed in the hope that it will be useful,
15 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
16 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
17 ;; GNU General Public License for more details.
19 ;; You should have received a copy of the GNU General Public License
20 ;; along with GNU Emacs; see the file COPYING. If not, write to
21 ;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
22 ;; Boston, MA 02111-1307, USA.
25 ;; This package provides the `vlf-write' command which takes care of
26 ;; saving changes where only part of file is viewed and updated.
32 (defvar tramp-verbose)
35 "Write current chunk to file. Always return true to disable save.
36 If changing size of chunk, shift remaining file content."
38 (when (and (buffer-modified-p)
39 (or (verify-visited-file-modtime (current-buffer))
40 (y-or-n-p "File has changed since visited or saved.\
43 (run-hook-with-args 'vlf-before-batch-functions 'write)
44 (let ((hexl (derived-mode-p 'hexl-mode)))
46 (if (consp buffer-undo-list)
47 (setq buffer-undo-list nil))
49 (if (zerop vlf-file-size) ;new file
50 (progn (vlf-tune-write nil nil vlf-start-pos t
51 (vlf-tune-encode-length (point-min)
53 (setq vlf-file-size (vlf-get-file-size
55 vlf-end-pos vlf-file-size)
56 (vlf-update-buffer-name))
57 (let* ((region-length (vlf-tune-encode-length (point-min)
59 (size-change (- vlf-end-pos vlf-start-pos
61 (if (zerop size-change)
62 (vlf-tune-write nil nil vlf-start-pos t
63 (- vlf-end-pos vlf-start-pos))
64 (let ((tramp-verbose (if (boundp 'tramp-verbose)
65 (min tramp-verbose 2)))
67 (font-lock font-lock-mode))
69 (let ((batch-size vlf-batch-size)
72 (vlf-file-shift-back size-change region-length)
73 (vlf-file-shift-forward (- size-change) region-length))
74 (if font-lock (font-lock-mode 1))
75 (setq vlf-batch-size batch-size)
76 (vlf-move-to-chunk-2 vlf-start-pos
77 (if (< (- vlf-end-pos vlf-start-pos)
79 (+ vlf-start-pos vlf-batch-size)
81 (vlf-update-buffer-name)
83 (message "Save took %f seconds" (- (float-time) time)))))))
84 (if hexl (vlf-tune-hexlify)))
85 (run-hook-with-args 'vlf-after-batch-functions 'write))
88 (defun vlf-file-shift-back (size-change write-size)
89 "Shift file contents SIZE-CHANGE bytes back.
90 WRITE-SIZE is byte length of saved chunk."
91 (vlf-tune-write nil nil vlf-start-pos t write-size)
92 (let ((read-start-pos vlf-end-pos)
93 (coding-system-for-write 'no-conversion)
94 (reporter (make-progress-reporter "Adjusting file content..."
97 (vlf-with-undo-disabled
98 (while (vlf-shift-batch read-start-pos (- read-start-pos
100 (setq read-start-pos (+ read-start-pos vlf-batch-size))
101 (progress-reporter-update reporter read-start-pos))
102 ;; pad end with space
105 (insert-char 32 size-change))
106 (vlf-tune-write nil nil (- vlf-file-size size-change)
108 (progress-reporter-done reporter)))
110 (defun vlf-shift-batch (read-pos write-pos)
111 "Read `vlf-batch-size' bytes from READ-POS and write them \
112 back at WRITE-POS. Return nil if EOF is reached, t otherwise."
115 (vlf-tune-batch '(:raw :write))
116 (let ((read-end (min (+ read-pos vlf-batch-size) vlf-file-size)))
117 (vlf-tune-insert-file-contents-literally read-pos read-end)
118 (vlf-tune-write nil nil write-pos 0 (- read-end read-pos))
119 (< read-end vlf-file-size)))
121 (defun vlf-file-shift-forward (size-change write-size)
122 "Shift file contents SIZE-CHANGE bytes forward.
123 WRITE-SIZE is byte length of saved chunk.
124 Done by saving content up front and then writing previous batch."
125 (vlf-tune-batch '(:raw :write))
126 (let ((read-size (max vlf-batch-size size-change))
127 (read-pos vlf-end-pos)
128 (write-pos vlf-start-pos)
129 (reporter (make-progress-reporter "Adjusting file content..."
132 (vlf-with-undo-disabled
133 (when (vlf-shift-batches read-size read-pos write-pos
135 (vlf-tune-batch '(:raw :write))
136 (setq write-pos (+ read-pos size-change)
137 read-pos (+ read-pos read-size)
139 read-size (max vlf-batch-size size-change))
140 (progress-reporter-update reporter write-pos)
141 (let ((coding-system-for-write 'no-conversion))
142 (while (vlf-shift-batches read-size read-pos write-pos
144 (vlf-tune-batch '(:raw :write))
145 (setq write-pos (+ read-pos size-change)
146 read-pos (+ read-pos read-size)
148 read-size (max vlf-batch-size size-change))
149 (progress-reporter-update reporter write-pos)))))
150 (progress-reporter-done reporter)))
152 (defun vlf-shift-batches (read-size read-pos write-pos write-size
154 "Append READ-SIZE bytes of file starting at READ-POS.
155 Then write initial buffer content to file at WRITE-POS.
156 WRITE-SIZE is byte length of saved chunk.
157 If HIDE-READ is non nil, temporarily hide literal read content.
158 Return nil if EOF is reached, t otherwise."
160 (let ((read-more (< read-pos vlf-file-size))
161 (start-write-pos (point-min))
162 (end-write-pos (point-max)))
164 (goto-char end-write-pos)
165 (vlf-tune-insert-file-contents-literally
166 read-pos (min vlf-file-size (+ read-pos read-size))))
168 (if hide-read ; hide literal region if user has to choose encoding
169 (narrow-to-region start-write-pos end-write-pos))
170 (vlf-tune-write start-write-pos end-write-pos write-pos
171 (or (not read-more) 0) write-size)
172 (delete-region start-write-pos end-write-pos)
173 (if hide-read (widen))
178 ;;; vlf-write.el ends here