Re: [ANN] guile-gi v0.1.0 released

[Jan Nieuwenhuizen]

Mike Gran writes:

> On behalf of the Guile-GI team, I am pleased to announce the release
> of Guile-GI v0.1.0.

Congrats and thanks!

I updated the editor example again with a `split' button and the
segfault that I got earliler is now gone.

Greetings,
janneke

>From 8f22c6d1d1ea95e4ee37e7d5a4623515995d93e1 Mon Sep 17 00:00:00 2001
From: Jan Nieuwenhuizen <address@hidden>
Date: Wed, 14 Aug 2019 10:08:57 +0200
Subject: [PATCH] editor: Add window split.

---
 examples/editor.scm | 106 +++++++++++++++++++++++++++++++++++++-------
 1 file changed, 91 insertions(+), 15 deletions(-)

diff --git a/examples/editor.scm b/examples/editor.scm
index ed472e7..d8d7ccf 100644
--- a/examples/editor.scm
+++ b/examples/editor.scm
@@ -14,25 +14,32 @@
 ;; You should have received a copy of the GNU General Public License
 ;; along with this program.  If not, see <https:;;www.gnu.org/licenses/>.
 (use-modules (gi) (gi repository)
+             (srfi srfi-9)
              (srfi srfi-26)
              (oop goops)
              (ice-9 receive))
 
 (map require
-     '("Gio" "Gtk" "Gdk")
-     '("2.0" "3.0" "3.0"))
+     '("Gio" "Gtk" "Gdk" "Pango")
+     '("2.0" "3.0" "3.0" "1.0"))
 
 (load-by-name "Gdk" "Event")
 (load-by-name "Gdk" "EventMask")
+(load-by-name "Gdk" "RGBA")
 (load-by-name "Gio" "Application")
+(load-by-name "Pango" "FontDescription")
 
 (for-each
  (cute load-by-name "Gtk" <>)
  '("ApplicationWindow" "Application"
-   "Button" "VBox" "ButtonBox"
+   "Button" "Box" "ButtonBox"
+   "Label" "EventBox"
    ;; base types that we use for some methods
    "Container" "Window" "Widget"
-   "TextView" "TextBuffer" "TextIter"))
+   "ScrolledWindow"
+   "TextView" "TextBuffer" "TextIter"
+   ;; enums
+   "Align" "Orientation" "PolicyType" "PositionType" "StateType"))
 
 (define (print-goodbye widget)
   (display "Goodbye World\n"))
@@ -43,25 +50,86 @@
     (format #t "key: ~s\n" keyval)
     #f))
 
+(define-record-type <user-data>
+  (make-user-data widget view mode-line)
+  user-data?
+  (widget user-data-widget)
+  (view user-data-view set-user-data-view)
+  (mode-line user-data-mode-line))
+
+(define (make-box children orientation)
+  (warn 'make-box 'children children)
+  (let ((box (box:new
+              (if (eq? orientation 'vertical)
+                  ORIENTATION_VERTICAL
+                  ORIENTATION_HORIZONTAL)
+              0)))
+    (set-homogeneous box #t)
+    (for-each
+     (lambda (ui-data)
+       (format (current-error-port) "ui-data ~a\n" ui-data)
+       (let* ((w (if (user-data? ui-data) (user-data-widget ui-data) ui-data))
+              (parent (get-parent w)))
+         (format (current-error-port) "w= ~a\n" w)
+         (when parent
+           (remove parent w))
+         (pack-start box w #t #t 0)))
+     children)
+    (show-all box)
+    box))
+
+(define (make-buffer-window)
+  (let ((vbox (box:new ORIENTATION_VERTICAL 0))
+        (ebox (event-box:new))
+        (bgc (make <GdkRGBA>))
+        (mode-line (label:new))
+        (window (scrolled-window:new))
+        (view (text-view:new)))
+
+    (set-halign mode-line ALIGN_START)
+    (set-markup mode-line " -:-- *mode-line*")
+    (set-line-wrap mode-line #f)
+    (set-policy window POLICY_AUTOMATIC POLICY_AUTOMATIC)
+    (parse? bgc "lightgray")
+    (override-background-color ebox STATE_NORMAL bgc)
+
+    (modify-font view (font-description:from-string "monospace 18"))
+
+    (pack-start vbox window #t #t 0)
+    (pack-start vbox ebox #f #f 0)
+    (add ebox mode-line)
+    (add window view)
+
+    (format (current-error-port) "buffer-window ~a\n" vbox)
+    (make-user-data vbox view mode-line)))
+
 (define (activate app)
-  (let ((window (application-window:new app))
-        (vbox (vbox:new 0 0))
-        (editor (text-view:new))
-        (button-box (button-box:new 0))
-        (button (button:new-with-label "Quit"))
-        (button2 (button:new-with-label "Hello")))
+  (let* ((window (application-window:new app))
+         (vbox (box:new ORIENTATION_VERTICAL 0))
+         (button-box (button-box:new 0))
+         (button-hello (button:new-with-label "Hello"))
+         (button-split (button:new-with-label "Split"))
+         (button-quit (button:new-with-label "Quit"))
+         (buffer-window (make-buffer-window))
+         (editor (user-data-view buffer-window))
+         (container (box:new ORIENTATION_VERTICAL 0))
+         (root (user-data-widget buffer-window)))
     (add-events editor EVENT_MASK_KEY_PRESS_MASK)
 
+    (add window vbox)
+    (add container root)
+    (pack-start vbox container #t #t 0)
+    (pack-start vbox button-box #f #f 0)
     (map add
-         (list button-box button-box vbox vbox window)
-         (list button2 button editor button-box vbox))
+         (list button-box button-box button-box)
+         (list button-hello button-split button-quit))
 
     (set-title window "Window")
     (set-default-size window 200 200)
 
     (map connect
-         (list editor button button button2)
-         (list key-press-event clicked clicked clicked)
+         (list editor button-quit button-quit button-hello button-split)
+         (list key-press-event clicked clicked clicked clicked)
          (list key-press
                print-goodbye (lambda x (destroy window))
                ;; When the 'hello' button is clicked, write the current 
contents
@@ -74,7 +142,15 @@
                    (get-bounds buffer iter1 iter2)
                    (write (get-text buffer iter1 iter2 #t))
                    (newline)
-                   (set-text buffer "Hello, world" 12)))))
+                   (set-text buffer "Hello, world" 12)))
+               ;; When the 'split' button is clicked, create second editor 
window
+               (lambda x
+                 (let* ((children (list buffer-window (make-buffer-window)))
+                        (root' (make-box children 'horizontal)))
+                   (remove container root)
+                   (add container root')
+                   (set! root root')
+                   (show-all vbox)))))
 
     (grab-focus editor)
     (show-all window)))
-- 
2.22.1

-- 
Jan Nieuwenhuizen <address@hidden> | GNU LilyPond http://lilypond.org
Freelance IT http://JoyofSource.com | Avatar® http://AvatarAcademy.com