mirror of
https://git.in.rschanz.org/ryan77627/guix.git
synced 2025-01-25 20:19:18 -05:00
system: grub: Adjust eye-candy to work on non-Intel systems.
* gnu/system/grub.scm (eye-candy): Accept additional 'system' argument. Add local 'setup-gfxterm-body' variable. Replace the 'load_video' grub function with 'setup_gfxterm', which includes everything in the 'if loadfont' form on Intel systems, but is empty on non-Intel. (grub-configuration-file): Pass 'system' to 'eye-candy.
This commit is contained in:
parent
c448bf7443
commit
6b173ac004
1 changed files with 28 additions and 17 deletions
|
@ -30,6 +30,7 @@ (define-module (gnu system grub)
|
||||||
#:autoload (gnu packages imagemagick) (imagemagick)
|
#:autoload (gnu packages imagemagick) (imagemagick)
|
||||||
#:autoload (gnu packages compression) (gzip)
|
#:autoload (gnu packages compression) (gzip)
|
||||||
#:use-module (ice-9 match)
|
#:use-module (ice-9 match)
|
||||||
|
#:use-module (ice-9 regex)
|
||||||
#:use-module (srfi srfi-1)
|
#:use-module (srfi srfi-1)
|
||||||
#:export (grub-image
|
#:export (grub-image
|
||||||
grub-image?
|
grub-image?
|
||||||
|
@ -152,10 +153,26 @@ (define* (grub-background-image config #:key (width 640) (height 480))
|
||||||
(with-monad %store-monad
|
(with-monad %store-monad
|
||||||
(return #f)))))
|
(return #f)))))
|
||||||
|
|
||||||
(define (eye-candy config port)
|
(define (eye-candy config system port)
|
||||||
"Return in %STORE-MONAD a gexp that writes to PORT (a port-valued gexp) the
|
"Return in %STORE-MONAD a gexp that writes to PORT (a port-valued gexp) the
|
||||||
'grub.cfg' part concerned with graphics mode, background images, colors, and
|
'grub.cfg' part concerned with graphics mode, background images, colors, and
|
||||||
all that."
|
all that."
|
||||||
|
(define setup-gfxterm-body
|
||||||
|
;; Intel systems need to be switched into graphics mode, whereas most
|
||||||
|
;; other modern architectures have no other mode and therefore don't need
|
||||||
|
;; to be switched.
|
||||||
|
(if (string-match "^(x86_64|i[3-6]86)-" system)
|
||||||
|
"
|
||||||
|
set gfxmode=640x480
|
||||||
|
insmod vbe
|
||||||
|
insmod vga
|
||||||
|
insmod video_bochs
|
||||||
|
insmod video_cirrus
|
||||||
|
insmod gfxterm
|
||||||
|
terminal_output gfxterm
|
||||||
|
"
|
||||||
|
""))
|
||||||
|
|
||||||
(define (theme-colors type)
|
(define (theme-colors type)
|
||||||
(let* ((theme (grub-configuration-theme config))
|
(let* ((theme (grub-configuration-theme config))
|
||||||
(colors (type theme)))
|
(colors (type theme)))
|
||||||
|
@ -163,22 +180,15 @@ (define (theme-colors type)
|
||||||
(symbol->string (assoc-ref colors 'bg)))))
|
(symbol->string (assoc-ref colors 'bg)))))
|
||||||
|
|
||||||
(mlet* %store-monad ((image (grub-background-image config)))
|
(mlet* %store-monad ((image (grub-background-image config)))
|
||||||
(return (and image #~(format #$port "
|
(return (and image
|
||||||
function load_video {
|
#~(format #$port "
|
||||||
insmod vbe
|
function setup_gfxterm {~a}
|
||||||
insmod vga
|
|
||||||
insmod video_bochs
|
|
||||||
insmod video_cirrus
|
|
||||||
}
|
|
||||||
|
|
||||||
# Set 'root' to the partition that contains /gnu/store.
|
# Set 'root' to the partition that contains /gnu/store.
|
||||||
search --file --set ~a/share/grub/unicode.pf2
|
search --file --set ~a/share/grub/unicode.pf2
|
||||||
|
|
||||||
if loadfont ~a/share/grub/unicode.pf2; then
|
if loadfont ~a/share/grub/unicode.pf2; then
|
||||||
set gfxmode=640x480
|
setup_gfxterm
|
||||||
load_video
|
|
||||||
insmod gfxterm
|
|
||||||
terminal_output gfxterm
|
|
||||||
fi
|
fi
|
||||||
|
|
||||||
insmod png
|
insmod png
|
||||||
|
@ -189,10 +199,11 @@ (define (theme-colors type)
|
||||||
set menu_color_normal=cyan/blue
|
set menu_color_normal=cyan/blue
|
||||||
set menu_color_highlight=white/blue
|
set menu_color_highlight=white/blue
|
||||||
fi~%"
|
fi~%"
|
||||||
#$grub #$grub
|
#$setup-gfxterm-body
|
||||||
#$image
|
#$grub #$grub
|
||||||
#$(theme-colors grub-theme-color-normal)
|
#$image
|
||||||
#$(theme-colors grub-theme-color-highlight))))))
|
#$(theme-colors grub-theme-color-normal)
|
||||||
|
#$(theme-colors grub-theme-color-highlight))))))
|
||||||
|
|
||||||
|
|
||||||
;;;
|
;;;
|
||||||
|
@ -229,7 +240,7 @@ (define entry->gexp
|
||||||
#$linux #$linux-image-name (string-join (list #$@arguments))
|
#$linux #$linux-image-name (string-join (list #$@arguments))
|
||||||
#$initrd))))
|
#$initrd))))
|
||||||
|
|
||||||
(mlet %store-monad ((sugar (eye-candy config #~port)))
|
(mlet %store-monad ((sugar (eye-candy config system #~port)))
|
||||||
(define builder
|
(define builder
|
||||||
#~(call-with-output-file #$output
|
#~(call-with-output-file #$output
|
||||||
(lambda (port)
|
(lambda (port)
|
||||||
|
|
Loading…
Reference in a new issue