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 (defun vlf-write ()
  33   "Write current chunk to file.  Always return true to disable save.
  34 If changing size of chunk, shift remaining file content."
  35   (interactive)
  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.\
  39   Save anyway? ")))
  40     (run-hook-with-args 'vlf-before-batch-functions 'write)
  41     (if (zerop vlf-file-size)           ;new file
  42         (progn (write-region nil nil buffer-file-name vlf-start-pos t)
  43                (setq vlf-file-size (vlf-get-file-size
  44                                     buffer-file-truename)
  45                      vlf-end-pos vlf-file-size)
  46                (vlf-update-buffer-name))
  47       (widen)
  48       (let* ((region-length (length (encode-coding-region
  49                                      (point-min) (point-max)
  50                                      buffer-file-coding-system t)))
  51              (size-change (- vlf-end-pos vlf-start-pos
  52                              region-length)))
  53         (if (zerop size-change)
  54             (write-region nil nil buffer-file-name vlf-start-pos t)
  55           (let ((tramp-verbose (if (boundp 'tramp-verbose)
  56                                    (min tramp-verbose 2)))
  57                 (pos (point))
  58                 (font-lock font-lock-mode))
  59             (font-lock-mode 0)
  60             (if (< 0 size-change)
  61                 (vlf-file-shift-back size-change)
  62               (vlf-file-shift-forward (- size-change)))
  63             (if font-lock (font-lock-mode 1))
  64             (vlf-move-to-chunk-2 vlf-start-pos
  65                                  (if (< (- vlf-end-pos vlf-start-pos)
  66                                         vlf-batch-size)
  67                                      (+ vlf-start-pos vlf-batch-size)
  68                                    vlf-end-pos))
  69             (vlf-update-buffer-name)
  70             (goto-char pos)))))
  71     (run-hook-with-args 'vlf-after-batch-functions 'write))
  72   t)
  73
  74 (defun vlf-file-shift-back (size-change)
  75   "Shift file contents SIZE-CHANGE bytes back."
  76   (write-region nil nil buffer-file-name vlf-start-pos t)
  77   (let ((read-start-pos vlf-end-pos)
  78         (coding-system-for-write 'no-conversion)
  79         (reporter (make-progress-reporter "Adjusting file content..."
  80                                           vlf-end-pos
  81                                           vlf-file-size)))
  82     (vlf-with-undo-disabled
  83      (while (vlf-shift-batch read-start-pos (- read-start-pos
  84                                                size-change))
  85        (setq read-start-pos (+ read-start-pos vlf-batch-size))
  86        (progress-reporter-update reporter read-start-pos))
  87      ;; pad end with space
  88      (erase-buffer)
  89      (vlf-verify-size t)
  90      (insert-char 32 size-change))
  91     (write-region nil nil buffer-file-name (- vlf-file-size
  92                                               size-change) t)
  93     (progress-reporter-done reporter)))
  94
  95 (defun vlf-shift-batch (read-pos write-pos)
  96   "Read `vlf-batch-size' bytes from READ-POS and write them \
  97 back at WRITE-POS.  Return nil if EOF is reached, t otherwise."
  98   (erase-buffer)
  99   (vlf-verify-size t)
 100   (let ((read-end (+ read-pos vlf-batch-size)))
 101     (insert-file-contents-literally buffer-file-name nil
 102                                     read-pos
 103                                     (min vlf-file-size read-end))
 104     (write-region nil nil buffer-file-name write-pos 0)
 105     (< read-end vlf-file-size)))
 106
 107 (defun vlf-file-shift-forward (size-change)
 108   "Shift file contents SIZE-CHANGE bytes forward.
 109 Done by saving content up front and then writing previous batch."
 110   (let ((read-size (max (/ vlf-batch-size 2) size-change))
 111         (read-pos vlf-end-pos)
 112         (write-pos vlf-start-pos)
 113         (reporter (make-progress-reporter "Adjusting file content..."
 114                                           vlf-start-pos
 115                                           vlf-file-size)))
 116     (vlf-with-undo-disabled
 117      (when (vlf-shift-batches read-size read-pos write-pos t)
 118        (setq write-pos (+ read-pos size-change)
 119              read-pos (+ read-pos read-size))
 120        (progress-reporter-update reporter write-pos)
 121        (let ((coding-system-for-write 'no-conversion))
 122          (while (vlf-shift-batches read-size read-pos write-pos nil)
 123            (setq write-pos (+ read-pos size-change)
 124                  read-pos (+ read-pos read-size))
 125            (progress-reporter-update reporter write-pos)))))
 126     (progress-reporter-done reporter)))
 127
 128 (defun vlf-shift-batches (read-size read-pos write-pos hide-read)
 129   "Append READ-SIZE bytes of file starting at READ-POS.
 130 Then write initial buffer content to file at WRITE-POS.
 131 If HIDE-READ is non nil, temporarily hide literal read content.
 132 Return nil if EOF is reached, t otherwise."
 133   (vlf-verify-size t)
 134   (let ((read-more (< read-pos vlf-file-size))
 135         (start-write-pos (point-min))
 136         (end-write-pos (point-max)))
 137     (when read-more
 138       (goto-char end-write-pos)
 139       (insert-file-contents-literally buffer-file-name nil read-pos
 140                                       (min vlf-file-size
 141                                            (+ read-pos read-size))))
 142     ;; write
 143     (if hide-read ; hide literal region if user has to choose encoding
 144         (narrow-to-region start-write-pos end-write-pos))
 145     (write-region start-write-pos end-write-pos
 146                   buffer-file-name write-pos 0)
 147     (delete-region start-write-pos end-write-pos)
 148     (if hide-read (widen))
 149     read-more))
 150
 151 (provide 'vlf-write)
 152
 153 ;;; vlf-write.el ends here