[gtk-cffi-cvs] CVS gtk-cffi/examples
CVS User rklochkov
rklochkov at common-lisp.net
Sun Oct 7 12:02:11 UTC 2012
Update of /project/gtk-cffi/cvsroot/gtk-cffi/examples
In directory tiger.common-lisp.net:/tmp/cvs-serv28209/examples
Modified Files:
ex1.lisp ex3-flash-button.lisp ex4.lisp ex5.lisp ex7.lisp
ex9.lisp
Log Message:
Fixed examples. Changed cell properties for tree-column to be set as :attributes
Fixed double init in g-value.
--- /project/gtk-cffi/cvsroot/gtk-cffi/examples/ex1.lisp 2011/08/26 17:16:13 1.2
+++ /project/gtk-cffi/cvsroot/gtk-cffi/examples/ex1.lisp 2012/10/07 12:02:10 1.3
@@ -31,15 +31,15 @@
(setf (gsignal window :destroy) :gtk-main-quit)
-(setf (border-width window) 25)
+;(setf (border-width window) 25)
-(setf (default-size window) '(400 100))
+;(setf (default-size window) '(400 100))
;(setf button (make-instance 'button :label "gtk-ok" :type :stock))
(setf button (make-instance 'button :pointer (gtk-cffi::gtk-button-new-from-stock "gtk-ok")))
-;(setf (color button :type :bg) "red")
+(setf (color button :type :bg) "red")
(setf (color button) "#0000ff")
(setf (font button) "Times New Roman Italic 24")
--- /project/gtk-cffi/cvsroot/gtk-cffi/examples/ex3-flash-button.lisp 2011/08/26 17:16:13 1.2
+++ /project/gtk-cffi/cvsroot/gtk-cffi/examples/ex3-flash-button.lisp 2012/10/07 12:02:10 1.3
@@ -31,7 +31,7 @@
(setf button (make-instance 'button :label "Click Me!"))
(setf (size-request button) '(80 32)
- (color button :background t) "#FFCC66")
+ (color button :type :bg) "#FFCC66")
(defvar *TIMEOUT*)
@@ -46,11 +46,11 @@
(realize window)
-(defparameter *ORG-BG* (color window :background t))
+(defparameter *ORG-BG* (color window :type :bg))
(let (i)
(defun flash (button bgcolor)
- (setf (color button :background t) (if i *ORG-BG* bgcolor))
+ (setf (color button :type :bg) (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 2012/05/07 09:02:03 1.3
+++ /project/gtk-cffi/cvsroot/gtk-cffi/examples/ex4.lisp 2012/10/07 12:02:11 1.4
@@ -91,7 +91,7 @@
(add scrolled-win *view*))
(let ((field-header '("Row #" "Description" "Qty" "Price"))
- (field-justification '(0 0 .5 1)))
+ (field-justification '(0.0 0.0 .5 1.0)))
(loop :for col :from 0 :below (length field-header) :do
(let ((cell-renderer (make-instance 'cell-renderer-text)))
(setf (property cell-renderer :xalign)
@@ -99,8 +99,10 @@
(let ((column (make-instance 'tree-view-column
:title (nth col field-header)
:cell cell-renderer
- :text (if (= col 3) 7 col))))
-; :cell-background 6)))
+ :attributes
+ (list
+ "text" (if (= col 3) 7 col)
+ :cell-background 6))))
(setf (alignment column) (nth col field-justification))
(setf (sort-column-id column) col)
@@ -126,9 +128,9 @@
"#dddddd" "#ffffff")
(format nil "$~,2f" (fourth values)))))
(append-values *model* values)))
-
- (let ((selection (get-selection *view*)))
- (setf (mode selection) :multiple)
+ (format t "Num rows: ~a~%" (iter-n-children *model* nil))
+ (let ((selection (selection *view*)))
+ ;(setf (mode selection) :multiple)
(format t "mode: ~a~%" (mode selection))
;(format t "read mode: ~a~%" (gtk-cffi::gtk-tree-selection-get-mode selection))
(setf (gsignal selection :changed) (cffi:callback on-selection))
@@ -159,39 +161,40 @@
event-box)))
(cffi:defcallback format-col
- :void ((column pobject) (cell pobject)
- (model pobject) (iter-ptr :pointer)
- (col-num pdata))
- ;(declare (optimize speed))
- ;(format t
- ; "~A ~A ~A ~A ~A~%" column cell model iter col-num)
- (let* ((iter (make-instance 'tree-iter :pointer iter-ptr))
- ;; (row-num (cffi:mem-aref
-;; (gtk-cffi::gtk-tree-path-get-indices
-;; (gtk-cffi::gtk-tree-model-get-path
-;; model iter)) :int 0)))
+ :void ((column pobject) (cell pobject)
+ (model pobject) (iter-ptr :pointer)
+ (col-num pdata))
+ (declare (ignore column))
+ ;;(declare (optimize speed))
+ ;;(format t
+ ;; "~A ~A ~A ~A ~A~%" column cell model iter col-num)
+ (let* ((iter (make-instance 'tree-iter :pointer iter-ptr))
+ ;; (row-num (cffi:mem-aref
+ ;; (gtk-cffi::gtk-tree-path-get-indices
+ ;; (gtk-cffi::gtk-tree-model-get-path
+ ;; model iter)) :int 0)))
- ;(row-num (parse-integer (gtk-cffi::iter-string model iter))))
- (row-num (get-index (iter->path model iter))))
-; (format t "~a ~a ~a~%" row-num col-num cell-ptr)
+ ;;(row-num (parse-integer (gtk-cffi::iter-string model iter))))
+ (row-num (aref (iter->path model iter) 0)))
+ ;; (format t "~a ~a ~a~%" row-num col-num cell-ptr)
- ;(format t "~a ~a ~a ~a ~a~%" column cell model iter col-num)
-; (let ((vals (get-values model iter
-; 3 :double
-; 2 :long)))
- ; (format t "~a ~a ~a~%" cell col-num vals)
- (if (= col-num 3)
- (setf (property cell :text)
- (format nil "$~,2f"
- (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)))
- (setf (property cell :cell-background)
- (if (= (mod row-num 2) 1) "#dddddd" "#ffffff"))
- (setf (property cell :alignment) :left)))
+ ;;(format t "~a ~a ~a ~a ~a~%" column cell model iter col-num)
+ ;; (let ((vals (get-values model iter
+ ;; 3 :double
+ ;; 2 :long)))
+ ;; (format t "~a ~a ~a~%" cell col-num vals)
+ (if (= col-num 3)
+ (setf (property cell :text)
+ (format nil "$~,2f"
+ (car (model-values model
+ :tree-iter iter
+ :column 3)))))
+ ;; (if (and (= col-num 2) (> (cadr vals) 10))
+ ;; (p-set cell :visible nil)
+ ;; (p-set cell :visible t)))
+ (setf (property cell :cell-background)
+ (if (= (mod row-num 2) 1) "#dddddd" "#ffffff"))
+ (setf (property cell :alignment) :left)))
;; (defun reformat-rows (model)
@@ -208,13 +211,14 @@
;; (when p (set-color m p iter data))))))))
(defun reformat-rows (model)
- (gtk-cffi::foreach
- model
- (lambda (model path iter data)
- (let ((row-num (get-index path)))
- (setf (model-values model :iter iter :col 6)
- (list (if (= (mod row-num 2) 1)
- "#dddddd" "#ffffff")))))))
+ (foreach
+ model
+ (lambda (model path iter data)
+ (declare (ignore data))
+ (let ((row-num (aref path 0)))
+ (setf (model-values model :tree-iter iter :column 6)
+ (list (if (= (mod row-num 2) 1)
+ "#dddddd" "#ffffff")))))))
(cffi:defcallback reorder :void ((model-ptr pobject))
@@ -224,11 +228,12 @@
: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*))))
+ (declare (ignore widget event))
+ (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)
@@ -238,14 +243,15 @@
(cffi:defcallback on-selection
- :void ((selection-ptr pobject)
+ :void ((selection pobject)
(data-ptr :pointer))
- (with-selection selected selection-ptr
- (when selected
+ (declare (ignore data-ptr))
+ (multiple-value-bind (tree-iter model) (selected selection)
+ (when tree-iter
(format
t "You have selected ~a~%"
- (model-values (first selected)
- :iter (second selected)
+ (model-values model
+ :tree-iter tree-iter
:columns '(1 2 7))))))
(main)
--- /project/gtk-cffi/cvsroot/gtk-cffi/examples/ex5.lisp 2011/08/26 17:16:13 1.3
+++ /project/gtk-cffi/cvsroot/gtk-cffi/examples/ex5.lisp 2012/10/07 12:02:11 1.4
@@ -12,7 +12,7 @@
(size-request window) '(400 150))
- (setf (bg-pixmap window) "/usr/share/pixmaps/gnome-color-browser.png")
+ (setf (bg-pixmap window) "/usr/share/pixmaps/gnome-about-logo.png")
(show window))
--- /project/gtk-cffi/cvsroot/gtk-cffi/examples/ex7.lisp 2012/07/29 15:13:59 1.7
+++ /project/gtk-cffi/cvsroot/gtk-cffi/examples/ex7.lisp 2012/10/07 12:02:11 1.8
@@ -48,7 +48,7 @@
(column (make-instance 'tree-view-column
:title (nth col field-header);""
:cell cell-renderer
- :text col)))
+ :attributes `(:text ,col))))
(let ((label (make-instance 'label
:text (nth col field-header))))
(setf (font label) "Arial")
@@ -69,7 +69,7 @@
(declare (ignore cell))
(format t "path: ~a new-text:~a~%" path new-text)
(path->iter model path)
- (setf (model-values model :col %col)
+ (setf (model-values model :column %col)
(list new-text)))))
(append-column view column))))
--- /project/gtk-cffi/cvsroot/gtk-cffi/examples/ex9.lisp 2012/05/07 09:02:03 1.4
+++ /project/gtk-cffi/cvsroot/gtk-cffi/examples/ex9.lisp 2012/10/07 12:02:11 1.5
@@ -1,5 +1,5 @@
(asdf:oos 'asdf:load-op :gtk-cffi-ext)
-;(declaim (optimize speed))
+(declaim (optimize speed))
(defpackage #:test9
(:use #:common-lisp #:iter #:gtk-cffi #:gtk-cffi-ext #:g-object-cffi))
(in-package #:test9)
@@ -22,7 +22,7 @@
(append-values *model0* '(3))
(let ((arr (make-array 0 :adjustable t :fill-pointer 0)))
- (iter (for i from 1 to 100000)
+ (iter (for i from 1 to 100000) ;; benchmark
(vector-push-extend (list (format nil "str ~a" i) i) arr))
(setf (larray (implementation *model*)) arr))
@@ -34,7 +34,7 @@
('scrolled-window
('tree-view :model *model* :columns '("Test str" "Test int"))))); "Test int"))))
-;(show *window*)
-(show #(1 2 3 4 5))
+(show *window*)
+;(show #(1 2 3 4 5))
(gtk-main)
More information about the gtk-cffi-cvs
mailing list