XEmacs 21.2.32 "Kastor & Polydeukes".
[chise/xemacs-chise.git.1] / src / frame-x.c
1 /* Functions for the X window system.
2    Copyright (C) 1989, 1992-5, 1997 Free Software Foundation, Inc.
3    Copyright (C) 1995, 1996 Ben Wing.
4
5 This file is part of XEmacs.
6
7 XEmacs is free software; you can redistribute it and/or modify it
8 under the terms of the GNU General Public License as published by the
9 Free Software Foundation; either version 2, or (at your option) any
10 later version.
11
12 XEmacs is distributed in the hope that it will be useful, but WITHOUT
13 ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
14 FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
15 for more details.
16
17 You should have received a copy of the GNU General Public License
18 along with XEmacs; see the file COPYING.  If not, write to
19 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
20 Boston, MA 02111-1307, USA.  */
21
22 /* Synched up with: Not synched with FSF. */
23
24 /* Substantially rewritten for XEmacs.  */
25
26 #include <config.h>
27 #include "lisp.h"
28
29 #include "console-x.h"
30 #include "xintrinsicp.h"        /* CoreP.h needs this */
31 #include <X11/CoreP.h>          /* Numerous places access the fields of
32                                    a core widget directly.  We could
33                                    use XtGetValues(), but ... */
34 #include <X11/Shell.h>
35 #include <X11/ShellP.h>
36 #include "xmu.h"
37 #include "EmacsManager.h"
38 #include "EmacsFrameP.h"
39 #include "EmacsShell.h"
40 #ifdef EXTERNAL_WIDGET
41 #include "ExternalShell.h"
42 #endif
43 #include "glyphs-x.h"
44 #include "objects-x.h"
45 #include "scrollbar-x.h"
46
47 #include "buffer.h"
48 #include "events.h"
49 #include "extents.h"
50 #include "faces.h"
51 #include "frame.h"
52 #include "window.h"
53 #include "gutter.h"
54
55 #ifdef HAVE_DRAGNDROP
56 #include "dragdrop.h"
57 #endif
58
59 #ifdef HAVE_OFFIX_DND
60 #include "offix.h"
61 #endif
62 #if defined (HAVE_OFFIX_DND) || defined (HAVE_CDE)
63 #include "events-mod.h"
64 #endif
65
66 /* Default properties to use when creating frames.  */
67 Lisp_Object Vdefault_x_frame_plist;
68
69 Lisp_Object Qwindow_id;
70 Lisp_Object Qx_resource_name;
71
72 EXFUN (Fx_window_id, 1);
73
74 \f
75 /************************************************************************/
76 /*                          helper functions                            */
77 /************************************************************************/
78
79 /* Return the Emacs frame-object corresponding to an X window */
80 struct frame *
81 x_window_to_frame (struct device *d, Window wdesc)
82 {
83   Lisp_Object tail, frame;
84   struct frame *f;
85
86   /* This function was previously written to accept only a window argument
87      (and to loop over all devices looking for a matching window), but
88      that is incorrect because window ID's are not unique across displays. */
89
90   for (tail = DEVICE_FRAME_LIST (d); CONSP (tail); tail = XCDR (tail))
91     {
92       frame = XCAR (tail);
93       if (!FRAMEP (frame))
94         continue;
95       f = XFRAME (frame);
96       if (FRAME_X_P (f) && XtWindow (FRAME_X_TEXT_WIDGET (f)) == wdesc)
97         return f;
98     }
99   return 0;
100 }
101
102 /* Like x_window_to_frame but also compares the window with the widget's
103    windows */
104 struct frame *
105 x_any_window_to_frame (struct device *d, Window wdesc)
106 {
107   Widget w;
108   assert (DEVICE_X_P (d));
109
110   w = XtWindowToWidget (DEVICE_X_DISPLAY (d), wdesc);
111
112   if (!w)
113     return 0;
114
115   /* We used to map over all frames here and then map over all widgets
116      belonging to that frame. However it turns out that this was very fragile
117      as it requires our display stuctures to be in sync _and_ that the
118      loop is told about every new widget somebody adds. Therefore we
119      now let Xt find it for us (which does a bottom-up search which
120      could even be faster) */
121   return  x_any_widget_or_parent_to_frame (d, w);
122 }
123
124 static struct frame *
125 x_find_frame_for_window (struct device *d, Window wdesc)
126 {
127   Lisp_Object tail, frame;
128   struct frame *f;
129   /* This function was previously written to accept only a window argument
130      (and to loop over all devices looking for a matching window), but
131      that is incorrect because window ID's are not unique across displays. */
132
133   for (tail = DEVICE_FRAME_LIST (d); CONSP (tail); tail = XCDR (tail))
134     {
135       frame = XCAR (tail);
136       f = XFRAME (frame);
137       /* This frame matches if the window is any of its widgets. */
138       if (wdesc == XtWindow (FRAME_X_SHELL_WIDGET (f)) ||
139           wdesc == XtWindow (FRAME_X_CONTAINER_WIDGET (f)) ||
140           wdesc == XtWindow (FRAME_X_TEXT_WIDGET (f)))
141         return f;
142
143       /* Match if the window is one of the widgets at the top of the frame
144          (menubar, Energize psheets). */
145
146       /* Note: Jamie once said
147
148          "Do *not* match if the window is this frame's psheet."
149
150          But this is wrong and will screw up some functions that expect
151          x_any_window_to_frame() to work as advertised.  I think the reason
152          for this statement is that, in the old (broken) event loop, where
153          not all events went through XtDispatchEvent(), psheet events
154          would incorrectly get sucked away by Emacs if this function matched
155          on psheet widgets. */
156
157       /* Note: that this called only from
158          x_any_widget_or_parent_to_frame it is unnecessary to iterate
159          over the top level widgets. */
160
161       /* Note:  we use to special case scrollbars but this turns out to be a bad idea
162          because
163          1. We sometimes get events for _unmapped_ scrollbars and our
164          callers don't want us to fail.
165          2. Starting with the 21.2 widget stuff there are now loads of
166          widgets to check and it is easy to forget adding them in a loop here.
167          See x_any_window_to_frame
168          3. We pick up all widgets now anyway. */
169     }
170
171   return 0;
172 }
173
174 struct frame *
175 x_any_widget_or_parent_to_frame (struct device *d, Widget widget)
176 {
177   while (widget)
178     {
179       struct frame *f = x_find_frame_for_window (d, XtWindow (widget));
180       if (f)
181         return f;
182       widget = XtParent (widget);
183     }
184
185   return 0;
186 }
187
188 struct frame *
189 decode_x_frame (Lisp_Object frame)
190 {
191   if (NILP (frame))
192     XSETFRAME (frame, selected_frame ());
193   CHECK_LIVE_FRAME (frame);
194   /* this will also catch dead frames, but putting in the above check
195      results in a more useful error */
196   CHECK_X_FRAME (frame);
197   return XFRAME (frame);
198 }
199
200 \f
201 /************************************************************************/
202 /*                      window-manager interactions                     */
203 /************************************************************************/
204
205 #if 0
206 /* Not currently used. */
207
208 void
209 x_wm_mark_shell_size_user_specified (Widget wmshell)
210 {
211   if (! XtIsWMShell (wmshell)) abort ();
212   EmacsShellSetSizeUserSpecified (wmshell);
213 }
214
215 void
216 x_wm_mark_shell_position_user_specified (Widget wmshell)
217 {
218   if (! XtIsWMShell (wmshell)) abort ();
219   EmacsShellSetPositionUserSpecified (wmshell);
220 }
221
222 #endif
223
224 void
225 x_wm_set_shell_iconic_p (Widget shell, int iconic_p)
226 {
227   if (! XtIsWMShell (shell)) abort ();
228
229   /* Because of questionable logic in Shell.c, this sequence can't work:
230
231        w = XtCreatePopupShell (...);
232        Xt_SET_VALUE (w, XtNiconic, True);
233        XtRealizeWidget (w);
234
235      The iconic resource is only consulted at initialization time (when
236      XtCreatePopupShell is called) instead of at realization time (just
237      before the window gets created, which would be more sensible) or
238      at management-time (just before the window gets mapped, which would
239      be most sensible of all).
240
241      The bug is that Shell's SetValues method doesn't do anything to
242      w->wm.wm_hints.initial_state until after the widget has been realized.
243      Calls to XtSetValues are ignored in the window between creation and
244      realization.  This is true of MIT X11R5 patch level 25, at least.
245      (Apparently some other versions of Xt don't have this bug?)
246    */
247   Xt_SET_VALUE (shell, XtNiconic, iconic_p);
248   EmacsShellSmashIconicHint (shell, iconic_p);
249 }
250
251 void
252 x_wm_set_cell_size (Widget wmshell, int cw, int ch)
253 {
254   Arg al [2];
255
256   if (!XtIsWMShell (wmshell))
257     abort ();
258   if (cw <= 0 || ch <= 0)
259     abort ();
260
261   XtSetArg (al [0], XtNwidthInc,  cw);
262   XtSetArg (al [1], XtNheightInc, ch);
263   XtSetValues (wmshell, al, 2);
264 }
265
266 void
267 x_wm_set_variable_size (Widget wmshell, int width, int height)
268 {
269   Arg al [2];
270
271   if (!XtIsWMShell (wmshell))
272     abort ();
273 #ifdef DEBUG_GEOMETRY_MANAGEMENT
274   /* See comment in EmacsShell.c */
275   printf ("x_wm_set_variable_size: %d %d\n", width, height);
276   fflush (stdout);
277 #endif
278
279   XtSetArg (al [0], XtNwidthCells,  width);
280   XtSetArg (al [1], XtNheightCells, height);
281   XtSetValues (wmshell, al, 2);
282 }
283
284 /* If the WM_PROTOCOLS property does not already contain WM_TAKE_FOCUS
285    and WM_DELETE_WINDOW, then add them.  (They may already be present
286    because of the toolkit (Motif adds them, for example, but Xt doesn't).
287  */
288 static void
289 x_wm_hack_wm_protocols (Widget widget)
290 {
291   Display *dpy = XtDisplay (widget);
292   struct device *d = get_device_from_display (dpy);
293   Window w = XtWindow (widget);
294   int need_delete = 1;
295   int need_focus = 1;
296
297   assert (XtIsWMShell (widget));
298
299   {
300     Atom type, *atoms = 0;
301     int format = 0;
302     unsigned long nitems = 0;
303     unsigned long bytes_after;
304
305     if (Success == XGetWindowProperty (dpy, w, DEVICE_XATOM_WM_PROTOCOLS (d),
306                                        0, 100, False, XA_ATOM,
307                                        &type, &format, &nitems, &bytes_after,
308                                        (unsigned char **) &atoms)
309         && format == 32 && type == XA_ATOM)
310       while (nitems > 0)
311         {
312           nitems--;
313           if (atoms [nitems] == DEVICE_XATOM_WM_DELETE_WINDOW (d))
314             need_delete = 0;
315           else if (atoms [nitems] == DEVICE_XATOM_WM_TAKE_FOCUS (d))
316             need_focus = 0;
317         }
318     if (atoms) XFree ((char *) atoms);
319   }
320   {
321     Atom props [10];
322     int count = 0;
323     if (need_delete) props[count++] = DEVICE_XATOM_WM_DELETE_WINDOW (d);
324     if (need_focus)  props[count++] = DEVICE_XATOM_WM_TAKE_FOCUS (d);
325     if (count)
326       XChangeProperty (dpy, w, DEVICE_XATOM_WM_PROTOCOLS (d), XA_ATOM, 32,
327                        PropModeAppend, (unsigned char *) props, count);
328   }
329 }
330
331 static void
332 x_wm_store_class_hints (Widget shell, char *frame_name)
333 {
334   Display *dpy = XtDisplay (shell);
335   char *app_name, *app_class;
336   XClassHint classhint;
337
338   if (!XtIsWMShell (shell))
339     abort ();
340
341   XtGetApplicationNameAndClass (dpy, &app_name, &app_class);
342   classhint.res_name = frame_name;
343   classhint.res_class = app_class;
344   XSetClassHint (dpy, XtWindow (shell), &classhint);
345 }
346
347 #ifndef HAVE_WMCOMMAND
348 static void
349 x_wm_maybe_store_wm_command (struct frame *f)
350 {
351   Widget w = FRAME_X_SHELL_WIDGET (f);
352   struct device *d = XDEVICE (FRAME_DEVICE (f));
353
354   if (!XtIsWMShell (w))
355     abort ();
356
357   if (NILP (DEVICE_X_WM_COMMAND_FRAME (d)))
358     {
359       int argc;
360       char **argv;
361       make_argc_argv (Vcommand_line_args, &argc, &argv);
362       XSetCommand (XtDisplay (w), XtWindow (w), argv, argc);
363       free_argc_argv (argv);
364       XSETFRAME (DEVICE_X_WM_COMMAND_FRAME (d), f);
365     }
366 }
367
368 /* If we're deleting the frame on which the WM_COMMAND property has been
369    set, then move that property to another frame so that there is exactly
370    one frame that has that property set.
371  */
372 static void
373 x_wm_maybe_move_wm_command (struct frame *f)
374 {
375   struct device *d = XDEVICE (FRAME_DEVICE (f));
376
377   /* There may not be a frame in DEVICE_X_WM_COMMAND_FRAME()
378      if we C-c'ed at startup at the right time. */
379   if (FRAMEP (DEVICE_X_WM_COMMAND_FRAME (d))
380       && f == XFRAME (DEVICE_X_WM_COMMAND_FRAME (d)))
381     {
382       Lisp_Object rest = DEVICE_FRAME_LIST (d);
383       DEVICE_X_WM_COMMAND_FRAME (d) = Qnil;
384       /* find some random other X frame that is not this one, or give up */
385       /* skip non-top-level (ExternalClient) frames */
386       while (!NILP (rest) &&
387              (f == XFRAME (XCAR (rest)) ||
388               !FRAME_X_TOP_LEVEL_FRAME_P (XFRAME (XCAR (rest)))))
389         rest = XCDR (rest);
390       if (NILP (rest))
391         return;
392       f = XFRAME (XCAR (rest));
393
394       x_wm_maybe_store_wm_command (f);
395
396     }
397 }
398 #endif /* !HAVE_WMCOMMAND */
399
400 static int
401 x_frame_iconified_p (struct frame *f)
402 {
403   Atom actual_type;
404   int actual_format;
405   unsigned long nitems, bytesafter;
406   unsigned long *datap = 0;
407   Widget widget;
408   int result = 0;
409   struct device *d = XDEVICE (FRAME_DEVICE (f));
410
411   widget = FRAME_X_SHELL_WIDGET (f);
412   if (Success == XGetWindowProperty (XtDisplay (widget), XtWindow (widget),
413                                      DEVICE_XATOM_WM_STATE (d), 0, 2, False,
414                                      DEVICE_XATOM_WM_STATE (d), &actual_type,
415                                      &actual_format, &nitems, &bytesafter,
416                                      (unsigned char **) &datap)
417       && datap)
418     {
419       if (nitems <= 2   /* "suggested" by ICCCM version 1 */
420           && datap[0] == IconicState)
421         result = 1;
422       XFree ((char *) datap);
423     }
424   return result;
425 }
426
427 \f
428 /************************************************************************/
429 /*                          frame properties                            */
430 /************************************************************************/
431
432 /* Connect the frame-property names (symbols) to the corresponding
433    X Resource Manager names.  The name of a property, as a Lisp symbol,
434    has an `x-resource-name' property which is a Lisp_String. */
435
436 static void
437 init_x_prop_symbols (void)
438 {
439 #define def(sym, rsrc) \
440    Fput (sym, Qx_resource_name, build_string (rsrc))
441 #define defi(sym,rsrc) \
442    def (sym, rsrc); Fput (sym, Qintegerp, Qt)
443
444 #if 0 /* this interferes with things. #### fix this right */
445   def (Qminibuffer, XtNminibuffer);
446   def (Qunsplittable, XtNunsplittable);
447 #endif
448   defi(Qinternal_border_width, XtNinternalBorderWidth);
449 #ifdef HAVE_TOOLBARS
450   def (Qtop_toolbar_shadow_color, XtNtopToolBarShadowColor);
451   def (Qbottom_toolbar_shadow_color, XtNbottomToolBarShadowColor);
452   def (Qbackground_toolbar_color, XtNbackgroundToolBarColor);
453   def (Qtop_toolbar_shadow_pixmap, XtNtopToolBarShadowPixmap);
454   def (Qbottom_toolbar_shadow_pixmap, XtNbottomToolBarShadowPixmap);
455   defi(Qtoolbar_shadow_thickness, XtNtoolBarShadowThickness);
456 #endif
457   def (Qscrollbar_placement, XtNscrollBarPlacement);
458   defi(Qinter_line_space, XtNinterline);
459   /* font, foreground */
460   def (Qiconic, XtNiconic);
461   def (Qbar_cursor, XtNbarCursor);
462   def (Qvisual_bell, XtNvisualBell);
463   defi(Qbell_volume, XtNbellVolume);
464   def (Qpointer_background, XtNpointerBackground);
465   def (Qpointer_color, XtNpointerColor);
466   def (Qtext_pointer, XtNtextPointer);
467   def (Qspace_pointer, XtNspacePointer);
468   def (Qmodeline_pointer, XtNmodeLinePointer);
469   def (Qgc_pointer, XtNgcPointer);
470   /* geometry, initial_geometry */
471   def (Qinitially_unmapped, XtNinitiallyUnmapped);
472   /* preferred_width, preferred_height */
473   def (Quse_backing_store, XtNuseBackingStore);
474
475   /* inherited: */
476
477   def (Qborder_color, XtNborderColor);
478   defi(Qborder_width, XtNborderWidth);
479   defi(Qwidth, XtNwidth);
480   defi(Qheight, XtNheight);
481   defi(Qleft, XtNx);
482   defi(Qtop, XtNy);
483
484 #undef def
485 }
486
487 static Lisp_Object
488 color_to_string (Widget w, unsigned long pixel)
489 {
490   char buf[255];
491
492   XColor color;
493   color.pixel = pixel;
494   XQueryColor (XtDisplay (w), w->core.colormap, &color);
495   sprintf (buf, "#%04x%04x%04x", color.red, color.green, color.blue);
496   return build_string (buf);
497 }
498
499 static void
500 x_get_top_level_position (Display *d, Window w, Position *x, Position *y)
501 {
502   Window root, parent = w, *children;
503   unsigned int nchildren;
504   XWindowAttributes xwa;
505
506   do
507     {
508       w = parent;
509       if (!XQueryTree (d, w, &root, &parent, &children, &nchildren))
510         {
511           *x = 0;
512           *y = 0;
513           return;
514         }
515       XFree (children);
516     }
517   while (root != parent);
518   XGetWindowAttributes (d, w, &xwa);
519   *x = xwa.x;
520   *y = xwa.y;
521 }
522
523 #if 0
524 static void
525 x_smash_bastardly_shell_position (Widget shell)
526 {
527   /* Naturally those bastards who wrote Xt couldn't be bothered
528      to learn about race conditions and such.  We can't trust
529      the X and Y values to have any semblance of correctness,
530      so we smash the right values in place. */
531
532  /* We might be called before we've actually realized the window (if
533      we're checking for the minibuffer resource).  This will bomb in
534      that case so we don't bother calling it. */
535   if (XtWindow (shell))
536     x_get_top_level_position (XtDisplay (shell), XtWindow (shell),
537                               &shell->core.x, &shell->core.y);
538 }
539 #endif /* 0 */
540
541 static Lisp_Object
542 x_frame_property (struct frame *f, Lisp_Object property)
543 {
544   Widget shell = FRAME_X_SHELL_WIDGET (f);
545   EmacsFrame w = (EmacsFrame) FRAME_X_TEXT_WIDGET (f);
546   Widget gw = (Widget) w;
547
548   if (EQ (Qleft, property) || EQ (Qtop, property))
549     {
550       Position x, y;
551       if (!XtWindow(shell))
552         return Qzero;
553       x_get_top_level_position (XtDisplay (shell), XtWindow (shell), &x, &y);
554       if (EQ (Qleft, property)) return make_int (x);
555       if (EQ (Qtop,  property)) return make_int (y);
556     }
557   if (EQ (Qborder_width, property))
558     return make_int (w->core.border_width);
559   if (EQ (Qinternal_border_width, property))
560     return make_int (w->emacs_frame.internal_border_width);
561   if (EQ (Qborder_color, property))
562     return color_to_string (gw, w->core.border_pixel);
563 #ifdef HAVE_TOOLBARS
564   if (EQ (Qtop_toolbar_shadow_color, property))
565     return color_to_string (gw, w->emacs_frame.top_toolbar_shadow_pixel);
566   if (EQ (Qbottom_toolbar_shadow_color, property))
567     return color_to_string (gw, w->emacs_frame.bottom_toolbar_shadow_pixel);
568   if (EQ (Qbackground_toolbar_color, property))
569     return color_to_string (gw, w->emacs_frame.background_toolbar_pixel);
570   if (EQ (Qtoolbar_shadow_thickness, property))
571     return make_int (w->emacs_frame.toolbar_shadow_thickness);
572 #endif /* HAVE_TOOLBARS */
573   if (EQ (Qinter_line_space, property))
574     return make_int (w->emacs_frame.interline);
575   if (EQ (Qwindow_id, property))
576     return Fx_window_id (make_frame (f));
577
578   return Qunbound;
579 }
580
581 static int
582 x_internal_frame_property_p (struct frame *f, Lisp_Object property)
583 {
584   return EQ (property, Qleft)
585     || EQ (property, Qtop)
586     || EQ (property, Qborder_width)
587     || EQ (property, Qinternal_border_width)
588     || EQ (property, Qborder_color)
589 #ifdef HAVE_TOOLBARS
590     || EQ (property, Qtop_toolbar_shadow_color)
591     || EQ (property, Qbottom_toolbar_shadow_color)
592     || EQ (property, Qbackground_toolbar_color)
593     || EQ (property, Qtoolbar_shadow_thickness)
594 #endif /* HAVE_TOOLBARS */
595     || EQ (property, Qinter_line_space)
596     || EQ (property, Qwindow_id)
597     || STRINGP (property);
598 }
599
600 static Lisp_Object
601 x_frame_properties (struct frame *f)
602 {
603   Lisp_Object props = Qnil;
604   Widget shell = FRAME_X_SHELL_WIDGET (f);
605   EmacsFrame w = (EmacsFrame) FRAME_X_TEXT_WIDGET (f);
606   Widget gw = (Widget) w;
607   Position x, y;
608
609   props = cons3 (Qwindow_id, Fx_window_id (make_frame (f)), props);
610   props = cons3 (Qinter_line_space, make_int (w->emacs_frame.interline), props);
611
612 #ifdef HAVE_TOOLBARS
613   props = cons3 (Qtoolbar_shadow_thickness,
614                  make_int (w->emacs_frame.toolbar_shadow_thickness),
615                  props);
616   props = cons3 (Qbackground_toolbar_color,
617                  color_to_string (gw, w->emacs_frame.background_toolbar_pixel),
618                  props);
619   props = cons3 (Qbottom_toolbar_shadow_color,
620                  color_to_string (gw, w->emacs_frame.bottom_toolbar_shadow_pixel),
621                  props);
622   props = cons3 (Qtop_toolbar_shadow_color,
623                  color_to_string (gw, w->emacs_frame.top_toolbar_shadow_pixel),
624                  props);
625 #endif /* HAVE_TOOLBARS */
626
627   props = cons3 (Qborder_color,
628                  color_to_string (gw, w->core.border_pixel), props);
629   props = cons3 (Qinternal_border_width,
630                  make_int (w->emacs_frame.internal_border_width), props);
631   props = cons3 (Qborder_width, make_int (w->core.border_width), props);
632
633   if (!XtWindow(shell))
634     x = y = 0;
635   else
636     x_get_top_level_position (XtDisplay (shell), XtWindow (shell), &x, &y);
637
638   props = cons3 (Qtop,  make_int (y), props);
639   props = cons3 (Qleft, make_int (x), props);
640
641   return props;
642 }
643
644 \f
645 /* Functions called only from `x_set_frame_properties' to set
646    individual properties. */
647
648 static void
649 x_set_frame_text_value (struct frame *f, Bufbyte *value,
650                         String Xt_resource_name,
651                         String Xt_resource_encoding_name)
652 {
653   Atom encoding = XA_STRING;
654   String new_XtValue = (String) value;
655   String old_XtValue = NULL;
656
657 #ifdef MULE
658   Bufbyte *ptr;
659   /* Optimize for common ASCII case */
660   for (ptr = value; *ptr; ptr++)
661     if (!BYTE_ASCII_P (*ptr))
662       {
663         const char * tmp;
664         encoding = DEVICE_XATOM_COMPOUND_TEXT (XDEVICE (FRAME_DEVICE (f)));
665         TO_EXTERNAL_FORMAT (C_STRING, value,
666                             C_STRING_ALLOCA, tmp,
667                             Qctext);
668         new_XtValue = (String) tmp;
669         break;
670       }
671 #endif /* MULE */
672
673   /* #### Caching is device-independent - belongs in update_frame_title. */
674   Xt_GET_VALUE (FRAME_X_SHELL_WIDGET (f), Xt_resource_name, &old_XtValue);
675   if (!old_XtValue || strcmp (new_XtValue, old_XtValue))
676     {
677       Arg al[2];
678       XtSetArg (al[0], Xt_resource_name, new_XtValue);
679       XtSetArg (al[1], Xt_resource_encoding_name, encoding);
680       XtSetValues (FRAME_X_SHELL_WIDGET (f), al, 2);
681     }
682 }
683
684 static void
685 x_set_title_from_bufbyte (struct frame *f, Bufbyte *name)
686 {
687   x_set_frame_text_value (f, name, XtNtitle, XtNtitleEncoding);
688 }
689
690 static void
691 x_set_icon_name_from_bufbyte (struct frame *f, Bufbyte *name)
692 {
693   x_set_frame_text_value (f, name, XtNiconName, XtNiconNameEncoding);
694 }
695
696 /* Set the initial frame size as specified.  This function is used
697    when the frame's widgets have not yet been realized.  In this
698    case, it is not sufficient just to set the width and height of
699    the EmacsFrame widget, because they will be ignored when the
700    widget is realized (instead, the shell's geometry resource is
701    used). */
702
703 static void
704 x_set_initial_frame_size (struct frame *f, int flags, int x, int y,
705                           unsigned int w, unsigned int h)
706 {
707   char shell_geom [255];
708   int xval, yval;
709   char xsign, ysign;
710   char uspos = !!(flags & (XValue | YValue));
711   char ussize = !!(flags & (WidthValue | HeightValue));
712   char *temp;
713
714   /* assign the correct size to the EmacsFrame widget ... */
715   EmacsFrameSetCharSize (FRAME_X_TEXT_WIDGET (f), w, h);
716
717   /* and also set the WMShell's geometry */
718   (flags & XNegative) ? (xval = -x, xsign = '-') : (xval = x, xsign = '+');
719   (flags & YNegative) ? (yval = -y, ysign = '-') : (yval = y, ysign = '+');
720
721   if (uspos && ussize)
722     sprintf (shell_geom, "=%dx%d%c%d%c%d", w, h, xsign, xval, ysign, yval);
723   else if (uspos)
724     sprintf (shell_geom, "=%c%d%c%d", xsign, xval, ysign, yval);
725   else if (ussize)
726     sprintf (shell_geom, "=%dx%d", w, h);
727
728   if (uspos || ussize)
729     {
730       temp = (char *) xmalloc (1 + strlen (shell_geom));
731       strcpy (temp, shell_geom);
732       FRAME_X_GEOM_FREE_ME_PLEASE (f) = temp;
733     }
734   else
735     temp = NULL;
736
737   Xt_SET_VALUE (FRAME_X_SHELL_WIDGET (f), XtNgeometry, temp);
738 }
739
740 /* Report to X that a frame property of frame S is being set or changed.
741    If the property is not specially recognized, do nothing.
742  */
743
744 static void
745 x_set_frame_properties (struct frame *f, Lisp_Object plist)
746 {
747   Position x, y;
748   Dimension width = 0, height = 0;
749   Bool width_specified_p = False;
750   Bool height_specified_p = False;
751   Bool x_position_specified_p = False;
752   Bool y_position_specified_p = False;
753   Bool internal_border_width_specified = False;
754   Lisp_Object tail;
755   Widget w = FRAME_X_TEXT_WIDGET (f);
756
757   for (tail = plist; !NILP (tail); tail = Fcdr (Fcdr (tail)))
758     {
759       Lisp_Object prop = Fcar (tail);
760       Lisp_Object val = Fcar (Fcdr (tail));
761
762       if (STRINGP (prop))
763         {
764           const char *extprop;
765
766           if (XSTRING_LENGTH (prop) == 0)
767             continue;
768
769           TO_EXTERNAL_FORMAT (LISP_STRING, prop,
770                               C_STRING_ALLOCA, extprop,
771                               Qctext);
772           if (STRINGP (val))
773             {
774               const Extbyte *extval;
775               Extcount extvallen;
776
777               TO_EXTERNAL_FORMAT (LISP_STRING, val,
778                                   ALLOCA, (extval, extvallen),
779                                   Qctext);
780               XtVaSetValues (w, XtVaTypedArg, extprop,
781                              XtRString, extval, extvallen + 1,
782                              (XtArgVal) NULL);
783             }
784           else
785             XtVaSetValues (w, XtVaTypedArg, extprop, XtRInt,
786                            XINT (val), sizeof (int),
787                            (XtArgVal) NULL);
788         }
789       else if (SYMBOLP (prop))
790         {
791           Lisp_Object str = Fget (prop, Qx_resource_name, Qnil);
792           int int_p = !NILP (Fget (prop, Qintegerp, Qnil));
793
794           if (NILP (prop) || NILP (str))
795             {
796               /* Kludge to handle the font property. */
797               if (EQ (prop, Qfont))
798                 {
799                   /* If the value is not a string we silently ignore it. */
800                   if (STRINGP (val))
801                     {
802                       Lisp_Object frm, font_spec;
803
804                       XSETFRAME (frm, f);
805                       font_spec = Fget (Fget_face (Qdefault), Qfont, Qnil);
806
807                       Fadd_spec_to_specifier (font_spec, val, frm, Qnil, Qnil);
808                       update_frame_face_values (f);
809                     }
810
811                   continue;
812                 }
813               else
814                 continue;
815             }
816           CHECK_STRING (str);
817
818           /* Kludge the width/height so that we interpret them in characters
819              instead of pixels.  Yuck yuck yuck. */
820           if (!strcmp ((char *) XSTRING_DATA (str), "width"))
821             {
822               CHECK_INT (val);
823               width = XINT (val);
824               width_specified_p = True;
825               continue;
826             }
827           if (!strcmp ((char *) XSTRING_DATA (str), "height"))
828             {
829               CHECK_INT (val);
830               height = XINT (val);
831               height_specified_p = True;
832               continue;
833             }
834           /* Further kludge the x/y. */
835           if (!strcmp ((char *) XSTRING_DATA (str), "x"))
836             {
837               CHECK_INT (val);
838               x = (Position) XINT (val);
839               x_position_specified_p = True;
840               continue;
841             }
842           if (!strcmp ((char *) XSTRING_DATA (str), "y"))
843             {
844               CHECK_INT (val);
845               y = (Position) XINT (val);
846               y_position_specified_p = True;
847               continue;
848             }
849           /* Have you figured out by now that this entire function is
850              one gigantic kludge? */
851           if (!strcmp ((char *) XSTRING_DATA (str),
852                        "internalBorderWidth"))
853             {
854               internal_border_width_specified = True;
855             }
856
857           if (int_p)
858             {
859               CHECK_INT (val);
860               Xt_SET_VALUE (w, (char *) XSTRING_DATA (str), XINT (val));
861             }
862           else if (EQ (val, Qt))
863             {
864               Xt_SET_VALUE (w, (char *) XSTRING_DATA (str), True); /* XtN...*/
865             }
866           else if (EQ (val, Qnil))
867             {
868               Xt_SET_VALUE (w, (char *) XSTRING_DATA (str), False); /* XtN...*/
869             }
870           else
871             {
872               CHECK_STRING (val);
873               XtVaSetValues (w, XtVaTypedArg,
874                              /* XtN... */
875                              (char *) XSTRING_DATA (str),
876                              XtRString,
877                              XSTRING_DATA (val),
878                              XSTRING_LENGTH (val) + 1,
879                              (XtArgVal) NULL);
880             }
881
882 #ifdef HAVE_SCROLLBARS
883           if (!strcmp ((char *) XSTRING_DATA (str), "scrollBarWidth")
884               || !strcmp ((char *) XSTRING_DATA (str),
885                           "scrollBarHeight"))
886             {
887               x_update_frame_scrollbars (f);
888             }
889 #endif /* HAVE_SCROLLBARS */
890         }
891     }
892
893   /* Kludge kludge kludge.   We need to deal with the size and position
894    specially. */
895   {
896     int size_specified_p = width_specified_p || height_specified_p;
897     int position_specified_p = x_position_specified_p ||
898       y_position_specified_p;
899
900     if (!width_specified_p)
901       width = FRAME_WIDTH (f);
902     if (!height_specified_p)
903       height = FRAME_HEIGHT (f);
904
905     /* Kludge kludge kludge kludge. */
906     if (position_specified_p &&
907         (!x_position_specified_p || !y_position_specified_p))
908       {
909         Position dummy;
910         Widget shell = FRAME_X_SHELL_WIDGET (f);
911         x_get_top_level_position (XtDisplay (shell), XtWindow (shell),
912                                   (x_position_specified_p ? &dummy : &x),
913                                   (y_position_specified_p ? &dummy : &y));
914 #if 0
915         x = (int) (FRAME_X_SHELL_WIDGET (f)->core.x);
916         y = (int) (FRAME_X_SHELL_WIDGET (f)->core.y);
917 #endif
918       }
919
920     if (!f->init_finished)
921       {
922         int flags = (size_specified_p ? WidthValue | HeightValue : 0) |
923           (position_specified_p ?
924            XValue | YValue | (x < 0 ? XNegative : 0) | (y < 0 ? YNegative : 0)
925            : 0);
926         if (size_specified_p
927             || position_specified_p
928             || internal_border_width_specified)
929           x_set_initial_frame_size (f, flags, x, y, width, height);
930       }
931     else
932       {
933         if (size_specified_p || internal_border_width_specified)
934           {
935             Lisp_Object frame;
936             XSETFRAME (frame, f);
937             Fset_frame_size (frame, make_int (width),
938                               make_int (height), Qnil);
939           }
940         if (position_specified_p)
941           {
942             Lisp_Object frame;
943             XSETFRAME (frame, f);
944             Fset_frame_position (frame, make_int (x), make_int (y));
945           }
946       }
947   }
948 }
949
950 static int frame_title_format_already_set;
951
952 static void
953 maybe_set_frame_title_format (Widget shell)
954 {
955
956   /* Only do this if this is the first X frame we're creating.
957
958      If the *title resource (or -title option) was specified, then
959      set frame-title-format to its value.
960      */
961
962   if (!frame_title_format_already_set)
963     {
964       /* No doubt there's a less stupid way to do this. */
965       char *results [2];
966       XtResource resources [2];
967       results [0] = results [1] = 0;
968       resources [0].resource_name = XtNtitle;
969       resources [0].resource_class = XtCTitle;
970       resources [0].resource_type = XtRString;
971       resources [0].resource_size = sizeof (String);
972       resources [0].resource_offset = 0;
973       resources [0].default_type = XtRString;
974       resources [0].default_addr = 0;
975       resources [1].resource_name = XtNiconName;
976       resources [1].resource_class = XtCIconName;
977       resources [1].resource_type = XtRString;
978       resources [1].resource_size = sizeof (String);
979       resources [1].resource_offset = sizeof (char *);
980       resources [1].default_type = XtRString;
981       resources [1].default_addr = 0;
982       XtGetSubresources (XtParent (shell), (XtPointer) results,
983                          shell->core.name,
984                          shell->core.widget_class->core_class.class_name,
985                          resources, XtNumber (resources), 0, 0);
986       if (results[0])
987         Vframe_title_format = build_string (results[0]);
988       if (results[1])
989         Vframe_icon_title_format = build_string (results[1]);
990     }
991
992   frame_title_format_already_set = 1;
993 }
994
995 #ifdef HAVE_CDE
996 #include <Dt/Dt.h>
997 #include <Dt/Dnd.h>
998
999 static Widget CurrentDragWidget = NULL;
1000 static XtCallbackRec dnd_convert_cb_rec[2];
1001 static XtCallbackRec dnd_destroy_cb_rec[2];
1002 static int drag_not_done = 0;
1003
1004 static void
1005 x_cde_destroy_callback (Widget widget, XtPointer clientData,
1006                         XtPointer callData)
1007 {
1008   DtDndDragFinishCallbackStruct *dragFinishInfo =
1009     (DtDndDragFinishCallbackStruct *)callData;
1010   DtDndContext *dragData = dragFinishInfo->dragData;
1011   int i;
1012
1013   /* free the items */
1014   if (callData != NULL && dragData != NULL)
1015     {
1016       if (dragData->protocol == DtDND_BUFFER_TRANSFER)
1017         {
1018           for (i = 0; i < dragData->numItems; i++)
1019             {
1020               XtFree((char *) dragData->data.buffers[i].bp);
1021               if (dragData->data.buffers[i].name)
1022                 XtFree(dragData->data.buffers[i].name);
1023             }
1024         }
1025       else
1026         {
1027           for (i = 0; i < dragData->numItems; i++)
1028             XtFree(dragData->data.files[i]);
1029         }
1030     }
1031
1032   /* free the data string */
1033   xfree (clientData);
1034
1035   CurrentDragWidget = NULL;
1036 }
1037
1038 static void
1039 x_cde_convert_callback (Widget widget, XtPointer clientData,
1040                         XtPointer callData)
1041 {
1042   DtDndConvertCallbackStruct *convertInfo =
1043     (DtDndConvertCallbackStruct *) callData;
1044   char *textdata = (char *) clientData;
1045   char *textptr = NULL;
1046   int i;
1047
1048   if (convertInfo == NULL)
1049     {
1050       return;
1051     }
1052
1053   if ((convertInfo->dragData->protocol != DtDND_BUFFER_TRANSFER
1054       && convertInfo->dragData->protocol != DtDND_FILENAME_TRANSFER) ||
1055      (convertInfo->reason != DtCR_DND_CONVERT_DATA))
1056     {
1057       return;
1058     }
1059
1060   for (textptr=textdata, i=0;
1061        i<convertInfo->dragData->numItems;
1062        textptr+=strlen(textptr)+1, i++)
1063     {
1064       if (convertInfo->dragData->protocol == DtDND_BUFFER_TRANSFER)
1065         {
1066           convertInfo->dragData->data.buffers[i].bp = XtNewString(textptr);
1067           convertInfo->dragData->data.buffers[i].size = strlen(textptr);
1068           convertInfo->dragData->data.buffers[i].name = NULL;
1069         }
1070       else
1071         {
1072           convertInfo->dragData->data.files[i] = XtNewString(textptr);
1073         }
1074     }
1075
1076   convertInfo->status = DtDND_SUCCESS;
1077 }
1078
1079 static Lisp_Object
1080 abort_current_drag(Lisp_Object arg)
1081 {
1082   if (CurrentDragWidget && drag_not_done)
1083     {
1084       XmDragCancel(CurrentDragWidget);
1085       CurrentDragWidget = NULL;
1086     }
1087   return arg;
1088 }
1089
1090 DEFUN ("cde-start-drag-internal", Fcde_start_drag_internal, 3, 3, 0, /*
1091 Start a CDE drag from a buffer.
1092 First argument is the event that started the drag (must be a
1093 button-press-event),
1094 second arg defines if the data should be treated as a buffer or
1095 a filename transfer (set to nil for buffer transfer),
1096 and the third argument is a list of data strings.
1097 WARNING: can only handle plain/text and file: transfers!
1098 */
1099        (event, dragtype, dragdata))
1100 {
1101   if (EVENTP (event))
1102     {
1103       struct frame *f = decode_x_frame (Fselected_frame (Qnil));
1104       XEvent x_event;
1105       Widget wid = FRAME_X_TEXT_WIDGET (f);
1106       Display *display = XtDisplayOfObject (wid);
1107       struct device *d    = get_device_from_display (display);
1108       struct x_device *xd = DEVICE_X_DATA (d);
1109       XWindowAttributes win_attrib;
1110       unsigned int modifier = 0, state = 0;
1111       char *Ctext;
1112       int numItems = 0, textlen = 0, pos = 0;
1113       Lisp_Event *lisp_event = XEVENT (event);
1114       Lisp_Object item = Qnil;
1115       struct gcpro gcpro1;
1116
1117       /* only drag if this is really a press */
1118       if (EVENT_TYPE(lisp_event) != button_press_event
1119           || !LISTP(dragdata))
1120         return Qnil;
1121
1122       GCPRO1 (item);
1123
1124       /*
1125        * not so cross hack that converts a emacs event back to a XEvent
1126        */
1127
1128       x_event.xbutton.type = ButtonPress;
1129       x_event.xbutton.send_event = False;
1130       x_event.xbutton.display = XtDisplayOfObject(wid);
1131       x_event.xbutton.window = XtWindowOfObject(wid);
1132       x_event.xbutton.root = XRootWindow(x_event.xbutton.display, 0);
1133       x_event.xbutton.subwindow = 0;
1134       x_event.xbutton.time = lisp_event->timestamp;
1135       x_event.xbutton.x = lisp_event->event.button.x;
1136       x_event.xbutton.y = lisp_event->event.button.y;
1137       if (Success == XGetWindowAttributes (x_event.xbutton.display,
1138                                            x_event.xbutton.window,
1139                                            &win_attrib))
1140         {
1141           x_event.xbutton.x_root = win_attrib.x + lisp_event->event.button.x;
1142           x_event.xbutton.y_root = win_attrib.y + lisp_event->event.button.y;
1143         }
1144       else
1145         {
1146           x_event.xbutton.x_root = lisp_event->event.button.x; /* this is wrong */
1147           x_event.xbutton.y_root = lisp_event->event.button.y;
1148         }
1149       modifier = lisp_event->event.button.modifiers;
1150       if (modifier & XEMACS_MOD_SHIFT)   state |= ShiftMask;
1151       if (modifier & XEMACS_MOD_CONTROL) state |= ControlMask;
1152       if (modifier & XEMACS_MOD_META)    state |= xd->MetaMask;
1153       if (modifier & XEMACS_MOD_SUPER)   state |= xd->SuperMask;
1154       if (modifier & XEMACS_MOD_HYPER)   state |= xd->HyperMask;
1155       if (modifier & XEMACS_MOD_ALT)     state |= xd->AltMask;
1156       state |= Button1Mask << (lisp_event->event.button.button-1);
1157
1158       x_event.xbutton.state = state;
1159       x_event.xbutton.button = lisp_event->event.button.button;
1160       x_event.xkey.same_screen = True;
1161
1162       /* convert data strings into a big string */
1163       item = dragdata;
1164       while (!NILP (item))
1165         {
1166           if (!STRINGP (XCAR (item)))
1167             {
1168               numItems=0;
1169               break;
1170             }
1171           textlen += XSTRING_LENGTH (XCAR (item)) + 1;
1172           numItems++;
1173           item = XCDR (item);
1174         }
1175
1176       if (numItems)
1177         {
1178           /*
1179            * concatenate all strings given to one large string, with
1180            * \0 as separator. List is ended by \0.
1181            */
1182           Ctext = (char *)xmalloc (textlen+1);
1183           Ctext[0] = 0;
1184
1185           item = dragdata;
1186           while (!NILP (item))
1187             {
1188               if (!STRINGP (XCAR (item)))
1189                 {
1190                   numItems=0;
1191                   xfree(Ctext);
1192                   Ctext=NULL;
1193                   break;
1194                 }
1195               strcpy (Ctext+pos, (const char *)XSTRING_DATA (XCAR (item)));
1196               pos += XSTRING_LENGTH (XCAR (item)) + 1;
1197               item = XCDR (item);
1198             }
1199           Ctext[pos] = 0;
1200
1201           dnd_convert_cb_rec[0].callback = x_cde_convert_callback;
1202           dnd_convert_cb_rec[0].closure  = (XtPointer) Ctext;
1203           dnd_convert_cb_rec[1].callback = NULL;
1204           dnd_convert_cb_rec[1].closure  = NULL;
1205
1206           dnd_destroy_cb_rec[0].callback = x_cde_destroy_callback;
1207           dnd_destroy_cb_rec[0].closure  = (XtPointer) Ctext;
1208           dnd_destroy_cb_rec[1].callback = NULL;
1209           dnd_destroy_cb_rec[1].closure  = NULL;
1210
1211           CurrentDragWidget =
1212             DtDndDragStart (wid, &x_event,
1213                             (NILP(dragtype)?DtDND_BUFFER_TRANSFER:DtDND_FILENAME_TRANSFER),
1214                             numItems,
1215                             XmDROP_COPY,
1216                             dnd_convert_cb_rec,
1217                             dnd_destroy_cb_rec,
1218                             NULL, 0);
1219         }
1220
1221       UNGCPRO;
1222
1223       return numItems?Qt:Qnil;
1224     }
1225
1226   return Qnil;
1227 }
1228
1229 static void
1230 x_cde_transfer_callback (Widget widget, XtPointer clientData,
1231                          XtPointer callData)
1232 {
1233   char *filePath, *hurl;
1234   int ii, enqueue=1;
1235   Lisp_Object frame = Qnil;
1236   Lisp_Object l_type = Qnil;
1237   Lisp_Object l_data = Qnil;
1238   DtDndTransferCallbackStruct *transferInfo = NULL;
1239   struct gcpro gcpro1, gcpro2, gcpro3;
1240
1241   /*
1242     this needs to be changed to the new protocol:
1243     - we need the button, modifier and pointer states to create a
1244       correct misc_user_event
1245     - the data must be converted to the new format (URL/MIME)
1246   */
1247   /* return; */
1248
1249   transferInfo = (DtDndTransferCallbackStruct *) callData;
1250   if (transferInfo == NULL)
1251     return;
1252
1253   GCPRO3 (frame, l_type, l_data);
1254
1255   frame = make_frame ((struct frame *) clientData);
1256
1257   if (transferInfo->dropData->protocol == DtDND_FILENAME_TRANSFER)
1258     {
1259       l_type = Qdragdrop_URL;
1260
1261       for (ii = 0; ii < transferInfo->dropData->numItems; ii++)
1262         {
1263           filePath = transferInfo->dropData->data.files[ii];
1264           hurl = dnd_url_hexify_string ((char *)filePath, "file:");
1265           /* #### Mule-izing required */
1266           l_data = Fcons (make_string ((Bufbyte* )hurl,
1267                                        strlen (hurl)),
1268                           l_data);
1269           xfree (hurl);
1270         }
1271     }
1272   else if (transferInfo->dropData->protocol == DtDND_BUFFER_TRANSFER)
1273     {
1274       int speccount = specpdl_depth();
1275
1276       /* Problem: all buffers a treated as text/plain!!!
1277          Solution: Also support DtDND_TEXT_TRANSFER
1278          perhaps implementation of the Motif protocol
1279          (which is the base of CDE) will clear this */
1280       l_type = Qdragdrop_MIME;
1281       record_unwind_protect(abort_current_drag, Qnil);
1282       drag_not_done = 1;
1283       for (ii = 0; ii < transferInfo->dropData->numItems; ii++)
1284         {
1285           /* let us forget this name thing for now... */
1286           /* filePath = transferInfo->dropData->data.buffers[ii].name;
1287              path = (filePath == NULL) ? Qnil
1288              : make_string ((Bufbyte *)filePath, strlen (filePath)); */
1289           /* what, if the data is no text, and how can I tell it? */
1290           l_data = Fcons ( list3 ( list1 ( make_string ((Bufbyte *)"text/plain", 10) ),
1291                                    make_string ((Bufbyte *)"8bit", 4),
1292                                    make_string ((Bufbyte *)transferInfo->dropData->data.buffers[ii].bp,
1293                                                 transferInfo->dropData->data.buffers[ii].size) ),
1294                            l_data );
1295         }
1296       drag_not_done = 0;
1297       unbind_to(speccount, Qnil);
1298     }
1299   else /* the other cases: NOOP_TRANSFER */
1300     enqueue=0;
1301
1302   /* The Problem: no button and mods from CDE... */
1303   if (enqueue)
1304     enqueue_misc_user_event_pos ( frame, Qdragdrop_drop_dispatch,
1305                                   Fcons (l_type, l_data),
1306                                   0 /* this is the button */,
1307                                   0 /* these are the mods */,
1308                                   transferInfo->x,
1309                                   transferInfo->y);
1310
1311   UNGCPRO;
1312   return;
1313 }
1314 #endif /* HAVE_CDE */
1315
1316 #ifdef HAVE_OFFIX_DND
1317
1318 DEFUN ("offix-start-drag-internal", Foffix_start_drag_internal, 2, 3, 0, /*
1319 Start a OffiX drag from a buffer.
1320 First arg is the event that started the drag,
1321 second arg should be some string, and the third
1322 is the type of the data (this should be an int).
1323 The type defaults to DndText (4).
1324 */
1325        (event, data, dtyp))
1326 {
1327   if (EVENTP(event))
1328     {
1329       struct frame *f = decode_x_frame (Fselected_frame (Qnil));
1330       XEvent x_event;
1331       Widget wid = FRAME_X_TEXT_WIDGET (f);
1332       Display *display = XtDisplayOfObject (wid);
1333       struct device *d    = get_device_from_display (display);
1334       struct x_device *xd = DEVICE_X_DATA (d);
1335       XWindowAttributes win_attrib;
1336       unsigned int modifier = 0, state = 0;
1337       char *dnd_data = NULL;
1338       unsigned long dnd_len = 0;
1339       int dnd_typ = DndText, dnd_dealloc = 0;
1340       Lisp_Event *lisp_event = XEVENT (event);
1341
1342       /* only drag if this is really a press */
1343       if (EVENT_TYPE(lisp_event) != button_press_event)
1344         return Qnil;
1345
1346       /* get the desired type */
1347       if (!NILP (dtyp) && INTP (dtyp))
1348         dnd_typ = XINT (dtyp);
1349
1350       if (dnd_typ == DndFiles)
1351         {
1352           Lisp_Object run = data;
1353           int len = 0;
1354
1355           if (NILP ( Flistp (data)))
1356             return Qnil;
1357
1358           /* construct the data from a list of files */
1359           dnd_len = 1;
1360           dnd_data = (char *) xmalloc (1);
1361           *dnd_data = 0;
1362           while (!NILP (run))
1363             {
1364               if (!STRINGP (XCAR (run)))
1365                 {
1366                   xfree (dnd_data);
1367                   return Qnil;
1368                 }
1369               len = XSTRING_LENGTH (XCAR (run)) + 1;
1370               dnd_data = (char *) xrealloc (dnd_data, dnd_len + len);
1371               strcpy (dnd_data + dnd_len - 1, (const char *)XSTRING_DATA (XCAR (run)));
1372               dnd_len += len;
1373               run = XCDR (run);
1374             }
1375
1376           dnd_data[dnd_len - 1] = 0; /* the list-ending zero */
1377           dnd_dealloc = 1;
1378
1379         }
1380       else
1381         {
1382           if (!STRINGP (data))
1383             return Qnil;
1384
1385           /* and what's with MULE data ??? */
1386           dnd_data = (char *)XSTRING_DATA (data);
1387           dnd_len  = XSTRING_LENGTH (data) + 1; /* the zero */
1388
1389         }
1390
1391       /* not so gross hack that converts an emacs event back to a XEvent */
1392
1393       x_event.xbutton.type = ButtonPress;
1394       x_event.xbutton.send_event = False;
1395       x_event.xbutton.display = XtDisplayOfObject(wid);
1396       x_event.xbutton.window = XtWindowOfObject(wid);
1397       x_event.xbutton.root = XRootWindow(x_event.xkey.display, 0);
1398       x_event.xbutton.subwindow = 0;
1399       x_event.xbutton.time = lisp_event->timestamp;
1400       x_event.xbutton.x = lisp_event->event.button.x;
1401       x_event.xbutton.y = lisp_event->event.button.y;
1402       if (Success == XGetWindowAttributes (x_event.xbutton.display,
1403                                            x_event.xbutton.window,
1404                                            &win_attrib))
1405         {
1406           x_event.xbutton.x_root = win_attrib.x + lisp_event->event.button.x;
1407           x_event.xbutton.y_root = win_attrib.y + lisp_event->event.button.y;
1408         }
1409       else
1410         {
1411           x_event.xbutton.x_root = lisp_event->event.button.x; /* this is wrong */
1412           x_event.xbutton.y_root = lisp_event->event.button.y;
1413         }
1414
1415       modifier = lisp_event->event.button.modifiers;
1416       if (modifier & XEMACS_MOD_SHIFT)   state |= ShiftMask;
1417       if (modifier & XEMACS_MOD_CONTROL) state |= ControlMask;
1418       if (modifier & XEMACS_MOD_META)    state |= xd->MetaMask;
1419       if (modifier & XEMACS_MOD_SUPER)   state |= xd->SuperMask;
1420       if (modifier & XEMACS_MOD_HYPER)   state |= xd->HyperMask;
1421       if (modifier & XEMACS_MOD_ALT)     state |= xd->AltMask;
1422       state |= Button1Mask << (lisp_event->event.button.button-1);
1423
1424       x_event.xbutton.state = state;
1425       x_event.xbutton.button = lisp_event->event.button.button;
1426       x_event.xkey.same_screen = True;
1427
1428       DndSetData(dnd_typ, (unsigned char *)dnd_data, dnd_len);
1429       if (dnd_dealloc)
1430         xfree (dnd_data);
1431
1432       /* the next thing blocks everything... */
1433       if (DndHandleDragging(wid, &x_event))
1434         return Qt;
1435     }
1436   return Qnil;
1437 }
1438
1439 #endif /* HAVE_OFFIX_DND */
1440
1441 \f
1442 /************************************************************************/
1443 /*                              widget creation                         */
1444 /************************************************************************/
1445
1446 /* The widget hierarchy is
1447
1448         argv[0]                 shell           container       FRAME-NAME
1449         ApplicationShell        EmacsShell      EmacsManager    EmacsFrame
1450
1451    We accept geometry specs in this order:
1452
1453         *FRAME-NAME.geometry
1454         *EmacsFrame.geometry
1455         Emacs.geometry
1456
1457    Other possibilities for widget hierarchies might be
1458
1459         argv[0]                 frame           container       FRAME-NAME
1460         ApplicationShell        EmacsShell      EmacsManager    EmacsFrame
1461    or
1462         argv[0]                 FRAME-NAME      container       FRAME-NAME
1463         ApplicationShell        EmacsShell      EmacsManager    EmacsFrame
1464    or
1465         argv[0]                 FRAME-NAME      container       emacsTextPane
1466         ApplicationShell        EmacsShell      EmacsManager    EmacsFrame
1467
1468 #ifdef EXTERNAL_WIDGET
1469    The ExternalShell widget is simply a replacement for the Shell widget
1470    which is able to deal with using an externally-supplied window instead
1471    of always creating its own.
1472 #endif
1473
1474 */
1475
1476 #ifdef EXTERNAL_WIDGET
1477
1478 static int
1479 is_valid_window (Window w, struct device *d)
1480 {
1481   XWindowAttributes xwa;
1482   Display *dpy = DEVICE_X_DISPLAY (d);
1483
1484   expect_x_error (dpy);
1485   XGetWindowAttributes (dpy, w, &xwa);
1486   return !x_error_occurred_p (dpy);
1487 }
1488
1489 #endif /* EXTERNAL_WIDGET */
1490
1491 /* This sends a synthetic mouse-motion event to the frame, if the mouse
1492    is over the frame.  This ensures that the cursor gets set properly
1493    before the user moves the mouse for the first time. */
1494
1495 static void
1496 x_send_synthetic_mouse_event (struct frame *f)
1497 {
1498   /* #### write this function. */
1499 }
1500
1501 static int
1502 first_x_frame_p (struct frame *f)
1503 {
1504   Lisp_Object rest = DEVICE_FRAME_LIST (XDEVICE (f->device));
1505   while (!NILP (rest) &&
1506          (f == XFRAME (XCAR (rest)) ||
1507           !FRAME_X_P (XFRAME (XCAR (rest)))))
1508     rest = XCDR (rest);
1509   return NILP (rest);
1510 }
1511
1512 /* Figure out what size the EmacsFrame widget should initially be,
1513    and set it.  Should be called after the default font has been
1514    determined but before the widget has been realized. */
1515
1516 static void
1517 x_initialize_frame_size (struct frame *f)
1518 {
1519   /* Geometry of the AppShell */
1520   int app_flags = 0;
1521   int app_x = 0;
1522   int app_y = 0;
1523   unsigned int app_w = 0;
1524   unsigned int app_h = 0;
1525
1526   /* Geometry of the EmacsFrame */
1527   int frame_flags = 0;
1528   int frame_x = 0;
1529   int frame_y = 0;
1530   unsigned int frame_w = 0;
1531   unsigned int frame_h = 0;
1532
1533   /* Hairily merged geometry */
1534   int x = 0;
1535   int y = 0;
1536   unsigned int w = 80;
1537   unsigned int h = 40;
1538   int flags = 0;
1539
1540   char *geom = 0, *ew_geom = 0;
1541   Boolean iconic_p = False, ew_iconic_p = False;
1542
1543   Widget wmshell = FRAME_X_SHELL_WIDGET (f);
1544   /* #### This may not be an ApplicationShell any more, with the 'popup
1545      frame property. */
1546   Widget app_shell = XtParent (wmshell);
1547   Widget ew = FRAME_X_TEXT_WIDGET (f);
1548
1549 /* set the position of the frame's root window now.  When the
1550    frame was created, the position was initialized to (0,0). */
1551   {
1552     struct window *win = XWINDOW (f->root_window);
1553
1554     WINDOW_LEFT (win) = FRAME_LEFT_BORDER_END (f)
1555       + FRAME_LEFT_GUTTER_BOUNDS (f);
1556     WINDOW_TOP (win) = FRAME_TOP_BORDER_END (f)
1557       + FRAME_TOP_GUTTER_BOUNDS (f);
1558
1559     if (!NILP (f->minibuffer_window))
1560       {
1561         win = XWINDOW (f->minibuffer_window);
1562         WINDOW_LEFT (win) = FRAME_LEFT_BORDER_END (f)
1563           + FRAME_LEFT_GUTTER_BOUNDS (f);
1564       }
1565   }
1566
1567 #ifdef EXTERNAL_WIDGET
1568   /* If we're an external widget, then the size of the frame is predetermined
1569      (by the client) and is not our decision to make. */
1570   if (FRAME_X_EXTERNAL_WINDOW_P (f))
1571     return;
1572 #endif
1573
1574 #if 0
1575   /* #### this junk has not been tested; therefore it's
1576      probably wrong.  Doesn't really matter at this point because
1577      currently all frames are either top-level or external widgets. */
1578
1579   /* If we're not our own top-level window, then we shouldn't go messing around
1580      with top-level shells or "Emacs.geometry" or any such stuff.  Therefore,
1581      we do as follows to determine the size of the frame:
1582
1583      1) If a value for the frame's "geometry" resource was specified, then
1584         use it.  (This specifies a size in characters.)
1585      2) Else, if the "width" and "height" resources were specified, then
1586         leave them alone.  (This is a value in pixels.  Sorry, we can't break
1587         Xt conventions here.)
1588      3) Else, assume a size of 64x12.  (This is somewhat arbitrary, but
1589         it's unlikely that a size of 80x40 is desirable because we're probably
1590         inside of a dialog box.)
1591
1592      Set the widget's x, y, height, and width as determined.  Don't set the
1593      top-level container widget, because we don't necessarily know what it
1594      is. (Assume it is smart and pays attention to our values.)
1595   */
1596
1597   if (!FRAME_X_TOP_LEVEL_FRAME_P (f))
1598     {
1599       Xt_GET_VALUE (ew, XtNgeometry, &ew_geom);
1600       if (ew_geom)
1601         frame_flags = XParseGeometry (ew_geom,
1602                                       &frame_x, &frame_y,
1603                                       &frame_w, &frame_h);
1604       if (! (frame_flags & (WidthValue | HeightValue)))
1605         {
1606           Arg al[2];
1607           XtSetArg (al [0], XtNwidth,  &frame_w);
1608           XtSetArg (al [1], XtNheight, &frame_h);
1609           XtGetValues (ew, al, 2);
1610           if (!frame_w && !frame_h)
1611             {
1612               frame_w = 64;
1613               frame_h = 12;
1614               frame_flags |= WidthValue | HeightValue;
1615             }
1616         }
1617       if (frame_flags & (WidthValue | HeightValue))
1618         EmacsFrameSetCharSize (ew, frame_w, frame_h);
1619       if (frame_flags & (XValue | YValue))
1620         {
1621           Arg al[2];
1622           XtSetArg (al [0], XtNwidth,  &frame_w);
1623           XtSetArg (al [1], XtNheight, &frame_h);
1624           XtGetValues (ew, al, 2);
1625
1626           if (frame_flags & XNegative)
1627             frame_x += frame_w;
1628           if (frame_flags & YNegative)
1629             frame_y += frame_h;
1630
1631           XtSetArg (al [0], XtNx, frame_x);
1632           XtSetArg (al [1], XtNy, frame_y);
1633           XtSetValues (ew, al, 2);
1634         }
1635       return;
1636     }
1637 #endif
1638
1639   /* OK, we're a top-level shell. */
1640
1641   if (!XtIsWMShell (wmshell))
1642     abort ();
1643
1644   /* If the EmacsFrame doesn't have a geometry but the shell does,
1645      treat that as the geometry of the frame.
1646      (Is this bogus? I'm not sure.) */
1647
1648   Xt_GET_VALUE (ew, XtNgeometry, &ew_geom);
1649   if (!ew_geom)
1650     {
1651       Xt_GET_VALUE (wmshell, XtNgeometry, &geom);
1652       if (geom)
1653         {
1654           ew_geom = geom;
1655           Xt_SET_VALUE (ew, XtNgeometry, ew_geom);
1656         }
1657     }
1658
1659   /* If the Shell is iconic, then the EmacsFrame is iconic.
1660      (Is this bogus? I'm not sure.) */
1661   Xt_GET_VALUE (ew, XtNiconic, &ew_iconic_p);
1662   if (!ew_iconic_p)
1663     {
1664       Xt_GET_VALUE (wmshell, XtNiconic, &iconic_p);
1665       if (iconic_p)
1666         {
1667           ew_iconic_p = iconic_p;
1668           Xt_SET_VALUE (ew, XtNiconic, iconic_p);
1669         }
1670     }
1671
1672   Xt_GET_VALUE (app_shell, XtNgeometry, &geom);
1673   if (geom)
1674     app_flags = XParseGeometry (geom, &app_x, &app_y, &app_w, &app_h);
1675
1676   if (ew_geom)
1677     frame_flags = XParseGeometry (ew_geom,
1678                                   &frame_x, &frame_y,
1679                                   &frame_w, &frame_h);
1680
1681   if (first_x_frame_p (f))
1682     {
1683       /* If this is the first frame created:
1684          ====================================
1685
1686          - Use the ApplicationShell's size/position, if specified.
1687            (This is "Emacs.geometry", or the "-geometry" command line arg.)
1688          - Else use the EmacsFrame's size/position.
1689            (This is "*FRAME-NAME.geometry")
1690
1691          - If the AppShell is iconic, the frame should be iconic.
1692
1693          AppShell comes first so that -geometry always applies to the first
1694          frame created, even if there is an "every frame" entry in the
1695          resource database.
1696        */
1697       if (app_flags & (XValue | YValue))
1698         {
1699           x = app_x; y = app_y;
1700           flags |= (app_flags & (XValue | YValue | XNegative | YNegative));
1701         }
1702       else if (frame_flags & (XValue | YValue))
1703         {
1704           x = frame_x; y = frame_y;
1705           flags |= (frame_flags & (XValue | YValue | XNegative | YNegative));
1706         }
1707
1708       if (app_flags & (WidthValue | HeightValue))
1709         {
1710           w = app_w; h = app_h;
1711           flags |= (app_flags & (WidthValue | HeightValue));
1712         }
1713       else if (frame_flags & (WidthValue | HeightValue))
1714         {
1715           w = frame_w; h = frame_h;
1716           flags |= (frame_flags & (WidthValue | HeightValue));
1717         }
1718
1719       /* If the AppShell is iconic, then the EmacsFrame is iconic. */
1720       if (!ew_iconic_p)
1721         {
1722           Xt_GET_VALUE (app_shell, XtNiconic, &iconic_p);
1723           if (iconic_p)
1724             {
1725               ew_iconic_p = iconic_p;
1726               Xt_SET_VALUE (ew, XtNiconic, iconic_p);
1727             }
1728         }
1729     }
1730   else
1731     {
1732       /* If this is not the first frame created:
1733          ========================================
1734
1735          - use the EmacsFrame's size/position if specified
1736          - Otherwise, use the ApplicationShell's size, but not position.
1737
1738          So that means that one can specify the position of the first frame
1739          with "Emacs.geometry" or `-geometry'; but can only specify the
1740          position of subsequent frames with "*FRAME-NAME.geometry".
1741
1742          AppShell comes second so that -geometry does not apply to subsequent
1743          frames when there is an "every frame" entry in the resource db,
1744          but does apply to the first frame.
1745        */
1746       if (frame_flags & (XValue | YValue))
1747         {
1748           x = frame_x; y = frame_y;
1749           flags |= (frame_flags & (XValue | YValue | XNegative | YNegative));
1750         }
1751
1752       if (frame_flags & (WidthValue | HeightValue))
1753         {
1754           w = frame_w; h = frame_h;
1755           flags |= (frame_flags & (WidthValue | HeightValue));
1756         }
1757       else if (app_flags & (WidthValue | HeightValue))
1758         {
1759           w = app_w;
1760           h = app_h;
1761           flags |= (app_flags & (WidthValue | HeightValue));
1762         }
1763     }
1764
1765   x_set_initial_frame_size (f, flags, x, y, w, h);
1766 }
1767
1768 static void
1769 x_get_layout_sizes (struct frame *f, Dimension *topbreadth)
1770 {
1771   int i;
1772
1773   /* compute height of all top-area widgets */
1774   for (i=0, *topbreadth = 0; i<FRAME_X_NUM_TOP_WIDGETS (f); i++)
1775     {
1776       Widget wid = FRAME_X_TOP_WIDGETS (f)[i];
1777       if (wid && XtIsManaged (wid))
1778         *topbreadth += wid->core.height + 2*wid->core.border_width;
1779     }
1780 }
1781
1782 static void
1783 x_layout_widgets (Widget w, XtPointer client_data, XtPointer call_data)
1784 {
1785   struct frame *f = (struct frame *) client_data;
1786   EmacsManagerResizeStruct *emst = (EmacsManagerResizeStruct *) call_data;
1787   Dimension width = emst->width;
1788   Dimension height = emst->height;
1789   Widget text = FRAME_X_TEXT_WIDGET (f);
1790   Dimension textbord = text->core.border_width;
1791   Dimension topbreadth;
1792   Position text_x = 0, text_y = 0;
1793   int i;
1794
1795   x_get_layout_sizes (f, &topbreadth);
1796
1797   /* first the menubar and psheets ... */
1798   for (i=0; i<FRAME_X_NUM_TOP_WIDGETS (f); i++)
1799     {
1800       Widget wid = FRAME_X_TOP_WIDGETS (f)[i];
1801       if (wid && XtIsManaged (wid))
1802         {
1803           Dimension bord = wid->core.border_width;
1804           XtConfigureWidget (wid, 0, text_y,
1805                              width - 2*bord, wid->core.height,
1806                              bord);
1807           text_y += wid->core.height + 2*bord;
1808         }
1809     }
1810
1811 #ifdef HAVE_SCROLLBARS
1812   f->scrollbar_y_offset = topbreadth + textbord;
1813 #endif
1814
1815   /* finally the text area */
1816   XtConfigureWidget (text, text_x, text_y,
1817                      width - 2*textbord,
1818                      height - text_y - 2*textbord,
1819                      textbord);
1820 }
1821
1822 static void
1823 x_do_query_geometry (Widget w, XtPointer client_data, XtPointer call_data)
1824 {
1825   struct frame *f = (struct frame *) client_data;
1826   EmacsManagerQueryGeometryStruct *emst =
1827     (EmacsManagerQueryGeometryStruct *) call_data;
1828   Widget text = FRAME_X_TEXT_WIDGET (f);
1829   Dimension textbord = text->core.border_width;
1830   Dimension topbreadth;
1831   XtWidgetGeometry req, repl;
1832   int mask = emst->request_mode & (CWWidth | CWHeight);
1833
1834   x_get_layout_sizes (f, &topbreadth);
1835
1836   /* Strip away menubar from suggested size, and ask the text widget
1837      what size it wants to be.  */
1838   req.request_mode = mask;
1839   if (mask & CWWidth)
1840     req.width = emst->proposed_width - 2*textbord;
1841   if (mask & CWHeight)
1842     req.height = emst->proposed_height - topbreadth - 2*textbord;
1843   XtQueryGeometry (text, &req, &repl);
1844
1845   /* Now add the menubar back again */
1846   emst->proposed_width  = repl.width  + 2*textbord;
1847   emst->proposed_height = repl.height + topbreadth + 2*textbord;
1848 }
1849
1850 /* Creates the widgets for a frame.
1851    lisp_window_id is a Lisp description of an X window or Xt
1852    widget to parse.
1853
1854    This function does not create or map the windows.  (That is
1855    done by x_popup_frame().)
1856  */
1857 static void
1858 x_create_widgets (struct frame *f, Lisp_Object lisp_window_id,
1859                   Lisp_Object parent)
1860 {
1861   struct device *d = XDEVICE (f->device);
1862   Visual *visual = DEVICE_X_VISUAL (d);
1863   int depth = DEVICE_X_DEPTH (d);
1864   Colormap cmap = DEVICE_X_COLORMAP (d);
1865 #ifdef EXTERNAL_WIDGET
1866   Window window_id = 0;
1867 #endif
1868   const char *name;
1869   Arg al [25];
1870   int ac = 0;
1871   Widget text, container, shell;
1872   Widget parentwid = 0;
1873 #ifdef HAVE_MENUBARS
1874   int menubar_visible;
1875   Widget menubar;
1876 #endif
1877
1878   if (STRINGP (f->name))
1879     TO_EXTERNAL_FORMAT (LISP_STRING, f->name,
1880                         C_STRING_ALLOCA, name,
1881                         Qctext);
1882   else
1883     name = "emacs";
1884
1885   /* The widget hierarchy is
1886
1887         argv[0]                 shell           pane            FRAME-NAME
1888         ApplicationShell        EmacsShell      EmacsManager    EmacsFrame
1889
1890         (the type of the shell is ExternalShell if this frame is running
1891         in another client's window)
1892
1893         However the EmacsShell widget has WM_CLASS of FRAME-NAME/Emacs.
1894         Normally such shells have name/class shellname/appclass, which in this
1895         case would be "shell/Emacs" instead of "frame-name/Emacs".  We could
1896         also get around this by naming the shell "frame-name", but that would
1897         be confusing because the text area (the EmacsFrame widget inferior of
1898         the shell) is also called that.  So we just set the WM_CLASS property.
1899    */
1900
1901 #ifndef EXTERNAL_WIDGET
1902   if (!NILP (lisp_window_id))
1903     error ("support for external widgets was not enabled at compile-time");
1904 #else
1905   if (!NILP (lisp_window_id))
1906     {
1907       char *string;
1908
1909       CHECK_STRING (lisp_window_id);
1910       string = (char *) XSTRING_DATA (lisp_window_id);
1911       if (string[0] == '0' && (string[1] == 'x' || string[1] == 'X'))
1912         sscanf (string+2, "%lxu", &window_id);
1913 #if 0
1914       else if (string[0] == 'w')
1915         {
1916           sscanf (string+1, "%x", &parent_widget);
1917           if (parent_widget)
1918             window_id = XtWindow (parent_widget);
1919         }
1920 #endif
1921       else
1922         sscanf (string, "%lu", &window_id);
1923       if (!is_valid_window (window_id, d))
1924         error ("Invalid window %lu", (unsigned long) window_id);
1925       FRAME_X_EXTERNAL_WINDOW_P (f) = 1;
1926     } else
1927 #endif /* EXTERNAL_WIDGET */
1928       FRAME_X_TOP_LEVEL_FRAME_P (f) = 1;
1929
1930   ac = 0;
1931   XtSetArg (al[ac], XtNallowShellResize, True); ac++;
1932 #ifdef LWLIB_USES_MOTIF
1933   /* Motif sucks beans.  Without this in here, it will delete the window
1934      out from under us when it receives a WM_DESTROY_WINDOW message
1935      from the WM. */
1936   XtSetArg (al[ac], XmNdeleteResponse, XmDO_NOTHING); ac++;
1937 #endif
1938
1939 #ifdef EXTERNAL_WIDGET
1940   if (window_id)
1941     {
1942       XtSetArg (al[ac], XtNwindow, window_id); ac++;
1943     }
1944   else
1945 #endif /* EXTERNAL_WIDGET */
1946     {
1947       XtSetArg (al[ac], XtNinput, True);       ac++;
1948       XtSetArg (al[ac], XtNminWidthCells, 10); ac++;
1949       XtSetArg (al[ac], XtNminHeightCells, 1); ac++;
1950       XtSetArg (al[ac], XtNvisual, visual);    ac++;
1951       XtSetArg (al[ac], XtNdepth, depth);      ac++;
1952       XtSetArg (al[ac], XtNcolormap, cmap);    ac++;
1953     }
1954
1955   if (!NILP (parent))
1956     {
1957       parentwid = FRAME_X_SHELL_WIDGET (XFRAME (parent));
1958       XtSetArg (al[ac], XtNtransientFor, parentwid); ac++;
1959     }
1960
1961   shell = XtCreatePopupShell ("shell",
1962                               (
1963 #ifdef EXTERNAL_WIDGET
1964                                window_id ? externalShellWidgetClass :
1965 #endif
1966                                parentwid ? transientEmacsShellWidgetClass :
1967                                topLevelEmacsShellWidgetClass
1968                                ),
1969                               parentwid ? parentwid :
1970                               DEVICE_XT_APP_SHELL (d),
1971                               al, ac);
1972   FRAME_X_SHELL_WIDGET (f) = shell;
1973   maybe_set_frame_title_format (shell);
1974
1975   /* Create the manager widget */
1976   ac = 0;
1977   XtSetArg (al[ac], XtNvisual, visual); ac++;
1978   XtSetArg (al[ac], XtNdepth, depth); ac++;
1979   XtSetArg (al[ac], XtNcolormap, cmap); ac++;
1980
1981   container = XtCreateWidget ("container",
1982                               emacsManagerWidgetClass, shell, al, ac);
1983   FRAME_X_CONTAINER_WIDGET (f) = container;
1984   XtAddCallback (container, XtNresizeCallback, x_layout_widgets,
1985                  (XtPointer) f);
1986   XtAddCallback (container, XtNqueryGeometryCallback, x_do_query_geometry,
1987                  (XtPointer) f);
1988
1989   /* Create the text area */
1990   ac = 0;
1991   XtSetArg (al[ac], XtNvisual, visual); ac++;
1992   XtSetArg (al[ac], XtNdepth, depth); ac++;
1993   XtSetArg (al[ac], XtNcolormap, cmap); ac++;
1994   XtSetArg (al[ac], XtNborderWidth, 0); ac++; /* should this be settable? */
1995   XtSetArg (al[ac], XtNemacsFrame,  f); ac++;
1996   text = XtCreateWidget (name, emacsFrameClass, container, al, ac);
1997   FRAME_X_TEXT_WIDGET (f) = text;
1998
1999 #ifdef HAVE_MENUBARS
2000   /* Create the initial menubar widget. */
2001   menubar_visible = x_initialize_frame_menubar (f);
2002   FRAME_X_TOP_WIDGETS (f)[0] = menubar = FRAME_X_MENUBAR_WIDGET (f);
2003   FRAME_X_NUM_TOP_WIDGETS (f) = 1;
2004
2005   if (menubar_visible)
2006     XtManageChild (menubar);
2007 #endif /* HAVE_MENUBARS */
2008   XtManageChild (text);
2009   XtManageChild (container);
2010 }
2011
2012 /* We used to call XtPopup() in x_popup_frame, but that doesn't give
2013    you control over whether the widget is initially mapped or not
2014    because XtPopup() makes an unconditional call to XMapRaised().
2015    Boy, those Xt designers were clever.
2016
2017    When we first removed it we only kept the XtRealizeWidget call in
2018    XtPopup.  For everything except HP's that was enough.  For HP's,
2019    though, the failure to call the popup callbacks resulted in XEmacs
2020    not accepting any input.  Bizarre but true.  Stupid but true.
2021
2022    So, in case there are any other gotchas floating out there along
2023    the same lines I've duplicated the majority of XtPopup here.  It
2024    assumes no grabs and that the widget is not already popped up, both
2025    valid assumptions for the one place this is called from. */
2026 static void
2027 xemacs_XtPopup (Widget widget)
2028 {
2029   ShellWidget shell_widget = (ShellWidget) widget;
2030   XtGrabKind call_data = XtGrabNone;
2031
2032   XtCallCallbacks (widget, XtNpopupCallback, (XtPointer)&call_data);
2033
2034   shell_widget->shell.popped_up = TRUE;
2035   shell_widget->shell.grab_kind = XtGrabNone;
2036   shell_widget->shell.spring_loaded = False;
2037
2038   if (shell_widget->shell.create_popup_child_proc != NULL)
2039     (*(shell_widget->shell.create_popup_child_proc))(widget);
2040
2041   /* The XtSetValues below are not in XtPopup menu.  We just want to
2042      make absolutely sure... */
2043   Xt_SET_VALUE (widget, XtNmappedWhenManaged, False);
2044   XtRealizeWidget (widget);
2045   Xt_SET_VALUE (widget, XtNmappedWhenManaged, True);
2046 }
2047
2048 /* create the windows for the specified frame and display them.
2049    Note that the widgets have already been created, and any
2050    necessary geometry calculations have already been done. */
2051 static void
2052 x_popup_frame (struct frame *f)
2053 {
2054   Widget shell_widget = FRAME_X_SHELL_WIDGET (f);
2055   Widget frame_widget = FRAME_X_TEXT_WIDGET (f);
2056   struct device *d = XDEVICE (FRAME_DEVICE (f));
2057
2058   /* Before mapping the window, make sure that the WMShell's notion of
2059      whether it should be iconified is synchronized with the EmacsFrame's
2060      notion.
2061      */
2062   if (FRAME_X_TOP_LEVEL_FRAME_P (f))
2063     x_wm_set_shell_iconic_p (shell_widget,
2064                              ((EmacsFrame) frame_widget)
2065                              ->emacs_frame.iconic);
2066
2067   xemacs_XtPopup (shell_widget);
2068
2069   if (!((EmacsFrame) frame_widget)->emacs_frame.initially_unmapped)
2070     XtMapWidget (shell_widget);
2071   else
2072     {
2073       /* We may have set f->visible to 1 in x_init_frame(), so undo
2074          that now. */
2075       FRAME_X_TOTALLY_VISIBLE_P (f) = 0;
2076       f->visible = 0;
2077     }
2078
2079 #ifdef EXTERNAL_WIDGET
2080   if (FRAME_X_EXTERNAL_WINDOW_P (f))
2081     ExternalShellReady (shell_widget, XtWindow (frame_widget), KeyPressMask);
2082   else
2083 #endif
2084     if (FRAME_X_TOP_LEVEL_FRAME_P (f))
2085       {
2086         /* tell the window manager about us. */
2087         x_wm_store_class_hints (shell_widget, XtName (frame_widget));
2088
2089 #ifndef HAVE_WMCOMMAND
2090         x_wm_maybe_store_wm_command (f);
2091 #endif /* HAVE_WMCOMMAND */
2092
2093         x_wm_hack_wm_protocols (shell_widget);
2094       }
2095
2096 #ifdef HAVE_XIM
2097   XIM_init_frame (f);
2098 #endif /* HAVE_XIM */
2099
2100 #ifdef HACK_EDITRES
2101   /* Allow XEmacs to respond to EditRes requests.  See the O'Reilly Xt */
2102   /* Intrinsics Programming Manual, Motif Edition, Aug 1993, Sect 14.14, */
2103   /* pp. 483-493. */
2104   XtAddEventHandler (shell_widget,           /* the shell widget in question */
2105                      (EventMask) NoEventMask,/* OR with existing mask */
2106                      True,                   /* called on non-maskable events? */
2107                      (XtEventHandler) _XEditResCheckMessages, /* the handler */
2108                      NULL);
2109 #endif /* HACK_EDITRES */
2110
2111 #ifdef HAVE_CDE
2112   {
2113     XtCallbackRec dnd_transfer_cb_rec[2];
2114
2115     dnd_transfer_cb_rec[0].callback = x_cde_transfer_callback;
2116     dnd_transfer_cb_rec[0].closure = (XtPointer) f;
2117     dnd_transfer_cb_rec[1].callback = NULL;
2118     dnd_transfer_cb_rec[1].closure = NULL;
2119
2120     DtDndVaDropRegister (FRAME_X_TEXT_WIDGET (f),
2121                          DtDND_FILENAME_TRANSFER | DtDND_BUFFER_TRANSFER,
2122                          XmDROP_COPY, dnd_transfer_cb_rec,
2123                          DtNtextIsBuffer, True,
2124                          DtNregisterChildren, True,
2125                          DtNpreserveRegistration, False,
2126                          NULL);
2127   }
2128 #endif /* HAVE_CDE */
2129
2130   /* Do a stupid property change to force the server to generate a
2131      propertyNotify event so that the event_stream server timestamp will
2132      be initialized to something relevant to the time we created the window.
2133      */
2134   XChangeProperty (XtDisplay (frame_widget), XtWindow (frame_widget),
2135                    DEVICE_XATOM_WM_PROTOCOLS (d), XA_ATOM, 32, PropModeAppend,
2136                    (unsigned char*) NULL, 0);
2137
2138   x_send_synthetic_mouse_event (f);
2139 }
2140
2141 static void
2142 allocate_x_frame_struct (struct frame *f)
2143 {
2144   /* zero out all slots. */
2145   f->frame_data = xnew_and_zero (struct x_frame);
2146
2147   /* yeah, except the lisp ones */
2148   FRAME_X_ICON_PIXMAP (f) = Qnil;
2149   FRAME_X_ICON_PIXMAP_MASK (f) = Qnil;
2150 }
2151
2152 \f
2153 /************************************************************************/
2154 /*                              Lisp functions                          */
2155 /************************************************************************/
2156
2157 static void
2158 x_init_frame_1 (struct frame *f, Lisp_Object props)
2159 {
2160   /* This function can GC */
2161   Lisp_Object device = FRAME_DEVICE (f);
2162   Lisp_Object lisp_window_id = Fplist_get (props, Qwindow_id, Qnil);
2163   Lisp_Object popup = Fplist_get (props, Qpopup, Qnil);
2164
2165   if (!NILP (popup))
2166     {
2167       if (EQ (popup, Qt))
2168         popup = Fselected_frame (device);
2169       CHECK_LIVE_FRAME (popup);
2170       if (!EQ (device, FRAME_DEVICE (XFRAME (popup))))
2171         signal_simple_error_2 ("Parent must be on same device as frame",
2172                                device, popup);
2173     }
2174
2175   /*
2176    * Previously we set this only if NILP (DEVICE_SELECTED_FRAME (d))
2177    * to make sure that messages were displayed as soon as possible
2178    * if we're creating the first frame on a device.  But it is
2179    * better to just set this all the time, so that when a new frame
2180    * is created that covers the selected frame, echo area status
2181    * messages can still be seen.  f->visible is reset later if the
2182    * initially-unmapped property is found to be non-nil in the
2183    * frame properties.
2184    */
2185   f->visible = 1;
2186
2187   allocate_x_frame_struct (f);
2188   x_create_widgets (f, lisp_window_id, popup);
2189 }
2190
2191 static void
2192 x_init_frame_2 (struct frame *f, Lisp_Object props)
2193 {
2194   /* Set up the values of the widget/frame.  A case could be made for putting
2195      this inside of the widget's initialize method. */
2196
2197   update_frame_face_values (f);
2198   x_initialize_frame_size (f);
2199   /* Kyle:
2200    *   update_frame_title() can't be done here, because some of the
2201    *   modeline specs depend on the frame's device having a selected
2202    *   frame, and that may not have been set up yet.  The redisplay
2203    *   will update the frame title anyway, so nothing is lost.
2204    * JV:
2205    *   It turns out it gives problems with FVWMs name based mapping.
2206    *   We'll just  need to be careful in the modeline specs.
2207    */
2208   update_frame_title (f);
2209 }
2210
2211 static void
2212 x_init_frame_3 (struct frame *f)
2213 {
2214   /* Pop up the frame. */
2215
2216   x_popup_frame (f);
2217 }
2218
2219 static void
2220 x_mark_frame (struct frame *f)
2221 {
2222   mark_object (FRAME_X_ICON_PIXMAP (f));
2223   mark_object (FRAME_X_ICON_PIXMAP_MASK (f));
2224 }
2225
2226 static void
2227 x_set_frame_icon (struct frame *f)
2228 {
2229   Pixmap x_pixmap, x_mask;
2230
2231   if (IMAGE_INSTANCEP (f->icon)
2232       && IMAGE_INSTANCE_PIXMAP_TYPE_P (XIMAGE_INSTANCE (f->icon)))
2233     {
2234       x_pixmap = XIMAGE_INSTANCE_X_PIXMAP (f->icon);
2235       x_mask = XIMAGE_INSTANCE_X_MASK (f->icon);
2236     }
2237   else
2238     {
2239       x_pixmap = 0;
2240       x_mask = 0;
2241     }
2242
2243   /* Store the X data into the widget. */
2244   {
2245     Arg al [2];
2246     XtSetArg (al [0], XtNiconPixmap, x_pixmap);
2247     XtSetArg (al [1], XtNiconMask,   x_mask);
2248     XtSetValues (FRAME_X_SHELL_WIDGET (f), al, 2);
2249   }
2250 }
2251
2252 static void
2253 x_set_frame_pointer (struct frame *f)
2254 {
2255   XDefineCursor (XtDisplay (FRAME_X_TEXT_WIDGET (f)),
2256                  XtWindow (FRAME_X_TEXT_WIDGET (f)),
2257                  XIMAGE_INSTANCE_X_CURSOR (f->pointer));
2258   XSync (XtDisplay (FRAME_X_TEXT_WIDGET (f)), 0);
2259 }
2260
2261 static Lisp_Object
2262 x_get_frame_parent (struct frame *f)
2263 {
2264   Widget parentwid = 0;
2265
2266   Xt_GET_VALUE (FRAME_X_SHELL_WIDGET (f), XtNtransientFor, &parentwid);
2267   /* find the frame whose wid is parentwid */
2268   if (parentwid)
2269     {
2270       Lisp_Object frmcons;
2271       DEVICE_FRAME_LOOP (frmcons, XDEVICE (FRAME_DEVICE (f)))
2272         {
2273           Lisp_Object frame = XCAR (frmcons);
2274           if (FRAME_X_SHELL_WIDGET (XFRAME (frame)) == parentwid)
2275             return frame;
2276         }
2277     }
2278   return Qnil;
2279 }
2280
2281 DEFUN ("x-window-id", Fx_window_id, 0, 1, 0, /*
2282 Get the ID of the X11 window.
2283 This gives us a chance to manipulate the Emacs window from within a
2284 different program.  Since the ID is an unsigned long, we return it as
2285 a string.
2286 */
2287        (frame))
2288 {
2289   char str[255];
2290   struct frame *f = decode_x_frame (frame);
2291
2292   sprintf (str, "%lu", XtWindow (FRAME_X_TEXT_WIDGET (f)));
2293   return build_string (str);
2294 }
2295
2296 \f
2297 /************************************************************************/
2298 /*                      manipulating the X window                       */
2299 /************************************************************************/
2300
2301 static void
2302 x_set_frame_position (struct frame *f, int xoff, int yoff)
2303 {
2304   Widget w = FRAME_X_SHELL_WIDGET (f);
2305   Display *dpy = XtDisplay (w);
2306   Dimension frame_w = DisplayWidth  (dpy, DefaultScreen (dpy));
2307   Dimension frame_h = DisplayHeight (dpy, DefaultScreen (dpy));
2308   Dimension shell_w, shell_h, shell_bord;
2309   int win_gravity;
2310   Arg al [3];
2311
2312   XtSetArg (al [0], XtNwidth,       &shell_w);
2313   XtSetArg (al [1], XtNheight,      &shell_h);
2314   XtSetArg (al [2], XtNborderWidth, &shell_bord);
2315   XtGetValues (w, al, 3);
2316
2317   win_gravity =
2318     xoff >= 0 && yoff >= 0 ? NorthWestGravity :
2319     xoff >= 0 ? SouthWestGravity :
2320     yoff >= 0 ? NorthEastGravity :
2321     SouthEastGravity;
2322   if (xoff < 0)
2323     xoff += frame_w - shell_w - 2*shell_bord;
2324   if (yoff < 0)
2325     yoff += frame_h - shell_h - 2*shell_bord;
2326
2327   /* Update the hints so that, if this window is currently iconified, it will
2328      come back at the right place.  We can't look at s->visible to determine
2329      whether it is iconified because it might not be up-to-date yet (the queue
2330      might not be processed). */
2331   XtSetArg (al [0], XtNwinGravity, win_gravity);
2332   XtSetArg (al [1], XtNx, xoff);
2333   XtSetArg (al [2], XtNy, yoff);
2334   XtSetValues (w, al, 3);
2335
2336   /* Sometimes you will find that
2337
2338      (set-frame-position (selected-frame) -50 -50)
2339
2340      doesn't put the frame where you expect it to: i.e. it's closer to
2341      the lower-right corner than it should be, and it appears that the
2342      size of the WM decorations was not taken into account.  This is
2343      *not* a problem with this function.  Both mwm and twm have bugs
2344      in handling this situation. (mwm ignores the window gravity and
2345      always assumes NorthWest, except the first time you map the
2346      window; twm gets things almost right, but forgets to account for
2347      the border width of the top-level window.) This function does
2348      what it's supposed to according to the ICCCM, and I'm not about
2349      to hack around window-manager bugs. */
2350
2351 #if 0
2352   /* This is not necessary under either mwm or twm */
2353   x_wm_mark_shell_position_user_specified (w);
2354 #endif
2355 }
2356
2357 /* Call this to change the size of frame S's x-window. */
2358
2359 static void
2360 x_set_frame_size (struct frame *f, int cols, int rows)
2361 {
2362   EmacsFrameSetCharSize (FRAME_X_TEXT_WIDGET (f), cols, rows);
2363 #if 0
2364     /* this is not correct.  x_set_frame_size() is called from
2365        Fset_frame_size(), which may or may not have been called
2366        by the user (e.g. update_EmacsFrame() calls it when the font
2367        changes).  For now, don't bother with getting this right. */
2368   x_wm_mark_shell_size_user_specified (FRAME_X_SHELL_WIDGET (f));
2369 #endif
2370 }
2371
2372 static void
2373 x_set_mouse_position (struct window *w, int x, int y)
2374 {
2375   struct frame *f = XFRAME (w->frame);
2376
2377   Display *display = DEVICE_X_DISPLAY (XDEVICE (f->device));
2378   XWarpPointer (display, None, XtWindow (FRAME_X_TEXT_WIDGET (f)),
2379                 0, 0, 0, 0, w->pixel_left + x, w->pixel_top + y);
2380 }
2381
2382 static int
2383 x_get_mouse_position (struct device *d, Lisp_Object *frame, int *x, int *y)
2384 {
2385   Display *display = DEVICE_X_DISPLAY (d);
2386   Window child_window;
2387   Window root_window;
2388   Window win;
2389   int root_x, root_y;
2390   int win_x, win_y;
2391   unsigned int keys_and_buttons;
2392   struct frame *f;
2393
2394   if (XQueryPointer (display, RootWindow (display, DefaultScreen (display)),
2395                      &root_window, &child_window, &root_x, &root_y,
2396                      &win_x, &win_y, &keys_and_buttons) == False)
2397     return 0;
2398
2399   if (child_window == None)
2400     return 0;   /* not over any window. */
2401
2402   while (1)
2403     {
2404       win = child_window;
2405       if (XTranslateCoordinates (display, root_window, win, root_x, root_y,
2406                                  &win_x, &win_y, &child_window) == False)
2407         /* Huh? */
2408         return 0;
2409
2410       if (child_window == None)
2411         break;
2412     }
2413
2414   /* At this point, win is the innermost window containing the pointer
2415      and win_x and win_y are the coordinates of that window. */
2416   f = x_any_window_to_frame (d, win);
2417   if (!f)
2418     return 0;
2419   XSETFRAME (*frame, f);
2420
2421   if (XTranslateCoordinates (display, win,
2422                              XtWindow (FRAME_X_TEXT_WIDGET (f)),
2423                              win_x, win_y, x, y, &child_window) == False)
2424     /* Huh? */
2425     return 0;
2426
2427   return 1;
2428 }
2429
2430 static void
2431 x_cant_notify_wm_error (void)
2432 {
2433   error ("Can't notify window manager of iconification.");
2434 }
2435
2436 /* Raise frame F.  */
2437 static void
2438 x_raise_frame_1 (struct frame *f, int force)
2439 {
2440   if (FRAME_VISIBLE_P (f) || force)
2441     {
2442       Widget bottom_dialog;
2443       XWindowChanges xwc;
2444       unsigned int flags;
2445       Display *display = DEVICE_X_DISPLAY (XDEVICE (f->device));
2446       Window emacs_window = XtWindow (FRAME_X_SHELL_WIDGET (f));
2447
2448       /* first raises all the dialog boxes, then put emacs just below the
2449        * bottom most dialog box */
2450       bottom_dialog = lw_raise_all_pop_up_widgets ();
2451       if (bottom_dialog && XtWindow (bottom_dialog))
2452         {
2453           xwc.sibling = XtWindow (bottom_dialog);
2454           xwc.stack_mode = Below;
2455           flags = CWSibling | CWStackMode;
2456         }
2457       else
2458         {
2459           xwc.stack_mode = Above;
2460           flags = CWStackMode;
2461         }
2462
2463       if (!XReconfigureWMWindow (display, emacs_window,
2464                                  DefaultScreen (display),
2465                                  flags, &xwc))
2466         x_cant_notify_wm_error ();
2467     }
2468 }
2469
2470 static void
2471 x_raise_frame (struct frame *f)
2472 {
2473   x_raise_frame_1 (f, 1);
2474 }
2475
2476 /* Lower frame F.  */
2477 static void
2478 x_lower_frame (struct frame *f)
2479 {
2480   if (FRAME_VISIBLE_P (f))
2481     {
2482       Display *display = DEVICE_X_DISPLAY (XDEVICE (f->device));
2483       XWindowChanges xwc;
2484       unsigned int flags = CWStackMode;
2485
2486       xwc.stack_mode = Below;
2487       if (!XReconfigureWMWindow (display, XtWindow (FRAME_X_SHELL_WIDGET (f)),
2488                                  DefaultScreen (display), flags, &xwc))
2489         x_cant_notify_wm_error ();
2490     }
2491 }
2492
2493 /* Change from withdrawn state to mapped state. */
2494 static void
2495 x_make_frame_visible (struct frame *f)
2496 {
2497   Display *display = DEVICE_X_DISPLAY (XDEVICE (f->device));
2498
2499   if (!FRAME_VISIBLE_P(f))
2500     XMapRaised (display, XtWindow (FRAME_X_SHELL_WIDGET (f)));
2501   else
2502     x_raise_frame_1 (f, 0);
2503 }
2504
2505 /* Change from mapped state to withdrawn state. */
2506 static void
2507 x_make_frame_invisible (struct frame *f)
2508 {
2509   Display *display = DEVICE_X_DISPLAY (XDEVICE (f->device));
2510
2511   if (!FRAME_VISIBLE_P(f))
2512     return;
2513
2514   if (!XWithdrawWindow (display,
2515                         XtWindow (FRAME_X_SHELL_WIDGET (f)),
2516                         DefaultScreen (display)))
2517     x_cant_notify_wm_error ();
2518 }
2519
2520 static int
2521 x_frame_visible_p (struct frame *f)
2522 {
2523 #if 0
2524   Display *display = DEVICE_X_DISPLAY (XDEVICE (f->device));
2525   XWindowAttributes xwa;
2526   int result;
2527
2528   /* JV:
2529      This is bad, very bad :-(
2530      It is not compatible with our tristate visible and
2531      it should never ever change the visibility for us, this leads to
2532      the frame-freeze problem under fvwm because with the pager
2533
2534      Mappedness != Viewability != Visibility != Emacs f->visible
2535
2536      This first unequalness is the reason for the frame freezing problem
2537      under fvwm (it happens when the frame is another fvwm-page)
2538
2539      The second unequalness happen when it is on the same fvwm-page
2540      but in an invisible part of the visible screen.
2541
2542      For now we just return the XEmacs internal value --- which might not be up
2543      to date. Is that a problem? ---. Otherwise we should
2544      use async visibility like in standard Emacs.
2545      */
2546
2547   if (!XGetWindowAttributes (display,
2548                              XtWindow (FRAME_X_SHELL_WIDGET (f)),
2549                              &xwa))
2550     result = 0;
2551   else
2552     result = xwa.map_state == IsViewable;
2553   /* In this implementation it should at least be != IsUnmapped
2554      JV */
2555
2556   f->visible = result;
2557   return result;
2558 #endif /* 0 */
2559
2560   return f->visible;
2561 }
2562
2563 static int
2564 x_frame_totally_visible_p (struct frame *f)
2565 {
2566   return FRAME_X_TOTALLY_VISIBLE_P (f);
2567 }
2568
2569 /* Change window state from mapped to iconified. */
2570 static void
2571 x_iconify_frame (struct frame *f)
2572 {
2573   Display *display = DEVICE_X_DISPLAY (XDEVICE (f->device));
2574
2575   if (!XIconifyWindow (display,
2576                        XtWindow (FRAME_X_SHELL_WIDGET (f)),
2577                        DefaultScreen (display)))
2578     x_cant_notify_wm_error ();
2579
2580   f->iconified = 1;
2581 }
2582
2583 /* Sets the X focus to frame f. */
2584 static void
2585 x_focus_on_frame (struct frame *f)
2586 {
2587   XWindowAttributes xwa;
2588   Widget shell_widget;
2589   int viewable = 0;
2590
2591   assert (FRAME_X_P (f));
2592
2593   shell_widget = FRAME_X_SHELL_WIDGET (f);
2594   if (!XtWindow (shell_widget))
2595     return;
2596
2597 #ifdef EXTERNAL_WIDGET
2598   if (FRAME_X_EXTERNAL_WINDOW_P (f))
2599     ExternalShellSetFocus (shell_widget);
2600 #endif /* EXTERNAL_WIDGET */
2601
2602   /* Do the ICCCM focus change if the window is still visible.
2603      The s->visible flag might not be up-to-date, because we might
2604      not have processed magic events recently.  So make a server
2605      round-trip to find out whether it's really mapped right now.
2606      We grab the server to do this, because that's the only way to
2607      eliminate the race condition.
2608    */
2609   XGrabServer (XtDisplay (shell_widget));
2610   if (XGetWindowAttributes (XtDisplay (shell_widget),
2611                             XtWindow (shell_widget),
2612                             &xwa))
2613     /* JV: it is bad to change the visibility like this, so we don't for the
2614        moment, at least change_frame_visibility should be called
2615        Note also that under fvwm a frame can be Viewable (and thus Mapped)
2616        but still X-invisible
2617     f->visible = xwa.map_state == IsViewable; */
2618     viewable = xwa.map_state == IsViewable;
2619
2620
2621   if (viewable)
2622     {
2623       Window focus;
2624       int revert_to;
2625       XGetInputFocus (XtDisplay (shell_widget), &focus, &revert_to);
2626       /* Don't explicitly set the focus on this window unless the focus
2627          was on some other window (not PointerRoot).  Note that, even when
2628          running a point-to-type window manager like *twm, there is always
2629          a focus window; the window manager maintains that based on the
2630          mouse position.  If you set the "NoTitleFocus" option in these
2631          window managers, then the server itself maintains the focus via
2632          PointerRoot, and changing that to focus on the window would make
2633          the window grab the focus.  Very bad.
2634          */
2635       if (focus != PointerRoot)
2636         {
2637           XSetInputFocus (XtDisplay (shell_widget),
2638                           XtWindow (shell_widget),
2639                           RevertToParent,
2640                           DEVICE_X_MOUSE_TIMESTAMP
2641                           (XDEVICE (FRAME_DEVICE (f))));
2642           XFlush (XtDisplay (shell_widget));
2643         }
2644     }
2645   XUngrabServer (XtDisplay (shell_widget));
2646   XFlush (XtDisplay (shell_widget)); /* hey, I'd like to DEBUG this... */
2647 }
2648
2649 /* Destroy the X window of frame S.  */
2650 static void
2651 x_delete_frame (struct frame *f)
2652 {
2653   Display *dpy;
2654
2655 #ifndef HAVE_WMCOMMAND
2656   if (FRAME_X_TOP_LEVEL_FRAME_P (f))
2657     x_wm_maybe_move_wm_command (f);
2658 #endif /* HAVE_WMCOMMAND */
2659
2660 #ifdef HAVE_CDE
2661   DtDndDropUnregister (FRAME_X_TEXT_WIDGET (f));
2662 #endif /* HAVE_CDE */
2663
2664   assert (FRAME_X_SHELL_WIDGET (f) != 0);
2665   dpy = XtDisplay (FRAME_X_SHELL_WIDGET (f));
2666
2667 #ifdef EXTERNAL_WIDGET
2668   expect_x_error (XtDisplay (FRAME_X_SHELL_WIDGET (f)));
2669   /* for obscure reasons having (I think) to do with the internal
2670      window-to-widget hierarchy maintained by Xt, we have to call
2671      XtUnrealizeWidget() here.  Xt can really suck. */
2672   if (f->being_deleted)
2673     XtUnrealizeWidget (FRAME_X_SHELL_WIDGET (f));
2674   XtDestroyWidget (FRAME_X_SHELL_WIDGET (f));
2675   x_error_occurred_p (XtDisplay (FRAME_X_SHELL_WIDGET (f)));
2676 #else
2677   XtDestroyWidget (FRAME_X_SHELL_WIDGET (f));
2678   /* make sure the windows are really gone! */
2679   /* #### Is this REALLY necessary? */
2680   XFlush (dpy);
2681 #endif /* EXTERNAL_WIDGET */
2682
2683   FRAME_X_SHELL_WIDGET (f) = 0;
2684
2685   if (FRAME_X_GEOM_FREE_ME_PLEASE (f))
2686     {
2687       xfree (FRAME_X_GEOM_FREE_ME_PLEASE (f));
2688       FRAME_X_GEOM_FREE_ME_PLEASE (f) = 0;
2689     }
2690
2691   if (f->frame_data)
2692     {
2693       xfree (f->frame_data);
2694       f->frame_data = 0;
2695     }
2696 }
2697
2698 static void
2699 x_update_frame_external_traits (struct frame* frm, Lisp_Object name)
2700 {
2701   Arg al[10];
2702   int ac = 0;
2703   Lisp_Object frame;
2704
2705   XSETFRAME(frame, frm);
2706
2707   if (EQ (name, Qforeground))
2708    {
2709      Lisp_Object color = FACE_FOREGROUND (Vdefault_face, frame);
2710      XColor fgc;
2711
2712      if (!EQ (color, Vthe_null_color_instance))
2713        {
2714          fgc = COLOR_INSTANCE_X_COLOR (XCOLOR_INSTANCE (color));
2715          XtSetArg (al[ac], XtNforeground, (void *) fgc.pixel); ac++;
2716        }
2717    }
2718   else if (EQ (name, Qbackground))
2719    {
2720      Lisp_Object color = FACE_BACKGROUND (Vdefault_face, frame);
2721      XColor bgc;
2722
2723      if (!EQ (color, Vthe_null_color_instance))
2724        {
2725          bgc = COLOR_INSTANCE_X_COLOR (XCOLOR_INSTANCE (color));
2726          XtSetArg (al[ac], XtNbackground, (void *) bgc.pixel); ac++;
2727        }
2728
2729      /* Really crappy way to force the modeline shadows to be
2730         redrawn.  But effective. */
2731      MARK_FRAME_WINDOWS_STRUCTURE_CHANGED (frm);
2732      MARK_FRAME_CHANGED (frm);
2733    }
2734   else if (EQ (name, Qfont))
2735    {
2736      Lisp_Object font = FACE_FONT (Vdefault_face, frame, Vcharset_ascii);
2737
2738      if (!EQ (font, Vthe_null_font_instance))
2739        XtSetArg (al[ac], XtNfont,
2740                  (void *) FONT_INSTANCE_X_FONT (XFONT_INSTANCE (font)));
2741      ac++;
2742    }
2743   else
2744    abort ();
2745
2746   XtSetValues (FRAME_X_TEXT_WIDGET (frm), al, ac);
2747
2748 #ifdef HAVE_TOOLBARS
2749   /* Setting the background clears the entire frame area
2750     including the toolbar so we force an immediate redraw of
2751     it. */
2752   if (EQ (name, Qbackground))
2753     MAYBE_DEVMETH (XDEVICE (frm->device), redraw_frame_toolbars, (frm));
2754 #endif /* HAVE_TOOLBARS */
2755
2756   /* Set window manager resize increment hints according to
2757      the new character size */
2758   if (EQ (name, Qfont))
2759     EmacsFrameRecomputeCellSize (FRAME_X_TEXT_WIDGET (frm));
2760 }
2761
2762 \f
2763 /************************************************************************/
2764 /*                            initialization                            */
2765 /************************************************************************/
2766
2767 void
2768 syms_of_frame_x (void)
2769 {
2770   defsymbol (&Qwindow_id, "window-id");
2771   defsymbol (&Qx_resource_name, "x-resource-name");
2772
2773   DEFSUBR (Fx_window_id);
2774 #ifdef HAVE_CDE
2775   DEFSUBR (Fcde_start_drag_internal);
2776 #endif
2777 #ifdef HAVE_OFFIX_DND
2778   DEFSUBR (Foffix_start_drag_internal);
2779 #endif
2780 }
2781
2782 void
2783 console_type_create_frame_x (void)
2784 {
2785   /* frame methods */
2786   CONSOLE_HAS_METHOD (x, init_frame_1);
2787   CONSOLE_HAS_METHOD (x, init_frame_2);
2788   CONSOLE_HAS_METHOD (x, init_frame_3);
2789   CONSOLE_HAS_METHOD (x, mark_frame);
2790   CONSOLE_HAS_METHOD (x, focus_on_frame);
2791   CONSOLE_HAS_METHOD (x, delete_frame);
2792   CONSOLE_HAS_METHOD (x, get_mouse_position);
2793   CONSOLE_HAS_METHOD (x, set_mouse_position);
2794   CONSOLE_HAS_METHOD (x, raise_frame);
2795   CONSOLE_HAS_METHOD (x, lower_frame);
2796   CONSOLE_HAS_METHOD (x, make_frame_visible);
2797   CONSOLE_HAS_METHOD (x, make_frame_invisible);
2798   CONSOLE_HAS_METHOD (x, iconify_frame);
2799   CONSOLE_HAS_METHOD (x, set_frame_size);
2800   CONSOLE_HAS_METHOD (x, set_frame_position);
2801   CONSOLE_HAS_METHOD (x, frame_property);
2802   CONSOLE_HAS_METHOD (x, internal_frame_property_p);
2803   CONSOLE_HAS_METHOD (x, frame_properties);
2804   CONSOLE_HAS_METHOD (x, set_frame_properties);
2805   CONSOLE_HAS_METHOD (x, set_title_from_bufbyte);
2806   CONSOLE_HAS_METHOD (x, set_icon_name_from_bufbyte);
2807   CONSOLE_HAS_METHOD (x, frame_visible_p);
2808   CONSOLE_HAS_METHOD (x, frame_totally_visible_p);
2809   CONSOLE_HAS_METHOD (x, frame_iconified_p);
2810   CONSOLE_HAS_METHOD (x, set_frame_pointer);
2811   CONSOLE_HAS_METHOD (x, set_frame_icon);
2812   CONSOLE_HAS_METHOD (x, get_frame_parent);
2813   CONSOLE_HAS_METHOD (x, update_frame_external_traits);
2814 }
2815
2816 void
2817 vars_of_frame_x (void)
2818 {
2819 #ifdef EXTERNAL_WIDGET
2820   Fprovide (intern ("external-widget"));
2821 #endif
2822
2823   /* this call uses only safe functions from emacs.c */
2824   init_x_prop_symbols ();
2825
2826   DEFVAR_LISP ("default-x-frame-plist", &Vdefault_x_frame_plist /*
2827 Plist of default frame-creation properties for X frames.
2828 These override what is specified in the resource database and in
2829 `default-frame-plist', but are overridden by the arguments to the
2830 particular call to `make-frame'.
2831
2832 Note: In many cases, properties of a frame are available as specifiers
2833 instead of through the frame-properties mechanism.
2834
2835 Here is a list of recognized frame properties, other than those
2836 documented in `set-frame-properties' (they can be queried and
2837 set at any time, except as otherwise noted):
2838
2839   window-id                     The X window ID corresponding to the
2840                                 frame.  May be set only at startup, and
2841                                 only if external widget support was
2842                                 compiled in; doing so causes the frame
2843                                 to be created as an "external widget"
2844                                 in another program that uses an existing
2845                                 window in the program rather than creating
2846                                 a new one.
2847   initially-unmapped            If non-nil, the frame will not be visible
2848                                 when it is created.  In this case, you
2849                                 need to call `make-frame-visible' to make
2850                                 the frame appear.
2851   popup                         If non-nil, it should be a frame, and this
2852                                 frame will be created as a "popup" frame
2853                                 whose parent is the given frame.  This
2854                                 will make the window manager treat the
2855                                 frame as a dialog box, which may entail
2856                                 doing different things (e.g. not asking
2857                                 for positioning, and not iconifying
2858                                 separate from its parent).
2859   inter-line-space              Not currently implemented.
2860   toolbar-shadow-thickness      Thickness of toolbar shadows.
2861   background-toolbar-color      Color of toolbar background.
2862   bottom-toolbar-shadow-color   Color of bottom shadows on toolbars.
2863                                 (*Not* specific to the bottom-toolbar.)
2864   top-toolbar-shadow-color      Color of top shadows on toolbars.
2865                                 (*Not* specific to the top-toolbar.)
2866   internal-border-width         Width of internal border around text area.
2867   border-width                  Width of external border around text area.
2868   top                           Y position (in pixels) of the upper-left
2869                                 outermost corner of the frame (i.e. the
2870                                 upper-left of the window-manager
2871                                 decorations).
2872   left                          X position (in pixels) of the upper-left
2873                                 outermost corner of the frame (i.e. the
2874                                 upper-left of the window-manager
2875                                 decorations).
2876   border-color                  Color of external border around text area.
2877   cursor-color                  Color of text cursor.
2878
2879 See also `default-frame-plist', which specifies properties which apply
2880 to all frames, not just X frames.
2881 */ );
2882   Vdefault_x_frame_plist = Qnil;
2883
2884   x_console_methods->device_specific_frame_props = &Vdefault_x_frame_plist;
2885 }