(frame.o, keyboard.o, xdisp.o, xfaces.o): Depend on macgui.h.
[emacs.git] / src / xfns.c
blobf576b7f6a3ccbedbe278bbe3a8ba56f06d1a714a
1 /* Functions for the X window system.
2 Copyright (C) 1989, 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999, 2000,
3 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008
4 Free Software Foundation, Inc.
6 This file is part of GNU Emacs.
8 GNU Emacs is free software; you can redistribute it and/or modify
9 it under the terms of the GNU General Public License as published by
10 the Free Software Foundation; either version 3, or (at your option)
11 any later version.
13 GNU Emacs is distributed in the hope that it will be useful,
14 but WITHOUT ANY WARRANTY; without even the implied warranty of
15 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
16 GNU General Public License for more details.
18 You should have received a copy of the GNU General Public License
19 along with GNU Emacs; see the file COPYING. If not, write to
20 the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
21 Boston, MA 02110-1301, USA. */
23 #include <config.h>
24 #include <stdio.h>
25 #include <math.h>
27 #ifdef HAVE_UNISTD_H
28 #include <unistd.h>
29 #endif
31 /* This makes the fields of a Display accessible, in Xlib header files. */
33 #define XLIB_ILLEGAL_ACCESS
35 #include "lisp.h"
36 #include "xterm.h"
37 #include "frame.h"
38 #include "window.h"
39 #include "buffer.h"
40 #include "intervals.h"
41 #include "dispextern.h"
42 #include "keyboard.h"
43 #include "blockinput.h"
44 #include <epaths.h>
45 #include "charset.h"
46 #include "coding.h"
47 #include "fontset.h"
48 #include "systime.h"
49 #include "termhooks.h"
50 #include "atimer.h"
52 #ifdef HAVE_X_WINDOWS
54 #include <ctype.h>
55 #include <sys/types.h>
56 #include <sys/stat.h>
58 #ifndef VMS
59 #if 1 /* Used to be #ifdef EMACS_BITMAP_FILES, but this should always work. */
60 #include "bitmaps/gray.xbm"
61 #else
62 #include <X11/bitmaps/gray>
63 #endif
64 #else
65 #include "[.bitmaps]gray.xbm"
66 #endif
68 #ifdef USE_GTK
69 #include "gtkutil.h"
70 #endif
72 #ifdef USE_X_TOOLKIT
73 #include <X11/Shell.h>
75 #ifndef USE_MOTIF
76 #include <X11/Xaw/Paned.h>
77 #include <X11/Xaw/Label.h>
78 #endif /* USE_MOTIF */
80 #ifdef USG
81 #undef USG /* ####KLUDGE for Solaris 2.2 and up */
82 #include <X11/Xos.h>
83 #define USG
84 #else
85 #include <X11/Xos.h>
86 #endif
88 #include "widget.h"
90 #include "../lwlib/lwlib.h"
92 #ifdef USE_MOTIF
93 #include <Xm/Xm.h>
94 #include <Xm/DialogS.h>
95 #include <Xm/FileSB.h>
96 #endif
98 /* Do the EDITRES protocol if running X11R5
99 Exception: HP-UX (at least version A.09.05) has X11R5 without EditRes */
101 #if (XtSpecificationRelease >= 5) && !defined(NO_EDITRES)
102 #define HACK_EDITRES
103 extern void _XEditResCheckMessages ();
104 #endif /* R5 + Athena */
106 /* Unique id counter for widgets created by the Lucid Widget Library. */
108 extern LWLIB_ID widget_id_tick;
110 #ifdef USE_LUCID
111 /* This is part of a kludge--see lwlib/xlwmenu.c. */
112 extern XFontStruct *xlwmenu_default_font;
113 #endif
115 extern void free_frame_menubar ();
116 extern double atof ();
118 #ifdef USE_MOTIF
120 /* LessTif/Motif version info. */
122 static Lisp_Object Vmotif_version_string;
124 #endif /* USE_MOTIF */
126 #endif /* USE_X_TOOLKIT */
128 #ifdef USE_GTK
130 /* GTK+ version info */
132 static Lisp_Object Vgtk_version_string;
134 #endif /* USE_GTK */
136 #ifdef HAVE_X11R4
137 #define MAXREQUEST(dpy) (XMaxRequestSize (dpy))
138 #else
139 #define MAXREQUEST(dpy) ((dpy)->max_request_size)
140 #endif
142 /* The gray bitmap `bitmaps/gray'. This is done because xterm.c uses
143 it, and including `bitmaps/gray' more than once is a problem when
144 config.h defines `static' as an empty replacement string. */
146 int gray_bitmap_width = gray_width;
147 int gray_bitmap_height = gray_height;
148 char *gray_bitmap_bits = gray_bits;
150 /* Non-zero means we're allowed to display an hourglass cursor. */
152 int display_hourglass_p;
154 /* Non-zero means prompt with the old GTK file selection dialog. */
156 int x_gtk_use_old_file_dialog;
158 /* If non-zero, by default show hidden files in the GTK file chooser. */
160 int x_gtk_show_hidden_files;
162 /* If non-zero, don't show additional help text in the GTK file chooser. */
164 int x_gtk_file_dialog_help_text;
166 /* If non-zero, don't collapse to tool bar when it is detached. */
168 int x_gtk_whole_detached_tool_bar;
170 /* The background and shape of the mouse pointer, and shape when not
171 over text or in the modeline. */
173 Lisp_Object Vx_pointer_shape, Vx_nontext_pointer_shape, Vx_mode_pointer_shape;
174 Lisp_Object Vx_hourglass_pointer_shape;
176 /* The shape when over mouse-sensitive text. */
178 Lisp_Object Vx_sensitive_text_pointer_shape;
180 /* If non-nil, the pointer shape to indicate that windows can be
181 dragged horizontally. */
183 Lisp_Object Vx_window_horizontal_drag_shape;
185 /* Color of chars displayed in cursor box. */
187 Lisp_Object Vx_cursor_fore_pixel;
189 /* Nonzero if using X. */
191 static int x_in_use;
193 /* Non nil if no window manager is in use. */
195 Lisp_Object Vx_no_window_manager;
197 /* Regexp matching a font name whose width is the same as `PIXEL_SIZE'. */
199 Lisp_Object Vx_pixel_size_width_font_regexp;
201 Lisp_Object Qnone;
202 Lisp_Object Qsuppress_icon;
203 Lisp_Object Qundefined_color;
204 Lisp_Object Qcompound_text, Qcancel_timer;
206 /* In dispnew.c */
208 extern Lisp_Object Vwindow_system_version;
210 /* The below are defined in frame.c. */
212 #if GLYPH_DEBUG
213 int image_cache_refcount, dpyinfo_refcount;
214 #endif
218 /* Error if we are not connected to X. */
220 void
221 check_x ()
223 if (! x_in_use)
224 error ("X windows are not in use or not initialized");
227 /* Nonzero if we can use mouse menus.
228 You should not call this unless HAVE_MENUS is defined. */
231 have_menus_p ()
233 return x_in_use;
236 /* Extract a frame as a FRAME_PTR, defaulting to the selected frame
237 and checking validity for X. */
239 FRAME_PTR
240 check_x_frame (frame)
241 Lisp_Object frame;
243 FRAME_PTR f;
245 if (NILP (frame))
246 frame = selected_frame;
247 CHECK_LIVE_FRAME (frame);
248 f = XFRAME (frame);
249 if (! FRAME_X_P (f))
250 error ("Non-X frame used");
251 return f;
254 /* Let the user specify an X display with a frame.
255 nil stands for the selected frame--or, if that is not an X frame,
256 the first X display on the list. */
258 struct x_display_info *
259 check_x_display_info (frame)
260 Lisp_Object frame;
262 struct x_display_info *dpyinfo = NULL;
264 if (NILP (frame))
266 struct frame *sf = XFRAME (selected_frame);
268 if (FRAME_X_P (sf) && FRAME_LIVE_P (sf))
269 dpyinfo = FRAME_X_DISPLAY_INFO (sf);
270 else if (x_display_list != 0)
271 dpyinfo = x_display_list;
272 else
273 error ("X windows are not in use or not initialized");
275 else if (STRINGP (frame))
276 dpyinfo = x_display_info_for_name (frame);
277 else
279 FRAME_PTR f = check_x_frame (frame);
280 dpyinfo = FRAME_X_DISPLAY_INFO (f);
283 return dpyinfo;
287 /* Return the Emacs frame-object corresponding to an X window.
288 It could be the frame's main window or an icon window. */
290 /* This function can be called during GC, so use GC_xxx type test macros. */
292 struct frame *
293 x_window_to_frame (dpyinfo, wdesc)
294 struct x_display_info *dpyinfo;
295 int wdesc;
297 Lisp_Object tail, frame;
298 struct frame *f;
300 if (wdesc == None) return 0;
302 for (tail = Vframe_list; GC_CONSP (tail); tail = XCDR (tail))
304 frame = XCAR (tail);
305 if (!GC_FRAMEP (frame))
306 continue;
307 f = XFRAME (frame);
308 if (!FRAME_X_P (f) || FRAME_X_DISPLAY_INFO (f) != dpyinfo)
309 continue;
310 if (f->output_data.x->hourglass_window == wdesc)
311 return f;
312 #ifdef USE_X_TOOLKIT
313 if ((f->output_data.x->edit_widget
314 && XtWindow (f->output_data.x->edit_widget) == wdesc)
315 /* A tooltip frame? */
316 || (!f->output_data.x->edit_widget
317 && FRAME_X_WINDOW (f) == wdesc)
318 || f->output_data.x->icon_desc == wdesc)
319 return f;
320 #else /* not USE_X_TOOLKIT */
321 #ifdef USE_GTK
322 if (f->output_data.x->edit_widget)
324 GtkWidget *gwdesc = xg_win_to_widget (dpyinfo->display, wdesc);
325 struct x_output *x = f->output_data.x;
326 if (gwdesc != 0 && gwdesc == x->edit_widget)
327 return f;
329 #endif /* USE_GTK */
330 if (FRAME_X_WINDOW (f) == wdesc
331 || f->output_data.x->icon_desc == wdesc)
332 return f;
333 #endif /* not USE_X_TOOLKIT */
335 return 0;
338 #if defined (USE_X_TOOLKIT) || defined (USE_GTK)
339 /* Like x_window_to_frame but also compares the window with the widget's
340 windows. */
342 struct frame *
343 x_any_window_to_frame (dpyinfo, wdesc)
344 struct x_display_info *dpyinfo;
345 int wdesc;
347 Lisp_Object tail, frame;
348 struct frame *f, *found;
349 struct x_output *x;
351 if (wdesc == None) return NULL;
353 found = NULL;
354 for (tail = Vframe_list; GC_CONSP (tail) && !found; tail = XCDR (tail))
356 frame = XCAR (tail);
357 if (!GC_FRAMEP (frame))
358 continue;
360 f = XFRAME (frame);
361 if (FRAME_X_P (f) && FRAME_X_DISPLAY_INFO (f) == dpyinfo)
363 /* This frame matches if the window is any of its widgets. */
364 x = f->output_data.x;
365 if (x->hourglass_window == wdesc)
366 found = f;
367 else if (x->widget)
369 #ifdef USE_GTK
370 GtkWidget *gwdesc = xg_win_to_widget (dpyinfo->display, wdesc);
371 if (gwdesc != 0
372 && (gwdesc == x->widget
373 || gwdesc == x->edit_widget
374 || gwdesc == x->vbox_widget
375 || gwdesc == x->menubar_widget))
376 found = f;
377 #else
378 if (wdesc == XtWindow (x->widget)
379 || wdesc == XtWindow (x->column_widget)
380 || wdesc == XtWindow (x->edit_widget))
381 found = f;
382 /* Match if the window is this frame's menubar. */
383 else if (lw_window_is_in_menubar (wdesc, x->menubar_widget))
384 found = f;
385 #endif
387 else if (FRAME_X_WINDOW (f) == wdesc)
388 /* A tooltip frame. */
389 found = f;
393 return found;
396 /* Likewise, but exclude the menu bar widget. */
398 struct frame *
399 x_non_menubar_window_to_frame (dpyinfo, wdesc)
400 struct x_display_info *dpyinfo;
401 int wdesc;
403 Lisp_Object tail, frame;
404 struct frame *f;
405 struct x_output *x;
407 if (wdesc == None) return 0;
409 for (tail = Vframe_list; GC_CONSP (tail); tail = XCDR (tail))
411 frame = XCAR (tail);
412 if (!GC_FRAMEP (frame))
413 continue;
414 f = XFRAME (frame);
415 if (!FRAME_X_P (f) || FRAME_X_DISPLAY_INFO (f) != dpyinfo)
416 continue;
417 x = f->output_data.x;
418 /* This frame matches if the window is any of its widgets. */
419 if (x->hourglass_window == wdesc)
420 return f;
421 else if (x->widget)
423 #ifdef USE_GTK
424 GtkWidget *gwdesc = xg_win_to_widget (dpyinfo->display, wdesc);
425 if (gwdesc != 0
426 && (gwdesc == x->widget
427 || gwdesc == x->edit_widget
428 || gwdesc == x->vbox_widget))
429 return f;
430 #else
431 if (wdesc == XtWindow (x->widget)
432 || wdesc == XtWindow (x->column_widget)
433 || wdesc == XtWindow (x->edit_widget))
434 return f;
435 #endif
437 else if (FRAME_X_WINDOW (f) == wdesc)
438 /* A tooltip frame. */
439 return f;
441 return 0;
444 /* Likewise, but consider only the menu bar widget. */
446 struct frame *
447 x_menubar_window_to_frame (dpyinfo, wdesc)
448 struct x_display_info *dpyinfo;
449 int wdesc;
451 Lisp_Object tail, frame;
452 struct frame *f;
453 struct x_output *x;
455 if (wdesc == None) return 0;
457 for (tail = Vframe_list; GC_CONSP (tail); tail = XCDR (tail))
459 frame = XCAR (tail);
460 if (!GC_FRAMEP (frame))
461 continue;
462 f = XFRAME (frame);
463 if (!FRAME_X_P (f) || FRAME_X_DISPLAY_INFO (f) != dpyinfo)
464 continue;
465 x = f->output_data.x;
466 /* Match if the window is this frame's menubar. */
467 #ifdef USE_GTK
468 if (x->menubar_widget)
470 GtkWidget *gwdesc = xg_win_to_widget (dpyinfo->display, wdesc);
471 int found = 0;
473 BLOCK_INPUT;
474 if (gwdesc != 0
475 && (gwdesc == x->menubar_widget
476 || gtk_widget_get_parent (gwdesc) == x->menubar_widget))
477 found = 1;
478 UNBLOCK_INPUT;
479 if (found) return f;
481 #else
482 if (x->menubar_widget
483 && lw_window_is_in_menubar (wdesc, x->menubar_widget))
484 return f;
485 #endif
487 return 0;
490 /* Return the frame whose principal (outermost) window is WDESC.
491 If WDESC is some other (smaller) window, we return 0. */
493 struct frame *
494 x_top_window_to_frame (dpyinfo, wdesc)
495 struct x_display_info *dpyinfo;
496 int wdesc;
498 Lisp_Object tail, frame;
499 struct frame *f;
500 struct x_output *x;
502 if (wdesc == None) return 0;
504 for (tail = Vframe_list; GC_CONSP (tail); tail = XCDR (tail))
506 frame = XCAR (tail);
507 if (!GC_FRAMEP (frame))
508 continue;
509 f = XFRAME (frame);
510 if (!FRAME_X_P (f) || FRAME_X_DISPLAY_INFO (f) != dpyinfo)
511 continue;
512 x = f->output_data.x;
514 if (x->widget)
516 /* This frame matches if the window is its topmost widget. */
517 #ifdef USE_GTK
518 GtkWidget *gwdesc = xg_win_to_widget (dpyinfo->display, wdesc);
519 if (gwdesc == x->widget)
520 return f;
521 #else
522 if (wdesc == XtWindow (x->widget))
523 return f;
524 #if 0 /* I don't know why it did this,
525 but it seems logically wrong,
526 and it causes trouble for MapNotify events. */
527 /* Match if the window is this frame's menubar. */
528 if (x->menubar_widget
529 && wdesc == XtWindow (x->menubar_widget))
530 return f;
531 #endif
532 #endif
534 else if (FRAME_X_WINDOW (f) == wdesc)
535 /* Tooltip frame. */
536 return f;
538 return 0;
540 #endif /* USE_X_TOOLKIT || USE_GTK */
544 static Lisp_Object unwind_create_frame P_ ((Lisp_Object));
545 static Lisp_Object unwind_create_tip_frame P_ ((Lisp_Object));
547 void x_set_foreground_color P_ ((struct frame *, Lisp_Object, Lisp_Object));
548 static void x_set_wait_for_wm P_ ((struct frame *, Lisp_Object, Lisp_Object));
549 void x_set_background_color P_ ((struct frame *, Lisp_Object, Lisp_Object));
550 void x_set_mouse_color P_ ((struct frame *, Lisp_Object, Lisp_Object));
551 void x_set_cursor_color P_ ((struct frame *, Lisp_Object, Lisp_Object));
552 void x_set_border_color P_ ((struct frame *, Lisp_Object, Lisp_Object));
553 void x_set_cursor_type P_ ((struct frame *, Lisp_Object, Lisp_Object));
554 void x_set_icon_type P_ ((struct frame *, Lisp_Object, Lisp_Object));
555 void x_set_icon_name P_ ((struct frame *, Lisp_Object, Lisp_Object));
556 void x_explicitly_set_name P_ ((struct frame *, Lisp_Object, Lisp_Object));
557 void x_set_menu_bar_lines P_ ((struct frame *, Lisp_Object, Lisp_Object));
558 void x_set_title P_ ((struct frame *, Lisp_Object, Lisp_Object));
559 void x_set_tool_bar_lines P_ ((struct frame *, Lisp_Object, Lisp_Object));
560 void x_set_scroll_bar_foreground P_ ((struct frame *, Lisp_Object,
561 Lisp_Object));
562 void x_set_scroll_bar_background P_ ((struct frame *, Lisp_Object,
563 Lisp_Object));
564 static Lisp_Object x_default_scroll_bar_color_parameter P_ ((struct frame *,
565 Lisp_Object,
566 Lisp_Object,
567 char *, char *,
568 int));
571 /* Store the screen positions of frame F into XPTR and YPTR.
572 These are the positions of the containing window manager window,
573 not Emacs's own window. */
575 void
576 x_real_positions (f, xptr, yptr)
577 FRAME_PTR f;
578 int *xptr, *yptr;
580 int win_x, win_y, outer_x, outer_y;
581 int real_x = 0, real_y = 0;
582 int had_errors = 0;
583 Window win = f->output_data.x->parent_desc;
585 BLOCK_INPUT;
587 x_catch_errors (FRAME_X_DISPLAY (f));
589 if (win == FRAME_X_DISPLAY_INFO (f)->root_window)
590 win = FRAME_OUTER_WINDOW (f);
592 /* This loop traverses up the containment tree until we hit the root
593 window. Window managers may intersect many windows between our window
594 and the root window. The window we find just before the root window
595 should be the outer WM window. */
596 for (;;)
598 Window wm_window, rootw;
599 Window *tmp_children;
600 unsigned int tmp_nchildren;
601 int success;
603 success = XQueryTree (FRAME_X_DISPLAY (f), win, &rootw,
604 &wm_window, &tmp_children, &tmp_nchildren);
606 had_errors = x_had_errors_p (FRAME_X_DISPLAY (f));
608 /* Don't free tmp_children if XQueryTree failed. */
609 if (! success)
610 break;
612 XFree ((char *) tmp_children);
614 if (wm_window == rootw || had_errors)
615 break;
617 win = wm_window;
620 if (! had_errors)
622 unsigned int ign;
623 Window child, rootw;
625 /* Get the real coordinates for the WM window upper left corner */
626 XGetGeometry (FRAME_X_DISPLAY (f), win,
627 &rootw, &real_x, &real_y, &ign, &ign, &ign, &ign);
629 /* Translate real coordinates to coordinates relative to our
630 window. For our window, the upper left corner is 0, 0.
631 Since the upper left corner of the WM window is outside
632 our window, win_x and win_y will be negative:
634 ------------------ ---> x
635 | title |
636 | ----------------- v y
637 | | our window
639 XTranslateCoordinates (FRAME_X_DISPLAY (f),
641 /* From-window, to-window. */
642 FRAME_X_DISPLAY_INFO (f)->root_window,
643 FRAME_X_WINDOW (f),
645 /* From-position, to-position. */
646 real_x, real_y, &win_x, &win_y,
648 /* Child of win. */
649 &child);
651 if (FRAME_X_WINDOW (f) == FRAME_OUTER_WINDOW (f))
653 outer_x = win_x;
654 outer_y = win_y;
656 else
658 XTranslateCoordinates (FRAME_X_DISPLAY (f),
660 /* From-window, to-window. */
661 FRAME_X_DISPLAY_INFO (f)->root_window,
662 FRAME_OUTER_WINDOW (f),
664 /* From-position, to-position. */
665 real_x, real_y, &outer_x, &outer_y,
667 /* Child of win. */
668 &child);
671 had_errors = x_had_errors_p (FRAME_X_DISPLAY (f));
674 x_uncatch_errors ();
676 UNBLOCK_INPUT;
678 if (had_errors) return;
680 f->x_pixels_diff = -win_x;
681 f->y_pixels_diff = -win_y;
683 FRAME_X_OUTPUT (f)->x_pixels_outer_diff = -outer_x;
684 FRAME_X_OUTPUT (f)->y_pixels_outer_diff = -outer_y;
686 *xptr = real_x;
687 *yptr = real_y;
693 /* Gamma-correct COLOR on frame F. */
695 void
696 gamma_correct (f, color)
697 struct frame *f;
698 XColor *color;
700 if (f->gamma)
702 color->red = pow (color->red / 65535.0, f->gamma) * 65535.0 + 0.5;
703 color->green = pow (color->green / 65535.0, f->gamma) * 65535.0 + 0.5;
704 color->blue = pow (color->blue / 65535.0, f->gamma) * 65535.0 + 0.5;
709 /* Decide if color named COLOR_NAME is valid for use on frame F. If
710 so, return the RGB values in COLOR. If ALLOC_P is non-zero,
711 allocate the color. Value is zero if COLOR_NAME is invalid, or
712 no color could be allocated. */
715 x_defined_color (f, color_name, color, alloc_p)
716 struct frame *f;
717 char *color_name;
718 XColor *color;
719 int alloc_p;
721 int success_p;
722 Display *dpy = FRAME_X_DISPLAY (f);
723 Colormap cmap = FRAME_X_COLORMAP (f);
725 BLOCK_INPUT;
726 success_p = XParseColor (dpy, cmap, color_name, color);
727 if (success_p && alloc_p)
728 success_p = x_alloc_nearest_color (f, cmap, color);
729 UNBLOCK_INPUT;
731 return success_p;
735 /* Return the pixel color value for color COLOR_NAME on frame F. If F
736 is a monochrome frame, return MONO_COLOR regardless of what ARG says.
737 Signal an error if color can't be allocated. */
740 x_decode_color (f, color_name, mono_color)
741 FRAME_PTR f;
742 Lisp_Object color_name;
743 int mono_color;
745 XColor cdef;
747 CHECK_STRING (color_name);
749 #if 0 /* Don't do this. It's wrong when we're not using the default
750 colormap, it makes freeing difficult, and it's probably not
751 an important optimization. */
752 if (strcmp (SDATA (color_name), "black") == 0)
753 return BLACK_PIX_DEFAULT (f);
754 else if (strcmp (SDATA (color_name), "white") == 0)
755 return WHITE_PIX_DEFAULT (f);
756 #endif
758 /* Return MONO_COLOR for monochrome frames. */
759 if (FRAME_X_DISPLAY_INFO (f)->n_planes == 1)
760 return mono_color;
762 /* x_defined_color is responsible for coping with failures
763 by looking for a near-miss. */
764 if (x_defined_color (f, SDATA (color_name), &cdef, 1))
765 return cdef.pixel;
767 signal_error ("Undefined color", color_name);
772 /* Change the `wait-for-wm' frame parameter of frame F. OLD_VALUE is
773 the previous value of that parameter, NEW_VALUE is the new value.
774 See also the comment of wait_for_wm in struct x_output. */
776 static void
777 x_set_wait_for_wm (f, new_value, old_value)
778 struct frame *f;
779 Lisp_Object new_value, old_value;
781 f->output_data.x->wait_for_wm = !NILP (new_value);
784 #ifdef USE_GTK
786 /* Set icon from FILE for frame F. By using GTK functions the icon
787 may be any format that GdkPixbuf knows about, i.e. not just bitmaps. */
790 xg_set_icon (f, file)
791 FRAME_PTR f;
792 Lisp_Object file;
794 int result = 0;
795 Lisp_Object found;
797 found = x_find_image_file (file);
799 if (! NILP (found))
801 GdkPixbuf *pixbuf;
802 GError *err = NULL;
803 char *filename = (char *) SDATA (found);
804 BLOCK_INPUT;
806 pixbuf = gdk_pixbuf_new_from_file (filename, &err);
808 if (pixbuf)
810 gtk_window_set_icon (GTK_WINDOW (FRAME_GTK_OUTER_WIDGET (f)),
811 pixbuf);
812 g_object_unref (pixbuf);
814 result = 1;
816 else
817 g_error_free (err);
819 UNBLOCK_INPUT;
822 return result;
826 xg_set_icon_from_xpm_data (f, data)
827 FRAME_PTR f;
828 char **data;
830 int result = 0;
831 GdkPixbuf *pixbuf = gdk_pixbuf_new_from_xpm_data ((const char **) data);
833 if (!pixbuf)
834 return 0;
836 gtk_window_set_icon (GTK_WINDOW (FRAME_GTK_OUTER_WIDGET (f)), pixbuf);
837 g_object_unref (pixbuf);
838 return 1;
840 #endif /* USE_GTK */
843 /* Functions called only from `x_set_frame_param'
844 to set individual parameters.
846 If FRAME_X_WINDOW (f) is 0,
847 the frame is being created and its X-window does not exist yet.
848 In that case, just record the parameter's new value
849 in the standard place; do not attempt to change the window. */
851 void
852 x_set_foreground_color (f, arg, oldval)
853 struct frame *f;
854 Lisp_Object arg, oldval;
856 struct x_output *x = f->output_data.x;
857 unsigned long fg, old_fg;
859 fg = x_decode_color (f, arg, BLACK_PIX_DEFAULT (f));
860 old_fg = x->foreground_pixel;
861 x->foreground_pixel = fg;
863 if (FRAME_X_WINDOW (f) != 0)
865 Display *dpy = FRAME_X_DISPLAY (f);
867 BLOCK_INPUT;
868 XSetForeground (dpy, x->normal_gc, fg);
869 XSetBackground (dpy, x->reverse_gc, fg);
871 if (x->cursor_pixel == old_fg)
873 unload_color (f, x->cursor_pixel);
874 x->cursor_pixel = x_copy_color (f, fg);
875 XSetBackground (dpy, x->cursor_gc, x->cursor_pixel);
878 UNBLOCK_INPUT;
880 update_face_from_frame_parameter (f, Qforeground_color, arg);
882 if (FRAME_VISIBLE_P (f))
883 redraw_frame (f);
886 unload_color (f, old_fg);
889 void
890 x_set_background_color (f, arg, oldval)
891 struct frame *f;
892 Lisp_Object arg, oldval;
894 struct x_output *x = f->output_data.x;
895 unsigned long bg;
897 bg = x_decode_color (f, arg, WHITE_PIX_DEFAULT (f));
898 unload_color (f, x->background_pixel);
899 x->background_pixel = bg;
901 if (FRAME_X_WINDOW (f) != 0)
903 Display *dpy = FRAME_X_DISPLAY (f);
905 BLOCK_INPUT;
906 XSetBackground (dpy, x->normal_gc, bg);
907 XSetForeground (dpy, x->reverse_gc, bg);
908 XSetWindowBackground (dpy, FRAME_X_WINDOW (f), bg);
909 XSetForeground (dpy, x->cursor_gc, bg);
911 #ifdef USE_GTK
912 xg_set_background_color (f, bg);
913 #endif
915 #ifndef USE_TOOLKIT_SCROLL_BARS /* Turns out to be annoying with
916 toolkit scroll bars. */
918 Lisp_Object bar;
919 for (bar = FRAME_SCROLL_BARS (f);
920 !NILP (bar);
921 bar = XSCROLL_BAR (bar)->next)
923 Window window = SCROLL_BAR_X_WINDOW (XSCROLL_BAR (bar));
924 XSetWindowBackground (dpy, window, bg);
927 #endif /* USE_TOOLKIT_SCROLL_BARS */
929 UNBLOCK_INPUT;
930 update_face_from_frame_parameter (f, Qbackground_color, arg);
932 if (FRAME_VISIBLE_P (f))
933 redraw_frame (f);
937 void
938 x_set_mouse_color (f, arg, oldval)
939 struct frame *f;
940 Lisp_Object arg, oldval;
942 struct x_output *x = f->output_data.x;
943 Display *dpy = FRAME_X_DISPLAY (f);
944 Cursor cursor, nontext_cursor, mode_cursor, hand_cursor;
945 Cursor hourglass_cursor, horizontal_drag_cursor;
946 unsigned long pixel = x_decode_color (f, arg, BLACK_PIX_DEFAULT (f));
947 unsigned long mask_color = x->background_pixel;
949 /* Don't let pointers be invisible. */
950 if (mask_color == pixel)
952 x_free_colors (f, &pixel, 1);
953 pixel = x_copy_color (f, x->foreground_pixel);
956 unload_color (f, x->mouse_pixel);
957 x->mouse_pixel = pixel;
959 BLOCK_INPUT;
961 /* It's not okay to crash if the user selects a screwy cursor. */
962 x_catch_errors (dpy);
964 if (!NILP (Vx_pointer_shape))
966 CHECK_NUMBER (Vx_pointer_shape);
967 cursor = XCreateFontCursor (dpy, XINT (Vx_pointer_shape));
969 else
970 cursor = XCreateFontCursor (dpy, XC_xterm);
971 x_check_errors (dpy, "bad text pointer cursor: %s");
973 if (!NILP (Vx_nontext_pointer_shape))
975 CHECK_NUMBER (Vx_nontext_pointer_shape);
976 nontext_cursor
977 = XCreateFontCursor (dpy, XINT (Vx_nontext_pointer_shape));
979 else
980 nontext_cursor = XCreateFontCursor (dpy, XC_left_ptr);
981 x_check_errors (dpy, "bad nontext pointer cursor: %s");
983 if (!NILP (Vx_hourglass_pointer_shape))
985 CHECK_NUMBER (Vx_hourglass_pointer_shape);
986 hourglass_cursor
987 = XCreateFontCursor (dpy, XINT (Vx_hourglass_pointer_shape));
989 else
990 hourglass_cursor = XCreateFontCursor (dpy, XC_watch);
991 x_check_errors (dpy, "bad hourglass pointer cursor: %s");
993 if (!NILP (Vx_mode_pointer_shape))
995 CHECK_NUMBER (Vx_mode_pointer_shape);
996 mode_cursor = XCreateFontCursor (dpy, XINT (Vx_mode_pointer_shape));
998 else
999 mode_cursor = XCreateFontCursor (dpy, XC_xterm);
1000 x_check_errors (dpy, "bad modeline pointer cursor: %s");
1002 if (!NILP (Vx_sensitive_text_pointer_shape))
1004 CHECK_NUMBER (Vx_sensitive_text_pointer_shape);
1005 hand_cursor
1006 = XCreateFontCursor (dpy, XINT (Vx_sensitive_text_pointer_shape));
1008 else
1009 hand_cursor = XCreateFontCursor (dpy, XC_hand2);
1011 if (!NILP (Vx_window_horizontal_drag_shape))
1013 CHECK_NUMBER (Vx_window_horizontal_drag_shape);
1014 horizontal_drag_cursor
1015 = XCreateFontCursor (dpy, XINT (Vx_window_horizontal_drag_shape));
1017 else
1018 horizontal_drag_cursor
1019 = XCreateFontCursor (dpy, XC_sb_h_double_arrow);
1021 /* Check and report errors with the above calls. */
1022 x_check_errors (dpy, "can't set cursor shape: %s");
1023 x_uncatch_errors ();
1026 XColor fore_color, back_color;
1028 fore_color.pixel = x->mouse_pixel;
1029 x_query_color (f, &fore_color);
1030 back_color.pixel = mask_color;
1031 x_query_color (f, &back_color);
1033 XRecolorCursor (dpy, cursor, &fore_color, &back_color);
1034 XRecolorCursor (dpy, nontext_cursor, &fore_color, &back_color);
1035 XRecolorCursor (dpy, mode_cursor, &fore_color, &back_color);
1036 XRecolorCursor (dpy, hand_cursor, &fore_color, &back_color);
1037 XRecolorCursor (dpy, hourglass_cursor, &fore_color, &back_color);
1038 XRecolorCursor (dpy, horizontal_drag_cursor, &fore_color, &back_color);
1041 if (FRAME_X_WINDOW (f) != 0)
1042 XDefineCursor (dpy, FRAME_X_WINDOW (f), cursor);
1044 if (cursor != x->text_cursor
1045 && x->text_cursor != 0)
1046 XFreeCursor (dpy, x->text_cursor);
1047 x->text_cursor = cursor;
1049 if (nontext_cursor != x->nontext_cursor
1050 && x->nontext_cursor != 0)
1051 XFreeCursor (dpy, x->nontext_cursor);
1052 x->nontext_cursor = nontext_cursor;
1054 if (hourglass_cursor != x->hourglass_cursor
1055 && x->hourglass_cursor != 0)
1056 XFreeCursor (dpy, x->hourglass_cursor);
1057 x->hourglass_cursor = hourglass_cursor;
1059 if (mode_cursor != x->modeline_cursor
1060 && x->modeline_cursor != 0)
1061 XFreeCursor (dpy, f->output_data.x->modeline_cursor);
1062 x->modeline_cursor = mode_cursor;
1064 if (hand_cursor != x->hand_cursor
1065 && x->hand_cursor != 0)
1066 XFreeCursor (dpy, x->hand_cursor);
1067 x->hand_cursor = hand_cursor;
1069 if (horizontal_drag_cursor != x->horizontal_drag_cursor
1070 && x->horizontal_drag_cursor != 0)
1071 XFreeCursor (dpy, x->horizontal_drag_cursor);
1072 x->horizontal_drag_cursor = horizontal_drag_cursor;
1074 XFlush (dpy);
1075 UNBLOCK_INPUT;
1077 update_face_from_frame_parameter (f, Qmouse_color, arg);
1080 void
1081 x_set_cursor_color (f, arg, oldval)
1082 struct frame *f;
1083 Lisp_Object arg, oldval;
1085 unsigned long fore_pixel, pixel;
1086 int fore_pixel_allocated_p = 0, pixel_allocated_p = 0;
1087 struct x_output *x = f->output_data.x;
1089 if (!NILP (Vx_cursor_fore_pixel))
1091 fore_pixel = x_decode_color (f, Vx_cursor_fore_pixel,
1092 WHITE_PIX_DEFAULT (f));
1093 fore_pixel_allocated_p = 1;
1095 else
1096 fore_pixel = x->background_pixel;
1098 pixel = x_decode_color (f, arg, BLACK_PIX_DEFAULT (f));
1099 pixel_allocated_p = 1;
1101 /* Make sure that the cursor color differs from the background color. */
1102 if (pixel == x->background_pixel)
1104 if (pixel_allocated_p)
1106 x_free_colors (f, &pixel, 1);
1107 pixel_allocated_p = 0;
1110 pixel = x->mouse_pixel;
1111 if (pixel == fore_pixel)
1113 if (fore_pixel_allocated_p)
1115 x_free_colors (f, &fore_pixel, 1);
1116 fore_pixel_allocated_p = 0;
1118 fore_pixel = x->background_pixel;
1122 unload_color (f, x->cursor_foreground_pixel);
1123 if (!fore_pixel_allocated_p)
1124 fore_pixel = x_copy_color (f, fore_pixel);
1125 x->cursor_foreground_pixel = fore_pixel;
1127 unload_color (f, x->cursor_pixel);
1128 if (!pixel_allocated_p)
1129 pixel = x_copy_color (f, pixel);
1130 x->cursor_pixel = pixel;
1132 if (FRAME_X_WINDOW (f) != 0)
1134 BLOCK_INPUT;
1135 XSetBackground (FRAME_X_DISPLAY (f), x->cursor_gc, x->cursor_pixel);
1136 XSetForeground (FRAME_X_DISPLAY (f), x->cursor_gc, fore_pixel);
1137 UNBLOCK_INPUT;
1139 if (FRAME_VISIBLE_P (f))
1141 x_update_cursor (f, 0);
1142 x_update_cursor (f, 1);
1146 update_face_from_frame_parameter (f, Qcursor_color, arg);
1149 /* Set the border-color of frame F to pixel value PIX.
1150 Note that this does not fully take effect if done before
1151 F has an x-window. */
1153 void
1154 x_set_border_pixel (f, pix)
1155 struct frame *f;
1156 int pix;
1158 unload_color (f, f->output_data.x->border_pixel);
1159 f->output_data.x->border_pixel = pix;
1161 if (FRAME_X_WINDOW (f) != 0 && f->border_width > 0)
1163 BLOCK_INPUT;
1164 XSetWindowBorder (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
1165 (unsigned long)pix);
1166 UNBLOCK_INPUT;
1168 if (FRAME_VISIBLE_P (f))
1169 redraw_frame (f);
1173 /* Set the border-color of frame F to value described by ARG.
1174 ARG can be a string naming a color.
1175 The border-color is used for the border that is drawn by the X server.
1176 Note that this does not fully take effect if done before
1177 F has an x-window; it must be redone when the window is created.
1179 Note: this is done in two routines because of the way X10 works.
1181 Note: under X11, this is normally the province of the window manager,
1182 and so emacs' border colors may be overridden. */
1184 void
1185 x_set_border_color (f, arg, oldval)
1186 struct frame *f;
1187 Lisp_Object arg, oldval;
1189 int pix;
1191 CHECK_STRING (arg);
1192 pix = x_decode_color (f, arg, BLACK_PIX_DEFAULT (f));
1193 x_set_border_pixel (f, pix);
1194 update_face_from_frame_parameter (f, Qborder_color, arg);
1198 void
1199 x_set_cursor_type (f, arg, oldval)
1200 FRAME_PTR f;
1201 Lisp_Object arg, oldval;
1203 set_frame_cursor_types (f, arg);
1205 /* Make sure the cursor gets redrawn. */
1206 cursor_type_changed = 1;
1209 void
1210 x_set_icon_type (f, arg, oldval)
1211 struct frame *f;
1212 Lisp_Object arg, oldval;
1214 int result;
1216 if (STRINGP (arg))
1218 if (STRINGP (oldval) && EQ (Fstring_equal (oldval, arg), Qt))
1219 return;
1221 else if (!STRINGP (oldval) && EQ (oldval, Qnil) == EQ (arg, Qnil))
1222 return;
1224 BLOCK_INPUT;
1225 if (NILP (arg))
1226 result = x_text_icon (f,
1227 (char *) SDATA ((!NILP (f->icon_name)
1228 ? f->icon_name
1229 : f->name)));
1230 else
1231 result = x_bitmap_icon (f, arg);
1233 if (result)
1235 UNBLOCK_INPUT;
1236 error ("No icon window available");
1239 XFlush (FRAME_X_DISPLAY (f));
1240 UNBLOCK_INPUT;
1243 void
1244 x_set_icon_name (f, arg, oldval)
1245 struct frame *f;
1246 Lisp_Object arg, oldval;
1248 int result;
1250 if (STRINGP (arg))
1252 if (STRINGP (oldval) && EQ (Fstring_equal (oldval, arg), Qt))
1253 return;
1255 else if (!NILP (arg) || NILP (oldval))
1256 return;
1258 f->icon_name = arg;
1260 if (f->output_data.x->icon_bitmap != 0)
1261 return;
1263 BLOCK_INPUT;
1265 result = x_text_icon (f,
1266 (char *) SDATA ((!NILP (f->icon_name)
1267 ? f->icon_name
1268 : !NILP (f->title)
1269 ? f->title
1270 : f->name)));
1272 if (result)
1274 UNBLOCK_INPUT;
1275 error ("No icon window available");
1278 XFlush (FRAME_X_DISPLAY (f));
1279 UNBLOCK_INPUT;
1283 void
1284 x_set_menu_bar_lines (f, value, oldval)
1285 struct frame *f;
1286 Lisp_Object value, oldval;
1288 int nlines;
1289 #if ! defined (USE_X_TOOLKIT) && ! defined (USE_GTK)
1290 int olines = FRAME_MENU_BAR_LINES (f);
1291 #endif
1293 /* Right now, menu bars don't work properly in minibuf-only frames;
1294 most of the commands try to apply themselves to the minibuffer
1295 frame itself, and get an error because you can't switch buffers
1296 in or split the minibuffer window. */
1297 if (FRAME_MINIBUF_ONLY_P (f))
1298 return;
1300 if (INTEGERP (value))
1301 nlines = XINT (value);
1302 else
1303 nlines = 0;
1305 /* Make sure we redisplay all windows in this frame. */
1306 windows_or_buffers_changed++;
1308 #if defined (USE_X_TOOLKIT) || defined (USE_GTK)
1309 FRAME_MENU_BAR_LINES (f) = 0;
1310 if (nlines)
1312 FRAME_EXTERNAL_MENU_BAR (f) = 1;
1313 if (FRAME_X_P (f) && f->output_data.x->menubar_widget == 0)
1314 /* Make sure next redisplay shows the menu bar. */
1315 XWINDOW (FRAME_SELECTED_WINDOW (f))->update_mode_line = Qt;
1317 else
1319 if (FRAME_EXTERNAL_MENU_BAR (f) == 1)
1320 free_frame_menubar (f);
1321 FRAME_EXTERNAL_MENU_BAR (f) = 0;
1322 if (FRAME_X_P (f))
1323 f->output_data.x->menubar_widget = 0;
1325 #else /* not USE_X_TOOLKIT && not USE_GTK */
1326 FRAME_MENU_BAR_LINES (f) = nlines;
1327 change_window_heights (f->root_window, nlines - olines);
1328 #endif /* not USE_X_TOOLKIT */
1329 adjust_glyphs (f);
1333 /* Set the number of lines used for the tool bar of frame F to VALUE.
1334 VALUE not an integer, or < 0 means set the lines to zero. OLDVAL
1335 is the old number of tool bar lines. This function changes the
1336 height of all windows on frame F to match the new tool bar height.
1337 The frame's height doesn't change. */
1339 void
1340 x_set_tool_bar_lines (f, value, oldval)
1341 struct frame *f;
1342 Lisp_Object value, oldval;
1344 int delta, nlines, root_height;
1345 Lisp_Object root_window;
1347 /* Treat tool bars like menu bars. */
1348 if (FRAME_MINIBUF_ONLY_P (f))
1349 return;
1351 /* Use VALUE only if an integer >= 0. */
1352 if (INTEGERP (value) && XINT (value) >= 0)
1353 nlines = XFASTINT (value);
1354 else
1355 nlines = 0;
1357 #ifdef USE_GTK
1358 FRAME_TOOL_BAR_LINES (f) = 0;
1359 if (nlines)
1361 FRAME_EXTERNAL_TOOL_BAR (f) = 1;
1362 if (FRAME_X_P (f) && f->output_data.x->toolbar_widget == 0)
1363 /* Make sure next redisplay shows the tool bar. */
1364 XWINDOW (FRAME_SELECTED_WINDOW (f))->update_mode_line = Qt;
1365 update_frame_tool_bar (f);
1367 else
1369 if (FRAME_EXTERNAL_TOOL_BAR (f))
1370 free_frame_tool_bar (f);
1371 FRAME_EXTERNAL_TOOL_BAR (f) = 0;
1374 return;
1375 #endif
1377 /* Make sure we redisplay all windows in this frame. */
1378 ++windows_or_buffers_changed;
1380 delta = nlines - FRAME_TOOL_BAR_LINES (f);
1382 /* Don't resize the tool-bar to more than we have room for. */
1383 root_window = FRAME_ROOT_WINDOW (f);
1384 root_height = WINDOW_TOTAL_LINES (XWINDOW (root_window));
1385 if (root_height - delta < 1)
1387 delta = root_height - 1;
1388 nlines = FRAME_TOOL_BAR_LINES (f) + delta;
1391 FRAME_TOOL_BAR_LINES (f) = nlines;
1392 change_window_heights (root_window, delta);
1393 adjust_glyphs (f);
1395 /* We also have to make sure that the internal border at the top of
1396 the frame, below the menu bar or tool bar, is redrawn when the
1397 tool bar disappears. This is so because the internal border is
1398 below the tool bar if one is displayed, but is below the menu bar
1399 if there isn't a tool bar. The tool bar draws into the area
1400 below the menu bar. */
1401 if (FRAME_X_WINDOW (f) && FRAME_TOOL_BAR_LINES (f) == 0)
1403 updating_frame = f;
1404 clear_frame ();
1405 clear_current_matrices (f);
1406 updating_frame = NULL;
1409 /* If the tool bar gets smaller, the internal border below it
1410 has to be cleared. It was formerly part of the display
1411 of the larger tool bar, and updating windows won't clear it. */
1412 if (delta < 0)
1414 int height = FRAME_INTERNAL_BORDER_WIDTH (f);
1415 int width = FRAME_PIXEL_WIDTH (f);
1416 int y = nlines * FRAME_LINE_HEIGHT (f);
1418 /* height can be zero here. */
1419 if (height > 0 && width > 0)
1421 BLOCK_INPUT;
1422 x_clear_area (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
1423 0, y, width, height, False);
1424 UNBLOCK_INPUT;
1427 if (WINDOWP (f->tool_bar_window))
1428 clear_glyph_matrix (XWINDOW (f->tool_bar_window)->current_matrix);
1433 /* Set the foreground color for scroll bars on frame F to VALUE.
1434 VALUE should be a string, a color name. If it isn't a string or
1435 isn't a valid color name, do nothing. OLDVAL is the old value of
1436 the frame parameter. */
1438 void
1439 x_set_scroll_bar_foreground (f, value, oldval)
1440 struct frame *f;
1441 Lisp_Object value, oldval;
1443 unsigned long pixel;
1445 if (STRINGP (value))
1446 pixel = x_decode_color (f, value, BLACK_PIX_DEFAULT (f));
1447 else
1448 pixel = -1;
1450 if (f->output_data.x->scroll_bar_foreground_pixel != -1)
1451 unload_color (f, f->output_data.x->scroll_bar_foreground_pixel);
1453 f->output_data.x->scroll_bar_foreground_pixel = pixel;
1454 if (FRAME_X_WINDOW (f) && FRAME_VISIBLE_P (f))
1456 /* Remove all scroll bars because they have wrong colors. */
1457 if (condemn_scroll_bars_hook)
1458 (*condemn_scroll_bars_hook) (f);
1459 if (judge_scroll_bars_hook)
1460 (*judge_scroll_bars_hook) (f);
1462 update_face_from_frame_parameter (f, Qscroll_bar_foreground, value);
1463 redraw_frame (f);
1468 /* Set the background color for scroll bars on frame F to VALUE VALUE
1469 should be a string, a color name. If it isn't a string or isn't a
1470 valid color name, do nothing. OLDVAL is the old value of the frame
1471 parameter. */
1473 void
1474 x_set_scroll_bar_background (f, value, oldval)
1475 struct frame *f;
1476 Lisp_Object value, oldval;
1478 unsigned long pixel;
1480 if (STRINGP (value))
1481 pixel = x_decode_color (f, value, WHITE_PIX_DEFAULT (f));
1482 else
1483 pixel = -1;
1485 if (f->output_data.x->scroll_bar_background_pixel != -1)
1486 unload_color (f, f->output_data.x->scroll_bar_background_pixel);
1488 #ifdef USE_TOOLKIT_SCROLL_BARS
1489 /* Scrollbar shadow colors. */
1490 if (f->output_data.x->scroll_bar_top_shadow_pixel != -1)
1492 unload_color (f, f->output_data.x->scroll_bar_top_shadow_pixel);
1493 f->output_data.x->scroll_bar_top_shadow_pixel = -1;
1495 if (f->output_data.x->scroll_bar_bottom_shadow_pixel != -1)
1497 unload_color (f, f->output_data.x->scroll_bar_bottom_shadow_pixel);
1498 f->output_data.x->scroll_bar_bottom_shadow_pixel = -1;
1500 #endif /* USE_TOOLKIT_SCROLL_BARS */
1502 f->output_data.x->scroll_bar_background_pixel = pixel;
1503 if (FRAME_X_WINDOW (f) && FRAME_VISIBLE_P (f))
1505 /* Remove all scroll bars because they have wrong colors. */
1506 if (condemn_scroll_bars_hook)
1507 (*condemn_scroll_bars_hook) (f);
1508 if (judge_scroll_bars_hook)
1509 (*judge_scroll_bars_hook) (f);
1511 update_face_from_frame_parameter (f, Qscroll_bar_background, value);
1512 redraw_frame (f);
1517 /* Encode Lisp string STRING as a text in a format appropriate for
1518 XICCC (X Inter Client Communication Conventions).
1520 This can call Lisp code, so callers must GCPRO.
1522 If STRING contains only ASCII characters, do no conversion and
1523 return the string data of STRING. Otherwise, encode the text by
1524 CODING_SYSTEM, and return a newly allocated memory area which
1525 should be freed by `xfree' by a caller.
1527 SELECTIONP non-zero means the string is being encoded for an X
1528 selection, so it is safe to run pre-write conversions (which
1529 may run Lisp code).
1531 Store the byte length of resulting text in *TEXT_BYTES.
1533 If the text contains only ASCII and Latin-1, store 1 in *STRING_P,
1534 which means that the `encoding' of the result can be `STRING'.
1535 Otherwise store 0 in *STRINGP, which means that the `encoding' of
1536 the result should be `COMPOUND_TEXT'. */
1538 static unsigned char *
1539 x_encode_text (string, coding_system, selectionp, text_bytes, stringp, freep)
1540 Lisp_Object string, coding_system;
1541 int *text_bytes, *stringp;
1542 int selectionp;
1543 int *freep;
1545 unsigned char *str = SDATA (string);
1546 int chars = SCHARS (string);
1547 int bytes = SBYTES (string);
1548 int charset_info;
1549 int bufsize;
1550 unsigned char *buf;
1551 struct coding_system coding;
1552 extern Lisp_Object Qcompound_text_with_extensions;
1554 charset_info = find_charset_in_text (str, chars, bytes, NULL, Qnil);
1555 if (charset_info == 0)
1557 /* No multibyte character in OBJ. We need not encode it. */
1558 *text_bytes = bytes;
1559 *stringp = 1;
1560 *freep = 0;
1561 return str;
1564 setup_coding_system (coding_system, &coding);
1565 if (selectionp
1566 && SYMBOLP (coding.pre_write_conversion)
1567 && !NILP (Ffboundp (coding.pre_write_conversion)))
1569 struct gcpro gcpro1;
1570 /* We don't need to GCPRO string. */
1571 GCPRO1 (coding_system);
1572 string = run_pre_post_conversion_on_str (string, &coding, 1);
1573 UNGCPRO;
1574 str = SDATA (string);
1575 chars = SCHARS (string);
1576 bytes = SBYTES (string);
1578 coding.src_multibyte = 1;
1579 coding.dst_multibyte = 0;
1580 coding.mode |= CODING_MODE_LAST_BLOCK;
1581 if (coding.type == coding_type_iso2022)
1582 coding.flags |= CODING_FLAG_ISO_SAFE;
1583 /* We suppress producing escape sequences for composition. */
1584 coding.composing = COMPOSITION_DISABLED;
1585 bufsize = encoding_buffer_size (&coding, bytes);
1586 buf = (unsigned char *) xmalloc (bufsize);
1587 encode_coding (&coding, str, buf, bytes, bufsize);
1588 *text_bytes = coding.produced;
1589 *stringp = (charset_info == 1
1590 || (!EQ (coding_system, Qcompound_text)
1591 && !EQ (coding_system, Qcompound_text_with_extensions)));
1592 *freep = 1;
1593 return buf;
1597 /* Set the WM name to NAME for frame F. Also set the icon name.
1598 If the frame already has an icon name, use that, otherwise set the
1599 icon name to NAME. */
1601 static void
1602 x_set_name_internal (f, name)
1603 FRAME_PTR f;
1604 Lisp_Object name;
1606 if (FRAME_X_WINDOW (f))
1608 BLOCK_INPUT;
1609 #ifdef HAVE_X11R4
1611 XTextProperty text, icon;
1612 int bytes, stringp;
1613 int do_free_icon_value = 0, do_free_text_value = 0;
1614 Lisp_Object coding_system;
1615 #ifdef USE_GTK
1616 Lisp_Object encoded_name;
1617 struct gcpro gcpro1;
1619 /* As ENCODE_UTF_8 may cause GC and relocation of string data,
1620 we use it before x_encode_text that may return string data. */
1621 GCPRO1 (name);
1622 encoded_name = ENCODE_UTF_8 (name);
1623 UNGCPRO;
1624 #endif
1626 coding_system = Qcompound_text;
1627 /* Note: Encoding strategy
1629 We encode NAME by compound-text and use "COMPOUND-TEXT" in
1630 text.encoding. But, there are non-internationalized window
1631 managers which don't support that encoding. So, if NAME
1632 contains only ASCII and 8859-1 characters, encode it by
1633 iso-latin-1, and use "STRING" in text.encoding hoping that
1634 such window managers at least analyze this format correctly,
1635 i.e. treat 8-bit bytes as 8859-1 characters.
1637 We may also be able to use "UTF8_STRING" in text.encoding
1638 in the future which can encode all Unicode characters.
1639 But, for the moment, there's no way to know that the
1640 current window manager supports it or not. */
1641 text.value = x_encode_text (name, coding_system, 0, &bytes, &stringp,
1642 &do_free_text_value);
1643 text.encoding = (stringp ? XA_STRING
1644 : FRAME_X_DISPLAY_INFO (f)->Xatom_COMPOUND_TEXT);
1645 text.format = 8;
1646 text.nitems = bytes;
1648 if (!STRINGP (f->icon_name))
1650 icon = text;
1652 else
1654 /* See the above comment "Note: Encoding strategy". */
1655 icon.value = x_encode_text (f->icon_name, coding_system, 0,
1656 &bytes, &stringp, &do_free_icon_value);
1657 icon.encoding = (stringp ? XA_STRING
1658 : FRAME_X_DISPLAY_INFO (f)->Xatom_COMPOUND_TEXT);
1659 icon.format = 8;
1660 icon.nitems = bytes;
1663 #ifdef USE_GTK
1664 gtk_window_set_title (GTK_WINDOW (FRAME_GTK_OUTER_WIDGET (f)),
1665 (char *) SDATA (encoded_name));
1666 #else /* not USE_GTK */
1667 XSetWMName (FRAME_X_DISPLAY (f), FRAME_OUTER_WINDOW (f), &text);
1668 #endif /* not USE_GTK */
1670 XSetWMIconName (FRAME_X_DISPLAY (f), FRAME_OUTER_WINDOW (f), &icon);
1672 if (do_free_icon_value)
1673 xfree (icon.value);
1674 if (do_free_text_value)
1675 xfree (text.value);
1677 #else /* not HAVE_X11R4 */
1678 XSetIconName (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
1679 SDATA (name));
1680 XStoreName (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
1681 SDATA (name));
1682 #endif /* not HAVE_X11R4 */
1683 UNBLOCK_INPUT;
1687 /* Change the name of frame F to NAME. If NAME is nil, set F's name to
1688 x_id_name.
1690 If EXPLICIT is non-zero, that indicates that lisp code is setting the
1691 name; if NAME is a string, set F's name to NAME and set
1692 F->explicit_name; if NAME is Qnil, then clear F->explicit_name.
1694 If EXPLICIT is zero, that indicates that Emacs redisplay code is
1695 suggesting a new name, which lisp code should override; if
1696 F->explicit_name is set, ignore the new name; otherwise, set it. */
1698 void
1699 x_set_name (f, name, explicit)
1700 struct frame *f;
1701 Lisp_Object name;
1702 int explicit;
1704 /* Make sure that requests from lisp code override requests from
1705 Emacs redisplay code. */
1706 if (explicit)
1708 /* If we're switching from explicit to implicit, we had better
1709 update the mode lines and thereby update the title. */
1710 if (f->explicit_name && NILP (name))
1711 update_mode_lines = 1;
1713 f->explicit_name = ! NILP (name);
1715 else if (f->explicit_name)
1716 return;
1718 /* If NAME is nil, set the name to the x_id_name. */
1719 if (NILP (name))
1721 /* Check for no change needed in this very common case
1722 before we do any consing. */
1723 if (!strcmp (FRAME_X_DISPLAY_INFO (f)->x_id_name,
1724 SDATA (f->name)))
1725 return;
1726 name = build_string (FRAME_X_DISPLAY_INFO (f)->x_id_name);
1728 else
1729 CHECK_STRING (name);
1731 /* Don't change the name if it's already NAME. */
1732 if (! NILP (Fstring_equal (name, f->name)))
1733 return;
1735 f->name = name;
1737 /* For setting the frame title, the title parameter should override
1738 the name parameter. */
1739 if (! NILP (f->title))
1740 name = f->title;
1742 x_set_name_internal (f, name);
1745 /* This function should be called when the user's lisp code has
1746 specified a name for the frame; the name will override any set by the
1747 redisplay code. */
1748 void
1749 x_explicitly_set_name (f, arg, oldval)
1750 FRAME_PTR f;
1751 Lisp_Object arg, oldval;
1753 x_set_name (f, arg, 1);
1756 /* This function should be called by Emacs redisplay code to set the
1757 name; names set this way will never override names set by the user's
1758 lisp code. */
1759 void
1760 x_implicitly_set_name (f, arg, oldval)
1761 FRAME_PTR f;
1762 Lisp_Object arg, oldval;
1764 x_set_name (f, arg, 0);
1767 /* Change the title of frame F to NAME.
1768 If NAME is nil, use the frame name as the title. */
1770 void
1771 x_set_title (f, name, old_name)
1772 struct frame *f;
1773 Lisp_Object name, old_name;
1775 /* Don't change the title if it's already NAME. */
1776 if (EQ (name, f->title))
1777 return;
1779 update_mode_lines = 1;
1781 f->title = name;
1783 if (NILP (name))
1784 name = f->name;
1785 else
1786 CHECK_STRING (name);
1788 x_set_name_internal (f, name);
1791 void
1792 x_set_scroll_bar_default_width (f)
1793 struct frame *f;
1795 int wid = FRAME_COLUMN_WIDTH (f);
1797 #ifdef USE_TOOLKIT_SCROLL_BARS
1798 /* A minimum width of 14 doesn't look good for toolkit scroll bars. */
1799 int width = 16 + 2 * VERTICAL_SCROLL_BAR_WIDTH_TRIM;
1800 FRAME_CONFIG_SCROLL_BAR_COLS (f) = (width + wid - 1) / wid;
1801 FRAME_CONFIG_SCROLL_BAR_WIDTH (f) = width;
1802 #else
1803 /* Make the actual width at least 14 pixels and a multiple of a
1804 character width. */
1805 FRAME_CONFIG_SCROLL_BAR_COLS (f) = (14 + wid - 1) / wid;
1807 /* Use all of that space (aside from required margins) for the
1808 scroll bar. */
1809 FRAME_CONFIG_SCROLL_BAR_WIDTH (f) = 0;
1810 #endif
1814 /* Record in frame F the specified or default value according to ALIST
1815 of the parameter named PROP (a Lisp symbol). If no value is
1816 specified for PROP, look for an X default for XPROP on the frame
1817 named NAME. If that is not found either, use the value DEFLT. */
1819 static Lisp_Object
1820 x_default_scroll_bar_color_parameter (f, alist, prop, xprop, xclass,
1821 foreground_p)
1822 struct frame *f;
1823 Lisp_Object alist;
1824 Lisp_Object prop;
1825 char *xprop;
1826 char *xclass;
1827 int foreground_p;
1829 struct x_display_info *dpyinfo = FRAME_X_DISPLAY_INFO (f);
1830 Lisp_Object tem;
1832 tem = x_get_arg (dpyinfo, alist, prop, xprop, xclass, RES_TYPE_STRING);
1833 if (EQ (tem, Qunbound))
1835 #ifdef USE_TOOLKIT_SCROLL_BARS
1837 /* See if an X resource for the scroll bar color has been
1838 specified. */
1839 tem = display_x_get_resource (dpyinfo,
1840 build_string (foreground_p
1841 ? "foreground"
1842 : "background"),
1843 empty_string,
1844 build_string ("verticalScrollBar"),
1845 empty_string);
1846 if (!STRINGP (tem))
1848 /* If nothing has been specified, scroll bars will use a
1849 toolkit-dependent default. Because these defaults are
1850 difficult to get at without actually creating a scroll
1851 bar, use nil to indicate that no color has been
1852 specified. */
1853 tem = Qnil;
1856 #else /* not USE_TOOLKIT_SCROLL_BARS */
1858 tem = Qnil;
1860 #endif /* not USE_TOOLKIT_SCROLL_BARS */
1863 x_set_frame_parameters (f, Fcons (Fcons (prop, tem), Qnil));
1864 return tem;
1869 #if !defined (HAVE_X11R4) && !defined (HAVE_XSETWMPROTOCOLS)
1871 Status
1872 XSetWMProtocols (dpy, w, protocols, count)
1873 Display *dpy;
1874 Window w;
1875 Atom *protocols;
1876 int count;
1878 Atom prop;
1879 prop = XInternAtom (dpy, "WM_PROTOCOLS", False);
1880 if (prop == None) return False;
1881 XChangeProperty (dpy, w, prop, XA_ATOM, 32, PropModeReplace,
1882 (unsigned char *) protocols, count);
1883 return True;
1885 #endif /* not HAVE_X11R4 && not HAVE_XSETWMPROTOCOLS */
1887 #ifdef USE_X_TOOLKIT
1889 /* If the WM_PROTOCOLS property does not already contain WM_TAKE_FOCUS,
1890 WM_DELETE_WINDOW, and WM_SAVE_YOURSELF, then add them. (They may
1891 already be present because of the toolkit (Motif adds some of them,
1892 for example, but Xt doesn't). */
1894 static void
1895 hack_wm_protocols (f, widget)
1896 FRAME_PTR f;
1897 Widget widget;
1899 Display *dpy = XtDisplay (widget);
1900 Window w = XtWindow (widget);
1901 int need_delete = 1;
1902 int need_focus = 1;
1903 int need_save = 1;
1905 BLOCK_INPUT;
1907 Atom type;
1908 unsigned char *catoms;
1909 int format = 0;
1910 unsigned long nitems = 0;
1911 unsigned long bytes_after;
1913 if ((XGetWindowProperty (dpy, w,
1914 FRAME_X_DISPLAY_INFO (f)->Xatom_wm_protocols,
1915 (long)0, (long)100, False, XA_ATOM,
1916 &type, &format, &nitems, &bytes_after,
1917 &catoms)
1918 == Success)
1919 && format == 32 && type == XA_ATOM)
1921 Atom *atoms = (Atom *) catoms;
1922 while (nitems > 0)
1924 nitems--;
1925 if (atoms[nitems]
1926 == FRAME_X_DISPLAY_INFO (f)->Xatom_wm_delete_window)
1927 need_delete = 0;
1928 else if (atoms[nitems]
1929 == FRAME_X_DISPLAY_INFO (f)->Xatom_wm_take_focus)
1930 need_focus = 0;
1931 else if (atoms[nitems]
1932 == FRAME_X_DISPLAY_INFO (f)->Xatom_wm_save_yourself)
1933 need_save = 0;
1936 if (catoms)
1937 XFree (catoms);
1940 Atom props [10];
1941 int count = 0;
1942 if (need_delete)
1943 props[count++] = FRAME_X_DISPLAY_INFO (f)->Xatom_wm_delete_window;
1944 if (need_focus)
1945 props[count++] = FRAME_X_DISPLAY_INFO (f)->Xatom_wm_take_focus;
1946 if (need_save)
1947 props[count++] = FRAME_X_DISPLAY_INFO (f)->Xatom_wm_save_yourself;
1948 if (count)
1949 XChangeProperty (dpy, w, FRAME_X_DISPLAY_INFO (f)->Xatom_wm_protocols,
1950 XA_ATOM, 32, PropModeAppend,
1951 (unsigned char *) props, count);
1953 UNBLOCK_INPUT;
1955 #endif
1959 /* Support routines for XIC (X Input Context). */
1961 #ifdef HAVE_X_I18N
1963 static XFontSet xic_create_xfontset P_ ((struct frame *, char *));
1964 static XIMStyle best_xim_style P_ ((XIMStyles *, XIMStyles *));
1967 /* Supported XIM styles, ordered by preference. */
1969 static XIMStyle supported_xim_styles[] =
1971 XIMPreeditPosition | XIMStatusArea,
1972 XIMPreeditPosition | XIMStatusNothing,
1973 XIMPreeditPosition | XIMStatusNone,
1974 XIMPreeditNothing | XIMStatusArea,
1975 XIMPreeditNothing | XIMStatusNothing,
1976 XIMPreeditNothing | XIMStatusNone,
1977 XIMPreeditNone | XIMStatusArea,
1978 XIMPreeditNone | XIMStatusNothing,
1979 XIMPreeditNone | XIMStatusNone,
1984 /* Create an X fontset on frame F with base font name BASE_FONTNAME. */
1986 char xic_defaut_fontset[] = "-*-*-*-r-normal--14-*-*-*-*-*-*-*";
1988 /* Create an Xt fontset spec from the name of a base font.
1989 If `motif' is True use the Motif syntax. */
1990 char *
1991 xic_create_fontsetname (base_fontname, motif)
1992 char *base_fontname;
1993 Bool motif;
1995 const char *sep = motif ? ";" : ",";
1996 char *fontsetname;
1998 /* Make a fontset name from the base font name. */
1999 if (xic_defaut_fontset == base_fontname)
2000 { /* There is no base font name, use the default. */
2001 int len = strlen (base_fontname) + 2;
2002 fontsetname = xmalloc (len);
2003 bzero (fontsetname, len);
2004 strcpy (fontsetname, base_fontname);
2006 else
2008 /* Make a fontset name from the base font name.
2009 The font set will be made of the following elements:
2010 - the base font.
2011 - the base font where the charset spec is replaced by -*-*.
2012 - the same but with the family also replaced with -*-*-. */
2013 char *p = base_fontname;
2014 int i;
2016 for (i = 0; *p; p++)
2017 if (*p == '-') i++;
2018 if (i != 14)
2019 { /* As the font name doesn't conform to XLFD, we can't
2020 modify it to generalize it to allcs and allfamilies.
2021 Use the specified font plus the default. */
2022 int len = strlen (base_fontname) + strlen (xic_defaut_fontset) + 3;
2023 fontsetname = xmalloc (len);
2024 bzero (fontsetname, len);
2025 strcpy (fontsetname, base_fontname);
2026 strcat (fontsetname, sep);
2027 strcat (fontsetname, xic_defaut_fontset);
2029 else
2031 int len;
2032 char *p1 = NULL, *p2 = NULL, *p3 = NULL;
2033 char *font_allcs = NULL;
2034 char *font_allfamilies = NULL;
2035 char *font_all = NULL;
2036 char *allcs = "*-*-*-*-*-*-*";
2037 char *allfamilies = "-*-*-";
2038 char *all = "*-*-*-*-";
2039 char *base;
2041 for (i = 0, p = base_fontname; i < 8; p++)
2043 if (*p == '-')
2045 i++;
2046 if (i == 3)
2047 p1 = p + 1;
2048 else if (i == 7)
2049 p2 = p + 1;
2050 else if (i == 6)
2051 p3 = p + 1;
2054 /* If base_fontname specifies ADSTYLE, make it a
2055 wildcard. */
2056 if (*p3 != '*')
2058 int diff = (p2 - p3) - 2;
2060 base = alloca (strlen (base_fontname) + 1);
2061 bcopy (base_fontname, base, p3 - base_fontname);
2062 base[p3 - base_fontname] = '*';
2063 base[(p3 - base_fontname) + 1] = '-';
2064 strcpy (base + (p3 - base_fontname) + 2, p2);
2065 p = base + (p - base_fontname) - diff;
2066 p1 = base + (p1 - base_fontname);
2067 p2 = base + (p2 - base_fontname) - diff;
2068 base_fontname = base;
2071 /* Build the font spec that matches all charsets. */
2072 len = p - base_fontname + strlen (allcs) + 1;
2073 font_allcs = (char *) alloca (len);
2074 bzero (font_allcs, len);
2075 bcopy (base_fontname, font_allcs, p - base_fontname);
2076 strcat (font_allcs, allcs);
2078 /* Build the font spec that matches all families and
2079 add-styles. */
2080 len = p - p1 + strlen (allcs) + strlen (allfamilies) + 1;
2081 font_allfamilies = (char *) alloca (len);
2082 bzero (font_allfamilies, len);
2083 strcpy (font_allfamilies, allfamilies);
2084 bcopy (p1, font_allfamilies + strlen (allfamilies), p - p1);
2085 strcat (font_allfamilies, allcs);
2087 /* Build the font spec that matches all. */
2088 len = p - p2 + strlen (allcs) + strlen (all) + strlen (allfamilies) + 1;
2089 font_all = (char *) alloca (len);
2090 bzero (font_all, len);
2091 strcpy (font_all, allfamilies);
2092 strcat (font_all, all);
2093 bcopy (p2, font_all + strlen (all) + strlen (allfamilies), p - p2);
2094 strcat (font_all, allcs);
2096 /* Build the actual font set name. */
2097 len = strlen (base_fontname) + strlen (font_allcs)
2098 + strlen (font_allfamilies) + strlen (font_all) + 5;
2099 fontsetname = xmalloc (len);
2100 bzero (fontsetname, len);
2101 strcpy (fontsetname, base_fontname);
2102 strcat (fontsetname, sep);
2103 strcat (fontsetname, font_allcs);
2104 strcat (fontsetname, sep);
2105 strcat (fontsetname, font_allfamilies);
2106 strcat (fontsetname, sep);
2107 strcat (fontsetname, font_all);
2110 if (motif)
2111 strcat (fontsetname, ":");
2112 return fontsetname;
2115 static XFontSet
2116 xic_create_xfontset (f, base_fontname)
2117 struct frame *f;
2118 char *base_fontname;
2120 XFontSet xfs = NULL;
2121 char **missing_list = NULL;
2122 int missing_count;
2123 char *def_string;
2124 Lisp_Object rest, frame;
2126 if (!base_fontname)
2127 base_fontname = xic_defaut_fontset;
2129 /* See if there is another frame already using same fontset. */
2130 FOR_EACH_FRAME (rest, frame)
2132 struct frame *cf = XFRAME (frame);
2133 if (cf != f && FRAME_LIVE_P (f) && FRAME_X_P (cf)
2134 && FRAME_X_DISPLAY_INFO (cf) == FRAME_X_DISPLAY_INFO (f)
2135 && FRAME_XIC_BASE_FONTNAME (cf)
2136 && !strcmp (FRAME_XIC_BASE_FONTNAME (cf), base_fontname))
2138 xfs = FRAME_XIC_FONTSET (cf);
2139 break;
2143 if (!xfs)
2145 char *fontsetname = xic_create_fontsetname (base_fontname, False);
2147 /* New fontset. */
2148 xfs = XCreateFontSet (FRAME_X_DISPLAY (f),
2149 fontsetname, &missing_list,
2150 &missing_count, &def_string);
2151 if (missing_list)
2152 XFreeStringList (missing_list);
2153 if (! xfs)
2155 /* FONTSETNAME contains a list of font names (specific fonts
2156 first, general fonts last), but giving that to
2157 XCreateFontSet at once occasionally fails (bug of X?).
2158 So, we try to call XCreateFontSet for each fontname. */
2159 char *p0 = fontsetname, *p1;
2161 while (p0)
2163 p1 = strchr (p0, ',');
2164 if (p1)
2165 *p1 = '\0';
2166 xfs = XCreateFontSet (FRAME_X_DISPLAY (f),
2167 p0, &missing_list,
2168 &missing_count, &def_string);
2169 if (missing_list)
2170 XFreeStringList (missing_list);
2171 if (xfs)
2172 break;
2173 p0 = p1 ? p1 + 1 : NULL;
2176 xfree (fontsetname);
2179 if (FRAME_XIC_BASE_FONTNAME (f))
2180 xfree (FRAME_XIC_BASE_FONTNAME (f));
2181 FRAME_XIC_BASE_FONTNAME (f) = xstrdup (base_fontname);
2183 /* No need to free def_string. */
2184 return xfs;
2187 /* Free the X fontset of frame F if it is the last frame using it. */
2189 void
2190 xic_free_xfontset (f)
2191 struct frame *f;
2193 Lisp_Object rest, frame;
2194 int shared_p = 0;
2196 if (!FRAME_XIC_FONTSET (f))
2197 return;
2199 /* See if there is another frame sharing the same fontset. */
2200 FOR_EACH_FRAME (rest, frame)
2202 struct frame *cf = XFRAME (frame);
2203 if (cf != f && FRAME_LIVE_P (f) && FRAME_X_P (cf)
2204 && FRAME_X_DISPLAY_INFO (cf) == FRAME_X_DISPLAY_INFO (f)
2205 && FRAME_XIC_FONTSET (cf) == FRAME_XIC_FONTSET (f))
2207 shared_p = 1;
2208 break;
2212 if (!shared_p)
2213 /* The fontset is not used anymore. It is safe to free it. */
2214 XFreeFontSet (FRAME_X_DISPLAY (f), FRAME_XIC_FONTSET (f));
2216 if (FRAME_XIC_BASE_FONTNAME (f))
2217 xfree (FRAME_XIC_BASE_FONTNAME (f));
2218 FRAME_XIC_BASE_FONTNAME (f) = NULL;
2219 FRAME_XIC_FONTSET (f) = NULL;
2223 /* Value is the best input style, given user preferences USER (already
2224 checked to be supported by Emacs), and styles supported by the
2225 input method XIM. */
2227 static XIMStyle
2228 best_xim_style (user, xim)
2229 XIMStyles *user;
2230 XIMStyles *xim;
2232 int i, j;
2234 for (i = 0; i < user->count_styles; ++i)
2235 for (j = 0; j < xim->count_styles; ++j)
2236 if (user->supported_styles[i] == xim->supported_styles[j])
2237 return user->supported_styles[i];
2239 /* Return the default style. */
2240 return XIMPreeditNothing | XIMStatusNothing;
2243 /* Create XIC for frame F. */
2245 static XIMStyle xic_style;
2247 void
2248 create_frame_xic (f)
2249 struct frame *f;
2251 XIM xim;
2252 XIC xic = NULL;
2253 XFontSet xfs = NULL;
2255 if (FRAME_XIC (f))
2256 return;
2258 /* Create X fontset. */
2259 xfs = xic_create_xfontset
2260 (f, (FRAME_FONTSET (f) < 0) ? NULL
2261 : (char *) SDATA (fontset_ascii (FRAME_FONTSET (f))));
2263 xim = FRAME_X_XIM (f);
2264 if (xim)
2266 XRectangle s_area;
2267 XPoint spot;
2268 XVaNestedList preedit_attr;
2269 XVaNestedList status_attr;
2271 s_area.x = 0; s_area.y = 0; s_area.width = 1; s_area.height = 1;
2272 spot.x = 0; spot.y = 1;
2274 /* Determine XIC style. */
2275 if (xic_style == 0)
2277 XIMStyles supported_list;
2278 supported_list.count_styles = (sizeof supported_xim_styles
2279 / sizeof supported_xim_styles[0]);
2280 supported_list.supported_styles = supported_xim_styles;
2281 xic_style = best_xim_style (&supported_list,
2282 FRAME_X_XIM_STYLES (f));
2285 preedit_attr = XVaCreateNestedList (0,
2286 XNFontSet, xfs,
2287 XNForeground,
2288 FRAME_FOREGROUND_PIXEL (f),
2289 XNBackground,
2290 FRAME_BACKGROUND_PIXEL (f),
2291 (xic_style & XIMPreeditPosition
2292 ? XNSpotLocation
2293 : NULL),
2294 &spot,
2295 NULL);
2296 status_attr = XVaCreateNestedList (0,
2297 XNArea,
2298 &s_area,
2299 XNFontSet,
2300 xfs,
2301 XNForeground,
2302 FRAME_FOREGROUND_PIXEL (f),
2303 XNBackground,
2304 FRAME_BACKGROUND_PIXEL (f),
2305 NULL);
2307 xic = XCreateIC (xim,
2308 XNInputStyle, xic_style,
2309 XNClientWindow, FRAME_X_WINDOW (f),
2310 XNFocusWindow, FRAME_X_WINDOW (f),
2311 XNStatusAttributes, status_attr,
2312 XNPreeditAttributes, preedit_attr,
2313 NULL);
2314 XFree (preedit_attr);
2315 XFree (status_attr);
2318 FRAME_XIC (f) = xic;
2319 FRAME_XIC_STYLE (f) = xic_style;
2320 FRAME_XIC_FONTSET (f) = xfs;
2324 /* Destroy XIC and free XIC fontset of frame F, if any. */
2326 void
2327 free_frame_xic (f)
2328 struct frame *f;
2330 if (FRAME_XIC (f) == NULL)
2331 return;
2333 XDestroyIC (FRAME_XIC (f));
2334 xic_free_xfontset (f);
2336 FRAME_XIC (f) = NULL;
2340 /* Place preedit area for XIC of window W's frame to specified
2341 pixel position X/Y. X and Y are relative to window W. */
2343 void
2344 xic_set_preeditarea (w, x, y)
2345 struct window *w;
2346 int x, y;
2348 struct frame *f = XFRAME (w->frame);
2349 XVaNestedList attr;
2350 XPoint spot;
2352 spot.x = WINDOW_TO_FRAME_PIXEL_X (w, x) + WINDOW_LEFT_FRINGE_WIDTH (w);
2353 spot.y = WINDOW_TO_FRAME_PIXEL_Y (w, y) + FONT_BASE (FRAME_FONT (f));
2354 attr = XVaCreateNestedList (0, XNSpotLocation, &spot, NULL);
2355 XSetICValues (FRAME_XIC (f), XNPreeditAttributes, attr, NULL);
2356 XFree (attr);
2360 /* Place status area for XIC in bottom right corner of frame F.. */
2362 void
2363 xic_set_statusarea (f)
2364 struct frame *f;
2366 XIC xic = FRAME_XIC (f);
2367 XVaNestedList attr;
2368 XRectangle area;
2369 XRectangle *needed;
2371 /* Negotiate geometry of status area. If input method has existing
2372 status area, use its current size. */
2373 area.x = area.y = area.width = area.height = 0;
2374 attr = XVaCreateNestedList (0, XNAreaNeeded, &area, NULL);
2375 XSetICValues (xic, XNStatusAttributes, attr, NULL);
2376 XFree (attr);
2378 attr = XVaCreateNestedList (0, XNAreaNeeded, &needed, NULL);
2379 XGetICValues (xic, XNStatusAttributes, attr, NULL);
2380 XFree (attr);
2382 if (needed->width == 0) /* Use XNArea instead of XNAreaNeeded */
2384 attr = XVaCreateNestedList (0, XNArea, &needed, NULL);
2385 XGetICValues (xic, XNStatusAttributes, attr, NULL);
2386 XFree (attr);
2389 area.width = needed->width;
2390 area.height = needed->height;
2391 area.x = FRAME_PIXEL_WIDTH (f) - area.width - FRAME_INTERNAL_BORDER_WIDTH (f);
2392 area.y = (FRAME_PIXEL_HEIGHT (f) - area.height
2393 - FRAME_MENUBAR_HEIGHT (f)
2394 - FRAME_TOOLBAR_HEIGHT (f)
2395 - FRAME_INTERNAL_BORDER_WIDTH (f));
2396 XFree (needed);
2398 attr = XVaCreateNestedList (0, XNArea, &area, NULL);
2399 XSetICValues (xic, XNStatusAttributes, attr, NULL);
2400 XFree (attr);
2404 /* Set X fontset for XIC of frame F, using base font name
2405 BASE_FONTNAME. Called when a new Emacs fontset is chosen. */
2407 void
2408 xic_set_xfontset (f, base_fontname)
2409 struct frame *f;
2410 char *base_fontname;
2412 XVaNestedList attr;
2413 XFontSet xfs;
2415 xic_free_xfontset (f);
2417 xfs = xic_create_xfontset (f, base_fontname);
2419 attr = XVaCreateNestedList (0, XNFontSet, xfs, NULL);
2420 if (FRAME_XIC_STYLE (f) & XIMPreeditPosition)
2421 XSetICValues (FRAME_XIC (f), XNPreeditAttributes, attr, NULL);
2422 if (FRAME_XIC_STYLE (f) & XIMStatusArea)
2423 XSetICValues (FRAME_XIC (f), XNStatusAttributes, attr, NULL);
2424 XFree (attr);
2426 FRAME_XIC_FONTSET (f) = xfs;
2429 #endif /* HAVE_X_I18N */
2433 #ifdef USE_X_TOOLKIT
2435 /* Create and set up the X widget for frame F. */
2437 static void
2438 x_window (f, window_prompting, minibuffer_only)
2439 struct frame *f;
2440 long window_prompting;
2441 int minibuffer_only;
2443 XClassHint class_hints;
2444 XSetWindowAttributes attributes;
2445 unsigned long attribute_mask;
2446 Widget shell_widget;
2447 Widget pane_widget;
2448 Widget frame_widget;
2449 Arg al [25];
2450 int ac;
2452 BLOCK_INPUT;
2454 /* Use the resource name as the top-level widget name
2455 for looking up resources. Make a non-Lisp copy
2456 for the window manager, so GC relocation won't bother it.
2458 Elsewhere we specify the window name for the window manager. */
2461 char *str = (char *) SDATA (Vx_resource_name);
2462 f->namebuf = (char *) xmalloc (strlen (str) + 1);
2463 strcpy (f->namebuf, str);
2466 ac = 0;
2467 XtSetArg (al[ac], XtNallowShellResize, 1); ac++;
2468 XtSetArg (al[ac], XtNinput, 1); ac++;
2469 XtSetArg (al[ac], XtNmappedWhenManaged, 0); ac++;
2470 XtSetArg (al[ac], XtNborderWidth, f->border_width); ac++;
2471 XtSetArg (al[ac], XtNvisual, FRAME_X_VISUAL (f)); ac++;
2472 XtSetArg (al[ac], XtNdepth, FRAME_X_DISPLAY_INFO (f)->n_planes); ac++;
2473 XtSetArg (al[ac], XtNcolormap, FRAME_X_COLORMAP (f)); ac++;
2474 shell_widget = XtAppCreateShell (f->namebuf, EMACS_CLASS,
2475 applicationShellWidgetClass,
2476 FRAME_X_DISPLAY (f), al, ac);
2478 f->output_data.x->widget = shell_widget;
2479 /* maybe_set_screen_title_format (shell_widget); */
2481 pane_widget = lw_create_widget ("main", "pane", widget_id_tick++,
2482 (widget_value *) NULL,
2483 shell_widget, False,
2484 (lw_callback) NULL,
2485 (lw_callback) NULL,
2486 (lw_callback) NULL,
2487 (lw_callback) NULL);
2489 ac = 0;
2490 XtSetArg (al[ac], XtNvisual, FRAME_X_VISUAL (f)); ac++;
2491 XtSetArg (al[ac], XtNdepth, FRAME_X_DISPLAY_INFO (f)->n_planes); ac++;
2492 XtSetArg (al[ac], XtNcolormap, FRAME_X_COLORMAP (f)); ac++;
2493 XtSetValues (pane_widget, al, ac);
2494 f->output_data.x->column_widget = pane_widget;
2496 /* mappedWhenManaged to false tells to the paned window to not map/unmap
2497 the emacs screen when changing menubar. This reduces flickering. */
2499 ac = 0;
2500 XtSetArg (al[ac], XtNmappedWhenManaged, 0); ac++;
2501 XtSetArg (al[ac], XtNshowGrip, 0); ac++;
2502 XtSetArg (al[ac], XtNallowResize, 1); ac++;
2503 XtSetArg (al[ac], XtNresizeToPreferred, 1); ac++;
2504 XtSetArg (al[ac], XtNemacsFrame, f); ac++;
2505 XtSetArg (al[ac], XtNvisual, FRAME_X_VISUAL (f)); ac++;
2506 XtSetArg (al[ac], XtNdepth, FRAME_X_DISPLAY_INFO (f)->n_planes); ac++;
2507 XtSetArg (al[ac], XtNcolormap, FRAME_X_COLORMAP (f)); ac++;
2508 frame_widget = XtCreateWidget (f->namebuf, emacsFrameClass, pane_widget,
2509 al, ac);
2511 f->output_data.x->edit_widget = frame_widget;
2513 XtManageChild (frame_widget);
2515 /* Do some needed geometry management. */
2517 int len;
2518 char *tem, shell_position[32];
2519 Arg al[10];
2520 int ac = 0;
2521 int extra_borders = 0;
2522 int menubar_size
2523 = (f->output_data.x->menubar_widget
2524 ? (f->output_data.x->menubar_widget->core.height
2525 + f->output_data.x->menubar_widget->core.border_width)
2526 : 0);
2528 #if 0 /* Experimentally, we now get the right results
2529 for -geometry -0-0 without this. 24 Aug 96, rms. */
2530 if (FRAME_EXTERNAL_MENU_BAR (f))
2532 Dimension ibw = 0;
2533 XtVaGetValues (pane_widget, XtNinternalBorderWidth, &ibw, NULL);
2534 menubar_size += ibw;
2536 #endif
2538 f->output_data.x->menubar_height = menubar_size;
2540 #ifndef USE_LUCID
2541 /* Motif seems to need this amount added to the sizes
2542 specified for the shell widget. The Athena/Lucid widgets don't.
2543 Both conclusions reached experimentally. -- rms. */
2544 XtVaGetValues (f->output_data.x->edit_widget, XtNinternalBorderWidth,
2545 &extra_borders, NULL);
2546 extra_borders *= 2;
2547 #endif
2549 /* Convert our geometry parameters into a geometry string
2550 and specify it.
2551 Note that we do not specify here whether the position
2552 is a user-specified or program-specified one.
2553 We pass that information later, in x_wm_set_size_hints. */
2555 int left = f->left_pos;
2556 int xneg = window_prompting & XNegative;
2557 int top = f->top_pos;
2558 int yneg = window_prompting & YNegative;
2559 if (xneg)
2560 left = -left;
2561 if (yneg)
2562 top = -top;
2564 if (window_prompting & USPosition)
2565 sprintf (shell_position, "=%dx%d%c%d%c%d",
2566 FRAME_PIXEL_WIDTH (f) + extra_borders,
2567 FRAME_PIXEL_HEIGHT (f) + menubar_size + extra_borders,
2568 (xneg ? '-' : '+'), left,
2569 (yneg ? '-' : '+'), top);
2570 else
2572 sprintf (shell_position, "=%dx%d",
2573 FRAME_PIXEL_WIDTH (f) + extra_borders,
2574 FRAME_PIXEL_HEIGHT (f) + menubar_size + extra_borders);
2576 /* Setting x and y when the position is not specified in
2577 the geometry string will set program position in the WM hints.
2578 If Emacs had just one program position, we could set it in
2579 fallback resources, but since each make-frame call can specify
2580 different program positions, this is easier. */
2581 XtSetArg (al[ac], XtNx, left); ac++;
2582 XtSetArg (al[ac], XtNy, top); ac++;
2586 len = strlen (shell_position) + 1;
2587 /* We don't free this because we don't know whether
2588 it is safe to free it while the frame exists.
2589 It isn't worth the trouble of arranging to free it
2590 when the frame is deleted. */
2591 tem = (char *) xmalloc (len);
2592 strncpy (tem, shell_position, len);
2593 XtSetArg (al[ac], XtNgeometry, tem); ac++;
2594 XtSetValues (shell_widget, al, ac);
2597 XtManageChild (pane_widget);
2598 XtRealizeWidget (shell_widget);
2600 FRAME_X_WINDOW (f) = XtWindow (frame_widget);
2602 validate_x_resource_name ();
2604 class_hints.res_name = (char *) SDATA (Vx_resource_name);
2605 class_hints.res_class = (char *) SDATA (Vx_resource_class);
2606 XSetClassHint (FRAME_X_DISPLAY (f), XtWindow (shell_widget), &class_hints);
2608 #ifdef HAVE_X_I18N
2609 FRAME_XIC (f) = NULL;
2610 if (use_xim)
2611 create_frame_xic (f);
2612 #endif
2614 f->output_data.x->wm_hints.input = True;
2615 f->output_data.x->wm_hints.flags |= InputHint;
2616 XSetWMHints (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
2617 &f->output_data.x->wm_hints);
2619 hack_wm_protocols (f, shell_widget);
2621 #ifdef HACK_EDITRES
2622 XtAddEventHandler (shell_widget, 0, True, _XEditResCheckMessages, 0);
2623 #endif
2625 /* Do a stupid property change to force the server to generate a
2626 PropertyNotify event so that the event_stream server timestamp will
2627 be initialized to something relevant to the time we created the window.
2629 XChangeProperty (XtDisplay (frame_widget), XtWindow (frame_widget),
2630 FRAME_X_DISPLAY_INFO (f)->Xatom_wm_protocols,
2631 XA_ATOM, 32, PropModeAppend,
2632 (unsigned char*) NULL, 0);
2634 /* Make all the standard events reach the Emacs frame. */
2635 attributes.event_mask = STANDARD_EVENT_SET;
2637 #ifdef HAVE_X_I18N
2638 if (FRAME_XIC (f))
2640 /* XIM server might require some X events. */
2641 unsigned long fevent = NoEventMask;
2642 XGetICValues (FRAME_XIC (f), XNFilterEvents, &fevent, NULL);
2643 attributes.event_mask |= fevent;
2645 #endif /* HAVE_X_I18N */
2647 attribute_mask = CWEventMask;
2648 XChangeWindowAttributes (XtDisplay (shell_widget), XtWindow (shell_widget),
2649 attribute_mask, &attributes);
2651 XtMapWidget (frame_widget);
2653 /* x_set_name normally ignores requests to set the name if the
2654 requested name is the same as the current name. This is the one
2655 place where that assumption isn't correct; f->name is set, but
2656 the X server hasn't been told. */
2658 Lisp_Object name;
2659 int explicit = f->explicit_name;
2661 f->explicit_name = 0;
2662 name = f->name;
2663 f->name = Qnil;
2664 x_set_name (f, name, explicit);
2667 XDefineCursor (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
2668 f->output_data.x->text_cursor);
2670 UNBLOCK_INPUT;
2672 /* This is a no-op, except under Motif. Make sure main areas are
2673 set to something reasonable, in case we get an error later. */
2674 lw_set_main_areas (pane_widget, 0, frame_widget);
2677 #else /* not USE_X_TOOLKIT */
2678 #ifdef USE_GTK
2679 void
2680 x_window (f)
2681 FRAME_PTR f;
2683 if (! xg_create_frame_widgets (f))
2684 error ("Unable to create window");
2686 #ifdef HAVE_X_I18N
2687 FRAME_XIC (f) = NULL;
2688 if (use_xim)
2690 BLOCK_INPUT;
2691 create_frame_xic (f);
2692 if (FRAME_XIC (f))
2694 /* XIM server might require some X events. */
2695 unsigned long fevent = NoEventMask;
2696 XGetICValues (FRAME_XIC (f), XNFilterEvents, &fevent, NULL);
2698 if (fevent != NoEventMask)
2700 XSetWindowAttributes attributes;
2701 XWindowAttributes wattr;
2702 unsigned long attribute_mask;
2704 XGetWindowAttributes (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
2705 &wattr);
2706 attributes.event_mask = wattr.your_event_mask | fevent;
2707 attribute_mask = CWEventMask;
2708 XChangeWindowAttributes (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
2709 attribute_mask, &attributes);
2712 UNBLOCK_INPUT;
2714 #endif
2717 #else /*! USE_GTK */
2718 /* Create and set up the X window for frame F. */
2720 void
2721 x_window (f)
2722 struct frame *f;
2725 XClassHint class_hints;
2726 XSetWindowAttributes attributes;
2727 unsigned long attribute_mask;
2729 attributes.background_pixel = f->output_data.x->background_pixel;
2730 attributes.border_pixel = f->output_data.x->border_pixel;
2731 attributes.bit_gravity = StaticGravity;
2732 attributes.backing_store = NotUseful;
2733 attributes.save_under = True;
2734 attributes.event_mask = STANDARD_EVENT_SET;
2735 attributes.colormap = FRAME_X_COLORMAP (f);
2736 attribute_mask = (CWBackPixel | CWBorderPixel | CWBitGravity | CWEventMask
2737 | CWColormap);
2739 BLOCK_INPUT;
2740 FRAME_X_WINDOW (f)
2741 = XCreateWindow (FRAME_X_DISPLAY (f),
2742 f->output_data.x->parent_desc,
2743 f->left_pos,
2744 f->top_pos,
2745 FRAME_PIXEL_WIDTH (f), FRAME_PIXEL_HEIGHT (f),
2746 f->border_width,
2747 CopyFromParent, /* depth */
2748 InputOutput, /* class */
2749 FRAME_X_VISUAL (f),
2750 attribute_mask, &attributes);
2752 #ifdef HAVE_X_I18N
2753 if (use_xim)
2755 create_frame_xic (f);
2756 if (FRAME_XIC (f))
2758 /* XIM server might require some X events. */
2759 unsigned long fevent = NoEventMask;
2760 XGetICValues (FRAME_XIC (f), XNFilterEvents, &fevent, NULL);
2761 attributes.event_mask |= fevent;
2762 attribute_mask = CWEventMask;
2763 XChangeWindowAttributes (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
2764 attribute_mask, &attributes);
2767 #endif /* HAVE_X_I18N */
2769 validate_x_resource_name ();
2771 class_hints.res_name = (char *) SDATA (Vx_resource_name);
2772 class_hints.res_class = (char *) SDATA (Vx_resource_class);
2773 XSetClassHint (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f), &class_hints);
2775 /* The menubar is part of the ordinary display;
2776 it does not count in addition to the height of the window. */
2777 f->output_data.x->menubar_height = 0;
2779 /* This indicates that we use the "Passive Input" input model.
2780 Unless we do this, we don't get the Focus{In,Out} events that we
2781 need to draw the cursor correctly. Accursed bureaucrats.
2782 XWhipsAndChains (FRAME_X_DISPLAY (f), IronMaiden, &TheRack); */
2784 f->output_data.x->wm_hints.input = True;
2785 f->output_data.x->wm_hints.flags |= InputHint;
2786 XSetWMHints (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
2787 &f->output_data.x->wm_hints);
2788 f->output_data.x->wm_hints.icon_pixmap = None;
2790 /* Request "save yourself" and "delete window" commands from wm. */
2792 Atom protocols[2];
2793 protocols[0] = FRAME_X_DISPLAY_INFO (f)->Xatom_wm_delete_window;
2794 protocols[1] = FRAME_X_DISPLAY_INFO (f)->Xatom_wm_save_yourself;
2795 XSetWMProtocols (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f), protocols, 2);
2798 /* x_set_name normally ignores requests to set the name if the
2799 requested name is the same as the current name. This is the one
2800 place where that assumption isn't correct; f->name is set, but
2801 the X server hasn't been told. */
2803 Lisp_Object name;
2804 int explicit = f->explicit_name;
2806 f->explicit_name = 0;
2807 name = f->name;
2808 f->name = Qnil;
2809 x_set_name (f, name, explicit);
2812 XDefineCursor (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
2813 f->output_data.x->text_cursor);
2815 UNBLOCK_INPUT;
2817 if (FRAME_X_WINDOW (f) == 0)
2818 error ("Unable to create window");
2821 #endif /* not USE_GTK */
2822 #endif /* not USE_X_TOOLKIT */
2824 /* Verify that the icon position args for this window are valid. */
2826 static void
2827 x_icon_verify (f, parms)
2828 struct frame *f;
2829 Lisp_Object parms;
2831 Lisp_Object icon_x, icon_y;
2833 /* Set the position of the icon. Note that twm groups all
2834 icons in an icon window. */
2835 icon_x = x_frame_get_and_record_arg (f, parms, Qicon_left, 0, 0, RES_TYPE_NUMBER);
2836 icon_y = x_frame_get_and_record_arg (f, parms, Qicon_top, 0, 0, RES_TYPE_NUMBER);
2837 if (!EQ (icon_x, Qunbound) && !EQ (icon_y, Qunbound))
2839 CHECK_NUMBER (icon_x);
2840 CHECK_NUMBER (icon_y);
2842 else if (!EQ (icon_x, Qunbound) || !EQ (icon_y, Qunbound))
2843 error ("Both left and top icon corners of icon must be specified");
2846 /* Handle the icon stuff for this window. Perhaps later we might
2847 want an x_set_icon_position which can be called interactively as
2848 well. */
2850 static void
2851 x_icon (f, parms)
2852 struct frame *f;
2853 Lisp_Object parms;
2855 Lisp_Object icon_x, icon_y;
2856 struct x_display_info *dpyinfo = FRAME_X_DISPLAY_INFO (f);
2858 /* Set the position of the icon. Note that twm groups all
2859 icons in an icon window. */
2860 icon_x = x_frame_get_and_record_arg (f, parms, Qicon_left, 0, 0, RES_TYPE_NUMBER);
2861 icon_y = x_frame_get_and_record_arg (f, parms, Qicon_top, 0, 0, RES_TYPE_NUMBER);
2862 if (!EQ (icon_x, Qunbound) && !EQ (icon_y, Qunbound))
2864 CHECK_NUMBER (icon_x);
2865 CHECK_NUMBER (icon_y);
2867 else if (!EQ (icon_x, Qunbound) || !EQ (icon_y, Qunbound))
2868 error ("Both left and top icon corners of icon must be specified");
2870 BLOCK_INPUT;
2872 if (! EQ (icon_x, Qunbound))
2873 x_wm_set_icon_position (f, XINT (icon_x), XINT (icon_y));
2875 #if 0 /* x_get_arg removes the visibility parameter as a side effect,
2876 but x_create_frame still needs it. */
2877 /* Start up iconic or window? */
2878 x_wm_set_window_state
2879 (f, (EQ (x_get_arg (dpyinfo, parms, Qvisibility, 0, 0, RES_TYPE_SYMBOL),
2880 Qicon)
2881 ? IconicState
2882 : NormalState));
2883 #endif
2885 x_text_icon (f, (char *) SDATA ((!NILP (f->icon_name)
2886 ? f->icon_name
2887 : f->name)));
2889 UNBLOCK_INPUT;
2892 /* Make the GCs needed for this window, setting the
2893 background, border and mouse colors; also create the
2894 mouse cursor and the gray border tile. */
2896 static char cursor_bits[] =
2898 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
2899 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
2900 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
2901 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00
2904 static void
2905 x_make_gc (f)
2906 struct frame *f;
2908 XGCValues gc_values;
2910 BLOCK_INPUT;
2912 /* Create the GCs of this frame.
2913 Note that many default values are used. */
2915 /* Normal video */
2916 gc_values.font = FRAME_FONT (f)->fid;
2917 gc_values.foreground = f->output_data.x->foreground_pixel;
2918 gc_values.background = f->output_data.x->background_pixel;
2919 gc_values.line_width = 0; /* Means 1 using fast algorithm. */
2920 f->output_data.x->normal_gc
2921 = XCreateGC (FRAME_X_DISPLAY (f),
2922 FRAME_X_WINDOW (f),
2923 GCLineWidth | GCFont | GCForeground | GCBackground,
2924 &gc_values);
2926 /* Reverse video style. */
2927 gc_values.foreground = f->output_data.x->background_pixel;
2928 gc_values.background = f->output_data.x->foreground_pixel;
2929 f->output_data.x->reverse_gc
2930 = XCreateGC (FRAME_X_DISPLAY (f),
2931 FRAME_X_WINDOW (f),
2932 GCFont | GCForeground | GCBackground | GCLineWidth,
2933 &gc_values);
2935 /* Cursor has cursor-color background, background-color foreground. */
2936 gc_values.foreground = f->output_data.x->background_pixel;
2937 gc_values.background = f->output_data.x->cursor_pixel;
2938 gc_values.fill_style = FillOpaqueStippled;
2939 gc_values.stipple
2940 = XCreateBitmapFromData (FRAME_X_DISPLAY (f),
2941 FRAME_X_DISPLAY_INFO (f)->root_window,
2942 cursor_bits, 16, 16);
2943 f->output_data.x->cursor_gc
2944 = XCreateGC (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
2945 (GCFont | GCForeground | GCBackground
2946 | GCFillStyle /* | GCStipple */ | GCLineWidth),
2947 &gc_values);
2949 /* Reliefs. */
2950 f->output_data.x->white_relief.gc = 0;
2951 f->output_data.x->black_relief.gc = 0;
2953 /* Create the gray border tile used when the pointer is not in
2954 the frame. Since this depends on the frame's pixel values,
2955 this must be done on a per-frame basis. */
2956 f->output_data.x->border_tile
2957 = (XCreatePixmapFromBitmapData
2958 (FRAME_X_DISPLAY (f), FRAME_X_DISPLAY_INFO (f)->root_window,
2959 gray_bits, gray_width, gray_height,
2960 f->output_data.x->foreground_pixel,
2961 f->output_data.x->background_pixel,
2962 DefaultDepth (FRAME_X_DISPLAY (f), FRAME_X_SCREEN_NUMBER (f))));
2964 UNBLOCK_INPUT;
2968 /* Free what was was allocated in x_make_gc. */
2970 void
2971 x_free_gcs (f)
2972 struct frame *f;
2974 Display *dpy = FRAME_X_DISPLAY (f);
2976 BLOCK_INPUT;
2978 if (f->output_data.x->normal_gc)
2980 XFreeGC (dpy, f->output_data.x->normal_gc);
2981 f->output_data.x->normal_gc = 0;
2984 if (f->output_data.x->reverse_gc)
2986 XFreeGC (dpy, f->output_data.x->reverse_gc);
2987 f->output_data.x->reverse_gc = 0;
2990 if (f->output_data.x->cursor_gc)
2992 XFreeGC (dpy, f->output_data.x->cursor_gc);
2993 f->output_data.x->cursor_gc = 0;
2996 if (f->output_data.x->border_tile)
2998 XFreePixmap (dpy, f->output_data.x->border_tile);
2999 f->output_data.x->border_tile = 0;
3002 UNBLOCK_INPUT;
3006 /* Handler for signals raised during x_create_frame and
3007 x_create_top_frame. FRAME is the frame which is partially
3008 constructed. */
3010 static Lisp_Object
3011 unwind_create_frame (frame)
3012 Lisp_Object frame;
3014 struct frame *f = XFRAME (frame);
3016 /* If frame is ``official'', nothing to do. */
3017 if (!CONSP (Vframe_list) || !EQ (XCAR (Vframe_list), frame))
3019 #if GLYPH_DEBUG
3020 struct x_display_info *dpyinfo = FRAME_X_DISPLAY_INFO (f);
3021 #endif
3023 x_free_frame_resources (f);
3025 #if GLYPH_DEBUG
3026 /* Check that reference counts are indeed correct. */
3027 xassert (dpyinfo->reference_count == dpyinfo_refcount);
3028 xassert (dpyinfo->image_cache->refcount == image_cache_refcount);
3029 #endif
3030 return Qt;
3033 return Qnil;
3037 DEFUN ("x-create-frame", Fx_create_frame, Sx_create_frame,
3038 1, 1, 0,
3039 doc: /* Make a new X window, which is called a "frame" in Emacs terms.
3040 Return an Emacs frame object.
3041 ALIST is an alist of frame parameters.
3042 If the parameters specify that the frame should not have a minibuffer,
3043 and do not specify a specific minibuffer window to use,
3044 then `default-minibuffer-frame' must be a frame whose minibuffer can
3045 be shared by the new frame.
3047 This function is an internal primitive--use `make-frame' instead. */)
3048 (parms)
3049 Lisp_Object parms;
3051 struct frame *f;
3052 Lisp_Object frame, tem;
3053 Lisp_Object name;
3054 int minibuffer_only = 0;
3055 long window_prompting = 0;
3056 int width, height;
3057 int count = SPECPDL_INDEX ();
3058 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
3059 Lisp_Object display;
3060 struct x_display_info *dpyinfo = NULL;
3061 Lisp_Object parent;
3062 struct kboard *kb;
3064 check_x ();
3066 parms = Fcopy_alist (parms);
3068 /* Use this general default value to start with
3069 until we know if this frame has a specified name. */
3070 Vx_resource_name = Vinvocation_name;
3072 display = x_get_arg (dpyinfo, parms, Qdisplay, 0, 0, RES_TYPE_STRING);
3073 if (EQ (display, Qunbound))
3074 display = Qnil;
3075 dpyinfo = check_x_display_info (display);
3076 #ifdef MULTI_KBOARD
3077 kb = dpyinfo->kboard;
3078 #else
3079 kb = &the_only_kboard;
3080 #endif
3082 name = x_get_arg (dpyinfo, parms, Qname, "name", "Name", RES_TYPE_STRING);
3083 if (!STRINGP (name)
3084 && ! EQ (name, Qunbound)
3085 && ! NILP (name))
3086 error ("Invalid frame name--not a string or nil");
3088 if (STRINGP (name))
3089 Vx_resource_name = name;
3091 /* See if parent window is specified. */
3092 parent = x_get_arg (dpyinfo, parms, Qparent_id, NULL, NULL, RES_TYPE_NUMBER);
3093 if (EQ (parent, Qunbound))
3094 parent = Qnil;
3095 if (! NILP (parent))
3096 CHECK_NUMBER (parent);
3098 /* make_frame_without_minibuffer can run Lisp code and garbage collect. */
3099 /* No need to protect DISPLAY because that's not used after passing
3100 it to make_frame_without_minibuffer. */
3101 frame = Qnil;
3102 GCPRO4 (parms, parent, name, frame);
3103 tem = x_get_arg (dpyinfo, parms, Qminibuffer, "minibuffer", "Minibuffer",
3104 RES_TYPE_SYMBOL);
3105 if (EQ (tem, Qnone) || NILP (tem))
3106 f = make_frame_without_minibuffer (Qnil, kb, display);
3107 else if (EQ (tem, Qonly))
3109 f = make_minibuffer_frame ();
3110 minibuffer_only = 1;
3112 else if (WINDOWP (tem))
3113 f = make_frame_without_minibuffer (tem, kb, display);
3114 else
3115 f = make_frame (1);
3117 XSETFRAME (frame, f);
3119 /* Note that X Windows does support scroll bars. */
3120 FRAME_CAN_HAVE_SCROLL_BARS (f) = 1;
3122 f->output_method = output_x_window;
3123 f->output_data.x = (struct x_output *) xmalloc (sizeof (struct x_output));
3124 bzero (f->output_data.x, sizeof (struct x_output));
3125 f->output_data.x->icon_bitmap = -1;
3126 FRAME_FONTSET (f) = -1;
3127 f->output_data.x->scroll_bar_foreground_pixel = -1;
3128 f->output_data.x->scroll_bar_background_pixel = -1;
3129 #ifdef USE_TOOLKIT_SCROLL_BARS
3130 f->output_data.x->scroll_bar_top_shadow_pixel = -1;
3131 f->output_data.x->scroll_bar_bottom_shadow_pixel = -1;
3132 #endif /* USE_TOOLKIT_SCROLL_BARS */
3134 f->icon_name
3135 = x_get_arg (dpyinfo, parms, Qicon_name, "iconName", "Title",
3136 RES_TYPE_STRING);
3137 if (! STRINGP (f->icon_name))
3138 f->icon_name = Qnil;
3140 FRAME_X_DISPLAY_INFO (f) = dpyinfo;
3142 /* With FRAME_X_DISPLAY_INFO set up, this unwind-protect is safe. */
3143 record_unwind_protect (unwind_create_frame, frame);
3144 #if GLYPH_DEBUG
3145 image_cache_refcount = FRAME_X_IMAGE_CACHE (f)->refcount;
3146 dpyinfo_refcount = dpyinfo->reference_count;
3147 #endif /* GLYPH_DEBUG */
3148 #ifdef MULTI_KBOARD
3149 FRAME_KBOARD (f) = kb;
3150 #endif
3152 /* These colors will be set anyway later, but it's important
3153 to get the color reference counts right, so initialize them! */
3155 Lisp_Object black;
3156 struct gcpro gcpro1;
3158 /* Function x_decode_color can signal an error. Make
3159 sure to initialize color slots so that we won't try
3160 to free colors we haven't allocated. */
3161 f->output_data.x->foreground_pixel = -1;
3162 f->output_data.x->background_pixel = -1;
3163 f->output_data.x->cursor_pixel = -1;
3164 f->output_data.x->cursor_foreground_pixel = -1;
3165 f->output_data.x->border_pixel = -1;
3166 f->output_data.x->mouse_pixel = -1;
3168 black = build_string ("black");
3169 GCPRO1 (black);
3170 f->output_data.x->foreground_pixel
3171 = x_decode_color (f, black, BLACK_PIX_DEFAULT (f));
3172 f->output_data.x->background_pixel
3173 = x_decode_color (f, black, BLACK_PIX_DEFAULT (f));
3174 f->output_data.x->cursor_pixel
3175 = x_decode_color (f, black, BLACK_PIX_DEFAULT (f));
3176 f->output_data.x->cursor_foreground_pixel
3177 = x_decode_color (f, black, BLACK_PIX_DEFAULT (f));
3178 f->output_data.x->border_pixel
3179 = x_decode_color (f, black, BLACK_PIX_DEFAULT (f));
3180 f->output_data.x->mouse_pixel
3181 = x_decode_color (f, black, BLACK_PIX_DEFAULT (f));
3182 UNGCPRO;
3185 /* Specify the parent under which to make this X window. */
3187 if (!NILP (parent))
3189 f->output_data.x->parent_desc = (Window) XFASTINT (parent);
3190 f->output_data.x->explicit_parent = 1;
3192 else
3194 f->output_data.x->parent_desc = FRAME_X_DISPLAY_INFO (f)->root_window;
3195 f->output_data.x->explicit_parent = 0;
3198 /* Set the name; the functions to which we pass f expect the name to
3199 be set. */
3200 if (EQ (name, Qunbound) || NILP (name))
3202 f->name = build_string (dpyinfo->x_id_name);
3203 f->explicit_name = 0;
3205 else
3207 f->name = name;
3208 f->explicit_name = 1;
3209 /* use the frame's title when getting resources for this frame. */
3210 specbind (Qx_resource_name, name);
3213 /* Extract the window parameters from the supplied values
3214 that are needed to determine window geometry. */
3216 Lisp_Object font;
3218 font = x_get_arg (dpyinfo, parms, Qfont, "font", "Font", RES_TYPE_STRING);
3220 BLOCK_INPUT;
3221 /* First, try whatever font the caller has specified. */
3222 if (STRINGP (font))
3224 tem = Fquery_fontset (font, Qnil);
3225 if (STRINGP (tem))
3226 font = x_new_fontset (f, SDATA (tem));
3227 else
3228 font = x_new_font (f, SDATA (font));
3231 /* Try out a font which we hope has bold and italic variations. */
3232 if (!STRINGP (font))
3233 font = x_new_font (f, "-adobe-courier-medium-r-*-*-*-120-*-*-*-*-iso8859-1");
3234 if (!STRINGP (font))
3235 font = x_new_font (f, "-misc-fixed-medium-r-normal-*-*-140-*-*-c-*-iso8859-1");
3236 if (! STRINGP (font))
3237 font = x_new_font (f, "-*-*-medium-r-normal-*-*-140-*-*-c-*-iso8859-1");
3238 if (! STRINGP (font))
3239 /* This was formerly the first thing tried, but it finds too many fonts
3240 and takes too long. */
3241 font = x_new_font (f, "-*-*-medium-r-*-*-*-*-*-*-c-*-iso8859-1");
3242 /* If those didn't work, look for something which will at least work. */
3243 if (! STRINGP (font))
3244 font = x_new_font (f, "-*-fixed-*-*-*-*-*-140-*-*-c-*-iso8859-1");
3245 UNBLOCK_INPUT;
3246 if (! STRINGP (font))
3247 font = build_string ("fixed");
3249 x_set_frame_parameters (f, Fcons (Fcons (Qfont, font), Qnil));
3252 #ifdef USE_LUCID
3253 /* Prevent lwlib/xlwmenu.c from crashing because of a bug
3254 whereby it fails to get any font. */
3255 xlwmenu_default_font = FRAME_FONT (f);
3256 #endif
3258 x_default_parameter (f, parms, Qborder_width, make_number (2),
3259 "borderWidth", "BorderWidth", RES_TYPE_NUMBER);
3261 /* This defaults to 1 in order to match xterm. We recognize either
3262 internalBorderWidth or internalBorder (which is what xterm calls
3263 it). */
3264 if (NILP (Fassq (Qinternal_border_width, parms)))
3266 Lisp_Object value;
3268 value = x_get_arg (dpyinfo, parms, Qinternal_border_width,
3269 "internalBorder", "internalBorder", RES_TYPE_NUMBER);
3270 if (! EQ (value, Qunbound))
3271 parms = Fcons (Fcons (Qinternal_border_width, value),
3272 parms);
3274 x_default_parameter (f, parms, Qinternal_border_width, make_number (1),
3275 "internalBorderWidth", "internalBorderWidth",
3276 RES_TYPE_NUMBER);
3277 x_default_parameter (f, parms, Qvertical_scroll_bars, Qleft,
3278 "verticalScrollBars", "ScrollBars",
3279 RES_TYPE_SYMBOL);
3281 /* Also do the stuff which must be set before the window exists. */
3282 x_default_parameter (f, parms, Qforeground_color, build_string ("black"),
3283 "foreground", "Foreground", RES_TYPE_STRING);
3284 x_default_parameter (f, parms, Qbackground_color, build_string ("white"),
3285 "background", "Background", RES_TYPE_STRING);
3286 x_default_parameter (f, parms, Qmouse_color, build_string ("black"),
3287 "pointerColor", "Foreground", RES_TYPE_STRING);
3288 x_default_parameter (f, parms, Qcursor_color, build_string ("black"),
3289 "cursorColor", "Foreground", RES_TYPE_STRING);
3290 x_default_parameter (f, parms, Qborder_color, build_string ("black"),
3291 "borderColor", "BorderColor", RES_TYPE_STRING);
3292 x_default_parameter (f, parms, Qscreen_gamma, Qnil,
3293 "screenGamma", "ScreenGamma", RES_TYPE_FLOAT);
3294 x_default_parameter (f, parms, Qline_spacing, Qnil,
3295 "lineSpacing", "LineSpacing", RES_TYPE_NUMBER);
3296 x_default_parameter (f, parms, Qleft_fringe, Qnil,
3297 "leftFringe", "LeftFringe", RES_TYPE_NUMBER);
3298 x_default_parameter (f, parms, Qright_fringe, Qnil,
3299 "rightFringe", "RightFringe", RES_TYPE_NUMBER);
3301 x_default_scroll_bar_color_parameter (f, parms, Qscroll_bar_foreground,
3302 "scrollBarForeground",
3303 "ScrollBarForeground", 1);
3304 x_default_scroll_bar_color_parameter (f, parms, Qscroll_bar_background,
3305 "scrollBarBackground",
3306 "ScrollBarBackground", 0);
3308 /* Init faces before x_default_parameter is called for scroll-bar
3309 parameters because that function calls x_set_scroll_bar_width,
3310 which calls change_frame_size, which calls Fset_window_buffer,
3311 which runs hooks, which call Fvertical_motion. At the end, we
3312 end up in init_iterator with a null face cache, which should not
3313 happen. */
3314 init_frame_faces (f);
3316 x_default_parameter (f, parms, Qmenu_bar_lines, make_number (1),
3317 "menuBar", "MenuBar", RES_TYPE_NUMBER);
3318 x_default_parameter (f, parms, Qtool_bar_lines, make_number (1),
3319 "toolBar", "ToolBar", RES_TYPE_NUMBER);
3320 x_default_parameter (f, parms, Qbuffer_predicate, Qnil,
3321 "bufferPredicate", "BufferPredicate",
3322 RES_TYPE_SYMBOL);
3323 x_default_parameter (f, parms, Qtitle, Qnil,
3324 "title", "Title", RES_TYPE_STRING);
3325 x_default_parameter (f, parms, Qwait_for_wm, Qt,
3326 "waitForWM", "WaitForWM", RES_TYPE_BOOLEAN);
3327 x_default_parameter (f, parms, Qfullscreen, Qnil,
3328 "fullscreen", "Fullscreen", RES_TYPE_SYMBOL);
3330 f->output_data.x->parent_desc = FRAME_X_DISPLAY_INFO (f)->root_window;
3332 /* Compute the size of the X window. */
3333 window_prompting = x_figure_window_size (f, parms, 1);
3335 tem = x_get_arg (dpyinfo, parms, Qunsplittable, 0, 0, RES_TYPE_BOOLEAN);
3336 f->no_split = minibuffer_only || EQ (tem, Qt);
3338 x_icon_verify (f, parms);
3340 /* Create the X widget or window. */
3341 #ifdef USE_X_TOOLKIT
3342 x_window (f, window_prompting, minibuffer_only);
3343 #else
3344 x_window (f);
3345 #endif
3347 x_icon (f, parms);
3348 x_make_gc (f);
3350 /* Now consider the frame official. */
3351 FRAME_X_DISPLAY_INFO (f)->reference_count++;
3352 Vframe_list = Fcons (frame, Vframe_list);
3354 /* We need to do this after creating the X window, so that the
3355 icon-creation functions can say whose icon they're describing. */
3356 x_default_parameter (f, parms, Qicon_type, Qt,
3357 "bitmapIcon", "BitmapIcon", RES_TYPE_SYMBOL);
3359 x_default_parameter (f, parms, Qauto_raise, Qnil,
3360 "autoRaise", "AutoRaiseLower", RES_TYPE_BOOLEAN);
3361 x_default_parameter (f, parms, Qauto_lower, Qnil,
3362 "autoLower", "AutoRaiseLower", RES_TYPE_BOOLEAN);
3363 x_default_parameter (f, parms, Qcursor_type, Qbox,
3364 "cursorType", "CursorType", RES_TYPE_SYMBOL);
3365 x_default_parameter (f, parms, Qscroll_bar_width, Qnil,
3366 "scrollBarWidth", "ScrollBarWidth",
3367 RES_TYPE_NUMBER);
3369 /* Dimensions, especially FRAME_LINES (f), must be done via change_frame_size.
3370 Change will not be effected unless different from the current
3371 FRAME_LINES (f). */
3372 width = FRAME_COLS (f);
3373 height = FRAME_LINES (f);
3375 SET_FRAME_COLS (f, 0);
3376 FRAME_LINES (f) = 0;
3377 change_frame_size (f, height, width, 1, 0, 0);
3379 #if defined (USE_X_TOOLKIT) || defined (USE_GTK)
3380 /* Create the menu bar. */
3381 if (!minibuffer_only && FRAME_EXTERNAL_MENU_BAR (f))
3383 /* If this signals an error, we haven't set size hints for the
3384 frame and we didn't make it visible. */
3385 initialize_frame_menubar (f);
3387 #ifndef USE_GTK
3388 /* This is a no-op, except under Motif where it arranges the
3389 main window for the widgets on it. */
3390 lw_set_main_areas (f->output_data.x->column_widget,
3391 f->output_data.x->menubar_widget,
3392 f->output_data.x->edit_widget);
3393 #endif /* not USE_GTK */
3395 #endif /* USE_X_TOOLKIT || USE_GTK */
3397 /* Tell the server what size and position, etc, we want, and how
3398 badly we want them. This should be done after we have the menu
3399 bar so that its size can be taken into account. */
3400 BLOCK_INPUT;
3401 x_wm_set_size_hint (f, window_prompting, 0);
3402 UNBLOCK_INPUT;
3404 /* Make the window appear on the frame and enable display, unless
3405 the caller says not to. However, with explicit parent, Emacs
3406 cannot control visibility, so don't try. */
3407 if (! f->output_data.x->explicit_parent)
3409 Lisp_Object visibility;
3411 visibility = x_get_arg (dpyinfo, parms, Qvisibility, 0, 0,
3412 RES_TYPE_SYMBOL);
3413 if (EQ (visibility, Qunbound))
3414 visibility = Qt;
3416 if (EQ (visibility, Qicon))
3417 x_iconify_frame (f);
3418 else if (! NILP (visibility))
3419 x_make_frame_visible (f);
3420 else
3421 /* Must have been Qnil. */
3425 /* Set the WM leader property. GTK does this itself, so this is not
3426 needed when using GTK. */
3427 if (dpyinfo->client_leader_window != 0)
3429 BLOCK_INPUT;
3430 XChangeProperty (FRAME_X_DISPLAY (f),
3431 FRAME_OUTER_WINDOW (f),
3432 dpyinfo->Xatom_wm_client_leader,
3433 XA_WINDOW, 32, PropModeReplace,
3434 (unsigned char *) &dpyinfo->client_leader_window, 1);
3435 UNBLOCK_INPUT;
3438 /* Initialize `default-minibuffer-frame' in case this is the first
3439 frame on this display device. */
3440 if (FRAME_HAS_MINIBUF_P (f)
3441 && (!FRAMEP (kb->Vdefault_minibuffer_frame)
3442 || !FRAME_LIVE_P (XFRAME (kb->Vdefault_minibuffer_frame))))
3443 kb->Vdefault_minibuffer_frame = frame;
3445 /* All remaining specified parameters, which have not been "used"
3446 by x_get_arg and friends, now go in the misc. alist of the frame. */
3447 for (tem = parms; !NILP (tem); tem = XCDR (tem))
3448 if (CONSP (XCAR (tem)) && !NILP (XCAR (XCAR (tem))))
3449 f->param_alist = Fcons (XCAR (tem), f->param_alist);
3451 UNGCPRO;
3453 /* Make sure windows on this frame appear in calls to next-window
3454 and similar functions. */
3455 Vwindow_list = Qnil;
3457 return unbind_to (count, frame);
3461 /* FRAME is used only to get a handle on the X display. We don't pass the
3462 display info directly because we're called from frame.c, which doesn't
3463 know about that structure. */
3465 Lisp_Object
3466 x_get_focus_frame (frame)
3467 struct frame *frame;
3469 struct x_display_info *dpyinfo = FRAME_X_DISPLAY_INFO (frame);
3470 Lisp_Object xfocus;
3471 if (! dpyinfo->x_focus_frame)
3472 return Qnil;
3474 XSETFRAME (xfocus, dpyinfo->x_focus_frame);
3475 return xfocus;
3479 /* In certain situations, when the window manager follows a
3480 click-to-focus policy, there seems to be no way around calling
3481 XSetInputFocus to give another frame the input focus .
3483 In an ideal world, XSetInputFocus should generally be avoided so
3484 that applications don't interfere with the window manager's focus
3485 policy. But I think it's okay to use when it's clearly done
3486 following a user-command. */
3488 DEFUN ("x-focus-frame", Fx_focus_frame, Sx_focus_frame, 1, 1, 0,
3489 doc: /* Set the input focus to FRAME.
3490 FRAME nil means use the selected frame. */)
3491 (frame)
3492 Lisp_Object frame;
3494 struct frame *f = check_x_frame (frame);
3495 Display *dpy = FRAME_X_DISPLAY (f);
3497 BLOCK_INPUT;
3498 x_catch_errors (dpy);
3499 XSetInputFocus (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
3500 RevertToParent, CurrentTime);
3501 x_uncatch_errors ();
3502 UNBLOCK_INPUT;
3504 return Qnil;
3508 DEFUN ("xw-color-defined-p", Fxw_color_defined_p, Sxw_color_defined_p, 1, 2, 0,
3509 doc: /* Internal function called by `color-defined-p', which see. */)
3510 (color, frame)
3511 Lisp_Object color, frame;
3513 XColor foo;
3514 FRAME_PTR f = check_x_frame (frame);
3516 CHECK_STRING (color);
3518 if (x_defined_color (f, SDATA (color), &foo, 0))
3519 return Qt;
3520 else
3521 return Qnil;
3524 DEFUN ("xw-color-values", Fxw_color_values, Sxw_color_values, 1, 2, 0,
3525 doc: /* Internal function called by `color-values', which see. */)
3526 (color, frame)
3527 Lisp_Object color, frame;
3529 XColor foo;
3530 FRAME_PTR f = check_x_frame (frame);
3532 CHECK_STRING (color);
3534 if (x_defined_color (f, SDATA (color), &foo, 0))
3535 return list3 (make_number (foo.red),
3536 make_number (foo.green),
3537 make_number (foo.blue));
3538 else
3539 return Qnil;
3542 DEFUN ("xw-display-color-p", Fxw_display_color_p, Sxw_display_color_p, 0, 1, 0,
3543 doc: /* Internal function called by `display-color-p', which see. */)
3544 (display)
3545 Lisp_Object display;
3547 struct x_display_info *dpyinfo = check_x_display_info (display);
3549 if (dpyinfo->n_planes <= 2)
3550 return Qnil;
3552 switch (dpyinfo->visual->class)
3554 case StaticColor:
3555 case PseudoColor:
3556 case TrueColor:
3557 case DirectColor:
3558 return Qt;
3560 default:
3561 return Qnil;
3565 DEFUN ("x-display-grayscale-p", Fx_display_grayscale_p, Sx_display_grayscale_p,
3566 0, 1, 0,
3567 doc: /* Return t if the X display supports shades of gray.
3568 Note that color displays do support shades of gray.
3569 The optional argument DISPLAY specifies which display to ask about.
3570 DISPLAY should be either a frame or a display name (a string).
3571 If omitted or nil, that stands for the selected frame's display. */)
3572 (display)
3573 Lisp_Object display;
3575 struct x_display_info *dpyinfo = check_x_display_info (display);
3577 if (dpyinfo->n_planes <= 1)
3578 return Qnil;
3580 switch (dpyinfo->visual->class)
3582 case StaticColor:
3583 case PseudoColor:
3584 case TrueColor:
3585 case DirectColor:
3586 case StaticGray:
3587 case GrayScale:
3588 return Qt;
3590 default:
3591 return Qnil;
3595 DEFUN ("x-display-pixel-width", Fx_display_pixel_width, Sx_display_pixel_width,
3596 0, 1, 0,
3597 doc: /* Return the width in pixels of the X display DISPLAY.
3598 The optional argument DISPLAY specifies which display to ask about.
3599 DISPLAY should be either a frame or a display name (a string).
3600 If omitted or nil, that stands for the selected frame's display. */)
3601 (display)
3602 Lisp_Object display;
3604 struct x_display_info *dpyinfo = check_x_display_info (display);
3606 return make_number (dpyinfo->width);
3609 DEFUN ("x-display-pixel-height", Fx_display_pixel_height,
3610 Sx_display_pixel_height, 0, 1, 0,
3611 doc: /* Return the height in pixels of the X display DISPLAY.
3612 The optional argument DISPLAY specifies which display to ask about.
3613 DISPLAY should be either a frame or a display name (a string).
3614 If omitted or nil, that stands for the selected frame's display. */)
3615 (display)
3616 Lisp_Object display;
3618 struct x_display_info *dpyinfo = check_x_display_info (display);
3620 return make_number (dpyinfo->height);
3623 DEFUN ("x-display-planes", Fx_display_planes, Sx_display_planes,
3624 0, 1, 0,
3625 doc: /* Return the number of bitplanes of the X display DISPLAY.
3626 The optional argument DISPLAY specifies which display to ask about.
3627 DISPLAY should be either a frame or a display name (a string).
3628 If omitted or nil, that stands for the selected frame's display. */)
3629 (display)
3630 Lisp_Object display;
3632 struct x_display_info *dpyinfo = check_x_display_info (display);
3634 return make_number (dpyinfo->n_planes);
3637 DEFUN ("x-display-color-cells", Fx_display_color_cells, Sx_display_color_cells,
3638 0, 1, 0,
3639 doc: /* Return the number of color cells of the X display DISPLAY.
3640 The optional argument DISPLAY specifies which display to ask about.
3641 DISPLAY should be either a frame or a display name (a string).
3642 If omitted or nil, that stands for the selected frame's display. */)
3643 (display)
3644 Lisp_Object display;
3646 struct x_display_info *dpyinfo = check_x_display_info (display);
3648 int nr_planes = DisplayPlanes (dpyinfo->display,
3649 XScreenNumberOfScreen (dpyinfo->screen));
3651 /* Truncate nr_planes to 24 to avoid integer overflow.
3652 Some displays says 32, but only 24 bits are actually significant.
3653 There are only very few and rare video cards that have more than
3654 24 significant bits. Also 24 bits is more than 16 million colors,
3655 it "should be enough for everyone". */
3656 if (nr_planes > 24) nr_planes = 24;
3658 return make_number (1 << nr_planes);
3661 DEFUN ("x-server-max-request-size", Fx_server_max_request_size,
3662 Sx_server_max_request_size,
3663 0, 1, 0,
3664 doc: /* Return the maximum request size of the X server of display DISPLAY.
3665 The optional argument DISPLAY specifies which display to ask about.
3666 DISPLAY should be either a frame or a display name (a string).
3667 If omitted or nil, that stands for the selected frame's display. */)
3668 (display)
3669 Lisp_Object display;
3671 struct x_display_info *dpyinfo = check_x_display_info (display);
3673 return make_number (MAXREQUEST (dpyinfo->display));
3676 DEFUN ("x-server-vendor", Fx_server_vendor, Sx_server_vendor, 0, 1, 0,
3677 doc: /* Return the "vendor ID" string of the X server of display DISPLAY.
3678 \(Labelling every distributor as a "vendor" embodies the false assumption
3679 that operating systems cannot be developed and distributed noncommercially.)
3680 The optional argument DISPLAY specifies which display to ask about.
3681 DISPLAY should be either a frame or a display name (a string).
3682 If omitted or nil, that stands for the selected frame's display. */)
3683 (display)
3684 Lisp_Object display;
3686 struct x_display_info *dpyinfo = check_x_display_info (display);
3687 char *vendor = ServerVendor (dpyinfo->display);
3689 if (! vendor) vendor = "";
3690 return build_string (vendor);
3693 DEFUN ("x-server-version", Fx_server_version, Sx_server_version, 0, 1, 0,
3694 doc: /* Return the version numbers of the X server of display DISPLAY.
3695 The value is a list of three integers: the major and minor
3696 version numbers of the X Protocol in use, and the distributor-specific release
3697 number. See also the function `x-server-vendor'.
3699 The optional argument DISPLAY specifies which display to ask about.
3700 DISPLAY should be either a frame or a display name (a string).
3701 If omitted or nil, that stands for the selected frame's display. */)
3702 (display)
3703 Lisp_Object display;
3705 struct x_display_info *dpyinfo = check_x_display_info (display);
3706 Display *dpy = dpyinfo->display;
3708 return Fcons (make_number (ProtocolVersion (dpy)),
3709 Fcons (make_number (ProtocolRevision (dpy)),
3710 Fcons (make_number (VendorRelease (dpy)), Qnil)));
3713 DEFUN ("x-display-screens", Fx_display_screens, Sx_display_screens, 0, 1, 0,
3714 doc: /* Return the number of screens on the X server of display DISPLAY.
3715 The optional argument DISPLAY specifies which display to ask about.
3716 DISPLAY should be either a frame or a display name (a string).
3717 If omitted or nil, that stands for the selected frame's display. */)
3718 (display)
3719 Lisp_Object display;
3721 struct x_display_info *dpyinfo = check_x_display_info (display);
3723 return make_number (ScreenCount (dpyinfo->display));
3726 DEFUN ("x-display-mm-height", Fx_display_mm_height, Sx_display_mm_height, 0, 1, 0,
3727 doc: /* Return the height in millimeters of the X display DISPLAY.
3728 The optional argument DISPLAY specifies which display to ask about.
3729 DISPLAY should be either a frame or a display name (a string).
3730 If omitted or nil, that stands for the selected frame's display. */)
3731 (display)
3732 Lisp_Object display;
3734 struct x_display_info *dpyinfo = check_x_display_info (display);
3736 return make_number (HeightMMOfScreen (dpyinfo->screen));
3739 DEFUN ("x-display-mm-width", Fx_display_mm_width, Sx_display_mm_width, 0, 1, 0,
3740 doc: /* Return the width in millimeters of the X display DISPLAY.
3741 The optional argument DISPLAY specifies which display to ask about.
3742 DISPLAY should be either a frame or a display name (a string).
3743 If omitted or nil, that stands for the selected frame's display. */)
3744 (display)
3745 Lisp_Object display;
3747 struct x_display_info *dpyinfo = check_x_display_info (display);
3749 return make_number (WidthMMOfScreen (dpyinfo->screen));
3752 DEFUN ("x-display-backing-store", Fx_display_backing_store,
3753 Sx_display_backing_store, 0, 1, 0,
3754 doc: /* Return an indication of whether X display DISPLAY does backing store.
3755 The value may be `always', `when-mapped', or `not-useful'.
3756 The optional argument DISPLAY specifies which display to ask about.
3757 DISPLAY should be either a frame or a display name (a string).
3758 If omitted or nil, that stands for the selected frame's display. */)
3759 (display)
3760 Lisp_Object display;
3762 struct x_display_info *dpyinfo = check_x_display_info (display);
3763 Lisp_Object result;
3765 switch (DoesBackingStore (dpyinfo->screen))
3767 case Always:
3768 result = intern ("always");
3769 break;
3771 case WhenMapped:
3772 result = intern ("when-mapped");
3773 break;
3775 case NotUseful:
3776 result = intern ("not-useful");
3777 break;
3779 default:
3780 error ("Strange value for BackingStore parameter of screen");
3781 result = Qnil;
3784 return result;
3787 DEFUN ("x-display-visual-class", Fx_display_visual_class,
3788 Sx_display_visual_class, 0, 1, 0,
3789 doc: /* Return the visual class of the X display DISPLAY.
3790 The value is one of the symbols `static-gray', `gray-scale',
3791 `static-color', `pseudo-color', `true-color', or `direct-color'.
3793 The optional argument DISPLAY specifies which display to ask about.
3794 DISPLAY should be either a frame or a display name (a string).
3795 If omitted or nil, that stands for the selected frame's display. */)
3796 (display)
3797 Lisp_Object display;
3799 struct x_display_info *dpyinfo = check_x_display_info (display);
3800 Lisp_Object result;
3802 switch (dpyinfo->visual->class)
3804 case StaticGray:
3805 result = intern ("static-gray");
3806 break;
3807 case GrayScale:
3808 result = intern ("gray-scale");
3809 break;
3810 case StaticColor:
3811 result = intern ("static-color");
3812 break;
3813 case PseudoColor:
3814 result = intern ("pseudo-color");
3815 break;
3816 case TrueColor:
3817 result = intern ("true-color");
3818 break;
3819 case DirectColor:
3820 result = intern ("direct-color");
3821 break;
3822 default:
3823 error ("Display has an unknown visual class");
3824 result = Qnil;
3827 return result;
3830 DEFUN ("x-display-save-under", Fx_display_save_under,
3831 Sx_display_save_under, 0, 1, 0,
3832 doc: /* Return t if the X display DISPLAY supports the save-under feature.
3833 The optional argument DISPLAY specifies which display to ask about.
3834 DISPLAY should be either a frame or a display name (a string).
3835 If omitted or nil, that stands for the selected frame's display. */)
3836 (display)
3837 Lisp_Object display;
3839 struct x_display_info *dpyinfo = check_x_display_info (display);
3841 if (DoesSaveUnders (dpyinfo->screen) == True)
3842 return Qt;
3843 else
3844 return Qnil;
3848 x_pixel_width (f)
3849 register struct frame *f;
3851 return FRAME_PIXEL_WIDTH (f);
3855 x_pixel_height (f)
3856 register struct frame *f;
3858 return FRAME_PIXEL_HEIGHT (f);
3862 x_char_width (f)
3863 register struct frame *f;
3865 return FRAME_COLUMN_WIDTH (f);
3869 x_char_height (f)
3870 register struct frame *f;
3872 return FRAME_LINE_HEIGHT (f);
3876 x_screen_planes (f)
3877 register struct frame *f;
3879 return FRAME_X_DISPLAY_INFO (f)->n_planes;
3884 /************************************************************************
3885 X Displays
3886 ************************************************************************/
3889 /* Mapping visual names to visuals. */
3891 static struct visual_class
3893 char *name;
3894 int class;
3896 visual_classes[] =
3898 {"StaticGray", StaticGray},
3899 {"GrayScale", GrayScale},
3900 {"StaticColor", StaticColor},
3901 {"PseudoColor", PseudoColor},
3902 {"TrueColor", TrueColor},
3903 {"DirectColor", DirectColor},
3904 {NULL, 0}
3908 #ifndef HAVE_XSCREENNUMBEROFSCREEN
3910 /* Value is the screen number of screen SCR. This is a substitute for
3911 the X function with the same name when that doesn't exist. */
3914 XScreenNumberOfScreen (scr)
3915 register Screen *scr;
3917 Display *dpy = scr->display;
3918 int i;
3920 for (i = 0; i < dpy->nscreens; ++i)
3921 if (scr == dpy->screens + i)
3922 break;
3924 return i;
3927 #endif /* not HAVE_XSCREENNUMBEROFSCREEN */
3930 /* Select the visual that should be used on display DPYINFO. Set
3931 members of DPYINFO appropriately. Called from x_term_init. */
3933 void
3934 select_visual (dpyinfo)
3935 struct x_display_info *dpyinfo;
3937 Display *dpy = dpyinfo->display;
3938 Screen *screen = dpyinfo->screen;
3939 Lisp_Object value;
3941 /* See if a visual is specified. */
3942 value = display_x_get_resource (dpyinfo,
3943 build_string ("visualClass"),
3944 build_string ("VisualClass"),
3945 Qnil, Qnil);
3946 if (STRINGP (value))
3948 /* VALUE should be of the form CLASS-DEPTH, where CLASS is one
3949 of `PseudoColor', `TrueColor' etc. and DEPTH is the color
3950 depth, a decimal number. NAME is compared with case ignored. */
3951 char *s = (char *) alloca (SBYTES (value) + 1);
3952 char *dash;
3953 int i, class = -1;
3954 XVisualInfo vinfo;
3956 strcpy (s, SDATA (value));
3957 dash = index (s, '-');
3958 if (dash)
3960 dpyinfo->n_planes = atoi (dash + 1);
3961 *dash = '\0';
3963 else
3964 /* We won't find a matching visual with depth 0, so that
3965 an error will be printed below. */
3966 dpyinfo->n_planes = 0;
3968 /* Determine the visual class. */
3969 for (i = 0; visual_classes[i].name; ++i)
3970 if (xstricmp (s, visual_classes[i].name) == 0)
3972 class = visual_classes[i].class;
3973 break;
3976 /* Look up a matching visual for the specified class. */
3977 if (class == -1
3978 || !XMatchVisualInfo (dpy, XScreenNumberOfScreen (screen),
3979 dpyinfo->n_planes, class, &vinfo))
3980 fatal ("Invalid visual specification `%s'", SDATA (value));
3982 dpyinfo->visual = vinfo.visual;
3984 else
3986 int n_visuals;
3987 XVisualInfo *vinfo, vinfo_template;
3989 dpyinfo->visual = DefaultVisualOfScreen (screen);
3991 #ifdef HAVE_X11R4
3992 vinfo_template.visualid = XVisualIDFromVisual (dpyinfo->visual);
3993 #else
3994 vinfo_template.visualid = dpyinfo->visual->visualid;
3995 #endif
3996 vinfo_template.screen = XScreenNumberOfScreen (screen);
3997 vinfo = XGetVisualInfo (dpy, VisualIDMask | VisualScreenMask,
3998 &vinfo_template, &n_visuals);
3999 if (n_visuals != 1)
4000 fatal ("Can't get proper X visual info");
4002 dpyinfo->n_planes = vinfo->depth;
4003 XFree ((char *) vinfo);
4008 /* Return the X display structure for the display named NAME.
4009 Open a new connection if necessary. */
4011 struct x_display_info *
4012 x_display_info_for_name (name)
4013 Lisp_Object name;
4015 Lisp_Object names;
4016 struct x_display_info *dpyinfo;
4018 CHECK_STRING (name);
4020 if (! EQ (Vwindow_system, intern ("x")))
4021 error ("Not using X Windows");
4023 for (dpyinfo = x_display_list, names = x_display_name_list;
4024 dpyinfo;
4025 dpyinfo = dpyinfo->next, names = XCDR (names))
4027 Lisp_Object tem;
4028 tem = Fstring_equal (XCAR (XCAR (names)), name);
4029 if (!NILP (tem))
4030 return dpyinfo;
4033 /* Use this general default value to start with. */
4034 Vx_resource_name = Vinvocation_name;
4036 validate_x_resource_name ();
4038 dpyinfo = x_term_init (name, (char *)0,
4039 (char *) SDATA (Vx_resource_name));
4041 if (dpyinfo == 0)
4042 error ("Cannot connect to X server %s", SDATA (name));
4044 x_in_use = 1;
4045 XSETFASTINT (Vwindow_system_version, 11);
4047 return dpyinfo;
4051 DEFUN ("x-open-connection", Fx_open_connection, Sx_open_connection,
4052 1, 3, 0,
4053 doc: /* Open a connection to an X server.
4054 DISPLAY is the name of the display to connect to.
4055 Optional second arg XRM-STRING is a string of resources in xrdb format.
4056 If the optional third arg MUST-SUCCEED is non-nil,
4057 terminate Emacs if we can't open the connection. */)
4058 (display, xrm_string, must_succeed)
4059 Lisp_Object display, xrm_string, must_succeed;
4061 unsigned char *xrm_option;
4062 struct x_display_info *dpyinfo;
4064 CHECK_STRING (display);
4065 if (! NILP (xrm_string))
4066 CHECK_STRING (xrm_string);
4068 if (! EQ (Vwindow_system, intern ("x")))
4069 error ("Not using X Windows");
4071 if (! NILP (xrm_string))
4072 xrm_option = (unsigned char *) SDATA (xrm_string);
4073 else
4074 xrm_option = (unsigned char *) 0;
4076 validate_x_resource_name ();
4078 /* This is what opens the connection and sets x_current_display.
4079 This also initializes many symbols, such as those used for input. */
4080 dpyinfo = x_term_init (display, xrm_option,
4081 (char *) SDATA (Vx_resource_name));
4083 if (dpyinfo == 0)
4085 if (!NILP (must_succeed))
4086 fatal ("Cannot connect to X server %s.\n\
4087 Check the DISPLAY environment variable or use `-d'.\n\
4088 Also use the `xauth' program to verify that you have the proper\n\
4089 authorization information needed to connect the X server.\n\
4090 An insecure way to solve the problem may be to use `xhost'.\n",
4091 SDATA (display));
4092 else
4093 error ("Cannot connect to X server %s", SDATA (display));
4096 x_in_use = 1;
4098 XSETFASTINT (Vwindow_system_version, 11);
4099 return Qnil;
4102 DEFUN ("x-close-connection", Fx_close_connection,
4103 Sx_close_connection, 1, 1, 0,
4104 doc: /* Close the connection to DISPLAY's X server.
4105 For DISPLAY, specify either a frame or a display name (a string).
4106 If DISPLAY is nil, that stands for the selected frame's display. */)
4107 (display)
4108 Lisp_Object display;
4110 struct x_display_info *dpyinfo = check_x_display_info (display);
4111 int i;
4113 if (dpyinfo->reference_count > 0)
4114 error ("Display still has frames on it");
4116 BLOCK_INPUT;
4117 /* Free the fonts in the font table. */
4118 for (i = 0; i < dpyinfo->n_fonts; i++)
4119 if (dpyinfo->font_table[i].name)
4121 XFreeFont (dpyinfo->display, dpyinfo->font_table[i].font);
4124 x_destroy_all_bitmaps (dpyinfo);
4125 XSetCloseDownMode (dpyinfo->display, DestroyAll);
4127 #ifdef USE_GTK
4128 xg_display_close (dpyinfo->display);
4129 #else
4130 #ifdef USE_X_TOOLKIT
4131 XtCloseDisplay (dpyinfo->display);
4132 #else
4133 XCloseDisplay (dpyinfo->display);
4134 #endif
4135 #endif /* ! USE_GTK */
4137 x_delete_display (dpyinfo);
4138 UNBLOCK_INPUT;
4140 return Qnil;
4143 DEFUN ("x-display-list", Fx_display_list, Sx_display_list, 0, 0, 0,
4144 doc: /* Return the list of display names that Emacs has connections to. */)
4147 Lisp_Object tail, result;
4149 result = Qnil;
4150 for (tail = x_display_name_list; ! NILP (tail); tail = XCDR (tail))
4151 result = Fcons (XCAR (XCAR (tail)), result);
4153 return result;
4156 DEFUN ("x-synchronize", Fx_synchronize, Sx_synchronize, 1, 2, 0,
4157 doc: /* If ON is non-nil, report X errors as soon as the erring request is made.
4158 If ON is nil, allow buffering of requests.
4159 Turning on synchronization prohibits the Xlib routines from buffering
4160 requests and seriously degrades performance, but makes debugging much
4161 easier.
4162 The optional second argument DISPLAY specifies which display to act on.
4163 DISPLAY should be either a frame or a display name (a string).
4164 If DISPLAY is omitted or nil, that stands for the selected frame's display. */)
4165 (on, display)
4166 Lisp_Object display, on;
4168 struct x_display_info *dpyinfo = check_x_display_info (display);
4170 XSynchronize (dpyinfo->display, !EQ (on, Qnil));
4172 return Qnil;
4175 /* Wait for responses to all X commands issued so far for frame F. */
4177 void
4178 x_sync (f)
4179 FRAME_PTR f;
4181 BLOCK_INPUT;
4182 XSync (FRAME_X_DISPLAY (f), False);
4183 UNBLOCK_INPUT;
4187 /***********************************************************************
4188 Window properties
4189 ***********************************************************************/
4191 DEFUN ("x-change-window-property", Fx_change_window_property,
4192 Sx_change_window_property, 2, 6, 0,
4193 doc: /* Change window property PROP to VALUE on the X window of FRAME.
4194 PROP must be a string.
4195 VALUE may be a string or a list of conses, numbers and/or strings.
4196 If an element in the list is a string, it is converted to
4197 an Atom and the value of the Atom is used. If an element is a cons,
4198 it is converted to a 32 bit number where the car is the 16 top bits and the
4199 cdr is the lower 16 bits.
4200 FRAME nil or omitted means use the selected frame.
4201 If TYPE is given and non-nil, it is the name of the type of VALUE.
4202 If TYPE is not given or nil, the type is STRING.
4203 FORMAT gives the size in bits of each element if VALUE is a list.
4204 It must be one of 8, 16 or 32.
4205 If VALUE is a string or FORMAT is nil or not given, FORMAT defaults to 8.
4206 If OUTER_P is non-nil, the property is changed for the outer X window of
4207 FRAME. Default is to change on the edit X window.
4209 Value is VALUE. */)
4210 (prop, value, frame, type, format, outer_p)
4211 Lisp_Object prop, value, frame, type, format, outer_p;
4213 struct frame *f = check_x_frame (frame);
4214 Atom prop_atom;
4215 Atom target_type = XA_STRING;
4216 int element_format = 8;
4217 unsigned char *data;
4218 int nelements;
4219 Window w;
4221 CHECK_STRING (prop);
4223 if (! NILP (format))
4225 CHECK_NUMBER (format);
4226 element_format = XFASTINT (format);
4228 if (element_format != 8 && element_format != 16
4229 && element_format != 32)
4230 error ("FORMAT must be one of 8, 16 or 32");
4233 if (CONSP (value))
4235 nelements = x_check_property_data (value);
4236 if (nelements == -1)
4237 error ("Bad data in VALUE, must be number, string or cons");
4239 if (element_format == 8)
4240 data = (unsigned char *) xmalloc (nelements);
4241 else if (element_format == 16)
4242 data = (unsigned char *) xmalloc (nelements*2);
4243 else /* format == 32 */
4244 /* The man page for XChangeProperty:
4245 "If the specified format is 32, the property data must be a
4246 long array."
4247 This applies even if long is more than 64 bits. The X library
4248 converts to 32 bits before sending to the X server. */
4249 data = (unsigned char *) xmalloc (nelements * sizeof(long));
4251 x_fill_property_data (FRAME_X_DISPLAY (f), value, data, element_format);
4253 else
4255 CHECK_STRING (value);
4256 data = SDATA (value);
4257 nelements = SCHARS (value);
4260 BLOCK_INPUT;
4261 prop_atom = XInternAtom (FRAME_X_DISPLAY (f), SDATA (prop), False);
4262 if (! NILP (type))
4264 CHECK_STRING (type);
4265 target_type = XInternAtom (FRAME_X_DISPLAY (f), SDATA (type), False);
4268 if (! NILP (outer_p)) w = FRAME_OUTER_WINDOW (f);
4269 else w = FRAME_X_WINDOW (f);
4271 XChangeProperty (FRAME_X_DISPLAY (f), w,
4272 prop_atom, target_type, element_format, PropModeReplace,
4273 data, nelements);
4275 if (CONSP (value)) xfree (data);
4277 /* Make sure the property is set when we return. */
4278 XFlush (FRAME_X_DISPLAY (f));
4279 UNBLOCK_INPUT;
4281 return value;
4285 DEFUN ("x-delete-window-property", Fx_delete_window_property,
4286 Sx_delete_window_property, 1, 2, 0,
4287 doc: /* Remove window property PROP from X window of FRAME.
4288 FRAME nil or omitted means use the selected frame. Value is PROP. */)
4289 (prop, frame)
4290 Lisp_Object prop, frame;
4292 struct frame *f = check_x_frame (frame);
4293 Atom prop_atom;
4295 CHECK_STRING (prop);
4296 BLOCK_INPUT;
4297 prop_atom = XInternAtom (FRAME_X_DISPLAY (f), SDATA (prop), False);
4298 XDeleteProperty (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f), prop_atom);
4300 /* Make sure the property is removed when we return. */
4301 XFlush (FRAME_X_DISPLAY (f));
4302 UNBLOCK_INPUT;
4304 return prop;
4308 DEFUN ("x-window-property", Fx_window_property, Sx_window_property,
4309 1, 6, 0,
4310 doc: /* Value is the value of window property PROP on FRAME.
4311 If FRAME is nil or omitted, use the selected frame.
4312 If TYPE is nil or omitted, get the property as a string. Otherwise TYPE
4313 is the name of the Atom that denotes the type expected.
4314 If SOURCE is non-nil, get the property on that window instead of from
4315 FRAME. The number 0 denotes the root window.
4316 If DELETE_P is non-nil, delete the property after retreiving it.
4317 If VECTOR_RET_P is non-nil, don't return a string but a vector of values.
4319 Value is nil if FRAME hasn't a property with name PROP or if PROP has
4320 no value of TYPE. */)
4321 (prop, frame, type, source, delete_p, vector_ret_p)
4322 Lisp_Object prop, frame, type, source, delete_p, vector_ret_p;
4324 struct frame *f = check_x_frame (frame);
4325 Atom prop_atom;
4326 int rc;
4327 Lisp_Object prop_value = Qnil;
4328 unsigned char *tmp_data = NULL;
4329 Atom actual_type;
4330 Atom target_type = XA_STRING;
4331 int actual_format;
4332 unsigned long actual_size, bytes_remaining;
4333 Window target_window = FRAME_X_WINDOW (f);
4334 struct gcpro gcpro1;
4336 GCPRO1 (prop_value);
4337 CHECK_STRING (prop);
4339 if (! NILP (source))
4341 if (NUMBERP (source))
4343 if (FLOATP (source))
4344 target_window = (Window) XFLOAT (source);
4345 else
4346 target_window = XFASTINT (source);
4348 if (target_window == 0)
4349 target_window = FRAME_X_DISPLAY_INFO (f)->root_window;
4351 else if (CONSP (source))
4352 target_window = cons_to_long (source);
4355 BLOCK_INPUT;
4356 if (STRINGP (type))
4358 if (strcmp ("AnyPropertyType", SDATA (type)) == 0)
4359 target_type = AnyPropertyType;
4360 else
4361 target_type = XInternAtom (FRAME_X_DISPLAY (f), SDATA (type), False);
4364 prop_atom = XInternAtom (FRAME_X_DISPLAY (f), SDATA (prop), False);
4365 rc = XGetWindowProperty (FRAME_X_DISPLAY (f), target_window,
4366 prop_atom, 0, 0, False, target_type,
4367 &actual_type, &actual_format, &actual_size,
4368 &bytes_remaining, &tmp_data);
4369 if (rc == Success)
4371 int size = bytes_remaining;
4373 XFree (tmp_data);
4374 tmp_data = NULL;
4376 rc = XGetWindowProperty (FRAME_X_DISPLAY (f), target_window,
4377 prop_atom, 0, bytes_remaining,
4378 ! NILP (delete_p), target_type,
4379 &actual_type, &actual_format,
4380 &actual_size, &bytes_remaining,
4381 &tmp_data);
4382 if (rc == Success && tmp_data)
4384 /* The man page for XGetWindowProperty says:
4385 "If the returned format is 32, the returned data is represented
4386 as a long array and should be cast to that type to obtain the
4387 elements."
4388 This applies even if long is more than 32 bits, the X library
4389 converts from 32 bit elements received from the X server to long
4390 and passes the long array to us. Thus, for that case bcopy can not
4391 be used. We convert to a 32 bit type here, because so much code
4392 assume on that.
4394 The bytes and offsets passed to XGetWindowProperty refers to the
4395 property and those are indeed in 32 bit quantities if format is
4396 32. */
4398 if (actual_format == 32 && actual_format < BITS_PER_LONG)
4400 unsigned long i;
4401 int *idata = (int *) tmp_data;
4402 long *ldata = (long *) tmp_data;
4404 for (i = 0; i < actual_size; ++i)
4405 idata[i] = (int) ldata[i];
4408 if (NILP (vector_ret_p))
4409 prop_value = make_string (tmp_data, size);
4410 else
4411 prop_value = x_property_data_to_lisp (f,
4412 tmp_data,
4413 actual_type,
4414 actual_format,
4415 actual_size);
4418 if (tmp_data) XFree (tmp_data);
4421 UNBLOCK_INPUT;
4422 UNGCPRO;
4423 return prop_value;
4428 /***********************************************************************
4429 Busy cursor
4430 ***********************************************************************/
4432 /* If non-null, an asynchronous timer that, when it expires, displays
4433 an hourglass cursor on all frames. */
4435 static struct atimer *hourglass_atimer;
4437 /* Non-zero means an hourglass cursor is currently shown. */
4439 static int hourglass_shown_p;
4441 /* Number of seconds to wait before displaying an hourglass cursor. */
4443 static Lisp_Object Vhourglass_delay;
4445 /* Default number of seconds to wait before displaying an hourglass
4446 cursor. */
4448 #define DEFAULT_HOURGLASS_DELAY 1
4450 /* Function prototypes. */
4452 static void show_hourglass P_ ((struct atimer *));
4453 static void hide_hourglass P_ ((void));
4455 /* Return non-zero if houglass timer has been started or hourglass is shown. */
4458 hourglass_started ()
4460 return hourglass_shown_p || hourglass_atimer != NULL;
4464 /* Cancel a currently active hourglass timer, and start a new one. */
4466 void
4467 start_hourglass ()
4469 EMACS_TIME delay;
4470 int secs, usecs = 0;
4472 /* Don't bother for ttys. */
4473 if (NILP (Vwindow_system))
4474 return;
4476 cancel_hourglass ();
4478 if (INTEGERP (Vhourglass_delay)
4479 && XINT (Vhourglass_delay) > 0)
4480 secs = XFASTINT (Vhourglass_delay);
4481 else if (FLOATP (Vhourglass_delay)
4482 && XFLOAT_DATA (Vhourglass_delay) > 0)
4484 Lisp_Object tem;
4485 tem = Ftruncate (Vhourglass_delay, Qnil);
4486 secs = XFASTINT (tem);
4487 usecs = (XFLOAT_DATA (Vhourglass_delay) - secs) * 1000000;
4489 else
4490 secs = DEFAULT_HOURGLASS_DELAY;
4492 EMACS_SET_SECS_USECS (delay, secs, usecs);
4493 hourglass_atimer = start_atimer (ATIMER_RELATIVE, delay,
4494 show_hourglass, NULL);
4498 /* Cancel the hourglass cursor timer if active, hide a busy cursor if
4499 shown. */
4501 void
4502 cancel_hourglass ()
4504 if (hourglass_atimer)
4506 cancel_atimer (hourglass_atimer);
4507 hourglass_atimer = NULL;
4510 if (hourglass_shown_p)
4511 hide_hourglass ();
4515 /* Timer function of hourglass_atimer. TIMER is equal to
4516 hourglass_atimer.
4518 Display an hourglass pointer on all frames by mapping the frames'
4519 hourglass_window. Set the hourglass_p flag in the frames'
4520 output_data.x structure to indicate that an hourglass cursor is
4521 shown on the frames. */
4523 static void
4524 show_hourglass (timer)
4525 struct atimer *timer;
4527 /* The timer implementation will cancel this timer automatically
4528 after this function has run. Set hourglass_atimer to null
4529 so that we know the timer doesn't have to be canceled. */
4530 hourglass_atimer = NULL;
4532 if (!hourglass_shown_p)
4534 Lisp_Object rest, frame;
4536 BLOCK_INPUT;
4538 FOR_EACH_FRAME (rest, frame)
4540 struct frame *f = XFRAME (frame);
4542 if (FRAME_LIVE_P (f) && FRAME_X_P (f) && FRAME_X_DISPLAY (f))
4544 Display *dpy = FRAME_X_DISPLAY (f);
4546 #ifdef USE_X_TOOLKIT
4547 if (f->output_data.x->widget)
4548 #else
4549 if (FRAME_OUTER_WINDOW (f))
4550 #endif
4552 f->output_data.x->hourglass_p = 1;
4554 if (!f->output_data.x->hourglass_window)
4556 unsigned long mask = CWCursor;
4557 XSetWindowAttributes attrs;
4558 #ifdef USE_GTK
4559 Window parent = FRAME_X_WINDOW (f);
4560 #else
4561 Window parent = FRAME_OUTER_WINDOW (f);
4562 #endif
4563 attrs.cursor = f->output_data.x->hourglass_cursor;
4565 f->output_data.x->hourglass_window
4566 = XCreateWindow (dpy, parent,
4567 0, 0, 32000, 32000, 0, 0,
4568 InputOnly,
4569 CopyFromParent,
4570 mask, &attrs);
4573 XMapRaised (dpy, f->output_data.x->hourglass_window);
4574 XFlush (dpy);
4579 hourglass_shown_p = 1;
4580 UNBLOCK_INPUT;
4585 /* Hide the hourglass pointer on all frames, if it is currently
4586 shown. */
4588 static void
4589 hide_hourglass ()
4591 if (hourglass_shown_p)
4593 Lisp_Object rest, frame;
4595 BLOCK_INPUT;
4596 FOR_EACH_FRAME (rest, frame)
4598 struct frame *f = XFRAME (frame);
4600 if (FRAME_X_P (f)
4601 /* Watch out for newly created frames. */
4602 && f->output_data.x->hourglass_window)
4604 XUnmapWindow (FRAME_X_DISPLAY (f),
4605 f->output_data.x->hourglass_window);
4606 /* Sync here because XTread_socket looks at the
4607 hourglass_p flag that is reset to zero below. */
4608 XSync (FRAME_X_DISPLAY (f), False);
4609 f->output_data.x->hourglass_p = 0;
4613 hourglass_shown_p = 0;
4614 UNBLOCK_INPUT;
4620 /***********************************************************************
4621 Tool tips
4622 ***********************************************************************/
4624 static Lisp_Object x_create_tip_frame P_ ((struct x_display_info *,
4625 Lisp_Object, Lisp_Object));
4626 static void compute_tip_xy P_ ((struct frame *, Lisp_Object, Lisp_Object,
4627 Lisp_Object, int, int, int *, int *));
4629 /* The frame of a currently visible tooltip. */
4631 Lisp_Object tip_frame;
4633 /* If non-nil, a timer started that hides the last tooltip when it
4634 fires. */
4636 Lisp_Object tip_timer;
4637 Window tip_window;
4639 /* If non-nil, a vector of 3 elements containing the last args
4640 with which x-show-tip was called. See there. */
4642 Lisp_Object last_show_tip_args;
4644 /* Maximum size for tooltips; a cons (COLUMNS . ROWS). */
4646 Lisp_Object Vx_max_tooltip_size;
4649 static Lisp_Object
4650 unwind_create_tip_frame (frame)
4651 Lisp_Object frame;
4653 Lisp_Object deleted;
4655 deleted = unwind_create_frame (frame);
4656 if (EQ (deleted, Qt))
4658 tip_window = None;
4659 tip_frame = Qnil;
4662 return deleted;
4666 /* Create a frame for a tooltip on the display described by DPYINFO.
4667 PARMS is a list of frame parameters. TEXT is the string to
4668 display in the tip frame. Value is the frame.
4670 Note that functions called here, esp. x_default_parameter can
4671 signal errors, for instance when a specified color name is
4672 undefined. We have to make sure that we're in a consistent state
4673 when this happens. */
4675 static Lisp_Object
4676 x_create_tip_frame (dpyinfo, parms, text)
4677 struct x_display_info *dpyinfo;
4678 Lisp_Object parms, text;
4680 struct frame *f;
4681 Lisp_Object frame, tem;
4682 Lisp_Object name;
4683 long window_prompting = 0;
4684 int width, height;
4685 int count = SPECPDL_INDEX ();
4686 struct gcpro gcpro1, gcpro2, gcpro3;
4687 struct kboard *kb;
4688 int face_change_count_before = face_change_count;
4689 Lisp_Object buffer;
4690 struct buffer *old_buffer;
4692 check_x ();
4694 parms = Fcopy_alist (parms);
4696 #ifdef MULTI_KBOARD
4697 kb = dpyinfo->kboard;
4698 #else
4699 kb = &the_only_kboard;
4700 #endif
4702 /* Get the name of the frame to use for resource lookup. */
4703 name = x_get_arg (dpyinfo, parms, Qname, "name", "Name", RES_TYPE_STRING);
4704 if (!STRINGP (name)
4705 && !EQ (name, Qunbound)
4706 && !NILP (name))
4707 error ("Invalid frame name--not a string or nil");
4709 frame = Qnil;
4710 GCPRO3 (parms, name, frame);
4711 f = make_frame (1);
4712 XSETFRAME (frame, f);
4714 buffer = Fget_buffer_create (build_string (" *tip*"));
4715 Fset_window_buffer (FRAME_ROOT_WINDOW (f), buffer, Qnil);
4716 old_buffer = current_buffer;
4717 set_buffer_internal_1 (XBUFFER (buffer));
4718 current_buffer->truncate_lines = Qnil;
4719 specbind (Qinhibit_read_only, Qt);
4720 specbind (Qinhibit_modification_hooks, Qt);
4721 Ferase_buffer ();
4722 Finsert (1, &text);
4723 set_buffer_internal_1 (old_buffer);
4725 FRAME_CAN_HAVE_SCROLL_BARS (f) = 0;
4726 record_unwind_protect (unwind_create_tip_frame, frame);
4728 /* By setting the output method, we're essentially saying that
4729 the frame is live, as per FRAME_LIVE_P. If we get a signal
4730 from this point on, x_destroy_window might screw up reference
4731 counts etc. */
4732 f->output_method = output_x_window;
4733 f->output_data.x = (struct x_output *) xmalloc (sizeof (struct x_output));
4734 bzero (f->output_data.x, sizeof (struct x_output));
4735 f->output_data.x->icon_bitmap = -1;
4736 FRAME_FONTSET (f) = -1;
4737 f->output_data.x->scroll_bar_foreground_pixel = -1;
4738 f->output_data.x->scroll_bar_background_pixel = -1;
4739 #ifdef USE_TOOLKIT_SCROLL_BARS
4740 f->output_data.x->scroll_bar_top_shadow_pixel = -1;
4741 f->output_data.x->scroll_bar_bottom_shadow_pixel = -1;
4742 #endif /* USE_TOOLKIT_SCROLL_BARS */
4743 f->icon_name = Qnil;
4744 FRAME_X_DISPLAY_INFO (f) = dpyinfo;
4745 #if GLYPH_DEBUG
4746 image_cache_refcount = FRAME_X_IMAGE_CACHE (f)->refcount;
4747 dpyinfo_refcount = dpyinfo->reference_count;
4748 #endif /* GLYPH_DEBUG */
4749 #ifdef MULTI_KBOARD
4750 FRAME_KBOARD (f) = kb;
4751 #endif
4752 f->output_data.x->parent_desc = FRAME_X_DISPLAY_INFO (f)->root_window;
4753 f->output_data.x->explicit_parent = 0;
4755 /* These colors will be set anyway later, but it's important
4756 to get the color reference counts right, so initialize them! */
4758 Lisp_Object black;
4759 struct gcpro gcpro1;
4761 black = build_string ("black");
4762 GCPRO1 (black);
4763 f->output_data.x->foreground_pixel
4764 = x_decode_color (f, black, BLACK_PIX_DEFAULT (f));
4765 f->output_data.x->background_pixel
4766 = x_decode_color (f, black, BLACK_PIX_DEFAULT (f));
4767 f->output_data.x->cursor_pixel
4768 = x_decode_color (f, black, BLACK_PIX_DEFAULT (f));
4769 f->output_data.x->cursor_foreground_pixel
4770 = x_decode_color (f, black, BLACK_PIX_DEFAULT (f));
4771 f->output_data.x->border_pixel
4772 = x_decode_color (f, black, BLACK_PIX_DEFAULT (f));
4773 f->output_data.x->mouse_pixel
4774 = x_decode_color (f, black, BLACK_PIX_DEFAULT (f));
4775 UNGCPRO;
4778 /* Set the name; the functions to which we pass f expect the name to
4779 be set. */
4780 if (EQ (name, Qunbound) || NILP (name))
4782 f->name = build_string (dpyinfo->x_id_name);
4783 f->explicit_name = 0;
4785 else
4787 f->name = name;
4788 f->explicit_name = 1;
4789 /* use the frame's title when getting resources for this frame. */
4790 specbind (Qx_resource_name, name);
4793 /* Extract the window parameters from the supplied values that are
4794 needed to determine window geometry. */
4796 Lisp_Object font;
4798 font = x_get_arg (dpyinfo, parms, Qfont, "font", "Font", RES_TYPE_STRING);
4800 BLOCK_INPUT;
4801 /* First, try whatever font the caller has specified. */
4802 if (STRINGP (font))
4804 tem = Fquery_fontset (font, Qnil);
4805 if (STRINGP (tem))
4806 font = x_new_fontset (f, SDATA (tem));
4807 else
4808 font = x_new_font (f, SDATA (font));
4811 /* Try out a font which we hope has bold and italic variations. */
4812 if (!STRINGP (font))
4813 font = x_new_font (f, "-adobe-courier-medium-r-*-*-*-120-*-*-*-*-iso8859-1");
4814 if (!STRINGP (font))
4815 font = x_new_font (f, "-misc-fixed-medium-r-normal-*-*-140-*-*-c-*-iso8859-1");
4816 if (! STRINGP (font))
4817 font = x_new_font (f, "-*-*-medium-r-normal-*-*-140-*-*-c-*-iso8859-1");
4818 if (! STRINGP (font))
4819 /* This was formerly the first thing tried, but it finds too many fonts
4820 and takes too long. */
4821 font = x_new_font (f, "-*-*-medium-r-*-*-*-*-*-*-c-*-iso8859-1");
4822 /* If those didn't work, look for something which will at least work. */
4823 if (! STRINGP (font))
4824 font = x_new_font (f, "-*-fixed-*-*-*-*-*-140-*-*-c-*-iso8859-1");
4825 UNBLOCK_INPUT;
4826 if (! STRINGP (font))
4827 font = build_string ("fixed");
4829 x_default_parameter (f, parms, Qfont, font,
4830 "font", "Font", RES_TYPE_STRING);
4833 x_default_parameter (f, parms, Qborder_width, make_number (2),
4834 "borderWidth", "BorderWidth", RES_TYPE_NUMBER);
4836 /* This defaults to 2 in order to match xterm. We recognize either
4837 internalBorderWidth or internalBorder (which is what xterm calls
4838 it). */
4839 if (NILP (Fassq (Qinternal_border_width, parms)))
4841 Lisp_Object value;
4843 value = x_get_arg (dpyinfo, parms, Qinternal_border_width,
4844 "internalBorder", "internalBorder", RES_TYPE_NUMBER);
4845 if (! EQ (value, Qunbound))
4846 parms = Fcons (Fcons (Qinternal_border_width, value),
4847 parms);
4850 x_default_parameter (f, parms, Qinternal_border_width, make_number (1),
4851 "internalBorderWidth", "internalBorderWidth",
4852 RES_TYPE_NUMBER);
4854 /* Also do the stuff which must be set before the window exists. */
4855 x_default_parameter (f, parms, Qforeground_color, build_string ("black"),
4856 "foreground", "Foreground", RES_TYPE_STRING);
4857 x_default_parameter (f, parms, Qbackground_color, build_string ("white"),
4858 "background", "Background", RES_TYPE_STRING);
4859 x_default_parameter (f, parms, Qmouse_color, build_string ("black"),
4860 "pointerColor", "Foreground", RES_TYPE_STRING);
4861 x_default_parameter (f, parms, Qcursor_color, build_string ("black"),
4862 "cursorColor", "Foreground", RES_TYPE_STRING);
4863 x_default_parameter (f, parms, Qborder_color, build_string ("black"),
4864 "borderColor", "BorderColor", RES_TYPE_STRING);
4866 /* Init faces before x_default_parameter is called for scroll-bar
4867 parameters because that function calls x_set_scroll_bar_width,
4868 which calls change_frame_size, which calls Fset_window_buffer,
4869 which runs hooks, which call Fvertical_motion. At the end, we
4870 end up in init_iterator with a null face cache, which should not
4871 happen. */
4872 init_frame_faces (f);
4874 f->output_data.x->parent_desc = FRAME_X_DISPLAY_INFO (f)->root_window;
4876 window_prompting = x_figure_window_size (f, parms, 0);
4879 XSetWindowAttributes attrs;
4880 unsigned long mask;
4882 BLOCK_INPUT;
4883 mask = CWBackPixel | CWOverrideRedirect | CWEventMask;
4884 if (DoesSaveUnders (dpyinfo->screen))
4885 mask |= CWSaveUnder;
4887 /* Window managers look at the override-redirect flag to determine
4888 whether or net to give windows a decoration (Xlib spec, chapter
4889 3.2.8). */
4890 attrs.override_redirect = True;
4891 attrs.save_under = True;
4892 attrs.background_pixel = FRAME_BACKGROUND_PIXEL (f);
4893 /* Arrange for getting MapNotify and UnmapNotify events. */
4894 attrs.event_mask = StructureNotifyMask;
4895 tip_window
4896 = FRAME_X_WINDOW (f)
4897 = XCreateWindow (FRAME_X_DISPLAY (f),
4898 FRAME_X_DISPLAY_INFO (f)->root_window,
4899 /* x, y, width, height */
4900 0, 0, 1, 1,
4901 /* Border. */
4903 CopyFromParent, InputOutput, CopyFromParent,
4904 mask, &attrs);
4905 UNBLOCK_INPUT;
4908 x_make_gc (f);
4910 x_default_parameter (f, parms, Qauto_raise, Qnil,
4911 "autoRaise", "AutoRaiseLower", RES_TYPE_BOOLEAN);
4912 x_default_parameter (f, parms, Qauto_lower, Qnil,
4913 "autoLower", "AutoRaiseLower", RES_TYPE_BOOLEAN);
4914 x_default_parameter (f, parms, Qcursor_type, Qbox,
4915 "cursorType", "CursorType", RES_TYPE_SYMBOL);
4917 /* Dimensions, especially FRAME_LINES (f), must be done via change_frame_size.
4918 Change will not be effected unless different from the current
4919 FRAME_LINES (f). */
4920 width = FRAME_COLS (f);
4921 height = FRAME_LINES (f);
4922 SET_FRAME_COLS (f, 0);
4923 FRAME_LINES (f) = 0;
4924 change_frame_size (f, height, width, 1, 0, 0);
4926 /* Add `tooltip' frame parameter's default value. */
4927 if (NILP (Fframe_parameter (frame, intern ("tooltip"))))
4928 Fmodify_frame_parameters (frame, Fcons (Fcons (intern ("tooltip"), Qt),
4929 Qnil));
4931 /* FIXME - can this be done in a similar way to normal frames?
4932 http://lists.gnu.org/archive/html/emacs-devel/2007-10/msg00641.html */
4934 /* Set the `display-type' frame parameter before setting up faces. */
4936 Lisp_Object disptype;
4938 if (FRAME_X_DISPLAY_INFO (f)->n_planes == 1)
4939 disptype = intern ("mono");
4940 else if (FRAME_X_DISPLAY_INFO (f)->visual->class == GrayScale
4941 || FRAME_X_DISPLAY_INFO (f)->visual->class == StaticGray)
4942 disptype = intern ("grayscale");
4943 else
4944 disptype = intern ("color");
4946 if (NILP (Fframe_parameter (frame, Qdisplay_type)))
4947 Fmodify_frame_parameters (frame, Fcons (Fcons (Qdisplay_type, disptype),
4948 Qnil));
4951 /* Set up faces after all frame parameters are known. This call
4952 also merges in face attributes specified for new frames.
4954 Frame parameters may be changed if .Xdefaults contains
4955 specifications for the default font. For example, if there is an
4956 `Emacs.default.attributeBackground: pink', the `background-color'
4957 attribute of the frame get's set, which let's the internal border
4958 of the tooltip frame appear in pink. Prevent this. */
4960 Lisp_Object bg = Fframe_parameter (frame, Qbackground_color);
4962 /* Set tip_frame here, so that */
4963 tip_frame = frame;
4964 call1 (Qface_set_after_frame_default, frame);
4966 if (!EQ (bg, Fframe_parameter (frame, Qbackground_color)))
4967 Fmodify_frame_parameters (frame, Fcons (Fcons (Qbackground_color, bg),
4968 Qnil));
4971 f->no_split = 1;
4973 UNGCPRO;
4975 /* It is now ok to make the frame official even if we get an error
4976 below. And the frame needs to be on Vframe_list or making it
4977 visible won't work. */
4978 Vframe_list = Fcons (frame, Vframe_list);
4980 /* Now that the frame is official, it counts as a reference to
4981 its display. */
4982 FRAME_X_DISPLAY_INFO (f)->reference_count++;
4984 /* Setting attributes of faces of the tooltip frame from resources
4985 and similar will increment face_change_count, which leads to the
4986 clearing of all current matrices. Since this isn't necessary
4987 here, avoid it by resetting face_change_count to the value it
4988 had before we created the tip frame. */
4989 face_change_count = face_change_count_before;
4991 /* Discard the unwind_protect. */
4992 return unbind_to (count, frame);
4996 /* Compute where to display tip frame F. PARMS is the list of frame
4997 parameters for F. DX and DY are specified offsets from the current
4998 location of the mouse. WIDTH and HEIGHT are the width and height
4999 of the tooltip. Return coordinates relative to the root window of
5000 the display in *ROOT_X, and *ROOT_Y. */
5002 static void
5003 compute_tip_xy (f, parms, dx, dy, width, height, root_x, root_y)
5004 struct frame *f;
5005 Lisp_Object parms, dx, dy;
5006 int width, height;
5007 int *root_x, *root_y;
5009 Lisp_Object left, top;
5010 int win_x, win_y;
5011 Window root, child;
5012 unsigned pmask;
5014 /* User-specified position? */
5015 left = Fcdr (Fassq (Qleft, parms));
5016 top = Fcdr (Fassq (Qtop, parms));
5018 /* Move the tooltip window where the mouse pointer is. Resize and
5019 show it. */
5020 if (!INTEGERP (left) || !INTEGERP (top))
5022 BLOCK_INPUT;
5023 XQueryPointer (FRAME_X_DISPLAY (f), FRAME_X_DISPLAY_INFO (f)->root_window,
5024 &root, &child, root_x, root_y, &win_x, &win_y, &pmask);
5025 UNBLOCK_INPUT;
5028 if (INTEGERP (top))
5029 *root_y = XINT (top);
5030 else if (*root_y + XINT (dy) <= 0)
5031 *root_y = 0; /* Can happen for negative dy */
5032 else if (*root_y + XINT (dy) + height <= FRAME_X_DISPLAY_INFO (f)->height)
5033 /* It fits below the pointer */
5034 *root_y += XINT (dy);
5035 else if (height + XINT (dy) <= *root_y)
5036 /* It fits above the pointer. */
5037 *root_y -= height + XINT (dy);
5038 else
5039 /* Put it on the top. */
5040 *root_y = 0;
5042 if (INTEGERP (left))
5043 *root_x = XINT (left);
5044 else if (*root_x + XINT (dx) <= 0)
5045 *root_x = 0; /* Can happen for negative dx */
5046 else if (*root_x + XINT (dx) + width <= FRAME_X_DISPLAY_INFO (f)->width)
5047 /* It fits to the right of the pointer. */
5048 *root_x += XINT (dx);
5049 else if (width + XINT (dx) <= *root_x)
5050 /* It fits to the left of the pointer. */
5051 *root_x -= width + XINT (dx);
5052 else
5053 /* Put it left-justified on the screen--it ought to fit that way. */
5054 *root_x = 0;
5058 DEFUN ("x-show-tip", Fx_show_tip, Sx_show_tip, 1, 6, 0,
5059 doc: /* Show STRING in a "tooltip" window on frame FRAME.
5060 A tooltip window is a small X window displaying a string.
5062 This is an internal function; Lisp code should call `tooltip-show'.
5064 FRAME nil or omitted means use the selected frame.
5066 PARMS is an optional list of frame parameters which can be used to
5067 change the tooltip's appearance.
5069 Automatically hide the tooltip after TIMEOUT seconds. TIMEOUT nil
5070 means use the default timeout of 5 seconds.
5072 If the list of frame parameters PARAMS contains a `left' parameters,
5073 the tooltip is displayed at that x-position. Otherwise it is
5074 displayed at the mouse position, with offset DX added (default is 5 if
5075 DX isn't specified). Likewise for the y-position; if a `top' frame
5076 parameter is specified, it determines the y-position of the tooltip
5077 window, otherwise it is displayed at the mouse position, with offset
5078 DY added (default is -10).
5080 A tooltip's maximum size is specified by `x-max-tooltip-size'.
5081 Text larger than the specified size is clipped. */)
5082 (string, frame, parms, timeout, dx, dy)
5083 Lisp_Object string, frame, parms, timeout, dx, dy;
5085 struct frame *f;
5086 struct window *w;
5087 int root_x, root_y;
5088 struct buffer *old_buffer;
5089 struct text_pos pos;
5090 int i, width, height;
5091 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
5092 int old_windows_or_buffers_changed = windows_or_buffers_changed;
5093 int count = SPECPDL_INDEX ();
5095 specbind (Qinhibit_redisplay, Qt);
5097 GCPRO4 (string, parms, frame, timeout);
5099 CHECK_STRING (string);
5100 f = check_x_frame (frame);
5101 if (NILP (timeout))
5102 timeout = make_number (5);
5103 else
5104 CHECK_NATNUM (timeout);
5106 if (NILP (dx))
5107 dx = make_number (5);
5108 else
5109 CHECK_NUMBER (dx);
5111 if (NILP (dy))
5112 dy = make_number (-10);
5113 else
5114 CHECK_NUMBER (dy);
5116 if (NILP (last_show_tip_args))
5117 last_show_tip_args = Fmake_vector (make_number (3), Qnil);
5119 if (!NILP (tip_frame))
5121 Lisp_Object last_string = AREF (last_show_tip_args, 0);
5122 Lisp_Object last_frame = AREF (last_show_tip_args, 1);
5123 Lisp_Object last_parms = AREF (last_show_tip_args, 2);
5125 if (EQ (frame, last_frame)
5126 && !NILP (Fequal (last_string, string))
5127 && !NILP (Fequal (last_parms, parms)))
5129 struct frame *f = XFRAME (tip_frame);
5131 /* Only DX and DY have changed. */
5132 if (!NILP (tip_timer))
5134 Lisp_Object timer = tip_timer;
5135 tip_timer = Qnil;
5136 call1 (Qcancel_timer, timer);
5139 BLOCK_INPUT;
5140 compute_tip_xy (f, parms, dx, dy, FRAME_PIXEL_WIDTH (f),
5141 FRAME_PIXEL_HEIGHT (f), &root_x, &root_y);
5142 XMoveWindow (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
5143 root_x, root_y);
5144 UNBLOCK_INPUT;
5145 goto start_timer;
5149 /* Hide a previous tip, if any. */
5150 Fx_hide_tip ();
5152 ASET (last_show_tip_args, 0, string);
5153 ASET (last_show_tip_args, 1, frame);
5154 ASET (last_show_tip_args, 2, parms);
5156 /* Add default values to frame parameters. */
5157 if (NILP (Fassq (Qname, parms)))
5158 parms = Fcons (Fcons (Qname, build_string ("tooltip")), parms);
5159 if (NILP (Fassq (Qinternal_border_width, parms)))
5160 parms = Fcons (Fcons (Qinternal_border_width, make_number (3)), parms);
5161 if (NILP (Fassq (Qborder_width, parms)))
5162 parms = Fcons (Fcons (Qborder_width, make_number (1)), parms);
5163 if (NILP (Fassq (Qborder_color, parms)))
5164 parms = Fcons (Fcons (Qborder_color, build_string ("lightyellow")), parms);
5165 if (NILP (Fassq (Qbackground_color, parms)))
5166 parms = Fcons (Fcons (Qbackground_color, build_string ("lightyellow")),
5167 parms);
5169 /* Create a frame for the tooltip, and record it in the global
5170 variable tip_frame. */
5171 frame = x_create_tip_frame (FRAME_X_DISPLAY_INFO (f), parms, string);
5172 f = XFRAME (frame);
5174 /* Set up the frame's root window. */
5175 w = XWINDOW (FRAME_ROOT_WINDOW (f));
5176 w->left_col = w->top_line = make_number (0);
5178 if (CONSP (Vx_max_tooltip_size)
5179 && INTEGERP (XCAR (Vx_max_tooltip_size))
5180 && XINT (XCAR (Vx_max_tooltip_size)) > 0
5181 && INTEGERP (XCDR (Vx_max_tooltip_size))
5182 && XINT (XCDR (Vx_max_tooltip_size)) > 0)
5184 w->total_cols = XCAR (Vx_max_tooltip_size);
5185 w->total_lines = XCDR (Vx_max_tooltip_size);
5187 else
5189 w->total_cols = make_number (80);
5190 w->total_lines = make_number (40);
5193 FRAME_TOTAL_COLS (f) = XINT (w->total_cols);
5194 adjust_glyphs (f);
5195 w->pseudo_window_p = 1;
5197 /* Display the tooltip text in a temporary buffer. */
5198 old_buffer = current_buffer;
5199 set_buffer_internal_1 (XBUFFER (XWINDOW (FRAME_ROOT_WINDOW (f))->buffer));
5200 current_buffer->truncate_lines = Qnil;
5201 clear_glyph_matrix (w->desired_matrix);
5202 clear_glyph_matrix (w->current_matrix);
5203 SET_TEXT_POS (pos, BEGV, BEGV_BYTE);
5204 try_window (FRAME_ROOT_WINDOW (f), pos, 0);
5206 /* Compute width and height of the tooltip. */
5207 width = height = 0;
5208 for (i = 0; i < w->desired_matrix->nrows; ++i)
5210 struct glyph_row *row = &w->desired_matrix->rows[i];
5211 struct glyph *last;
5212 int row_width;
5214 /* Stop at the first empty row at the end. */
5215 if (!row->enabled_p || !row->displays_text_p)
5216 break;
5218 /* Let the row go over the full width of the frame. */
5219 row->full_width_p = 1;
5221 /* There's a glyph at the end of rows that is used to place
5222 the cursor there. Don't include the width of this glyph. */
5223 if (row->used[TEXT_AREA])
5225 last = &row->glyphs[TEXT_AREA][row->used[TEXT_AREA] - 1];
5226 row_width = row->pixel_width - last->pixel_width;
5228 else
5229 row_width = row->pixel_width;
5231 height += row->height;
5232 width = max (width, row_width);
5235 /* Add the frame's internal border to the width and height the X
5236 window should have. */
5237 height += 2 * FRAME_INTERNAL_BORDER_WIDTH (f);
5238 width += 2 * FRAME_INTERNAL_BORDER_WIDTH (f);
5240 /* Move the tooltip window where the mouse pointer is. Resize and
5241 show it. */
5242 compute_tip_xy (f, parms, dx, dy, width, height, &root_x, &root_y);
5244 BLOCK_INPUT;
5245 XMoveResizeWindow (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
5246 root_x, root_y, width, height);
5247 XMapRaised (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f));
5248 UNBLOCK_INPUT;
5250 /* Draw into the window. */
5251 w->must_be_updated_p = 1;
5252 update_single_window (w, 1);
5254 /* Restore original current buffer. */
5255 set_buffer_internal_1 (old_buffer);
5256 windows_or_buffers_changed = old_windows_or_buffers_changed;
5258 start_timer:
5259 /* Let the tip disappear after timeout seconds. */
5260 tip_timer = call3 (intern ("run-at-time"), timeout, Qnil,
5261 intern ("x-hide-tip"));
5263 UNGCPRO;
5264 return unbind_to (count, Qnil);
5268 DEFUN ("x-hide-tip", Fx_hide_tip, Sx_hide_tip, 0, 0, 0,
5269 doc: /* Hide the current tooltip window, if there is any.
5270 Value is t if tooltip was open, nil otherwise. */)
5273 int count;
5274 Lisp_Object deleted, frame, timer;
5275 struct gcpro gcpro1, gcpro2;
5277 /* Return quickly if nothing to do. */
5278 if (NILP (tip_timer) && NILP (tip_frame))
5279 return Qnil;
5281 frame = tip_frame;
5282 timer = tip_timer;
5283 GCPRO2 (frame, timer);
5284 tip_frame = tip_timer = deleted = Qnil;
5286 count = SPECPDL_INDEX ();
5287 specbind (Qinhibit_redisplay, Qt);
5288 specbind (Qinhibit_quit, Qt);
5290 if (!NILP (timer))
5291 call1 (Qcancel_timer, timer);
5293 if (FRAMEP (frame))
5295 Fdelete_frame (frame, Qnil);
5296 deleted = Qt;
5298 #ifdef USE_LUCID
5299 /* Bloodcurdling hack alert: The Lucid menu bar widget's
5300 redisplay procedure is not called when a tip frame over menu
5301 items is unmapped. Redisplay the menu manually... */
5303 struct frame *f = SELECTED_FRAME ();
5304 Widget w = f->output_data.x->menubar_widget;
5305 extern void xlwmenu_redisplay P_ ((Widget));
5307 if (!DoesSaveUnders (FRAME_X_DISPLAY_INFO (f)->screen)
5308 && w != NULL)
5310 BLOCK_INPUT;
5311 xlwmenu_redisplay (w);
5312 UNBLOCK_INPUT;
5315 #endif /* USE_LUCID */
5318 UNGCPRO;
5319 return unbind_to (count, deleted);
5324 /***********************************************************************
5325 File selection dialog
5326 ***********************************************************************/
5328 DEFUN ("x-uses-old-gtk-dialog", Fx_uses_old_gtk_dialog,
5329 Sx_uses_old_gtk_dialog,
5330 0, 0, 0,
5331 doc: /* Return t if the old Gtk+ file selection dialog is used. */)
5334 #ifdef USE_GTK
5335 extern int use_dialog_box;
5336 extern int use_file_dialog;
5338 if (use_dialog_box
5339 && use_file_dialog
5340 && have_menus_p ()
5341 && xg_uses_old_file_dialog ())
5342 return Qt;
5343 #endif
5344 return Qnil;
5348 #ifdef USE_MOTIF
5349 /* Callback for "OK" and "Cancel" on file selection dialog. */
5351 static void
5352 file_dialog_cb (widget, client_data, call_data)
5353 Widget widget;
5354 XtPointer call_data, client_data;
5356 int *result = (int *) client_data;
5357 XmAnyCallbackStruct *cb = (XmAnyCallbackStruct *) call_data;
5358 *result = cb->reason;
5362 /* Callback for unmapping a file selection dialog. This is used to
5363 capture the case where a dialog is closed via a window manager's
5364 closer button, for example. Using a XmNdestroyCallback didn't work
5365 in this case. */
5367 static void
5368 file_dialog_unmap_cb (widget, client_data, call_data)
5369 Widget widget;
5370 XtPointer call_data, client_data;
5372 int *result = (int *) client_data;
5373 *result = XmCR_CANCEL;
5376 static Lisp_Object
5377 clean_up_file_dialog (arg)
5378 Lisp_Object arg;
5380 struct Lisp_Save_Value *p = XSAVE_VALUE (arg);
5381 Widget dialog = (Widget) p->pointer;
5383 /* Clean up. */
5384 BLOCK_INPUT;
5385 XtUnmanageChild (dialog);
5386 XtDestroyWidget (dialog);
5387 x_menu_set_in_use (0);
5388 UNBLOCK_INPUT;
5390 return Qnil;
5394 DEFUN ("x-file-dialog", Fx_file_dialog, Sx_file_dialog, 2, 5, 0,
5395 doc: /* Read file name, prompting with PROMPT in directory DIR.
5396 Use a file selection dialog. Select DEFAULT-FILENAME in the dialog's file
5397 selection box, if specified. If MUSTMATCH is non-nil, the returned file
5398 or directory must exist. ONLY-DIR-P is ignored." */)
5399 (prompt, dir, default_filename, mustmatch, only_dir_p)
5400 Lisp_Object prompt, dir, default_filename, mustmatch, only_dir_p;
5402 int result;
5403 struct frame *f = SELECTED_FRAME ();
5404 Lisp_Object file = Qnil;
5405 Lisp_Object decoded_file;
5406 Widget dialog, text, help;
5407 Arg al[10];
5408 int ac = 0;
5409 extern XtAppContext Xt_app_con;
5410 XmString dir_xmstring, pattern_xmstring;
5411 int count = SPECPDL_INDEX ();
5412 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5, gcpro6;
5414 check_x ();
5416 GCPRO6 (prompt, dir, default_filename, mustmatch, only_dir_p, file);
5418 if (popup_activated ())
5419 error ("Trying to use a menu from within a menu-entry");
5421 CHECK_STRING (prompt);
5422 CHECK_STRING (dir);
5424 /* Prevent redisplay. */
5425 specbind (Qinhibit_redisplay, Qt);
5427 BLOCK_INPUT;
5429 /* Create the dialog with PROMPT as title, using DIR as initial
5430 directory and using "*" as pattern. */
5431 dir = Fexpand_file_name (dir, Qnil);
5432 dir_xmstring = XmStringCreateLocalized (SDATA (dir));
5433 pattern_xmstring = XmStringCreateLocalized ("*");
5435 XtSetArg (al[ac], XmNtitle, SDATA (prompt)); ++ac;
5436 XtSetArg (al[ac], XmNdirectory, dir_xmstring); ++ac;
5437 XtSetArg (al[ac], XmNpattern, pattern_xmstring); ++ac;
5438 XtSetArg (al[ac], XmNresizePolicy, XmRESIZE_GROW); ++ac;
5439 XtSetArg (al[ac], XmNdialogStyle, XmDIALOG_APPLICATION_MODAL); ++ac;
5440 dialog = XmCreateFileSelectionDialog (f->output_data.x->widget,
5441 "fsb", al, ac);
5442 XmStringFree (dir_xmstring);
5443 XmStringFree (pattern_xmstring);
5445 /* Add callbacks for OK and Cancel. */
5446 XtAddCallback (dialog, XmNokCallback, file_dialog_cb,
5447 (XtPointer) &result);
5448 XtAddCallback (dialog, XmNcancelCallback, file_dialog_cb,
5449 (XtPointer) &result);
5450 XtAddCallback (dialog, XmNunmapCallback, file_dialog_unmap_cb,
5451 (XtPointer) &result);
5453 /* Remove the help button since we can't display help. */
5454 help = XmFileSelectionBoxGetChild (dialog, XmDIALOG_HELP_BUTTON);
5455 XtUnmanageChild (help);
5457 /* Mark OK button as default. */
5458 XtVaSetValues (XmFileSelectionBoxGetChild (dialog, XmDIALOG_OK_BUTTON),
5459 XmNshowAsDefault, True, NULL);
5461 /* If MUSTMATCH is non-nil, disable the file entry field of the
5462 dialog, so that the user must select a file from the files list
5463 box. We can't remove it because we wouldn't have a way to get at
5464 the result file name, then. */
5465 text = XmFileSelectionBoxGetChild (dialog, XmDIALOG_TEXT);
5466 if (!NILP (mustmatch))
5468 Widget label;
5469 label = XmFileSelectionBoxGetChild (dialog, XmDIALOG_SELECTION_LABEL);
5470 XtSetSensitive (text, False);
5471 XtSetSensitive (label, False);
5474 /* Manage the dialog, so that list boxes get filled. */
5475 XtManageChild (dialog);
5477 if (STRINGP (default_filename))
5479 XmString default_xmstring;
5480 Widget wtext = XmFileSelectionBoxGetChild (dialog, XmDIALOG_TEXT);
5481 Widget list = XmFileSelectionBoxGetChild (dialog, XmDIALOG_LIST);
5483 XmTextPosition last_pos = XmTextFieldGetLastPosition (wtext);
5484 XmTextFieldReplace (wtext, 0, last_pos,
5485 (SDATA (Ffile_name_nondirectory (default_filename))));
5487 /* Select DEFAULT_FILENAME in the files list box. DEFAULT_FILENAME
5488 must include the path for this to work. */
5490 default_xmstring = XmStringCreateLocalized (SDATA (default_filename));
5492 if (XmListItemExists (list, default_xmstring))
5494 int item_pos = XmListItemPos (list, default_xmstring);
5495 /* Select the item and scroll it into view. */
5496 XmListSelectPos (list, item_pos, True);
5497 XmListSetPos (list, item_pos);
5500 XmStringFree (default_xmstring);
5503 record_unwind_protect (clean_up_file_dialog, make_save_value (dialog, 0));
5505 /* Process events until the user presses Cancel or OK. */
5506 x_menu_set_in_use (1);
5507 result = 0;
5508 while (result == 0)
5510 XEvent event;
5511 x_menu_wait_for_event (0);
5512 XtAppNextEvent (Xt_app_con, &event);
5513 if (event.type == KeyPress
5514 && FRAME_X_DISPLAY (f) == event.xkey.display)
5516 KeySym keysym = XLookupKeysym (&event.xkey, 0);
5518 /* Pop down on C-g. */
5519 if (keysym == XK_g && (event.xkey.state & ControlMask) != 0)
5520 XtUnmanageChild (dialog);
5523 (void) x_dispatch_event (&event, FRAME_X_DISPLAY (f));
5526 /* Get the result. */
5527 if (result == XmCR_OK)
5529 XmString text;
5530 String data;
5532 XtVaGetValues (dialog, XmNtextString, &text, NULL);
5533 XmStringGetLtoR (text, XmFONTLIST_DEFAULT_TAG, &data);
5534 XmStringFree (text);
5535 file = build_string (data);
5536 XtFree (data);
5538 else
5539 file = Qnil;
5541 UNBLOCK_INPUT;
5542 UNGCPRO;
5544 /* Make "Cancel" equivalent to C-g. */
5545 if (NILP (file))
5546 Fsignal (Qquit, Qnil);
5548 decoded_file = DECODE_FILE (file);
5550 return unbind_to (count, decoded_file);
5553 #endif /* USE_MOTIF */
5555 #ifdef USE_GTK
5557 static Lisp_Object
5558 clean_up_dialog (arg)
5559 Lisp_Object arg;
5561 x_menu_set_in_use (0);
5563 return Qnil;
5566 DEFUN ("x-file-dialog", Fx_file_dialog, Sx_file_dialog, 2, 5, 0,
5567 doc: /* Read file name, prompting with PROMPT in directory DIR.
5568 Use a file selection dialog. Select DEFAULT-FILENAME in the dialog's file
5569 selection box, if specified. If MUSTMATCH is non-nil, the returned file
5570 or directory must exist. If ONLY-DIR-P is non-nil, the user can only select
5571 directories. */)
5572 (prompt, dir, default_filename, mustmatch, only_dir_p)
5573 Lisp_Object prompt, dir, default_filename, mustmatch, only_dir_p;
5575 FRAME_PTR f = SELECTED_FRAME ();
5576 char *fn;
5577 Lisp_Object file = Qnil;
5578 Lisp_Object decoded_file;
5579 int count = SPECPDL_INDEX ();
5580 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5, gcpro6;
5581 char *cdef_file;
5583 check_x ();
5585 GCPRO6 (prompt, dir, default_filename, mustmatch, only_dir_p, file);
5587 if (popup_activated ())
5588 error ("Trying to use a menu from within a menu-entry");
5590 CHECK_STRING (prompt);
5591 CHECK_STRING (dir);
5593 /* Prevent redisplay. */
5594 specbind (Qinhibit_redisplay, Qt);
5595 record_unwind_protect (clean_up_dialog, Qnil);
5597 BLOCK_INPUT;
5599 if (STRINGP (default_filename))
5600 cdef_file = SDATA (default_filename);
5601 else
5602 cdef_file = SDATA (dir);
5604 fn = xg_get_file_name (f, SDATA (prompt), cdef_file,
5605 ! NILP (mustmatch),
5606 ! NILP (only_dir_p));
5608 if (fn)
5610 file = build_string (fn);
5611 xfree (fn);
5614 UNBLOCK_INPUT;
5615 UNGCPRO;
5617 /* Make "Cancel" equivalent to C-g. */
5618 if (NILP (file))
5619 Fsignal (Qquit, Qnil);
5621 decoded_file = DECODE_FILE (file);
5623 return unbind_to (count, decoded_file);
5626 #endif /* USE_GTK */
5629 /***********************************************************************
5630 Keyboard
5631 ***********************************************************************/
5633 #ifdef HAVE_XKBGETKEYBOARD
5634 #include <X11/XKBlib.h>
5635 #include <X11/keysym.h>
5636 #endif
5638 DEFUN ("x-backspace-delete-keys-p", Fx_backspace_delete_keys_p,
5639 Sx_backspace_delete_keys_p, 0, 1, 0,
5640 doc: /* Check if both Backspace and Delete keys are on the keyboard of FRAME.
5641 FRAME nil means use the selected frame.
5642 Value is t if we know that both keys are present, and are mapped to the
5643 usual X keysyms. Value is `lambda' if we cannot determine if both keys are
5644 present and mapped to the usual X keysyms. */)
5645 (frame)
5646 Lisp_Object frame;
5648 #ifdef HAVE_XKBGETKEYBOARD
5649 XkbDescPtr kb;
5650 struct frame *f = check_x_frame (frame);
5651 Display *dpy = FRAME_X_DISPLAY (f);
5652 Lisp_Object have_keys;
5653 int major, minor, op, event, error;
5655 BLOCK_INPUT;
5657 /* Check library version in case we're dynamically linked. */
5658 major = XkbMajorVersion;
5659 minor = XkbMinorVersion;
5660 if (!XkbLibraryVersion (&major, &minor))
5662 UNBLOCK_INPUT;
5663 return Qlambda;
5666 /* Check that the server supports XKB. */
5667 major = XkbMajorVersion;
5668 minor = XkbMinorVersion;
5669 if (!XkbQueryExtension (dpy, &op, &event, &error, &major, &minor))
5671 UNBLOCK_INPUT;
5672 return Qlambda;
5675 /* In this code we check that the keyboard has physical keys with names
5676 that start with BKSP (Backspace) and DELE (Delete), and that they
5677 generate keysym XK_BackSpace and XK_Delete respectively.
5678 This function is used to test if normal-erase-is-backspace should be
5679 turned on.
5680 An alternative approach would be to just check if XK_BackSpace and
5681 XK_Delete are mapped to any key. But if any of those are mapped to
5682 some non-intuitive key combination (Meta-Shift-Ctrl-whatever) and the
5683 user doesn't know about it, it is better to return false here.
5684 It is more obvious to the user what to do if she/he has two keys
5685 clearly marked with names/symbols and one key does something not
5686 expected (i.e. she/he then tries the other).
5687 The cases where Backspace/Delete is mapped to some other key combination
5688 are rare, and in those cases, normal-erase-is-backspace can be turned on
5689 manually. */
5691 have_keys = Qnil;
5692 kb = XkbGetMap (dpy, XkbAllMapComponentsMask, XkbUseCoreKbd);
5693 if (kb)
5695 int delete_keycode = 0, backspace_keycode = 0, i;
5697 if (XkbGetNames (dpy, XkbAllNamesMask, kb) == Success)
5699 for (i = kb->min_key_code;
5700 (i < kb->max_key_code
5701 && (delete_keycode == 0 || backspace_keycode == 0));
5702 ++i)
5704 /* The XKB symbolic key names can be seen most easily in
5705 the PS file generated by `xkbprint -label name
5706 $DISPLAY'. */
5707 if (bcmp ("DELE", kb->names->keys[i].name, 4) == 0)
5708 delete_keycode = i;
5709 else if (bcmp ("BKSP", kb->names->keys[i].name, 4) == 0)
5710 backspace_keycode = i;
5713 XkbFreeNames (kb, 0, True);
5716 XkbFreeClientMap (kb, 0, True);
5718 if (delete_keycode
5719 && backspace_keycode
5720 && XKeysymToKeycode (dpy, XK_Delete) == delete_keycode
5721 && XKeysymToKeycode (dpy, XK_BackSpace) == backspace_keycode)
5722 have_keys = Qt;
5724 UNBLOCK_INPUT;
5725 return have_keys;
5726 #else /* not HAVE_XKBGETKEYBOARD */
5727 return Qlambda;
5728 #endif /* not HAVE_XKBGETKEYBOARD */
5733 /***********************************************************************
5734 Initialization
5735 ***********************************************************************/
5737 /* Keep this list in the same order as frame_parms in frame.c.
5738 Use 0 for unsupported frame parameters. */
5740 frame_parm_handler x_frame_parm_handlers[] =
5742 x_set_autoraise,
5743 x_set_autolower,
5744 x_set_background_color,
5745 x_set_border_color,
5746 x_set_border_width,
5747 x_set_cursor_color,
5748 x_set_cursor_type,
5749 x_set_font,
5750 x_set_foreground_color,
5751 x_set_icon_name,
5752 x_set_icon_type,
5753 x_set_internal_border_width,
5754 x_set_menu_bar_lines,
5755 x_set_mouse_color,
5756 x_explicitly_set_name,
5757 x_set_scroll_bar_width,
5758 x_set_title,
5759 x_set_unsplittable,
5760 x_set_vertical_scroll_bars,
5761 x_set_visibility,
5762 x_set_tool_bar_lines,
5763 x_set_scroll_bar_foreground,
5764 x_set_scroll_bar_background,
5765 x_set_screen_gamma,
5766 x_set_line_spacing,
5767 x_set_fringe_width,
5768 x_set_fringe_width,
5769 x_set_wait_for_wm,
5770 x_set_fullscreen,
5773 void
5774 syms_of_xfns ()
5776 /* This is zero if not using X windows. */
5777 x_in_use = 0;
5779 /* The section below is built by the lisp expression at the top of the file,
5780 just above where these variables are declared. */
5781 /*&&& init symbols here &&&*/
5782 Qnone = intern ("none");
5783 staticpro (&Qnone);
5784 Qsuppress_icon = intern ("suppress-icon");
5785 staticpro (&Qsuppress_icon);
5786 Qundefined_color = intern ("undefined-color");
5787 staticpro (&Qundefined_color);
5788 Qcompound_text = intern ("compound-text");
5789 staticpro (&Qcompound_text);
5790 Qcancel_timer = intern ("cancel-timer");
5791 staticpro (&Qcancel_timer);
5792 /* This is the end of symbol initialization. */
5794 /* Text property `display' should be nonsticky by default. */
5795 Vtext_property_default_nonsticky
5796 = Fcons (Fcons (Qdisplay, Qt), Vtext_property_default_nonsticky);
5799 Fput (Qundefined_color, Qerror_conditions,
5800 Fcons (Qundefined_color, Fcons (Qerror, Qnil)));
5801 Fput (Qundefined_color, Qerror_message,
5802 build_string ("Undefined color"));
5804 DEFVAR_LISP ("x-pointer-shape", &Vx_pointer_shape,
5805 doc: /* The shape of the pointer when over text.
5806 Changing the value does not affect existing frames
5807 unless you set the mouse color. */);
5808 Vx_pointer_shape = Qnil;
5810 #if 0 /* This doesn't really do anything. */
5811 DEFVAR_LISP ("x-nontext-pointer-shape", &Vx_nontext_pointer_shape,
5812 doc: /* The shape of the pointer when not over text.
5813 This variable takes effect when you create a new frame
5814 or when you set the mouse color. */);
5815 #endif
5816 Vx_nontext_pointer_shape = Qnil;
5818 DEFVAR_LISP ("x-hourglass-pointer-shape", &Vx_hourglass_pointer_shape,
5819 doc: /* The shape of the pointer when Emacs is busy.
5820 This variable takes effect when you create a new frame
5821 or when you set the mouse color. */);
5822 Vx_hourglass_pointer_shape = Qnil;
5824 DEFVAR_BOOL ("display-hourglass", &display_hourglass_p,
5825 doc: /* Non-zero means Emacs displays an hourglass pointer on window systems. */);
5826 display_hourglass_p = 1;
5828 DEFVAR_LISP ("hourglass-delay", &Vhourglass_delay,
5829 doc: /* *Seconds to wait before displaying an hourglass pointer.
5830 Value must be an integer or float. */);
5831 Vhourglass_delay = make_number (DEFAULT_HOURGLASS_DELAY);
5833 #if 0 /* This doesn't really do anything. */
5834 DEFVAR_LISP ("x-mode-pointer-shape", &Vx_mode_pointer_shape,
5835 doc: /* The shape of the pointer when over the mode line.
5836 This variable takes effect when you create a new frame
5837 or when you set the mouse color. */);
5838 #endif
5839 Vx_mode_pointer_shape = Qnil;
5841 DEFVAR_LISP ("x-sensitive-text-pointer-shape",
5842 &Vx_sensitive_text_pointer_shape,
5843 doc: /* The shape of the pointer when over mouse-sensitive text.
5844 This variable takes effect when you create a new frame
5845 or when you set the mouse color. */);
5846 Vx_sensitive_text_pointer_shape = Qnil;
5848 DEFVAR_LISP ("x-window-horizontal-drag-cursor",
5849 &Vx_window_horizontal_drag_shape,
5850 doc: /* Pointer shape to use for indicating a window can be dragged horizontally.
5851 This variable takes effect when you create a new frame
5852 or when you set the mouse color. */);
5853 Vx_window_horizontal_drag_shape = Qnil;
5855 DEFVAR_LISP ("x-cursor-fore-pixel", &Vx_cursor_fore_pixel,
5856 doc: /* A string indicating the foreground color of the cursor box. */);
5857 Vx_cursor_fore_pixel = Qnil;
5859 DEFVAR_LISP ("x-max-tooltip-size", &Vx_max_tooltip_size,
5860 doc: /* Maximum size for tooltips. Value is a pair (COLUMNS . ROWS).
5861 Text larger than this is clipped. */);
5862 Vx_max_tooltip_size = Fcons (make_number (80), make_number (40));
5864 DEFVAR_LISP ("x-no-window-manager", &Vx_no_window_manager,
5865 doc: /* Non-nil if no X window manager is in use.
5866 Emacs doesn't try to figure this out; this is always nil
5867 unless you set it to something else. */);
5868 /* We don't have any way to find this out, so set it to nil
5869 and maybe the user would like to set it to t. */
5870 Vx_no_window_manager = Qnil;
5872 DEFVAR_LISP ("x-pixel-size-width-font-regexp",
5873 &Vx_pixel_size_width_font_regexp,
5874 doc: /* Regexp matching a font name whose width is the same as `PIXEL_SIZE'.
5876 Since Emacs gets width of a font matching with this regexp from
5877 PIXEL_SIZE field of the name, font finding mechanism gets faster for
5878 such a font. This is especially effective for such large fonts as
5879 Chinese, Japanese, and Korean. */);
5880 Vx_pixel_size_width_font_regexp = Qnil;
5882 /* This is not ifdef:ed, so other builds than GTK can customize it. */
5883 DEFVAR_BOOL ("x-gtk-use-old-file-dialog", &x_gtk_use_old_file_dialog,
5884 doc: /* *Non-nil means prompt with the old GTK file selection dialog.
5885 If nil or if the file selection dialog is not available, the new GTK file
5886 chooser is used instead. To turn off all file dialogs set the
5887 variable `use-file-dialog'. */);
5888 x_gtk_use_old_file_dialog = 0;
5890 DEFVAR_BOOL ("x-gtk-show-hidden-files", &x_gtk_show_hidden_files,
5891 doc: /* *If non-nil, the GTK file chooser will by default show hidden files.
5892 Note that this is just the default, there is a toggle button on the file
5893 chooser to show or not show hidden files on a case by case basis. */);
5894 x_gtk_show_hidden_files = 0;
5896 DEFVAR_BOOL ("x-gtk-file-dialog-help-text", &x_gtk_file_dialog_help_text,
5897 doc: /* *If non-nil, the GTK file chooser will show additional help text.
5898 If more space for files in the file chooser dialog is wanted, set this to nil
5899 to turn the additional text off. */);
5900 x_gtk_file_dialog_help_text = 1;
5902 DEFVAR_BOOL ("x-gtk-whole-detached-tool-bar", &x_gtk_whole_detached_tool_bar,
5903 doc: /* *If non-nil, a detached tool bar is shown in full.
5904 The default is to just show an arrow and pressing on that arrow shows
5905 the tool bar buttons. */);
5906 x_gtk_whole_detached_tool_bar = 0;
5908 Fprovide (intern ("x"), Qnil);
5910 #ifdef USE_X_TOOLKIT
5911 Fprovide (intern ("x-toolkit"), Qnil);
5912 #ifdef USE_MOTIF
5913 Fprovide (intern ("motif"), Qnil);
5915 DEFVAR_LISP ("motif-version-string", &Vmotif_version_string,
5916 doc: /* Version info for LessTif/Motif. */);
5917 Vmotif_version_string = build_string (XmVERSION_STRING);
5918 #endif /* USE_MOTIF */
5919 #endif /* USE_X_TOOLKIT */
5921 #ifdef USE_GTK
5922 /* Provide x-toolkit also for GTK. Internally GTK does not use Xt so it
5923 is not an X toolkit in that sense (USE_X_TOOLKIT is not defined).
5924 But for a user it is a toolkit for X, and indeed, configure
5925 accepts --with-x-toolkit=gtk. */
5926 Fprovide (intern ("x-toolkit"), Qnil);
5927 Fprovide (intern ("gtk"), Qnil);
5929 DEFVAR_LISP ("gtk-version-string", &Vgtk_version_string,
5930 doc: /* Version info for GTK+. */);
5932 char gtk_version[40];
5933 g_snprintf (gtk_version, sizeof (gtk_version), "%u.%u.%u",
5934 GTK_MAJOR_VERSION, GTK_MINOR_VERSION, GTK_MICRO_VERSION);
5935 Vgtk_version_string = build_string (gtk_version);
5937 #endif /* USE_GTK */
5939 /* X window properties. */
5940 defsubr (&Sx_change_window_property);
5941 defsubr (&Sx_delete_window_property);
5942 defsubr (&Sx_window_property);
5944 defsubr (&Sxw_display_color_p);
5945 defsubr (&Sx_display_grayscale_p);
5946 defsubr (&Sxw_color_defined_p);
5947 defsubr (&Sxw_color_values);
5948 defsubr (&Sx_server_max_request_size);
5949 defsubr (&Sx_server_vendor);
5950 defsubr (&Sx_server_version);
5951 defsubr (&Sx_display_pixel_width);
5952 defsubr (&Sx_display_pixel_height);
5953 defsubr (&Sx_display_mm_width);
5954 defsubr (&Sx_display_mm_height);
5955 defsubr (&Sx_display_screens);
5956 defsubr (&Sx_display_planes);
5957 defsubr (&Sx_display_color_cells);
5958 defsubr (&Sx_display_visual_class);
5959 defsubr (&Sx_display_backing_store);
5960 defsubr (&Sx_display_save_under);
5961 defsubr (&Sx_create_frame);
5962 defsubr (&Sx_open_connection);
5963 defsubr (&Sx_close_connection);
5964 defsubr (&Sx_display_list);
5965 defsubr (&Sx_synchronize);
5966 defsubr (&Sx_focus_frame);
5967 defsubr (&Sx_backspace_delete_keys_p);
5969 /* Setting callback functions for fontset handler. */
5970 get_font_info_func = x_get_font_info;
5972 #if 0 /* This function pointer doesn't seem to be used anywhere.
5973 And the pointer assigned has the wrong type, anyway. */
5974 list_fonts_func = x_list_fonts;
5975 #endif
5977 load_font_func = x_load_font;
5978 find_ccl_program_func = x_find_ccl_program;
5979 query_font_func = x_query_font;
5980 set_frame_fontset_func = x_set_font;
5981 check_window_system_func = check_x;
5983 hourglass_atimer = NULL;
5984 hourglass_shown_p = 0;
5986 defsubr (&Sx_show_tip);
5987 defsubr (&Sx_hide_tip);
5988 tip_timer = Qnil;
5989 staticpro (&tip_timer);
5990 tip_frame = Qnil;
5991 staticpro (&tip_frame);
5993 last_show_tip_args = Qnil;
5994 staticpro (&last_show_tip_args);
5996 defsubr (&Sx_uses_old_gtk_dialog);
5997 #if defined (USE_MOTIF) || defined (USE_GTK)
5998 defsubr (&Sx_file_dialog);
5999 #endif
6002 #endif /* HAVE_X_WINDOWS */
6004 /* arch-tag: 55040d02-5485-4d58-8b22-95a7a05f3288
6005 (do not change this comment) */