]> code.delx.au - gnu-emacs-elpa/blobdiff - packages/vlf/vlf-write.el
* packages/vlf: Version 1.7
[gnu-emacs-elpa] / packages / vlf / vlf-write.el
index 1c5db49db64dc4fc7f47c7d10edf1eb8f437d036..ae1eda64415eacaa250204a4303e04bd5324065e 100644 (file)
 
 (require 'vlf-base)
 
+(defcustom vlf-save-in-place 'ask
+  "Should VLF save in place when additional adjustment of file content\
+is needed."
+  :group 'vlf :type '(choice (const :tag "Always when applicable" t)
+                             (const :tag "Ask when applicable" 'ask)
+                             (const :tag "Never" nil)))
+
 (defun vlf-write ()
   "Write current chunk to file.  Always return true to disable save.
 If changing size of chunk, shift remaining file content."
@@ -37,43 +44,70 @@ If changing size of chunk, shift remaining file content."
              (or (verify-visited-file-modtime (current-buffer))
                  (y-or-n-p "File has changed since visited or saved.\
   Save anyway? ")))
+    (widen)
     (run-hook-with-args 'vlf-before-batch-functions 'write)
-    (if (zerop vlf-file-size)           ;new file
-        (progn (write-region nil nil buffer-file-name vlf-start-pos t)
-               (setq vlf-file-size (vlf-get-file-size
-                                    buffer-file-truename)
-                     vlf-end-pos vlf-file-size)
-               (vlf-update-buffer-name))
-      (widen)
-      (let* ((region-length (length (encode-coding-region
-                                     (point-min) (point-max)
-                                     buffer-file-coding-system t)))
-             (size-change (- vlf-end-pos vlf-start-pos
-                             region-length)))
-        (if (zerop size-change)
-            (write-region nil nil buffer-file-name vlf-start-pos t)
-          (let ((tramp-verbose (if (boundp 'tramp-verbose)
-                                   (min tramp-verbose 2)))
-                (pos (point))
-                (font-lock font-lock-mode))
-            (font-lock-mode 0)
-            (if (< 0 size-change)
-                (vlf-file-shift-back size-change)
-              (vlf-file-shift-forward (- size-change)))
-            (if font-lock (font-lock-mode 1))
-            (vlf-move-to-chunk-2 vlf-start-pos
-                                 (if (< (- vlf-end-pos vlf-start-pos)
-                                        vlf-batch-size)
-                                     (+ vlf-start-pos vlf-batch-size)
-                                   vlf-end-pos))
-            (vlf-update-buffer-name)
-            (goto-char pos)))))
+    (let ((hexl (derived-mode-p 'hexl-mode)))
+      (when hexl
+        (if (consp buffer-undo-list)
+            (setq buffer-undo-list nil))
+        (vlf-tune-dehexlify))
+      (if (zerop vlf-file-size)           ;new file
+          (progn (vlf-tune-write nil nil vlf-start-pos t
+                                 (vlf-tune-encode-length (point-min)
+                                                         (point-max)))
+                 (if hexl (vlf-tune-hexlify))
+                 (setq vlf-file-size (vlf-get-file-size
+                                      buffer-file-truename)
+                       vlf-end-pos vlf-file-size))
+        (let* ((region-length (vlf-tune-encode-length (point-min)
+                                                      (point-max)))
+               (size-change (- vlf-end-pos vlf-start-pos
+                               region-length)))
+          (if (zerop size-change)
+              (progn (vlf-tune-write nil nil vlf-start-pos t
+                                     (- vlf-end-pos vlf-start-pos))
+                     (if hexl (vlf-tune-hexlify)))
+            (let ((pos (point))
+                  (font-lock font-lock-mode)
+                  (batch-size vlf-batch-size)
+                  time)
+              (font-lock-mode 0)
+              (if (or (file-remote-p buffer-file-name)
+                      (if (eq vlf-save-in-place 'ask)
+                          (y-or-n-p "File content needs be adjusted\
+ till end.  Use temporary copy of the whole file (slower but safer)? ")
+                        (not vlf-save-in-place)))
+                  (let ((file-tmp (make-temp-file "vlf")))
+                    (setq time (float-time))
+                    (copy-file buffer-file-name file-tmp t t t t)
+                    (if (< 0 size-change)
+                        (vlf-file-shift-back size-change region-length
+                                             file-tmp)
+                      (vlf-file-shift-forward (- size-change)
+                                              region-length file-tmp))
+                    (rename-file file-tmp buffer-file-name t))
+                (setq time (float-time))
+                (if (< 0 size-change)
+                    (vlf-file-shift-back size-change region-length)
+                  (vlf-file-shift-forward (- size-change)
+                                          region-length)))
+              (if font-lock (font-lock-mode 1))
+              (setq vlf-batch-size batch-size)
+              (vlf-move-to-chunk-2 vlf-start-pos
+                                   (if (< (- vlf-end-pos vlf-start-pos)
+                                          vlf-batch-size)
+                                       (+ vlf-start-pos vlf-batch-size)
+                                     vlf-end-pos))
+              (goto-char pos)
+              (message "Save took %f seconds" (- (float-time) time)))))))
     (run-hook-with-args 'vlf-after-batch-functions 'write))
   t)
 
-(defun vlf-file-shift-back (size-change)
-  "Shift file contents SIZE-CHANGE bytes back."
-  (write-region nil nil buffer-file-name vlf-start-pos t)
+(defun vlf-file-shift-back (size-change write-size &optional file)
+  "Shift file contents SIZE-CHANGE bytes back.
+WRITE-SIZE is byte length of saved chunk.
+FILE if given is filename to be used, otherwise `buffer-file-name'."
+  (vlf-tune-write nil nil vlf-start-pos (if file nil t) write-size file)
   (let ((read-start-pos vlf-end-pos)
         (coding-system-for-write 'no-conversion)
         (reporter (make-progress-reporter "Adjusting file content..."
@@ -81,69 +115,84 @@ If changing size of chunk, shift remaining file content."
                                           vlf-file-size)))
     (vlf-with-undo-disabled
      (while (vlf-shift-batch read-start-pos (- read-start-pos
-                                               size-change))
+                                               size-change)
+                             file)
        (setq read-start-pos (+ read-start-pos vlf-batch-size))
        (progress-reporter-update reporter read-start-pos))
      ;; pad end with space
      (erase-buffer)
-     (vlf-verify-size t)
+     (vlf-verify-size t file)
      (insert-char 32 size-change))
-    (write-region nil nil buffer-file-name (- vlf-file-size
-                                              size-change) t)
+    (vlf-tune-write nil nil (- vlf-file-size size-change)
+                    (if file nil t) size-change file)
     (progress-reporter-done reporter)))
 
-(defun vlf-shift-batch (read-pos write-pos)
+(defun vlf-shift-batch (read-pos write-pos file)
   "Read `vlf-batch-size' bytes from READ-POS and write them \
-back at WRITE-POS.  Return nil if EOF is reached, t otherwise."
+back at WRITE-POS using FILE.
+Return nil if EOF is reached, t otherwise."
   (erase-buffer)
-  (vlf-verify-size t)
-  (let ((read-end (+ read-pos vlf-batch-size)))
-    (insert-file-contents-literally buffer-file-name nil
-                                    read-pos
-                                    (min vlf-file-size read-end))
-    (write-region nil nil buffer-file-name write-pos 0)
+  (vlf-verify-size t file)
+  (vlf-tune-batch '(:raw :write) nil file) ;insert speed over temp write file may defer wildly
+  (let ((read-end (min (+ read-pos vlf-batch-size) vlf-file-size))) ;compared to the original file
+    (vlf-tune-insert-file-contents-literally read-pos read-end file)
+    (vlf-tune-write nil nil write-pos 0 (- read-end read-pos) file)
     (< read-end vlf-file-size)))
 
-(defun vlf-file-shift-forward (size-change)
+(defun vlf-file-shift-forward (size-change write-size &optional file)
   "Shift file contents SIZE-CHANGE bytes forward.
+WRITE-SIZE is byte length of saved chunk.
+FILE if given is filename to be used, otherwise `buffer-file-name'.
 Done by saving content up front and then writing previous batch."
-  (let ((read-size (max (/ vlf-batch-size 2) size-change))
+  (vlf-tune-batch '(:raw :write) nil file)
+  (let ((read-size (max vlf-batch-size size-change))
         (read-pos vlf-end-pos)
         (write-pos vlf-start-pos)
         (reporter (make-progress-reporter "Adjusting file content..."
                                           vlf-start-pos
                                           vlf-file-size)))
     (vlf-with-undo-disabled
-     (when (vlf-shift-batches read-size read-pos write-pos t)
+     (when (vlf-shift-batches read-size read-pos write-pos
+                              write-size t file)
+       (vlf-tune-batch '(:raw :write) nil file)
        (setq write-pos (+ read-pos size-change)
-             read-pos (+ read-pos read-size))
+             read-pos (+ read-pos read-size)
+             write-size read-size
+             read-size (max vlf-batch-size size-change))
        (progress-reporter-update reporter write-pos)
        (let ((coding-system-for-write 'no-conversion))
-         (while (vlf-shift-batches read-size read-pos write-pos nil)
+         (while (vlf-shift-batches read-size read-pos write-pos
+                                   write-size nil file)
+           (vlf-tune-batch '(:raw :write) nil file)
            (setq write-pos (+ read-pos size-change)
-                 read-pos (+ read-pos read-size))
+                 read-pos (+ read-pos read-size)
+                 write-size read-size
+                 read-size (max vlf-batch-size size-change))
            (progress-reporter-update reporter write-pos)))))
     (progress-reporter-done reporter)))
 
-(defun vlf-shift-batches (read-size read-pos write-pos hide-read)
+(defun vlf-shift-batches (read-size read-pos write-pos write-size
+                                    hide-read file)
   "Append READ-SIZE bytes of file starting at READ-POS.
 Then write initial buffer content to file at WRITE-POS.
+WRITE-SIZE is byte length of saved chunk.
 If HIDE-READ is non nil, temporarily hide literal read content.
+FILE if given is filename to be used, otherwise `buffer-file-name'.
 Return nil if EOF is reached, t otherwise."
-  (vlf-verify-size t)
+  (vlf-verify-size t file)
   (let ((read-more (< read-pos vlf-file-size))
         (start-write-pos (point-min))
         (end-write-pos (point-max)))
     (when read-more
       (goto-char end-write-pos)
-      (insert-file-contents-literally buffer-file-name nil read-pos
-                                      (min vlf-file-size
-                                           (+ read-pos read-size))))
+      (vlf-tune-insert-file-contents-literally
+       read-pos (min vlf-file-size (+ read-pos read-size)) file))
     ;; write
     (if hide-read ; hide literal region if user has to choose encoding
         (narrow-to-region start-write-pos end-write-pos))
-    (write-region start-write-pos end-write-pos
-                  buffer-file-name write-pos 0)
+    (vlf-tune-write start-write-pos end-write-pos write-pos
+                    (or (and (not read-more) (not file)) 0)
+                    write-size file)
     (delete-region start-write-pos end-write-pos)
     (if hide-read (widen))
     read-more))