(require 'vlf)
+(defvar vlf-occur-vlf-file nil "VLF file that is searched.")
+(make-variable-buffer-local 'vlf-occur-vlf-file)
+
+(defvar vlf-occur-vlf-buffer nil "VLF buffer that is scanned.")
+(make-variable-buffer-local 'vlf-occur-vlf-buffer)
+
+(defvar vlf-occur-regexp)
+(make-variable-buffer-local 'vlf-occur-regexp)
+
+(defvar vlf-occur-hexl nil "Is `hexl-mode' active?")
+(make-variable-buffer-local 'vlf-occur-hexl)
+
+(defvar vlf-occur-lines 0 "Number of lines scanned by `vlf-occur'.")
+(make-variable-buffer-local 'vlf-occur-lines)
+
+(defvar tramp-verbose)
+(defvar hexl-bits)
+
(defvar vlf-occur-mode-map
(let ((map (make-sparse-keymap)))
(define-key map "n" 'vlf-occur-next-match)
(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)
+ (define-key map [remap save-buffer] 'vlf-occur-save)
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.")
+ "Major mode for showing occur matches of VLF opened files."
+ (add-hook 'write-file-functions 'vlf-occur-save nil t))
(defun vlf-occur-next-match ()
"Move cursor to next match."
(interactive)
- (if (eq (get-char-property (point) 'face) 'match)
+ (if (eq (get-text-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)
(defun vlf-occur-prev-match ()
"Move cursor to previous match."
(interactive)
- (if (eq (get-char-property (point) 'face) 'match)
+ (if (eq (get-text-property (point) 'face) 'match)
(goto-char (previous-single-property-change (point) 'face)))
- (while (not (eq (get-char-property (point) 'face) 'match))
+ (while (not (eq (get-text-property (point) 'face) 'match))
(goto-char (or (previous-single-property-change (point) 'face)
(point-max)))))
(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))
+ (pos-relative (- pos (previous-single-char-property-change
+ pos 'vlf-match)))
+ (chunk-start (get-text-property pos 'chunk-start)))
+ (if chunk-start
+ (let ((chunk-end (get-text-property pos 'chunk-end))
+ (file (if (file-exists-p vlf-occur-vlf-file)
+ vlf-occur-vlf-file
+ (setq vlf-occur-vlf-file
+ (read-file-name
+ (concat vlf-occur-vlf-file
+ " doesn't exist, locate it: ")))))
+ (vlf-buffer vlf-occur-vlf-buffer)
+ (not-hexl (not vlf-occur-hexl))
(occur-buffer (current-buffer))
- (match-pos (+ (get-char-property pos 'line-pos)
+ (match-pos (+ (get-text-property pos 'line-pos)
pos-relative)))
(cond (current-prefix-arg
- (setq vlf-buffer (vlf file))
+ (let ((original-occur-buffer vlf-occur-vlf-buffer))
+ (setq vlf-buffer (vlf file t))
+ (if (buffer-live-p original-occur-buffer)
+ (vlf-tune-copy-profile original-occur-buffer)))
+ (or not-hexl (hexl-mode))
(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)))
+ (unless (catch 'found
+ (dolist (buf (buffer-list))
+ (set-buffer buf)
+ (and vlf-mode
+ (equal file buffer-file-name)
+ (eq (not (derived-mode-p 'hexl-mode))
+ not-hexl)
+ (setq vlf-buffer buf)
+ (throw 'found t))))
+ (setq vlf-buffer (vlf file t))
+ (or not-hexl (hexl-mode)))
+ (switch-to-buffer occur-buffer)
+ (setq vlf-occur-vlf-buffer vlf-buffer)))
(pop-to-buffer vlf-buffer)
(vlf-move-to-chunk chunk-start chunk-end)
(goto-char match-pos)))))
+(defun vlf-occur-other-buffer (regexp)
+ "Make whole file occur style index for REGEXP branching to new buffer.
+Prematurely ending indexing will still show what's found so far."
+ (let ((vlf-buffer (current-buffer))
+ (file buffer-file-name)
+ (file-size vlf-file-size)
+ (batch-size vlf-batch-size)
+ (is-hexl (derived-mode-p 'hexl-mode)))
+ (with-temp-buffer
+ (setq buffer-file-name file
+ buffer-file-truename file
+ buffer-undo-list t
+ vlf-file-size file-size)
+ (set-buffer-modified-p nil)
+ (set (make-local-variable 'vlf-batch-size) batch-size)
+ (when vlf-tune-enabled
+ (vlf-tune-copy-profile vlf-buffer)
+ (vlf-tune-batch (if is-hexl
+ '(:hexl :raw)
+ '(:insert :encode)) t))
+ (vlf-mode 1)
+ (if is-hexl (hexl-mode))
+ (goto-char (point-min))
+ (vlf-build-occur regexp vlf-buffer)
+ (if vlf-tune-enabled
+ (vlf-tune-copy-profile (current-buffer) vlf-buffer)))))
+
(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))))
+ (run-hook-with-args 'vlf-before-batch-functions 'occur)
+ (if (or (buffer-modified-p)
+ (consp buffer-undo-list)
+ (< vlf-batch-size vlf-start-pos))
+ (vlf-occur-other-buffer regexp)
(let ((start-pos vlf-start-pos)
(end-pos vlf-end-pos)
- (pos (point)))
- (vlf-with-undo-disabled
- (vlf-beginning-of-file)
- (goto-char (point-min))
- (unwind-protect (vlf-build-occur regexp (current-buffer))
- (vlf-move-to-chunk start-pos end-pos)
- (goto-char pos))))))
+ (pos (point))
+ (batch-size vlf-batch-size))
+ (vlf-tune-batch (if (derived-mode-p 'hexl-mode)
+ '(:hexl :raw)
+ '(:insert :encode)) t)
+ (vlf-move-to-batch 0)
+ (goto-char (point-min))
+ (unwind-protect (vlf-build-occur regexp (current-buffer))
+ (vlf-move-to-chunk start-pos end-pos)
+ (goto-char pos)
+ (setq vlf-batch-size batch-size))))
+ (run-hook-with-args 'vlf-after-batch-functions 'occur))
(defun vlf-build-occur (regexp vlf-buffer)
"Build occur style index for REGEXP over VLF-BUFFER."
- (let ((tramp-verbose (min 2 tramp-verbose))
- (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)))
+ (let* ((tramp-verbose (if (boundp 'tramp-verbose)
+ (min tramp-verbose 1)))
+ (case-fold-search t)
+ (line 1)
+ (last-match-line 0)
+ (total-matches 0)
+ (first-line-offset 0)
+ (first-line-incomplete nil)
+ (match-start-point (point-min))
+ (match-end-point match-start-point)
+ (last-match-insert-point nil)
+ (occur-buffer (generate-new-buffer
+ (concat "*VLF-occur " (file-name-nondirectory
+ buffer-file-name)
+ "*")))
+ (is-hexl (derived-mode-p 'hexl-mode))
+ (end-of-file nil)
+ (time (float-time))
+ (tune-types (if is-hexl '(:hexl :raw)
+ '(:insert :encode)))
+ (reporter (make-progress-reporter
+ (concat "Building index for " regexp "...")
+ vlf-start-pos vlf-file-size)))
+ (with-current-buffer occur-buffer
+ (setq buffer-undo-list t))
(unwind-protect
(progn
(while (not end-of-file)
- (if (re-search-forward line-regexp nil t)
+ (if (re-search-forward 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
+ (setq line (+ line -1
+ (count-lines match-start-point
+ (1+ (match-beginning 0))))
+ match-start-point (match-beginning 0)
+ match-end-point (match-end 0))
+ (let* ((chunk-start vlf-start-pos)
+ (chunk-end vlf-end-pos)
+ (line-pos (save-excursion
+ (goto-char match-start-point)
+ (line-beginning-position)))
+ (line-text (buffer-substring
+ line-pos (line-end-position))))
+ (if (/= line-pos (point-min))
+ (setq first-line-offset 0
+ first-line-incomplete nil))
+ (with-current-buffer occur-buffer
+ (unless (= line last-match-line) ;new match line
+ (insert "\n:") ; insert line number
+ (let* ((column-point (1- (point)))
+ (overlay-pos column-point)
+ (overlay (make-overlay
+ overlay-pos
+ (1+ overlay-pos))))
+ (overlay-put overlay 'before-string
+ (propertize
+ (number-to-string line)
+ 'face 'shadow))
+ (overlay-put overlay 'vlf-match t)
+ (setq last-match-insert-point column-point
+ first-line-offset 0)))
+ (when (or first-line-incomplete
+ (/= line last-match-line))
+ (insert (propertize
+ (if first-line-incomplete
+ (substring line-text
+ first-line-incomplete)
+ line-text)
+ 'chunk-start chunk-start
+ 'chunk-end chunk-end
+ 'mouse-face '(highlight)
+ 'line-pos line-pos
'help-echo
- (format "Move to match %d"
- total-matches))))))))
+ (format "Move to line %d"
+ line)))
+ (setq first-line-incomplete nil))
+ (setq last-match-line line
+ total-matches (1+ total-matches))
+ (let ((line-start (+ last-match-insert-point
+ first-line-offset 1
+ (- line-pos))))
+ (add-text-properties ; mark match
+ (+ line-start match-start-point)
+ (+ line-start match-end-point)
+ (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))))
+ (let ((start
+ (if is-hexl
+ (progn
+ (goto-char (point-max))
+ (forward-line -10)
+ (setq line
+ (+ line
+ (if (< match-end-point (point))
+ (count-lines match-start-point
+ (point))
+ (goto-char match-end-point)
+ (1- (count-lines match-start-point
+ match-end-point)))))
+ (- vlf-end-pos (* (- 10 (forward-line 10))
+ hexl-bits)))
+ (let* ((pmax (point-max))
+ (batch-step (min 1024 (/ vlf-batch-size
+ 10)))
+ (batch-point
+ (max match-end-point
+ (or
+ (byte-to-position
+ (- vlf-batch-size batch-step))
+ (progn
+ (goto-char pmax)
+ (let ((last (line-beginning-position)))
+ (if (= last (point-min))
+ (1- (point))
+ last)))))))
+ (goto-char batch-point)
+ (setq first-line-offset
+ (- batch-point (line-beginning-position))
+ line
+ (+ line
+ (count-lines match-start-point
+ batch-point)
+ (if (< 0 first-line-offset) -1 0)))
+ ;; last match is on the last line?
+ (goto-char match-end-point)
+ (forward-line)
+ (setq first-line-incomplete
+ (if (= (point) pmax)
+ (- pmax match-end-point)))
+ (vlf-byte-position batch-point)))))
+ (vlf-tune-batch tune-types)
+ (setq vlf-end-pos start) ;not to adjust start
+ (vlf-move-to-chunk start (+ start vlf-batch-size)))
+ (setq match-start-point (point-min)
+ match-end-point match-start-point)
+ (goto-char match-end-point)
+ (progress-reporter-update reporter vlf-start-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\" \
+ (progn (kill-buffer occur-buffer)
+ (message "No matches for \"%s\" (%f secs)"
+ regexp (- (float-time) time)))
+ (let ((file buffer-file-name)
+ (dir default-directory))
+ (with-current-buffer occur-buffer
+ (insert "\n")
+ (goto-char (point-min))
+ (insert (propertize
+ (format "%d matches from %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)))))
+ 'face 'underline))
+ (set-buffer-modified-p nil)
+ (forward-char 2)
+ (vlf-occur-mode)
+ (setq default-directory dir
+ vlf-occur-vlf-file file
+ vlf-occur-vlf-buffer vlf-buffer
+ vlf-occur-regexp regexp
+ vlf-occur-hexl is-hexl
+ vlf-occur-lines line)))
+ (display-buffer occur-buffer)
+ (message "Occur finished for \"%s\" (%f secs)"
+ regexp (- (float-time) time))))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; save, load vlf-occur data
+
+(defun vlf-occur-save (file)
+ "Serialize `vlf-occur' results to FILE which can later be reloaded."
+ (interactive (list (or buffer-file-name
+ (read-file-name "Save vlf-occur results in: "
+ nil nil nil
+ (concat
+ (file-name-nondirectory
+ vlf-occur-vlf-file)
+ ".vlfo")))))
+ (setq buffer-file-name file)
+ (let ((vlf-occur-save-buffer
+ (generate-new-buffer (concat "*VLF-occur-save "
+ (file-name-nondirectory file)
+ "*"))))
+ (with-current-buffer vlf-occur-save-buffer
+ (setq buffer-file-name file
+ buffer-undo-list t)
+ (insert ";; -*- eval: (vlf-occur-load) -*-\n"))
+ (prin1 (list vlf-occur-vlf-file vlf-occur-regexp vlf-occur-hexl
+ vlf-occur-lines)
+ vlf-occur-save-buffer)
+ (save-excursion
+ (goto-char (point-min))
+ (let ((pmax (point-max)))
+ (while (/= pmax (goto-char (next-single-char-property-change
+ (1+ (point)) 'vlf-match)))
+ (let* ((pos (1+ (point)))
+ (line (get-char-property (1- pos) 'before-string)))
+ (if line
+ (prin1 (list (string-to-number line)
+ (get-text-property pos 'chunk-start)
+ (get-text-property pos 'chunk-end)
+ (get-text-property pos 'line-pos)
+ (buffer-substring-no-properties
+ pos (1- (next-single-char-property-change
+ pos 'vlf-match))))
+ vlf-occur-save-buffer))))))
+ (with-current-buffer vlf-occur-save-buffer
+ (save-buffer))
+ (kill-buffer vlf-occur-save-buffer))
+ t)
+
+;;;###autoload
+(defun vlf-occur-load ()
+ "Load serialized `vlf-occur' results from current buffer."
+ (interactive)
+ (goto-char (point-min))
+ (let* ((vlf-occur-data-buffer (current-buffer))
+ (header (read vlf-occur-data-buffer))
+ (vlf-file (nth 0 header))
+ (regexp (nth 1 header))
+ (all-lines (nth 3 header))
+ (file buffer-file-name)
+ (vlf-occur-buffer
+ (generate-new-buffer (concat "*VLF-occur "
+ (file-name-nondirectory file)
+ "*"))))
+ (switch-to-buffer vlf-occur-buffer)
+ (setq buffer-file-name file
+ buffer-undo-list t)
+ (goto-char (point-min))
+ (let ((match-count 0)
+ (form 0))
+ (while (setq form (ignore-errors (read vlf-occur-data-buffer)))
+ (goto-char (point-max))
+ (insert "\n:")
+ (let* ((overlay-pos (1- (point)))
+ (overlay (make-overlay overlay-pos (1+ overlay-pos)))
+ (line (number-to-string (nth 0 form)))
+ (pos (point)))
+ (overlay-put overlay 'before-string
+ (propertize line 'face 'shadow))
+ (overlay-put overlay 'vlf-match t)
+ (insert (propertize (nth 4 form) 'chunk-start (nth 1 form)
+ 'chunk-end (nth 2 form)
+ 'mouse-face '(highlight)
+ 'line-pos (nth 3 form)
+ 'help-echo (concat "Move to line "
+ line)))
+ (goto-char pos)
+ (while (re-search-forward regexp nil t)
+ (add-text-properties
+ (match-beginning 0) (match-end 0)
+ (list 'face 'match 'help-echo
+ (format "Move to match %d"
+ (setq match-count (1+ match-count))))))))
+ (kill-buffer vlf-occur-data-buffer)
+ (goto-char (point-min))
+ (insert (propertize
+ (format "%d matches from %d lines for \"%s\" in file: %s"
+ match-count all-lines regexp vlf-file)
+ 'face 'underline)))
+ (set-buffer-modified-p nil)
+ (vlf-occur-mode)
+ (setq vlf-occur-vlf-file vlf-file
+ vlf-occur-regexp regexp
+ vlf-occur-hexl (nth 2 header)
+ vlf-occur-lines all-lines)))
(provide 'vlf-occur)