Author: junrue Date: Thu Mar 29 20:05:44 2007 New Revision: 448

Modified: branches/graphic-forms-newtypes/src/uitoolkit/system/user32.lisp branches/graphic-forms-newtypes/src/uitoolkit/widgets/display.lisp branches/graphic-forms-newtypes/src/uitoolkit/widgets/thread-context.lisp branches/graphic-forms-newtypes/src/uitoolkit/widgets/window.lisp Log: completed change-over to stdcall support offered by CFFI

Modified: branches/graphic-forms-newtypes/src/uitoolkit/system/user32.lisp ============================================================================== --- branches/graphic-forms-newtypes/src/uitoolkit/system/user32.lisp (original) +++ branches/graphic-forms-newtypes/src/uitoolkit/system/user32.lisp Thu Mar 29 20:05:44 2007 @@ -34,7 +34,9 @@ (in-package :graphic-forms.uitoolkit.system)

(eval-when (:compile-toplevel :load-toplevel :execute) - (use-package :cffi)) + (use-package :cffi) +#+cffi-features:no-stdcall + (error "Graphic-Forms requires stdcall support enabled in CFFI."))

(load-foreign-library "user32.dll")

@@ -206,7 +208,6 @@ (hwnd HANDLE) (ps LPTR))

-#-cffi-features:no-stdcall (defcfun ("EnumChildWindows" enum-child-windows :cconv :stdcall) INT @@ -214,15 +215,6 @@ (func :pointer) (lparam LPARAM))

-#+lispworks -(fli:define-foreign-function - (enum-child-windows "EnumChildWindows") - ((hwnd :pointer) - (func :pointer) - (lparam :long)) - :result-type :int) - -#-cffi-features:no-stdcall (defcfun ("EnumDisplayMonitors" enum-display-monitors :cconv :stdcall) INT @@ -231,16 +223,6 @@ (enumproc LPTR) (data LPARAM))

-#+lispworks -(fli:define-foreign-function - (enum-display-monitors "EnumDisplayMonitors") - ((hdc :pointer) - (cliprect :pointer) - (enumproc :pointer) - (data :long)) - :result-type :int) - -#-cffi-features:no-stdcall (defcfun ("EnumThreadWindows" enum-thread-windows :cconv :stdcall) INT @@ -248,14 +230,6 @@ (func :pointer) (lparam LPARAM))

-#+lispworks -(fli:define-foreign-function - (enum-thread-windows "EnumThreadWindows") - ((threadid (:unsigned :long)) - (func :pointer) - (lparam :long)) - :result-type :int) - (defcfun ("GetAncestor" get-ancestor) HANDLE

Modified: branches/graphic-forms-newtypes/src/uitoolkit/widgets/display.lisp ============================================================================== --- branches/graphic-forms-newtypes/src/uitoolkit/widgets/display.lisp (original) +++ branches/graphic-forms-newtypes/src/uitoolkit/widgets/display.lisp Thu Mar 29 20:05:44 2007 @@ -37,30 +37,16 @@ ;;; helper functions ;;;

-#-cffi-features:no-stdcall (cffi:defcallback (display-visitor :cconv :stdcall) gfs::BOOL ((hmonitor :pointer) (hdc :pointer) (monitorrect :pointer) (data gfs::LPARAM)) (declare (ignore hdc monitorrect)) (call-display-visitor-func (thread-context) hmonitor data) 1)

-#+lispworks -(fli:define-foreign-callable - ("display_visitor" :result-type :integer :calling-convention :stdcall) - ((hmonitor :pointer) - (hdc :pointer) - (monitorrect :pointer) - (data :long)) - (declare (ignore hdc monitorrect)) - (call-display-visitor-func (thread-context) hmonitor data) - 1) - (defun query-display-info (hmonitor) (let ((info nil)) (cffi:with-foreign-object (mi-ptr 'gfs::monitorinfoex) - (cffi:with-foreign-slots ((gfs::cbsize gfs::monitor gfs::work - gfs::flags gfs::device) - mi-ptr gfs::monitorinfoex) + (cffi:with-foreign-slots ((gfs::cbsize gfs::flags) mi-ptr gfs::monitorinfoex) (setf gfs::cbsize (cffi:foreign-type-size 'gfs::monitorinfoex)) (if (zerop (gfs::get-monitor-info hmonitor mi-ptr)) (error 'gfs:win32-warning :detail "get-monitor-info failed")) @@ -88,13 +74,9 @@ (let ((tc (thread-context))) (setf (display-visitor-func tc) func) (unwind-protect -#-cffi-features:no-stdcall (gfs::enum-display-monitors (cffi:null-pointer) (cffi:null-pointer) (cffi:callback display-visitor) 0) -#+lispworks - (let ((ptr (fli:make-pointer :address 0))) - (gfs::enum-display-monitors ptr ptr (fli:make-pointer :symbol-name "display_visitor") 0)) (setf (display-visitor-func tc) nil)) (let ((tmp (reverse (display-visitor-results tc)))) (setf (display-visitor-results tc) nil) @@ -109,7 +91,6 @@ (defun obtain-primary-display () (find-if #'primary-p (obtain-displays)))

