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

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