Add 2011 to FSF/AIST copyright years.
[bpt/emacs.git] / lisp / locate.el
CommitLineData
092af6d8 1;;; locate.el --- interface to the locate command
6aea3b07 2
dccbf237 3;; Copyright (C) 1996, 1998, 2001, 2002, 2003, 2004, 2005, 2006, 2007,
5df4f04c 4;; 2008, 2009, 2010, 2011 Free Software Foundation, Inc.
6aea3b07 5
dc268724 6;; Author: Peter Breton <pbreton@cs.umb.edu>
f947a7fa 7;; Keywords: unix files
6aea3b07
RS
8
9;; This file is part of GNU Emacs.
10
eb3fa2cf 11;; GNU Emacs is free software: you can redistribute it and/or modify
6aea3b07 12;; it under the terms of the GNU General Public License as published by
eb3fa2cf
GM
13;; the Free Software Foundation, either version 3 of the License, or
14;; (at your option) any later version.
6aea3b07
RS
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
eb3fa2cf 22;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
6aea3b07
RS
23
24;;; Commentary:
25
271a87e8 26;; Search a database of files and use dired commands on the result.
6aea3b07
RS
27;;
28;; Locate.el provides an interface to a program which searches a
29;; database of file names. By default, this program is the GNU locate
30;; command, but it could also be the BSD-style find command, or even a
31;; user specified command.
32;;
33;; To use the BSD-style "fast find", or any other shell command of the
83346ee8 34;; form
6aea3b07
RS
35;;
36;; SHELLPROGRAM Name-to-find
37;;
be8bf2d0 38;; set the variable `locate-command' in your .emacs file.
6aea3b07 39;;
83346ee8 40;; To use a more complicated expression, create a function which
be8bf2d0
RS
41;; takes a string (the name to find) as input and returns a list.
42;; The first element should be the command to be executed, the remaining
43;; elements should be the arguments (including the name to find). Then put
6aea3b07 44;;
83346ee8 45;; (setq locate-make-command-line 'my-locate-command-line)
6aea3b07
RS
46;;
47;; in your .emacs, using the name of your function in place of
be8bf2d0 48;; my-locate-command-line.
6aea3b07
RS
49;;
50;; You should make sure that whichever command you use works correctly
51;; from a shell prompt. GNU locate and BSD find expect the file databases
52;; to either be in standard places or located via environment variables.
53;; If the latter, make sure these environment variables are set in
be8bf2d0 54;; your emacs process.
6aea3b07
RS
55;;
56;; Locate-mode assumes that each line output from the locate-command
57;; consists exactly of a file name, possibly preceded or trailed by
58;; whitespace. If your file database has other information on the line (for
83346ee8 59;; example, the file size), you will need to redefine the function
be8bf2d0 60;; `locate-get-file-positions' to return a list consisting of the first
6aea3b07
RS
61;; character in the file name and the last character in the file name.
62;;
63;; To use locate-mode, simply type M-x locate and then the string
64;; you wish to find. You can use almost all of the dired commands in
65;; the resulting *Locate* buffer. It is worth noting that your commands
66;; do not, of course, affect the file database. For example, if you
67;; compress a file in the locate buffer, the actual file will be
68;; compressed, but the entry in the file database will not be
69;; affected. Consequently, the database and the filesystem will be out
be8bf2d0 70;; of sync until the next time the database is updated.
6aea3b07 71;;
be8bf2d0 72;; The command `locate-with-filter' keeps only lines matching a
6aea3b07
RS
73;; regular expression; this is often useful to constrain a big search.
74;;
75\f
271a87e8
LT
76;;;;; Building a database of files ;;;;;;;;;
77;;
78;; You can create a simple files database with a port of the Unix find command
79;; and one of the various Windows NT various scheduling utilities,
80;; for example the AT command from the NT Resource Kit, WinCron which is
81;; included with Microsoft FrontPage, or the shareware NTCron program.
82;;
83;; To set up a function which searches the files database, do something
84;; like this:
85;;
86;; (defvar locate-fcodes-file "c:/users/peter/fcodes")
87;; (defvar locate-make-command-line 'nt-locate-make-command-line)
88;;
89;; (defun nt-locate-make-command-line (arg)
90;; (list "grep" "-i" arg locate-fcodes-file))
91;;
92;;;;;;;; ADVICE For dired-make-relative: ;;;;;;;;;
93;;
94;; For certain dired commands to work right, you should also include the
95;; following in your _emacs/.emacs:
96;;
97;; (defadvice dired-make-relative (before set-no-error activate)
98;; "For locate mode and Windows, don't return errors"
99;; (if (and (eq major-mode 'locate-mode)
100;; (memq system-type (list 'windows-nt 'ms-dos)))
101;; (ad-set-arg 2 t)
102;; ))
103;;
104;; Otherwise, `dired-make-relative' will give error messages like
105;; "FILENAME: not in directory tree growing at /"
106
107\f
6aea3b07
RS
108;;; Code:
109
dccbf237 110(require 'dired)
6aea3b07
RS
111
112;; Variables
6aea3b07 113
be8bf2d0 114(defvar locate-current-filter nil)
1f8330fb
CY
115(defvar locate-local-filter nil)
116(defvar locate-local-search nil)
7861843e 117(defvar locate-local-prompt nil)
be8bf2d0 118
d979dc2b
SE
119(defgroup locate nil
120 "Interface to the locate command."
121 :prefix "locate-"
122 :group 'external)
6aea3b07 123
d979dc2b 124(defcustom locate-command "locate"
18886d54
LT
125 "Executable program for searching a database of files.
126The Emacs commands `locate' and `locate-with-filter' use this.
127The value should be a program that can be called from a shell
128with one argument, SEARCH-STRING. The program determines which
129database it searches. The output of the program should consist
130of those file names in the database that match SEARCH-STRING,
131listed one per line, possibly with leading or trailing
132whitespace. If the output is in another form, you may have to
133redefine the function `locate-get-file-positions'.
134
135The program may interpret SEARCH-STRING as a literal string, a
136shell pattern or a regular expression. The exact rules of what
137constitutes a match may also depend on the program.
138
139The standard value of this variable is \"locate\".
140This program normally searches a database of all files on your
141system, or of all files that you have access to. Consult the
142documentation of that program for the details about how it determines
143which file names match SEARCH-STRING. (Those details vary highly with
144the version.)"
d979dc2b
SE
145 :type 'string
146 :group 'locate)
6aea3b07 147
d1882ac7
EW
148(defcustom locate-post-command-hook nil
149 "List of hook functions run after `locate' (see `run-hooks')."
150 :type 'hook
151 :group 'locate)
152
d979dc2b
SE
153(defvar locate-history-list nil
154 "The history list used by the \\[locate] command.")
6aea3b07 155
83346ee8
PB
156(defvar locate-grep-history-list nil
157 "The history list used by the \\[locate-with-filter] command.")
158
d979dc2b 159(defcustom locate-make-command-line 'locate-default-make-command-line
18886d54
LT
160 "Function used to create the locate command line.
161The Emacs commands `locate' and `locate-with-filter' use this.
162This function should take one argument, a string (the name to find)
163and return a list of strings. The first element of the list should be
164the name of a command to be executed by a shell, the remaining elements
165should be the arguments to that command (including the name to find)."
d979dc2b
SE
166 :type 'function
167 :group 'locate)
168
169(defcustom locate-buffer-name "*Locate*"
18886d54 170 "Name of the buffer to show results from the \\[locate] command."
d979dc2b
SE
171 :type 'string
172 :group 'locate)
173
174(defcustom locate-fcodes-file nil
18886d54
LT
175 "File name for the database of file names used by `locate'.
176If non-nil, `locate' uses this name in the header of the `*Locate*'
177buffer. If nil, it mentions no file name in that header.
178
179Just setting this variable does not actually change the database
180that `locate' searches. The executive program that the Emacs
181function `locate' uses, as given by the variables `locate-command'
182or `locate-make-command-line', determines the database."
e0063bf6 183 :type '(choice (const :tag "None" nil) file)
d979dc2b
SE
184 :group 'locate)
185
83346ee8 186(defcustom locate-header-face nil
18886d54 187 "Face used to highlight the locate header."
e0063bf6 188 :type '(choice (const :tag "None" nil) face)
d979dc2b 189 :group 'locate)
6aea3b07 190
271a87e8 191;;;###autoload
6bdad9ae 192(defcustom locate-ls-subdir-switches (purecopy "-al")
271a87e8 193 "`ls' switches for inserting subdirectories in `*Locate*' buffers.
34bb9b0a 194This should contain the \"-l\" switch, but not the \"-F\" or \"-b\" switches."
271a87e8
LT
195 :type 'string
196 :group 'locate
bf247b6e 197 :version "22.1")
271a87e8 198
e8fc997c
LT
199(defcustom locate-update-when-revert nil
200 "This option affects how the *Locate* buffer gets reverted.
201If non-nil, offer to update the locate database when reverting that buffer.
202\(Normally, you need to have root privileges for this to work. See the
203option `locate-update-path'.)
204If nil, reverting does not update the locate database."
205 :type 'boolean
206 :group 'locate
207 :version "22.1")
208
be8bf2d0 209(defcustom locate-update-command "updatedb"
18886d54 210 "The executable program used to update the locate database."
be8bf2d0
RS
211 :type 'string
212 :group 'locate)
6aea3b07 213
e8fc997c
LT
214(defcustom locate-update-path "/"
215 "The default directory from where `locate-update-command' is called.
216Usually, root permissions are required to run that command. This
217can be achieved by setting this option to \"/su::\" or \"/sudo::\"
218\(if you have the appropriate authority). If your current user
219permissions are sufficient to run the command, you can set this
220option to \"/\"."
221 :type 'string
222 :group 'locate
223 :version "22.1")
224
83346ee8 225(defcustom locate-prompt-for-command nil
18886d54 226 "If non-nil, the `locate' command prompts for a command to run.
7861843e
CY
227Otherwise, that behavior is invoked via a prefix argument.
228
229Setting this option non-nil actually inverts the meaning of a prefix arg;
230that is, with a prefix arg, you get the default behavior."
83346ee8 231 :group 'locate
e8fc997c 232 :type 'boolean)
83346ee8 233
d1882ac7
EW
234(defcustom locate-mode-hook nil
235 "List of hook functions run by `locate-mode' (see `run-mode-hooks')."
236 :type 'hook
237 :group 'locate)
238
6aea3b07
RS
239;; Functions
240
241(defun locate-default-make-command-line (search-string)
be8bf2d0 242 (list locate-command search-string))
6aea3b07 243
96c1776c
PB
244(defun locate-word-at-point ()
245 (let ((pt (point)))
246 (buffer-substring-no-properties
247 (save-excursion
248 (skip-chars-backward "-a-zA-Z0-9.")
249 (point))
250 (save-excursion
251 (skip-chars-forward "-a-zA-Z0-9.")
252 (skip-chars-backward "." pt)
253 (point)))))
254
20bf672e 255;; Function for use in interactive declarations.
7861843e
CY
256(defun locate-prompt-for-search-string ()
257 (if (or (and current-prefix-arg
258 (not locate-prompt-for-command))
259 (and (not current-prefix-arg) locate-prompt-for-command))
260 (let ((locate-cmd (funcall locate-make-command-line "")))
261 (read-from-minibuffer
262 "Run locate (like this): "
263 (cons
264 (concat (car locate-cmd) " "
265 (mapconcat 'identity (cdr locate-cmd) " "))
266 (+ 2 (length (car locate-cmd))))
267 nil nil 'locate-history-list))
268 (let* ((default (locate-word-at-point))
269 (input
270 (read-from-minibuffer
271 (if (> (length default) 0)
272 (format "Locate (default %s): " default)
273 (format "Locate: "))
274 nil nil nil 'locate-history-list default t)))
275 (and (equal input "") default
276 (setq input default))
277 input)))
278
1d96c2ff 279;;;###autoload
7861843e 280(defun locate (search-string &optional filter arg)
83346ee8 281 "Run the program `locate', putting results in `*Locate*' buffer.
18886d54 282Pass it SEARCH-STRING as argument. Interactively, prompt for SEARCH-STRING.
cb5e49a3 283With prefix arg ARG, prompt for the exact shell command to run instead.
18886d54
LT
284
285This program searches for those file names in a database that match
286SEARCH-STRING and normally outputs all matching absolute file names,
287one per line. The database normally consists of all files on your
288system, or of all files that you have access to. Consult the
289documentation of the program for the details about how it determines
290which file names match SEARCH-STRING. (Those details vary highly with
291the version.)
292
293You can specify another program for this command to run by customizing
294the variables `locate-command' or `locate-make-command-line'.
295
296The main use of FILTER is to implement `locate-with-filter'. See
7861843e
CY
297the docstring of that function for its meaning.
298
cb5e49a3
GM
299After preparing the results buffer, this runs `dired-mode-hook' and
300then `locate-post-command-hook'."
6aea3b07 301 (interactive
7861843e
CY
302 (list
303 (locate-prompt-for-search-string)
304 nil
305 current-prefix-arg))
306
fe8c7212 307 (if (equal search-string "")
c19813f3 308 (error "Please specify a filename to search for"))
be8bf2d0 309 (let* ((locate-cmd-list (funcall locate-make-command-line search-string))
6aea3b07
RS
310 (locate-cmd (car locate-cmd-list))
311 (locate-cmd-args (cdr locate-cmd-list))
83346ee8 312 (run-locate-command
7861843e 313 (or (and arg (not locate-prompt-for-command))
cb5e49a3 314 (and (not arg) locate-prompt-for-command))))
83346ee8 315
6aea3b07 316 ;; Find the Locate buffer
1f8330fb
CY
317 (save-window-excursion
318 (set-buffer (get-buffer-create locate-buffer-name))
be8bf2d0 319 (locate-mode)
e242b6c4 320 (let ((inhibit-read-only t)
1f8330fb
CY
321 (buffer-undo-list t))
322 (erase-buffer)
83346ee8 323
1f8330fb
CY
324 (setq locate-current-filter filter)
325 (set (make-local-variable 'locate-local-search) search-string)
326 (set (make-local-variable 'locate-local-filter) filter)
7861843e 327 (set (make-local-variable 'locate-local-prompt) run-locate-command)
83346ee8 328
1f8330fb
CY
329 (if run-locate-command
330 (shell-command search-string locate-buffer-name)
331 (apply 'call-process locate-cmd nil t nil locate-cmd-args))
83346ee8 332
1f8330fb
CY
333 (and filter
334 (locate-filter-output filter))
6aea3b07 335
cb5e49a3 336 (locate-do-setup search-string)))
1f8330fb
CY
337 (and (not (string-equal (buffer-name) locate-buffer-name))
338 (switch-to-buffer-other-window locate-buffer-name))
83346ee8 339
96c1776c 340 (run-hooks 'dired-mode-hook)
271a87e8 341 (dired-next-line 3) ;move to first matching file.
cb5e49a3 342 (run-hooks 'locate-post-command-hook)))
6aea3b07 343
1d96c2ff 344;;;###autoload
7861843e 345(defun locate-with-filter (search-string filter &optional arg)
18886d54
LT
346 "Run the executable program `locate' with a filter.
347This function is similar to the function `locate', which see.
348The difference is that, when invoked interactively, the present function
349prompts for both SEARCH-STRING and FILTER. It passes SEARCH-STRING
350to the locate executable program. It produces a `*Locate*' buffer
351that lists only those lines in the output of the locate program that
352contain a match for the regular expression FILTER; this is often useful
353to constrain a big search.
354
7861843e
CY
355ARG is the interactive prefix arg, which has the same effect as in `locate'.
356
18886d54
LT
357When called from Lisp, this function is identical with `locate',
358except that FILTER is not optional."
6aea3b07 359 (interactive
7861843e
CY
360 (list
361 (locate-prompt-for-search-string)
362 (read-from-minibuffer "Filter: " nil nil
363 nil 'locate-grep-history-list)
364 current-prefix-arg))
365 (locate search-string filter arg))
6aea3b07
RS
366
367(defun locate-filter-output (filter)
368 "Filter output from the locate command."
369 (goto-char (point-min))
18886d54 370 (keep-lines filter))
6aea3b07 371
dccbf237
GM
372(defvar locate-mode-map
373 (let ((map (copy-keymap dired-mode-map)))
374 ;; Undefine Useless Dired Menu bars
375 (define-key map [menu-bar Dired] 'undefined)
376 (define-key map [menu-bar subdir] 'undefined)
377 (define-key map [menu-bar mark executables] 'undefined)
378 (define-key map [menu-bar mark directory] 'undefined)
379 (define-key map [menu-bar mark directories] 'undefined)
380 (define-key map [menu-bar mark symlinks] 'undefined)
381 (define-key map [M-mouse-2] 'locate-mouse-view-file)
382 (define-key map "\C-c\C-t" 'locate-tags)
383 (define-key map "l" 'locate-do-redisplay)
384 (define-key map "U" 'dired-unmark-all-files)
385 (define-key map "V" 'locate-find-directory)
386 map)
6aea3b07 387 "Local keymap for Locate mode buffers.")
6aea3b07
RS
388
389;; This variable is used to indent the lines and then to search for
390;; the file name
391(defconst locate-filename-indentation 4
be8bf2d0 392 "The amount of indentation for each file.")
6aea3b07 393
6aea3b07 394(defun locate-get-file-positions ()
18886d54
LT
395 "Return list of start and end of the file name on the current line.
396This is a list of two buffer positions.
397
398You should only call this function on lines that contain a file name
399listed by the locate program. Inside inserted subdirectories, or if
400there is no file name on the current line, the return value is
401meaningless. You can check whether the current line contains a file
402listed by the locate program, using the function
403`locate-main-listing-line-p'."
25ca95c0
TTN
404 (list (+ locate-filename-indentation
405 (line-beginning-position))
406 ;; Assume names end at the end of the line.
407 (line-end-position)))
6aea3b07
RS
408
409;; From SQL-mode
be8bf2d0 410(defun locate-current-line-number ()
6aea3b07 411 "Return the current line number, as an integer."
6aea3b07
RS
412 (+ (count-lines (point-min) (point))
413 (if (eq (current-column) 0)
414 1
415 0)))
416
18886d54
LT
417;; You should only call this function on lines that contain a file name
418;; listed by the locate program. Inside inserted subdirectories, or if
419;; there is no file name on the current line, the return value is
420;; meaningless. You can check whether the current line contains a file
421;; listed by the locate program, using the function
422;; `locate-main-listing-line-p'.
6aea3b07
RS
423(defun locate-get-filename ()
424 (let ((pos (locate-get-file-positions))
be8bf2d0 425 (lineno (locate-current-line-number)))
83346ee8
PB
426 (and (not (eq lineno 1))
427 (not (eq lineno 2))
6aea3b07
RS
428 (buffer-substring (elt pos 0) (elt pos 1)))))
429
271a87e8
LT
430(defun locate-main-listing-line-p ()
431 "Return t if current line contains a file name listed by locate.
432This function returns nil if the current line either contains no
433file name or is inside a subdirectory."
434 (save-excursion
435 (forward-line 0)
436 (looking-at (concat "."
a861d465 437 (make-string (1- locate-filename-indentation) ?\s)
271a87e8
LT
438 "\\(/\\|[A-Za-z]:\\)"))))
439
83346ee8 440(defun locate-mouse-view-file (event)
6aea3b07 441 "In Locate mode, view a file, using the mouse."
83346ee8 442 (interactive "@e")
6aea3b07
RS
443 (save-excursion
444 (goto-char (posn-point (event-start event)))
271a87e8
LT
445 (if (locate-main-listing-line-p)
446 (view-file (locate-get-filename))
447 (message "This command only works inside main listing."))))
6aea3b07
RS
448
449;; Define a mode for locate
450;; Default directory is set to "/" so that dired commands, which
451;; expect to be in a tree, will work properly
452(defun locate-mode ()
442c8150 453 "Major mode for the `*Locate*' buffer made by \\[locate].
271a87e8 454\\<locate-mode-map>\
442c8150
LT
455In that buffer, you can use almost all the usual dired bindings.
456\\[locate-find-directory] visits the directory of the file on the current line.
cb5e49a3 457This function runs `locate-mode-hook' before returning.
442c8150 458
271a87e8
LT
459Operating on listed files works, but does not always
460automatically update the buffer as in ordinary Dired.
461This is true both for the main listing and for subdirectories.
462Reverting the buffer using \\[revert-buffer] deletes all subdirectories.
463Specific `locate-mode' commands, such as \\[locate-find-directory],
464do not work in subdirectories.
465
442c8150 466\\{locate-mode-map}"
271a87e8 467 ;; Not to be called interactively.
6aea3b07 468 (kill-all-local-variables)
271a87e8 469 ;; Avoid clobbering this variable
83346ee8 470 (make-local-variable 'dired-subdir-alist)
6aea3b07
RS
471 (use-local-map locate-mode-map)
472 (setq major-mode 'locate-mode
473 mode-name "Locate"
271a87e8
LT
474 default-directory "/"
475 buffer-read-only t
476 selective-display t)
83346ee8 477 (dired-alist-add-1 default-directory (point-min-marker))
271a87e8
LT
478 (set (make-local-variable 'dired-directory) "/")
479 (set (make-local-variable 'dired-subdir-switches) locate-ls-subdir-switches)
480 (setq dired-switches-alist nil)
9bc260cf 481 (make-local-variable 'directory-listing-before-filename-regexp)
83346ee8 482 ;; This should support both Unix and Windoze style names
9bc260cf 483 (setq directory-listing-before-filename-regexp
d1882ac7 484 (concat "^.\\("
a861d465 485 (make-string (1- locate-filename-indentation) ?\s)
d1882ac7 486 "\\)\\|"
9bc260cf 487 (default-value 'directory-listing-before-filename-regexp)))
5c6a8dfe
RS
488 (make-local-variable 'dired-actual-switches)
489 (setq dired-actual-switches "")
490 (make-local-variable 'dired-permission-flags-regexp)
83346ee8
PB
491 (setq dired-permission-flags-regexp
492 (concat "^.\\("
a861d465 493 (make-string (1- locate-filename-indentation) ?\s)
271a87e8
LT
494 "\\)\\|"
495 (default-value 'dired-permission-flags-regexp)))
be8bf2d0 496 (make-local-variable 'revert-buffer-function)
83346ee8 497 (setq revert-buffer-function 'locate-update)
271a87e8 498 (set (make-local-variable 'page-delimiter) "\n\n")
9b5e13c4 499 (run-mode-hooks 'locate-mode-hook))
6aea3b07 500
8348e1f9
PB
501(defun locate-do-setup (search-string)
502 (goto-char (point-min))
503 (save-excursion
83346ee8 504
8348e1f9
PB
505 ;; Nothing returned from locate command?
506 (and (eobp)
507 (progn
1f8330fb
CY
508 (kill-buffer locate-buffer-name)
509 (if locate-current-filter
510 (error "Locate: no match for %s in database using filter %s"
511 search-string locate-current-filter)
512 (error "Locate: no match for %s in database" search-string))))
83346ee8 513
8348e1f9 514 (locate-insert-header search-string)
83346ee8 515
8348e1f9 516 (while (not (eobp))
a861d465 517 (insert-char ?\s locate-filename-indentation t)
8348e1f9
PB
518 (locate-set-properties)
519 (forward-line 1)))
520 (goto-char (point-min)))
6aea3b07
RS
521
522(defun locate-set-properties ()
523 (save-excursion
524 (let ((pos (locate-get-file-positions)))
83346ee8 525 (dired-insert-set-properties (elt pos 0) (elt pos 1)))))
6aea3b07
RS
526
527(defun locate-insert-header (search-string)
271a87e8
LT
528 ;; There needs to be a space before `Matches, because otherwise,
529 ;; `*!" would erase the `M'. We can not use two spaces, or the line
530 ;; would mistakenly fit `dired-subdir-regexp'.
531 (let ((locate-format-string " /:\n Matches for %s")
6aea3b07
RS
532 (locate-regexp-match
533 (concat " *Matches for \\(" (regexp-quote search-string) "\\)"))
534 (locate-format-args (list search-string))
535 )
83346ee8 536
be8bf2d0 537 (and locate-fcodes-file
6aea3b07
RS
538 (setq locate-format-string
539 (concat locate-format-string " in %s")
540 locate-regexp-match
541 (concat locate-regexp-match
542 " in \\("
543 (regexp-quote locate-fcodes-file)
544 "\\)")
545 locate-format-args
546 (append (list locate-fcodes-file) locate-format-args)))
547
be8bf2d0 548 (and locate-current-filter
6aea3b07
RS
549 (setq locate-format-string
550 (concat locate-format-string " using filter %s")
551 locate-regexp-match
552 (concat locate-regexp-match
553 " using filter "
554 "\\("
555 (regexp-quote locate-current-filter)
556 "\\)")
557 locate-format-args
558 (append (list locate-current-filter) locate-format-args)))
83346ee8 559
6aea3b07 560 (setq locate-format-string
5421b899 561 (concat locate-format-string ":\n\n")
6aea3b07 562 locate-regexp-match
5421b899 563 (concat locate-regexp-match ":\n"))
83346ee8 564
5c6a8dfe 565 (insert (apply 'format locate-format-string (reverse locate-format-args)))
83346ee8 566
6aea3b07
RS
567 (save-excursion
568 (goto-char (point-min))
271a87e8 569 (forward-line 1)
6aea3b07
RS
570 (if (not (looking-at locate-regexp-match))
571 nil
572 (add-text-properties (match-beginning 1) (match-end 1)
573 (list 'face locate-header-face))
574 (and (match-beginning 2)
575 (add-text-properties (match-beginning 2) (match-end 2)
576 (list 'face locate-header-face)))
577 (and (match-beginning 3)
578 (add-text-properties (match-beginning 3) (match-end 3)
579 (list 'face locate-header-face)))
580 ))))
581
582(defun locate-tags ()
583 "Visit a tags table in `*Locate*' mode."
584 (interactive)
271a87e8
LT
585 (if (locate-main-listing-line-p)
586 (let ((tags-table (locate-get-filename)))
587 (and (y-or-n-p (format "Visit tags table %s? " tags-table))
588 (visit-tags-table tags-table)))
589 (message "This command only works inside main listing.")))
be8bf2d0
RS
590
591;; From Stephen Eglen <stephen@cns.ed.ac.uk>
592(defun locate-update (ignore1 ignore2)
e8fc997c
LT
593 "Revert the *Locate* buffer.
594If `locate-update-when-revert' is non-nil, offer to update the
595locate database using the shell command in `locate-update-command'."
7861843e
CY
596 (let ((locate-buffer-name (buffer-name))
597 (locate-prompt-for-command locate-local-prompt))
1f8330fb
CY
598 (and locate-update-when-revert
599 (yes-or-no-p "Update locate database (may take a few seconds)? ")
600 ;; `expand-file-name' is used in order to autoload Tramp if
601 ;; necessary. It cannot be loaded when `default-directory'
602 ;; is remote.
603 (let ((default-directory (expand-file-name locate-update-path)))
604 (shell-command locate-update-command)))
605 (locate locate-local-search locate-local-filter)))
83346ee8
PB
606
607;;; Modified three functions from `dired.el':
608;;; dired-find-directory,
609;;; dired-find-directory-other-window
610;;; dired-get-filename
611
612(defun locate-find-directory ()
613 "Visit the directory of the file mentioned on this line."
614 (interactive)
271a87e8
LT
615 (if (locate-main-listing-line-p)
616 (let ((directory-name (locate-get-dirname)))
617 (if (file-directory-p directory-name)
618 (find-file directory-name)
619 (if (file-symlink-p directory-name)
620 (error "Directory is a symlink to a nonexistent target")
621 (error "Directory no longer exists; run `updatedb' to update database"))))
622 (message "This command only works inside main listing.")))
83346ee8
PB
623
624(defun locate-find-directory-other-window ()
625 "Visit the directory of the file named on this line in other window."
626 (interactive)
18886d54
LT
627 (if (locate-main-listing-line-p)
628 (find-file-other-window (locate-get-dirname))
629 (message "This command only works inside main listing.")))
83346ee8 630
18886d54
LT
631;; You should only call this function on lines that contain a file name
632;; listed by the locate program. Inside inserted subdirectories, or if
633;; there is no file name on the current line, the return value is
634;; meaningless. You can check whether the current line contains a file
635;; listed by the locate program, using the function
636;; `locate-main-listing-line-p'.
83346ee8
PB
637(defun locate-get-dirname ()
638 "Return the directory name of the file mentioned on this line."
639 (let (file (filepos (locate-get-file-positions)))
640 (if (setq file (buffer-substring (nth 0 filepos) (nth 1 filepos)))
641 (progn
642 ;; Get rid of the mouse-face property that file names have.
643 (set-text-properties 0 (length file) nil file)
644 (setq file (file-name-directory file))
645 ;; Unquote names quoted by ls or by dired-insert-directory.
646 ;; Using read to unquote is much faster than substituting
647 ;; \007 (4 chars) -> ^G (1 char) etc. in a lisp loop.
648 (setq file
649 (read
650 (concat "\""
651 ;; some ls -b don't escape quotes, argh!
652 ;; This is not needed for GNU ls, though.
653 (or (dired-string-replace-match
654 "\\([^\\]\\|\\`\\)\"" file "\\1\\\\\"" nil t)
655 file)
656 "\"")))))
657 (and file buffer-file-coding-system
658 (not file-name-coding-system)
659 (setq file (encode-coding-string file buffer-file-coding-system)))
660 file))
661
662;; Only for GNU locate
663(defun locate-in-alternate-database (search-string database)
59f3a543 664 "Run the GNU locate program, using an alternate database.
8baa97f9
GM
665
666This command only works if you use GNU locate. It does not work
667properly if `locate-prompt-for-command' is set to t. In that
668case, you can just run the regular `locate' command and specify
669the database on the command line."
83346ee8
PB
670 (interactive
671 (list
672 (progn
673 ;; (require 'locate)
674 (read-from-minibuffer "Locate: " nil nil
675 nil 'locate-history-list))
676 (read-file-name "Locate using Database: " )
677 ))
678 (or (file-exists-p database)
679 (error "Database file %s does not exist" database))
680 (let ((locate-make-command-line
681 (function (lambda (string)
682 (cons locate-command
683 (list (concat "--database="
684 (expand-file-name database))
685 string))))))
8348e1f9 686 (locate search-string)))
6aea3b07 687
271a87e8
LT
688(defun locate-do-redisplay (&optional arg test-for-subdir)
689 "Like `dired-do-redisplay', but adapted for `*Locate*' buffers."
690 (interactive "P\np")
691 (if (string= (dired-current-directory) "/")
692 (message "This command only works in subdirectories.")
693 (let ((dired-actual-switches locate-ls-subdir-switches))
694 (dired-do-redisplay arg test-for-subdir))))
695
6aea3b07
RS
696(provide 'locate)
697
698;;; locate.el ends here