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 hexl-bits)
  33 (defvar tramp-verbose)
  34
  35 (defun vlf-re-search (regexp count backward
  36                              &optional reporter time highlight)
  37   "Search for REGEXP COUNT number of times forward or BACKWARD.
  38 Use existing REPORTER and start TIME if given.
  39 Highlight match if HIGHLIGHT is non nil.
  40 Return t if search has been at least partially successful."
  41   (if (<= count 0)
  42       (error "Count must be positive"))
  43   (run-hook-with-args 'vlf-before-batch-functions 'search)
  44   (or reporter (setq reporter (make-progress-reporter
  45                                (concat "Searching for " regexp "...")
  46                                (if backward
  47                                    (- vlf-file-size vlf-end-pos)
  48                                  vlf-start-pos)
  49                                vlf-file-size)))
  50   (or time (setq time (float-time)))
  51   (let* ((tramp-verbose (if (boundp 'tramp-verbose)
  52                             (min tramp-verbose 1)))
  53          (case-fold-search t)
  54          (match-chunk-start vlf-start-pos)
  55          (match-chunk-end vlf-end-pos)
  56          (match-start-pos (point))
  57          (match-end-pos match-start-pos)
  58          (last-match-pos match-start-pos)
  59          (to-find count)
  60          (is-hexl (derived-mode-p 'hexl-mode))
  61          (tune-types (if is-hexl '(:hexl :raw)
  62                        '(:insert :encode)))
  63          (font-lock font-lock-mode))
  64     (font-lock-mode 0)
  65     (vlf-with-undo-disabled
  66      (unwind-protect
  67          (catch 'end-of-file
  68            (if backward
  69                (while (not (zerop to-find))
  70                  (cond ((re-search-backward regexp nil t)
  71                         (setq to-find (1- to-find)
  72                               match-chunk-start vlf-start-pos
  73                               match-chunk-end vlf-end-pos
  74                               match-start-pos (match-beginning 0)
  75                               match-end-pos (match-end 0)
  76                               last-match-pos match-start-pos))
  77                        ((zerop vlf-start-pos)
  78                         (throw 'end-of-file nil))
  79                        (t (let ((end
  80                                  (if is-hexl
  81                                      (progn
  82                                        (goto-char (point-min))
  83                                        (forward-line 10)
  84                                        (if (< last-match-pos (point))
  85                                            (goto-char last-match-pos))
  86                                        (+ vlf-start-pos
  87                                           (* (- 10 (forward-line -10))
  88                                              hexl-bits)))
  89                                    (vlf-byte-position
  90                                     (min 1024 (/ (point-max) 10)
  91                                          last-match-pos)))))
  92                             (vlf-tune-batch tune-types)
  93                             (setq vlf-start-pos end) ;don't adjust end
  94                             (vlf-move-to-chunk (- end vlf-batch-size)
  95                                                end))
  96                           (let ((pmax (point-max)))
  97                             (goto-char pmax)
  98                             (setq last-match-pos pmax))
  99                           (progress-reporter-update
 100                            reporter (- vlf-file-size
 101                                        vlf-start-pos)))))
 102              (while (not (zerop to-find))
 103                (cond ((re-search-forward regexp nil t)
 104                       (setq to-find (1- to-find)
 105                             match-chunk-start vlf-start-pos
 106                             match-chunk-end vlf-end-pos
 107                             match-start-pos (match-beginning 0)
 108                             match-end-pos (match-end 0)
 109                             last-match-pos match-end-pos))
 110                      ((>= vlf-end-pos vlf-file-size)
 111                       (throw 'end-of-file nil))
 112                      (t (let* ((pmax (point-max))
 113                                (start
 114                                 (if is-hexl
 115                                     (progn
 116                                       (goto-char pmax)
 117                                       (forward-line -10)
 118                                       (if (< (point) last-match-pos)
 119                                           (goto-char last-match-pos))
 120                                       (- vlf-end-pos
 121                                          (* (- 10 (forward-line 10))
 122                                             hexl-bits)))
 123                                   (vlf-byte-position
 124                                    (max (- pmax 1024)
 125                                         (- pmax (/ pmax 10))
 126                                         last-match-pos)))))
 127                           (vlf-tune-batch tune-types)
 128                           (setq vlf-end-pos start) ;don't adjust start
 129                           (vlf-move-to-chunk start (+ start
 130                                                       vlf-batch-size)))
 131                         (let ((pmin (point-min)))
 132                           (goto-char pmin)
 133                           (setq last-match-pos pmin))
 134                         (progress-reporter-update reporter
 135                                                   vlf-end-pos)))))
 136            (progress-reporter-done reporter))
 137        (set-buffer-modified-p nil)
 138        (if font-lock (font-lock-mode 1))
 139        (let ((result
 140               (if backward
 141                   (vlf-goto-match match-chunk-start match-chunk-end
 142                                   match-end-pos match-start-pos
 143                                   count to-find time highlight)
 144                 (vlf-goto-match match-chunk-start match-chunk-end
 145                                 match-start-pos match-end-pos
 146                                 count to-find time highlight))))
 147          (run-hook-with-args 'vlf-after-batch-functions 'search)
 148          result)))))
 149
 150 (defun vlf-goto-match (match-chunk-start match-chunk-end
 151                                          match-start-pos match-end-pos
 152                                          count to-find time
 153                                          highlight)
 154   "Move to MATCH-CHUNK-START MATCH-CHUNK-END surrounding\
 155 MATCH-START-POS and MATCH-END-POS.
 156 According to COUNT and left TO-FIND, show if search has been
 157 successful.  Use start TIME to report how much it took.
 158 Highlight match if HIGHLIGHT is non nil.
 159 Return nil if nothing found."
 160   (vlf-move-to-chunk match-chunk-start match-chunk-end)
 161   (goto-char match-start-pos)
 162   (setq vlf-batch-size (vlf-tune-optimal-load
 163                         (if (derived-mode-p 'hexl-mode)
 164                             '(:hexl :raw)
 165                           '(:insert :encode))))
 166   (if (= count to-find)
 167       (progn (message "Not found (%f secs)" (- (float-time) time))
 168              nil)
 169     (let ((success (zerop to-find))
 170           (overlay (make-overlay match-start-pos match-end-pos)))
 171       (overlay-put overlay 'face 'match)
 172       (if success
 173           (message "Match found (%f secs)" (- (float-time) time))
 174         (message "Moved to the %d match which is last (%f secs)"
 175                  (- count to-find) (- (float-time) time)))
 176       (if highlight
 177           (unwind-protect (sit-for 1)
 178             (delete-overlay overlay))
 179         (delete-overlay overlay)))
 180     t))
 181
 182 (defun vlf-re-search-forward (regexp count)
 183   "Search forward for REGEXP prefix COUNT number of times.
 184 Search is performed chunk by chunk in `vlf-batch-size' memory."
 185   (interactive (if (vlf-no-modifications)
 186                    (list (read-regexp "Search whole file"
 187                                       (if regexp-history
 188                                           (car regexp-history)))
 189                          (or current-prefix-arg 1))))
 190   (let ((batch-size vlf-batch-size)
 191         success)
 192     (unwind-protect
 193         (setq success (vlf-re-search regexp count nil nil nil t))
 194       (or success (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         success)
 206     (unwind-protect
 207         (setq success (vlf-re-search regexp count t nil nil t))
 208       (or success (setq vlf-batch-size batch-size)))))
 209
 210 (defun vlf-goto-line (n)
 211   "Go to line N.  If N is negative, count from the end of file."
 212   (interactive (if (vlf-no-modifications)
 213                    (list (read-number "Go to line: "))))
 214   (if (derived-mode-p 'hexl-mode)
 215       (vlf-goto-line-hexl n)
 216     (run-hook-with-args 'vlf-before-batch-functions 'goto-line)
 217     (vlf-verify-size)
 218     (let ((tramp-verbose (if (boundp 'tramp-verbose)
 219                              (min tramp-verbose 1)))
 220           (start-pos vlf-start-pos)
 221           (end-pos vlf-end-pos)
 222           (batch-size vlf-batch-size)
 223           (pos (point))
 224           (font-lock font-lock-mode)
 225           (time (float-time))
 226           (success nil))
 227       (font-lock-mode 0)
 228       (vlf-tune-batch '(:raw))
 229       (unwind-protect
 230           (if (< 0 n)
 231               (let ((start 0)
 232                     (end (min vlf-batch-size vlf-file-size))
 233                     (reporter (make-progress-reporter
 234                                (concat "Searching for line "
 235                                        (number-to-string n) "...")
 236                                0 vlf-file-size))
 237                     (inhibit-read-only t))
 238                 (setq n (1- n))
 239                 (vlf-with-undo-disabled
 240                  ;; (while (and (< (- end start) n)
 241                  ;;             (< n (- vlf-file-size start)))
 242                  ;;   (erase-buffer)
 243                  ;;   (vlf-tune-insert-file-contents-literally start end)
 244                  ;;   (goto-char (point-min))
 245                  ;;   (while (re-search-forward "[\n\C-m]" nil t)
 246                  ;;     (setq n (1- n)))
 247                  ;;   (vlf-verify-size)
 248                  ;;   (vlf-tune-batch '(:raw))
 249                  ;;   (setq start end
 250                  ;;         end (min vlf-file-size (+ start
 251                  ;;                                   vlf-batch-size)))
 252                  ;;   (progress-reporter-update reporter start))
 253                  (when (< n (- vlf-file-size end))
 254                    (vlf-tune-batch '(:insert :encode))
 255                    (vlf-move-to-chunk start (+ start vlf-batch-size))
 256                    (goto-char (point-min))
 257                    (setq success
 258                          (or (zerop n)
 259                              (when (vlf-re-search "[\n\C-m]" n nil
 260                                                   reporter time)
 261                                (forward-char) t))))))
 262             (let ((end vlf-file-size)
 263                   (reporter (make-progress-reporter
 264                              (concat "Searching for line -"
 265                                      (number-to-string n) "...")
 266                              0 vlf-file-size))
 267                   (inhibit-read-only t))
 268               (setq n (- n))
 269               (vlf-with-undo-disabled
 270                ;; (let ((start (max 0 (- vlf-file-size vlf-batch-size))))
 271                ;;   (while (and (< (- end start) n) (< n end))
 272                ;;     (erase-buffer)
 273                ;;     (vlf-tune-insert-file-contents-literally start end)
 274                ;;     (goto-char (point-max))
 275                ;;     (while (re-search-backward "[\n\C-m]" nil t)
 276                ;;       (setq n (1- n)))
 277                ;;     (vlf-tune-batch '(:raw))
 278                ;;     (setq end start
 279                ;;           start (max 0 (- end vlf-batch-size)))
 280                ;;     (progress-reporter-update reporter
 281                ;;                               (- vlf-file-size end))))
 282                (when (< n end)
 283                  (vlf-tune-batch '(:insert :encode))
 284                  (vlf-move-to-chunk (- end vlf-batch-size) end)
 285                  (goto-char (point-max))
 286                  (setq success (vlf-re-search "[\n\C-m]" n t
 287                                               reporter time))))))
 288         (if font-lock (font-lock-mode 1))
 289         (unless success
 290           (vlf-with-undo-disabled
 291            (vlf-move-to-chunk start-pos end-pos))
 292           (goto-char pos)
 293           (setq vlf-batch-size batch-size)
 294           (message "Unable to find line"))
 295         (run-hook-with-args 'vlf-after-batch-functions 'goto-line)))))
 296
 297 (defun vlf-goto-line-hexl (n)
 298   "Go to line N.  If N is negative, count from the end of file.
 299 Assume `hexl-mode' is active."
 300   (vlf-tune-load '(:hexl :raw))
 301   (if (< n 0)
 302       (let ((hidden-bytes (+ vlf-file-size (* n hexl-bits))))
 303         (setq hidden-bytes (- hidden-bytes (mod hidden-bytes
 304                                                 vlf-batch-size)))
 305         (vlf-move-to-batch hidden-bytes)
 306         (goto-char (point-max))
 307         (forward-line (+ (round (- vlf-file-size
 308                                    (min vlf-file-size
 309                                         (+ hidden-bytes
 310                                            vlf-batch-size)))
 311                                 hexl-bits)
 312                          n)))
 313     (let ((hidden-bytes (1- (* n hexl-bits))))
 314       (setq hidden-bytes (- hidden-bytes (mod hidden-bytes
 315                                               vlf-batch-size)))
 316       (vlf-move-to-batch hidden-bytes)
 317       (goto-char (point-min))
 318       (forward-line (- n 1 (/ hidden-bytes hexl-bits))))))
 319
 320 (defun vlf-query-replace (regexp to-string &optional delimited backward)
 321   "Query replace over whole file matching REGEXP with TO-STRING.
 322 Third arg DELIMITED (prefix arg if interactive), if non-nil, replace
 323 only matches surrounded by word boundaries.  A negative prefix arg means
 324 replace BACKWARD."
 325   (interactive (let ((common (query-replace-read-args
 326                               (concat "Query replace over whole file"
 327                                       (if current-prefix-arg
 328                                           (if (eq current-prefix-arg '-)
 329                                               " backward"
 330                                             " word")
 331                                         "")
 332                                       " regexp")
 333                               t)))
 334                  (list (nth 0 common) (nth 1 common) (nth 2 common)
 335                        (nth 3 common))))
 336   (let ((not-automatic t))
 337     (while (vlf-re-search regexp 1 backward)
 338       (cond (not-automatic
 339              (query-replace-regexp regexp to-string delimited
 340                                    nil nil backward)
 341              (if (eq 'automatic (lookup-key query-replace-map
 342                                             (vector last-input-event)))
 343                  (setq not-automatic nil)))
 344             (backward (while (re-search-backward regexp nil t)
 345                         (replace-match to-string)))
 346             (t (while (re-search-forward regexp nil t)
 347                  (replace-match to-string))))
 348       (if (buffer-modified-p)
 349           (save-buffer)))))
 350
 351 (provide 'vlf-search)
 352
 353 ;;; vlf-search.el ends here