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