From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.io!.POSTED.blaine.gmane.org!not-for-mail From: Daniel Mendler Newsgroups: gmane.emacs.devel Subject: Re: [ELPA PATCH] Add badge generator to elpa-admin.el Date: Mon, 31 May 2021 20:02:21 +0200 Message-ID: <8af1b593-e093-c933-93d3-f1feedab0dd3@daniel-mendler.de> References: <27aaa2b3-96a1-d1b1-07dc-d8f0a9ca7900@daniel-mendler.de> <87wnrfrtho.fsf@web.de> <87k0nft2qr.fsf@web.de> <87eednszon.fsf@web.de> <971552f7-8d2c-89b6-d3ba-4448ed4089ab@daniel-mendler.de> Mime-Version: 1.0 Content-Type: multipart/mixed; boundary="------------A135FB941592E2C2BE4EBE7E" Injection-Info: ciao.gmane.io; posting-host="blaine.gmane.org:116.202.254.214"; logging-data="29879"; mail-complaints-to="usenet@ciao.gmane.io" Cc: emacs-devel@gnu.org To: Stefan Monnier , Michael Heerdegen Original-X-From: emacs-devel-bounces+ged-emacs-devel=m.gmane-mx.org@gnu.org Mon May 31 20:04:04 2021 Return-path: Envelope-to: ged-emacs-devel@m.gmane-mx.org Original-Received: from lists.gnu.org ([209.51.188.17]) by ciao.gmane.io with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.92) (envelope-from ) id 1lnmGi-0007T6-8m for ged-emacs-devel@m.gmane-mx.org; Mon, 31 May 2021 20:04:04 +0200 Original-Received: from localhost ([::1]:54358 helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1lnmGg-0001ph-K7 for ged-emacs-devel@m.gmane-mx.org; Mon, 31 May 2021 14:04:02 -0400 Original-Received: from eggs.gnu.org ([2001:470:142:3::10]:46036) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1lnmFL-000184-3Z for emacs-devel@gnu.org; Mon, 31 May 2021 14:02:39 -0400 Original-Received: from server.qxqx.de ([2a01:4f8:121:346::180]:38785 helo=mail.qxqx.de) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1lnmFA-0005il-Aq for emacs-devel@gnu.org; Mon, 31 May 2021 14:02:37 -0400 DKIM-Signature: v=1; a=rsa-sha256; q=dns/txt; c=relaxed/relaxed; d=qxqx.de; s=mail1392553390; h=Content-Type:In-Reply-To:MIME-Version:Date:Message-ID: References:Cc:To:From:Subject:Sender:Reply-To:Content-Transfer-Encoding: Content-ID:Content-Description:Resent-Date:Resent-From:Resent-Sender: Resent-To:Resent-Cc:Resent-Message-ID:List-Id:List-Help:List-Unsubscribe: List-Subscribe:List-Post:List-Owner:List-Archive; bh=UGSZSIKLfIIC0ZzcTNEGBN2i8qGtq4xBGDVg49SeVTg=; b=SDHG32uZr/bRFpVSgpzWtj/iqa qZM4pa2ytK0aq41ezX+15g/qqMAezkWXT7+y0o0j+yvqy9gNwpIniNuXXH0qiXbvixEWryFyxnRko ApDoNXea/HyP6oO53UwvOInqzfBYUVYkYvJPQu2Vi39ir+0tni3oNADHVoLp/+kj2qIg=; In-Reply-To: <971552f7-8d2c-89b6-d3ba-4448ed4089ab@daniel-mendler.de> Content-Language: en-US Received-SPF: pass client-ip=2a01:4f8:121:346::180; envelope-from=mail@daniel-mendler.de; helo=mail.qxqx.de X-Spam_score_int: -41 X-Spam_score: -4.2 X-Spam_bar: ---- X-Spam_report: (-4.2 / 5.0 requ) BAYES_00=-1.9, DKIM_SIGNED=0.1, DKIM_VALID=-0.1, RCVD_IN_DNSWL_MED=-2.3, SPF_HELO_PASS=-0.001, SPF_PASS=-0.001 autolearn=ham autolearn_force=no X-Spam_action: no action X-BeenThere: emacs-devel@gnu.org X-Mailman-Version: 2.1.23 Precedence: list List-Id: "Emacs development discussions." List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: emacs-devel-bounces+ged-emacs-devel=m.gmane-mx.org@gnu.org Original-Sender: "Emacs-devel" Xref: news.gmane.io gmane.emacs.devel:270181 Archived-At: This is a multi-part message in MIME format. --------------A135FB941592E2C2BE4EBE7E Content-Type: text/plain; charset=utf-8 Content-Transfer-Encoding: 7bit On 5/31/21 7:23 PM, Daniel Mendler wrote: > I can relate to your sentiment above. But I can at least help out with a > patch to elpa-admin.el for the badges. I attached an improved version, which adds the missing badges and badge links to the existing html files. In principle this patch should work with the existing archive. If a new release and html page is generated, a new badge is generated too. Daniel --------------A135FB941592E2C2BE4EBE7E Content-Type: text/x-diff; charset=UTF-8; name="0001-elpa-admin.el-Generate-SVG-badges.patch" Content-Transfer-Encoding: 8bit Content-Disposition: attachment; filename="0001-elpa-admin.el-Generate-SVG-badges.patch" >From a85621396db68c3a2d6c93855a525145ec3a014f Mon Sep 17 00:00:00 2001 From: Daniel Mendler Date: Mon, 31 May 2021 19:10:36 +0200 Subject: [PATCH] * elpa-admin.el: Generate SVG badges (elpaa--string-width): New function. (elpaa--make-badge): New function. (elpaa--add-badge-link): New function. (elpaa--make-one-package): Use `elpaa--make-badge` and `elpaa--add-badge-link`. (elpaa--html-make-pkg): Add link to badge, call `elpaa--make-badge`. --- elpa-admin.el | 123 +++++++++++++++++++++++++++++++++++++++++++++++++- 1 file changed, 122 insertions(+), 1 deletion(-) diff --git a/elpa-admin.el b/elpa-admin.el index 48fc5decdc..823b297cfc 100644 --- a/elpa-admin.el +++ b/elpa-admin.el @@ -626,6 +626,107 @@ Return non-nil if a new tarball was created." (delete-file tarball) (elpaa--make-one-package pkg-spec tarball)))) +(defun elpaa--string-width (str) + "Determine string width in pixels of STR." + (let ((output (shell-command-to-string + (format "convert -debug annotate xc: -font DejaVu-Sans\ + -pointsize 110 -annotate 0 %s null: 2>&1" + (shell-quote-argument str))))) + (save-match-data + (if (string-match + "Metrics:.*?width: \\([0-9]+\\)" + output) + (string-to-number (match-string 1 output)) + (error "Could not determine string width"))))) + +(defun elpaa--make-badge (file left right) + "Make badge svg FILE with LEFT and RIGHT string." + (let* ((lw (elpaa--string-width left)) + (rw (elpaa--string-width right)) + (pad (elpaa--string-width "x")) + (color "#bb3955") + (width (/ (+ lw rw (* 4 pad)) 10)) + (offset -10) ;; Small alignment correction + (ctx `((offset . ,offset) + (left . ,left) + (right . ,right) + (lw . ,lw) + (rw . ,rw) + (width . ,width) + (color . ,color) + (pad . ,pad)))) + (with-temp-buffer + (insert + (replace-regexp-in-string + "[ \t\n]+" " " + (replace-regexp-in-string + "{\\([^}]+\\)}" + (lambda (str) + (format "%s" (eval (read (match-string 1 str)) ctx))) + (replace-regexp-in-string + "'" "\"" + " + + {left}: {right} + + + + + + + + + + + + + + + {left} + + {right} + +")))) + (write-region (point-min) (point-max) file)))) + +(defun elpaa--add-badge-link (file name) + "Add badge link to FILE for package NAME." + (with-temp-buffer + (insert-file-contents file) + (insert + (prog1 + (replace-regexp-in-string "" + (format "
Badge
\n" + (elpaa--html-quote name)) + (buffer-string)) + (erase-buffer))) + (write-region (point-min) (point-max) file))) + (defun elpaa--make-one-package (pkg-spec &optional one-tarball) "Build the new tarballs (if needed) for PKG-SPEC. If ONE-TARBALL is non-nil, don't try and select some other revision and @@ -704,7 +805,23 @@ place the resulting tarball into the file named ONE-TARBALL." (elpaa--get-release-revision dir pkg-spec vers (plist-get (cdr pkg-spec) :version-map)))) - (elpaa--release-email pkg-spec metadata dir))))))))) + (elpaa--release-email pkg-spec metadata dir))))) + + ;; Generate missing badges (temporary code) + (let ((release-badge (format "%s/%s.svg" elpaa--release-subdir pkgname)) + (devel-badge (format "%s/%s.svg" elpaa--devel-subdir pkgname)) + (release-html (format "%s/%s.html" elpaa--release-subdir pkgname)) + (devel-html (format "%s/%s.html" elpaa--devel-subdir pkgname))) + (unless (file-exists-p devel-badge) + (elpaa--make-badge devel-badge + (format "%s-devel ELPA" elpaa--name) + (format "%s %s" pkgname devel-vers)) + (elpaa--add-badge-link devel-html pkgname)) + (unless (file-exists-p release-badge) + (elpaa--make-badge release-badge + (format "%s ELPA" elpaa--name) + (format "%s %s" pkgname vers)) + (elpaa--add-badge-link release-html pkgname))))))) (defun elpaa--call (destination program &rest args) "Like ‘call-process’ for PROGRAM, DESTINATION, ARGS. @@ -1073,6 +1190,9 @@ Rename DIR/ to PKG-VERS/, and return the descriptor." (mainsrcfile (expand-file-name (elpaa--main-file pkg-spec) srcdir)) (desc (aref (cdr pkg) 2))) (cl-assert (equal name (car pkg-spec))) + (elpaa--make-badge (concat name ".svg") + (format "%s ELPA" elpaa--name) + (format "%s %s" name latest)) (with-temp-buffer (insert (elpaa--html-header (format "%s ELPA - %s" elpaa--name name) @@ -1103,6 +1223,7 @@ Rename DIR/ to PKG-VERS/, and return the descriptor." pkg-spec (or (cdr (assoc :url (aref (cdr pkg) 4))) (elpaa--get-prop "URL" name srcdir mainsrcfile))) + (insert (format "
Badge
\n" (elpaa--html-quote name))) (insert "") (insert (format "

To install this package, run in Emacs:

M-x package-install RET %s RET
" -- 2.20.1 --------------A135FB941592E2C2BE4EBE7E--