cells-gtk-cvs February 2006

cells-gtk-cvs@common-lisp.net

1 participants
69 discussions

[cells-gtk-cvs] CVS root/gtk-ffi
by pdenno 11 Feb '06

11 Feb '06

Update of /project/cells-gtk/cvsroot/root/gtk-ffi In directory common-lisp:/tmp/cvs-serv31260/root/gtk-ffi Modified Files: gtk-ffi.asd Log Message: removed reference to ffx.lisp --- /project/cells-gtk/cvsroot/root/gtk-ffi/gtk-ffi.asd 2006/01/03 19:06:22 1.10 +++ /project/cells-gtk/cvsroot/root/gtk-ffi/gtk-ffi.asd 2006/02/11 03:44:32 1.11 @@ -12,8 +12,8 @@ ;;; Specify for Lispworks (definitely), other maybe. #+macosx(setf *gtk-lib-path* "/sw/lib/") #+(or win32 mswindows)(setf *gtk-lib-path* "E:/GTK/bin/") -;#-(or macosx win32 mswindows)(setf *gtk-lib-path* "/usr/lib/") -#-(or macosx win32 mswindows)(setf *gtk-lib-path* "/opt/gnome/lib/") ; For my SuSE machine +#-(or macosx win32 mswindows)(setf *gtk-lib-path* "/usr/lib/") +;#-(or macosx win32 mswindows)(setf *gtk-lib-path* "/opt/gnome/lib/") ; For my SuSE machine ;;; Step 2 -- If you built or downloaded the libcellsgtk library, uncomment the next line. (pushnew :libcellsgtk *features*) @@ -22,8 +22,7 @@ :name "gtk-ffi" :depends-on (:cells :cffi :cffi-uffi-compat) :components - ((:file "ffx") ; Novikov Leonid's compatibility stuff from hello-c - (:file "gtk-ffi" :depends-on ("ffx")) + ((:file "gtk-ffi") (:file "gtk-core" :depends-on ("gtk-ffi")) (:file "gtk-other" :depends-on ("gtk-ffi")) (:file "gtk-button" :depends-on ("gtk-ffi"))

1 0

[cells-gtk-cvs] CVS root/gtk-ffi
by pdenno 11 Feb '06

11 Feb '06

Update of /project/cells-gtk/cvsroot/root/gtk-ffi In directory common-lisp:/tmp/cvs-serv31246/root/gtk-ffi Removed Files: ffx.lisp Log Message: No longer used.

1 0

[cells-gtk-cvs] CVS root/gtk-ffi
by pdenno 11 Feb '06

11 Feb '06

