cgit.sxemacs.org Git - slh/blob - dired-tar.el

   1 ;;;; dired-tar.el - extensions to dired to create and unpack tar files.
   2
   3 ;;;; Originally by: Jim Blandy <jimb@cyclic.com> --- June 1995
   4 ;;;; Adapted to use bzip2 as well as gzip by Steve Youngs <steve@sxemacs.org>
   5 ;;;; Copyright (C) 1995 Jim Blandy
   6 ;;;; Copyright (C) 2005 Steve Youngs
   7
   8 ;; Author: Jim Blandy <jimb@cyclic.com>
   9 ;; Maintainer: Jim Blandy <jimb@cyclic.com>
  10 ;; Created: Mon  6 Sep 1993
  11 ;; Updated: Sun  3 Jul 2005
  12 ;; Version: 1.8
  13 ;; Keywords: unix
  14
  15 ;;; Commentary:
  16
  17 ;;; dired-tar adds a command to dired-mode for creating and unpacking
  18 ;;; tar files.  When using this package, typing `M-t' on a tar file in a
  19 ;;; dired listing unpacks the tar file, uncompressing it if necessary.
  20 ;;; Typing `M-t' on a directory packs up that directory into a gzipped,
  21 ;;; or bzip2'd tar file named DIRNAME.tar.gz (DIRNAME.tar.bz2 for bzip2).
  22 ;;;
  23 ;;; To use this package, just place it in a directory in your Emacs
  24 ;;; lisp load path, byte-compile it, and put the line
  25 ;;;    (require 'dired-tar)
  26 ;;; in your .emacs.
  27 ;;;
  28 ;;; This file defines the following function:
  29 ;;;
  30 ;;; dired-tar-pack-unpack - If the file on the current line is a tar
  31 ;;;    file, or a gzipped or compressed tar file, unpack it.  If the
  32 ;;;    file on the current line is a directory, build a tar file for
  33 ;;;    it, and gzip it.
  34 ;;;
  35 ;;; It also declares the following variables:
  36 ;;;
  37 ;;; dired-tar-compress-with - If the symbol `gzip', compress created tars
  38 ;;;     with gzip, if `bzip2', compress with bzip2, if nil, don't compress
  39 ;;;     tars.
  40 ;;;
  41 ;;; dired-tar-command-switches - flags to pass to the tar program.
  42 ;;;      This is concatenated with command characters ("x" or "c" or
  43 ;;;      whatever).  The default is 'vf'; I'm told Windows users
  44 ;;;      should use "mvf".
  45 ;;;
  46 ;;; dired-tar-gzip-extension - extension to use for gzipped tar files.
  47 ;;;      Defaults to ".tar.gz", but ".tgz" may be a useful value in
  48 ;;;      some circumstances.
  49 ;;;
  50 ;;; dired-tar-bzip2-extension - extension to use for bzipped tar files.
  51 ;;;      Defaults to ".tar.bz2", but ".tbz" or ".tbz2" may be a useful value in
  52 ;;;      some circumstances.
  53 ;;;
  54 ;;; dired-tar-gzip-command - a shell command which gzips its
  55 ;;;     standard input to its standard output.
  56 ;;;
  57 ;;; dired-tar-ungzip-command - a shell command which ungzips
  58 ;;;     its standard input to its standard output.
  59 ;;;
  60 ;;; dired-tar-bzip2-command - a shell command which bzips its
  61 ;;;     standard input to its standard output.
  62 ;;;
  63 ;;; dired-tar-unbzip2-command - a shell command which unbzips
  64 ;;;     its standard input to its standard output.
  65 ;;;
  66 ;;; dired-tar-shell-file-name - name of the shell to use to run the
  67 ;;;      tar command.  The default is `shell-file-name'.
  68
  69 ;;; Changes since 1.7:
  70 ;;; - From Steve Youngs <steve@sxemacs.org>:
  71 ;;;   - Add support for bzip2 tarfiles
  72 ;;;   - Convert user variables to defcustom's
  73 ;;;   - Change key binding to `M-t' (`T' is `dired-do-total-size')
  74 ;;; Changes since 1.6:
  75 ;;; - recognize files with extension .tgz as gzipped tarfiles; let user
  76 ;;;   configure what we name compressed tar files we create.
  77 ;;; Changes since 1.5:
  78 ;;; - (dired-tar-pack): Changes from Cord Kielhorn: name files correctly
  79 ;;;   when dired-tar-should-gzip is false.
  80 ;;;
  81 ;;; Changes since 1.4:
  82 ;;; - added dired-tar-shell-file-name and dired-tar-command-switches;
  83 ;;;   thanks to Cristian Ionescu-Idbohrn <cii@kcs.se>!
  84
  85 ;;; Code:
  86
  87 (require 'compile)
  88 (eval-when-compile (load "cl-macs"))
  89
  90 \f
  91 ;;;; Variables.
  92
  93 (defgroup dired-tar nil
  94   "Extensions to Dired for handling tarfiles."
  95   :prefix "dired-tar-"
  96   :group 'dired)
  97
  98 (defcustom dired-tar-compress-with 'gzip
  99   "*Compression program to use when creating tarfiles.
 100
 101 Can either be the symbols `gzip' or `bzip2' for those respective
 102 compression programs, or nil for no compression."
 103   :type '(choice
 104           (item :tag "Use Gzip" gzip)
 105           (item :tag "Use Bzip2" bzip2)
 106           (item :tag "No compression" nil))
 107   :group 'dired-tar)
 108
 109 (defcustom dired-tar-gzip-extension ".tar.gz"
 110   "*File name extension to use for creating gzipped tar files.
 111
 112 By default, this is \".tar.gz\", but some people may like to use
 113 \".tgz\".
 114
 115 NOTE: this variable is only for _creating_ gzipped tarfiles, it isn't
 116 used for unpacking existing tarfiles."
 117   :type 'string
 118   :group 'dired-tar)
 119
 120 (defcustom dired-tar-bzip2-extension ".tar.bz2"
 121   "*File name extension to use for bzip2'd tar files.
 122
 123 By default, this is \".tar.bz2\", but some people may like to use
 124 \".tbz\" or \".tbz2\".
 125
 126 NOTE: this variable is only for _creating_ bzipped tarfiles, it isn't
 127 used for unpacking existing tarfiles."
 128   :type 'string
 129   :group 'dired-tar)
 130
 131 (defcustom dired-tar-gzip-command "gzip --best --stdout"
 132   "*A shell command which gzips its stdin to its stdout."
 133   :type 'string
 134   :group 'dired-tar)
 135
 136 (defcustom dired-tar-bzip2-command "bzip2 --best --stdout"
 137   "*A shell command which bzip2's its stdin to its stdout."
 138   :type 'string
 139   :group 'dired-tar)
 140
 141 (defcustom dired-tar-ungzip-command "gzip --decompress --stdout"
 142   "*A shell command which ungzips its stdin to its stdout."
 143   :type 'string
 144   :group 'dired-tar)
 145
 146 (defcustom dired-tar-unbzip2-command "bzip2 --decompress --stdout"
 147   "*A shell command which unbzip2's its stdin to its stdout."
 148   :type 'string
 149   :group 'dired-tar)
 150
 151 (defcustom dired-tar-shell-file-name shell-file-name
 152   "*The name of the shell to use to run the tar command."
 153   :type '(file :must-match t)
 154   :group 'dired-tar)
 155
 156 (defcustom dired-tar-command-switches "vf"
 157   "Flags to pass to the tar program, in addition to the command charcaters.
 158
 159 This is concatenated with command characters (\"x\" or \"c\" or
 160 whatever).  The default is 'vf'; I'm told Windows users should use
 161 \"mvf\"."
 162   :type 'string
 163   :group 'dired-tar)
 164
 165 (defvar dired-tar-result nil
 166   "For internal use by dired-tar functions.
 167 This variable is made local to the buffer in which we run the tar
 168 process, and holds the name of the file created or affected.  The
 169 process-termination sentinal uses this to update the dired listing
 170 when the process completes its work, or dies.")
 171
 172 \f
 173 ;;;; Internal functions.
 174
 175 (defun dired-tar-run-command (command directory result)
 176   "Internal function for use by the dired-tar package.
 177 Run COMMAND asynchronously in its own window, like a compilation.
 178 Use DIRECTORY as the default directory for the command's execution.
 179 RESULT is the name of the tar file which will be created, or the
 180 name of the directory into which the tar file was unpacked."
 181   (let ((buf (dired-tar-get-buffer)))
 182     (save-excursion
 183       (set-buffer buf)
 184       (setq buffer-read-only nil)
 185       (widen)
 186       (erase-buffer)
 187       (goto-char (point-min))
 188       (insert "cd " directory)
 189       (newline)
 190       (insert command)
 191       (newline)
 192
 193       (setq buffer-read-only t
 194             mode-name "Tar-Output"
 195             default-directory directory)
 196
 197       (set (make-local-variable 'dired-tar-result)
 198            result)
 199       (set (make-local-variable 'mode-line-process)
 200            '(": %s"))
 201       (set (make-local-variable 'compilation-finish-function)
 202            'dired-tar-operation-done)
 203
 204       (let ((process
 205              ;; Chris Moore <Chris.Moore@src.bae.co.uk> says that the
 206              ;; tar commands barf using his version of the zsh.  We
 207              ;; don't need anything but the Bourne shell here; that's
 208              ;; the default value for dired-tar-shell-file-name.
 209              (let ((shell-file-name dired-tar-shell-file-name))
 210                (start-process-shell-command "*Tar*" buf command))))
 211         (set-process-sentinel process 'compilation-sentinel))
 212       (display-buffer buf))))
 213
 214 (defun dired-tar-get-buffer ()
 215   "Choose a buffer to run a tar process in.
 216 Tar output buffers have names like *Tar*, *Tar*<2>, *Tar*<3>, ...
 217 We return the lowest-numbered buffer that doesn't have a live tar
 218 process in it.  We delete any other buffers whose processes have
 219 deleted."
 220
 221   ;; Kill all completed tar buffers.
 222   (let ((number 1))
 223     (while number
 224       (let* ((name (if (<= number 1) "*Tar*"
 225                      (format "*Tar*<%d>" number)))
 226              (buf (get-buffer name)))
 227         (if (null buf) (setq number nil)
 228           (save-excursion
 229             (set-buffer buf)
 230             (if (let ((process (get-buffer-process buf)))
 231                   (not (and process (eq (process-status process) 'run))))
 232                 (kill-buffer buf)))
 233           (setq number (1+ number))))))
 234
 235   ;; Make us a fresh buffer.
 236   (generate-new-buffer "*Tar*"))
 237
 238
 239 (defun dired-tar-operation-done (buf message)
 240   "Internal function for use by the dired-tar package.
 241 This function is run when the tar operation completes.  It tries to
 242 update the dired listing by looking at dired-tar-result."
 243   (cond
 244    ((null dired-tar-result))
 245
 246    ((file-directory-p dired-tar-result)
 247     (save-excursion
 248       (mapcar
 249        (function (lambda (buf)
 250                    (set-buffer buf)
 251                    (dired-revert)))
 252        (dired-buffers-for-dir dired-tar-result))))
 253
 254    ((file-exists-p dired-tar-result)
 255     (dired-relist-file dired-tar-result))
 256
 257    ;; Otherwise, I guess the tar operation must have failed somehow.
 258    ))
 259
 260 (defun dired-tar-pack (directory prefix-arg)
 261   "Internal function for use by the dired-tar package.
 262
 263 Create a tar file from the contents of DIRECTORY, compressed with
 264 `dired-tar-compress-with'.  The archive is named after the directory,
 265 and the files are stored in the archive with names relative to
 266 DIRECTORY's parent.
 267
 268 If `dired-tar-compress-with' is nil, the tar file will not be compressed.
 269
 270 We use `dired-tar-gzip-extension' or `dired-tar-bzip2-extension' as
 271 the suffix for the filenames we create.  Or just \".tar\" if the tar
 272 file is not compressed.
 273
 274 For example, (dired-tar-pack \"/home/blandy/womble/\") could produce a
 275 tar file named \"/home/blandy/womble.tar.gz\", whose contents had
 276 names like \"womble/foo\", \"womble/bar\", etcetera.
 277
 278 The second argument PREFIX-ARG is ignored."
 279   (let* ((dir-file (directory-file-name directory))
 280          (tar-file-name
 281           (case dired-tar-compress-with
 282             (gzip (concat dir-file dired-tar-gzip-extension))
 283             (bzip2 (concat dir-file dired-tar-bzip2-extension))
 284             (otherwise (format "%s.tar" dir-file))))
 285          (parent-name (file-name-directory dir-file))
 286          (content-name (file-name-nondirectory dir-file)))
 287     (dired-tar-run-command
 288      (case dired-tar-compress-with
 289        (gzip (format "tar cvf - %s | %s > %s"
 290                      content-name
 291                      dired-tar-gzip-command
 292                      tar-file-name))
 293        (bzip2 (format "tar cvf - %s | %s > %s"
 294                       content-name
 295                       dired-tar-bzip2-command
 296                       tar-file-name))
 297        (otherwise (format "tar cvf %s %s"
 298                           tar-file-name
 299                           content-name)))
 300      parent-name
 301      tar-file-name)))
 302
 303 (defconst dired-tar-tarfile-regexp
 304   (format "\\(%s\\)\\'"
 305           (mapconcat 'regexp-quote
 306                      '(".tar" ".tar.z" ".tar.gz" ".tar.Z" ".tgz" ".tar.bz2"
 307                        ".tbz" ".tbz2")
 308                      "\\|"))
 309   "Regular expression matching plausible filenames for tar files.")
 310
 311 (defconst dired-tar-gzipped-tarfile-regexp
 312   (format "\\(%s\\)\\'"
 313           (mapconcat 'regexp-quote
 314                      '(".tar.z" ".tar.gz" ".tar.Z" ".tgz")
 315                      "\\|"))
 316   "Regular expression matching plausible filenames for gzip compressed tar files.")
 317
 318 (defconst dired-tar-bzipped-tarfile-regexp
 319   (format "\\(%s\\)\\'"
 320           (mapconcat 'regexp-quote
 321                      '(".tar.bz2" ".tbz" ".tbz2")
 322                      "\\|"))
 323   "Regular expression matching plausible filenames for bzip2 compressed tar files.")
 324
 325 (defun dired-tar-unpack (tar-file prefix-arg)
 326   "Internal function for use by the dired-tar package.
 327 Unpack TAR-FILE into the directory containing it.
 328 If PREFIX-ARG is non-nil, just list the archive's contents without
 329 unpacking it."
 330
 331   (let ((tar-file-dir (file-name-directory tar-file))
 332         (action (if prefix-arg "t" "x")))
 333     (dired-tar-run-command
 334      (cond
 335
 336       ;; Does this look like a tar file at all?
 337       ((not (string-match dired-tar-tarfile-regexp tar-file))
 338        (error
 339         "bug: dired-tar-unpack should only be passed tar file names."))
 340
 341       ;; Does it look like a compressed tar file?
 342       ((string-match dired-tar-gzipped-tarfile-regexp tar-file)
 343        (format "%s < %s | tar %s%s -"
 344                dired-tar-ungzip-command
 345                tar-file
 346                action
 347                dired-tar-command-switches))
 348
 349       ;; Does it look like a bzip2 compressed tar file?
 350       ((string-match dired-tar-bzipped-tarfile-regexp tar-file)
 351        (format "%s < %s | tar %s%s -"
 352                dired-tar-unbzip2-command
 353                tar-file
 354                action
 355                dired-tar-command-switches))
 356
 357       ;; Okay, then it must look like an uncompressed tar file.
 358       (t
 359        (format "tar %svf %s" action tar-file)))
 360      tar-file-dir
 361
 362      ;; If we're just unpacking the archive, don't bother updating the
 363      ;; dired listing.
 364      (if prefix-arg nil tar-file-dir))))
 365
 366 \f
 367 ;;;; User-visible functions.
 368
 369 ;;;###autoload
 370 (defun dired-tar-pack-unpack (prefix-arg)
 371   "Create or unpack a tar archive for the file on the current line.
 372
 373 If the file on the current line is a directory, make a gzipped tar
 374 file out of its contents.
 375
 376 If the file on the current line is a tar archive, unpack it.  If the
 377 archive appears to be gzipped or compressed, expand it first.  With a
 378 prefix argument, just list the tar archive's contents, and don't unpack
 379 it.  The file's name must end in \".tar\", \".tar.gz\", \".tar.Z\",
 380 \".tar.bz2\", \".tbz\", or \".tbz2\" or else this command will assume
 381 it's not a tar file."
 382   (interactive "P")
 383
 384   (let ((filename (dired-get-filename)))
 385     (cond
 386      ((file-directory-p filename)
 387       (dired-tar-pack filename prefix-arg))
 388
 389      ((string-match dired-tar-tarfile-regexp filename)
 390       (dired-tar-unpack filename prefix-arg))
 391
 392      (t
 393       (error "%s is neither a tar file nor a directory" filename)))))
 394
 395 \f
 396 ;;;; Hooking this into dired mode.
 397
 398 (add-hook 'dired-mode-hook
 399           (lambda ()
 400             (define-key dired-mode-map [(meta ?t)] 'dired-tar-pack-unpack)))
 401
 402 \f
 403 (provide 'dired-tar)
 404
 405 ;;; dired-tar.el ends here