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

   1 ;;; vlf.el --- View Large Files  -*- lexical-binding: t -*-
   2
   3 ;; Copyright (C) 2006, 2012-2015 Free Software Foundation, Inc.
   4
   5 ;; Version: 1.7
   6 ;; Keywords: large files, utilities
   7 ;; Maintainer: Andrey Kotlarski <m00naticus@gmail.com>
   8 ;; Authors: 2006 Mathias Dahl <mathias.dahl@gmail.com>
   9 ;;          2012 Sam Steingold <sds@gnu.org>
  10 ;;          2013-2015 Andrey Kotlarski <m00naticus@gmail.com>
  11 ;; URL: https://github.com/m00natic/vlfi
  12
  13 ;; This file is free software; you can redistribute it and/or modify
  14 ;; it under the terms of the GNU General Public License as published by
  15 ;; the Free Software Foundation; either version 2, or (at your option)
  16 ;; any later version.
  17
  18 ;; This file is distributed in the hope that it will be useful,
  19 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  20 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  21 ;; GNU General Public License for more details.
  22
  23 ;; You should have received a copy of the GNU General Public License
  24 ;; along with GNU Emacs; see the file COPYING.  If not, write to
  25 ;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  26 ;; Boston, MA 02111-1307, USA.
  27
  28 ;;; Commentary:
  29 ;; This package provides the M-x vlf command, which visits part of
  30 ;; large file without loading it entirely.  The buffer uses VLF mode,
  31 ;; which provides several commands for moving around, searching,
  32 ;; comparing and editing selected part of file.
  33 ;; To have it offered when opening large files:
  34 ;; (require 'vlf-setup)
  35
  36 ;; This package was inspired by a snippet posted by Kevin Rodgers,
  37 ;; showing how to use `insert-file-contents' to extract part of a
  38 ;; file.
  39
  40 ;;; Code:
  41
  42 (require 'vlf-base)
  43
  44 (defcustom vlf-before-batch-functions nil
  45   "Hook that runs before multiple batch operations.
  46 One argument is supplied that specifies current action.  Possible
  47 values are: `write', `ediff', `occur', `search', `goto-line'."
  48   :group 'vlf :type 'hook)
  49
  50 (defcustom vlf-after-batch-functions nil
  51   "Hook that runs after multiple batch operations.
  52 One argument is supplied that specifies current action.  Possible
  53 values are: `write', `ediff', `occur', `search', `goto-line'."
  54   :group 'vlf :type 'hook)
  55
  56 (defvar hexl-bits)
  57
  58 (autoload 'vlf-write "vlf-write" "Write current chunk to file." t)
  59 (autoload 'vlf-re-search-forward "vlf-search"
  60   "Search forward for REGEXP prefix COUNT number of times." t)
  61 (autoload 'vlf-re-search-backward "vlf-search"
  62   "Search backward for REGEXP prefix COUNT number of times." t)
  63 (autoload 'vlf-goto-line "vlf-search" "Go to line." t)
  64 (autoload 'vlf-query-replace "vlf-search"
  65   "Query replace regexp over whole file." t)
  66 (autoload 'vlf-occur "vlf-occur"
  67   "Make whole file occur style index for REGEXP." t)
  68 (autoload 'vlf-toggle-follow "vlf-follow"
  69   "Toggle continuous chunk recenter around current point." t)
  70 (autoload 'vlf-stop-follow "vlf-follow" "Stop continuous recenter." t)
  71 (autoload 'vlf-ediff-buffers "vlf-ediff"
  72   "Run batch by batch ediff over VLF buffers." t)
  73
  74 (defvar vlf-mode-map
  75   (let ((map (make-sparse-keymap)))
  76     (define-key map "n" 'vlf-next-batch)
  77     (define-key map "p" 'vlf-prev-batch)
  78     (define-key map " " 'vlf-next-batch-from-point)
  79     (define-key map "+" 'vlf-change-batch-size)
  80     (define-key map "-"
  81       (lambda () "Decrease vlf batch size by factor of 2."
  82         (interactive)
  83         (vlf-change-batch-size t)))
  84     (define-key map "s" 'vlf-re-search-forward)
  85     (define-key map "r" 'vlf-re-search-backward)
  86     (define-key map "%" 'vlf-query-replace)
  87     (define-key map "o" 'vlf-occur)
  88     (define-key map "[" 'vlf-beginning-of-file)
  89     (define-key map "]" 'vlf-end-of-file)
  90     (define-key map "j" 'vlf-jump-to-chunk)
  91     (define-key map "l" 'vlf-goto-line)
  92     (define-key map "e" 'vlf-ediff-buffers)
  93     (define-key map "f" 'vlf-toggle-follow)
  94     (define-key map "g" 'vlf-revert)
  95     map)
  96   "Keymap for `vlf-mode'.")
  97
  98 (defvar vlf-prefix-map
  99   (let ((map (make-sparse-keymap)))
 100     (define-key map "\C-c\C-v" vlf-mode-map)
 101     map)
 102   "Prefixed keymap for `vlf-mode'.")
 103
 104 (define-minor-mode vlf-mode
 105   "Mode to browse large files in."
 106   :group 'vlf :keymap vlf-prefix-map
 107   :lighter (:eval (format " VLF[%d/%d](%s)"
 108                           (/ vlf-end-pos vlf-batch-size)
 109                           (/ vlf-file-size vlf-batch-size)
 110                           (file-size-human-readable vlf-file-size)))
 111   (cond (vlf-mode
 112          (set (make-local-variable 'require-final-newline) nil)
 113          (add-hook 'write-file-functions 'vlf-write nil t)
 114          (set (make-local-variable 'revert-buffer-function)
 115               'vlf-revert)
 116          (make-local-variable 'vlf-batch-size)
 117          (setq vlf-file-size (vlf-get-file-size buffer-file-truename)
 118                vlf-start-pos 0
 119                vlf-end-pos 0)
 120          (let* ((pos (position-bytes (point)))
 121                 (start (* (/ pos vlf-batch-size) vlf-batch-size)))
 122            (goto-char (byte-to-position (- pos start)))
 123            (vlf-move-to-batch start))
 124          (add-hook 'after-change-major-mode-hook 'vlf-keep-alive t t)
 125          (vlf-keep-alive))
 126         ((or (not large-file-warning-threshold)
 127              (< vlf-file-size large-file-warning-threshold)
 128              (y-or-n-p (format "Load whole file (%s)? "
 129                                (file-size-human-readable
 130                                 vlf-file-size))))
 131          (kill-local-variable 'revert-buffer-function)
 132          (vlf-stop-follow)
 133          (kill-local-variable 'require-final-newline)
 134          (remove-hook 'write-file-functions 'vlf-write t)
 135          (remove-hook 'after-change-major-mode-hook
 136                       'vlf-keep-alive t)
 137          (if (derived-mode-p 'hexl-mode)
 138              (let ((line (/ (1+ vlf-start-pos) hexl-bits))
 139                    (pos (point)))
 140                (if (consp buffer-undo-list)
 141                    (setq buffer-undo-list nil))
 142                (vlf-with-undo-disabled
 143                 (let ((inhibit-read-only t))
 144                   (insert-file-contents-literally buffer-file-name
 145                                                   t nil nil t)
 146                   (hexlify-buffer)))
 147                (set-buffer-modified-p nil)
 148                (goto-char (point-min))
 149                (forward-line line)
 150                (forward-char pos))
 151            (let ((pos (+ vlf-start-pos (position-bytes (point))))
 152                  (inhibit-read-only t))
 153              (vlf-with-undo-disabled
 154               (insert-file-contents buffer-file-name t nil nil t))
 155              (goto-char (byte-to-position pos)))))
 156         (t (setq vlf-mode t))))
 157
 158 (defun vlf-keep-alive ()
 159   "Keep `vlf-mode' on major mode change."
 160   (if (derived-mode-p 'hexl-mode)
 161       (set (make-local-variable 'revert-buffer-function) 'vlf-revert))
 162   (setq vlf-mode t))
 163
 164 ;;;###autoload
 165 (defun vlf (file &optional minimal)
 166   "View Large FILE in batches.  When MINIMAL load just a few bytes.
 167 You can customize number of bytes displayed by customizing
 168 `vlf-batch-size'.
 169 Return newly created buffer."
 170   (interactive (list (read-file-name "File to open: ") nil))
 171   (let ((vlf-buffer (generate-new-buffer "*vlf*")))
 172     (set-buffer vlf-buffer)
 173     (set-visited-file-name file)
 174     (set-buffer-modified-p nil)
 175     (if (or minimal (file-remote-p file))
 176         (set (make-local-variable 'vlf-batch-size) 1024))
 177     (vlf-mode 1)
 178     (when minimal                 ;restore batch size to default value
 179       (kill-local-variable 'vlf-batch-size)
 180       (make-local-variable 'vlf-batch-size))
 181     (switch-to-buffer vlf-buffer)
 182     vlf-buffer))
 183
 184 (defun vlf-next-batch (append)
 185   "Display the next batch of file data.
 186 When prefix argument is supplied and positive
 187  jump over APPEND number of batches.
 188 When prefix argument is negative
 189  append next APPEND number of batches to the existing buffer."
 190   (interactive "p")
 191   (vlf-verify-size)
 192   (vlf-tune-load (if (derived-mode-p 'hexl-mode)
 193                      '(:hexl :raw)
 194                    '(:insert :encode)))
 195   (let* ((end (min (+ vlf-end-pos (* vlf-batch-size (abs append)))
 196                    vlf-file-size))
 197          (start (if (< append 0)
 198                     vlf-start-pos
 199                   (- end vlf-batch-size))))
 200     (vlf-move-to-chunk start end)))
 201
 202 (defun vlf-prev-batch (prepend)
 203   "Display the previous batch of file data.
 204 When prefix argument is supplied and positive
 205  jump over PREPEND number of batches.
 206 When prefix argument is negative
 207  append previous PREPEND number of batches to the existing buffer."
 208   (interactive "p")
 209   (if (zerop vlf-start-pos)
 210       (error "Already at BOF"))
 211   (vlf-tune-load (if (derived-mode-p 'hexl-mode)
 212                      '(:hexl :raw)
 213                    '(:insert :encode)))
 214   (let* ((start (max 0 (- vlf-start-pos (* vlf-batch-size (abs prepend)))))
 215          (end (if (< prepend 0)
 216                   vlf-end-pos
 217                 (+ start vlf-batch-size))))
 218     (vlf-move-to-chunk start end)))
 219
 220 ;; scroll auto batching
 221 (defadvice scroll-up (around vlf-scroll-up
 222                              activate compile)
 223   "Slide to next batch if at end of buffer in `vlf-mode'."
 224   (if (and vlf-mode (pos-visible-in-window-p (point-max)))
 225       (progn (vlf-next-batch 1)
 226              (goto-char (point-min)))
 227     ad-do-it))
 228
 229 (defadvice scroll-down (around vlf-scroll-down
 230                                activate compile)
 231   "Slide to previous batch if at beginning of buffer in `vlf-mode'."
 232   (if (and vlf-mode (pos-visible-in-window-p (point-min)))
 233       (progn (vlf-prev-batch 1)
 234              (goto-char (point-max)))
 235     ad-do-it))
 236
 237 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 238 ;;; hexl mode integration
 239
 240 (eval-after-load "hexl"
 241   '(progn
 242      (defadvice hexl-save-buffer (around vlf-hexl-save
 243                                          activate compile)
 244        "Prevent hexl save if `vlf-mode' is active."
 245        (if vlf-mode
 246            (vlf-write)
 247          ad-do-it))
 248
 249      (defadvice hexl-scroll-up (around vlf-hexl-scroll-up
 250                                        activate compile)
 251        "Slide to next batch if at end of buffer in `vlf-mode'."
 252        (if (and vlf-mode (pos-visible-in-window-p (point-max))
 253                 (or (not (numberp arg)) (< 0 arg)))
 254            (progn (vlf-next-batch 1)
 255                   (goto-char (point-min)))
 256          ad-do-it))
 257
 258      (defadvice hexl-scroll-down (around vlf-hexl-scroll-down
 259                                          activate compile)
 260        "Slide to previous batch if at beginning of buffer in `vlf-mode'."
 261        (if (and vlf-mode (pos-visible-in-window-p (point-min)))
 262            (progn (vlf-prev-batch 1)
 263                   (goto-char (point-max)))
 264          ad-do-it))
 265
 266      (defadvice hexl-mode-exit (around vlf-hexl-mode-exit
 267                                        activate compile)
 268        "Exit `hexl-mode' gracefully in case `vlf-mode' is active."
 269        (if (and vlf-mode (not (buffer-modified-p)))
 270            (vlf-with-undo-disabled
 271             (erase-buffer)
 272             ad-do-it
 273             (vlf-move-to-chunk-2 vlf-start-pos vlf-end-pos))
 274          ad-do-it))))
 275
 276 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 277 ;;; utilities
 278
 279 (defun vlf-change-batch-size (decrease)
 280   "Change the buffer-local value of `vlf-batch-size'.
 281 Normally, the value is doubled;
 282 with the prefix argument DECREASE it is halved."
 283   (interactive "P")
 284   (vlf-set-batch-size (if decrease (/ vlf-batch-size 2)
 285                         (* vlf-batch-size 2))))
 286
 287 (defun vlf-set-batch-size (size)
 288   "Set batch to SIZE bytes and update chunk."
 289   (interactive
 290    (list (read-number "Size in bytes: "
 291                       (vlf-tune-optimal-load
 292                        (if (derived-mode-p 'hexl-mode)
 293                            '(:hexl :raw)
 294                          '(:insert :encode))))))
 295   (setq vlf-batch-size size)
 296   (vlf-move-to-batch vlf-start-pos))
 297
 298 (defun vlf-beginning-of-file ()
 299   "Jump to beginning of file content."
 300   (interactive)
 301   (vlf-tune-load (if (derived-mode-p 'hexl-mode)
 302                      '(:hexl :raw)
 303                    '(:insert :encode)))
 304   (vlf-move-to-batch 0))
 305
 306 (defun vlf-end-of-file ()
 307   "Jump to end of file content."
 308   (interactive)
 309   (vlf-verify-size)
 310   (vlf-tune-load (if (derived-mode-p 'hexl-mode)
 311                      '(:hexl :raw)
 312                    '(:insert :encode)))
 313   (vlf-move-to-batch vlf-file-size))
 314
 315 (defun vlf-revert (&optional _auto noconfirm)
 316   "Revert current chunk.  Ignore _AUTO.
 317 Ask for confirmation if NOCONFIRM is nil."
 318   (interactive)
 319   (when (or noconfirm
 320             (yes-or-no-p (format "Revert buffer from file %s? "
 321                                  buffer-file-name)))
 322     (set-buffer-modified-p nil)
 323     (vlf-move-to-chunk-2 vlf-start-pos vlf-end-pos)))
 324
 325 (defun vlf-jump-to-chunk (n)
 326   "Go to to chunk N."
 327   (interactive "nGoto to chunk: ")
 328   (vlf-tune-load (if (derived-mode-p 'hexl-mode)
 329                      '(:hexl :raw)
 330                    '(:insert :encode)))
 331   (vlf-move-to-batch (* (1- n) vlf-batch-size)))
 332
 333 (defun vlf-no-modifications ()
 334   "Ensure there are no buffer modifications."
 335   (if (buffer-modified-p)
 336       (error "Save or discard your changes first")
 337     t))
 338
 339 (defun vlf-move-to-batch (start)
 340   "Move to batch determined by START.
 341 Adjust according to file start/end and show `vlf-batch-size' bytes."
 342   (vlf-verify-size)
 343   (let* ((start (max 0 start))
 344          (end (min (+ start vlf-batch-size) vlf-file-size)))
 345     (if (= vlf-file-size end)          ; re-adjust start
 346         (setq start (max 0 (- end vlf-batch-size))))
 347     (vlf-move-to-chunk start end)))
 348
 349 (defun vlf-next-batch-from-point ()
 350   "Display batch of file data starting from current point."
 351   (interactive)
 352   (let ((start (+ vlf-start-pos (position-bytes (point)) -1)))
 353     (vlf-move-to-chunk start (+ start vlf-batch-size)))
 354   (goto-char (point-min)))
 355
 356 (provide 'vlf)
 357
 358 ;;; vlf.el ends here