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

[Dmitry Gutov <dgutov@yandex.ru>]

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

Here's a rough patch for elpa/admin/archive-contents.el

[-- Attachment #2: archive-contents-homepage.diff --]
[-- Type: text/plain, Size: 4642 bytes --]

=== modified file 'admin/archive-contents.el' (properties changed: -x to +x)
--- admin/archive-contents.el	2012-11-29 17:21:45 +0000
+++ admin/archive-contents.el	2013-01-13 06:17:37 +0000
@@ -122,15 +122,16 @@
 
 (defun archive--simple-package-p (dir pkg)
   "Test whether DIR contains a simple package named PKG.
-If so, return a list (VERSION DESCRIPTION REQ COMMENTARY), where
-VERSION is the version string of the simple package, DESCRIPTION
-is the brief description of the package, REQ is a list of
-requirements, and COMMENTARY is the package commentary.
+If so, return a list (VERSION DESCRIPTION REQ COMMENTARY
+METADATA...), where VERSION is the version string of the simple
+package, DESCRIPTION is the brief description of the package, REQ
+is a list of requirements, COMMENTARY is the package commentary,
+and METADATA is a property list with additional metadata.
 Otherwise, return nil."
   (let* ((pkg-file (expand-file-name (concat pkg "-pkg.el") dir))
 	 (mainfile (expand-file-name (concat pkg ".el") dir))
          (files (directory-files dir nil archive-re-no-dot))
-	 version description req commentary)
+	 version description req commentary homepage)
     (dolist (file (prog1 files (setq files ())))
       (unless (string-match "\\.elc\\'" file)
         (push file files)))
@@ -157,11 +158,15 @@
                 (setq req (mapcar 'archive--convert-require
                                   (car (read-from-string requires-str))))))
           (setq commentary (lm-commentary))
-          (list version description req commentary))))
+          (setq homepage (or (lm-homepage)
+                             (format "http://elpa.gnu.org/packages/%s.html" pkg)))
+          (list version description req commentary
+                :homepage homepage))))
      ((not (file-exists-p pkg-file))
       (error "Can find single file nor package desc file in %s" dir)))))
 
-(defun archive--process-simple-package (dir pkg vers desc req commentary)
+(defun archive--process-simple-package (dir pkg vers desc req commentary
+                                            &rest extra-properties)
   "Deploy the contents of DIR into the archive as a simple package.
 Rename DIR/PKG.el to PKG-VERS.el, delete DIR, and write the
 package commentary to PKG-readme.txt.  Return the descriptor."
@@ -205,7 +210,9 @@
       (save-buffer)
       (kill-buffer)))
   (delete-directory dir t)
-  (cons (intern pkg) (vector (version-to-list vers) req desc 'single)))
+  (cons (intern pkg) (vconcat
+                      (vector (version-to-list vers) req desc 'single)
+                      extra-properties)))
 
 (defun archive--make-changelog (dir)
   "Export Bzr log info of DIR into a ChangeLog file."
@@ -239,7 +246,9 @@
     (when (file-exists-p readme)
       (copy-file readme (concat pkg "-readme.txt") 'ok-if-already-exists))
     (rename-file dir (concat pkg "-" vers))
-    (cons (intern pkg) (vector (version-to-list vers) req (nth 3 exp) 'tar))))
+    (cons (intern pkg) (vconcat
+                        (vector (version-to-list vers) req (nth 3 exp) 'tar)
+                        (cdr (cddddr exp))))))
 
 (defun archive--multi-file-package-def (dir pkg)
   "Reurn the `define-package' form in the file DIR/PKG-pkg.el."
@@ -294,7 +303,8 @@
       ;; FIXME: Don't compile the -pkg.el files!
       (byte-recompile-directory dir 0))))
 
-(defun archive--write-pkg-file (pkg-dir name version desc requires &rest ignored)
+(defun archive--write-pkg-file (pkg-dir name version desc requires
+                                        &rest extra-properties)
   (let ((pkg-file (expand-file-name (concat name "-pkg.el") pkg-dir))
 	(print-level nil)
 	(print-length nil))
@@ -302,17 +312,19 @@
      (concat (format ";; Generated package description from %s.el\n"
 		     name)
 	     (prin1-to-string
-	      (list 'define-package
-		    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
+                     name
+                     version
+                     desc
+                     (list 'quote
+                           ;; Turn version lists into string form.
+                           (mapcar
+                            (lambda (elt)
+                              (list (car elt)
+                                    (package-version-join (cadr elt))))
+                            requires)))
+               extra-properties))
 	     "\n")
      nil
      pkg-file)))