gnus-article-read-summary-keys: Don't move point for WDD and WDW commands
[emacs.git] / src / widget.c
blobd7ec70285171581ed760bf30e708d30bb9a9fa65
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 {(char *) XtNgeometry, (char *) XtCGeometry, XtRString, sizeof (String),
61 offset (geometry), XtRString, (XtPointer) 0},
62 {XtNiconic, XtCIconic, XtRBoolean, sizeof (Boolean),
63 offset (iconic), XtRImmediate, (XtPointer) False},
65 {(char *) XtNemacsFrame, (char *) XtCEmacsFrame,
66 XtRPointer, sizeof (XtPointer),
67 offset (frame), XtRImmediate, 0},
69 {(char *) XtNminibuffer, (char *) XtCMinibuffer, XtRInt, sizeof (int),
70 offset (minibuffer), XtRImmediate, (XtPointer)0},
71 {(char *) XtNunsplittable, (char *) XtCUnsplittable,
72 XtRBoolean, sizeof (Boolean),
73 offset (unsplittable), XtRImmediate, (XtPointer)0},
74 {(char *) XtNinternalBorderWidth, (char *) XtCInternalBorderWidth,
75 XtRInt, sizeof (int),
76 offset (internal_border_width), XtRImmediate, (XtPointer)4},
77 {(char *) XtNinterline, (char *) XtCInterline, XtRInt, sizeof (int),
78 offset (interline), XtRImmediate, (XtPointer)0},
79 {(char *) XtNforeground, (char *) XtCForeground, XtRPixel, sizeof (Pixel),
80 offset (foreground_pixel), XtRString, (char *) "XtDefaultForeground"},
81 {(char *) XtNcursorColor, (char *) XtCForeground, XtRPixel, sizeof (Pixel),
82 offset (cursor_color), XtRString, (char *) "XtDefaultForeground"},
83 {(char *) XtNbarCursor, (char *) XtCBarCursor, XtRBoolean, sizeof (Boolean),
84 offset (bar_cursor), XtRImmediate, (XtPointer)0},
85 {(char *) XtNvisualBell, (char *) XtCVisualBell, XtRBoolean, sizeof (Boolean),
86 offset (visual_bell), XtRImmediate, (XtPointer)0},
87 {(char *) XtNbellVolume, (char *) XtCBellVolume, XtRInt, sizeof (int),
88 offset (bell_volume), XtRImmediate, (XtPointer)0},
91 #undef offset
94 static XtActionsRec
95 emacsFrameActionsTable [] = {
96 {"keypress", key_press},
97 {"focus_in", emacs_frame_focus_handler},
98 {"focus_out", emacs_frame_focus_handler},
101 static char
102 emacsFrameTranslations [] = "\
103 <KeyPress>: keypress()\n\
104 <FocusIn>: focus_in()\n\
105 <FocusOut>: focus_out()\n\
109 static EmacsFrameClassRec emacsFrameClassRec = {
110 { /* core fields */
111 /* superclass */ &widgetClassRec,
112 /* class_name */ (char *) "EmacsFrame",
113 /* widget_size */ sizeof (EmacsFrameRec),
114 /* class_initialize */ 0,
115 /* class_part_initialize */ 0,
116 /* class_inited */ FALSE,
117 /* initialize */ EmacsFrameInitialize,
118 /* initialize_hook */ 0,
119 /* realize */ EmacsFrameRealize,
120 /* actions */ 0, /*emacsFrameActionsTable*/
121 /* num_actions */ 0, /*XtNumber (emacsFrameActionsTable)*/
122 /* resources */ resources,
123 /* resource_count */ XtNumber (resources),
124 /* xrm_class */ NULLQUARK,
125 /* compress_motion */ TRUE,
126 /* compress_exposure */ TRUE,
127 /* compress_enterleave */ TRUE,
128 /* visible_interest */ FALSE,
129 /* destroy */ EmacsFrameDestroy,
130 /* resize */ EmacsFrameResize,
131 /* expose */ XtInheritExpose,
133 /* Emacs never does XtSetvalues on this widget, so we have no code
134 for it. */
135 /* set_values */ 0, /* Not supported */
136 /* set_values_hook */ 0,
137 /* set_values_almost */ XtInheritSetValuesAlmost,
138 /* get_values_hook */ 0,
139 /* accept_focus */ XtInheritAcceptFocus,
140 /* version */ XtVersion,
141 /* callback_private */ 0,
142 /* tm_table */ 0, /*emacsFrameTranslations*/
143 /* query_geometry */ EmacsFrameQueryGeometry,
144 /* display_accelerator */ XtInheritDisplayAccelerator,
145 /* extension */ 0
149 WidgetClass emacsFrameClass = (WidgetClass) &emacsFrameClassRec;
151 static void
152 get_default_char_pixel_size (EmacsFrame ew, int *pixel_width, int *pixel_height)
154 struct frame *f = ew->emacs_frame.frame;
155 *pixel_width = FRAME_COLUMN_WIDTH (f);
156 *pixel_height = FRAME_LINE_HEIGHT (f);
159 static void
160 pixel_to_char_size (EmacsFrame ew, Dimension pixel_width, Dimension pixel_height, int *char_width, int *char_height)
162 struct frame *f = ew->emacs_frame.frame;
163 *char_width = FRAME_PIXEL_WIDTH_TO_TEXT_COLS (f, (int) pixel_width);
164 *char_height = FRAME_PIXEL_HEIGHT_TO_TEXT_LINES (f, (int) pixel_height);
167 static void
168 pixel_to_text_size (EmacsFrame ew, Dimension pixel_width, Dimension pixel_height, int *text_width, int *text_height)
170 struct frame *f = ew->emacs_frame.frame;
171 *text_width = FRAME_PIXEL_TO_TEXT_WIDTH (f, (int) pixel_width);
172 *text_height = FRAME_PIXEL_TO_TEXT_HEIGHT (f, (int) pixel_height);
175 static void
176 char_to_pixel_size (EmacsFrame ew, int char_width, int char_height, Dimension *pixel_width, Dimension *pixel_height)
178 struct frame *f = ew->emacs_frame.frame;
179 *pixel_width = FRAME_TEXT_COLS_TO_PIXEL_WIDTH (f, char_width);
180 *pixel_height = FRAME_TEXT_LINES_TO_PIXEL_HEIGHT (f, char_height);
183 static void
184 round_size_to_char (EmacsFrame ew, Dimension in_width, Dimension in_height, Dimension *out_width, Dimension *out_height)
186 int char_width;
187 int char_height;
188 pixel_to_char_size (ew, in_width, in_height, &char_width, &char_height);
189 char_to_pixel_size (ew, char_width, char_height, out_width, out_height);
192 static Widget
193 get_wm_shell (Widget w)
195 Widget wmshell;
197 for (wmshell = XtParent (w);
198 wmshell && !XtIsWMShell (wmshell);
199 wmshell = XtParent (wmshell));
201 return wmshell;
204 #if 0 /* Currently not used. */
206 static void
207 mark_shell_size_user_specified (Widget wmshell)
209 if (! XtIsWMShell (wmshell)) emacs_abort ();
210 /* This is kind of sleazy, but I can't see how else to tell it to make it
211 mark the WM_SIZE_HINTS size as user specified when appropriate. */
212 ((WMShellWidget) wmshell)->wm.size_hints.flags |= USSize;
215 #endif
218 static void
219 set_frame_size (EmacsFrame ew)
221 /* The widget hierarchy is
223 argv[0] emacsShell pane Frame-NAME
224 ApplicationShell EmacsShell Paned EmacsFrame
226 We accept geometry specs in this order:
228 *Frame-NAME.geometry
229 *EmacsFrame.geometry
230 Emacs.geometry
232 Other possibilities for widget hierarchies might be
234 argv[0] frame pane Frame-NAME
235 ApplicationShell EmacsShell Paned EmacsFrame
237 argv[0] Frame-NAME pane Frame-NAME
238 ApplicationShell EmacsShell Paned EmacsFrame
240 argv[0] Frame-NAME pane emacsTextPane
241 ApplicationShell EmacsFrame Paned EmacsTextPane
243 With the current setup, the text-display-area is the part which is
244 an emacs "frame", since that's the only part managed by emacs proper
245 (the menubar and the parent of the menubar and all that sort of thing
246 are managed by lwlib.)
248 The EmacsShell widget is simply a replacement for the Shell widget
249 which is able to deal with using an externally-supplied window instead
250 of always creating its own. It is not actually emacs specific, and
251 should possibly have class "Shell" instead of "EmacsShell" to simplify
252 the resources.
256 /* Hairily merged geometry */
257 struct frame *f = ew->emacs_frame.frame;
258 int w = FRAME_COLS (f);
259 int h = FRAME_LINES (f);
260 Widget wmshell = get_wm_shell ((Widget) ew);
261 Dimension pixel_width, pixel_height;
262 /* Each Emacs shell is now independent and top-level. */
264 if (! XtIsSubclass (wmshell, shellWidgetClass)) emacs_abort ();
266 char_to_pixel_size (ew, w, h, &pixel_width, &pixel_height);
267 ew->core.width = (frame_resize_pixelwise
268 ? FRAME_PIXEL_WIDTH (f)
269 : pixel_width);
270 ew->core.height = (frame_resize_pixelwise
271 ? FRAME_PIXEL_HEIGHT (f)
272 : pixel_height);
274 frame_size_history_add
275 (f, Qset_frame_size, FRAME_TEXT_WIDTH (f), FRAME_TEXT_HEIGHT (f),
276 list2 (make_number (ew->core.width), make_number (ew->core.height)));
279 static void
280 update_wm_hints (EmacsFrame ew)
282 Widget wmshell = get_wm_shell ((Widget) ew);
283 int cw;
284 int ch;
285 Dimension rounded_width;
286 Dimension rounded_height;
287 int char_width;
288 int char_height;
289 int base_width;
290 int base_height;
291 int min_rows = 0, min_cols = 0;
293 /* This happens when the frame is just created. */
294 if (! wmshell) return;
296 pixel_to_char_size (ew, ew->core.width, ew->core.height,
297 &char_width, &char_height);
298 char_to_pixel_size (ew, char_width, char_height,
299 &rounded_width, &rounded_height);
300 get_default_char_pixel_size (ew, &cw, &ch);
302 base_width = (wmshell->core.width - ew->core.width
303 + (rounded_width - (char_width * cw)));
304 base_height = (wmshell->core.height - ew->core.height
305 + (rounded_height - (char_height * ch)));
307 /* This is kind of sleazy, but I can't see how else to tell it to
308 make it mark the WM_SIZE_HINTS size as user specified.
310 /* ((WMShellWidget) wmshell)->wm.size_hints.flags |= USSize;*/
312 XtVaSetValues (wmshell,
313 XtNbaseWidth, (XtArgVal) base_width,
314 XtNbaseHeight, (XtArgVal) base_height,
315 XtNwidthInc, (XtArgVal) (frame_resize_pixelwise ? 1 : cw),
316 XtNheightInc, (XtArgVal) (frame_resize_pixelwise ? 1 : ch),
317 XtNminWidth, (XtArgVal) (base_width + min_cols * cw),
318 XtNminHeight, (XtArgVal) (base_height + min_rows * ch),
319 NULL);
322 void
323 widget_update_wm_size_hints (Widget widget)
325 EmacsFrame ew = (EmacsFrame) widget;
326 update_wm_hints (ew);
329 static void
330 update_various_frame_slots (EmacsFrame ew)
332 struct frame *f = ew->emacs_frame.frame;
334 f->internal_border_width = ew->emacs_frame.internal_border_width;
337 static void
338 update_from_various_frame_slots (EmacsFrame ew)
340 struct frame *f = ew->emacs_frame.frame;
341 struct x_output *x = f->output_data.x;
343 ew->core.height = FRAME_PIXEL_HEIGHT (f) - x->menubar_height;
344 ew->core.width = FRAME_PIXEL_WIDTH (f);
345 ew->core.background_pixel = FRAME_BACKGROUND_PIXEL (f);
346 ew->emacs_frame.internal_border_width = f->internal_border_width;
347 ew->emacs_frame.foreground_pixel = FRAME_FOREGROUND_PIXEL (f);
348 ew->emacs_frame.cursor_color = x->cursor_pixel;
349 ew->core.border_pixel = x->border_pixel;
352 static void
353 EmacsFrameInitialize (Widget request, Widget new, ArgList dum1, Cardinal *dum2)
355 EmacsFrame ew = (EmacsFrame) new;
357 if (!ew->emacs_frame.frame)
359 fprintf (stderr,
360 "can't create an emacs frame widget without a frame\n");
361 exit (1);
364 update_from_various_frame_slots (ew);
365 set_frame_size (ew);
368 static void
369 resize_cb (Widget widget,
370 XtPointer closure,
371 XEvent *event,
372 Boolean *continue_to_dispatch)
374 EmacsFrameResize (widget);
378 static void
379 EmacsFrameRealize (Widget widget, XtValueMask *mask, XSetWindowAttributes *attrs)
381 EmacsFrame ew = (EmacsFrame) widget;
383 /* This used to contain SubstructureRedirectMask, but this turns out
384 to be a problem with XIM on Solaris, and events from that mask
385 don't seem to be used. Let's check that. */
386 attrs->event_mask = (STANDARD_EVENT_SET
387 | PropertyChangeMask
388 | SubstructureNotifyMask);
389 *mask |= CWEventMask;
390 XtCreateWindow (widget, InputOutput, (Visual *) CopyFromParent, *mask,
391 attrs);
392 /* Some ConfigureNotify events does not end up in EmacsFrameResize so
393 make sure we get them all. Seen with xfcwm4 for example. */
394 XtAddRawEventHandler (widget, StructureNotifyMask, False, resize_cb, NULL);
395 update_wm_hints (ew);
398 static void
399 EmacsFrameDestroy (Widget widget)
401 /* All GCs are now freed in x_free_frame_resources. */
404 static void
405 EmacsFrameResize (Widget widget)
407 EmacsFrame ew = (EmacsFrame) widget;
408 struct frame *f = ew->emacs_frame.frame;
409 int width, height;
411 pixel_to_text_size (ew, ew->core.width, ew->core.height, &width, &height);
413 frame_size_history_add
414 (f, QEmacsFrameResize, width, height,
415 list5 (make_number (ew->core.width), make_number (ew->core.height),
416 make_number (FRAME_TOP_MARGIN_HEIGHT (f)),
417 make_number (FRAME_SCROLL_BAR_AREA_HEIGHT (f)),
418 make_number (2 * FRAME_INTERNAL_BORDER_WIDTH (f))));
420 change_frame_size (f, width, height, 0, 1, 0, 1);
422 update_wm_hints (ew);
423 update_various_frame_slots (ew);
425 cancel_mouse_face (f);
428 static XtGeometryResult
429 EmacsFrameQueryGeometry (Widget widget, XtWidgetGeometry *request, XtWidgetGeometry *result)
431 EmacsFrame ew = (EmacsFrame) widget;
433 int mask = request->request_mode;
434 Dimension ok_width, ok_height;
436 if (mask & (CWWidth | CWHeight))
438 if (!frame_resize_pixelwise)
439 round_size_to_char (ew,
440 (mask & CWWidth) ? request->width : ew->core.width,
441 ((mask & CWHeight) ? request->height
442 : ew->core.height),
443 &ok_width, &ok_height);
444 if ((mask & CWWidth) && (ok_width != request->width))
446 result->request_mode |= CWWidth;
447 result->width = ok_width;
449 if ((mask & CWHeight) && (ok_height != request->height))
451 result->request_mode |= CWHeight;
452 result->height = ok_height;
455 return result->request_mode ? XtGeometryAlmost : XtGeometryYes;
458 /* Special entry points */
459 void
460 EmacsFrameSetCharSize (Widget widget, int columns, int rows)
462 EmacsFrame ew = (EmacsFrame) widget;
463 struct frame *f = ew->emacs_frame.frame;
465 if (!frame_inhibit_resize (f, 0, Qfont)
466 && !frame_inhibit_resize (f, 1, Qfont))
467 x_set_window_size (f, 0, columns, rows, 0);
471 void
472 widget_store_internal_border (Widget widget)
474 EmacsFrame ew = (EmacsFrame) widget;
475 struct frame *f = ew->emacs_frame.frame;
477 ew->emacs_frame.internal_border_width = f->internal_border_width;