1
0
mirror of https://github.com/m00natic/vlfi.git synced 2024-10-05 18:30:51 +01:00

Break VLF into components.

This commit is contained in:
Andrey Kotlarski 2014-01-01 15:43:14 +02:00
parent deec75dfc9
commit 516584e6c9
8 changed files with 1171 additions and 1008 deletions

View File

@ -36,8 +36,8 @@ editing, search and indexing.
** 32-bit GNU Emacs
Regular Emacs integers are used, so if you use 32-bit Emacs without
bignum support and have really huge file (with size beyond the maximum
integer value), VLF will probably not quite work.
bignum support, VLF will not work with files over 512 MB (maximum
integer value).
** Memory control
@ -98,13 +98,8 @@ the end.
** Follow point
Intelligent continuous recenter around point in current buffer can be
enabled with:
*M-x vlf-start-following*
You are asked for number of idle seconds interval for automatic
update. To cancel following invoke *M-x vlf-stop-following*.
Continuous chunk recenter around point in current buffer can be
toggled with *C-c C-v f*.
** Search whole file

328
vlf-base.el Normal file
View File

@ -0,0 +1,328 @@
;;; vlf-base.el --- VLF primitive operations -*- lexical-binding: t -*-
;; Copyright (C) 2014 Free Software Foundation, Inc.
;; Keywords: large files, chunk
;; Author: Andrey Kotlarski <m00naticus@gmail.com>
;; URL: https://github.com/m00natic/vlfi
;; This file is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 3, or (at your option)
;; any later version.
;; This file is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING. If not, write to
;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.
;;; Commentary:
;; This package provides basic chunk operations for VLF
;;; Code:
(defconst vlf-min-chunk-size 16
"Minimal number of bytes that can be properly decoded.")
(defconst vlf-partial-decode-shown
(cond ((< emacs-major-version 24) t)
((< 24 emacs-major-version) nil)
(t ;; TODO: use (< emacs-minor-version 4) after 24.4 release
(string-lessp emacs-version "24.3.5")))
"Indicates whether partial decode codes are displayed.")
(defun vlf-move-to-chunk (start end &optional minimal)
"Move to chunk determined by START END.
When given MINIMAL flag, skip non important operations.
If same as current chunk is requested, do nothing.
Return number of bytes moved back for proper decoding and number of
bytes added to the end."
(unless (and (= start vlf-start-pos)
(= end vlf-end-pos))
(vlf-verify-size)
(let ((shifts (vlf-move-to-chunk-1 start end)))
(and shifts (not minimal)
(vlf-update-buffer-name))
shifts)))
(defun vlf-move-to-chunk-1 (start end)
"Move to chunk determined by START END keeping as much edits if any.
Return number of bytes moved back for proper decoding and number of
bytes added to the end."
(let* ((modified (buffer-modified-p))
(start (max 0 start))
(end (min end vlf-file-size))
(edit-end (if modified
(+ vlf-start-pos
(length (encode-coding-region
(point-min) (point-max)
buffer-file-coding-system t)))
vlf-end-pos)))
(cond
((and (= start vlf-start-pos) (= end edit-end))
(or modified (vlf-move-to-chunk-2 start end)))
((or (<= edit-end start) (<= end vlf-start-pos))
(when (or (not modified)
(y-or-n-p "Chunk modified, are you sure? ")) ;full chunk renewal
(set-buffer-modified-p nil)
(vlf-move-to-chunk-2 start end)))
((or (and (<= start vlf-start-pos) (<= edit-end end))
(not modified)
(y-or-n-p "Chunk modified, are you sure? "))
(let ((shift-start 0)
(shift-end 0))
(let ((pos (+ (position-bytes (point)) vlf-start-pos))
(inhibit-read-only t))
(cond ((< end edit-end)
(let* ((del-pos (1+ (byte-to-position
(- end vlf-start-pos))))
(del-len (length (encode-coding-region
del-pos (point-max)
buffer-file-coding-system
t))))
(setq end (- (if (zerop vlf-end-pos)
vlf-file-size
vlf-end-pos)
del-len))
(vlf-with-undo-disabled
(delete-region del-pos (point-max)))))
((< edit-end end)
(if (and (not vlf-partial-decode-shown)
(< (- end vlf-end-pos) 4))
(setq end vlf-end-pos)
(vlf-with-undo-disabled
(setq shift-end (cdr (vlf-insert-file-contents
vlf-end-pos end nil t
(point-max))))))))
(cond ((< vlf-start-pos start)
(let* ((del-pos (1+ (byte-to-position
(- start vlf-start-pos))))
(del-len (length (encode-coding-region
(point-min) del-pos
buffer-file-coding-system
t))))
(setq start (+ vlf-start-pos del-len))
(vlf-with-undo-disabled
(delete-region (point-min) del-pos))
(vlf-shift-undo-list (- 1 del-pos))))
((< start vlf-start-pos)
(if (and (not vlf-partial-decode-shown)
(< (- vlf-start-pos start) 4))
(setq start vlf-start-pos)
(let ((edit-end-pos (point-max)))
(vlf-with-undo-disabled
(setq shift-start (car (vlf-insert-file-contents
start vlf-start-pos
t nil edit-end-pos)))
(goto-char (point-min))
(insert (delete-and-extract-region
edit-end-pos (point-max))))
(vlf-shift-undo-list (- (point-max) edit-end-pos))))))
(setq start (- start shift-start))
(goto-char (or (byte-to-position (- pos start))
(byte-to-position (- pos vlf-start-pos))
(point-max)))
(setq vlf-start-pos start
vlf-end-pos (+ end shift-end)))
(set-buffer-modified-p modified)
(cons shift-start shift-end))))))
(defun vlf-move-to-chunk-2 (start end)
"Unconditionally move to chunk determined by START END.
Return number of bytes moved back for proper decoding and number of
bytes added to the end."
(setq vlf-start-pos (max 0 start)
vlf-end-pos (min end vlf-file-size))
(let (shifts)
(let ((inhibit-read-only t)
(pos (position-bytes (point))))
(vlf-with-undo-disabled
(erase-buffer)
(setq shifts (vlf-insert-file-contents vlf-start-pos
vlf-end-pos t t)
vlf-start-pos (- vlf-start-pos (car shifts))
vlf-end-pos (+ vlf-end-pos (cdr shifts)))
(goto-char (or (byte-to-position (+ pos (car shifts)))
(point-max)))))
(set-buffer-modified-p nil)
(setq buffer-undo-list nil)
(set-visited-file-modtime)
shifts))
(defun vlf-insert-file-contents (start end adjust-start adjust-end
&optional position)
"Adjust chunk at absolute START to END till content can be\
properly decoded. ADJUST-START determines if trying to prepend bytes\
to the beginning, ADJUST-END - append to the end.
Use buffer POSITION as start if given.
Return number of bytes moved back for proper decoding and number of
bytes added to the end."
(setq adjust-start (and adjust-start (not (zerop start)))
adjust-end (and adjust-end (< end vlf-file-size))
position (or position (point-min)))
(let ((shift-start 0)
(shift-end 0))
(if adjust-start
(setq shift-start (vlf-adjust-start start end position
adjust-end)
start (- start shift-start))
(setq shift-end (vlf-insert-content-safe start end position)
end (+ end shift-end)))
(if adjust-end
(setq shift-end (+ shift-end
(vlf-adjust-end start end position))))
(cons shift-start shift-end)))
(defun vlf-adjust-start (start end position adjust-end)
"Adjust chunk beginning at absolute START to END till content can\
be properly decoded. Use buffer POSITION as start.
ADJUST-END is non-nil if end would be adjusted later.
Return number of bytes moved back for proper decoding."
(let* ((min-end (min end (+ start vlf-min-chunk-size)))
(chunk-size (- min-end start))
(strict (and (not adjust-end) (= min-end end)))
(shift (vlf-insert-content-safe start min-end position t)))
(setq start (- start shift))
(while (and (not (zerop start))
(< shift 3)
(let ((diff (- chunk-size
(length
(encode-coding-region
position (point-max)
buffer-file-coding-system t)))))
(cond (strict (not (zerop diff)))
(vlf-partial-decode-shown
(or (< diff -3) (< 0 diff)))
(t (or (< diff 0) (< 3 diff))))))
(setq shift (1+ shift)
start (1- start)
chunk-size (1+ chunk-size))
(delete-region position (point-max))
(insert-file-contents buffer-file-name nil start min-end))
(unless (= min-end end)
(delete-region position (point-max))
(insert-file-contents buffer-file-name nil start end))
shift))
(defun vlf-adjust-end (start end position)
"Adjust chunk end at absolute START to END till content can be\
properly decoded starting at POSITION.
Return number of bytes added for proper decoding."
(let ((shift 0))
(if vlf-partial-decode-shown
(let ((new-pos (max position
(- (point-max) vlf-min-chunk-size))))
(if (< position new-pos)
(setq start (+ start (length (encode-coding-region
position new-pos
buffer-file-coding-system
t)))
position new-pos))))
(let ((chunk-size (- end start)))
(goto-char (point-max))
(while (and (< shift 3)
(< end vlf-file-size)
(or (eq (char-charset (preceding-char)) 'eight-bit)
(/= chunk-size
(length (encode-coding-region
position (point-max)
buffer-file-coding-system t)))))
(setq shift (1+ shift)
end (1+ end)
chunk-size (1+ chunk-size))
(delete-region position (point-max))
(insert-file-contents buffer-file-name nil start end)
(goto-char (point-max))))
shift))
(defun vlf-insert-content-safe (start end position &optional shift-start)
"Insert file content from absolute START to END of file at\
POSITION. Adjust start if SHIFT-START is non nil, end otherwise.
Clean up if no characters are inserted."
(goto-char position)
(let ((shift 0))
(while (and (< shift 3)
(zerop (cadr (insert-file-contents buffer-file-name
nil start end)))
(if shift-start
(not (zerop start))
(< end vlf-file-size)))
;; TODO: this seems like regression after Emacs 24.3
(message "Buffer content may be broken")
(setq shift (1+ shift))
(if shift-start
(setq start (1- start))
(setq end (1+ end)))
(delete-region position (point-max)))
shift))
(defun vlf-shift-undo-list (n)
"Shift undo list element regions by N."
(or (eq buffer-undo-list t)
(setq buffer-undo-list
(nreverse
(let ((min (point-min))
undo-list)
(catch 'end
(dolist (el buffer-undo-list undo-list)
(push
(cond
((null el) nil)
((numberp el) (let ((pos (+ el n)))
(if (< pos min)
(throw 'end undo-list)
pos)))
(t (let ((head (car el)))
(cond ((numberp head)
(let ((beg (+ head n)))
(if (< beg min)
(throw 'end undo-list)
(cons beg (+ (cdr el) n)))))
((stringp head)
(let* ((pos (cdr el))
(positive (< 0 pos))
(new (+ (abs pos) n)))
(if (< new min)
(throw 'end undo-list)
(cons head (if positive
new
(- new))))))
((null head)
(let ((beg (+ (nth 3 el) n)))
(if (< beg min)
(throw 'end undo-list)
(cons
nil
(cons
(cadr el)
(cons
(nth 2 el)
(cons beg
(+ (cddr
(cddr el)) n))))))))
((and (eq head 'apply)
(numberp (cadr el)))
(let ((beg (+ (nth 2 el) n)))
(if (< beg min)
(throw 'end undo-list)
(cons
'apply
(cons
(cadr el)
(cons
beg
(cons
(+ (nth 3 el) n)
(cons (nth 4 el)
(cdr (last el))))))))))
(t el)))))
undo-list))))))))
(provide 'vlf-base)
;;; vlf-base.el ends here

81
vlf-follow.el Normal file
View File

@ -0,0 +1,81 @@
;;; vlf-follow.el --- VLF chunk follows point functionality -*- lexical-binding: t -*-
;; Copyright (C) 2014 Free Software Foundation, Inc.
;; Keywords: large files, follow, recenter
;; Author: Andrey Kotlarski <m00naticus@gmail.com>
;; URL: https://github.com/m00natic/vlfi
;; This file is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 3, or (at your option)
;; any later version.
;; This file is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING. If not, write to
;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.
;;; Commentary:
;; This package provides `vlf-toggle-follow' command which toggles
;; continuous recenter of chunk around current point.
;;; Code:
(defvar vlf-follow-timer nil
"Contains timer if vlf buffer is set to continuously recenter.")
(put 'vlf-follow-timer 'permanent-local t)
(defun vlf-recenter (vlf-buffer)
"Recenter chunk around current point in VLF-BUFFER."
(and vlf-follow-timer
(eq (current-buffer) vlf-buffer)
(or (pos-visible-in-window-p (point-min))
(pos-visible-in-window-p (point-max)))
(let ((current-pos (+ vlf-start-pos (position-bytes (point))))
(half-batch (/ vlf-batch-size 2)))
(if (buffer-modified-p)
(progn
(let ((edit-end (+ (position-bytes (point-max))
vlf-start-pos)))
(vlf-move-to-chunk (min vlf-start-pos
(- current-pos half-batch))
(max edit-end
(+ current-pos half-batch))))
(goto-char (byte-to-position (- current-pos
vlf-start-pos))))
(vlf-move-to-batch (- current-pos half-batch))
(and (< half-batch current-pos)
(< half-batch (- vlf-file-size current-pos))
(goto-char (byte-to-position (- current-pos
vlf-start-pos))))))))
(defun vlf-stop-follow ()
"Stop continuous recenter."
(cancel-timer vlf-follow-timer)
(setq vlf-follow-timer nil))
(defun vlf-start-follow (interval)
"Continuously recenter chunk around point every INTERVAL seconds."
(setq vlf-follow-timer (run-with-idle-timer interval interval
'vlf-recenter
(current-buffer)))
(add-hook 'kill-buffer-hook 'vlf-stop-follow nil t))
(defun vlf-toggle-follow ()
"Toggle continuous chunk recenter around current point."
(interactive)
(if vlf-mode
(if vlf-follow-timer
(progn (vlf-stop-follow)
(message "Following stopped"))
(vlf-start-follow (read-number "Number of seconds: " 1)))))
(provide 'vlf-follow)
;;; vlf-follow.el ends here

151
vlf-integrate.el Normal file
View File

@ -0,0 +1,151 @@
;;; vlf-integrate.el --- VLF integration with other packages -*- lexical-binding: t -*-
;; Copyright (C) 2014 Free Software Foundation, Inc.
;; Keywords: large files, integration
;; Author: Andrey Kotlarski <m00naticus@gmail.com>
;; URL: https://github.com/m00natic/vlfi
;; This file is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 3, or (at your option)
;; any later version.
;; This file is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING. If not, write to
;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.
;;; Commentary:
;; This package enables VLF play seamlessly with rest of Emacs.
;;; Code:
(defgroup vlf nil
"View Large Files in Emacs."
:prefix "vlf-"
:group 'files)
(defcustom vlf-application 'ask
"Determines when `vlf' will be offered on opening files.
Possible values are: nil to never use it;
`ask' offer `vlf' when file size is beyond `large-file-warning-threshold';
`dont-ask' automatically use `vlf' for large files;
`always' use `vlf' for all files."
:group 'vlf
:type '(radio (const :format "%v " nil)
(const :format "%v " ask)
(const :format "%v " dont-ask)
(const :format "%v" always)))
(defcustom vlf-forbidden-modes-list
'(archive-mode tar-mode jka-compr git-commit-mode image-mode
doc-view-mode doc-view-mode-maybe ebrowse-tree-mode)
"Major modes which VLF will not be automatically applied to."
:group 'vlf
:type '(list symbol))
(unless (fboundp 'file-size-human-readable)
(defun file-size-human-readable (file-size)
"Print FILE-SIZE in MB."
(format "%.3fMB" (/ file-size 1048576.0))))
(defun vlf-determine-major-mode (filename)
"Determine major mode from FILENAME."
(let ((name filename)
(remote-id (file-remote-p filename))
mode)
;; Remove backup-suffixes from file name.
(setq name (file-name-sans-versions name))
;; Remove remote file name identification.
(and (stringp remote-id)
(string-match (regexp-quote remote-id) name)
(setq name (substring name (match-end 0))))
(setq mode
(if (memq system-type '(windows-nt cygwin))
;; System is case-insensitive.
(let ((case-fold-search t))
(assoc-default name auto-mode-alist 'string-match))
;; System is case-sensitive.
(or ;; First match case-sensitively.
(let ((case-fold-search nil))
(assoc-default name auto-mode-alist 'string-match))
;; Fallback to case-insensitive match.
(and auto-mode-case-fold
(let ((case-fold-search t))
(assoc-default name auto-mode-alist
'string-match))))))
(if (and mode (consp mode))
(cadr mode)
mode)))
(defadvice abort-if-file-too-large (around vlf-if-file-too-large
compile activate)
"If file SIZE larger than `large-file-warning-threshold', \
allow user to view file with `vlf', open it normally, or abort.
OP-TYPE specifies the file operation being performed over FILENAME."
(cond
((or (not size) (zerop size)))
((or (not vlf-application)
(not filename)
(memq (vlf-determine-major-mode filename)
vlf-forbidden-modes-list))
ad-do-it)
((eq vlf-application 'always)
(vlf filename)
(error ""))
((and large-file-warning-threshold
(< large-file-warning-threshold size))
(if (eq vlf-application 'dont-ask)
(progn (vlf filename)
(error ""))
(let ((char nil))
(while (not (memq (setq char
(read-event
(propertize
(format
"File %s is large (%s): \
%s normally (o), %s with vlf (v) or abort (a)"
(if filename
(file-name-nondirectory filename)
"")
(file-size-human-readable size)
op-type op-type)
'face 'minibuffer-prompt)))
'(?o ?O ?v ?V ?a ?A))))
(cond ((memq char '(?v ?V))
(vlf filename)
(error ""))
((memq char '(?a ?A))
(error "Aborted"))))))))
(eval-after-load "etags"
'(progn
(defadvice tags-verify-table (around vlf-tags-verify-table
compile activate)
"Temporarily disable `vlf-mode'."
(let ((vlf-application nil))
ad-do-it))
(defadvice tag-find-file-of-tag-noselect
(around vlf-tag-find-file-of-tag compile activate)
"Temporarily disable `vlf-mode'."
(let ((vlf-application nil))
ad-do-it))))
(defun dired-vlf ()
"In Dired, visit the file on this line in VLF mode."
(interactive)
(vlf (dired-get-file-for-visit)))
(eval-after-load "dired"
'(define-key dired-mode-map "V" 'dired-vlf))
(provide 'vlf-integrate)
;;; vlf-integrate.el ends here

248
vlf-occur.el Normal file
View File

@ -0,0 +1,248 @@
;;; vlf-occur.el --- Occur-like functionality for VLF -*- lexical-binding: t -*-
;; Copyright (C) 2014 Free Software Foundation, Inc.
;; Keywords: large files, indexing, occur
;; Author: Andrey Kotlarski <m00naticus@gmail.com>
;; URL: https://github.com/m00natic/vlfi
;; This file is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 3, or (at your option)
;; any later version.
;; This file is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING. If not, write to
;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.
;;; Commentary:
;; This package provides the `vlf-occur' command which builds
;; index of search occurrences in large file just like occur.
;;; Code:
(defvar vlf-occur-mode-map
(let ((map (make-sparse-keymap)))
(define-key map "n" 'vlf-occur-next-match)
(define-key map "p" 'vlf-occur-prev-match)
(define-key map "\C-m" 'vlf-occur-visit)
(define-key map "\M-\r" 'vlf-occur-visit-new-buffer)
(define-key map [mouse-1] 'vlf-occur-visit)
(define-key map "o" 'vlf-occur-show)
map)
"Keymap for command `vlf-occur-mode'.")
(define-derived-mode vlf-occur-mode special-mode "VLF[occur]"
"Major mode for showing occur matches of VLF opened files.")
(defun vlf-occur-next-match ()
"Move cursor to next match."
(interactive)
(if (eq (get-char-property (point) 'face) 'match)
(goto-char (next-single-property-change (point) 'face)))
(goto-char (or (text-property-any (point) (point-max) 'face 'match)
(text-property-any (point-min) (point)
'face 'match))))
(defun vlf-occur-prev-match ()
"Move cursor to previous match."
(interactive)
(if (eq (get-char-property (point) 'face) 'match)
(goto-char (previous-single-property-change (point) 'face)))
(while (not (eq (get-char-property (point) 'face) 'match))
(goto-char (or (previous-single-property-change (point) 'face)
(point-max)))))
(defun vlf-occur-show (&optional event)
"Visit current `vlf-occur' link in a vlf buffer but stay in the \
occur buffer. If original VLF buffer has been killed,
open new VLF session each time.
EVENT may hold details of the invocation."
(interactive (list last-nonmenu-event))
(let ((occur-buffer (if event
(window-buffer (posn-window
(event-end event)))
(current-buffer))))
(vlf-occur-visit event)
(pop-to-buffer occur-buffer)))
(defun vlf-occur-visit-new-buffer ()
"Visit `vlf-occur' link in new vlf buffer."
(interactive)
(let ((current-prefix-arg t))
(vlf-occur-visit)))
(defun vlf-occur-visit (&optional event)
"Visit current `vlf-occur' link in a vlf buffer.
With prefix argument or if original VLF buffer has been killed,
open new VLF session.
EVENT may hold details of the invocation."
(interactive (list last-nonmenu-event))
(when event
(set-buffer (window-buffer (posn-window (event-end event))))
(goto-char (posn-point (event-end event))))
(let* ((pos (point))
(pos-relative (- pos (line-beginning-position) 1))
(file (get-char-property pos 'file)))
(if file
(let ((chunk-start (get-char-property pos 'chunk-start))
(chunk-end (get-char-property pos 'chunk-end))
(vlf-buffer (get-char-property pos 'buffer))
(occur-buffer (current-buffer))
(match-pos (+ (get-char-property pos 'line-pos)
pos-relative)))
(cond (current-prefix-arg
(setq vlf-buffer (vlf file))
(switch-to-buffer occur-buffer))
((not (buffer-live-p vlf-buffer))
(or (catch 'found
(dolist (buf (buffer-list))
(set-buffer buf)
(and vlf-mode (equal file buffer-file-name)
(setq vlf-buffer buf)
(throw 'found t))))
(setq vlf-buffer (vlf file)))
(switch-to-buffer occur-buffer)))
(pop-to-buffer vlf-buffer)
(vlf-move-to-chunk chunk-start chunk-end)
(goto-char match-pos)))))
(defun vlf-occur (regexp)
"Make whole file occur style index for REGEXP.
Prematurely ending indexing will still show what's found so far."
(interactive (list (read-regexp "List lines matching regexp"
(if regexp-history
(car regexp-history)))))
(if (buffer-modified-p) ;use temporary buffer not to interfere with modifications
(let ((vlf-buffer (current-buffer))
(file buffer-file-name)
(batch-size vlf-batch-size))
(with-temp-buffer
(setq buffer-file-name file)
(set-buffer-modified-p nil)
(set (make-local-variable 'vlf-batch-size) batch-size)
(vlf-mode 1)
(goto-char (point-min))
(vlf-with-undo-disabled
(vlf-build-occur regexp vlf-buffer))))
(let ((start-pos vlf-start-pos)
(end-pos vlf-end-pos)
(pos (point)))
(vlf-beginning-of-file)
(goto-char (point-min))
(vlf-with-undo-disabled
(unwind-protect (vlf-build-occur regexp (current-buffer))
(vlf-move-to-chunk start-pos end-pos)
(goto-char pos))))))
(defun vlf-build-occur (regexp vlf-buffer)
"Build occur style index for REGEXP over VLF-BUFFER."
(let ((case-fold-search t)
(line 1)
(last-match-line 0)
(last-line-pos (point-min))
(file buffer-file-name)
(total-matches 0)
(match-end-pos (+ vlf-start-pos (position-bytes (point))))
(occur-buffer (generate-new-buffer
(concat "*VLF-occur " (file-name-nondirectory
buffer-file-name)
"*")))
(line-regexp (concat "\\(?5:[\n\C-m]\\)\\|\\(?10:"
regexp "\\)"))
(batch-step (/ vlf-batch-size 8))
(end-of-file nil)
(reporter (make-progress-reporter
(concat "Building index for " regexp "...")
vlf-start-pos vlf-file-size)))
(unwind-protect
(progn
(while (not end-of-file)
(if (re-search-forward line-regexp nil t)
(progn
(setq match-end-pos (+ vlf-start-pos
(position-bytes
(match-end 0))))
(if (match-string 5)
(setq line (1+ line) ; line detected
last-line-pos (point))
(let* ((chunk-start vlf-start-pos)
(chunk-end vlf-end-pos)
(line-pos (line-beginning-position))
(line-text (buffer-substring
line-pos (line-end-position))))
(with-current-buffer occur-buffer
(unless (= line last-match-line) ;new match line
(insert "\n:") ; insert line number
(let* ((overlay-pos (1- (point)))
(overlay (make-overlay
overlay-pos
(1+ overlay-pos))))
(overlay-put overlay 'before-string
(propertize
(number-to-string line)
'face 'shadow)))
(insert (propertize line-text ; insert line
'file file
'buffer vlf-buffer
'chunk-start chunk-start
'chunk-end chunk-end
'mouse-face '(highlight)
'line-pos line-pos
'help-echo
(format "Move to line %d"
line))))
(setq last-match-line line
total-matches (1+ total-matches))
(let ((line-start (1+
(line-beginning-position)))
(match-pos (match-beginning 10)))
(add-text-properties ; mark match
(+ line-start match-pos (- last-line-pos))
(+ line-start (match-end 10)
(- last-line-pos))
(list 'face 'match
'help-echo
(format "Move to match %d"
total-matches))))))))
(setq end-of-file (= vlf-end-pos vlf-file-size))
(unless end-of-file
(let ((batch-move (- vlf-end-pos batch-step)))
(vlf-move-to-batch (if (< batch-move match-end-pos)
match-end-pos
batch-move) t))
(goto-char (if (< vlf-start-pos match-end-pos)
(or (byte-to-position (- match-end-pos
vlf-start-pos))
(point-min))
(point-min)))
(setq last-match-line 0
last-line-pos (line-beginning-position))
(progress-reporter-update reporter vlf-end-pos))))
(progress-reporter-done reporter))
(set-buffer-modified-p nil)
(if (zerop total-matches)
(progn (with-current-buffer occur-buffer
(set-buffer-modified-p nil))
(kill-buffer occur-buffer)
(message "No matches for \"%s\"" regexp))
(with-current-buffer occur-buffer
(goto-char (point-min))
(insert (propertize
(format "%d matches in %d lines for \"%s\" \
in file: %s" total-matches line regexp file)
'face 'underline))
(set-buffer-modified-p nil)
(forward-char 2)
(vlf-occur-mode))
(display-buffer occur-buffer)))))
(provide 'vlf-occur)
;;; vlf-occur.el ends here

196
vlf-search.el Normal file
View File

@ -0,0 +1,196 @@
;;; vlf-search.el --- Search functionality for VLF -*- lexical-binding: t -*-
;; Copyright (C) 2014 Free Software Foundation, Inc.
;; Keywords: large files, search
;; Author: Andrey Kotlarski <m00naticus@gmail.com>
;; URL: https://github.com/m00natic/vlfi
;; This file is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 3, or (at your option)
;; any later version.
;; This file is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING. If not, write to
;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.
;;; Commentary:
;; This package provides search utilities for dealing with large files
;; in constant memory.
;;; Code:
(defun vlf-re-search (regexp count backward batch-step)
"Search for REGEXP COUNT number of times forward or BACKWARD.
BATCH-STEP is amount of overlap between successive chunks."
(if (<= count 0)
(error "Count must be positive"))
(let* ((case-fold-search t)
(match-chunk-start vlf-start-pos)
(match-chunk-end vlf-end-pos)
(match-start-pos (+ vlf-start-pos (position-bytes (point))))
(match-end-pos match-start-pos)
(to-find count)
(reporter (make-progress-reporter
(concat "Searching for " regexp "...")
(if backward
(- vlf-file-size vlf-end-pos)
vlf-start-pos)
vlf-file-size)))
(vlf-with-undo-disabled
(unwind-protect
(catch 'end-of-file
(if backward
(while (not (zerop to-find))
(cond ((re-search-backward regexp nil t)
(setq to-find (1- to-find)
match-chunk-start vlf-start-pos
match-chunk-end vlf-end-pos
match-start-pos (+ vlf-start-pos
(position-bytes
(match-beginning 0)))
match-end-pos (+ vlf-start-pos
(position-bytes
(match-end 0)))))
((zerop vlf-start-pos)
(throw 'end-of-file nil))
(t (let ((batch-move (- vlf-start-pos
(- vlf-batch-size
batch-step))))
(vlf-move-to-batch
(if (< match-start-pos batch-move)
(- match-start-pos vlf-batch-size)
batch-move) t))
(goto-char (if (< match-start-pos
vlf-end-pos)
(or (byte-to-position
(- match-start-pos
vlf-start-pos))
(point-max))
(point-max)))
(progress-reporter-update
reporter (- vlf-file-size
vlf-start-pos)))))
(while (not (zerop to-find))
(cond ((re-search-forward regexp nil t)
(setq to-find (1- to-find)
match-chunk-start vlf-start-pos
match-chunk-end vlf-end-pos
match-start-pos (+ vlf-start-pos
(position-bytes
(match-beginning 0)))
match-end-pos (+ vlf-start-pos
(position-bytes
(match-end 0)))))
((= vlf-end-pos vlf-file-size)
(throw 'end-of-file nil))
(t (let ((batch-move (- vlf-end-pos batch-step)))
(vlf-move-to-batch
(if (< batch-move match-end-pos)
match-end-pos
batch-move) t))
(goto-char (if (< vlf-start-pos match-end-pos)
(or (byte-to-position
(- match-end-pos
vlf-start-pos))
(point-min))
(point-min)))
(progress-reporter-update reporter
vlf-end-pos)))))
(progress-reporter-done reporter))
(set-buffer-modified-p nil)
(if backward
(vlf-goto-match match-chunk-start match-chunk-end
match-end-pos match-start-pos
count to-find)
(vlf-goto-match match-chunk-start match-chunk-end
match-start-pos match-end-pos
count to-find))))))
(defun vlf-goto-match (match-chunk-start match-chunk-end
match-pos-start
match-pos-end
count to-find)
"Move to MATCH-CHUNK-START MATCH-CHUNK-END surrounding \
MATCH-POS-START and MATCH-POS-END.
According to COUNT and left TO-FIND, show if search has been
successful. Return nil if nothing found."
(if (= count to-find)
(progn (vlf-move-to-chunk match-chunk-start match-chunk-end)
(goto-char (or (byte-to-position (- match-pos-start
vlf-start-pos))
(point-max)))
(message "Not found")
nil)
(let ((success (zerop to-find)))
(if success
(vlf-update-buffer-name)
(vlf-move-to-chunk match-chunk-start match-chunk-end))
(let* ((match-end (or (byte-to-position (- match-pos-end
vlf-start-pos))
(point-max)))
(overlay (make-overlay (byte-to-position
(- match-pos-start
vlf-start-pos))
match-end)))
(overlay-put overlay 'face 'match)
(unless success
(goto-char match-end)
(message "Moved to the %d match which is last"
(- count to-find)))
(unwind-protect (sit-for 3)
(delete-overlay overlay))
t))))
(defun vlf-re-search-forward (regexp count)
"Search forward for REGEXP prefix COUNT number of times.
Search is performed chunk by chunk in `vlf-batch-size' memory."
(interactive (if (vlf-no-modifications)
(list (read-regexp "Search whole file"
(if regexp-history
(car regexp-history)))
(or current-prefix-arg 1))))
(vlf-re-search regexp count nil (/ vlf-batch-size 8)))
(defun vlf-re-search-backward (regexp count)
"Search backward for REGEXP prefix COUNT number of times.
Search is performed chunk by chunk in `vlf-batch-size' memory."
(interactive (if (vlf-no-modifications)
(list (read-regexp "Search whole file backward"
(if regexp-history
(car regexp-history)))
(or current-prefix-arg 1))))
(vlf-re-search regexp count t (/ vlf-batch-size 8)))
(defun vlf-goto-line (n)
"Go to line N. If N is negative, count from the end of file."
(interactive (if (vlf-no-modifications)
(list (read-number "Go to line: "))))
(let ((start-pos vlf-start-pos)
(end-pos vlf-end-pos)
(pos (point))
(success nil))
(unwind-protect
(if (< 0 n)
(progn (vlf-beginning-of-file)
(goto-char (point-min))
(setq success (vlf-re-search "[\n\C-m]" (1- n)
nil 0)))
(vlf-end-of-file)
(goto-char (point-max))
(setq success (vlf-re-search "[\n\C-m]" (- n) t 0)))
(if success
(message "Onto line %s" n)
(vlf-move-to-chunk start-pos end-pos)
(goto-char pos)))))
(provide 'vlf-search)
;;; vlf-search.el ends here

145
vlf-write.el Normal file
View File

@ -0,0 +1,145 @@
;;; vlf-write.el --- Saving functionality for VLF -*- lexical-binding: t -*-
;; Copyright (C) 2014 Free Software Foundation, Inc.
;; Keywords: large files, saving
;; Author: Andrey Kotlarski <m00naticus@gmail.com>
;; URL: https://github.com/m00natic/vlfi
;; This file is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 3, or (at your option)
;; any later version.
;; This file is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING. If not, write to
;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.
;;; Commentary:
;; This package provides the `vlf-write' command which takes care of
;; saving changes where only part of file is viewed and updated.
;;; Code:
(defun vlf-write ()
"Write current chunk to file. Always return true to disable save.
If changing size of chunk, shift remaining file content."
(interactive)
(and (buffer-modified-p)
(or (verify-visited-file-modtime (current-buffer))
(y-or-n-p "File has changed since visited or saved. \
Save anyway? "))
(if (zerop vlf-file-size) ;new file
(progn
(write-region nil nil buffer-file-name vlf-start-pos t)
(setq vlf-file-size (vlf-get-file-size
buffer-file-truename)
vlf-end-pos vlf-file-size)
(vlf-update-buffer-name))
(let* ((region-length (length (encode-coding-region
(point-min) (point-max)
buffer-file-coding-system t)))
(size-change (- vlf-end-pos vlf-start-pos
region-length)))
(if (zerop size-change)
(write-region nil nil buffer-file-name vlf-start-pos t)
(let ((pos (point)))
(if (< 0 size-change)
(vlf-file-shift-back size-change)
(vlf-file-shift-forward (- size-change))
(vlf-verify-size))
(vlf-move-to-chunk-2 vlf-start-pos
(if (< (- vlf-end-pos vlf-start-pos)
vlf-batch-size)
(+ vlf-start-pos vlf-batch-size)
vlf-end-pos))
(vlf-update-buffer-name)
(goto-char pos))))))
t)
(defun vlf-file-shift-back (size-change)
"Shift file contents SIZE-CHANGE bytes back."
(write-region nil nil buffer-file-name vlf-start-pos t)
(let ((read-start-pos vlf-end-pos)
(coding-system-for-write 'no-conversion)
(reporter (make-progress-reporter "Adjusting file content..."
vlf-end-pos
vlf-file-size)))
(vlf-with-undo-disabled
(while (vlf-shift-batch read-start-pos (- read-start-pos
size-change))
(setq read-start-pos (+ read-start-pos vlf-batch-size))
(progress-reporter-update reporter read-start-pos))
;; pad end with space
(erase-buffer)
(vlf-verify-size)
(insert-char 32 size-change))
(write-region nil nil buffer-file-name (- vlf-file-size
size-change) t)
(progress-reporter-done reporter)))
(defun vlf-shift-batch (read-pos write-pos)
"Read `vlf-batch-size' bytes from READ-POS and write them \
back at WRITE-POS. Return nil if EOF is reached, t otherwise."
(erase-buffer)
(vlf-verify-size)
(let ((read-end (+ read-pos vlf-batch-size)))
(insert-file-contents-literally buffer-file-name nil
read-pos
(min vlf-file-size read-end))
(write-region nil nil buffer-file-name write-pos 0)
(< read-end vlf-file-size)))
(defun vlf-file-shift-forward (size-change)
"Shift file contents SIZE-CHANGE bytes forward.
Done by saving content up front and then writing previous batch."
(let ((read-size (max (/ vlf-batch-size 2) size-change))
(read-pos vlf-end-pos)
(write-pos vlf-start-pos)
(reporter (make-progress-reporter "Adjusting file content..."
vlf-start-pos
vlf-file-size)))
(vlf-with-undo-disabled
(when (vlf-shift-batches read-size read-pos write-pos t)
(setq write-pos (+ read-pos size-change)
read-pos (+ read-pos read-size))
(progress-reporter-update reporter write-pos)
(let ((coding-system-for-write 'no-conversion))
(while (vlf-shift-batches read-size read-pos write-pos nil)
(setq write-pos (+ read-pos size-change)
read-pos (+ read-pos read-size))
(progress-reporter-update reporter write-pos)))))
(progress-reporter-done reporter)))
(defun vlf-shift-batches (read-size read-pos write-pos hide-read)
"Append READ-SIZE bytes of file starting at READ-POS.
Then write initial buffer content to file at WRITE-POS.
If HIDE-READ is non nil, temporarily hide literal read content.
Return nil if EOF is reached, t otherwise."
(vlf-verify-size)
(let ((read-more (< read-pos vlf-file-size))
(start-write-pos (point-min))
(end-write-pos (point-max)))
(when read-more
(goto-char end-write-pos)
(insert-file-contents-literally buffer-file-name nil read-pos
(min vlf-file-size
(+ read-pos read-size))))
;; write
(if hide-read ; hide literal region if user has to choose encoding
(narrow-to-region start-write-pos end-write-pos))
(write-region start-write-pos end-write-pos
buffer-file-name write-pos 0)
(delete-region start-write-pos end-write-pos)
(if hide-read (widen))
read-more))
(provide 'vlf-write)
;;; vlf-write.el ends here

1017
vlf.el

File diff suppressed because it is too large Load Diff