Add cl-struct specific optimizations to pcase.
[emacs.git] / src / widget.c
blobacf559f313b981a2644af69975956968d45ac3bd
1 /* The emacs frame widget.
2 Copyright (C) 1992-1993, 2000-2015 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>
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 "character.h"
54 #include "font.h"
57 static void EmacsFrameInitialize (Widget request, Widget new, ArgList dum1, Cardinal *dum2);
58 static void EmacsFrameDestroy (Widget widget);
59 static void EmacsFrameRealize (Widget widget, XtValueMask *mask, XSetWindowAttributes *attrs);
60 static void EmacsFrameResize (Widget widget);
61 static XtGeometryResult EmacsFrameQueryGeometry (Widget widget, XtWidgetGeometry *request, XtWidgetGeometry *result);
64 #undef XtOffset
65 #define XtOffset(p_type,field) \
66 ((Cardinal) (((char *) (&(((p_type)0)->field))) - ((char *)0)))
67 #define offset(field) XtOffset (EmacsFrame, emacs_frame.field)
69 static XtResource resources[] = {
70 {XtNgeometry, XtCGeometry, XtRString, sizeof (String),
71 offset (geometry), XtRString, (XtPointer) 0},
72 {XtNiconic, XtCIconic, XtRBoolean, sizeof (Boolean),
73 offset (iconic), XtRImmediate, (XtPointer) False},
75 {XtNemacsFrame, XtCEmacsFrame, XtRPointer, sizeof (XtPointer),
76 offset (frame), XtRImmediate, 0},
78 {XtNminibuffer, XtCMinibuffer, XtRInt, sizeof (int),
79 offset (minibuffer), XtRImmediate, (XtPointer)0},
80 {XtNunsplittable, XtCUnsplittable, XtRBoolean, sizeof (Boolean),
81 offset (unsplittable), XtRImmediate, (XtPointer)0},
82 {XtNinternalBorderWidth, XtCInternalBorderWidth, XtRInt, sizeof (int),
83 offset (internal_border_width), XtRImmediate, (XtPointer)4},
84 {XtNinterline, XtCInterline, XtRInt, sizeof (int),
85 offset (interline), XtRImmediate, (XtPointer)0},
86 {XtNforeground, XtCForeground, XtRPixel, sizeof (Pixel),
87 offset (foreground_pixel), XtRString, "XtDefaultForeground"},
88 {XtNcursorColor, XtCForeground, XtRPixel, sizeof (Pixel),
89 offset (cursor_color), XtRString, "XtDefaultForeground"},
90 {XtNbarCursor, XtCBarCursor, XtRBoolean, sizeof (Boolean),
91 offset (bar_cursor), XtRImmediate, (XtPointer)0},
92 {XtNvisualBell, XtCVisualBell, XtRBoolean, sizeof (Boolean),
93 offset (visual_bell), XtRImmediate, (XtPointer)0},
94 {XtNbellVolume, XtCBellVolume, XtRInt, sizeof (int),
95 offset (bell_volume), XtRImmediate, (XtPointer)0},
98 #undef offset
101 static XtActionsRec
102 emacsFrameActionsTable [] = {
103 {"keypress", key_press},
104 {"focus_in", emacs_frame_focus_handler},
105 {"focus_out", emacs_frame_focus_handler},
108 static char
109 emacsFrameTranslations [] = "\
110 <KeyPress>: keypress()\n\
111 <FocusIn>: focus_in()\n\
112 <FocusOut>: focus_out()\n\
116 static EmacsFrameClassRec emacsFrameClassRec = {
117 { /* core fields */
118 /* superclass */ &widgetClassRec,
119 /* class_name */ "EmacsFrame",
120 /* widget_size */ sizeof (EmacsFrameRec),
121 /* class_initialize */ 0,
122 /* class_part_initialize */ 0,
123 /* class_inited */ FALSE,
124 /* initialize */ EmacsFrameInitialize,
125 /* initialize_hook */ 0,
126 /* realize */ EmacsFrameRealize,
127 /* actions */ 0, /*emacsFrameActionsTable*/
128 /* num_actions */ 0, /*XtNumber (emacsFrameActionsTable)*/
129 /* resources */ resources,
130 /* resource_count */ XtNumber (resources),
131 /* xrm_class */ NULLQUARK,
132 /* compress_motion */ TRUE,
133 /* compress_exposure */ TRUE,
134 /* compress_enterleave */ TRUE,
135 /* visible_interest */ FALSE,
136 /* destroy */ EmacsFrameDestroy,
137 /* resize */ EmacsFrameResize,
138 /* expose */ XtInheritExpose,
140 /* Emacs never does XtSetvalues on this widget, so we have no code
141 for it. */
142 /* set_values */ 0, /* Not supported */
143 /* set_values_hook */ 0,
144 /* set_values_almost */ XtInheritSetValuesAlmost,
145 /* get_values_hook */ 0,
146 /* accept_focus */ XtInheritAcceptFocus,
147 /* version */ XtVersion,
148 /* callback_private */ 0,
149 /* tm_table */ 0, /*emacsFrameTranslations*/
150 /* query_geometry */ EmacsFrameQueryGeometry,
151 /* display_accelerator */ XtInheritDisplayAccelerator,
152 /* extension */ 0
156 WidgetClass emacsFrameClass = (WidgetClass) &emacsFrameClassRec;
158 static void
159 get_default_char_pixel_size (EmacsFrame ew, int *pixel_width, int *pixel_height)
161 struct frame* f = ew->emacs_frame.frame;
162 *pixel_width = FRAME_COLUMN_WIDTH (f);
163 *pixel_height = FRAME_LINE_HEIGHT (f);
166 static void
167 pixel_to_char_size (EmacsFrame ew, Dimension pixel_width, Dimension pixel_height, int *char_width, int *char_height)
169 struct frame* f = ew->emacs_frame.frame;
170 *char_width = FRAME_PIXEL_WIDTH_TO_TEXT_COLS (f, (int) pixel_width);
171 *char_height = FRAME_PIXEL_HEIGHT_TO_TEXT_LINES (f, (int) pixel_height);
174 static void
175 pixel_to_text_size (EmacsFrame ew, Dimension pixel_width, Dimension pixel_height, int *text_width, int *text_height)
177 struct frame* f = ew->emacs_frame.frame;
178 *text_width = FRAME_PIXEL_TO_TEXT_WIDTH (f, (int) pixel_width);
179 *text_height = FRAME_PIXEL_TO_TEXT_HEIGHT (f, (int) pixel_height);
182 static void
183 char_to_pixel_size (EmacsFrame ew, int char_width, int char_height, Dimension *pixel_width, Dimension *pixel_height)
185 struct frame* f = ew->emacs_frame.frame;
186 *pixel_width = FRAME_TEXT_COLS_TO_PIXEL_WIDTH (f, char_width);
187 *pixel_height = FRAME_TEXT_LINES_TO_PIXEL_HEIGHT (f, char_height);
190 static void
191 round_size_to_char (EmacsFrame ew, Dimension in_width, Dimension in_height, Dimension *out_width, Dimension *out_height)
193 int char_width;
194 int char_height;
195 pixel_to_char_size (ew, in_width, in_height, &char_width, &char_height);
196 char_to_pixel_size (ew, char_width, char_height, out_width, out_height);
199 static Widget
200 get_wm_shell (Widget w)
202 Widget wmshell;
204 for (wmshell = XtParent (w);
205 wmshell && !XtIsWMShell (wmshell);
206 wmshell = XtParent (wmshell));
208 return wmshell;
211 #if 0 /* Currently not used. */
213 static void
214 mark_shell_size_user_specified (Widget wmshell)
216 if (! XtIsWMShell (wmshell)) emacs_abort ();
217 /* This is kind of sleazy, but I can't see how else to tell it to make it
218 mark the WM_SIZE_HINTS size as user specified when appropriate. */
219 ((WMShellWidget) wmshell)->wm.size_hints.flags |= USSize;
222 #endif
225 /* Can't have static frame locals because of some broken compilers.
226 Normally, initializing a variable like this doesn't work in emacs,
227 but it's ok in this file because it must come after lastfile (and
228 thus have its data not go into text space) because Xt needs to
229 write to initialized data objects too.
231 #if 0
232 static Boolean first_frame_p = True;
233 #endif
235 static void
236 set_frame_size (EmacsFrame ew)
238 /* The widget hierarchy is
240 argv[0] emacsShell pane Frame-NAME
241 ApplicationShell EmacsShell Paned EmacsFrame
243 We accept geometry specs in this order:
245 *Frame-NAME.geometry
246 *EmacsFrame.geometry
247 Emacs.geometry
249 Other possibilities for widget hierarchies might be
251 argv[0] frame pane Frame-NAME
252 ApplicationShell EmacsShell Paned EmacsFrame
254 argv[0] Frame-NAME pane Frame-NAME
255 ApplicationShell EmacsShell Paned EmacsFrame
257 argv[0] Frame-NAME pane emacsTextPane
258 ApplicationShell EmacsFrame Paned EmacsTextPane
260 With the current setup, the text-display-area is the part which is
261 an emacs "frame", since that's the only part managed by emacs proper
262 (the menubar and the parent of the menubar and all that sort of thing
263 are managed by lwlib.)
265 The EmacsShell widget is simply a replacement for the Shell widget
266 which is able to deal with using an externally-supplied window instead
267 of always creating its own. It is not actually emacs specific, and
268 should possibly have class "Shell" instead of "EmacsShell" to simplify
269 the resources.
273 /* Hairily merged geometry */
274 unsigned int w = FRAME_COLS (ew->emacs_frame.frame);
275 unsigned int h = FRAME_LINES (ew->emacs_frame.frame);
277 Widget wmshell = get_wm_shell ((Widget) ew);
278 /* Each Emacs shell is now independent and top-level. */
280 if (! XtIsSubclass (wmshell, shellWidgetClass)) emacs_abort ();
282 /* We don't need this for the moment. The geometry is computed in
283 xfns.c. */
284 #if 0
285 /* If the EmacsFrame doesn't have a geometry but the shell does,
286 treat that as the geometry of the frame. (Is this bogus?
287 I'm not sure.) */
288 if (ew->emacs_frame.geometry == 0)
289 XtVaGetValues (wmshell, XtNgeometry, &ew->emacs_frame.geometry, NULL);
291 /* If the Shell is iconic, then the EmacsFrame is iconic. (Is
292 this bogus? I'm not sure.) */
293 if (!ew->emacs_frame.iconic)
294 XtVaGetValues (wmshell, XtNiconic, &ew->emacs_frame.iconic, NULL);
298 char *geom = 0;
299 XtVaGetValues (app_shell, XtNgeometry, &geom, NULL);
300 if (geom)
301 app_flags = XParseGeometry (geom, &app_x, &app_y, &app_w, &app_h);
304 if (ew->emacs_frame.geometry)
305 frame_flags = XParseGeometry (ew->emacs_frame.geometry,
306 &frame_x, &frame_y,
307 &frame_w, &frame_h);
309 if (first_frame_p)
311 /* If this is the first frame created:
312 ====================================
314 - Use the ApplicationShell's size/position, if specified.
315 (This is "Emacs.geometry", or the "-geometry" command line arg.)
316 - Else use the EmacsFrame's size/position.
317 (This is "*Frame-NAME.geometry")
319 - If the AppShell is iconic, the frame should be iconic.
321 AppShell comes first so that -geometry always applies to the first
322 frame created, even if there is an "every frame" entry in the
323 resource database.
325 if (app_flags & (XValue | YValue))
327 x = app_x; y = app_y;
328 flags |= (app_flags & (XValue | YValue | XNegative | YNegative));
330 else if (frame_flags & (XValue | YValue))
332 x = frame_x; y = frame_y;
333 flags |= (frame_flags & (XValue | YValue | XNegative | YNegative));
336 if (app_flags & (WidthValue | HeightValue))
338 w = app_w; h = app_h;
339 flags |= (app_flags & (WidthValue | HeightValue));
341 else if (frame_flags & (WidthValue | HeightValue))
343 w = frame_w; h = frame_h;
344 flags |= (frame_flags & (WidthValue | HeightValue));
347 /* If the AppShell is iconic, then the EmacsFrame is iconic. */
348 if (!ew->emacs_frame.iconic)
349 XtVaGetValues (app_shell, XtNiconic, &ew->emacs_frame.iconic, NULL);
351 first_frame_p = False;
353 else
355 /* If this is not the first frame created:
356 ========================================
358 - use the EmacsFrame's size/position if specified
359 - Otherwise, use the ApplicationShell's size, but not position.
361 So that means that one can specify the position of the first frame
362 with "Emacs.geometry" or `-geometry'; but can only specify the
363 position of subsequent frames with "*Frame-NAME.geometry".
365 AppShell comes second so that -geometry does not apply to subsequent
366 frames when there is an "every frame" entry in the resource db,
367 but does apply to the first frame.
369 if (frame_flags & (XValue | YValue))
371 x = frame_x; y = frame_y;
372 flags |= (frame_flags & (XValue | YValue | XNegative | YNegative));
375 if (frame_flags & (WidthValue | HeightValue))
377 w = frame_w; h = frame_h;
378 flags |= (frame_flags & (WidthValue | HeightValue));
380 else if (app_flags & (WidthValue | HeightValue))
382 w = app_w;
383 h = app_h;
384 flags |= (app_flags & (WidthValue | HeightValue));
387 #endif /* 0 */
389 Dimension pixel_width, pixel_height;
391 /* Take into account the size of the scrollbar. Always use the
392 number of columns occupied by the scroll bar here otherwise we
393 might end up with a frame width that is not a multiple of the
394 frame's character width which is bad for vertically split
395 windows. */
397 #if 0 /* This can run Lisp code, and it is dangerous to give
398 out the frame to Lisp code before it officially exists.
399 This is handled in Fx_create_frame so not needed here. */
400 change_frame_size (f, w, h, 1, 0, 0, 0);
401 #endif
402 char_to_pixel_size (ew, w, h, &pixel_width, &pixel_height);
403 ew->core.width = pixel_width;
404 ew->core.height = pixel_height;
406 #if 0 /* xfns.c takes care of this now. */
407 /* If a position was specified, assign it to the shell widget.
408 (Else WM won't do anything with it.)
410 if (flags & (XValue | YValue))
412 /* the tricky things with the sign is to make sure that
413 -0 is printed -0. */
414 sprintf (shell_position, "=%c%d%c%d",
415 flags & XNegative ? '-' : '+', x < 0 ? -x : x,
416 flags & YNegative ? '-' : '+', y < 0 ? -y : y);
417 XtVaSetValues (wmshell, XtNgeometry, xstrdup (shell_position), NULL);
419 else if (flags & (WidthValue | HeightValue))
421 sprintf (shell_position, "=%dx%d", pixel_width, pixel_height);
422 XtVaSetValues (wmshell, XtNgeometry, xstrdup (shell_position), NULL);
425 /* If the geometry spec we're using has W/H components, mark the size
426 in the WM_SIZE_HINTS as user specified. */
427 if (flags & (WidthValue | HeightValue))
428 mark_shell_size_user_specified (wmshell);
430 /* Also assign the iconic status of the frame to the Shell, so that
431 the WM sees it. */
432 XtVaSetValues (wmshell, XtNiconic, ew->emacs_frame.iconic, NULL);
433 #endif /* 0 */
437 static void
438 update_wm_hints (EmacsFrame ew)
440 Widget wmshell = get_wm_shell ((Widget)ew);
441 int cw;
442 int ch;
443 Dimension rounded_width;
444 Dimension rounded_height;
445 int char_width;
446 int char_height;
447 int base_width;
448 int base_height;
449 int min_rows = 0, min_cols = 0;
451 /* This happens when the frame is just created. */
452 if (! wmshell) return;
454 pixel_to_char_size (ew, ew->core.width, ew->core.height,
455 &char_width, &char_height);
456 char_to_pixel_size (ew, char_width, char_height,
457 &rounded_width, &rounded_height);
458 get_default_char_pixel_size (ew, &cw, &ch);
460 base_width = (wmshell->core.width - ew->core.width
461 + (rounded_width - (char_width * cw)));
462 base_height = (wmshell->core.height - ew->core.height
463 + (rounded_height - (char_height * ch)));
465 /* This is kind of sleazy, but I can't see how else to tell it to
466 make it mark the WM_SIZE_HINTS size as user specified.
468 /* ((WMShellWidget) wmshell)->wm.size_hints.flags |= USSize;*/
470 XtVaSetValues (wmshell,
471 XtNbaseWidth, (XtArgVal) base_width,
472 XtNbaseHeight, (XtArgVal) base_height,
473 XtNwidthInc, (XtArgVal) (frame_resize_pixelwise ? 1 : cw),
474 XtNheightInc, (XtArgVal) (frame_resize_pixelwise ? 1 : ch),
475 XtNminWidth, (XtArgVal) (base_width + min_cols * cw),
476 XtNminHeight, (XtArgVal) (base_height + min_rows * ch),
477 NULL);
480 void
481 widget_update_wm_size_hints (Widget widget)
483 EmacsFrame ew = (EmacsFrame)widget;
484 update_wm_hints (ew);
487 static void
488 update_various_frame_slots (EmacsFrame ew)
490 struct frame *f = ew->emacs_frame.frame;
492 /* Don't do that: It confuses the check in change_frame_size_1 whether
493 the pixel size of the frame changed due to a change of the internal
494 border width. Bug#16736. */
495 if (false)
497 struct x_output *x = f->output_data.x;
498 FRAME_PIXEL_HEIGHT (f) = ew->core.height + x->menubar_height;
499 FRAME_PIXEL_WIDTH (f) = ew->core.width;
502 f->internal_border_width = ew->emacs_frame.internal_border_width;
505 static void
506 update_from_various_frame_slots (EmacsFrame ew)
508 struct frame *f = ew->emacs_frame.frame;
509 struct x_output *x = f->output_data.x;
510 ew->core.height = FRAME_PIXEL_HEIGHT (f) - x->menubar_height;
511 ew->core.width = FRAME_PIXEL_WIDTH (f);
512 ew->core.background_pixel = FRAME_BACKGROUND_PIXEL (f);
513 ew->emacs_frame.internal_border_width = f->internal_border_width;
514 ew->emacs_frame.foreground_pixel = FRAME_FOREGROUND_PIXEL (f);
515 ew->emacs_frame.cursor_color = x->cursor_pixel;
516 ew->core.border_pixel = x->border_pixel;
519 static void
520 EmacsFrameInitialize (Widget request, Widget new, ArgList dum1, Cardinal *dum2)
522 EmacsFrame ew = (EmacsFrame)new;
524 if (!ew->emacs_frame.frame)
526 fprintf (stderr,
527 "can't create an emacs frame widget without a frame\n");
528 exit (1);
531 update_from_various_frame_slots (ew);
532 set_frame_size (ew);
535 static void
536 resize_cb (Widget widget,
537 XtPointer closure,
538 XEvent* event,
539 Boolean* continue_to_dispatch)
541 EmacsFrameResize (widget);
545 static void
546 EmacsFrameRealize (Widget widget, XtValueMask *mask, XSetWindowAttributes *attrs)
548 EmacsFrame ew = (EmacsFrame)widget;
550 /* This used to contain SubstructureRedirectMask, but this turns out
551 to be a problem with XIM on Solaris, and events from that mask
552 don't seem to be used. Let's check that. */
553 attrs->event_mask = (STANDARD_EVENT_SET
554 | PropertyChangeMask
555 | SubstructureNotifyMask);
556 *mask |= CWEventMask;
557 XtCreateWindow (widget, InputOutput, (Visual *)CopyFromParent, *mask,
558 attrs);
559 /* Some ConfigureNotify events does not end up in EmacsFrameResize so
560 make sure we get them all. Seen with xfcwm4 for example. */
561 XtAddRawEventHandler (widget, StructureNotifyMask, False, resize_cb, NULL);
562 update_wm_hints (ew);
565 static void
566 EmacsFrameDestroy (Widget widget)
568 /* All GCs are now freed in x_free_frame_resources. */
571 static void
572 EmacsFrameResize (Widget widget)
574 EmacsFrame ew = (EmacsFrame)widget;
575 struct frame *f = ew->emacs_frame.frame;
576 int width, height;
578 pixel_to_text_size (ew, ew->core.width, ew->core.height, &width, &height);
580 frame_size_history_add
581 (f, QEmacsFrameResize, width, height,
582 list2 (make_number (ew->core.width), make_number (ew->core.height)));
584 change_frame_size (f, width, height, 0, 1, 0, 1);
586 update_wm_hints (ew);
587 update_various_frame_slots (ew);
589 cancel_mouse_face (f);
592 static XtGeometryResult
593 EmacsFrameQueryGeometry (Widget widget, XtWidgetGeometry *request, XtWidgetGeometry *result)
595 EmacsFrame ew = (EmacsFrame)widget;
597 int mask = request->request_mode;
598 Dimension ok_width, ok_height;
600 if (mask & (CWWidth | CWHeight))
602 round_size_to_char (ew,
603 (mask & CWWidth) ? request->width : ew->core.width,
604 ((mask & CWHeight) ? request->height
605 : ew->core.height),
606 &ok_width, &ok_height);
607 if ((mask & CWWidth) && (ok_width != request->width))
609 result->request_mode |= CWWidth;
610 result->width = ok_width;
612 if ((mask & CWHeight) && (ok_height != request->height))
614 result->request_mode |= CWHeight;
615 result->height = ok_height;
618 return result->request_mode ? XtGeometryAlmost : XtGeometryYes;
621 /* Special entry points */
622 void
623 EmacsFrameSetCharSize (Widget widget, int columns, int rows)
625 EmacsFrame ew = (EmacsFrame) widget;
626 struct frame *f = ew->emacs_frame.frame;
628 if (!frame_inhibit_resize (f, 0, Qfont)
629 && !frame_inhibit_resize (f, 1, Qfont))
630 x_set_window_size (f, 0, columns, rows, 0);
634 void
635 widget_store_internal_border (Widget widget)
637 EmacsFrame ew = (EmacsFrame) widget;
638 struct frame *f = ew->emacs_frame.frame;
640 ew->emacs_frame.internal_border_width = f->internal_border_width;