[graphic-forms-cvs] r448 - in branches/graphic-forms-newtypes/src/uitoolkit: system widgets
junrue at common-lisp.net
junrue at common-lisp.net
Fri Mar 30 01:05:45 UTC 2007
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)
More information about the Graphic-forms-cvs
mailing list