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 (write-region nil nil buffer-file-name vlf-start-pos t)
49 (setq vlf-file-size (vlf-get-file-size
51 vlf-end-pos vlf-file-size)
52 (vlf-update-buffer-name))
53 (let* ((region-length (length (encode-coding-region
54 (point-min) (point-max)
55 buffer-file-coding-system t)))
56 (size-change (- vlf-end-pos vlf-start-pos
58 (if (zerop size-change)
59 (write-region nil nil buffer-file-name vlf-start-pos t)
60 (let ((tramp-verbose (if (boundp 'tramp-verbose)
61 (min tramp-verbose 2)))
63 (font-lock font-lock-mode))
66 (vlf-file-shift-back size-change)
67 (vlf-file-shift-forward (- size-change)))
68 (if font-lock (font-lock-mode 1))
69 (vlf-move-to-chunk-2 vlf-start-pos
70 (if (< (- vlf-end-pos vlf-start-pos)
72 (+ vlf-start-pos vlf-batch-size)
74 (vlf-update-buffer-name)
76 (if hexl (hexl-mode)))
77 (run-hook-with-args 'vlf-after-batch-functions 'write))
80 (defun vlf-file-shift-back (size-change)
81 "Shift file contents SIZE-CHANGE bytes back."
82 (write-region nil nil buffer-file-name vlf-start-pos t)
83 (let ((read-start-pos vlf-end-pos)
84 (coding-system-for-write 'no-conversion)
85 (reporter (make-progress-reporter "Adjusting file content..."
88 (vlf-with-undo-disabled
89 (while (vlf-shift-batch read-start-pos (- read-start-pos
91 (setq read-start-pos (+ read-start-pos vlf-batch-size))
92 (progress-reporter-update reporter read-start-pos))
96 (insert-char 32 size-change))
97 (write-region nil nil buffer-file-name (- vlf-file-size
99 (progress-reporter-done reporter)))
101 (defun vlf-shift-batch (read-pos write-pos)
102 "Read `vlf-batch-size' bytes from READ-POS and write them \
103 back at WRITE-POS. Return nil if EOF is reached, t otherwise."
106 (let ((read-end (+ read-pos vlf-batch-size)))
107 (insert-file-contents-literally buffer-file-name nil
109 (min vlf-file-size read-end))
110 (write-region nil nil buffer-file-name write-pos 0)
111 (< read-end vlf-file-size)))
113 (defun vlf-file-shift-forward (size-change)
114 "Shift file contents SIZE-CHANGE bytes forward.
115 Done by saving content up front and then writing previous batch."
116 (let ((read-size (max (/ vlf-batch-size 2) size-change))
117 (read-pos vlf-end-pos)
118 (write-pos vlf-start-pos)
119 (reporter (make-progress-reporter "Adjusting file content..."
122 (vlf-with-undo-disabled
123 (when (vlf-shift-batches read-size read-pos write-pos t)
124 (setq write-pos (+ read-pos size-change)
125 read-pos (+ read-pos read-size))
126 (progress-reporter-update reporter write-pos)
127 (let ((coding-system-for-write 'no-conversion))
128 (while (vlf-shift-batches read-size read-pos write-pos nil)
129 (setq write-pos (+ read-pos size-change)
130 read-pos (+ read-pos read-size))
131 (progress-reporter-update reporter write-pos)))))
132 (progress-reporter-done reporter)))
134 (defun vlf-shift-batches (read-size read-pos write-pos hide-read)
135 "Append READ-SIZE bytes of file starting at READ-POS.
136 Then write initial buffer content to file at WRITE-POS.
137 If HIDE-READ is non nil, temporarily hide literal read content.
138 Return nil if EOF is reached, t otherwise."
140 (let ((read-more (< read-pos vlf-file-size))
141 (start-write-pos (point-min))
142 (end-write-pos (point-max)))
144 (goto-char end-write-pos)
145 (insert-file-contents-literally buffer-file-name nil read-pos
147 (+ read-pos read-size))))
149 (if hide-read ; hide literal region if user has to choose encoding
150 (narrow-to-region start-write-pos end-write-pos))
151 (write-region start-write-pos end-write-pos
152 buffer-file-name write-pos 0)
153 (delete-region start-write-pos end-write-pos)
154 (if hide-read (widen))
159 ;;; vlf-write.el ends here