]> code.delx.au - gnu-emacs-elpa/blobdiff - packages/vlf/vlf-search.el
Merge commit 'a11ba779f588af28f93fd4b7a716849695d5d9f3'
[gnu-emacs-elpa] / packages / vlf / vlf-search.el
index 0db5ba518ec78e56ac672692b20add5ef4e9a330..bfbeb8890c322b19b1008e5a339edfa912b7df10 100644 (file)
 
 (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"))
-  (let* ((case-fold-search t)
+  (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)
          (match-chunk-start vlf-start-pos)
          (match-chunk-end vlf-end-pos)
          (match-start-pos (+ vlf-start-pos (position-bytes (point))))
          (match-end-pos match-start-pos)
          (to-find count)
-         (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
          (catch 'end-of-file
@@ -63,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)))))
@@ -93,48 +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 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))))))
+       (if is-hexl (vlf-tune-hexlify))
+       (if font-lock (font-lock-mode 1))
+       (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)
-  "Move to MATCH-CHUNK-START MATCH-CHUNK-END surrounding \
+                                         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)))
@@ -143,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))))
@@ -159,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.
@@ -169,29 +201,99 @@ 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."
   (interactive (if (vlf-no-modifications)
                    (list (read-number "Go to line: "))))
-  (let ((start-pos vlf-start-pos)
+  (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)
+        (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)
-            (progn (vlf-beginning-of-file)
-                   (goto-char (point-min))
-                   (setq success (vlf-re-search "[\n\C-m]" (1- n)
-                                                nil 0)))
-          (vlf-end-of-file)
-          (goto-char (point-max))
-          (setq success (vlf-re-search "[\n\C-m]" (- n) t 0)))
-      (if success
-          (message "Onto line %s" n)
-        (vlf-move-to-chunk start-pos end-pos)
-        (goto-char pos)))))
+            (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
+               (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-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
+                                              reporter time)))))
+          (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
+             (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-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
+                                            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))))
 
 (provide 'vlf-search)