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