Update of /project/cells-gtk/cvsroot/root/gtk-ffi In directory common-lisp:/tmp/cvs-serv31208/root/gtk-ffi Modified Files: gtk-definitions.lisp Log Message: Replaced some fgn-alloc fgn-free stuff with equivalent cffi. --- /project/cells-gtk/cvsroot/root/gtk-ffi/gtk-definitions.lisp 2004/12/05 06:31:14 1.2 +++ /project/cells-gtk/cvsroot/root/gtk-ffi/gtk-definitions.lisp 2006/02/11 03:41:05 1.3 @@ -64,14 +64,15 @@ (def-struct g-value (g-type (:array :int 16))) +;;; POD variable capture! (defmacro with-g-value ((var) &body body) - `(let ((,var (ffx:fgn-alloc 'g-value 1 :with-g-value ',var))) + `(let ((,var (cffi:foreign-alloc 'g-value))) (unwind-protect (progn (dotimes (n 16) (setf (int-slot-indexed ,var 'g-value 'g-type n) 0)) ,@body) - (ffx:fgn-free ,var)))) + (cffi:foreign-free ,var)))) (eval-when (compile load eval) (export 'with-g-value))

1 0

[cells-gtk-cvs] CVS root/gtk-ffi
by pdenno 11 Feb '06

11 Feb '06

Update of /project/cells-gtk/cvsroot/root/gtk-ffi In directory common-lisp:/tmp/cvs-serv31188/root/gtk-ffi Modified Files: gtk-core.lisp Log Message: Replaced some fgn-alloc fgn-free stuff with equivalent cffi. --- /project/cells-gtk/cvsroot/root/gtk-ffi/gtk-core.lisp 2006/01/03 19:05:17 1.5 +++ /project/cells-gtk/cvsroot/root/gtk-ffi/gtk-core.lisp 2006/02/11 03:40:26 1.6 @@ -49,7 +49,7 @@ (gdk-flush ())) (def-union g-value-data - (v-int :int) + (v-int :int) (v-uint :unsigned-int) (v-long :long) (v-ulong :unsigned-long) @@ -69,14 +69,14 @@ (defun call-with-g-value (fn) (declare (optimize (speed 3) (safety 0) (space 0))) - (let ((gva (ffx:fgn-alloc 'g-value 1 :with-g-value))) + (let ((gva (cffi:foreign-alloc 'g-value))) (unwind-protect (dotimes (n 16) - (let ((gv (ffx:ff-elt gva 'g-value 0))) - (let ((ns (get-slot-pointer gv 'g-value 'g-type))) - (setf (deref-array ns '(:array :int) n) 0)))) + (let* ((gv (cffi:mem-aref gva 'g-value 0)) + (ns (get-slot-pointer gv 'g-value 'g-type))) + (setf (cffi:mem-aref ns ':int n) 0)))) (funcall fn gva) - (ffx:fgn-free gva)))) + (cffi:foreign-free gva))) (eval-when (compile load eval) (export 'with-g-value))

1 0

[cells-gtk-cvs] CVS root/cells-gtk
by pdenno 11 Feb '06

11 Feb '06

Update of /project/cells-gtk/cvsroot/root/cells-gtk In directory common-lisp:/tmp/cvs-serv31088/root/cells-gtk Modified Files: widgets.lisp Log Message: Replaced hello-c:ff-defun-callable with cffi:defcallback. Replaced some fgn-alloc fgn-free stuff with equivalent cffi. --- /project/cells-gtk/cvsroot/root/cells-gtk/widgets.lisp 2006/01/03 19:03:02 1.15 +++ /project/cells-gtk/cvsroot/root/cells-gtk/widgets.lisp 2006/02/11 03:39:10 1.16 @@ -110,15 +110,15 @@ (intern (format nil "GTK-~a~{-~a~}" class slot-access) :gtk-ffi)))) ;;; --- widget -------------------- -;;; Define handlers that recover the the callback defined on the widget +;;; Define handlers that recover the callback defined on the widget + (defmacro def-gtk-event-handler (event) - `(ff-defun-callable :cdecl :int ,(intern (string-upcase (format nil "~a-handler" event))) - ((widget :pointer-void) (event :pointer-void) (data :pointer-void)) - ;(print (list :entered-gtk-event-handler-cb ,(symbol-name event) widget)) + `(cffi:defcallback ,(intern (format nil "~a-HANDLER" event)) :int + ((widget :pointer) (event :pointer) (data :pointer)) (bif (self (gtk-object-find widget)) - (let ((cb (callback-recover self ,(intern (symbol-name event) :keyword)))) - (funcall cb self widget event data)) - (trc nil "unknown widget. from prior run. clean up on errors" widget)))) + (let ((cb (callback-recover self ,(intern (string event) :keyword)))) + (funcall cb self widget event data)) + (trc nil "Unknown widget from prior run. Clean up on errors" widget)))) (def-gtk-event-handler clicked) (def-gtk-event-handler changed) @@ -131,15 +131,15 @@ (def-gtk-event-handler modified-changed) (defparameter *widget-callbacks* - (list (cons 'clicked (ff-register-callable 'clicked-handler)) - (cons 'changed (ff-register-callable 'changed-handler)) - (cons 'activate (ff-register-callable 'activate-handler)) - (cons 'value-changed (ff-register-callable 'value-changed-handler)) - (cons 'day-selected (ff-register-callable 'day-selected-handler)) - (cons 'selection-changed (ff-register-callable 'selection-changed-handler)) - (cons 'toggled (ff-register-callable 'toggled-handler)) - (cons 'delete-event (ff-register-callable 'delete-event-handler)) - (cons 'modified-changed (ff-register-callable 'modified-changed-handler)))) + (list (cons 'clicked (cffi:get-callback 'clicked-handler)) + (cons 'changed (cffi:get-callback 'changed-handler)) + (cons 'activate (cffi:get-callback 'activate-handler)) + (cons 'value-changed (cffi:get-callback 'value-changed-handler)) + (cons 'day-selected (cffi:get-callback 'day-selected-handler)) + (cons 'selection-changed (cffi:get-callback 'selection-changed-handler)) + (cons 'toggled (cffi:get-callback 'toggled-handler)) + (cons 'delete-event (cffi:get-callback 'delete-event-handler)) + (cons 'modified-changed (cffi:get-callback 'modified-changed-handler)))) (eval-when (:compile-toplevel :load-toplevel :execute) @@ -226,14 +226,11 @@ ,@body 1)))) -(ff-defun-callable :cdecl :int timeout-handler-callback - ((data (* :int))) - ;;(print (list :timeout-handler-callback data)) - (let* ((id (elti data 0)) - (r2 (gtk-global-callback-funcall id))) - (trc nil "timeout func really returning" r2) - (if r2 1 0))) - +(cffi:defcallback timeout-handler-callback :int ((data :pointer)) + (let* ((id (cffi:mem-aref data :int 0)) + (r2 (gtk-global-callback-funcall id))) + (trc nil "timeout func really returning" r2) + (if r2 1 0))) (defun timeout-add (milliseconds function) (let ((id (gtk-global-callback-register @@ -244,9 +241,9 @@ (trc nil "timeout func returning" r) r)))) (c-id (fgn-alloc :int 1))) - (setf (elti c-id 0) id) - (trc nil "timeout-add > passing cb data, *data" c-id (elti c-id 0)) - (g-timeout-add milliseconds (ff-register-callable 'timeout-handler-callback) c-id))) + (setf (cffi:mem-aref c-id :int 0) (coerce id 'integer)) + (trc nil "timeout-add > passing cb data, *data" c-id (cffi:mem-aref c-id :int 0)) + (g-timeout-add milliseconds (cffi:get-callback 'timeout-handler-callback) c-id))) (def-object widget () ((tooltip :accessor tooltip :initarg :tooltip :initform (c-in nil))

1 0

[cells-gtk-cvs] CVS root/cells-gtk
by pdenno 11 Feb '06

11 Feb '06

Update of /project/cells-gtk/cvsroot/root/cells-gtk In directory common-lisp:/tmp/cvs-serv31057/root/cells-gtk Modified Files: tree-view.lisp Log Message: Replaced hello-c:ff-defun-callable with cffi:defcallback --- /project/cells-gtk/cvsroot/root/cells-gtk/tree-view.lisp 2006/01/03 19:01:59 1.12 +++ /project/cells-gtk/cvsroot/root/cells-gtk/tree-view.lisp 2006/02/11 03:38:02 1.13 @@ -82,20 +82,19 @@ finally (return node))) ;;; Used by combo-box also, when it is using a tree model. -(ff-defun-callable :cdecl :void tree-view-items-selector - ((model :pointer-void) (path :pointer-void) (iter :pointer-void) (data :pointer-void)) +(cffi:defcallback tree-view-items-selector :void + ((model :pointer) (path :pointer) (iter :pointer) (data :pointer)) (let ((tree (of-tree (gtk-object-find model)))) - (push (item-from-path - (children-fn tree) - (roots tree) - (read-from-string - (gtk-tree-model-get-cell model iter (length (column-types tree)) :string))) + (push (item-from-path (children-fn tree) + (roots tree) + (read-from-string + (gtk-tree-model-get-cell model iter (length (column-types tree)) :string))) (selected-items-cache tree))) 0) (defmethod get-selection ((self tree-view)) (let ((selection (gtk-tree-view-get-selection (id self))) - (cb (ff-register-callable 'tree-view-items-selector))) + (cb (cffi:get-callback 'tree-view-items-selector))) (setf (selected-items-cache self) nil) (gtk-tree-selection-selected-foreach selection cb c-null) (if (equal (gtk-tree-selection-get-mode selection) 3) ;;multiple @@ -112,12 +111,12 @@ (:browse 2) (:multiple 3)))))) -(ff-defun-callable :cdecl :void tree-view-select-handler - ((column-widget :pointer-void) (event :pointer-void) (data :pointer-void)) +(cffi:defcallback tree-view-select-handler :void + ((column-widget :pointer) (event :pointer) (data :pointer)) (bif (tree-view (gtk-object-find column-widget)) - (let ((cb (callback-recover tree-view :on-select))) - (funcall cb tree-view column-widget event data)) - (trc "dude, clean up old widgets after runs" column-widget)) + (let ((cb (callback-recover tree-view :on-select))) + (funcall cb tree-view column-widget event data)) + (trc "Clean up old widgets after runs" column-widget)) 0) ;;; The check that previously was performed here (for a clos object) caused the handler @@ -127,7 +126,7 @@ (let ((selected-widget (gtk-tree-view-get-selection (id self)))) (gtk-object-store selected-widget self) ;; tie column widget to clos tree-view (callback-register self :on-select new-value) - (let ((cb (ff-register-callable 'tree-view-select-handler))) + (let ((cb (cffi:get-callback 'tree-view-select-handler))) ;(trc nil "tree-view on-select pcb:" cb selected-widget "changed") (gtk-signal-connect selected-widget "changed" cb))))) @@ -209,14 +208,14 @@ (gtk-tree-store-set-kids model sub-tree iter pos column-types print-fn children-fn (cons index path))))) -(ff-defun-callable :cdecl :int tree-view-render-cell-callback - ((tree-column :pointer-void) (cell-renderer :pointer-void) - (tree-model :pointer-void) (iter :pointer-void) (data :pointer-void)) +(cffi:defcallback tree-view-render-cell-callback :int + ((tree-column :pointer) (cell-renderer :pointer) (tree-model :pointer) + (iter :pointer) (data :pointer)) (bif (self (gtk-object-find tree-column)) - (let ((cb (callback-recover self :render-cell))) - (assert cb () "No :render-cell callback for ~a" self) - (funcall cb tree-column cell-renderer tree-model iter data)) - (trc nil "dude, clean up old widgets from prior runs" tree-column)) + (let ((cb (callback-recover self :render-cell))) + (assert cb nil "no :render-cell callback for ~a" self) + (funcall cb tree-column cell-renderer tree-model iter data)) + (trc nil "Clean up old widgets from prior runs." tree-column)) 1) (def-c-output columns ((self tree-view)) @@ -229,7 +228,7 @@ (t (gtk-cell-renderer-text-new))) do (gtk-tree-view-column-pack-start (id col) renderer t) (gtk-tree-view-column-set-cell-data-func (id col) renderer - (let ((cb (ff-register-callable 'tree-view-render-cell-callback))) + (let ((cb (cffi:get-callback 'tree-view-render-cell-callback))) ;(trc nil "tree-view columns pcb:" cb (id col) :render-cell) (callback-register col :render-cell (gtk-tree-view-render-cell pos

1 0

[cells-gtk-cvs] CVS root/cells-gtk
by pdenno 11 Feb '06

11 Feb '06

Update of /project/cells-gtk/cvsroot/root/cells-gtk In directory common-lisp:/tmp/cvs-serv31035/root/cells-gtk Modified Files: textview.lisp Log Message: Replaced hello-c:ff-defun-callable with cffi:defcallback --- /project/cells-gtk/cvsroot/root/cells-gtk/textview.lisp 2006/01/03 19:01:20 1.6 +++ /project/cells-gtk/cvsroot/root/cells-gtk/textview.lisp 2006/02/11 03:37:13 1.7 @@ -69,8 +69,8 @@ when (eql type :menu-item) collect `(funcall #'make-instance 'populate-adds ,@args)))) -(ff-defun-callable :cdecl :void text-view-populate-popup-handler - ((widget :pointer-void) (signal :pointer-void) (data :pointer-void)) +(cffi:defcallback text-view-populate-popup-handler :void + ((widget :pointer) (signal :pointer) (data :pointer)) (let ((popup-menu (gtk-adds-text-view-popup-menu widget))) (bwhen (text-view (gtk-object-find widget)) (bwhen (cb (callback-recover text-view :populate-popup)) @@ -81,7 +81,7 @@ (when new-value (callback-register self :populate-popup (populate-popup-closure (reverse new-value) self)) (gtk-signal-connect (id self) "populate-popup" - (ffx:ff-register-callable 'text-view-populate-popup-handler)))) + (cffi:get-callback 'text-view-populate-popup-handler)))) (defun populate-popup-closure (p-adds text-view) (let (accum)

1 0

[cells-gtk-cvs] CVS root/cells-gtk
by pdenno 11 Feb '06

11 Feb '06

Update of /project/cells-gtk/cvsroot/root/cells-gtk In directory common-lisp:/tmp/cvs-serv31015/root/cells-gtk Modified Files: packages.lisp Log Message: Removed reference to package ffx --- /project/cells-gtk/cvsroot/root/cells-gtk/packages.lisp 2006/01/03 18:59:58 1.2 +++ /project/cells-gtk/cvsroot/root/cells-gtk/packages.lisp 2006/02/11 03:35:13 1.3 @@ -18,8 +18,7 @@ (defpackage :cells-gtk (:nicknames :cgtk) - (:use :common-lisp :utils-kt :cells :gtk-ffi - :uffi #:ffx)) + (:use :common-lisp :utils-kt :cells :gtk-ffi :uffi ))

1 0

[cells-gtk-cvs] CVS root/cells-gtk
by pdenno 11 Feb '06

11 Feb '06

Update of /project/cells-gtk/cvsroot/root/cells-gtk In directory common-lisp:/tmp/cvs-serv30914/root/cells-gtk Modified Files: drawing.lisp Log Message: Replaced hello-c stuff with cffi stuff --- /project/cells-gtk/cvsroot/root/cells-gtk/drawing.lisp 2006/01/03 19:03:33 1.3 +++ /project/cells-gtk/cvsroot/root/cells-gtk/drawing.lisp 2006/02/11 03:34:09 1.4 @@ -17,57 +17,58 @@ (in-package :gtk-ffi) -(ffx:ff-defun-callable :cdecl :int drawing-expose-event-handler - ((drawing-area :pointer-void) (signal (* gdk-event-expose)) (data :pointer-void)) +(cffi:defcallback drawing-expose-event-handler :int + ((drawing-area :pointer) (signal :pointer) (data :pointer)) (declare (ignorable data signal gkd-event-expose widget)) - (bwhen (self (cgtk::gtk-object-find drawing-area)) - (cgtk::init-graphics-context drawing-area) - ;; POD This should draw the entire backing-pixmap - (gdk-draw-drawable - cgtk::*window* cgtk::*gcontext* - (funcall (funcall (intern "DRAW-FN" :cells-gtk) self) self) + (bwhen (self (gtk-object-find drawing-area)) + (init-graphics-context drawing-area) + (gdk-draw-drawable + *window* + *gcontext* + (funcall (funcall (intern "draw-fn" :cells-gtk) self) self) 0 0 0 0 -1 -1) - 0)) + 0)) - -(ffx:ff-defun-callable :cdecl :int drawing-button-events-handler - ((drawing-area :pointer-void) (signal (* gdk-event-button)) (data :pointer-void)) +(cffi:defcallback drawing-button-events-handler :int + ((drawing-area :pointer) (signal :pointer) (data :pointer)) (declare (ignorable data)) - (bwhen (self (cgtk::gtk-object-find drawing-area)) + (bwhen (self (gtk-object-find drawing-area)) (let ((event (gdk-event-button-type signal))) - (when (and (eql (event-type event) :button_press) - (= (gdk-event-button-button signal) 1)) - (setf (cgtk::button1-down self) (cons (truncate (gdk-event-button-x signal)) - (truncate (gdk-event-button-y signal))))) - (when (and (eql (event-type event) :button_release) - (= (gdk-event-button-button signal) 1)) - (setf (cgtk::button1-down self) nil)))) + (when (and (eql (event-type event) :button_press) + (= (gdk-event-button-button signal) 1)) + (setf (button1-down self) + (cons (truncate (gdk-event-button-x signal)) + (truncate (gdk-event-button-y signal))))) + (when (and (eql (event-type event) :button_release) + (= (gdk-event-button-button signal) 1)) + (setf (button1-down self) nil)))) 0) -(ffx:ff-defun-callable :cdecl :int drawing-pointer-motion-handler - ((drawing-area :pointer-void) (signal (* gdk-event-motion)) (data :pointer-void)) + +(cffi:defcallback drawing-pointer-motion-handler :int + ((drawing-area :pointer) (signal :pointer) (data :pointer)) (declare (ignorable data signal widget)) - (bwhen (self (cgtk::gtk-object-find drawing-area)) - (bwhen (button1 (cgtk::button1-down self)) - (let ((dx (- (truncate (gdk-event-motion-x signal)) (car button1))) - (dy (- (truncate (gdk-event-motion-y signal)) (cdr button1)))) - ;; POD NYI this should drag the thing closest to pointer, and redraw around it. - (loop for drawable being the hash-value of (cgtk::gobjects self) do - (gdk-draw-drawable cgtk::*window* cgtk::*gcontext* drawable 0 0 dx dy -1 -1))))) + (bwhen (self (gtk-object-find drawing-area)) + (bwhen (button1 (button1-down self)) + (let ((dx (- (truncate (gdk-event-motion-x signal)) (car button1))) + (dy(- (truncate (gdk-event-motion-y signal)) (cdr button1)))) + (loop for drawable being the hash-value of (gobjects self) do + (gdk-draw-drawable *window* *gcontext* drawable 0 0 dx dy -1 -1))))) 0) + (defun gtk-drawing-set-handlers (widget data) (gtk-signal-connect-swap widget "button-press-event" - (ffx:ff-register-callable 'drawing-button-events-handler) + (cffi:get-callback 'drawing-button-events-handler) :data data) (gtk-signal-connect-swap widget "button-release-event" - (ffx:ff-register-callable 'drawing-button-events-handler) + (cffi:get-callback 'drawing-button-events-handler) :data data) (gtk-signal-connect-swap widget "motion-notify-event" - (ffx:ff-register-callable 'drawing-pointer-motion-handler) + (cffi:get-callback 'drawing-pointer-motion-handler) :data data) (gtk-signal-connect-swap widget "expose-event" - (ffx:ff-register-callable 'drawing-expose-event-handler) + (cffi:get-callback 'drawing-expose-event-handler) :data data)) (export '(gtk-drawing-set-handlers))

1 0

2024

2023

2022

2021

2020

2019

2018

2017

2016

2015

2014

2013

2012

2011

2010

2009

2008

2007

2006

2005

2004

cells-gtk-cvs February 2006