* lisp/emacs-lisp/package.el: Use tar-mode rather than tar executable.

Consolidate the single-file vs tarball code.
(package-desc-suffix): New function.
(package-desc-full-name): Don't bother inlining it.
(package-load-descriptor): Return the new package-desc.
(package-mark-obsolete): Remove unused arg `package'.
(package-unpack): Make it work for single files as well.
Make it update package-alist.
(package--make-autoloads-and-stuff): Rename from
package--make-autoloads-and-compile.  Don't compile any more.
(package--compile): New function.
(package-generate-description-file): New function, extracted from
package-unpack-single.
(package-unpack-single): Remove.
(package--with-work-buffer): Add indentation and debugging info.
(package-download-single): Remove.
(package-install-from-archive): Rename from package-download-tar, make
it take a pkg-desc, and make it work for single files as well.
(package-download-transaction): Simplify.
(package-tar-file-info): Remove `file' arg.  Rewrite not to use an
external tar program.
(package-install-from-buffer): Remove `pkg-desc' argument.
Use package-tar-file-info for tar-mode buffers.
(package-install-file): Simplify accordingly.
(package-archive-base): Change to take a pkg-desc.
* lisp/tar-mode.el (tar--check-descriptor): New function, extracted from
tar-get-descriptor.
(tar-get-descriptor): Use it.
(tar-get-file-descriptor): New function.
(tar--extract): New function, extracted from tar-extract.
(tar--extract): Use it.
* lisp/emacs-lisp/package-x.el (package-upload-file): Decode the file, in
case the summary uses non-ascii.  Adjust to new calling convention of
package-tar-file-info.

4 files changed, 284 insertions, 262 deletions

diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index e4c67dde1d9..39013982477 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,7 +1,45 @@
+2013-06-21  Stefan Monnier  <monnier@iro.umontreal.ca>
+            Daniel Hackney  <dan@haxney.org>
+
+        * emacs-lisp/package.el: Use tar-mode rather than tar executable.
+        Consolidate the single-file vs tarball code.
+        (package-desc-suffix): New function.
+        (package-desc-full-name): Don't bother inlining it.
+        (package-load-descriptor): Return the new package-desc.
+        (package-mark-obsolete): Remove unused arg `package'.
+        (package-unpack): Make it work for single files as well.
+        Make it update package-alist.
+        (package--make-autoloads-and-stuff): Rename from
+        package--make-autoloads-and-compile.  Don't compile any more.
+        (package--compile): New function.
+        (package-generate-description-file): New function, extracted from
+        package-unpack-single.
+        (package-unpack-single): Remove.
+        (package--with-work-buffer): Add indentation and debugging info.
+        (package-download-single): Remove.
+        (package-install-from-archive): Rename from package-download-tar, make
+        it take a pkg-desc, and make it work for single files as well.
+        (package-download-transaction): Simplify.
+        (package-tar-file-info): Remove `file' arg.  Rewrite not to use an
+        external tar program.
+        (package-install-from-buffer): Remove `pkg-desc' argument.
+        Use package-tar-file-info for tar-mode buffers.
+        (package-install-file): Simplify accordingly.
+        (package-archive-base): Change to take a pkg-desc.
+        * tar-mode.el (tar--check-descriptor): New function, extracted from
+        tar-get-descriptor.
+        (tar-get-descriptor): Use it.
+        (tar-get-file-descriptor): New function.
+        (tar--extract): New function, extracted from tar-extract.
+        (tar--extract): Use it.
+        * emacs-lisp/package-x.el (package-upload-file): Decode the file, in
+        case the summary uses non-ascii.  Adjust to new calling convention of
+        package-tar-file-info.
+
 2013-06-21  Leo Liu  <sdl.web@gmail.com>
 
