/[emacs]/emacs/lisp/locate.el
ViewVC logotype

Diff of /emacs/lisp/locate.el

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.20.6.1 by handa, Fri Apr 16 12:50:07 2004 UTC revision 1.20.6.2 by miles, Mon Jun 28 07:28:42 2004 UTC
# Line 24  Line 24 
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
# Line 109  Line 74 
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
# Line 154  Line 151 
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
# Line 223  With prefix arg, prompt for the locate c Line 228  With prefix arg, prompt for the locate c
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    )    )
# Line 281  shown; this is often useful to constrain Line 287  shown; this is often useful to constrain
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  )  )
# Line 318  shown; this is often useful to constrain Line 325  shown; this is often useful to constrain
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)
# Line 382  shown; this is often useful to constrain Line 422  shown; this is often useful to constrain
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))
# Line 420  shown; this is often useful to constrain Line 463  shown; this is often useful to constrain
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)
# Line 435  shown; this is often useful to constrain Line 479  shown; this is often useful to constrain
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)
# Line 456  Database is updated using the shell comm Line 502  Database is updated using the shell comm
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."
# Line 514  Database is updated using the shell comm Line 562  Database is updated using the shell comm
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

Legend:
Removed from v.1.20.6.1  
changed lines
  Added in v.1.20.6.2

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26