/[cells]/Celtk/tk-structs.lisp
ViewVC logotype

Contents of /Celtk/tk-structs.lisp

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.8 - (show annotations)
Mon Jun 16 12:35:56 2008 UTC (5 years, 10 months ago) by ktilton
Branch: MAIN
CVS Tags: HEAD
Changes since 1.7: +2 -0 lines
Notebook.lisp from Andy and random other recent work
1 ;; -*- mode: Lisp; Syntax: Common-Lisp; Package: cells; -*-
2 #|
3
4 Celtk -- Cells, Tcl, and Tk
5
6 Copyright (C) 2006 by Kenneth Tilton
7
8 This library is free software; you can redistribute it and/or
9 modify it under the terms of the Lisp Lesser GNU Public License
10 (http://opensource.franz.com/preamble.html), known as the LLGPL.
11
12 This library is distributed WITHOUT ANY WARRANTY; without even
13 the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
14
15 See the Lisp Lesser GNU Public License for more details.
16
17 |#
18
19 (in-package :celtk)
20
21
22 (defctype Window :unsigned-long) ;; <sigh> The XWindow pointer stored in the tkwin record
23 (defctype Time :unsigned-long)
24 (defctype Tk_Uid :string)
25
26 (defcstruct tk-fake-win
27 "Used by macros to peek at tkwins (why use a fake window definition?)"
28 (display :pointer)
29 (dummy1 :pointer)
30 (screen-num :int)
31 (visual :pointer)
32 (depth :int)
33 (window Window)
34 (dummy2 :pointer)
35 (dummy3 :pointer)
36 (parent-ptr Window)
37 (dummy4 :pointer)
38 (dummy5 :pointer)
39 (pathName :string)
40 ;;; Tk_Uid nameUid;
41 ;;; Tk_Uid classUid;
42 ;;; XWindowChanges changes;
43 ;;; unsigned int dummy6; /* dirtyChanges */
44 ;;; XSetWindowAttributes atts;
45 ;;; unsigned long dummy7; /* dirtyAtts */
46 ;;; unsigned int flags;
47 ;;; char *dummy8; /* handlerList */
48 ;;;#ifdef TK_USE_INPUT_METHODS
49 ;;; XIC dummy9; /* inputContext */
50 ;;;#endif /* TK_USE_INPUT_METHODS */
51 ;;; ClientData *dummy10; /* tagPtr */
52 ;;; int dummy11; /* numTags */
53 ;;; int dummy12; /* optionLevel */
54 ;;; char *dummy13; /* selHandlerList */
55 ;;; char *dummy14; /* geomMgrPtr */
56 ;;; ClientData dummy15; /* geomData */
57 ;;; int reqWidth, reqHeight;
58 ;;; int internalBorderLeft;
59 ;;; char *dummy16; /* wmInfoPtr */
60 ;;; char *dummy17; /* classProcPtr */
61 ;;; ClientData dummy18; /* instanceData */
62 ;;; char *dummy19; /* privatePtr */
63 ;;; int internalBorderRight;
64 ;;; int internalBorderTop;
65 ;;; int internalBorderBottom;
66 ;;; int minReqWidth;
67 ;;; int minReqHeight;
68 )
69
70 (defun tkwin-pathname (tkwin)
71 (foreign-slot-value tkwin 'tk-fake-win 'pathname))
72
73 (defun tkwin-window (tkwin)
74 "Get the (different!) XWindow pointer from the tkwin data structure.
75 Note that the Xwindow structure is not allocated straight away, not until
76 (I guess) the XWindow server has gotten involved with the widget."
77 (foreign-slot-value tkwin 'tk-fake-win 'window))
78
79 #|
80 typedef struct {
81 int type;
82 unsigned long serial; /* # of last request processed by server */
83 Bool send_event; /* True if this came from a SendEvent request */
84 Display *display; /* Display the event was read from */
85 Window event; /* Window on which event was requested. */
86 Window root; /* root window that the event occured on */
87 Window subwindow; /* child window */
88 Time time; /* milliseconds */
89 int x, y; /* pointer x, y coordinates in event window */
90 int x_root, y_root; /* coordinates relative to root */
91 unsigned int state; /* key or button mask */
92 Tk_Uid name; /* Name of virtual event. */
93 Bool same_screen; /* same screen flag */
94 Tcl_Obj *user_data; /* application-specific data reference; Tk will
95 * decrement the reference count *once* when it
96 * has finished processing the event. */
97 } XVirtualEvent;
98 |#
99
100 (defcstruct x-virtual-event
101 "common event fields"
102 (type :int)
103 (serial :unsigned-long)
104 (send-event :boolean)
105 (display :pointer)
106 (event-window Window)
107 (root-window Window)
108 (sub-window Window)
109 (time Time)
110 (x :int)
111 (y :int)
112 (x-root :int)
113 (y-root :int)
114 (state :unsigned-int)
115 (name :string)
116 (same-screen :boolean)
117 (user-data :pointer)
118 )
119
120 (defmacro xsv (slot-name xptr)
121 `(foreign-slot-value ,xptr 'X-Virtual-Event ',slot-name))
122
123 (defun myx (xe)
124 (xsv x xe))
125 (defmacro xke (slot-name xptr)
126 `(foreign-slot-value ,xptr 'x-key-event ',slot-name))
127
128 (export! xevent-type)
129 (defun xevent-type (xe)
130 (tk-event-type (xsv type xe)))
131
132 ;; -------------------------------------------
133
134 (defcstruct x-key-event
135 "X key Event"
136 (xke-header x-virtual-event)
137 (trans-char-0 :char)
138 (trans-char-1 :char)
139 (trans-char-2 :char)
140 (trans-char-3 :char))
141
142 (defcstruct x-button-event
143 "common event fields"
144 (type :int)
145 (serial :unsigned-long)
146 (send-event :boolean)
147 (display :pointer)
148 (event-window Window)
149 (root-window Window)
150 (sub-window Window)
151 (time Time)
152 (x :int)
153 (y :int)
154 (x-root :int)
155 (y-root :int)
156 (state :unsigned-int)
157 (button :unsigned-int)
158 (same-screen :boolean))
159
160 (defmacro xbe (slot-name xptr)
161 `(foreign-slot-value ,xptr 'x-button-event ',slot-name))
162
163 (defun xbe-x (xbe) (xbe x xbe))
164 (defun xbe-y (xbe) (xbe y xbe))
165 (defun xbe-button (xbe) (xbe button xbe))
166 (export! xbe-x xbe-y xbe-button xbe)
167
168 ;; --------------------------------------------
169
170 (defcenum tcl-event-flag-values
171 (:tcl-dont-wait 2)
172 (:tcl-window-events 4)
173 (:tcl-file-events 8)
174 (:tcl-timer-events 16)
175 (:tcl-idle-events 32)
176 (:tcl-all-events -3))
177
178 (defcenum tcl-variable-related-flag
179 "flags passed to getvar, setvar, tracevar, etc"
180 (:tcl-global-only 1)
181 (:tcl-namespace-only 2)
182 (:tcl-append-value 4)
183 (:tcl-list-element 8)
184 (:tcl-trace-reads #x10)
185 (:tcl-trace-writes #x20)
186 (:tcl-trace-unsets #x40)
187 (:tcl-trace-destroyed #x80)
188 (:tcl-interp-destroyed #x100)
189 (:tcl-leave-err-msg #x200)
190 (:tcl-trace-array #x800)
191 ;; required to support old variable/vdelete/vinfo traces */
192 (:tcl-trace-old-style #x1000)
193 ;; indicate the semantics of the result of a trace */
194 (:tcl-trace-result-dynamic #x8000)
195 (:tcl-trace-result-object #x10000))
196
197 (defun var-flags (&rest kws)
198 (apply '+ (loop for kw in kws
199 collecting (foreign-enum-value 'tcl-variable-related-flag kw))))
200
201 (defcstruct Tcl_ChannelType
202 (typeName :string)
203 (blockModeProc :pointer)
204 (closeProc :pointer)
205 (inputProc :pointer)
206 (outputProc :pointer)
207 (seekProc :pointer)
208 (setOptionProc :pointer)
209 (getOptionProc :pointer)
210 (watchChannelProc :pointer)
211 (channelReadyProc :pointer)
212 (getFileProc :pointer))
213

  ViewVC Help
Powered by ViewVC 1.1.5