[gtk-cffi-cvs] CVS gtk-cffi/examples

[CVS User rklochkov]

Update of /project/gtk-cffi/cvsroot/gtk-cffi/examples
In directory tiger.common-lisp.net:/tmp/cvs-serv27495/examples

Modified Files:
	editor.lisp ex2.lisp ex9.lisp 
Log Message:
Some refactoring. Now we can use (show #(1 2 3)) or (show '(1 2 3)) to lookup
through the sequence in GTK list view



--- /project/gtk-cffi/cvsroot/gtk-cffi/examples/editor.lisp	2011/08/28 15:38:31	1.3
+++ /project/gtk-cffi/cvsroot/gtk-cffi/examples/editor.lisp	2011/09/10 16:26:10	1.4
@@ -1,32 +1,79 @@
 (asdf:oos 'asdf:load-op :gtk-cffi)
+(asdf:oos 'asdf:load-op :babel)
+(asdf:oos 'asdf:load-op :flexi-streams)
+
 
 (defpackage #:editor
   (:use #:common-lisp #:gtk-cffi #:g-object-cffi))
 (in-package #:editor)
 
+
 (gtk-init)
-(defparameter *window*
+
+(defvar *window*)
+
+(defun open-file (&rest rest)
+  (declare (ignore rest))
+  (let ((d (make-instance 'file-chooser-dialog
+                          :action :open
+                          :parent *window*
+                          :title "Open file")))
+    (when (eq (run d) :accept)
+      (setf (text (buffer (object-by-id :main-text)))
+            (with-open-file (s (filename d) :element-type '(unsigned-byte 8))
+              (destroy d) ; filename fetched
+              (let ((res (make-array (file-length s) 
+                                     :element-type '(unsigned-byte 8))))
+                (read-sequence res s)
+                (handler-case (babel:octets-to-string res :encoding :utf-8)
+                  (t nil (flexi-streams:octets-to-string 
+                          res :external-format :koi8-r)))))))))
+
+
+(defun save-file (&rest rest)
+  (format t "~a" rest))
+
+
+(setq *window*
   (gtk-model 
     'window :signals '(:destroy :gtk-main-quit)
-    :width 400 :height 400 :title "Editor"
+    :width 950 :height 600 :title "Editor"
     ('v-box
      :expand nil
-     ('menu-bar)
-     :expand t
+     ('menu-bar
+      ('menu-item 
+       :label "File"
+       :submenu 
+       (gtk-model 
+         'menu 
+         ('menu-item :label "Open"
+                     :signals '(:activate open-file))
+         ('menu-item :label "Save"
+                     :signals '(:activate save-file))
+         ('menu-item :label "Quit" 
+                     :signals `(:activate ,(lambda (&rest rest)
+                                                   (declare (ignore rest))
+                                                   (destroy *window*)))))))
+      :expand t
      ('h-box
       :expand nil
       ;('h-paned
       ('scrolled-window
        ('tree-view))
       :expand t
+      ('frame
+       ('v-box
+       :expand nil
+       ('label :text "Main window")
+       :expand t
+       ('scrolled-window
+        ('text-view :id :main-text))))
       ('v-box
        :expand nil
-       ('label :text "12323")
+       ('label :text "REPL")
        :expand t
        ('scrolled-window
-        ('text-view :id :text2)))
-      ('scrolled-window
-       ('text-view :id :text3)))
+        ('text-view :id :text3))))
      :expand nil
      ('statusbar))))
 
--- /project/gtk-cffi/cvsroot/gtk-cffi/examples/ex2.lisp	2011/08/26 17:16:13	1.3
+++ /project/gtk-cffi/cvsroot/gtk-cffi/examples/ex2.lisp	2011/09/10 16:26:10	1.4
@@ -41,8 +41,7 @@
                                    (event :pointer)
                                    (module gtk-string))
   (declare (ignore widget))
-  (when (equal (gdk-cffi:parse-event event :keyval)
-               (gdk-cffi:key :f12))
+  (when (eq (gdk-cffi:parse-event event :keyval) :f12)
     (format t "~a~%" module)
     (if (string= module "main")
         (destroy (gethash "main" *apps*))
@@ -65,7 +64,7 @@
                 (setf (size-request button) '(80 32))
                 (when (string= (car module) cur-module)
                   (mapcar (lambda (x)
-                            (setf (color button :bg x) "#95DDFF"))
+                            (setf (color button :type :bg :state x) "#95DDFF"))
                           '(:normal :active :prelight)))
                 (pack h-box button)
                 (pack h-box (make-instance 'label) :fill t :expand t)
--- /project/gtk-cffi/cvsroot/gtk-cffi/examples/ex9.lisp	2011/08/26 17:16:13	1.1
+++ /project/gtk-cffi/cvsroot/gtk-cffi/examples/ex9.lisp	2011/09/10 16:26:10	1.2
@@ -35,5 +35,6 @@
      ('tree-view :model *model* :columns '("Test str" "Test int"))))); "Test int"))))
 
 (show *window*)
+(show #(1 2 3 4 5))
 
 (gtk-main)