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, 02 Oct 2013 04:00:51 +0300 Message-ID: <874n90fpvg.fsf@yandex.ru> References: <50DDAF17.7020602@yandex.ru> <50F26A91.1090905@yandex.ru> <513F1650.6070700@yandex.ru> <52021960.3050109@yandex.ru> <87vc1jtnv1.fsf@yandex.ru> NNTP-Posting-Host: plane.gmane.org Mime-Version: 1.0 Content-Type: multipart/mixed; boundary="=-=-=" X-Trace: ger.gmane.org 1380675734 22238 80.91.229.3 (2 Oct 2013 01:02:14 GMT) X-Complaints-To: usenet@ger.gmane.org NNTP-Posting-Date: Wed, 2 Oct 2013 01:02:14 +0000 (UTC) To: 13291@debbugs.gnu.org Original-X-From: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane.org@gnu.org Wed Oct 02 03:02:18 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 1VRApU-0002dX-Px for geb-bug-gnu-emacs@m.gmane.org; Wed, 02 Oct 2013 03:02:17 +0200 Original-Received: from localhost ([::1]:33378 helo=lists.gnu.org) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1VRApT-0003MJ-UY for geb-bug-gnu-emacs@m.gmane.org; Tue, 01 Oct 2013 21:02:15 -0400 Original-Received: from eggs.gnu.org ([2001:4830:134:3::10]:55159) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1VRApL-0003M0-9p for bug-gnu-emacs@gnu.org; Tue, 01 Oct 2013 21:02:12 -0400 Original-Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1VRApG-0001R8-Dq for bug-gnu-emacs@gnu.org; Tue, 01 Oct 2013 21:02:07 -0400 Original-Received: from debbugs.gnu.org ([140.186.70.43]:39964) by eggs.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1VRApG-0001R0-AF for bug-gnu-emacs@gnu.org; Tue, 01 Oct 2013 21:02:02 -0400 Original-Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.80) (envelope-from ) id 1VRApF-0002Ru-V5 for bug-gnu-emacs@gnu.org; Tue, 01 Oct 2013 21:02: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, 02 Oct 2013 01:02:01 +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.13806756719355 (code B ref 13291); Wed, 02 Oct 2013 01:02:01 +0000 Original-Received: (at 13291) by debbugs.gnu.org; 2 Oct 2013 01:01:11 +0000 Original-Received: from localhost ([127.0.0.1]:48257 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.80) (envelope-from ) id 1VRAoQ-0002Ql-Nz for submit@debbugs.gnu.org; Tue, 01 Oct 2013 21:01:11 -0400 Original-Received: from mail-ea0-f172.google.com ([209.85.215.172]:56475) by debbugs.gnu.org with esmtp (Exim 4.80) (envelope-from ) id 1VRAoN-0002Qa-TI for 13291@debbugs.gnu.org; Tue, 01 Oct 2013 21:01:08 -0400 Original-Received: by mail-ea0-f172.google.com with SMTP id r16so47698ead.3 for <13291@debbugs.gnu.org>; Tue, 01 Oct 2013 18:01:07 -0700 (PDT) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=gmail.com; s=20120113; h=sender:from:to:cc:subject:references:date:in-reply-to:message-id :user-agent:mime-version:content-type; bh=4R999Xkx0EgPcTaAa4IOfdPEmnozCUcJ7LGBkf96Rp0=; b=NEoED+RwDyRU+/Qx6mIkWH6KeAOQUdL2bhqq/PjpMwOonyaYodVlRslMMBuoEWIGrZ 1uJYVh6j3lDsMNK3/Qs6vdTBS4ch3oyBk03R01pTPynxcxZK02APqXMwvBHiOXVEefGI +kownrpXiHWO54sx1T6QidqvocRKuGHPfq5XGn9hWfNA6Mhf9M7bsiKM/4MtwRGM9xCO IRLYFugXMb6EX8VlE7d81hjNYpuN+UpjUzVIXwn0lNT1mt/Ypsz3Qbcn+tQIQn9Rd1MP 85xsK/nZ0GKEpxLqYj9ETP4Ntt+TomHClopDWDcyPhP26xnMc6Fqzo6mt842qk6Udc6d tBLA== X-Received: by 10.15.43.13 with SMTP id w13mr49996075eev.37.1380675666975; Tue, 01 Oct 2013 18:01:06 -0700 (PDT) Original-Received: from axl (62-118-214.netrun.cytanet.com.cy. [62.228.118.214]) by mx.google.com with ESMTPSA id bn13sm19007383eeb.11.1969.12.31.16.00.00 (version=TLSv1.2 cipher=RC4-SHA bits=128/128); Tue, 01 Oct 2013 18:01:05 -0700 (PDT) In-Reply-To: <87vc1jtnv1.fsf@yandex.ru> (Dmitry Gutov's message of "Sun, 29 Sep 2013 22:43:46 +0300") User-Agent: Gnus/5.13 (Gnus v5.13) Emacs/24.3.50 (gnu/linux) 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:78847 Archived-At: --=-=-= Content-Type: text/plain And here's the updated patch for admin/archive-contents.el. Does the ELPA server use the stable version of Emacs, or the current trunk? The attached code uses `package-desc-from-define' and `package--alist-to-plist', requiring a very recent version. --=-=-= Content-Type: text/x-diff Content-Disposition: inline; filename=archive-contents-homepage-new.diff Content-Description: archive-contents url patch diff --git a/admin/archive-contents.el b/admin/archive-contents.el index 499728e..17a4e17 100644 --- a/admin/archive-contents.el +++ b/admin/archive-contents.el @@ -158,11 +158,12 @@ Currently only refreshes the ChangeLog files." (defun archive--simple-package-p (dir pkg) "Test whether DIR contains a simple package named PKG. -Return a list (SIMPLE VERSION DESCRIPTION REQ), where +Return a list (SIMPLE VERSION DESCRIPTION REQ EXTRAS), where SIMPLE is non-nil if the package is indeed simple; VERSION is the version string of the simple package; DESCRIPTION is the brief description of the package; -REQ is a list of requirements. +REQ is a list of requirements; +EXTRAS is an alist with additional metadata. Otherwise, return nil." (let* ((pkg-file (expand-file-name (concat pkg "-pkg.el") dir)) (mainfile (expand-file-name (concat pkg ".el") dir)) @@ -186,15 +187,17 @@ Otherwise, return nil." (requires-str (lm-header "package-requires")) (pt (lm-header "package-type")) (simple (if pt (equal pt "simple") (= (length files) 1))) + (url (or (lm-homepage) + (format "http://elpa.gnu.org/packages/%s.html" pkg))) (req (if requires-str (mapcar 'archive--convert-require (car (read-from-string requires-str)))))) - (list simple version description req))))) + (list simple version description req (list (cons :url url))))))) ((not (file-exists-p pkg-file)) (error "Can find single file nor package desc file in %s" dir))))) -(defun archive--process-simple-package (dir pkg vers desc req) +(defun archive--process-simple-package (dir pkg vers desc req extras) "Deploy the contents of DIR into the archive as a simple package. Rename DIR/PKG.el to PKG-VERS.el, delete DIR, and return the descriptor." ;; Write DIR/foo.el to foo-VERS.el and delete DIR @@ -220,7 +223,7 @@ Rename DIR/PKG.el to PKG-VERS.el, delete DIR, and return the descriptor." (kill-buffer))) (delete-directory dir t) (cons (intern pkg) (vector (archive--version-to-list vers) - req desc 'single))) + req desc 'single extras))) (defun archive--make-changelog (dir srcdir) "Export Git log info of DIR into a ChangeLog file." @@ -251,19 +254,18 @@ Rename DIR/PKG.el to PKG-VERS.el, delete DIR, and return the descriptor." "Deploy the contents of DIR into the archive as a multi-file package. Rename DIR/ to PKG-VERS/, and return the descriptor." (let* ((exp (archive--multi-file-package-def dir pkg)) - (vers (nth 2 exp)) - (req-exp (nth 4 exp)) - (req (mapcar 'archive--convert-require - (if (eq 'quote (car-safe req-exp)) (nth 1 req-exp) - (when req-exp - (error "REQ should be a quoted constant: %S" - req-exp)))))) - (unless (equal (nth 1 exp) pkg) + (pkg-desc (apply #'package-desc-from-define (cdr exp))) + (pkg-name (package-desc-name pkg-desc))) + (unless (string= pkg-name pkg) (error (format "Package name %s doesn't match file name %s" - (nth 1 exp) pkg))) - (rename-file dir (concat pkg "-" vers)) - (cons (intern pkg) (vector (archive--version-to-list vers) - req (nth 3 exp) 'tar)))) + pkg-name pkg))) + (rename-file dir (concat pkg "-" (package-version-join + (package-desc-version pkg-desc)))) + (cons (intern pkg) (vector (package-desc-version pkg-desc) + (package-desc-reqs pkg-desc) + (package-desc-summary pkg-desc) + 'tar + (package-desc-extras pkg-desc))))) (defun archive--multi-file-package-def (dir pkg) "Return the `define-package' form in the file DIR/PKG-pkg.el." @@ -286,7 +288,7 @@ Rename DIR/ to PKG-VERS/, and return the descriptor." ;; (message "Not refreshing pkg description of %s" pkg) ))) -(defun archive--write-pkg-file (pkg-dir name version desc requires &rest ignored) +(defun archive--write-pkg-file (pkg-dir name version desc requires extras) (let ((pkg-file (expand-file-name (concat name "-pkg.el") pkg-dir)) (print-level nil) (print-quoted t) @@ -295,17 +297,19 @@ Rename DIR/ to PKG-VERS/, and return the descriptor." (concat (format ";; Generated package description from %s.el\n" name) (prin1-to-string - (list 'define-package - name - version - 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 + name + version + 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 extras))) "\n") nil pkg-file))) @@ -388,30 +392,29 @@ Rename DIR/ to PKG-VERS/, and return the descriptor." (replace-regexp-in-string "<" "<" (replace-regexp-in-string "&" "&" txt))) -(defun archive--insert-repolinks (name srcdir mainsrcfile) - (let ((url (archive--get-prop "URL" name srcdir mainsrcfile))) - (if url - (insert (format "

Origin: %s

\n" - url (archive--quote url))) - (let* ((externals - (with-temp-buffer - (insert-file-contents - (expand-file-name "../../../elpa/externals-list" srcdir)) - (read (current-buffer)))) - (external (eq :external (nth 1 (assoc name externals)))) - (git-sv "http://git.savannah.gnu.org/") - (urls (if external - '("cgit/emacs/elpa.git/?h=externals/" - "gitweb/?p=emacs/elpa.git;a=shortlog;h=refs/heads/externals/") - '("cgit/emacs/elpa.git/tree/packages/" - "gitweb/?p=emacs/elpa.git;a=tree;f=packages/")))) - (insert (format - (concat "

Browse repository: %s" - " or %s

\n") - (concat git-sv (nth 0 urls) name) - 'CGit - (concat git-sv (nth 1 urls) name) - 'Gitweb)))))) +(defun archive--insert-repolinks (name srcdir mainsrcfile url) + (if url + (insert (format "

Origin: %s

\n" + url (archive--quote url))) + (let* ((externals + (with-temp-buffer + (insert-file-contents + (expand-file-name "../../../elpa/externals-list" srcdir)) + (read (current-buffer)))) + (external (eq :external (nth 1 (assoc name externals)))) + (git-sv "http://git.savannah.gnu.org/") + (urls (if external + '("cgit/emacs/elpa.git/?h=externals/" + "gitweb/?p=emacs/elpa.git;a=shortlog;h=refs/heads/externals/") + '("cgit/emacs/elpa.git/tree/packages/" + "gitweb/?p=emacs/elpa.git;a=tree;f=packages/")))) + (insert (format + (concat "

Browse repository: %s" + " or %s

\n") + (concat git-sv (nth 0 urls) name) + 'CGit + (concat git-sv (nth 1 urls) name) + 'Gitweb))))) (defun archive--html-make-pkg (pkg files) (let* ((name (symbol-name (car pkg))) @@ -431,7 +434,8 @@ Rename DIR/ to PKG-VERS/, and return the descriptor." (let ((maint (archive--get-prop "Maintainer" name srcdir mainsrcfile))) (when maint (insert (format "

Maintainer: %s

\n" (archive--quote maint))))) - (archive--insert-repolinks name srcdir mainsrcfile) + (archive--insert-repolinks name srcdir mainsrcfile + (cdr (assoc :url (aref (cdr pkg) 4)))) (let ((rm (archive--get-section "Commentary" '("README" "README.rst" "README.md" "README.org") srcdir mainsrcfile))) --=-=-=--