bug#13291: The package description buffer needs an URL button

[Dmitry Gutov <dgutov@yandex.ru>]

[-- Attachment #1: Type: text/plain, Size: 238 bytes --]

And here's the updated patch for package.el, with saving the new 
metadata to -pkg.el file when a single-file package is being installed, 
and with support for it in `package-install-file'.

Again, probably less tested that it should be.

[-- Attachment #2: package-homepage-button.diff --]
[-- Type: text/plain, Size: 10283 bytes --]

=== modified file 'lisp/ChangeLog'
--- lisp/ChangeLog	2013-01-12 19:24:27 +0000
+++ lisp/ChangeLog	2013-01-13 07:54:01 +0000
@@ -1,3 +1,27 @@
+2013-01-13  Dmitry Gutov  <dgutov@yandex.ru>
+
+	* emacs-lisp/package.el (package-desc-kind): Get the kind from the
+	metadata plist.
+	(package-desc-meta): Return metadata plist.
+	(define-package): Store EXTRA-PROPERTIES as the 4th element of
+	the package data vector.
+	(package--add-to-archive-contents): Instead of just package kind,
+	use the 4th element of the vector for the matadata.  Include kind
+	in the metadata.
+	(describe-package-1): When the package metadata includes
+	`:homepage', display a link button for it (bug#13291).
+	(package-unpack-single): Accept a 5th argument, with metadata.
+	Appent it to the `define-package' form.
+	(package-download-single): Accept and pass on the META argument.
+	(package-download-transaction): Pass the package metadata to
+	`package-download-single'.
+	(package-buffer-info): Return the package metadata (currently with
+	just homepage) as the 6th vector argument.
+	(package-tar-file-info): Same.  Like most of the elements of the
+	returned vector, though, it won't be used by the caller.
+	(package-install-from-buffer): Get package metadata from PKG-INFO
+	and pass it to `package-unpack-single'.
+
 2013-01-12  Michael Albinus  <michael.albinus@gmx.de>
 
 	* autorevert.el (auto-revert-notify-watch-descriptor): Give it

=== modified file 'lisp/emacs-lisp/package.el'
--- lisp/emacs-lisp/package.el	2013-01-01 09:11:05 +0000
+++ lisp/emacs-lisp/package.el	2013-01-13 07:44:34 +0000
@@ -170,6 +170,7 @@
 ;;; Code:
 
 (require 'tabulated-list)
+(require 'cl-lib)
 
 (defgroup package nil
   "Manager for Emacs Lisp packages."
@@ -302,12 +303,13 @@
 Each element has the form (PKG . DESC), where PKG is a package
 name (a symbol) and DESC is a vector that describes the package.
 
-The vector DESC has the form [VERSION-LIST REQS DOCSTRING].
+The vector DESC has the form [VERSION-LIST REQS DOCSTRING META].
   VERSION-LIST is a version list.
   REQS is a list of packages required by the package, each
    requirement having the form (NAME VL) where NAME is a string
    and VL is a version list.
   DOCSTRING is a brief description of the package.
+  META is a property list mapping metadata keywords to values.
 
 This variable is set automatically by `package-load-descriptor',
 called via `package-initialize'.  To change which packages are
@@ -426,6 +428,10 @@
 
 (defsubst package-desc-kind (desc)
   "Extract the kind of download from an archive package description vector."
+  (plist-get (package-desc-meta desc) :kind))
+
+(defsubst package-desc-meta (desc)
+  "Extract the metadata property list from a package description vector."
   (aref desc 3))
 
 (defun package--dir (name version)
@@ -525,7 +531,7 @@
 
 (defun define-package (name-string version-string
 				&optional docstring requirements
-				&rest _extra-properties)
+				&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.
@@ -533,8 +539,8 @@
 REQUIREMENTS is a list of dependencies on other packages.
  Each requirement is of the form (OTHER-PACKAGE OTHER-VERSION),
  where OTHER-VERSION is a string.
-
-EXTRA-PROPERTIES is currently unused."
+EXTRA-PROPERTIES is a property list mapping additional metadata
+keywords (e.g. `:homepage') to values."
   (let* ((name (intern name-string))
 	 (version (version-to-list version-string))
 	 (new-pkg-desc
@@ -545,7 +551,8 @@
 			   (list (car elt)
 				 (version-to-list (car (cdr elt)))))
 			 requirements)
-			docstring)))
+			docstring
+			extra-properties)))
 	 (old-pkg (assq name package-alist)))
     (cond
      ;; If there's no old package, just add this to `package-alist'.
@@ -642,7 +649,7 @@
   (let ((buffer-file-coding-system 'no-conversion))
     (write-region (point-min) (point-max) file-name)))
 
-(defun package-unpack-single (file-name version desc requires)
+(defun package-unpack-single (file-name version desc requires meta)
   "Install the contents of the current buffer as a package."
   ;; Special case "package".
   (if (string= file-name "package")
@@ -661,17 +668,19 @@
 	(write-region
 	 (concat
 	  (prin1-to-string
-	   (list 'define-package
-		 file-name
-		 version
-		 desc
-		 (list 'quote
-		       ;; Turn version lists into string form.
-		       (mapcar
-			(lambda (elt)
-			  (list (car elt)
-				(package-version-join (cadr elt))))
-			requires))))
+           (nconc
+            (list 'define-package
+                  file-name
+                  version
+                  desc
+                  (list 'quote
+                        ;; Turn version lists into string form.
+                        (mapcar
+                         (lambda (elt)
+                           (list (car elt)
+                                 (package-version-join (cadr elt))))
+                         requires)))
+            meta))
 	  "\n")
 	 nil
 	 pkg-file
@@ -721,12 +730,12 @@
 						       (end-of-line)
 						       (point)))))))
 