-        * comint.el (comint-redirect-results-list-from-process): Fix
-        random delay.  (Bug#14681)
+        * comint.el (comint-redirect-results-list-from-process):
+        Fix random delay.  (Bug#14681)
 
 2013-06-21  Juanma Barranquero  <lekktu@gmail.com>
 
@@ -135,8 +173,8 @@
 2013-06-19  Michael Albinus  <michael.albinus@gmx.de>
 
         * net/secrets.el (secrets-struct-secret-content-type): Replace
-        check of introspection data by a test call of "CreateItem".  Some
-        servers do not offer introspection.
+        check of introspection data by a test call of "CreateItem".
+        Some servers do not offer introspection.
 
 2013-06-19  Stefan Monnier  <monnier@iro.umontreal.ca>
 
diff --git a/lisp/emacs-lisp/package-x.el b/lisp/emacs-lisp/package-x.el
index 3300e89ec1e..7d0d75f7cee 100644
--- a/lisp/emacs-lisp/package-x.el
+++ b/lisp/emacs-lisp/package-x.el
@@ -291,10 +291,11 @@ If `package-archive-upload-base' does not specify a valid upload
 destination, prompt for one."
   (interactive "fPackage file name: ")
   (with-temp-buffer
-    (insert-file-contents-literally file)
+    (insert-file-contents file)
     (let ((pkg-desc
            (cond
-            ((string-match "\\.tar\\'" file) (package-tar-file-info file))
+            ((string-match "\\.tar\\'" file)
+             (tar-mode) (package-tar-file-info))
             ((string-match "\\.el\\'" file) (package-buffer-info))
             (t (error "Unrecognized extension `%s'"
                       (file-name-extension file))))))
diff --git a/lisp/emacs-lisp/package.el b/lisp/emacs-lisp/package.el
index ae4ebb87ee2..1bf1e6027e2 100644
--- a/lisp/emacs-lisp/package.el
+++ b/lisp/emacs-lisp/package.el
@@ -340,11 +340,17 @@ package came.
   dir)
 
 ;; Pseudo fields.
-(defsubst package-desc-full-name (pkg-desc)
+(defun package-desc-full-name (pkg-desc)
   (format "%s-%s"
           (package-desc-name pkg-desc)
           (package-version-join (package-desc-version pkg-desc))))
 
+(defun package-desc-suffix (pkg-desc)
+  (pcase (package-desc-kind pkg-desc)
+    (`single ".el")
+    (`tar ".tar")
+    (kind (error "Unknown package kind: %s" kind))))
+
 ;; Package descriptor format used in finder-inf.el and package--builtins.
 (cl-defstruct (package--bi-desc
                (:constructor package-make-builtin (version summary))
@@ -422,7 +428,8 @@ This is, approximately, the inverse of `version-to-list'.
         (goto-char (point-min))
         (let ((pkg-desc (package-process-define-package
                          (read (current-buffer)) pkg-file)))
-          (setf (package-desc-dir pkg-desc) pkg-dir))))))
+          (setf (package-desc-dir pkg-desc) pkg-dir)
+          pkg-desc)))))
 
 (defun package-load-all-descriptors ()
   "Load descriptors for installed Emacs Lisp packages.
@@ -529,13 +536,13 @@ Required package `%s-%s' is unavailable"
           ;; If all goes well, activate the package itself.
           (package-activate-1 pkg-vec)))))))
 
-(defun package-mark-obsolete (package pkg-vec)
-  "Put package on the obsolete list, if not already there."
-  (push pkg-vec package-obsolete-list))
+(defun package-mark-obsolete (pkg-desc)
+  "Put PKG-DESC on the obsolete list, if not already there."
+  (push pkg-desc package-obsolete-list))
 
-(defun define-package (name-string version-string
-                                &optional docstring requirements
-                                &rest _extra-properties)
+(defun define-package (_name-string _version-string
+                                    &optional _docstring _requirements
+                                    &rest _extra-properties)
   "Define a new package.
 NAME-STRING is the name of the package, as a string.
 VERSION-STRING is the version of the package, as a string.
@@ -559,13 +566,13 @@ EXTRA-PROPERTIES is currently unused."
      ;; If it's not newer than a builtin version, mark it obsolete.
      ((let ((bi (assq name package--builtin-versions)))
         (and bi (version-list-<= version (cdr bi))))
-      (package-mark-obsolete name new-pkg-desc))
+      (package-mark-obsolete new-pkg-desc))
      ;; If there's no old package, just add this to `package-alist'.
      ((null old-pkg)
       (push (cons name new-pkg-desc) package-alist))
      ((version-list-< (package-desc-version (cdr old-pkg)) version)
       ;; Remove the old package and declare it obsolete.
-      (package-mark-obsolete name (cdr old-pkg))
+      (package-mark-obsolete (cdr old-pkg))
       (setq package-alist (cons (cons name new-pkg-desc)
                                 (delq old-pkg package-alist))))
      ;; You can have two packages with the same version, e.g. one in
@@ -573,10 +580,10 @@ EXTRA-PROPERTIES is currently unused."
      ;; directory.  We just let the first one win.
      ((not (version-list-= (package-desc-version (cdr old-pkg)) version))
       ;; The package is born obsolete.
-      (package-mark-obsolete name new-pkg-desc)))
+      (package-mark-obsolete new-pkg-desc)))
     new-pkg-desc))
 
