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, 2013  Free Software Foundation, Inc.
   4
   5 ;; Version: 0.9
   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 Andrey Kotlarski <m00naticus@gmail.com>
  11
  12 ;; This file is free software; you can redistribute it and/or modify
  13 ;; it under the terms of the GNU General Public License as published by
  14 ;; the Free Software Foundation; either version 2, or (at your option)
  15 ;; any later version.
  16
  17 ;; This file is distributed in the hope that it will be useful,
  18 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  19 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  20 ;; GNU General Public License for more details.
  21
  22 ;; You should have received a copy of the GNU General Public License
  23 ;; along with GNU Emacs; see the file COPYING.  If not, write to
  24 ;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  25 ;; Boston, MA 02111-1307, USA.
  26
  27 ;;; Commentary:
  28
  29 ;; This package provides the M-x vlf command, which visits part of a
  30 ;; large file without loading the entire file.
  31 ;; The buffer uses VLF mode, which defines several commands for
  32 ;; moving around, searching and editing selected part of file.
  33
  34 ;; This package was inspired by a snippet posted by Kevin Rodgers,
  35 ;; showing how to use `insert-file-contents' to extract part of a
  36 ;; file.
  37
  38 ;;; Code:
  39
  40 (defgroup vlf nil
  41   "View Large Files in Emacs."
  42   :prefix "vlf-"
  43   :group 'files)
  44
  45 (defcustom vlf-batch-size 1024
  46   "Defines how large each batch of file data is (in bytes)."
  47   :type 'integer
  48   :group 'vlf)
  49
  50 ;;; Keep track of file position.
  51 (defvar vlf-start-pos 0
  52   "Absolute position of the visible chunk start.")
  53 (defvar vlf-end-pos 0 "Absolute position of the visible chunk end.")
  54 (defvar vlf-file-size 0 "Total size of presented file.")
  55
  56 (defvar vlf-mode-map
  57   (let ((map (make-sparse-keymap)))
  58     (define-key map [M-next] 'vlf-next-batch)
  59     (define-key map [M-prior] 'vlf-prev-batch)
  60     (define-key map "+" 'vlf-change-batch-size)
  61     (define-key map "-"
  62       (lambda () "Decrease vlf batch size by factor of 2."
  63         (interactive)
  64         (vlf-change-batch-size t)))
  65     (define-key map "s" 'vlf-re-search-forward)
  66     (define-key map "r" 'vlf-re-search-backward)
  67     (define-key map "o" 'vlf-occur)
  68     (define-key map "[" 'vlf-beginning-of-file)
  69     (define-key map "]" 'vlf-end-of-file)
  70     (define-key map "e" 'vlf-edit-mode)
  71     (define-key map "j" 'vlf-jump-to-chunk)
  72     (define-key map "l" 'vlf-goto-line)
  73     map)
  74   "Keymap for `vlf-mode'.")
  75
  76 (define-derived-mode vlf-mode special-mode "VLF"
  77   "Mode to browse large files in."
  78   (setq buffer-read-only t)
  79   (set-buffer-modified-p nil)
  80   (buffer-disable-undo)
  81   (make-local-variable 'write-file-functions)
  82   (add-hook 'write-file-functions 'vlf-write)
  83   (make-local-variable 'revert-buffer-function)
  84   (setq revert-buffer-function 'vlf-revert)
  85   (make-local-variable 'vlf-batch-size)
  86   (put 'vlf-batch-size 'permanent-local t)
  87   (make-local-variable 'vlf-start-pos)
  88   (put 'vlf-start-pos 'permanent-local t)
  89   (make-local-variable 'vlf-end-pos)
  90   (put 'vlf-end-pos 'permanent-local t)
  91   (make-local-variable 'vlf-file-size)
  92   (put 'vlf-file-size 'permanent-local t))
  93
  94 ;;;###autoload
  95 (defun vlf (file)
  96   "View Large FILE.
  97 Batches of the file data from FILE will be displayed in a read-only
  98 buffer.  You can customize number of bytes displayed by customizing
  99 `vlf-batch-size'."
 100   (interactive "fFile to open: ")
 101   (with-current-buffer (generate-new-buffer "*vlf*")
 102     (vlf-mode)
 103     (setq buffer-file-name file
 104           vlf-file-size (vlf-get-file-size file))
 105     (vlf-insert-file)
 106     (switch-to-buffer (current-buffer))))
 107
 108 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 109 ;;; integration with other packages
 110
 111 ;;;###autoload
 112 (defun dired-vlf ()
 113   "In Dired, visit the file on this line in VLF mode."
 114   (interactive)
 115   (vlf (dired-get-file-for-visit)))
 116
 117 ;;;###autoload
 118 (eval-after-load "dired"
 119   '(define-key dired-mode-map "V" 'dired-vlf))
 120
 121 ;;;###autoload
 122 (defun vlf-if-file-too-large (size op-type &optional filename)
 123   "If file SIZE larger than `large-file-warning-threshold', \
 124 allow user to view file with `vlf', open it normally, or abort.
 125 OP-TYPE specifies the file operation being performed over FILENAME."
 126   (and large-file-warning-threshold size
 127        (> size large-file-warning-threshold)
 128        (let ((char nil))
 129          (while (not (memq (setq char
 130                                  (read-event
 131                                   (propertize
 132                                    (format
 133                                     "File %s is large (%s): \
 134 %s normally (o), %s with vlf (v) or abort (a)"
 135                                     (if filename
 136                                         (file-name-nondirectory filename)
 137                                       "")
 138                                     (file-size-human-readable size)
 139                                     op-type op-type)
 140                                    'face 'minibuffer-prompt)))
 141                            '(?o ?O ?v ?V ?a ?A))))
 142          (cond ((memq char '(?o ?O)))
 143                ((memq char '(?v ?V))
 144                 (vlf filename)
 145                 (error ""))
 146                ((memq char '(?a ?A))
 147                 (error "Aborted"))))))
 148
 149 ;; hijack `abort-if-file-too-large'
 150 ;;;###autoload
 151 (fset 'abort-if-file-too-large 'vlf-if-file-too-large)
 152
 153 ;; scroll auto batching
 154 (defadvice scroll-up (around vlf-scroll-up
 155                              activate compile)
 156   "Slide to next batch if at end of buffer in `vlf-mode'."
 157   (if (and (eq major-mode 'vlf-mode)
 158            (eobp))
 159       (progn (vlf-next-batch 1)
 160              (goto-char (point-min)))
 161     ad-do-it))
 162
 163 (defadvice scroll-down (around vlf-scroll-down
 164                                activate compile)
 165   "Slide to previous batch if at beginning of buffer  in `vlf-mode'."
 166   (if (and (eq major-mode 'vlf-mode)
 167            (bobp))
 168       (progn (vlf-prev-batch 1)
 169              (goto-char (point-max)))
 170     ad-do-it))
 171
 172 ;; non-recent Emacs
 173 (unless (fboundp 'file-size-human-readable)
 174   (defun file-size-human-readable (file-size)
 175     "Print FILE-SIZE in MB."
 176     (format "%.1fMB" (/ file-size 1048576.0))))
 177
 178 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 179 ;;; utilities
 180
 181 (defun vlf-change-batch-size (decrease)
 182   "Change the buffer-local value of `vlf-batch-size'.
 183 Normally, the value is doubled;
 184 with the prefix argument DECREASE it is halved."
 185   (interactive "P")
 186   (or (assq 'vlf-batch-size (buffer-local-variables))
 187       (error "%s is not local in this buffer" 'vlf-batch-size))
 188   (setq vlf-batch-size (if decrease
 189                             (/ vlf-batch-size 2)
 190                           (* vlf-batch-size 2)))
 191   (vlf-move-to-batch vlf-start-pos))
 192
 193 (defun vlf-format-buffer-name ()
 194   "Return format for vlf buffer name."
 195   (format "%s(%s)[%d/%d](%d)"
 196           (file-name-nondirectory buffer-file-name)
 197           (file-size-human-readable vlf-file-size)
 198           (/ vlf-end-pos vlf-batch-size)
 199           (/ vlf-file-size vlf-batch-size)
 200           vlf-batch-size))
 201
 202 (defun vlf-update-buffer-name ()
 203   "Update the current buffer name."
 204   (rename-buffer (vlf-format-buffer-name) t))
 205
 206 (defun vlf-get-file-size (file)
 207   "Get size in bytes of FILE."
 208   (nth 7 (file-attributes file)))
 209
 210 (defun vlf-insert-file (&optional from-end)
 211   "Insert first chunk of current file contents in current buffer.
 212 With FROM-END prefix, start from the back."
 213   (if from-end
 214       (setq vlf-start-pos (max 0 (- vlf-file-size vlf-batch-size))
 215             vlf-end-pos vlf-file-size)
 216     (setq vlf-start-pos 0
 217           vlf-end-pos (min vlf-batch-size vlf-file-size)))
 218   (vlf-move-to-chunk vlf-start-pos vlf-end-pos))
 219
 220 (defun vlf-beginning-of-file ()
 221   "Jump to beginning of file content."
 222   (interactive)
 223   (vlf-insert-file))
 224
 225 (defun vlf-end-of-file ()
 226   "Jump to end of file content."
 227   (interactive)
 228   (vlf-insert-file t))
 229
 230 (defun vlf-revert (&optional _ignore-auto noconfirm)
 231   "Revert current chunk.  Ignore IGNORE-AUTO.
 232 Ask for confirmation if NOCONFIRM is nil."
 233   (or noconfirm
 234       (yes-or-no-p (format "Revert buffer from file %s? "
 235                            buffer-file-name))
 236       (vlf-move-to-chunk vlf-start-pos vlf-end-pos)))
 237
 238 (defun vlf-jump-to-chunk (n)
 239   "Go to to chunk N."
 240   (interactive "nGoto to chunk: ")
 241   (vlf-move-to-batch (* (1- n) vlf-batch-size)))
 242
 243 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 244 ;;; batch movement
 245
 246 (defun vlf-next-batch (append)
 247   "Display the next batch of file data.
 248 When prefix argument is supplied and positive
 249  jump over APPEND number of batches.
 250 When prefix argument is negative
 251  append next APPEND number of batches to the existing buffer."
 252   (interactive "p")
 253   (or (verify-visited-file-modtime (current-buffer))
 254       (setq vlf-file-size (vlf-get-file-size buffer-file-name)))
 255   (let ((end (min (+ vlf-end-pos (* vlf-batch-size
 256                                      (abs append)))
 257                   vlf-file-size)))
 258     (let ((inhibit-read-only t)
 259           (do-append (< append 0))
 260           (pos (position-bytes (point))))
 261       (if do-append
 262           (goto-char (point-max))
 263         (setq vlf-start-pos (- end vlf-batch-size))
 264         (erase-buffer))
 265       (insert-file-contents buffer-file-name nil (if do-append
 266                                                      vlf-end-pos
 267                                                    vlf-start-pos)
 268                             end)
 269       (setq vlf-end-pos end)
 270       (goto-char (or (byte-to-position (+ pos (vlf-adjust-chunk)))
 271                      (point-max)))))
 272   (set-visited-file-modtime)
 273   (set-buffer-modified-p nil)
 274   (vlf-update-buffer-name))
 275
 276 (defun vlf-prev-batch (prepend)
 277   "Display the previous batch of file data.
 278 When prefix argument is supplied and positive
 279  jump over PREPEND number of batches.
 280 When prefix argument is negative
 281  append previous PREPEND number of batches to the existing buffer."
 282   (interactive "p")
 283   (if (zerop vlf-start-pos)
 284       (error "Already at BOF"))
 285   (or (verify-visited-file-modtime (current-buffer))
 286       (setq vlf-file-size (vlf-get-file-size buffer-file-name)))
 287   (let ((inhibit-read-only t)
 288         (start (max 0 (- vlf-start-pos (* vlf-batch-size
 289                                            (abs prepend)))))
 290         (do-prepend (< prepend 0))
 291         (pos (- (position-bytes (point-max))
 292                 (position-bytes (point)))))
 293     (if do-prepend
 294         (goto-char (point-min))
 295       (setq vlf-end-pos (min (+ start vlf-batch-size)
 296                               vlf-file-size))
 297       (erase-buffer))
 298     (insert-file-contents buffer-file-name nil start
 299                           (if do-prepend
 300                               vlf-start-pos
 301                             vlf-end-pos))
 302     (setq vlf-start-pos start)
 303     (setq pos (+ pos (vlf-adjust-chunk)))
 304     (goto-char (or (byte-to-position (- (position-bytes (point-max))
 305                                         pos))
 306                    (point-max))))
 307   (set-visited-file-modtime)
 308   (set-buffer-modified-p nil)
 309   (vlf-update-buffer-name))
 310
 311 (defun vlf-move-to-batch (start &optional minimal)
 312   "Move to batch determined by START.
 313 Adjust according to file start/end and show `vlf-batch-size' bytes.
 314 When given MINIMAL flag, skip non important operations."
 315   (or (verify-visited-file-modtime (current-buffer))
 316       (setq vlf-file-size (vlf-get-file-size buffer-file-name)))
 317   (setq vlf-start-pos (max 0 start)
 318         vlf-end-pos (min (+ vlf-start-pos vlf-batch-size)
 319                           vlf-file-size))
 320   (if (= vlf-file-size vlf-end-pos)   ; re-check file size
 321       (setq vlf-start-pos (max 0 (- vlf-end-pos vlf-batch-size))))
 322   (let ((inhibit-read-only t)
 323         (pos (position-bytes (point))))
 324     (erase-buffer)
 325     (insert-file-contents buffer-file-name nil
 326                           vlf-start-pos vlf-end-pos)
 327     (goto-char (or (byte-to-position (+ pos (vlf-adjust-chunk)))
 328                    (point-max))))
 329   (set-buffer-modified-p nil)
 330   (set-visited-file-modtime)
 331   (or minimal(vlf-update-buffer-name)))
 332
 333 (defun vlf-move-to-chunk (start end &optional minimal)
 334   "Move to chunk determined by START END.
 335 When given MINIMAL flag, skip non important operations."
 336   (or (verify-visited-file-modtime (current-buffer))
 337       (setq vlf-file-size (vlf-get-file-size buffer-file-name)))
 338   (setq vlf-start-pos (max 0 start)
 339         vlf-end-pos (min end vlf-file-size))
 340   (let ((inhibit-read-only t)
 341         (pos (position-bytes (point))))
 342     (erase-buffer)
 343     (insert-file-contents buffer-file-name nil
 344                           vlf-start-pos vlf-end-pos)
 345     (goto-char (or (byte-to-position (+ pos (vlf-adjust-chunk)))
 346                    (point-max))))
 347   (set-buffer-modified-p nil)
 348   (set-visited-file-modtime)
 349   (or minimal (vlf-update-buffer-name)))
 350
 351 (defun vlf-adjust-chunk ()
 352   "Adjust chunk beginning until content can be properly decoded.
 353 Return number of bytes moved back for this to happen."
 354   (let ((shift 0)
 355         (chunk-size (- vlf-end-pos vlf-start-pos)))
 356     (while (and (not (zerop vlf-start-pos))
 357                 (< shift 4)
 358                 (/= chunk-size
 359                     (length (encode-coding-region
 360                              (point-min) (point-max)
 361                              buffer-file-coding-system t))))
 362       (setq shift (1+ shift)
 363             vlf-start-pos (1- vlf-start-pos)
 364             chunk-size (1+ chunk-size))
 365       (let ((inhibit-read-only t))
 366         (erase-buffer)
 367         (insert-file-contents buffer-file-name nil
 368                               vlf-start-pos vlf-end-pos)))
 369     (set-buffer-modified-p nil)
 370     shift))
 371
 372 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 373 ;;; search
 374
 375 (defun vlf-re-search (regexp count backward batch-step)
 376   "Search for REGEXP COUNT number of times forward or BACKWARD.
 377 BATCH-STEP is amount of overlap between successive chunks."
 378   (assert (< 0 count))
 379   (let* ((match-chunk-start vlf-start-pos)
 380          (match-chunk-end vlf-end-pos)
 381          (match-start-pos (+ vlf-start-pos (position-bytes (point))))
 382          (match-end-pos match-start-pos)
 383          (to-find count)
 384          (reporter (make-progress-reporter
 385                     (concat "Searching for " regexp "...")
 386                     (if backward
 387                         (- vlf-file-size vlf-end-pos)
 388                       vlf-start-pos)
 389                     vlf-file-size)))
 390     (unwind-protect
 391         (catch 'end-of-file
 392           (if backward
 393               (while (not (zerop to-find))
 394                 (cond ((re-search-backward regexp nil t)
 395                        (setq to-find (1- to-find)
 396                              match-chunk-start vlf-start-pos
 397                              match-chunk-end vlf-end-pos
 398                              match-start-pos (+ vlf-start-pos
 399                                                 (position-bytes
 400                                                  (match-beginning 0)))
 401                              match-end-pos (+ vlf-start-pos
 402                                               (position-bytes
 403                                                (match-end 0)))))
 404                       ((zerop vlf-start-pos)
 405                        (throw 'end-of-file nil))
 406                       (t (let ((batch-move (- vlf-start-pos
 407                                               (- vlf-batch-size
 408                                                  batch-step))))
 409                            (vlf-move-to-batch
 410                             (if (< match-start-pos batch-move)
 411                                 (- match-start-pos vlf-batch-size)
 412                               batch-move) t))
 413                          (goto-char (if (< match-start-pos
 414                                            vlf-end-pos)
 415                                         (or (byte-to-position
 416                                              (- match-start-pos
 417                                                 vlf-start-pos))
 418                                             (point-max))
 419                                       (point-max)))
 420                          (progress-reporter-update
 421                           reporter (- vlf-file-size
 422                                       vlf-start-pos)))))
 423             (while (not (zerop to-find))
 424               (cond ((re-search-forward regexp nil t)
 425                      (setq to-find (1- to-find)
 426                            match-chunk-start vlf-start-pos
 427                            match-chunk-end vlf-end-pos
 428                            match-start-pos (+ vlf-start-pos
 429                                               (position-bytes
 430                                                (match-beginning 0)))
 431                            match-end-pos (+ vlf-start-pos
 432                                             (position-bytes
 433                                              (match-end 0)))))
 434                     ((= vlf-end-pos vlf-file-size)
 435                      (throw 'end-of-file nil))
 436                     (t (let ((batch-move (- vlf-end-pos batch-step)))
 437                          (vlf-move-to-batch
 438                           (if (< batch-move match-end-pos)
 439                               match-end-pos
 440                             batch-move) t))
 441                        (goto-char (if (< vlf-start-pos match-end-pos)
 442                                       (or (byte-to-position
 443                                            (- match-end-pos
 444                                               vlf-start-pos))
 445                                           (point-min))
 446                                     (point-min)))
 447                        (progress-reporter-update reporter
 448                                                  vlf-end-pos)))))
 449           (progress-reporter-done reporter))
 450       (if backward
 451           (vlf-goto-match match-chunk-start match-chunk-end
 452                            match-end-pos match-start-pos
 453                            count to-find)
 454         (vlf-goto-match match-chunk-start match-chunk-end
 455                          match-start-pos match-end-pos
 456                          count to-find)))))
 457
 458 (defun vlf-goto-match (match-chunk-start match-chunk-end
 459                                           match-pos-start
 460                                           match-pos-end
 461                                           count to-find)
 462   "Move to MATCH-CHUNK-START MATCH-CHUNK-END surrounding \
 463 MATCH-POS-START and MATCH-POS-END.
 464 According to COUNT and left TO-FIND, show if search has been
 465 successful.  Return nil if nothing found."
 466   (if (= count to-find)
 467       (progn (vlf-move-to-chunk match-chunk-start match-chunk-end)
 468              (goto-char (or (byte-to-position (- match-pos-start
 469                                                  vlf-start-pos))
 470                             (point-max)))
 471              (message "Not found")
 472              nil)
 473     (let ((success (zerop to-find)))
 474       (if success
 475           (vlf-update-buffer-name)
 476         (vlf-move-to-chunk match-chunk-start match-chunk-end))
 477       (let* ((match-end (or (byte-to-position (- match-pos-end
 478                                                  vlf-start-pos))
 479                             (point-max)))
 480              (overlay (make-overlay (byte-to-position
 481                                      (- match-pos-start
 482                                         vlf-start-pos))
 483                                     match-end)))
 484         (overlay-put overlay 'face 'match)
 485         (unless success
 486           (goto-char match-end)
 487           (message "Moved to the %d match which is last"
 488                    (- count to-find)))
 489         (sit-for 0.1)
 490         (delete-overlay overlay)
 491         t))))
 492
 493 (defun vlf-re-search-forward (regexp count)
 494   "Search forward for REGEXP prefix COUNT number of times.
 495 Search is performed chunk by chunk in `vlf-batch-size' memory."
 496   (interactive (list (read-regexp "Search whole file"
 497                                   (if regexp-history
 498                                       (car regexp-history)))
 499                      (or current-prefix-arg 1)))
 500   (vlf-re-search regexp count nil (/ vlf-batch-size 8)))
 501
 502 (defun vlf-re-search-backward (regexp count)
 503   "Search backward for REGEXP prefix COUNT number of times.
 504 Search is performed chunk by chunk in `vlf-batch-size' memory."
 505   (interactive (list (read-regexp "Search whole file backward"
 506                                   (if regexp-history
 507                                       (car regexp-history)))
 508                      (or current-prefix-arg 1)))
 509   (vlf-re-search regexp count t (/ vlf-batch-size 8)))
 510
 511 (defun vlf-goto-line (n)
 512   "Go to line N.  If N is negative, count from the end of file."
 513   (interactive "nGo to line: ")
 514   (let ((start-pos vlf-start-pos)
 515         (end-pos vlf-end-pos)
 516         (pos (point))
 517         (success nil))
 518     (unwind-protect
 519         (if (< 0 n)
 520             (progn (vlf-beginning-of-file)
 521                    (goto-char (point-min))
 522                    (setq success (vlf-re-search "[\n\C-m]" (1- n)
 523                                                  nil 0)))
 524           (vlf-end-of-file)
 525           (goto-char (point-max))
 526           (setq success (vlf-re-search "[\n\C-m]" (- n) t 0)))
 527       (if success
 528           (message "Onto line %s" n)
 529         (vlf-move-to-chunk start-pos end-pos)
 530         (goto-char pos)))))
 531
 532 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 533 ;;; occur
 534
 535 (defvar vlf-occur-mode-map
 536   (let ((map (make-sparse-keymap)))
 537     (define-key map "n" 'vlf-occur-next-match)
 538     (define-key map "p" 'vlf-occur-prev-match)
 539     (define-key map "\C-m" 'vlf-occur-visit)
 540     (define-key map [mouse-1] 'vlf-occur-visit)
 541     (define-key map "o" 'vlf-occur-show)
 542     map)
 543   "Keymap for command `vlf-occur-mode'.")
 544
 545 (define-derived-mode vlf-occur-mode special-mode "VLF[occur]"
 546   "Major mode for showing occur matches of VLF opened files.")
 547
 548 (defun vlf-occur-next-match ()
 549   "Move cursor to next match."
 550   (interactive)
 551   (if (eq (get-char-property (point) 'face) 'match)
 552       (goto-char (next-single-property-change (point) 'face)))
 553   (goto-char (or (text-property-any (point) (point-max) 'face 'match)
 554                  (text-property-any (point-min) (point)
 555                                     'face 'match))))
 556
 557 (defun vlf-occur-prev-match ()
 558   "Move cursor to previous match."
 559   (interactive)
 560   (if (eq (get-char-property (point) 'face) 'match)
 561       (goto-char (previous-single-property-change (point) 'face)))
 562   (while (not (eq (get-char-property (point) 'face) 'match))
 563     (goto-char (or (previous-single-property-change (point) 'face)
 564                    (point-max)))))
 565
 566 (defun vlf-occur-show (&optional event)
 567   "Visit current `vlf-occur' link in a vlf buffer but stay in the \
 568 occur buffer.  If original VLF buffer has been killed,
 569 open new VLF session each time.
 570 EVENT may hold details of the invocation."
 571   (interactive (list last-nonmenu-event))
 572   (let ((occur-buffer (if event
 573                           (window-buffer (posn-window
 574                                           (event-end event)))
 575                         (current-buffer))))
 576     (vlf-occur-visit event)
 577     (pop-to-buffer occur-buffer)))
 578
 579 (defun vlf-occur-visit (&optional event)
 580   "Visit current `vlf-occur' link in a vlf buffer.
 581 If original VLF buffer has been killed,
 582 open new VLF session each time.
 583 EVENT may hold details of the invocation."
 584   (interactive (list last-nonmenu-event))
 585   (when event
 586     (set-buffer (window-buffer (posn-window (event-end event))))
 587     (goto-char (posn-point (event-end event))))
 588   (let* ((pos (point))
 589          (pos-relative (- pos (line-beginning-position) 1))
 590          (file (get-char-property pos 'file)))
 591     (if file
 592         (let ((chunk-start (get-char-property pos 'chunk-start))
 593               (chunk-end (get-char-property pos 'chunk-end))
 594               (buffer (get-char-property pos 'buffer))
 595               (match-pos (+ (get-char-property pos 'line-pos)
 596                             pos-relative)))
 597           (or (buffer-live-p buffer)
 598               (let ((occur-buffer (current-buffer)))
 599                 (setq buffer (vlf file))
 600                 (switch-to-buffer occur-buffer)))
 601           (pop-to-buffer buffer)
 602           (if (buffer-modified-p)
 603               (cond ((and (= vlf-start-pos chunk-start)
 604                           (= vlf-end-pos chunk-end))
 605                      (goto-char match-pos))
 606                     ((y-or-n-p "VLF buffer has been modified.  \
 607 Really jump to new chunk? ")
 608                      (vlf-move-to-chunk chunk-start chunk-end)
 609                      (goto-char match-pos)))
 610             (vlf-move-to-chunk chunk-start chunk-end)
 611             (goto-char match-pos))))))
 612
 613 (defun vlf-occur (regexp)
 614   "Make whole file occur style index for REGEXP.
 615 Prematurely ending indexing will still show what's found so far."
 616   (interactive (list (read-regexp "List lines matching regexp"
 617                                   (if regexp-history
 618                                       (car regexp-history)))))
 619   (let ((start-pos vlf-start-pos)
 620         (end-pos vlf-end-pos)
 621         (pos (point)))
 622     (vlf-beginning-of-file)
 623     (goto-char (point-min))
 624     (unwind-protect (vlf-build-occur regexp)
 625       (vlf-move-to-chunk start-pos end-pos)
 626       (goto-char pos))))
 627
 628 (defun vlf-build-occur (regexp)
 629   "Build occur style index for REGEXP."
 630   (let ((line 1)
 631         (last-match-line 0)
 632         (last-line-pos (point-min))
 633         (file buffer-file-name)
 634         (total-matches 0)
 635         (match-end-pos (+ vlf-start-pos (position-bytes (point))))
 636         (occur-buffer (generate-new-buffer
 637                        (concat "*VLF-occur " (file-name-nondirectory
 638                                                buffer-file-name)
 639                                "*")))
 640         (line-regexp (concat "\\(?5:[\n\C-m]\\)\\|\\(?10:"
 641                              regexp "\\)"))
 642         (batch-step (/ vlf-batch-size 8))
 643         (end-of-file nil)
 644         (reporter (make-progress-reporter
 645                    (concat "Building index for " regexp "...")
 646                    vlf-start-pos vlf-file-size)))
 647     (unwind-protect
 648         (progn
 649           (while (not end-of-file)
 650             (if (re-search-forward line-regexp nil t)
 651                 (progn
 652                   (setq match-end-pos (+ vlf-start-pos
 653                                          (position-bytes
 654                                           (match-end 0))))
 655                   (if (match-string 5)
 656                       (setq line (1+ line) ; line detected
 657                             last-line-pos (point))
 658                     (let* ((chunk-start vlf-start-pos)
 659                            (chunk-end vlf-end-pos)
 660                            (vlf-buffer (current-buffer))
 661                            (line-pos (line-beginning-position))
 662                            (line-text (buffer-substring
 663                                        line-pos (line-end-position))))
 664                       (with-current-buffer occur-buffer
 665                         (unless (= line last-match-line) ;new match line
 666                           (insert "\n:") ; insert line number
 667                           (let* ((overlay-pos (1- (point)))
 668                                  (overlay (make-overlay
 669                                            overlay-pos
 670                                            (1+ overlay-pos))))
 671                             (overlay-put overlay 'before-string
 672                                          (propertize
 673                                           (number-to-string line)
 674                                           'face 'shadow)))
 675                           (insert (propertize line-text ; insert line
 676                                               'file file
 677                                               'buffer vlf-buffer
 678                                               'chunk-start chunk-start
 679                                               'chunk-end chunk-end
 680                                               'mouse-face '(highlight)
 681                                               'line-pos line-pos
 682                                               'help-echo
 683                                               (format "Move to line %d"
 684                                                       line))))
 685                         (setq last-match-line line
 686                               total-matches (1+ total-matches))
 687                         (let ((line-start (1+
 688                                            (line-beginning-position)))
 689                               (match-pos (match-beginning 10)))
 690                           (add-text-properties ; mark match
 691                            (+ line-start match-pos (- last-line-pos))
 692                            (+ line-start (match-end 10)
 693                               (- last-line-pos))
 694                            (list 'face 'match
 695                                  'help-echo
 696                                  (format "Move to match %d"
 697                                          total-matches))))))))
 698               (setq end-of-file (= vlf-end-pos vlf-file-size))
 699               (unless end-of-file
 700                 (let ((batch-move (- vlf-end-pos batch-step)))
 701                   (vlf-move-to-batch (if (< batch-move match-end-pos)
 702                                           match-end-pos
 703                                         batch-move) t))
 704                 (goto-char (if (< vlf-start-pos match-end-pos)
 705                                (or (byte-to-position (- match-end-pos
 706                                                         vlf-start-pos))
 707                                    (point-min))
 708                              (point-min)))
 709                 (setq last-match-line 0
 710                       last-line-pos (line-beginning-position))
 711                 (progress-reporter-update reporter vlf-end-pos))))
 712           (progress-reporter-done reporter))
 713       (if (zerop total-matches)
 714           (progn (with-current-buffer occur-buffer
 715                    (set-buffer-modified-p nil))
 716                  (kill-buffer occur-buffer)
 717                  (message "No matches for \"%s\"" regexp))
 718         (with-current-buffer occur-buffer
 719           (goto-char (point-min))
 720           (insert (propertize
 721                    (format "%d matches from %d lines for \"%s\" \
 722 in file: %s" total-matches line regexp file)
 723                    'face 'underline))
 724           (set-buffer-modified-p nil)
 725           (forward-char 2)
 726           (vlf-occur-mode))
 727         (display-buffer occur-buffer)))))
 728
 729 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 730 ;;; editing
 731
 732 (defvar vlf-edit-mode-map
 733   (let ((map (make-sparse-keymap)))
 734     (set-keymap-parent map text-mode-map)
 735     (define-key map "\C-c\C-c" 'vlf-write)
 736     (define-key map "\C-c\C-q" 'vlf-discard-edit)
 737     (define-key map "\C-v" vlf-mode-map)
 738     map)
 739   "Keymap for command `vlf-edit-mode'.")
 740
 741 (define-derived-mode vlf-edit-mode vlf-mode "VLF[edit]"
 742   "Major mode for editing large file chunks."
 743   (setq buffer-read-only nil)
 744   (buffer-enable-undo)
 745   (message (substitute-command-keys
 746             "Editing: Type \\[vlf-write] to write chunk \
 747 or \\[vlf-discard-edit] to discard changes.")))
 748
 749 (defun vlf-discard-edit ()
 750   "Discard edit and refresh chunk from file."
 751   (interactive)
 752   (set-buffer-modified-p nil)
 753   (vlf-move-to-chunk vlf-start-pos vlf-end-pos)
 754   (vlf-mode)
 755   (message "Switched to VLF mode."))
 756
 757 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 758 ;;; saving
 759
 760 (defun vlf-write ()
 761   "Write current chunk to file.  Always return true to disable save.
 762 If changing size of chunk shift remaining file content."
 763   (interactive)
 764   (when (and (buffer-modified-p)
 765              (or (verify-visited-file-modtime (current-buffer))
 766                  (y-or-n-p "File has changed since visited or saved.  \
 767 Save anyway? ")))
 768     (let ((pos (point))
 769           (size-change (- vlf-end-pos vlf-start-pos
 770                           (length (encode-coding-region
 771                                    (point-min) (point-max)
 772                                    buffer-file-coding-system t)))))
 773       (cond ((zerop size-change)
 774              (write-region nil nil buffer-file-name vlf-start-pos t))
 775             ((< 0 size-change)
 776              (vlf-file-shift-back size-change))
 777             (t (vlf-file-shift-forward (- size-change))))
 778       (vlf-move-to-chunk vlf-start-pos vlf-end-pos)
 779       (goto-char pos))
 780     (vlf-mode))
 781   t)
 782
 783 (defun vlf-file-shift-back (size-change)
 784   "Shift file contents SIZE-CHANGE bytes back."
 785   (write-region nil nil buffer-file-name vlf-start-pos t)
 786   (buffer-disable-undo)
 787   (let ((read-start-pos vlf-end-pos)
 788         (coding-system-for-write 'no-conversion)
 789         (reporter (make-progress-reporter "Adjusting file content..."
 790                                           vlf-end-pos
 791                                           vlf-file-size)))
 792     (while (vlf-shift-batch read-start-pos (- read-start-pos
 793                                                size-change))
 794       (setq read-start-pos (+ read-start-pos vlf-batch-size))
 795       (progress-reporter-update reporter read-start-pos))
 796     ;; pad end with space
 797     (erase-buffer)
 798     (insert-char 32 size-change)
 799     (write-region nil nil buffer-file-name (- vlf-file-size
 800                                               size-change) t)
 801     (progress-reporter-done reporter)))
 802
 803 (defun vlf-shift-batch (read-pos write-pos)
 804   "Read `vlf-batch-size' bytes from READ-POS and write them \
 805 back at WRITE-POS.  Return nil if EOF is reached, t otherwise."
 806   (erase-buffer)
 807   (or (verify-visited-file-modtime (current-buffer))
 808       (setq vlf-file-size (vlf-get-file-size buffer-file-name)))
 809   (let ((read-end (+ read-pos vlf-batch-size)))
 810     (insert-file-contents-literally buffer-file-name nil
 811                                     read-pos
 812                                     (min vlf-file-size read-end))
 813     (write-region nil nil buffer-file-name write-pos 0)
 814     (< read-end vlf-file-size)))
 815
 816 (defun vlf-file-shift-forward (size-change)
 817   "Shift file contents SIZE-CHANGE bytes forward.
 818 Done by saving content up front and then writing previous batch."
 819   (buffer-disable-undo)
 820   (let ((size (+ vlf-batch-size size-change))
 821         (read-pos vlf-end-pos)
 822         (write-pos vlf-start-pos)
 823         (reporter (make-progress-reporter "Adjusting file content..."
 824                                           vlf-start-pos
 825                                           vlf-file-size)))
 826     (when (vlf-shift-batches size read-pos write-pos t)
 827       (setq write-pos (+ read-pos size-change)
 828             read-pos (+ read-pos size))
 829       (progress-reporter-update reporter write-pos)
 830       (let ((coding-system-for-write 'no-conversion))
 831         (while (vlf-shift-batches size read-pos write-pos nil)
 832           (setq write-pos (+ read-pos size-change)
 833                 read-pos (+ read-pos size))
 834           (progress-reporter-update reporter write-pos))))
 835     (progress-reporter-done reporter)))
 836
 837 (defun vlf-shift-batches (size read-pos write-pos hide-read)
 838   "Append SIZE bytes of file starting at READ-POS.
 839 Then write initial buffer content to file at WRITE-POS.
 840 If HIDE-READ is non nil, temporarily hide literal read content.
 841 Return nil if EOF is reached, t otherwise."
 842   (or (verify-visited-file-modtime (current-buffer))
 843       (setq vlf-file-size (vlf-get-file-size buffer-file-name)))
 844   (let ((read-more (< read-pos vlf-file-size))
 845         (start-write-pos (point-min))
 846         (end-write-pos (point-max)))
 847     (when read-more
 848       (goto-char end-write-pos)
 849       (insert-file-contents-literally buffer-file-name nil read-pos
 850                                       (min vlf-file-size (+ read-pos
 851                                                              size))))
 852     ;; write
 853     (if hide-read ; hide literal region if user has to choose encoding
 854         (narrow-to-region start-write-pos end-write-pos))
 855     (write-region start-write-pos end-write-pos
 856                   buffer-file-name write-pos 0)
 857     (delete-region start-write-pos end-write-pos)
 858     (if hide-read (widen))
 859     read-more))
 860
 861 (provide 'vlf)
 862
 863 ;;; vlf.el ends here