code.delx.au - gnu-emacs-elpa/blob - packages/vlf/vlf-search.el

   1 ;;; vlf-search.el --- Search functionality for VLF  -*- lexical-binding: t -*-
   2
   3 ;; Copyright (C) 2014 Free Software Foundation, Inc.
   4
   5 ;; Keywords: large files, search
   6 ;; Author: Andrey Kotlarski <m00naticus@gmail.com>
   7 ;; URL: https://github.com/m00natic/vlfi
   8
   9 ;; This file is free software; you can redistribute it and/or modify
  10 ;; it under the terms of the GNU General Public License as published by
  11 ;; the Free Software Foundation; either version 3, or (at your option)
  12 ;; any later version.
  13
  14 ;; This file is distributed in the hope that it will be useful,
  15 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  16 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  17 ;; GNU General Public License for more details.
  18
  19 ;; You should have received a copy of the GNU General Public License
  20 ;; along with GNU Emacs; see the file COPYING.  If not, write to
  21 ;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  22 ;; Boston, MA 02111-1307, USA.
  23
  24 ;;; Commentary:
  25 ;; This package provides search utilities for dealing with large files
  26 ;; in constant memory.
  27
  28 ;;; Code:
  29
  30 (require 'vlf)
  31
  32 (defvar tramp-verbose)
  33
  34 (defun vlf-re-search (regexp count backward batch-step
  35                              &optional reporter time)
  36   "Search for REGEXP COUNT number of times forward or BACKWARD.
  37 BATCH-STEP is amount of overlap between successive chunks.
  38 Use existing REPORTER and start TIME if given.
  39 Return t if search has been at least partially successful."
  40   (if (<= count 0)
  41       (error "Count must be positive"))
  42   (run-hook-with-args 'vlf-before-batch-functions 'search)
  43   (or reporter (setq reporter (make-progress-reporter
  44                                (concat "Searching for " regexp "...")
  45                                (if backward
  46                                    (- vlf-file-size vlf-end-pos)
  47                                  vlf-start-pos)
  48                                vlf-file-size)))
  49   (or time (setq time (float-time)))
  50   (let* ((tramp-verbose (if (boundp 'tramp-verbose)
  51                             (min tramp-verbose 2)))
  52          (case-fold-search t)
  53          (match-chunk-start vlf-start-pos)
  54          (match-chunk-end vlf-end-pos)
  55          (match-start-pos (+ vlf-start-pos (position-bytes (point))))
  56          (match-end-pos match-start-pos)
  57          (to-find count)
  58          (is-hexl (derived-mode-p 'hexl-mode))
  59          (tune-types (if is-hexl '(:hexl :dehexlify :insert :encode)
  60                        '(:insert :encode)))
  61          (font-lock font-lock-mode))
  62     (font-lock-mode 0)
  63     (vlf-with-undo-disabled
  64      (unwind-protect
  65          (catch 'end-of-file
  66            (if backward
  67                (while (not (zerop to-find))
  68                  (cond ((re-search-backward regexp nil t)
  69                         (setq to-find (1- to-find)
  70                               match-chunk-start vlf-start-pos
  71                               match-chunk-end vlf-end-pos
  72                               match-start-pos (+ vlf-start-pos
  73                                                  (position-bytes
  74                                                   (match-beginning 0)))
  75                               match-end-pos (+ vlf-start-pos
  76                                                (position-bytes
  77                                                 (match-end 0)))))
  78                        ((zerop vlf-start-pos)
  79                         (throw 'end-of-file nil))
  80                        (t (vlf-tune-batch tune-types)
  81                           (let ((batch-move (- vlf-start-pos
  82                                                (- vlf-batch-size
  83                                                   batch-step))))
  84                             (vlf-move-to-batch
  85                              (if (or is-hexl
  86                                      (<= batch-move match-start-pos))
  87                                  batch-move
  88                                (- match-start-pos vlf-batch-size)) t))
  89                           (goto-char (if (or is-hexl
  90                                              (<= vlf-end-pos
  91                                                  match-start-pos))
  92                                          (point-max)
  93                                        (or (byte-to-position
  94                                             (- match-start-pos
  95                                                vlf-start-pos))
  96                                            (point-max))))
  97                           (progress-reporter-update
  98                            reporter (- vlf-file-size
  99                                        vlf-start-pos)))))
 100              (while (not (zerop to-find))
 101                (cond ((re-search-forward regexp nil t)
 102                       (setq to-find (1- to-find)
 103                             match-chunk-start vlf-start-pos
 104                             match-chunk-end vlf-end-pos
 105                             match-start-pos (+ vlf-start-pos
 106                                                (position-bytes
 107                                                 (match-beginning 0)))
 108                             match-end-pos (+ vlf-start-pos
 109                                              (position-bytes
 110                                               (match-end 0)))))
 111                      ((= vlf-end-pos vlf-file-size)
 112                       (throw 'end-of-file nil))
 113                      (t (vlf-tune-batch tune-types)
 114                         (let ((batch-move (- vlf-end-pos batch-step)))
 115                           (vlf-move-to-batch
 116                            (if (or is-hexl
 117                                    (< match-end-pos batch-move))
 118                                batch-move
 119                              match-end-pos) t))
 120                         (goto-char (if (or is-hexl
 121                                            (<= match-end-pos vlf-start-pos))
 122                                        (point-min)
 123                                      (or (byte-to-position
 124                                           (- match-end-pos
 125                                              vlf-start-pos))
 126                                          (point-min))))
 127                         (progress-reporter-update reporter
 128                                                   vlf-end-pos)))))
 129            (progress-reporter-done reporter))
 130        (set-buffer-modified-p nil)
 131        (if is-hexl (vlf-tune-hexlify))
 132        (if font-lock (font-lock-mode 1))
 133        (let ((result
 134               (if backward
 135                   (vlf-goto-match match-chunk-start match-chunk-end
 136                                   match-end-pos match-start-pos
 137                                   count to-find time)
 138                 (vlf-goto-match match-chunk-start match-chunk-end
 139                                 match-start-pos match-end-pos
 140                                 count to-find time))))
 141          (run-hook-with-args 'vlf-after-batch-functions 'search)
 142          result)))))
 143
 144 (defun vlf-goto-match (match-chunk-start match-chunk-end
 145                                          match-pos-start match-pos-end
 146                                          count to-find time)
 147   "Move to MATCH-CHUNK-START MATCH-CHUNK-END surrounding\
 148 MATCH-POS-START and MATCH-POS-END.
 149 According to COUNT and left TO-FIND, show if search has been
 150 successful.  Use start TIME to report how much it took.
 151 Return nil if nothing found."
 152   (if (= count to-find)
 153       (progn (vlf-move-to-chunk match-chunk-start match-chunk-end)
 154              (goto-char (or (byte-to-position (- match-pos-start
 155                                                  vlf-start-pos))
 156                             (point-max)))
 157              (message "Not found (%f secs)" (- (float-time) time))
 158              nil)
 159     (let ((success (zerop to-find)))
 160       (if success
 161           (vlf-update-buffer-name)
 162         (vlf-move-to-chunk match-chunk-start match-chunk-end))
 163       (setq vlf-batch-size (vlf-tune-optimal-load
 164                             (if (derived-mode-p 'hexl-mode)
 165                                 '(:hexl :dehexlify :insert :encode)
 166                               '(:insert :encode))))
 167       (let* ((match-end (or (byte-to-position (- match-pos-end
 168                                                  vlf-start-pos))
 169                             (point-max)))
 170              (overlay (make-overlay (byte-to-position
 171                                      (- match-pos-start
 172                                         vlf-start-pos))
 173                                     match-end)))
 174         (overlay-put overlay 'face 'match)
 175         (if success
 176             (message "Match found (%f secs)" (- (float-time) time))
 177           (goto-char match-end)
 178           (message "Moved to the %d match which is last (%f secs)"
 179                    (- count to-find) (- (float-time) time)))
 180         (unwind-protect (sit-for 3)
 181           (delete-overlay overlay))
 182         t))))
 183
 184 (defun vlf-re-search-forward (regexp count)
 185   "Search forward for REGEXP prefix COUNT number of times.
 186 Search is performed chunk by chunk in `vlf-batch-size' memory."
 187   (interactive (if (vlf-no-modifications)
 188                    (list (read-regexp "Search whole file"
 189                                       (if regexp-history
 190                                           (car regexp-history)))
 191                          (or current-prefix-arg 1))))
 192   (let ((batch-size vlf-batch-size))
 193     (or (vlf-re-search regexp count nil (min 1024 (/ vlf-batch-size 8)))
 194         (setq vlf-batch-size batch-size))))
 195
 196 (defun vlf-re-search-backward (regexp count)
 197   "Search backward for REGEXP prefix COUNT number of times.
 198 Search is performed chunk by chunk in `vlf-batch-size' memory."
 199   (interactive (if (vlf-no-modifications)
 200                    (list (read-regexp "Search whole file backward"
 201                                       (if regexp-history
 202                                           (car regexp-history)))
 203                          (or current-prefix-arg 1))))
 204   (let ((batch-size vlf-batch-size))
 205     (or (vlf-re-search regexp count t (min 1024 (/ vlf-batch-size 8)))
 206         (setq vlf-batch-size batch-size))))
 207
 208 (defun vlf-goto-line (n)
 209   "Go to line N.  If N is negative, count from the end of file."
 210   (interactive (if (vlf-no-modifications)
 211                    (list (read-number "Go to line: "))))
 212   (run-hook-with-args 'vlf-before-batch-functions 'goto-line)
 213   (vlf-verify-size)
 214   (let ((tramp-verbose (if (boundp 'tramp-verbose)
 215                            (min tramp-verbose 2)))
 216         (start-pos vlf-start-pos)
 217         (end-pos vlf-end-pos)
 218         (batch-size vlf-batch-size)
 219         (pos (point))
 220         (is-hexl (derived-mode-p 'hexl-mode))
 221         (font-lock font-lock-mode)
 222         (time (float-time))
 223         (success nil))
 224     (font-lock-mode 0)
 225     (vlf-tune-batch '(:raw))
 226     (unwind-protect
 227         (if (< 0 n)
 228             (let ((start 0)
 229                   (end (min vlf-batch-size vlf-file-size))
 230                   (reporter (make-progress-reporter
 231                              (concat "Searching for line "
 232                                      (number-to-string n) "...")
 233                              0 vlf-file-size))
 234                   (inhibit-read-only t))
 235               (setq n (1- n))
 236               (vlf-with-undo-disabled
 237                (or is-hexl
 238                    (while (and (< (- end start) n)
 239                                (< n (- vlf-file-size start)))
 240                      (erase-buffer)
 241                      (vlf-tune-insert-file-contents-literally start end)
 242                      (goto-char (point-min))
 243                      (while (re-search-forward "[\n\C-m]" nil t)
 244                        (setq n (1- n)))
 245                      (vlf-verify-size)
 246                      (vlf-tune-batch '(:raw))
 247                      (setq start end
 248                            end (min vlf-file-size
 249                                     (+ start vlf-batch-size)))
 250                      (progress-reporter-update reporter start)))
 251                (when (< n (- vlf-file-size end))
 252                  (vlf-tune-batch (if is-hexl
 253                                      '(:hexl :dehexlify :insert :encode)
 254                                    '(:insert :encode)))
 255                  (vlf-move-to-chunk-2 start (+ start vlf-batch-size))
 256                  (goto-char (point-min))
 257                  (setq success (vlf-re-search "[\n\C-m]" n nil 0
 258                                               reporter time)))))
 259           (let ((start (max 0 (- vlf-file-size vlf-batch-size)))
 260                 (end vlf-file-size)
 261                 (reporter (make-progress-reporter
 262                            (concat "Searching for line -"
 263                                    (number-to-string n) "...")
 264                            0 vlf-file-size))
 265                 (inhibit-read-only t))
 266             (setq n (- n))
 267             (vlf-with-undo-disabled
 268              (or is-hexl
 269                  (while (and (< (- end start) n) (< n end))
 270                    (erase-buffer)
 271                    (vlf-tune-insert-file-contents-literally start end)
 272                    (goto-char (point-max))
 273                    (while (re-search-backward "[\n\C-m]" nil t)
 274                      (setq n (1- n)))
 275                    (vlf-tune-batch '(:raw))
 276                    (setq end start
 277                          start (max 0 (- end vlf-batch-size)))
 278                    (progress-reporter-update reporter
 279                                              (- vlf-file-size end))))
 280              (when (< n end)
 281                (vlf-tune-batch (if is-hexl
 282                                    '(:hexl :dehexlify :insert :encode)
 283                                  '(:insert :encode)))
 284                (vlf-move-to-chunk-2 (- end vlf-batch-size) end)
 285                (goto-char (point-max))
 286                (setq success (vlf-re-search "[\n\C-m]" n t 0
 287                                             reporter time))))))
 288       (if font-lock (font-lock-mode 1))
 289       (unless success
 290         (vlf-with-undo-disabled
 291          (vlf-move-to-chunk-2 start-pos end-pos))
 292         (vlf-update-buffer-name)
 293         (goto-char pos)
 294         (setq vlf-batch-size batch-size)
 295         (message "Unable to find line"))
 296       (run-hook-with-args 'vlf-after-batch-functions 'goto-line))))
 297
 298 (provide 'vlf-search)
 299
 300 ;;; vlf-search.el ends here