mirror of
https://git.in.rschanz.org/ryan77627/guix.git
synced 2025-01-11 13:49:23 -05:00
guix system: Decorate GRUB entries of old generations with date and number.
* guix/scripts/system.scm (seconds->string): New procedure. (previous-grub-entries)[system->grub-entry]: Add 'number' and 'time' parameters. Adjust call accordingly.
This commit is contained in:
parent
f34c56be3a
commit
906b1b0986
1 changed files with 19 additions and 5 deletions
|
@ -34,6 +34,7 @@ (define-module (guix scripts system)
|
|||
#:use-module (gnu system grub)
|
||||
#:use-module (gnu packages grub)
|
||||
#:use-module (srfi srfi-1)
|
||||
#:use-module (srfi srfi-19)
|
||||
#:use-module (srfi srfi-26)
|
||||
#:use-module (srfi srfi-37)
|
||||
#:use-module (ice-9 match)
|
||||
|
@ -216,9 +217,15 @@ (define-syntax-rule (unless-file-not-found exp)
|
|||
#f
|
||||
(apply throw args)))))
|
||||
|
||||
(define (seconds->string seconds)
|
||||
"Return a string representing the date for SECONDS."
|
||||
(let ((time (make-time time-utc 0 seconds)))
|
||||
(date->string (time-utc->date time)
|
||||
"~Y-~m-~d ~H:~M")))
|
||||
|
||||
(define* (previous-grub-entries #:optional (profile %system-profile))
|
||||
"Return a list of 'menu-entry' for the generations of PROFILE."
|
||||
(define (system->grub-entry system)
|
||||
(define (system->grub-entry system number time)
|
||||
(unless-file-not-found
|
||||
(call-with-input-file (string-append system "/parameters")
|
||||
(lambda (port)
|
||||
|
@ -228,7 +235,9 @@ (define (system->grub-entry system)
|
|||
('kernel linux)
|
||||
_ ...)
|
||||
(menu-entry
|
||||
(label label)
|
||||
(label (string-append label " (#"
|
||||
(number->string number) ", "
|
||||
(seconds->string time) ")"))
|
||||
(linux linux)
|
||||
(linux-arguments
|
||||
(list (string-append "--root=" root)
|
||||
|
@ -240,9 +249,14 @@ (define (system->grub-entry system)
|
|||
system)
|
||||
#f))))))
|
||||
|
||||
(let ((systems (map (cut generation-file-name profile <>)
|
||||
(generation-numbers profile))))
|
||||
(filter-map system->grub-entry systems)))
|
||||
(let* ((numbers (generation-numbers profile))
|
||||
(systems (map (cut generation-file-name profile <>)
|
||||
numbers))
|
||||
(times (map (lambda (system)
|
||||
(unless-file-not-found
|
||||
(stat:mtime (lstat system))))
|
||||
systems)))
|
||||
(filter-map system->grub-entry systems numbers times)))
|
||||
|
||||
|
||||
;;;
|
||||
|
|
Loading…
Reference in a new issue