]> code.delx.au - gnu-emacs/blob - lisp/locate.el
(iswitchb-exhibit): Extract user-input only
[gnu-emacs] / lisp / locate.el
1 ;;; locate.el --- interface to the locate command
2
3 ;; Copyright (C) 1996, 1998 Free Software Foundation, Inc.
4
5 ;; Author: Peter Breton <pbreton@cs.umb.edu>
6
7 ;; This file is part of GNU Emacs.
8
9 ;; GNU Emacs is free software; you can redistribute it and/or modify
10 ;; it under the terms of the GNU General Public License as published by
11 ;; the Free Software Foundation; either version 2, or (at your option)
12 ;; any later version.
13
14 ;; GNU Emacs is distributed in the hope that it will be useful,
15 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
16 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
17 ;; GNU General Public License for more details.
18
19 ;; You should have received a copy of the GNU General Public License
20 ;; along with GNU Emacs; see the file COPYING. If not, write to the
21 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
22 ;; Boston, MA 02111-1307, USA.
23
24 ;;; Commentary:
25
26 ;; Search a database of files and use dired commands on
27 ;; the result.
28 ;;
29 \f
30 ;;;;; Building a database of files ;;;;;;;;;
31 ;;
32 ;; You can create a simple files database with a port of the Unix find command
33 ;; and one of the various Windows NT various scheduling utilities,
34 ;; for example the AT command from the NT Resource Kit, WinCron which is
35 ;; included with Microsoft FrontPage, or the shareware NTCron program.
36 ;;
37 ;; To set up a function which searches the files database, do something
38 ;; like this:
39 ;;
40 ;; (defvar locate-fcodes-file "c:/users/peter/fcodes")
41 ;; (defvar locate-make-command-line 'nt-locate-make-command-line)
42 ;;
43 ;; (defun nt-locate-make-command-line (arg)
44 ;; (list "grep" "-i" arg locate-fcodes-file))
45 ;;
46 ;;;;;;;; ADVICE For dired-make-relative: ;;;;;;;;;
47 ;;
48 ;; For certain dired commands to work right, you should also include the
49 ;; following in your _emacs/.emacs:
50 ;;
51 ;; (defadvice dired-make-relative (before set-no-error activate)
52 ;; "For locate mode and Windows, don't return errors"
53 ;; (if (and (eq major-mode 'locate-mode)
54 ;; (memq system-type (list 'windows-nt 'ms-dos)))
55 ;; (ad-set-arg 2 t)
56 ;; ))
57 ;;
58 ;; Otherwise, `dired-make-relative' will give error messages like
59 ;; "FILENAME: not in directory tree growing at /"
60 \f
61 ;;; Commentary:
62 ;;
63 ;; Locate.el provides an interface to a program which searches a
64 ;; database of file names. By default, this program is the GNU locate
65 ;; command, but it could also be the BSD-style find command, or even a
66 ;; user specified command.
67 ;;
68 ;; To use the BSD-style "fast find", or any other shell command of the
69 ;; form
70 ;;
71 ;; SHELLPROGRAM Name-to-find
72 ;;
73 ;; set the variable `locate-command' in your .emacs file.
74 ;;
75 ;; To use a more complicated expression, create a function which
76 ;; takes a string (the name to find) as input and returns a list.
77 ;; The first element should be the command to be executed, the remaining
78 ;; elements should be the arguments (including the name to find). Then put
79 ;;
80 ;; (setq locate-make-command-line 'my-locate-command-line)
81 ;;
82 ;; in your .emacs, using the name of your function in place of
83 ;; my-locate-command-line.
84 ;;
85 ;; You should make sure that whichever command you use works correctly
86 ;; from a shell prompt. GNU locate and BSD find expect the file databases
87 ;; to either be in standard places or located via environment variables.
88 ;; If the latter, make sure these environment variables are set in
89 ;; your emacs process.
90 ;;
91 ;; Locate-mode assumes that each line output from the locate-command
92 ;; consists exactly of a file name, possibly preceded or trailed by
93 ;; whitespace. If your file database has other information on the line (for
94 ;; example, the file size), you will need to redefine the function
95 ;; `locate-get-file-positions' to return a list consisting of the first
96 ;; character in the file name and the last character in the file name.
97 ;;
98 ;; To use locate-mode, simply type M-x locate and then the string
99 ;; you wish to find. You can use almost all of the dired commands in
100 ;; the resulting *Locate* buffer. It is worth noting that your commands
101 ;; do not, of course, affect the file database. For example, if you
102 ;; compress a file in the locate buffer, the actual file will be
103 ;; compressed, but the entry in the file database will not be
104 ;; affected. Consequently, the database and the filesystem will be out
105 ;; of sync until the next time the database is updated.
106 ;;
107 ;; The command `locate-with-filter' keeps only lines matching a
108 ;; regular expression; this is often useful to constrain a big search.
109 ;;
110 \f
111 ;;; Code:
112
113 (eval-when-compile
114 (require 'dired))
115
116 ;; Variables
117
118 (defvar locate-current-filter nil)
119
120 (defgroup locate nil
121 "Interface to the locate command."
122 :prefix "locate-"
123 :group 'external)
124
125 (defcustom locate-command "locate"
126 "*The executable program used to search a database of files."
127 :type 'string
128 :group 'locate)
129
130 (defvar locate-history-list nil
131 "The history list used by the \\[locate] command.")
132
133 (defvar locate-grep-history-list nil
134 "The history list used by the \\[locate-with-filter] command.")
135
136 (defcustom locate-make-command-line 'locate-default-make-command-line
137 "*Function used to create the locate command line."
138 :type 'function
139 :group 'locate)
140
141 (defcustom locate-buffer-name "*Locate*"
142 "*Name of the buffer to show results from the \\[locate] command."
143 :type 'string
144 :group 'locate)
145
146 (defcustom locate-fcodes-file nil
147 "*File name for the database of file names."
148 :type '(choice file (const nil))
149 :group 'locate)
150
151 (defcustom locate-header-face nil
152 "*Face used to highlight the locate header."
153 :type 'face
154 :group 'locate)
155
156 (defcustom locate-update-command "updatedb"
157 "The command used to update the locate database."
158 :type 'string
159 :group 'locate)
160
161 (defcustom locate-prompt-for-command nil
162 "If non-nil, the default behavior of the locate command is to prompt for a command to run.
163 Otherwise, that behavior is invoked via a prefix argument."
164 :group 'locate
165 :type 'boolean
166 )
167
168 ;; Functions
169
170 (defun locate-default-make-command-line (search-string)
171 (list locate-command search-string))
172
173 ;;;###autoload
174 (defun locate (arg search-string &optional filter)
175 "Run the program `locate', putting results in `*Locate*' buffer.
176 With prefix arg, prompt for the locate command to run."
177 (interactive
178 (list
179 current-prefix-arg
180 (if (or (and current-prefix-arg (not locate-prompt-for-command))
181 (and (not current-prefix-arg) locate-prompt-for-command))
182 (read-from-minibuffer "Run locate command: "
183 nil nil nil 'locate-history-list)
184 (read-from-minibuffer "Locate: " nil nil
185 nil 'locate-history-list)
186 )))
187 (let* ((locate-cmd-list (funcall locate-make-command-line search-string))
188 (locate-cmd (car locate-cmd-list))
189 (locate-cmd-args (cdr locate-cmd-list))
190 (run-locate-command
191 (or (and arg (not locate-prompt-for-command))
192 (and (not arg) locate-prompt-for-command)))
193 )
194
195 ;; Find the Locate buffer
196 (save-window-excursion
197 (set-buffer (get-buffer-create locate-buffer-name))
198 (locate-mode)
199 (erase-buffer)
200
201 (setq locate-current-filter filter)
202
203 (if run-locate-command
204 (shell-command search-string locate-buffer-name)
205 (apply 'call-process locate-cmd nil t nil locate-cmd-args))
206
207 (and filter
208 (locate-filter-output filter))
209
210 (locate-do-setup)
211 )
212 (and (not (string-equal (buffer-name) locate-buffer-name))
213 (switch-to-buffer-other-window locate-buffer-name))
214
215 (run-hooks 'locate-post-command-hook)
216 )
217 )
218
219 ;;;###autoload
220 (defun locate-with-filter (search-string filter)
221 "Run the locate command with a filter."
222 (interactive
223 (list (read-from-minibuffer "Locate: " nil nil
224 nil 'locate-history-list)
225 (read-from-minibuffer "Filter: " nil nil
226 nil 'locate-grep-history-list)))
227 (locate nil search-string filter))
228
229 (defun locate-filter-output (filter)
230 "Filter output from the locate command."
231 (goto-char (point-min))
232 (delete-non-matching-lines filter))
233
234 (defvar locate-mode-map nil
235 "Local keymap for Locate mode buffers.")
236 (if locate-mode-map
237 nil
238
239 (require 'dired)
240
241 (setq locate-mode-map (copy-keymap dired-mode-map))
242
243 ;; Undefine Useless Dired Menu bars
244 (define-key locate-mode-map [menu-bar Dired] 'undefined)
245 (define-key locate-mode-map [menu-bar subdir] 'undefined)
246
247 (define-key locate-mode-map [menu-bar mark executables] 'undefined)
248 (define-key locate-mode-map [menu-bar mark directory] 'undefined)
249 (define-key locate-mode-map [menu-bar mark directories] 'undefined)
250 (define-key locate-mode-map [menu-bar mark symlinks] 'undefined)
251
252 (define-key locate-mode-map [mouse-2] 'locate-mouse-view-file)
253 (define-key locate-mode-map "\C-c\C-t" 'locate-tags)
254
255 (define-key locate-mode-map "U" 'dired-unmark-all-files)
256 (define-key locate-mode-map "V" 'locate-find-directory)
257 )
258
259 ;; This variable is used to indent the lines and then to search for
260 ;; the file name
261 (defconst locate-filename-indentation 4
262 "The amount of indentation for each file.")
263
264 (defun locate-get-file-positions ()
265 (save-excursion
266 (end-of-line)
267 (let ((eol (point)))
268 (beginning-of-line)
269
270 ;; Assumes names end at the end of the line
271 (forward-char locate-filename-indentation)
272 (list (point) eol))))
273
274 ;; From SQL-mode
275 (defun locate-current-line-number ()
276 "Return the current line number, as an integer."
277 (+ (count-lines (point-min) (point))
278 (if (eq (current-column) 0)
279 1
280 0)))
281
282 (defun locate-get-filename ()
283 (let ((pos (locate-get-file-positions))
284 (lineno (locate-current-line-number)))
285 (and (not (eq lineno 1))
286 (not (eq lineno 2))
287 (buffer-substring (elt pos 0) (elt pos 1)))))
288
289 (defun locate-mouse-view-file (event)
290 "In Locate mode, view a file, using the mouse."
291 (interactive "@e")
292 (save-excursion
293 (goto-char (posn-point (event-start event)))
294 (view-file (locate-get-filename))))
295
296 ;; Define a mode for locate
297 ;; Default directory is set to "/" so that dired commands, which
298 ;; expect to be in a tree, will work properly
299 (defun locate-mode ()
300 "Major mode for the `*Locate*' buffer made by \\[locate]."
301 (kill-all-local-variables)
302 ;; Avoid clobbering this variables
303 (make-local-variable 'dired-subdir-alist)
304 (use-local-map locate-mode-map)
305 (setq major-mode 'locate-mode
306 mode-name "Locate"
307 default-directory "/")
308 (dired-alist-add-1 default-directory (point-min-marker))
309 (make-local-variable 'dired-move-to-filename-regexp)
310 ;; This should support both Unix and Windoze style names
311 (setq dired-move-to-filename-regexp
312 (concat "."
313 (make-string (1- locate-filename-indentation) ?\ )
314 "\\(/\\|[A-Za-z]:\\)"))
315 (make-local-variable 'dired-actual-switches)
316 (setq dired-actual-switches "")
317 (make-local-variable 'dired-permission-flags-regexp)
318 (setq dired-permission-flags-regexp
319 (concat "^.\\("
320 (make-string (1- locate-filename-indentation) ?\ )
321 "\\)"))
322 (make-local-variable 'revert-buffer-function)
323 (setq revert-buffer-function 'locate-update)
324 (run-hooks 'locate-mode-hook))
325
326 (defun locate-do-setup ()
327 (let ((search-string (car locate-history-list)))
328 (goto-char (point-min))
329 (save-excursion
330
331 ;; Nothing returned from locate command?
332 (and (eobp)
333 (progn
334 (kill-buffer locate-buffer-name)
335 (if locate-current-filter
336 (error "Locate: no match for %s in database using filter %s"
337 search-string locate-current-filter)
338 (error "Locate: no match for %s in database" search-string))))
339
340 (locate-insert-header search-string)
341
342 (while (not (eobp))
343 (insert-char ?\ locate-filename-indentation t)
344 (locate-set-properties)
345 (forward-line 1)))))
346
347 (defun locate-set-properties ()
348 (save-excursion
349 (let ((pos (locate-get-file-positions)))
350 (dired-insert-set-properties (elt pos 0) (elt pos 1)))))
351
352 (defun locate-insert-header (search-string)
353 (let ((locate-format-string "Matches for %s")
354 (locate-regexp-match
355 (concat " *Matches for \\(" (regexp-quote search-string) "\\)"))
356 (locate-format-args (list search-string))
357 )
358
359 (and locate-fcodes-file
360 (setq locate-format-string
361 (concat locate-format-string " in %s")
362 locate-regexp-match
363 (concat locate-regexp-match
364 " in \\("
365 (regexp-quote locate-fcodes-file)
366 "\\)")
367 locate-format-args
368 (append (list locate-fcodes-file) locate-format-args)))
369
370 (and locate-current-filter
371 (setq locate-format-string
372 (concat locate-format-string " using filter %s")
373 locate-regexp-match
374 (concat locate-regexp-match
375 " using filter "
376 "\\("
377 (regexp-quote locate-current-filter)
378 "\\)")
379 locate-format-args
380 (append (list locate-current-filter) locate-format-args)))
381
382 (setq locate-format-string
383 (concat locate-format-string ": \n\n")
384 locate-regexp-match
385 (concat locate-regexp-match ": \n"))
386
387 (insert (apply 'format locate-format-string (reverse locate-format-args)))
388
389 (save-excursion
390 (goto-char (point-min))
391 (if (not (looking-at locate-regexp-match))
392 nil
393 (add-text-properties (match-beginning 1) (match-end 1)
394 (list 'face locate-header-face))
395 (and (match-beginning 2)
396 (add-text-properties (match-beginning 2) (match-end 2)
397 (list 'face locate-header-face)))
398 (and (match-beginning 3)
399 (add-text-properties (match-beginning 3) (match-end 3)
400 (list 'face locate-header-face)))
401 ))))
402
403 (defun locate-tags ()
404 "Visit a tags table in `*Locate*' mode."
405 (interactive)
406 (let ((tags-table (locate-get-filename)))
407 (and (y-or-n-p (format "Visit tags table %s? " tags-table))
408 (visit-tags-table tags-table))))
409
410 ;; From Stephen Eglen <stephen@cns.ed.ac.uk>
411 (defun locate-update (ignore1 ignore2)
412 "Update the locate database.
413 Database is updated using the shell command in `locate-update-command'."
414 (let ((str (car locate-history-list)))
415 (cond ((yes-or-no-p "Update locate database (may take a few seconds)? ")
416 (shell-command locate-update-command)
417 (locate nil str)))))
418
419 ;;; Modified three functions from `dired.el':
420 ;;; dired-find-directory,
421 ;;; dired-find-directory-other-window
422 ;;; dired-get-filename
423
424 (defun locate-find-directory ()
425 "Visit the directory of the file mentioned on this line."
426 (interactive)
427 (let ((directory-name (locate-get-dirname)))
428 (if (file-directory-p directory-name)
429 (find-file directory-name)
430 (if (file-symlink-p directory-name)
431 (error "Directory is a symlink to a nonexistent target")
432 (error "Directory no longer exists; run `updatedb' to update database")))))
433
434 (defun locate-find-directory-other-window ()
435 "Visit the directory of the file named on this line in other window."
436 (interactive)
437 (find-file-other-window (locate-get-dirname)))
438
439 (defun locate-get-dirname ()
440 "Return the directory name of the file mentioned on this line."
441 (let (file (filepos (locate-get-file-positions)))
442 (if (setq file (buffer-substring (nth 0 filepos) (nth 1 filepos)))
443 (progn
444 ;; Get rid of the mouse-face property that file names have.
445 (set-text-properties 0 (length file) nil file)
446 (setq file (file-name-directory file))
447 ;; Unquote names quoted by ls or by dired-insert-directory.
448 ;; Using read to unquote is much faster than substituting
449 ;; \007 (4 chars) -> ^G (1 char) etc. in a lisp loop.
450 (setq file
451 (read
452 (concat "\""
453 ;; some ls -b don't escape quotes, argh!
454 ;; This is not needed for GNU ls, though.
455 (or (dired-string-replace-match
456 "\\([^\\]\\|\\`\\)\"" file "\\1\\\\\"" nil t)
457 file)
458 "\"")))))
459 (and file buffer-file-coding-system
460 (not file-name-coding-system)
461 (setq file (encode-coding-string file buffer-file-coding-system)))
462 file))
463
464 ;; Only for GNU locate
465 (defun locate-in-alternate-database (search-string database)
466 "Run the GNU locate command, using an alternate database."
467 (interactive
468 (list
469 (progn
470 ;; (require 'locate)
471 (read-from-minibuffer "Locate: " nil nil
472 nil 'locate-history-list))
473 (read-file-name "Locate using Database: " )
474 ))
475 (or (file-exists-p database)
476 (error "Database file %s does not exist" database))
477 (let ((locate-make-command-line
478 (function (lambda (string)
479 (cons locate-command
480 (list (concat "--database="
481 (expand-file-name database))
482 string))))))
483 (locate nil search-string)))
484
485 (provide 'locate)
486
487 ;;; locate.el ends here