-(defun package-download-single (name version desc requires)
+(defun package-download-single (name version desc requires meta)
   "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 (symbol-name name) version desc requires))))
+      (package-unpack-single (symbol-name name) version desc requires meta))))
 
 (defun package-download-tar (name version)
   "Download and install a tar package."
@@ -853,8 +862,15 @@
 Also, add the originating archive to the end of the package vector."
   (let* ((name    (car package))
          (version (package-desc-vers (cdr package)))
+         (data    (append (cdr package) nil))
+         (ex-len  (- (length data) 3))
+         (extras  (last data ex-len))
          (entry   (cons name
-			(vconcat (cdr package) (vector archive))))
+                        (vconcat (nbutlast data ex-len)
+                                 ;; Save the kind and any following
+                                 ;; keyword-value pairs as metadata.
+                                 (vector (cons :kind extras)
+                                         archive))))
          (existing-package (assq name package-archive-contents)))
     (cond ((not existing-package)
 	   (add-to-list 'package-archive-contents entry))
@@ -886,7 +902,8 @@
        ((eq kind 'single)
 	(package-download-single elt v-string
 				 (package-desc-doc desc)
-				 (package-desc-reqs desc)))
+				 (package-desc-reqs desc)
+                                 (package-desc-meta desc)))
        (t
 	(error "Unknown package kind: %s" (symbol-name kind))))
       ;; If package A depends on package B, then A may `require' B
@@ -942,7 +959,7 @@
   "Return a vector describing the package in the current buffer.
 The vector has the form
 
-   [FILENAME REQUIRES DESCRIPTION VERSION COMMENTARY]
+   [FILENAME REQUIRES DESCRIPTION VERSION COMMENTARY META]
 
 FILENAME is the file name, a string, sans the \".el\" extension.
 REQUIRES is a list of requirements, each requirement having the
@@ -950,6 +967,7 @@
 DESCRIPTION is the package description, a string.
 VERSION is the version, a string.
 COMMENTARY is the commentary section, a string, or nil if none.
+META is a property list with additional metadata.
 
 If the buffer does not contain a conforming package, signal an
 error.  If there is a package, narrow the buffer to the file's
@@ -975,7 +993,8 @@
 	   (pkg-version
 	    (or (package-strip-rcs-id (lm-header "package-version"))
 		(package-strip-rcs-id (lm-header "version"))))
-	   (commentary (lm-commentary)))
+	   (commentary (lm-commentary))
+           (homepage (lm-homepage)))
       (unless pkg-version
 	(error
 	 "Package lacks a \"Version\" or \"Package-Version\" header"))
@@ -986,7 +1005,8 @@
 	       (list (car elt)
 		     (version-to-list (car (cdr elt)))))
 	     requires))
-      (vector file-name requires desc pkg-version commentary))))
+      (vector file-name requires desc pkg-version commentary
+              (list :homepage homepage)))))
 
 (defun package-tar-file-info (file)
   "Find package information for a tar file.
@@ -1013,6 +1033,7 @@
 	    (version-string (nth 2 pkg-def-parsed))
 	    (docstring      (nth 3 pkg-def-parsed))
 	    (requires       (nth 4 pkg-def-parsed))
+            (meta           (cdr (cl-cddddr pkg-def-parsed)))
 	    (readme (shell-command-to-string
 		     ;; Requires GNU tar.
 		     (concat "tar -xOf " file " "
@@ -1032,7 +1053,7 @@
 			(list (car elt)
 			      (version-to-list (cadr elt))))
 		      requires))
-	(vector pkg-name requires docstring version-string readme)))))
+	(vector pkg-name requires docstring version-string readme meta)))))
 
 ;;;###autoload
 (defun package-install-from-buffer (pkg-info type)
@@ -1052,14 +1073,15 @@
 	     (desc (if (string= (aref pkg-info 2) "")
 		       "No description available."
 		     (aref pkg-info 2)))
-	     (pkg-version (aref pkg-info 3)))
+	     (pkg-version (aref pkg-info 3))
+             (meta (aref pkg-info 5)))
 	;; Download and install the dependencies.
 	(let ((transaction (package-compute-transaction nil requires)))
 	  (package-download-transaction transaction))
 	;; Install the package itself.
 	(cond
 	 ((eq type 'single)
-	  (package-unpack-single file-name pkg-version desc requires))
+	  (package-unpack-single file-name pkg-version desc requires meta))
 	 ((eq type 'tar)
 	  (package-unpack (intern file-name) pkg-version))
 	 (t
@@ -1261,7 +1283,13 @@
 	  (help-insert-xref-button text 'help-package name))
 	(insert "\n")))
     (insert "    " (propertize "Summary" 'font-lock-face 'bold)
-	    ": " (if desc (package-desc-doc desc)) "\n\n")
+	    ": " (if desc (package-desc-doc desc)) "\n")
+    (let ((homepage (plist-get (package-desc-meta desc) :homepage)))
+      (when homepage
+        (insert "   " (propertize "Homepage" 'font-lock-face 'bold) ": ")
+        (help-insert-xref-button homepage 'help-url homepage)
+        (insert "\n")))
+    (insert "\n")
 
     (if built-in
 	;; For built-in packages, insert the commentary.