Fix minor problems with loaddefs autogeneration
[emacs.git] / src / widget.c
blob96555ed2ac7868f578877772175dcfbff5a5b62b
1 /* The emacs frame widget.
2 Copyright (C) 1992-1993, 2000-2017 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 (at
9 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 "widget.h"
34 #include <stdio.h>
35 #include <stdlib.h>
37 #include "lisp.h"
38 #include "xterm.h"
39 #include "frame.h"
41 #include <X11/StringDefs.h>
42 #include <X11/IntrinsicP.h>
43 #include <X11/cursorfont.h>
44 #include "widgetprv.h"
45 #include <X11/ObjectP.h>
46 #include <X11/Shell.h>
47 #include <X11/ShellP.h>
48 #include "../lwlib/lwlib.h"
50 static void EmacsFrameInitialize (Widget request, Widget new, ArgList dum1, Cardinal *dum2);
51 static void EmacsFrameDestroy (Widget widget);
52 static void EmacsFrameRealize (Widget widget, XtValueMask *mask, XSetWindowAttributes *attrs);
53 static void EmacsFrameResize (Widget widget);
54 static XtGeometryResult EmacsFrameQueryGeometry (Widget widget, XtWidgetGeometry *request, XtWidgetGeometry *result);
57 #define offset(field) offsetof (EmacsFrameRec, emacs_frame.field)
59 static XtResource resources[] = {
60 {XtNgeometry, XtCGeometry, XtRString, sizeof (String),
61 offset (geometry), XtRString, (XtPointer) 0},
62 {XtNiconic, XtCIconic, XtRBoolean, sizeof (Boolean),
63 offset (iconic), XtRImmediate, (XtPointer) False},
65 {XtNemacsFrame, XtCEmacsFrame, XtRPointer, sizeof (XtPointer),
66 offset (frame), XtRImmediate, 0},
68 {XtNminibuffer, XtCMinibuffer, XtRInt, sizeof (int),
69 offset (minibuffer), XtRImmediate, (XtPointer)0},
70 {XtNunsplittable, XtCUnsplittable, XtRBoolean, sizeof (Boolean),
71 offset (unsplittable), XtRImmediate, (XtPointer)0},
72 {XtNinternalBorderWidth, XtCInternalBorderWidth, XtRInt, sizeof (int),
73 offset (internal_border_width), XtRImmediate, (XtPointer)4},
74 {XtNinterline, XtCInterline, XtRInt, sizeof (int),
75 offset (interline), XtRImmediate, (XtPointer)0},
76 {XtNforeground, XtCForeground, XtRPixel, sizeof (Pixel),
77 offset (foreground_pixel), XtRString, "XtDefaultForeground"},
78 {XtNcursorColor, XtCForeground, XtRPixel, sizeof (Pixel),
79 offset (cursor_color), XtRString, "XtDefaultForeground"},
80 {XtNbarCursor, XtCBarCursor, XtRBoolean, sizeof (Boolean),
81 offset (bar_cursor), XtRImmediate, (XtPointer)0},
82 {XtNvisualBell, XtCVisualBell, XtRBoolean, sizeof (Boolean),
83 offset (visual_bell), XtRImmediate, (XtPointer)0},
84 {XtNbellVolume, XtCBellVolume, XtRInt, sizeof (int),
85 offset (bell_volume), XtRImmediate, (XtPointer)0},
88 #undef offset
91 static XtActionsRec
92 emacsFrameActionsTable [] = {
93 {"keypress", key_press},
94 {"focus_in", emacs_frame_focus_handler},
95 {"focus_out", emacs_frame_focus_handler},
98 static char
99 emacsFrameTranslations [] = "\
100 <KeyPress>: keypress()\n\
101 <FocusIn>: focus_in()\n\
102 <FocusOut>: focus_out()\n\
106 static EmacsFrameClassRec emacsFrameClassRec = {
107 { /* core fields */
108 /* superclass */ &widgetClassRec,
109 /* class_name */ "EmacsFrame",
110 /* widget_size */ sizeof (EmacsFrameRec),
111 /* class_initialize */ 0,
112 /* class_part_initialize */ 0,
113 /* class_inited */ FALSE,
114 /* initialize */ EmacsFrameInitialize,
115 /* initialize_hook */ 0,
116 /* realize */ EmacsFrameRealize,
117 /* actions */ 0, /*emacsFrameActionsTable*/
118 /* num_actions */ 0, /*XtNumber (emacsFrameActionsTable)*/
119 /* resources */ resources,
120 /* resource_count */ XtNumber (resources),
121 /* xrm_class */ NULLQUARK,
122 /* compress_motion */ TRUE,
123 /* compress_exposure */ TRUE,
124 /* compress_enterleave */ TRUE,
125 /* visible_interest */ FALSE,
126 /* destroy */ EmacsFrameDestroy,
127 /* resize */ EmacsFrameResize,
128 /* expose */ XtInheritExpose,
130 /* Emacs never does XtSetvalues on this widget, so we have no code
131 for it. */
132 /* set_values */ 0, /* Not supported */
133 /* set_values_hook */ 0,
134 /* set_values_almost */ XtInheritSetValuesAlmost,
135 /* get_values_hook */ 0,
136 /* accept_focus */ XtInheritAcceptFocus,
137 /* version */ XtVersion,
138 /* callback_private */ 0,
139 /* tm_table */ 0, /*emacsFrameTranslations*/
140 /* query_geometry */ EmacsFrameQueryGeometry,
141 /* display_accelerator */ XtInheritDisplayAccelerator,
142 /* extension */ 0
146 WidgetClass emacsFrameClass = (WidgetClass) &emacsFrameClassRec;
148 static void
149 get_default_char_pixel_size (EmacsFrame ew, int *pixel_width, int *pixel_height)
151 struct frame *f = ew->emacs_frame.frame;
152 *pixel_width = FRAME_COLUMN_WIDTH (f);
153 *pixel_height = FRAME_LINE_HEIGHT (f);
156 static void
157 pixel_to_char_size (EmacsFrame ew, Dimension pixel_width, Dimension pixel_height, int *char_width, int *char_height)
159 struct frame *f = ew->emacs_frame.frame;
160 *char_width = FRAME_PIXEL_WIDTH_TO_TEXT_COLS (f, (int) pixel_width);
161 *char_height = FRAME_PIXEL_HEIGHT_TO_TEXT_LINES (f, (int) pixel_height);
164 static void
165 pixel_to_text_size (EmacsFrame ew, Dimension pixel_width, Dimension pixel_height, int *text_width, int *text_height)
167 struct frame *f = ew->emacs_frame.frame;
168 *text_width = FRAME_PIXEL_TO_TEXT_WIDTH (f, (int) pixel_width);
169 *text_height = FRAME_PIXEL_TO_TEXT_HEIGHT (f, (int) pixel_height);
172 static void
173 char_to_pixel_size (EmacsFrame ew, int char_width, int char_height, Dimension *pixel_width, Dimension *pixel_height)
175 struct frame *f = ew->emacs_frame.frame;
176 *pixel_width = FRAME_TEXT_COLS_TO_PIXEL_WIDTH (f, char_width);
177 *pixel_height = FRAME_TEXT_LINES_TO_PIXEL_HEIGHT (f, char_height);
180 static void
181 round_size_to_char (EmacsFrame ew, Dimension in_width, Dimension in_height, Dimension *out_width, Dimension *out_height)
183 int char_width;
184 int char_height;
185 pixel_to_char_size (ew, in_width, in_height, &char_width, &char_height);
186 char_to_pixel_size (ew, char_width, char_height, out_width, out_height);
189 static Widget
190 get_wm_shell (Widget w)
192 Widget wmshell;
194 for (wmshell = XtParent (w);
195 wmshell && !XtIsWMShell (wmshell);
196 wmshell = XtParent (wmshell));
198 return wmshell;
201 #if 0 /* Currently not used. */
203 static void
204 mark_shell_size_user_specified (Widget wmshell)
206 if (! XtIsWMShell (wmshell)) emacs_abort ();
207 /* This is kind of sleazy, but I can't see how else to tell it to make it
208 mark the WM_SIZE_HINTS size as user specified when appropriate. */
209 ((WMShellWidget) wmshell)->wm.size_hints.flags |= USSize;
212 #endif
215 static void
216 set_frame_size (EmacsFrame ew)
218 /* The widget hierarchy is
220 argv[0] emacsShell pane Frame-NAME
221 ApplicationShell EmacsShell Paned EmacsFrame
223 We accept geometry specs in this order:
225 *Frame-NAME.geometry
226 *EmacsFrame.geometry
227 Emacs.geometry
229 Other possibilities for widget hierarchies might be
231 argv[0] frame pane Frame-NAME
232 ApplicationShell EmacsShell Paned EmacsFrame
234 argv[0] Frame-NAME pane Frame-NAME
235 ApplicationShell EmacsShell Paned EmacsFrame
237 argv[0] Frame-NAME pane emacsTextPane
238 ApplicationShell EmacsFrame Paned EmacsTextPane
240 With the current setup, the text-display-area is the part which is
241 an emacs "frame", since that's the only part managed by emacs proper
242 (the menubar and the parent of the menubar and all that sort of thing
243 are managed by lwlib.)
245 The EmacsShell widget is simply a replacement for the Shell widget
246 which is able to deal with using an externally-supplied window instead
247 of always creating its own. It is not actually emacs specific, and
248 should possibly have class "Shell" instead of "EmacsShell" to simplify
249 the resources.
253 /* Hairily merged geometry */
254 struct frame *f = ew->emacs_frame.frame;
255 int w = FRAME_COLS (f);
256 int h = FRAME_LINES (f);
257 Widget wmshell = get_wm_shell ((Widget) ew);
258 Dimension pixel_width, pixel_height;
259 /* Each Emacs shell is now independent and top-level. */
261 if (! XtIsSubclass (wmshell, shellWidgetClass)) emacs_abort ();
263 char_to_pixel_size (ew, w, h, &pixel_width, &pixel_height);
264 ew->core.width = (frame_resize_pixelwise
265 ? FRAME_PIXEL_WIDTH (f)
266 : pixel_width);
267 ew->core.height = (frame_resize_pixelwise
268 ? FRAME_PIXEL_HEIGHT (f)
269 : pixel_height);
271 frame_size_history_add
272 (f, Qset_frame_size, FRAME_TEXT_WIDTH (f), FRAME_TEXT_HEIGHT (f),
273 list2 (make_number (ew->core.width), make_number (ew->core.height)));
276 static void
277 update_wm_hints (EmacsFrame ew)
279 Widget wmshell = get_wm_shell ((Widget) ew);
280 int cw;
281 int ch;
282 Dimension rounded_width;
283 Dimension rounded_height;
284 int char_width;
285 int char_height;
286 int base_width;
287 int base_height;
288 int min_rows = 0, min_cols = 0;
290 /* This happens when the frame is just created. */
291 if (! wmshell) return;
293 pixel_to_char_size (ew, ew->core.width, ew->core.height,
294 &char_width, &char_height);
295 char_to_pixel_size (ew, char_width, char_height,
296 &rounded_width, &rounded_height);
297 get_default_char_pixel_size (ew, &cw, &ch);
299 base_width = (wmshell->core.width - ew->core.width
300 + (rounded_width - (char_width * cw)));
301 base_height = (wmshell->core.height - ew->core.height
302 + (rounded_height - (char_height * ch)));
304 /* This is kind of sleazy, but I can't see how else to tell it to
305 make it mark the WM_SIZE_HINTS size as user specified.
307 /* ((WMShellWidget) wmshell)->wm.size_hints.flags |= USSize;*/
309 XtVaSetValues (wmshell,
310 XtNbaseWidth, (XtArgVal) base_width,
311 XtNbaseHeight, (XtArgVal) base_height,
312 XtNwidthInc, (XtArgVal) (frame_resize_pixelwise ? 1 : cw),
313 XtNheightInc, (XtArgVal) (frame_resize_pixelwise ? 1 : ch),
314 XtNminWidth, (XtArgVal) (base_width + min_cols * cw),
315 XtNminHeight, (XtArgVal) (base_height + min_rows * ch),
316 NULL);
319 void
320 widget_update_wm_size_hints (Widget widget)
322 EmacsFrame ew = (EmacsFrame) widget;
323 update_wm_hints (ew);
326 static void
327 update_various_frame_slots (EmacsFrame ew)
329 struct frame *f = ew->emacs_frame.frame;
331 f->internal_border_width = ew->emacs_frame.internal_border_width;
334 static void
335 update_from_various_frame_slots (EmacsFrame ew)
337 struct frame *f = ew->emacs_frame.frame;
338 struct x_output *x = f->output_data.x;
340 ew->core.height = FRAME_PIXEL_HEIGHT (f) - x->menubar_height;
341 ew->core.width = FRAME_PIXEL_WIDTH (f);
342 ew->core.background_pixel = FRAME_BACKGROUND_PIXEL (f);
343 ew->emacs_frame.internal_border_width = f->internal_border_width;
344 ew->emacs_frame.foreground_pixel = FRAME_FOREGROUND_PIXEL (f);
345 ew->emacs_frame.cursor_color = x->cursor_pixel;
346 ew->core.border_pixel = x->border_pixel;
349 static void
350 EmacsFrameInitialize (Widget request, Widget new, ArgList dum1, Cardinal *dum2)
352 EmacsFrame ew = (EmacsFrame) new;
354 if (!ew->emacs_frame.frame)
356 fprintf (stderr,
357 "can't create an emacs frame widget without a frame\n");
358 exit (1);
361 update_from_various_frame_slots (ew);
362 set_frame_size (ew);
365 static void
366 resize_cb (Widget widget,
367 XtPointer closure,
368 XEvent *event,
369 Boolean *continue_to_dispatch)
371 EmacsFrameResize (widget);
375 static void
376 EmacsFrameRealize (Widget widget, XtValueMask *mask, XSetWindowAttributes *attrs)
378 EmacsFrame ew = (EmacsFrame) widget;
380 /* This used to contain SubstructureRedirectMask, but this turns out
381 to be a problem with XIM on Solaris, and events from that mask
382 don't seem to be used. Let's check that. */
383 attrs->event_mask = (STANDARD_EVENT_SET
384 | PropertyChangeMask
385 | SubstructureNotifyMask);
386 *mask |= CWEventMask;
387 XtCreateWindow (widget, InputOutput, (Visual *) CopyFromParent, *mask,
388 attrs);
389 /* Some ConfigureNotify events does not end up in EmacsFrameResize so
390 make sure we get them all. Seen with xfcwm4 for example. */
391 XtAddRawEventHandler (widget, StructureNotifyMask, False, resize_cb, NULL);
392 update_wm_hints (ew);
395 static void
396 EmacsFrameDestroy (Widget widget)
398 /* All GCs are now freed in x_free_frame_resources. */
401 static void
402 EmacsFrameResize (Widget widget)
404 EmacsFrame ew = (EmacsFrame) widget;
405 struct frame *f = ew->emacs_frame.frame;
406 int width, height;
408 pixel_to_text_size (ew, ew->core.width, ew->core.height, &width, &height);
410 frame_size_history_add
411 (f, QEmacsFrameResize, width, height,
412 list5 (make_number (ew->core.width), make_number (ew->core.height),
413 make_number (FRAME_TOP_MARGIN_HEIGHT (f)),
414 make_number (FRAME_SCROLL_BAR_AREA_HEIGHT (f)),
415 make_number (2 * FRAME_INTERNAL_BORDER_WIDTH (f))));
417 change_frame_size (f, width, height, 0, 1, 0, 1);
419 update_wm_hints (ew);
420 update_various_frame_slots (ew);
422 cancel_mouse_face (f);
425 static XtGeometryResult
426 EmacsFrameQueryGeometry (Widget widget, XtWidgetGeometry *request, XtWidgetGeometry *result)
428 EmacsFrame ew = (EmacsFrame) widget;
430 int mask = request->request_mode;
431 Dimension ok_width, ok_height;
433 if (mask & (CWWidth | CWHeight))
435 if (!frame_resize_pixelwise)
436 round_size_to_char (ew,
437 (mask & CWWidth) ? request->width : ew->core.width,
438 ((mask & CWHeight) ? request->height
439 : ew->core.height),
440 &ok_width, &ok_height);
441 if ((mask & CWWidth) && (ok_width != request->width))
443 result->request_mode |= CWWidth;
444 result->width = ok_width;
446 if ((mask & CWHeight) && (ok_height != request->height))
448 result->request_mode |= CWHeight;
449 result->height = ok_height;
452 return result->request_mode ? XtGeometryAlmost : XtGeometryYes;
455 /* Special entry points */
456 void
457 EmacsFrameSetCharSize (Widget widget, int columns, int rows)
459 EmacsFrame ew = (EmacsFrame) widget;
460 struct frame *f = ew->emacs_frame.frame;
462 if (!frame_inhibit_resize (f, 0, Qfont)
463 && !frame_inhibit_resize (f, 1, Qfont))
464 x_set_window_size (f, 0, columns, rows, 0);
468 void
469 widget_store_internal_border (Widget widget)
471 EmacsFrame ew = (EmacsFrame) widget;
472 struct frame *f = ew->emacs_frame.frame;
474 ew->emacs_frame.internal_border_width = f->internal_border_width;