locate.el 19.7 KB
Newer Older
Richard M. Stallman's avatar
Richard M. Stallman committed
1
;;; locate.el --- interface to the locate command
Richard M. Stallman's avatar
Richard M. Stallman committed
2

3 4
;; Copyright (C) 1996, 1998, 2001, 2002, 2003, 2004,
;;   2005 Free Software Foundation, Inc.
Richard M. Stallman's avatar
Richard M. Stallman committed
5

6
;; Author: Peter Breton <pbreton@cs.umb.edu>
Dave Love's avatar
Dave Love committed
7
;; Keywords: unix files
Richard M. Stallman's avatar
Richard M. Stallman committed
8 9 10 11 12 13 14 15 16 17 18 19 20 21 22

;; This file is part of GNU Emacs.

;; GNU Emacs is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 2, or (at your option)
;; any later version.

;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.

;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING.  If not, write to the
Lute Kamstra's avatar
Lute Kamstra committed
23 24
;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
;; Boston, MA 02110-1301, USA.
Richard M. Stallman's avatar
Richard M. Stallman committed
25 26 27

;;; Commentary:

28
;; Search a database of files and use dired commands on the result.
Richard M. Stallman's avatar
Richard M. Stallman committed
29 30 31 32 33 34 35
;;
;; Locate.el provides an interface to a program which searches a
;; database of file names. By default, this program is the GNU locate
;; command, but it could also be the BSD-style find command, or even a
;; user specified command.
;;
;; To use the BSD-style "fast find", or any other shell command of the
36
;; form
Richard M. Stallman's avatar
Richard M. Stallman committed
37 38 39
;;
;;   SHELLPROGRAM  Name-to-find
;;
40
;; set the variable `locate-command' in your .emacs file.
Richard M. Stallman's avatar
Richard M. Stallman committed
41
;;
42
;;   To use a more complicated expression, create a function which
43 44 45
;; takes a string (the name to find) as input and returns a list.
;; The first element should be the command to be executed, the remaining
;; elements should be the arguments (including the name to find). Then put
Richard M. Stallman's avatar
Richard M. Stallman committed
46
;;
47
;; (setq locate-make-command-line 'my-locate-command-line)
Richard M. Stallman's avatar
Richard M. Stallman committed
48 49
;;
;; in your .emacs, using the name of your function in place of
50
;; my-locate-command-line.
Richard M. Stallman's avatar
Richard M. Stallman committed
51 52 53 54 55
;;
;; You should make sure that whichever command you use works correctly
;; from a shell prompt. GNU locate and BSD find expect the file databases
;; to either be in standard places or located via environment variables.
;; If the latter, make sure these environment variables are set in
56
;; your emacs process.
Richard M. Stallman's avatar
Richard M. Stallman committed
57 58 59 60
;;
;; Locate-mode assumes that each line output from the locate-command
;; consists exactly of a file name, possibly preceded or trailed by
;; 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
Richard M. Stallman's avatar
Richard M. Stallman committed
63 64 65 66 67 68 69 70 71
;; character in the file name and the last character in the file name.
;;
;; To use locate-mode, simply type M-x locate and then the string
;; you wish to find. You can use almost all of the dired commands in
;; the resulting *Locate* buffer.  It is worth noting that your commands
;; do not, of course, affect the file database. For example, if you
;; compress a file in the locate buffer, the actual file will be
;; compressed, but the entry in the file database will not be
;; affected. Consequently, the database and the filesystem will be out
72
;; of sync until the next time the database is updated.
Richard M. Stallman's avatar
Richard M. Stallman committed
73
;;
74
;; The command `locate-with-filter' keeps only lines matching a
Richard M. Stallman's avatar
Richard M. Stallman committed
75 76
;; regular expression; this is often useful to constrain a big search.
;;
77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108

