diff options
| author | Richard M. Stallman | 1998-03-03 18:17:02 +0000 |
|---|---|---|
| committer | Richard M. Stallman | 1998-03-03 18:17:02 +0000 |
| commit | be8bf2d0b0d5348f4ff0e540f9fdc735e7f448b5 (patch) | |
| tree | 2eda454d20fc1d46173e7f1498352952e69867df | |
| parent | f7111f902a1cbcef5e47848f12d6f1afd59c9a9c (diff) | |
| download | emacs-be8bf2d0b0d5348f4ff0e540f9fdc735e7f448b5.tar.gz emacs-be8bf2d0b0d5348f4ff0e540f9fdc735e7f448b5.zip | |
(locate-update): New function.
(locate-current-line-number): Renamed from `current-line'.
(locate-default-make-command-line): Use list, not cons.
(locate): Added a `save-window-excursion' form.
(locate): Used an `apply' form for the start-process call.
(locate-mode): Now has a `revert-buffer-function'
(locate-do-setup): Now longer deletes window.
(locate-header-face): Use underline, not region.
(locate-update-command): New option.
(locate-command): Changed from defvar to defcustom.
(locate-make-command-line): Changed from defvar to defcustom.
(locate-fcodes-file): Changed from defvar to defcustom.
(locate-mouse-face): Changed from defvar to defcustom.
| -rw-r--r-- | lisp/locate.el | 148 |
1 files changed, 79 insertions, 69 deletions
diff --git a/lisp/locate.el b/lisp/locate.el index 3c89e02ec23..7cc3e0a2102 100644 --- a/lisp/locate.el +++ b/lisp/locate.el | |||
| @@ -1,6 +1,6 @@ | |||
| 1 | ;;; locate.el --- interface to the locate command | 1 | ;;; locate.el --- interface to the locate command |
| 2 | 2 | ||
| 3 | ;; Copyright (C) 1996 Free Software Foundation, Inc. | 3 | ;; Copyright (C) 1996, 1998 Free Software Foundation, Inc. |
| 4 | 4 | ||
| 5 | ;; Author: Peter Breton <pbreton@i-kinetics.com> | 5 | ;; Author: Peter Breton <pbreton@i-kinetics.com> |
| 6 | 6 | ||
| @@ -37,14 +37,11 @@ | |||
| 37 | ;; To set up a function which searches the files database, do something | 37 | ;; To set up a function which searches the files database, do something |
| 38 | ;; like this: | 38 | ;; like this: |
| 39 | ;; | 39 | ;; |
| 40 | ;; (defvar locate-fcodes-file (concat my-home "/fcodes")) | 40 | ;; (defvar locate-fcodes-file "c:/users/peter/fcodes") |
| 41 | ;; (defvar locate-make-command-line 'nt-locate-make-command-line) | 41 | ;; (defvar locate-make-command-line 'nt-locate-make-command-line) |
| 42 | ;; | 42 | ;; |
| 43 | ;; (defun nt-locate-make-command-line (arg) | 43 | ;; (defun nt-locate-make-command-line (arg) |
| 44 | ;; (cons "grep" | 44 | ;; (list "grep" "-i" arg locate-fcodes-file)) |
| 45 | ;; (mapconcat 'identity | ||
| 46 | ;; (list "-i" arg locate-fcodes-file) | ||
| 47 | ;; " "))) | ||
| 48 | ;; | 45 | ;; |
| 49 | ;;;;;;;; ADVICE For dired-make-relative: ;;;;;;;;; | 46 | ;;;;;;;; ADVICE For dired-make-relative: ;;;;;;;;; |
| 50 | ;; | 47 | ;; |
| @@ -58,7 +55,7 @@ | |||
| 58 | ;; (ad-set-arg 2 t) | 55 | ;; (ad-set-arg 2 t) |
| 59 | ;; )) | 56 | ;; )) |
| 60 | ;; | 57 | ;; |
| 61 | ;; Otherwise, dired-make-relative will give error messages like | 58 | ;; Otherwise, `dired-make-relative' will give error messages like |
| 62 | ;; "FILENAME: not in directory tree growing at /" | 59 | ;; "FILENAME: not in directory tree growing at /" |
| 63 | 60 | ||
| 64 | ;;; Commentary: | 61 | ;;; Commentary: |
| @@ -73,30 +70,29 @@ | |||
| 73 | ;; | 70 | ;; |
| 74 | ;; SHELLPROGRAM Name-to-find | 71 | ;; SHELLPROGRAM Name-to-find |
| 75 | ;; | 72 | ;; |
| 76 | ;; set the variable locate-command in your .emacs file. | 73 | ;; set the variable `locate-command' in your .emacs file. |
| 77 | ;; | 74 | ;; |
| 78 | ;; To use a more complicated expression, create a function which | 75 | ;; To use a more complicated expression, create a function which |
| 79 | ;; takes a string (the name to find) as input and returns a cons | 76 | ;; takes a string (the name to find) as input and returns a list. |
| 80 | ;; pair: the car should be the command to be executed, the cdr | 77 | ;; The first element should be the command to be executed, the remaining |
| 81 | ;; should be the arguments, concatenated into a string (including | 78 | ;; elements should be the arguments (including the name to find). Then put |
| 82 | ;; the name to find). Then do | ||
| 83 | ;; | 79 | ;; |
| 84 | ;; (setq locate-make-command-line 'my-locate-command-line) | 80 | ;; (setq locate-make-command-line 'my-locate-command-line) |
| 85 | ;; | 81 | ;; |
| 86 | ;; in your .emacs, using the name of your function in place of | 82 | ;; in your .emacs, using the name of your function in place of |
| 87 | ;; my-locate-command-line | 83 | ;; my-locate-command-line. |
| 88 | ;; | 84 | ;; |
| 89 | ;; You should make sure that whichever command you use works correctly | 85 | ;; 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 | 86 | ;; 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. | 87 | ;; to either be in standard places or located via environment variables. |
| 92 | ;; If the latter, make sure these environment variables are set in | 88 | ;; If the latter, make sure these environment variables are set in |
| 93 | ;; your emacs process | 89 | ;; your emacs process. |
| 94 | ;; | 90 | ;; |
| 95 | ;; Locate-mode assumes that each line output from the locate-command | 91 | ;; Locate-mode assumes that each line output from the locate-command |
| 96 | ;; consists exactly of a file name, possibly preceded or trailed by | 92 | ;; consists exactly of a file name, possibly preceded or trailed by |
| 97 | ;; whitespace. If your file database has other information on the line (for | 93 | ;; whitespace. If your file database has other information on the line (for |
| 98 | ;; example, the file size), you will need to redefine the function | 94 | ;; example, the file size), you will need to redefine the function |
| 99 | ;; locate-get-file-positions to return a list consisting of the first | 95 | ;; `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. | 96 | ;; character in the file name and the last character in the file name. |
| 101 | ;; | 97 | ;; |
| 102 | ;; To use locate-mode, simply type M-x locate and then the string | 98 | ;; To use locate-mode, simply type M-x locate and then the string |
| @@ -106,9 +102,9 @@ | |||
| 106 | ;; compress a file in the locate buffer, the actual file will be | 102 | ;; compress a file in the locate buffer, the actual file will be |
| 107 | ;; compressed, but the entry in the file database will not be | 103 | ;; compressed, but the entry in the file database will not be |
| 108 | ;; affected. Consequently, the database and the filesystem will be out | 104 | ;; affected. Consequently, the database and the filesystem will be out |
| 109 | ;; of sync until the next time the database is updated | 105 | ;; of sync until the next time the database is updated. |
| 110 | ;; | 106 | ;; |
| 111 | ;; The command locate-with-filter keeps only lines matching a | 107 | ;; The command `locate-with-filter' keeps only lines matching a |
| 112 | ;; regular expression; this is often useful to constrain a big search. | 108 | ;; regular expression; this is often useful to constrain a big search. |
| 113 | ;; | 109 | ;; |
| 114 | 110 | ||
| @@ -119,6 +115,8 @@ | |||
| 119 | 115 | ||
| 120 | ;; Variables | 116 | ;; Variables |
| 121 | 117 | ||
| 118 | (defvar locate-current-filter nil) | ||
| 119 | |||
| 122 | (defgroup locate nil | 120 | (defgroup locate nil |
| 123 | "Interface to the locate command." | 121 | "Interface to the locate command." |
| 124 | :prefix "locate-" | 122 | :prefix "locate-" |
| @@ -143,8 +141,8 @@ | |||
| 143 | :group 'locate) | 141 | :group 'locate) |
| 144 | 142 | ||
| 145 | (defcustom locate-fcodes-file nil | 143 | (defcustom locate-fcodes-file nil |
| 146 | "*Database of filenames." | 144 | "*File name for the database of file names." |
| 147 | :type 'file | 145 | :type '(choice file (const nil)) |
| 148 | :group 'locate) | 146 | :group 'locate) |
| 149 | 147 | ||
| 150 | (defcustom locate-mouse-face 'highlight | 148 | (defcustom locate-mouse-face 'highlight |
| @@ -152,17 +150,20 @@ | |||
| 152 | :type 'face | 150 | :type 'face |
| 153 | :group 'locate) | 151 | :group 'locate) |
| 154 | 152 | ||
| 155 | (defcustom locate-header-face 'region | 153 | (defcustom locate-header-face 'underline |
| 156 | "*Face used to highlight the locate header." | 154 | "*Face used to highlight the locate header." |
| 157 | :type 'face | 155 | :type 'face |
| 158 | :group 'locate) | 156 | :group 'locate) |
| 159 | 157 | ||
| 160 | (defvar locate-current-filter nil) | 158 | (defcustom locate-update-command "updatedb" |
| 159 | "The command used to update the locate database." | ||
| 160 | :type 'string | ||
| 161 | :group 'locate) | ||
| 161 | 162 | ||
| 162 | ;; Functions | 163 | ;; Functions |
| 163 | 164 | ||
| 164 | (defun locate-default-make-command-line (search-string) | 165 | (defun locate-default-make-command-line (search-string) |
| 165 | (cons locate-command search-string)) | 166 | (list locate-command search-string)) |
| 166 | 167 | ||
| 167 | ;;;### autoload | 168 | ;;;### autoload |
| 168 | (defun locate (search-string &optional filter) | 169 | (defun locate (search-string &optional filter) |
| @@ -170,38 +171,38 @@ | |||
| 170 | (interactive | 171 | (interactive |
| 171 | (list (read-from-minibuffer "Locate: " nil nil | 172 | (list (read-from-minibuffer "Locate: " nil nil |
| 172 | nil 'locate-history-list))) | 173 | nil 'locate-history-list))) |
| 173 | (let* ((pop-up-windows 1) | 174 | (let* ((locate-cmd-list (funcall locate-make-command-line search-string)) |
| 174 | (locate-cmd-list (funcall locate-make-command-line search-string)) | ||
| 175 | (locate-cmd (car locate-cmd-list)) | 175 | (locate-cmd (car locate-cmd-list)) |
| 176 | (locate-cmd-args (cdr locate-cmd-list)) | 176 | (locate-cmd-args (cdr locate-cmd-list)) |
| 177 | (locate-proc) | 177 | ) |
| 178 | ) | ||
| 179 | 178 | ||
| 180 | ;; Find the Locate buffer | 179 | ;; Find the Locate buffer |
| 181 | (if (not (string-equal (buffer-name) locate-buffer-name)) | 180 | (save-window-excursion |
| 182 | (switch-to-buffer-other-window locate-buffer-name)) | 181 | (set-buffer (get-buffer-create locate-buffer-name)) |
| 183 | 182 | (locate-mode) | |
| 184 | (locate-mode) | 183 | (erase-buffer) |
| 185 | (erase-buffer) | 184 | |
| 186 | 185 | (setq locate-current-filter filter) | |
| 187 | (setq locate-current-filter filter) | 186 | |
| 188 | 187 | (apply 'call-process locate-cmd nil t nil locate-cmd-args) | |
| 189 | (call-process locate-cmd nil t nil locate-cmd-args) | 188 | (and filter |
| 190 | (if filter | 189 | (locate-filter-output filter)) |
| 191 | (locate-filter-output filter)) | ||
| 192 | 190 | ||
| 193 | (locate-do-setup) | 191 | (locate-do-setup) |
| 194 | ) | 192 | ) |
| 195 | ) | 193 | (and (not (string-equal (buffer-name) locate-buffer-name)) |
| 194 | (switch-to-buffer-other-window locate-buffer-name)) | ||
| 195 | ) | ||
| 196 | ) | ||
| 196 | 197 | ||
| 197 | ;;;### autoload | 198 | ;;;### autoload |
| 198 | (defun locate-with-filter (search-string filter) | 199 | (defun locate-with-filter (search-string filter) |
| 199 | "Run the locate command with a filter." | 200 | "Run the locate command with a filter." |
| 200 | (interactive | 201 | (interactive |
| 201 | (list (read-from-minibuffer "Locate: " nil nil | 202 | (list (read-from-minibuffer "Locate: " nil nil |
| 202 | nil 'locate-history-list) | 203 | nil 'locate-history-list) |
| 203 | (read-from-minibuffer "Filter: " nil nil | 204 | (read-from-minibuffer "Filter: " nil nil |
| 204 | nil 'grep-history))) | 205 | nil 'grep-history))) |
| 205 | (locate search-string filter)) | 206 | (locate search-string filter)) |
| 206 | 207 | ||
| 207 | (defun locate-filter-output (filter) | 208 | (defun locate-filter-output (filter) |
| @@ -236,20 +237,20 @@ | |||
| 236 | ;; This variable is used to indent the lines and then to search for | 237 | ;; This variable is used to indent the lines and then to search for |
| 237 | ;; the file name | 238 | ;; the file name |
| 238 | (defconst locate-filename-indentation 4 | 239 | (defconst locate-filename-indentation 4 |
| 239 | "The amount of indentation for each file.") | 240 | "The amount of indentation for each file.") |
| 240 | 241 | ||
| 241 | (defun locate-get-file-positions () | 242 | (defun locate-get-file-positions () |
| 242 | (save-excursion | 243 | (save-excursion |
| 243 | (end-of-line) | 244 | (end-of-line) |
| 244 | (let ((eol (point))) | 245 | (let ((eol (point))) |
| 245 | (beginning-of-line) | 246 | (beginning-of-line) |
| 246 | 247 | ||
| 247 | ;; Assumes names end at the end of the line | 248 | ;; Assumes names end at the end of the line |
| 248 | (forward-char locate-filename-indentation) | 249 | (forward-char locate-filename-indentation) |
| 249 | (list (point) eol)))) | 250 | (list (point) eol)))) |
| 250 | 251 | ||
| 251 | ;; From SQL-mode | 252 | ;; From SQL-mode |
| 252 | (defun current-line () | 253 | (defun locate-current-line-number () |
| 253 | "Return the current line number, as an integer." | 254 | "Return the current line number, as an integer." |
| 254 | (interactive) | 255 | (interactive) |
| 255 | (+ (count-lines (point-min) (point)) | 256 | (+ (count-lines (point-min) (point)) |
| @@ -259,7 +260,7 @@ | |||
| 259 | 260 | ||
| 260 | (defun locate-get-filename () | 261 | (defun locate-get-filename () |
| 261 | (let ((pos (locate-get-file-positions)) | 262 | (let ((pos (locate-get-file-positions)) |
| 262 | (lineno (current-line))) | 263 | (lineno (locate-current-line-number))) |
| 263 | (and (not (eq lineno 1)) | 264 | (and (not (eq lineno 1)) |
| 264 | (not (eq lineno 2)) | 265 | (not (eq lineno 2)) |
| 265 | (buffer-substring (elt pos 0) (elt pos 1))))) | 266 | (buffer-substring (elt pos 0) (elt pos 1))))) |
| @@ -269,7 +270,7 @@ | |||
| 269 | (interactive "@e") | 270 | (interactive "@e") |
| 270 | (save-excursion | 271 | (save-excursion |
| 271 | (goto-char (posn-point (event-start event))) | 272 | (goto-char (posn-point (event-start event))) |
| 272 | (view-file (locate-get-filename)))) | 273 | (view-file (locate-get-filename)))) |
| 273 | 274 | ||
| 274 | ;; Define a mode for locate | 275 | ;; Define a mode for locate |
| 275 | ;; Default directory is set to "/" so that dired commands, which | 276 | ;; Default directory is set to "/" so that dired commands, which |
| @@ -289,6 +290,8 @@ | |||
| 289 | (setq dired-actual-switches "") | 290 | (setq dired-actual-switches "") |
| 290 | (make-local-variable 'dired-permission-flags-regexp) | 291 | (make-local-variable 'dired-permission-flags-regexp) |
| 291 | (setq dired-permission-flags-regexp "^\\( \\)") | 292 | (setq dired-permission-flags-regexp "^\\( \\)") |
| 293 | (make-local-variable 'revert-buffer-function) | ||
| 294 | (setq revert-buffer-function 'locate-update) | ||
| 292 | (run-hooks 'locate-mode-hook)) | 295 | (run-hooks 'locate-mode-hook)) |
| 293 | 296 | ||
| 294 | (defun locate-do-setup () | 297 | (defun locate-do-setup () |
| @@ -297,15 +300,14 @@ | |||
| 297 | (save-excursion | 300 | (save-excursion |
| 298 | 301 | ||
| 299 | ;; Nothing returned from locate command? | 302 | ;; Nothing returned from locate command? |
| 300 | (if (eobp) | 303 | (and (eobp) |
| 301 | (progn | 304 | (progn |
| 302 | (kill-buffer locate-buffer-name) | 305 | (kill-buffer locate-buffer-name) |
| 303 | (delete-window) | 306 | (if locate-current-filter |
| 304 | (if locate-current-filter | 307 | (error "Locate: no match for %s in database using filter %s" |
| 305 | (error "Locate: no match for %s in database using filter %s" | 308 | search-string locate-current-filter) |
| 306 | search-string locate-current-filter) | 309 | (error "Locate: no match for %s in database" search-string)))) |
| 307 | (error "Locate: no match for %s in database" search-string)))) | 310 | |
| 308 | |||
| 309 | (locate-insert-header search-string) | 311 | (locate-insert-header search-string) |
| 310 | 312 | ||
| 311 | (while (not (eobp)) | 313 | (while (not (eobp)) |
| @@ -326,7 +328,7 @@ | |||
| 326 | (locate-format-args (list search-string)) | 328 | (locate-format-args (list search-string)) |
| 327 | ) | 329 | ) |
| 328 | 330 | ||
| 329 | (if locate-fcodes-file | 331 | (and locate-fcodes-file |
| 330 | (setq locate-format-string | 332 | (setq locate-format-string |
| 331 | (concat locate-format-string " in %s") | 333 | (concat locate-format-string " in %s") |
| 332 | locate-regexp-match | 334 | locate-regexp-match |
| @@ -337,7 +339,7 @@ | |||
| 337 | locate-format-args | 339 | locate-format-args |
| 338 | (append (list locate-fcodes-file) locate-format-args))) | 340 | (append (list locate-fcodes-file) locate-format-args))) |
| 339 | 341 | ||
| 340 | (if locate-current-filter | 342 | (and locate-current-filter |
| 341 | (setq locate-format-string | 343 | (setq locate-format-string |
| 342 | (concat locate-format-string " using filter %s") | 344 | (concat locate-format-string " using filter %s") |
| 343 | locate-regexp-match | 345 | locate-regexp-match |
| @@ -374,9 +376,17 @@ | |||
| 374 | "Visit a tags table in `*Locate*' mode." | 376 | "Visit a tags table in `*Locate*' mode." |
| 375 | (interactive) | 377 | (interactive) |
| 376 | (let ((tags-table (locate-get-filename))) | 378 | (let ((tags-table (locate-get-filename))) |
| 377 | (if (y-or-n-p (format "Visit tags table %s? " tags-table)) | 379 | (and (y-or-n-p (format "Visit tags table %s? " tags-table)) |
| 378 | (visit-tags-table tags-table) | 380 | (visit-tags-table tags-table)))) |
| 379 | nil))) | 381 | |
| 382 | ;; From Stephen Eglen <stephen@cns.ed.ac.uk> | ||
| 383 | (defun locate-update (ignore1 ignore2) | ||
| 384 | "Update the locate database. | ||
| 385 | Database is updated using the shell command in `locate-update-command'." | ||
| 386 | (let ((str (car locate-history-list))) | ||
| 387 | (cond ((yes-or-no-p "Update locate database (may take a few seconds)? ") | ||
| 388 | (shell-command locate-update-command) | ||
| 389 | (locate str))))) | ||
| 380 | 390 | ||
| 381 | (provide 'locate) | 391 | (provide 'locate) |
| 382 | 392 | ||