Skip to content
GitLab
Explore
Sign in
Register
Primary navigation
Search or go to…
Project
C
clim-tos
Manage
Activity
Members
Labels
Plan
Issues
Issue boards
Milestones
Wiki
Code
Merge requests
Repository
Branches
Commits
Tags
Repository graph
Compare revisions
Snippets
Build
Pipelines
Jobs
Pipeline schedules
Artifacts
Deploy
Releases
Container Registry
Model registry
Operate
Environments
Monitor
Incidents
Service Desk
Analyze
Value stream analytics
Contributor analytics
CI/CD analytics
Repository analytics
Model experiments
Help
Help
Support
GitLab documentation
Compare GitLab plans
Community forum
Contribute to GitLab
Provide feedback
Terms and privacy
Keyboard shortcuts
?
Snippets
Groups
Projects
Show more breadcrumbs
Alastair Bridgewater
clim-tos
Commits
01307ad9
Commit
01307ad9
authored
19 years ago
by
layer
Browse files
Options
Downloads
Patches
Plain Diff
2006-03-29 <layer@HOBART>
parent
e704fc7b
No related branches found
No related tags found
No related merge requests found
Changes
3
Hide whitespace changes
Inline
Side-by-side
Showing
3 changed files
ChangeLog.n
+9
-1
9 additions, 1 deletion
ChangeLog.n
aclpc/acl-class.lisp
+18
-83
18 additions, 83 deletions
aclpc/acl-class.lisp
aclpc/acl-frames.lisp
+6
-6
6 additions, 6 deletions
aclpc/acl-frames.lisp
with
33 additions
and
90 deletions
ChangeLog.n
+
9
−
1
View file @
01307ad9
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.1
4
$
$Revision: 2.1
5
$
This diff is collapsed.
Click to expand it.
aclpc/acl-class.lisp
+
18
−
83
View file @
01307ad9
...
@@ -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.1
0
2006/03/29
00:32:30
layer Exp $
;; $Id: acl-class.lisp,v 2.1
1
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
)
...
...
This diff is collapsed.
Click to expand it.
aclpc/acl-frames.lisp
+
6
−
6
View file @
01307ad9
...
@@ -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
200
5/12/08 21
:2
5
:4
1
layer Exp $
;; $Id: acl-frames.lisp,v 2.
9
200
6/03/29 16
:2
1
:4
9
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:u
int
)
(
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
)
...
...
This diff is collapsed.
Click to expand it.
Preview
0%
Loading
Try again
or
attach a new file
.
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Save comment
Cancel
Please
register
or
sign in
to comment