From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.org!not-for-mail From: Dmitry Gutov Newsgroups: gmane.emacs.bugs Subject: bug#13291: The package description buffer needs an URL button Date: Wed, 07 Aug 2013 12:54:40 +0300 Message-ID: <52021960.3050109@yandex.ru> References: <50DDAF17.7020602@yandex.ru> <50F26A91.1090905@yandex.ru> <513F1650.6070700@yandex.ru> NNTP-Posting-Host: plane.gmane.org Mime-Version: 1.0 Content-Type: multipart/mixed; boundary="------------040505090908000005000903" X-Trace: ger.gmane.org 1375869319 15106 80.91.229.3 (7 Aug 2013 09:55:19 GMT) X-Complaints-To: usenet@ger.gmane.org NNTP-Posting-Date: Wed, 7 Aug 2013 09:55:19 +0000 (UTC) Cc: 13291@debbugs.gnu.org To: Stefan Monnier Original-X-From: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane.org@gnu.org Wed Aug 07 11:55:21 2013 Return-path: Envelope-to: geb-bug-gnu-emacs@m.gmane.org Original-Received: from lists.gnu.org ([208.118.235.17]) by plane.gmane.org with esmtp (Exim 4.69) (envelope-from ) id 1V70Sf-0007zI-AE for geb-bug-gnu-emacs@m.gmane.org; Wed, 07 Aug 2013 11:55:21 +0200 Original-Received: from localhost ([::1]:41175 helo=lists.gnu.org) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1V70Se-0002Uy-UC for geb-bug-gnu-emacs@m.gmane.org; Wed, 07 Aug 2013 05:55:20 -0400 Original-Received: from eggs.gnu.org ([2001:4830:134:3::10]:45485) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1V70SU-0002CU-0i for bug-gnu-emacs@gnu.org; Wed, 07 Aug 2013 05:55:16 -0400 Original-Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1V70SO-0006I7-CR for bug-gnu-emacs@gnu.org; Wed, 07 Aug 2013 05:55:09 -0400 Original-Received: from debbugs.gnu.org ([140.186.70.43]:50516) by eggs.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1V70SN-0006E9-UH for bug-gnu-emacs@gnu.org; Wed, 07 Aug 2013 05:55:04 -0400 Original-Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.80) (envelope-from ) id 1V70SM-00014j-Em for bug-gnu-emacs@gnu.org; Wed, 07 Aug 2013 05:55:02 -0400 X-Loop: help-debbugs@gnu.org Resent-From: Dmitry Gutov Original-Sender: "Debbugs-submit" Resent-CC: bug-gnu-emacs@gnu.org Resent-Date: Wed, 07 Aug 2013 09:55:02 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 13291 X-GNU-PR-Package: emacs X-GNU-PR-Keywords: Original-Received: via spool by 13291-submit@debbugs.gnu.org id=B13291.13758692964116 (code B ref 13291); Wed, 07 Aug 2013 09:55:02 +0000 Original-Received: (at 13291) by debbugs.gnu.org; 7 Aug 2013 09:54:56 +0000 Original-Received: from localhost ([127.0.0.1]:44832 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.80) (envelope-from ) id 1V70SE-00014H-De for submit@debbugs.gnu.org; Wed, 07 Aug 2013 05:54:55 -0400 Original-Received: from forward5.mail.yandex.net ([77.88.46.21]:45068) by debbugs.gnu.org with esmtp (Exim 4.80) (envelope-from ) id 1V70S9-00013u-NF for 13291@debbugs.gnu.org; Wed, 07 Aug 2013 05:54:52 -0400 Original-Received: from smtp4.mail.yandex.net (smtp4.mail.yandex.net [77.88.46.104]) by forward5.mail.yandex.net (Yandex) with ESMTP id 59A6F1200D90; Wed, 7 Aug 2013 13:54:43 +0400 (MSK) Original-Received: from smtp4.mail.yandex.net (localhost [127.0.0.1]) by smtp4.mail.yandex.net (Yandex) with ESMTP id 22D9C5C084D; Wed, 7 Aug 2013 13:54:43 +0400 (MSK) Original-Received: from 62-107-247.netrun.cytanet.com.cy (62-107-247.netrun.cytanet.com.cy [62.228.107.247]) by smtp4.mail.yandex.net (nwsmtp/Yandex) with ESMTP id a74XjMVm2M-sfbOkYfV; Wed, 7 Aug 2013 13:54:42 +0400 DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=yandex.ru; s=mail; t=1375869282; bh=rsIJcftjt0c6jSWrrh3RJuYkkljIFQLEkHEE8c0ABs4=; h=Message-ID:Date:From:User-Agent:MIME-Version:To:CC:Subject: References:In-Reply-To:Content-Type; b=Wp/Rd99qVnvIFNyU3DAW35hVvRjRKxpB5cWRYvh20nvrgHd3zo9IKG6TaekTxRTF9 QwAu5oGvKM35RM1SjiNyK3lmrnpknXcCTpH+MgCUVnENebbe5NErwTu7R9durPItSA bzndrEloraPLO5RntiLlpt4hR9qlALvMFW5r6DxM= Authentication-Results: smtp4.mail.yandex.net; dkim=pass header.i=@yandex.ru User-Agent: Mozilla/5.0 (X11; Linux x86_64; rv:17.0) Gecko/20130623 Thunderbird/17.0.7 In-Reply-To: <513F1650.6070700@yandex.ru> X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.15 Precedence: list X-detected-operating-system: by eggs.gnu.org: GNU/Linux 3.x X-Received-From: 140.186.70.43 X-BeenThere: bug-gnu-emacs@gnu.org List-Id: "Bug reports for GNU Emacs, the Swiss army knife of text editors" List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane.org@gnu.org Original-Sender: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane.org@gnu.org Xref: news.gmane.org gmane.emacs.bugs:77014 Archived-At: This is a multi-part message in MIME format. --------------040505090908000005000903 Content-Type: text/plain; charset=ISO-8859-1; format=flowed Content-Transfer-Encoding: 7bit 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. --------------040505090908000005000903 Content-Type: text/x-patch; name="package-homepage-button-new.diff" Content-Transfer-Encoding: 7bit Content-Disposition: attachment; filename="package-homepage-button-new.diff" === 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 () --------------040505090908000005000903--