code.delx.au - gnu-emacs/blob - src/widget.c

   1 /* The emacs frame widget.
   2    Copyright (C) 1992-1993, 2000-2016 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 <http://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
  36 #include "lisp.h"
  37 #include "xterm.h"
  38 #include "frame.h"
  39
  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"
  48
  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);
  54
  55
  56 #define offset(field) offsetof (EmacsFrameRec, emacs_frame.field)
  57
  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},
  63
  64   {XtNemacsFrame, XtCEmacsFrame, XtRPointer, sizeof (XtPointer),
  65      offset (frame), XtRImmediate, 0},
  66
  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},
  85 };
  86
  87 #undef offset
  88
  89 /*
  90 static XtActionsRec
  91 emacsFrameActionsTable [] = {
  92   {"keypress",  key_press},
  93   {"focus_in",  emacs_frame_focus_handler},
  94   {"focus_out", emacs_frame_focus_handler},
  95 };
  96
  97 static char
  98 emacsFrameTranslations [] = "\
  99 <KeyPress>: keypress()\n\
 100 <FocusIn>:  focus_in()\n\
 101 <FocusOut>: focus_out()\n\
 102 ";
 103 */
 104
 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,
 128
 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
 142     }
 143 };
 144
 145 WidgetClass emacsFrameClass = (WidgetClass) &emacsFrameClassRec;
 146
 147 static void
 148 get_default_char_pixel_size (EmacsFrame ew, int *pixel_width, int *pixel_height)
 149 {
 150   struct frame* f = ew->emacs_frame.frame;
 151   *pixel_width = FRAME_COLUMN_WIDTH (f);
 152   *pixel_height = FRAME_LINE_HEIGHT (f);
 153 }
 154
 155 static void
 156 pixel_to_char_size (EmacsFrame ew, Dimension pixel_width, Dimension pixel_height, int *char_width, int *char_height)
 157 {
 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);
 161 }
 162
 163 static void
 164 pixel_to_text_size (EmacsFrame ew, Dimension pixel_width, Dimension pixel_height, int *text_width, int *text_height)
 165 {
 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);
 169 }
 170
 171 static void
 172 char_to_pixel_size (EmacsFrame ew, int char_width, int char_height, Dimension *pixel_width, Dimension *pixel_height)
 173 {
 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);
 177 }
 178
 179 static void
 180 round_size_to_char (EmacsFrame ew, Dimension in_width, Dimension in_height, Dimension *out_width, Dimension *out_height)
 181 {
 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);
 186 }
 187
 188 static Widget
 189 get_wm_shell (Widget w)
 190 {
 191   Widget wmshell;
 192
 193   for (wmshell = XtParent (w);
 194        wmshell && !XtIsWMShell (wmshell);
 195        wmshell = XtParent (wmshell));
 196
 197   return wmshell;
 198 }
 199
 200 #if 0 /* Currently not used.  */
 201
 202 static void
 203 mark_shell_size_user_specified (Widget wmshell)
 204 {
 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;
 209 }
 210
 211 #endif
 212
 213
 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.
 219  */
 220 #if 0
 221 static Boolean first_frame_p = True;
 222 #endif
 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   /* 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.  */
 269
 270   if (! XtIsSubclass (wmshell, shellWidgetClass)) emacs_abort ();
 271
 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);
 279
 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)));
 283 }
 284
 285 static void
 286 update_wm_hints (EmacsFrame ew)
 287 {
 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;
 298
 299   /* This happens when the frame is just created.  */
 300   if (! wmshell) return;
 301
 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);
 307
 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)));
 312
 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.
 315    */
 316 /*  ((WMShellWidget) wmshell)->wm.size_hints.flags |= USSize;*/
 317
 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);
 326 }
 327
 328 void
 329 widget_update_wm_size_hints (Widget widget)
 330 {
 331   EmacsFrame ew = (EmacsFrame) widget;
 332   update_wm_hints (ew);
 333 }
 334
 335 static void
 336 update_various_frame_slots (EmacsFrame ew)
 337 {
 338   struct frame *f = ew->emacs_frame.frame;
 339
 340   f->internal_border_width = ew->emacs_frame.internal_border_width;
 341 }
 342
 343 static void
 344 update_from_various_frame_slots (EmacsFrame ew)
 345 {
 346   struct frame *f = ew->emacs_frame.frame;
 347   struct x_output *x = f->output_data.x;
 348
 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;
 356 }
 357
 358 static void
 359 EmacsFrameInitialize (Widget request, Widget new, ArgList dum1, Cardinal *dum2)
 360 {
 361   EmacsFrame ew = (EmacsFrame) new;
 362
 363   if (!ew->emacs_frame.frame)
 364     {
 365       fprintf (stderr,
 366                "can't create an emacs frame widget without a frame\n");
 367       exit (1);
 368     }
 369
 370   update_from_various_frame_slots (ew);
 371   set_frame_size (ew);
 372 }
 373
 374 static void
 375 resize_cb (Widget widget,
 376            XtPointer closure,
 377            XEvent* event,
 378            Boolean* continue_to_dispatch)
 379 {
 380   EmacsFrameResize (widget);
 381 }
 382
 383
 384 static void
 385 EmacsFrameRealize (Widget widget, XtValueMask *mask, XSetWindowAttributes *attrs)
 386 {
 387   EmacsFrame ew = (EmacsFrame) widget;
 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   update_wm_hints (ew);
 402 }
 403
 404 static void
 405 EmacsFrameDestroy (Widget widget)
 406 {
 407   /* All GCs are now freed in x_free_frame_resources.  */
 408 }
 409
 410 static void
 411 EmacsFrameResize (Widget widget)
 412 {
 413   EmacsFrame ew = (EmacsFrame) widget;
 414   struct frame *f = ew->emacs_frame.frame;
 415   int width, height;
 416
 417   pixel_to_text_size (ew, ew->core.width, ew->core.height, &width, &height);
 418
 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))));
 425
 426   change_frame_size (f, width, height, 0, 1, 0, 1);
 427
 428   update_wm_hints (ew);
 429   update_various_frame_slots (ew);
 430
 431   cancel_mouse_face (f);
 432 }
 433
 434 static XtGeometryResult
 435 EmacsFrameQueryGeometry (Widget widget, XtWidgetGeometry *request, XtWidgetGeometry *result)
 436 {
 437   EmacsFrame ew = (EmacsFrame) widget;
 438
 439   int mask = request->request_mode;
 440   Dimension ok_width, ok_height;
 441
 442   if (mask & (CWWidth | CWHeight))
 443     {
 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))
 451         {
 452           result->request_mode |= CWWidth;
 453           result->width = ok_width;
 454         }
 455       if ((mask & CWHeight) && (ok_height != request->height))
 456         {
 457           result->request_mode |= CWHeight;
 458           result->height = ok_height;
 459         }
 460     }
 461   return result->request_mode ? XtGeometryAlmost : XtGeometryYes;
 462 }
 463
 464 /* Special entry points */
 465 void
 466 EmacsFrameSetCharSize (Widget widget, int columns, int rows)
 467 {
 468   EmacsFrame ew = (EmacsFrame) widget;
 469   struct frame *f = ew->emacs_frame.frame;
 470
 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);
 474 }
 475
 476 \f
 477 void
 478 widget_store_internal_border (Widget widget)
 479 {
 480   EmacsFrame ew = (EmacsFrame) widget;
 481   struct frame *f = ew->emacs_frame.frame;
 482
 483   ew->emacs_frame.internal_border_width = f->internal_border_width;
 484 }