Added some support for adding widget into text view

[cl-gtk2.git] / gtk / gtk.demo.lisp

diff --git a/gtk/gtk.demo.lisp b/gtk/gtk.demo.lisp
index 87d813f..f517183 100644 (file)
--- a/gtk/gtk.demo.lisp
+++ b/gtk/gtk.demo.lisp
@@ -198,6 +198,7 @@
 (defun test-text-view ()
   (using* ((window (make-instance 'gtk-window :type :toplevel :title "Testing text view" :width-request 400 :height-request 300))
            (button (make-instance 'button :label "Do"))
+           (button-insert (make-instance 'button :label "Insert a button!"))
            (bold-btn (make-instance 'button :label "Bold"))
            (buffer (make-instance 'text-buffer :text "Some text buffer with some text inside"))
            (v (make-instance 'text-view :buffer buffer :wrap-mode :word))
@@ -225,6 +226,12 @@
                                                  (if (text-iter-has-tag start tag)
                                                      (text-buffer-remove-tag buffer tag start end)
                                                      (text-buffer-apply-tag buffer tag start end)))))))
+    (g-signal-connect button-insert "clicked" (lambda (b) (declare (ignore b))
+                                                (let* ((iter (text-buffer-get-iter-at-mark buffer (text-buffer-get-mark buffer "insert")))
+                                                       (anchor (text-buffer-insert-child-anchor buffer iter))
+                                                       (button (make-instance 'button :label "A button!")))
+                                                  (widget-show button)
+                                                  (text-view-add-child-at-anchor v button anchor))))
     (let ((tag (make-instance 'text-tag :name "bold" :weight 700)))
       (text-tag-table-add (text-buffer-tag-table buffer) tag)
       (g-signal-connect tag "event"
@@ -237,6 +244,7 @@
     (container-add window box)
     (container-add scrolled v)
     (box-pack-start box button :expand nil)
+    (box-pack-start box button-insert :expand nil)
     (box-pack-start box bold-btn :expand nil)
     (box-pack-start box scrolled)
     (widget-show window)