lisp/locate.el

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