Mercurial > hg > xemacs-beta
comparison lisp/dired/dired-x.el @ 0:376386a54a3c r19-14
Import from CVS: tag r19-14
| author | cvs |
|---|---|
| date | Mon, 13 Aug 2007 08:45:50 +0200 |
| parents | |
| children | ac2d302a0011 |
comparison
equal
deleted
inserted
replaced
| -1:000000000000 | 0:376386a54a3c |
|---|---|
| 1 ;;; dired-x.el --- Sebastian Kremer's Extra DIRED hacked up for GNU Emacs19 | |
| 2 ;; Keywords: dired extensions | |
| 3 | |
| 4 (defconst dired-extra-version (substring "!Revision: 1.191 !" 11 -2) | |
| 5 "Id: dired-x.el,v 1.191 1992/05/14 11:41:54 sk RelBeta ") | |
| 6 | |
| 7 ;; Copyright (C) 1991 Sebastian Kremer. | |
| 8 | |
| 9 ;; This file is part of XEmacs. | |
| 10 | |
| 11 ;; XEmacs is free software; you can redistribute it and/or modify it | |
| 12 ;; under the terms of the GNU General Public License as published by | |
| 13 ;; the Free Software Foundation; either version 2, or (at your option) | |
| 14 ;; any later version. | |
| 15 | |
| 16 ;; XEmacs is distributed in the hope that it will be useful, but | |
| 17 ;; WITHOUT ANY WARRANTY; without even the implied warranty of | |
| 18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU | |
| 19 ;; General Public License for more details. | |
| 20 | |
| 21 ;; You should have received a copy of the GNU General Public License | |
| 22 ;; along with XEmacs; see the file COPYING. If not, write to the Free | |
| 23 ;; Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. | |
| 24 | |
| 25 ;; LISPDIR ENTRY for the Elisp Archive =============================== | |
| 26 ;; LCD Archive Entry: | |
| 27 ;; dired-x|Sebastian Kremer|sk@thp.uni-koeln.de | |
| 28 ;; |Extra Features for Tree Dired | |
| 29 ;; |Date: 1992/05/14 11:41:54 |Revision: 1.191 | | |
| 30 | |
| 31 ;; INSTALLATION ====================================================== | |
| 32 | |
| 33 ;; In your ~/.emacs, say | |
| 34 ;; | |
| 35 ;; (setq dired-load-hook '(lambda () (load "dired-x"))) | |
| 36 ;; | |
| 37 ;; At load time dired-x will install itself using the various other | |
| 38 ;; dired hooks. It will redefine some functions and bind dired keys. | |
| 39 ;; If gmhist is present, dired-x will take advantage of it. | |
| 40 | |
| 41 (require 'dired) ; we will redefine some functions | |
| 42 ; and also need some macros | |
| 43 | |
| 44 (provide 'dired-extra) ; but this file is "dired-x" | |
| 45 (provide 'dired-x) ; but this file is "dired-x" | |
| 46 | |
| 47 ;; Customization (see also defvars in other sections below) | |
| 48 | |
| 49 ;; user should define this as `nil' prior to loading dired-x in order that the | |
| 50 ;; compression/decompression material of emacs19 is not overwritten. | |
| 51 (defvar dired-mark-keys '("Z") | |
| 52 "*List of keys (strings) that insert themselves as file markers.") | |
| 53 | |
| 54 (defvar dired-dangerous-shell-command "^rm" ; e.g. "rm" or "rmdir" | |
| 55 "*Regexp for dangerous shell commands that should never be the default.") | |
| 56 | |
| 57 ;; Add key bindings. This file is supposed to be loaded immediately | |
| 58 ;; after dired, inside dired-load-hook. | |
| 59 | |
| 60 (define-key dired-mode-map "V" 'dired-vm) | |
| 61 (define-key dired-mode-map "\(" 'dired-set-marker-char) | |
| 62 (define-key dired-mode-map "\)" 'dired-restore-marker-char) | |
| 63 (define-key dired-mode-map "I" 'dired-do-insert-subdir) | |
| 64 ;;(define-key dired-mode-map "\M-f" 'dired-flag-extension) | |
| 65 (define-key dired-mode-map "\M-M" 'dired-do-unmark) | |
| 66 (define-key dired-mode-map "\M-o" 'dired-omit-toggle) | |
| 67 (define-key dired-mode-map "\M-(" 'dired-mark-sexp) | |
| 68 (define-key dired-mode-map "," 'dired-mark-rcs-files) | |
| 69 (define-key dired-mode-map "\M-!" 'dired-smart-shell-command) | |
| 70 (define-key dired-mode-map "\M-&" 'dired-smart-background-shell-command) | |
| 71 (define-key dired-mode-map "T" 'dired-do-toggle) | |
| 72 (define-key dired-mode-map "w" 'dired-copy-filename-as-kill) | |
| 73 (define-key dired-mode-map "\M-g" 'dired-goto-file) | |
| 74 (define-key dired-mode-map "\M-G" 'dired-goto-subdir) | |
| 75 (define-key dired-mode-map "&" 'dired-do-background-shell-command) | |
| 76 (define-key dired-mode-map "A" 'dired-do-byte-compile-and-load) | |
| 77 (define-key dired-mode-map "F" 'dired-do-find-file) | |
| 78 (define-key dired-mode-map "S" 'dired-do-relsymlink) | |
| 79 (define-key dired-mode-map "%S" 'dired-do-relsymlink-regexp) | |
| 80 | |
| 81 (mapcar (function;; do this last to override bindings above | |
| 82 (lambda (x) | |
| 83 (define-key dired-mode-map x 'dired-mark-with-this-char))) | |
| 84 dired-mark-keys) | |
| 85 | |
| 86 ;; Install ourselves into the appropriate hooks | |
| 87 | |
| 88 (defun dired-add-hook (hook-var function) | |
| 89 "Add a function to a hook. | |
| 90 First argument HOOK-VAR (a symbol) is the name of a hook, second | |
| 91 argument FUNCTION is the function to add. | |
| 92 Returns nil if FUNCTION was already present in HOOK-VAR, else new | |
| 93 value of HOOK-VAR." | |
| 94 (interactive "SAdd to hook-var (symbol): \naAdd which function to %s? ") | |
| 95 (if (not (boundp hook-var)) (set hook-var nil)) | |
| 96 (if (or (not (listp (symbol-value hook-var))) | |
| 97 (eq (car (symbol-value hook-var)) 'lambda)) | |
| 98 (set hook-var (list (symbol-value hook-var)))) | |
| 99 (if (memq function (symbol-value hook-var)) | |
| 100 nil | |
| 101 (set hook-var (cons function (symbol-value hook-var))))) | |
| 102 | |
| 103 (dired-add-hook 'dired-mode-hook 'dired-extra-startup) | |
| 104 (dired-add-hook 'dired-after-readin-hook 'dired-omit-expunge) | |
| 105 | |
| 106 (defvar dired-default-marker dired-marker-char | |
| 107 "*The value of `dired-marker-char' in effect before dired-x was | |
| 108 loaded and the value which is restored if the marker stack underflows. | |
| 109 This is usually the asterisk `*'.") | |
| 110 | |
| 111 ;;;###autoload | |
| 112 (defun dired-extra-startup () | |
| 113 "Automatically put on dired-mode-hook to get extra dired features: | |
| 114 \\<dired-mode-map> | |
| 115 \\[dired-vm]\t-- VM on folder | |
| 116 \\[dired-rmail]\t-- Rmail on folder | |
| 117 \\[dired-do-insert-subdir]\t-- insert all marked subdirs | |
| 118 \\[dired-do-find-file]\t-- visit all marked files simultaneously | |
| 119 \\[dired-set-marker-char], \\[dired-restore-marker-char]\t-- change and display dired-marker-char dynamically. | |
| 120 \\[dired-omit-toggle]\t-- toggle omitting of files | |
| 121 \\[dired-mark-sexp]\t-- mark by lisp expression | |
| 122 \\[dired-do-unmark]\t-- replace existing marker with another. | |
| 123 \\[dired-mark-rcs-files]\t-- mark all RCS controlled files | |
| 124 \\[dired-mark-files-compilation-buffer]\t-- mark compilation files | |
| 125 \\[dired-copy-filename-as-kill]\t-- copy the file or subdir names into the kill ring. | |
| 126 \t You can feed it to other commands using \\[yank]. | |
| 127 | |
| 128 For more features, see variables | |
| 129 | |
| 130 dired-omit-files | |
| 131 dired-omit-extenstions | |
| 132 dired-dangerous-shell-command | |
| 133 dired-mark-keys | |
| 134 dired-local-variables-file | |
| 135 dired-find-subdir | |
| 136 dired-guess-have-gnutar | |
| 137 dired-auto-shell-command-alist | |
| 138 | |
| 139 See also functions | |
| 140 | |
| 141 dired-sort-on-size | |
| 142 dired-do-relsymlink | |
| 143 dired-flag-extension | |
| 144 dired-virtual | |
| 145 dired-jump-back | |
| 146 dired-jump-back-other-window | |
| 147 " | |
| 148 (interactive) | |
| 149 ;; This must be done in each new dired buffer: | |
| 150 (dired-hack-local-variables) | |
| 151 (dired-omit-startup) | |
| 152 (dired-marker-stack-startup)) | |
| 153 | |
| 154 ;;; Handle customization | |
| 155 | |
| 156 (or (fboundp 'read-with-history-in) ; it's loaded | |
| 157 (not (subrp (symbol-function 'read-from-minibuffer))) ; it's 19.4L | |
| 158 ;; else try to load gmhist | |
| 159 (load "gmhist" t)) | |
| 160 | |
| 161 (if (not (fboundp 'read-with-history-in)) | |
| 162 | |
| 163 nil ; Gmhist is not available | |
| 164 | |
| 165 ;; Else use generic minibuffer history | |
| 166 (put 'dired-shell-command-history 'dangerous dired-dangerous-shell-command) | |
| 167 | |
| 168 ;; Redefinition - when this is loaded, dired.el has alreay been loaded. | |
| 169 | |
| 170 (defun dired-read-regexp (prompt &optional initial) | |
| 171 (setq dired-flagging-regexp | |
| 172 (if (null initial) | |
| 173 (read-with-history-in 'regexp-history prompt initial) | |
| 174 (put 'regexp-history 'default | |
| 175 nil) | |
| 176 (put 'regexp-history 'default | |
| 177 (read-with-history-in 'regexp-history prompt initial))))) | |
| 178 | |
| 179 (defun dired-read-dir-and-switches (str) | |
| 180 (nreverse | |
| 181 (list | |
| 182 (if current-prefix-arg | |
| 183 (read-string "Dired listing switches: " dired-listing-switches)) | |
| 184 (read-file-name-with-history-in | |
| 185 'file-history ; or 'dired-history? | |
| 186 (format "Dired %s(directory): " str) nil default-directory nil)))) | |
| 187 ) | |
| 188 | |
| 189 | |
| 190 | |
| 191 ;;; Dynamic Markers | |
| 192 | |
| 193 (defun dired-mark-with-this-char (arg) | |
| 194 "Mark the current file or subdir with the last key you pressed to invoke | |
| 195 this command. Else like \\[dired-mark-subdir-or-file] command." | |
| 196 (interactive "p") | |
| 197 (let ((dired-marker-char;; use last character, in case of prefix cmd | |
| 198 last-command-char)) | |
| 199 (dired-mark-subdir-or-file arg))) | |
| 200 | |
| 201 (defvar dired-marker-stack nil | |
| 202 "List of previously used dired marker characters.") | |
| 203 | |
| 204 (defvar dired-marker-string "" | |
| 205 "String version of `dired-marker-stack'.") | |
| 206 | |
| 207 (defun dired-current-marker-string () | |
| 208 "Computes and returns `dired-marker-string'." | |
| 209 (setq dired-marker-string | |
| 210 (concat " " | |
| 211 (mapconcat (function char-to-string) | |
| 212 (reverse dired-marker-stack) | |
| 213 "")))) | |
| 214 | |
| 215 (defun dired-marker-stack-startup () | |
| 216 (make-local-variable 'dired-marker-char) | |
| 217 (make-local-variable 'dired-del-marker) | |
| 218 (make-local-variable 'dired-marker-stack) | |
| 219 (or (assq 'dired-marker-stack minor-mode-alist) | |
| 220 (setq minor-mode-alist | |
| 221 (cons '(dired-marker-stack dired-marker-string) | |
| 222 minor-mode-alist)))) | |
| 223 | |
| 224 (defun dired-set-marker-char (c) | |
| 225 "Set the marker character to something else. | |
| 226 Use \\[dired-restore-marker-char] to restore the previous value." | |
| 227 (interactive "cNew marker character: ") | |
| 228 (setq dired-marker-stack (cons c dired-marker-stack)) | |
| 229 (dired-current-marker-string) | |
| 230 (setq dired-marker-char c) | |
| 231 (set-buffer-modified-p (buffer-modified-p)) ; update mode line | |
| 232 (message "New marker is %c" dired-marker-char)) | |
| 233 | |
| 234 (defun dired-restore-marker-char () | |
| 235 "Restore the marker character to its previous value. | |
| 236 Uses `dired-default-marker' if the marker stack is empty." | |
| 237 (interactive) | |
| 238 (setq dired-marker-stack (cdr dired-marker-stack) | |
| 239 dired-marker-char (car dired-marker-stack)) | |
| 240 (dired-current-marker-string) | |
| 241 (set-buffer-modified-p (buffer-modified-p)) ; update mode line | |
| 242 (or dired-marker-char (setq dired-marker-char dired-default-marker)) | |
| 243 (message "Marker is %c" dired-marker-char)) | |
| 244 | |
| 245 ;;; Sort on Size kludge if your ls can't do it | |
| 246 | |
| 247 (defun dired-sort-on-size () | |
| 248 "Sorts a dired listing on file size. | |
| 249 If your ls cannot sort on size, this is useful as `dired-after-readin-hook': | |
| 250 \(setq dired-after-readin-hook 'dired-sort-on-size\)" | |
| 251 (require 'sort) | |
| 252 (goto-char (point-min)) | |
| 253 (dired-goto-next-file) ; skip `total' line | |
| 254 (beginning-of-line) | |
| 255 (sort-subr t ; biggest file first | |
| 256 'forward-line 'end-of-line 'dired-get-file-size)) | |
| 257 | |
| 258 (defun dired-get-file-size () | |
| 259 (re-search-forward "\\(Jan\\|Feb\\|Mar\\|Apr\\|May\\|Jun\\|Jul\\|Aug\\|Sep\\|Oct\\|Nov\\|Dec\\)") | |
| 260 (goto-char (match-beginning 1)) | |
| 261 (forward-char -1) | |
| 262 (string-to-int (buffer-substring (save-excursion | |
| 263 (backward-word 1) | |
| 264 (point)) | |
| 265 (point)))) | |
| 266 | |
| 267 | |
| 268 ;;; Misc. (mostly featurismic) commands | |
| 269 | |
| 270 ;; Mail folders | |
| 271 | |
| 272 (defvar dired-vm-read-only-folders nil | |
| 273 "*If t, \\[dired-vm] will visit all folders read-only. | |
| 274 If neither nil nor t, e.g. the symbol `if-file-read-only', only | |
| 275 files not writable by you are visited read-only. | |
| 276 | |
| 277 Read-only folders only work in VM 5, not in VM 4.") | |
| 278 | |
| 279 (defun dired-vm (&optional read-only) | |
| 280 "Run VM on this file. | |
| 281 With prefix arg, visit folder read-only (this requires at least VM 5). | |
| 282 See also variable `dired-vm-read-only-folders'." | |
| 283 (interactive "P") | |
| 284 (let ((dir (dired-current-directory)) | |
| 285 (fil (dired-get-filename))) | |
| 286 ;; take care to supply 2nd arg only if requested - may still run VM 4! | |
| 287 (cond (read-only (vm-visit-folder fil t)) | |
| 288 ((eq t dired-vm-read-only-folders) (vm-visit-folder fil t)) | |
| 289 ((null dired-vm-read-only-folders) (vm-visit-folder fil)) | |
| 290 (t (vm-visit-folder fil (not (file-writable-p fil))))) | |
| 291 ;; so that pressing `v' inside VM does prompt within current directory: | |
| 292 (set (make-local-variable 'vm-folder-directory) dir))) | |
| 293 | |
| 294 (defun dired-rmail () | |
| 295 "Run RMAIL on this file." | |
| 296 (interactive) | |
| 297 (rmail (dired-get-filename))) | |
| 298 | |
| 299 ;; More subdir operations | |
| 300 | |
| 301 (defun dired-do-insert-subdir () | |
| 302 "Insert all marked subdirectories in situ that are not yet inserted. | |
| 303 Non-directories are silently ignored." | |
| 304 (interactive) | |
| 305 (let ((files (or (dired-mark-get-files) | |
| 306 (error "No files marked.")))) | |
| 307 (while files | |
| 308 (if (file-directory-p (car files)) | |
| 309 (save-excursion (dired-maybe-insert-subdir (car files)))) | |
| 310 (setq files (cdr files))))) | |
| 311 | |
| 312 (defun dired-mark-extension (extension &optional marker-char) | |
| 313 "Mark all files with a certain extension for use in later commands. | |
| 314 A `.' is not automatically prepended to the string entered." | |
| 315 ;; EXTENSION may also be a list of extensions instead of a single one. | |
| 316 ;; Optional MARKER-CHAR is marker to use. | |
| 317 (interactive "sMarking extension: \nP") | |
| 318 (or (listp extension) | |
| 319 (setq extension (list extension))) | |
| 320 (dired-mark-files-regexp | |
| 321 (concat ".";; don't match names with nothing but an extension | |
| 322 "\\(" | |
| 323 (mapconcat 'regexp-quote extension "\\|") | |
| 324 "\\)$") | |
| 325 marker-char)) | |
| 326 | |
| 327 (defun dired-flag-extension (extension) | |
| 328 "In dired, flag all files with a certain extension for deletion. | |
| 329 A `.' is *not* automatically prepended to the string entered." | |
| 330 (interactive "sFlagging extension: ") | |
| 331 (dired-mark-extension extension dired-del-marker)) | |
| 332 | |
| 333 (defvar patch-unclean-extensions | |
| 334 '(".rej" ".orig") | |
| 335 "List of extensions of dispensable files created by the `patch' program.") | |
| 336 | |
| 337 (defvar tex-unclean-extensions | |
| 338 '(".toc" ".log" ".aux");; these are already in completion-ignored-extensions | |
| 339 "List of extensions of dispensable files created by TeX.") | |
| 340 | |
| 341 (defvar latex-unclean-extensions | |
| 342 '(".idx" ".lof" ".lot" ".glo") | |
| 343 "List of extensions of dispensable files created by LaTeX.") | |
| 344 | |
| 345 (defvar bibtex-unclean-extensions | |
| 346 '(".blg" ".bbl") | |
| 347 "List of extensions of dispensable files created by BibTeX.") | |
| 348 | |
| 349 (defvar texinfo-unclean-extensions | |
| 350 '(".cp" ".cps" ".fn" ".fns" ".ky" ".kys" ".pg" ".pgs" | |
| 351 ".tp" ".tps" ".vr" ".vrs") | |
| 352 "List of extensions of dispensable files created by texinfo.") | |
| 353 | |
| 354 (defun dired-clean-patch () | |
| 355 "Flag dispensable files created by patch for deletion. | |
| 356 See variable `patch-unclean-extensions'." | |
| 357 (interactive) | |
| 358 (dired-flag-extension patch-unclean-extensions)) | |
| 359 | |
| 360 (defun dired-clean-tex () | |
| 361 "Flag dispensable files created by tex etc. for deletion. | |
| 362 See variable `texinfo-unclean-extensions', `latex-unclean-extensions', | |
| 363 `bibtex-unclean-extensions' and `texinfo-unclean-extensions'." | |
| 364 (interactive) | |
| 365 (dired-flag-extension (append texinfo-unclean-extensions | |
| 366 latex-unclean-extensions | |
| 367 bibtex-unclean-extensions | |
| 368 tex-unclean-extensions))) | |
| 369 | |
| 370 (defun dired-do-unmark (unmarker) | |
| 371 "Unmark marked files by replacing the marker with another character. | |
| 372 The new character defaults to a space, effectively unmarking them." | |
| 373 (interactive "sChange marker to: ") | |
| 374 (if (string= unmarker "") | |
| 375 (setq unmarker " ")) | |
| 376 (setq unmarker (substring unmarker 0 1)) | |
| 377 (let ((regexp (dired-marker-regexp)) | |
| 378 (buffer-read-only nil)) | |
| 379 (save-excursion | |
| 380 (goto-char (point-min)) | |
| 381 (while (re-search-forward regexp nil t) | |
| 382 (replace-match unmarker))))) | |
| 383 | |
| 384 ;; This is unused but might come in handy sometime | |
| 385 ;(defun dired-directories-of (files) | |
| 386 ; ;; Return unique list of parent directories of FILES. | |
| 387 ; (let (dirs dir file) | |
| 388 ; (while files | |
| 389 ; (setq file (car files) | |
| 390 ; files (cdr files) | |
| 391 ; dir (file-name-directory file)) | |
| 392 ; (or (member dir dirs) | |
| 393 ; (setq dirs (cons dir dirs)))) | |
| 394 ; dirs)) | |
| 395 | |
| 396 ;; Adapted from code by wurgler@zippysun.math.uakron.edu (Tom Wurgler). | |
| 397 ;; Suggest you bind it to a key. I use C-x C-j. | |
| 398 (defun dired-jump-back (&optional other-window) | |
| 399 "Jump back to dired: | |
| 400 If in a file, dired the current directory and move to file's line. | |
| 401 If in dired already, pop up a level and goto old directory's line. | |
| 402 In case the proper dired file line cannot be found, refresh the dired | |
| 403 buffer and try again." | |
| 404 (interactive) | |
| 405 (let* ((file buffer-file-name) | |
| 406 (dir (if file (file-name-directory file) default-directory))) | |
| 407 (if (eq major-mode 'dired-mode) | |
| 408 (progn | |
| 409 (setq dir (dired-current-directory)) | |
| 410 (if other-window | |
| 411 (dired-up-directory-other-window) | |
| 412 (dired-up-directory)) | |
| 413 (dired-really-goto-file dir)) | |
| 414 (if other-window | |
| 415 (dired-other-window dir) | |
| 416 (dired dir)) | |
| 417 (if file (dired-really-goto-file file))))) | |
| 418 | |
| 419 (defun dired-jump-back-other-window () | |
| 420 "Like \\[dired-jump-back], but to other window." | |
| 421 (interactive) | |
| 422 (dired-jump-back t)) | |
| 423 | |
| 424 (defun dired-really-goto-file (file) | |
| 425 (or (dired-goto-file file) | |
| 426 (progn ; refresh and try again | |
| 427 (dired-insert-subdir (file-name-directory file)) | |
| 428 (dired-goto-file file)))) | |
| 429 | |
| 430 (defun dired-up-directory-other-window () | |
| 431 "Like `dired-up-directory', but in other window." | |
| 432 (interactive) | |
| 433 (let* ((dir (dired-current-directory)) | |
| 434 (up (file-name-directory (directory-file-name dir)))) | |
| 435 (or (dired-goto-file (directory-file-name dir)) | |
| 436 (dired-goto-subdir up) | |
| 437 ;; Only in this case it really uses another window: | |
| 438 (progn | |
| 439 (dired-other-window up) | |
| 440 (dired-goto-file dir))))) | |
| 441 | |
| 442 (defun dired-mark-rcs-files (&optional unflag-p) | |
| 443 "Mark all files that are under RCS control. | |
| 444 With prefix argument, unflag all those files. | |
| 445 Mentions RCS files for which a working file was not found in this buffer. | |
| 446 Type \\[dired-why] to see them again." | |
| 447 ;; Returns failures, or nil on success. | |
| 448 ;; Finding those with locks would require to peek into the ,v file, | |
| 449 ;; depends slightly on the RCS version used and should be done | |
| 450 ;; together with the Emacs RCS interface. | |
| 451 ;; Unfortunately, there is no definitive RCS interface yet. | |
| 452 (interactive "P") | |
| 453 (message "%sarking RCS controlled files..." (if unflag-p "Unm" "M")) | |
| 454 (let ((dired-marker-char (if unflag-p ?\ dired-marker-char)) | |
| 455 rcs-files wf failures count total) | |
| 456 (mapcar ; loop over subdirs | |
| 457 (function | |
| 458 (lambda (dir) | |
| 459 (or (equal (file-name-nondirectory (directory-file-name dir)) | |
| 460 "RCS") | |
| 461 ;; skip inserted RCS subdirs | |
| 462 (setq rcs-files | |
| 463 (append (directory-files dir t ",v$") ; *,v and RCS/*,v | |
| 464 (let ((rcs-dir (expand-file-name "RCS" dir))) | |
| 465 (if (file-directory-p rcs-dir) | |
| 466 (mapcar ; working files from ./RCS are in ./ | |
| 467 (function | |
| 468 (lambda (x) | |
| 469 (expand-file-name x dir))) | |
| 470 (directory-files | |
| 471 (file-name-as-directory rcs-dir) nil ",v$")))) | |
| 472 rcs-files))))) | |
| 473 (mapcar (function car) dired-subdir-alist)) | |
| 474 (setq total (length rcs-files)) | |
| 475 (while rcs-files | |
| 476 (setq wf (substring (car rcs-files) 0 -2) | |
| 477 rcs-files (cdr rcs-files)) | |
| 478 (save-excursion (if (dired-goto-file wf) | |
| 479 (dired-mark-file 1) | |
| 480 (setq failures (cons wf failures))))) | |
| 481 (if (null failures) | |
| 482 (message "%d RCS file%s %smarked." | |
| 483 total (dired-plural-s total) (if unflag-p "un" "")) | |
| 484 (setq count (length failures)) | |
| 485 (dired-log-summary "RCS working file not found %s" failures) | |
| 486 (message "%d RCS file%s: %d %smarked - %d not found %s." | |
| 487 total (dired-plural-s total) (- total count) | |
| 488 (if unflag-p "un" "") count failures)) | |
| 489 failures)) | |
| 490 | |
| 491 (defun dired-do-toggle () | |
| 492 "Toggle marks. | |
| 493 That is, currently marked files become unmarked and vice versa. | |
| 494 Files marked with other flags (such as `D') are not affected. | |
| 495 `.' and `..' are never toggled. | |
| 496 As always, hidden subdirs are not affected." | |
| 497 (interactive) | |
| 498 (save-excursion | |
| 499 (goto-char (point-min)) | |
| 500 (let (buffer-read-only) | |
| 501 (while (not (eobp)) | |
| 502 (or (dired-between-files) | |
| 503 (looking-at dired-re-dot) | |
| 504 ;; use subst instead of insdel because it does not move | |
| 505 ;; the gap and thus should be faster and because | |
| 506 ;; other characters are left alone automatically | |
| 507 (apply 'subst-char-in-region | |
| 508 (point) (1+ (point)) | |
| 509 (if (eq ?\040 (following-char)) ; SPC | |
| 510 (list ?\040 dired-marker-char) | |
| 511 (list dired-marker-char ?\040)))) | |
| 512 (forward-line 1))))) | |
| 513 | |
| 514 ;; This function is missing in simple.el | |
| 515 (defun copy-string-as-kill (string) | |
| 516 "Save STRING as if killed in a buffer." | |
| 517 (setq kill-ring (cons string kill-ring)) | |
| 518 (if (> (length kill-ring) kill-ring-max) | |
| 519 (setcdr (nthcdr (1- kill-ring-max) kill-ring) nil)) | |
| 520 (setq kill-ring-yank-pointer kill-ring)) | |
| 521 | |
| 522 (defvar dired-marked-files nil | |
| 523 "List of filenames from last `dired-copy-filename-as-kill' call.") | |
| 524 | |
| 525 (defun dired-copy-filename-as-kill (&optional arg) | |
| 526 "Copy names of marked (or next ARG) files into the kill ring. | |
| 527 The names are separated by a space. | |
| 528 With a zero prefix arg, use the complete pathname of each marked file. | |
| 529 With a raw (just \\[universal-argument]) prefix arg, use the relative pathname of each marked file. | |
| 530 | |
| 531 If on a subdir headerline and no prefix arg given, use subdirname instead. | |
| 532 | |
| 533 You can then feed the file name to other commands with \\[yank]. | |
| 534 | |
| 535 The list of names is also stored onto the variable | |
| 536 `dired-marked-files' for use, e.g., in an `\\[eval-expression]' command." | |
| 537 (interactive "P") | |
| 538 (copy-string-as-kill | |
| 539 (or (and (not arg) | |
| 540 (dired-get-subdir)) | |
| 541 (mapconcat (function identity) | |
| 542 (setq dired-marked-files | |
| 543 (if arg | |
| 544 (cond ((zerop (prefix-numeric-value arg)) | |
| 545 (dired-mark-get-files)) | |
| 546 ((integerp arg) | |
| 547 (dired-mark-get-files 'no-dir arg)) | |
| 548 (t ; else a raw arg | |
| 549 (dired-mark-get-files t))) | |
| 550 (dired-mark-get-files 'no-dir))) | |
| 551 " "))) | |
| 552 (message "%s" (car kill-ring))) | |
| 553 | |
| 554 (defun dired-do-background-shell-command (&optional arg) | |
| 555 "Like \\[dired-do-shell-command], but starts command in background. | |
| 556 Note that you can type input to the command in its buffer. | |
| 557 This requires background.el from the comint package to work." | |
| 558 ;; With the version in emacs-19.el, you can alternatively just | |
| 559 ;; append an `&' to any shell command to make it run in the | |
| 560 ;; background, but you can't type input to it. | |
| 561 (interactive "P") | |
| 562 (dired-do-shell-command arg t)) | |
| 563 | |
| 564 ;; redefines dired.el to put back in the dired-offer-kill-buffer | |
| 565 ;; feature which rms didn't like. | |
| 566 (defun dired-clean-up-after-deletion (fn) | |
| 567 ;; Clean up after a deleted file or directory FN. | |
| 568 ;; Remove expanded subdir of deleted dir, if any | |
| 569 (save-excursion (and (dired-goto-subdir fn) | |
| 570 (dired-kill-subdir))) | |
| 571 ;; Offer to kill buffer of deleted file FN. | |
| 572 (let ((buf (get-file-buffer fn))) | |
| 573 (and buf | |
| 574 (funcall (function y-or-n-p) | |
| 575 (format "Kill buffer of %s, too? " | |
| 576 (file-name-nondirectory fn))) | |
| 577 (save-excursion;; you never know where kill-buffer leaves you | |
| 578 (kill-buffer buf)))) | |
| 579 (let ((buf-list (dired-buffers-for-top-dir fn)) | |
| 580 (buf nil)) | |
| 581 (and buf-list | |
| 582 (y-or-n-p (format "Kill dired buffer%s of %s, too? " | |
| 583 (dired-plural-s (length buf-list)) | |
| 584 (file-name-nondirectory fn))) | |
| 585 (while buf-list | |
| 586 (save-excursion (kill-buffer (car buf-list))) | |
| 587 (setq buf-list (cdr buf-list))))) | |
| 588 ;; Anything else? | |
| 589 ) | |
| 590 | |
| 591 ;;; Omitting | |
| 592 | |
| 593 ;;; Enhanced omitting of lines from directory listings. | |
| 594 ;;; Marked files are never omitted. | |
| 595 ;;; Adapted from code submitted by: | |
| 596 ;;; Michael D. Ernst, mernst@theory.lcs.mit.edu, 1/11/91 | |
| 597 | |
| 598 (make-variable-buffer-local | |
| 599 (defvar dired-omit-files-p nil | |
| 600 "*If non-nil, \"uninteresting\" files are not listed (buffer-local). | |
| 601 Use \\[dired-omit-toggle] to toggle its value. | |
| 602 Uninteresting files are those whose filenames match regexp `dired-omit-files', | |
| 603 plus those ending with extensions in `dired-omit-extensions'.")) | |
| 604 | |
| 605 (defvar dired-omit-files "^#\\|\\.$" | |
| 606 "*Filenames matching this regexp will not be displayed (buffer-local). | |
| 607 This only has effect when `dired-omit-files-p' is t. | |
| 608 See also `dired-omit-extensions'.") | |
| 609 | |
| 610 (defvar dired-omit-extensions | |
| 611 (append completion-ignored-extensions | |
| 612 latex-unclean-extensions | |
| 613 bibtex-unclean-extensions | |
| 614 texinfo-unclean-extensions) | |
| 615 "*If non-nil, a list of extensions (strings) to omit from Dired | |
| 616 listings. Defaults to the elements of | |
| 617 `completion-ignored-extensions', `latex-unclean-extensions', | |
| 618 `bibtex-unclean-extensions' and `texinfo-unclean-extensions'.") | |
| 619 | |
| 620 ;; should probably get rid of this and always use 'no-dir. | |
| 621 ;; sk 28-Aug-1991 09:37 | |
| 622 (defvar dired-omit-localp 'no-dir | |
| 623 "The LOCALP argument dired-omit-expunge passes to dired-get-filename. | |
| 624 If it is 'no-dir, omitting is much faster, but you can only match | |
| 625 against the basename of the file. Set it to nil if you need to match the | |
| 626 whole pathname.") | |
| 627 | |
| 628 ;; \017=^O for Omit - other packages can chose other control characters. | |
| 629 (defvar dired-omit-marker-char ?\017 | |
| 630 "Temporary marker used by by dired-omit. | |
| 631 Should never be used as marker by the user or other packages.") | |
| 632 | |
| 633 (defun dired-omit-startup () | |
| 634 (or (assq 'dired-omit-files-p minor-mode-alist) | |
| 635 ;; Append at end so that it doesn't get between "Dired" and "by name". | |
| 636 (setq minor-mode-alist | |
| 637 (append minor-mode-alist '((dired-omit-files-p " Omit")))))) | |
| 638 | |
| 639 (defun dired-omit-toggle (&optional flag) | |
| 640 "Toggle between displaying and omitting files matching `dired-omit-files'. | |
| 641 With an arg, and if omitting was off, don't toggle and just mark the | |
| 642 files but don't actually omit them. | |
| 643 With an arg, and if omitting was on, turn it off but don't refresh the buffer." | |
| 644 (interactive "P") | |
| 645 (if flag | |
| 646 (if dired-omit-files-p | |
| 647 (setq dired-omit-files-p (not dired-omit-files-p)) | |
| 648 (dired-mark-unmarked-files (dired-omit-regexp) nil nil | |
| 649 dired-omit-localp)) | |
| 650 ;; no FLAG | |
| 651 (setq dired-omit-files-p (not dired-omit-files-p)) | |
| 652 (if (not dired-omit-files-p) | |
| 653 (revert-buffer) | |
| 654 ;; this will mention how many were omitted: | |
| 655 (dired-omit-expunge)))) | |
| 656 | |
| 657 ;; This is sometimes let-bound to t if messages would be annoying, | |
| 658 ;; e.g., in dired-awrh.el. | |
| 659 (defvar dired-omit-silent nil) | |
| 660 | |
| 661 ;; in emacs19 `(dired-do-kill)' is called `(dired-do-kill-lines)' | |
| 662 (if (fboundp 'dired-do-kill-lines) | |
| 663 (fset 'dired-do-kill 'dired-do-kill-lines)) | |
| 664 | |
| 665 (defun dired-omit-expunge (&optional regexp) | |
| 666 "Erases all unmarked files matching REGEXP. | |
| 667 Does nothing if global variable `dired-omit-files-p' is nil. | |
| 668 If REGEXP is nil or not specified, uses `dired-omit-files', and also omits | |
| 669 filenames ending in `dired-omit-extensions'. | |
| 670 If REGEXP is the empty string, this function is a no-op. | |
| 671 | |
| 672 This functions works by temporarily binding `dired-marker-char' to | |
| 673 `dired-omit-marker-char' and calling `dired-do-kill'." | |
| 674 (interactive "sOmit files (regexp): ") | |
| 675 (if dired-omit-files-p | |
| 676 (let ((omit-re (or regexp (dired-omit-regexp))) | |
| 677 count) | |
| 678 (or (string= omit-re "") | |
| 679 (let ((dired-marker-char dired-omit-marker-char)) | |
| 680 (or dired-omit-silent (message "Omitting...")) | |
| 681 (if (dired-mark-unmarked-files | |
| 682 omit-re nil nil dired-omit-localp) | |
| 683 (setq count (dired-do-kill nil (if dired-omit-silent | |
| 684 "" | |
| 685 "Omitted %d line%s."))) | |
| 686 (or dired-omit-silent | |
| 687 (message "(Nothing to omit)"))))) | |
| 688 count))) | |
| 689 | |
| 690 (defun dired-omit-regexp () | |
| 691 (concat (if dired-omit-files (concat "\\(" dired-omit-files "\\)") "") | |
| 692 (if (and dired-omit-files dired-omit-extensions) "\\|" "") | |
| 693 (if dired-omit-extensions | |
| 694 (concat ".";; a non-extension part should exist | |
| 695 "\\(" | |
| 696 (mapconcat 'regexp-quote dired-omit-extensions "\\|") | |
| 697 "\\)$") | |
| 698 ""))) | |
| 699 | |
| 700 ;; Returns t if any work was done, nil otherwise. | |
| 701 (defun dired-mark-unmarked-files (regexp msg &optional unflag-p localp) | |
| 702 "Marks unmarked files matching REGEXP, displaying MSG. | |
| 703 REGEXP is matched against the complete pathname. | |
| 704 Does not re-mark files which already have a mark. | |
| 705 With prefix argument, unflag all those files. | |
| 706 Second optional argument LOCALP is as in `dired-get-filename'." | |
| 707 (interactive "P") | |
| 708 (let ((dired-marker-char (if unflag-p ?\ dired-marker-char))) | |
| 709 (dired-mark-if | |
| 710 (and | |
| 711 ;; not already marked | |
| 712 (looking-at " ") | |
| 713 ;; uninteresting | |
| 714 (let ((fn (dired-get-filename localp t))) | |
| 715 (and fn (string-match regexp fn)))) | |
| 716 msg))) | |
| 717 | |
| 718 (defun dired-omit-new-add-entry (filename &optional marker-char) | |
| 719 ;; This redefines dired.el's dired-add-entry to avoid calling ls for | |
| 720 ;; files that are going to be omitted anyway. | |
| 721 (if dired-omit-files-p | |
| 722 ;; perhaps return t without calling ls | |
| 723 (let ((omit-re (dired-omit-regexp))) | |
| 724 (if (or (string= omit-re "") | |
| 725 (not | |
| 726 (string-match omit-re | |
| 727 (cond | |
| 728 ((eq 'no-dir dired-omit-localp) | |
| 729 filename) | |
| 730 ((eq t dired-omit-localp) | |
| 731 (dired-make-relative filename)) | |
| 732 (t | |
| 733 (dired-make-absolute filename directory)))))) | |
| 734 ;; if it didn't match, go ahead and add the entry | |
| 735 (dired-omit-old-add-entry filename marker-char) | |
| 736 ;; dired-add-entry returns t for success, perhaps we should | |
| 737 ;; return file-exists-p | |
| 738 t)) | |
| 739 ;; omitting is not turned on at all | |
| 740 (dired-omit-old-add-entry filename marker-char))) | |
| 741 | |
| 742 ;; Save old defun if not already done: | |
| 743 (or (fboundp 'dired-omit-old-add-entry) | |
| 744 (fset 'dired-omit-old-add-entry (symbol-function 'dired-add-entry))) | |
| 745 ;; Redefine dired.el | |
| 746 (fset 'dired-add-entry 'dired-omit-new-add-entry) | |
| 747 | |
| 748 | |
| 749 ;; | |
| 750 (defun dired-mark-sexp (predicate &optional unflag-p) | |
| 751 "Mark files for which PREDICATE returns non-nil. | |
| 752 With a prefix arg, unflag those files instead. | |
| 753 | |
| 754 PREDICATE is a lisp expression that can refer to the following symbols: | |
| 755 | |
| 756 inode [integer] the inode of the file (only for ls -i output) | |
| 757 s [integer] the size of the file for ls -s output | |
| 758 (ususally in blocks or, with -k, in KByte) | |
| 759 mode [string] file permission bits, e.g. \"-rw-r--r--\" | |
| 760 nlink [integer] number of links to file | |
| 761 uid [string] owner | |
| 762 gid [string] group (If the gid is not displayed by ls, | |
| 763 this will still be set (to the same as uid)) | |
| 764 size [integer] file size in bytes | |
| 765 time [string] the time that ls displays, e.g. \"Feb 12 14:17\" | |
| 766 name [string] the name of the file | |
| 767 sym [string] if file is a symbolic link, the linked-to name, else \"\" | |
| 768 | |
| 769 For example, use | |
| 770 | |
| 771 (equal 0 size) | |
| 772 | |
| 773 to mark all zero length files." | |
| 774 ;; Using sym="" instead of nil avoids the trap of | |
| 775 ;; (string-match "foo" sym) into which a user would soon fall. | |
| 776 ;; Give `equal' instead of `=' in the example, as this works on | |
| 777 ;; integers and strings. | |
| 778 (interactive "xMark if (lisp expr): \nP") | |
| 779 (message "%s" predicate) | |
| 780 (let ((dired-marker-char (if unflag-p ?\040 dired-marker-char)) | |
| 781 inode s mode nlink uid gid size time name sym) | |
| 782 (dired-mark-if | |
| 783 (save-excursion (and (dired-parse-ls) | |
| 784 (eval predicate))) | |
| 785 (format "'%s file" predicate)) | |
| 786 ;; With Jamie's compiler we could do the following instead: | |
| 787 ; (eval (byte-compile-sexp | |
| 788 ; (macroexpand | |
| 789 ; (` (dired-mark-if | |
| 790 ; (save-excursion (and (dired-parse-ls) | |
| 791 ; (, predicate))) | |
| 792 ; (format "'%s file" (quote (, predicate)))))))) | |
| 793 ;; This isn't measurably faster, though, at least for simple predicates. | |
| 794 ;; Caching compiled predicates might be interesting if you use | |
| 795 ;; this command a lot or with complicated predicates. | |
| 796 ;; Alternatively compiling PREDICATE by hand should not be too | |
| 797 ;; hard - e.g., if it uses just one variable, not all of the ls | |
| 798 ;; line needs to be parsed. | |
| 799 )) | |
| 800 | |
| 801 (if (fboundp 'gmhist-make-magic) | |
| 802 (gmhist-make-magic 'dired-mark-sexp 'eval-expression-history)) | |
| 803 | |
| 804 (defun dired-parse-ls () | |
| 805 ;; Sets vars | |
| 806 ;; inode s mode nlink uid gid size time name sym | |
| 807 ;; (probably let-bound in caller) according to current file line. | |
| 808 ;; Returns t for succes, nil if this is no file line. | |
| 809 ;; Upon success, all variables are set, either to nil or the | |
| 810 ;; appropriate value, so they need not be initialized. | |
| 811 ;; Moves point within the current line. | |
| 812 (if (dired-move-to-filename) | |
| 813 (let (pos | |
| 814 (mode-len 10) ; length of mode string | |
| 815 ;; like in dired.el, but with subexpressions \1=inode, \2=s: | |
| 816 (dired-re-inode-size "\\s *\\([0-9]*\\)\\s *\\([0-9]*\\) ?")) | |
| 817 (beginning-of-line) | |
| 818 (forward-char 2) | |
| 819 (if (looking-at dired-re-inode-size) | |
| 820 (progn | |
| 821 (goto-char (match-end 0)) | |
| 822 (setq inode (string-to-int (buffer-substring (match-beginning 1) | |
| 823 (match-end 1))) | |
| 824 s (string-to-int (buffer-substring (match-beginning 2) | |
| 825 (match-end 2))))) | |
| 826 (setq inode nil | |
| 827 s nil)) | |
| 828 (setq mode (buffer-substring (point) (+ mode-len (point)))) | |
| 829 (forward-char mode-len) | |
| 830 (setq nlink (read (current-buffer))) | |
| 831 (setq uid (buffer-substring (point) (progn (forward-word 1) (point)))) | |
| 832 (re-search-forward "\\(Jan\\|Feb\\|Mar\\|Apr\\|May\\|Jun\\|Jul\\|Aug\\|Sep\\|Oct\\|Nov\\|Dec\\)") | |
| 833 (goto-char (match-beginning 1)) | |
| 834 (forward-char -1) | |
| 835 (setq size (string-to-int (buffer-substring (save-excursion | |
| 836 (backward-word 1) | |
| 837 (setq pos (point))) | |
| 838 (point)))) | |
| 839 (goto-char pos) | |
| 840 (backward-word 1) | |
| 841 ;; if no gid is displayed, gid will be set to uid | |
| 842 ;; but user will then not reference it anyway in PREDICATE. | |
| 843 (setq gid (buffer-substring (save-excursion (forward-word 1) (point)) | |
| 844 (point)) | |
| 845 time (buffer-substring (match-beginning 1) | |
| 846 (1- (dired-move-to-filename))) | |
| 847 name (buffer-substring (point) | |
| 848 (or (dired-move-to-end-of-filename t) | |
| 849 (point))) | |
| 850 sym (progn | |
| 851 (if (looking-at " -> ") | |
| 852 (buffer-substring (progn (forward-char 4) (point)) | |
| 853 (progn (end-of-line) (point))) | |
| 854 ""))) | |
| 855 t) | |
| 856 nil)) | |
| 857 | |
| 858 | |
| 859 ;; tester | |
| 860 ;;(defun dired-parse-ls-show () | |
| 861 ;; (interactive) | |
| 862 ;; (let (inode s mode size uid gid nlink time name sym) | |
| 863 ;; (if (dired-parse-ls) | |
| 864 ;; (message "%s" (list inode s mode nlink uid gid size time name sym)) | |
| 865 ;; (message "Not on a file line.")))) | |
| 866 | |
| 867 | |
| 868 ;; Mark files whose names appear in another buffer. | |
| 869 | |
| 870 (defun dired-mark-these-files (file-list from) | |
| 871 ;; Mark the files in FILE-LIST. Relative filenames are taken to be | |
| 872 ;; in the current dired directory. | |
| 873 ;; FROM is a string (used for logging) describing where FILE-LIST | |
| 874 ;; came from. | |
| 875 ;; Logs files that were not found and displays a success or failure | |
| 876 ;; message. | |
| 877 (message "Marking files %s..." from) | |
| 878 (let ((total (length file-list)) | |
| 879 (cur-dir (dired-current-directory)) | |
| 880 file failures) | |
| 881 (while file-list | |
| 882 (setq file (dired-make-absolute (car file-list) cur-dir) | |
| 883 file-list (cdr file-list)) | |
| 884 ;;(message "Marking file `%s'" file) | |
| 885 (save-excursion | |
| 886 (if (dired-goto-file file) | |
| 887 (dired-mark-file 1) | |
| 888 (setq failures (cons (dired-make-relative file) failures)) | |
| 889 (dired-log "Cannot mark this file (not found): %s\n" file)))) | |
| 890 (if failures | |
| 891 (dired-log-summary (message "Failed to mark %d of %d files %s %s" | |
| 892 (length failures) total from failures)) | |
| 893 (message "Marked %d file%s %s." total (dired-plural-s total) from)))) | |
| 894 | |
| 895 (defun dired-mark-files-from-other-dired-buffer (buf) | |
| 896 "Mark files that are marked in the other Dired buffer. | |
| 897 I.e, mark those files in this Dired buffer that have the same | |
| 898 non-directory part as the marked files in the Dired buffer in the other window." | |
| 899 (interactive (list (window-buffer (next-window)))) | |
| 900 (if (eq (get-buffer buf) (current-buffer)) | |
| 901 (error "Other dired buffer is the same")) | |
| 902 (or (stringp buf) (setq buf (buffer-name buf))) | |
| 903 (let ((other-files (save-excursion | |
| 904 (set-buffer buf) | |
| 905 (or (eq major-mode 'dired-mode) | |
| 906 (error "%s is not a dired buffer" buf)) | |
| 907 (dired-mark-get-files 'no-dir)))) | |
| 908 (dired-mark-these-files other-files (concat "from buffer " buf)))) | |
| 909 | |
| 910 (defun dired-mark-files-compilation-buffer (&optional regexp buf) | |
| 911 "Mark the files mentioned in the `*compilation*' buffer. | |
| 912 With an arg, you may specify the other buffer and your own regexp | |
| 913 instead of `compilation-error-regexp'. | |
| 914 Use `^.+$' (the default with a prefix arg) to match complete lines or | |
| 915 an empty string for `compilation-error-regexp'. | |
| 916 In conjunction with narrowing the other buffer you can mark an | |
| 917 arbitrary list of files, one per line, with this command." | |
| 918 (interactive | |
| 919 (if current-prefix-arg | |
| 920 (list | |
| 921 (read-string "Use compilation regexp: " "^.+$") | |
| 922 (read-buffer "Use buffer: " | |
| 923 (let ((next-buffer (window-buffer (next-window)))) | |
| 924 (if (eq next-buffer (current-buffer)) | |
| 925 (other-buffer) | |
| 926 next-buffer)))))) | |
| 927 (let (other-files user-regexp-p) | |
| 928 (if (zerop (length regexp)) ; nil or "" | |
| 929 (setq regexp compilation-error-regexp) | |
| 930 (setq user-regexp-p t)) | |
| 931 (or buf (setq buf "*compilation*")) | |
| 932 (or (stringp buf) (setq buf (buffer-name buf))) | |
| 933 (save-excursion | |
| 934 (set-buffer (or (get-buffer buf) | |
| 935 (error "No %s buffer!" buf))) | |
| 936 (goto-char (point-min)) | |
| 937 (let (file new-file) | |
| 938 (while (re-search-forward regexp nil t) | |
| 939 (setq new-file | |
| 940 (buffer-substring | |
| 941 ;; If user specified a regexp with subexpr 1, and it | |
| 942 ;; matched, take that one for the file name, else | |
| 943 ;; take whole match. | |
| 944 ;; Else take the match from the compile regexp | |
| 945 (if user-regexp-p | |
| 946 (or (match-beginning 1) | |
| 947 (match-beginning 0)) | |
| 948 (match-beginning 1)) | |
| 949 (if user-regexp-p | |
| 950 (or (match-end 1) | |
| 951 (match-end 0)) | |
| 952 (match-beginning 2)))) | |
| 953 (or (equal file new-file) | |
| 954 ;; Avoid marking files twice as this is slow. Multiple | |
| 955 ;; lines for the same file are common when compiling. | |
| 956 (setq other-files (cons new-file other-files) | |
| 957 file new-file))))) | |
| 958 (dired-mark-these-files other-files (concat "from buffer " buf)))) | |
| 959 | |
| 960 | |
| 961 ;; make-symbolic-link always expand-file-name's its args, so relative | |
| 962 ;; symlinks (e.g. "foo" -> "../bar/foo") are impossible to create. | |
| 963 ;; Following code uses ln -s for a workaround. | |
| 964 | |
| 965 (defvar dired-keep-marker-relsymlink ?S | |
| 966 "See variable `dired-keep-marker-move'.") | |
| 967 | |
| 968 (defun dired-make-symbolic-link (name1 name2 &optional ok-if-already-exists) | |
| 969 ;; Args NAME1 NAME2 &optional OK-IF-ALREADY-EXISTS. | |
| 970 ;; Create file NAME2, a symbolic link pointing to NAME1 (which may | |
| 971 ;; be any string whatsoever and is passed untouched to ln -s). | |
| 972 ;; OK-IF-ALREADY-EXISTS means that NAME2 will be overwritten if it | |
| 973 ;; already exists. If it is an integer, user will be asked about this. | |
| 974 ;; On error, signals a file-error. | |
| 975 (interactive "FSymlink to (string): \nFMake symbolic link to `%s': \np") | |
| 976 (setq name2 (expand-file-name name2)) | |
| 977 (let* ((file-symlink-p (file-symlink-p name2)) | |
| 978 (file-exists-p (file-exists-p name2)) ; dereferences symlinks | |
| 979 (file-or-symlink-exists (or file-symlink-p file-exists-p))) | |
| 980 (if (and file-symlink-p (not file-exists-p)) | |
| 981 ;; We do something dirty here as dired.el never checks | |
| 982 ;; file-symlink-p in addition to file-exists-p. | |
| 983 ;; This way me make sure we never silently overwrite even | |
| 984 ;; symlinks to non-existing files (what an achievement! ;-) | |
| 985 (setq ok-if-already-exists 1)) | |
| 986 (if (or (null ok-if-already-exists) | |
| 987 (integerp ok-if-already-exists)) | |
| 988 (if (and file-or-symlink-exists | |
| 989 (not (and (integerp ok-if-already-exists) | |
| 990 (yes-or-no-p | |
| 991 (format | |
| 992 "File %s already exists; symlink anyway? " | |
| 993 name2))))) | |
| 994 (signal 'file-error (cons "File already exists" name2)))) | |
| 995 ;; Bombs if NAME1 starts with "-", but not all ln programs may | |
| 996 ;; understand "--" to mean end of options...sigh | |
| 997 (let (err) | |
| 998 (if file-or-symlink-exists (delete-file name2)) | |
| 999 (setq err (dired-check-process "SymLink" "ln" "-s" name1 name2)) | |
| 1000 (if err | |
| 1001 (signal 'file-error (cons "ln" err)))))) | |
| 1002 | |
| 1003 (defun dired-make-relative-symlink (file1 file2 &optional ok-if-already-exists) | |
| 1004 "Three arguments: FILE1 FILE2 &optional OK-IF-ALREADY-EXISTS | |
| 1005 Make a symbolic link (pointing to FILE1) in FILE2. | |
| 1006 The link is relative (if possible), for example | |
| 1007 | |
| 1008 \"/vol/tex/bin/foo\" \"/vol/local/bin/foo\" | |
| 1009 | |
| 1010 results in | |
| 1011 | |
| 1012 \"../../tex/bin/foo\" \"/vol/local/bin/foo\" | |
| 1013 " | |
| 1014 (interactive "FRelSymLink: \nFRelSymLink %s: \np") | |
| 1015 (let (name1 name2 len1 len2 (index 0) sub) | |
| 1016 (setq file1 (expand-file-name file1) | |
| 1017 file2 (expand-file-name file2) | |
| 1018 len1 (length file1) | |
| 1019 len2 (length file2)) | |
| 1020 ;; Find common initial pathname components: | |
| 1021 (let (next) | |
| 1022 (while (and (setq next (string-match "/" file1 index)) | |
| 1023 (setq next (1+ next)) | |
| 1024 (< next (min len1 len2)) | |
| 1025 ;; For the comparison, both substrings must end in | |
| 1026 ;; `/', so NEXT is *one plus* the result of the | |
| 1027 ;; string-match. | |
| 1028 ;; E.g., consider the case of linking "/tmp/a/abc" | |
| 1029 ;; to "/tmp/abc" erronously giving "/tmp/a" instead | |
| 1030 ;; of "/tmp/" as common initial component | |
| 1031 (string-equal (substring file1 0 next) | |
| 1032 (substring file2 0 next))) | |
| 1033 (setq index next)) | |
| 1034 (setq name2 file2 | |
| 1035 sub (substring file1 0 index) | |
| 1036 name1 (substring file1 index))) | |
| 1037 (if (string-equal sub "/") | |
| 1038 ;; No common initial pathname found | |
| 1039 (setq name1 file1) | |
| 1040 ;; Else they have a common parent directory | |
| 1041 (let ((tem (substring file2 index)) | |
| 1042 (start 0) | |
| 1043 (count 0)) | |
| 1044 ;; Count number of slashes we must compensate for ... | |
| 1045 (while (setq start (string-match "/" tem start)) | |
| 1046 (setq count (1+ count) | |
| 1047 start (1+ start))) | |
| 1048 ;; ... and prepend a "../" for each slash found: | |
| 1049 (while (> count 0) | |
| 1050 (setq count (1- count) | |
| 1051 name1 (concat "../" name1))))) | |
| 1052 (dired-make-symbolic-link | |
| 1053 (directory-file-name name1) ; must not link to foo/ | |
| 1054 ; (trailing slash!) | |
| 1055 name2 ok-if-already-exists))) | |
| 1056 | |
| 1057 (defun dired-do-relsymlink (&optional arg) | |
| 1058 "Symlink all marked (or next ARG) files into a directory, | |
| 1059 or make a symbolic link to the current file. | |
| 1060 This creates relative symbolic links like | |
| 1061 | |
| 1062 foo -> ../bar/foo | |
| 1063 | |
| 1064 not absolute ones like | |
| 1065 | |
| 1066 foo -> /ugly/path/that/may/change/any/day/bar/foo" | |
| 1067 (interactive "P") | |
| 1068 (dired-do-create-files 'relsymlink (function dired-make-relative-symlink) | |
| 1069 "RelSymLink" arg dired-keep-marker-relsymlink)) | |
| 1070 | |
| 1071 ;; XEmacs: added extra arg per tbarker@sun059.cpdsc.com (Ted Barker) | |
| 1072 (defun dired-do-relsymlink-regexp (regexp newname &optional arg whole-path) | |
| 1073 "RelSymlink all marked files containing REGEXP to NEWNAME. | |
| 1074 See functions `dired-rename-regexp' and `dired-do-relsymlink' | |
| 1075 for more info. With optional prefix ARG, will operate on ARG files following | |
| 1076 point if no files are marked." | |
| 1077 (interactive (dired-mark-read-regexp "RelSymLink")) | |
| 1078 (dired-do-create-files-regexp | |
| 1079 (function dired-make-relative-symlink) | |
| 1080 "RelSymLink" arg regexp newname whole-path dired-keep-marker-relsymlink)) | |
| 1081 | |
| 1082 ;; Virtual dired mode to browse ls -lR listings | |
| 1083 ;; sk@sun5 7-Mar-1991 16:00 | |
| 1084 | |
| 1085 (fset 'virtual-dired 'dired-virtual) | |
| 1086 (defun dired-virtual (dirname &optional switches) | |
| 1087 "Put this buffer into Virtual Dired mode. | |
| 1088 | |
| 1089 In Virtual Dired mode, all commands that do not actually consult the | |
| 1090 filesystem will work. | |
| 1091 | |
| 1092 This is useful if you want to peruse and move around in an ls -lR | |
| 1093 output file, for example one you got from an ftp server. With | |
| 1094 ange-ftp, you can even dired a directory containing an ls-lR file, | |
| 1095 visit that file and turn on virtual dired mode. But don't try to save | |
| 1096 this file, as dired-virtual indents the listing and thus changes the | |
| 1097 buffer. | |
| 1098 | |
| 1099 If you have save a Dired buffer in a file you can use \\[dired-virtual] to | |
| 1100 resume it in a later session. | |
| 1101 | |
| 1102 Type \\<dired-mode-map>\\[revert-buffer] in the | |
| 1103 Virtual Dired buffer and answer `y' to convert the virtual to a real | |
| 1104 dired buffer again. You don't have to do this, though: you can relist | |
| 1105 single subdirs using \\[dired-do-redisplay]. | |
| 1106 " | |
| 1107 | |
| 1108 ;; DIRNAME is the top level directory of the buffer. It will become | |
| 1109 ;; its `default-directory'. If nil, the old value of | |
| 1110 ;; default-directory is used. | |
| 1111 | |
| 1112 ;; Optional SWITCHES are the ls switches to use. | |
| 1113 | |
| 1114 ;; Shell wildcards will be used if there already is a `wildcard' | |
| 1115 ;; line in the buffer (thus it is a saved Dired buffer), but there | |
| 1116 ;; is no other way to get wildcards. Insert a `wildcard' line by | |
| 1117 ;; hand if you want them. | |
| 1118 | |
| 1119 (interactive | |
| 1120 (list (read-string "Virtual Dired directory: " (dired-virtual-guess-dir)))) | |
| 1121 (goto-char (point-min)) | |
| 1122 (or (looking-at " ") | |
| 1123 ;; if not already indented, do it now: | |
| 1124 (indent-region (point-min) (point-max) 2)) | |
| 1125 (or dirname (setq dirname default-directory)) | |
| 1126 (setq dirname (expand-file-name (file-name-as-directory dirname))) | |
| 1127 (setq default-directory dirname) ; contains no wildcards | |
| 1128 (let ((wildcard (save-excursion | |
| 1129 (goto-char (point-min)) | |
| 1130 (forward-line 1) | |
| 1131 (and (looking-at "^ wildcard ") | |
| 1132 (buffer-substring (match-end 0) | |
| 1133 (progn (end-of-line) (point))))))) | |
| 1134 (if wildcard | |
| 1135 (setq dirname (expand-file-name wildcard default-directory)))) | |
| 1136 ;; If raw ls listing (not a saved old dired buffer), give it a | |
| 1137 ;; decent subdir headerline: | |
| 1138 (goto-char (point-min)) | |
| 1139 (or (looking-at dired-subdir-regexp) | |
| 1140 (dired-insert-headerline default-directory)) | |
| 1141 (dired-mode dirname (or switches dired-listing-switches)) | |
| 1142 (setq mode-name "Virtual Dired" | |
| 1143 revert-buffer-function 'dired-virtual-revert) | |
| 1144 (set (make-local-variable 'dired-subdir-alist) nil) | |
| 1145 (dired-build-subdir-alist) | |
| 1146 (goto-char (point-min)) | |
| 1147 (dired-initial-position dirname)) | |
| 1148 | |
| 1149 (defun dired-virtual-guess-dir () | |
| 1150 | |
| 1151 ;; Guess and return appropriate working directory of this buffer, | |
| 1152 ;; assumed to be in Dired or ls -lR format. | |
| 1153 ;; The guess is based upon buffer contents. | |
| 1154 ;; If nothing could be guessed, returns nil. | |
| 1155 | |
| 1156 (let ((regexp "^\\( \\)?\\([^ \n\r]*\\)\\(:\\)[\n\r]") | |
| 1157 (subexpr 2)) | |
| 1158 (goto-char (point-min)) | |
| 1159 (cond ((looking-at regexp) | |
| 1160 ;; If a saved dired buffer, look to which dir and | |
| 1161 ;; perhaps wildcard it belongs: | |
| 1162 (let ((dir (buffer-substring (match-beginning subexpr) | |
| 1163 (match-end subexpr)))) | |
| 1164 (file-name-as-directory dir))) | |
| 1165 ;; Else no match for headerline found. It's a raw ls listing. | |
| 1166 ;; In raw ls listings the directory does not have a headerline | |
| 1167 ;; try parent of first subdir, if any | |
| 1168 ((re-search-forward regexp nil t) | |
| 1169 (file-name-directory | |
| 1170 (directory-file-name | |
| 1171 (file-name-as-directory | |
| 1172 (buffer-substring (match-beginning subexpr) | |
| 1173 (match-end subexpr)))))) | |
| 1174 (t ; if all else fails | |
| 1175 nil)))) | |
| 1176 | |
| 1177 | |
| 1178 (defun dired-virtual-revert (&optional arg noconfirm) | |
| 1179 (if (not | |
| 1180 (y-or-n-p "Cannot revert a Virtual Dired buffer - switch to Real Dired mode? ")) | |
| 1181 (error "Cannot revert a Virtual Dired buffer.") | |
| 1182 (setq mode-name "Dired" | |
| 1183 revert-buffer-function 'dired-revert) | |
| 1184 (revert-buffer))) | |
| 1185 | |
| 1186 ;; A zero-arg version of dired-virtual. | |
| 1187 ;; You need my modified version of set-auto-mode for the | |
| 1188 ;; `buffer-contents-mode-alist'. | |
| 1189 ;; Or you use infer-mode.el and infer-mode-alist, same syntax. | |
| 1190 (defun dired-virtual-mode () | |
| 1191 "Put current buffer into virtual dired mode (see `dired-virtual'). | |
| 1192 Useful on `buffer-contents-mode-alist' (which see) with the regexp | |
| 1193 | |
| 1194 \"^ \\(/[^ /]+\\)/?+:$\" | |
| 1195 | |
| 1196 to put saved dired buffers automatically into virtual dired mode. | |
| 1197 | |
| 1198 Also useful for `auto-mode-alist' (which see) like this: | |
| 1199 | |
| 1200 \(setq auto-mode-alist (cons '(\"[^/]\\.dired$\" . dired-virtual-mode) | |
| 1201 auto-mode-alist)\) | |
| 1202 " | |
| 1203 (interactive) | |
| 1204 (dired-virtual (dired-virtual-guess-dir))) | |
| 1205 | |
| 1206 | |
| 1207 (defvar dired-find-subdir nil ; t is pretty near to DWIM... | |
| 1208 "*If non-nil, Dired does not make a new buffer for a directory if it | |
| 1209 can be found (perhaps as subdir) in some existing Dired buffer. | |
| 1210 | |
| 1211 If there are several Dired buffers for a directory, the most recently | |
| 1212 used is chosen. | |
| 1213 | |
| 1214 Dired avoids switching to the current buffer, so that if you have | |
| 1215 a normal and a wildcard buffer for the same directory, C-x d RET will | |
| 1216 toggle between those two.") | |
| 1217 | |
| 1218 (or (fboundp 'dired-old-find-buffer-nocreate) | |
| 1219 (fset 'dired-old-find-buffer-nocreate | |
| 1220 (symbol-function 'dired-find-buffer-nocreate))) | |
| 1221 | |
| 1222 (defun dired-find-buffer-nocreate (dirname) ; redefine dired.el | |
| 1223 (if dired-find-subdir | |
| 1224 (let* ((cur-buf (current-buffer)) | |
| 1225 (buffers (nreverse (dired-buffers-for-dir-exact dirname))) | |
| 1226 (cur-buf-matches (and (memq cur-buf buffers) | |
| 1227 ;; wildcards must match, too: | |
| 1228 (equal dired-directory dirname)))) | |
| 1229 ;; We don't want to switch to the same buffer--- | |
| 1230 (setq buffers (delq cur-buf buffers));;need setq with delq | |
| 1231 (or (car (sort buffers (function dired-x-buffer-more-recently-used-p))) | |
| 1232 ;; ---unless it's the only possibility: | |
| 1233 (and cur-buf-matches cur-buf))) | |
| 1234 (dired-old-find-buffer-nocreate dirname))) | |
| 1235 | |
| 1236 ;; this should be a builtin | |
| 1237 (defun dired-x-buffer-more-recently-used-p (buffer1 buffer2) | |
| 1238 "Return t if BUFFER1 is more recently used than BUFFER2." | |
| 1239 (if (equal buffer1 buffer2) | |
| 1240 nil | |
| 1241 (let ((more-recent nil) | |
| 1242 (list (buffer-list))) | |
| 1243 (while (and list | |
| 1244 (not (setq more-recent (equal buffer1 (car list)))) | |
| 1245 (not (equal buffer2 (car list)))) | |
| 1246 (setq list (cdr list))) | |
| 1247 more-recent))) | |
| 1248 | |
| 1249 (defun dired-buffers-for-dir-exact (dir) | |
| 1250 ;; Return a list of buffers that dired DIR (a directory or wildcard) | |
| 1251 ;; at top level, or as subdirectory. | |
| 1252 ;; Top level matches must match the wildcard part too, if any. | |
| 1253 ;; The list is in reverse order of buffer creation, most recent last. | |
| 1254 ;; As a side effect, killed dired buffers for DIR are removed from | |
| 1255 ;; dired-buffers. | |
| 1256 (let ((alist dired-buffers) result elt) | |
| 1257 (while alist | |
| 1258 (setq elt (car alist) | |
| 1259 alist (cdr alist)) | |
| 1260 (let ((buf (cdr elt))) | |
| 1261 (if (buffer-name buf) | |
| 1262 ;; Top level must match exactly against dired-directory in | |
| 1263 ;; case one of them is a wildcard. | |
| 1264 (if (or (equal dir (save-excursion (set-buffer buf) | |
| 1265 dired-directory)) | |
| 1266 (assoc dir (save-excursion (set-buffer buf) | |
| 1267 dired-subdir-alist))) | |
| 1268 (setq result (cons buf result))) | |
| 1269 ;; else buffer is killed - clean up: | |
| 1270 (setq dired-buffers (delq elt dired-buffers))))) | |
| 1271 result)) | |
| 1272 | |
| 1273 (defun dired-buffers-for-top-dir (dir) | |
| 1274 ;; Return a list of buffers that dired DIR (a directory, not a wildcard) | |
| 1275 ;; at top level, with or without wildcards. | |
| 1276 ;; As a side effect, killed dired buffers for DIR are removed from | |
| 1277 ;; dired-buffers. | |
| 1278 (setq dir (file-name-as-directory dir)) | |
| 1279 (let ((alist dired-buffers) result elt) | |
| 1280 (while alist | |
| 1281 (setq elt (car alist) | |
| 1282 alist (cdr alist)) | |
| 1283 (let ((buf (cdr elt))) | |
| 1284 (if (buffer-name buf) | |
| 1285 (if (equal dir (save-excursion (set-buffer buf) default-directory)) | |
| 1286 (setq result (cons buf result))) | |
| 1287 ;; else buffer is killed - clean up: | |
| 1288 (setq dired-buffers (delq elt dired-buffers))))) | |
| 1289 result)) | |
| 1290 | |
| 1291 (defun dired-initial-position (dirname) ; redefine dired.el | |
| 1292 (end-of-line) | |
| 1293 (if dired-find-subdir (dired-goto-subdir dirname)) ; new | |
| 1294 (if dired-trivial-filenames (dired-goto-next-nontrivial-file))) | |
| 1295 | |
| 1296 ;;; Let `C-x f' and `C-x 4 f' know about Tree Dired's multiple directories. | |
| 1297 ;;; As a bonus, you get filename-at-point as default with a prefix arg. | |
| 1298 | |
| 1299 ;; It's easier to add to this alist than redefine function | |
| 1300 ;; default-directory while keeping the old information. | |
| 1301 (defconst default-directory-alist | |
| 1302 '((dired-mode . (if (fboundp 'dired-current-directory) | |
| 1303 (dired-current-directory) | |
| 1304 default-directory))) | |
| 1305 "Alist of major modes and their opinion on default-directory, as a | |
| 1306 lisp expression to evaluate. A resulting value of nil is ignored in | |
| 1307 favor of default-directory.") | |
| 1308 | |
| 1309 (defun default-directory () | |
| 1310 "Usage like variable `default-directory', but knows about the special | |
| 1311 cases in variable `default-directory-alist' (which see)." | |
| 1312 (or (eval (cdr (assq major-mode default-directory-alist))) | |
| 1313 default-directory)) | |
| 1314 | |
| 1315 (defun find-file-read-filename-at-point (prompt) | |
| 1316 (if (fboundp 'gmhist-read-file-name) | |
| 1317 (if current-prefix-arg | |
| 1318 (let ((fn (filename-at-point))) | |
| 1319 (gmhist-read-file-name | |
| 1320 prompt (default-directory) fn nil | |
| 1321 ;; the INITIAL arg is only accepted in Emacs 19 or with gmhist: | |
| 1322 fn)) | |
| 1323 (gmhist-read-file-name prompt (default-directory))) | |
| 1324 ;; Else gmhist is not available, thus no initial input possible. | |
| 1325 ;; Could use filename-at-point as default and mung prompt...ugh. | |
| 1326 ;; Nah, get gmhist, folks! | |
| 1327 (read-file-name prompt (default-directory)))) | |
| 1328 | |
| 1329 (defun filename-at-point () | |
| 1330 "Get the filename closest to point, but don't change your position. | |
| 1331 Has a preference for looking backward when not directly on a symbol." | |
| 1332 ;; Not at all perfect - point must be right in the name. | |
| 1333 (let ((filename-chars ".a-zA-Z0-9---_/:$") start end filename | |
| 1334 (bol (save-excursion (beginning-of-line) (point))) | |
| 1335 (eol (save-excursion (end-of-line) (point)))) | |
| 1336 (save-excursion | |
| 1337 ;; first see if you're just past a filename | |
| 1338 (if (not (eobp)) | |
| 1339 (if (looking-at "[] \t\n[{}()]") ; whitespace or some parens | |
| 1340 (progn | |
| 1341 (skip-chars-backward " \n\t\r({[]})") | |
| 1342 (if (not (bobp)) | |
| 1343 (backward-char 1))))) | |
| 1344 (if (string-match (concat "[" filename-chars "]") | |
| 1345 (char-to-string (following-char))) | |
| 1346 (progn | |
| 1347 (skip-chars-backward filename-chars) | |
| 1348 (setq start (point)) | |
| 1349 (if (string-match "[/~]" (char-to-string (preceding-char))) | |
| 1350 (setq start (1- start))) | |
| 1351 (skip-chars-forward filename-chars)) | |
| 1352 (error "No file found around point!")) | |
| 1353 (expand-file-name (buffer-substring start (point)))))) | |
| 1354 | |
| 1355 (defun find-this-file (fn) | |
| 1356 "Edit file FILENAME. | |
| 1357 Switch to a buffer visiting file FILENAME, creating one if none already exists. | |
| 1358 | |
| 1359 Interactively, with a prefix arg, calls `filename-at-point'. | |
| 1360 Useful to edit the file mentioned in the buffer you are editing, or to | |
| 1361 test if that file exists: use minibuffer completion after snatching the | |
| 1362 name or part of it." | |
| 1363 (interactive (list (find-file-read-filename-at-point "Find file: "))) | |
| 1364 (find-file (expand-file-name fn))) | |
| 1365 | |
| 1366 (defun find-this-file-other-window (fn) | |
| 1367 "Edit file FILENAME in other window. | |
| 1368 Switch to a buffer visiting file FILENAME, creating one if none already exists. | |
| 1369 | |
| 1370 Interactively, with a prefix arg, call `filename-at-point'. | |
| 1371 Useful to edit the file mentioned in the buffer you are editing, or to | |
| 1372 test if that file exists: use minibuffer completion after snatching the | |
| 1373 name or part of it." | |
| 1374 (interactive (list (find-file-read-filename-at-point "Find file: "))) | |
| 1375 (find-file-other-window (expand-file-name fn))) | |
| 1376 | |
| 1377 (defun dired-smart-shell-command (cmd &optional insert) | |
| 1378 "Like function `shell-command', but in the current Tree Dired directory." | |
| 1379 (interactive "sShell command: \nP") | |
| 1380 (let ((default-directory (default-directory))) | |
| 1381 (shell-command cmd insert))) | |
| 1382 | |
| 1383 (if (fboundp 'gmhist-make-magic) | |
| 1384 (gmhist-make-magic 'dired-smart-shell-command 'shell-history)) | |
| 1385 | |
| 1386 (defun dired-smart-background-shell-command (cmd) | |
| 1387 "Run a shell command in the background. | |
| 1388 Like function `background' but in the current Tree Dired directory." | |
| 1389 (interactive "s%% ") | |
| 1390 (shell-command (concat "cd " (default-directory) "; " cmd " &"))) | |
| 1391 | |
| 1392 (if (fboundp 'gmhist-make-magic) | |
| 1393 (gmhist-make-magic 'dired-smart-background-shell-command 'shell-history)) | |
| 1394 | |
| 1395 | |
| 1396 ;; Local variables for Dired buffers | |
| 1397 | |
| 1398 (defvar dired-local-variables-file ".dired" | |
| 1399 "If non-nil, filename for local variables for Dired. | |
| 1400 If Dired finds a file with that name in the current directory, it will | |
| 1401 temporarily insert it into the dired buffer and run `hack-local-variables'. | |
| 1402 | |
| 1403 Type \\[info] and and `g' `(emacs)File Variables' `RET' for more info on | |
| 1404 local variables.") | |
| 1405 | |
| 1406 (defun dired-hack-local-variables () | |
| 1407 "Parse, and bind or evaluate as appropriate, any local variables | |
| 1408 for current dired buffer. | |
| 1409 See variable `dired-local-variables-file'." | |
| 1410 (if (and dired-local-variables-file | |
| 1411 (file-exists-p dired-local-variables-file)) | |
| 1412 (let (buffer-read-only opoint ) | |
| 1413 (save-excursion | |
| 1414 (goto-char (point-max)) | |
| 1415 (setq opoint (point-marker)) | |
| 1416 (insert "\^L\n") | |
| 1417 (insert-file-contents dired-local-variables-file)) | |
| 1418 (let ((buffer-file-name dired-local-variables-file)) | |
| 1419 (hack-local-variables)) | |
| 1420 ;; Must delete it as (eobp) is often used as test for last | |
| 1421 ;; subdir in dired.el. | |
| 1422 (delete-region opoint (point-max)) | |
| 1423 (set-marker opoint nil)))) | |
| 1424 | |
| 1425 ;; Guess what shell command to apply to a file. | |
| 1426 | |
| 1427 (defvar dired-guess-have-gnutar nil | |
| 1428 "*If non-nil, name of the GNU tar executable (e.g. \"tar\" or \"gnutar\"). | |
| 1429 GNU tar's `z' switch is used for compressed tar files. | |
| 1430 If you don't have GNU tar, set this to nil: a pipe using `zcat' is then used.") | |
| 1431 | |
| 1432 (defvar dired-make-gzip-quiet t | |
| 1433 "*If non-nil, pass -q to shell commands involving gzip this will override | |
| 1434 GZIP environment variable.") | |
| 1435 | |
| 1436 (defvar dired-znew-switches nil | |
| 1437 "*If non-nil, a string of switches that will be passed to `znew' | |
| 1438 example: \"-K\"") | |
| 1439 | |
| 1440 (defvar dired-auto-shell-command-alist-default | |
| 1441 (list | |
| 1442 (list "\\.tar$" (if dired-guess-have-gnutar | |
| 1443 (concat dired-guess-have-gnutar " xvf") | |
| 1444 "tar xvf")) | |
| 1445 | |
| 1446 ;; regexps for compressed archives must come before the .Z rule to | |
| 1447 ;; be recognized: | |
| 1448 (list "\\.tar\\.Z$" (if dired-guess-have-gnutar | |
| 1449 (concat dired-guess-have-gnutar " zxvf") | |
| 1450 (concat "zcat * | tar xvf -")) | |
| 1451 ;; optional conversion to gzip (GNU zip) format | |
| 1452 (concat "znew" | |
| 1453 (if dired-make-gzip-quiet " -q") | |
| 1454 " " dired-znew-switches)) | |
| 1455 | |
| 1456 ;; gzip'ed (GNU zip) archives | |
| 1457 (list "\\.tar\\.g?z$\\|\\.tgz$" (if dired-guess-have-gnutar | |
| 1458 (concat dired-guess-have-gnutar " zxvf") | |
| 1459 ;; use `gunzip -qc' instead of `zcat' since some | |
| 1460 ;; people don't install GNU zip's version of zcat | |
| 1461 (concat "gunzip -qc * | tar xvf -"))) | |
| 1462 '("\\.shar.Z$" "zcat * | unshar") | |
| 1463 ;; use `gunzip -c' instead of `zcat' | |
| 1464 '("\\.shar.g?z$" "gunzip -qc * | unshar") | |
| 1465 '("\\.ps$" "ghostview" "xv" "lpr") | |
| 1466 '("\\.ps.g?z$" "gunzip -qc * | ghostview -" | |
| 1467 ;; optional decompression | |
| 1468 (concat "gunzip" (if dired-make-gzip-quiet " -q"))) | |
| 1469 '("\\.ps.Z$" "zcat * | ghostview -" | |
| 1470 ;; optional conversion to gzip (GNU zip) format | |
| 1471 (concat "znew" | |
| 1472 (if dired-make-gzip-quiet " -q") | |
| 1473 " " dired-znew-switches)) | |
| 1474 '("\\.dvi$" "xdvi" "dvips") | |
| 1475 '("\\.au$" "play") ; play Sun audiofiles | |
| 1476 '("\\.mpg$" "mpeg_play") | |
| 1477 '("\\.dl$" "xdl") ; loop pictures | |
| 1478 '("\\.fli$" "xanim") | |
| 1479 '("\\.gl$" "xgrasp") | |
| 1480 '("\\.uu$" "uudecode") | |
| 1481 '("\\.hqx$" "mcvert") | |
| 1482 '("\\.sh$" "sh") ; execute shell scripts | |
| 1483 '("\\.xbm$" "bitmap") ; view X11 bitmaps | |
| 1484 '("\\.xpm$" "sxpm") | |
| 1485 '("\\.gp$" "gnuplot") | |
| 1486 '("\\.p[bgpn]m$" "xv") | |
| 1487 '("\\.gif$" "xv") ; view gif pictures | |
| 1488 '("\\.tif$" "xv") | |
| 1489 '("\\.jpg$" "xv") | |
| 1490 '("\\.fig$" "xfig") ; edit fig pictures | |
| 1491 '("\.tex$" "latex" "tex") | |
| 1492 '("\\.texi\\(nfo\\)?$" "makeinfo" "texi2dvi") | |
| 1493 (if (eq window-system 'x) ; under X, offer both... | |
| 1494 '("\\.dvi$" "xtex" "dvips") ; ...preview and printing | |
| 1495 '("\\.dvi$" "dvips")) | |
| 1496 '("\\.g?z$" (concat "gunzip" (if dired-make-gzip-quiet " -q" ""))) ; quiet? | |
| 1497 '("\\.Z$" "uncompress" | |
| 1498 ;; optional conversion to gzip (GNU zip) format | |
| 1499 (concat "znew" (if dired-make-gzip-quiet " -q") " " dired-znew-switches)) | |
| 1500 ;; some popular archivers: | |
| 1501 '("\\.zoo$" "zoo x//") | |
| 1502 '("\\.zip$" "unzip") | |
| 1503 '("\\.lzh$" "lharc x") | |
| 1504 '("\\.arc$" "arc x") | |
| 1505 '("\\.shar$" "unshar") ; use "sh" if you don't have unshar | |
| 1506 ) | |
| 1507 | |
| 1508 "Default for variable `dired-auto-shell-command-alist' (which see). | |
| 1509 Set this to nil to turn off shell command guessing.") | |
| 1510 | |
| 1511 (defvar dired-auto-shell-command-alist nil | |
| 1512 "*If non-nil, an alist of file regexps and their suggested commands. | |
| 1513 Dired shell commands will look up the name of a file in this list | |
| 1514 and suggest the matching command as default. | |
| 1515 | |
| 1516 Each element of this list looks like | |
| 1517 | |
| 1518 \(REGEXP COMMAND...\) | |
| 1519 | |
| 1520 where each COMMAND can either be a string or a lisp expression that | |
| 1521 evaluates to a string. If several COMMANDs are given, the first one | |
| 1522 will be the default and minibuffer completion will use the given set. | |
| 1523 | |
| 1524 These rules take precedence over the predefined rules in the variable | |
| 1525 `dired-auto-shell-command-alist-default' (to which they are prepended). | |
| 1526 | |
| 1527 You can set this variable in your ~/.emacs. For example, to add | |
| 1528 rules for `.foo' and `.bar' files, write | |
| 1529 | |
| 1530 \(setq dired-auto-shell-command-alist | |
| 1531 (list (list \"\\\\.foo$\" \"FOO-COMMAND\");; fixed rule | |
| 1532 ;; possibly more rules ... | |
| 1533 (list \"\\\\.bar$\";; rule with condition test | |
| 1534 '(if condition | |
| 1535 \"BAR-COMMAND-1\" | |
| 1536 \"BAR-COMMAND-2\")))\) | |
| 1537 ") | |
| 1538 | |
| 1539 (setq dired-auto-shell-command-alist | |
| 1540 (if dired-auto-shell-command-alist;; join user and default value: | |
| 1541 (append dired-auto-shell-command-alist | |
| 1542 dired-auto-shell-command-alist-default) | |
| 1543 ;; else just copy the default value: | |
| 1544 dired-auto-shell-command-alist-default)) | |
| 1545 | |
| 1546 (defun dired-guess-default (files) | |
| 1547 ;; Guess a shell command for FILES. | |
| 1548 ;; Returns a command or a list of commands. | |
| 1549 ;; You may want to redefine this to try something smarter. | |
| 1550 (if (or (cdr files) | |
| 1551 (null dired-auto-shell-command-alist)) | |
| 1552 nil ; If more than one file, don't guess | |
| 1553 (let* ((file (car files)) | |
| 1554 (alist dired-auto-shell-command-alist) | |
| 1555 (case-fold-search nil) ; need search to be case-sensitive in order | |
| 1556 ; to distinguish between gzip'ed (`.z') and | |
| 1557 ; compressed (`.Z') files | |
| 1558 elt re cmds) | |
| 1559 (while alist | |
| 1560 (setq elt (car alist) | |
| 1561 re (car elt) | |
| 1562 alist (cdr alist)) | |
| 1563 (if (string-match re file) | |
| 1564 (setq cmds (cdr elt) | |
| 1565 alist nil))) | |
| 1566 (cond ((not (cdr cmds)) (eval (car cmds))) ; single command | |
| 1567 (t (mapcar (function eval) cmds)))))) | |
| 1568 | |
| 1569 (defun dired-guess-shell-command (prompt files) | |
| 1570 ;;"Ask user with PROMPT for a shell command, guessing a default from FILES." | |
| 1571 (let ((default (dired-guess-default files)) | |
| 1572 default-list old-history val (failed t)) | |
| 1573 (if (not (featurep 'gmhist)) | |
| 1574 (read-string prompt (if (listp default) (car default) default)) | |
| 1575 ;; else we have gmhist | |
| 1576 (if (null default) | |
| 1577 (read-with-history-in 'dired-shell-command-history prompt) | |
| 1578 (or (boundp 'dired-shell-command-history) | |
| 1579 (setq dired-shell-command-history nil)) | |
| 1580 (setq old-history dired-shell-command-history) | |
| 1581 (if (listp default) | |
| 1582 ;; more than one guess | |
| 1583 (setq default-list default | |
| 1584 default (car default) | |
| 1585 prompt (concat | |
| 1586 prompt | |
| 1587 (format "{%d guesses} " (length default-list)))) | |
| 1588 ;; just one guess | |
| 1589 (setq default-list (list default))) | |
| 1590 (put 'dired-shell-command-history 'default default) | |
| 1591 ;; push guesses onto history so that they can be retrieved with M-p | |
| 1592 (setq dired-shell-command-history | |
| 1593 (append default-list dired-shell-command-history)) | |
| 1594 ;; the unwind-protect returns VAL, and we too. | |
| 1595 (unwind-protect | |
| 1596 (progn | |
| 1597 (setq val (read-with-history-in | |
| 1598 'dired-shell-command-history prompt) | |
| 1599 failed nil) | |
| 1600 val) | |
| 1601 (progn | |
| 1602 ;; Undo pushing onto the history list so that an aborted | |
| 1603 ;; command doesn't get the default in the next command. | |
| 1604 (setq dired-shell-command-history old-history) | |
| 1605 (if (not failed) | |
| 1606 (or (equal val (car-safe dired-shell-command-history)) | |
| 1607 (setq dired-shell-command-history | |
| 1608 (cons val dired-shell-command-history)))))))))) | |
| 1609 | |
| 1610 ;; redefine dired.el's version: | |
| 1611 (defun dired-read-shell-command (prompt arg files) | |
| 1612 "Read a dired shell command using generic minibuffer history. | |
| 1613 This command tries to guess a command from the filename(s) | |
| 1614 from the variable `dired-auto-shell-command-alist' (which see)." | |
| 1615 (dired-mark-pop-up | |
| 1616 nil 'shell files ; bufname type files | |
| 1617 'dired-guess-shell-command ; function &rest args | |
| 1618 (format prompt (dired-mark-prompt arg files)) files)) | |
| 1619 | |
| 1620 | |
| 1621 ;; Byte-compile-and-load (requires jwz@lucid.com's new byte compiler) | |
| 1622 (defun dired-do-byte-compile-and-load (&optional arg) | |
| 1623 "Byte compile marked and load (or next ARG) Emacs lisp files. | |
| 1624 This requires jwz@lucid.com's new optimizing byte compiler." | |
| 1625 (interactive "P") | |
| 1626 (dired-mark-map-check (function dired-byte-compile-and-load) arg | |
| 1627 'byte-compile-and-load t)) | |
| 1628 | |
| 1629 (defun dired-byte-compile-and-load () | |
| 1630 ;; Return nil for success, offending file name else. | |
| 1631 (let* (buffer-read-only | |
| 1632 (from-file (dired-get-filename)) | |
| 1633 (new-file (byte-compile-dest-file from-file))) | |
| 1634 (if (not (string-match elisp-source-extention-re from-file)) | |
| 1635 (progn | |
| 1636 (dired-log "Attempt to compile non-elisp file %s\n" from-file) | |
| 1637 ;; return a non-nil value as error indication | |
| 1638 (dired-make-relative from-file)) | |
| 1639 (save-excursion;; Jamie's compiler may switch buffer | |
| 1640 (byte-compile-and-load-file from-file)) | |
| 1641 (dired-remove-file new-file) | |
| 1642 (forward-line) ; insert .elc after its .el file | |
| 1643 (dired-add-file new-file) | |
| 1644 nil))) | |
| 1645 | |
| 1646 ;; Visit all marked files simultaneously. | |
| 1647 ;; After an idea by wurgler@zippysun.math.uakron.edu (Tom Wurgler). | |
| 1648 | |
| 1649 (defun dired-do-find-file (&optional arg) | |
| 1650 "Visit all marked files at once, and display them simultaneously. | |
| 1651 See also function `simultaneous-find-file'. | |
| 1652 If you want to keep the dired buffer displayed, type \\[split-window-vertically] first. | |
| 1653 If you want just the marked files displayed and nothing else, type \\[delete-other-windows] first." | |
| 1654 (interactive "P") | |
| 1655 (simultaneous-find-file (dired-mark-get-files nil arg))) | |
| 1656 | |
| 1657 (defun simultaneous-find-file (file-list) | |
| 1658 "Visit all files in FILE-LIST and display them simultaneously. | |
| 1659 | |
| 1660 The current window is split across all files in FILE-LIST, as evenly | |
| 1661 as possible. Remaining lines go to the bottommost window. | |
| 1662 | |
| 1663 The number of files that can be displayed this way is restricted by | |
| 1664 the height of the current window and the variable `window-min-height'." | |
| 1665 ;; It is usually too clumsy to specify FILE-LIST interactively | |
| 1666 ;; unless via dired (dired-do-find-file). | |
| 1667 (let ((size (/ (window-height) (length file-list)))) | |
| 1668 (or (<= window-min-height size) | |
| 1669 (error "Too many files to visit simultaneously")) | |
| 1670 (find-file (car file-list)) | |
| 1671 (setq file-list (cdr file-list)) | |
| 1672 (while file-list | |
| 1673 ;; Split off vertically a window of the desired size | |
| 1674 ;; The upper window will have SIZE lines. We select the lower | |
| 1675 ;; (larger) window because we want to split that again. | |
| 1676 (select-window (split-window nil size)) | |
| 1677 (find-file (car file-list)) | |
| 1678 (setq file-list (cdr file-list))))) |