Mercurial > emacs
annotate lisp/locate.el @ 20483:141c2d41d39c
(toggle-enable-multibyte-characters): Doc fix.
author | Richard M. Stallman <rms@gnu.org> |
---|---|
date | Sun, 21 Dec 1997 01:49:03 +0000 |
parents | 8f952e921136 |
children | 2fd9f2883ad4 |
rev | line source |
---|---|
17517 | 1 ;;; locate.el --- interface to the locate command |
16781 | 2 |
3 ;; Copyright (C) 1996 Free Software Foundation, Inc. | |
4 | |
5 ;; Author: Peter Breton <pbreton@i-kinetics.com> | |
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 | |
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 (concat my-home "/fcodes")) | |
41 ;; (defvar locate-make-command-line 'nt-locate-make-command-line) | |
42 ;; | |
43 ;; (defun nt-locate-make-command-line (arg) | |
44 ;; (cons "grep" | |
45 ;; (mapconcat 'identity | |
46 ;; (list "-i" arg locate-fcodes-file) | |
47 ;; " "))) | |
48 ;; | |
49 ;;;;;;;; ADVICE For dired-make-relative: ;;;;;;;;; | |
50 ;; | |
51 ;; For certain dired commands to work right, you should also include the | |
52 ;; following in your _emacs/.emacs: | |
53 ;; | |
54 ;; (defadvice dired-make-relative (before set-no-error activate) | |
55 ;; "For locate mode and Windows, don't return errors" | |
56 ;; (if (and (eq major-mode 'locate-mode) | |
57 ;; (memq system-type (list 'windows-nt 'ms-dos))) | |
58 ;; (ad-set-arg 2 t) | |
59 ;; )) | |
60 ;; | |
61 ;; Otherwise, dired-make-relative will give error messages like | |
62 ;; "FILENAME: not in directory tree growing at /" | |
63 | |
64 ;;; Commentary: | |
65 ;; | |
66 ;; Locate.el provides an interface to a program which searches a | |
67 ;; database of file names. By default, this program is the GNU locate | |
68 ;; command, but it could also be the BSD-style find command, or even a | |
69 ;; user specified command. | |
70 ;; | |
71 ;; To use the BSD-style "fast find", or any other shell command of the | |
72 ;; form | |
73 ;; | |
74 ;; SHELLPROGRAM Name-to-find | |
75 ;; | |
76 ;; set the variable locate-command in your .emacs file. | |
77 ;; | |
78 ;; To use a more complicated expression, create a function which | |
79 ;; takes a string (the name to find) as input and returns a cons | |
80 ;; pair: the car should be the command to be executed, the cdr | |
81 ;; should be the arguments, concatenated into a string (including | |
82 ;; the name to find). Then do | |
83 ;; | |
84 ;; (setq locate-make-command-line 'my-locate-command-line) | |
85 ;; | |
86 ;; in your .emacs, using the name of your function in place of | |
87 ;; my-locate-command-line | |
88 ;; | |
89 ;; You should make sure that whichever command you use works correctly | |
90 ;; from a shell prompt. GNU locate and BSD find expect the file databases | |
91 ;; to either be in standard places or located via environment variables. | |
92 ;; If the latter, make sure these environment variables are set in | |
93 ;; your emacs process | |
94 ;; | |
95 ;; Locate-mode assumes that each line output from the locate-command | |
96 ;; consists exactly of a file name, possibly preceded or trailed by | |
97 ;; whitespace. If your file database has other information on the line (for | |
98 ;; example, the file size), you will need to redefine the function | |
99 ;; locate-get-file-positions to return a list consisting of the first | |
100 ;; character in the file name and the last character in the file name. | |
101 ;; | |
102 ;; To use locate-mode, simply type M-x locate and then the string | |
103 ;; you wish to find. You can use almost all of the dired commands in | |
104 ;; the resulting *Locate* buffer. It is worth noting that your commands | |
105 ;; do not, of course, affect the file database. For example, if you | |
106 ;; compress a file in the locate buffer, the actual file will be | |
107 ;; compressed, but the entry in the file database will not be | |
108 ;; affected. Consequently, the database and the filesystem will be out | |
109 ;; of sync until the next time the database is updated | |
110 ;; | |
111 ;; The command locate-with-filter keeps only lines matching a | |
112 ;; regular expression; this is often useful to constrain a big search. | |
113 ;; | |
114 | |
115 ;;; Code: | |
116 | |
117 (eval-when-compile | |
118 (require 'dired)) | |
119 | |
120 ;; Variables | |
121 (defvar locate-command "locate" | |
122 "*The executable program used to search a database of files.") | |
123 | |
124 (defvar locate-history-list nil | |
125 "The history list used by the \\[locate] command.") | |
126 | |
127 (defvar locate-make-command-line 'locate-default-make-command-line | |
128 "*Function used to create the locate command line.") | |
129 | |
130 (defvar locate-buffer-name "*Locate*" | |
131 "*Name of the buffer to show results from the \\[locate] command.") | |
132 | |
133 (defvar locate-fcodes-file nil | |
134 "*Database of filenames.") | |
135 | |
136 (defvar locate-mouse-face 'highlight | |
137 "*Face used to highlight locate entries.") | |
138 | |
139 (defvar locate-header-face 'region | |
140 "*Face used to highlight the locate header.") | |
141 | |
142 (defvar locate-current-filter nil) | |
143 | |
144 ;; Functions | |
145 | |
146 (defun locate-default-make-command-line (search-string) | |
147 (cons locate-command search-string)) | |
148 | |
149 ;;;### autoload | |
150 (defun locate (search-string &optional filter) | |
151 "Run the \\[locate] command, putting results in `*Locate*' buffer." | |
152 (interactive | |
153 (list (read-from-minibuffer "Locate: " nil nil | |
154 nil 'locate-history-list))) | |
155 (let* ((pop-up-windows 1) | |
156 (locate-cmd-list (funcall locate-make-command-line search-string)) | |
157 (locate-cmd (car locate-cmd-list)) | |
158 (locate-cmd-args (cdr locate-cmd-list)) | |
159 (locate-proc) | |
160 ) | |
161 | |
162 ;; Find the Locate buffer | |
163 (if (not (string-equal (buffer-name) locate-buffer-name)) | |
164 (switch-to-buffer-other-window locate-buffer-name)) | |
165 | |
166 (locate-mode) | |
167 (erase-buffer) | |
168 | |
169 (setq locate-current-filter filter) | |
170 | |
171 (call-process locate-cmd nil t nil locate-cmd-args) | |
172 (if filter | |
173 (locate-filter-output filter)) | |
174 | |
175 (locate-do-setup) | |
176 ) | |
177 ) | |
178 | |
179 ;;;### autoload | |
180 (defun locate-with-filter (search-string filter) | |
181 "Run the locate command with a filter." | |
182 (interactive | |
183 (list (read-from-minibuffer "Locate: " nil nil | |
184 nil 'locate-history-list) | |
185 (read-from-minibuffer "Filter: " nil nil | |
186 nil 'grep-history))) | |
187 (locate search-string filter)) | |
188 | |
189 (defun locate-filter-output (filter) | |
190 "Filter output from the locate command." | |
191 (goto-char (point-min)) | |
192 (delete-non-matching-lines (regexp-quote filter))) | |
193 | |
194 (defvar locate-mode-map nil | |
195 "Local keymap for Locate mode buffers.") | |
196 (if locate-mode-map | |
197 nil | |
198 | |
199 (require 'dired) | |
200 | |
201 (setq locate-mode-map (copy-keymap dired-mode-map)) | |
202 | |
203 ;; Undefine Useless Dired Menu bars | |
204 (define-key locate-mode-map [menu-bar Dired] 'undefined) | |
205 (define-key locate-mode-map [menu-bar subdir] 'undefined) | |
206 | |
207 (define-key locate-mode-map [menu-bar mark executables] 'undefined) | |
208 (define-key locate-mode-map [menu-bar mark directory] 'undefined) | |
209 (define-key locate-mode-map [menu-bar mark directories] 'undefined) | |
210 (define-key locate-mode-map [menu-bar mark symlinks] 'undefined) | |
211 | |
212 (define-key locate-mode-map [mouse-2] 'mouse-locate-view-file) | |
213 (define-key locate-mode-map "\C-ct" 'locate-tags) | |
214 | |
215 (define-key locate-mode-map "U" 'dired-unmark-all-files-no-query) | |
216 ) | |
217 | |
218 ;; This variable is used to indent the lines and then to search for | |
219 ;; the file name | |
220 (defconst locate-filename-indentation 4 | |
221 "The amount of indentation for each file.") | |
222 | |
223 (defun locate-get-file-positions () | |
224 (save-excursion | |
225 (end-of-line) | |
226 (let ((eol (point))) | |
227 (beginning-of-line) | |
228 | |
229 ;; Assumes names end at the end of the line | |
230 (forward-char locate-filename-indentation) | |
231 (list (point) eol)))) | |
232 | |
233 ;; From SQL-mode | |
234 (defun current-line () | |
235 "Return the current line number, as an integer." | |
236 (interactive) | |
237 (+ (count-lines (point-min) (point)) | |
238 (if (eq (current-column) 0) | |
239 1 | |
240 0))) | |
241 | |
242 (defun locate-get-filename () | |
243 (let ((pos (locate-get-file-positions)) | |
244 (lineno (current-line))) | |
245 (and (not (eq lineno 1)) | |
246 (not (eq lineno 2)) | |
247 (buffer-substring (elt pos 0) (elt pos 1))))) | |
248 | |
249 (defun mouse-locate-view-file (event) | |
250 "In Locate mode, view a file, using the mouse." | |
251 (interactive "@e") | |
252 (save-excursion | |
253 (goto-char (posn-point (event-start event))) | |
254 (view-file (locate-get-filename)))) | |
255 | |
256 ;; Define a mode for locate | |
257 ;; Default directory is set to "/" so that dired commands, which | |
258 ;; expect to be in a tree, will work properly | |
259 (defun locate-mode () | |
260 "Major mode for the `*Locate*' buffer made by \\[locate]." | |
261 (kill-all-local-variables) | |
262 (use-local-map locate-mode-map) | |
263 (setq major-mode 'locate-mode | |
264 mode-name "Locate" | |
265 default-directory "/" | |
266 dired-subdir-alist (list (cons "/" (point-min-marker)))) | |
16795
2a9ae2be61ae
(locate-mode): Locally set dired-move-to-filename-regexp,
Richard M. Stallman <rms@gnu.org>
parents:
16781
diff
changeset
|
267 (make-local-variable 'dired-move-to-filename-regexp) |
2a9ae2be61ae
(locate-mode): Locally set dired-move-to-filename-regexp,
Richard M. Stallman <rms@gnu.org>
parents:
16781
diff
changeset
|
268 (setq dired-move-to-filename-regexp |
2a9ae2be61ae
(locate-mode): Locally set dired-move-to-filename-regexp,
Richard M. Stallman <rms@gnu.org>
parents:
16781
diff
changeset
|
269 (make-string locate-filename-indentation ?\ )) |
2a9ae2be61ae
(locate-mode): Locally set dired-move-to-filename-regexp,
Richard M. Stallman <rms@gnu.org>
parents:
16781
diff
changeset
|
270 (make-local-variable 'dired-actual-switches) |
2a9ae2be61ae
(locate-mode): Locally set dired-move-to-filename-regexp,
Richard M. Stallman <rms@gnu.org>
parents:
16781
diff
changeset
|
271 (setq dired-actual-switches "") |
2a9ae2be61ae
(locate-mode): Locally set dired-move-to-filename-regexp,
Richard M. Stallman <rms@gnu.org>
parents:
16781
diff
changeset
|
272 (make-local-variable 'dired-permission-flags-regexp) |
2a9ae2be61ae
(locate-mode): Locally set dired-move-to-filename-regexp,
Richard M. Stallman <rms@gnu.org>
parents:
16781
diff
changeset
|
273 (setq dired-permission-flags-regexp "^\\( \\)") |
16781 | 274 (run-hooks 'locate-mode-hook)) |
275 | |
276 (defun locate-do-setup () | |
277 (let ((search-string (car locate-history-list))) | |
278 (goto-char (point-min)) | |
279 (save-excursion | |
280 | |
281 ;; Nothing returned from locate command? | |
282 (if (eobp) | |
283 (progn | |
284 (kill-buffer locate-buffer-name) | |
285 (delete-window) | |
286 (if locate-current-filter | |
287 (error "Locate: no match for %s in database using filter %s" | |
288 search-string locate-current-filter) | |
289 (error "Locate: no match for %s in database" search-string)))) | |
290 | |
291 (locate-insert-header search-string) | |
292 | |
16795
2a9ae2be61ae
(locate-mode): Locally set dired-move-to-filename-regexp,
Richard M. Stallman <rms@gnu.org>
parents:
16781
diff
changeset
|
293 (while (not (eobp)) |
2a9ae2be61ae
(locate-mode): Locally set dired-move-to-filename-regexp,
Richard M. Stallman <rms@gnu.org>
parents:
16781
diff
changeset
|
294 (insert-char ?\ locate-filename-indentation t) |
2a9ae2be61ae
(locate-mode): Locally set dired-move-to-filename-regexp,
Richard M. Stallman <rms@gnu.org>
parents:
16781
diff
changeset
|
295 (locate-set-properties) |
2a9ae2be61ae
(locate-mode): Locally set dired-move-to-filename-regexp,
Richard M. Stallman <rms@gnu.org>
parents:
16781
diff
changeset
|
296 (forward-line 1))))) |
16781 | 297 |
298 (defun locate-set-properties () | |
299 (save-excursion | |
300 (let ((pos (locate-get-file-positions))) | |
301 (add-text-properties (elt pos 0) (elt pos 1) | |
302 (list 'mouse-face locate-mouse-face))))) | |
303 | |
304 (defun locate-insert-header (search-string) | |
305 (let ((locate-format-string "Matches for %s") | |
306 (locate-regexp-match | |
307 (concat " *Matches for \\(" (regexp-quote search-string) "\\)")) | |
308 (locate-format-args (list search-string)) | |
309 ) | |
310 | |
311 (if locate-fcodes-file | |
312 (setq locate-format-string | |
313 (concat locate-format-string " in %s") | |
314 locate-regexp-match | |
315 (concat locate-regexp-match | |
316 " in \\(" | |
317 (regexp-quote locate-fcodes-file) | |
318 "\\)") | |
319 locate-format-args | |
320 (append (list locate-fcodes-file) locate-format-args))) | |
321 | |
322 (if locate-current-filter | |
323 (setq locate-format-string | |
324 (concat locate-format-string " using filter %s") | |
325 locate-regexp-match | |
326 (concat locate-regexp-match | |
327 " using filter " | |
328 "\\(" | |
329 (regexp-quote locate-current-filter) | |
330 "\\)") | |
331 locate-format-args | |
332 (append (list locate-current-filter) locate-format-args))) | |
333 | |
334 (setq locate-format-string | |
335 (concat locate-format-string ": \n\n") | |
336 locate-regexp-match | |
337 (concat locate-regexp-match ": \n")) | |
338 | |
16795
2a9ae2be61ae
(locate-mode): Locally set dired-move-to-filename-regexp,
Richard M. Stallman <rms@gnu.org>
parents:
16781
diff
changeset
|
339 (insert (apply 'format locate-format-string (reverse locate-format-args))) |
16781 | 340 |
341 (save-excursion | |
342 (goto-char (point-min)) | |
343 (if (not (looking-at locate-regexp-match)) | |
344 nil | |
345 (add-text-properties (match-beginning 1) (match-end 1) | |
346 (list 'face locate-header-face)) | |
347 (and (match-beginning 2) | |
348 (add-text-properties (match-beginning 2) (match-end 2) | |
349 (list 'face locate-header-face))) | |
350 (and (match-beginning 3) | |
351 (add-text-properties (match-beginning 3) (match-end 3) | |
352 (list 'face locate-header-face))) | |
353 )))) | |
354 | |
355 (defun locate-tags () | |
356 "Visit a tags table in `*Locate*' mode." | |
357 (interactive) | |
358 (let ((tags-table (locate-get-filename))) | |
359 (if (y-or-n-p (format "Visit tags table %s? " tags-table)) | |
360 (visit-tags-table tags-table) | |
361 nil))) | |
362 | |
363 (provide 'locate) | |
364 | |
365 ;;; locate.el ends here |