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