Author: junrue Date: Sun Feb 12 02:29:46 2006 New Revision: 6 Modified: trunk/src/uitoolkit/system/user32.lisp trunk/src/uitoolkit/widgets/widget-utils.lisp trunk/src/uitoolkit/widgets/window.lisp Log: cannot specific stdcall for CFFI callable funcs, use vendor-specific FFI instead for visit-child-widgets Modified: trunk/src/uitoolkit/system/user32.lisp ============================================================================== --- trunk/src/uitoolkit/system/user32.lisp (original) +++ trunk/src/uitoolkit/system/user32.lisp Sun Feb 12 02:29:46 2006 @@ -116,12 +116,40 @@ (hwnd HANDLE) (ps LPTR)) +;;; FIXME: uncomment this when CFFI callbacks can +;;; be tagged as stdcall or cdecl (only the latter +;;; is supported as of 0.9.0) +;;; +#| (defcfun ("EnumChildWindows" enum-child-windows) BOOL (hwnd HANDLE) (func :pointer) (lparam LPARAM)) +|# + +#+lispworks +(fli:define-foreign-function + (enum-child-windows "EnumChildWindows" :result-type :int) + ((hwnd :pointer) + (func :pointer) + (lparam :long))) + +#+clisp +(ffi:def-call-out enum-child-windows + (:name "EnumChildWindows") + (:library "user32.dll") + (:language :stdc) + (:arguments (hwnd ffi:c-pointer) + (func (ffi:c-function + (:arguments + (hwnd ffi:c-pointer) + (lparam ffi:long)) + (:return-type ffi:int) + (:language :stdc-stdcall))) + (lparam ffi:long)) + (:return-type ffi:int)) (defcfun ("GetAsyncKeyState" get-async-key-state) Modified: trunk/src/uitoolkit/widgets/widget-utils.lisp ============================================================================== --- trunk/src/uitoolkit/widgets/widget-utils.lisp (original) +++ trunk/src/uitoolkit/widgets/widget-utils.lisp Sun Feb 12 02:29:46 2006 @@ -79,6 +79,7 @@ (hwnd (gfi:handle w)) (len (gfs::get-window-text-length hwnd))) (unless (zerop len) + (incf len) (let ((str-ptr (cffi:foreign-alloc :char :count len))) (unwind-protect (unless (zerop (gfs::get-window-text hwnd str-ptr len)) Modified: trunk/src/uitoolkit/widgets/window.lisp ============================================================================== --- trunk/src/uitoolkit/widgets/window.lisp (original) +++ trunk/src/uitoolkit/widgets/window.lisp Sun Feb 12 02:29:46 2006 @@ -43,15 +43,21 @@ ;;; helper functions ;;; -;; FIXME: causes GPF -;; -(cffi:defcallback child_hwnd_collector - gfs::BOOL - ((hwnd gfs::HANDLE) - (lparam gfs::LPARAM)) +#+lispworks +(fli:define-foreign-callable + ("child_window_visitor" :result-type :integer :calling-convention :stdcall) + ((hwnd :pointer) + (lparam :long)) (let ((w (get-widget hwnd))) (unless (or (null w) (null *child-visiting-functions*)) - (funcall (car *child-visiting-functions*) w lparam))) + (funcall (first *child-visiting-functions*) w lparam))) + 1) + +#+clisp +(defun child_window_visitor (hwnd lparam) + (let ((w (get-widget hwnd))) + (unless (or (null w) (null *child-visiting-functions*)) + (funcall (first *child-visiting-functions*) w lparam))) 1) (defun visit-child-widgets (win func val) @@ -62,7 +68,17 @@ ;; (push func *child-visiting-functions*) (unwind-protect - (gfs::enum-child-windows (gfi:handle win) (cffi:get-callback 'child_hwnd_collector) val) +#+lispworks (gfs::enum-child-windows (fli:make-pointer :address (cffi:pointer-address (gfi:handle win))) + (fli:make-pointer :symbol-name "child_window_visitor") + 0) +#+clisp (let ((ptr (ffi:foreign-pointer (ffi:unsigned-foreign-address 0)))) + (setf ptr (ffi:set-foreign-pointer + (ffi:unsigned-foreign-address + (cffi:pointer-address (gfi:handle win))) + ptr)) + (gfs::enum-child-windows ptr + #'child_window_visitor + 0)) (pop *child-visiting-functions*))) (defun register-window-class (class-name proc-ptr st)