src/widget.c

   1 /* The emacs frame widget.
   2    Copyright (C) 1992-1993, 2000-2018 Free Software Foundation, Inc.
   3
   4 This file is part of GNU Emacs.
   5
   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.
  10
  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.
  15
  16 You should have received a copy of the GNU General Public License
  17 along with GNU Emacs.  If not, see <https://www.gnu.org/licenses/>.  */
  18
  19 /* Emacs 19 face widget ported by Fred Pierresteguy */
  20
  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.
  25
  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/
  29    */
  30
  31 #include <config.h>
  32 #include "widget.h"
  33
  34 #include <stdio.h>
  35 #include <stdlib.h>
  36
  37 #include "lisp.h"
  38 #include "xterm.h"
  39 #include "frame.h"
  40
  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"
  49
  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);
  55
  56
  57 #define offset(field) offsetof (EmacsFrameRec, emacs_frame.field)
  58
  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},
  64
  65   {(char *) XtNemacsFrame, (char *) XtCEmacsFrame,
  66      XtRPointer, sizeof (XtPointer),
  67      offset (frame), XtRImmediate, 0},
  68
  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},
  89 };
  90
  91 #undef offset
  92
  93 /*
  94 static XtActionsRec
  95 emacsFrameActionsTable [] = {
  96   {"keypress",  key_press},
  97   {"focus_in",  emacs_frame_focus_handler},
  98   {"focus_out", emacs_frame_focus_handler},
  99 };
 100
 101 static char
 102 emacsFrameTranslations [] = "\
 103 <KeyPress>: keypress()\n\
 104 <FocusIn>:  focus_in()\n\
 105 <FocusOut>: focus_out()\n\
 106 ";
 107 */
 108
 109 static EmacsFrameClassRec emacsFrameClassRec = {
 110     { /* core fields */
 111     /* superclass               */      0, /* filled in by emacsFrameClass */
 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,
 132
 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
 146     }
 147 };
 148
 149 WidgetClass
 150 emacsFrameClass (void)
 151 {
 152   /* Set the superclass here rather than relying on static
 153      initialization, to work around an unexelf.c bug on x86 platforms
 154      that use the GNU Gold linker (Bug#27248).  */
 155   emacsFrameClassRec.core_class.superclass = &widgetClassRec;
 156
 157   return (WidgetClass) &emacsFrameClassRec;
 158 }
 159
 160 static void
 161 get_default_char_pixel_size (EmacsFrame ew, int *pixel_width, int *pixel_height)
 162 {
 163   struct frame *f = ew->emacs_frame.frame;
 164   *pixel_width = FRAME_COLUMN_WIDTH (f);
 165   *pixel_height = FRAME_LINE_HEIGHT (f);
 166 }
 167
 168 static void
 169 pixel_to_char_size (EmacsFrame ew, Dimension pixel_width, Dimension pixel_height, int *char_width, int *char_height)
 170 {
 171   struct frame *f = ew->emacs_frame.frame;
 172   *char_width = FRAME_PIXEL_WIDTH_TO_TEXT_COLS (f, (int) pixel_width);
 173   *char_height = FRAME_PIXEL_HEIGHT_TO_TEXT_LINES (f, (int) pixel_height);
 174 }
 175
 176 static void
 177 pixel_to_text_size (EmacsFrame ew, Dimension pixel_width, Dimension pixel_height, int *text_width, int *text_height)
 178 {
 179   struct frame *f = ew->emacs_frame.frame;
 180   *text_width = FRAME_PIXEL_TO_TEXT_WIDTH (f, (int) pixel_width);
 181   *text_height = FRAME_PIXEL_TO_TEXT_HEIGHT (f, (int) pixel_height);
 182 }
 183
 184 static void
 185 char_to_pixel_size (EmacsFrame ew, int char_width, int char_height, Dimension *pixel_width, Dimension *pixel_height)
 186 {
 187   struct frame *f = ew->emacs_frame.frame;
 188   *pixel_width = FRAME_TEXT_COLS_TO_PIXEL_WIDTH (f, char_width);
 189   *pixel_height = FRAME_TEXT_LINES_TO_PIXEL_HEIGHT (f, char_height);
 190 }
 191
 192 static void
 193 round_size_to_char (EmacsFrame ew, Dimension in_width, Dimension in_height, Dimension *out_width, Dimension *out_height)
 194 {
 195   int char_width;
 196   int char_height;
 197   pixel_to_char_size (ew, in_width, in_height, &char_width, &char_height);
 198   char_to_pixel_size (ew, char_width, char_height, out_width, out_height);
 199 }
 200
 201 static Widget
 202 get_wm_shell (Widget w)
 203 {
 204   Widget wmshell;
 205
 206   for (wmshell = XtParent (w);
 207        wmshell && !XtIsWMShell (wmshell);
 208        wmshell = XtParent (wmshell));
 209
 210   return wmshell;
 211 }
 212
 213 #if 0 /* Currently not used.  */
 214
 215 static void
 216 mark_shell_size_user_specified (Widget wmshell)
 217 {
 218   if (! XtIsWMShell (wmshell)) emacs_abort ();
 219   /* This is kind of sleazy, but I can't see how else to tell it to make it
 220      mark the WM_SIZE_HINTS size as user specified when appropriate. */
 221   ((WMShellWidget) wmshell)->wm.size_hints.flags |= USSize;
 222 }
 223
 224 #endif
 225
 226
 227 static void
 228 set_frame_size (EmacsFrame ew)
 229 {
 230   /* The widget hierarchy is
 231
 232         argv[0]                 emacsShell      pane    Frame-NAME
 233         ApplicationShell        EmacsShell      Paned   EmacsFrame
 234
 235      We accept geometry specs in this order:
 236
 237         *Frame-NAME.geometry
 238         *EmacsFrame.geometry
 239         Emacs.geometry
 240
 241      Other possibilities for widget hierarchies might be
 242
 243         argv[0]                 frame           pane    Frame-NAME
 244         ApplicationShell        EmacsShell      Paned   EmacsFrame
 245      or
 246         argv[0]                 Frame-NAME      pane    Frame-NAME
 247         ApplicationShell        EmacsShell      Paned   EmacsFrame
 248      or
 249         argv[0]                 Frame-NAME      pane    emacsTextPane
 250         ApplicationShell        EmacsFrame      Paned   EmacsTextPane
 251
 252      With the current setup, the text-display-area is the part which is
 253      an emacs "frame", since that's the only part managed by emacs proper
 254      (the menubar and the parent of the menubar and all that sort of thing
 255      are managed by lwlib.)
 256
 257      The EmacsShell widget is simply a replacement for the Shell widget
 258      which is able to deal with using an externally-supplied window instead
 259      of always creating its own.  It is not actually emacs specific, and
 260      should possibly have class "Shell" instead of "EmacsShell" to simplify
 261      the resources.
 262
 263    */
 264
 265   /* Hairily merged geometry */
 266   struct frame *f = ew->emacs_frame.frame;
 267   int w = FRAME_COLS (f);
 268   int h = FRAME_LINES (f);
 269   Widget wmshell = get_wm_shell ((Widget) ew);
 270   Dimension pixel_width, pixel_height;
 271   /* Each Emacs shell is now independent and top-level.  */
 272
 273   if (! XtIsSubclass (wmshell, shellWidgetClass)) emacs_abort ();
 274
 275   char_to_pixel_size (ew, w, h, &pixel_width, &pixel_height);
 276   ew->core.width = (frame_resize_pixelwise
 277                     ? FRAME_PIXEL_WIDTH (f)
 278                     : pixel_width);
 279   ew->core.height = (frame_resize_pixelwise
 280                      ? FRAME_PIXEL_HEIGHT (f)
 281                      : pixel_height);
 282
 283   frame_size_history_add
 284     (f, Qset_frame_size, FRAME_TEXT_WIDTH (f), FRAME_TEXT_HEIGHT (f),
 285      list2 (make_number (ew->core.width), make_number (ew->core.height)));
 286 }
 287
 288 static void
 289 update_wm_hints (EmacsFrame ew)
 290 {
 291   Widget wmshell = get_wm_shell ((Widget) ew);
 292   int cw;
 293   int ch;
 294   Dimension rounded_width;
 295   Dimension rounded_height;
 296   int char_width;
 297   int char_height;
 298   int base_width;
 299   int base_height;
 300   int min_rows = 0, min_cols = 0;
 301
 302   /* This happens when the frame is just created.  */
 303   if (! wmshell) return;
 304
 305   pixel_to_char_size (ew, ew->core.width, ew->core.height,
 306                       &char_width, &char_height);
 307   char_to_pixel_size (ew, char_width, char_height,
 308                       &rounded_width, &rounded_height);
 309   get_default_char_pixel_size (ew, &cw, &ch);
 310
 311   base_width = (wmshell->core.width - ew->core.width
 312                 + (rounded_width - (char_width * cw)));
 313   base_height = (wmshell->core.height - ew->core.height
 314                  + (rounded_height - (char_height * ch)));
 315
 316   /* This is kind of sleazy, but I can't see how else to tell it to
 317      make it mark the WM_SIZE_HINTS size as user specified.
 318    */
 319 /*  ((WMShellWidget) wmshell)->wm.size_hints.flags |= USSize;*/
 320
 321   XtVaSetValues (wmshell,
 322                  XtNbaseWidth, (XtArgVal) base_width,
 323                  XtNbaseHeight, (XtArgVal) base_height,
 324                  XtNwidthInc, (XtArgVal) (frame_resize_pixelwise ? 1 : cw),
 325                  XtNheightInc, (XtArgVal) (frame_resize_pixelwise ? 1 : ch),
 326                  XtNminWidth, (XtArgVal) (base_width + min_cols * cw),
 327                  XtNminHeight, (XtArgVal) (base_height + min_rows * ch),
 328                  NULL);
 329 }
 330
 331 void
 332 widget_update_wm_size_hints (Widget widget)
 333 {
 334   EmacsFrame ew = (EmacsFrame) widget;
 335   update_wm_hints (ew);
 336 }
 337
 338 static void
 339 update_various_frame_slots (EmacsFrame ew)
 340 {
 341   struct frame *f = ew->emacs_frame.frame;
 342
 343   f->internal_border_width = ew->emacs_frame.internal_border_width;
 344 }
 345
 346 static void
 347 update_from_various_frame_slots (EmacsFrame ew)
 348 {
 349   struct frame *f = ew->emacs_frame.frame;
 350   struct x_output *x = f->output_data.x;
 351
 352   ew->core.height = FRAME_PIXEL_HEIGHT (f) - x->menubar_height;
 353   ew->core.width = FRAME_PIXEL_WIDTH (f);
 354   ew->core.background_pixel = FRAME_BACKGROUND_PIXEL (f);
 355   ew->emacs_frame.internal_border_width = f->internal_border_width;
 356   ew->emacs_frame.foreground_pixel = FRAME_FOREGROUND_PIXEL (f);
 357   ew->emacs_frame.cursor_color = x->cursor_pixel;
 358   ew->core.border_pixel = x->border_pixel;
 359 }
 360
 361 static void
 362 EmacsFrameInitialize (Widget request, Widget new, ArgList dum1, Cardinal *dum2)
 363 {
 364   EmacsFrame ew = (EmacsFrame) new;
 365
 366   if (!ew->emacs_frame.frame)
 367     {
 368       fprintf (stderr,
 369                "can't create an emacs frame widget without a frame\n");
 370       exit (1);
 371     }
 372
 373   update_from_various_frame_slots (ew);
 374   set_frame_size (ew);
 375 }
 376
 377 static void
 378 resize_cb (Widget widget,
 379            XtPointer closure,
 380            XEvent *event,
 381            Boolean *continue_to_dispatch)
 382 {
 383   EmacsFrameResize (widget);
 384 }
 385
 386
 387 static void
 388 EmacsFrameRealize (Widget widget, XtValueMask *mask, XSetWindowAttributes *attrs)
 389 {
 390   EmacsFrame ew = (EmacsFrame) widget;
 391
 392   /* This used to contain SubstructureRedirectMask, but this turns out
 393      to be a problem with XIM on Solaris, and events from that mask
 394      don't seem to be used.  Let's check that.  */
 395   attrs->event_mask = (STANDARD_EVENT_SET
 396                        | PropertyChangeMask
 397                        | SubstructureNotifyMask);
 398   *mask |= CWEventMask;
 399   XtCreateWindow (widget, InputOutput, (Visual *) CopyFromParent, *mask,
 400                   attrs);
 401   /* Some ConfigureNotify events does not end up in EmacsFrameResize so
 402      make sure we get them all.  Seen with xfcwm4 for example.  */
 403   XtAddRawEventHandler (widget, StructureNotifyMask, False, resize_cb, NULL);
 404   update_wm_hints (ew);
 405 }
 406
 407 static void
 408 EmacsFrameDestroy (Widget widget)
 409 {
 410   /* All GCs are now freed in x_free_frame_resources.  */
 411 }
 412
 413 static void
 414 EmacsFrameResize (Widget widget)
 415 {
 416   EmacsFrame ew = (EmacsFrame) widget;
 417   struct frame *f = ew->emacs_frame.frame;
 418   int width, height;
 419
 420   pixel_to_text_size (ew, ew->core.width, ew->core.height, &width, &height);
 421
 422   frame_size_history_add
 423     (f, QEmacsFrameResize, width, height,
 424      list5 (make_number (ew->core.width), make_number (ew->core.height),
 425             make_number (FRAME_TOP_MARGIN_HEIGHT (f)),
 426             make_number (FRAME_SCROLL_BAR_AREA_HEIGHT (f)),
 427             make_number (2 * FRAME_INTERNAL_BORDER_WIDTH (f))));
 428
 429   change_frame_size (f, width, height, 0, 1, 0, 1);
 430
 431   update_wm_hints (ew);
 432   update_various_frame_slots (ew);
 433
 434   cancel_mouse_face (f);
 435 }
 436
 437 static XtGeometryResult
 438 EmacsFrameQueryGeometry (Widget widget, XtWidgetGeometry *request, XtWidgetGeometry *result)
 439 {
 440   EmacsFrame ew = (EmacsFrame) widget;
 441
 442   int mask = request->request_mode;
 443   Dimension ok_width, ok_height;
 444
 445   if (mask & (CWWidth | CWHeight))
 446     {
 447       if (!frame_resize_pixelwise)
 448         round_size_to_char (ew,
 449                             (mask & CWWidth) ? request->width : ew->core.width,
 450                             ((mask & CWHeight) ? request->height
 451                              : ew->core.height),
 452                             &ok_width, &ok_height);
 453       if ((mask & CWWidth) && (ok_width != request->width))
 454         {
 455           result->request_mode |= CWWidth;
 456           result->width = ok_width;
 457         }
 458       if ((mask & CWHeight) && (ok_height != request->height))
 459         {
 460           result->request_mode |= CWHeight;
 461           result->height = ok_height;
 462         }
 463     }
 464   return result->request_mode ? XtGeometryAlmost : XtGeometryYes;
 465 }
 466
 467 /* Special entry points */
 468 void
 469 EmacsFrameSetCharSize (Widget widget, int columns, int rows)
 470 {
 471   EmacsFrame ew = (EmacsFrame) widget;
 472   struct frame *f = ew->emacs_frame.frame;
 473
 474   if (!frame_inhibit_resize (f, 0, Qfont)
 475       && !frame_inhibit_resize (f, 1, Qfont))
 476     x_set_window_size (f, 0, columns, rows, 0);
 477 }
 478
 479 \f
 480 void
 481 widget_store_internal_border (Widget widget)
 482 {
 483   EmacsFrame ew = (EmacsFrame) widget;
 484   struct frame *f = ew->emacs_frame.frame;
 485
 486   ew->emacs_frame.internal_border_width = f->internal_border_width;
 487 }