From: Dmitry Gutov <dgutov@yandex.ru>
To: Stefan Monnier <monnier@iro.umontreal.ca>
Cc: 13291@debbugs.gnu.org
Subject: bug#13291: The package description buffer needs an URL button
Date: Wed, 07 Aug 2013 12:54:40 +0300 [thread overview]
Message-ID: <52021960.3050109@yandex.ru> (raw)
In-Reply-To: <513F1650.6070700@yandex.ru>
[-- Attachment #1: Type: text/plain, Size: 577 bytes --]
Here's an updated patch for package, package-x and tests.
Please comment, I'd like to install it soon-ish.
Notes:
* Converting from plist to alist and back is a hassle, but it gives us
an opportunity to clear out keys with nil values in
`package-desc-from-define'.
* Not passing :homepage to `package-desc-from-define' in
`package-buffer-info' when its value is nil seems hard.
* `package--add-to-archive-contents' tries to retain backward
compatibility by checking the given vector's length.
Now we just need a package archive that would include homepage information.
[-- Attachment #2: package-homepage-button-new.diff --]
[-- Type: text/x-patch, Size: 16895 bytes --]
=== 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 <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.
+
+ * 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 <lekktu@gmail.com>
* 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 <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-08-05 Glenn Morris <rgm@gnu.org>
* 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 <jrh@example.com>
;; 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 ()
next prev parent reply other threads:[~2013-08-07 9:54 UTC|newest]
Thread overview: 17+ messages / expand[flat|nested] mbox.gz Atom feed top
2012-12-28 14:39 bug#13291: The package description buffer needs an URL button Dmitry Gutov
2013-01-12 3:28 ` Stefan Monnier
2013-01-12 7:41 ` Dmitry Gutov
2013-01-13 2:54 ` Dmitry Gutov
2013-01-13 6:49 ` Dmitry Gutov
2013-01-13 8:04 ` Dmitry Gutov
2013-03-05 17:12 ` Dmitry Gutov
2013-03-11 17:40 ` Stefan Monnier
2013-03-12 11:49 ` Dmitry Gutov
2013-08-07 9:54 ` Dmitry Gutov [this message]
2013-09-29 19:43 ` Dmitry Gutov
2013-10-02 1:00 ` Dmitry Gutov
2013-10-02 3:09 ` Stefan Monnier
2013-10-02 3:22 ` Dmitry Gutov
2013-10-03 13:46 ` Stefan Monnier
2013-10-07 3:45 ` Dmitry Gutov
2013-10-07 4:50 ` Stefan Monnier
Reply instructions:
You may reply publicly to this message via plain-text email
using any one of the following methods:
* Save the following mbox file, import it into your mail client,
and reply-to-all from there: mbox
Avoid top-posting and favor interleaved quoting:
https://en.wikipedia.org/wiki/Posting_style#Interleaved_style
List information: https://www.gnu.org/software/emacs/
* Reply using the --to, --cc, and --in-reply-to
switches of git-send-email(1):
git send-email \
--in-reply-to=52021960.3050109@yandex.ru \
--to=dgutov@yandex.ru \
--cc=13291@debbugs.gnu.org \
--cc=monnier@iro.umontreal.ca \
/path/to/YOUR_REPLY
https://kernel.org/pub/software/scm/git/docs/git-send-email.html
* If your mail client supports setting the In-Reply-To header
via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line
before the message body.
Code repositories for project(s) associated with this public inbox
https://git.savannah.gnu.org/cgit/emacs.git
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).