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 (defvar tramp-verbose)
  33
  34 (defun vlf-write ()
  35   "Write current chunk to file.  Always return true to disable save.
  36 If changing size of chunk, shift remaining file content."
  37   (interactive)
  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.\
  41   Save anyway? ")))
  42     (widen)
  43     (run-hook-with-args 'vlf-before-batch-functions 'write)
  44     (let ((hexl (derived-mode-p 'hexl-mode)))
  45       (when hexl
  46         (if (consp buffer-undo-list)
  47             (setq buffer-undo-list nil))
  48         (vlf-tune-dehexlify))
  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)
  52                                                          (point-max)))
  53                  (setq vlf-file-size (vlf-get-file-size
  54                                       buffer-file-truename)
  55                        vlf-end-pos vlf-file-size)
  56                  (vlf-update-buffer-name))
  57         (let* ((region-length (vlf-tune-encode-length (point-min)
  58                                                       (point-max)))
  59                (size-change (- vlf-end-pos vlf-start-pos
  60                                region-length)))
  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)))
  66                   (pos (point))
  67                   (font-lock font-lock-mode))
  68               (font-lock-mode 0)
  69               (let ((batch-size vlf-batch-size)
  70                     (time (float-time)))
  71                 (if (< 0 size-change)
  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)
  78                                             vlf-batch-size)
  79                                          (+ vlf-start-pos vlf-batch-size)
  80                                        vlf-end-pos))
  81                 (vlf-update-buffer-name)
  82                 (goto-char pos)
  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))
  86   t)
  87
  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..."
  95                                           vlf-end-pos
  96                                           vlf-file-size)))
  97     (vlf-with-undo-disabled
  98      (while (vlf-shift-batch read-start-pos (- read-start-pos
  99                                                size-change))
 100        (setq read-start-pos (+ read-start-pos vlf-batch-size))
 101        (progress-reporter-update reporter read-start-pos))
 102      ;; pad end with space
 103      (erase-buffer)
 104      (vlf-verify-size t)
 105      (insert-char 32 size-change))
 106     (vlf-tune-write nil nil (- vlf-file-size size-change)
 107                     t size-change)
 108     (progress-reporter-done reporter)))
 109
 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."
 113   (erase-buffer)
 114   (vlf-verify-size t)
 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)))
 120
 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..."
 130                                           vlf-start-pos
 131                                           vlf-file-size)))
 132     (vlf-with-undo-disabled
 133      (when (vlf-shift-batches read-size read-pos write-pos
 134                               write-size t)
 135        (vlf-tune-batch '(:raw :write))
 136        (setq write-pos (+ read-pos size-change)
 137              read-pos (+ read-pos read-size)
 138              write-size 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
 143                                    write-size nil)
 144            (vlf-tune-batch '(:raw :write))
 145            (setq write-pos (+ read-pos size-change)
 146                  read-pos (+ read-pos read-size)
 147                  write-size read-size
 148                  read-size (max vlf-batch-size size-change))
 149            (progress-reporter-update reporter write-pos)))))
 150     (progress-reporter-done reporter)))
 151
 152 (defun vlf-shift-batches (read-size read-pos write-pos write-size
 153                                     hide-read)
 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."
 159   (vlf-verify-size t)
 160   (let ((read-more (< read-pos vlf-file-size))
 161         (start-write-pos (point-min))
 162         (end-write-pos (point-max)))
 163     (when read-more
 164       (goto-char end-write-pos)
 165       (vlf-tune-insert-file-contents-literally
 166        read-pos (min vlf-file-size (+ read-pos read-size))))
 167     ;; write
 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))
 174     read-more))
 175
 176 (provide 'vlf-write)
 177
 178 ;;; vlf-write.el ends here