From: Daniel Mendler <mail@daniel-mendler.de>
To: Stefan Monnier <monnier@iro.umontreal.ca>,
Michael Heerdegen <michael_heerdegen@web.de>
Cc: emacs-devel@gnu.org
Subject: Re: [ELPA PATCH] Add badge generator to elpa-admin.el
Date: Mon, 31 May 2021 20:02:21 +0200 [thread overview]
Message-ID: <8af1b593-e093-c933-93d3-f1feedab0dd3@daniel-mendler.de> (raw)
In-Reply-To: <971552f7-8d2c-89b6-d3ba-4448ed4089ab@daniel-mendler.de>
[-- Attachment #1: Type: text/plain, Size: 411 bytes --]
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
[-- Attachment #2: 0001-elpa-admin.el-Generate-SVG-badges.patch --]
[-- Type: text/x-diff, Size: 7245 bytes --]
From a85621396db68c3a2d6c93855a525145ec3a014f Mon Sep 17 00:00:00 2001
From: Daniel Mendler <mail@daniel-mendler.de>
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
+ "'" "\""
+ "<?xml version='1.0'?>
+<svg xmlns='http://www.w3.org/2000/svg'
+ xmlns:xlink='http://www.w3.org/1999/xlink'
+ width='{width}'
+ height='20'
+ role='img'
+ aria-label='{left}: {right}'>
+ <title>{left}: {right}</title>
+ <linearGradient id='s' x2='0' y2='100%'>
+ <stop offset='0' stop-color='#bbb' stop-opacity='.1'/>
+ <stop offset='1' stop-opacity='.1'/>
+ </linearGradient>
+ <clipPath id='r'>
+ <rect width='{width}' height='20' rx='3' fill='#fff'/>
+ </clipPath>
+ <g clip-path='url(#r)'>
+ <rect width='{(/ (+ lw (* 2 pad)) 10)}'
+ height='20' fill='#555'/>
+ <rect x='{(1- (/ (+ lw (* 2 pad)) 10))}'
+ width='{width}' height='20' fill='{color}'/>
+ <rect width='{width}' height='20' fill='url(#s)'/>
+ </g>
+ <g fill='#fff'
+ text-anchor='middle'
+ font-family='Verdana,Geneva,DejaVu Sans,sans-serif'
+ font-size='110'
+ text-rendering='geometricPrecision'>
+ <text aria-hidden='true'
+ x='{(+ (/ lw 2) pad offset)}'
+ y='150'
+ fill='#010101' fill-opacity='.3'
+ transform='scale(.1)' textLength='{lw}'>{left}</text>
+ <text x='{(+ (/ lw 2) pad offset)}'
+ y='140' transform='scale(.1)'
+ fill='#fff'
+ textLength='{lw}'>{left}</text>
+ <text aria-hidden='true'
+ x='{(+ lw (/ rw 2) (* 3 pad) offset)}'
+ y='150'
+ fill='#010101' fill-opacity='.3'
+ transform='scale(.1)' textLength='{rw}'>{right}</text>
+ <text x='{(+ lw (/ rw 2) (* 3 pad) offset)}'
+ y='140'
+ transform='scale(.1)'
+ fill='#fff' textLength='{rw}'>{right}</text>
+ </g>
+</svg>"))))
+ (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 "</dl>"
+ (format "<dt>Badge</dt><dd><img src=\"%s.svg\"/></dd>\n</dl>"
+ (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 "<dt>Badge</dt><dd><img src=\"%s.svg\"/></dd>\n" (elpaa--html-quote name)))
(insert "</dl>")
(insert (format "<p>To install this package, run in Emacs:</p>
<pre>M-x <span class=\"kw\">package-install</span> RET <span class=\"kw\">%s</span> RET</pre>"
--
2.20.1
next prev parent reply other threads:[~2021-05-31 18:02 UTC|newest]
Thread overview: 15+ messages / expand[flat|nested] mbox.gz Atom feed top
2021-05-31 10:09 [ELPA] Display package description as Org-exported text or HTML? Daniel Mendler
2021-05-31 10:29 ` Jean Louis
2021-05-31 10:53 ` Daniel Mendler
2021-05-31 11:04 ` Jean Louis
2021-05-31 12:13 ` Michael Heerdegen
2021-05-31 12:29 ` Jean Louis
2021-05-31 13:19 ` Stefan Monnier
2021-05-31 14:08 ` Michael Heerdegen
2021-05-31 14:59 ` Stefan Monnier
2021-05-31 15:14 ` Michael Heerdegen
2021-05-31 15:36 ` Stefan Monnier
2021-05-31 17:23 ` [ELPA PATCH] Add badge generator to elpa-admin.el Daniel Mendler
2021-05-31 18:02 ` Daniel Mendler [this message]
2021-06-04 16:00 ` Michael Heerdegen
2021-05-31 13:12 ` [ELPA] Display package description as Org-exported text or HTML? 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
* Reply using the --to, --cc, and --in-reply-to
switches of git-send-email(1):
git send-email \
--in-reply-to=8af1b593-e093-c933-93d3-f1feedab0dd3@daniel-mendler.de \
--to=mail@daniel-mendler.de \
--cc=emacs-devel@gnu.org \
--cc=michael_heerdegen@web.de \
--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 external index
https://git.savannah.gnu.org/cgit/emacs.git
https://git.savannah.gnu.org/cgit/emacs/org-mode.git
This is an external index of several public inboxes,
see mirroring instructions on how to clone and mirror
all data and code used by this external index.