-#-cffi-features:no-stdcall (cffi:defcallback (top-level-window-visitor :cconv :stdcall) gfs::BOOL ((hwnd :pointer) (lparam gfs::LPARAM)) (declare (ignore lparam)) @@ -119,14 +100,6 @@ (call-top-level-visitor-func tc win))) 1)

-#+lispworks -(fli:define-foreign-callable - ("top_level_window_visitor" :result-type :integer :calling-convention :stdcall) - ((hwnd :pointer) - (lparam :long)) - (top-level-window-visitor hwnd lparam) - 1) - (defun maptoplevels (func) ;; ;; func should expect one parameter: @@ -135,14 +108,9 @@ (let ((tc (thread-context))) (setf (top-level-visitor-func tc) func) (unwind-protect -#-cffi-features:no-stdcall (gfs::enum-thread-windows (gfs::get-window-thread-process-id (utility-hwnd tc) (cffi:null-pointer)) (cffi:callback top-level-window-visitor) 0) -#+lispworks - (gfs::enum-thread-windows (gfs::get-window-thread-process-id (utility-hwnd tc) (cffi:null-pointer)) - (fli:make-pointer :symbol-name "top_level_window_visitor") - 0) (setf (top-level-visitor-func tc) nil)) (let ((tmp (reverse (top-level-visitor-results tc)))) (setf (top-level-visitor-results tc) nil)

Modified: branches/graphic-forms-newtypes/src/uitoolkit/widgets/thread-context.lisp ============================================================================== --- branches/graphic-forms-newtypes/src/uitoolkit/widgets/thread-context.lisp (original) +++ branches/graphic-forms-newtypes/src/uitoolkit/widgets/thread-context.lisp Thu Mar 29 20:05:44 2007 @@ -1,7 +1,7 @@ ;;;; ;;;; thread-context.lisp ;;;; -;;;; Copyright (C) 2006, Jack D. Unrue +;;;; Copyright (C) 2006-2007, Jack D. Unrue ;;;; All rights reserved. ;;;; ;;;; Redistribution and use in source and binary forms, with or without

Modified: branches/graphic-forms-newtypes/src/uitoolkit/widgets/window.lisp ============================================================================== --- branches/graphic-forms-newtypes/src/uitoolkit/widgets/window.lisp (original) +++ branches/graphic-forms-newtypes/src/uitoolkit/widgets/window.lisp Thu Mar 29 20:05:44 2007 @@ -70,7 +70,6 @@ (if (and parent (layout-of parent)) (append-layout-item (layout-of parent) win)))))

-#-cffi-features:no-stdcall (cffi:defcallback (child-window-visitor :cconv :stdcall) gfs::BOOL ((hwnd :pointer) (lparam gfs::LPARAM)) (let* ((tc (thread-context)) @@ -83,14 +82,6 @@ (setf (child-visitor-results tc) (push (call-child-visitor-func tc parent child) tmp-list)))))) 1)

-#+lispworks -(fli:define-foreign-callable - ("child_window_visitor" :result-type :integer :calling-convention :stdcall) - ((hwnd :pointer) - (lparam :long)) - (child-window-visitor hwnd lparam) - 1) - (defun window-class-registered-p (class-name) (cffi:with-foreign-string (str-ptr class-name) (cffi:with-foreign-object (wc-ptr 'gfs::wndclassex) @@ -326,14 +317,9 @@ (hwnd (gfs:handle self))) (setf (child-visitor-func tc) func) (unwind-protect -#-cffi-features:no-stdcall (gfs::enum-child-windows hwnd (cffi:callback child-window-visitor) (cffi:pointer-address hwnd)) -#+lispworks - (gfs::enum-child-windows hwnd - (fli:make-pointer :symbol-name "child_window_visitor") - (cffi:pointer-address hwnd)) (setf (child-visitor-func tc) nil)) (let ((tmp (reverse (child-visitor-results tc)))) (setf (child-visitor-results tc) nil)