CI: show commits elapsed with outdated packages

This commit is contained in:
TEC 2021-02-14 21:41:22 +08:00
parent 7de8615033
commit a625c8db45
Signed by: tec
GPG key ID: 779591AFDB81F06C

View file

@ -28,6 +28,68 @@
(url-hexify-string text) colour))
(publish "misc/pkg-status.svg")))
;;; Show commits
(setq upgradeable-packages 0)
(defadvice! doom/bump-package-at-point-more-detail (&optional select)
"Include commit messages."
:override #'doom/bump-package-at-point
(doom-initialize-packages)
(cl-destructuring-bind (&key package plist beg end)
(or (doom--package-at-point)
(user-error "Not on a `package!' call"))
(when (memq package doom-disabled-packages)
(user-error "Package %s is disabled, skipping." package))
(let* ((recipe (doom--package-merge-recipes package plist))
(branch (plist-get recipe :branch))
(oldid (or (plist-get plist :pin)
(doom-package-get package :pin)))
(url (straight-vc-git--destructure recipe (upstream-repo upstream-host)
(straight-vc-git--encode-url upstream-repo upstream-host)))
(id (or (when url
(cdr (doom-call-process
"git" "ls-remote" url
(unless select branch))))
(user-error "Couldn't find a recipe for %s" package)))
(id (car (split-string
(if select
(completing-read "Commit: " (split-string id "\n" t))
id))))
(commits (unless (and oldid
(plist-member plist :pin)
(equal oldid id))
(let ((default-directory
(straight--repos-dir
(file-name-sans-extension
(file-name-nondirectory url)))))
(doom-call-process "git" "fetch")
(concat " "
(cdr
(doom-call-process
"git" "log" "--pretty=format: %h %s"
(format "%s...%s" oldid id))))))))
(when (and oldid
(plist-member plist :pin)
(equal oldid id))
(user-error "%s: no update necessary" package))
(save-excursion
(if (re-search-forward ":pin +\"\\([^\"]+\\)\"" end t)
(replace-match id t t nil 1)
(goto-char (1- end))
(insert " :pin " (prin1-to-string id))))
(cond ((not oldid)
(message "%s: → %s" package (substring id 0 10)))
((< (length oldid) (length id))
(message "%s: extended to %s..." package id))
((progn
(setq upgradeable-packages (1+ upgradeable-packages))
(message "%s: %s → %s\n%s"
package
(substring oldid 0 10)
(substring id 0 10)
commits)))))))
;;; Do it
(message "[34] Opening package file")
@ -42,11 +104,6 @@
(setq total-packages (1+ total-packages))))
(message "[32] %s total packages" total-packages)
(setq upgradeable-packages
(if (string= "No packages to update" package-upgrades) 0
(1- (length (split-string package-upgrades "\n")))))
(message "[33] %s packages upgradable" upgradeable-packages)
(gen-status-img upgradeable-packages total-packages)
@ -65,4 +122,6 @@
(publish "misc/upgradable-packages.txt"))
(setq inhibit-message t)
(if (= exit-code 0)
(delete-file log-file))
(kill-emacs exit-code)