sascha/vlfi
1
0
Fork 0
mirror of https://github.com/m00natic/vlfi.git synced 2025-01-18 12:05:31 +00:00
Code Issues Releases Wiki Activity

vlf-occur changes:

Browse Source 
- support multi-line matches
- divide user regex search from line counting
- fix wrong last match overall position
- fix edge cases of incorrect line numbers, matches in last chunk line
which is incomplete
This commit is contained in:
Andrey Kotlarski 2014-12-13 18:49:37 +02:00
parent 0fa624837a
commit 68d6c1bc33
1 changed files with 139 additions and 84 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

223
vlf-occur.el
View File

@ -45,6 +45,7 @@
(make-variable-buffer-local 'vlf-occur-lines) (make-variable-buffer-local 'vlf-occur-lines)
(defvar tramp-verbose) (defvar tramp-verbose)
(defvar hexl-bits)
(defvar vlf-occur-mode-map (defvar vlf-occur-mode-map
(let ((map (make-sparse-keymap))) (let ((map (make-sparse-keymap)))
@ -109,7 +110,8 @@ EVENT may hold details of the invocation."
(set-buffer (window-buffer (posn-window (event-end event)))) (set-buffer (window-buffer (posn-window (event-end event))))
(goto-char (posn-point (event-end event)))) (goto-char (posn-point (event-end event))))
(let* ((pos (point)) (let* ((pos (point))
(pos-relative (- pos (line-beginning-position) 1)) (pos-relative (- pos (previous-single-char-property-change
pos 'vlf-match)))
(chunk-start (get-text-property pos 'chunk-start))) (chunk-start (get-text-property pos 'chunk-start)))
(if chunk-start (if chunk-start
(let ((chunk-end (get-text-property pos 'chunk-end)) (let ((chunk-end (get-text-property pos 'chunk-end))
@ -190,6 +192,7 @@ Prematurely ending indexing will still show what's found so far."
(car regexp-history))))) (car regexp-history)))))
(run-hook-with-args 'vlf-before-batch-functions 'occur) (run-hook-with-args 'vlf-before-batch-functions 'occur)
(if (or (buffer-modified-p) (if (or (buffer-modified-p)
(consp buffer-undo-list)
(< vlf-batch-size vlf-start-pos)) (< vlf-batch-size vlf-start-pos))
(vlf-occur-other-buffer regexp) (vlf-occur-other-buffer regexp)
(let ((start-pos vlf-start-pos) (let ((start-pos vlf-start-pos)
@ -199,13 +202,12 @@ Prematurely ending indexing will still show what's found so far."
(vlf-tune-batch (if (derived-mode-p 'hexl-mode) (vlf-tune-batch (if (derived-mode-p 'hexl-mode)
'(:hexl :raw) '(:hexl :raw)
'(:insert :encode)) t) '(:insert :encode)) t)
(vlf-with-undo-disabled (vlf-move-to-batch 0)
(vlf-move-to-batch 0) (goto-char (point-min))
(goto-char (point-min)) (unwind-protect (vlf-build-occur regexp (current-buffer))
(unwind-protect (vlf-build-occur regexp (current-buffer)) (vlf-move-to-chunk start-pos end-pos)
(vlf-move-to-chunk start-pos end-pos) (goto-char pos)
(goto-char pos) (setq vlf-batch-size batch-size))))
(setq vlf-batch-size batch-size)))))
(run-hook-with-args 'vlf-after-batch-functions 'occur)) (run-hook-with-args 'vlf-after-batch-functions 'occur))
(defun vlf-build-occur (regexp vlf-buffer) (defun vlf-build-occur (regexp vlf-buffer)
@ -215,16 +217,16 @@ Prematurely ending indexing will still show what's found so far."
(case-fold-search t) (case-fold-search t)
(line 1) (line 1)
(last-match-line 0) (last-match-line 0)
(last-line-pos (point-min))
(total-matches 0) (total-matches 0)
(match-end-pos (+ vlf-start-pos (position-bytes (point)))) (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 (occur-buffer (generate-new-buffer
(concat "*VLF-occur " (file-name-nondirectory (concat "*VLF-occur " (file-name-nondirectory
buffer-file-name) buffer-file-name)
"*"))) "*")))
(line-regexp (concat "\\(?5:[\n\C-m]\\)\\|\\(?10:"
regexp "\\)"))
(batch-step (min 1024 (/ vlf-batch-size 8)))
(is-hexl (derived-mode-p 'hexl-mode)) (is-hexl (derived-mode-p 'hexl-mode))
(end-of-file nil) (end-of-file nil)
(time (float-time)) (time (float-time))
@ -238,70 +240,118 @@ Prematurely ending indexing will still show what's found so far."
(unwind-protect (unwind-protect
(progn (progn
(while (not end-of-file) (while (not end-of-file)
(if (re-search-forward line-regexp nil t) (if (re-search-forward regexp nil t)
(progn (progn
(setq match-end-pos (+ vlf-start-pos (setq line (+ line -1
(position-bytes (count-lines match-start-point
(match-end 0)))) (1+ (match-beginning 0))))
(if (match-string 5) match-start-point (match-beginning 0)
(setq line (1+ line) ; line detected match-end-point (match-end 0))
last-line-pos (point)) (let* ((chunk-start vlf-start-pos)
(let* ((chunk-start vlf-start-pos) (chunk-end vlf-end-pos)
(chunk-end vlf-end-pos) (line-pos (save-excursion
(line-pos (line-beginning-position)) (goto-char match-start-point)
(line-text (buffer-substring (line-beginning-position)))
line-pos (line-end-position)))) (line-text (buffer-substring
(with-current-buffer occur-buffer line-pos (line-end-position))))
(unless (= line last-match-line) ;new match line (if (/= line-pos (point-min))
(insert "\n:") ; insert line number (setq first-line-offset 0
(let* ((overlay-pos (1- (point))) first-line-incomplete nil))
(overlay (make-overlay (with-current-buffer occur-buffer
overlay-pos (unless (= line last-match-line) ;new match line
(1+ overlay-pos)))) (insert "\n:") ; insert line number
(overlay-put overlay 'before-string (let* ((column-point (1- (point)))
(propertize (overlay-pos column-point)
(number-to-string line) (overlay (make-overlay
'face 'shadow))) overlay-pos
(insert (propertize line-text ; insert line (1+ overlay-pos))))
'chunk-start chunk-start (overlay-put overlay 'before-string
'chunk-end chunk-end (propertize
'mouse-face '(highlight) (number-to-string line)
'line-pos line-pos 'face 'shadow))
'help-echo (overlay-put overlay 'vlf-match t)
(format "Move to line %d" (setq last-match-insert-point column-point
line)))) first-line-offset 0)))
(setq last-match-line line (when (or first-line-incomplete
total-matches (1+ total-matches)) (/= line last-match-line))
(let ((line-start (1+ (insert (propertize
(line-beginning-position))) (if first-line-incomplete
(match-pos (match-beginning 10))) (substring line-text
(add-text-properties ; mark match first-line-incomplete)
(+ line-start match-pos (- last-line-pos)) line-text)
(+ line-start (match-end 10) 'chunk-start chunk-start
(- last-line-pos)) 'chunk-end chunk-end
(list 'face 'match 'mouse-face '(highlight)
'line-pos line-pos
'help-echo 'help-echo
(format "Move to match %d" (format "Move to line %d"
total-matches)))))))) 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)) (setq end-of-file (= vlf-end-pos vlf-file-size))
(unless end-of-file (unless end-of-file
(vlf-tune-batch tune-types) (let ((start
(let* ((batch-move (- vlf-end-pos batch-step)) (if is-hexl
(start (if (or is-hexl (< match-end-pos (progn
batch-move)) (goto-char (point-max))
batch-move (forward-line -10)
match-end-pos))) (setq line
(vlf-move-to-chunk start (+ start (+ line
vlf-batch-size) t)) (if (< match-end-point (point))
(goto-char (if (or is-hexl (count-lines match-start-point
(<= match-end-pos vlf-start-pos)) (point))
(point-min) (goto-char match-end-point)
(or (byte-to-position (- match-end-pos (1- (count-lines match-start-point
vlf-start-pos)) match-end-point)))))
(point-min)))) (- vlf-end-pos (* (- 10 (forward-line 10))
(setq last-match-line 0 hexl-bits)))
last-line-pos (line-beginning-position)) (let* ((batch-step (min 1024 (/ vlf-batch-size
(progress-reporter-update reporter vlf-end-pos)))) 10)))
(batch-point
(max match-end-point
(or
(byte-to-position
(- vlf-batch-size batch-step))
(progn
(goto-char (point-max))
(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
(let ((pmax (point-max)))
(if (= (point) pmax)
(- pmax match-end-point))))
(+ vlf-start-pos
(vlf-tune-encode-length (point-min)
batch-point))))))
(vlf-tune-batch tune-types)
(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)) (progress-reporter-done reporter))
(set-buffer-modified-p nil) (set-buffer-modified-p nil)
(if (zerop total-matches) (if (zerop total-matches)
@ -311,6 +361,7 @@ Prematurely ending indexing will still show what's found so far."
(let ((file buffer-file-name) (let ((file buffer-file-name)
(dir default-directory)) (dir default-directory))
(with-current-buffer occur-buffer (with-current-buffer occur-buffer
(insert "\n")
(goto-char (point-min)) (goto-char (point-min))
(insert (propertize (insert (propertize
(format "%d matches from %d lines for \"%s\" \ (format "%d matches from %d lines for \"%s\" \
@ -355,17 +406,20 @@ in file: %s" total-matches line regexp file)
vlf-occur-save-buffer) vlf-occur-save-buffer)
(save-excursion (save-excursion
(goto-char (point-min)) (goto-char (point-min))
(while (zerop (forward-line)) (let ((pmax (point-max)))
(let* ((pos (1+ (point))) (while (/= pmax (goto-char (next-single-char-property-change
(line (get-char-property (1- pos) 'before-string))) (1+ (point)) 'vlf-match)))
(if line (let* ((pos (1+ (point)))
(prin1 (list (string-to-number line) (line (get-char-property (1- pos) 'before-string)))
(get-text-property pos 'chunk-start) (if line
(get-text-property pos 'chunk-end) (prin1 (list (string-to-number line)
(get-text-property pos 'line-pos) (get-text-property pos 'chunk-start)
(buffer-substring-no-properties (get-text-property pos 'chunk-end)
pos (line-end-position))) (get-text-property pos 'line-pos)
vlf-occur-save-buffer))))) (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 (with-current-buffer vlf-occur-save-buffer
(save-buffer)) (save-buffer))
(kill-buffer vlf-occur-save-buffer)) (kill-buffer vlf-occur-save-buffer))
@ -401,6 +455,7 @@ in file: %s" total-matches line regexp file)
(pos (point))) (pos (point)))
(overlay-put overlay 'before-string (overlay-put overlay 'before-string
(propertize line 'face 'shadow)) (propertize line 'face 'shadow))
(overlay-put overlay 'vlf-match t)
(insert (propertize (nth 4 form) 'chunk-start (nth 1 form) (insert (propertize (nth 4 form) 'chunk-start (nth 1 form)
'chunk-end (nth 2 form) 'chunk-end (nth 2 form)
'mouse-face '(highlight) 'mouse-face '(highlight)