* lisp/emacs-lisp/nadvice.el (add-function): Fix debug spec.
[emacs.git] / src / widget.c
blobd0c3e60cfa63587e038c6c695b01a9b6b9c039ea
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 "widget.h"
34 #include <stdio.h>
36 #include "lisp.h"
37 #include "xterm.h"
38 #include "frame.h"
40 #include <X11/StringDefs.h>
41 #include <X11/IntrinsicP.h>
42 #include <X11/cursorfont.h>
43 #include "widgetprv.h"
44 #include <X11/ObjectP.h>
45 #include <X11/Shell.h>
46 #include <X11/ShellP.h>
47 #include "../lwlib/lwlib.h"
49 static void EmacsFrameInitialize (Widget request, Widget new, ArgList dum1, Cardinal *dum2);
50 static void EmacsFrameDestroy (Widget widget);
51 static void EmacsFrameRealize (Widget widget, XtValueMask *mask, XSetWindowAttributes *attrs);
52 static void EmacsFrameResize (Widget widget);
53 static XtGeometryResult EmacsFrameQueryGeometry (Widget widget, XtWidgetGeometry *request, XtWidgetGeometry *result);
56 #define offset(field) offsetof (EmacsFrameRec, emacs_frame.field)
58 static XtResource resources[] = {
59 {XtNgeometry, XtCGeometry, XtRString, sizeof (String),
60 offset (geometry), XtRString, (XtPointer) 0},
61 {XtNiconic, XtCIconic, XtRBoolean, sizeof (Boolean),
62 offset (iconic), XtRImmediate, (XtPointer) False},
64 {XtNemacsFrame, XtCEmacsFrame, XtRPointer, sizeof (XtPointer),
65 offset (frame), XtRImmediate, 0},
67 {XtNminibuffer, XtCMinibuffer, XtRInt, sizeof (int),
68 offset (minibuffer), XtRImmediate, (XtPointer)0},
69 {XtNunsplittable, XtCUnsplittable, XtRBoolean, sizeof (Boolean),
70 offset (unsplittable), XtRImmediate, (XtPointer)0},
71 {XtNinternalBorderWidth, XtCInternalBorderWidth, XtRInt, sizeof (int),
72 offset (internal_border_width), XtRImmediate, (XtPointer)4},
73 {XtNinterline, XtCInterline, XtRInt, sizeof (int),
74 offset (interline), XtRImmediate, (XtPointer)0},
75 {XtNforeground, XtCForeground, XtRPixel, sizeof (Pixel),
76 offset (foreground_pixel), XtRString, "XtDefaultForeground"},
77 {XtNcursorColor, XtCForeground, XtRPixel, sizeof (Pixel),
78 offset (cursor_color), XtRString, "XtDefaultForeground"},
79 {XtNbarCursor, XtCBarCursor, XtRBoolean, sizeof (Boolean),
80 offset (bar_cursor), XtRImmediate, (XtPointer)0},
81 {XtNvisualBell, XtCVisualBell, XtRBoolean, sizeof (Boolean),
82 offset (visual_bell), XtRImmediate, (XtPointer)0},
83 {XtNbellVolume, XtCBellVolume, XtRInt, sizeof (int),
84 offset (bell_volume), XtRImmediate, (XtPointer)0},
87 #undef offset
90 static XtActionsRec
91 emacsFrameActionsTable [] = {
92 {"keypress", key_press},
93 {"focus_in", emacs_frame_focus_handler},
94 {"focus_out", emacs_frame_focus_handler},
97 static char
98 emacsFrameTranslations [] = "\
99 <KeyPress>: keypress()\n\
100 <FocusIn>: focus_in()\n\
101 <FocusOut>: focus_out()\n\
105 static EmacsFrameClassRec emacsFrameClassRec = {
106 { /* core fields */
107 /* superclass */ &widgetClassRec,
108 /* class_name */ "EmacsFrame",
109 /* widget_size */ sizeof (EmacsFrameRec),
110 /* class_initialize */ 0,
111 /* class_part_initialize */ 0,
112 /* class_inited */ FALSE,
113 /* initialize */ EmacsFrameInitialize,
114 /* initialize_hook */ 0,
115 /* realize */ EmacsFrameRealize,
116 /* actions */ 0, /*emacsFrameActionsTable*/
117 /* num_actions */ 0, /*XtNumber (emacsFrameActionsTable)*/
118 /* resources */ resources,
119 /* resource_count */ XtNumber (resources),
120 /* xrm_class */ NULLQUARK,
121 /* compress_motion */ TRUE,
122 /* compress_exposure */ TRUE,
123 /* compress_enterleave */ TRUE,
124 /* visible_interest */ FALSE,
125 /* destroy */ EmacsFrameDestroy,
126 /* resize */ EmacsFrameResize,
127 /* expose */ XtInheritExpose,
129 /* Emacs never does XtSetvalues on this widget, so we have no code
130 for it. */
131 /* set_values */ 0, /* Not supported */
132 /* set_values_hook */ 0,
133 /* set_values_almost */ XtInheritSetValuesAlmost,
134 /* get_values_hook */ 0,
135 /* accept_focus */ XtInheritAcceptFocus,
136 /* version */ XtVersion,
137 /* callback_private */ 0,
138 /* tm_table */ 0, /*emacsFrameTranslations*/
139 /* query_geometry */ EmacsFrameQueryGeometry,
140 /* display_accelerator */ XtInheritDisplayAccelerator,
141 /* extension */ 0
145 WidgetClass emacsFrameClass = (WidgetClass) &emacsFrameClassRec;
147 static void
148 get_default_char_pixel_size (EmacsFrame ew, int *pixel_width, int *pixel_height)
150 struct frame* f = ew->emacs_frame.frame;
151 *pixel_width = FRAME_COLUMN_WIDTH (f);
152 *pixel_height = FRAME_LINE_HEIGHT (f);
155 static void
156 pixel_to_char_size (EmacsFrame ew, Dimension pixel_width, Dimension pixel_height, int *char_width, int *char_height)
158 struct frame* f = ew->emacs_frame.frame;
159 *char_width = FRAME_PIXEL_WIDTH_TO_TEXT_COLS (f, (int) pixel_width);
160 *char_height = FRAME_PIXEL_HEIGHT_TO_TEXT_LINES (f, (int) pixel_height);
163 static void
164 pixel_to_text_size (EmacsFrame ew, Dimension pixel_width, Dimension pixel_height, int *text_width, int *text_height)
166 struct frame* f = ew->emacs_frame.frame;
167 *text_width = FRAME_PIXEL_TO_TEXT_WIDTH (f, (int) pixel_width);
168 *text_height = FRAME_PIXEL_TO_TEXT_HEIGHT (f, (int) pixel_height);
171 static void
172 char_to_pixel_size (EmacsFrame ew, int char_width, int char_height, Dimension *pixel_width, Dimension *pixel_height)
174 struct frame* f = ew->emacs_frame.frame;
175 *pixel_width = FRAME_TEXT_COLS_TO_PIXEL_WIDTH (f, char_width);
176 *pixel_height = FRAME_TEXT_LINES_TO_PIXEL_HEIGHT (f, char_height);
179 static void
180 round_size_to_char (EmacsFrame ew, Dimension in_width, Dimension in_height, Dimension *out_width, Dimension *out_height)
182 int char_width;
183 int char_height;
184 pixel_to_char_size (ew, in_width, in_height, &char_width, &char_height);
185 char_to_pixel_size (ew, char_width, char_height, out_width, out_height);
188 static Widget
189 get_wm_shell (Widget w)
191 Widget wmshell;
193 for (wmshell = XtParent (w);
194 wmshell && !XtIsWMShell (wmshell);
195 wmshell = XtParent (wmshell));
197 return wmshell;
200 #if 0 /* Currently not used. */
202 static void
203 mark_shell_size_user_specified (Widget wmshell)
205 if (! XtIsWMShell (wmshell)) emacs_abort ();
206 /* This is kind of sleazy, but I can't see how else to tell it to make it
207 mark the WM_SIZE_HINTS size as user specified when appropriate. */
208 ((WMShellWidget) wmshell)->wm.size_hints.flags |= USSize;
211 #endif
214 /* Can't have static frame locals because of some broken compilers.
215 Normally, initializing a variable like this doesn't work in emacs,
216 but it's ok in this file because it must come after lastfile (and
217 thus have its data not go into text space) because Xt needs to
218 write to initialized data objects too.
220 #if 0
221 static Boolean first_frame_p = True;
222 #endif
224 static void
225 set_frame_size (EmacsFrame ew)
227 /* The widget hierarchy is
229 argv[0] emacsShell pane Frame-NAME
230 ApplicationShell EmacsShell Paned EmacsFrame
232 We accept geometry specs in this order:
234 *Frame-NAME.geometry
235 *EmacsFrame.geometry
236 Emacs.geometry
238 Other possibilities for widget hierarchies might be
240 argv[0] frame pane Frame-NAME
241 ApplicationShell EmacsShell Paned EmacsFrame
243 argv[0] Frame-NAME pane Frame-NAME
244 ApplicationShell EmacsShell Paned EmacsFrame
246 argv[0] Frame-NAME pane emacsTextPane
247 ApplicationShell EmacsFrame Paned EmacsTextPane
249 With the current setup, the text-display-area is the part which is
250 an emacs "frame", since that's the only part managed by emacs proper
251 (the menubar and the parent of the menubar and all that sort of thing
252 are managed by lwlib.)
254 The EmacsShell widget is simply a replacement for the Shell widget
255 which is able to deal with using an externally-supplied window instead
256 of always creating its own. It is not actually emacs specific, and
257 should possibly have class "Shell" instead of "EmacsShell" to simplify
258 the resources.
262 /* Hairily merged geometry */
263 struct frame *f = ew->emacs_frame.frame;
264 int w = FRAME_COLS (f);
265 int h = FRAME_LINES (f);
266 Widget wmshell = get_wm_shell ((Widget) ew);
267 Dimension pixel_width, pixel_height;
268 /* Each Emacs shell is now independent and top-level. */
270 if (! XtIsSubclass (wmshell, shellWidgetClass)) emacs_abort ();
272 char_to_pixel_size (ew, w, h, &pixel_width, &pixel_height);
273 ew->core.width = (frame_resize_pixelwise
274 ? FRAME_PIXEL_WIDTH (f)
275 : pixel_width);
276 ew->core.height = (frame_resize_pixelwise
277 ? FRAME_PIXEL_HEIGHT (f)
278 : pixel_height);
280 frame_size_history_add
281 (f, Qset_frame_size, FRAME_TEXT_WIDTH (f), FRAME_TEXT_HEIGHT (f),
282 list2 (make_number (ew->core.width), make_number (ew->core.height)));
285 static void
286 update_wm_hints (EmacsFrame ew)
288 Widget wmshell = get_wm_shell ((Widget) ew);
289 int cw;
290 int ch;
291 Dimension rounded_width;
292 Dimension rounded_height;
293 int char_width;
294 int char_height;
295 int base_width;
296 int base_height;
297 int min_rows = 0, min_cols = 0;
299 /* This happens when the frame is just created. */
300 if (! wmshell) return;
302 pixel_to_char_size (ew, ew->core.width, ew->core.height,
303 &char_width, &char_height);
304 char_to_pixel_size (ew, char_width, char_height,
305 &rounded_width, &rounded_height);
306 get_default_char_pixel_size (ew, &cw, &ch);
308 base_width = (wmshell->core.width - ew->core.width
309 + (rounded_width - (char_width * cw)));
310 base_height = (wmshell->core.height - ew->core.height
311 + (rounded_height - (char_height * ch)));
313 /* This is kind of sleazy, but I can't see how else to tell it to
314 make it mark the WM_SIZE_HINTS size as user specified.
316 /* ((WMShellWidget) wmshell)->wm.size_hints.flags |= USSize;*/
318 XtVaSetValues (wmshell,
319 XtNbaseWidth, (XtArgVal) base_width,
320 XtNbaseHeight, (XtArgVal) base_height,
321 XtNwidthInc, (XtArgVal) (frame_resize_pixelwise ? 1 : cw),
322 XtNheightInc, (XtArgVal) (frame_resize_pixelwise ? 1 : ch),
323 XtNminWidth, (XtArgVal) (base_width + min_cols * cw),
324 XtNminHeight, (XtArgVal) (base_height + min_rows * ch),
325 NULL);
328 void
329 widget_update_wm_size_hints (Widget widget)
331 EmacsFrame ew = (EmacsFrame) widget;
332 update_wm_hints (ew);
335 static void
336 update_various_frame_slots (EmacsFrame ew)
338 struct frame *f = ew->emacs_frame.frame;
340 f->internal_border_width = ew->emacs_frame.internal_border_width;
343 static void
344 update_from_various_frame_slots (EmacsFrame ew)
346 struct frame *f = ew->emacs_frame.frame;
347 struct x_output *x = f->output_data.x;
349 ew->core.height = FRAME_PIXEL_HEIGHT (f) - x->menubar_height;
350 ew->core.width = FRAME_PIXEL_WIDTH (f);
351 ew->core.background_pixel = FRAME_BACKGROUND_PIXEL (f);
352 ew->emacs_frame.internal_border_width = f->internal_border_width;
353 ew->emacs_frame.foreground_pixel = FRAME_FOREGROUND_PIXEL (f);
354 ew->emacs_frame.cursor_color = x->cursor_pixel;
355 ew->core.border_pixel = x->border_pixel;
358 static void
359 EmacsFrameInitialize (Widget request, Widget new, ArgList dum1, Cardinal *dum2)
361 EmacsFrame ew = (EmacsFrame) new;
363 if (!ew->emacs_frame.frame)
365 fprintf (stderr,
366 "can't create an emacs frame widget without a frame\n");
367 exit (1);
370 update_from_various_frame_slots (ew);
371 set_frame_size (ew);
374 static void
375 resize_cb (Widget widget,
376 XtPointer closure,
377 XEvent* event,
378 Boolean* continue_to_dispatch)
380 EmacsFrameResize (widget);
384 static void
385 EmacsFrameRealize (Widget widget, XtValueMask *mask, XSetWindowAttributes *attrs)
387 EmacsFrame ew = (EmacsFrame) widget;
389 /* This used to contain SubstructureRedirectMask, but this turns out
390 to be a problem with XIM on Solaris, and events from that mask
391 don't seem to be used. Let's check that. */
392 attrs->event_mask = (STANDARD_EVENT_SET
393 | PropertyChangeMask
394 | SubstructureNotifyMask);
395 *mask |= CWEventMask;
396 XtCreateWindow (widget, InputOutput, (Visual *) CopyFromParent, *mask,
397 attrs);
398 /* Some ConfigureNotify events does not end up in EmacsFrameResize so
399 make sure we get them all. Seen with xfcwm4 for example. */
400 XtAddRawEventHandler (widget, StructureNotifyMask, False, resize_cb, NULL);
401 update_wm_hints (ew);
404 static void
405 EmacsFrameDestroy (Widget widget)
407 /* All GCs are now freed in x_free_frame_resources. */
410 static void
411 EmacsFrameResize (Widget widget)
413 EmacsFrame ew = (EmacsFrame) widget;
414 struct frame *f = ew->emacs_frame.frame;
415 int width, height;
417 pixel_to_text_size (ew, ew->core.width, ew->core.height, &width, &height);
419 frame_size_history_add
420 (f, QEmacsFrameResize, width, height,
421 list5 (make_number (ew->core.width), make_number (ew->core.height),
422 make_number (FRAME_TOP_MARGIN_HEIGHT (f)),
423 make_number (FRAME_SCROLL_BAR_AREA_HEIGHT (f)),
424 make_number (2 * FRAME_INTERNAL_BORDER_WIDTH (f))));
426 change_frame_size (f, width, height, 0, 1, 0, 1);
428 update_wm_hints (ew);
429 update_various_frame_slots (ew);
431 cancel_mouse_face (f);
434 static XtGeometryResult
435 EmacsFrameQueryGeometry (Widget widget, XtWidgetGeometry *request, XtWidgetGeometry *result)
437 EmacsFrame ew = (EmacsFrame) widget;
439 int mask = request->request_mode;
440 Dimension ok_width, ok_height;
442 if (mask & (CWWidth | CWHeight))
444 if (!frame_resize_pixelwise)
445 round_size_to_char (ew,
446 (mask & CWWidth) ? request->width : ew->core.width,
447 ((mask & CWHeight) ? request->height
448 : ew->core.height),
449 &ok_width, &ok_height);
450 if ((mask & CWWidth) && (ok_width != request->width))
452 result->request_mode |= CWWidth;
453 result->width = ok_width;
455 if ((mask & CWHeight) && (ok_height != request->height))
457 result->request_mode |= CWHeight;
458 result->height = ok_height;
461 return result->request_mode ? XtGeometryAlmost : XtGeometryYes;
464 /* Special entry points */
465 void
466 EmacsFrameSetCharSize (Widget widget, int columns, int rows)
468 EmacsFrame ew = (EmacsFrame) widget;
469 struct frame *f = ew->emacs_frame.frame;
471 if (!frame_inhibit_resize (f, 0, Qfont)
472 && !frame_inhibit_resize (f, 1, Qfont))
473 x_set_window_size (f, 0, columns, rows, 0);
477 void
478 widget_store_internal_border (Widget widget)
480 EmacsFrame ew = (EmacsFrame) widget;
481 struct frame *f = ew->emacs_frame.frame;
483 ew->emacs_frame.internal_border_width = f->internal_border_width;