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

Improve search precision.

Browse Source
This commit is contained in:
Andrey Kotlarski 2014-12-27 02:31:47 +02:00
parent b300137941
commit 86be48302e
1 changed files with 87 additions and 108 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

195
vlf-search.el
View File

@ -32,10 +32,9 @@
(defvar hexl-bits) (defvar hexl-bits)
(defvar tramp-verbose) (defvar tramp-verbose)
(defun vlf-re-search (regexp count backward batch-step (defun vlf-re-search (regexp count backward
&optional reporter time highlight) &optional reporter time highlight)
"Search for REGEXP COUNT number of times forward or BACKWARD. "Search for REGEXP COUNT number of times forward or BACKWARD.
BATCH-STEP is amount of overlap between successive chunks.
Use existing REPORTER and start TIME if given. Use existing REPORTER and start TIME if given.
Highlight match if HIGHLIGHT is non nil. Highlight match if HIGHLIGHT is non nil.
Return t if search has been at least partially successful." Return t if search has been at least partially successful."
@ -54,8 +53,9 @@ Return t if search has been at least partially successful."
(case-fold-search t) (case-fold-search t)
(match-chunk-start vlf-start-pos) (match-chunk-start vlf-start-pos)
(match-chunk-end vlf-end-pos) (match-chunk-end vlf-end-pos)
(match-start-pos (+ vlf-start-pos (position-bytes (point)))) (match-start-pos (point))
(match-end-pos match-start-pos) (match-end-pos match-start-pos)
(last-match-pos match-start-pos)
(to-find count) (to-find count)
(is-hexl (derived-mode-p 'hexl-mode)) (is-hexl (derived-mode-p 'hexl-mode))
(tune-types (if is-hexl '(:hexl :raw) (tune-types (if is-hexl '(:hexl :raw)
@ -68,71 +68,69 @@ Return t if search has been at least partially successful."
(if backward (if backward
(while (not (zerop to-find)) (while (not (zerop to-find))
(cond ((re-search-backward regexp nil t) (cond ((re-search-backward regexp nil t)
(setq match-end-pos (+ vlf-start-pos (setq to-find (1- to-find)
(position-bytes match-chunk-start vlf-start-pos
(match-end 0)))) match-chunk-end vlf-end-pos
(if (/= match-start-pos match-end-pos) match-start-pos (match-beginning 0)
(setq to-find (1- to-find) match-end-pos (match-end 0)
match-chunk-start vlf-start-pos last-match-pos match-start-pos))
match-chunk-end vlf-end-pos
match-start-pos
(+ vlf-start-pos
(position-bytes
(match-beginning 0))))))
((zerop vlf-start-pos) ((zerop vlf-start-pos)
(throw 'end-of-file nil)) (throw 'end-of-file nil))
(t (vlf-tune-batch tune-types) (t (let ((end
(let* ((batch-move (+ vlf-start-pos (if is-hexl
batch-step)) (progn
(end (if (or is-hexl (goto-char (point-min))
(<= batch-move (forward-line 10)
match-start-pos)) (if (< last-match-pos (point))
batch-move (goto-char last-match-pos))
match-start-pos))) (+ vlf-start-pos
(* (- 10 (forward-line -10))
hexl-bits)))
(vlf-byte-position
(min 1024 (/ (point-max) 10)
last-match-pos)))))
(vlf-tune-batch tune-types)
(setq vlf-start-pos end) ;don't adjust end
(vlf-move-to-chunk (- end vlf-batch-size) (vlf-move-to-chunk (- end vlf-batch-size)
end)) end))
(goto-char (if (or is-hexl (let ((pmax (point-max)))
(<= vlf-end-pos (goto-char pmax)
match-start-pos)) (setq last-match-pos pmax))
(point-max)
(or (byte-to-position
(- match-start-pos
vlf-start-pos))
(point-max))))
(progress-reporter-update (progress-reporter-update
reporter (- vlf-file-size reporter (- vlf-file-size
vlf-start-pos))))) vlf-start-pos)))))
(while (not (zerop to-find)) (while (not (zerop to-find))
(cond ((re-search-forward regexp nil t) (cond ((re-search-forward regexp nil t)
(setq match-start-pos (+ vlf-start-pos (setq to-find (1- to-find)
(position-bytes match-chunk-start vlf-start-pos
(match-beginning 0)))) match-chunk-end vlf-end-pos
(if (/= match-start-pos match-end-pos) match-start-pos (match-beginning 0)
(setq to-find (1- to-find) match-end-pos (match-end 0)
match-chunk-start vlf-start-pos last-match-pos match-end-pos))
match-chunk-end vlf-end-pos
match-end-pos (+ vlf-start-pos
(position-bytes
(match-end 0))))))
((>= vlf-end-pos vlf-file-size) ((>= vlf-end-pos vlf-file-size)
(throw 'end-of-file nil)) (throw 'end-of-file nil))
(t (vlf-tune-batch tune-types) (t (let* ((pmax (point-max))
(let* ((batch-move (- vlf-end-pos batch-step)) (start
(start (if (or is-hexl (if is-hexl
(< match-end-pos (progn
batch-move)) (goto-char pmax)
batch-move (forward-line -10)
match-end-pos))) (if (< (point) last-match-pos)
(vlf-move-to-chunk start (goto-char last-match-pos))
(+ start vlf-batch-size))) (- vlf-end-pos
(goto-char (if (or is-hexl (* (- 10 (forward-line 10))
(<= match-end-pos hexl-bits)))
vlf-start-pos)) (vlf-byte-position
(point-min) (max (- pmax 1024)
(or (byte-to-position (- pmax (/ pmax 10))
(- match-end-pos last-match-pos)))))
vlf-start-pos)) (vlf-tune-batch tune-types)
(point-min)))) (setq vlf-end-pos start) ;don't adjust start
(vlf-move-to-chunk start (+ start
vlf-batch-size)))
(let ((pmin (point-min)))
(goto-char pmin)
(setq last-match-pos pmin))
(progress-reporter-update reporter (progress-reporter-update reporter
vlf-end-pos))))) vlf-end-pos)))))
(progress-reporter-done reporter)) (progress-reporter-done reporter))
@ -150,49 +148,36 @@ Return t if search has been at least partially successful."
result))))) result)))))
(defun vlf-goto-match (match-chunk-start match-chunk-end (defun vlf-goto-match (match-chunk-start match-chunk-end
match-pos-start match-pos-end match-start-pos match-end-pos
count to-find time count to-find time
highlight) highlight)
"Move to MATCH-CHUNK-START MATCH-CHUNK-END surrounding\ "Move to MATCH-CHUNK-START MATCH-CHUNK-END surrounding\
MATCH-POS-START and MATCH-POS-END. MATCH-START-POS and MATCH-END-POS.
According to COUNT and left TO-FIND, show if search has been According to COUNT and left TO-FIND, show if search has been
successful. Use start TIME to report how much it took. successful. Use start TIME to report how much it took.
Highlight match if HIGHLIGHT is non nil. Highlight match if HIGHLIGHT is non nil.
Return nil if nothing found." Return nil if nothing found."
(vlf-move-to-chunk match-chunk-start match-chunk-end)
(goto-char match-start-pos)
(setq vlf-batch-size (vlf-tune-optimal-load
(if (derived-mode-p 'hexl-mode)
'(:hexl :raw)
'(:insert :encode))))
(if (= count to-find) (if (= count to-find)
(progn (vlf-move-to-chunk match-chunk-start match-chunk-end) (progn (message "Not found (%f secs)" (- (float-time) time))
(goto-char (or (byte-to-position (- match-pos-start
vlf-start-pos))
(point-max)))
(message "Not found (%f secs)" (- (float-time) time))
nil) nil)
(let ((success (zerop to-find))) (let ((success (zerop to-find))
(or success (overlay (make-overlay match-start-pos match-end-pos)))
(vlf-move-to-chunk match-chunk-start match-chunk-end)) (overlay-put overlay 'face 'match)
(setq vlf-batch-size (vlf-tune-optimal-load (if success
(if (derived-mode-p 'hexl-mode) (message "Match found (%f secs)" (- (float-time) time))
'(:hexl :raw) (message "Moved to the %d match which is last (%f secs)"
'(:insert :encode)))) (- count to-find) (- (float-time) time)))
(let* ((match-end (or (byte-to-position (- match-pos-end (if highlight
vlf-start-pos)) (unwind-protect (sit-for 1)
(point-max))) (delete-overlay overlay))
(overlay (make-overlay (byte-to-position (delete-overlay overlay)))
(- match-pos-start t))
vlf-start-pos))
match-end)))
(overlay-put overlay 'face 'match)
(if success
(message "Match found (%f secs)" (- (float-time) time))
(message "Moved to the %d match which is last (%f secs)"
(- count to-find) (- (float-time) time)))
(goto-char (or (byte-to-position (- match-pos-start
vlf-start-pos))
(point-max)))
(if highlight
(unwind-protect (sit-for 1)
(delete-overlay overlay))
(delete-overlay overlay))
t))))
(defun vlf-re-search-forward (regexp count) (defun vlf-re-search-forward (regexp count)
"Search forward for REGEXP prefix COUNT number of times. "Search forward for REGEXP prefix COUNT number of times.
@ -205,9 +190,7 @@ Search is performed chunk by chunk in `vlf-batch-size' memory."
(let ((batch-size vlf-batch-size) (let ((batch-size vlf-batch-size)
success) success)
(unwind-protect (unwind-protect
(setq success (vlf-re-search regexp count nil (setq success (vlf-re-search regexp count nil nil nil t))
(min 1024 (/ vlf-batch-size 8))
nil nil t))
(or success (setq vlf-batch-size batch-size))))) (or success (setq vlf-batch-size batch-size)))))
(defun vlf-re-search-backward (regexp count) (defun vlf-re-search-backward (regexp count)
@ -221,9 +204,7 @@ Search is performed chunk by chunk in `vlf-batch-size' memory."
(let ((batch-size vlf-batch-size) (let ((batch-size vlf-batch-size)
success) success)
(unwind-protect (unwind-protect
(setq success (vlf-re-search regexp count t (setq success (vlf-re-search regexp count t nil nil t))
(min 1024 (/ vlf-batch-size 8))
nil nil t))
(or success (setq vlf-batch-size batch-size))))) (or success (setq vlf-batch-size batch-size)))))
(defun vlf-goto-line (n) (defun vlf-goto-line (n)
@ -271,11 +252,11 @@ Search is performed chunk by chunk in `vlf-batch-size' memory."
;; (progress-reporter-update reporter start)) ;; (progress-reporter-update reporter start))
(when (< n (- vlf-file-size end)) (when (< n (- vlf-file-size end))
(vlf-tune-batch '(:insert :encode)) (vlf-tune-batch '(:insert :encode))
(vlf-move-to-chunk-2 start (+ start vlf-batch-size)) (vlf-move-to-chunk start (+ start vlf-batch-size))
(goto-char (point-min)) (goto-char (point-min))
(setq success (setq success
(or (zerop n) (or (zerop n)
(when (vlf-re-search "[\n\C-m]" n nil 0 (when (vlf-re-search "[\n\C-m]" n nil
reporter time) reporter time)
(forward-char) t)))))) (forward-char) t))))))
(let ((end vlf-file-size) (let ((end vlf-file-size)
@ -300,14 +281,14 @@ Search is performed chunk by chunk in `vlf-batch-size' memory."
;; (- vlf-file-size end)))) ;; (- vlf-file-size end))))
(when (< n end) (when (< n end)
(vlf-tune-batch '(:insert :encode)) (vlf-tune-batch '(:insert :encode))
(vlf-move-to-chunk-2 (- end vlf-batch-size) end) (vlf-move-to-chunk (- end vlf-batch-size) end)
(goto-char (point-max)) (goto-char (point-max))
(setq success (vlf-re-search "[\n\C-m]" n t 0 (setq success (vlf-re-search "[\n\C-m]" n t
reporter time)))))) reporter time))))))
(if font-lock (font-lock-mode 1)) (if font-lock (font-lock-mode 1))
(unless success (unless success
(vlf-with-undo-disabled (vlf-with-undo-disabled
(vlf-move-to-chunk-2 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)
(message "Unable to find line")) (message "Unable to find line"))
@ -353,15 +334,13 @@ replace BACKWARD."
(list (nth 0 common) (nth 1 common) (nth 2 common) (list (nth 0 common) (nth 1 common) (nth 2 common)
(nth 3 common)))) (nth 3 common))))
(let ((not-automatic t)) (let ((not-automatic t))
(while (vlf-re-search regexp 1 backward (while (vlf-re-search regexp 1 backward)
(min 1024 (/ vlf-batch-size 8)))
(cond (not-automatic (cond (not-automatic
(query-replace-regexp regexp to-string delimited (query-replace-regexp regexp to-string delimited
nil nil backward) nil nil backward)
(setq not-automatic (if (eq 'automatic (lookup-key query-replace-map
(not (eq (lookup-key query-replace-map (vector last-input-event)))
(vector last-input-event)) (setq not-automatic nil)))
'automatic))))
(backward (while (re-search-backward regexp nil t) (backward (while (re-search-backward regexp nil t)
(replace-match to-string))) (replace-match to-string)))
(t (while (re-search-forward regexp nil t) (t (while (re-search-forward regexp nil t)