From be31b7e742a0ea6812e3bcd14e5287a98b77ae51 Mon Sep 17 00:00:00 2001 From: Matt Birkholz Date: Tue, 2 Feb 2016 22:28:55 -0700 Subject: [PATCH] gtk-screen: Use gtk-style-context to set widget fonts/colors. --- src/gtk-screen/gtk-screen.pkg | 11 +++++--- src/gtk-screen/gtk-screen.scm | 52 +++++++++++++++++------------------ 2 files changed, 32 insertions(+), 31 deletions(-) diff --git a/src/gtk-screen/gtk-screen.pkg b/src/gtk-screen/gtk-screen.pkg index 3d9c8bb2a..46efbe0f8 100644 --- a/src/gtk-screen/gtk-screen.pkg +++ b/src/gtk-screen/gtk-screen.pkg @@ -107,6 +107,12 @@ USA. (import (glib) gobject-alien gobject-unref!) (import (gtk) + gtk-css-provider-load-from-data + gtk-css-provider-new + gtk-style-context-add-provider + gtk-widget-get-style-context + gtk-widget-set-name + gdk-key-state->char-bits gdk-keyval->name gdk-window-process-updates @@ -118,13 +124,11 @@ USA. gtk-widget-error-bell gtk-widget-queue-draw gtk-widget-queue-resize-no-redraw - gtk-widget-font set-gtk-widget-font! gtk-widget-get-pango-context gtk-widget-create-pango-layout gtk-widget-set-hexpand gtk-widget-set-vexpand - gtk-widget-bg-color set-gtk-widget-bg-color! - gtk-widget-fg-color set-gtk-widget-fg-color! + gtk-widget-set-opacity gtk-container? gtk-container-children gtk-container-add gtk-container-remove @@ -146,7 +150,6 @@ USA. gtk-window-new gtk-window-present gtk-window-set-title - gtk-window-set-opacity gtk-window-set-default-size set-scm-widget-minimum-size! diff --git a/src/gtk-screen/gtk-screen.scm b/src/gtk-screen/gtk-screen.scm index 254261305..0ccb27c71 100644 --- a/src/gtk-screen/gtk-screen.scm +++ b/src/gtk-screen/gtk-screen.scm @@ -47,9 +47,8 @@ USA. ;; set to #f! (name define standard initial-value #f) - ;; The default font. Initially a string. Replaced with a - ;; PangoFontDescription when the toplevel has been realized. - (font define standard) + ;; Toplevel's gtk-style-context, after toplevel is realized. + (style-context define standard initial-value #f) ;; The default font's character dimensions. (char-width define standard) @@ -74,9 +73,8 @@ USA. (begin (guarantee-string geometry 'make-gtk-screen) geometry)))) - (gtk-window-set-opacity toplevel 0.95) - (set-gtk-screen-font! screen "Monospace 11") - (init-font-dimensions! screen) + (gtk-widget-set-opacity toplevel 0.95) + (init-font-dimensions! screen "Monospace 11") (init-size! screen geometry*) (let ((thread (create-blinker-thread screen))) (%trace "; blinker thread: "thread"\n") @@ -87,13 +85,12 @@ USA. (%trace "; screen: "screen"\n") screen)) -(define (init-font-dimensions! screen) - (%trace "; init-font-dimensions! "screen"\n") +(define (init-font-dimensions! screen spec) + (%trace "; init-font-dimensions! "screen" "spec"\n") ;; Lookup SCREEN's font via the toplevel widget's pango-context, ;; which appears to be available before toplevel is realized. - (let* ((spec (gtk-screen-font screen)) - (toplevel (gtk-screen-toplevel screen)) + (let* ((toplevel (gtk-screen-toplevel screen)) (context (gtk-widget-get-pango-context toplevel)) (font (pango-font-description-from-string spec)) (metrics (pango-context-get-metrics context font))) @@ -111,17 +108,6 @@ USA. (%trace "; Font: \""spec"\" "width"x"ascent"+"descent" "spacing"\n") (pango-font-metrics-unref metrics)))) -(define (realize-font! widget) - (let* ((screen (edwin-widget-screen widget)) - (font (gtk-screen-font screen))) - (if (string? font) - (let ((desc (pango-font-description-from-string font))) - (%trace "; realize-font!\n") - (set-gtk-widget-font! (gtk-screen-toplevel screen) desc) - (set-gtk-widget-font! widget desc) - (set-gtk-screen-font! screen desc)) - (set-gtk-widget-font! widget font)))) - (define (init-size! screen geometry) (%trace "; init-size! "screen" "geometry"\n") ;; Sets the logical screen size. This sets Edwin window and thus @@ -1182,8 +1168,22 @@ USA. (%widget-y-size window screen)) (%trace "; initialized geometry: "geometry"\n")))) (call-next-method widget) - (realize-font! widget) - (set-gtk-widget-bg-color! widget "white")) + (realize-style-context! widget)) + +(define (realize-style-context! widget) + (%trace "; realize-style-context!\n") + (let ((screen (edwin-widget-screen widget))) + (if (not (gtk-screen-style-context screen)) + (let ((provider (gtk-css-provider-new)) + (context (gtk-widget-get-style-context + (gtk-screen-toplevel screen)))) + (set-gtk-screen-style-context! screen context) + (gtk-css-provider-load-from-data + provider " +ScmWidget { font: Monospace 11 } +#modeline { background: black }") + (gtk-style-context-add-provider context provider 'fallback) + (gobject-unref! provider))))) (define-method fix-widget-new-geometry-callback ((widget )) (%trace "; (fix-widget-new-geometry-callback ) "widget"\n") @@ -1344,6 +1344,7 @@ USA. (call-next-method widget 0 (y-size->height screen 1))) (gtk-widget-set-hexpand widget #t) (gtk-widget-set-vexpand widget #f) + (gtk-widget-set-name widget "modeline") (let ((drawing (make-fix-drawing))) ;;; (%trace "; drawing: "drawing"\n") (set-fix-layout-drawing! widget drawing 0 0)) @@ -1368,12 +1369,9 @@ USA. (set-fix-rect-size! geometry 0 (y-size->height screen 1)) (%trace "; initialized geometry: "geometry"\n")))) (call-next-method widget) - (set-gtk-widget-bg-color! widget "black") - (realize-font! widget) + (realize-style-context! widget) (let ((ink (make-simple-text-ink)) (drawing (fix-layout-drawing widget))) - (set-simple-text-ink-font! ink (gtk-screen-font - (edwin-widget-screen widget))) (set-simple-text-ink-text! ink widget "--------Initial mode line.--------------------------------") (set-text-ink-color! ink "white") -- 2.25.1