Move old compatiblity to cl.el. Remove cl-macroexpand-all.
[emacs.git] / src / widget.c
blob0cb1013b9718cd79e74e427e3042935f46bc7b1a
1 /* The emacs frame widget.
2 Copyright (C) 1992-1993, 2000-2012 Free Software Foundation, Inc.
4 This file is part of GNU Emacs.
6 GNU Emacs is free software: you can redistribute it and/or modify
7 it under the terms of the GNU General Public License as published by
8 the Free Software Foundation, either version 3 of the License, or
9 (at your option) any later version.
11 GNU Emacs is distributed in the hope that it will be useful,
12 but WITHOUT ANY WARRANTY; without even the implied warranty of
13 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14 GNU General Public License for more details.
16 You should have received a copy of the GNU General Public License
17 along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
19 /* Emacs 19 face widget ported by Fred Pierresteguy */
21 /* This file has been censored by the Communications Decency Act.
22 That law was passed under the guise of a ban on pornography, but
23 it bans far more than that. This file did not contain pornography,
24 but it was censored nonetheless.
26 For information on US government censorship of the Internet, and
27 what you can do to bring back freedom of the press, see the web
28 site http://www.vtw.org/
31 #include <config.h>
32 #include <stdio.h>
33 #include <setjmp.h>
34 #include "lisp.h"
35 #include "xterm.h"
37 #include "keyboard.h"
38 #include "frame.h"
39 #include "window.h"
41 #include "dispextern.h"
42 #include "blockinput.h"
44 #include <X11/StringDefs.h>
45 #include <X11/IntrinsicP.h>
46 #include <X11/cursorfont.h>
47 #include "widgetprv.h"
48 #include <X11/ObjectP.h>
49 #include <X11/Shell.h>
50 #include <X11/ShellP.h>
51 #include "../lwlib/lwlib.h"
53 #include <signal.h>
54 #include "syssignal.h"
56 #include "character.h"
57 #include "font.h"
59 /* This sucks: this is the first default that x-faces.el tries. This won't
60 be used unless neither the "Emacs.EmacsFrame" resource nor the
61 "Emacs.EmacsFrame" resource is set; the frame
62 may have the wrong default size if this font doesn't exist, but some other
63 font that x-faces.el does. The workaround is to specify some font in the
64 resource database; I don't know a solution other than duplicating the font-
65 searching code from x-faces.el in this file.
67 This also means that if "Emacs.EmacsFrame" is specified as a non-
68 existent font, then Xt is going to substitute "XtDefaultFont" for it,
69 which is a different size than this one. The solution for this is to
70 make x-faces.el try to use XtDefaultFont. The problem with that is that
71 XtDefaultFont is almost certainly variable-width.
73 #### Perhaps we could have this code explicitly set XtDefaultFont to this?
75 #define DEFAULT_FACE_FONT "-*-courier-medium-r-*-*-*-120-*-*-*-*-iso8859-*"
78 static void EmacsFrameInitialize (Widget request, Widget new, ArgList dum1, Cardinal *dum2);
79 static void EmacsFrameDestroy (Widget widget);
80 static void EmacsFrameRealize (Widget widget, XtValueMask *mask, XSetWindowAttributes *attrs);
81 static void EmacsFrameResize (Widget widget);
82 static Boolean EmacsFrameSetValues (Widget cur_widget, Widget req_widget, Widget new_widget, ArgList dum1, Cardinal *dum2);
83 static XtGeometryResult EmacsFrameQueryGeometry (Widget widget, XtWidgetGeometry *request, XtWidgetGeometry *result);
86 #undef XtOffset
87 #define XtOffset(p_type,field) \
88 ((Cardinal) (((char *) (&(((p_type)0)->field))) - ((char *)0)))
89 #define offset(field) XtOffset (EmacsFrame, emacs_frame.field)
91 static XtResource resources[] = {
92 {XtNgeometry, XtCGeometry, XtRString, sizeof (String),
93 offset (geometry), XtRString, (XtPointer) 0},
94 {XtNiconic, XtCIconic, XtRBoolean, sizeof (Boolean),
95 offset (iconic), XtRImmediate, (XtPointer) False},
97 {XtNemacsFrame, XtCEmacsFrame, XtRPointer, sizeof (XtPointer),
98 offset (frame), XtRImmediate, 0},
100 {XtNminibuffer, XtCMinibuffer, XtRInt, sizeof (int),
101 offset (minibuffer), XtRImmediate, (XtPointer)0},
102 {XtNunsplittable, XtCUnsplittable, XtRBoolean, sizeof (Boolean),
103 offset (unsplittable), XtRImmediate, (XtPointer)0},
104 {XtNinternalBorderWidth, XtCInternalBorderWidth, XtRInt, sizeof (int),
105 offset (internal_border_width), XtRImmediate, (XtPointer)4},
106 {XtNinterline, XtCInterline, XtRInt, sizeof (int),
107 offset (interline), XtRImmediate, (XtPointer)0},
108 {XtNfont, XtCFont, XtRFontStruct, sizeof (struct font *),
109 offset (font),XtRString, DEFAULT_FACE_FONT},
110 {XtNforeground, XtCForeground, XtRPixel, sizeof (Pixel),
111 offset (foreground_pixel), XtRString, "XtDefaultForeground"},
112 {XtNcursorColor, XtCForeground, XtRPixel, sizeof (Pixel),
113 offset (cursor_color), XtRString, "XtDefaultForeground"},
114 {XtNbarCursor, XtCBarCursor, XtRBoolean, sizeof (Boolean),
115 offset (bar_cursor), XtRImmediate, (XtPointer)0},
116 {XtNvisualBell, XtCVisualBell, XtRBoolean, sizeof (Boolean),
117 offset (visual_bell), XtRImmediate, (XtPointer)0},
118 {XtNbellVolume, XtCBellVolume, XtRInt, sizeof (int),
119 offset (bell_volume), XtRImmediate, (XtPointer)0},
122 #undef offset
125 static XtActionsRec
126 emacsFrameActionsTable [] = {
127 {"keypress", key_press},
128 {"focus_in", emacs_frame_focus_handler},
129 {"focus_out", emacs_frame_focus_handler},
132 static char
133 emacsFrameTranslations [] = "\
134 <KeyPress>: keypress()\n\
135 <FocusIn>: focus_in()\n\
136 <FocusOut>: focus_out()\n\
140 static EmacsFrameClassRec emacsFrameClassRec = {
141 { /* core fields */
142 /* superclass */ &widgetClassRec,
143 /* class_name */ "EmacsFrame",
144 /* widget_size */ sizeof (EmacsFrameRec),
145 /* class_initialize */ 0,
146 /* class_part_initialize */ 0,
147 /* class_inited */ FALSE,
148 /* initialize */ EmacsFrameInitialize,
149 /* initialize_hook */ 0,
150 /* realize */ EmacsFrameRealize,
151 /* actions */ 0, /*emacsFrameActionsTable*/
152 /* num_actions */ 0, /*XtNumber (emacsFrameActionsTable)*/
153 /* resources */ resources,
154 /* resource_count */ XtNumber (resources),
155 /* xrm_class */ NULLQUARK,
156 /* compress_motion */ TRUE,
157 /* compress_exposure */ TRUE,
158 /* compress_enterleave */ TRUE,
159 /* visible_interest */ FALSE,
160 /* destroy */ EmacsFrameDestroy,
161 /* resize */ EmacsFrameResize,
162 /* expose */ XtInheritExpose,
163 /* set_values */ EmacsFrameSetValues,
164 /* set_values_hook */ 0,
165 /* set_values_almost */ XtInheritSetValuesAlmost,
166 /* get_values_hook */ 0,
167 /* accept_focus */ XtInheritAcceptFocus,
168 /* version */ XtVersion,
169 /* callback_private */ 0,
170 /* tm_table */ 0, /*emacsFrameTranslations*/
171 /* query_geometry */ EmacsFrameQueryGeometry,
172 /* display_accelerator */ XtInheritDisplayAccelerator,
173 /* extension */ 0
177 WidgetClass emacsFrameClass = (WidgetClass) &emacsFrameClassRec;
179 static void
180 get_default_char_pixel_size (EmacsFrame ew, int *pixel_width, int *pixel_height)
182 struct frame* f = ew->emacs_frame.frame;
183 *pixel_width = FRAME_COLUMN_WIDTH (f);
184 *pixel_height = FRAME_LINE_HEIGHT (f);
187 static void
188 pixel_to_char_size (EmacsFrame ew, Dimension pixel_width, Dimension pixel_height, int *char_width, int *char_height)
190 struct frame* f = ew->emacs_frame.frame;
191 *char_width = FRAME_PIXEL_WIDTH_TO_TEXT_COLS (f, (int) pixel_width);
192 *char_height = FRAME_PIXEL_HEIGHT_TO_TEXT_LINES (f, (int) pixel_height);
195 static void
196 char_to_pixel_size (EmacsFrame ew, int char_width, int char_height, Dimension *pixel_width, Dimension *pixel_height)
198 struct frame* f = ew->emacs_frame.frame;
199 *pixel_width = FRAME_TEXT_COLS_TO_PIXEL_WIDTH (f, char_width);
200 *pixel_height = FRAME_TEXT_LINES_TO_PIXEL_HEIGHT (f, char_height);
203 static void
204 round_size_to_char (EmacsFrame ew, Dimension in_width, Dimension in_height, Dimension *out_width, Dimension *out_height)
206 int char_width;
207 int char_height;
208 pixel_to_char_size (ew, in_width, in_height, &char_width, &char_height);
209 char_to_pixel_size (ew, char_width, char_height, out_width, out_height);
212 static Widget
213 get_wm_shell (Widget w)
215 Widget wmshell;
217 for (wmshell = XtParent (w);
218 wmshell && !XtIsWMShell (wmshell);
219 wmshell = XtParent (wmshell));
221 return wmshell;
224 #if 0 /* Currently not used. */
226 static void
227 mark_shell_size_user_specified (Widget wmshell)
229 if (! XtIsWMShell (wmshell)) abort ();
230 /* This is kind of sleazy, but I can't see how else to tell it to make it
231 mark the WM_SIZE_HINTS size as user specified when appropriate. */
232 ((WMShellWidget) wmshell)->wm.size_hints.flags |= USSize;
235 #endif
238 /* Can't have static frame locals because of some broken compilers.
239 Normally, initializing a variable like this doesn't work in emacs,
240 but it's ok in this file because it must come after lastfile (and
241 thus have its data not go into text space) because Xt needs to
242 write to initialized data objects too.
244 #if 0
245 static Boolean first_frame_p = True;
246 #endif
248 static void
249 set_frame_size (EmacsFrame ew)
251 /* The widget hierarchy is
253 argv[0] emacsShell pane Frame-NAME
254 ApplicationShell EmacsShell Paned EmacsFrame
256 We accept geometry specs in this order:
258 *Frame-NAME.geometry
259 *EmacsFrame.geometry
260 Emacs.geometry
262 Other possibilities for widget hierarchies might be
264 argv[0] frame pane Frame-NAME
265 ApplicationShell EmacsShell Paned EmacsFrame
267 argv[0] Frame-NAME pane Frame-NAME
268 ApplicationShell EmacsShell Paned EmacsFrame
270 argv[0] Frame-NAME pane emacsTextPane
271 ApplicationShell EmacsFrame Paned EmacsTextPane
273 With the current setup, the text-display-area is the part which is
274 an emacs "frame", since that's the only part managed by emacs proper
275 (the menubar and the parent of the menubar and all that sort of thing
276 are managed by lwlib.)
278 The EmacsShell widget is simply a replacement for the Shell widget
279 which is able to deal with using an externally-supplied window instead
280 of always creating its own. It is not actually emacs specific, and
281 should possibly have class "Shell" instead of "EmacsShell" to simplify
282 the resources.
286 /* Hairily merged geometry */
287 unsigned int w = FRAME_COLS (ew->emacs_frame.frame);
288 unsigned int h = FRAME_LINES (ew->emacs_frame.frame);
290 Widget wmshell = get_wm_shell ((Widget) ew);
291 /* Each Emacs shell is now independent and top-level. */
293 if (! XtIsSubclass (wmshell, shellWidgetClass)) abort ();
295 /* We don't need this for the moment. The geometry is computed in
296 xfns.c. */
297 #if 0
298 /* If the EmacsFrame doesn't have a geometry but the shell does,
299 treat that as the geometry of the frame. (Is this bogus?
300 I'm not sure.) */
301 if (ew->emacs_frame.geometry == 0)
302 XtVaGetValues (wmshell, XtNgeometry, &ew->emacs_frame.geometry, NULL);
304 /* If the Shell is iconic, then the EmacsFrame is iconic. (Is
305 this bogus? I'm not sure.) */
306 if (!ew->emacs_frame.iconic)
307 XtVaGetValues (wmshell, XtNiconic, &ew->emacs_frame.iconic, NULL);
311 char *geom = 0;
312 XtVaGetValues (app_shell, XtNgeometry, &geom, NULL);
313 if (geom)
314 app_flags = XParseGeometry (geom, &app_x, &app_y, &app_w, &app_h);
317 if (ew->emacs_frame.geometry)
318 frame_flags = XParseGeometry (ew->emacs_frame.geometry,
319 &frame_x, &frame_y,
320 &frame_w, &frame_h);
322 if (first_frame_p)
324 /* If this is the first frame created:
325 ====================================
327 - Use the ApplicationShell's size/position, if specified.
328 (This is "Emacs.geometry", or the "-geometry" command line arg.)
329 - Else use the EmacsFrame's size/position.
330 (This is "*Frame-NAME.geometry")
332 - If the AppShell is iconic, the frame should be iconic.
334 AppShell comes first so that -geometry always applies to the first
335 frame created, even if there is an "every frame" entry in the
336 resource database.
338 if (app_flags & (XValue | YValue))
340 x = app_x; y = app_y;
341 flags |= (app_flags & (XValue | YValue | XNegative | YNegative));
343 else if (frame_flags & (XValue | YValue))
345 x = frame_x; y = frame_y;
346 flags |= (frame_flags & (XValue | YValue | XNegative | YNegative));
349 if (app_flags & (WidthValue | HeightValue))
351 w = app_w; h = app_h;
352 flags |= (app_flags & (WidthValue | HeightValue));
354 else if (frame_flags & (WidthValue | HeightValue))
356 w = frame_w; h = frame_h;
357 flags |= (frame_flags & (WidthValue | HeightValue));
360 /* If the AppShell is iconic, then the EmacsFrame is iconic. */
361 if (!ew->emacs_frame.iconic)
362 XtVaGetValues (app_shell, XtNiconic, &ew->emacs_frame.iconic, NULL);
364 first_frame_p = False;
366 else
368 /* If this is not the first frame created:
369 ========================================
371 - use the EmacsFrame's size/position if specified
372 - Otherwise, use the ApplicationShell's size, but not position.
374 So that means that one can specify the position of the first frame
375 with "Emacs.geometry" or `-geometry'; but can only specify the
376 position of subsequent frames with "*Frame-NAME.geometry".
378 AppShell comes second so that -geometry does not apply to subsequent
379 frames when there is an "every frame" entry in the resource db,
380 but does apply to the first frame.
382 if (frame_flags & (XValue | YValue))
384 x = frame_x; y = frame_y;
385 flags |= (frame_flags & (XValue | YValue | XNegative | YNegative));
388 if (frame_flags & (WidthValue | HeightValue))
390 w = frame_w; h = frame_h;
391 flags |= (frame_flags & (WidthValue | HeightValue));
393 else if (app_flags & (WidthValue | HeightValue))
395 w = app_w;
396 h = app_h;
397 flags |= (app_flags & (WidthValue | HeightValue));
400 #endif /* 0 */
402 struct frame *f = ew->emacs_frame.frame;
403 Dimension pixel_width, pixel_height;
405 /* Take into account the size of the scrollbar. Always use the
406 number of columns occupied by the scroll bar here otherwise we
407 might end up with a frame width that is not a multiple of the
408 frame's character width which is bad for vertically split
409 windows. */
410 f->scroll_bar_actual_width
411 = FRAME_SCROLL_BAR_COLS (f) * FRAME_COLUMN_WIDTH (f);
413 compute_fringe_widths (f, 0);
415 #if 0 /* This can run Lisp code, and it is dangerous to give
416 out the frame to Lisp code before it officially exists.
417 This is handled in Fx_create_frame so not needed here. */
418 change_frame_size (f, h, w, 1, 0, 0);
419 #endif
420 char_to_pixel_size (ew, w, h, &pixel_width, &pixel_height);
421 ew->core.width = pixel_width;
422 ew->core.height = pixel_height;
424 #if 0 /* xfns.c takes care of this now. */
425 /* If a position was specified, assign it to the shell widget.
426 (Else WM won't do anything with it.)
428 if (flags & (XValue | YValue))
430 /* the tricky things with the sign is to make sure that
431 -0 is printed -0. */
432 int len;
433 char *tem;
434 sprintf (shell_position, "=%c%d%c%d",
435 flags & XNegative ? '-' : '+', x < 0 ? -x : x,
436 flags & YNegative ? '-' : '+', y < 0 ? -y : y);
437 len = strlen (shell_position) + 1;
438 tem = (char *) xmalloc (len);
439 strncpy (tem, shell_position, len);
440 XtVaSetValues (wmshell, XtNgeometry, tem, NULL);
442 else if (flags & (WidthValue | HeightValue))
444 int len;
445 char *tem;
446 sprintf (shell_position, "=%dx%d", pixel_width, pixel_height);
447 len = strlen (shell_position) + 1;
448 tem = (char *) xmalloc (len);
449 strncpy (tem, shell_position, len);
450 XtVaSetValues (wmshell, XtNgeometry, tem, NULL);
453 /* If the geometry spec we're using has W/H components, mark the size
454 in the WM_SIZE_HINTS as user specified. */
455 if (flags & (WidthValue | HeightValue))
456 mark_shell_size_user_specified (wmshell);
458 /* Also assign the iconic status of the frame to the Shell, so that
459 the WM sees it. */
460 XtVaSetValues (wmshell, XtNiconic, ew->emacs_frame.iconic, NULL);
461 #endif /* 0 */
465 static void
466 update_wm_hints (EmacsFrame ew)
468 Widget wmshell = get_wm_shell ((Widget)ew);
469 int cw;
470 int ch;
471 Dimension rounded_width;
472 Dimension rounded_height;
473 int char_width;
474 int char_height;
475 int base_width;
476 int base_height;
477 int min_rows = 0, min_cols = 0;
479 /* This happens when the frame is just created. */
480 if (! wmshell) return;
482 #if 0
483 check_frame_size (ew->emacs_frame.frame, &min_rows, &min_cols);
484 #endif
486 pixel_to_char_size (ew, ew->core.width, ew->core.height,
487 &char_width, &char_height);
488 char_to_pixel_size (ew, char_width, char_height,
489 &rounded_width, &rounded_height);
490 get_default_char_pixel_size (ew, &cw, &ch);
492 base_width = (wmshell->core.width - ew->core.width
493 + (rounded_width - (char_width * cw)));
494 base_height = (wmshell->core.height - ew->core.height
495 + (rounded_height - (char_height * ch)));
497 /* This is kind of sleazy, but I can't see how else to tell it to
498 make it mark the WM_SIZE_HINTS size as user specified.
500 /* ((WMShellWidget) wmshell)->wm.size_hints.flags |= USSize;*/
502 XtVaSetValues (wmshell,
503 XtNbaseWidth, (XtArgVal) base_width,
504 XtNbaseHeight, (XtArgVal) base_height,
505 XtNwidthInc, (XtArgVal) cw,
506 XtNheightInc, (XtArgVal) ch,
507 XtNminWidth, (XtArgVal) (base_width + min_cols * cw),
508 XtNminHeight, (XtArgVal) (base_height + min_rows * ch),
509 NULL);
512 void
513 widget_update_wm_size_hints (Widget widget)
515 EmacsFrame ew = (EmacsFrame)widget;
516 update_wm_hints (ew);
520 #if 0
522 static void
523 create_frame_gcs (EmacsFrame ew)
525 struct frame *s = ew->emacs_frame.frame;
527 s->output_data.x->normal_gc
528 = XCreateGC (XtDisplay (ew), RootWindowOfScreen (XtScreen (ew)), 0, 0);
529 s->output_data.x->reverse_gc
530 = XCreateGC (XtDisplay (ew), RootWindowOfScreen (XtScreen (ew)), 0, 0);
531 s->output_data.x->cursor_gc
532 = XCreateGC (XtDisplay (ew), RootWindowOfScreen (XtScreen (ew)), 0, 0);
533 s->output_data.x->black_relief.gc = 0;
534 s->output_data.x->white_relief.gc = 0;
537 #endif /* 0 */
539 static char setup_frame_cursor_bits[] =
541 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
542 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
543 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
544 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00
547 static void
548 setup_frame_gcs (EmacsFrame ew)
550 XGCValues gc_values;
551 struct frame* s = ew->emacs_frame.frame;
552 Pixmap blank_stipple, blank_tile;
553 unsigned long valuemask = (GCForeground | GCBackground | GCGraphicsExposures
554 | GCStipple | GCTile);
555 Lisp_Object font;
557 XSETFONT (font, ew->emacs_frame.font);
558 font = Ffont_xlfd_name (font, Qnil);
559 if (STRINGP (font))
561 XFontStruct *xfont = XLoadQueryFont (FRAME_X_DISPLAY_INFO (s)->display,
562 SSDATA (font));
563 if (xfont)
565 gc_values.font = xfont->fid;
566 valuemask |= GCFont;
570 /* We have to initialize all of our GCs to have a stipple/tile, otherwise
571 XGetGCValues returns uninitialized data when we query the stipple
572 (instead of None or something sensible) and it makes things hard.
574 This should be fixed for real by not querying the GCs but instead having
575 some GC-based cache instead of the current face-based cache which doesn't
576 effectively cache all of the GC settings we need to use.
579 blank_stipple
580 = XCreateBitmapFromData (XtDisplay (ew),
581 RootWindowOfScreen (XtScreen (ew)),
582 setup_frame_cursor_bits, 2, 2);
584 /* use fg = 0, bg = 1 below, but it's irrelevant since this pixmap should
585 never actually get used as a background tile!
587 blank_tile
588 = XCreatePixmapFromBitmapData (XtDisplay (ew),
589 RootWindowOfScreen (XtScreen (ew)),
590 setup_frame_cursor_bits, 2, 2,
591 0, 1, ew->core.depth);
593 /* Normal video */
594 gc_values.foreground = ew->emacs_frame.foreground_pixel;
595 gc_values.background = ew->core.background_pixel;
596 gc_values.graphics_exposures = False;
597 gc_values.stipple = blank_stipple;
598 gc_values.tile = blank_tile;
599 XChangeGC (XtDisplay (ew), s->output_data.x->normal_gc,
600 valuemask, &gc_values);
602 /* Reverse video style. */
603 gc_values.foreground = ew->core.background_pixel;
604 gc_values.background = ew->emacs_frame.foreground_pixel;
605 gc_values.graphics_exposures = False;
606 gc_values.stipple = blank_stipple;
607 gc_values.tile = blank_tile;
608 XChangeGC (XtDisplay (ew), s->output_data.x->reverse_gc,
609 valuemask, &gc_values);
611 /* Cursor has to have an empty stipple. */
612 gc_values.foreground = ew->core.background_pixel;
613 gc_values.background = ew->emacs_frame.cursor_color;
614 gc_values.graphics_exposures = False;
615 gc_values.tile = blank_tile;
616 gc_values.stipple
617 = XCreateBitmapFromData (XtDisplay (ew),
618 RootWindowOfScreen (XtScreen (ew)),
619 setup_frame_cursor_bits, 16, 16);
620 XChangeGC (XtDisplay (ew), s->output_data.x->cursor_gc,
621 valuemask, &gc_values);
624 static void
625 update_various_frame_slots (EmacsFrame ew)
627 struct frame *f = ew->emacs_frame.frame;
628 struct x_output *x = f->output_data.x;
629 FRAME_PIXEL_HEIGHT (f) = ew->core.height + x->menubar_height;
630 FRAME_PIXEL_WIDTH (f) = ew->core.width;
631 f->internal_border_width = ew->emacs_frame.internal_border_width;
635 static void
636 update_from_various_frame_slots (EmacsFrame ew)
638 struct frame *f = ew->emacs_frame.frame;
639 struct x_output *x = f->output_data.x;
640 ew->core.height = FRAME_PIXEL_HEIGHT (f) - x->menubar_height;
641 ew->core.width = FRAME_PIXEL_WIDTH (f);
642 ew->core.background_pixel = FRAME_BACKGROUND_PIXEL (f);
643 ew->emacs_frame.internal_border_width = f->internal_border_width;
644 ew->emacs_frame.font = x->font;
645 ew->emacs_frame.foreground_pixel = FRAME_FOREGROUND_PIXEL (f);
646 ew->emacs_frame.cursor_color = x->cursor_pixel;
647 ew->core.border_pixel = x->border_pixel;
650 static void
651 EmacsFrameInitialize (Widget request, Widget new, ArgList dum1, Cardinal *dum2)
653 EmacsFrame ew = (EmacsFrame)new;
655 if (!ew->emacs_frame.frame)
657 fprintf (stderr,
658 "can't create an emacs frame widget without a frame\n");
659 exit (1);
662 update_from_various_frame_slots (ew);
663 set_frame_size (ew);
667 static void
668 EmacsFrameRealize (Widget widget, XtValueMask *mask, XSetWindowAttributes *attrs)
670 EmacsFrame ew = (EmacsFrame)widget;
672 /* This used to contain SubstructureRedirectMask, but this turns out
673 to be a problem with XIM on Solaris, and events from that mask
674 don't seem to be used. Let's check that. */
675 attrs->event_mask = (STANDARD_EVENT_SET
676 | PropertyChangeMask
677 | SubstructureNotifyMask);
678 *mask |= CWEventMask;
679 XtCreateWindow (widget, InputOutput, (Visual *)CopyFromParent, *mask,
680 attrs);
681 update_wm_hints (ew);
684 extern void free_frame_faces (struct frame *);
686 static void
687 EmacsFrameDestroy (Widget widget)
689 EmacsFrame ew = (EmacsFrame) widget;
690 struct frame* s = ew->emacs_frame.frame;
692 if (! s) abort ();
693 if (! s->output_data.x) abort ();
695 BLOCK_INPUT;
696 x_free_gcs (s);
697 if (s->output_data.x->white_relief.gc)
698 XFreeGC (XtDisplay (widget), s->output_data.x->white_relief.gc);
699 if (s->output_data.x->black_relief.gc)
700 XFreeGC (XtDisplay (widget), s->output_data.x->black_relief.gc);
701 UNBLOCK_INPUT;
704 static void
705 EmacsFrameResize (Widget widget)
707 EmacsFrame ew = (EmacsFrame)widget;
708 struct frame *f = ew->emacs_frame.frame;
709 int columns;
710 int rows;
712 pixel_to_char_size (ew, ew->core.width, ew->core.height, &columns, &rows);
713 change_frame_size (f, rows, columns, 0, 1, 0);
714 update_wm_hints (ew);
715 update_various_frame_slots (ew);
717 cancel_mouse_face (f);
720 static Boolean
721 EmacsFrameSetValues (Widget cur_widget, Widget req_widget, Widget new_widget, ArgList dum1, Cardinal *dum2)
723 EmacsFrame cur = (EmacsFrame)cur_widget;
724 EmacsFrame new = (EmacsFrame)new_widget;
726 Boolean needs_a_refresh = False;
727 Boolean has_to_recompute_size;
728 Boolean has_to_recompute_gcs;
729 Boolean has_to_update_hints;
731 int char_width, char_height;
732 Dimension pixel_width;
733 Dimension pixel_height;
735 /* AFAIK, this function is never called. -- Jan D, Oct 2009. */
736 has_to_recompute_gcs = (cur->emacs_frame.font != new->emacs_frame.font
737 || (cur->emacs_frame.foreground_pixel
738 != new->emacs_frame.foreground_pixel)
739 || (cur->core.background_pixel
740 != new->core.background_pixel)
743 has_to_recompute_size = (cur->emacs_frame.font != new->emacs_frame.font
744 && cur->core.width == new->core.width
745 && cur->core.height == new->core.height);
747 has_to_update_hints = (cur->emacs_frame.font != new->emacs_frame.font);
749 if (has_to_recompute_gcs)
751 setup_frame_gcs (new);
752 needs_a_refresh = True;
755 if (has_to_recompute_size)
757 pixel_width = new->core.width;
758 pixel_height = new->core.height;
759 pixel_to_char_size (new, pixel_width, pixel_height, &char_width,
760 &char_height);
761 char_to_pixel_size (new, char_width, char_height, &pixel_width,
762 &pixel_height);
763 new->core.width = pixel_width;
764 new->core.height = pixel_height;
766 change_frame_size (new->emacs_frame.frame, char_height, char_width,
767 1, 0, 0);
768 needs_a_refresh = True;
771 if (has_to_update_hints)
772 update_wm_hints (new);
774 update_various_frame_slots (new);
776 /* #### This doesn't work, I haven't been able to find ANY kludge that
777 will let (x-create-frame '((iconic . t))) work. It seems that changes
778 to wm_shell's iconic slot have no effect after it has been realized,
779 and calling XIconifyWindow doesn't work either (even though the window
780 has been created.) Perhaps there is some property we could smash
781 directly, but I'm sick of this for now.
783 if (cur->emacs_frame.iconic != new->emacs_frame.iconic)
785 Widget wmshell = get_wm_shell ((Widget) cur);
786 XtVaSetValues (wmshell, XtNiconic,
787 (XtArgVal) new->emacs_frame.iconic, NULL);
790 return needs_a_refresh;
793 static XtGeometryResult
794 EmacsFrameQueryGeometry (Widget widget, XtWidgetGeometry *request, XtWidgetGeometry *result)
796 EmacsFrame ew = (EmacsFrame)widget;
798 int mask = request->request_mode;
799 Dimension ok_width, ok_height;
801 if (mask & (CWWidth | CWHeight))
803 round_size_to_char (ew,
804 (mask & CWWidth) ? request->width : ew->core.width,
805 ((mask & CWHeight) ? request->height
806 : ew->core.height),
807 &ok_width, &ok_height);
808 if ((mask & CWWidth) && (ok_width != request->width))
810 result->request_mode |= CWWidth;
811 result->width = ok_width;
813 if ((mask & CWHeight) && (ok_height != request->height))
815 result->request_mode |= CWHeight;
816 result->height = ok_height;
819 return result->request_mode ? XtGeometryAlmost : XtGeometryYes;
822 /* Special entry points */
823 void
824 EmacsFrameSetCharSize (Widget widget, int columns, int rows)
826 EmacsFrame ew = (EmacsFrame) widget;
827 struct frame *f = ew->emacs_frame.frame;
829 x_set_window_size (f, 0, columns, rows);
833 void
834 widget_store_internal_border (Widget widget)
836 EmacsFrame ew = (EmacsFrame) widget;
837 FRAME_PTR f = ew->emacs_frame.frame;
839 ew->emacs_frame.internal_border_width = f->internal_border_width;