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