]> git.zerfleddert.de Git - micropolis/blame - src/tk/tkframe.c
src/tclx/ucbsrc/tclbasic.sed: Micropolis build fixes for recent macOS
[micropolis] / src / tk / tkframe.c
CommitLineData
6a5fa4e0
MG
1/*
2 * tkFrame.c --
3 *
4 * This module implements "frame" widgets for the Tk
5 * toolkit. Frames are windows with a background color
6 * and possibly a 3-D effect, but no other attributes.
7 *
8 * Copyright 1990 Regents of the University of California.
9 * Permission to use, copy, modify, and distribute this
10 * software and its documentation for any purpose and without
11 * fee is hereby granted, provided that the above copyright
12 * notice appear in all copies. The University of California
13 * makes no representations about the suitability of this
14 * software for any purpose. It is provided "as is" without
15 * express or implied warranty.
16 */
17
18#ifndef lint
19static char rcsid[] = "$Header: /user6/ouster/wish/RCS/tkFrame.c,v 1.27 92/08/21 16:17:24 ouster Exp $ SPRITE (Berkeley)";
20#endif
21
22#include "default.h"
23#include "tkconfig.h"
24#include "tk.h"
25
26/*
27 * A data structure of the following type is kept for each
28 * frame that currently exists for this process:
29 */
30
31typedef struct {
32 Tk_Window tkwin; /* Window that embodies the frame. NULL
33 * means that the window has been destroyed
34 * but the data structures haven't yet been
35 * cleaned up.*/
36 Tcl_Interp *interp; /* Interpreter associated with
37 * widget. Used to delete widget
38 * command. */
39 Tk_Uid screenName; /* If this window isn't a toplevel window
40 * then this is NULL; otherwise it gives
41 * the name of the screen on which window
42 * is displayed. */
43 Tk_3DBorder border; /* Structure used to draw 3-D border and
44 * background. */
45 int borderWidth; /* Width of 3-D border (if any). */
46 int relief; /* 3-d effect: TK_RELIEF_RAISED etc. */
47 int width; /* Width to request for window. <= 0 means
48 * don't request any size. */
49 int height; /* Height to request for window. <= 0 means
50 * don't request any size. */
51 char *geometry; /* Geometry that user requested. NULL
52 * means use width and height instead.
53 * Malloc'ed. */
54 Cursor cursor; /* Current cursor for window, or None. */
55 int flags; /* Various flags; see below for
56 * definitions. */
57} Frame;
58
59/*
60 * Flag bits for frames:
61 *
62 * REDRAW_PENDING: Non-zero means a DoWhenIdle handler
63 * has already been queued to redraw
64 * this window.
65 * CLEAR_NEEDED; Need to clear the window when redrawing.
66 */
67
68#define REDRAW_PENDING 1
69#define CLEAR_NEEDED 2
70
71static Tk_ConfigSpec configSpecs[] = {
72 {TK_CONFIG_BORDER, "-background", "background", "Background",
73 DEF_FRAME_BG_COLOR, Tk_Offset(Frame, border), TK_CONFIG_COLOR_ONLY},
74 {TK_CONFIG_BORDER, "-background", "background", "Background",
75 DEF_FRAME_BG_MONO, Tk_Offset(Frame, border), TK_CONFIG_MONO_ONLY},
76 {TK_CONFIG_SYNONYM, "-bd", "borderWidth", (char *) NULL,
77 (char *) NULL, 0, 0},
78 {TK_CONFIG_SYNONYM, "-bg", "background", (char *) NULL,
79 (char *) NULL, 0, 0},
80 {TK_CONFIG_PIXELS, "-borderwidth", "borderWidth", "BorderWidth",
81 DEF_FRAME_BORDER_WIDTH, Tk_Offset(Frame, borderWidth), 0},
82 {TK_CONFIG_ACTIVE_CURSOR, "-cursor", "cursor", "Cursor",
83 DEF_FRAME_CURSOR, Tk_Offset(Frame, cursor), TK_CONFIG_NULL_OK},
84 {TK_CONFIG_STRING, "-geometry", "geometry", "Geometry",
85 DEF_FRAME_GEOMETRY, Tk_Offset(Frame, geometry), TK_CONFIG_NULL_OK},
86 {TK_CONFIG_PIXELS, "-height", "height", "Height",
87 DEF_FRAME_HEIGHT, Tk_Offset(Frame, height), 0},
88 {TK_CONFIG_RELIEF, "-relief", "relief", "Relief",
89 DEF_FRAME_RELIEF, Tk_Offset(Frame, relief), 0},
90 {TK_CONFIG_PIXELS, "-width", "width", "Width",
91 DEF_FRAME_WIDTH, Tk_Offset(Frame, width), 0},
92 {TK_CONFIG_END, (char *) NULL, (char *) NULL, (char *) NULL,
93 (char *) NULL, 0, 0}
94};
95
96/*
97 * Forward declarations for procedures defined later in this file:
98 */
99
100static int ConfigureFrame _ANSI_ARGS_((Tcl_Interp *interp,
101 Frame *framePtr, int argc, char **argv, int flags));
102static void DestroyFrame _ANSI_ARGS_((ClientData clientData));
103static void DisplayFrame _ANSI_ARGS_((ClientData clientData));
104static void FrameEventProc _ANSI_ARGS_((ClientData clientData,
105 XEvent *eventPtr));
106static int FrameWidgetCmd _ANSI_ARGS_((ClientData clientData,
107 Tcl_Interp *interp, int argc, char **argv));
108static void MapFrame _ANSI_ARGS_((ClientData clientData));
109\f
110/*
111 *--------------------------------------------------------------
112 *
113 * Tk_FrameCmd --
114 *
115 * This procedure is invoked to process the "frame" and
116 * "toplevel" Tcl commands. See the user documentation for
117 * details on what it does.
118 *
119 * Results:
120 * A standard Tcl result.
121 *
122 * Side effects:
123 * See the user documentation.
124 *
125 *--------------------------------------------------------------
126 */
127
128int
129Tk_FrameCmd(clientData, interp, argc, argv)
130 ClientData clientData; /* Main window associated with
131 * interpreter. */
132 Tcl_Interp *interp; /* Current interpreter. */
133 int argc; /* Number of arguments. */
134 char **argv; /* Argument strings. */
135{
136 Tk_Window tkwin = (Tk_Window) clientData;
137 Tk_Window new;
138 register Frame *framePtr;
139 Tk_Uid screenUid;
140 char *className, *screen;
141 int src, dst;
142
143 if (argc < 2) {
144 Tcl_AppendResult(interp, "wrong # args: should be \"",
145 argv[0], " pathName ?options?\"", (char *) NULL);
146 return TCL_ERROR;
147 }
148
149 /*
150 * The code below is a special workaround that extracts a few key
151 * options from the argument list now, rather than letting
152 * ConfigureFrame do it. This is necessary because we have
153 * to know the window's screen (if it's top-level) and its
154 * class before creating the window.
155 */
156
157 screen = NULL;
158 className = (argv[0][0] == 't') ? "Toplevel" : "Frame";
159 for (src = 2, dst = 2; src < argc; src += 2) {
160 char c;
161
162 c = argv[src][1];
163 if ((c == 'c')
164 && (strncmp(argv[src], "-class", strlen(argv[src])) == 0)) {
165 className = argv[src+1];
166 } else if ((argv[0][0] == 't') && (c == 's')
167 && (strncmp(argv[src], "-screen", strlen(argv[src])) == 0)) {
168 screen = argv[src+1];
169 } else {
170 argv[dst] = argv[src];
171 argv[dst+1] = argv[src+1];
172 dst += 2;
173 }
174 }
175 argc -= src-dst;
176
177 /*
178 * Provide a default screen for top-level windows (same as screen
179 * of parent window).
180 */
181
182 if ((argv[0][0] == 't') && (screen == NULL)) {
183 screen = "";
184 }
185 if (screen != NULL) {
186 screenUid = Tk_GetUid(screen);
187 } else {
188 screenUid = NULL;
189 }
190
191 /*
192 * Create the window.
193 */
194
195 new = Tk_CreateWindowFromPath(interp, tkwin, argv[1], screenUid);
196
197 if (new == NULL) {
198 return TCL_ERROR;
199 }
200
201 Tk_SetClass(new, className);
202 framePtr = (Frame *) ckalloc(sizeof(Frame));
203 framePtr->tkwin = new;
204 framePtr->interp = interp;
205 framePtr->screenName = screenUid;
206 framePtr->border = NULL;
207 framePtr->geometry = NULL;
208 framePtr->cursor = None;
209 framePtr->flags = 0;
210 Tk_CreateEventHandler(framePtr->tkwin, ExposureMask|StructureNotifyMask,
211 FrameEventProc, (ClientData) framePtr);
212 Tcl_CreateCommand(interp, Tk_PathName(framePtr->tkwin),
213 FrameWidgetCmd, (ClientData) framePtr, (void (*)()) NULL);
214
215 if (ConfigureFrame(interp, framePtr, argc-2, argv+2, 0) != TCL_OK) {
216 Tk_DestroyWindow(framePtr->tkwin);
217 return TCL_ERROR;
218 }
219 if (screenUid != NULL) {
220 Tk_DoWhenIdle(MapFrame, (ClientData) framePtr);
221 }
222 interp->result = Tk_PathName(framePtr->tkwin);
223 return TCL_OK;
224}
225\f
226/*
227 *--------------------------------------------------------------
228 *
229 * FrameWidgetCmd --
230 *
231 * This procedure is invoked to process the Tcl command
232 * that corresponds to a frame widget. See the user
233 * documentation for details on what it does.
234 *
235 * Results:
236 * A standard Tcl result.
237 *
238 * Side effects:
239 * See the user documentation.
240 *
241 *--------------------------------------------------------------
242 */
243
244static int
245FrameWidgetCmd(clientData, interp, argc, argv)
246 ClientData clientData; /* Information about frame widget. */
247 Tcl_Interp *interp; /* Current interpreter. */
248 int argc; /* Number of arguments. */
249 char **argv; /* Argument strings. */
250{
251 register Frame *framePtr = (Frame *) clientData;
252 int result = TCL_OK;
253 int length;
254 char c;
255
256 if (argc < 2) {
257 Tcl_AppendResult(interp, "wrong # args: should be \"",
258 argv[0], " option ?arg arg ...?\"", (char *) NULL);
259 return TCL_ERROR;
260 }
261 Tk_Preserve((ClientData) framePtr);
262 c = argv[1][0];
263 length = strlen(argv[1]);
264 if ((c == 'c') && (strncmp(argv[1], "configure", length) == 0)) {
265 if (argc == 2) {
266 result = Tk_ConfigureInfo(interp, framePtr->tkwin, configSpecs,
267 (char *) framePtr, (char *) NULL, 0);
268 } else if (argc == 3) {
269 result = Tk_ConfigureInfo(interp, framePtr->tkwin, configSpecs,
270 (char *) framePtr, argv[2], 0);
271 } else {
272 result = ConfigureFrame(interp, framePtr, argc-2, argv+2,
273 TK_CONFIG_ARGV_ONLY);
274 }
275 } else {
276 Tcl_AppendResult(interp, "bad option \"", argv[1],
277 "\": must be configure", (char *) NULL);
278 result = TCL_ERROR;
279 }
280 Tk_Release((ClientData) framePtr);
281 return result;
282}
283\f
284/*
285 *----------------------------------------------------------------------
286 *
287 * DestroyFrame --
288 *
289 * This procedure is invoked by Tk_EventuallyFree or Tk_Release
290 * to clean up the internal structure of a frame at a safe time
291 * (when no-one is using it anymore).
292 *
293 * Results:
294 * None.
295 *
296 * Side effects:
297 * Everything associated with the frame is freed up.
298 *
299 *----------------------------------------------------------------------
300 */
301
302static void
303DestroyFrame(clientData)
304 ClientData clientData; /* Info about frame widget. */
305{
306 register Frame *framePtr = (Frame *) clientData;
307
308 if (framePtr->border != NULL) {
309 Tk_Free3DBorder(framePtr->border);
310 }
311 if (framePtr->geometry != NULL) {
312 ckfree(framePtr->geometry);
313 }
314 if (framePtr->cursor != None) {
315 Tk_FreeCursor(framePtr->cursor);
316 }
317 ckfree((char *) framePtr);
318}
319\f
320/*
321 *----------------------------------------------------------------------
322 *
323 * ConfigureFrame --
324 *
325 * This procedure is called to process an argv/argc list, plus
326 * the Tk option database, in order to configure (or
327 * reconfigure) a frame widget.
328 *
329 * Results:
330 * The return value is a standard Tcl result. If TCL_ERROR is
331 * returned, then interp->result contains an error message.
332 *
333 * Side effects:
334 * Configuration information, such as text string, colors, font,
335 * etc. get set for framePtr; old resources get freed, if there
336 * were any.
337 *
338 *----------------------------------------------------------------------
339 */
340
341static int
342ConfigureFrame(interp, framePtr, argc, argv, flags)
343 Tcl_Interp *interp; /* Used for error reporting. */
344 register Frame *framePtr; /* Information about widget; may or may
345 * not already have values for some fields. */
346 int argc; /* Number of valid entries in argv. */
347 char **argv; /* Arguments. */
348 int flags; /* Flags to pass to Tk_ConfigureWidget. */
349{
350 if (Tk_ConfigureWidget(interp, framePtr->tkwin, configSpecs,
351 argc, argv, (char *) framePtr, flags) != TCL_OK) {
352 return TCL_ERROR;
353 }
354
355 Tk_SetBackgroundFromBorder(framePtr->tkwin, framePtr->border);
356 Tk_SetInternalBorder(framePtr->tkwin, framePtr->borderWidth);
357 if (framePtr->geometry != NULL) {
358 int height, width;
359 if (sscanf(framePtr->geometry, "%dx%d", &width, &height) != 2) {
360 Tcl_AppendResult(interp, "bad geometry \"", framePtr->geometry,
361 "\": expected widthxheight", (char *) NULL);
362 return TCL_ERROR;
363 }
364 Tk_GeometryRequest(framePtr->tkwin, width, height);
365 } else if ((framePtr->width > 0) && (framePtr->height > 0)) {
366 Tk_GeometryRequest(framePtr->tkwin, framePtr->width,
367 framePtr->height);
368 }
369
370 if (Tk_IsMapped(framePtr->tkwin)
371 && !(framePtr->flags & REDRAW_PENDING)) {
372 Tk_DoWhenIdle(DisplayFrame, (ClientData) framePtr);
373 framePtr->flags |= REDRAW_PENDING|CLEAR_NEEDED;
374 }
375 return TCL_OK;
376}
377\f
378/*
379 *----------------------------------------------------------------------
380 *
381 * DisplayFrame --
382 *
383 * This procedure is invoked to display a frame widget.
384 *
385 * Results:
386 * None.
387 *
388 * Side effects:
389 * Commands are output to X to display the frame in its
390 * current mode.
391 *
392 *----------------------------------------------------------------------
393 */
394
395static void
396DisplayFrame(clientData)
397 ClientData clientData; /* Information about widget. */
398{
399 register Frame *framePtr = (Frame *) clientData;
400 register Tk_Window tkwin = framePtr->tkwin;
401
402 framePtr->flags &= ~REDRAW_PENDING;
403 if ((framePtr->tkwin == NULL) || !Tk_IsMapped(tkwin)) {
404 return;
405 }
406
407 if (framePtr->flags & CLEAR_NEEDED) {
408 XClearWindow(Tk_Display(tkwin), Tk_WindowId(tkwin));
409 framePtr->flags &= ~CLEAR_NEEDED;
410 }
411 if ((framePtr->border != NULL)
412 && (framePtr->relief != TK_RELIEF_FLAT)) {
413 Tk_Draw3DRectangle(Tk_Display(tkwin), Tk_WindowId(tkwin),
414 framePtr->border, 0, 0, Tk_Width(tkwin), Tk_Height(tkwin),
415 framePtr->borderWidth, framePtr->relief);
416 }
417}
418\f
419/*
420 *--------------------------------------------------------------
421 *
422 * FrameEventProc --
423 *
424 * This procedure is invoked by the Tk dispatcher on
425 * structure changes to a frame. For frames with 3D
426 * borders, this procedure is also invoked for exposures.
427 *
428 * Results:
429 * None.
430 *
431 * Side effects:
432 * When the window gets deleted, internal structures get
433 * cleaned up. When it gets exposed, it is redisplayed.
434 *
435 *--------------------------------------------------------------
436 */
437
438static void
439FrameEventProc(clientData, eventPtr)
440 ClientData clientData; /* Information about window. */
441 register XEvent *eventPtr; /* Information about event. */
442{
443 register Frame *framePtr = (Frame *) clientData;
444
445 if ((eventPtr->type == Expose) && (eventPtr->xexpose.count == 0)) {
446 if ((framePtr->relief != TK_RELIEF_FLAT) && (framePtr->tkwin != NULL)
447 && !(framePtr->flags & REDRAW_PENDING)) {
448 Tk_DoWhenIdle(DisplayFrame, (ClientData) framePtr);
449 framePtr->flags |= REDRAW_PENDING;
450 }
451 } else if (eventPtr->type == DestroyNotify) {
452 Tcl_DeleteCommand(framePtr->interp, Tk_PathName(framePtr->tkwin));
453 framePtr->tkwin = NULL;
454 if (framePtr->flags & REDRAW_PENDING) {
455 Tk_CancelIdleCall(DisplayFrame, (ClientData) framePtr);
456 }
457 Tk_CancelIdleCall(MapFrame, (ClientData) framePtr);
458 Tk_EventuallyFree((ClientData) framePtr, DestroyFrame);
459 }
460}
461\f
462/*
463 *----------------------------------------------------------------------
464 *
465 * MapFrame --
466 *
467 * This procedure is invoked as a when-idle handler to map a
468 * newly-created top-level frame.
469 *
470 * Results:
471 * None.
472 *
473 * Side effects:
474 * The frame given by the clientData argument is mapped.
475 *
476 *----------------------------------------------------------------------
477 */
478
479static void
480MapFrame(clientData)
481 ClientData clientData; /* Pointer to frame structure. */
482{
483 Frame *framePtr = (Frame *) clientData;
484
485 /*
486 * Wait for all other background events to be processed before
487 * mapping window. This ensures that the window's correct geometry
488 * will have been determined before it is first mapped, so that the
489 * window manager doesn't get a false idea of its desired geometry.
490 */
491
492 do {
493 if (Tk_DoOneEvent(TK_IDLE_EVENTS) == 0) {
494 break;
495 }
496
497 /*
498 * After each event, make sure that the window still exists,
499 * and quit if the window has been destroyed.
500 */
501
502 if (framePtr->tkwin == NULL) {
503 return;
504 }
505 } while (1);
506 Tk_MapWindow(framePtr->tkwin);
507}
Impressum, Datenschutz