[bot] built_in_updates (#15910)
Co-authored-by: SpacemacsBot <not@an.actual.email.beep.boop>
This commit is contained in:
SpacemacsBot
GitHub
parent
cf021951b7
commit
f3f0d6e6da
|
|
@ -3,6 +3,7 @@
|
|||
;; Copyright (C) 2011-2023 Donald Ephraim Curtis
|
||||
;; Copyright (C) 2012-2023 Steve Purcell
|
||||
;; Copyright (C) 2018-2023 Jonas Bernoulli
|
||||
;; Copyright (C) 2021-2023 Free Software Foundation, Inc
|
||||
;; Copyright (C) 2009 Phil Hagelberg
|
||||
|
||||
;; Author: Donald Ephraim Curtis <dcurtis@milkbox.net>
|
||||
|
|
@ -26,23 +27,117 @@
|
|||
|
||||
;;; Commentary:
|
||||
|
||||
;; In future we should provide a hook. Note also that it would be
|
||||
;; straightforward to generate the SVG ourselves, which would save
|
||||
;; the network overhead.
|
||||
;; Create batches for packages.
|
||||
;; The code in this file was lifted from `elpa-admin'.
|
||||
|
||||
;;; Code:
|
||||
|
||||
(defvar package-build-stable)
|
||||
|
||||
(defun package-build--write-melpa-badge-image (name version target-dir)
|
||||
(unless (zerop (call-process
|
||||
"curl" nil nil nil "-f" "-o"
|
||||
(expand-file-name (concat name "-badge.svg") target-dir)
|
||||
(format "https://img.shields.io/badge/%s-%s-%s.svg"
|
||||
(if package-build-stable "melpa stable" "melpa")
|
||||
(url-hexify-string version)
|
||||
(if package-build-stable "3e999f" "922793"))))
|
||||
(message "Failed to fetch badge")))
|
||||
(defun package-build--write-melpa-badge-image ( name version target-dir
|
||||
&optional archive color)
|
||||
"Make badge svg file.
|
||||
This is essentially a copy of `elpaa--make-badge'."
|
||||
(let* ((file (expand-file-name (concat name "-badge.svg") target-dir))
|
||||
(left (or archive (if package-build-stable "melpa stable" "melpa")))
|
||||
(right (url-hexify-string version))
|
||||
(color (or color (if package-build-stable "#3e999f" "#922793")))
|
||||
(lw (package-build-badge--string-width left))
|
||||
(rw (package-build-badge--string-width right))
|
||||
(pad (package-build-badge--string-width "x"))
|
||||
(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
|
||||
"{\\([^}]+\\)}"
|
||||
(lambda (str)
|
||||
(url-insert-entities-in-string
|
||||
(format "%s" (eval (read (match-string 1 str)) ctx))))
|
||||
(eval-when-compile
|
||||
(replace-regexp-in-string
|
||||
"[ \t\n]+" " "
|
||||
(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 package-build-badge--string-width (str)
|
||||
"Determine string width in pixels of STR."
|
||||
(with-temp-buffer
|
||||
;; ImageMagick 7.1.0 or later requires using the "magick" driver,
|
||||
;; rather than "convert" directly, but Debian doesn't provide it
|
||||
;; yet (2021).
|
||||
(let ((args `(,@(if (executable-find "magick")
|
||||
'("magick" "convert")
|
||||
'("convert"))
|
||||
"-debug" "annotate" "xc:" "-font" "DejaVu-Sans"
|
||||
"-pointsize" "110" "-annotate" "0" ,str "null:")))
|
||||
(apply #'call-process (car args) nil t nil (delq nil (cdr args)))
|
||||
(goto-char (point-min))
|
||||
(if (not (re-search-forward "Metrics:.*?width: \\([0-9]+\\)"))
|
||||
(error "Could not determine string width")
|
||||
(let ((width (string-to-number (match-string 1))))
|
||||
;; This test aims to catch the case where the font is missing,
|
||||
;; but it seems it only works in some cases :-(
|
||||
(if (and (> (string-width str) 0) (not (> width 0)))
|
||||
(progn (message "convert:\n%s" (buffer-string))
|
||||
(error "Could not determine string width"))
|
||||
width))))))
|
||||
|
||||
(provide 'package-build-badges)
|
||||
;;; package-badges.el ends here
|
||||
|
|
|
|||
|
|
@ -1,4 +1,4 @@
|
|||
;;; package-recipe-mode.el --- Minor mode for editing package recipes -*- lexical-binding:t; coding:utf-8 -*-
|
||||
;;; package-recipe-mode.el --- Major-mode for editing package recipes -*- lexical-binding:t; coding:utf-8 -*-
|
||||
|
||||
;; Copyright (C) 2011-2023 Donald Ephraim Curtis
|
||||
;; Copyright (C) 2012-2023 Steve Purcell
|
||||
|
|
@ -26,25 +26,43 @@
|
|||
|
||||
;;; Commentary:
|
||||
|
||||
;; This library defines the minor mode `package-build-minor-mode',
|
||||
;; which will likely be replaced with the `emacs-lisp-mode' derived
|
||||
;; `package-recipe-mode' eventually.
|
||||
;; This library defines the major-mode `package-recipe-mode', which is
|
||||
;; used for Melpa package recipe files.
|
||||
|
||||
;;; Code:
|
||||
|
||||
(require 'package-build)
|
||||
|
||||
(defvar package-build-minor-mode-map
|
||||
(let ((m (make-sparse-keymap)))
|
||||
(define-key m (kbd "C-c C-c") 'package-build-current-recipe)
|
||||
m)
|
||||
"Keymap for `package-build-minor-mode'.")
|
||||
;;;###autoload
|
||||
(defvar package-recipe-mode-map
|
||||
(let ((map (make-sparse-keymap)))
|
||||
(define-key map (kbd "C-c C-c") 'package-build-current-recipe)
|
||||
(define-key map (kbd "C-c C-n") 'package-build-create-recipe)
|
||||
map)
|
||||
"Keymap for `package-recipe-mode'.")
|
||||
|
||||
(define-minor-mode package-build-minor-mode
|
||||
"Helpful functionality for building packages."
|
||||
:lighter " PBuild"
|
||||
(when package-build-minor-mode
|
||||
(message "Use C-c C-c to build this recipe.")))
|
||||
;;;###autoload
|
||||
(if (fboundp 'lisp-data-mode) ; Since Emacs 28.1.
|
||||
(define-derived-mode package-recipe-mode lisp-data-mode "Melpa-Recipe"
|
||||
"Major mode for buffers holding Melpa package recipes."
|
||||
:group 'package-build
|
||||
(package-recipe-mode--enable))
|
||||
(define-derived-mode package-recipe-mode emacs-lisp-mode "Melpa-Recipe"
|
||||
"Major mode for buffers holding Melpa package recipes."
|
||||
:group 'package-build
|
||||
(package-recipe-mode--enable)))
|
||||
|
||||
(defun package-recipe-mode--enable ()
|
||||
(setq-local package-build-recipes-dir default-directory)
|
||||
(setq-local package-build-working-dir (expand-file-name "../working/"))
|
||||
(setq-local package-build-archive-dir (expand-file-name "../packages/"))
|
||||
(setq-local flycheck-checkers nil)
|
||||
(setq-local indent-tabs-mode nil)
|
||||
(setq-local require-final-newline t)
|
||||
(add-hook 'before-save-hook #'whitespace-cleanup)
|
||||
(message "%s" (substitute-command-keys "\
|
||||
Use \\[package-build-current-recipe] to build this recipe, \
|
||||
\\[package-build-create-recipe] to create a new recipe")))
|
||||
|
||||
;;;###autoload
|
||||
(defun package-build-create-recipe (name fetcher)
|
||||
|
|
@ -56,15 +74,13 @@
|
|||
(let ((recipe-file (expand-file-name name package-build-recipes-dir)))
|
||||
(when (file-exists-p recipe-file)
|
||||
(error "Recipe already exists"))
|
||||
(find-file recipe-file)
|
||||
(insert (pp-to-string `(,(intern name)
|
||||
:fetcher ,fetcher
|
||||
,@(cl-case fetcher
|
||||
(github (list :repo "USER/REPO"))
|
||||
(t (list :url "SCM_URL_HERE"))))))
|
||||
(emacs-lisp-mode)
|
||||
(package-build-minor-mode)
|
||||
(goto-char (point-min))))
|
||||
(with-current-buffer (find-file recipe-file)
|
||||
(save-excursion
|
||||
(insert (format "(%s\n" name)
|
||||
(format " :fetcher %s\n" fetcher)
|
||||
(if (memq fetcher package-recipe--forge-fetchers)
|
||||
" :repo \"USER/REPO\")\n"
|
||||
" :url \"https://TODO\")\n"))))))
|
||||
|
||||
;;;###autoload
|
||||
(defun package-build-current-recipe ()
|
||||
|
|
@ -81,19 +97,19 @@
|
|||
(check-parens)
|
||||
(let ((name (file-name-nondirectory (buffer-file-name))))
|
||||
(package-build-archive name t)
|
||||
(let ((output-buffer-name "*package-build-result*"))
|
||||
(let ((entry (assq (intern name) (package-build-archive-alist)))
|
||||
(output-buffer-name "*package-build-archive-entry*"))
|
||||
(with-output-to-temp-buffer output-buffer-name
|
||||
(princ ";; Please check the following package descriptor.\n")
|
||||
(princ ";; If the correct package description or dependencies are missing,\n")
|
||||
(princ ";; then the source .el file is likely malformed, and should be fixed.\n")
|
||||
(pp (assoc (intern name) (package-build-archive-alist))))
|
||||
(pp entry))
|
||||
(with-current-buffer output-buffer-name
|
||||
(emacs-lisp-mode)
|
||||
(view-mode)))
|
||||
(when (yes-or-no-p "Install new package? ")
|
||||
(package-install-file
|
||||
(package-build--artifact-file
|
||||
(assq (intern name) (package-build-archive-alist)))))))
|
||||
(if (fboundp 'lisp-data-mode) (lisp-data-mode) (emacs-lisp-mode))
|
||||
(view-mode))
|
||||
(when (y-or-n-p "Install new package? ")
|
||||
(package-install-file (package-build--artifact-file entry))
|
||||
(pop-to-buffer (get-buffer byte-compile-log-buffer))))))
|
||||
|
||||
(provide 'package-recipe-mode)
|
||||
;;; package-recipe-mode.el ends here
|
||||
|
|
|
|||
Loading…
Reference in New Issue