X-Git-Url: https://code.delx.au/gnu-emacs-elpa/blobdiff_plain/abab0678161b2c8cd92d285589ae53bb2b191884..a1ac1e0fdea2e1ce69969acd139838e90c39f44d:/packages/vlf/vlf-search.el diff --git a/packages/vlf/vlf-search.el b/packages/vlf/vlf-search.el index 0462cb26b..f797378d7 100644 --- a/packages/vlf/vlf-search.el +++ b/packages/vlf/vlf-search.el @@ -29,27 +29,38 @@ (require 'vlf) -(defun vlf-re-search (regexp count backward batch-step) +(defvar hexl-bits) +(defvar tramp-verbose) + +(defun vlf-re-search (regexp count backward + &optional reporter time highlight) "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. +Highlight match if HIGHLIGHT is non nil. +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))) + (min tramp-verbose 1))) (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-start-pos (point)) (match-end-pos match-start-pos) + (last-match-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 :raw) + '(:insert :encode))) + (font-lock font-lock-mode)) (font-lock-mode 0) (vlf-with-undo-disabled (unwind-protect @@ -60,28 +71,31 @@ BATCH-STEP is amount of overlap between successive chunks." (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))))) + match-start-pos (match-beginning 0) + match-end-pos (match-end 0) + last-match-pos match-start-pos)) ((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))) + (t (let ((end + (if is-hexl + (progn + (goto-char (point-min)) + (forward-line 10) + (if (< last-match-pos (point)) + (goto-char last-match-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) + end)) + (let ((pmax (point-max))) + (goto-char pmax) + (setq last-match-pos pmax)) (progress-reporter-update reporter (- vlf-file-size vlf-start-pos))))) @@ -90,73 +104,80 @@ BATCH-STEP is amount of overlap between successive chunks." (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) + match-start-pos (match-beginning 0) + match-end-pos (match-end 0) + last-match-pos match-end-pos)) + ((>= 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))) + (t (let* ((pmax (point-max)) + (start + (if is-hexl + (progn + (goto-char pmax) + (forward-line -10) + (if (< (point) last-match-pos) + (goto-char last-match-pos)) + (- vlf-end-pos + (* (- 10 (forward-line 10)) + hexl-bits))) + (vlf-byte-position + (max (- pmax 1024) + (- pmax (/ pmax 10)) + last-match-pos))))) + (vlf-tune-batch tune-types) + (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 vlf-end-pos))))) (progress-reporter-done reporter)) (set-buffer-modified-p nil) (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 highlight) + (vlf-goto-match match-chunk-start match-chunk-end + match-start-pos match-end-pos + count to-find time highlight)))) + (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-start-pos match-end-pos + count to-find time + highlight) "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 -successful. Return nil if nothing found." +successful. Use start TIME to report how much it took. +Highlight match if HIGHLIGHT is non nil. +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) - (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") + (progn (message "Not found (%f secs)" (- (float-time) time)) nil) - (let ((success (zerop to-find))) + (let ((success (zerop to-find)) + (overlay (make-overlay match-start-pos match-end-pos))) + (overlay-put overlay 'face 'match) (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)))) + (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))) + (if highlight + (unwind-protect (sit-for 1) + (delete-overlay overlay)) + (delete-overlay overlay))) + t)) (defun vlf-re-search-forward (regexp count) "Search forward for REGEXP prefix COUNT number of times. @@ -166,7 +187,11 @@ 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) + success) + (unwind-protect + (setq success (vlf-re-search regexp count nil nil nil t)) + (or success (setq vlf-batch-size batch-size))))) (defun vlf-re-search-backward (regexp count) "Search backward for REGEXP prefix COUNT number of times. @@ -176,82 +201,152 @@ 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) + success) + (unwind-protect + (setq success (vlf-re-search regexp count t nil nil t)) + (or success (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." (interactive (if (vlf-no-modifications) (list (read-number "Go to line: ")))) - (run-hook-with-args 'vlf-before-batch-functions 'goto-line) - (vlf-verify-size) - (let ((tramp-verbose (if (boundp 'tramp-verbose) - (min tramp-verbose 2))) - (start-pos vlf-start-pos) - (end-pos vlf-end-pos) - (pos (point)) - (font-lock font-lock-mode) - (success nil)) - (font-lock-mode 0) - (unwind-protect - (if (< 0 n) - (let ((start 0) - (end (min vlf-batch-size vlf-file-size)) + (if (derived-mode-p 'hexl-mode) + (vlf-goto-line-hexl n) + (run-hook-with-args 'vlf-before-batch-functions 'goto-line) + (vlf-verify-size) + (let ((tramp-verbose (if (boundp 'tramp-verbose) + (min tramp-verbose 1))) + (start-pos vlf-start-pos) + (end-pos vlf-end-pos) + (batch-size vlf-batch-size) + (pos (point)) + (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) + (end (min vlf-batch-size vlf-file-size)) + (reporter (make-progress-reporter + (concat "Searching for line " + (number-to-string n) "...") + 0 vlf-file-size)) + (inhibit-read-only t)) + (setq n (1- n)) + (vlf-with-undo-disabled + ;; (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-tune-batch '(:insert :encode)) + (vlf-move-to-chunk start (+ start vlf-batch-size)) + (goto-char (point-min)) + (setq success + (or (zerop n) + (when (vlf-re-search "[\n\C-m]" n nil + reporter time) + (forward-char) t)))))) + (let ((end vlf-file-size) (reporter (make-progress-reporter - (concat "Searching for line " + (concat "Searching for line -" (number-to-string n) "...") 0 vlf-file-size)) (inhibit-read-only t)) - (setq n (1- n)) + (setq n (- 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)) - (when (< n (- vlf-file-size end)) - (vlf-move-to-chunk-2 start end) - (goto-char (point-min)) - (setq success (vlf-re-search "[\n\C-m]" n nil 0))))) - (let ((start (max 0 (- vlf-file-size vlf-batch-size))) - (end vlf-file-size) - (reporter (make-progress-reporter - (concat "Searching for line -" - (number-to-string n) "...") - 0 vlf-file-size)) - (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))) - (when (< n end) - (vlf-move-to-chunk-2 start end) - (goto-char (point-max)) - (setq success (vlf-re-search "[\n\C-m]" n t 0)))))) - (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) - (message "Unable to find line")) - (run-hook-with-args 'vlf-after-batch-functions 'goto-line)))) + ;; (let ((start (max 0 (- vlf-file-size vlf-batch-size)))) + ;; (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-tune-batch '(:insert :encode)) + (vlf-move-to-chunk (- end vlf-batch-size) end) + (goto-char (point-max)) + (setq success (vlf-re-search "[\n\C-m]" n t + reporter time)))))) + (if font-lock (font-lock-mode 1)) + (unless success + (vlf-with-undo-disabled + (vlf-move-to-chunk start-pos end-pos)) + (goto-char pos) + (setq vlf-batch-size batch-size) + (message "Unable to find line")) + (run-hook-with-args 'vlf-after-batch-functions 'goto-line))))) + +(defun vlf-goto-line-hexl (n) + "Go to line N. If N is negative, count from the end of file. +Assume `hexl-mode' is active." + (vlf-tune-load '(:hexl :raw)) + (if (< n 0) + (let ((hidden-bytes (+ vlf-file-size (* n hexl-bits)))) + (setq hidden-bytes (- hidden-bytes (mod hidden-bytes + vlf-batch-size))) + (vlf-move-to-batch hidden-bytes) + (goto-char (point-max)) + (forward-line (+ (round (- vlf-file-size + (min vlf-file-size + (+ hidden-bytes + vlf-batch-size))) + hexl-bits) + n))) + (let ((hidden-bytes (1- (* n hexl-bits)))) + (setq hidden-bytes (- hidden-bytes (mod hidden-bytes + vlf-batch-size))) + (vlf-move-to-batch hidden-bytes) + (goto-char (point-min)) + (forward-line (- n 1 (/ hidden-bytes hexl-bits)))))) + +(defun vlf-query-replace (regexp to-string &optional delimited backward) + "Query replace over whole file matching REGEXP with TO-STRING. +Third arg DELIMITED (prefix arg if interactive), if non-nil, replace +only matches surrounded by word boundaries. A negative prefix arg means +replace BACKWARD." + (interactive (let ((common (query-replace-read-args + (concat "Query replace over whole file" + (if current-prefix-arg + (if (eq current-prefix-arg '-) + " backward" + " word") + "") + " regexp") + t))) + (list (nth 0 common) (nth 1 common) (nth 2 common) + (nth 3 common)))) + (let ((not-automatic t)) + (while (vlf-re-search regexp 1 backward) + (cond (not-automatic + (query-replace-regexp regexp to-string delimited + nil nil backward) + (if (eq 'automatic (lookup-key query-replace-map + (vector last-input-event))) + (setq not-automatic nil))) + (backward (while (re-search-backward regexp nil t) + (replace-match to-string))) + (t (while (re-search-forward regexp nil t) + (replace-match to-string)))) + (if (buffer-modified-p) + (save-buffer))))) (provide 'vlf-search)