lisp/locate.el

   1 ;;; locate.el --- interface to the locate command
   2
   3 ;; Copyright (C) 1996, 1998, 2001, 2002, 2003, 2004,
   4 ;;   2005, 2006 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 (const :tag "None" nil) file)
 148   :group 'locate)
 149
 150 (defcustom locate-header-face nil
 151   "*Face used to highlight the locate header."
 152   :type '(choice (const :tag "None" nil) 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             (buffer-undo-list t))
 234         (erase-buffer)
 235
 236         (setq locate-current-filter filter)
 237
 238         (if run-locate-command
 239             (shell-command search-string locate-buffer-name)
 240           (apply 'call-process locate-cmd nil t nil locate-cmd-args))
 241
 242         (and filter
 243              (locate-filter-output filter))
 244
 245         (locate-do-setup search-string)
 246         ))
 247     (and (not (string-equal (buffer-name) locate-buffer-name))
 248         (switch-to-buffer-other-window locate-buffer-name))
 249
 250     (run-hooks 'dired-mode-hook)
 251     (dired-next-line 3)                 ;move to first matching file.
 252     (run-hooks 'locate-post-command-hook)
 253     )
 254   )
 255
 256 ;;;###autoload
 257 (defun locate-with-filter (search-string filter)
 258   "Run the locate command with a filter.
 259
 260 The filter is a regular expression. Only results matching the filter are
 261 shown; this is often useful to constrain a big search."
 262   (interactive
 263    (list (read-from-minibuffer "Locate: " nil nil
 264                                nil 'locate-history-list)
 265          (read-from-minibuffer "Filter: " nil nil
 266                                nil 'locate-grep-history-list)))
 267   (locate search-string filter))
 268
 269 (defun locate-filter-output (filter)
 270   "Filter output from the locate command."
 271   (goto-char (point-min))
 272   (delete-non-matching-lines filter))
 273
 274 (defvar locate-mode-map nil
 275   "Local keymap for Locate mode buffers.")
 276 (if locate-mode-map
 277     nil
 278
 279    (require 'dired)
 280
 281    (setq locate-mode-map (copy-keymap dired-mode-map))
 282
 283    ;; Undefine Useless Dired Menu bars
 284    (define-key locate-mode-map [menu-bar Dired]   'undefined)
 285    (define-key locate-mode-map [menu-bar subdir]  'undefined)
 286
 287    (define-key locate-mode-map [menu-bar mark executables] 'undefined)
 288    (define-key locate-mode-map [menu-bar mark directory]   'undefined)
 289    (define-key locate-mode-map [menu-bar mark directories] 'undefined)
 290    (define-key locate-mode-map [menu-bar mark symlinks]    'undefined)
 291
 292    (define-key locate-mode-map [M-mouse-2] 'locate-mouse-view-file)
 293    (define-key locate-mode-map "\C-c\C-t"  'locate-tags)
 294
 295    (define-key locate-mode-map "l"       'locate-do-redisplay)
 296    (define-key locate-mode-map "U"       'dired-unmark-all-files)
 297    (define-key locate-mode-map "V"       'locate-find-directory)
 298 )
 299
 300 ;; This variable is used to indent the lines and then to search for
 301 ;; the file name
 302 (defconst locate-filename-indentation 4
 303   "The amount of indentation for each file.")
 304
 305 (defun locate-get-file-positions ()
 306   (save-excursion
 307     (end-of-line)
 308     (let ((eol (point)))
 309       (beginning-of-line)
 310
 311       ;; Assumes names end at the end of the line
 312       (forward-char locate-filename-indentation)
 313       (list (point) eol))))
 314
 315 ;; From SQL-mode
 316 (defun locate-current-line-number ()
 317   "Return the current line number, as an integer."
 318   (+ (count-lines (point-min) (point))
 319      (if (eq (current-column) 0)
 320          1
 321        0)))
 322
 323 (defun locate-get-filename ()
 324   (let ((pos    (locate-get-file-positions))
 325         (lineno (locate-current-line-number)))
 326     (and (not (eq lineno 1))
 327          (not (eq lineno 2))
 328          (buffer-substring (elt pos 0) (elt pos 1)))))
 329
 330 (defun locate-main-listing-line-p ()
 331   "Return t if current line contains a file name listed by locate.
 332 This function returns nil if the current line either contains no
 333 file name or is inside a subdirectory."
 334   (save-excursion
 335     (forward-line 0)
 336     (looking-at (concat "."
 337                         (make-string (1- locate-filename-indentation) ?\ )
 338                         "\\(/\\|[A-Za-z]:\\)"))))
 339
 340 (defun locate-mouse-view-file (event)
 341   "In Locate mode, view a file, using the mouse."
 342   (interactive "@e")
 343   (save-excursion
 344     (goto-char (posn-point (event-start event)))
 345     (if (locate-main-listing-line-p)
 346         (view-file (locate-get-filename))
 347       (message "This command only works inside main listing."))))
 348
 349 ;; Define a mode for locate
 350 ;; Default directory is set to "/" so that dired commands, which
 351 ;; expect to be in a tree, will work properly
 352 (defun locate-mode ()
 353   "Major mode for the `*Locate*' buffer made by \\[locate].
 354 \\<locate-mode-map>\
 355 In that buffer, you can use almost all the usual dired bindings.
 356 \\[locate-find-directory] visits the directory of the file on the current line.
 357
 358 Operating on listed files works, but does not always
 359 automatically update the buffer as in ordinary Dired.
 360 This is true both for the main listing and for subdirectories.
 361 Reverting the buffer using \\[revert-buffer] deletes all subdirectories.
 362 Specific `locate-mode' commands, such as \\[locate-find-directory],
 363 do not work in subdirectories.
 364
 365 \\{locate-mode-map}"
 366   ;; Not to be called interactively.
 367   (kill-all-local-variables)
 368   ;; Avoid clobbering this variable
 369   (make-local-variable 'dired-subdir-alist)
 370   (use-local-map             locate-mode-map)
 371   (setq major-mode          'locate-mode
 372         mode-name           "Locate"
 373         default-directory   "/"
 374         buffer-read-only    t
 375         selective-display   t)
 376   (dired-alist-add-1 default-directory (point-min-marker))
 377   (set (make-local-variable 'dired-directory) "/")
 378   (set (make-local-variable 'dired-subdir-switches) locate-ls-subdir-switches)
 379   (setq dired-switches-alist nil)
 380   (make-local-variable 'directory-listing-before-filename-regexp)
 381   ;; This should support both Unix and Windoze style names
 382   (setq directory-listing-before-filename-regexp
 383         (concat "^."
 384                 (make-string (1- locate-filename-indentation) ?\ )
 385                 "\\(/\\|[A-Za-z]:\\)\\|"
 386                 (default-value 'directory-listing-before-filename-regexp)))
 387   (make-local-variable 'dired-actual-switches)
 388   (setq dired-actual-switches "")
 389   (make-local-variable 'dired-permission-flags-regexp)
 390   (setq dired-permission-flags-regexp
 391         (concat "^.\\("
 392                 (make-string (1- locate-filename-indentation) ?\ )
 393                 "\\)\\|"
 394                 (default-value 'dired-permission-flags-regexp)))
 395   (make-local-variable 'revert-buffer-function)
 396   (setq revert-buffer-function 'locate-update)
 397   (set (make-local-variable 'page-delimiter) "\n\n")
 398   (run-mode-hooks 'locate-mode-hook))
 399
 400 (defun locate-do-setup (search-string)
 401   (goto-char (point-min))
 402   (save-excursion
 403
 404     ;; Nothing returned from locate command?
 405     (and (eobp)
 406          (progn
 407            (kill-buffer locate-buffer-name)
 408            (if locate-current-filter
 409                (error "Locate: no match for %s in database using filter %s"
 410                       search-string locate-current-filter)
 411              (error "Locate: no match for %s in database" search-string))))
 412
 413     (locate-insert-header search-string)
 414
 415     (while (not (eobp))
 416       (insert-char ?\  locate-filename-indentation t)
 417       (locate-set-properties)
 418       (forward-line 1)))
 419   (goto-char (point-min)))
 420
 421 (defun locate-set-properties ()
 422   (save-excursion
 423     (let ((pos (locate-get-file-positions)))
 424       (dired-insert-set-properties (elt pos 0) (elt pos 1)))))
 425
 426 (defun locate-insert-header (search-string)
 427   ;; There needs to be a space before `Matches, because otherwise,
 428   ;; `*!" would erase the `M'.  We can not use two spaces, or the line
 429   ;; would mistakenly fit `dired-subdir-regexp'.
 430   (let ((locate-format-string "  /:\n Matches for %s")
 431         (locate-regexp-match
 432          (concat " *Matches for \\(" (regexp-quote search-string) "\\)"))
 433         (locate-format-args (list search-string))
 434         )
 435
 436     (and locate-fcodes-file
 437         (setq locate-format-string
 438               (concat locate-format-string " in %s")
 439               locate-regexp-match
 440               (concat locate-regexp-match
 441                       " in \\("
 442                       (regexp-quote locate-fcodes-file)
 443                       "\\)")
 444               locate-format-args
 445               (append (list locate-fcodes-file) locate-format-args)))
 446
 447     (and locate-current-filter
 448         (setq locate-format-string
 449               (concat locate-format-string " using filter %s")
 450               locate-regexp-match
 451               (concat locate-regexp-match
 452                       " using filter "
 453                       "\\("
 454                       (regexp-quote locate-current-filter)
 455                       "\\)")
 456               locate-format-args
 457               (append (list locate-current-filter) locate-format-args)))
 458
 459     (setq locate-format-string
 460           (concat locate-format-string ":\n\n")
 461           locate-regexp-match
 462           (concat locate-regexp-match ":\n"))
 463
 464     (insert (apply 'format locate-format-string (reverse locate-format-args)))
 465
 466     (save-excursion
 467       (goto-char (point-min))
 468       (forward-line 1)
 469       (if (not (looking-at locate-regexp-match))
 470           nil
 471         (add-text-properties (match-beginning 1) (match-end 1)
 472                              (list 'face locate-header-face))
 473         (and (match-beginning 2)
 474              (add-text-properties (match-beginning 2) (match-end 2)
 475                                   (list 'face locate-header-face)))
 476         (and (match-beginning 3)
 477              (add-text-properties (match-beginning 3) (match-end 3)
 478                                   (list 'face locate-header-face)))
 479         ))))
 480
 481 (defun locate-tags ()
 482   "Visit a tags table in `*Locate*' mode."
 483   (interactive)
 484   (if (locate-main-listing-line-p)
 485       (let ((tags-table (locate-get-filename)))
 486         (and (y-or-n-p (format "Visit tags table %s? " tags-table))
 487              (visit-tags-table tags-table)))
 488     (message "This command only works inside main listing.")))
 489
 490 ;; From Stephen Eglen <stephen@cns.ed.ac.uk>
 491 (defun locate-update (ignore1 ignore2)
 492   "Update the locate database.
 493 Database is updated using the shell command in `locate-update-command'."
 494   (let ((str (car locate-history-list)))
 495     (cond ((yes-or-no-p "Update locate database (may take a few seconds)? ")
 496            (shell-command locate-update-command)
 497            (locate str)))))
 498
 499 ;;; Modified three functions from `dired.el':
 500 ;;;   dired-find-directory,
 501 ;;;   dired-find-directory-other-window
 502 ;;;   dired-get-filename
 503
 504 (defun locate-find-directory ()
 505   "Visit the directory of the file mentioned on this line."
 506   (interactive)
 507   (if (locate-main-listing-line-p)
 508       (let ((directory-name (locate-get-dirname)))
 509         (if (file-directory-p directory-name)
 510             (find-file directory-name)
 511           (if (file-symlink-p directory-name)
 512               (error "Directory is a symlink to a nonexistent target")
 513             (error "Directory no longer exists; run `updatedb' to update database"))))
 514     (message "This command only works inside main listing.")))
 515
 516 (defun locate-find-directory-other-window ()
 517   "Visit the directory of the file named on this line in other window."
 518   (interactive)
 519   (find-file-other-window (locate-get-dirname)))
 520
 521 (defun locate-get-dirname ()
 522   "Return the directory name of the file mentioned on this line."
 523   (let (file (filepos (locate-get-file-positions)))
 524     (if (setq file (buffer-substring (nth 0 filepos) (nth 1 filepos)))
 525         (progn
 526           ;; Get rid of the mouse-face property that file names have.
 527           (set-text-properties 0 (length file) nil file)
 528           (setq file (file-name-directory file))
 529           ;; Unquote names quoted by ls or by dired-insert-directory.
 530           ;; Using read to unquote is much faster than substituting
 531           ;; \007 (4 chars) -> ^G  (1 char) etc. in a lisp loop.
 532           (setq file
 533                 (read
 534                  (concat "\""
 535                          ;; some ls -b don't escape quotes, argh!
 536                          ;; This is not needed for GNU ls, though.
 537                          (or (dired-string-replace-match
 538                               "\\([^\\]\\|\\`\\)\"" file "\\1\\\\\"" nil t)
 539                              file)
 540                          "\"")))))
 541     (and file buffer-file-coding-system
 542          (not file-name-coding-system)
 543          (setq file (encode-coding-string file buffer-file-coding-system)))
 544     file))
 545
 546 ;; Only for GNU locate
 547 (defun locate-in-alternate-database  (search-string database)
 548   "Run the GNU locate command, using an alternate database."
 549   (interactive
 550       (list
 551        (progn
 552          ;; (require 'locate)
 553          (read-from-minibuffer "Locate: " nil nil
 554                                nil 'locate-history-list))
 555        (read-file-name "Locate using Database: " )
 556        ))
 557   (or (file-exists-p database)
 558       (error "Database file %s does not exist" database))
 559   (let ((locate-make-command-line
 560          (function (lambda (string)
 561                      (cons locate-command
 562                            (list (concat "--database="
 563                                          (expand-file-name database))
 564                                  string))))))
 565     (locate search-string)))
 566
 567 (defun locate-do-redisplay (&optional arg test-for-subdir)
 568   "Like `dired-do-redisplay', but adapted for `*Locate*' buffers."
 569   (interactive "P\np")
 570   (if (string= (dired-current-directory) "/")
 571       (message "This command only works in subdirectories.")
 572     (let ((dired-actual-switches locate-ls-subdir-switches))
 573       (dired-do-redisplay arg test-for-subdir))))
 574
 575 (provide 'locate)
 576
 577 ;;; arch-tag: 60c4d098-b5d5-4b3c-a3e0-51a2e9f43898
 578 ;;; locate.el ends here