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