-;; From Emacs 22.
+;; From Emacs 22, but changed so it adds to load-path.
 (defun package-autoload-ensure-default-file (file)
   "Make sure that the autoload file FILE exists and if not create it."
   (unless (file-exists-p file)
@@ -632,74 +639,79 @@ untar into a directory named DIR; otherwise, signal an error."
             (error "Package does not untar cleanly into directory %s/" dir)))))
   (tar-untar-buffer))
 
-(defun package-unpack (package version)
-  (let* ((name (symbol-name package))
-         (dirname (concat name "-" version))
+(defun package-generate-description-file (pkg-desc pkg-dir)
+  "Create the foo-pkg.el file for single-file packages."
+  (let* ((name (package-desc-name pkg-desc))
+         (pkg-file (expand-file-name (package--description-file pkg-dir)
+                                     pkg-dir)))
+    (let ((print-level nil)
+          (print-quoted t)
+          (print-length nil))
+      (write-region
+       (concat
+        (prin1-to-string
+         (list 'define-package
+               (symbol-name name)
+               (package-version-join (package-desc-version pkg-desc))
+               (package-desc-summary pkg-desc)
+               (let ((requires (package-desc-reqs pkg-desc)))
+                 (list 'quote
+                       ;; Turn version lists into string form.
+                       (mapcar
+                        (lambda (elt)
+                          (list (car elt)
+                                (package-version-join (cadr elt))))
+                        requires)))))
+        "\n")
+       nil
+       pkg-file))))
+
+(defun package-unpack (pkg-desc)
+  "Install the contents of the current buffer as a package."
+  (let* ((name (package-desc-name pkg-desc))
+         (dirname (package-desc-full-name pkg-desc))
          (pkg-dir (expand-file-name dirname package-user-dir)))
-    (make-directory package-user-dir t)
-    ;; FIXME: should we delete PKG-DIR if it exists?
-    (let* ((default-directory (file-name-as-directory package-user-dir)))
-      (package-untar-buffer dirname)
-      (package--make-autoloads-and-compile package pkg-dir)
-      pkg-dir)))
-
-(defun package--make-autoloads-and-compile (name pkg-dir)
-  "Generate autoloads and do byte-compilation for package named NAME.
-PKG-DIR is the name of the package directory."
-  (let ((auto-name (package-generate-autoloads name pkg-dir))
-        (load-path (cons pkg-dir load-path)))
-    ;; We must load the autoloads file before byte compiling, in
-    ;; case there are magic cookies to set up non-trivial paths.
-    (load auto-name nil t)
-    ;; FIXME: Compilation should be done as a separate, optional, step.
-    ;; E.g. for multi-package installs, we should first install all packages
-    ;; and then compile them.
-    (byte-recompile-directory pkg-dir 0 t)))
+    (pcase (package-desc-kind pkg-desc)
+      (`tar
+       (make-directory package-user-dir t)
+       ;; FIXME: should we delete PKG-DIR if it exists?
+       (let* ((default-directory (file-name-as-directory package-user-dir)))
+         (package-untar-buffer dirname)))
+      (`single
+       (let ((el-file (expand-file-name (format "%s.el" name) pkg-dir)))
+         (make-directory pkg-dir t)
+         (package--write-file-no-coding el-file)))
+      (kind (error "Unknown package kind: %S" kind)))
+    (package--make-autoloads-and-stuff pkg-desc pkg-dir)
+    ;; Update package-alist.
+    (let ((new-desc (package-load-descriptor pkg-dir)))
+      ;; FIXME: Check that `new-desc' matches `desc'!
+      ;; FIXME: Compilation should be done as a separate, optional, step.
+      ;; E.g. for multi-package installs, we should first install all packages
+      ;; and then compile them.
+      (package--compile new-desc))
+    ;; Try to activate it.
+    (package-activate name (package-desc-version pkg-desc))
+    pkg-dir))
+
+(defun package--make-autoloads-and-stuff (pkg-desc pkg-dir)
+  "Generate autoloads, description file, etc.. for PKG-DESC installed at PKG-DIR."
+  (package-generate-autoloads (package-desc-name pkg-desc) pkg-dir)
+  (let ((desc-file (package--description-file pkg-dir)))
+    (unless (file-exists-p desc-file)
+      (package-generate-description-file pkg-desc pkg-dir)))
+  ;; FIXME: Create foo.info and dir file from foo.texi?
+  )
+
+(defun package--compile (pkg-desc)
+  "Byte-compile installed package PKG-DESC."
+  (package-activate-1 pkg-desc)
+  (byte-recompile-directory (package-desc-dir pkg-desc) 0 t))
 
 (defun package--write-file-no-coding (file-name)
   (let ((buffer-file-coding-system 'no-conversion))
     (write-region (point-min) (point-max) file-name)))
 
-(defun package-unpack-single (name version desc requires)
-  "Install the contents of the current buffer as a package."
-  ;; Special case "package".  FIXME: Should this still be supported?
-  (if (eq name 'package)
-      (package--write-file-no-coding
-       (expand-file-name (format "%s.el" name) package-user-dir))
-    (let* ((pkg-dir  (expand-file-name (format "%s-%s" name
-                                               (package-version-join
-                                                (version-to-list version)))
-                                       package-user-dir))
-           (el-file  (expand-file-name (format "%s.el" name) pkg-dir))
-           (pkg-file (expand-file-name (package--description-file pkg-dir)
-                                       pkg-dir)))
-      (make-directory pkg-dir t)
-      (package--write-file-no-coding el-file)
-      (let ((print-level nil)
-            (print-quoted t)
-            (print-length nil))
-        (write-region
-         (concat
-          (prin1-to-string
-           (list 'define-package
-                 (symbol-name name)
-                 version
-                 desc
-                 (when requires         ;Don't bother quoting nil.
-                   (list 'quote
-                         ;; Turn version lists into string form.
-                         (mapcar
-                          (lambda (elt)
-                            (list (car elt)
-                                  (package-version-join (cadr elt))))
-                          requires)))))
-          "\n")
-         nil
-         pkg-file
-         nil nil nil 'excl))
-      (package--make-autoloads-and-compile name pkg-dir)
-      pkg-dir)))
-
 (defmacro package--with-work-buffer (location file &rest body)
   "Run BODY in a buffer containing the contents of FILE at LOCATION.
 LOCATION is the base location of a package archive, and should be
@@ -709,6 +721,7 @@ FILE is the name of a file relative to that base location.
 This macro retrieves FILE from LOCATION into a temporary buffer,
 and evaluates BODY while that buffer is current.  This work
 buffer is killed afterwards.  Return the last value in BODY."
+  (declare (indent 2) (debug t))
   `(let* ((http (string-match "\\`https?:" ,location))
           (buffer
            (if http
@@ -741,19 +754,13 @@ It will move point to somewhere in the headers."
       (error "Error during download request:%s"
              (buffer-substring-no-properties (point) (line-end-position))))))
 
-(defun package-download-single (name version desc requires)
-  "Download and install a single-file package."
-  (let ((location (package-archive-base name))
-        (file (concat (symbol-name name) "-" version ".el")))
-    (package--with-work-buffer location file
-      (package-unpack-single name version desc requires))))
-
-(defun package-download-tar (name version)
+(defun package-install-from-archive (pkg-desc)
   "Download and install a tar package."
-  (let ((location (package-archive-base name))
-        (file (concat (symbol-name name) "-" version ".tar")))
+  (let ((location (package-archive-base pkg-desc))
+        (file (concat (package-desc-full-name pkg-desc)
+                      (package-desc-suffix pkg-desc))))
     (package--with-work-buffer location file
-      (package-unpack name version))))
+      (package-unpack pkg-desc))))
 
 (defvar package--initialized nil)
 
@@ -918,30 +925,8 @@ PACKAGE-LIST are satisfied, i.e. that PACKAGE-LIST is computed
 using `package-compute-transaction'."
   ;; FIXME: make package-list a list of pkg-desc.
   (dolist (elt package-list)
-    (let* ((desc (cdr (assq elt package-archive-contents)))
-           ;; As an exception, if package is "held" in
-           ;; `package-load-list', download the held version.
-           (hold (cadr (assq elt package-load-list)))
-           (v-string (or (and (stringp hold) hold)
-                         (package-version-join (package-desc-version desc))))
-           (kind (package-desc-kind desc))
-           (pkg-dir
-            (cond
-             ((eq kind 'tar)
-              (package-download-tar elt v-string))
-             ((eq kind 'single)
-              (package-download-single elt v-string
-                                       (package-desc-summary desc)
-                                       (package-desc-reqs desc)))
-             (t
-              (error "Unknown package kind: %s" (symbol-name kind))))))
-      ;; Update package-alist.
-      ;; FIXME: Check that the installed package's descriptor matches `desc'!
-      (package-load-descriptor pkg-dir)
-      ;; If package A depends on package B, then A may `require' B
-      ;; during byte compilation.  So we need to activate B before
-      ;; unpacking A.
-      (package-activate elt (version-to-list v-string)))))
+    (let ((desc (cdr (assq elt package-archive-contents))))
+      (package-install-from-archive desc))))
 
 ;;;###autoload
 (defun package-install (pkg-desc)
@@ -1018,60 +1003,48 @@ boundaries."
        (if requires-str (package-read-from-string requires-str))
        :kind 'single))))
 
-(defun package-tar-file-info (file)
+(defun package-tar-file-info ()
   "Find package information for a tar file.
-FILE is the name of the tar file to examine.
-The return result is a vector like `package-buffer-info'."
-  (let* ((default-directory (file-name-directory file))
-         (file (file-name-nondirectory file))
-         (dir-name
-          (if (string-match "\\.tar\\'" file)
-              (substring file 0 (match-beginning 0))
-            (error "Invalid package name `%s'" file)))
+The return result is a `package-desc'."
+  (cl-assert (derived-mode-p 'tar-mode))
+  (let* ((dir-name (file-name-directory
+                    (tar-header-name (car tar-parse-info))))
          (desc-file (package--description-file dir-name))
-         ;; Extract the package descriptor.
-         (pkg-def-contents (shell-command-to-string
-                            ;; Requires GNU tar.
-                            (concat "tar -xOf " file " "
-                                    dir-name "/" desc-file)))
-         (pkg-def-parsed (package-read-from-string pkg-def-contents)))
-    (unless (eq (car pkg-def-parsed) 'define-package)
-      (error "Can't find define-package in %s" desc-file))
-    (let ((pkg-desc
-           (apply #'package-desc-from-define (append (cdr pkg-def-parsed)
-                                                     '(:kind tar)))))
-      (unless (equal dir-name (package-desc-full-name pkg-desc))
-        ;; FIXME: Shouldn't this just be a message/warning?
-        (error "Package has inconsistent name"))
-      pkg-desc)))
+         (tar-desc (tar-get-file-descriptor (concat dir-name desc-file))))
+    (unless tar-desc
+      (error "No package descriptor file found"))
+    (with-current-buffer (tar--extract tar-desc)
+      (goto-char (point-min))
+      (unwind-protect
+          (let* ((pkg-def-parsed (read (current-buffer)))
+                 (pkg-desc
+                  (if (not (eq (car pkg-def-parsed) 'define-package))
+                      (error "Can't find define-package in %s"
+                             (tar-header-name tar-desc))
+                    (apply #'package-desc-from-define
+                           (append (cdr pkg-def-parsed))))))
+            (setf (package-desc-kind pkg-desc) 'tar)
+            pkg-desc)
+        (kill-buffer (current-buffer))))))
 
 
 ;;;###autoload
-(defun package-install-from-buffer (pkg-desc)
+(defun package-install-from-buffer ()
   "Install a package from the current buffer.
-When called interactively, the current buffer is assumed to be a
-single .el file that follows the packaging guidelines; see info
-node `(elisp)Packaging'.
-
-When called from Lisp, PKG-DESC is a `package-desc' describing the
-information)."
-  (interactive (list (package-buffer-info)))
-  (save-excursion
-    (save-restriction
-      (let* ((name      (package-desc-name pkg-desc))
-             (requires  (package-desc-reqs pkg-desc))
-             (desc      (package-desc-summary pkg-desc))
-             (pkg-version (package-desc-version pkg-desc)))
-        ;; Download and install the dependencies.
-        (let ((transaction (package-compute-transaction nil requires)))
-          (package-download-transaction transaction))
-        ;; Install the package itself.
-        (pcase (package-desc-kind pkg-desc)
-         (`single (package-unpack-single name pkg-version desc requires))
-         (`tar    (package-unpack name pkg-version))
-         (type    (error "Unknown type: %S" type)))
-        ;; Try to activate it.
-        (package-initialize)))))
+The current buffer is assumed to be a single .el or .tar file that follows the
+packaging guidelines; see info node `(elisp)Packaging'.
+Downloads and installs required packages as needed."
+  (interactive)
+  (let ((pkg-desc (if (derived-mode-p 'tar-mode)
+                      (package-tar-file-info)
+                    (package-buffer-info))))
+    ;; Download and install the dependencies.
+    (let* ((requires (package-desc-reqs pkg-desc))
+           (transaction (package-compute-transaction nil requires)))
+      (package-download-transaction transaction))
+    ;; Install the package itself.
+    (package-unpack pkg-desc)
+    pkg-desc))
 
 ;;;###autoload
 (defun package-install-file (file)
@@ -1080,12 +1053,8 @@ The file can either be a tar file or an Emacs Lisp file."
   (interactive "fPackage file name: ")
   (with-temp-buffer
     (insert-file-contents-literally file)
-    (cond
-     ((string-match "\\.el\\'" file)
-      (package-install-from-buffer (package-buffer-info)))
-     ((string-match "\\.tar\\'" file)
-      (package-install-from-buffer (package-tar-file-info file)))
-     (t (error "Unrecognized extension `%s'" (file-name-extension file))))))
+    (when (string-match "\\.tar\\'" file) (tar-mode))
+    (package-install-from-buffer)))
 
 (defun package-delete (pkg-desc)
   (let ((dir (package-desc-dir pkg-desc)))
@@ -1099,10 +1068,9 @@ The file can either be a tar file or an Emacs Lisp file."
       (error "Package `%s' is a system package, not deleting"
              (package-desc-full-name pkg-desc)))))
 
-(defun package-archive-base (name)
+(defun package-archive-base (desc)
   "Return the archive containing the package NAME."
-  (let ((desc (cdr (assq (intern-soft name) package-archive-contents))))
-    (cdr (assoc (package-desc-archive desc) package-archives))))
+  (cdr (assoc (package-desc-archive desc) package-archives)))
 
 (defun package--download-one-archive (archive file)
   "Retrieve an archive file FILE from ARCHIVE, and cache it.
@@ -1292,7 +1260,7 @@ If optional arg NO-ACTIVATE is non-nil, don't activate packages."
         ;; For elpa packages, try downloading the commentary.  If that
         ;; fails, try an existing readme file in `package-user-dir'.
         (cond ((condition-case nil
-                   (package--with-work-buffer (package-archive-base package)
+                   (package--with-work-buffer (package-archive-base desc)
                                               (concat package-name "-readme.txt")
                      (setq buffer-file-name
                            (expand-file-name readme package-user-dir))
diff --git a/lisp/tar-mode.el b/lisp/tar-mode.el
index 109107e857f..be7bdb25d26 100644
--- a/lisp/tar-mode.el
+++ b/lisp/tar-mode.el
@@ -740,10 +740,8 @@ tar-file's buffer."
           nil
           (error "This line does not describe a tar-file entry"))))
 
-(defun tar-get-descriptor ()
-  (let* ((descriptor (tar-current-descriptor))
-         (size (tar-header-size descriptor))
-         (link-p (tar-header-link-type descriptor)))
+(defun tar--check-descriptor (descriptor)
+  (let ((link-p (tar-header-link-type descriptor)))
     (if link-p
         (error "This is %s, not a real file"
                (cond ((eq link-p 5) "a directory")
@@ -754,10 +752,24 @@ tar-file's buffer."
                      ((eq link-p 38) "a volume header")
                      ((eq link-p 55) "a pax global extended header")
                      ((eq link-p 72) "a pax extended header")
-                     (t "a link"))))
+                     (t "a link"))))))
+
+(defun tar-get-descriptor ()
+  (let* ((descriptor (tar-current-descriptor))
+         (size (tar-header-size descriptor)))
+    (tar--check-descriptor descriptor)
     (if (zerop size) (message "This is a zero-length file"))
     descriptor))
 
+(defun tar-get-file-descriptor (file)
+  ;; Used by package.el.
+  (let ((desc ()))
+    (dolist (hdr tar-parse-info)
+      (when (equal file (tar-header-name hdr))
+        (setq desc hdr)))
+    (tar--check-descriptor desc)
+    desc))
+
 (defun tar-mouse-extract (event)
   "Extract a file whose tar directory line you click on."
   (interactive "e")
@@ -776,96 +788,99 @@ tar-file's buffer."
       (let ((file-name-handler-alist nil))
         (apply op args))))
 
+(defun tar--extract (descriptor)
+  "Extract this entry of the tar file into its own buffer."
+  (let* ((name (tar-header-name descriptor))
+         (size (tar-header-size descriptor))
+         (start (tar-header-data-start descriptor))
+         (end (+ start size))
+         (tarname (buffer-name))
+         (bufname (concat (file-name-nondirectory name)
+                          " ("
+                          tarname
+                          ")"))
+         (buffer (generate-new-buffer bufname)))
+    (with-current-buffer buffer
+      (setq buffer-undo-list t))
+    (with-current-buffer tar-data-buffer
+      (let (coding)
+        (narrow-to-region start end)
+        (goto-char start)
+        (setq coding (or coding-system-for-read
+                         (and set-auto-coding-function
+                              (funcall set-auto-coding-function
+                                       name (- end start)))
+                         ;; The following binding causes
+                         ;; find-buffer-file-type-coding-system
+                         ;; (defined on dos-w32.el) to act as if
+                         ;; the file being extracted existed, so
+                         ;; that the file's contents' encoding and
+                         ;; EOL format are auto-detected.
+                         (let ((file-name-handler-alist
+                                '(("" . tar-file-name-handler))))
+                           (car (find-operation-coding-system
+                                 'insert-file-contents
+                                 (cons name (current-buffer)) t)))))
+        (if (or (not coding)
+                (eq (coding-system-type coding) 'undecided))
+            (setq coding (detect-coding-region start end t)))
+        (if (and (default-value 'enable-multibyte-characters)
+                 (coding-system-get coding :for-unibyte))
+            (with-current-buffer buffer
+              (set-buffer-multibyte nil)))
+        (widen)
+        (decode-coding-region start end coding buffer)))
+    buffer))
+
 (defun tar-extract (&optional other-window-p)
   "In Tar mode, extract this entry of the tar file into its own buffer."
   (interactive)
   (let* ((view-p (eq other-window-p 'view))
          (descriptor (tar-get-descriptor))
          (name (tar-header-name descriptor))
-         (size (tar-header-size descriptor))
-         (start (tar-header-data-start descriptor))
-         (end (+ start size)))
-    (let* ((tar-buffer (current-buffer))
-           (tarname (buffer-name))
-           (bufname (concat (file-name-nondirectory name)
-                            " ("
-                             tarname
-                             ")"))
-           (read-only-p (or buffer-read-only view-p))
-           (new-buffer-file-name (expand-file-name
-                                  ;; `:' is not allowed on Windows
-                                  (concat tarname "!"
-                                          (if (string-match "/" name)
-                                              name
-                                            ;; Make sure `name' contains a /
-                                            ;; so set-auto-mode doesn't try
-                                            ;; to look at `tarname' for hints.
-                                            (concat "./" name)))))
-           (buffer (get-file-buffer new-buffer-file-name))
-           (just-created nil)
-           undo-list)
-      (unless buffer
-        (setq buffer (generate-new-buffer bufname))
-        (with-current-buffer buffer
-          (setq undo-list buffer-undo-list
-                buffer-undo-list t))
-        (setq bufname (buffer-name buffer))
-        (setq just-created t)
-        (with-current-buffer tar-data-buffer
-          (let (coding)
-            (narrow-to-region start end)
-            (goto-char start)
-            (setq coding (or coding-system-for-read
-                             (and set-auto-coding-function
-                                  (funcall set-auto-coding-function
-                                           name (- end start)))
-                             ;; The following binding causes
-                             ;; find-buffer-file-type-coding-system
-                             ;; (defined on dos-w32.el) to act as if
-                             ;; the file being extracted existed, so
-                             ;; that the file's contents' encoding and
-                             ;; EOL format are auto-detected.
-                             (let ((file-name-handler-alist
-                                    '(("" . tar-file-name-handler))))
-                               (car (find-operation-coding-system
-                                     'insert-file-contents
-                                     (cons name (current-buffer)) t)))))
-            (if (or (not coding)
-                    (eq (coding-system-type coding) 'undecided))
-                (setq coding (detect-coding-region start end t)))
-            (if (and (default-value 'enable-multibyte-characters)
-                     (coding-system-get coding :for-unibyte))
-                (with-current-buffer buffer
-                  (set-buffer-multibyte nil)))
-            (widen)
-            (decode-coding-region start end coding buffer)))
-        (with-current-buffer buffer
-          (goto-char (point-min))
-          (setq buffer-file-name new-buffer-file-name)
-          (setq buffer-file-truename
-                (abbreviate-file-name buffer-file-name))
-          ;; Force buffer-file-coding-system to what
-          ;; decode-coding-region actually used.
-          (set-buffer-file-coding-system last-coding-system-used t)
-          ;; Set the default-directory to the dir of the
-          ;; superior buffer.
-          (setq default-directory
-                (with-current-buffer tar-buffer
-                  default-directory))
-          (rename-buffer bufname)
-          (set-buffer-modified-p nil)
-          (setq buffer-undo-list undo-list)
-          (normal-mode)  ; pick a mode.
-          (set (make-local-variable 'tar-superior-buffer) tar-buffer)
-          (set (make-local-variable 'tar-superior-descriptor) descriptor)
-          (setq buffer-read-only read-only-p)
-          (tar-subfile-mode 1)))
-      (cond
-       (view-p
-        (view-buffer buffer (and just-created 'kill-buffer-if-not-modified)))
-       ((eq other-window-p 'display) (display-buffer buffer))
-       (other-window-p (switch-to-buffer-other-window buffer))
-       (t (switch-to-buffer buffer))))))
+         (tar-buffer (current-buffer))
+         (tarname (buffer-name))
+         (read-only-p (or buffer-read-only view-p))
+         (new-buffer-file-name (expand-file-name
+                                ;; `:' is not allowed on Windows
+                                (concat tarname "!"
+                                        (if (string-match "/" name)
+                                            name
+                                          ;; Make sure `name' contains a /
+                                          ;; so set-auto-mode doesn't try
+                                          ;; to look at `tarname' for hints.
+                                          (concat "./" name)))))
+         (buffer (get-file-buffer new-buffer-file-name))
+         (just-created nil))
+    (unless buffer
+      (setq buffer (tar--extract descriptor))
+      (setq just-created t)
+      (with-current-buffer buffer
+        (goto-char (point-min))
+        (setq buffer-file-name new-buffer-file-name)
+        (setq buffer-file-truename
+              (abbreviate-file-name buffer-file-name))
+        ;; Force buffer-file-coding-system to what
+        ;; decode-coding-region actually used.
+        (set-buffer-file-coding-system last-coding-system-used t)
+        ;; Set the default-directory to the dir of the
+        ;; superior buffer.
+        (setq default-directory
+              (with-current-buffer tar-buffer
+                default-directory))
+        (set-buffer-modified-p nil)
+        (setq buffer-undo-list t)
+        (normal-mode)                   ; pick a mode.
+        (set (make-local-variable 'tar-superior-buffer) tar-buffer)
+        (set (make-local-variable 'tar-superior-descriptor) descriptor)
+        (setq buffer-read-only read-only-p)
+        (tar-subfile-mode 1)))
+    (cond
+     (view-p
+      (view-buffer buffer (and just-created 'kill-buffer-if-not-modified)))
+     ((eq other-window-p 'display) (display-buffer buffer))
+     (other-window-p (switch-to-buffer-other-window buffer))
+     (t (switch-to-buffer buffer)))))
 
 
 (defun tar-extract-other-window ()