=== modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2013-08-06 12:18:43 +0000 +++ lisp/ChangeLog 2013-08-07 09:14:53 +0000 @@ -1,3 +1,22 @@ +2013-08-07 Dmitry Gutov + + * emacs-lisp/package.el (package-desc-from-define): Accept + additional arguments as plist, convert it to an alist and store it + in the `extras' slot. + (package-generate-description-file): Convert extras alist back to + plist and append to the `define-package' form arguments. + (package--alist-to-plist): New function. + (package--ac-desc): Add `extras' slot. + (package--add-to-archive-contents): Check if the archive-contents + vector is long enough, and if it is, pass its `extras' slot value + to `package-desc-create'. + (package-buffer-info): Call `lm-homepage', pass the returned value + to `package-desc-from-define'. + (describe-package-1): Render the homepage button. + + * emacs-lisp/package-x.el (package-upload-buffer-internal): Pass + `extras' slot from `package-desc' to `package-make-ac-desc'. + 2013-08-06 Juanma Barranquero * frameset.el (frameset, frameset-filter-alist) === modified file 'lisp/emacs-lisp/package-x.el' --- lisp/emacs-lisp/package-x.el 2013-06-27 09:26:54 +0000 +++ lisp/emacs-lisp/package-x.el 2013-08-07 08:31:50 +0000 @@ -209,6 +209,7 @@ (pcase file-type (`single (lm-commentary)) (`tar nil))) ;; FIXME: Get it from the README file. + (extras (package-desc-extras pkg-desc)) (pkg-version (package-version-join split-version)) (pkg-buffer (current-buffer))) @@ -217,7 +218,7 @@ (let ((contents (or (package--archive-contents-from-url archive-url) (package--archive-contents-from-file))) (new-desc (package-make-ac-desc - split-version requires desc file-type))) + split-version requires desc file-type extras))) (if (> (car contents) package-archive-version) (error "Unrecognized archive version %d" (car contents))) (let ((elt (assq pkg-name (cdr contents)))) === modified file 'lisp/emacs-lisp/package.el' --- lisp/emacs-lisp/package.el 2013-08-03 02:34:22 +0000 +++ lisp/emacs-lisp/package.el 2013-08-07 08:51:42 +0000 @@ -296,7 +296,7 @@ (:constructor package-desc-from-define (name-string version-string &optional summary requirements - &key kind archive &allow-other-keys + &rest rest-plist &aux (name (intern name-string)) (version (version-to-list version-string)) @@ -305,7 +305,19 @@ (version-to-list (cadr elt)))) (if (eq 'quote (car requirements)) (nth 1 requirements) - requirements)))))) + requirements))) + (kind (plist-get rest-plist :kind)) + (archive (plist-get rest-plist :archive)) + (extras (let (alist) + (cl-remf rest-plist :kind) + (cl-remf rest-plist :archive) + (while rest-plist + (let ((value (cadr rest-plist))) + (when value + (push (cons (car rest-plist) value) + alist))) + (setq rest-plist (cddr rest-plist))) + alist))))) "Structure containing information about an individual package. Slots: @@ -327,14 +339,17 @@ package came. `dir' The directory where the package is installed (if installed), - `builtin' if it is built-in, or nil otherwise." + `builtin' if it is built-in, or nil otherwise. + +`extras' Optional alist of additional keyword-value pairs." name version (summary package--default-summary) reqs kind archive - dir) + dir + extras) ;; Pseudo fields. (defun package-desc-full-name (pkg-desc) @@ -635,22 +650,28 @@ (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))))) + (nconc + (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)))) + (package--alist-to-plist + (package-desc-extras pkg-desc)))) "\n") nil pkg-file)))) +(defun package--alist-to-plist (alist) + (apply #'nconc (mapcar (lambda (pair) (list (car pair) (cdr pair))) alist))) + (defun package-unpack (pkg-desc) "Install the contents of the current buffer as a package." (let* ((name (package-desc-name pkg-desc)) @@ -886,10 +907,10 @@ ;; Changing this defstruct implies changing the format of the ;; "archive-contents" files. (cl-defstruct (package--ac-desc - (:constructor package-make-ac-desc (version reqs summary kind)) + (:constructor package-make-ac-desc (version reqs summary kind extras)) (:copier nil) (:type vector)) - version reqs summary kind) + version reqs summary kind extras) (defun package--add-to-archive-contents (package archive) "Add the PACKAGE from the given ARCHIVE if necessary. @@ -904,7 +925,11 @@ :reqs (package--ac-desc-reqs (cdr package)) :summary (package--ac-desc-summary (cdr package)) :kind (package--ac-desc-kind (cdr package)) - :archive archive)) + :archive archive + :extras (and (> (length (cdr package)) 4) + ;; Older archive-contents files have only 4 + ;; elements here. + (package--ac-desc-extras (cdr package))))) (existing-packages (assq name package-archive-contents)) (pinned-to-archive (assoc name package-pinned-packages))) (cond @@ -997,14 +1022,16 @@ ;; probably wants us to use it. Otherwise try Version. (pkg-version (or (package-strip-rcs-id (lm-header "package-version")) - (package-strip-rcs-id (lm-header "version"))))) + (package-strip-rcs-id (lm-header "version")))) + (homepage (lm-homepage))) (unless pkg-version (error "Package lacks a \"Version\" or \"Package-Version\" header")) (package-desc-from-define file-name pkg-version desc (if requires-str (package-read-from-string requires-str)) - :kind 'single)))) + :kind 'single + :homepage homepage)))) (declare-function tar-get-file-descriptor "tar-mode" (file)) (declare-function tar--extract "tar-mode" (descriptor)) @@ -1173,6 +1200,8 @@ (reqs (if desc (package-desc-reqs desc))) (version (if desc (package-desc-version desc))) (archive (if desc (package-desc-archive desc))) + (homepage (if desc (cdr (assoc :homepage + (package-desc-extras desc))))) (built-in (eq pkg-dir 'builtin)) (installable (and archive (not built-in))) (status (if desc (package-desc-status desc) "orphan"))) @@ -1241,7 +1270,10 @@ (insert "\n"))) (insert " " (propertize "Summary" 'font-lock-face 'bold) ": " (if desc (package-desc-summary desc)) "\n") - + (when homepage + (insert " " (propertize "Homepage" 'font-lock-face 'bold) ": ") + (help-insert-xref-button homepage 'help-url homepage) + (insert "\n")) (let* ((all-pkgs (append (cdr (assq name package-alist)) (cdr (assq name package-archive-contents)) (let ((bi (assq name package--builtins))) === modified file 'test/ChangeLog' --- test/ChangeLog 2013-08-05 01:32:00 +0000 +++ test/ChangeLog 2013-08-07 09:43:50 +0000 @@ -1,3 +1,29 @@ +2013-08-07 Dmitry Gutov + + * automated/package-test.el (simple-single-desc-1-4): Remove, it + was unused. + (simple-single-desc): Expect :homepage property. + (multi-file-desc): Same. + (with-package-test): Do not save previous `default-directory' + value, let-bind the var instead. + (package-test-install-single): Expect :homepage property in the + generated pkg file. + (package-test-describe-package): Expect Homepage button. + (package-test-describe-non-installed-package) + (package-test-describe-non-installed-multi-file-package): Same. + (package-test-describe-not-installed-package): Remove, it was a + duplicate. + + * automated/package-x-test.el + (package-x-test--single-archive-entry-1-3): Expect :homepage + property. + (package-x-test--single-archive-entry-1-4): Expect nil extras slot. + + * automated/data/package/simple-single-1.3.el: Add URL header. + + * automated/data/package/archive-contents: Add :homepage + properties to `simple-single' and `multi-file'. + 2013-08-05 Glenn Morris * automated/mule-util.el: New file, with tests extracted from === modified file 'test/automated/data/package/archive-contents' --- test/automated/data/package/archive-contents 2013-06-27 09:26:54 +0000 +++ test/automated/data/package/archive-contents 2013-08-07 08:37:09 +0000 @@ -1,10 +1,12 @@ (1 (simple-single . [(1 3) - nil "A single-file package with no dependencies" single]) + nil "A single-file package with no dependencies" single + ((:homepage . "http://doodles.au"))]) (simple-depend . [(1 0) ((simple-single (1 3))) "A single-file package with a dependency." single]) (multi-file . [(0 2 3) - nil "Example of a multi-file tar package" tar])) + nil "Example of a multi-file tar package" tar + ((:homepage . "http://puddles.li"))])) === modified file 'test/automated/data/package/multi-file-0.2.3.tar' Binary files test/automated/data/package/multi-file-0.2.3.tar 2013-06-27 09:26:54 +0000 and test/automated/data/package/multi-file-0.2.3.tar 2013-08-06 22:11:14 +0000 differ === modified file 'test/automated/data/package/simple-single-1.3.el' --- test/automated/data/package/simple-single-1.3.el 2013-06-27 09:26:54 +0000 +++ test/automated/data/package/simple-single-1.3.el 2013-08-07 08:36:44 +0000 @@ -3,6 +3,7 @@ ;; Author: J. R. Hacker ;; Version: 1.3 ;; Keywords: frobnicate +;; URL: http://doodles.au ;;; Commentary: === modified file 'test/automated/package-test.el' --- test/automated/package-test.el 2013-07-11 16:01:26 +0000 +++ test/automated/package-test.el 2013-08-07 09:44:09 +0000 @@ -47,16 +47,10 @@ (package-desc-create :name 'simple-single :version '(1 3) :summary "A single-file package with no dependencies" - :kind 'single) + :kind 'single + :extras '((:homepage . "http://doodles.au"))) "Expected `package-desc' parsed from simple-single-1.3.el.") -(defvar simple-single-desc-1-4 - (package-desc-create :name 'simple-single - :version '(1 4) - :summary "A single-file package with no dependencies" - :kind 'single) - "Expected `package-desc' parsed from simple-single-1.4.el.") - (defvar simple-depend-desc (package-desc-create :name 'simple-depend :version '(1 0) @@ -69,7 +63,8 @@ (package-desc-create :name 'multi-file :version '(0 2 3) :summary "Example of a multi-file tar package" - :kind 'tar) + :kind 'tar + :extras '((:homepage . "http://puddles.li"))) "Expected `package-desc' from \"multi-file-0.2.3.tar\".") (defvar new-pkg-desc @@ -100,7 +95,7 @@ (package-user-dir package-test-user-dir) (package-archives `(("gnu" . ,package-test-data-dir))) (old-yes-no-defn (symbol-function 'yes-or-no-p)) - (old-pwd default-directory) + (default-directory package-test-file-dir) package--initialized package-alist ,@(if update-news @@ -131,8 +126,7 @@ (when (and (boundp 'package-test-archive-upload-base) (file-directory-p package-test-archive-upload-base)) (delete-directory package-test-archive-upload-base t)) - (setf (symbol-function 'yes-or-no-p) old-yes-no-defn) - (cd old-pwd)))) + (setf (symbol-function 'yes-or-no-p) old-yes-no-defn)))) (defmacro with-fake-help-buffer (&rest body) "Execute BODY in a temp buffer which is treated as the \"*Help*\" buffer." @@ -232,7 +226,9 @@ (should (string= (buffer-string) (concat "(define-package \"simple-single\" \"1.3\" " "\"A single-file package " - "with no dependencies\" 'nil)\n")))) + "with no dependencies\" 'nil " + ":homepage \"http://doodles.au\"" + ")\n")))) (should (file-exists-p autoloads-file)) (should-not (get-file-buffer autoloads-file))))) @@ -357,23 +353,12 @@ (should (search-forward "Version: 1.3" nil t)) (should (search-forward "Summary: A single-file package with no dependencies" nil t)) + (should (search-forward "Homepage: http://doodles.au" nil t)) ;; No description, though. Because at this point we don't know ;; what archive the package originated from, and we don't have ;; its readme file saved. ))) -(ert-deftest package-test-describe-not-installed-package () - "Test displaying of the readme for not-installed package." - - (with-package-test () - (package-initialize) - (package-refresh-contents) - (with-fake-help-buffer - (describe-package 'simple-single) - (goto-char (point-min)) - (should (search-forward "This package provides a minor mode to frobnicate" - nil t))))) - (ert-deftest package-test-describe-non-installed-package () "Test displaying of the readme for non-installed package." @@ -383,6 +368,7 @@ (with-fake-help-buffer (describe-package 'simple-single) (goto-char (point-min)) + (should (search-forward "Homepage: http://doodles.au" nil t)) (should (search-forward "This package provides a minor mode to frobnicate" nil t))))) @@ -395,6 +381,7 @@ (with-fake-help-buffer (describe-package 'multi-file) (goto-char (point-min)) + (should (search-forward "Homepage: http://puddles.li" nil t)) (should (search-forward "This is a bare-bones readme file for the multi-file" nil t))))) === modified file 'test/automated/package-x-test.el' --- test/automated/package-x-test.el 2013-07-09 07:11:50 +0000 +++ test/automated/package-x-test.el 2013-08-07 08:34:21 +0000 @@ -48,14 +48,16 @@ (cons 'simple-single (package-make-ac-desc '(1 3) nil "A single-file package with no dependencies" - 'single)) + 'single + '((:homepage . "http://doodles.au")))) "Expected contents of the archive entry from the \"simple-single\" package.") (defvar package-x-test--single-archive-entry-1-4 (cons 'simple-single (package-make-ac-desc '(1 4) nil "A single-file package with no dependencies" - 'single)) + 'single + nil)) "Expected contents of the archive entry from the updated \"simple-single\" package.") (ert-deftest package-x-test-upload-buffer ()