/[gtk-cffi]/gtk-cffi/examples/ex2.lisp
ViewVC logotype

Diff of /gtk-cffi/examples/ex2.lisp

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.1.1.1 by rklochkov, Mon Apr 25 19:16:08 2011 UTC revision 1.6 by rklochkov, Mon May 7 09:02:03 2012 UTC
# Line 1  Line 1 
1  (asdf:oos 'asdf:load-op :gtk-cffi)  (asdf:oos 'asdf:load-op :gtk-cffi)
2    
3  (defpackage :test-ex2  (defpackage :test-ex2
4    (:use #:common-lisp #:gtk-cffi #:cffi-object #:g-object-cffi))    (:use #:common-lisp #:gtk-cffi #:cffi-objects #:g-object-cffi))
5    
6  (in-package :test-ex2)  (in-package :test-ex2)
7    
# Line 16  Line 16 
16                         ("finance" (480 360))))                         ("finance" (480 360))))
17    
18  (cffi:defcallback clicked  (cffi:defcallback clicked
19                    :void ((widget :pointer) (activated-module gtk-string))                    :void ((widget :pointer) (activated-module :string))
20    (declare (ignore widget))    (declare (ignore widget))
21    (declare (ignorable widget))    (declare (ignorable widget))
22    (format t "button_clicked: ~a~%" activated-module)    (format t "button_clicked: ~a~%" activated-module)
23    (show (gethash activated-module *apps*) :all t)    (show (gethash activated-module *apps*) :all t)
24    (mapcar (lambda (module)    (mapcar (lambda (module)
25              (unless (string= activated-module (car module))              (unless (string= activated-module (car module))
26                (hide (gethash (car module) *apps*) :all t)))                (hide (gethash (car module) *apps*))))
27            *mods*)            *mods*)
28    (run (gethash activated-module *apps*)))    (run (gethash activated-module *apps*)))
29    
30    
31  (cffi:defcallback on-delete :boolean ((widget :pointer)  (cffi:defcallback on-delete :boolean ((widget :pointer)
32                                        (event :pointer)                                        (event :pointer)
33                                        (module gtk-string))                                        (module :string))
34    (declare (ignore widget))    (declare (ignore widget event))
35    (unless (string= module "main")    (unless (string= module "main")
36      (hide (gethash module *apps*))      (hide (gethash module *apps*))
37      (show (gethash "main" *apps*) :all t)      (show (gethash "main" *apps*) :all t)
# Line 39  Line 39 
39    
40  (cffi:defcallback on-key :boolean ((widget :pointer)  (cffi:defcallback on-key :boolean ((widget :pointer)
41                                     (event :pointer)                                     (event :pointer)
42                                     (module gtk-string))                                     (module :string))
43    (declare (ignore widget))    (declare (ignore widget))
44    (when (equal (gdk-cffi:parse-event event :keyval)    (when (eq (gdk-cffi:parse-event event :keyval) (gdk-cffi:key :f12))
                (gdk-cffi:key :f12))  
45      (format t "~a~%" module)      (format t "~a~%" module)
46      (if (string= module "main")      (if (string= module "main")
47          (destroy (gethash "main" *apps*))          (destroy (gethash "main" *apps*))
# Line 65  Line 64 
64                  (setf (size-request button) '(80 32))                  (setf (size-request button) '(80 32))
65                  (when (string= (car module) cur-module)                  (when (string= (car module) cur-module)
66                    (mapcar (lambda (x)                    (mapcar (lambda (x)
67                              (setf (color button :bg x) "#95DDFF"))                              (setf (color button :type :bg :state x) "#95DDFF"))
68                            '(:normal :active :prelight)))                            '(:normal :active :prelight)))
69                  (pack h-box button)                  (pack h-box button)
70                  (pack h-box (make-instance 'label) :fill t :expand t)                  (pack h-box (make-instance 'label) :fill t :expand t)
71                  (setf (gsignal button :clicked                  (setf (gsignal button :clicked
72                                 :data (cffi:convert-to-foreign                                 :data (cffi:convert-to-foreign
73                                        (car module) 'gtk-string))                                        (car module) :string))
74                        (cffi:callback clicked))))                        (cffi:callback clicked))))
75              *mods*)))              *mods*)))
76    
# Line 79  Line 78 
78    
79  (defun setup-app (module)  (defun setup-app (module)
80    (let ((dialog (make-instance 'dialog :title (car module) :flags :modal)))    (let ((dialog (make-instance 'dialog :title (car module) :flags :modal)))
81      (setf (win-position dialog) :center-always)      (setf (position-type dialog) :center-always)
82      (setf (size-request dialog) (second module))      (setf (size-request dialog) (second module))
83      ;(setf (property dialog :content-area-border) 10)      ;(setf (property dialog :content-area-border) 10)
84      (let ((top-area (v-box dialog)))      (let ((top-area (content-area dialog)))
85        (flet ((print-out (str)        (flet ((print-out (str)
86                          (pack top-area (make-instance 'label                          (pack top-area (make-instance 'label
87                                            :text str)                                            :text str)
# Line 98  Line 97 
97        (pack top-area        (pack top-area
98              (make-instance 'label) :fill t :expand t)              (make-instance 'label) :fill t :expand t)
99        (show-buttons top-area (car module)))        (show-buttons top-area (car module)))
100      (setf (has-separator dialog) nil)      ;(setf (has-separator dialog) nil)
101      (setf (gsignal dialog :delete-event      (setf (gsignal dialog :delete-event
102                     :data (cffi:convert-to-foreign (car module) 'gtk-string))                     :data (cffi:convert-to-foreign (car module) :string))
103            (cffi:callback on-delete)            (cffi:callback on-delete)
104            (gsignal dialog :key-press-event            (gsignal dialog :key-press-event
105                     :data (cffi:convert-to-foreign (car module) 'gtk-string))                     :data (cffi:convert-to-foreign (car module) :string))
106            (cffi:callback on-key))            (cffi:callback on-key))
107      dialog))      dialog))
108    
# Line 115  Line 114 
114                  (setup-app module))) *mods*)                  (setup-app module))) *mods*)
115    
116  (let ((main-dialog (gethash "main" *apps*)))  (let ((main-dialog (gethash "main" *apps*)))
117    ;(show main-dialog :all t)    (show main-dialog :all t)
118    (run main-dialog)    (run main-dialog)
119    (format t "here end~%")    (format t "here end~%")
120    (destroy main-dialog))    (destroy main-dialog))
121    
122    ;; Cleanup after dialog
123    (g-object-cffi::timeout-add :idle #'gtk-main-quit)
124    (gtk-main)
125    
126  ;(setf window (make-instance 'window))  ;(setf window (make-instance 'window))
127    
128  ;(set-border-width window 6)  ;(set-border-width window 6)

Legend:
Removed from v.1.1.1.1  
changed lines
  Added in v.1.6

  ViewVC Help
Powered by ViewVC 1.1.5