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