lisp/locate.el

   1 ;;; locate.el --- interface to the locate command
   2
   3 ;; Copyright (C) 1996, 1998, 2001, 2002, 2003, 2004,
   4 ;;   2005, 2006, 2007 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 (defvar locate-local-filter nil)
 119 (defvar locate-local-search nil)
 120 (defvar locate-local-prompt nil)
 121
 122 (defgroup locate nil
 123   "Interface to the locate command."
 124   :prefix "locate-"
 125   :group 'external)
 126
 127 (defcustom locate-command "locate"
 128   "Executable program for searching a database of files.
 129 The Emacs commands `locate' and `locate-with-filter' use this.
 130 The value should be a program that can be called from a shell
 131 with one argument, SEARCH-STRING.  The program determines which
 132 database it searches.  The output of the program should consist
 133 of those file names in the database that match SEARCH-STRING,
 134 listed one per line, possibly with leading or trailing
 135 whitespace.  If the output is in another form, you may have to
 136 redefine the function `locate-get-file-positions'.
 137
 138 The program may interpret SEARCH-STRING as a literal string, a
 139 shell pattern or a regular expression.  The exact rules of what
 140 constitutes a match may also depend on the program.
 141
 142 The standard value of this variable is \"locate\".
 143 This program normally searches a database of all files on your
 144 system, or of all files that you have access to.  Consult the
 145 documentation of that program for the details about how it determines
 146 which file names match SEARCH-STRING.  (Those details vary highly with
 147 the version.)"
 148   :type 'string
 149   :group 'locate)
 150
 151 (defvar locate-history-list nil
 152   "The history list used by the \\[locate] command.")
 153
 154 (defvar locate-grep-history-list nil
 155   "The history list used by the \\[locate-with-filter] command.")
 156
 157 (defcustom locate-make-command-line 'locate-default-make-command-line
 158   "Function used to create the locate command line.
 159 The Emacs commands `locate' and `locate-with-filter' use this.
 160 This function should take one argument, a string (the name to find)
 161 and return a list of strings.  The first element of the list should be
 162 the name of a command to be executed by a shell, the remaining elements
 163 should be the arguments to that command (including the name to find)."
 164   :type 'function
 165   :group 'locate)
 166
 167 (defcustom locate-buffer-name "*Locate*"
 168   "Name of the buffer to show results from the \\[locate] command."
 169   :type 'string
 170   :group 'locate)
 171
 172 (defcustom locate-fcodes-file nil
 173   "File name for the database of file names used by `locate'.
 174 If non-nil, `locate' uses this name in the header of the `*Locate*'
 175 buffer.  If nil, it mentions no file name in that header.
 176
 177 Just setting this variable does not actually change the database
 178 that `locate' searches.  The executive program that the Emacs
 179 function `locate' uses, as given by the variables `locate-command'
 180 or `locate-make-command-line', determines the database."
 181   :type '(choice (const :tag "None" nil) file)
 182   :group 'locate)
 183
 184 (defcustom locate-header-face nil
 185   "Face used to highlight the locate header."
 186   :type '(choice (const :tag "None" nil) face)
 187   :group 'locate)
 188
 189 ;;;###autoload
 190 (defcustom locate-ls-subdir-switches "-al"
 191   "`ls' switches for inserting subdirectories in `*Locate*' buffers.
 192 This should contain the \"-l\" switch, but not the \"-F\" or \"-b\" switches."
 193   :type 'string
 194   :group 'locate
 195   :version "22.1")
 196
 197 (defcustom locate-update-when-revert nil
 198   "This option affects how the *Locate* buffer gets reverted.
 199 If non-nil, offer to update the locate database when reverting that buffer.
 200 \(Normally, you need to have root privileges for this to work.  See the
 201 option `locate-update-path'.)
 202 If nil, reverting does not update the locate database."
 203   :type 'boolean
 204   :group 'locate
 205   :version "22.1")
 206
 207 (defcustom locate-update-command "updatedb"
 208   "The executable program used to update the locate database."
 209   :type 'string
 210   :group 'locate)
 211
 212 (defcustom locate-update-path "/"
 213   "The default directory from where `locate-update-command' is called.
 214 Usually, root permissions are required to run that command.  This
 215 can be achieved by setting this option to \"/su::\" or \"/sudo::\"
 216 \(if you have the appropriate authority).  If your current user
 217 permissions are sufficient to run the command, you can set this
 218 option to \"/\"."
 219   :type 'string
 220   :group 'locate
 221   :version "22.1")
 222
 223 (defcustom locate-prompt-for-command nil
 224   "If non-nil, the `locate' command prompts for a command to run.
 225 Otherwise, that behavior is invoked via a prefix argument.
 226
 227 Setting this option non-nil actually inverts the meaning of a prefix arg;
 228 that is, with a prefix arg, you get the default behavior."
 229   :group 'locate
 230   :type 'boolean)
 231
 232 ;; Functions
 233
 234 (defun locate-default-make-command-line (search-string)
 235   (list locate-command search-string))
 236
 237 (defun locate-word-at-point ()
 238   (let ((pt (point)))
 239     (buffer-substring-no-properties
 240      (save-excursion
 241        (skip-chars-backward "-a-zA-Z0-9.")
 242        (point))
 243      (save-excursion
 244        (skip-chars-forward "-a-zA-Z0-9.")
 245        (skip-chars-backward "." pt)
 246        (point)))))
 247
 248 ;; Function for use in interactive declarations.
 249 (defun locate-prompt-for-search-string ()
 250   (if (or (and current-prefix-arg
 251                (not locate-prompt-for-command))
 252           (and (not current-prefix-arg) locate-prompt-for-command))
 253       (let ((locate-cmd (funcall locate-make-command-line "")))
 254         (read-from-minibuffer
 255          "Run locate (like this): "
 256          (cons
 257           (concat (car locate-cmd) "  "
 258                   (mapconcat 'identity (cdr locate-cmd) " "))
 259           (+ 2 (length (car locate-cmd))))
 260          nil nil 'locate-history-list))
 261     (let* ((default (locate-word-at-point))
 262            (input
 263             (read-from-minibuffer
 264              (if  (> (length default) 0)
 265                  (format "Locate (default %s): " default)
 266                (format "Locate: "))
 267              nil nil nil 'locate-history-list default t)))
 268       (and (equal input "") default
 269            (setq input default))
 270       input)))
 271
 272 ;;;###autoload
 273 (defun locate (search-string &optional filter arg)
 274   "Run the program `locate', putting results in `*Locate*' buffer.
 275 Pass it SEARCH-STRING as argument.  Interactively, prompt for SEARCH-STRING.
 276 With prefix arg, prompt for the exact shell command to run instead.
 277
 278 This program searches for those file names in a database that match
 279 SEARCH-STRING and normally outputs all matching absolute file names,
 280 one per line.  The database normally consists of all files on your
 281 system, or of all files that you have access to.  Consult the
 282 documentation of the program for the details about how it determines
 283 which file names match SEARCH-STRING.  (Those details vary highly with
 284 the version.)
 285
 286 You can specify another program for this command to run by customizing
 287 the variables `locate-command' or `locate-make-command-line'.
 288
 289 The main use of FILTER is to implement `locate-with-filter'.  See
 290 the docstring of that function for its meaning.
 291
 292 ARG is the interactive prefix arg."
 293   (interactive
 294    (list
 295     (locate-prompt-for-search-string)
 296     nil
 297     current-prefix-arg))
 298
 299   (if (equal search-string "")
 300       (error "Please specify a filename to search for"))
 301   (let* ((locate-cmd-list (funcall locate-make-command-line search-string))
 302          (locate-cmd (car locate-cmd-list))
 303          (locate-cmd-args (cdr locate-cmd-list))
 304          (run-locate-command
 305           (or (and arg (not locate-prompt-for-command))
 306               (and (not arg) locate-prompt-for-command)))
 307          )
 308
 309     ;; Find the Locate buffer
 310     (save-window-excursion
 311       (set-buffer (get-buffer-create locate-buffer-name))
 312       (locate-mode)
 313       (let ((inhibit-read-only t)
 314             (buffer-undo-list t))
 315         (erase-buffer)
 316
 317         (setq locate-current-filter filter)
 318         (set (make-local-variable 'locate-local-search) search-string)
 319         (set (make-local-variable 'locate-local-filter) filter)
 320         (set (make-local-variable 'locate-local-prompt) run-locate-command)
 321
 322         (if run-locate-command
 323             (shell-command search-string locate-buffer-name)
 324           (apply 'call-process locate-cmd nil t nil locate-cmd-args))
 325
 326         (and filter
 327              (locate-filter-output filter))
 328
 329         (locate-do-setup search-string)
 330         ))
 331     (and (not (string-equal (buffer-name) locate-buffer-name))
 332         (switch-to-buffer-other-window locate-buffer-name))
 333
 334     (run-hooks 'dired-mode-hook)
 335     (dired-next-line 3)                 ;move to first matching file.
 336     (run-hooks 'locate-post-command-hook)
 337     )
 338   )
 339
 340 ;;;###autoload
 341 (defun locate-with-filter (search-string filter &optional arg)
 342   "Run the executable program `locate' with a filter.
 343 This function is similar to the function `locate', which see.
 344 The difference is that, when invoked interactively, the present function
 345 prompts for both SEARCH-STRING and FILTER.  It passes SEARCH-STRING
 346 to the locate executable program.  It produces a `*Locate*' buffer
 347 that lists only those lines in the output of the locate program that
 348 contain a match for the regular expression FILTER; this is often useful
 349 to constrain a big search.
 350
 351 ARG is the interactive prefix arg, which has the same effect as in `locate'.
 352
 353 When called from Lisp, this function is identical with `locate',
 354 except that FILTER is not optional."
 355   (interactive
 356    (list
 357     (locate-prompt-for-search-string)
 358     (read-from-minibuffer "Filter: " nil nil
 359                           nil 'locate-grep-history-list)
 360     current-prefix-arg))
 361   (locate search-string filter arg))
 362
 363 (defun locate-filter-output (filter)
 364   "Filter output from the locate command."
 365   (goto-char (point-min))
 366   (keep-lines filter))
 367
 368 (defvar locate-mode-map nil
 369   "Local keymap for Locate mode buffers.")
 370 (if locate-mode-map
 371     nil
 372
 373    (require 'dired)
 374
 375    (setq locate-mode-map (copy-keymap dired-mode-map))
 376
 377    ;; Undefine Useless Dired Menu bars
 378    (define-key locate-mode-map [menu-bar Dired]   'undefined)
 379    (define-key locate-mode-map [menu-bar subdir]  'undefined)
 380
 381    (define-key locate-mode-map [menu-bar mark executables] 'undefined)
 382    (define-key locate-mode-map [menu-bar mark directory]   'undefined)
 383    (define-key locate-mode-map [menu-bar mark directories] 'undefined)
 384    (define-key locate-mode-map [menu-bar mark symlinks]    'undefined)
 385
 386    (define-key locate-mode-map [M-mouse-2] 'locate-mouse-view-file)
 387    (define-key locate-mode-map "\C-c\C-t"  'locate-tags)
 388
 389    (define-key locate-mode-map "l"       'locate-do-redisplay)
 390    (define-key locate-mode-map "U"       'dired-unmark-all-files)
 391    (define-key locate-mode-map "V"       'locate-find-directory)
 392 )
 393
 394 ;; This variable is used to indent the lines and then to search for
 395 ;; the file name
 396 (defconst locate-filename-indentation 4
 397   "The amount of indentation for each file.")
 398
 399 (defun locate-get-file-positions ()
 400   "Return list of start and end of the file name on the current line.
 401 This is a list of two buffer positions.
 402
 403 You should only call this function on lines that contain a file name
 404 listed by the locate program.  Inside inserted subdirectories, or if
 405 there is no file name on the current line, the return value is
 406 meaningless.  You can check whether the current line contains a file
 407 listed by the locate program, using the function
 408 `locate-main-listing-line-p'."
 409   (save-excursion
 410     (end-of-line)
 411     (let ((eol (point)))
 412       (beginning-of-line)
 413
 414       ;; Assumes names end at the end of the line
 415       (forward-char locate-filename-indentation)
 416       (list (point) eol))))
 417
 418 ;; From SQL-mode
 419 (defun locate-current-line-number ()
 420   "Return the current line number, as an integer."
 421   (+ (count-lines (point-min) (point))
 422      (if (eq (current-column) 0)
 423          1
 424        0)))
 425
 426 ;; You should only call this function on lines that contain a file name
 427 ;; listed by the locate program.  Inside inserted subdirectories, or if
 428 ;; there is no file name on the current line, the return value is
 429 ;; meaningless.  You can check whether the current line contains a file
 430 ;; listed by the locate program, using the function
 431 ;; `locate-main-listing-line-p'.
 432 (defun locate-get-filename ()
 433   (let ((pos    (locate-get-file-positions))
 434         (lineno (locate-current-line-number)))
 435     (and (not (eq lineno 1))
 436          (not (eq lineno 2))
 437          (buffer-substring (elt pos 0) (elt pos 1)))))
 438
 439 (defun locate-main-listing-line-p ()
 440   "Return t if current line contains a file name listed by locate.
 441 This function returns nil if the current line either contains no
 442 file name or is inside a subdirectory."
 443   (save-excursion
 444     (forward-line 0)
 445     (looking-at (concat "."
 446                         (make-string (1- locate-filename-indentation) ?\s)
 447                         "\\(/\\|[A-Za-z]:\\)"))))
 448
 449 (defun locate-mouse-view-file (event)
 450   "In Locate mode, view a file, using the mouse."
 451   (interactive "@e")
 452   (save-excursion
 453     (goto-char (posn-point (event-start event)))
 454     (if (locate-main-listing-line-p)
 455         (view-file (locate-get-filename))
 456       (message "This command only works inside main listing."))))
 457
 458 ;; Define a mode for locate
 459 ;; Default directory is set to "/" so that dired commands, which
 460 ;; expect to be in a tree, will work properly
 461 (defun locate-mode ()
 462   "Major mode for the `*Locate*' buffer made by \\[locate].
 463 \\<locate-mode-map>\
 464 In that buffer, you can use almost all the usual dired bindings.
 465 \\[locate-find-directory] visits the directory of the file on the current line.
 466
 467 Operating on listed files works, but does not always
 468 automatically update the buffer as in ordinary Dired.
 469 This is true both for the main listing and for subdirectories.
 470 Reverting the buffer using \\[revert-buffer] deletes all subdirectories.
 471 Specific `locate-mode' commands, such as \\[locate-find-directory],
 472 do not work in subdirectories.
 473
 474 \\{locate-mode-map}"
 475   ;; Not to be called interactively.
 476   (kill-all-local-variables)
 477   ;; Avoid clobbering this variable
 478   (make-local-variable 'dired-subdir-alist)
 479   (use-local-map             locate-mode-map)
 480   (setq major-mode          'locate-mode
 481         mode-name           "Locate"
 482         default-directory   "/"
 483         buffer-read-only    t
 484         selective-display   t)
 485   (dired-alist-add-1 default-directory (point-min-marker))
 486   (set (make-local-variable 'dired-directory) "/")
 487   (set (make-local-variable 'dired-subdir-switches) locate-ls-subdir-switches)
 488   (setq dired-switches-alist nil)
 489   (make-local-variable 'directory-listing-before-filename-regexp)
 490   ;; This should support both Unix and Windoze style names
 491   (setq directory-listing-before-filename-regexp
 492         (concat "^."
 493                 (make-string (1- locate-filename-indentation) ?\s)
 494                 "\\(/\\|[A-Za-z]:\\)\\|"
 495                 (default-value 'directory-listing-before-filename-regexp)))
 496   (make-local-variable 'dired-actual-switches)
 497   (setq dired-actual-switches "")
 498   (make-local-variable 'dired-permission-flags-regexp)
 499   (setq dired-permission-flags-regexp
 500         (concat "^.\\("
 501                 (make-string (1- locate-filename-indentation) ?\s)
 502                 "\\)\\|"
 503                 (default-value 'dired-permission-flags-regexp)))
 504   (make-local-variable 'revert-buffer-function)
 505   (setq revert-buffer-function 'locate-update)
 506   (set (make-local-variable 'page-delimiter) "\n\n")
 507   (run-mode-hooks 'locate-mode-hook))
 508
 509 (defun locate-do-setup (search-string)
 510   (goto-char (point-min))
 511   (save-excursion
 512
 513     ;; Nothing returned from locate command?
 514     (and (eobp)
 515          (progn
 516            (kill-buffer locate-buffer-name)
 517            (if locate-current-filter
 518                (error "Locate: no match for %s in database using filter %s"
 519                       search-string locate-current-filter)
 520              (error "Locate: no match for %s in database" search-string))))
 521
 522     (locate-insert-header search-string)
 523
 524     (while (not (eobp))
 525       (insert-char ?\s locate-filename-indentation t)
 526       (locate-set-properties)
 527       (forward-line 1)))
 528   (goto-char (point-min)))
 529
 530 (defun locate-set-properties ()
 531   (save-excursion
 532     (let ((pos (locate-get-file-positions)))
 533       (dired-insert-set-properties (elt pos 0) (elt pos 1)))))
 534
 535 (defun locate-insert-header (search-string)
 536   ;; There needs to be a space before `Matches, because otherwise,
 537   ;; `*!" would erase the `M'.  We can not use two spaces, or the line
 538   ;; would mistakenly fit `dired-subdir-regexp'.
 539   (let ((locate-format-string "  /:\n Matches for %s")
 540         (locate-regexp-match
 541          (concat " *Matches for \\(" (regexp-quote search-string) "\\)"))
 542         (locate-format-args (list search-string))
 543         )
 544
 545     (and locate-fcodes-file
 546         (setq locate-format-string
 547               (concat locate-format-string " in %s")
 548               locate-regexp-match
 549               (concat locate-regexp-match
 550                       " in \\("
 551                       (regexp-quote locate-fcodes-file)
 552                       "\\)")
 553               locate-format-args
 554               (append (list locate-fcodes-file) locate-format-args)))
 555
 556     (and locate-current-filter
 557         (setq locate-format-string
 558               (concat locate-format-string " using filter %s")
 559               locate-regexp-match
 560               (concat locate-regexp-match
 561                       " using filter "
 562                       "\\("
 563                       (regexp-quote locate-current-filter)
 564                       "\\)")
 565               locate-format-args
 566               (append (list locate-current-filter) locate-format-args)))
 567
 568     (setq locate-format-string
 569           (concat locate-format-string ":\n\n")
 570           locate-regexp-match
 571           (concat locate-regexp-match ":\n"))
 572
 573     (insert (apply 'format locate-format-string (reverse locate-format-args)))
 574
 575     (save-excursion
 576       (goto-char (point-min))
 577       (forward-line 1)
 578       (if (not (looking-at locate-regexp-match))
 579           nil
 580         (add-text-properties (match-beginning 1) (match-end 1)
 581                              (list 'face locate-header-face))
 582         (and (match-beginning 2)
 583              (add-text-properties (match-beginning 2) (match-end 2)
 584                                   (list 'face locate-header-face)))
 585         (and (match-beginning 3)
 586              (add-text-properties (match-beginning 3) (match-end 3)
 587                                   (list 'face locate-header-face)))
 588         ))))
 589
 590 (defun locate-tags ()
 591   "Visit a tags table in `*Locate*' mode."
 592   (interactive)
 593   (if (locate-main-listing-line-p)
 594       (let ((tags-table (locate-get-filename)))
 595         (and (y-or-n-p (format "Visit tags table %s? " tags-table))
 596              (visit-tags-table tags-table)))
 597     (message "This command only works inside main listing.")))
 598
 599 ;; From Stephen Eglen <stephen@cns.ed.ac.uk>
 600 (defun locate-update (ignore1 ignore2)
 601   "Revert the *Locate* buffer.
 602 If `locate-update-when-revert' is non-nil, offer to update the
 603 locate database using the shell command in `locate-update-command'."
 604   (let ((locate-buffer-name (buffer-name))
 605         (locate-prompt-for-command locate-local-prompt))
 606     (and locate-update-when-revert
 607          (yes-or-no-p "Update locate database (may take a few seconds)? ")
 608          ;; `expand-file-name' is used in order to autoload Tramp if
 609          ;; necessary.  It cannot be loaded when `default-directory'
 610          ;; is remote.
 611          (let ((default-directory (expand-file-name locate-update-path)))
 612            (shell-command locate-update-command)))
 613     (locate locate-local-search locate-local-filter)))
 614
 615 ;;; Modified three functions from `dired.el':
 616 ;;;   dired-find-directory,
 617 ;;;   dired-find-directory-other-window
 618 ;;;   dired-get-filename
 619
 620 (defun locate-find-directory ()
 621   "Visit the directory of the file mentioned on this line."
 622   (interactive)
 623   (if (locate-main-listing-line-p)
 624       (let ((directory-name (locate-get-dirname)))
 625         (if (file-directory-p directory-name)
 626             (find-file directory-name)
 627           (if (file-symlink-p directory-name)
 628               (error "Directory is a symlink to a nonexistent target")
 629             (error "Directory no longer exists; run `updatedb' to update database"))))
 630     (message "This command only works inside main listing.")))
 631
 632 (defun locate-find-directory-other-window ()
 633   "Visit the directory of the file named on this line in other window."
 634   (interactive)
 635   (if (locate-main-listing-line-p)
 636       (find-file-other-window (locate-get-dirname))
 637     (message "This command only works inside main listing.")))
 638
 639 ;; You should only call this function on lines that contain a file name
 640 ;; listed by the locate program.  Inside inserted subdirectories, or if
 641 ;; there is no file name on the current line, the return value is
 642 ;; meaningless.  You can check whether the current line contains a file
 643 ;; listed by the locate program, using the function
 644 ;; `locate-main-listing-line-p'.
 645 (defun locate-get-dirname ()
 646   "Return the directory name of the file mentioned on this line."
 647   (let (file (filepos (locate-get-file-positions)))
 648     (if (setq file (buffer-substring (nth 0 filepos) (nth 1 filepos)))
 649         (progn
 650           ;; Get rid of the mouse-face property that file names have.
 651           (set-text-properties 0 (length file) nil file)
 652           (setq file (file-name-directory file))
 653           ;; Unquote names quoted by ls or by dired-insert-directory.
 654           ;; Using read to unquote is much faster than substituting
 655           ;; \007 (4 chars) -> ^G  (1 char) etc. in a lisp loop.
 656           (setq file
 657                 (read
 658                  (concat "\""
 659                          ;; some ls -b don't escape quotes, argh!
 660                          ;; This is not needed for GNU ls, though.
 661                          (or (dired-string-replace-match
 662                               "\\([^\\]\\|\\`\\)\"" file "\\1\\\\\"" nil t)
 663                              file)
 664                          "\"")))))
 665     (and file buffer-file-coding-system
 666          (not file-name-coding-system)
 667          (setq file (encode-coding-string file buffer-file-coding-system)))
 668     file))
 669
 670 ;; Only for GNU locate
 671 (defun locate-in-alternate-database  (search-string database)
 672   "Run the GNU locate command, using an alternate database."
 673   (interactive
 674       (list
 675        (progn
 676          ;; (require 'locate)
 677          (read-from-minibuffer "Locate: " nil nil
 678                                nil 'locate-history-list))
 679        (read-file-name "Locate using Database: " )
 680        ))
 681   (or (file-exists-p database)
 682       (error "Database file %s does not exist" database))
 683   (let ((locate-make-command-line
 684          (function (lambda (string)
 685                      (cons locate-command
 686                            (list (concat "--database="
 687                                          (expand-file-name database))
 688                                  string))))))
 689     (locate search-string)))
 690
 691 (defun locate-do-redisplay (&optional arg test-for-subdir)
 692   "Like `dired-do-redisplay', but adapted for `*Locate*' buffers."
 693   (interactive "P\np")
 694   (if (string= (dired-current-directory) "/")
 695       (message "This command only works in subdirectories.")
 696     (let ((dired-actual-switches locate-ls-subdir-switches))
 697       (dired-do-redisplay arg test-for-subdir))))
 698
 699 (provide 'locate)
 700
 701 ;;; arch-tag: 60c4d098-b5d5-4b3c-a3e0-51a2e9f43898
 702 ;;; locate.el ends here