lisp/locate.el

   1 ;;; locate.el --- interface to the locate command
   2
   3 ;; Copyright (C) 1996, 1998, 2001, 2002, 2003, 2004,
   4 ;;   2005 Free Software Foundation, Inc.
   5
   6 ;; Author: Peter Breton <pbreton@cs.umb.edu>
   7 ;; Keywords: unix files
   8
   9 ;; This file is part of GNU Emacs.
  10
  11 ;; GNU Emacs is free software; you can redistribute it and/or modify
  12 ;; it under the terms of the GNU General Public License as published by
  13 ;; the Free Software Foundation; either version 2, or (at your option)
  14 ;; any later version.
  15
  16 ;; GNU Emacs is distributed in the hope that it will be useful,
  17 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  19 ;; GNU General Public License for more details.
  20
  21 ;; You should have received a copy of the GNU General Public License
  22 ;; along with GNU Emacs; see the file COPYING.  If not, write to the
  23 ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
  24 ;; Boston, MA 02110-1301, USA.
  25
  26 ;;; Commentary:
  27
  28 ;; Search a database of files and use dired commands on the result.
  29 ;;
  30 ;; Locate.el provides an interface to a program which searches a
  31 ;; database of file names. By default, this program is the GNU locate
  32 ;; command, but it could also be the BSD-style find command, or even a
  33 ;; user specified command.
  34 ;;
  35 ;; To use the BSD-style "fast find", or any other shell command of the
  36 ;; form
  37 ;;
  38 ;;   SHELLPROGRAM  Name-to-find
  39 ;;
  40 ;; set the variable `locate-command' in your .emacs file.
  41 ;;
  42 ;;   To use a more complicated expression, create a function which
  43 ;; takes a string (the name to find) as input and returns a list.
  44 ;; The first element should be the command to be executed, the remaining
  45 ;; elements should be the arguments (including the name to find). Then put
  46 ;;
  47 ;; (setq locate-make-command-line 'my-locate-command-line)
  48 ;;
  49 ;; in your .emacs, using the name of your function in place of
  50 ;; my-locate-command-line.
  51 ;;
  52 ;; You should make sure that whichever command you use works correctly
  53 ;; from a shell prompt. GNU locate and BSD find expect the file databases
  54 ;; to either be in standard places or located via environment variables.
  55 ;; If the latter, make sure these environment variables are set in
  56 ;; your emacs process.
  57 ;;
  58 ;; Locate-mode assumes that each line output from the locate-command
  59 ;; consists exactly of a file name, possibly preceded or trailed by
  60 ;; whitespace. If your file database has other information on the line (for
  61 ;; example, the file size), you will need to redefine the function
  62 ;; `locate-get-file-positions' to return a list consisting of the first
  63 ;; character in the file name and the last character in the file name.
  64 ;;
  65 ;; To use locate-mode, simply type M-x locate and then the string
  66 ;; you wish to find. You can use almost all of the dired commands in
  67 ;; the resulting *Locate* buffer.  It is worth noting that your commands
  68 ;; do not, of course, affect the file database. For example, if you
  69 ;; compress a file in the locate buffer, the actual file will be
  70 ;; compressed, but the entry in the file database will not be
  71 ;; affected. Consequently, the database and the filesystem will be out
  72 ;; of sync until the next time the database is updated.
  73 ;;
  74 ;; The command `locate-with-filter' keeps only lines matching a
  75 ;; regular expression; this is often useful to constrain a big search.
  76 ;;
  77 \f
  78 ;;;;; Building a database of files ;;;;;;;;;
  79 ;;
  80 ;; You can create a simple files database with a port of the Unix find command
  81 ;; and one of the various Windows NT various scheduling utilities,
  82 ;; for example the AT command from the NT Resource Kit, WinCron which is
  83 ;; included with Microsoft FrontPage, or the shareware NTCron program.
  84 ;;
  85 ;; To set up a function which searches the files database, do something
  86 ;; like this:
  87 ;;
  88 ;; (defvar locate-fcodes-file       "c:/users/peter/fcodes")
  89 ;; (defvar locate-make-command-line 'nt-locate-make-command-line)
  90 ;;
  91 ;; (defun nt-locate-make-command-line (arg)
  92 ;;  (list "grep" "-i" arg locate-fcodes-file))
  93 ;;
  94 ;;;;;;;; ADVICE For dired-make-relative: ;;;;;;;;;
  95 ;;
  96 ;; For certain dired commands to work right, you should also include the
  97 ;; following in your _emacs/.emacs:
  98 ;;
  99 ;; (defadvice dired-make-relative (before set-no-error activate)
 100 ;;   "For locate mode and Windows, don't return errors"
 101 ;;   (if (and (eq   major-mode  'locate-mode)
 102 ;;         (memq system-type (list 'windows-nt 'ms-dos)))
 103 ;;       (ad-set-arg 2 t)
 104 ;;     ))
 105 ;;
 106 ;; Otherwise, `dired-make-relative' will give error messages like
 107 ;; "FILENAME: not in directory tree growing at /"
 108
 109 \f
 110 ;;; Code:
 111
 112 (eval-when-compile
 113   (require 'dired))
 114
 115 ;; Variables
 116
 117 (defvar locate-current-filter nil)
 118
 119 (defgroup locate nil
 120   "Interface to the locate command."
 121   :prefix "locate-"
 122   :group 'external)
 123
 124 (defcustom locate-command "locate"
 125   "*The executable program used to search a database of files."
 126   :type 'string
 127   :group 'locate)
 128
 129 (defvar locate-history-list nil
 130   "The history list used by the \\[locate] command.")
 131
 132 (defvar locate-grep-history-list nil
 133   "The history list used by the \\[locate-with-filter] command.")
 134
 135 (defcustom locate-make-command-line 'locate-default-make-command-line
 136   "*Function used to create the locate command line."
 137   :type 'function
 138   :group 'locate)
 139
 140 (defcustom locate-buffer-name "*Locate*"
 141   "*Name of the buffer to show results from the \\[locate] command."
 142   :type 'string
 143   :group 'locate)
 144
 145 (defcustom locate-fcodes-file nil
 146   "*File name for the database of file names."
 147   :type '(choice file (const nil))
 148   :group 'locate)
 149
 150 (defcustom locate-header-face nil
 151   "*Face used to highlight the locate header."
 152   :type 'face
 153   :group 'locate)
 154
 155 ;;;###autoload
 156 (defcustom locate-ls-subdir-switches "-al"
 157   "`ls' switches for inserting subdirectories in `*Locate*' buffers.
 158 This should contain the \"-l\" switch, but not the \"-F\" or \"-b\" switches."
 159   :type 'string
 160   :group 'locate
 161   :version "22.1")
 162
 163 (defcustom locate-update-command "updatedb"
 164   "The command used to update the locate database."
 165   :type 'string
 166   :group 'locate)
 167
 168 (defcustom locate-prompt-for-command nil
 169   "If non-nil, the locate command prompts for a command to run.
 170 Otherwise, that behavior is invoked via a prefix argument."
 171   :group 'locate
 172   :type 'boolean
 173   )
 174
 175 ;; Functions
 176
 177 (defun locate-default-make-command-line (search-string)
 178   (list locate-command search-string))
 179
 180 (defun locate-word-at-point ()
 181   (let ((pt (point)))
 182     (buffer-substring-no-properties
 183      (save-excursion
 184        (skip-chars-backward "-a-zA-Z0-9.")
 185        (point))
 186      (save-excursion
 187        (skip-chars-forward "-a-zA-Z0-9.")
 188        (skip-chars-backward "." pt)
 189        (point)))))
 190
 191 ;;;###autoload
 192 (defun locate (search-string &optional filter)
 193   "Run the program `locate', putting results in `*Locate*' buffer.
 194 With prefix arg, prompt for the locate command to run."
 195   (interactive
 196       (list
 197        (if (or (and current-prefix-arg
 198                     (not locate-prompt-for-command))
 199                (and (not current-prefix-arg) locate-prompt-for-command))
 200            (let ((locate-cmd (funcall locate-make-command-line "")))
 201              (read-from-minibuffer
 202               "Run locate (like this): "
 203               (cons
 204                (concat (car locate-cmd) "  "
 205                        (mapconcat 'identity (cdr locate-cmd) " "))
 206                        (+ 2 (length (car locate-cmd))))
 207               nil nil 'locate-history-list))
 208          (let* ((default (locate-word-at-point))
 209                (input
 210                 (read-from-minibuffer
 211                  (if  (> (length default) 0)
 212                      (format "Locate (default %s): " default)
 213                    (format "Locate: "))
 214                  nil nil nil 'locate-history-list default t)))
 215                (and (equal input "") default
 216                     (setq input default))
 217                input))))
 218   (if (equal search-string "")
 219       (error "Please specify a filename to search for"))
 220   (let* ((locate-cmd-list (funcall locate-make-command-line search-string))
 221          (locate-cmd (car locate-cmd-list))
 222          (locate-cmd-args (cdr locate-cmd-list))
 223          (run-locate-command
 224           (or (and current-prefix-arg (not locate-prompt-for-command))
 225               (and (not current-prefix-arg) locate-prompt-for-command)))
 226          )
 227
 228     ;; Find the Locate buffer
 229     (save-window-excursion
 230       (set-buffer (get-buffer-create locate-buffer-name))
 231       (locate-mode)
 232       (let ((inhibit-read-only t))
 233         (erase-buffer)
 234
 235         (setq locate-current-filter filter)
 236
 237         (if run-locate-command
 238             (shell-command search-string locate-buffer-name)
 239           (apply 'call-process locate-cmd nil t nil locate-cmd-args))
 240
 241         (and filter
 242              (locate-filter-output filter))
 243
 244         (locate-do-setup search-string)
 245         ))
 246     (and (not (string-equal (buffer-name) locate-buffer-name))
 247         (switch-to-buffer-other-window locate-buffer-name))
 248
 249     (run-hooks 'dired-mode-hook)
 250     (dired-next-line 3)                 ;move to first matching file.
 251     (run-hooks 'locate-post-command-hook)
 252     )
 253   )
 254
 255 ;;;###autoload
 256 (defun locate-with-filter (search-string filter)
 257   "Run the locate command with a filter.
 258
 259 The filter is a regular expression. Only results matching the filter are
 260 shown; this is often useful to constrain a big search."
 261   (interactive
 262    (list (read-from-minibuffer "Locate: " nil nil
 263                                nil 'locate-history-list)
 264          (read-from-minibuffer "Filter: " nil nil
 265                                nil 'locate-grep-history-list)))
 266   (locate search-string filter))
 267
 268 (defun locate-filter-output (filter)
 269   "Filter output from the locate command."
 270   (goto-char (point-min))
 271   (delete-non-matching-lines filter))
 272
 273 (defvar locate-mode-map nil
 274   "Local keymap for Locate mode buffers.")
 275 (if locate-mode-map
 276     nil
 277
 278    (require 'dired)
 279
 280    (setq locate-mode-map (copy-keymap dired-mode-map))
 281
 282    ;; Undefine Useless Dired Menu bars
 283    (define-key locate-mode-map [menu-bar Dired]   'undefined)
 284    (define-key locate-mode-map [menu-bar subdir]  'undefined)
 285
 286    (define-key locate-mode-map [menu-bar mark executables] 'undefined)
 287    (define-key locate-mode-map [menu-bar mark directory]   'undefined)
 288    (define-key locate-mode-map [menu-bar mark directories] 'undefined)
 289    (define-key locate-mode-map [menu-bar mark symlinks]    'undefined)
 290
 291    (define-key locate-mode-map [M-mouse-2] 'locate-mouse-view-file)
 292    (define-key locate-mode-map "\C-c\C-t"  'locate-tags)
 293
 294    (define-key locate-mode-map "l"       'locate-do-redisplay)
 295    (define-key locate-mode-map "U"       'dired-unmark-all-files)
 296    (define-key locate-mode-map "V"       'locate-find-directory)
 297 )
 298
 299 ;; This variable is used to indent the lines and then to search for
 300 ;; the file name
 301 (defconst locate-filename-indentation 4
 302   "The amount of indentation for each file.")
 303
 304 (defun locate-get-file-positions ()
 305   (save-excursion
 306     (end-of-line)
 307     (let ((eol (point)))
 308       (beginning-of-line)
 309
 310       ;; Assumes names end at the end of the line
 311       (forward-char locate-filename-indentation)
 312       (list (point) eol))))
 313
 314 ;; From SQL-mode
 315 (defun locate-current-line-number ()
 316   "Return the current line number, as an integer."
 317   (+ (count-lines (point-min) (point))
 318      (if (eq (current-column) 0)
 319          1
 320        0)))
 321
 322 (defun locate-get-filename ()
 323   (let ((pos    (locate-get-file-positions))
 324         (lineno (locate-current-line-number)))
 325     (and (not (eq lineno 1))
 326          (not (eq lineno 2))
 327          (buffer-substring (elt pos 0) (elt pos 1)))))
 328
 329 (defun locate-main-listing-line-p ()
 330   "Return t if current line contains a file name listed by locate.
 331 This function returns nil if the current line either contains no
 332 file name or is inside a subdirectory."
 333   (save-excursion
 334     (forward-line 0)
 335     (looking-at (concat "."
 336                         (make-string (1- locate-filename-indentation) ?\ )
 337                         "\\(/\\|[A-Za-z]:\\)"))))
 338
 339 (defun locate-mouse-view-file (event)
 340   "In Locate mode, view a file, using the mouse."
 341   (interactive "@e")
 342   (save-excursion
 343     (goto-char (posn-point (event-start event)))
 344     (if (locate-main-listing-line-p)
 345         (view-file (locate-get-filename))
 346       (message "This command only works inside main listing."))))
 347
 348 ;; Define a mode for locate
 349 ;; Default directory is set to "/" so that dired commands, which
 350 ;; expect to be in a tree, will work properly
 351 (defun locate-mode ()
 352   "Major mode for the `*Locate*' buffer made by \\[locate].
 353 \\<locate-mode-map>\
 354 In that buffer, you can use almost all the usual dired bindings.
 355 \\[locate-find-directory] visits the directory of the file on the current line.
 356
 357 Operating on listed files works, but does not always
 358 automatically update the buffer as in ordinary Dired.
 359 This is true both for the main listing and for subdirectories.
 360 Reverting the buffer using \\[revert-buffer] deletes all subdirectories.
 361 Specific `locate-mode' commands, such as \\[locate-find-directory],
 362 do not work in subdirectories.
 363
 364 \\{locate-mode-map}"
 365   ;; Not to be called interactively.
 366   (kill-all-local-variables)
 367   ;; Avoid clobbering this variable
 368   (make-local-variable 'dired-subdir-alist)
 369   (use-local-map             locate-mode-map)
 370   (setq major-mode          'locate-mode
 371         mode-name           "Locate"
 372         default-directory   "/"
 373         buffer-read-only    t
 374         selective-display   t)
 375   (dired-alist-add-1 default-directory (point-min-marker))
 376   (set (make-local-variable 'dired-directory) "/")
 377   (set (make-local-variable 'dired-subdir-switches) locate-ls-subdir-switches)
 378   (setq dired-switches-alist nil)
 379   (make-local-variable 'directory-listing-before-filename-regexp)
 380   ;; This should support both Unix and Windoze style names
 381   (setq directory-listing-before-filename-regexp
 382         (concat "^."
 383                 (make-string (1- locate-filename-indentation) ?\ )
 384                 "\\(/\\|[A-Za-z]:\\)\\|"
 385                 (default-value 'directory-listing-before-filename-regexp)))
 386   (make-local-variable 'dired-actual-switches)
 387   (setq dired-actual-switches "")
 388   (make-local-variable 'dired-permission-flags-regexp)
 389   (setq dired-permission-flags-regexp
 390         (concat "^.\\("
 391                 (make-string (1- locate-filename-indentation) ?\ )
 392                 "\\)\\|"
 393                 (default-value 'dired-permission-flags-regexp)))
 394   (make-local-variable 'revert-buffer-function)
 395   (setq revert-buffer-function 'locate-update)
 396   (set (make-local-variable 'page-delimiter) "\n\n")
 397   (run-mode-hooks 'locate-mode-hook))
 398
 399 (defun locate-do-setup (search-string)
 400   (goto-char (point-min))
 401   (save-excursion
 402
 403     ;; Nothing returned from locate command?
 404     (and (eobp)
 405          (progn
 406            (kill-buffer locate-buffer-name)
 407            (if locate-current-filter
 408                (error "Locate: no match for %s in database using filter %s"
 409                       search-string locate-current-filter)
 410              (error "Locate: no match for %s in database" search-string))))
 411
 412     (locate-insert-header search-string)
 413
 414     (while (not (eobp))
 415       (insert-char ?\  locate-filename-indentation t)
 416       (locate-set-properties)
 417       (forward-line 1)))
 418   (goto-char (point-min)))
 419
 420 (defun locate-set-properties ()
 421   (save-excursion
 422     (let ((pos (locate-get-file-positions)))
 423       (dired-insert-set-properties (elt pos 0) (elt pos 1)))))
 424
 425 (defun locate-insert-header (search-string)
 426   ;; There needs to be a space before `Matches, because otherwise,
 427   ;; `*!" would erase the `M'.  We can not use two spaces, or the line
 428   ;; would mistakenly fit `dired-subdir-regexp'.
 429   (let ((locate-format-string "  /:\n Matches for %s")
 430         (locate-regexp-match
 431          (concat " *Matches for \\(" (regexp-quote search-string) "\\)"))
 432         (locate-format-args (list search-string))
 433         )
 434
 435     (and locate-fcodes-file
 436         (setq locate-format-string
 437               (concat locate-format-string " in %s")
 438               locate-regexp-match
 439               (concat locate-regexp-match
 440                       " in \\("
 441                       (regexp-quote locate-fcodes-file)
 442                       "\\)")
 443               locate-format-args
 444               (append (list locate-fcodes-file) locate-format-args)))
 445
 446     (and locate-current-filter
 447         (setq locate-format-string
 448               (concat locate-format-string " using filter %s")
 449               locate-regexp-match
 450               (concat locate-regexp-match
 451                       " using filter "
 452                       "\\("
 453                       (regexp-quote locate-current-filter)
 454                       "\\)")
 455               locate-format-args
 456               (append (list locate-current-filter) locate-format-args)))
 457
 458     (setq locate-format-string
 459           (concat locate-format-string ":\n\n")
 460           locate-regexp-match
 461           (concat locate-regexp-match ":\n"))
 462
 463     (insert (apply 'format locate-format-string (reverse locate-format-args)))
 464
 465     (save-excursion
 466       (goto-char (point-min))
 467       (forward-line 1)
 468       (if (not (looking-at locate-regexp-match))
 469           nil
 470         (add-text-properties (match-beginning 1) (match-end 1)
 471                              (list 'face locate-header-face))
 472         (and (match-beginning 2)
 473              (add-text-properties (match-beginning 2) (match-end 2)
 474                                   (list 'face locate-header-face)))
 475         (and (match-beginning 3)
 476              (add-text-properties (match-beginning 3) (match-end 3)
 477                                   (list 'face locate-header-face)))
 478         ))))
 479
 480 (defun locate-tags ()
 481   "Visit a tags table in `*Locate*' mode."
 482   (interactive)
 483   (if (locate-main-listing-line-p)
 484       (let ((tags-table (locate-get-filename)))
 485         (and (y-or-n-p (format "Visit tags table %s? " tags-table))
 486              (visit-tags-table tags-table)))
 487     (message "This command only works inside main listing.")))
 488
 489 ;; From Stephen Eglen <stephen@cns.ed.ac.uk>
 490 (defun locate-update (ignore1 ignore2)
 491   "Update the locate database.
 492 Database is updated using the shell command in `locate-update-command'."
 493   (let ((str (car locate-history-list)))
 494     (cond ((yes-or-no-p "Update locate database (may take a few seconds)? ")
 495            (shell-command locate-update-command)
 496            (locate str)))))
 497
 498 ;;; Modified three functions from `dired.el':
 499 ;;;   dired-find-directory,
 500 ;;;   dired-find-directory-other-window
 501 ;;;   dired-get-filename
 502
 503 (defun locate-find-directory ()
 504   "Visit the directory of the file mentioned on this line."
 505   (interactive)
 506   (if (locate-main-listing-line-p)
 507       (let ((directory-name (locate-get-dirname)))
 508         (if (file-directory-p directory-name)
 509             (find-file directory-name)
 510           (if (file-symlink-p directory-name)
 511               (error "Directory is a symlink to a nonexistent target")
 512             (error "Directory no longer exists; run `updatedb' to update database"))))
 513     (message "This command only works inside main listing.")))
 514
 515 (defun locate-find-directory-other-window ()
 516   "Visit the directory of the file named on this line in other window."
 517   (interactive)
 518   (find-file-other-window (locate-get-dirname)))
 519
 520 (defun locate-get-dirname ()
 521   "Return the directory name of the file mentioned on this line."
 522   (let (file (filepos (locate-get-file-positions)))
 523     (if (setq file (buffer-substring (nth 0 filepos) (nth 1 filepos)))
 524         (progn
 525           ;; Get rid of the mouse-face property that file names have.
 526           (set-text-properties 0 (length file) nil file)
 527           (setq file (file-name-directory file))
 528           ;; Unquote names quoted by ls or by dired-insert-directory.
 529           ;; Using read to unquote is much faster than substituting
 530           ;; \007 (4 chars) -> ^G  (1 char) etc. in a lisp loop.
 531           (setq file
 532                 (read
 533                  (concat "\""
 534                          ;; some ls -b don't escape quotes, argh!
 535                          ;; This is not needed for GNU ls, though.
 536                          (or (dired-string-replace-match
 537                               "\\([^\\]\\|\\`\\)\"" file "\\1\\\\\"" nil t)
 538                              file)
 539                          "\"")))))
 540     (and file buffer-file-coding-system
 541          (not file-name-coding-system)
 542          (setq file (encode-coding-string file buffer-file-coding-system)))
 543     file))
 544
 545 ;; Only for GNU locate
 546 (defun locate-in-alternate-database  (search-string database)
 547   "Run the GNU locate command, using an alternate database."
 548   (interactive
 549       (list
 550        (progn
 551          ;; (require 'locate)
 552          (read-from-minibuffer "Locate: " nil nil
 553                                nil 'locate-history-list))
 554        (read-file-name "Locate using Database: " )
 555        ))
 556   (or (file-exists-p database)
 557       (error "Database file %s does not exist" database))
 558   (let ((locate-make-command-line
 559          (function (lambda (string)
 560                      (cons locate-command
 561                            (list (concat "--database="
 562                                          (expand-file-name database))
 563                                  string))))))
 564     (locate search-string)))
 565
 566 (defun locate-do-redisplay (&optional arg test-for-subdir)
 567   "Like `dired-do-redisplay', but adapted for `*Locate*' buffers."
 568   (interactive "P\np")
 569   (if (string= (dired-current-directory) "/")
 570       (message "This command only works in subdirectories.")
 571     (let ((dired-actual-switches locate-ls-subdir-switches))
 572       (dired-do-redisplay arg test-for-subdir))))
 573
 574 (provide 'locate)
 575
 576 ;;; arch-tag: 60c4d098-b5d5-4b3c-a3e0-51a2e9f43898
 577 ;;; locate.el ends here