mirror/emacs
1
0
Fork 0
mirror of https://git.savannah.gnu.org/git/emacs.git synced 2025-01-13 16:38:14 +00:00
Code Issues Releases Activity

* lisp/emacs-lisp/package-x.el (package-upload-buffer-internal): Pass

Browse Source 
`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
This commit is contained in:
Dmitry Gutov 2013-09-29 22:41:00 +03:00
parent 832966e57f
commit 056453c62e
9 changed files with 122 additions and 52 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

19
lisp/ChangeLog
View File

@ -1,3 +1,22 @@
2013-09-29 Dmitry Gutov <dgutov@yandex.ru>
* 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 <jan.h.d@swipnet.se>
* term/ns-win.el (ns-initialize-window-system): Set locale-coding-system

3
lisp/emacs-lisp/package-x.el
View File

@ -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))))

76
lisp/emacs-lisp/package.el
View File

@ -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)))

26
test/ChangeLog
View File

@ -1,3 +1,29 @@
2013-09-29 Dmitry Gutov <dgutov@yandex.ru>
* 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 <dancol@dancol.org>
* automated/data-test.el:

6
test/automated/data/package/archive-contents
View File

@ -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"))]))

BIN
test/automated/data/package/multi-file-0.2.3.tar
View File

Binary file not shown.

1
test/automated/data/package/simple-single-1.3.el
View File

@ -3,6 +3,7 @@
;; Author: J. R. Hacker <jrh@example.com>
;; Version: 1.3
;; Keywords: frobnicate
;; URL: http://doodles.au
;;; Commentary:

37
test/automated/package-test.el
View File

@ -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)))))

6
test/automated/package-x-test.el
View File

@ -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 ()