Author: junrue Date: Sat Dec 16 23:12:03 2006 New Revision: 414
Modified: trunk/src/uitoolkit/system/user32.lisp trunk/src/uitoolkit/widgets/display.lisp trunk/src/uitoolkit/widgets/window.lisp Log: ACL port: fix mistakes in callback definitions
Modified: trunk/src/uitoolkit/system/user32.lisp ============================================================================== --- trunk/src/uitoolkit/system/user32.lisp (original) +++ trunk/src/uitoolkit/system/user32.lisp Sat Dec 16 23:12:03 2006 @@ -220,14 +220,6 @@ |#
#+allegro -(eval-when (:compile-toplevel :load-toplevel :execute) - (ff:defun-foreign-callable enum-child-windows-callback ((hwnd :foreign-address) - (lparam :long)) - (declare (:convention :stdcall))) - - (ff:register-foreign-callable 'enum-child-windows-callback :reuse t)) - -#+allegro (ff:def-foreign-call (enum-child-windows "EnumChildWindows") ((hwnd :foreign-address) (func :foreign-address) @@ -277,16 +269,6 @@ |#
#+allegro -(eval-when (:compile-toplevel :load-toplevel :execute) - (ff:defun-foreign-callable enum-display-monitors-callback ((hmonitor :foreign-address) - (hdc :foreign-address) - (monitorrect :foreign-address) - (data :long)) - (declare (:convention :stdcall))) - - (ff:register-foreign-callable 'enum-display-monitors-callback :reuse t)) - -#+allegro (ff:def-foreign-call (enum-display-monitors "EnumDisplayMonitors") ((hdc :foreign-address) (cliprect :foreign-address) @@ -341,14 +323,6 @@ |#
#+allegro -(eval-when (:compile-toplevel :load-toplevel :execute) - (ff:defun-foreign-callable enum-thread-windows-callback ((hwnd :foreign-address) - (lparam :long)) - (declare (:convention :stdcall))) - - (ff:register-foreign-callable 'enum-thread-windows-callback :reuse t)) - -#+allegro (ff:def-foreign-call (enum-thread-windows "EnumThreadWindows") ((thread-id :unsigned-long) (func :foreign-address)
Modified: trunk/src/uitoolkit/widgets/display.lisp ============================================================================== --- trunk/src/uitoolkit/widgets/display.lisp (original) +++ trunk/src/uitoolkit/widgets/display.lisp Sat Dec 16 23:12:03 2006 @@ -37,6 +37,23 @@ ;;; helper functions ;;;
+(defun display-visitor (hmonitor hdc monitorrect data) + (declare (ignore hdc monitorrect)) + (call-display-visitor-func (thread-context) hmonitor data) + 1) + +#+allegro +(eval-when (:compile-toplevel :load-toplevel :execute) + (ff:defun-foreign-callable enum-display-monitors-callback ((hmonitor :foreign-address) + (hdc :foreign-address) + (monitorrect :foreign-address) + (data :long)) + (declare (:convention :stdcall)) + (call-display-visitor-func (thread-context) hmonitor data)) + + (defvar *monitors-enum-proc* + (ff:register-foreign-callable 'enum-display-monitors-callback :reuse t))) + #+lispworks (fli:define-foreign-callable ("display_visitor" :result-type :integer :calling-convention :stdcall) @@ -48,11 +65,6 @@ (call-display-visitor-func (thread-context) hmonitor data) 1)
-(defun display-visitor (hmonitor hdc monitorrect data) - (declare (ignore hdc monitorrect)) - (call-display-visitor-func (thread-context) hmonitor data) - 1) - #+sbcl (defvar *monitors-enum-proc* (sb-alien::alien-callback @@ -97,7 +109,10 @@ (let ((tc (thread-context))) (setf (display-visitor-func tc) func) (unwind-protect -#+(or allegro clisp) +#+allegro + (let ((ptr (cffi:null-pointer))) + (gfs::enum-display-monitors ptr ptr (cffi:pointer-address *monitors-enum-proc*) 0)) +#+clisp (gfs::enum-display-monitors nil nil #'display-visitor nil) #+lispworks (let ((ptr (fli:make-pointer :address 0))) @@ -127,6 +142,16 @@ (call-top-level-visitor-func tc win))) 1)
+#+allegro +(eval-when (:compile-toplevel :load-toplevel :execute) + (ff:defun-foreign-callable enum-thread-windows-callback ((hwnd :foreign-address) + (lparam :long)) + (declare (:convention :stdcall)) + (top-level-window-visitor hwnd lparam)) + + (defvar *enum-thread-wnd-proc* + (ff:register-foreign-callable 'enum-thread-windows-callback :reuse t))) + #+lispworks (fli:define-foreign-callable ("top_level_window_visitor" :result-type :integer :calling-convention :stdcall) @@ -152,7 +177,11 @@ (let ((tc (thread-context))) (setf (top-level-visitor-func tc) func) (unwind-protect -#+(or allegro clisp) +#+allegro + (gfs::enum-child-windows (gfs::get-window-thread-process-id (utility-hwnd tc) (cffi:null-pointer)) + (cffi:pointer-address *enum-thread-wnd-proc*) + 0) +#+clisp (gfs::enum-child-windows (gfs::get-window-thread-process-id (utility-hwnd tc) (cffi:null-pointer)) #'top-level-window-visitor 0)
Modified: trunk/src/uitoolkit/widgets/window.lisp ============================================================================== --- trunk/src/uitoolkit/widgets/window.lisp (original) +++ trunk/src/uitoolkit/widgets/window.lisp Sat Dec 16 23:12:03 2006 @@ -79,6 +79,16 @@ (setf (child-visitor-results tc) (push (call-child-visitor-func tc parent child) tmp-list)))))) 1)
+#+allegro +(eval-when (:compile-toplevel :load-toplevel :execute) + (ff:defun-foreign-callable enum-child-windows-callback ((hwnd :foreign-address) + (lparam :long)) + (declare (:convention :stdcall)) + (child-window-visitor hwnd lparam)) + + (defvar *enum-child-proc* + (ff:register-foreign-callable 'enum-child-windows-callback :reuse t))) + #+lispworks (fli:define-foreign-callable ("child_window_visitor" :result-type :integer :calling-convention :stdcall) @@ -329,7 +339,11 @@ (hwnd (gfs:handle self))) (setf (child-visitor-func tc) func) (unwind-protect -#+(or allegro clisp) +#+allegro + (gfs::enum-child-windows hwnd + (cffi:pointer-address *enum-child-proc*) + (cffi:pointer-address hwnd)) +#+clisp (gfs::enum-child-windows hwnd #'child-window-visitor (cffi:pointer-address hwnd))