[gtk-cffi-cvs] CVS gtk-cffi/examples
CVS User rklochkov
rklochkov at common-lisp.net
Fri Aug 26 17:16:13 UTC 2011
Update of /project/gtk-cffi/cvsroot/gtk-cffi/examples
In directory tiger.common-lisp.net:/tmp/cvs-serv16215/examples
Modified Files:
ex1-new.lisp ex1.lisp ex2.lisp ex3-flash-button.lisp ex4.lisp
ex5.lisp ex7.lisp load-1c-txt.lisp
Added Files:
editor.lisp ex9.lisp paned.lisp
Log Message:
Added GTK3 support. Dropped GTK2 support.
Refactored CFFI layer.
--- /project/gtk-cffi/cvsroot/gtk-cffi/examples/ex1-new.lisp 2011/04/25 19:16:08 1.1.1.1
+++ /project/gtk-cffi/cvsroot/gtk-cffi/examples/ex1-new.lisp 2011/08/26 17:16:13 1.2
@@ -5,11 +5,16 @@
(in-package #:test-ex1n)
(gtk-init)
-(defvar *window*
+(defparameter *window*
(gtk-model
'window :width 80
:title "Hello world!"
- :signals '(:destroy :gtk-main-quit)
+ :signals `(:destroy
+ :gtk-main-quit
+ :enter-notify-event
+ ,(lambda (widget event)
+ (declare (ignore widget event))
+ (format t "Entered~%")))
('button :label "Hello!"
:signals (list :clicked
(let ((count 0))
--- /project/gtk-cffi/cvsroot/gtk-cffi/examples/ex1.lisp 2011/04/25 19:16:08 1.1.1.1
+++ /project/gtk-cffi/cvsroot/gtk-cffi/examples/ex1.lisp 2011/08/26 17:16:13 1.2
@@ -1,7 +1,7 @@
(asdf:oos 'asdf:load-op :gtk-cffi)
(defpackage #:test-ex1
- (:use #:common-lisp #:gtk-cffi #:g-object-cffi))
+ (:use #:common-lisp #:gtk-cffi #:g-object-cffi #:cffi))
(in-package #:test-ex1)
(cffi:defcallback hello :void ((widget pobject) (data pdata))
@@ -14,9 +14,9 @@
(setf window (make-instance 'window :name "Example 1"))
-(setf (bg-pixmap window) "/usr/share/pixmaps/gqview.png")
+;(setf (bg-pixmap window) "/usr/share/pixmaps/gqview.png")
-(setf (property window :resize-mode) :immediate)
+;(setf (property window :resize-mode) :immediate)
(setf (gsignal window "delete-event")
(let ((i 0))
@@ -30,19 +30,22 @@
(setf (gsignal window :destroy) :gtk-main-quit)
+
(setf (border-width window) 25)
(setf (default-size window) '(400 100))
-(setf button (make-instance 'button :label "gtk-index" :type :stock))
+;(setf button (make-instance 'button :label "gtk-ok" :type :stock))
-(setf (font button) "Times New Roman Italic 24")
+(setf button (make-instance 'button :pointer (gtk-cffi::gtk-button-new-from-stock "gtk-ok")))
+
+;(setf (color button :type :bg) "red")
(setf (color button) "#0000ff")
+(setf (font button) "Times New Roman Italic 24")
(setf (gsignal button :clicked :data "Медвед") (cffi:callback hello)
- (gsignal button "clicked" :data window
- :swapped t) "gtk-widget-destroy")
+ (gsignal button "clicked" :data window :swapped t) "gtk-widget-destroy")
(add window button)
--- /project/gtk-cffi/cvsroot/gtk-cffi/examples/ex2.lisp 2011/08/08 15:02:01 1.2
+++ /project/gtk-cffi/cvsroot/gtk-cffi/examples/ex2.lisp 2011/08/26 17:16:13 1.3
@@ -23,7 +23,7 @@
(show (gethash activated-module *apps*) :all t)
(mapcar (lambda (module)
(unless (string= activated-module (car module))
- (hide (gethash (car module) *apps*) :all t)))
+ (hide (gethash (car module) *apps*))))
*mods*)
(run (gethash activated-module *apps*)))
@@ -79,10 +79,10 @@
(defun setup-app (module)
(let ((dialog (make-instance 'dialog :title (car module) :flags :modal)))
- (setf (win-position dialog) :center-always)
+ (setf (window-position dialog) :center-always)
(setf (size-request dialog) (second module))
;(setf (property dialog :content-area-border) 10)
- (let ((top-area (v-box dialog)))
+ (let ((top-area (content-area dialog)))
(flet ((print-out (str)
(pack top-area (make-instance 'label
:text str)
@@ -98,7 +98,7 @@
(pack top-area
(make-instance 'label) :fill t :expand t)
(show-buttons top-area (car module)))
- (setf (has-separator dialog) nil)
+ ;(setf (has-separator dialog) nil)
(setf (gsignal dialog :delete-event
:data (cffi:convert-to-foreign (car module) 'gtk-string))
(cffi:callback on-delete)
--- /project/gtk-cffi/cvsroot/gtk-cffi/examples/ex3-flash-button.lisp 2011/04/25 19:16:08 1.1.1.1
+++ /project/gtk-cffi/cvsroot/gtk-cffi/examples/ex3-flash-button.lisp 2011/08/26 17:16:13 1.2
@@ -31,7 +31,7 @@
(setf button (make-instance 'button :label "Click Me!"))
(setf (size-request button) '(80 32)
- (color button :bg) "#FFCC66")
+ (color button :background t) "#FFCC66")
(defvar *TIMEOUT*)
@@ -46,11 +46,11 @@
(realize window)
-(defparameter *ORG-BG* (color window :bg))
+(defparameter *ORG-BG* (color window :background t))
(let (i)
(defun flash (button bgcolor)
- (setf (color button :bg) (if i *ORG-BG* bgcolor))
+ (setf (color button :background t) (if i *ORG-BG* bgcolor))
(setf i (not i)) t))
(setf *TIMEOUT* (timeout-add 200 #'flash :data (list button "#FFCC66")))
--- /project/gtk-cffi/cvsroot/gtk-cffi/examples/ex4.lisp 2011/04/25 19:16:08 1.1.1.1
+++ /project/gtk-cffi/cvsroot/gtk-cffi/examples/ex4.lisp 2011/08/26 17:16:13 1.2
@@ -1,7 +1,7 @@
(asdf:oos 'asdf:load-op :gtk-cffi)
-(declaim (optimize speed))
+;(declaim (optimize speed))
(defpackage #:test
- (:use #:common-lisp #:gtk-cffi #:gobject-cffi))
+ (:use #:common-lisp #:gtk-cffi #:g-object-cffi))
(in-package #:test)
(defun main ()
@@ -18,11 +18,12 @@
(setf (font title) "Times New Roman Italic 10"
(color title) "#0000ff")
(setf (size-request title) '(-1 40))
- (pack v-box title))
+ (pack v-box title :expand nil))
(pack v-box (make-instance
- 'label :text "Click on the options on the left pane."))
- (pack v-box (make-instance 'label))
+ 'label :text "Click on the options on the left pane.")
+ :expand nil)
+ (pack v-box (make-instance 'label) :expand nil)
(pack v-box hpane :fill t :expand t))
(let ((left-pane (make-instance 'frame))
@@ -49,7 +50,7 @@
(setf data (append data data))
(setf (shadow-type right-pane) :in)
- (pack hpane right-pane :type 2 :resize t)
+ (pack hpane right-pane :pane-type 2 :resize t)
(format t "parent of ~a is ~a~%" right-pane
(property right-pane :parent))
(display-table right-pane data))
@@ -57,9 +58,14 @@
(show window :all t)
(gtk-main)))
+(defvar *model*)
+(defvar *modelfilter1*)
+(defvar *modelfilter2*)
+(defvar *view*)
+
(defun display-table (container data)
- (defparameter *model*
+ (setf *model*
(make-instance 'list-store :columns
'(:string :string :long :double
:boolean :boolean ; filters
@@ -67,15 +73,15 @@
:string ; third column
)))
- (defparameter *modelfilter1*
+ (setf *modelfilter1*
(make-instance 'tree-model-filter :model *model*))
(setf (visible-column *modelfilter1*) 4)
- (defparameter *modelfilter2*
+ (setf *modelfilter2*
(make-instance 'tree-model-filter :model *model*))
(setf (visible-column *modelfilter2*) 5)
- (defparameter *view*
+ (setf *view*
(make-instance 'tree-view :model *model*))
(let ((scrolled-win (make-instance 'scrolled-window)))
@@ -104,9 +110,8 @@
(setf (widget column) label)
(show label))
(if (/= col 0) (setf (reorderable column) t))
- (set-cell-data-func column cell-renderer
- (cffi:callback format-col)
- col)
+ (setf (cell-data-func column cell-renderer col)
+ (cffi:callback format-col))
(append-column *view* column)))))
(setf (gsignal *model* :rows-reordered) (cffi:callback reorder))
@@ -119,7 +124,7 @@
(if (= (mod row 2) 1)
"#dddddd" "#ffffff")
(format nil "$~,2f" (fourth values)))))
- (append-values *model* values)))
+ (append-values *model* values)))
(let ((selection (get-selection *view*)))
(setf (mode selection) :multiple)
@@ -129,12 +134,12 @@
;(format t "signals selection: ~a~%" (signals selection))
(format t "signals selection2: ~a~%" (gsignal selection :changed))
;(setf (gsignal selection :changed) nil)
- (format t "signals deleted: ~a~%" (signals selection))
+ ;(format t "signals deleted: ~a~%" (gsignals selection))
;(set-signal (get-selection *view*) :changed (cffi:callback on-selection))
))
+(defparameter *create-link-i* 0)
(defun create-link (str)
- (defvar *create-link-i* 0)
(let ((event-box (make-instance 'event-box))
(label (make-instance 'label
:text (format nil " ~a. ~a "
@@ -166,7 +171,7 @@
;; model iter)) :int 0)))
;(row-num (parse-integer (gtk-cffi::iter-string model iter))))
- (row-num (get-index (iter-path model iter))))
+ (row-num (get-index (iter->path model iter))))
; (format t "~a ~a ~a~%" row-num col-num cell-ptr)
;(format t "~a ~a ~a ~a ~a~%" column cell model iter col-num)
@@ -177,8 +182,9 @@
(if (= col-num 3)
(setf (property cell :text)
(format nil "$~,2f"
- (car (model-values model iter
- 3)))))
+ (car (model-values model
+ :iter iter
+ :col 3)))))
; (if (and (= col-num 2) (> (cadr vals) 10))
; (p-set cell :visible nil)
; (p-set cell :visible t)))
@@ -201,44 +207,44 @@
;; (when p (set-color m p iter data))))))))
(defun reformat-rows (model)
- (tree-model-foreach
+ (gtk-cffi::foreach
model
(lambda (model path iter data)
(let ((row-num (get-index path)))
- (setf (model-values model iter 6)
+ (setf (model-values model :iter iter :col 6)
(list (if (= (mod row-num 2) 1)
- "#dddddd" "#ffffff")))))))
+ "#dddddd" "#ffffff")))))))
-(cffi:defcallback reorder :void ((model-ptr pobject)))
-; (reformat-rows model-ptr))
+(cffi:defcallback reorder :void ((model-ptr pobject))
+ (reformat-rows model-ptr))
(cffi:defcallback link-clicked
- :boolean ((widget :pointer)
- (event :pointer)
- (str pdata))
- (let* ((model (cond
- ((string= str "Show All") *model*)
- ((string= str "Qty > 10") *modelfilter1*)
- ((string= str "Price < $10")
- *modelfilter2*))))
- (format t "link clicked: ~a~%" str)
- (when model
- (setf (model *view*) model)
- ;(reformat-rows model)
- (setf (property *view* :headers-clickable)
- (typep model 'list-store)))))
-
+ :boolean ((widget :pointer)
+ (event :pointer)
+ (str pdata))
+ (let* ((model (cond
+ ((string= str "Show All") *model*)
+ ((string= str "Qty > 10") *modelfilter1*)
+ ((string= str "Price < $10")
+ *modelfilter2*))))
+ (format t "link clicked: ~a~%" str)
+ (when model
+ (setf (model *view*) model)
+ (reformat-rows model)
+ (setf (property *view* :headers-clickable)
+ (typep model 'list-store)))))
+
(cffi:defcallback on-selection
- :void ((selection-ptr pobject)
- (data-ptr :pointer))
- (with-selection selected selection-ptr
- (when selected
- (format
- t "You have selected ~a~%"
- (apply #'model-values
- `(,@(subseq selected 0 2)
- 1 2 7))))))
+ :void ((selection-ptr pobject)
+ (data-ptr :pointer))
+ (with-selection selected selection-ptr
+ (when selected
+ (format
+ t "You have selected ~a~%"
+ (model-values (first selected)
+ :iter (second selected)
+ :columns '(1 2 7))))))
-(main)
\ No newline at end of file
+(main)
--- /project/gtk-cffi/cvsroot/gtk-cffi/examples/ex5.lisp 2011/08/08 15:02:01 1.2
+++ /project/gtk-cffi/cvsroot/gtk-cffi/examples/ex5.lisp 2011/08/26 17:16:13 1.3
@@ -6,14 +6,14 @@
(gtk-init)
-(setf window (make-instance 'window))
+(let ((window (make-instance 'window)))
-(setf (gsignal window :destroy) :gtk-main-quit
- (size-request window) '(400 150))
+ (setf (gsignal window :destroy) :gtk-main-quit
+ (size-request window) '(400 150))
+
+ (setf (bg-pixmap window) "/usr/share/pixmaps/gnome-color-browser.png")
-(setf (bg-pixmap window :normal) "/usr/share/pixmaps/gnome-color-browser.png")
-
-(show window)
+ (show window))
(gtk-main)
\ No newline at end of file
--- /project/gtk-cffi/cvsroot/gtk-cffi/examples/ex7.lisp 2011/08/08 15:02:01 1.2
+++ /project/gtk-cffi/cvsroot/gtk-cffi/examples/ex7.lisp 2011/08/26 17:16:13 1.3
@@ -29,7 +29,7 @@
(let ((title (make-instance 'label :text "Use of GtkCellEditable")))
(setf (font title) "Times New Roman Italic 12"
(color title) "#0000ff"
- (color title :bg) "#ff0000")
+ (color title :type :bg) "#ff0000")
;(setf (size-request title) '(-1 40))
(pack v-box title))
@@ -37,7 +37,7 @@
'(:string :string)))
(frame (make-instance 'frame))
(view (make-instance 'tree-view :model model)))
- ;(setf (color view :base :selected) "#ff0000")
+ (setf (color view :state :selected) "#ff0000")
(pack v-box frame :pack-fill nil :expand t)
(pack v-box (make-instance 'label) :pack-fill t :expand t)
(add frame view)
@@ -98,7 +98,7 @@
(defun set-bold (view column)
(format t "set ~A~%" column)
(loop :for col :in (columns view)
- :for i :from 0 :to 100
+ :for i :from 0 :to (length (columns view))
:do (progn
(setf (font (widget col))
(if (equal col column)
@@ -120,10 +120,10 @@
(iter (path->iter (model view) path)))
(setf (text (buffer text-view))
(car (model-values (model view) :columns '(1) :iter iter)))
- (let ((top-area (v-box dialog)))
+ (let ((top-area (content-area dialog)))
(pack top-area text-view :pack-fill t :expand t)
(show text-view))
- (setf (win-position dialog) :center-on-parent)
+ (setf (window-position dialog) :center-on-parent)
;(pack top-area text-view :fill t :expand t))
(run dialog)
--- /project/gtk-cffi/cvsroot/gtk-cffi/examples/load-1c-txt.lisp 2011/04/25 19:16:08 1.1.1.1
+++ /project/gtk-cffi/cvsroot/gtk-cffi/examples/load-1c-txt.lisp 2011/08/26 17:16:13 1.2
@@ -10,7 +10,9 @@
(make-instance 'list-store :columns '(:string :string :string :boolean)))
(defparameter *window* nil)
-(defconstant +space+ '(#\Space #\Tab #\Newline))
+(defconstant +space+
+ (if (boundp '+space+) +space+
+ '(#\Space #\Tab #\Newline)))
(defun empty (str)
(string=
@@ -109,6 +111,7 @@
(setf (text (object-by-id :filename)) (filename d)))
(destroy d)))
+;(import 'gtk-cffi::expand)
(setf *window*
(gtk-model
'window :width 800
@@ -133,7 +136,7 @@
:signals (list :file-set #'load-file)
:id :filename)
:expand t
- ('v-paned
+ ('v-paned :vexpand t
('scrolled-window
('tree-view :model *model*
:columns (list "Код ошибки" "ТекÑÑ‚"
@@ -146,8 +149,8 @@
(setf (text (buffer (object-by-id :text)))
(car (model-values model
:iter iter :col 2))))))
- ('scrolled-window
- ('text-view :id :text))))))
+ ('scrolled-window :vexpand t
+ ('text-view :id :text :vexpand t))))))
(show *window* :all t)
--- /project/gtk-cffi/cvsroot/gtk-cffi/examples/editor.lisp 2011/08/26 17:16:13 NONE
+++ /project/gtk-cffi/cvsroot/gtk-cffi/examples/editor.lisp 2011/08/26 17:16:13 1.1
(asdf:oos 'asdf:load-op :gtk-cffi)
(defpackage #:editor
(:use #:common-lisp #:gtk-cffi #:g-object-cffi))
(in-package #:editor)
(gtk-init)
(defparameter *window*
(gtk-model
'window :signals '(:destroy :gtk-main-quit)
:width 400 :height 400
('h-box
:expand nil
; ('h-paned
('scrolled-window
('tree-view))
:expand t
('v-box
:expand nil
('label :text "12323")
:expand t
('scrolled-window
('text-view :id :text2)))
('scrolled-window
('text-view :id :text3)))))
;(setf ;(text (buffer (object-by-id :text1))) "1"
; (text (buffer (object-by-id :text2))) "2"
; (text (buffer (object-by-id :text3))) "3")
(show *window*)
(gtk-main)
--- /project/gtk-cffi/cvsroot/gtk-cffi/examples/ex9.lisp 2011/08/26 17:16:13 NONE
+++ /project/gtk-cffi/cvsroot/gtk-cffi/examples/ex9.lisp 2011/08/26 17:16:13 1.1
(asdf:oos 'asdf:load-op :gtk-cffi)
;(declaim (optimize speed))
(defpackage #:test
(:use #:common-lisp #:iter #:gtk-cffi #:g-object-cffi))
(in-package #:test)
(gtk-init)
(defparameter *model*
(make-instance 'lisp-model
:implementation
(make-instance 'lisp-model-array
:array #((1) (2) (3))
:columns '(:string :int))))
;:array #(("ok" 1))
;:columns '(:string :int))))
(defparameter *model0*
(make-instance 'list-store :columns '(:int)))
(append-values *model0* '(1))
(append-values *model0* '(2))
(append-values *model0* '(3))
(let ((arr (make-array 0 :adjustable t :fill-pointer 0)))
(iter (for i from 1 to 100000)
(vector-push-extend (list (format nil "str ~a" i) i) arr))
(setf (gtk-cffi::larray (gtk-cffi::implementation *model*)) arr))
(defparameter *window*
(gtk-model
'window :width 400
:height 400
:signals '(:destroy :gtk-main-quit)
('scrolled-window
('tree-view :model *model* :columns '("Test str" "Test int"))))); "Test int"))))
(show *window*)
(gtk-main)
--- /project/gtk-cffi/cvsroot/gtk-cffi/examples/paned.lisp 2011/08/26 17:16:13 NONE
+++ /project/gtk-cffi/cvsroot/gtk-cffi/examples/paned.lisp 2011/08/26 17:16:13 1.1
(asdf:oos 'asdf:load-op :gtk-cffi)
(defpackage :test-paned
(:use #:common-lisp #:gtk-cffi))
(in-package :test-paned)
(gtk-init)
;; GtkWidget *hpaned = gtk_paned_new (GTK_ORIENTATION_HORIZONTAL);
;; GtkWidget *frame1 = gtk_frame_new (NULL);
;; GtkWidget *frame2 = gtk_frame_new (NULL);
;; gtk_frame_set_shadow_type (GTK_FRAME (frame1), GTK_SHADOW_IN);
;; gtk_frame_set_shadow_type (GTK_FRAME (frame2), GTK_SHADOW_IN);
;; gtk_widget_set_size_request (hpaned, 200, -1);
;; gtk_paned_pack1 (GTK_PANED (hpaned), frame1, TRUE, FALSE);
;; gtk_widget_set_size_request (frame1, 50, -1);
;; gtk_paned_pack2 (GTK_PANED (hpaned), frame2, FALSE, FALSE);
;; gtk_widget_set_size_request (frame2, 50, -1);
(let ((window (make-instance 'window :width 200 :height 200
:signals '(:destroy :gtk-main-quit)))
(hpaned (make-instance 'h-paned))
(frame1 (make-instance 'frame))
(frame2 (make-instance 'frame)))
(setf (shadow-type frame1) :in
(shadow-type frame2) :in
(size-request hpaned) '(200 -1))
(pack hpaned frame1 :pane-type 1 :resize t :shrink nil)
(setf (size-request frame1) '(50 -1))
(pack hpaned frame2 :resize nil :shrink nil)
(setf (size-request frame2) '(50 -1))
(add window hpaned)
(show window)
(gtk-main))
More information about the gtk-cffi-cvs
mailing list