From: Dmitry Gutov Date: Sun, 29 Sep 2013 19:41:00 +0000 (+0300) Subject: * lisp/emacs-lisp/package-x.el (package-upload-buffer-internal): Pass X-Git-Tag: emacs-24.3.90~173^2^2~42^2~45^2~387^2~1425 X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=056453c62ebfdcea2764fdaba09a89d0e533ec1d;p=emacs.git * lisp/emacs-lisp/package-x.el (package-upload-buffer-internal): Pass `extras' slot from `package-desc' to `package-make-ac-desc'. * lisp/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. * test/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. * test/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. * test/automated/data/package/archive-contents: Add :homepage properties to `simple-single' and `multi-file'. * test/automated/data/package/simple-single-1.3.el: Add URL header. Fixes: debbugs:13291 --- diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 3da4cef6952..3e689f443ce 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,22 @@ +2013-09-29 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 (Bug#13291). + + * emacs-lisp/package-x.el (package-upload-buffer-internal): Pass + `extras' slot from `package-desc' to `package-make-ac-desc'. + 2013-09-29 Jan Djärv * term/ns-win.el (ns-initialize-window-system): Set locale-coding-system diff --git a/lisp/emacs-lisp/package-x.el b/lisp/emacs-lisp/package-x.el index 76d7565d64b..11053158d3e 100644 --- a/lisp/emacs-lisp/package-x.el +++ b/lisp/emacs-lisp/package-x.el @@ -209,6 +209,7 @@ if it exists." (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 @@ if it exists." (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)))) diff --git a/lisp/emacs-lisp/package.el b/lisp/emacs-lisp/package.el index 77496bad441..785263789b0 100644 --- a/lisp/emacs-lisp/package.el +++ b/lisp/emacs-lisp/package.el @@ -296,7 +296,7 @@ contrast, `package-user-dir' contains packages for personal use." (: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 @@ contrast, `package-user-dir' contains packages for personal use." (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 @@ Slots: 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) @@ -642,22 +657,28 @@ untar into a directory named DIR; otherwise, signal an error." (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)) @@ -893,10 +914,10 @@ If the archive version is too new, signal an error." ;; 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. @@ -911,7 +932,11 @@ Also, add the originating archive to the `package-desc' structure." :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 @@ -1004,14 +1029,16 @@ boundaries." ;; 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)) @@ -1180,6 +1207,8 @@ If optional arg NO-ACTIVATE is non-nil, don't activate packages." (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"))) @@ -1248,7 +1277,10 @@ If optional arg NO-ACTIVATE is non-nil, don't activate packages." (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))) diff --git a/test/ChangeLog b/test/ChangeLog index c8785ab4fec..3f115d9e4e8 100644 --- a/test/ChangeLog +++ b/test/ChangeLog @@ -1,3 +1,29 @@ +2013-09-29 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-09-22 Daniel Colascione * automated/data-test.el: diff --git a/test/automated/data/package/archive-contents b/test/automated/data/package/archive-contents index 7e4a410030f..b26179c0c3b 100644 --- a/test/automated/data/package/archive-contents +++ b/test/automated/data/package/archive-contents @@ -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"))])) diff --git a/test/automated/data/package/multi-file-0.2.3.tar b/test/automated/data/package/multi-file-0.2.3.tar index bdbbab0e6f4..dde331d0e01 100644 Binary files a/test/automated/data/package/multi-file-0.2.3.tar and b/test/automated/data/package/multi-file-0.2.3.tar differ diff --git a/test/automated/data/package/simple-single-1.3.el b/test/automated/data/package/simple-single-1.3.el index a61784164f8..6756a28080b 100644 --- a/test/automated/data/package/simple-single-1.3.el +++ b/test/automated/data/package/simple-single-1.3.el @@ -3,6 +3,7 @@ ;; Author: J. R. Hacker ;; Version: 1.3 ;; Keywords: frobnicate +;; URL: http://doodles.au ;;; Commentary: diff --git a/test/automated/package-test.el b/test/automated/package-test.el index 799009063e1..b5235ee99a9 100644 --- a/test/automated/package-test.el +++ b/test/automated/package-test.el @@ -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 @@ -97,7 +92,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 @@ -128,8 +123,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." @@ -194,7 +188,9 @@ Must called from within a `tar-mode' buffer." (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))))) @@ -319,23 +315,12 @@ Must called from within a `tar-mode' buffer." (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." @@ -345,6 +330,7 @@ Must called from within a `tar-mode' buffer." (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))))) @@ -357,6 +343,7 @@ Must called from within a `tar-mode' buffer." (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))))) diff --git a/test/automated/package-x-test.el b/test/automated/package-x-test.el index beb18358085..c7b82360dd8 100644 --- a/test/automated/package-x-test.el +++ b/test/automated/package-x-test.el @@ -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 ()