Skip to content
Snippets Groups Projects
Commit 01307ad9 authored by layer's avatar layer
Browse files

2006-03-29 <layer@HOBART>

parent e704fc7b
No related branches found
No related tags found
No related merge requests found
2006-03-29 <layer@HOBART>
* aclpc/acl-class.lisp: get rid of a LOT of unused code
(functions, types, specials). In some cases, I commented the
code out, in case it is useful for debugging.
* aclpc/acl-frames.lisp: use winapi types for browse-callback-proc
to insure it works on 64-bits
2006-03-28 <layer@HOBART> 2006-03-28 <layer@HOBART>
* aclpc/acl-class.lisp: update arglist for wproc-clim-wrapper, * aclpc/acl-class.lisp: update arglist for wproc-clim-wrapper,
...@@ -6011,4 +6019,4 @@ IGNORE JDI SPECIFIC CHANGES TO Makefile ...@@ -6011,4 +6019,4 @@ IGNORE JDI SPECIFIC CHANGES TO Makefile
Lots of other stuff Lots of other stuff
******************************************************************************* *******************************************************************************
$Revision: 2.14 $ $Revision: 2.15 $
...@@ -17,7 +17,7 @@ ...@@ -17,7 +17,7 @@
;; Commercial Software developed at private expense as specified in ;; Commercial Software developed at private expense as specified in
;; DOD FAR Supplement 52.227-7013 (c) (1) (ii), as applicable. ;; DOD FAR Supplement 52.227-7013 (c) (1) (ii), as applicable.
;; ;;
;; $Id: acl-class.lisp,v 2.10 2006/03/29 00:32:30 layer Exp $ ;; $Id: acl-class.lisp,v 2.11 2006/03/29 16:21:49 layer Exp $
#|**************************************************************************** #|****************************************************************************
* * * *
...@@ -98,21 +98,8 @@ ...@@ -98,21 +98,8 @@
(defparameter application-icon (defparameter application-icon
(ff:allocate-fobject 'win:hicon :foreign-static-gc nil)) (ff:allocate-fobject 'win:hicon :foreign-static-gc nil))
;; window procedure unwinding state ;;;;; window procedure args, rebound in each call to window proc
(defvar *window-proc-return-reason* nil) ;;;(defvar *hwnd* 0)
(defvar *window-proc-return-tag* nil)
(defvar *window-proc-return-value* nil)
(defvar *window-proc-return-other-values* nil)
;; window procedure args, rebound in each call to window proc
(defvar *hwnd* 0)
(defvar *msg* win:WM_NULL)
(defvar *wparam* 0)
(defvar *lparam* (ct:callocate :long))
;; Window procedure result variable, returned to Windows.
;; Set to 0 initially in each call to window proc and smashed by anyone.
(defvar *window-proc-result* 0)
;; to avoid garbage we reuse window procedure args from queue
(defvar *window-proc-args-queue* nil)
(defun init-cursors () (defun init-cursors ()
;; put back old cursor mechanism for the moment (cim 9/13/96) ;; put back old cursor mechanism for the moment (cim 9/13/96)
...@@ -126,68 +113,25 @@ ...@@ -126,68 +113,25 @@
(check-last-error "LoadIcon" :action :warn)) (check-last-error "LoadIcon" :action :warn))
t) t)
;;; Gather up the argument information and invoke the window procedure. ;;;(defvar *clim-wproc-arg-struct* nil)
;;; +++ at some point merge this in with the cg mechanism for lisp ;;;(defvar *clim-ctrl-arg-struct* nil)
;;; windows. ;;;(defvar *tooltip-relay-struct* nil)
(defun clim-window-proc (x)
(declare (ignore x))
;; always return *window-proc-result* to the kernel as a cpointer
(let ((result 0))
(setf result *window-proc-result*)
;; return result
result))
(defvar *clim-wproc-arg-struct* nil)
(defvar *clim-ctrl-arg-struct* nil)
(defvar *tooltip-relay-struct* nil)
(defstruct (pccstructure
(:print-function print-pccstructure)
(:predicate pccstructurep))
(type-tag 0)
(data-length 0)
(data-pointer 0)
)
(defmacro long-ref (p i)
`(sys::memref-int ,p 0
(the fixnum (* 4 (the fixnum ,i)))
:unsigned-long))
(defmacro signed-long-ref (p i)
`(sys::memref-int ,p 0
(the fixnum (* 4 (the fixnum ,i)))
:signed-long))
;; [rfe4951]:
(ff:defun-foreign-callable wproc-clim-wrapper ((hwnd win:hwnd)
(message win:uint)
(wparam win:wparam)
(lparam win:lparam))
(let* ((s *clim-wproc-arg-struct*)
(d (pccstructure-data-pointer s)))
(setf (long-ref d 0) hwnd
(long-ref d 1) message
(long-ref d 2) wparam
(signed-long-ref d 3) lparam)
(clim-window-proc s)
))
(defun init-clim-win-proc (wproc-address arg-struct) (defun init-clim-win-proc (wproc-address arg-struct)
(declare (ignore wproc-address)) (declare (ignore wproc-address arg-struct))
(setf *clim-wproc-arg-struct* arg-struct) ;;; (setf *clim-wproc-arg-struct* arg-struct)
;; [rfe4951]: ;; [rfe4951]:
(ff:register-foreign-callable 'clim-wind-proc :reuse :return-value)) (ff:register-foreign-callable 'clim-wind-proc :reuse :return-value))
(defun init-tooltip-relay (wproc-address arg-struct) (defun init-tooltip-relay (wproc-address arg-struct)
(declare (ignore wproc-address)) (declare (ignore wproc-address arg-struct))
(setf *tooltip-relay-struct* arg-struct) ;;; (setf *tooltip-relay-struct* arg-struct)
;; [rfe4951]: ;; [rfe4951]:
(ff:register-foreign-callable 'tooltip-relay :reuse :return-value)) (ff:register-foreign-callable 'tooltip-relay :reuse :return-value))
(defun init-clim-ctrl-proc (wproc-address arg-struct) (defun init-clim-ctrl-proc (wproc-address arg-struct)
(declare (ignore wproc-address)) (declare (ignore wproc-address arg-struct))
(setf *clim-ctrl-arg-struct* arg-struct) ;;; (setf *clim-ctrl-arg-struct* arg-struct)
;; [rfe4951]: ;; [rfe4951]:
(ff:register-foreign-callable 'clim-ctrl-proc :reuse :return-value)) (ff:register-foreign-callable 'clim-ctrl-proc :reuse :return-value))
...@@ -945,7 +889,7 @@ ...@@ -945,7 +889,7 @@
(optimize (safety 0) (speed 3))) (optimize (safety 0) (speed 3)))
(let ((result 0) (let ((result 0)
(*level* (1+ (the fixnum *level*)))) (*level* (1+ (the fixnum *level*))))
(setf *hwnd* window) ;;; (setf *hwnd* window)
;; FYI: Spy++ does a better job of tracing messages, ;; FYI: Spy++ does a better job of tracing messages,
;; though it doesn't report everything. ;; though it doesn't report everything.
(mformat *windows-message-trace-output* (mformat *windows-message-trace-output*
...@@ -1046,7 +990,7 @@ ...@@ -1046,7 +990,7 @@
(lparam win:lparam)) (lparam win:lparam))
(declare (:convention :stdcall) (:unwind 0)) (declare (:convention :stdcall) (:unwind 0))
(mp:without-scheduling (mp:without-scheduling
(setf *hwnd* window) ;;; (setf *hwnd* window)
(mformat excl:*initial-terminal-io* (mformat excl:*initial-terminal-io*
"In clim-ctrl-proc msg=~a sheet=~s~%" "In clim-ctrl-proc msg=~a sheet=~s~%"
(msg-name msg) (mirror->sheet *acl-port* window)) (msg-name msg) (mirror->sheet *acl-port* window))
...@@ -1572,19 +1516,10 @@ ...@@ -1572,19 +1516,10 @@
(setq *modstate* (make-modstate)) (setq *modstate* (make-modstate))
(setq *ctlmodstate* (make-modstate)) (setq *ctlmodstate* (make-modstate))
(setq *win-result* 0) (setq *win-result* 0)
(setq *window-proc-return-reason* nil) ;;; (setq *hwnd* 0)
(setq *window-proc-return-tag* nil) ;;; (setq *clim-wproc-arg-struct* nil)
(setq *window-proc-return-value* nil) ;;; (setq *clim-ctrl-arg-struct* nil)
(setq *window-proc-return-other-values* nil) ;;; (setq *tooltip-relay-struct* nil)
(setq *hwnd* 0)
(setq *msg* win:WM_NULL)
(setq *wparam* 0)
(setq *lparam* (ct:callocate :long))
(setq *window-proc-result* 0)
(setq *window-proc-args-queue* nil)
(setq *clim-wproc-arg-struct* nil)
(setq *clim-ctrl-arg-struct* nil)
(setq *tooltip-relay-struct* nil)
(setq *level* 0) (setq *level* 0)
(setq *realtime-scrollbar-tracking* t) (setq *realtime-scrollbar-tracking* t)
(setq *win-scroll-grain* 1000) (setq *win-scroll-grain* 1000)
......
...@@ -17,7 +17,7 @@ ...@@ -17,7 +17,7 @@
;; Commercial Software developed at private expense as specified in ;; Commercial Software developed at private expense as specified in
;; DOD FAR Supplement 52.227-7013 (c) (1) (ii), as applicable. ;; DOD FAR Supplement 52.227-7013 (c) (1) (ii), as applicable.
;; ;;
;; $Id: acl-frames.lisp,v 2.8 2005/12/08 21:25:41 layer Exp $ ;; $Id: acl-frames.lisp,v 2.9 2006/03/29 16:21:49 layer Exp $
#|**************************************************************************** #|****************************************************************************
* * * *
...@@ -2200,12 +2200,12 @@ in a second Lisp process. This frame cannot be reused." ...@@ -2200,12 +2200,12 @@ in a second Lisp process. This frame cannot be reused."
(defconstant BFFM_SETSTATUSTEXT BFFM_SETSTATUSTEXTW) (defconstant BFFM_SETSTATUSTEXT BFFM_SETSTATUSTEXTW)
(defconstant BFFM_SETSELECTION BFFM_SETSELECTIONW) (defconstant BFFM_SETSELECTION BFFM_SETSELECTIONW)
;; The the docs for the `BrowseCallbackProc' function.
(ff:defun-foreign-callable browse-callback-proc (ff:defun-foreign-callable browse-callback-proc
((hwnd win:hwnd) ((hwnd win:hwnd)
(message :unsigned-int) (message win:uint)
(lparam :long) (lparam win:lparam)
(lparam-data :long)) (lparam-data win:lparam))
(declare (:convention :stdcall) (:unwind 0) (declare (:convention :stdcall) (:unwind 0)
(ignore lparam)) (ignore lparam))
(when (and (= message BFFM_INITIALIZED) (when (and (= message BFFM_INITIALIZED)
......
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment