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

   1 ;;; vlf-base.el --- VLF primitive operations  -*- lexical-binding: t -*-
   2
   3 ;; Copyright (C) 2014 Free Software Foundation, Inc.
   4
   5 ;; Keywords: large files, chunk
   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 basic chunk operations for VLF,
  26 ;; most notable being the `vlf-move-to-chunk' function.
  27
  28 ;;; Code:
  29
  30 (defgroup vlf nil
  31   "View Large Files in Emacs."
  32   :prefix "vlf-"
  33   :group 'files)
  34
  35 (defcustom vlf-batch-size 1024
  36   "Defines how large each batch of file data is (in bytes)."
  37   :group 'vlf
  38   :type 'integer)
  39 (put 'vlf-batch-size 'permanent-local t)
  40
  41 ;;; Keep track of file position.
  42 (defvar vlf-start-pos 0
  43   "Absolute position of the visible chunk start.")
  44 (make-variable-buffer-local 'vlf-start-pos)
  45 (put 'vlf-start-pos 'permanent-local t)
  46
  47 (defvar vlf-end-pos 0 "Absolute position of the visible chunk end.")
  48 (make-variable-buffer-local 'vlf-end-pos)
  49 (put 'vlf-end-pos 'permanent-local t)
  50
  51 (defvar vlf-file-size 0 "Total size of presented file.")
  52 (make-variable-buffer-local 'vlf-file-size)
  53 (put 'vlf-file-size 'permanent-local t)
  54
  55 (defconst vlf-sample-size 24
  56   "Minimal number of bytes that can be properly decoded.")
  57
  58 (defun vlf-get-file-size (file)
  59   "Get size in bytes of FILE."
  60   (or (nth 7 (file-attributes file)) 0))
  61
  62 (defun vlf-verify-size (&optional update-visited-time)
  63   "Update file size information if necessary and visited file time.
  64 If non-nil, UPDATE-VISITED-TIME."
  65   (unless (verify-visited-file-modtime (current-buffer))
  66     (setq vlf-file-size (vlf-get-file-size buffer-file-truename))
  67     (if update-visited-time
  68         (set-visited-file-modtime))))
  69
  70 (unless (fboundp 'file-size-human-readable)
  71   (defun file-size-human-readable (file-size)
  72     "Print FILE-SIZE in MB."
  73     (format "%.3fMB" (/ file-size 1048576.0))))
  74
  75 (defun vlf-update-buffer-name ()
  76   "Update the current buffer name."
  77   (rename-buffer (format "%s(%d/%d)[%s]"
  78                          (file-name-nondirectory buffer-file-name)
  79                          (/ vlf-end-pos vlf-batch-size)
  80                          (/ vlf-file-size vlf-batch-size)
  81                          (file-size-human-readable vlf-batch-size))
  82                  t))
  83
  84 (defmacro vlf-with-undo-disabled (&rest body)
  85   "Execute BODY with temporarily disabled undo."
  86   `(let ((undo-list buffer-undo-list))
  87      (setq buffer-undo-list t)
  88      (unwind-protect (progn ,@body)
  89        (setq buffer-undo-list undo-list))))
  90
  91 (defun vlf-move-to-chunk (start end &optional minimal)
  92   "Move to chunk enclosed by START END bytes.
  93 When given MINIMAL flag, skip non important operations.
  94 If same as current chunk is requested, do nothing.
  95 Return number of bytes moved back for proper decoding and number of
  96 bytes added to the end."
  97   (unless (and (= start vlf-start-pos)
  98                (= end vlf-end-pos))
  99     (vlf-verify-size)
 100     (let ((shifts (vlf-move-to-chunk-1 start end)))
 101       (and shifts (not minimal)
 102            (vlf-update-buffer-name))
 103       shifts)))
 104
 105 (defun vlf-move-to-chunk-1 (start end)
 106   "Move to chunk enclosed by START END keeping as much edits if any.
 107 Return number of bytes moved back for proper decoding and number of
 108 bytes added to the end."
 109   (widen)
 110   (let* ((modified (buffer-modified-p))
 111          (start (max 0 start))
 112          (end (min end vlf-file-size))
 113          (edit-end (if modified
 114                        (+ vlf-start-pos
 115                           (length (encode-coding-region
 116                                    (point-min) (point-max)
 117                                    buffer-file-coding-system t)))
 118                      vlf-end-pos)))
 119     (cond
 120      ((or (< edit-end start) (< end vlf-start-pos)
 121           (not (verify-visited-file-modtime (current-buffer))))
 122       (when (or (not modified)
 123                 (y-or-n-p "Chunk modified, are you sure? ")) ;full chunk renewal
 124         (set-buffer-modified-p nil)
 125         (vlf-move-to-chunk-2 start end)))
 126      ((and (= start vlf-start-pos) (= end edit-end))
 127       (or modified (vlf-move-to-chunk-2 start end)))
 128      ((or (and (<= start vlf-start-pos) (<= edit-end end))
 129           (not modified)
 130           (y-or-n-p "Chunk modified, are you sure? "))
 131       (let ((shift-start 0)
 132             (shift-end 0))
 133         (let ((pos (+ (position-bytes (point)) vlf-start-pos))
 134               (inhibit-read-only t))
 135           (cond ((< end edit-end)
 136                  (let* ((del-pos (1+ (or (byte-to-position
 137                                           (- end vlf-start-pos))
 138                                          0)))
 139                         (del-len (length (encode-coding-region
 140                                           del-pos (point-max)
 141                                           buffer-file-coding-system
 142                                           t))))
 143                    (setq end (- (if (zerop vlf-end-pos)
 144                                     vlf-file-size
 145                                   vlf-end-pos)
 146                                 del-len))
 147                    (vlf-with-undo-disabled
 148                     (delete-region del-pos (point-max)))))
 149                 ((< edit-end end)
 150                  (vlf-with-undo-disabled
 151                   (setq shift-end (cdr (vlf-insert-file-contents
 152                                         vlf-end-pos end
 153                                         (/= start vlf-end-pos) t
 154                                         (point-max)))))))
 155           (cond ((< vlf-start-pos start)
 156                  (let* ((del-pos (1+ (byte-to-position
 157                                       (- start vlf-start-pos))))
 158                         (del-len (length (encode-coding-region
 159                                           (point-min) del-pos
 160                                           buffer-file-coding-system
 161                                           t))))
 162                    (setq start (+ vlf-start-pos del-len))
 163                    (vlf-with-undo-disabled
 164                     (delete-region (point-min) del-pos))
 165                    (vlf-shift-undo-list (- (point-min) del-pos))))
 166                 ((< start vlf-start-pos)
 167                  (let ((edit-end-pos (point-max)))
 168                    (vlf-with-undo-disabled
 169                     (setq shift-start (car (vlf-insert-file-contents
 170                                             start vlf-start-pos t
 171                                             (/= end vlf-start-pos)
 172                                             edit-end-pos)))
 173                     (goto-char (point-min))
 174                     (insert (delete-and-extract-region
 175                              edit-end-pos (point-max))))
 176                    (vlf-shift-undo-list (- (point-max) edit-end-pos)))))
 177           (setq start (- start shift-start))
 178           (goto-char (or (byte-to-position (- pos start))
 179                          (byte-to-position (- pos vlf-start-pos))
 180                          (point-max)))
 181           (setq vlf-start-pos start
 182                 vlf-end-pos (+ end shift-end)))
 183         (set-buffer-modified-p modified)
 184         (set-visited-file-modtime)
 185         (cons shift-start shift-end))))))
 186
 187 (defun vlf-move-to-chunk-2 (start end)
 188   "Unconditionally move to chunk enclosed by START END bytes.
 189 Return number of bytes moved back for proper decoding and number of
 190 bytes added to the end."
 191   (vlf-verify-size t)
 192   (setq vlf-start-pos (max 0 start)
 193         vlf-end-pos (min end vlf-file-size))
 194   (let (shifts)
 195     (let ((inhibit-read-only t)
 196           (pos (position-bytes (point))))
 197       (vlf-with-undo-disabled
 198        (erase-buffer)
 199        (setq shifts (vlf-insert-file-contents vlf-start-pos
 200                                               vlf-end-pos t t)
 201              vlf-start-pos (- vlf-start-pos (car shifts))
 202              vlf-end-pos (+ vlf-end-pos (cdr shifts)))
 203        (goto-char (or (byte-to-position (+ pos (car shifts)))
 204                       (point-max)))))
 205     (set-buffer-modified-p nil)
 206     (setq buffer-undo-list nil)
 207     shifts))
 208
 209 (defun vlf-insert-file-contents (start end adjust-start adjust-end
 210                                        &optional position)
 211   "Adjust chunk at absolute START to END till content can be\
 212 properly decoded.  ADJUST-START determines if trying to prepend bytes\
 213  to the beginning, ADJUST-END - append to the end.
 214 Use buffer POSITION as start if given.
 215 Return number of bytes moved back for proper decoding and number of
 216 bytes added to the end."
 217   (setq adjust-start (and adjust-start (not (zerop start)))
 218         adjust-end (and adjust-end (< end vlf-file-size))
 219         position (or position (point-min)))
 220   (goto-char position)
 221   (let ((shift-start 0)
 222         (shift-end 0)
 223         (safe-end (if adjust-end
 224                       (min vlf-file-size (+ end 4))
 225                     end)))
 226     (if adjust-start
 227         (setq shift-start (vlf-adjust-start start safe-end position
 228                                             adjust-end)
 229               start (- start shift-start))
 230       (vlf-insert-file-contents-safe start safe-end position))
 231     (if adjust-end
 232         (setq shift-end (vlf-adjust-end start end position)))
 233     (cons shift-start shift-end)))
 234
 235 (defun vlf-adjust-start (start end position adjust-end)
 236   "Adjust chunk beginning at absolute START to END till content can\
 237 be properly decoded.  Use buffer POSITION as start.
 238 ADJUST-END is non-nil if end would be adjusted later.
 239 Return number of bytes moved back for proper decoding."
 240   (let* ((safe-start (max 0 (- start 4)))
 241          (sample-end (min end (+ safe-start vlf-sample-size)))
 242          (chunk-size (- sample-end safe-start))
 243          (strict (or (= sample-end vlf-file-size)
 244                      (and (not adjust-end) (= sample-end end))))
 245          (shift 0))
 246     (while (and (progn (vlf-insert-file-contents-safe
 247                         safe-start sample-end position)
 248                        (not (zerop safe-start)))
 249                 (< shift 3)
 250                 (let ((diff (- chunk-size
 251                                (length
 252                                 (encode-coding-region
 253                                  position (point-max)
 254                                  buffer-file-coding-system t)))))
 255                   (if strict
 256                       (not (zerop diff))
 257                     (or (< diff -3) (< 0 diff)))))
 258       (setq shift (1+ shift)
 259             safe-start (1- safe-start)
 260             chunk-size (1+ chunk-size))
 261       (delete-region position (point-max)))
 262     (let ((cut-pos position)
 263           (cut-len 0))
 264       (while (< safe-start start)
 265         (setq cut-len (length (encode-coding-region
 266                                cut-pos (1+ cut-pos)
 267                                buffer-file-coding-system t))
 268               cut-pos (1+ cut-pos)
 269               safe-start (+ safe-start cut-len)))
 270       (if (< start safe-start)
 271           (setq safe-start (- safe-start cut-len)
 272                 cut-pos (1- cut-pos)))
 273       (if (= sample-end end)
 274           (delete-region position cut-pos)
 275         (delete-region position (point-max))
 276         (vlf-insert-file-contents-safe safe-start end position)))
 277     (- start safe-start)))
 278
 279 (defun vlf-adjust-end (start end position)
 280   "Adjust chunk end at absolute START to END starting at POSITION.
 281 Remove characters from the end until length is closest to expected.
 282 Return number of bytes added over expected."
 283   (let ((expected-size (- end start))
 284         (current-size (length (encode-coding-region
 285                                position (point-max)
 286                                buffer-file-coding-system t)))
 287         (cut-point (point-max))
 288         (cut-len 0))
 289     (while (< expected-size current-size)
 290       (setq cut-len (length (encode-coding-region
 291                              (1- cut-point) cut-point
 292                              buffer-file-coding-system t))
 293             cut-point (1- cut-point)
 294             current-size (- current-size cut-len)))
 295     (if (< current-size expected-size)
 296         (setq cut-point (1+ cut-point)
 297               current-size (+ current-size cut-len)))
 298     (delete-region cut-point (point-max))
 299     (- current-size expected-size)))
 300
 301 (defun vlf-insert-file-contents-safe (start end position)
 302   "Extract decoded file bytes START to END at POSITION."
 303   (let ((coding buffer-file-coding-system))
 304     (insert-file-contents-literally buffer-file-name nil start end)
 305     (let ((coding-system-for-read coding))
 306       (decode-coding-inserted-region position (point-max)
 307                                      buffer-file-name nil start end)))
 308   (setq buffer-file-coding-system last-coding-system-used))
 309
 310 (defun vlf-shift-undo-list (n)
 311   "Shift undo list element regions by N."
 312   (or (eq buffer-undo-list t)
 313       (setq buffer-undo-list
 314             (nreverse
 315              (let ((min (point-min))
 316                    undo-list)
 317                (catch 'end
 318                  (dolist (el buffer-undo-list undo-list)
 319                    (push
 320                     (cond
 321                      ((null el) nil)
 322                      ((numberp el) (let ((pos (+ el n)))
 323                                      (if (< pos min)
 324                                          (throw 'end undo-list)
 325                                        pos)))
 326                      (t (let ((head (car el)))
 327                           (cond ((numberp head)
 328                                  (let ((beg (+ head n)))
 329                                    (if (< beg min)
 330                                        (throw 'end undo-list)
 331                                      (cons beg (+ (cdr el) n)))))
 332                                 ((stringp head)
 333                                  (let* ((pos (cdr el))
 334                                         (positive (< 0 pos))
 335                                         (new (+ (abs pos) n)))
 336                                    (if (< new min)
 337                                        (throw 'end undo-list)
 338                                      (cons head (if positive
 339                                                     new
 340                                                   (- new))))))
 341                                 ((null head)
 342                                  (let ((beg (+ (nth 3 el) n)))
 343                                    (if (< beg min)
 344                                        (throw 'end undo-list)
 345                                      (cons
 346                                       nil
 347                                       (cons
 348                                        (cadr el)
 349                                        (cons
 350                                         (nth 2 el)
 351                                         (cons beg
 352                                               (+ (cddr
 353                                                   (cddr el)) n))))))))
 354                                 ((and (eq head 'apply)
 355                                       (numberp (cadr el)))
 356                                  (let ((beg (+ (nth 2 el) n)))
 357                                    (if (< beg min)
 358                                        (throw 'end undo-list)
 359                                      (cons
 360                                       'apply
 361                                       (cons
 362                                        (cadr el)
 363                                        (cons
 364                                         beg
 365                                         (cons
 366                                          (+ (nth 3 el) n)
 367                                          (cons (nth 4 el)
 368                                                (cdr (last el))))))))))
 369                                 (t el)))))
 370                     undo-list))))))))
 371
 372 (provide 'vlf-base)
 373
 374 ;;; vlf-base.el ends here