* 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.

1 files changed, 104 insertions, 89 deletions

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 ()