code.delx.au - gnu-emacs-elpa/blob - packages/vlf/vlf-write.el

   1 ;;; vlf-write.el --- Saving functionality for VLF  -*- lexical-binding: t -*-
   2
   3 ;; Copyright (C) 2014 Free Software Foundation, Inc.
   4
   5 ;; Keywords: large files, saving
   6 ;; Author: Andrey Kotlarski <m00naticus@gmail.com>
   7 ;; URL: https://github.com/m00natic/vlfi
   8
   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)
  12 ;; any later version.
  13
  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.
  18
  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.
  23
  24 ;;; Commentary:
  25 ;; This package provides the `vlf-write' command which takes care of
  26 ;; saving changes where only part of file is viewed and updated.
  27
  28 ;;; Code:
  29
  30 (require 'vlf-base)
  31
  32 (defcustom vlf-save-in-place 'ask
  33   "Should VLF save in place when additional adjustment of file content\
  34 is needed."
  35   :group 'vlf :type '(choice (const :tag "Always when applicable" t)
  36                              (const :tag "Ask when applicable" 'ask)
  37                              (const :tag "Never" nil)))
  38
  39 (defun vlf-write ()
  40   "Write current chunk to file.  Always return true to disable save.
  41 If changing size of chunk, shift remaining file content."
  42   (interactive)
  43   (when (and (buffer-modified-p)
  44              (or (verify-visited-file-modtime (current-buffer))
  45                  (y-or-n-p "File has changed since visited or saved.\
  46   Save anyway? ")))
  47     (widen)
  48     (run-hook-with-args 'vlf-before-batch-functions 'write)
  49     (let ((hexl (derived-mode-p 'hexl-mode)))
  50       (when hexl
  51         (if (consp buffer-undo-list)
  52             (setq buffer-undo-list nil))
  53         (vlf-tune-dehexlify))
  54       (if (zerop vlf-file-size)           ;new file
  55           (progn (vlf-tune-write nil nil vlf-start-pos t
  56                                  (vlf-tune-encode-length (point-min)
  57                                                          (point-max)))
  58                  (if hexl (vlf-tune-hexlify))
  59                  (setq vlf-file-size (vlf-get-file-size
  60                                       buffer-file-truename)
  61                        vlf-end-pos vlf-file-size))
  62         (let* ((region-length (vlf-tune-encode-length (point-min)
  63                                                       (point-max)))
  64                (size-change (- vlf-end-pos vlf-start-pos
  65                                region-length)))
  66           (if (zerop size-change)
  67               (progn (vlf-tune-write nil nil vlf-start-pos t
  68                                      (- vlf-end-pos vlf-start-pos))
  69                      (if hexl (vlf-tune-hexlify)))
  70             (let ((pos (point))
  71                   (font-lock font-lock-mode)
  72                   (batch-size vlf-batch-size)
  73                   time)
  74               (font-lock-mode 0)
  75               (if (or (file-remote-p buffer-file-name)
  76                       (if (eq vlf-save-in-place 'ask)
  77                           (y-or-n-p "File content needs be adjusted\
  78  till end.  Use temporary copy of the whole file (slower but safer)? ")
  79                         (not vlf-save-in-place)))
  80                   (let ((file-tmp (make-temp-file "vlf")))
  81                     (setq time (float-time))
  82                     (copy-file buffer-file-name file-tmp t t t t)
  83                     (if (< 0 size-change)
  84                         (vlf-file-shift-back size-change region-length
  85                                              file-tmp)
  86                       (vlf-file-shift-forward (- size-change)
  87                                               region-length file-tmp))
  88                     (rename-file file-tmp buffer-file-name t))
  89                 (setq time (float-time))
  90                 (if (< 0 size-change)
  91                     (vlf-file-shift-back size-change region-length)
  92                   (vlf-file-shift-forward (- size-change)
  93                                           region-length)))
  94               (if font-lock (font-lock-mode 1))
  95               (setq vlf-batch-size batch-size)
  96               (vlf-move-to-chunk-2 vlf-start-pos
  97                                    (if (< (- vlf-end-pos vlf-start-pos)
  98                                           vlf-batch-size)
  99                                        (+ vlf-start-pos vlf-batch-size)
 100                                      vlf-end-pos))
 101               (goto-char pos)
 102               (message "Save took %f seconds" (- (float-time) time)))))))
 103     (run-hook-with-args 'vlf-after-batch-functions 'write))
 104   t)
 105
 106 (defun vlf-file-shift-back (size-change write-size &optional file)
 107   "Shift file contents SIZE-CHANGE bytes back.
 108 WRITE-SIZE is byte length of saved chunk.
 109 FILE if given is filename to be used, otherwise `buffer-file-name'."
 110   (vlf-tune-write nil nil vlf-start-pos (if file nil t) write-size file)
 111   (let ((read-start-pos vlf-end-pos)
 112         (coding-system-for-write 'no-conversion)
 113         (reporter (make-progress-reporter "Adjusting file content..."
 114                                           vlf-end-pos
 115                                           vlf-file-size)))
 116     (vlf-with-undo-disabled
 117      (while (vlf-shift-batch read-start-pos (- read-start-pos
 118                                                size-change)
 119                              file)
 120        (setq read-start-pos (+ read-start-pos vlf-batch-size))
 121        (progress-reporter-update reporter read-start-pos))
 122      ;; pad end with space
 123      (erase-buffer)
 124      (vlf-verify-size t file)
 125      (insert-char 32 size-change))
 126     (vlf-tune-write nil nil (- vlf-file-size size-change)
 127                     (if file nil t) size-change file)
 128     (progress-reporter-done reporter)))
 129
 130 (defun vlf-shift-batch (read-pos write-pos file)
 131   "Read `vlf-batch-size' bytes from READ-POS and write them \
 132 back at WRITE-POS using FILE.
 133 Return nil if EOF is reached, t otherwise."
 134   (erase-buffer)
 135   (vlf-verify-size t file)
 136   (vlf-tune-batch '(:raw :write) nil file) ;insert speed over temp write file may defer wildly
 137   (let ((read-end (min (+ read-pos vlf-batch-size) vlf-file-size))) ;compared to the original file
 138     (vlf-tune-insert-file-contents-literally read-pos read-end file)
 139     (vlf-tune-write nil nil write-pos 0 (- read-end read-pos) file)
 140     (< read-end vlf-file-size)))
 141
 142 (defun vlf-file-shift-forward (size-change write-size &optional file)
 143   "Shift file contents SIZE-CHANGE bytes forward.
 144 WRITE-SIZE is byte length of saved chunk.
 145 FILE if given is filename to be used, otherwise `buffer-file-name'.
 146 Done by saving content up front and then writing previous batch."
 147   (vlf-tune-batch '(:raw :write) nil file)
 148   (let ((read-size (max vlf-batch-size size-change))
 149         (read-pos vlf-end-pos)
 150         (write-pos vlf-start-pos)
 151         (reporter (make-progress-reporter "Adjusting file content..."
 152                                           vlf-start-pos
 153                                           vlf-file-size)))
 154     (vlf-with-undo-disabled
 155      (when (vlf-shift-batches read-size read-pos write-pos
 156                               write-size t file)
 157        (vlf-tune-batch '(:raw :write) nil file)
 158        (setq write-pos (+ read-pos size-change)
 159              read-pos (+ read-pos read-size)
 160              write-size read-size
 161              read-size (max vlf-batch-size size-change))
 162        (progress-reporter-update reporter write-pos)
 163        (let ((coding-system-for-write 'no-conversion))
 164          (while (vlf-shift-batches read-size read-pos write-pos
 165                                    write-size nil file)
 166            (vlf-tune-batch '(:raw :write) nil file)
 167            (setq write-pos (+ read-pos size-change)
 168                  read-pos (+ read-pos read-size)
 169                  write-size read-size
 170                  read-size (max vlf-batch-size size-change))
 171            (progress-reporter-update reporter write-pos)))))
 172     (progress-reporter-done reporter)))
 173
 174 (defun vlf-shift-batches (read-size read-pos write-pos write-size
 175                                     hide-read file)
 176   "Append READ-SIZE bytes of file starting at READ-POS.
 177 Then write initial buffer content to file at WRITE-POS.
 178 WRITE-SIZE is byte length of saved chunk.
 179 If HIDE-READ is non nil, temporarily hide literal read content.
 180 FILE if given is filename to be used, otherwise `buffer-file-name'.
 181 Return nil if EOF is reached, t otherwise."
 182   (vlf-verify-size t file)
 183   (let ((read-more (< read-pos vlf-file-size))
 184         (start-write-pos (point-min))
 185         (end-write-pos (point-max)))
 186     (when read-more
 187       (goto-char end-write-pos)
 188       (vlf-tune-insert-file-contents-literally
 189        read-pos (min vlf-file-size (+ read-pos read-size)) file))
 190     ;; write
 191     (if hide-read ; hide literal region if user has to choose encoding
 192         (narrow-to-region start-write-pos end-write-pos))
 193     (vlf-tune-write start-write-pos end-write-pos write-pos
 194                     (or (and (not read-more) (not file)) 0)
 195                     write-size file)
 196     (delete-region start-write-pos end-write-pos)
 197     (if hide-read (widen))
 198     read-more))
 199
 200 (provide 'vlf-write)
 201
 202 ;;; vlf-write.el ends here