src/widget.c

   1 /* The emacs frame widget.
   2    Copyright (C) 1992-1993, 2000-2024 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 #include <config.h>
  27 #include "widget.h"
  28
  29 #include <stdlib.h>
  30
  31 #include "lisp.h"
  32 #include "sysstdio.h"
  33 #include "xterm.h"
  34 #include "frame.h"
  35
  36 #include <X11/StringDefs.h>
  37 #include <X11/IntrinsicP.h>
  38 #include <X11/cursorfont.h>
  39 #include "widgetprv.h"
  40 #include <X11/ObjectP.h>
  41 #include <X11/Shell.h>
  42 #include <X11/ShellP.h>
  43 #include "../lwlib/lwlib.h"
  44
  45 static void EmacsFrameInitialize (Widget, Widget, ArgList, Cardinal *);
  46 static void EmacsFrameDestroy (Widget);
  47 static void EmacsFrameRealize (Widget, XtValueMask *, XSetWindowAttributes *);
  48 static void EmacsFrameResize (Widget);
  49 static void EmacsFrameExpose (Widget, XEvent *, Region);
  50 static XtGeometryResult EmacsFrameQueryGeometry (Widget, XtWidgetGeometry *,
  51                                                  XtWidgetGeometry *);
  52
  53
  54 #define offset(field) offsetof (EmacsFrameRec, emacs_frame.field)
  55
  56 static XtResource resources[] = {
  57   {(char *) XtNgeometry, (char *) XtCGeometry, XtRString, sizeof (String),
  58      offset (geometry), XtRString, (XtPointer) 0},
  59   {XtNiconic, XtCIconic, XtRBoolean, sizeof (Boolean),
  60      offset (iconic), XtRImmediate, (XtPointer) False},
  61
  62   {(char *) XtNemacsFrame, (char *) XtCEmacsFrame,
  63      XtRPointer, sizeof (XtPointer),
  64      offset (frame), XtRImmediate, 0},
  65
  66   {(char *) XtNminibuffer, (char *) XtCMinibuffer, XtRInt, sizeof (int),
  67      offset (minibuffer), XtRImmediate, (XtPointer)0},
  68   {(char *) XtNunsplittable, (char *) XtCUnsplittable,
  69      XtRBoolean, sizeof (Boolean),
  70      offset (unsplittable), XtRImmediate, (XtPointer)0},
  71   {(char *) XtNinternalBorderWidth, (char *) XtCInternalBorderWidth,
  72      XtRInt, sizeof (int),
  73      offset (internal_border_width), XtRImmediate, (XtPointer)4},
  74   {(char *) XtNinterline, (char *) XtCInterline, XtRInt, sizeof (int),
  75      offset (interline), XtRImmediate, (XtPointer)0},
  76   {(char *) XtNforeground, (char *) XtCForeground, XtRPixel, sizeof (Pixel),
  77      offset (foreground_pixel), XtRString, (char *) "XtDefaultForeground"},
  78   {(char *) XtNcursorColor, (char *) XtCForeground, XtRPixel, sizeof (Pixel),
  79      offset (cursor_color), XtRString, (char *) "XtDefaultForeground"},
  80   {(char *) XtNbarCursor, (char *) XtCBarCursor, XtRBoolean, sizeof (Boolean),
  81      offset (bar_cursor), XtRImmediate, (XtPointer)0},
  82   {(char *) XtNvisualBell, (char *) XtCVisualBell, XtRBoolean, sizeof (Boolean),
  83      offset (visual_bell), XtRImmediate, (XtPointer)0},
  84   {(char *) XtNbellVolume, (char *) XtCBellVolume, XtRInt, sizeof (int),
  85      offset (bell_volume), XtRImmediate, (XtPointer)0},
  86 };
  87
  88 #undef offset
  89
  90 /*
  91 static XtActionsRec
  92 emacsFrameActionsTable [] = {
  93   {"keypress",  key_press},
  94   {"focus_in",  emacs_frame_focus_handler},
  95   {"focus_out", emacs_frame_focus_handler},
  96 };
  97
  98 static char
  99 emacsFrameTranslations [] = "\
 100 <KeyPress>: keypress()\n\
 101 <FocusIn>:  focus_in()\n\
 102 <FocusOut>: focus_out()\n\
 103 ";
 104 */
 105
 106 static EmacsFrameClassRec emacsFrameClassRec = {
 107     { /* core fields */
 108     /* superclass               */      0, /* filled in by emacsFrameClass */
 109     /* class_name               */      (char *) "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        */      XtExposeNoCompress,
 124     /* compress_enterleave      */      TRUE,
 125     /* visible_interest         */      FALSE,
 126     /* destroy                  */      EmacsFrameDestroy,
 127     /* resize                   */      EmacsFrameResize,
 128     /* expose                   */      EmacsFrameExpose,
 129
 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
 143     }
 144 };
 145
 146 WidgetClass
 147 emacsFrameClass (void)
 148 {
 149   /* Set the superclass here rather than relying on static
 150      initialization, to work around an unexelf.c bug on x86 platforms
 151      that use the GNU Gold linker (Bug#27248).  */
 152   emacsFrameClassRec.core_class.superclass = &widgetClassRec;
 153
 154   return (WidgetClass) &emacsFrameClassRec;
 155 }
 156
 157 static void
 158 get_default_char_pixel_size (EmacsFrame ew, int *pixel_width, int *pixel_height)
 159 {
 160   struct frame *f = ew->emacs_frame.frame;
 161
 162   *pixel_width = FRAME_COLUMN_WIDTH (f);
 163   *pixel_height = FRAME_LINE_HEIGHT (f);
 164 }
 165
 166 static void
 167 pixel_to_char_size (EmacsFrame ew, Dimension pixel_width,
 168                     Dimension pixel_height, int *char_width, int *char_height)
 169 {
 170   struct frame *f = ew->emacs_frame.frame;
 171
 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 char_to_pixel_size (EmacsFrame ew, int char_width, int char_height,
 178                     Dimension *pixel_width, Dimension *pixel_height)
 179 {
 180   struct frame *f = ew->emacs_frame.frame;
 181
 182   *pixel_width = FRAME_TEXT_COLS_TO_PIXEL_WIDTH (f, char_width);
 183   *pixel_height = FRAME_TEXT_LINES_TO_PIXEL_HEIGHT (f, char_height);
 184 }
 185
 186 static void
 187 round_size_to_char (EmacsFrame ew, Dimension in_width, Dimension in_height,
 188                     Dimension *out_width, Dimension *out_height)
 189 {
 190   int char_width;
 191   int char_height;
 192   pixel_to_char_size (ew, in_width, in_height,
 193                       &char_width, &char_height);
 194   char_to_pixel_size (ew, char_width, char_height,
 195                       out_width, out_height);
 196 }
 197
 198 static WMShellWidget
 199 get_wm_shell (Widget w)
 200 {
 201   Widget wmshell;
 202
 203   for (wmshell = XtParent (w);
 204        wmshell && !XtIsWMShell (wmshell);
 205        wmshell = XtParent (wmshell));
 206
 207   return (WMShellWidget) wmshell;
 208 }
 209
 210 #if 0 /* Currently not used.  */
 211
 212 static void
 213 mark_shell_size_user_specified (Widget wmshell)
 214 {
 215   if (! XtIsWMShell (wmshell)) emacs_abort ();
 216   /* This is kind of sleazy, but I can't see how else to tell it to make it
 217      mark the WM_SIZE_HINTS size as user specified when appropriate. */
 218   ((WMShellWidget) wmshell)->wm.size_hints.flags |= USSize;
 219 }
 220
 221 #endif
 222
 223
 224 static void
 225 set_frame_size (EmacsFrame ew)
 226 {
 227   /* The widget hierarchy is
 228
 229         argv[0]                 emacsShell      pane    Frame-NAME
 230         ApplicationShell        EmacsShell      Paned   EmacsFrame
 231
 232      We accept geometry specs in this order:
 233
 234         *Frame-NAME.geometry
 235         *EmacsFrame.geometry
 236         Emacs.geometry
 237
 238      Other possibilities for widget hierarchies might be
 239
 240         argv[0]                 frame           pane    Frame-NAME
 241         ApplicationShell        EmacsShell      Paned   EmacsFrame
 242      or
 243         argv[0]                 Frame-NAME      pane    Frame-NAME
 244         ApplicationShell        EmacsShell      Paned   EmacsFrame
 245      or
 246         argv[0]                 Frame-NAME      pane    emacsTextPane
 247         ApplicationShell        EmacsFrame      Paned   EmacsTextPane
 248
 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.)
 253
 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.
 259
 260    */
 261
 262   struct frame *f = ew->emacs_frame.frame;
 263
 264   ew->core.width = FRAME_PIXEL_WIDTH (f);
 265   ew->core.height = FRAME_PIXEL_HEIGHT (f);
 266
 267   if (CONSP (frame_size_history))
 268     frame_size_history_plain
 269       (f, build_string ("set_frame_size"));
 270 }
 271
 272 static bool
 273 update_wm_hints (WMShellWidget wmshell, EmacsFrame ew)
 274 {
 275   int cw;
 276   int ch;
 277   Dimension rounded_width;
 278   Dimension rounded_height;
 279   int char_width;
 280   int char_height;
 281   int base_width;
 282   int base_height;
 283   char buffer[sizeof wmshell->wm.size_hints];
 284   char *hints_ptr;
 285
 286   /* Copy the old size hints to the buffer.  */
 287   memcpy (buffer, &wmshell->wm.size_hints,
 288           sizeof wmshell->wm.size_hints);
 289
 290   pixel_to_char_size (ew, ew->core.width, ew->core.height,
 291                       &char_width, &char_height);
 292   char_to_pixel_size (ew, char_width, char_height,
 293                       &rounded_width, &rounded_height);
 294   get_default_char_pixel_size (ew, &cw, &ch);
 295
 296   base_width = (wmshell->core.width - ew->core.width
 297                 + (rounded_width - (char_width * cw)));
 298   base_height = (wmshell->core.height - ew->core.height
 299                  + (rounded_height - (char_height * ch)));
 300
 301   XtVaSetValues ((Widget) wmshell,
 302                  XtNbaseWidth, (XtArgVal) base_width,
 303                  XtNbaseHeight, (XtArgVal) base_height,
 304                  XtNwidthInc, (XtArgVal) (frame_resize_pixelwise ? 1 : cw),
 305                  XtNheightInc, (XtArgVal) (frame_resize_pixelwise ? 1 : ch),
 306                  XtNminWidth, (XtArgVal) base_width,
 307                  XtNminHeight, (XtArgVal) base_height,
 308                  NULL);
 309
 310   /* Return if size hints really changed.  If they did not, then Xt
 311      probably didn't set them either (or take the flags into
 312      account.)  */
 313   hints_ptr = (char *) &wmshell->wm.size_hints;
 314
 315   /* Skip flags, which is unsigned long.  */
 316   return memcmp (hints_ptr + sizeof (long), buffer + sizeof (long),
 317                  sizeof wmshell->wm.wm_hints - sizeof (long));
 318 }
 319
 320 bool
 321 widget_update_wm_size_hints (Widget widget, Widget frame)
 322 {
 323   return update_wm_hints ((WMShellWidget) widget, (EmacsFrame) frame);
 324 }
 325
 326 static void
 327 update_various_frame_slots (EmacsFrame ew)
 328 {
 329   struct frame *f = ew->emacs_frame.frame;
 330
 331   f->internal_border_width = ew->emacs_frame.internal_border_width;
 332 }
 333
 334 static void
 335 update_from_various_frame_slots (EmacsFrame ew)
 336 {
 337   struct frame *f = ew->emacs_frame.frame;
 338   struct x_output *x = f->output_data.x;
 339
 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;
 347
 348   if (CONSP (frame_size_history))
 349     frame_size_history_extra
 350       (f, build_string ("update_from_various_frame_slots"),
 351        FRAME_PIXEL_WIDTH (f), FRAME_PIXEL_HEIGHT (f),
 352        ew->core.width, ew->core.height,
 353        f->new_width, f->new_height);
 354 }
 355
 356 static void
 357 EmacsFrameInitialize (Widget request, Widget new,
 358                       ArgList dum1, Cardinal *dum2)
 359 {
 360   EmacsFrame ew = (EmacsFrame) new;
 361
 362   if (!ew->emacs_frame.frame)
 363     {
 364       fputs ("can't create an emacs frame widget without a frame\n", stderr);
 365       exit (1);
 366     }
 367
 368   update_from_various_frame_slots (ew);
 369   set_frame_size (ew);
 370 }
 371
 372 static void
 373 resize_cb (Widget widget,
 374            XtPointer closure,
 375            XEvent *event,
 376            Boolean *continue_to_dispatch)
 377 {
 378   EmacsFrameResize (widget);
 379 }
 380
 381
 382 static void
 383 EmacsFrameRealize (Widget widget, XtValueMask *mask,
 384                    XSetWindowAttributes *attrs)
 385 {
 386   EmacsFrame ew = (EmacsFrame) widget;
 387   struct frame *f = ew->emacs_frame.frame;
 388
 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
 402   if (CONSP (frame_size_history))
 403     frame_size_history_plain
 404       (f, build_string ("EmacsFrameRealize"));
 405
 406   if (get_wm_shell (widget))
 407     update_wm_hints (get_wm_shell (widget), ew);
 408 }
 409
 410 static void
 411 EmacsFrameDestroy (Widget widget)
 412 {
 413   /* All GCs are now freed in x_free_frame_resources.  */
 414 }
 415
 416 static void
 417 EmacsFrameResize (Widget widget)
 418 {
 419   EmacsFrame ew = (EmacsFrame) widget;
 420   struct frame *f = ew->emacs_frame.frame;
 421
 422   if (CONSP (frame_size_history))
 423     frame_size_history_extra
 424       (f, build_string ("EmacsFrameResize"),
 425        FRAME_PIXEL_WIDTH (f), FRAME_PIXEL_HEIGHT (f),
 426        ew->core.width, ew->core.height,
 427        f->new_width, f->new_height);
 428
 429   change_frame_size (f, ew->core.width, ew->core.height,
 430                      false, true, false);
 431
 432   if (get_wm_shell (widget))
 433     update_wm_hints (get_wm_shell (widget), ew);
 434   update_various_frame_slots (ew);
 435
 436   cancel_mouse_face (f);
 437 }
 438
 439 static XtGeometryResult
 440 EmacsFrameQueryGeometry (Widget widget, XtWidgetGeometry *request,
 441                          XtWidgetGeometry *result)
 442 {
 443   int mask = request->request_mode;
 444
 445   if (mask & (CWWidth | CWHeight) && !frame_resize_pixelwise)
 446     {
 447       EmacsFrame ew = (EmacsFrame) widget;
 448       Dimension ok_width, ok_height;
 449
 450       round_size_to_char (ew,
 451                           mask & CWWidth ? request->width : ew->core.width,
 452                           mask & CWHeight ? request->height : ew->core.height,
 453                           &ok_width, &ok_height);
 454       if ((mask & CWWidth) && (ok_width != request->width))
 455         {
 456           result->request_mode |= CWWidth;
 457           result->width = ok_width;
 458         }
 459       if ((mask & CWHeight) && (ok_height != request->height))
 460         {
 461           result->request_mode |= CWHeight;
 462           result->height = ok_height;
 463         }
 464     }
 465   return result->request_mode ? XtGeometryAlmost : XtGeometryYes;
 466 }
 467
 468 /* Special entry points */
 469 void
 470 EmacsFrameSetCharSize (Widget widget, int columns, int rows)
 471 {
 472   EmacsFrame ew = (EmacsFrame) widget;
 473   struct frame *f = ew->emacs_frame.frame;
 474
 475   if (CONSP (frame_size_history))
 476     frame_size_history_extra
 477       (f, build_string ("EmacsFrameSetCharSize"),
 478        FRAME_PIXEL_WIDTH (f), FRAME_PIXEL_HEIGHT (f),
 479        columns, rows,
 480        f->new_width, f->new_height);
 481
 482   if (!frame_inhibit_resize (f, 0, Qfont)
 483       && !frame_inhibit_resize (f, 1, Qfont))
 484     x_set_window_size (f, 0, columns * FRAME_COLUMN_WIDTH (f),
 485                        rows * FRAME_LINE_HEIGHT (f));
 486 }
 487
 488 static void
 489 EmacsFrameExpose (Widget widget, XEvent *event, Region region)
 490 {
 491   EmacsFrame ew = (EmacsFrame) widget;
 492   struct frame *f = ew->emacs_frame.frame;
 493
 494   expose_frame (f, event->xexpose.x, event->xexpose.y,
 495                 event->xexpose.width, event->xexpose.height);
 496   flush_frame (f);
 497 }
 498
 499 \f
 500 void
 501 widget_store_internal_border (Widget widget)
 502 {
 503   EmacsFrame ew = (EmacsFrame) widget;
 504   struct frame *f = ew->emacs_frame.frame;
 505
 506   ew->emacs_frame.internal_border_width = f->internal_border_width;
 507 }