[graphic-forms-cvs] r449 - in trunk/src/uitoolkit: system widgets

junrue at common-lisp.net junrue at common-lisp.net
Fri Mar 30 01:05:58 UTC 2007


Author: junrue
Date: Thu Mar 29 20:05:58 2007
New Revision: 449

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

Modified: trunk/src/uitoolkit/system/user32.lisp
==============================================================================
--- trunk/src/uitoolkit/system/user32.lisp	(original)
+++ trunk/src/uitoolkit/system/user32.lisp	Thu Mar 29 20:05:58 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: trunk/src/uitoolkit/widgets/display.lisp
==============================================================================
--- trunk/src/uitoolkit/widgets/display.lisp	(original)
+++ trunk/src/uitoolkit/widgets/display.lisp	Thu Mar 29 20:05:58 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,13 +108,8 @@
   (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))))

Modified: trunk/src/uitoolkit/widgets/thread-context.lisp
==============================================================================
--- trunk/src/uitoolkit/widgets/thread-context.lisp	(original)
+++ trunk/src/uitoolkit/widgets/thread-context.lisp	Thu Mar 29 20:05:58 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: trunk/src/uitoolkit/widgets/window.lisp
==============================================================================
--- trunk/src/uitoolkit/widgets/window.lisp	(original)
+++ trunk/src/uitoolkit/widgets/window.lisp	Thu Mar 29 20:05:58 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)



More information about the Graphic-forms-cvs mailing list