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