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.
33 "Write current chunk to file. Always return true to disable save.
34 If changing size of chunk, shift remaining file content."
36 (when (and (buffer-modified-p)
37 (or (verify-visited-file-modtime (current-buffer))
38 (y-or-n-p "File has changed since visited or saved.\
41 (run-hook-with-args 'vlf-before-batch-functions 'write)
42 (let ((hexl (derived-mode-p 'hexl-mode)))
44 (if (consp buffer-undo-list)
45 (setq buffer-undo-list nil))
47 (if (zerop vlf-file-size) ;new file
48 (progn (vlf-tune-write nil nil vlf-start-pos t
49 (vlf-tune-encode-length (point-min)
51 (setq vlf-file-size (vlf-get-file-size
53 vlf-end-pos vlf-file-size)
54 (vlf-update-buffer-name))
55 (let* ((region-length (vlf-tune-encode-length (point-min)
57 (size-change (- vlf-end-pos vlf-start-pos
59 (if (zerop size-change)
60 (vlf-tune-write nil nil vlf-start-pos t
61 (- vlf-end-pos vlf-start-pos))
62 (let ((tramp-verbose (if (boundp 'tramp-verbose)
63 (min tramp-verbose 2)))
65 (font-lock font-lock-mode))
67 (let ((batch-size vlf-batch-size)
70 (vlf-file-shift-back size-change region-length)
71 (vlf-file-shift-forward (- size-change) region-length))
72 (if font-lock (font-lock-mode 1))
73 (setq vlf-batch-size batch-size)
74 (vlf-move-to-chunk-2 vlf-start-pos
75 (if (< (- vlf-end-pos vlf-start-pos)
77 (+ vlf-start-pos vlf-batch-size)
79 (vlf-update-buffer-name)
81 (message "Save took %f seconds" (- (float-time) time)))))))
82 (if hexl (vlf-tune-hexlify)))
83 (run-hook-with-args 'vlf-after-batch-functions 'write))
86 (defun vlf-file-shift-back (size-change write-size)
87 "Shift file contents SIZE-CHANGE bytes back.
88 WRITE-SIZE is byte length of saved chunk."
89 (vlf-tune-write nil nil vlf-start-pos t write-size)
90 (let ((read-start-pos vlf-end-pos)
91 (coding-system-for-write 'no-conversion)
92 (reporter (make-progress-reporter "Adjusting file content..."
95 (vlf-with-undo-disabled
96 (while (vlf-shift-batch read-start-pos (- read-start-pos
98 (setq read-start-pos (+ read-start-pos vlf-batch-size))
99 (progress-reporter-update reporter read-start-pos))
100 ;; pad end with space
103 (insert-char 32 size-change))
104 (vlf-tune-write nil nil (- vlf-file-size size-change)
106 (progress-reporter-done reporter)))
108 (defun vlf-shift-batch (read-pos write-pos)
109 "Read `vlf-batch-size' bytes from READ-POS and write them \
110 back at WRITE-POS. Return nil if EOF is reached, t otherwise."
113 (vlf-tune-batch '(:raw :write))
114 (let ((read-end (min (+ read-pos vlf-batch-size) vlf-file-size)))
115 (vlf-tune-insert-file-contents-literally read-pos read-end)
116 (vlf-tune-write nil nil write-pos 0 (- read-end read-pos))
117 (< read-end vlf-file-size)))
119 (defun vlf-file-shift-forward (size-change write-size)
120 "Shift file contents SIZE-CHANGE bytes forward.
121 WRITE-SIZE is byte length of saved chunk.
122 Done by saving content up front and then writing previous batch."
123 (vlf-tune-batch '(:raw :write))
124 (let ((read-size (max vlf-batch-size size-change))
125 (read-pos vlf-end-pos)
126 (write-pos vlf-start-pos)
127 (reporter (make-progress-reporter "Adjusting file content..."
130 (vlf-with-undo-disabled
131 (when (vlf-shift-batches read-size read-pos write-pos
133 (vlf-tune-batch '(:raw :write))
134 (setq write-pos (+ read-pos size-change)
135 read-pos (+ read-pos read-size)
137 read-size (max vlf-batch-size size-change))
138 (progress-reporter-update reporter write-pos)
139 (let ((coding-system-for-write 'no-conversion))
140 (while (vlf-shift-batches read-size read-pos write-pos
142 (vlf-tune-batch '(:raw :write))
143 (setq write-pos (+ read-pos size-change)
144 read-pos (+ read-pos read-size)
146 read-size (max vlf-batch-size size-change))
147 (progress-reporter-update reporter write-pos)))))
148 (progress-reporter-done reporter)))
150 (defun vlf-shift-batches (read-size read-pos write-pos write-size
152 "Append READ-SIZE bytes of file starting at READ-POS.
153 Then write initial buffer content to file at WRITE-POS.
154 WRITE-SIZE is byte length of saved chunk.
155 If HIDE-READ is non nil, temporarily hide literal read content.
156 Return nil if EOF is reached, t otherwise."
158 (let ((read-more (< read-pos vlf-file-size))
159 (start-write-pos (point-min))
160 (end-write-pos (point-max)))
162 (goto-char end-write-pos)
163 (vlf-tune-insert-file-contents-literally
164 read-pos (min vlf-file-size (+ read-pos read-size))))
166 (if hide-read ; hide literal region if user has to choose encoding
167 (narrow-to-region start-write-pos end-write-pos))
168 (vlf-tune-write start-write-pos end-write-pos write-pos
169 (or (not read-more) 0) write-size)
170 (delete-region start-write-pos end-write-pos)
171 (if hide-read (widen))
176 ;;; vlf-write.el ends here