;;;;; Building a database of files ;;;;;;;;;
;;
;; You can create a simple files database with a port of the Unix find command
;; and one of the various Windows NT various scheduling utilities,
;; for example the AT command from the NT Resource Kit, WinCron which is
;; included with Microsoft FrontPage, or the shareware NTCron program.
;;
;; To set up a function which searches the files database, do something
;; like this:
;;
;; (defvar locate-fcodes-file       "c:/users/peter/fcodes")
;; (defvar locate-make-command-line 'nt-locate-make-command-line)
;;
;; (defun nt-locate-make-command-line (arg)
;;  (list "grep" "-i" arg locate-fcodes-file))
;;
;;;;;;;; ADVICE For dired-make-relative: ;;;;;;;;;
;;
;; For certain dired commands to work right, you should also include the
;; following in your _emacs/.emacs:
;;
;; (defadvice dired-make-relative (before set-no-error activate)
;;   "For locate mode and Windows, don't return errors"
;;   (if (and (eq   major-mode  'locate-mode)
;; 	   (memq system-type (list 'windows-nt 'ms-dos)))
;;       (ad-set-arg 2 t)
;;     ))
;;
;; Otherwise, `dired-make-relative' will give error messages like
;; "FILENAME: not in directory tree growing at /"

Richard M. Stallman's avatar
Richard M. Stallman committed
109 110 111 112 113 114 115 116

;;; Code:

(eval-when-compile
  (require 'dired))

;; Variables

117 118
(defvar locate-current-filter nil)

Stephen Eglen's avatar
Stephen Eglen committed
119 120 121 122
(defgroup locate nil
  "Interface to the locate command."
  :prefix "locate-"
  :group 'external)
Richard M. Stallman's avatar
Richard M. Stallman committed
123

Stephen Eglen's avatar
Stephen Eglen committed
124 125 126 127
(defcustom locate-command "locate"
  "*The executable program used to search a database of files."
  :type 'string
  :group 'locate)
Richard M. Stallman's avatar
Richard M. Stallman committed
128

Stephen Eglen's avatar
Stephen Eglen committed
129 130
(defvar locate-history-list nil
  "The history list used by the \\[locate] command.")
Richard M. Stallman's avatar
Richard M. Stallman committed
131

132 133 134
(defvar locate-grep-history-list nil
  "The history list used by the \\[locate-with-filter] command.")

Stephen Eglen's avatar
Stephen Eglen committed
135 136 137 138 139 140 141 142 143 144 145
(defcustom locate-make-command-line 'locate-default-make-command-line
  "*Function used to create the locate command line."
  :type 'function
  :group 'locate)

(defcustom locate-buffer-name "*Locate*"
  "*Name of the buffer to show results from the \\[locate] command."
  :type 'string
  :group 'locate)

(defcustom locate-fcodes-file nil
146 147
  "*File name for the database of file names."
  :type '(choice file (const nil))
Stephen Eglen's avatar
Stephen Eglen committed
148 149
  :group 'locate)

150
(defcustom locate-header-face nil
Stephen Eglen's avatar
Stephen Eglen committed
151
  "*Face used to highlight the locate header."
152
  :type '(choice face (const nil))
Stephen Eglen's avatar
Stephen Eglen committed
153
  :group 'locate)
Richard M. Stallman's avatar
Richard M. Stallman committed
154

155 156 157
;;;###autoload
(defcustom locate-ls-subdir-switches "-al"
  "`ls' switches for inserting subdirectories in `*Locate*' buffers.
158
This should contain the \"-l\" switch, but not the \"-F\" or \"-b\" switches."
159 160
  :type 'string
  :group 'locate
161
  :version "22.1")
162

163 164 165 166
(defcustom locate-update-command "updatedb"
  "The command used to update the locate database."
  :type 'string
  :group 'locate)
Richard M. Stallman's avatar
Richard M. Stallman committed
167

168
(defcustom locate-prompt-for-command nil
169
  "If non-nil, the locate command prompts for a command to run.
170 171 172 173 174
Otherwise, that behavior is invoked via a prefix argument."
  :group 'locate
  :type 'boolean
  )

Richard M. Stallman's avatar
Richard M. Stallman committed
175 176 177
;; Functions

(defun locate-default-make-command-line (search-string)
178
  (list locate-command search-string))
Richard M. Stallman's avatar
Richard M. Stallman committed
179

180 181 182 183 184 185 186 187 188 189 190
(defun locate-word-at-point ()
  (let ((pt (point)))
    (buffer-substring-no-properties
     (save-excursion
       (skip-chars-backward "-a-zA-Z0-9.")
       (point))
     (save-excursion
       (skip-chars-forward "-a-zA-Z0-9.")
       (skip-chars-backward "." pt)
       (point)))))

Dan Nicolaescu's avatar
Dan Nicolaescu committed
191
;;;###autoload
192
(defun locate (search-string &optional filter)
193 194
  "Run the program `locate', putting results in `*Locate*' buffer.
With prefix arg, prompt for the locate command to run."
Richard M. Stallman's avatar
Richard M. Stallman committed
195
  (interactive
196
      (list
197 198
       (if (or (and current-prefix-arg
		    (not locate-prompt-for-command))
199
	       (and (not current-prefix-arg) locate-prompt-for-command))
200 201 202 203 204 205 206 207
	   (let ((locate-cmd (funcall locate-make-command-line "")))
	     (read-from-minibuffer
	      "Run locate (like this): "
	      (cons
	       (concat (car locate-cmd) "  "
		       (mapconcat 'identity (cdr locate-cmd) " "))
		       (+ 2 (length (car locate-cmd))))
	      nil nil 'locate-history-list))
208
	 (let* ((default (locate-word-at-point))
209
	       (input
210 211
		(read-from-minibuffer
		 (if  (> (length default) 0)
212
		     (format "Locate (default %s): " default)
213 214 215 216 217 218
		   (format "Locate: "))
		 nil nil nil 'locate-history-list default t)))
	       (and (equal input "") default
		    (setq input default))
	       input))))
  (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))
Richard M. Stallman's avatar
Richard M. Stallman committed
221 222
	 (locate-cmd (car locate-cmd-list))
	 (locate-cmd-args (cdr locate-cmd-list))
223
	 (run-locate-command
224 225
	  (or (and current-prefix-arg (not locate-prompt-for-command))
	      (and (not current-prefix-arg) locate-prompt-for-command)))
226
	 )
227

Richard M. Stallman's avatar
Richard M. Stallman committed
228
    ;; Find the Locate buffer
229 230 231
    (save-window-excursion
      (set-buffer (get-buffer-create locate-buffer-name))
      (locate-mode)
232 233
      (let ((inhibit-read-only t)
	    (buffer-undo-list t))
234
	(erase-buffer)
235

236
	(setq locate-current-filter filter)
237

238 239 240
	(if run-locate-command
	    (shell-command search-string locate-buffer-name)
	  (apply 'call-process locate-cmd nil t nil locate-cmd-args))
241

242 243
	(and filter
	     (locate-filter-output filter))
Richard M. Stallman's avatar
Richard M. Stallman committed
244

245 246
	(locate-do-setup search-string)
	))
247 248
    (and (not (string-equal (buffer-name) locate-buffer-name))
	(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
    )
  )
Richard M. Stallman's avatar
Richard M. Stallman committed
255

Dan Nicolaescu's avatar
Dan Nicolaescu committed
256
;;;###autoload
Richard M. Stallman's avatar
Richard M. Stallman committed
257
(defun locate-with-filter (search-string filter)
258 259 260 261
  "Run the locate command with a filter.

The filter is a regular expression. Only results matching the filter are
shown; this is often useful to constrain a big search."
Richard M. Stallman's avatar
Richard M. Stallman committed
262
  (interactive
263 264 265
   (list (read-from-minibuffer "Locate: " nil nil
			       nil 'locate-history-list)
	 (read-from-minibuffer "Filter: " nil nil
266
			       nil 'locate-grep-history-list)))
267
  (locate search-string filter))
Richard M. Stallman's avatar
Richard M. Stallman committed
268 269 270 271

(defun locate-filter-output (filter)
  "Filter output from the locate command."
  (goto-char (point-min))
272
  (delete-non-matching-lines filter))
Richard M. Stallman's avatar
Richard M. Stallman committed
273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291

(defvar locate-mode-map nil
  "Local keymap for Locate mode buffers.")
(if locate-mode-map
    nil

   (require 'dired)

   (setq locate-mode-map (copy-keymap dired-mode-map))

   ;; Undefine Useless Dired Menu bars
   (define-key locate-mode-map [menu-bar Dired]   'undefined)
   (define-key locate-mode-map [menu-bar subdir]  'undefined)

   (define-key locate-mode-map [menu-bar mark executables] 'undefined)
   (define-key locate-mode-map [menu-bar mark directory]   'undefined)
   (define-key locate-mode-map [menu-bar mark directories] 'undefined)
   (define-key locate-mode-map [menu-bar mark symlinks]    'undefined)

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)
Richard M. Stallman's avatar
Richard M. Stallman committed
294

295
   (define-key locate-mode-map "l"       'locate-do-redisplay)
296 297
   (define-key locate-mode-map "U"       'dired-unmark-all-files)
   (define-key locate-mode-map "V"       'locate-find-directory)
Richard M. Stallman's avatar
Richard M. Stallman committed
298 299 300 301 302
)

;; This variable is used to indent the lines and then to search for
;; the file name
(defconst locate-filename-indentation 4
303
  "The amount of indentation for each file.")
Richard M. Stallman's avatar
Richard M. Stallman committed
304 305 306

(defun locate-get-file-positions ()
  (save-excursion
307 308 309
    (end-of-line)
    (let ((eol (point)))
      (beginning-of-line)
310

311 312 313
      ;; Assumes names end at the end of the line
      (forward-char locate-filename-indentation)
      (list (point) eol))))
Richard M. Stallman's avatar
Richard M. Stallman committed
314 315

;; From SQL-mode
316
(defun locate-current-line-number ()
Richard M. Stallman's avatar
Richard M. Stallman committed
317 318 319 320 321 322 323 324
  "Return the current line number, as an integer."
  (+ (count-lines (point-min) (point))
     (if (eq (current-column) 0)
	 1
       0)))

(defun locate-get-filename ()
  (let ((pos    (locate-get-file-positions))
325
	(lineno (locate-current-line-number)))
326 327
    (and (not (eq lineno 1))
	 (not (eq lineno 2))
Richard M. Stallman's avatar
Richard M. Stallman committed
328 329
	 (buffer-substring (elt pos 0) (elt pos 1)))))

330 331 332 333 334 335 336 337 338 339
(defun locate-main-listing-line-p ()
  "Return t if current line contains a file name listed by locate.
This function returns nil if the current line either contains no
file name or is inside a subdirectory."
  (save-excursion
    (forward-line 0)
    (looking-at (concat "."
			(make-string (1- locate-filename-indentation) ?\ )
			"\\(/\\|[A-Za-z]:\\)"))))

340
(defun locate-mouse-view-file (event)
Richard M. Stallman's avatar
Richard M. Stallman committed
341
  "In Locate mode, view a file, using the mouse."
342
  (interactive "@e")
Richard M. Stallman's avatar
Richard M. Stallman committed
343 344
  (save-excursion
    (goto-char (posn-point (event-start event)))
345 346 347
    (if (locate-main-listing-line-p)
	(view-file (locate-get-filename))
      (message "This command only works inside main listing."))))
Richard M. Stallman's avatar
Richard M. Stallman committed
348 349 350 351 352

;; Define a mode for locate
;; Default directory is set to "/" so that dired commands, which
;; expect to be in a tree, will work properly
(defun locate-mode ()
353
  "Major mode for the `*Locate*' buffer made by \\[locate].
354
\\<locate-mode-map>\
355 356 357
In that buffer, you can use almost all the usual dired bindings.
\\[locate-find-directory] visits the directory of the file on the current line.

358 359 360 361 362 363 364
Operating on listed files works, but does not always
automatically update the buffer as in ordinary Dired.
This is true both for the main listing and for subdirectories.
Reverting the buffer using \\[revert-buffer] deletes all subdirectories.
Specific `locate-mode' commands, such as \\[locate-find-directory],
do not work in subdirectories.

365
\\{locate-mode-map}"
366
  ;; Not to be called interactively.
Richard M. Stallman's avatar
Richard M. Stallman committed
367
  (kill-all-local-variables)
368
  ;; Avoid clobbering this variable
369
  (make-local-variable 'dired-subdir-alist)
Richard M. Stallman's avatar
Richard M. Stallman committed
370 371 372
  (use-local-map             locate-mode-map)
  (setq major-mode          'locate-mode
        mode-name           "Locate"
373 374 375
        default-directory   "/"
	buffer-read-only    t
	selective-display   t)
376
  (dired-alist-add-1 default-directory (point-min-marker))
377 378 379
  (set (make-local-variable 'dired-directory) "/")
  (set (make-local-variable 'dired-subdir-switches) locate-ls-subdir-switches)
  (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 388 389
  (make-local-variable 'dired-actual-switches)
  (setq dired-actual-switches "")
  (make-local-variable 'dired-permission-flags-regexp)
390 391 392
  (setq dired-permission-flags-regexp
	(concat "^.\\("
		(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))
Richard M. Stallman's avatar
Richard M. Stallman committed
399

400 401 402
(defun locate-do-setup (search-string)
  (goto-char (point-min))
  (save-excursion
403

404 405 406 407 408 409 410 411
    ;; Nothing returned from locate command?
    (and (eobp)
	 (progn
	   (kill-buffer locate-buffer-name)
	   (if locate-current-filter
	       (error "Locate: no match for %s in database using filter %s"
		      search-string locate-current-filter)
	     (error "Locate: no match for %s in database" search-string))))
412

413
    (locate-insert-header search-string)
414

415 416 417 418 419
    (while (not (eobp))
      (insert-char ?\  locate-filename-indentation t)
      (locate-set-properties)
      (forward-line 1)))
  (goto-char (point-min)))
Richard M. Stallman's avatar
Richard M. Stallman committed
420 421 422 423

(defun locate-set-properties ()
  (save-excursion
    (let ((pos (locate-get-file-positions)))
424
      (dired-insert-set-properties (elt pos 0) (elt pos 1)))))
Richard M. Stallman's avatar
Richard M. Stallman committed
425 426

(defun locate-insert-header (search-string)
427 428 429 430
  ;; There needs to be a space before `Matches, because otherwise,
  ;; `*!" would erase the `M'.  We can not use two spaces, or the line
  ;; would mistakenly fit `dired-subdir-regexp'.
  (let ((locate-format-string "  /:\n Matches for %s")
Richard M. Stallman's avatar
Richard M. Stallman committed
431 432 433 434
	(locate-regexp-match
	 (concat " *Matches for \\(" (regexp-quote search-string) "\\)"))
	(locate-format-args (list search-string))
	)
435

436
    (and locate-fcodes-file
Richard M. Stallman's avatar
Richard M. Stallman committed
437 438 439 440 441 442 443 444 445 446
	(setq locate-format-string
	      (concat locate-format-string " in %s")
	      locate-regexp-match
	      (concat locate-regexp-match
		      " in \\("
		      (regexp-quote locate-fcodes-file)
		      "\\)")
	      locate-format-args
	      (append (list locate-fcodes-file) locate-format-args)))

447
    (and locate-current-filter
Richard M. Stallman's avatar
Richard M. Stallman committed
448 449 450 451 452 453 454 455 456 457
	(setq locate-format-string
	      (concat locate-format-string " using filter %s")
	      locate-regexp-match
	      (concat locate-regexp-match
		      " using filter "
		      "\\("
		      (regexp-quote locate-current-filter)
		      "\\)")
	      locate-format-args
	      (append (list locate-current-filter) locate-format-args)))
458

Richard M. Stallman's avatar
Richard M. Stallman committed
459
    (setq locate-format-string
460
	  (concat locate-format-string ":\n\n")
Richard M. Stallman's avatar
Richard M. Stallman committed
461
	  locate-regexp-match
462
	  (concat locate-regexp-match ":\n"))
463

464
    (insert (apply 'format locate-format-string (reverse locate-format-args)))
465

Richard M. Stallman's avatar
Richard M. Stallman committed
466 467
    (save-excursion
      (goto-char (point-min))
468
      (forward-line 1)
Richard M. Stallman's avatar
Richard M. Stallman committed
469 470 471 472 473 474 475 476 477 478 479 480 481 482 483
      (if (not (looking-at locate-regexp-match))
	  nil
	(add-text-properties (match-beginning 1) (match-end 1)
			     (list 'face locate-header-face))
	(and (match-beginning 2)
	     (add-text-properties (match-beginning 2) (match-end 2)
				  (list 'face locate-header-face)))
	(and (match-beginning 3)
	     (add-text-properties (match-beginning 3) (match-end 3)
				  (list 'face locate-header-face)))
	))))

(defun locate-tags ()
  "Visit a tags table in `*Locate*' mode."
  (interactive)
484 485 486 487 488
  (if (locate-main-listing-line-p)
      (let ((tags-table (locate-get-filename)))
	(and (y-or-n-p (format "Visit tags table %s? " tags-table))
	     (visit-tags-table tags-table)))
    (message "This command only works inside main listing.")))
489 490 491 492 493 494 495 496

;; From Stephen Eglen <stephen@cns.ed.ac.uk>
(defun locate-update (ignore1 ignore2)
  "Update the locate database.
Database is updated using the shell command in `locate-update-command'."
  (let ((str (car locate-history-list)))
    (cond ((yes-or-no-p "Update locate database (may take a few seconds)? ")
	   (shell-command locate-update-command)
497
	   (locate str)))))
498 499 500 501 502 503 504 505 506

;;; Modified three functions from `dired.el':
;;;   dired-find-directory,
;;;   dired-find-directory-other-window
;;;   dired-get-filename

(defun locate-find-directory ()
  "Visit the directory of the file mentioned on this line."
  (interactive)
507 508 509 510 511 512 513 514
  (if (locate-main-listing-line-p)
      (let ((directory-name (locate-get-dirname)))
	(if (file-directory-p directory-name)
	    (find-file directory-name)
	  (if (file-symlink-p directory-name)
	      (error "Directory is a symlink to a nonexistent target")
	    (error "Directory no longer exists; run `updatedb' to update database"))))
    (message "This command only works inside main listing.")))
515 516 517 518 519 520 521 522 523 524 525 526 527 528 529 530 531 532 533 534 535 536 537 538 539 540 541 542 543 544 545 546 547 548 549 550 551 552 553 554 555 556 557 558 559 560 561 562 563 564

(defun locate-find-directory-other-window ()
  "Visit the directory of the file named on this line in other window."
  (interactive)
  (find-file-other-window (locate-get-dirname)))

(defun locate-get-dirname ()
  "Return the directory name of the file mentioned on this line."
  (let (file (filepos (locate-get-file-positions)))
    (if (setq file (buffer-substring (nth 0 filepos) (nth 1 filepos)))
	(progn
	  ;; Get rid of the mouse-face property that file names have.
	  (set-text-properties 0 (length file) nil file)
	  (setq file (file-name-directory file))
	  ;; Unquote names quoted by ls or by dired-insert-directory.
	  ;; Using read to unquote is much faster than substituting
	  ;; \007 (4 chars) -> ^G  (1 char) etc. in a lisp loop.
	  (setq file
		(read
		 (concat "\""
			 ;; some ls -b don't escape quotes, argh!
			 ;; This is not needed for GNU ls, though.
			 (or (dired-string-replace-match
			      "\\([^\\]\\|\\`\\)\"" file "\\1\\\\\"" nil t)
			     file)
			 "\"")))))
    (and file buffer-file-coding-system
	 (not file-name-coding-system)
	 (setq file (encode-coding-string file buffer-file-coding-system)))
    file))

;; Only for GNU locate
(defun locate-in-alternate-database  (search-string database)
  "Run the GNU locate command, using an alternate database."
  (interactive
      (list
       (progn
	 ;; (require 'locate)
	 (read-from-minibuffer "Locate: " nil nil
			       nil 'locate-history-list))
       (read-file-name "Locate using Database: " )
       ))
  (or (file-exists-p database)
      (error "Database file %s does not exist" database))
  (let ((locate-make-command-line
	 (function (lambda (string)
		     (cons locate-command
			   (list (concat "--database="
					 (expand-file-name database))
				 string))))))
565
    (locate search-string)))
Richard M. Stallman's avatar
Richard M. Stallman committed
566

567 568 569 570 571 572 573 574
(defun locate-do-redisplay (&optional arg test-for-subdir)
  "Like `dired-do-redisplay', but adapted for `*Locate*' buffers."
  (interactive "P\np")
  (if (string= (dired-current-directory) "/")
      (message "This command only works in subdirectories.")
    (let ((dired-actual-switches locate-ls-subdir-switches))
      (dired-do-redisplay arg test-for-subdir))))

Richard M. Stallman's avatar
Richard M. Stallman committed
575 576
(provide 'locate)

Miles Bader's avatar
Miles Bader committed
577
;;; arch-tag: 60c4d098-b5d5-4b3c-a3e0-51a2e9f43898
Richard M. Stallman's avatar
Richard M. Stallman committed
578
;;; locate.el ends here