Styling etc

scmvm.scm

@@ -6,11 +6,11 @@ exec guile -L . -e main -s "$0" "$@"
              (ice-9 format)
              (srfi srfi-26)
              (srfi srfi-43)
-             (scmvm vm))
+             (scmvm vm)
+             (oop goops)
+             (g-golf))
 
 (eval-when (expand load eval)
-  (use-modules (oop goops)
-               (g-golf))
   (g-irepository-require "Gtk" #:version "4.0")
   (for-each (lambda (name)
               (gi-import-by-name "Gio" name))
@@ -22,7 +22,13 @@ exec guile -L . -e main -s "$0" "$@"
               "CallbackAction"
               "FileDialog"
               "Box"
-              "TextView")))
+              "TextView"
+              "CssProvider")))
+
+(define *css* "
+.mono {
+	font-family: monospace;
+}")
 
 (define %vm (make-vm #:memory-size 100))
 (define %program #f)
@@ -37,7 +43,7 @@ exec guile -L . -e main -s "$0" "$@"
     (set-text %buffer "" 0)
     (vector-for-each
      (lambda (_ byte)
-       (insert-at-cursor %buffer (format #f "~2'0x " byte) 3))
+       (insert-at-cursor %buffer (format #f "~:@(~2'0x~) " byte) -1))
      ram)))
 
 (define (open-file win cb)
@@ -55,6 +61,10 @@ exec guile -L . -e main -s "$0" "$@"
   (define win (make <gtk-application-window>
                 #:application app
                 #:title "Scheme Compiler"))
+  (define css-provider (make <gtk-css-provider>))
+  (load-from-string css-provider *css*)
+  (gtk-style-context-add-provider-for-display
+   (gdk-display-get-default) css-provider #xffff)
 
   ;; All this to make a menu...
   (let ([app-action-group (make <g-simple-action-group>)]
@@ -77,19 +87,28 @@ exec guile -L . -e main -s "$0" "$@"
                      #:vexpand #t
                      #:editable #f
                      #:cursor-visible #f
-                     #:wrap-mode 'word))
+                     #:wrap-mode 'word
+                     #:css-classes '("mono")))
   (set! %buffer (get-buffer textview))
   (update-memory-buffer!)
   (append box textview)
   (set-child win box)
   
   (present win))
-
+
 (define* (main #:optional args)
   (define app (make <gtk-application>))
   (connect app 'activate activate)
   (let ([status (run app args)])
     (exit status)))
+
+;;; DEBUG
+(use-modules (ice-9 threads))
+(define (debug)
+  (define app (make <gtk-application>))
+  (connect app 'activate activate)
+  (begin-thread
+   (run app '())))
 
 ;; Local Variables:
 ;; mode: scheme