X-Git-Url: https://code.delx.au/gnu-emacs-elpa/blobdiff_plain/2d44e7fef7e7388759518cba1a424495119679d1..cfedb0258384d1ff6352a83cc6102a7ad4a62422:/packages/vlf/vlf-search.el diff --git a/packages/vlf/vlf-search.el b/packages/vlf/vlf-search.el index 0462cb26b..bfbeb8890 100644 --- a/packages/vlf/vlf-search.el +++ b/packages/vlf/vlf-search.el @@ -29,12 +29,24 @@ (require 'vlf) -(defun vlf-re-search (regexp count backward batch-step) +(defvar tramp-verbose) + +(defun vlf-re-search (regexp count backward batch-step + &optional reporter time) "Search for REGEXP COUNT number of times forward or BACKWARD. -BATCH-STEP is amount of overlap between successive chunks." +BATCH-STEP is amount of overlap between successive chunks. +Use existing REPORTER and start TIME if given. +Return t if search has been at least partially successful." (if (<= count 0) (error "Count must be positive")) (run-hook-with-args 'vlf-before-batch-functions 'search) + (or reporter (setq reporter (make-progress-reporter + (concat "Searching for " regexp "...") + (if backward + (- vlf-file-size vlf-end-pos) + vlf-start-pos) + vlf-file-size))) + (or time (setq time (float-time))) (let* ((tramp-verbose (if (boundp 'tramp-verbose) (min tramp-verbose 2))) (case-fold-search t) @@ -43,13 +55,10 @@ BATCH-STEP is amount of overlap between successive chunks." (match-start-pos (+ vlf-start-pos (position-bytes (point)))) (match-end-pos match-start-pos) (to-find count) - (font-lock font-lock-mode) - (reporter (make-progress-reporter - (concat "Searching for " regexp "...") - (if backward - (- vlf-file-size vlf-end-pos) - vlf-start-pos) - vlf-file-size))) + (is-hexl (derived-mode-p 'hexl-mode)) + (tune-types (if is-hexl '(:hexl :dehexlify :insert :encode) + '(:insert :encode))) + (font-lock font-lock-mode)) (font-lock-mode 0) (vlf-with-undo-disabled (unwind-protect @@ -68,20 +77,23 @@ BATCH-STEP is amount of overlap between successive chunks." (match-end 0))))) ((zerop vlf-start-pos) (throw 'end-of-file nil)) - (t (let ((batch-move (- vlf-start-pos + (t (vlf-tune-batch tune-types) + (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))) + (if (or is-hexl + (<= batch-move match-start-pos)) + batch-move + (- match-start-pos vlf-batch-size)) t)) + (goto-char (if (or is-hexl + (<= vlf-end-pos + match-start-pos)) + (point-max) + (or (byte-to-position + (- match-start-pos + vlf-start-pos)) + (point-max)))) (progress-reporter-update reporter (- vlf-file-size vlf-start-pos))))) @@ -98,50 +110,60 @@ BATCH-STEP is amount of overlap between successive chunks." (match-end 0))))) ((= vlf-end-pos vlf-file-size) (throw 'end-of-file nil)) - (t (let ((batch-move (- vlf-end-pos batch-step))) + (t (vlf-tune-batch tune-types) + (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))) + (if (or is-hexl + (< match-end-pos batch-move)) + batch-move + match-end-pos) t)) + (goto-char (if (or is-hexl + (<= match-end-pos vlf-start-pos)) + (point-min) + (or (byte-to-position + (- match-end-pos + vlf-start-pos)) + (point-min)))) (progress-reporter-update reporter vlf-end-pos))))) (progress-reporter-done reporter)) (set-buffer-modified-p nil) + (if is-hexl (vlf-tune-hexlify)) (if font-lock (font-lock-mode 1)) - (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)) - (run-hook-with-args 'vlf-after-batch-functions 'search))))) + (let ((result + (if backward + (vlf-goto-match match-chunk-start match-chunk-end + match-end-pos match-start-pos + count to-find time) + (vlf-goto-match match-chunk-start match-chunk-end + match-start-pos match-end-pos + count to-find time)))) + (run-hook-with-args 'vlf-after-batch-functions 'search) + result))))) (defun vlf-goto-match (match-chunk-start match-chunk-end - match-pos-start - match-pos-end - count to-find) + match-pos-start match-pos-end + count to-find time) "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." +successful. Use start TIME to report how much it took. +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") + (message "Not found (%f secs)" (- (float-time) time)) nil) (let ((success (zerop to-find))) (if success (vlf-update-buffer-name) (vlf-move-to-chunk match-chunk-start match-chunk-end)) + (setq vlf-batch-size (vlf-tune-optimal-load + (if (derived-mode-p 'hexl-mode) + '(:hexl :dehexlify :insert :encode) + '(:insert :encode)))) (let* ((match-end (or (byte-to-position (- match-pos-end vlf-start-pos)) (point-max))) @@ -150,10 +172,11 @@ successful. Return nil if nothing found." vlf-start-pos)) match-end))) (overlay-put overlay 'face 'match) - (unless success + (if success + (message "Match found (%f secs)" (- (float-time) time)) (goto-char match-end) - (message "Moved to the %d match which is last" - (- count to-find))) + (message "Moved to the %d match which is last (%f secs)" + (- count to-find) (- (float-time) time))) (unwind-protect (sit-for 3) (delete-overlay overlay)) t)))) @@ -166,7 +189,9 @@ Search is performed chunk by chunk in `vlf-batch-size' memory." (if regexp-history (car regexp-history))) (or current-prefix-arg 1)))) - (vlf-re-search regexp count nil (/ vlf-batch-size 8))) + (let ((batch-size vlf-batch-size)) + (or (vlf-re-search regexp count nil (min 1024 (/ vlf-batch-size 8))) + (setq vlf-batch-size batch-size)))) (defun vlf-re-search-backward (regexp count) "Search backward for REGEXP prefix COUNT number of times. @@ -176,7 +201,9 @@ Search is performed chunk by chunk in `vlf-batch-size' memory." (if regexp-history (car regexp-history))) (or current-prefix-arg 1)))) - (vlf-re-search regexp count t (/ vlf-batch-size 8))) + (let ((batch-size vlf-batch-size)) + (or (vlf-re-search regexp count t (min 1024 (/ vlf-batch-size 8))) + (setq vlf-batch-size batch-size)))) (defun vlf-goto-line (n) "Go to line N. If N is negative, count from the end of file." @@ -188,10 +215,14 @@ Search is performed chunk by chunk in `vlf-batch-size' memory." (min tramp-verbose 2))) (start-pos vlf-start-pos) (end-pos vlf-end-pos) + (batch-size vlf-batch-size) (pos (point)) + (is-hexl (derived-mode-p 'hexl-mode)) (font-lock font-lock-mode) + (time (float-time)) (success nil)) (font-lock-mode 0) + (vlf-tune-batch '(:raw)) (unwind-protect (if (< 0 n) (let ((start 0) @@ -203,23 +234,28 @@ Search is performed chunk by chunk in `vlf-batch-size' memory." (inhibit-read-only t)) (setq n (1- n)) (vlf-with-undo-disabled - (while (and (< (- end start) n) - (< n (- vlf-file-size start))) - (erase-buffer) - (insert-file-contents-literally buffer-file-name - nil start end) - (goto-char (point-min)) - (while (re-search-forward "[\n\C-m]" nil t) - (setq n (1- n))) - (vlf-verify-size) - (setq start end - end (min vlf-file-size - (+ start vlf-batch-size))) - (progress-reporter-update reporter start)) + (or is-hexl + (while (and (< (- end start) n) + (< n (- vlf-file-size start))) + (erase-buffer) + (vlf-tune-insert-file-contents-literally start end) + (goto-char (point-min)) + (while (re-search-forward "[\n\C-m]" nil t) + (setq n (1- n))) + (vlf-verify-size) + (vlf-tune-batch '(:raw)) + (setq start end + end (min vlf-file-size + (+ start vlf-batch-size))) + (progress-reporter-update reporter start))) (when (< n (- vlf-file-size end)) - (vlf-move-to-chunk-2 start end) + (vlf-tune-batch (if is-hexl + '(:hexl :dehexlify :insert :encode) + '(:insert :encode))) + (vlf-move-to-chunk-2 start (+ start vlf-batch-size)) (goto-char (point-min)) - (setq success (vlf-re-search "[\n\C-m]" n nil 0))))) + (setq success (vlf-re-search "[\n\C-m]" n nil 0 + reporter time))))) (let ((start (max 0 (- vlf-file-size vlf-batch-size))) (end vlf-file-size) (reporter (make-progress-reporter @@ -229,27 +265,33 @@ Search is performed chunk by chunk in `vlf-batch-size' memory." (inhibit-read-only t)) (setq n (- n)) (vlf-with-undo-disabled - (while (and (< (- end start) n) (< n end)) - (erase-buffer) - (insert-file-contents-literally buffer-file-name nil - start end) - (goto-char (point-max)) - (while (re-search-backward "[\n\C-m]" nil t) - (setq n (1- n))) - (setq end start - start (max 0 (- end vlf-batch-size))) - (progress-reporter-update reporter - (- vlf-file-size end))) + (or is-hexl + (while (and (< (- end start) n) (< n end)) + (erase-buffer) + (vlf-tune-insert-file-contents-literally start end) + (goto-char (point-max)) + (while (re-search-backward "[\n\C-m]" nil t) + (setq n (1- n))) + (vlf-tune-batch '(:raw)) + (setq end start + start (max 0 (- end vlf-batch-size))) + (progress-reporter-update reporter + (- vlf-file-size end)))) (when (< n end) - (vlf-move-to-chunk-2 start end) + (vlf-tune-batch (if is-hexl + '(:hexl :dehexlify :insert :encode) + '(:insert :encode))) + (vlf-move-to-chunk-2 (- end vlf-batch-size) end) (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 0 + reporter time)))))) (if font-lock (font-lock-mode 1)) (unless success (vlf-with-undo-disabled (vlf-move-to-chunk-2 start-pos end-pos)) (vlf-update-buffer-name) (goto-char pos) + (setq vlf-batch-size batch-size) (message "Unable to find line")) (run-hook-with-args 'vlf-after-batch-functions 'goto-line))))