lisp/locate.el

   1 ;;; locate.el --- interface to the locate command
   2
   3 ;; Copyright (C) 1996, 1998 Free Software Foundation, Inc.
   4
   5 ;; Author: Peter Breton <pbreton@cs.umb.edu>
   6
   7 ;; This file is part of GNU Emacs.
   8
   9 ;; GNU Emacs 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 2, or (at your option)
  12 ;; any later version.
  13
  14 ;; GNU Emacs 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 the
  21 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  22 ;; Boston, MA 02111-1307, USA.
  23
  24 ;;; Commentary:
  25
  26 ;; Search a database of files and use dired commands on
  27 ;; the result.
  28 ;;
  29 \f
  30 ;;;;; Building a database of files ;;;;;;;;;
  31 ;;
  32 ;; You can create a simple files database with a port of the Unix find command
  33 ;; and one of the various Windows NT various scheduling utilities,
  34 ;; for example the AT command from the NT Resource Kit, WinCron which is
  35 ;; included with Microsoft FrontPage, or the shareware NTCron program.
  36 ;;
  37 ;; To set up a function which searches the files database, do something
  38 ;; like this:
  39 ;;
  40 ;; (defvar locate-fcodes-file       "c:/users/peter/fcodes")
  41 ;; (defvar locate-make-command-line 'nt-locate-make-command-line)
  42 ;;
  43 ;; (defun nt-locate-make-command-line (arg)
  44 ;;  (list "grep" "-i" arg locate-fcodes-file))
  45 ;;
  46 ;;;;;;;; ADVICE For dired-make-relative: ;;;;;;;;;
  47 ;;
  48 ;; For certain dired commands to work right, you should also include the
  49 ;; following in your _emacs/.emacs:
  50 ;;
  51 ;; (defadvice dired-make-relative (before set-no-error activate)
  52 ;;   "For locate mode and Windows, don't return errors"
  53 ;;   (if (and (eq   major-mode  'locate-mode)
  54 ;;         (memq system-type (list 'windows-nt 'ms-dos)))
  55 ;;       (ad-set-arg 2 t)
  56 ;;     ))
  57 ;;
  58 ;; Otherwise, `dired-make-relative' will give error messages like
  59 ;; "FILENAME: not in directory tree growing at /"
  60 \f
  61 ;;; Commentary:
  62 ;;
  63 ;; Locate.el provides an interface to a program which searches a
  64 ;; database of file names. By default, this program is the GNU locate
  65 ;; command, but it could also be the BSD-style find command, or even a
  66 ;; user specified command.
  67 ;;
  68 ;; To use the BSD-style "fast find", or any other shell command of the
  69 ;; form
  70 ;;
  71 ;;   SHELLPROGRAM  Name-to-find
  72 ;;
  73 ;; set the variable `locate-command' in your .emacs file.
  74 ;;
  75 ;;   To use a more complicated expression, create a function which
  76 ;; takes a string (the name to find) as input and returns a list.
  77 ;; The first element should be the command to be executed, the remaining
  78 ;; elements should be the arguments (including the name to find). Then put
  79 ;;
  80 ;; (setq locate-make-command-line 'my-locate-command-line)
  81 ;;
  82 ;; in your .emacs, using the name of your function in place of
  83 ;; my-locate-command-line.
  84 ;;
  85 ;; You should make sure that whichever command you use works correctly
  86 ;; from a shell prompt. GNU locate and BSD find expect the file databases
  87 ;; to either be in standard places or located via environment variables.
  88 ;; If the latter, make sure these environment variables are set in
  89 ;; your emacs process.
  90 ;;
  91 ;; Locate-mode assumes that each line output from the locate-command
  92 ;; consists exactly of a file name, possibly preceded or trailed by
  93 ;; whitespace. If your file database has other information on the line (for
  94 ;; example, the file size), you will need to redefine the function
  95 ;; `locate-get-file-positions' to return a list consisting of the first
  96 ;; character in the file name and the last character in the file name.
  97 ;;
  98 ;; To use locate-mode, simply type M-x locate and then the string
  99 ;; you wish to find. You can use almost all of the dired commands in
 100 ;; the resulting *Locate* buffer.  It is worth noting that your commands
 101 ;; do not, of course, affect the file database. For example, if you
 102 ;; compress a file in the locate buffer, the actual file will be
 103 ;; compressed, but the entry in the file database will not be
 104 ;; affected. Consequently, the database and the filesystem will be out
 105 ;; of sync until the next time the database is updated.
 106 ;;
 107 ;; The command `locate-with-filter' keeps only lines matching a
 108 ;; regular expression; this is often useful to constrain a big search.
 109 ;;
 110 \f
 111 ;;; Code:
 112
 113 (eval-when-compile
 114   (require 'dired))
 115
 116 ;; Variables
 117
 118 (defvar locate-current-filter nil)
 119
 120 (defgroup locate nil
 121   "Interface to the locate command."
 122   :prefix "locate-"
 123   :group 'external)
 124
 125 (defcustom locate-command "locate"
 126   "*The executable program used to search a database of files."
 127   :type 'string
 128   :group 'locate)
 129
 130 (defvar locate-history-list nil
 131   "The history list used by the \\[locate] command.")
 132
 133 (defcustom locate-make-command-line 'locate-default-make-command-line
 134   "*Function used to create the locate command line."
 135   :type 'function
 136   :group 'locate)
 137
 138 (defcustom locate-buffer-name "*Locate*"
 139   "*Name of the buffer to show results from the \\[locate] command."
 140   :type 'string
 141   :group 'locate)
 142
 143 (defcustom locate-fcodes-file nil
 144   "*File name for the database of file names."
 145   :type '(choice file (const nil))
 146   :group 'locate)
 147
 148 (defcustom locate-mouse-face 'highlight
 149   "*Face used to highlight locate entries."
 150   :type 'face
 151   :group 'locate)
 152
 153 (defcustom locate-header-face 'underline
 154   "*Face used to highlight the locate header."
 155   :type 'face
 156   :group 'locate)
 157
 158 (defcustom locate-update-command "updatedb"
 159   "The command used to update the locate database."
 160   :type 'string
 161   :group 'locate)
 162
 163 ;; Functions
 164
 165 (defun locate-default-make-command-line (search-string)
 166   (list locate-command search-string))
 167
 168 ;;;###autoload
 169 (defun locate (search-string &optional filter)
 170   "Run the program `locate', putting results in `*Locate*' buffer."
 171   (interactive
 172       (list (read-from-minibuffer "Locate: " nil nil
 173                   nil 'locate-history-list)))
 174   (let* ((locate-cmd-list (funcall locate-make-command-line search-string))
 175          (locate-cmd (car locate-cmd-list))
 176          (locate-cmd-args (cdr locate-cmd-list))
 177          )
 178
 179     ;; Find the Locate buffer
 180     (save-window-excursion
 181       (set-buffer (get-buffer-create locate-buffer-name))
 182       (locate-mode)
 183       (erase-buffer)
 184
 185       (setq locate-current-filter filter)
 186
 187       (apply 'call-process locate-cmd nil t nil locate-cmd-args)
 188       (and filter
 189           (locate-filter-output filter))
 190
 191       (locate-do-setup)
 192       )
 193     (and (not (string-equal (buffer-name) locate-buffer-name))
 194         (switch-to-buffer-other-window locate-buffer-name))
 195     )
 196   )
 197
 198 ;;;###autoload
 199 (defun locate-with-filter (search-string filter)
 200   "Run the locate command with a filter."
 201   (interactive
 202    (list (read-from-minibuffer "Locate: " nil nil
 203                                nil 'locate-history-list)
 204          (read-from-minibuffer "Filter: " nil nil
 205                                nil 'grep-history)))
 206   (locate search-string filter))
 207
 208 (defun locate-filter-output (filter)
 209   "Filter output from the locate command."
 210   (goto-char (point-min))
 211   (delete-non-matching-lines (regexp-quote filter)))
 212
 213 (defvar locate-mode-map nil
 214   "Local keymap for Locate mode buffers.")
 215 (if locate-mode-map
 216     nil
 217
 218    (require 'dired)
 219
 220    (setq locate-mode-map (copy-keymap dired-mode-map))
 221
 222    ;; Undefine Useless Dired Menu bars
 223    (define-key locate-mode-map [menu-bar Dired]   'undefined)
 224    (define-key locate-mode-map [menu-bar subdir]  'undefined)
 225
 226    (define-key locate-mode-map [menu-bar mark executables] 'undefined)
 227    (define-key locate-mode-map [menu-bar mark directory]   'undefined)
 228    (define-key locate-mode-map [menu-bar mark directories] 'undefined)
 229    (define-key locate-mode-map [menu-bar mark symlinks]    'undefined)
 230
 231    (define-key locate-mode-map [mouse-2] 'mouse-locate-view-file)
 232    (define-key locate-mode-map "\C-ct"   'locate-tags)
 233
 234    (define-key locate-mode-map "U"       'dired-unmark-all-files-no-query)
 235 )
 236
 237 ;; This variable is used to indent the lines and then to search for
 238 ;; the file name
 239 (defconst locate-filename-indentation 4
 240   "The amount of indentation for each file.")
 241
 242 (defun locate-get-file-positions ()
 243   (save-excursion
 244     (end-of-line)
 245     (let ((eol (point)))
 246       (beginning-of-line)
 247
 248       ;; Assumes names end at the end of the line
 249       (forward-char locate-filename-indentation)
 250       (list (point) eol))))
 251
 252 ;; From SQL-mode
 253 (defun locate-current-line-number ()
 254   "Return the current line number, as an integer."
 255   (+ (count-lines (point-min) (point))
 256      (if (eq (current-column) 0)
 257          1
 258        0)))
 259
 260 (defun locate-get-filename ()
 261   (let ((pos    (locate-get-file-positions))
 262         (lineno (locate-current-line-number)))
 263     (and (not (eq lineno 1))
 264          (not (eq lineno 2))
 265          (buffer-substring (elt pos 0) (elt pos 1)))))
 266
 267 (defun mouse-locate-view-file (event)
 268   "In Locate mode, view a file, using the mouse."
 269   (interactive "@e")
 270   (save-excursion
 271     (goto-char (posn-point (event-start event)))
 272     (view-file (locate-get-filename))))
 273
 274 ;; Define a mode for locate
 275 ;; Default directory is set to "/" so that dired commands, which
 276 ;; expect to be in a tree, will work properly
 277 (defun locate-mode ()
 278   "Major mode for the `*Locate*' buffer made by \\[locate]."
 279   (kill-all-local-variables)
 280   (use-local-map             locate-mode-map)
 281   (setq major-mode          'locate-mode
 282         mode-name           "Locate"
 283         default-directory   "/"
 284         dired-subdir-alist  (list (cons "/" (point-min-marker))))
 285   (make-local-variable 'dired-move-to-filename-regexp)
 286   (setq dired-move-to-filename-regexp
 287         (make-string locate-filename-indentation ?\ ))
 288   (make-local-variable 'dired-actual-switches)
 289   (setq dired-actual-switches "")
 290   (make-local-variable 'dired-permission-flags-regexp)
 291   (setq dired-permission-flags-regexp "^\\(    \\)")
 292   (make-local-variable 'revert-buffer-function)
 293   (setq revert-buffer-function 'locate-update)
 294   (run-hooks 'locate-mode-hook))
 295
 296 (defun locate-do-setup ()
 297   (let ((search-string (car locate-history-list)))
 298     (goto-char (point-min))
 299     (save-excursion
 300
 301       ;; Nothing returned from locate command?
 302       (and (eobp)
 303            (progn
 304              (kill-buffer locate-buffer-name)
 305              (if locate-current-filter
 306                  (error "Locate: no match for %s in database using filter %s"
 307                         search-string locate-current-filter)
 308                (error "Locate: no match for %s in database" search-string))))
 309
 310       (locate-insert-header search-string)
 311
 312       (while (not (eobp))
 313         (insert-char ?\  locate-filename-indentation t)
 314         (locate-set-properties)
 315         (forward-line 1)))))
 316
 317 (defun locate-set-properties ()
 318   (save-excursion
 319     (let ((pos (locate-get-file-positions)))
 320       (add-text-properties (elt pos 0) (elt pos 1)
 321                            (list 'mouse-face locate-mouse-face)))))
 322
 323 (defun locate-insert-header (search-string)
 324   (let ((locate-format-string "Matches for %s")
 325         (locate-regexp-match
 326          (concat " *Matches for \\(" (regexp-quote search-string) "\\)"))
 327         (locate-format-args (list search-string))
 328         )
 329
 330     (and locate-fcodes-file
 331         (setq locate-format-string
 332               (concat locate-format-string " in %s")
 333               locate-regexp-match
 334               (concat locate-regexp-match
 335                       " in \\("
 336                       (regexp-quote locate-fcodes-file)
 337                       "\\)")
 338               locate-format-args
 339               (append (list locate-fcodes-file) locate-format-args)))
 340
 341     (and locate-current-filter
 342         (setq locate-format-string
 343               (concat locate-format-string " using filter %s")
 344               locate-regexp-match
 345               (concat locate-regexp-match
 346                       " using filter "
 347                       "\\("
 348                       (regexp-quote locate-current-filter)
 349                       "\\)")
 350               locate-format-args
 351               (append (list locate-current-filter) locate-format-args)))
 352
 353     (setq locate-format-string
 354           (concat locate-format-string ": \n\n")
 355           locate-regexp-match
 356           (concat locate-regexp-match ": \n"))
 357
 358     (insert (apply 'format locate-format-string (reverse locate-format-args)))
 359
 360     (save-excursion
 361       (goto-char (point-min))
 362       (if (not (looking-at locate-regexp-match))
 363           nil
 364         (add-text-properties (match-beginning 1) (match-end 1)
 365                              (list 'face locate-header-face))
 366         (and (match-beginning 2)
 367              (add-text-properties (match-beginning 2) (match-end 2)
 368                                   (list 'face locate-header-face)))
 369         (and (match-beginning 3)
 370              (add-text-properties (match-beginning 3) (match-end 3)
 371                                   (list 'face locate-header-face)))
 372         ))))
 373
 374 (defun locate-tags ()
 375   "Visit a tags table in `*Locate*' mode."
 376   (interactive)
 377   (let ((tags-table (locate-get-filename)))
 378     (and (y-or-n-p (format "Visit tags table %s? " tags-table))
 379          (visit-tags-table tags-table))))
 380
 381 ;; From Stephen Eglen <stephen@cns.ed.ac.uk>
 382 (defun locate-update (ignore1 ignore2)
 383   "Update the locate database.
 384 Database is updated using the shell command in `locate-update-command'."
 385   (let ((str (car locate-history-list)))
 386     (cond ((yes-or-no-p "Update locate database (may take a few seconds)? ")
 387            (shell-command locate-update-command)
 388            (locate str)))))
 389
 390 (provide 'locate)
 391
 392 ;;; locate.el ends here