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-2014 Free Software Foundation, Inc.
   4
   5 ;; Version: 1.6
   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-2014 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-integrate)
  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 (autoload 'vlf-write "vlf-write" "Write current chunk to file." t)
  57 (autoload 'vlf-re-search-forward "vlf-search"
  58   "Search forward for REGEXP prefix COUNT number of times." t)
  59 (autoload 'vlf-re-search-backward "vlf-search"
  60   "Search backward for REGEXP prefix COUNT number of times." t)
  61 (autoload 'vlf-goto-line "vlf-search" "Go to line." t)
  62 (autoload 'vlf-occur "vlf-occur"
  63   "Make whole file occur style index for REGEXP." t)
  64 (autoload 'vlf-toggle-follow "vlf-follow"
  65   "Toggle continuous chunk recenter around current point." t)
  66 (autoload 'vlf-stop-follow "vlf-follow" "Stop continuous recenter." t)
  67 (autoload 'vlf-ediff-buffers "vlf-ediff"
  68   "Run batch by batch ediff over VLF buffers." t)
  69
  70 (defvar vlf-mode-map
  71   (let ((map (make-sparse-keymap)))
  72     (define-key map "n" 'vlf-next-batch)
  73     (define-key map "p" 'vlf-prev-batch)
  74     (define-key map " " 'vlf-next-batch-from-point)
  75     (define-key map "+" 'vlf-change-batch-size)
  76     (define-key map "-"
  77       (lambda () "Decrease vlf batch size by factor of 2."
  78         (interactive)
  79         (vlf-change-batch-size t)))
  80     (define-key map "s" 'vlf-re-search-forward)
  81     (define-key map "r" 'vlf-re-search-backward)
  82     (define-key map "o" 'vlf-occur)
  83     (define-key map "[" 'vlf-beginning-of-file)
  84     (define-key map "]" 'vlf-end-of-file)
  85     (define-key map "j" 'vlf-jump-to-chunk)
  86     (define-key map "l" 'vlf-goto-line)
  87     (define-key map "e" 'vlf-ediff-buffers)
  88     (define-key map "f" 'vlf-toggle-follow)
  89     (define-key map "g" 'vlf-revert)
  90     map)
  91   "Keymap for `vlf-mode'.")
  92
  93 (defvar vlf-prefix-map
  94   (let ((map (make-sparse-keymap)))
  95     (define-key map "\C-c\C-v" vlf-mode-map)
  96     map)
  97   "Prefixed keymap for `vlf-mode'.")
  98
  99 (define-minor-mode vlf-mode
 100   "Mode to browse large files in."
 101   :lighter " VLF" :group 'vlf :keymap vlf-prefix-map
 102   (cond (vlf-mode
 103          (set (make-local-variable 'require-final-newline) nil)
 104          (add-hook 'write-file-functions 'vlf-write nil t)
 105          (set (make-local-variable 'revert-buffer-function)
 106               'vlf-revert)
 107          (make-local-variable 'vlf-batch-size)
 108          (setq vlf-file-size (vlf-get-file-size buffer-file-truename)
 109                vlf-start-pos 0
 110                vlf-end-pos 0)
 111          (let* ((pos (position-bytes (point)))
 112                 (start (* (/ pos vlf-batch-size) vlf-batch-size)))
 113            (goto-char (byte-to-position (- pos start)))
 114            (vlf-move-to-batch start))
 115          (add-hook 'after-change-major-mode-hook 'vlf-keep-alive t t)
 116          (vlf-keep-alive))
 117         ((or (not large-file-warning-threshold)
 118              (< vlf-file-size large-file-warning-threshold)
 119              (y-or-n-p (format "Load whole file (%s)? "
 120                                (file-size-human-readable
 121                                 vlf-file-size))))
 122          (kill-local-variable 'revert-buffer-function)
 123          (vlf-stop-follow)
 124          (kill-local-variable 'require-final-newline)
 125          (remove-hook 'write-file-functions 'vlf-write t)
 126          (remove-hook 'after-change-major-mode-hook
 127                       'vlf-keep-alive t)
 128          (let ((hexl (derived-mode-p 'hexl-mode)))
 129            (if hexl (hexl-mode-exit))
 130            (let ((pos (+ vlf-start-pos (position-bytes (point)))))
 131              (vlf-with-undo-disabled
 132               (insert-file-contents buffer-file-name t nil nil t))
 133              (goto-char (byte-to-position pos)))
 134            (if hexl (hexl-mode)))
 135          (rename-buffer (file-name-nondirectory buffer-file-name) t))
 136         (t (setq vlf-mode t))))
 137
 138 (defun vlf-keep-alive ()
 139   "Keep `vlf-mode' on major mode change."
 140   (if (derived-mode-p 'hexl-mode)
 141       (set (make-local-variable 'revert-buffer-function) 'vlf-revert))
 142   (setq vlf-mode t))
 143
 144 ;;;###autoload
 145 (defun vlf (file &optional minimal)
 146   "View Large FILE in batches.  When MINIMAL load just a few bytes.
 147 You can customize number of bytes displayed by customizing
 148 `vlf-batch-size'.
 149 Return newly created buffer."
 150   (interactive (list (read-file-name "File to open: ") nil))
 151   (let ((vlf-buffer (generate-new-buffer "*vlf*")))
 152     (set-buffer vlf-buffer)
 153     (set-visited-file-name file)
 154     (set-buffer-modified-p nil)
 155     (if (or minimal (file-remote-p file))
 156         (set (make-local-variable 'vlf-batch-size) 1024))
 157     (vlf-mode 1)
 158     (when minimal                 ;restore batch size to default value
 159       (kill-local-variable 'vlf-batch-size)
 160       (make-local-variable 'vlf-batch-size))
 161     (switch-to-buffer vlf-buffer)
 162     vlf-buffer))
 163
 164 (defun vlf-next-batch (append)
 165   "Display the next batch of file data.
 166 When prefix argument is supplied and positive
 167  jump over APPEND number of batches.
 168 When prefix argument is negative
 169  append next APPEND number of batches to the existing buffer."
 170   (interactive "p")
 171   (vlf-verify-size)
 172   (vlf-tune-load (if (derived-mode-p 'hexl-mode)
 173                      '(:hexl :dehexlify :insert :encode)
 174                    '(:insert :encode)))
 175   (let* ((end (min (+ vlf-end-pos (* vlf-batch-size (abs append)))
 176                    vlf-file-size))
 177          (start (if (< append 0)
 178                     vlf-start-pos
 179                   (- end vlf-batch-size))))
 180     (vlf-move-to-chunk start end)))
 181
 182 (defun vlf-prev-batch (prepend)
 183   "Display the previous batch of file data.
 184 When prefix argument is supplied and positive
 185  jump over PREPEND number of batches.
 186 When prefix argument is negative
 187  append previous PREPEND number of batches to the existing buffer."
 188   (interactive "p")
 189   (if (zerop vlf-start-pos)
 190       (error "Already at BOF"))
 191   (vlf-tune-load (if (derived-mode-p 'hexl-mode)
 192                      '(:hexl :dehexlify :insert :encode)
 193                    '(:insert :encode)))
 194   (let* ((start (max 0 (- vlf-start-pos (* vlf-batch-size (abs prepend)))))
 195          (end (if (< prepend 0)
 196                   vlf-end-pos
 197                 (+ start vlf-batch-size))))
 198     (vlf-move-to-chunk start end)))
 199
 200 ;; scroll auto batching
 201 (defadvice scroll-up (around vlf-scroll-up
 202                              activate compile)
 203   "Slide to next batch if at end of buffer in `vlf-mode'."
 204   (if (and vlf-mode (pos-visible-in-window-p (point-max)))
 205       (progn (vlf-next-batch 1)
 206              (goto-char (point-min)))
 207     ad-do-it))
 208
 209 (defadvice scroll-down (around vlf-scroll-down
 210                                activate compile)
 211   "Slide to previous batch if at beginning of buffer in `vlf-mode'."
 212   (if (and vlf-mode (pos-visible-in-window-p (point-min)))
 213       (progn (vlf-prev-batch 1)
 214              (goto-char (point-max)))
 215     ad-do-it))
 216
 217 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 218 ;;; hexl mode integration
 219
 220 (eval-after-load "hexl"
 221   '(progn
 222      (defadvice hexl-save-buffer (around vlf-hexl-save
 223                                          activate compile)
 224        "Prevent hexl save if `vlf-mode' is active."
 225        (if vlf-mode
 226            (vlf-write)
 227          ad-do-it))
 228
 229      (defadvice hexl-scroll-up (around vlf-hexl-scroll-up
 230                                        activate compile)
 231        "Slide to next batch if at end of buffer in `vlf-mode'."
 232        (if (and vlf-mode (pos-visible-in-window-p (point-max))
 233                 (or (not (numberp arg)) (< 0 arg)))
 234            (progn (vlf-next-batch 1)
 235                   (goto-char (point-min)))
 236          ad-do-it))
 237
 238      (defadvice hexl-scroll-down (around vlf-hexl-scroll-down
 239                                          activate compile)
 240        "Slide to previous batch if at beginning of buffer in `vlf-mode'."
 241        (if (and vlf-mode (pos-visible-in-window-p (point-min)))
 242            (progn (vlf-prev-batch 1)
 243                   (goto-char (point-max)))
 244          ad-do-it))))
 245
 246 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 247 ;;; utilities
 248
 249 (defun vlf-change-batch-size (decrease)
 250   "Change the buffer-local value of `vlf-batch-size'.
 251 Normally, the value is doubled;
 252 with the prefix argument DECREASE it is halved."
 253   (interactive "P")
 254   (vlf-set-batch-size (if decrease (/ vlf-batch-size 2)
 255                         (* vlf-batch-size 2))))
 256
 257 (defun vlf-set-batch-size (size)
 258   "Set batch to SIZE bytes and update chunk."
 259   (interactive
 260    (list (read-number "Size in bytes: "
 261                       (vlf-tune-optimal-load
 262                        (if (derived-mode-p 'hexl-mode)
 263                            '(:hexl :dehexlify :insert :encode)
 264                          '(:insert :encode))))))
 265   (setq vlf-batch-size size)
 266   (vlf-move-to-batch vlf-start-pos))
 267
 268 (defun vlf-beginning-of-file ()
 269   "Jump to beginning of file content."
 270   (interactive)
 271   (vlf-tune-load (if (derived-mode-p 'hexl-mode)
 272                      '(:hexl :dehexlify :insert :encode)
 273                    '(:insert :encode)))
 274   (vlf-move-to-batch 0))
 275
 276 (defun vlf-end-of-file ()
 277   "Jump to end of file content."
 278   (interactive)
 279   (vlf-verify-size)
 280   (vlf-tune-load (if (derived-mode-p 'hexl-mode)
 281                      '(:hexl :dehexlify :insert :encode)
 282                    '(:insert :encode)))
 283   (vlf-move-to-batch vlf-file-size))
 284
 285 (defun vlf-revert (&optional _auto noconfirm)
 286   "Revert current chunk.  Ignore _AUTO.
 287 Ask for confirmation if NOCONFIRM is nil."
 288   (interactive)
 289   (when (or noconfirm
 290             (yes-or-no-p (format "Revert buffer from file %s? "
 291                                  buffer-file-name)))
 292     (set-buffer-modified-p nil)
 293     (vlf-move-to-chunk-2 vlf-start-pos vlf-end-pos)))
 294
 295 (defun vlf-jump-to-chunk (n)
 296   "Go to to chunk N."
 297   (interactive "nGoto to chunk: ")
 298   (vlf-tune-load (if (derived-mode-p 'hexl-mode)
 299                      '(:hexl :dehexlify :insert :encode)
 300                    '(:insert :encode)))
 301   (vlf-move-to-batch (* (1- n) vlf-batch-size)))
 302
 303 (defun vlf-no-modifications ()
 304   "Ensure there are no buffer modifications."
 305   (if (buffer-modified-p)
 306       (error "Save or discard your changes first")
 307     t))
 308
 309 (defun vlf-move-to-batch (start &optional minimal)
 310   "Move to batch determined by START.
 311 Adjust according to file start/end and show `vlf-batch-size' bytes.
 312 When given MINIMAL flag, skip non important operations."
 313   (vlf-verify-size)
 314   (let* ((start (max 0 start))
 315          (end (min (+ start vlf-batch-size) vlf-file-size)))
 316     (if (= vlf-file-size end)          ; re-adjust start
 317         (setq start (max 0 (- end vlf-batch-size))))
 318     (vlf-move-to-chunk start end minimal)))
 319
 320 (defun vlf-next-batch-from-point ()
 321   "Display batch of file data starting from current point."
 322   (interactive)
 323   (let ((start (+ vlf-start-pos (position-bytes (point)) -1)))
 324     (vlf-move-to-chunk start (+ start vlf-batch-size)))
 325   (goto-char (point-min)))
 326
 327 (provide 'vlf)
 328
 329 ;;; vlf.el ends here