cells-cvs

cells-cvs@common-lisp.net

721 discussions

[cells-cvs] CVS cells
by phildebrandt 21 May '08

21 May '08

Update of /project/cells/cvsroot/cells In directory clnet:/tmp/cvs-serv12895 Modified Files: defmodel.lisp Log Message: added an eval-now! in defmodel to suppress SBCL warnings --- /project/cells/cvsroot/cells/defmodel.lisp 2008/04/23 03:20:09 1.20 +++ /project/cells/cvsroot/cells/defmodel.lisp 2008/05/21 10:46:52 1.21 @@ -54,73 +54,74 @@ ; ------- defclass --------------- (^slot-value ,model ',',slotname) ; - (prog1 - (defclass ,class ,(or directsupers '(model-object)) ;; now we can def the class - ,(mapcar (lambda (s) - (list* (car s) - (let ((ias (cdr s))) - (remf ias :persistable) - (remf ias :ps) - ;; We handle accessor below - (when (getf ias :cell t) - (remf ias :reader) - (remf ias :writer) - (remf ias :accessor)) - (remf ias :cell) - (remf ias :owning) - (remf ias :unchanged-if) - ias))) (mapcar #'copy-list slotspecs)) - (:documentation - ,@(or (cdr (find :documentation options :key #'car)) - '("chya"))) - (:default-initargs ;; nil ok and needed: acl oddity in re not clearing d-i's sans this - ,@(cdr (find :default-initargs options :key #'car))) - (:metaclass ,(or (cadr (find :metaclass options :key #'car)) - 'standard-class))) + (eval-now! ;; suppress style warning in SBCL + (prog1 + (defclass ,class ,(or directsupers '(model-object)) ;; now we can def the class + ,(mapcar (lambda (s) + (list* (car s) + (let ((ias (cdr s))) + (remf ias :persistable) + (remf ias :ps) + ;; We handle accessor below + (when (getf ias :cell t) + (remf ias :reader) + (remf ias :writer) + (remf ias :accessor)) + (remf ias :cell) + (remf ias :owning) + (remf ias :unchanged-if) + ias))) (mapcar #'copy-list slotspecs)) + (:documentation + ,@(or (cdr (find :documentation options :key #'car)) + '("chya"))) + (:default-initargs ;; nil ok and needed: acl oddity in re not clearing d-i's sans this + ,@(cdr (find :default-initargs options :key #'car))) + (:metaclass ,(or (cadr (find :metaclass options :key #'car)) + 'standard-class))) - (defmethod shared-initialize :after ((self ,class) slot-names &rest iargs &key) - (declare (ignore slot-names iargs)) - ,(when (and directsupers (not (member 'model-object directsupers))) - `(unless (typep self 'model-object) - (error "If no superclass of ~a inherits directly + (defmethod shared-initialize :after ((self ,class) slot-names &rest iargs &key) + (declare (ignore slot-names iargs)) + ,(when (and directsupers (not (member 'model-object directsupers))) + `(unless (typep self 'model-object) + (error "If no superclass of ~a inherits directly or indirectly from model-object, model-object must be included as a direct super-class in the defmodel form for ~a" ',class ',class)))) - ; - ; slot accessors once class is defined... - ; - ,@(mapcar (lambda (slotspec) - (destructuring-bind - (slotname &rest slotargs - &key (cell t) owning unchanged-if (accessor slotname) reader writer type - &allow-other-keys) - slotspec + ; + ; slot accessors once class is defined... + ; + ,@(mapcar (lambda (slotspec) + (destructuring-bind + (slotname &rest slotargs + &key (cell t) owning unchanged-if (accessor slotname) reader writer type + &allow-other-keys) + slotspec - (declare (ignorable slotargs)) - (when cell - (let* ((reader-fn (or reader accessor)) - (writer-fn (or writer accessor)) - ) - `(eval-when (#-sbcl :compile-toplevel :load-toplevel :execute) ; ph -- prevent sbcl warning - (setf (md-slot-cell-type ',class ',slotname) ,cell) - ,(when owning - `(setf (md-slot-owning-direct? ',class ',slotname) ,owning)) - ,(when reader-fn - `(defmethod ,reader-fn ((self ,class)) - (md-slot-value self ',slotname))) + (declare (ignorable slotargs)) + (when cell + (let* ((reader-fn (or reader accessor)) + (writer-fn (or writer accessor)) + ) + `(eval-when (#-sbcl :compile-toplevel :load-toplevel :execute) ; ph -- prevent sbcl warning + (setf (md-slot-cell-type ',class ',slotname) ,cell) + ,(when owning + `(setf (md-slot-owning-direct? ',class ',slotname) ,owning)) + ,(when reader-fn + `(defmethod ,reader-fn ((self ,class)) + (md-slot-value self ',slotname))) - ,(when writer-fn - `(defmethod (setf ,writer-fn) (new-value (self ,class)) - (setf (md-slot-value self ',slotname) - ,(if type - `(coerce new-value ',type) - 'new-value)))) + ,(when writer-fn + `(defmethod (setf ,writer-fn) (new-value (self ,class)) + (setf (md-slot-value self ',slotname) + ,(if type + `(coerce new-value ',type) + 'new-value)))) - ,(when unchanged-if - `(def-c-unchanged-test (,class ,slotname) ,unchanged-if)) - ) - )) - )) - slotspecs)))) + ,(when unchanged-if + `(def-c-unchanged-test (,class ,slotname) ,unchanged-if)) + ) + )) + )) + slotspecs))))) (defun defmd-canonicalize-slot (slotname &key

1 0

[cells-cvs] CVS cells-gtk3/cells-gtk
by phildebrandt 19 May '08

19 May '08

Update of /project/cells/cvsroot/cells-gtk3/cells-gtk In directory clnet:/tmp/cvs-serv30171/cells-gtk Modified Files: gtk-app.lisp Log Message: Ingo's non-threading patch. --- /project/cells/cvsroot/cells-gtk3/cells-gtk/gtk-app.lisp 2008/05/19 10:18:32 1.6 +++ /project/cells/cvsroot/cells-gtk3/cells-gtk/gtk-app.lisp 2008/05/19 10:26:06 1.7 @@ -157,10 +157,12 @@ (when close-all-windows (gtk-main-quit)) (when #+libcellsgtk (= 0 (gtk-adds-g-thread-supported)) ; init only once - #-libcellsgtk threading-initialized + #-libcellsgtk (not threading-initialized) (with-trcs - (g-thread-init +c-null+) ; init threading - (gdk-threads-init) + #+cells-gtk-threads + (progn + (g-thread-init +c-null+) ; init threading + (gdk-threads-init)) (assert (gtk-init-check +c-null+ +c-null+)) (gtk-init +c-null+ +c-null+) #+cells-gtk-opengl (gl-init)

1 0

[cells-cvs] CVS cells-gtk3/cells-gtk
by phildebrandt 19 May '08

19 May '08

Update of /project/cells/cvsroot/cells-gtk3/cells-gtk In directory clnet:/tmp/cvs-serv27464/cells-gtk Modified Files: cairo-drawing-area.lisp gtk-app.lisp widgets.lisp Log Message: With Ingo's utf-8 patch for clisp and cells-store support --- /project/cells/cvsroot/cells-gtk3/cells-gtk/cairo-drawing-area.lisp 2008/04/20 13:05:02 1.3 +++ /project/cells/cvsroot/cells-gtk3/cells-gtk/cairo-drawing-area.lisp 2008/05/19 10:18:32 1.4 @@ -509,7 +509,7 @@ (with-accessors ((mouse mouse-pos)) (widget self) (and (2d:point-in-box-p mouse (^p1) (^p2) :tol (^line-width)) (if (not (^filled)) - (not (2d:point-in-box-p mouse (^p1) (^p2) :tol (^line-width))) + (2d:point-in-box-p mouse (^p1) (^p2) :tol (^line-width)) t)))))) :no-redraw (mouse-over-p))) @@ -646,6 +646,8 @@ (^arrow-length)))))))) (defmodify arrow-line (arrow-angle arrow-length)) +(def-mk-primitive arrow-line (self initargs)) + ;;;; ----------------------------------------------------------- ;;;; event handlers ;;;; ----------------------------------------------------------- @@ -666,7 +668,7 @@ (setf (button-down-position self) pos) (case button (1 - (trc "button down on" (hover self)) + (trc nil "button down on" (hover self)) (bif (prim (hover self)) ;; prim --> select/toggle (with-slot-accessors (selection) self @@ -674,7 +676,7 @@ (if (contains-any '(:shift :control) state) ;; toggle if ctrl/shift (progn - (trc "CTRL/SHIFT -- toggeling" prim) + (trc nil "CTRL/SHIFT -- toggeling" prim) (if (selected-p prim) (setf selection (delete prim selection)) (push prim selection))) @@ -684,7 +686,7 @@ ;(deb "selection: ~a" selection))) ;; no prim --> draw a select box (progn - (trc "START SELECT-BOX") + (trc nil "START SELECT-BOX") (unless (contains-any '(:shift :control) state) (setf (selection self) nil)) (setf (select-box self) (mk-primitive self @@ -698,10 +700,10 @@ :fill-alpha .1)) (trc nil "select box is" (select-box self))))) (t (bwhen (box (select-box self)) - (trc "CANCEL SELECT-BOX") + (trc nil "CANCEL SELECT-BOX") (setf box (remove-primitive box))) (when (dragging self) - (trc "CANCEL DRAG") + (trc nil "CANCEL DRAG") (dolist (prim (selection self)) (setf (dragged-p prim) nil)) (setf (dragging self) nil @@ -714,7 +716,7 @@ (cond ((dragging self) ;; this is the button release after a dragging event - (trc "FINISH DRAGGING") + (trc nil "FINISH DRAGGING") (with-slot-accessors (dragging on-dragged drag-offset drag-start selection) self (dolist (prim selection) ;; call on-dragged [widget] [button] [primitive] [start-pos] [end-pos] @@ -730,15 +732,15 @@ drag-start nil drag-offset nil))) ((select-box self) - (trc "FINISH SELECT-BOX") + (trc nil "FINISH SELECT-BOX") (with-slot-accessors (selection prims button-down-position select-box) self (dolist (prim prims) - (trc "checking" prim) + (trc nil "checking" prim) (and (selectable prim) (2d:point-in-box-p (c-o-g prim) button-down-position pos) (push prim selection) - (trc "--> selected " prim))) - (trc "selection is now" selection) + (trc nil "--> selected " prim))) + (trc nil "selection is now" selection) (setf select-box (remove-primitive select-box)))) (t (with-slot-accessors (selection hover) self (unless (contains-any '(:shift :control) state) @@ -760,7 +762,7 @@ ((bwhen (start-pos (button-down-position self)) (and (not (select-box self)) (> (2d:polar-radius (2d:v- start-pos pos)) (drag-threshold self)))) - (trc "START DRAGGING") + (trc nil "START DRAGGING") ;; initiate dragging (with-slot-accessors (drag-offset drag-start selection dragging) self (setf drag-offset (make-hash-table) --- /project/cells/cvsroot/cells-gtk3/cells-gtk/gtk-app.lisp 2008/04/20 13:05:02 1.5 +++ /project/cells/cvsroot/cells-gtk3/cells-gtk/gtk-app.lisp 2008/05/19 10:18:32 1.6 @@ -253,11 +253,14 @@ (gtk-main)) ;; clean-up forms -- application windows are taken down by gtk-quit-add callbacks + (trc "cells-gtk clean-up code") (loop for i below (gtk-main-level) + do (trc " gtk-main-quit") do (gtk-main-quit)) ;; Next is a work-around for a problem with gtk and lispwork-created .exe files #+(and Lispworks win32)(loop for i from 1 to 30 do (gtk-main-quit)) (loop while (gtk-events-pending) + do (trc " gtk-main-iteration-do") do (gtk-main-iteration-do nil)))) ;;; --- /project/cells/cvsroot/cells-gtk3/cells-gtk/widgets.lisp 2008/04/20 13:05:02 1.4 +++ /project/cells/cvsroot/cells-gtk3/cells-gtk/widgets.lisp 2008/05/19 10:18:34 1.5 @@ -77,13 +77,13 @@ (defun gtk-object-forget (gtk-id gtk-object) (when (and gtk-id gtk-object) - (trc " forgetting id/obj" gtk-id gtk-object) + (trc nil " forgetting id/obj" gtk-id gtk-object) (let ((ptr (cffi:pointer-address gtk-id))) (assert *gtk-objects*) (remhash ptr *gtk-objects*) #+unnecessary (mapc (lambda (k) (gtk-object-forget (slot-value k 'id) k)) (slot-value gtk-object '.kids))) ; unnecessary, ph - (trc " done" gtk-id gtk-object))) + (trc nil " done" gtk-id gtk-object))) (defun gtk-object-find (gtk-id &optional must-find-p &aux (hash-id (cffi:pointer-address gtk-id))) (when *gtk-objects* @@ -340,11 +340,11 @@ #+libcellsgtk (cffi:defcallback reshape-widget-handler :int ((widget :pointer) (event :pointer) (data :pointer)) (declare (ignore data event)) - (trc "reshape" widget) + (trc nil "reshape" widget) (bwhen (self (gtk-object-find widget)) (let ((new-width (gtk-adds-widget-width widget)) (new-height (gtk-adds-widget-height widget))) - (trc "reshape widget to new size" self widget new-width new-height) + (trc nil "reshape widget to new size" self widget new-width new-height) (with-integrity (:change :adjust-widget-size) (setf (allocated-width self) new-width (allocated-height self) new-height)))) @@ -380,22 +380,22 @@ (gtk-widget-hide (id self)))) (defmethod not-to-be :around ((self gtk-object)) - (trc "gtk-object not-to-be :around" (md-name self) self) - (trc " store-remove") + (trc nil "gtk-object not-to-be :around" (md-name self) self) + (trc nil " store-remove") (when (eql (store-lookup (md-name self) *widgets*) self) (store-remove (md-name self) *widgets*)) - (trc " object-forget") + (trc nil " object-forget") (gtk-object-forget (id self) self) - (trc " call-next-method") + (trc nil " call-next-method") (call-next-method) - (trc " widget-destroy") + (trc nil " widget-destroy") (when *gtk-debug* - (trc "WIDGET DESTROY" (slot-value self '.md-name) (type-of self) self) + (trc nil "WIDGET DESTROY" (slot-value self '.md-name) (type-of self) self) (force-output)) (gtk-widget-destroy (slot-value self 'id)) - (trc " done")) + (trc nil " done")) (defun assert-bin (container)

1 0

[cells-cvs] CVS cells-gtk3/gtk-ffi
by phildebrandt 19 May '08

19 May '08

Update of /project/cells/cvsroot/cells-gtk3/gtk-ffi In directory clnet:/tmp/cvs-serv27464/gtk-ffi Modified Files: gtk-ffi-impl.lisp Log Message: With Ingo's utf-8 patch for clisp and cells-store support --- /project/cells/cvsroot/cells-gtk3/gtk-ffi/gtk-ffi-impl.lisp 2008/04/13 10:59:23 1.1 +++ /project/cells/cvsroot/cells-gtk3/gtk-ffi/gtk-ffi-impl.lisp 2008/05/19 10:18:35 1.2 @@ -6,6 +6,7 @@ Currently supported -- sbcl: utf-8 string handling + -- clisp: utf-8 string handling (thanks to Ingo Bormuth) |# @@ -16,21 +17,24 @@ ;;; UTF-8 string handling ;;; -(defun utf-8-to-lisp (str) +(defun lisp-to-utf-8 (str) + #-(or clisp sbcl) (return-from lisp-to-utf-8 str) (when str - #+sbcl (let ((s (sb-ext:string-to-octets str :external-format :utf-8))) - (sb-ext:octets-to-string - (coerce (loop for i from 0 below (length s) - for b = (aref s i) - collect b - if (= b 195) do (incf i 2)) ; ph: gtk gives us 4 bytes per char -- no idea why. - '(vector (unsigned-byte 8))) - :external-format :utf-8)) - #-(or sbcl) str)) + #+clisp (ext:convert-string-to-bytes str charset:utf-8) + #+sbcl (sb-ext:string-to-octets str :external-format :utf-8))) -(defun lisp-to-utf-8 (str) +(defun utf-8-to-lisp (str) + #-(or clisp sbcl) (return-from utf-8-to-lisp str) (when str - #+sbcl (sb-ext:string-to-octets str :external-format :utf-8) - #-(or sbcl) str)) + (let* ((nat (lisp-to-utf-8 str)) + (oct (coerce (loop for i from 0 below (length nat) + for b = (aref nat i) + collect b + ;; ph: gtk gives us 4 bytes per char ; why ? + if (= b 195) do (incf i 2)) + '(vector (unsigned-byte 8))))) + #+clisp (ext:convert-string-from-bytes oct charset:utf-8) + #+sbcl (sb-ext:octets-to-string oct :external-format :utf-8)))) +

1 0

[cells-cvs] CVS cells
by phildebrandt 15 May '08

15 May '08

Update of /project/cells/cvsroot/cells In directory clnet:/tmp/cvs-serv7570 Modified Files: cells-store.lisp Log Message: added store-items to get an (a)list of all items --- /project/cells/cvsroot/cells/cells-store.lisp 2008/04/22 14:50:56 1.1 +++ /project/cells/cvsroot/cells/cells-store.lisp 2008/05/15 16:06:29 1.2 @@ -18,7 +18,7 @@ (in-package :cells) -(export! cells-store bwhen-c-stored c?-with-stored with-store-item store-add store-lookup store-remove) +(export! cells-store bwhen-c-stored c?-with-stored with-store-item store-add store-lookup store-remove store-items) (defmacro c?-with-stored ((var key store &optional default) &body body) `(c? (bwhen-c-stored (,var ,key ,store ,default) @@ -118,6 +118,11 @@ (with-store-entry (key store :quiet quiet) (setf (item key store) nil))) +(defmethod store-items ((store cells-store) &key (include-keys nil)) + (loop for key being the hash-keys in (data store) + for val being the hash-values in (data store) + if (and (cdr val) include-keys) collect (cons key (cdr val)) + else if (cdr val) collect it)) ;;; unit test

1 0

[cells-cvs] CVS cells-gtk3/gtk-ffi
by phildebrandt 05 May '08

05 May '08

Update of /project/cells/cvsroot/cells-gtk3/gtk-ffi In directory clnet:/tmp/cvs-serv26378/gtk-ffi Modified Files: gtk-button.lisp gtk-core.lisp gtk-ffi.lisp gtk-gl-ext.lisp gtk-list-tree.lisp gtk-menu.lisp gtk-other.lisp gtk-tool.lisp gtk-utilities.lisp package.lisp Log Message: ported to the latest cffi, cl-opengl, cl-cairo2 --- /project/cells/cvsroot/cells-gtk3/gtk-ffi/gtk-button.lisp 2008/04/13 10:59:23 1.1 +++ /project/cells/cvsroot/cells-gtk3/gtk-ffi/gtk-button.lisp 2008/05/05 15:30:14 1.2 @@ -25,23 +25,23 @@ (gtk-button-new :pointer ()) (gtk-button-set-label :void - ((button :pointer) (label :gtk-string))) + ((button :pointer) (label gtk-string))) (gtk-button-set-relief :void ((button :pointer) (style :int))) (gtk-button-set-use-stock :void - ((button :pointer) (use-stock :gtk-boolean))) + ((button :pointer) (use-stock gtk-boolean))) (gtk-toggle-button-new :pointer ()) (gtk-toggle-button-set-mode :void ((button :pointer) - (draw-indicator :gtk-boolean))) + (draw-indicator gtk-boolean))) (gtk-toggle-button-set-active :void - ((button :pointer) (active :gtk-boolean))) + ((button :pointer) (active gtk-boolean))) (gtk-toggle-button-get-active - :gtk-boolean + gtk-boolean ((button :pointer))) (gtk-check-button-new :pointer ()) (gtk-radio-button-new @@ -70,7 +70,7 @@ ((spin-button :pointer))) (gtk-spin-button-set-wrap :void - ((spin-button :pointer) (wrap :gtk-boolean)))) + ((spin-button :pointer) (wrap gtk-boolean)))) #+debugthis --- /project/cells/cvsroot/cells-gtk3/gtk-ffi/gtk-core.lisp 2008/04/13 10:59:23 1.1 +++ /project/cells/cvsroot/cells-gtk3/gtk-ffi/gtk-core.lisp 2008/05/05 15:30:14 1.2 @@ -26,14 +26,14 @@ ((milliseconds :unsigned-int) (func :pointer) (data :pointer))) - (g-locale-from-utf8 :gtk-string + (g-locale-from-utf8 gtk-string ((utf8-string :pointer) (len :int) (bytes-read :pointer) (bytes-written :pointer) (gerror :pointer))) (g-locale-to-utf8 :pointer - ((local-string :gtk-string) + ((local-string gtk-string) (len :int) (bytes-read :pointer) (bytes-written :pointer) @@ -100,27 +100,27 @@ (destroy-data :pointer))) (g-signal-connect-closure :unsigned-long ((instance :pointer) - (detailed-signal :gtk-string) + (detailed-signal gtk-string) (closure :pointer) - (after :gtk-boolean))) + (after gtk-boolean))) (g-object-set-valist :void ((object :pointer) - (first-prop :gtk-string) + (first-prop gtk-string) (varargs :pointer))) (g-object-set-property :void ((object :pointer) - (property-name :gtk-string) + (property-name gtk-string) (value :pointer))) (g-value-init :pointer ((value :pointer) (type :unsigned-long))) (g-value-unset :void ((value :pointer))) (g-value-set-string :void - ((value :pointer) (str :gtk-string))) + ((value :pointer) (str gtk-string))) (g-value-set-int :void ((value :pointer) (int :int))) (g-value-set-long :void ((value :pointer) (long :long))) (g-value-set-boolean :void ((value :pointer) - (bool :gtk-boolean))) + (bool gtk-boolean))) (g-value-set-float :void ((value :pointer) (float :float))) (g-value-set-double :void --- /project/cells/cvsroot/cells-gtk3/gtk-ffi/gtk-ffi.lisp 2008/04/23 06:34:24 1.2 +++ /project/cells/cvsroot/cells-gtk3/gtk-ffi/gtk-ffi.lisp 2008/05/05 15:30:14 1.3 @@ -24,8 +24,8 @@ "Convert hello-c to uffi to cffi types. Swap order of arguments." (flet ((convert-type (type) (case type - (c-string :gtk-string) - (boolean :gtk-boolean) + (c-string 'gtk-string) + (boolean 'gtk-boolean) (t (cffi-uffi-compat::convert-uffi-type (ffi-to-uffi-type type)))))) (dbind (ignore module &rest funcs) body (pprint `(,ignore @@ -54,26 +54,45 @@ (defvar *gtk-debug* nil) ;;; ============== Define CFFI types, and their translations.... -(eval-when (:compile-toplevel :load-toplevel :execute) ; ph: help SBCL - (cffi:defctype :gtk-string :pointer :documentation "string type for cffi type translation") - (cffi:defctype :gtk-boolean :pointer :documentation "boolean type for cffi type translation")) +#+nil (eval-when (:compile-toplevel :load-toplevel :execute) ; ph: help SBCL + (cffi:defctype gtk-string :pointer "string type for cffi type translation") + (cffi:defctype gtk-boolean :pointer "boolean type for cffi type translation")) -(defmethod cffi:translate-to-foreign (value (type (eql :gtk-boolean))) +(cffi:define-foreign-type gtk-boolean-type () + () + (:actual-type :pointer) + #-sbcl (:simple-parser gtk-boolean)) + +#+sbcl (cffi:define-parse-method gtk-boolean (&rest cffi::args) + (apply #'make-instance 'gtk-boolean-type cffi::args)) + +(cffi:define-foreign-type gtk-string-type () + () + (:actual-type :pointer) + #-sbcl (:simple-parser gtk-string)) + +#+sbcl (cffi:define-parse-method gtk-string (&rest cffi::args) + (apply #'make-instance 'gtk-string-type cffi::args)) + + +(defmethod cffi:translate-to-foreign (value (type gtk-boolean-type)) (cffi:make-pointer (if value 1 0))) -(defmethod cffi:translate-from-foreign (value (type (eql :gtk-boolean))) +(defmethod cffi:translate-from-foreign (value (type gtk-boolean-type)) #-clisp(not (zerop (cffi::pointer-address value))) ; pod strange! #+clisp(if (null value) ; pod something really wrong here! nil (not (zerop (cffi::pointer-address value))))) -(defmethod cffi:translate-to-foreign (value (type (eql :gtk-string))) +(defmethod cffi:translate-to-foreign (value (type gtk-string-type)) (when (null value) (setf value "")) ; pod ??? (cffi:foreign-string-alloc value)) -(defmethod cffi:translate-from-foreign (value (type (eql :gtk-string))) +(defmethod cffi:translate-from-foreign (value (type gtk-string-type)) (utf-8-to-lisp (cffi:foreign-string-to-lisp value))) + + (defun int-slot-indexed (obj obj-type slot index) (declare (ignorable obj-type)) (cffi:mem-aref (cffi:foreign-slot-value obj obj-type slot) :int index)) @@ -199,7 +218,7 @@ ,(when (with-debug-p name) `(format *trace-output* "~%Calling (~A ~{~A~^ ~})" ,(string-downcase (string name)) (list ,@(mapcar 'car arguments))))) - (let ((result ,(let ((fn `(,gtk-name ,@(mapcar #'(lambda (arg) (if (eql (cadr arg) :gtk-string) + (let ((result ,(let ((fn `(,gtk-name ,@(mapcar #'(lambda (arg) (if (eql (cadr arg) 'gtk-string) `(lisp-to-utf-8 ,(car arg)) (car arg))) arguments)))) --- /project/cells/cvsroot/cells-gtk3/gtk-ffi/gtk-gl-ext.lisp 2008/04/14 16:43:55 1.2 +++ /project/cells/cvsroot/cells-gtk3/gtk-ffi/gtk-gl-ext.lisp 2008/05/05 15:30:14 1.3 @@ -18,7 +18,7 @@ ;(export '(with-gl-drawable with-swap-buffers)) (cffi:define-foreign-library libgtkglext - (:unix "libgtkglext-x11-1.0.so") + (:unix (:or "libgtkglext-x11-1.0.so" "libgtkglext-x11-1.0.so.0")) (t (:default "libgtkglext"))) (cffi:use-foreign-library libgtkglext) --- /project/cells/cvsroot/cells-gtk3/gtk-ffi/gtk-list-tree.lisp 2008/04/13 10:59:23 1.1 +++ /project/cells/cvsroot/cells-gtk3/gtk-ffi/gtk-list-tree.lisp 2008/05/05 15:30:14 1.2 @@ -54,7 +54,7 @@ ((tree-store :pointer) (iter :pointer) (parent :pointer))) - (gtk-tree-store-remove :gtk-boolean + (gtk-tree-store-remove gtk-boolean ((tree-store :pointer) (iter :pointer))) (gtk-tree-store-clear :void @@ -74,7 +74,7 @@ (gtk-tree-view-get-selection :pointer ((tree-view :pointer))) - (gtk-tree-view-get-path-at-pos :gtk-boolean + (gtk-tree-view-get-path-at-pos gtk-boolean ((tree-view :pointer) (x :int) (y :int) @@ -104,19 +104,19 @@ (column :int) (data :pointer) (eof :int))) - (gtk-tree-model-get-iter :gtk-boolean + (gtk-tree-model-get-iter gtk-boolean ((tree-model :pointer) (iter :pointer) (path :pointer))) ;;tree-model - (gtk-tree-model-get-iter-from-string :gtk-boolean + (gtk-tree-model-get-iter-from-string gtk-boolean ((tree-model :pointer) (iter :pointer) - (path :gtk-string))) + (path gtk-string))) ;;tree-path (gtk-tree-path-new-from-string :pointer - ((path :gtk-string))) - (gtk-tree-path-to-string :gtk-string + ((path gtk-string))) + (gtk-tree-path-to-string gtk-string ((path :pointer))) (gtk-tree-path-free :void ((path :pointer))) (gtk-tree-model-get-path :pointer @@ -126,7 +126,7 @@ (gtk-tree-row-reference-new :pointer ((tree-model :pointer) (path :pointer))) - (gtk-tree-row-reference-valid :gtk-boolean + (gtk-tree-row-reference-valid gtk-boolean ((tree-row-reference :pointer))) (gtk-tree-row-reference-get-model :pointer ((tree-row-reference :pointer))) @@ -143,7 +143,7 @@ (gtk-tree-selection-select-path :void ((sel :pointer) (path :pointer))) - (gtk-tree-selection-get-selected :gtk-boolean + (gtk-tree-selection-get-selected gtk-boolean ((sel :pointer) (model :pointer) (iter :pointer))) @@ -158,30 +158,30 @@ (gtk-tree-view-column-pack-start :void ((tree-column :pointer) (renderer :pointer) - (expand :gtk-boolean))) + (expand gtk-boolean))) (gtk-tree-view-column-add-attribute :void ((tree-column :pointer) (renderer :pointer) - (attribute :gtk-string) + (attribute gtk-string) (column :int))) (gtk-tree-view-column-set-spacing :void ((tree-column :pointer) (spacing :int))) (gtk-tree-view-column-set-visible :void ((tree-column :pointer) - (spacing :gtk-boolean))) + (spacing gtk-boolean))) (gtk-tree-view-column-set-reorderable :void ((tree-column :pointer) - (resizable :gtk-boolean))) + (resizable gtk-boolean))) (gtk-tree-view-column-set-sort-column-id :void ((tree-column :pointer) (col-id :int))) (gtk-tree-view-column-set-sort-indicator :void ((tree-column :pointer) - (resizable :gtk-boolean))) + (resizable gtk-boolean))) (gtk-tree-view-column-set-resizable :void ((tree-column :pointer) - (resizable :gtk-boolean))) + (resizable gtk-boolean))) (gtk-tree-view-column-set-fixed-width :void ((tree-column :pointer) (fixed-width :int))) @@ -193,15 +193,15 @@ (max-width :int))) (gtk-tree-view-column-set-title :void ((tree-column :pointer) - (title :gtk-string))) + (title gtk-string))) (gtk-tree-view-column-set-expand :void ((tree-column :pointer) - (expand :gtk-boolean))) + (expand gtk-boolean))) (gtk-tree-view-column-set-clickable :void ((tree-column :pointer) (clickable - :gtk-boolean))) + gtk-boolean))) (gtk-tree-view-column-set-cell-data-func :void ((tree-column :pointer) (cell-renderer :pointer) --- /project/cells/cvsroot/cells-gtk3/gtk-ffi/gtk-menu.lisp 2008/04/13 10:59:23 1.1 +++ /project/cells/cvsroot/cells-gtk3/gtk-ffi/gtk-menu.lisp 2008/05/05 15:30:14 1.2 @@ -19,7 +19,7 @@ (in-package :gtk-ffi) (def-gtk-function :gtk gtk-check-menu-item-set-active :void - ((check-menu :pointer) (active :gtk-boolean))) + ((check-menu :pointer) (active gtk-boolean))) #+test (def-gtk-lib-functions :gtk @@ -40,7 +40,7 @@ (gtk-menu-bar-new :pointer ()) (gtk-menu-new :pointer ()) (gtk-menu-set-title :void - ((menu :pointer) (title :gtk-string))) + ((menu :pointer) (title gtk-string))) (gtk-menu-attach :void ((menu :pointer) (child :pointer) (lattach :unsigned-int) @@ -63,7 +63,7 @@ ((label :pointer))) (gtk-menu-item-set-right-justified :void ((menu-item :pointer) - (right-justified :gtk-boolean))) + (right-justified gtk-boolean))) (gtk-menu-item-set-submenu :void ((menu-item :pointer) (submenu :pointer))) @@ -81,7 +81,7 @@ (gtk-check-menu-item-new :pointer ()) (gtk-check-menu-item-new-with-label :pointer ((label :pointer))) - (gtk-check-menu-item-get-active :gtk-boolean + (gtk-check-menu-item-get-active gtk-boolean ((check-menu :pointer))) (gtk-radio-menu-item-new :pointer ((group :pointer))) (gtk-radio-menu-item-new-from-widget :pointer @@ -90,12 +90,12 @@ ((group :pointer))) (gtk-radio-menu-item-new-with-label-from-widget :pointer ((radio :pointer) - (label :gtk-string))) + (label gtk-string))) (gtk-radio-menu-item-get-group :pointer ((radio :pointer))) (gtk-image-menu-item-new :pointer ()) - (gtk-image-menu-item-new-with-label :pointer ((label :gtk-string))) + (gtk-image-menu-item-new-with-label :pointer ((label gtk-string))) (gtk-image-menu-item-new-from-stock :pointer - ((stock-id :gtk-string) + ((stock-id gtk-string) (accel-group :pointer))) (gtk-image-menu-item-set-image :void ((menu-item :pointer) --- /project/cells/cvsroot/cells-gtk3/gtk-ffi/gtk-other.lisp 2008/04/14 16:43:55 1.2 +++ /project/cells/cvsroot/cells-gtk3/gtk-ffi/gtk-other.lisp 2008/05/05 15:30:14 1.3 @@ -23,13 +23,13 @@ ;; main-loop (gtk-init :void ((argc :pointer) (argv :pointer))) - (gtk-init-check :gtk-boolean + (gtk-init-check gtk-boolean ((argc :pointer) (argv :pointer))) - (gtk-events-pending :gtk-boolean ()) - (gtk-main-iteration :gtk-boolean ()) - (gtk-main-iteration-do :gtk-boolean - ((blocking :gtk-boolean))) + (gtk-events-pending gtk-boolean ()) + (gtk-main-iteration gtk-boolean ()) + (gtk-main-iteration-do gtk-boolean + ((blocking gtk-boolean))) (gtk-main :void ()) (gtk-main-quit :void ()) (gtk-quit-add :unsigned-int @@ -62,8 +62,8 @@ (gtk-box-pack-start :void ((box :pointer) (widget :pointer) - (expand :gtk-boolean) - (fill :gtk-boolean) + (expand gtk-boolean) + (fill gtk-boolean) (padding :int))) (gtk-box-pack-start-defaults :void ((box :pointer) @@ -72,15 +72,15 @@ (gtk-box-set-homogeneous :void ((box :pointer) (homogeneous - :gtk-boolean))) + gtk-boolean))) (gtk-box-set-spacing :void ((box :pointer) (spacing :int))) (gtk-hbox-new :pointer - ((homogeneous :gtk-boolean) + ((homogeneous gtk-boolean) (spacing :int))) (gtk-vbox-new :pointer - ((homogeneous :gtk-boolean) + ((homogeneous gtk-boolean) (spacing :int))) (gtk-drawing-area-new :pointer ()) @@ -88,7 +88,7 @@ (gtk-table-new :pointer ((rows :unsigned-int) (columns :unsigned-int) - (homogeneous :gtk-boolean))) + (homogeneous gtk-boolean))) (gtk-table-attach :void ((table :pointer) (child :pointer) @@ -114,7 +114,7 @@ (gtk-table-set-homogeneous :void ((table :pointer) (homogeneous - :gtk-boolean))) + gtk-boolean))) ;;paned (gtk-paned-add1 :void @@ -131,27 +131,27 @@ ;;expander (gtk-expander-new :pointer - ((label :gtk-string))) + ((label gtk-string))) (gtk-expander-set-expanded :void ((expander :pointer) (expanded - :gtk-boolean))) + gtk-boolean))) (gtk-expander-set-spacing :void ((expander :pointer) (spacing :pointer))) (gtk-expander-set-label :void ((expander :pointer) - (label :gtk-string))) + (label gtk-string))) (gtk-expander-set-use-underline :void ((expander :pointer) (use-underline - :gtk-boolean))) + gtk-boolean))) (gtk-expander-set-use-markup :void ((expander :pointer) (use-markup - :gtk-boolean))) + gtk-boolean))) (gtk-expander-set-label-widget :void ((expander :pointer) @@ -172,10 +172,10 @@ (yscale :float))) ;;frame - (gtk-frame-new :pointer ((label :gtk-string))) + (gtk-frame-new :pointer ((label gtk-string))) (gtk-frame-set-label :void ((frame :pointer) - (label :gtk-string))) + (label gtk-string))) (gtk-frame-set-label-widget :void ((frame :pointer) (label-widget @@ -190,12 +190,12 @@ ;;aspect-frame (gtk-aspect-frame-new :pointer - ((label :gtk-string) + ((label gtk-string) (xalign :float) (yalign :float) (ratio :float) (obey_child - :gtk-boolean))) + gtk-boolean))) ;; separator (gtk-hseparator-new :pointer ()) (gtk-vseparator-new :pointer ()) @@ -262,13 +262,13 @@ (pos :int))) (gtk-notebook-set-show-tabs :void ((notebook :pointer) - (show-tabs :gtk-boolean))) + (show-tabs gtk-boolean))) (gtk-notebook-set-show-border :void ((notebook :pointer) - (show-border :gtk-boolean))) + (show-border gtk-boolean))) (gtk-notebook-set-scrollable :void ((notebook :pointer) - (scrollable :gtk-boolean))) + (scrollable gtk-boolean))) (gtk-notebook-set-tab-border :void ((notebook :pointer) (border-width :int))) @@ -278,7 +278,7 @@ ((notebook :pointer))) (gtk-notebook-set-homogeneous-tabs :void ((notebook :pointer) - (homogeneous-tabs :gtk-boolean))) + (homogeneous-tabs gtk-boolean))) (gtk-notebook-get-nth-page :pointer ((notebook :pointer) (n :int))) @@ -286,30 +286,30 @@ ((notebook :pointer))) ;;label - (gtk-label-new :pointer ((text :gtk-string))) + (gtk-label-new :pointer ((text gtk-string))) (gtk-label-set-text :void ((label :pointer) - (text :gtk-string))) + (text gtk-string))) (gtk-label-set-text-with-mnemonic :void ((label :pointer) - (text :gtk-string))) + (text gtk-string))) (gtk-label-set-line-wrap :void ((label :pointer) - (wrap :gtk-boolean))) + (wrap gtk-boolean))) (gtk-label-set-selectable :void ((label :pointer) - (selectable :gtk-boolean))) + (selectable gtk-boolean))) (gtk-label-set-use-markup :void ((label :pointer) - (use-markup :gtk-boolean))) + (use-markup gtk-boolean))) (gtk-label-set-markup :void ((label :pointer) - (markup :gtk-string))) + (markup gtk-string))) (gtk-label-set-markup-with-mnemonic :void ((label :pointer) - (markup :gtk-string))) + (markup gtk-string))) (gtk-accel-label-new :pointer - ((str :gtk-string))) + ((str gtk-string))) (gtk-accel-label-set-accel-widget :void ((label :pointer) (widget :pointer))) @@ -319,7 +319,7 @@ (gtk-progress-bar-pulse :void ((pbar :pointer))) (gtk-progress-bar-set-text :void ((pbar :pointer) - (text :gtk-string))) + (text gtk-string))) (gtk-progress-bar-set-fraction :void ((pbar :pointer) (fraction :double))) @@ -347,13 +347,13 @@ ;;image (gtk-image-new-from-file :pointer - ((filename :gtk-string))) + ((filename gtk-string))) (gtk-image-new-from-stock :pointer - ((stock :gtk-string) + ((stock gtk-string) (icon-size :int))) (gtk-image-set-from-stock :void ((image :pointer) - (stock :gtk-string) + (stock gtk-string) (icon-size :int))) (gtk-image-get-pixbuf :pointer ((image :pointer))) @@ -364,7 +364,7 @@ ((factory :pointer))) (gtk-icon-factory-add :void ((factory :pointer) - (stock-id :gtk-string) + (stock-id gtk-string) (icon-set :pointer))) ;;icon-set @@ -375,11 +375,11 @@ (gtk-statusbar-new :pointer ()) (gtk-statusbar-get-context-id :unsigned-int ((sbar :pointer) - (description :gtk-string))) + (description gtk-string))) (gtk-statusbar-push :unsigned-int ((sbar :pointer) (context-id :unsigned-int) - (text :gtk-string))) + (text gtk-string))) (gtk-statusbar-pop :void ((sbar :pointer) (context-id :unsigned-int))) @@ -389,7 +389,7 @@ (message-id :unsigned-int))) (gtk-statusbar-set-has-resize-grip :void ((sbar :pointer) - (setting :gtk-boolean))) + (setting gtk-boolean))) ;;widget (gtk-widget-show :void ((widget :pointer))) @@ -401,7 +401,7 @@ (gtk-widget-destroy :void ((widget :pointer))) (gtk-widget-set-sensitive :void ((widget :pointer) - (sensitive :gtk-boolean))) + (sensitive gtk-boolean))) (gtk-widget-set-size-request :void ((widget :pointer) (width :int) @@ -410,7 +410,7 @@ ((widget :pointer))) (gtk-widget-add-accelerator :void ((widget :pointer) - (gsignal :gtk-string) + (gsignal gtk-string) (accel-group :pointer) (key :unsigned-int) (mods :int) @@ -430,10 +430,10 @@ (gtk-window-new :pointer ((type :int))) (gtk-window-set-title :void ((widget :pointer) - (title :gtk-string))) - (gtk-window-set-icon-from-file :gtk-boolean + (title gtk-string))) + (gtk-window-set-icon-from-file gtk-boolean ((window :pointer) - (filename :gtk-string) + (filename gtk-string) (err :pointer))) (gtk-window-set-default-size :void ((widget :pointer) @@ -441,13 +441,13 @@ (height :int))) (gtk-window-set-resizable :void ((widget :pointer) - (resizable :gtk-boolean))) + (resizable gtk-boolean))) (gtk-window-set-decorated :void ((widget :pointer) - (decorated :gtk-boolean))) + (decorated gtk-boolean))) (gtk-window-set-auto-startup-notification :void ((setting - :gtk-boolean))) + gtk-boolean))) (gtk-window-set-position :void ((widget :pointer) (position :int))) @@ -468,7 +468,7 @@ (gtk-entry-new :pointer ()) (gtk-entry-set-text :void ((entry :pointer) - (text :gtk-string))) + (text gtk-string))) (gtk-entry-get-text :pointer ((entry :pointer))) (gtk-entry-set-max-length :void ((entry :pointer) @@ -476,13 +476,13 @@ (gtk-entry-set-editable :void ((entry :pointer) (editable - :gtk-boolean))) + gtk-boolean))) (gtk-entry-set-completion :void ((entry :pointer) (completion :pointer))) (gtk-entry-set-has-frame :void ((entry :pointer) - (has-frame :gtk-boolean))) + (has-frame gtk-boolean))) ;;entry-completion (gtk-entry-completion-new :pointer ()) @@ -504,7 +504,7 @@ (gtk-range-set-inverted :void ((range :pointer) (inverted - :gtk-boolean))) + gtk-boolean))) (gtk-range-set-increments :void ((range :pointer) (step :double) @@ -517,7 +517,7 @@ ;;scale (gtk-scale-set-draw-value :void ((scale :pointer) - (draw-value :gtk-boolean))) + (draw-value gtk-boolean))) (gtk-scale-set-value-pos :void ((scale :pointer) (pos-type :int))) @@ -545,7 +545,7 @@ (gtk-combo-box-new-text :pointer ()) (gtk-combo-box-append-text :void ((combo-box :pointer) - (text :gtk-string))) + (text gtk-string))) (gtk-combo-box-remove-text :void ((combo-box :pointer) (position :int))) @@ -557,7 +557,7 @@ (gtk-combo-box-set-model :void ((combo-box :pointer) (model :pointer))) - (gtk-combo-box-get-active-iter :gtk-boolean + (gtk-combo-box-get-active-iter gtk-boolean ((combo-box :pointer) (iter :pointer))) (gtk-combo-box-set-active-iter :void @@ -608,7 +608,7 @@ (gtk-dialog-add-button :pointer ((dialog :pointer) (button-text - :gtk-string) + gtk-string) (response-id :int))) (gtk-dialog-add-action-widget :void ((dialog :pointer) @@ -616,7 +616,7 @@ (response-id :pointer))) (gtk-dialog-set-has-separator :void ((dialog :pointer) - (has-separator :gtk-boolean))) + (has-separator gtk-boolean))) (gtk-dialog-set-default-response :void ((dialog :pointer) (response-id :int))) @@ -627,11 +627,11 @@ (flags :int) (type :int) (buttons :int) - (message :gtk-string))) + (message gtk-string))) (gtk-message-dialog-set-markup :void ((dialog :pointer) - (str :gtk-string))) + (str gtk-string))) ;;file-chooser (gtk-file-chooser-set-action :void @@ -639,42 +639,42 @@ (action :int))) (gtk-file-chooser-set-local-only :void ((chooser :pointer) [238 lines skipped] --- /project/cells/cvsroot/cells-gtk3/gtk-ffi/gtk-tool.lisp 2008/04/13 10:59:23 1.1 +++ /project/cells/cvsroot/cells-gtk3/gtk-ffi/gtk-tool.lisp 2008/05/05 15:30:14 1.2 @@ -29,13 +29,13 @@ (gtk-toolbar-set-show-arrow :void ((toolbar :pointer) - (show-arrow :gtk-boolean))) + (show-arrow gtk-boolean))) (gtk-toolbar-set-orientation :void ((toolbar :pointer) (orientation :int))) (gtk-toolbar-set-tooltips :void - ((toolbar :pointer) (enable :gtk-boolean))) + ((toolbar :pointer) (enable gtk-boolean))) (gtk-toolbar-set-style :void ((toolbar :pointer) (style :int))) @@ -46,8 +46,8 @@ :void ((tooltips :pointer) (widget :pointer) - (tip-text :gtk-string) - (tip-private :gtk-string))) + (tip-text gtk-string) + (tip-private gtk-string))) (gtk-tooltips-enable :void ((tooltips :pointer))) @@ -63,24 +63,24 @@ (gtk-tool-item-set-homogeneous :void ((tool-item :pointer) - (homogeneous :gtk-boolean))) + (homogeneous gtk-boolean))) (gtk-tool-item-set-expand :void - ((tool-item :pointer) (expand :gtk-boolean))) + ((tool-item :pointer) (expand gtk-boolean))) (gtk-tool-item-set-tooltip :void ((tool-item :pointer) (tooltips :pointer) - (tip-text :gtk-string) - (tip-private :gtk-string))) + (tip-text gtk-string) + (tip-private gtk-string))) (gtk-tool-item-set-is-important :void ((tool-item :pointer) - (is-important :gtk-boolean))) + (is-important gtk-boolean))) (gtk-separator-tool-item-new :pointer ()) (gtk-separator-tool-item-set-draw :void - ((item :pointer) (draw :gtk-boolean))) + ((item :pointer) (draw gtk-boolean))) ;;tool-button (gtk-tool-button-new @@ -88,17 +88,17 @@ ((icon-widget :pointer) (label :pointer))) (gtk-tool-button-new-from-stock :pointer - ((stock-id :gtk-string))) + ((stock-id gtk-string))) (gtk-tool-button-set-label :void ((tool-button :pointer) (label :pointer))) (gtk-tool-button-set-use-underline :void ((tool-button :pointer) - (use-underline :gtk-boolean))) + (use-underline gtk-boolean))) (gtk-tool-button-set-stock-id :void - ((tool-button :pointer) (stock-id :gtk-string))) + ((tool-button :pointer) (stock-id gtk-string))) (gtk-tool-button-set-icon-widget :void ((tool-button :pointer) --- /project/cells/cvsroot/cells-gtk3/gtk-ffi/gtk-utilities.lisp 2008/04/14 16:43:55 1.2 +++ /project/cells/cvsroot/cells-gtk3/gtk-ffi/gtk-utilities.lisp 2008/05/05 15:30:14 1.3 @@ -234,8 +234,7 @@ (defun deref-col-type-buffer (col-type buffer) (ecase col-type ((:string :icon) - (get-gtk-string - (cffi:make-pointer (cffi:mem-aref buffer :pointer 0)))) + (get-gtk-string (cffi:make-pointer (cffi-sys:pointer-address (cffi:mem-aref buffer :pointer 0))))) (:boolean (not (zerop (cffi:mem-aref buffer :unsigned-char 0)))) (:date (cffi:mem-aref buffer :FLOAT 0)) (:int (cffi:mem-aref buffer :int 0)) --- /project/cells/cvsroot/cells-gtk3/gtk-ffi/package.lisp 2008/04/14 16:43:55 1.2 +++ /project/cells/cvsroot/cells-gtk3/gtk-ffi/package.lisp 2008/05/05 15:30:14 1.3 @@ -19,7 +19,7 @@ (in-package :cl-user) (defpackage :gtk-ffi - (:use :common-lisp :pod) + (:use :common-lisp :pod :utils-kt) (:export #:+c-null+ #:int-slot-indexed #:load-gtk-libs @@ -38,6 +38,8 @@ #:long #:single-float #:double-float + #:gtk-string + #:gtk-boolean #:otherwise #:*gtk-debug* #:load-gtk-libs @@ -79,4 +81,4 @@ #:gdk-event-motion-y #:event-type - #:gl-init)) + #:gtk-gl-init))

1 0

[cells-cvs] CVS cells-gtk3/cells-gtk
by phildebrandt 05 May '08

05 May '08

Update of /project/cells/cvsroot/cells-gtk3/cells-gtk In directory clnet:/tmp/cvs-serv26378/cells-gtk Modified Files: tree-view.lisp Log Message: ported to the latest cffi, cl-opengl, cl-cairo2 --- /project/cells/cvsroot/cells-gtk3/cells-gtk/tree-view.lisp 2008/04/20 13:05:02 1.3 +++ /project/cells/cvsroot/cells-gtk3/cells-gtk/tree-view.lisp 2008/05/05 15:30:14 1.4 @@ -344,7 +344,7 @@ ;;; a tribute to static typing (cffi:defcallback tree-view-edit-cell-callback-string :int - ((renderer :pointer) (path :pointer) (new-value :gtk-string)) + ((renderer :pointer) (path :pointer) (new-value gtk-string)) (tree-view-edit-cell-callback renderer path new-value) 1)

1 0

[cells-cvs] CVS cells-gtk3/cells-gtk/test-gtk
by phildebrandt 05 May '08

05 May '08

Update of /project/cells/cvsroot/cells-gtk3/cells-gtk/test-gtk In directory clnet:/tmp/cvs-serv26378/cells-gtk/test-gtk Modified Files: test-display.lisp test-entry.lisp test-layout.lisp Log Message: ported to the latest cffi, cl-opengl, cl-cairo2 --- /project/cells/cvsroot/cells-gtk3/cells-gtk/test-gtk/test-display.lisp 2008/04/16 14:41:30 1.3 +++ /project/cells/cvsroot/cells-gtk3/cells-gtk/test-gtk/test-display.lisp 2008/05/05 15:30:14 1.4 @@ -38,7 +38,8 @@ :on-clicked (callback (widget event data) (with-widget (w :statusbar) - (push-message w (format nil "~a" (fraction (fm-other :pbar))))))))) + (with-widget (pbar :pbar) + (push-message w (format nil "~a" (fraction pbar))))))))) (mk-hbox :kids (kids-list? (mk-progress-bar :md-name :pbar2 --- /project/cells/cvsroot/cells-gtk3/cells-gtk/test-gtk/test-entry.lisp 2008/04/13 10:59:20 1.1 +++ /project/cells/cvsroot/cells-gtk3/cells-gtk/test-gtk/test-entry.lisp 2008/05/05 15:30:14 1.2 @@ -30,21 +30,19 @@ :expand t :fill t :markup (c? (with-markup (:font-desc "24") (with-markup (:foreground :blue - :font-family "Arial" - :font-desc (if (value (fm-other :spin)) - (truncate (value (fm-other :spin))) - 10)) - (value (fm-other :entry))) + :font-family "Arial" + :font-desc (with-widget-value (s :spin :alternative 10) + (truncate s))) + (widget-value :entry)) (with-markup (:underline :double - :weight :bold - :foreground :red - :font-desc (if (value (fm-other :hscale)) - (truncate (value (fm-other :hscale))) - 10)) + :weight :bold + :foreground :red + :font-desc (with-widget-value (s :hscale :alternative 10) + (truncate s))) "is") - (with-markup (:strikethrough (value (fm^ :cool))) + (with-markup (:strikethrough (widget-value :cool)) "boring") - (with-markup (:strikethrough (not (value (fm^ :cool)))) + (with-markup (:strikethrough (not (widget-value :cool))) "cool!"))) :selectable t) (mk-entry :md-name :entry :auto-update t :init "Testing")))) @@ -61,8 +59,8 @@ :init t :label "Visible"))) (mk-hscale :md-name :hscale - :visible (c? (value (fm^ :visible))) - :sensitive (c? (value (fm^ :sensitive))) + :visible (c? (widget-value :visible)) + :sensitive (c? (widget-value :sensitive)) :expand t :fill t :min 0 :max 100 :init 10))))))) --- /project/cells/cvsroot/cells-gtk3/cells-gtk/test-gtk/test-layout.lisp 2008/04/13 10:59:21 1.1 +++ /project/cells/cvsroot/cells-gtk3/cells-gtk/test-gtk/test-layout.lisp 2008/05/05 15:30:14 1.2 @@ -6,7 +6,7 @@ :expand t :fill t :scrollable t :tab-labels (list "_Table" "_Panes" "_Alignment") - :tab-pos (c? (value (fm-other :tab-pos))) + :tab-pos (c? (widget-value :tab-pos)) :kids (kids-list? (mk-table :elements (cons

1 0

[cells-cvs] penetrate deeper
by Noreen 25 Apr '08

25 Apr '08

GAIN YOUR PENIS 2 INCH - SIMPLE AS NEVER. NATURAL HERBAL PRODUCT 100% SATISFACTION GUARANTEE! http://babbuyae.com

1 0

[cells-cvs] CVS cells-gtk3/pod-utils
by phildebrandt 23 Apr '08

23 Apr '08

Update of /project/cells/cvsroot/cells-gtk3/pod-utils In directory clnet:/tmp/cvs-serv11350/pod-utils Modified Files: utils.lisp Log Message: Fixed library names for ubuntu. resolved conflict with utils-kt. --- /project/cells/cvsroot/cells-gtk3/pod-utils/utils.lisp 2008/04/13 10:59:26 1.1 +++ /project/cells/cvsroot/cells-gtk3/pod-utils/utils.lisp 2008/04/23 06:34:24 1.2 @@ -42,8 +42,8 @@ prepend breadth-first-search update with-stack-size pprint-without-strings chop setx reuse-cons intersect-predicates defmemo system-clear-memoized-fns system-add-memoized-fn system-list-memoized-fns - system-forget-memoized-fns with-gensyms fail)) -; ph: removed last1 new-reslist reslist-pop reslist-push reslist-fillptr now + system-forget-memoized-fns fail)) +; ph: removed last1 new-reslist reslist-pop reslist-push reslist-fillptr now with-gensyms (in-package :pod-utils)

1 0

← Newer
1
2
3
4
5
6
7
...
73
Older →

Jump to page:

2024

2023

2022

2021

2020

2019

2018

2017

2016

2015

2014

2013

2012

2011

2010

2009

2008

2007

2006

2005

2004

2003

cells-cvs