Added some support for adding widget into text view
[cl-gtk2.git] / gtk / gtk.demo.lisp
index 1664d09..f517183 100644 (file)
@@ -1,5 +1,5 @@
 (defpackage :gtk-demo
-  (:use :cl :gtk :gdk :gobject)
+  (:use :cl :gtk :gdk :gobject :anaphora :iter)
   (:export #:test
            #:test-entry
            #:table-packing
@@ -9,10 +9,25 @@
            #:test-status-bar
            #:test-scale-button
            #:test-text-view
-           #:demo-code-editor))
+           #:demo-code-editor
+           #:test-treeview-list
+           #:test-combo-box
+           #:test-toolbar
+           #:test-ui-manager
+           #:test-color-button
+           #:test-color-selection
+           #:test-file-chooser
+           #:test-font-chooser
+           #:test-notebook
+           #:test-calendar
+           #:test-box-child-property
+           #:test-builder
+           #:demo-text-editor))
 
 (in-package :gtk-demo)
 
+(defparameter *src-location* (asdf:component-pathname (asdf:find-system :gtk)))
+
 (defun test ()
   (let ((window (make-instance 'gtk-window :type :toplevel :app-paintable t))
         x y)
@@ -23,7 +38,7 @@
                                                      (release widget)
                                                      (setf x (event-motion-x event)
                                                            y (event-motion-y event))
-                                                     (gtk-widget-queue-draw window)))
+                                                     (widget-queue-draw window)))
     (g-signal-connect window "expose-event"
                       (lambda (widget event)
                         (declare (ignore event))
@@ -31,7 +46,7 @@
                         ;(print event)
                         (using* ((gdk-window (widget-window window))
                                  (gc (gdk-gc-new gdk-window))
-                                 (layout (gtk-widget-create-pango-layout window (format nil "X: ~F~%Y: ~F" x y))))
+                                 (layout (widget-create-pango-layout window (format nil "X: ~F~%Y: ~F" x y))))
                           (gdk-draw-layout gdk-window gc 0 0 layout)
                           (gdk-gc-set-rgb-fg-color gc (make-color :red 65535 :green 0 :blue 0))
                           (multiple-value-bind (x y) (drawable-get-size gdk-window)
@@ -40,8 +55,8 @@
                       (lambda (widget event)
                         (declare (ignore event))
                         (release widget)
-                        (gtk-widget-queue-draw window)))
-    (gtk-widget-show-all window)
+                        (widget-queue-draw window)))
+    (widget-show window)
     (push :pointer-motion-mask (gdk-window-events (widget-window window)))
     (gtk-main)
     (release window)))
@@ -80,7 +95,7 @@
                                                (editable-select-region entry 5 10)))
     (g-signal-connect button-insert "clicked" (lambda (button) (release button)
                                                       (editable-insert-text entry "hello" 2)))
