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 (defun vlf-re-search (regexp count backward batch-step)
  33   "Search for REGEXP COUNT number of times forward or BACKWARD.
  34 BATCH-STEP is amount of overlap between successive chunks."
  35   (if (<= count 0)
  36       (error "Count must be positive"))
  37   (run-hook-with-args 'vlf-before-batch-functions 'search)
  38   (let* ((tramp-verbose (if (boundp 'tramp-verbose)
  39                             (min tramp-verbose 2)))
  40          (case-fold-search t)
  41          (match-chunk-start vlf-start-pos)
  42          (match-chunk-end vlf-end-pos)
  43          (match-start-pos (+ vlf-start-pos (position-bytes (point))))
  44          (match-end-pos match-start-pos)
  45          (to-find count)
  46          (is-hexl (derived-mode-p 'hexl-mode))
  47          (font-lock font-lock-mode)
  48          (reporter (make-progress-reporter
  49                     (concat "Searching for " regexp "...")
  50                     (if backward
  51                         (- vlf-file-size vlf-end-pos)
  52                       vlf-start-pos)
  53                     vlf-file-size)))
  54     (font-lock-mode 0)
  55     (vlf-with-undo-disabled
  56      (unwind-protect
  57          (catch 'end-of-file
  58            (if backward
  59                (while (not (zerop to-find))
  60                  (cond ((re-search-backward regexp nil t)
  61                         (setq to-find (1- to-find)
  62                               match-chunk-start vlf-start-pos
  63                               match-chunk-end vlf-end-pos
  64                               match-start-pos (+ vlf-start-pos
  65                                                  (position-bytes
  66                                                   (match-beginning 0)))
  67                               match-end-pos (+ vlf-start-pos
  68                                                (position-bytes
  69                                                 (match-end 0)))))
  70                        ((zerop vlf-start-pos)
  71                         (throw 'end-of-file nil))
  72                        (t (let ((batch-move (- vlf-start-pos
  73                                                (- vlf-batch-size
  74                                                   batch-step))))
  75                             (vlf-move-to-batch
  76                              (if (or is-hexl
  77                                      (<= batch-move match-start-pos))
  78                                  batch-move
  79                                (- match-start-pos vlf-batch-size)) t))
  80                           (goto-char (if (or is-hexl
  81                                              (<= vlf-end-pos
  82                                                  match-start-pos))
  83                                          (point-max)
  84                                        (or (byte-to-position
  85                                               (- match-start-pos
  86                                                  vlf-start-pos))
  87                                              (point-max))))
  88                           (progress-reporter-update
  89                            reporter (- vlf-file-size
  90                                        vlf-start-pos)))))
  91              (while (not (zerop to-find))
  92                (cond ((re-search-forward regexp nil t)
  93                       (setq to-find (1- to-find)
  94                             match-chunk-start vlf-start-pos
  95                             match-chunk-end vlf-end-pos
  96                             match-start-pos (+ vlf-start-pos
  97                                                (position-bytes
  98                                                 (match-beginning 0)))
  99                             match-end-pos (+ vlf-start-pos
 100                                              (position-bytes
 101                                               (match-end 0)))))
 102                      ((= vlf-end-pos vlf-file-size)
 103                       (throw 'end-of-file nil))
 104                      (t (let ((batch-move (- vlf-end-pos batch-step)))
 105                           (vlf-move-to-batch
 106                            (if (or is-hexl
 107                                    (< match-end-pos batch-move))
 108                                batch-move
 109                              match-end-pos) t))
 110                         (goto-char (if (or is-hexl
 111                                            (<= match-end-pos vlf-start-pos))
 112                                        (point-min)
 113                                      (or (byte-to-position
 114                                             (- match-end-pos
 115                                                vlf-start-pos))
 116                                            (point-min))))
 117                         (progress-reporter-update reporter
 118                                                   vlf-end-pos)))))
 119            (progress-reporter-done reporter))
 120        (set-buffer-modified-p nil)
 121        (if font-lock (font-lock-mode 1))
 122        (if backward
 123            (vlf-goto-match match-chunk-start match-chunk-end
 124                            match-end-pos match-start-pos
 125                            count to-find)
 126          (vlf-goto-match match-chunk-start match-chunk-end
 127                          match-start-pos match-end-pos
 128                          count to-find))
 129        (run-hook-with-args 'vlf-after-batch-functions 'search)))))
 130
 131 (defun vlf-goto-match (match-chunk-start match-chunk-end
 132                                          match-pos-start
 133                                          match-pos-end
 134                                          count to-find)
 135   "Move to MATCH-CHUNK-START MATCH-CHUNK-END surrounding\
 136 MATCH-POS-START and MATCH-POS-END.
 137 According to COUNT and left TO-FIND, show if search has been
 138 successful.  Return nil if nothing found."
 139   (if (= count to-find)
 140       (progn (vlf-move-to-chunk match-chunk-start match-chunk-end)
 141              (goto-char (or (byte-to-position (- match-pos-start
 142                                                  vlf-start-pos))
 143                             (point-max)))
 144              (message "Not found")
 145              nil)
 146     (let ((success (zerop to-find)))
 147       (if success
 148           (vlf-update-buffer-name)
 149         (vlf-move-to-chunk match-chunk-start match-chunk-end))
 150       (let* ((match-end (or (byte-to-position (- match-pos-end
 151                                                  vlf-start-pos))
 152                             (point-max)))
 153              (overlay (make-overlay (byte-to-position
 154                                      (- match-pos-start
 155                                         vlf-start-pos))
 156                                     match-end)))
 157         (overlay-put overlay 'face 'match)
 158         (unless success
 159           (goto-char match-end)
 160           (message "Moved to the %d match which is last"
 161                    (- count to-find)))
 162         (unwind-protect (sit-for 3)
 163           (delete-overlay overlay))
 164         t))))
 165
 166 (defun vlf-re-search-forward (regexp count)
 167   "Search forward for REGEXP prefix COUNT number of times.
 168 Search is performed chunk by chunk in `vlf-batch-size' memory."
 169   (interactive (if (vlf-no-modifications)
 170                    (list (read-regexp "Search whole file"
 171                                       (if regexp-history
 172                                           (car regexp-history)))
 173                          (or current-prefix-arg 1))))
 174   (vlf-re-search regexp count nil (/ vlf-batch-size 8)))
 175
 176 (defun vlf-re-search-backward (regexp count)
 177   "Search backward for REGEXP prefix COUNT number of times.
 178 Search is performed chunk by chunk in `vlf-batch-size' memory."
 179   (interactive (if (vlf-no-modifications)
 180                    (list (read-regexp "Search whole file backward"
 181                                       (if regexp-history
 182                                           (car regexp-history)))
 183                          (or current-prefix-arg 1))))
 184   (vlf-re-search regexp count t (/ vlf-batch-size 8)))
 185
 186 (defun vlf-goto-line (n)
 187   "Go to line N.  If N is negative, count from the end of file."
 188   (interactive (if (vlf-no-modifications)
 189                    (list (read-number "Go to line: "))))
 190   (run-hook-with-args 'vlf-before-batch-functions 'goto-line)
 191   (vlf-verify-size)
 192   (let ((tramp-verbose (if (boundp 'tramp-verbose)
 193                            (min tramp-verbose 2)))
 194         (start-pos vlf-start-pos)
 195         (end-pos vlf-end-pos)
 196         (pos (point))
 197         (is-hexl (derived-mode-p 'hexl-mode))
 198         (font-lock font-lock-mode)
 199         (success nil))
 200     (font-lock-mode 0)
 201     (unwind-protect
 202         (if (< 0 n)
 203             (let ((start 0)
 204                   (end (min vlf-batch-size vlf-file-size))
 205                   (reporter (make-progress-reporter
 206                              (concat "Searching for line "
 207                                      (number-to-string n) "...")
 208                              0 vlf-file-size))
 209                   (inhibit-read-only t))
 210               (setq n (1- n))
 211               (vlf-with-undo-disabled
 212                (or is-hexl
 213                    (while (and (< (- end start) n)
 214                                (< n (- vlf-file-size start)))
 215                      (erase-buffer)
 216                      (insert-file-contents-literally buffer-file-name
 217                                                      nil start end)
 218                      (goto-char (point-min))
 219                      (while (re-search-forward "[\n\C-m]" nil t)
 220                        (setq n (1- n)))
 221                      (vlf-verify-size)
 222                      (setq start end
 223                            end (min vlf-file-size
 224                                     (+ start vlf-batch-size)))
 225                      (progress-reporter-update reporter start)))
 226                (when (< n (- vlf-file-size end))
 227                  (vlf-move-to-chunk-2 start end)
 228                  (goto-char (point-min))
 229                  (setq success (vlf-re-search "[\n\C-m]" n nil 0)))))
 230           (let ((start (max 0 (- vlf-file-size vlf-batch-size)))
 231                 (end vlf-file-size)
 232                 (reporter (make-progress-reporter
 233                            (concat "Searching for line -"
 234                                    (number-to-string n) "...")
 235                            0 vlf-file-size))
 236                 (inhibit-read-only t))
 237             (setq n (- n))
 238             (vlf-with-undo-disabled
 239              (or is-hexl
 240                  (while (and (< (- end start) n) (< n end))
 241                    (erase-buffer)
 242                    (insert-file-contents-literally buffer-file-name
 243                                                    nil start end)
 244                    (goto-char (point-max))
 245                    (while (re-search-backward "[\n\C-m]" nil t)
 246                      (setq n (1- n)))
 247                    (setq end start
 248                          start (max 0 (- end vlf-batch-size)))
 249                    (progress-reporter-update reporter
 250                                              (- vlf-file-size end))))
 251              (when (< n end)
 252                (vlf-move-to-chunk-2 start end)
 253                (goto-char (point-max))
 254                (setq success (vlf-re-search "[\n\C-m]" n t 0))))))
 255       (if font-lock (font-lock-mode 1))
 256       (unless success
 257         (vlf-with-undo-disabled
 258          (vlf-move-to-chunk-2 start-pos end-pos))
 259         (vlf-update-buffer-name)
 260         (goto-char pos)
 261         (message "Unable to find line"))
 262       (run-hook-with-args 'vlf-after-batch-functions 'goto-line))))
 263
 264 (provide 'vlf-search)
 265
 266 ;;; vlf-search.el ends here