24 |
|
|
25 |
;;; Commentary: |
;;; Commentary: |
26 |
|
|
27 |
;; Search a database of files and use dired commands on |
;; Search a database of files and use dired commands on the result. |
|
;; the result. |
|
|
;; |
|
|
|
|
|
;;;;; Building a database of files ;;;;;;;;; |
|
|
;; |
|
|
;; You can create a simple files database with a port of the Unix find command |
|
|
;; and one of the various Windows NT various scheduling utilities, |
|
|
;; for example the AT command from the NT Resource Kit, WinCron which is |
|
|
;; included with Microsoft FrontPage, or the shareware NTCron program. |
|
|
;; |
|
|
;; To set up a function which searches the files database, do something |
|
|
;; like this: |
|
|
;; |
|
|
;; (defvar locate-fcodes-file "c:/users/peter/fcodes") |
|
|
;; (defvar locate-make-command-line 'nt-locate-make-command-line) |
|
|
;; |
|
|
;; (defun nt-locate-make-command-line (arg) |
|
|
;; (list "grep" "-i" arg locate-fcodes-file)) |
|
|
;; |
|
|
;;;;;;;; ADVICE For dired-make-relative: ;;;;;;;;; |
|
|
;; |
|
|
;; For certain dired commands to work right, you should also include the |
|
|
;; following in your _emacs/.emacs: |
|
|
;; |
|
|
;; (defadvice dired-make-relative (before set-no-error activate) |
|
|
;; "For locate mode and Windows, don't return errors" |
|
|
;; (if (and (eq major-mode 'locate-mode) |
|
|
;; (memq system-type (list 'windows-nt 'ms-dos))) |
|
|
;; (ad-set-arg 2 t) |
|
|
;; )) |
|
|
;; |
|
|
;; Otherwise, `dired-make-relative' will give error messages like |
|
|
;; "FILENAME: not in directory tree growing at /" |
|
|
|
|
|
;;; Commentary: |
|
28 |
;; |
;; |
29 |
;; Locate.el provides an interface to a program which searches a |
;; Locate.el provides an interface to a program which searches a |
30 |
;; database of file names. By default, this program is the GNU locate |
;; database of file names. By default, this program is the GNU locate |
74 |
;; regular expression; this is often useful to constrain a big search. |
;; regular expression; this is often useful to constrain a big search. |
75 |
;; |
;; |
76 |
|
|
77 |
|
;;;;; Building a database of files ;;;;;;;;; |
78 |
|
;; |
79 |
|
;; You can create a simple files database with a port of the Unix find command |
80 |
|
;; and one of the various Windows NT various scheduling utilities, |
81 |
|
;; for example the AT command from the NT Resource Kit, WinCron which is |
82 |
|
;; included with Microsoft FrontPage, or the shareware NTCron program. |
83 |
|
;; |
84 |
|
;; To set up a function which searches the files database, do something |
85 |
|
;; like this: |
86 |
|
;; |
87 |
|
;; (defvar locate-fcodes-file "c:/users/peter/fcodes") |
88 |
|
;; (defvar locate-make-command-line 'nt-locate-make-command-line) |
89 |
|
;; |
90 |
|
;; (defun nt-locate-make-command-line (arg) |
91 |
|
;; (list "grep" "-i" arg locate-fcodes-file)) |
92 |
|
;; |
93 |
|
;;;;;;;; ADVICE For dired-make-relative: ;;;;;;;;; |
94 |
|
;; |
95 |
|
;; For certain dired commands to work right, you should also include the |
96 |
|
;; following in your _emacs/.emacs: |
97 |
|
;; |
98 |
|
;; (defadvice dired-make-relative (before set-no-error activate) |
99 |
|
;; "For locate mode and Windows, don't return errors" |
100 |
|
;; (if (and (eq major-mode 'locate-mode) |
101 |
|
;; (memq system-type (list 'windows-nt 'ms-dos))) |
102 |
|
;; (ad-set-arg 2 t) |
103 |
|
;; )) |
104 |
|
;; |
105 |
|
;; Otherwise, `dired-make-relative' will give error messages like |
106 |
|
;; "FILENAME: not in directory tree growing at /" |
107 |
|
|
108 |
|
|
109 |
;;; Code: |
;;; Code: |
110 |
|
|
111 |
(eval-when-compile |
(eval-when-compile |
151 |
:type 'face |
:type 'face |
152 |
:group 'locate) |
:group 'locate) |
153 |
|
|
154 |
|
;;;###autoload |
155 |
|
(defcustom locate-ls-subdir-switches "-al" |
156 |
|
"`ls' switches for inserting subdirectories in `*Locate*' buffers. |
157 |
|
This should contain the \"-l\" switch, but not the \"-F\" or \"-b\" switches." |
158 |
|
:type 'string |
159 |
|
:group 'locate |
160 |
|
:version "21.4") |
161 |
|
|
162 |
(defcustom locate-update-command "updatedb" |
(defcustom locate-update-command "updatedb" |
163 |
"The command used to update the locate database." |
"The command used to update the locate database." |
164 |
:type 'string |
:type 'string |
165 |
:group 'locate) |
:group 'locate) |
166 |
|
|
167 |
(defcustom locate-prompt-for-command nil |
(defcustom locate-prompt-for-command nil |
168 |
"If non-nil, the default behavior of the locate command is to prompt for a command to run. |
"If non-nil, the locate command prompts for a command to run. |
169 |
Otherwise, that behavior is invoked via a prefix argument." |
Otherwise, that behavior is invoked via a prefix argument." |
170 |
:group 'locate |
:group 'locate |
171 |
:type 'boolean |
:type 'boolean |
228 |
(save-window-excursion |
(save-window-excursion |
229 |
(set-buffer (get-buffer-create locate-buffer-name)) |
(set-buffer (get-buffer-create locate-buffer-name)) |
230 |
(locate-mode) |
(locate-mode) |
231 |
(erase-buffer) |
(let ((inhibit-read-only t)) |
232 |
|
(erase-buffer) |
233 |
|
|
234 |
(setq locate-current-filter filter) |
(setq locate-current-filter filter) |
235 |
|
|
236 |
(if run-locate-command |
(if run-locate-command |
237 |
(shell-command search-string locate-buffer-name) |
(shell-command search-string locate-buffer-name) |
238 |
(apply 'call-process locate-cmd nil t nil locate-cmd-args)) |
(apply 'call-process locate-cmd nil t nil locate-cmd-args)) |
239 |
|
|
240 |
(and filter |
(and filter |
241 |
(locate-filter-output filter)) |
(locate-filter-output filter)) |
242 |
|
|
243 |
(locate-do-setup search-string) |
(locate-do-setup search-string) |
244 |
) |
)) |
245 |
(and (not (string-equal (buffer-name) locate-buffer-name)) |
(and (not (string-equal (buffer-name) locate-buffer-name)) |
246 |
(switch-to-buffer-other-window locate-buffer-name)) |
(switch-to-buffer-other-window locate-buffer-name)) |
247 |
|
|
248 |
(run-hooks 'dired-mode-hook) |
(run-hooks 'dired-mode-hook) |
249 |
(dired-next-line 2) ;move to first matching file. |
(dired-next-line 3) ;move to first matching file. |
250 |
(run-hooks 'locate-post-command-hook) |
(run-hooks 'locate-post-command-hook) |
251 |
) |
) |
252 |
) |
) |
287 |
(define-key locate-mode-map [menu-bar mark directories] 'undefined) |
(define-key locate-mode-map [menu-bar mark directories] 'undefined) |
288 |
(define-key locate-mode-map [menu-bar mark symlinks] 'undefined) |
(define-key locate-mode-map [menu-bar mark symlinks] 'undefined) |
289 |
|
|
290 |
(define-key locate-mode-map [mouse-2] 'locate-mouse-view-file) |
(define-key locate-mode-map [M-mouse-2] 'locate-mouse-view-file) |
291 |
(define-key locate-mode-map "\C-c\C-t" 'locate-tags) |
(define-key locate-mode-map "\C-c\C-t" 'locate-tags) |
292 |
|
|
293 |
|
(define-key locate-mode-map "l" 'locate-do-redisplay) |
294 |
(define-key locate-mode-map "U" 'dired-unmark-all-files) |
(define-key locate-mode-map "U" 'dired-unmark-all-files) |
295 |
(define-key locate-mode-map "V" 'locate-find-directory) |
(define-key locate-mode-map "V" 'locate-find-directory) |
296 |
) |
) |
325 |
(not (eq lineno 2)) |
(not (eq lineno 2)) |
326 |
(buffer-substring (elt pos 0) (elt pos 1))))) |
(buffer-substring (elt pos 0) (elt pos 1))))) |
327 |
|
|
328 |
|
(defun locate-main-listing-line-p () |
329 |
|
"Return t if current line contains a file name listed by locate. |
330 |
|
This function returns nil if the current line either contains no |
331 |
|
file name or is inside a subdirectory." |
332 |
|
(save-excursion |
333 |
|
(forward-line 0) |
334 |
|
(looking-at (concat "." |
335 |
|
(make-string (1- locate-filename-indentation) ?\ ) |
336 |
|
"\\(/\\|[A-Za-z]:\\)")))) |
337 |
|
|
338 |
(defun locate-mouse-view-file (event) |
(defun locate-mouse-view-file (event) |
339 |
"In Locate mode, view a file, using the mouse." |
"In Locate mode, view a file, using the mouse." |
340 |
(interactive "@e") |
(interactive "@e") |
341 |
(save-excursion |
(save-excursion |
342 |
(goto-char (posn-point (event-start event))) |
(goto-char (posn-point (event-start event))) |
343 |
(view-file (locate-get-filename)))) |
(if (locate-main-listing-line-p) |
344 |
|
(view-file (locate-get-filename)) |
345 |
|
(message "This command only works inside main listing.")))) |
346 |
|
|
347 |
;; Define a mode for locate |
;; Define a mode for locate |
348 |
;; Default directory is set to "/" so that dired commands, which |
;; Default directory is set to "/" so that dired commands, which |
349 |
;; expect to be in a tree, will work properly |
;; expect to be in a tree, will work properly |
350 |
(defun locate-mode () |
(defun locate-mode () |
351 |
"Major mode for the `*Locate*' buffer made by \\[locate]." |
"Major mode for the `*Locate*' buffer made by \\[locate]. |
352 |
|
\\<locate-mode-map>\ |
353 |
|
In that buffer, you can use almost all the usual dired bindings. |
354 |
|
\\[locate-find-directory] visits the directory of the file on the current line. |
355 |
|
|
356 |
|
Operating on listed files works, but does not always |
357 |
|
automatically update the buffer as in ordinary Dired. |
358 |
|
This is true both for the main listing and for subdirectories. |
359 |
|
Reverting the buffer using \\[revert-buffer] deletes all subdirectories. |
360 |
|
Specific `locate-mode' commands, such as \\[locate-find-directory], |
361 |
|
do not work in subdirectories. |
362 |
|
|
363 |
|
\\{locate-mode-map}" |
364 |
|
;; Not to be called interactively. |
365 |
(kill-all-local-variables) |
(kill-all-local-variables) |
366 |
;; Avoid clobbering this variables |
;; Avoid clobbering this variable |
367 |
(make-local-variable 'dired-subdir-alist) |
(make-local-variable 'dired-subdir-alist) |
368 |
(use-local-map locate-mode-map) |
(use-local-map locate-mode-map) |
369 |
(setq major-mode 'locate-mode |
(setq major-mode 'locate-mode |
370 |
mode-name "Locate" |
mode-name "Locate" |
371 |
default-directory "/") |
default-directory "/" |
372 |
|
buffer-read-only t |
373 |
|
selective-display t) |
374 |
(dired-alist-add-1 default-directory (point-min-marker)) |
(dired-alist-add-1 default-directory (point-min-marker)) |
375 |
|
(set (make-local-variable 'dired-directory) "/") |
376 |
|
(set (make-local-variable 'dired-subdir-switches) locate-ls-subdir-switches) |
377 |
|
(setq dired-switches-alist nil) |
378 |
(make-local-variable 'dired-move-to-filename-regexp) |
(make-local-variable 'dired-move-to-filename-regexp) |
379 |
;; This should support both Unix and Windoze style names |
;; This should support both Unix and Windoze style names |
380 |
(setq dired-move-to-filename-regexp |
(setq dired-move-to-filename-regexp |
381 |
(concat "." |
(concat "^." |
382 |
(make-string (1- locate-filename-indentation) ?\ ) |
(make-string (1- locate-filename-indentation) ?\ ) |
383 |
"\\(/\\|[A-Za-z]:\\)")) |
"\\(/\\|[A-Za-z]:\\)\\|" |
384 |
|
(default-value 'dired-move-to-filename-regexp))) |
385 |
(make-local-variable 'dired-actual-switches) |
(make-local-variable 'dired-actual-switches) |
386 |
(setq dired-actual-switches "") |
(setq dired-actual-switches "") |
387 |
(make-local-variable 'dired-permission-flags-regexp) |
(make-local-variable 'dired-permission-flags-regexp) |
388 |
(setq dired-permission-flags-regexp |
(setq dired-permission-flags-regexp |
389 |
(concat "^.\\(" |
(concat "^.\\(" |
390 |
(make-string (1- locate-filename-indentation) ?\ ) |
(make-string (1- locate-filename-indentation) ?\ ) |
391 |
"\\)")) |
"\\)\\|" |
392 |
|
(default-value 'dired-permission-flags-regexp))) |
393 |
(make-local-variable 'revert-buffer-function) |
(make-local-variable 'revert-buffer-function) |
394 |
(setq revert-buffer-function 'locate-update) |
(setq revert-buffer-function 'locate-update) |
395 |
|
(set (make-local-variable 'page-delimiter) "\n\n") |
396 |
(run-hooks 'locate-mode-hook)) |
(run-hooks 'locate-mode-hook)) |
397 |
|
|
398 |
(defun locate-do-setup (search-string) |
(defun locate-do-setup (search-string) |
422 |
(dired-insert-set-properties (elt pos 0) (elt pos 1))))) |
(dired-insert-set-properties (elt pos 0) (elt pos 1))))) |
423 |
|
|
424 |
(defun locate-insert-header (search-string) |
(defun locate-insert-header (search-string) |
425 |
(let ((locate-format-string "Matches for %s") |
;; There needs to be a space before `Matches, because otherwise, |
426 |
|
;; `*!" would erase the `M'. We can not use two spaces, or the line |
427 |
|
;; would mistakenly fit `dired-subdir-regexp'. |
428 |
|
(let ((locate-format-string " /:\n Matches for %s") |
429 |
(locate-regexp-match |
(locate-regexp-match |
430 |
(concat " *Matches for \\(" (regexp-quote search-string) "\\)")) |
(concat " *Matches for \\(" (regexp-quote search-string) "\\)")) |
431 |
(locate-format-args (list search-string)) |
(locate-format-args (list search-string)) |
463 |
|
|
464 |
(save-excursion |
(save-excursion |
465 |
(goto-char (point-min)) |
(goto-char (point-min)) |
466 |
|
(forward-line 1) |
467 |
(if (not (looking-at locate-regexp-match)) |
(if (not (looking-at locate-regexp-match)) |
468 |
nil |
nil |
469 |
(add-text-properties (match-beginning 1) (match-end 1) |
(add-text-properties (match-beginning 1) (match-end 1) |
479 |
(defun locate-tags () |
(defun locate-tags () |
480 |
"Visit a tags table in `*Locate*' mode." |
"Visit a tags table in `*Locate*' mode." |
481 |
(interactive) |
(interactive) |
482 |
(let ((tags-table (locate-get-filename))) |
(if (locate-main-listing-line-p) |
483 |
(and (y-or-n-p (format "Visit tags table %s? " tags-table)) |
(let ((tags-table (locate-get-filename))) |
484 |
(visit-tags-table tags-table)))) |
(and (y-or-n-p (format "Visit tags table %s? " tags-table)) |
485 |
|
(visit-tags-table tags-table))) |
486 |
|
(message "This command only works inside main listing."))) |
487 |
|
|
488 |
;; From Stephen Eglen <stephen@cns.ed.ac.uk> |
;; From Stephen Eglen <stephen@cns.ed.ac.uk> |
489 |
(defun locate-update (ignore1 ignore2) |
(defun locate-update (ignore1 ignore2) |
502 |
(defun locate-find-directory () |
(defun locate-find-directory () |
503 |
"Visit the directory of the file mentioned on this line." |
"Visit the directory of the file mentioned on this line." |
504 |
(interactive) |
(interactive) |
505 |
(let ((directory-name (locate-get-dirname))) |
(if (locate-main-listing-line-p) |
506 |
(if (file-directory-p directory-name) |
(let ((directory-name (locate-get-dirname))) |
507 |
(find-file directory-name) |
(if (file-directory-p directory-name) |
508 |
(if (file-symlink-p directory-name) |
(find-file directory-name) |
509 |
(error "Directory is a symlink to a nonexistent target") |
(if (file-symlink-p directory-name) |
510 |
(error "Directory no longer exists; run `updatedb' to update database"))))) |
(error "Directory is a symlink to a nonexistent target") |
511 |
|
(error "Directory no longer exists; run `updatedb' to update database")))) |
512 |
|
(message "This command only works inside main listing."))) |
513 |
|
|
514 |
(defun locate-find-directory-other-window () |
(defun locate-find-directory-other-window () |
515 |
"Visit the directory of the file named on this line in other window." |
"Visit the directory of the file named on this line in other window." |
562 |
string)))))) |
string)))))) |
563 |
(locate search-string))) |
(locate search-string))) |
564 |
|
|
565 |
|
(defun locate-do-redisplay (&optional arg test-for-subdir) |
566 |
|
"Like `dired-do-redisplay', but adapted for `*Locate*' buffers." |
567 |
|
(interactive "P\np") |
568 |
|
(if (string= (dired-current-directory) "/") |
569 |
|
(message "This command only works in subdirectories.") |
570 |
|
(let ((dired-actual-switches locate-ls-subdir-switches)) |
571 |
|
(dired-do-redisplay arg test-for-subdir)))) |
572 |
|
|
573 |
(provide 'locate) |
(provide 'locate) |
574 |
|
|
575 |
;;; arch-tag: 60c4d098-b5d5-4b3c-a3e0-51a2e9f43898 |
;;; arch-tag: 60c4d098-b5d5-4b3c-a3e0-51a2e9f43898 |