-    (gtk-widget-show-all window)
+    (widget-show window)
     (gtk-main)))
 
 (defun table-packing ()
     (table-attach table button-q 0 2 1 2)
     (g-signal-connect window "destroy" (lambda (w) (release w) (gtk-main-quit)))
     (g-signal-connect button-q "clicked" (lambda (b) (release b) (object-destroy window)))
-    (gtk-widget-show-all window)
+    (widget-show window)
     (gtk-main)))
 
 (defun test-pixbuf ()
     (container-add eventbox vbox-1)
     (box-pack-start vbox-1 (make-instance 'label :text "This is the eventbox"))
     (box-pack-start vbox-1 (make-instance 'label :text "The green ball is the bg"))
-    (gtk-widget-show-all window)
+    (widget-show window)
     (gtk-main)))
 
 (defun test-image ()
           (image (make-instance 'image :icon-name "applications-development" :icon-size 6)))
     (container-add window image)
     (g-signal-connect window "destroy" (lambda (w) (release w) (gtk-main-quit)))
-    (gtk-widget-show-all window)
+    (widget-show window)
     (gtk-main)))
 
 (defun test-progress-bar ()
     (g-signal-connect button-set "clicked" (lambda (w) (release w)
                                                    (setf (progress-bar-fraction p-bar)
                                                          (coerce (read-from-string (entry-text entry)) 'real))))
-    (gtk-widget-show-all window)
+    (widget-show window)
     (gtk-main)))
 
 (defun test-status-bar ()
     (box-pack-start h-box button-pop :expand nil)
     (box-pack-start v-box label)
     (box-pack-start v-box status-bar :expand nil)
-    (gtk-widget-show-all window)
+    (widget-show window)
     (setf (status-icon-screen icon) (gtk-window-screen window))
     (gtk-main)))
 
            (button (make-instance 'scale-button :icons (list "media-seek-backward" "media-seek-forward" "media-playback-stop" "media-playback-start") :adjustment (make-instance 'adjustment :lower -40 :upper 50 :value 20))))
     (g-signal-connect window "destroy" (lambda (w) (release w) (gtk-main-quit)))
     (container-add window button)
-    (gtk-widget-show-all window)
+    (widget-show window)
     (gtk-main)))
 
 (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))
                                                  (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"
     (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)
-    (gtk-widget-show-all window)
+    (widget-show window)
     (gtk-main)))
 
 (defun demo-code-editor ()
     (g-signal-connect window "destroy" (lambda (w) (release w) (gtk-main-quit)))
     (container-add window scrolled)
     (container-add scrolled view)
-    (gtk-widget-show-all window)
+    (widget-show window)
     (g-signal-connect buffer "insert-text" (lambda (buffer location text len)
                                              (using* ((buffer buffer) (location location))
                                                (format t "~A~%" (list buffer location text len)))))
-    (gtk-main)))
\ No newline at end of file
+    (gtk-main)))
+
+(defstruct tvi title value)
+
+(defun test-treeview-list ()
+  (let* ((window (make-instance 'gtk-window :type :toplevel :title "Treeview (list)"))
+         (model (make-instance 'array-list-store))
+         (scroll (make-instance 'scrolled-window :hscrollbar-policy :automatic :vscrollbar-policy :automatic))
+         (tv (make-instance 'tree-view :headers-visible t :width-request 100 :height-request 400 :rules-hint t))
+         (h-box (make-instance 'h-box))
+         (v-box (make-instance 'v-box))
+         (title-entry (make-instance 'entry))
+         (value-entry (make-instance 'entry))
+         (button (make-instance 'button :label "Add")))
+    (store-add-column model "gchararray" #'tvi-title)
+    (store-add-column model "gint" #'tvi-value)
+    (store-add-item model (make-tvi :title "Monday" :value 1))
+    (store-add-item model (make-tvi :title "Tuesday" :value 2))
+    (store-add-item model (make-tvi :title "Wednesday" :value 3))
+    (store-add-item model (make-tvi :title "Thursday" :value 4))
+    (store-add-item model (make-tvi :title "Friday" :value 5))
+    (store-add-item model (make-tvi :title "Saturday" :value 6))
+    (store-add-item model (make-tvi :title "Sunday" :value 7))
+    (setf (tree-view-model tv) model (tree-view-tooltip-column tv) 0)
+    (gobject:g-signal-connect window "destroy" (lambda (w) (gobject:release w) (gtk-main-quit)))
+    (gobject:g-signal-connect button "clicked" (lambda (b) (gobject:release b) 
+                                                       (store-add-item model (make-tvi :title (entry-text title-entry)
+                                                                                       :value (or (parse-integer (entry-text value-entry) 
+                                                                                                                 :junk-allowed t)
+                                                                                                  0)))))
+    (g-signal-connect tv "row-activated" (lambda (tv path column)
+                                           (release* tv path column)
+                                           (format t "You clicked on row ~A~%" (tree-path-indices path))))
+    (container-add window v-box)
+    (box-pack-start v-box h-box :expand nil)
+    (box-pack-start h-box title-entry :expand nil)
+    (box-pack-start h-box value-entry :expand nil)
+    (box-pack-start h-box button :expand nil)
+    (box-pack-start v-box scroll)
+    (container-add scroll tv)
+    (let ((column (make-instance 'tree-view-column :title "Title" :sort-column-id 0))
+          (renderer (make-instance 'cell-renderer-text :text "A text")))
+      (tree-view-column-pack-start column renderer)
+      (tree-view-column-add-attribute column renderer "text" 0)
+      (tree-view-append-column tv column)
+      (print (tree-view-column-tree-view column))
+      (print (tree-view-column-cell-renderers column)))
+    (let ((column (make-instance 'tree-view-column :title "Value"))
+          (renderer (make-instance 'cell-renderer-text :text "A text")))
+      (tree-view-column-pack-start column renderer)
+      (tree-view-column-add-attribute column renderer "text" 1)
+      (tree-view-append-column tv column)
+      (print (tree-view-column-tree-view column))
+      (print (tree-view-column-cell-renderers column)))
+    (widget-show window)
+    (gtk-main)))
+
+(defun test-combo-box ()
+  (let* ((window (make-instance 'gtk-window :type :toplevel :title "Treeview (list)"))
+         (model (make-instance 'array-list-store))
+         (combo-box (make-instance 'combo-box :model model))
+         (h-box (make-instance 'h-box))
+         (v-box (make-instance 'v-box))
+         (title-entry (make-instance 'entry))
+         (value-entry (make-instance 'entry))
+         (button (make-instance 'button :label "Add")))
+    (store-add-column model "gchararray" #'tvi-title)
+    (store-add-column model "gint" #'tvi-value)
+    (store-add-item model (make-tvi :title "Monday" :value 1))
+    (store-add-item model (make-tvi :title "Tuesday" :value 2))
+    (store-add-item model (make-tvi :title "Wednesday" :value 3))
+    (store-add-item model (make-tvi :title "Thursday" :value 4))
+    (store-add-item model (make-tvi :title "Friday" :value 5))
+    (store-add-item model (make-tvi :title "Saturday" :value 6))
+    (store-add-item model (make-tvi :title "Sunday" :value 7))
+    (gobject:g-signal-connect window "destroy" (lambda (w) (gobject:release w) (gtk-main-quit)))
+    (gobject:g-signal-connect button "clicked" (lambda (b) (gobject:release b) 
+                                                       (store-add-item model (make-tvi :title (entry-text title-entry)
+                                                                                       :value (or (parse-integer (entry-text value-entry) 
+                                                                                                                 :junk-allowed t)
+                                                                                                  0)))))
+    (g-signal-connect combo-box "changed" (lambda (c)
+                                     (declare (ignore c))
+                                     (format t "You clicked on row ~A~%" (combo-box-active combo-box))))
+    (container-add window v-box)
+    (box-pack-start v-box h-box :expand nil)
+    (box-pack-start h-box title-entry :expand nil)
+    (box-pack-start h-box value-entry :expand nil)
+    (box-pack-start h-box button :expand nil)
+    (box-pack-start v-box combo-box)
+    (let ((renderer (make-instance 'cell-renderer-text :text "A text")))
+      (cell-layout-pack-start combo-box renderer :expand t)
+      (cell-layout-add-attribute combo-box renderer "text" 0))
+    (let ((renderer (make-instance 'cell-renderer-text :text "A number")))
+      (cell-layout-pack-start combo-box renderer :expand nil)
+      (cell-layout-add-attribute combo-box renderer "text" 1))
+    (widget-show window)
+    (gtk-main)))
+
+(defun test-ui-manager ()
+  (let* ((window (make-instance 'gtk-window :type :toplevel :title "UI Manager" :default-width 200 :default-height 100 :window-position :center))
+         (ui-manager (make-instance 'ui-manager))
+         (print-confirmation t))
+    (ui-manager-add-ui-from-string ui-manager
+                                   "
+<ui>
+  <toolbar action='toolbar1'>
+      <separator/>
+      <toolitem name='Left' action='justify-left'/>
+      <toolitem name='Center' action='justify-center'/>
+      <toolitem name='Right' action='justify-right'/>
+      <toolitem name='Zoom in' action='zoom-in' />
+      <toolitem name='print-confirm' action='print-confirm' />
+      <separator/>
+  </toolbar>
+</ui>")
+    (gobject:g-signal-connect window "destroy" (lambda (w) (gobject:release w) (gtk-main-quit)))
+    (iter (with fn = (lambda (action) (when print-confirmation (format t "Action ~A with name ~A activated~%" action (action-name action)))))
+          (with action-group = (make-instance 'action-group :name "Actions"))
+          (finally (let ((a (make-instance 'toggle-action :name "print-confirm" :label "Print" :stock-id "gtk-print-report" :active t)))
+                     (g-signal-connect a "toggled" (lambda (action) (setf print-confirmation (toggle-action-active action))))
+                     (action-group-add-action action-group a))
+                   (ui-manager-insert-action-group ui-manager action-group 0))
+          (for (name stock-id) in '(("justify-left" "gtk-justify-left")
+                                    ("justify-center" "gtk-justify-center")
+                                    ("justify-right" "gtk-justify-right")
+                                    ("zoom-in" "gtk-zoom-in")))
+          (for action = (make-instance 'action :name name :stock-id stock-id))
+          (g-signal-connect action "activate" fn)
+          (action-group-add-action action-group action))
+    (awhen (ui-manager-widget ui-manager "/toolbar1")
+      (container-add window it))
+    (widget-show window)
+    (gtk-main)))
+
+(defun test-color-button ()
+  (let ((window (make-instance 'gtk-window :title "Color button" :type :toplevel :window-position :center :width-request 100 :height-request 100))
+        (button (make-instance 'color-button :title "Color button")))
+    (g-signal-connect window "destroy" (lambda (w) (release w) (gtk-main-quit)))
+    (g-signal-connect button "color-set" (lambda (b) (release b) (format t "Chose color ~A~%" (color-button-color button))))
+    (container-add window button)
+    (widget-show window)
+    (gtk-main)))
+
+(defun test-color-selection ()
+  (let ((window (make-instance 'gtk-window :title "Color selection" :type :toplevel :window-position :center))
+        (selection (make-instance 'color-selection :has-opacity-control t)))
+    (g-signal-connect window "destroy" (lambda (w) (declare (ignore w)) (gtk-main-quit)))
+    (g-signal-connect selection "color-changed" (lambda (s) (declare (ignore s)) (unless (color-selection-adjusting-p selection) (format t "color: ~A~%" (color-selection-current-color selection)))))
+    (container-add window selection)
+    (widget-show window)
+    (gtk-main)))
+
+(defun test-file-chooser ()
+  (let ((window (make-instance 'gtk-window :title "file chooser" :type :toplevel :window-position :center :default-width 100 :default-height 100))
+        (v-box (make-instance 'v-box))
+        (button (make-instance 'file-chooser-button :action :open))
+        (b (make-instance 'button :label "Choose for save" :stock-id "gtk-save")))
+    (g-signal-connect window "destroy" (lambda (w) (declare (ignore w)) (gtk-main-quit)))
+    (g-signal-connect button "file-set" (lambda (b) (declare (ignore b)) (format t "File set: ~A~%" (file-chooser-filename button))))
+    (g-signal-connect b "clicked" (lambda (b)
+                                    (declare (ignore b))
+                                    (let ((d (make-instance 'file-chooser-dialog :action :save :title "Choose file to save")))
+                                      (dialog-add-button d "gtk-save" :accept)
+                                      (dialog-add-button d "gtk-cancel" :cancel)
+                                      (when (eq (dialog-run d) :accept)
+                                        (format t "saved to file ~A~%" (file-chooser-filename d)))
+                                      (object-destroy d))))
+    (container-add window v-box)
+    (box-pack-start v-box button)
+    (box-pack-start v-box b)
+    (widget-show window)
+    (gtk-main)))
+
+(defun test-font-chooser ()
+  (let ((window (make-instance 'gtk-window :title "fonts" :type :toplevel :window-position :center :default-width 100 :default-height 100))
+        (v-box (make-instance 'v-box))
+        (button (make-instance 'font-button :title "Choose font" :font-name "Sans 10")))
+    (g-signal-connect window "destroy" (lambda (w) (declare (ignore w)) (gtk-main-quit)))
+    (g-signal-connect button "font-set" (lambda (b) (declare (ignore b)) (format t "Chose font ~A~%" (font-button-font-name button))))
+    (container-add window v-box)
+    (box-pack-start v-box button)
+    (widget-show window)
+    (gtk-main)))
+
+(defun test-notebook ()
+  (let ((window (make-instance 'gtk-window :title "Notebook" :type :toplevel :window-position :center :default-width 100 :default-height 100))
+        (expander (make-instance 'expander :expanded t :label "notebook"))
+        (notebook (make-instance 'notebook :enable-popup t)))
+    (g-signal-connect window "destroy" (lambda (w) (declare (ignore w)) (gtk-main-quit)))
+    (iter (for i from 0 to 5)
+          (for page = (make-instance 'label :label (format nil "Label for page ~A" i)))
+          (for tab-label = (make-instance 'label :label (format nil "Tab ~A" i)))
+          (for tab-button = (make-instance 'button :use-stock t :label "gtk-close" :relief :none))
+          (for tab-hbox = (make-instance 'h-box))
+          (box-pack-start tab-hbox tab-label)
+          (box-pack-start tab-hbox tab-button)
+          (widget-show tab-hbox)
+          (notebook-add-page notebook page tab-hbox))
+    (container-add window expander)
+    (container-add expander notebook)
+    (widget-show window)
+    (gtk-main)))
+
+(defun calendar-detail (calendar year month day)
+  (declare (ignore calendar year month))
+  (when (= day 23)
+    "!"))
+
+(defun test-calendar ()
+  (let ((window (make-instance 'gtk-window :title "Calendar" :type :toplevel :window-position :center :default-width 100 :default-height 100))
+        (calendar (make-instance 'calendar :detail-function #'calendar-detail)))
+    (g-signal-connect window "destroy" (lambda (w) (declare (ignore w)) (gtk-main-quit)))
+    (g-signal-connect calendar "day-selected" (lambda (c) (declare (ignore c)) (format t "selected: year ~A month ~A day ~A~%"
+                                                                                       (calendar-year calendar)
+                                                                                       (calendar-month calendar)
+                                                                                       (calendar-day calendar))))
+    (container-add window calendar)
+    (widget-show window)
+    (gtk-main)))
+
+(defun test-box-child-property ()
+  (let ((window (make-instance 'gtk-window :title "Text box child property" :type :toplevel :window-position :center :width-request 200 :height-request 200))
+        (box (make-instance 'h-box))
+        (button (make-instance 'toggle-button :active t :label "Expand")))
+    (g-signal-connect window "destroy" (lambda (w) (declare (ignore w)) (gtk-main-quit)))
+    (g-signal-connect button "toggled" (lambda (b) (declare (ignore b)) (setf (box-child-expand box button) (toggle-button-active button))))
+    (container-add window box)
+    (box-pack-start box button)
+    (widget-show window)
+    (gtk-main)))
+
+(defun test-builder ()
+  (let ((builder (make-instance 'builder)))
+    (builder-add-from-file builder (namestring (merge-pathnames "demo/demo1.ui" *src-location*)))
+    (let ((text-view (builder-get-object builder "textview1"))
+          (c 0))
+      (builder-connect-signals-simple builder `(("toolbutton1_clicked_cb" ,(lambda (b)
+                                                                                   (declare (ignore b))
+                                                                                   #+nil(print (current-event))
+                                                                                   (setf (text-buffer-text (text-view-buffer text-view))
+                                                                                         (format nil "Clicked ~A times~%" (incf c)))
+                                                                                   (status-bar-pop (builder-get-object builder "statusbar1")
+                                                                                                   "times")
+                                                                                   (status-bar-push (builder-get-object builder "statusbar1")
+                                                                                                    "times"
+                                                                                                    (format nil "~A times" c))))
+                                                ("quit_cb" ,(lambda (&rest args)
+                                                                    (print args)
+                                                                    (object-destroy (builder-get-object builder "window1"))))
+                                                ("about_cb" ,(lambda (&rest args)
+                                                                     (print args)
+                                                                     (let ((d (make-instance 'about-dialog
+                                                                                             :program-name "GtkBuilder text"
+                                                                                             :version "0.00001"
+                                                                                             :authors '("Dmitry Kalyanov")
+                                                                                             :logo-icon-name "gtk-apply")))
+                                                                       (dialog-run d)
+                                                                       (object-destroy d)))))))
+    (g-signal-connect (builder-get-object builder "window1") "destroy" (lambda (w) (declare (ignore w)) (gtk-main-quit)))
+    (status-bar-push (builder-get-object builder "statusbar1") "times" "0 times")
+    (widget-show (builder-get-object builder "window1"))
+    (gtk-main)))
+
+(defun read-text-file (file-name)
+  (with-output-to-string (str)
+    (with-open-file (file file-name)
+      (loop
+         for line = (read-line file nil nil)
+         while line
+         do (fresh-line str)
+         do (write-string line str)))))
+
+(defun demo-text-editor ()
+  (let* ((builder (aprog1 (make-instance 'builder)
+                    (builder-add-from-file it (namestring (merge-pathnames "demo/text-editor.ui" *src-location*)))))
+         (window (builder-get-object builder "window1"))
+         (text-view (builder-get-object builder "textview1"))
+         (status-bar (builder-get-object builder "statusbar1"))
+         (file-name nil)
+         (modified-p t))
+    (status-bar-push status-bar "filename" "Untitled *")
+    (labels ((set-properties ()
+               (status-bar-pop status-bar "filename")
+               (status-bar-push status-bar "filename" (format nil "~A~:[~; *~]" (or file-name "Untitled") modified-p)))
+             (new (&rest args) (declare (ignore args))
+               (setf file-name nil
+                     modified-p t
+                     (text-buffer-text (text-view-buffer text-view)) "")
+               (set-properties))
+             (cb-open (&rest args) (declare (ignore args))
+               (let ((d (make-instance 'file-chooser-dialog :action :open :title "Open file")))
+                 (when file-name (setf (file-chooser-filename d) file-name))
+                 (dialog-add-button d "gtk-open" :accept)
+                 (dialog-add-button d "gtk-cancel" :cancel)
+                 (when (eq :accept (dialog-run d))
+                   (setf file-name (file-chooser-filename d)
+                         (text-buffer-text (text-view-buffer text-view)) (read-text-file file-name)
+                         modified-p nil)
+                   (set-properties))
+                 (object-destroy d)))
+             (save (&rest args) (declare (ignore args))
+               (if file-name
+                   (progn
+                     (with-open-file (file file-name :direction :output :if-exists :supersede)
+                       (write-string (text-buffer-text (text-view-buffer text-view)) file))
+                     (setf modified-p nil)
+                     (set-properties))
+                   (save-as)))
+             (save-as (&rest args) (declare (ignore args))
+               (let ((d (make-instance 'file-chooser-dialog :action :save :title "Save file")))
+                 (when file-name (setf (file-chooser-filename d) file-name))
+                 (dialog-add-button d "gtk-save" :accept)
+                 (dialog-add-button d "gtk-cancel" :cancel)
+                 (if (eq :accept (dialog-run d))
+                     (progn
+                       (setf file-name (file-chooser-filename d))
+                       (object-destroy d)
+                       (save))
+                     (object-destroy d))))
+             (cut (&rest args) (declare (ignore args))
+               (text-buffer-cut-clipboard (text-view-buffer text-view) (get-clipboard "CLIPBOARD")))
+             (copy (&rest args) (declare (ignore args))
+               (text-buffer-copy-clipboard (text-view-buffer text-view) (get-clipboard "CLIPBOARD")))
+             (paste (&rest args) (declare (ignore args))
+               (text-buffer-paste-clipboard (text-view-buffer text-view) (get-clipboard "CLIPBOARD")))
+             (cb-delete (&rest args) (declare (ignore args))
+               (let ((buffer (text-view-buffer text-view)))
+                 (multiple-value-bind (i1 i2) (text-buffer-get-selection-bounds buffer)
+                   (when (and i1 i2)
+                     (text-buffer-delete buffer i1 i2)))))
+             (about (&rest args) (declare (ignore args))
+               (let ((d (make-instance 'about-dialog
+                                       :program-name "Lisp Gtk+ Binding Demo Text Editor"
+                                       :version (format nil "0.0.0.1 ~A" #\GREEK_SMALL_LETTER_ALPHA)
+                                       :authors '("Kalyanov Dmitry")
+                                       :license "Public Domain"
+                                       :logo-icon-name "accessories-text-editor")))
+                 (dialog-run d)
+                 (object-destroy d)))
+             (quit (&rest args) (declare (ignore args)) (object-destroy window))
+             (cb-eval (&rest args) (declare (ignore args))
+               (let ((buffer (text-view-buffer text-view)))
+                 (multiple-value-bind (i1 i2) (text-buffer-get-selection-bounds buffer)
+                   (when (and i1 i2)
+                     (with-gtk-message-error-handler
+                       (let* ((text (text-buffer-slice buffer i1 i2))
+                              (value (eval (read-from-string text)))
+                              (value-str (format nil "~A" value))
+                              (pos (max (text-iter-offset i1) (text-iter-offset i2))))
+                         (text-buffer-insert buffer " => " :position (text-buffer-get-iter-at-offset buffer pos))
+                         (incf pos (length " => "))
+                         (text-buffer-insert buffer value-str :position (text-buffer-get-iter-at-offset buffer pos)))))))))
+      (builder-connect-signals-simple builder `(("new" ,#'new)
+                                                ("open" ,#'cb-open)
+                                                ("save" ,#'save)
+                                                ("save-as" ,#'save-as)
+                                                ("cut" ,#'cut)
+                                                ("copy" ,#'copy)
+                                                ("paste" ,#'paste)
+                                                ("delete" ,#'cb-delete)
+                                                ("about" ,#'about)
+                                                ("quit" ,#'quit)
+                                                ("eval" ,#'cb-eval)))
+      (g-signal-connect window "destroy" (lambda (w) (declare (ignore w)) (gtk-main-quit)))
+      (g-signal-connect (text-view-buffer text-view) "changed" (lambda (b) (declare (ignore b)) (setf modified-p t) (set-properties)))
+      (widget-show window)
+      (gtk-main))))
\ No newline at end of file