CI: Revamp package-update checking script

This commit is contained in:
TEC 2024-03-09 12:45:20 +08:00
parent 909230afcd
commit 031781460c
Signed by: tec
SSH Key Fingerprint: SHA256:eobz41Mnm0/iYWBvWThftS0ElEs1ftBr6jamutnXc/A
2 changed files with 121 additions and 112 deletions

View File

@ -1,131 +1,140 @@
#!/usr/bin/env sh #!/usr/bin/env sh
":"; exec emacs --quick --script "$0" -- "$@" # -*- mode: emacs-lisp; lexical-binding: t; -*- ":"; exec emacs --quick --script "$0" -- "$@" # -*- mode: emacs-lisp; lexical-binding: t; -*-
(setq log-file (expand-file-name (format "%s-log.txt" (file-name-base load-file-name)))
log-messages nil)
(load (expand-file-name "initialise.el" (file-name-directory load-file-name)) nil t) (load (expand-file-name "initialise.el" (file-name-directory load-file-name)) nil t)
(initialise) (initialise 'light)
(autoload #'sp-point-in-string "smartparens") (doom-require 'doom-lib 'packages)
(doom-require 'doom-lib 'text)
(defcli! check-updates ()
;;; Generation of status badge ;;; Generation of status badge
(defun gen-status-img (upgradeable total) (defun gen-status-img (upgradeable total)
(let ((colour (pcase (/ (float upgradeable) total) (let ((colour (pcase (/ (float upgradeable) total)
((pred (= 0.0)) "brightgreen") ((pred (= 0.0)) "brightgreen")
((pred (> 0.15)) "green") ((pred (> 0.15)) "green")
((pred (> 0.25)) "yellowgreen") ((pred (> 0.25)) "yellowgreen")
((pred (> 0.4)) "yellow") ((pred (> 0.4)) "yellow")
((pred (> 0.8)) "orange") ((pred (> 0.8)) "orange")
(_ "red"))) (_ "red")))
(text (if (= 0 upgradeable) (text (if (= 0 upgradeable)
(format "all %s up to date" total) (format "all %s up to date" total)
(format "%s/%s up to date" (- total upgradeable) total)))) (format "%s/%s up to date" (- total upgradeable) total))))
(call-process (call-process
"wget" "wget"
nil nil nil nil nil nil
"-O" "-O"
(expand-file-name "misc/pkg-status.svg" config-root) (expand-file-name "misc/pkg-status.svg" config-root)
(format "https://img.shields.io/badge/packages-%s-%s.svg?style=flat-square&logo=blueprint" (format "https://img.shields.io/badge/packages-%s-%s.svg?style=flat-square&logo=blueprint"
(url-hexify-string text) colour)) (url-hexify-string text) colour))
(publish "misc/pkg-status.svg"))) (publish "misc/pkg-status.svg")))
;;; Show commits ;;; Show commits
(setq upgradeable-packages 0) (setq upgradeable-packages 0)
(defadvice! doom/bump-package-at-point-more-detail (&optional select) (defadvice! doom/bump-package-at-point-more-detail (&optional select)
"Include commit messages." "Include commit messages."
:override #'doom/bump-package-at-point :override #'doom/bump-package-at-point
(doom-initialize-packages) (doom-initialize-packages)
(cl-destructuring-bind (&key package plist beg end) (cl-destructuring-bind (&key package plist beg end)
(or (doom--package-at-point) (or (doom--package-at-point)
(user-error "Not on a `package!' call")) (user-error "Not on a `package!' call"))
(when (or (memq package doom-disabled-packages) (when (or (memq package doom-disabled-packages)
(looking-back "^[ ]*;.*" (line-beginning-position))) (looking-back "^[ ]*;.*" (line-beginning-position)))
(user-error "Package %s is disabled, skipping." package)) (user-error "Package %s is disabled, skipping." package))
(let* ((recipe (doom--package-merge-recipes package plist)) (let* ((recipe (doom--package-merge-recipes package plist))
(branch (plist-get recipe :branch)) (branch (plist-get recipe :branch))
(oldid (or (plist-get plist :pin) (oldid (or (plist-get plist :pin)
(doom-package-get package :pin))) (doom-package-get package :pin)))
(url (straight-vc-git--destructure recipe (upstream-repo upstream-host) (url (straight-vc-git--destructure recipe (upstream-repo upstream-host)
(straight-vc-git--encode-url upstream-repo upstream-host))) (straight-vc-git--encode-url upstream-repo upstream-host)))
(id (or (when url (id (or (when url
(cdr (doom-call-process (cdr (doom-call-process
"git" "ls-remote" url "git" "ls-remote" url
(unless select branch)))) (unless select branch))))
(user-error "Couldn't find a recipe for %s" package))) (user-error "Couldn't find a recipe for %s" package)))
(id (car (split-string (id (car (split-string
(if select (if select
(completing-read "Commit: " (split-string id "\n" t)) (completing-read "Commit: " (split-string id "\n" t))
id)))) id))))
(commits (unless (and oldid (commits (unless (and oldid
(plist-member plist :pin) (plist-member plist :pin)
(equal oldid id)) (equal oldid id))
(let ((default-directory (let ((default-directory
(or (when (plist-member recipe :local-repo) (or (when (plist-member recipe :local-repo)
(doom-glob doom-private-dir (plist-get recipe :local-repo))) (expand-file-name (plist-get recipe :local-repo) doom-private-dir))
(straight--repos-dir (straight--repos-dir
(file-name-sans-extension (file-name-sans-extension
(file-name-nondirectory url)))))) (file-name-nondirectory url))))))
(doom-call-process "git" "fetch") (doom-call-process "git" "fetch")
(concat " " (concat " "
(cdr (cdr
(doom-call-process (doom-call-process
"git" "log" "--pretty=format: %h %s" "git" "log" "--pretty=format: %h %s"
(format "%s...%s" oldid id)))))))) (format "%s...%s" oldid id))))))))
(when (and oldid (equal oldid id)) (when (and oldid (equal oldid id))
(user-error "%s: no update necessary" package)) (user-error "%s: no update necessary" package))
(save-excursion (save-excursion
(if (re-search-forward ":pin +\"\\([^\"]+\\)\"" end t) (if (re-search-forward ":pin +\"\\([^\"]+\\)\"" end t)
(replace-match id t t nil 1) (replace-match id t t nil 1)
(goto-char (1- end)) (goto-char (1- end))
(insert " :pin " (prin1-to-string id)))) (insert " :pin " (prin1-to-string id))))
(cond ((not oldid) (cond ((not oldid)
(message "%s: → %s" package (substring id 0 10))) (message "%s: → %s" package (substring id 0 10)))
((< (length oldid) (length id)) ((< (length oldid) (length id))
(message "%s: extended to %s..." package id)) (message "%s: extended to %s..." package id))
(t (t
(setq upgradeable-packages (1+ upgradeable-packages)) (setq upgradeable-packages (1+ upgradeable-packages))
(message "%s: %s → %s\n%s" (message "%s: %s → %s\n%s"
package package
(substring oldid 0 10) (substring oldid 0 10)
(substring id 0 10) (substring id 0 10)
commits)))))) commits))))))
;;; Do it ;;; Do it
(message "[34] Opening package file") (message "[34] Opening package file")
(with-temp-buffer (setq packages nil)
(insert-file-contents (expand-file-name "packages.el" config-root))
(message "[34] Checking for updates")
(setq package-upgrades (doom/bump-packages-in-buffer))
(goto-char (point-min))
(setq total-packages 0)
(while (search-forward "(package!" nil t)
(setq total-packages (1+ total-packages))))
(message "[32] %s total packages" total-packages) (with-temp-buffer
(message "[33] %s packages upgradable" upgradeable-packages) (setq buffer-file-name (expand-file-name "packages.el" config-root))
(insert-file-contents buffer-file-name)
(emacs-lisp-mode)
;; Running `doom/bump-package-at-point' on my Org statement
;; causes it to hang, so let's get rid of it.
(goto-char (point-min))
(when (search-forward "\n(package! org" nil t)
(search-backward "(")
(delete-region
(point)
(save-excursion
(forward-sexp 1)
(point))))
(message "[34] Checking for updates")
(pp packages)
(setq package-upgrades
(doom/bump-packages-in-buffer))
(goto-char (point-min))
(setq total-packages 0)
(while (search-forward "\n(package!" nil t)
(setq total-packages (1+ total-packages))))
(gen-status-img upgradeable-packages total-packages) (message "[32] %s total packages" total-packages)
(message "[33] %s packages upgradable" upgradeable-packages)
(when (> upgradeable-packages 0) (gen-status-img upgradeable-packages total-packages)
(write-region
(when (> upgradeable-packages 0)
(write-region
(replace-regexp-in-string
"- \\[ *[0-9.s]+\\] " ""
(replace-regexp-in-string
"\033\\[0;90m" ""
(replace-regexp-in-string (replace-regexp-in-string
"- \\[ *[0-9.s]+\\] " "" "\\`.*\n" ""
(replace-regexp-in-string package-upgrades)))
"\033\\[0;90m" "" nil
(replace-regexp-in-string (expand-file-name "misc/upgradable-packages.txt" config-root))
"\\`.*\n" "" (publish "misc/upgradable-packages.txt"))
package-upgrades)))
nil
(expand-file-name "misc/upgradable-packages.txt" config-root))
(publish "misc/upgradable-packages.txt")))
(setq inhibit-message t)
(kill-emacs (doom-cli-execute :doom "check-updates"))

View File

@ -13,7 +13,7 @@
(load (expand-file-name "async-proc-management.el") nil t) (load (expand-file-name "async-proc-management.el") nil t)
(apm-exec '("subconf.sh" "engrave.sh")) (apm-exec '("subconf.sh" "engrave.sh" "check-package-updates.sh"))
(if (not (file-exists-p (concat user-emacs-directory "xkcd/"))) (if (not (file-exists-p (concat user-emacs-directory "xkcd/")))
(apm-exec "org-html.sh" :then "org-pdf.sh") (apm-exec "org-html.sh" :then "org-pdf.sh")