Revision: miles@gnu.org--gnu-2004/emacs--unicode--0--patch-72
[bpt/emacs.git] / src / xfns.c
1 /* Functions for the X window system.
2 Copyright (C) 1989, 92, 93, 94, 95, 96, 97, 98, 99, 2000,01,02,03,04
3 Free Software Foundation.
4
5 This file is part of GNU Emacs.
6
7 GNU Emacs is free software; you can redistribute it and/or modify
8 it under the terms of the GNU General Public License as published by
9 the Free Software Foundation; either version 2, or (at your option)
10 any later version.
11
12 GNU Emacs is distributed in the hope that it will be useful,
13 but WITHOUT ANY WARRANTY; without even the implied warranty of
14 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15 GNU General Public License for more details.
16
17 You should have received a copy of the GNU General Public License
18 along with GNU Emacs; see the file COPYING. If not, write to
19 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
20 Boston, MA 02111-1307, USA. */
21
22 #include <config.h>
23 #include <signal.h>
24 #include <stdio.h>
25 #include <math.h>
26
27 #ifdef HAVE_UNISTD_H
28 #include <unistd.h>
29 #endif
30
31 /* This makes the fields of a Display accessible, in Xlib header files. */
32
33 #define XLIB_ILLEGAL_ACCESS
34
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 "character.h"
46 #include "charset.h"
47 #include "coding.h"
48 #include "fontset.h"
49 #include "systime.h"
50 #include "termhooks.h"
51 #include "atimer.h"
52
53 #ifdef HAVE_X_WINDOWS
54
55 #include <ctype.h>
56 #include <sys/types.h>
57 #include <sys/stat.h>
58
59 #ifndef VMS
60 #if 1 /* Used to be #ifdef EMACS_BITMAP_FILES, but this should always work. */
61 #include "bitmaps/gray.xbm"
62 #else
63 #include <X11/bitmaps/gray>
64 #endif
65 #else
66 #include "[.bitmaps]gray.xbm"
67 #endif
68
69 #ifdef USE_GTK
70 #include "gtkutil.h"
71 #endif
72
73 #ifdef USE_X_TOOLKIT
74 #include <X11/Shell.h>
75
76 #ifndef USE_MOTIF
77 #include <X11/Xaw/Paned.h>
78 #include <X11/Xaw/Label.h>
79 #endif /* USE_MOTIF */
80
81 #ifdef USG
82 #undef USG /* ####KLUDGE for Solaris 2.2 and up */
83 #include <X11/Xos.h>
84 #define USG
85 #else
86 #include <X11/Xos.h>
87 #endif
88
89 #include "widget.h"
90
91 #include "../lwlib/lwlib.h"
92
93 #ifdef USE_MOTIF
94 #include <Xm/Xm.h>
95 #include <Xm/DialogS.h>
96 #include <Xm/FileSB.h>
97 #endif
98
99 /* Do the EDITRES protocol if running X11R5
100 Exception: HP-UX (at least version A.09.05) has X11R5 without EditRes */
101
102 #if (XtSpecificationRelease >= 5) && !defined(NO_EDITRES)
103 #define HACK_EDITRES
104 extern void _XEditResCheckMessages ();
105 #endif /* R5 + Athena */
106
107 /* Unique id counter for widgets created by the Lucid Widget Library. */
108
109 extern LWLIB_ID widget_id_tick;
110
111 #ifdef USE_LUCID
112 /* This is part of a kludge--see lwlib/xlwmenu.c. */
113 extern XFontStruct *xlwmenu_default_font;
114 #endif
115
116 extern void free_frame_menubar ();
117 extern double atof ();
118
119 #ifdef USE_MOTIF
120
121 /* LessTif/Motif version info. */
122
123 static Lisp_Object Vmotif_version_string;
124
125 #endif /* USE_MOTIF */
126
127 #endif /* USE_X_TOOLKIT */
128
129 #ifdef USE_GTK
130
131 /* GTK+ version info */
132
133 static Lisp_Object Vgtk_version_string;
134
135 #endif /* USE_GTK */
136
137 #ifdef HAVE_X11R4
138 #define MAXREQUEST(dpy) (XMaxRequestSize (dpy))
139 #else
140 #define MAXREQUEST(dpy) ((dpy)->max_request_size)
141 #endif
142
143 /* The gray bitmap `bitmaps/gray'. This is done because xterm.c uses
144 it, and including `bitmaps/gray' more than once is a problem when
145 config.h defines `static' as an empty replacement string. */
146
147 int gray_bitmap_width = gray_width;
148 int gray_bitmap_height = gray_height;
149 char *gray_bitmap_bits = gray_bits;
150
151 /* Non-zero means we're allowed to display an hourglass cursor. */
152
153 int display_hourglass_p;
154
155 /* The background and shape of the mouse pointer, and shape when not
156 over text or in the modeline. */
157
158 Lisp_Object Vx_pointer_shape, Vx_nontext_pointer_shape, Vx_mode_pointer_shape;
159 Lisp_Object Vx_hourglass_pointer_shape;
160
161 /* The shape when over mouse-sensitive text. */
162
163 Lisp_Object Vx_sensitive_text_pointer_shape;
164
165 /* If non-nil, the pointer shape to indicate that windows can be
166 dragged horizontally. */
167
168 Lisp_Object Vx_window_horizontal_drag_shape;
169
170 /* Color of chars displayed in cursor box. */
171
172 Lisp_Object Vx_cursor_fore_pixel;
173
174 /* Nonzero if using X. */
175
176 static int x_in_use;
177
178 /* Non nil if no window manager is in use. */
179
180 Lisp_Object Vx_no_window_manager;
181
182 /* Regexp matching a font name whose width is the same as `PIXEL_SIZE'. */
183
184 Lisp_Object Vx_pixel_size_width_font_regexp;
185
186 Lisp_Object Qnone;
187 Lisp_Object Qsuppress_icon;
188 Lisp_Object Qundefined_color;
189 Lisp_Object Qcompound_text, Qcancel_timer;
190
191 /* In dispnew.c */
192
193 extern Lisp_Object Vwindow_system_version;
194
195 /* The below are defined in frame.c. */
196
197 #if GLYPH_DEBUG
198 int image_cache_refcount, dpyinfo_refcount;
199 #endif
200
201
202 \f
203 /* Error if we are not connected to X. */
204
205 void
206 check_x ()
207 {
208 if (! x_in_use)
209 error ("X windows are not in use or not initialized");
210 }
211
212 /* Nonzero if we can use mouse menus.
213 You should not call this unless HAVE_MENUS is defined. */
214
215 int
216 have_menus_p ()
217 {
218 return x_in_use;
219 }
220
221 /* Extract a frame as a FRAME_PTR, defaulting to the selected frame
222 and checking validity for X. */
223
224 FRAME_PTR
225 check_x_frame (frame)
226 Lisp_Object frame;
227 {
228 FRAME_PTR f;
229
230 if (NILP (frame))
231 frame = selected_frame;
232 CHECK_LIVE_FRAME (frame);
233 f = XFRAME (frame);
234 if (! FRAME_X_P (f))
235 error ("Non-X frame used");
236 return f;
237 }
238
239 /* Let the user specify an X display with a frame.
240 nil stands for the selected frame--or, if that is not an X frame,
241 the first X display on the list. */
242
243 struct x_display_info *
244 check_x_display_info (frame)
245 Lisp_Object frame;
246 {
247 struct x_display_info *dpyinfo = NULL;
248
249 if (NILP (frame))
250 {
251 struct frame *sf = XFRAME (selected_frame);
252
253 if (FRAME_X_P (sf) && FRAME_LIVE_P (sf))
254 dpyinfo = FRAME_X_DISPLAY_INFO (sf);
255 else if (x_display_list != 0)
256 dpyinfo = x_display_list;
257 else
258 error ("X windows are not in use or not initialized");
259 }
260 else if (STRINGP (frame))
261 dpyinfo = x_display_info_for_name (frame);
262 else
263 {
264 FRAME_PTR f = check_x_frame (frame);
265 dpyinfo = FRAME_X_DISPLAY_INFO (f);
266 }
267
268 return dpyinfo;
269 }
270
271 \f
272 /* Return the Emacs frame-object corresponding to an X window.
273 It could be the frame's main window or an icon window. */
274
275 /* This function can be called during GC, so use GC_xxx type test macros. */
276
277 struct frame *
278 x_window_to_frame (dpyinfo, wdesc)
279 struct x_display_info *dpyinfo;
280 int wdesc;
281 {
282 Lisp_Object tail, frame;
283 struct frame *f;
284
285 if (wdesc == None) return 0;
286
287 for (tail = Vframe_list; GC_CONSP (tail); tail = XCDR (tail))
288 {
289 frame = XCAR (tail);
290 if (!GC_FRAMEP (frame))
291 continue;
292 f = XFRAME (frame);
293 if (!FRAME_X_P (f) || FRAME_X_DISPLAY_INFO (f) != dpyinfo)
294 continue;
295 if (f->output_data.x->hourglass_window == wdesc)
296 return f;
297 #ifdef USE_X_TOOLKIT
298 if ((f->output_data.x->edit_widget
299 && XtWindow (f->output_data.x->edit_widget) == wdesc)
300 /* A tooltip frame? */
301 || (!f->output_data.x->edit_widget
302 && FRAME_X_WINDOW (f) == wdesc)
303 || f->output_data.x->icon_desc == wdesc)
304 return f;
305 #else /* not USE_X_TOOLKIT */
306 #ifdef USE_GTK
307 if (f->output_data.x->edit_widget)
308 {
309 GtkWidget *gwdesc = xg_win_to_widget (dpyinfo->display, wdesc);
310 struct x_output *x = f->output_data.x;
311 if (gwdesc != 0 && gwdesc == x->edit_widget)
312 return f;
313 }
314 #endif /* USE_GTK */
315 if (FRAME_X_WINDOW (f) == wdesc
316 || f->output_data.x->icon_desc == wdesc)
317 return f;
318 #endif /* not USE_X_TOOLKIT */
319 }
320 return 0;
321 }
322
323 #if defined (USE_X_TOOLKIT) || defined (USE_GTK)
324 /* Like x_window_to_frame but also compares the window with the widget's
325 windows. */
326
327 struct frame *
328 x_any_window_to_frame (dpyinfo, wdesc)
329 struct x_display_info *dpyinfo;
330 int wdesc;
331 {
332 Lisp_Object tail, frame;
333 struct frame *f, *found;
334 struct x_output *x;
335
336 if (wdesc == None) return NULL;
337
338 found = NULL;
339 for (tail = Vframe_list; GC_CONSP (tail) && !found; tail = XCDR (tail))
340 {
341 frame = XCAR (tail);
342 if (!GC_FRAMEP (frame))
343 continue;
344
345 f = XFRAME (frame);
346 if (FRAME_X_P (f) && FRAME_X_DISPLAY_INFO (f) == dpyinfo)
347 {
348 /* This frame matches if the window is any of its widgets. */
349 x = f->output_data.x;
350 if (x->hourglass_window == wdesc)
351 found = f;
352 else if (x->widget)
353 {
354 #ifdef USE_GTK
355 GtkWidget *gwdesc = xg_win_to_widget (dpyinfo->display, wdesc);
356 if (gwdesc != 0
357 && (gwdesc == x->widget
358 || gwdesc == x->edit_widget
359 || gwdesc == x->vbox_widget
360 || gwdesc == x->menubar_widget))
361 found = f;
362 #else
363 if (wdesc == XtWindow (x->widget)
364 || wdesc == XtWindow (x->column_widget)
365 || wdesc == XtWindow (x->edit_widget))
366 found = f;
367 /* Match if the window is this frame's menubar. */
368 else if (lw_window_is_in_menubar (wdesc, x->menubar_widget))
369 found = f;
370 #endif
371 }
372 else if (FRAME_X_WINDOW (f) == wdesc)
373 /* A tooltip frame. */
374 found = f;
375 }
376 }
377
378 return found;
379 }
380
381 /* Likewise, but exclude the menu bar widget. */
382
383 struct frame *
384 x_non_menubar_window_to_frame (dpyinfo, wdesc)
385 struct x_display_info *dpyinfo;
386 int wdesc;
387 {
388 Lisp_Object tail, frame;
389 struct frame *f;
390 struct x_output *x;
391
392 if (wdesc == None) return 0;
393
394 for (tail = Vframe_list; GC_CONSP (tail); tail = XCDR (tail))
395 {
396 frame = XCAR (tail);
397 if (!GC_FRAMEP (frame))
398 continue;
399 f = XFRAME (frame);
400 if (!FRAME_X_P (f) || FRAME_X_DISPLAY_INFO (f) != dpyinfo)
401 continue;
402 x = f->output_data.x;
403 /* This frame matches if the window is any of its widgets. */
404 if (x->hourglass_window == wdesc)
405 return f;
406 else if (x->widget)
407 {
408 #ifdef USE_GTK
409 GtkWidget *gwdesc = xg_win_to_widget (dpyinfo->display, wdesc);
410 if (gwdesc != 0
411 && (gwdesc == x->widget
412 || gwdesc == x->edit_widget
413 || gwdesc == x->vbox_widget))
414 return f;
415 #else
416 if (wdesc == XtWindow (x->widget)
417 || wdesc == XtWindow (x->column_widget)
418 || wdesc == XtWindow (x->edit_widget))
419 return f;
420 #endif
421 }
422 else if (FRAME_X_WINDOW (f) == wdesc)
423 /* A tooltip frame. */
424 return f;
425 }
426 return 0;
427 }
428
429 /* Likewise, but consider only the menu bar widget. */
430
431 struct frame *
432 x_menubar_window_to_frame (dpyinfo, wdesc)
433 struct x_display_info *dpyinfo;
434 int wdesc;
435 {
436 Lisp_Object tail, frame;
437 struct frame *f;
438 struct x_output *x;
439
440 if (wdesc == None) return 0;
441
442 for (tail = Vframe_list; GC_CONSP (tail); tail = XCDR (tail))
443 {
444 frame = XCAR (tail);
445 if (!GC_FRAMEP (frame))
446 continue;
447 f = XFRAME (frame);
448 if (!FRAME_X_P (f) || FRAME_X_DISPLAY_INFO (f) != dpyinfo)
449 continue;
450 x = f->output_data.x;
451 /* Match if the window is this frame's menubar. */
452 #ifdef USE_GTK
453 if (x->menubar_widget)
454 {
455 GtkWidget *gwdesc = xg_win_to_widget (dpyinfo->display, wdesc);
456 int found = 0;
457
458 BLOCK_INPUT;
459 if (gwdesc != 0
460 && (gwdesc == x->menubar_widget
461 || gtk_widget_get_parent (gwdesc) == x->menubar_widget))
462 found = 1;
463 UNBLOCK_INPUT;
464 if (found) return f;
465 }
466 #else
467 if (x->menubar_widget
468 && lw_window_is_in_menubar (wdesc, x->menubar_widget))
469 return f;
470 #endif
471 }
472 return 0;
473 }
474
475 /* Return the frame whose principal (outermost) window is WDESC.
476 If WDESC is some other (smaller) window, we return 0. */
477
478 struct frame *
479 x_top_window_to_frame (dpyinfo, wdesc)
480 struct x_display_info *dpyinfo;
481 int wdesc;
482 {
483 Lisp_Object tail, frame;
484 struct frame *f;
485 struct x_output *x;
486
487 if (wdesc == None) return 0;
488
489 for (tail = Vframe_list; GC_CONSP (tail); tail = XCDR (tail))
490 {
491 frame = XCAR (tail);
492 if (!GC_FRAMEP (frame))
493 continue;
494 f = XFRAME (frame);
495 if (!FRAME_X_P (f) || FRAME_X_DISPLAY_INFO (f) != dpyinfo)
496 continue;
497 x = f->output_data.x;
498
499 if (x->widget)
500 {
501 /* This frame matches if the window is its topmost widget. */
502 #ifdef USE_GTK
503 GtkWidget *gwdesc = xg_win_to_widget (dpyinfo->display, wdesc);
504 if (gwdesc == x->widget)
505 return f;
506 #else
507 if (wdesc == XtWindow (x->widget))
508 return f;
509 #if 0 /* I don't know why it did this,
510 but it seems logically wrong,
511 and it causes trouble for MapNotify events. */
512 /* Match if the window is this frame's menubar. */
513 if (x->menubar_widget
514 && wdesc == XtWindow (x->menubar_widget))
515 return f;
516 #endif
517 #endif
518 }
519 else if (FRAME_X_WINDOW (f) == wdesc)
520 /* Tooltip frame. */
521 return f;
522 }
523 return 0;
524 }
525 #endif /* USE_X_TOOLKIT || USE_GTK */
526
527 \f
528
529 static Lisp_Object unwind_create_frame P_ ((Lisp_Object));
530 static Lisp_Object unwind_create_tip_frame P_ ((Lisp_Object));
531
532 void x_set_foreground_color P_ ((struct frame *, Lisp_Object, Lisp_Object));
533 static void x_set_wait_for_wm P_ ((struct frame *, Lisp_Object, Lisp_Object));
534 void x_set_background_color P_ ((struct frame *, Lisp_Object, Lisp_Object));
535 void x_set_mouse_color P_ ((struct frame *, Lisp_Object, Lisp_Object));
536 void x_set_cursor_color P_ ((struct frame *, Lisp_Object, Lisp_Object));
537 void x_set_border_color P_ ((struct frame *, Lisp_Object, Lisp_Object));
538 void x_set_cursor_type P_ ((struct frame *, Lisp_Object, Lisp_Object));
539 void x_set_icon_type P_ ((struct frame *, Lisp_Object, Lisp_Object));
540 void x_set_icon_name P_ ((struct frame *, Lisp_Object, Lisp_Object));
541 void x_explicitly_set_name P_ ((struct frame *, Lisp_Object, Lisp_Object));
542 void x_set_menu_bar_lines P_ ((struct frame *, Lisp_Object, Lisp_Object));
543 void x_set_title P_ ((struct frame *, Lisp_Object, Lisp_Object));
544 void x_set_tool_bar_lines P_ ((struct frame *, Lisp_Object, Lisp_Object));
545 void x_set_scroll_bar_foreground P_ ((struct frame *, Lisp_Object,
546 Lisp_Object));
547 void x_set_scroll_bar_background P_ ((struct frame *, Lisp_Object,
548 Lisp_Object));
549 static Lisp_Object x_default_scroll_bar_color_parameter P_ ((struct frame *,
550 Lisp_Object,
551 Lisp_Object,
552 char *, char *,
553 int));
554 \f
555
556 /* Store the screen positions of frame F into XPTR and YPTR.
557 These are the positions of the containing window manager window,
558 not Emacs's own window. */
559
560 void
561 x_real_positions (f, xptr, yptr)
562 FRAME_PTR f;
563 int *xptr, *yptr;
564 {
565 int win_x, win_y, outer_x, outer_y;
566 int real_x = 0, real_y = 0;
567 int had_errors = 0;
568 Window win = f->output_data.x->parent_desc;
569
570 int count;
571
572 BLOCK_INPUT;
573
574 count = x_catch_errors (FRAME_X_DISPLAY (f));
575
576 if (win == FRAME_X_DISPLAY_INFO (f)->root_window)
577 win = FRAME_OUTER_WINDOW (f);
578
579 /* This loop traverses up the containment tree until we hit the root
580 window. Window managers may intersect many windows between our window
581 and the root window. The window we find just before the root window
582 should be the outer WM window. */
583 for (;;)
584 {
585 Window wm_window, rootw;
586 Window *tmp_children;
587 unsigned int tmp_nchildren;
588 int success;
589
590 success = XQueryTree (FRAME_X_DISPLAY (f), win, &rootw,
591 &wm_window, &tmp_children, &tmp_nchildren);
592
593 had_errors = x_had_errors_p (FRAME_X_DISPLAY (f));
594
595 /* Don't free tmp_children if XQueryTree failed. */
596 if (! success)
597 break;
598
599 XFree ((char *) tmp_children);
600
601 if (wm_window == rootw || had_errors)
602 break;
603
604 win = wm_window;
605 }
606
607 if (! had_errors)
608 {
609 int ign;
610 Window child, rootw;
611
612 /* Get the real coordinates for the WM window upper left corner */
613 XGetGeometry (FRAME_X_DISPLAY (f), win,
614 &rootw, &real_x, &real_y, &ign, &ign, &ign, &ign);
615
616 /* Translate real coordinates to coordinates relative to our
617 window. For our window, the upper left corner is 0, 0.
618 Since the upper left corner of the WM window is outside
619 our window, win_x and win_y will be negative:
620
621 ------------------ ---> x
622 | title |
623 | ----------------- v y
624 | | our window
625 */
626 XTranslateCoordinates (FRAME_X_DISPLAY (f),
627
628 /* From-window, to-window. */
629 FRAME_X_DISPLAY_INFO (f)->root_window,
630 FRAME_X_WINDOW (f),
631
632 /* From-position, to-position. */
633 real_x, real_y, &win_x, &win_y,
634
635 /* Child of win. */
636 &child);
637
638 if (FRAME_X_WINDOW (f) == FRAME_OUTER_WINDOW (f))
639 {
640 outer_x = win_x;
641 outer_y = win_y;
642 }
643 else
644 {
645 XTranslateCoordinates (FRAME_X_DISPLAY (f),
646
647 /* From-window, to-window. */
648 FRAME_X_DISPLAY_INFO (f)->root_window,
649 FRAME_OUTER_WINDOW (f),
650
651 /* From-position, to-position. */
652 real_x, real_y, &outer_x, &outer_y,
653
654 /* Child of win. */
655 &child);
656 }
657
658 had_errors = x_had_errors_p (FRAME_X_DISPLAY (f));
659 }
660
661 x_uncatch_errors (FRAME_X_DISPLAY (f), count);
662
663 UNBLOCK_INPUT;
664
665 if (had_errors) return;
666
667 f->x_pixels_diff = -win_x;
668 f->y_pixels_diff = -win_y;
669
670 FRAME_X_OUTPUT (f)->x_pixels_outer_diff = -outer_x;
671 FRAME_X_OUTPUT (f)->y_pixels_outer_diff = -outer_y;
672
673 *xptr = real_x;
674 *yptr = real_y;
675 }
676
677 \f
678
679
680 /* Gamma-correct COLOR on frame F. */
681
682 void
683 gamma_correct (f, color)
684 struct frame *f;
685 XColor *color;
686 {
687 if (f->gamma)
688 {
689 color->red = pow (color->red / 65535.0, f->gamma) * 65535.0 + 0.5;
690 color->green = pow (color->green / 65535.0, f->gamma) * 65535.0 + 0.5;
691 color->blue = pow (color->blue / 65535.0, f->gamma) * 65535.0 + 0.5;
692 }
693 }
694
695
696 /* Decide if color named COLOR_NAME is valid for use on frame F. If
697 so, return the RGB values in COLOR. If ALLOC_P is non-zero,
698 allocate the color. Value is zero if COLOR_NAME is invalid, or
699 no color could be allocated. */
700
701 int
702 x_defined_color (f, color_name, color, alloc_p)
703 struct frame *f;
704 char *color_name;
705 XColor *color;
706 int alloc_p;
707 {
708 int success_p;
709 Display *dpy = FRAME_X_DISPLAY (f);
710 Colormap cmap = FRAME_X_COLORMAP (f);
711
712 BLOCK_INPUT;
713 success_p = XParseColor (dpy, cmap, color_name, color);
714 if (success_p && alloc_p)
715 success_p = x_alloc_nearest_color (f, cmap, color);
716 UNBLOCK_INPUT;
717
718 return success_p;
719 }
720
721
722 /* Return the pixel color value for color COLOR_NAME on frame F. If F
723 is a monochrome frame, return MONO_COLOR regardless of what ARG says.
724 Signal an error if color can't be allocated. */
725
726 int
727 x_decode_color (f, color_name, mono_color)
728 FRAME_PTR f;
729 Lisp_Object color_name;
730 int mono_color;
731 {
732 XColor cdef;
733
734 CHECK_STRING (color_name);
735
736 #if 0 /* Don't do this. It's wrong when we're not using the default
737 colormap, it makes freeing difficult, and it's probably not
738 an important optimization. */
739 if (strcmp (SDATA (color_name), "black") == 0)
740 return BLACK_PIX_DEFAULT (f);
741 else if (strcmp (SDATA (color_name), "white") == 0)
742 return WHITE_PIX_DEFAULT (f);
743 #endif
744
745 /* Return MONO_COLOR for monochrome frames. */
746 if (FRAME_X_DISPLAY_INFO (f)->n_planes == 1)
747 return mono_color;
748
749 /* x_defined_color is responsible for coping with failures
750 by looking for a near-miss. */
751 if (x_defined_color (f, SDATA (color_name), &cdef, 1))
752 return cdef.pixel;
753
754 Fsignal (Qerror, Fcons (build_string ("Undefined color"),
755 Fcons (color_name, Qnil)));
756 return 0;
757 }
758
759
760 \f
761 /* Change the `wait-for-wm' frame parameter of frame F. OLD_VALUE is
762 the previous value of that parameter, NEW_VALUE is the new value.
763 See also the comment of wait_for_wm in struct x_output. */
764
765 static void
766 x_set_wait_for_wm (f, new_value, old_value)
767 struct frame *f;
768 Lisp_Object new_value, old_value;
769 {
770 f->output_data.x->wait_for_wm = !NILP (new_value);
771 }
772
773 #ifdef USE_GTK
774
775 /* Set icon from FILE for frame F. By using GTK functions the icon
776 may be any format that GdkPixbuf knows about, i.e. not just bitmaps. */
777
778 int
779 xg_set_icon (f, file)
780 FRAME_PTR f;
781 Lisp_Object file;
782 {
783 struct gcpro gcpro1;
784 int result = 0;
785 Lisp_Object found;
786
787 GCPRO1 (found);
788
789 found = x_find_image_file (file);
790
791 if (! NILP (found))
792 {
793 GdkPixbuf *pixbuf;
794 GError *err = NULL;
795 char *filename;
796
797 filename = SDATA (found);
798 BLOCK_INPUT;
799
800 pixbuf = gdk_pixbuf_new_from_file (filename, &err);
801
802 if (pixbuf)
803 {
804 gtk_window_set_icon (GTK_WINDOW (FRAME_GTK_OUTER_WIDGET (f)),
805 pixbuf);
806 g_object_unref (pixbuf);
807
808 result = 1;
809 }
810 else
811 g_error_free (err);
812
813 UNBLOCK_INPUT;
814 }
815
816 UNGCPRO;
817 return result;
818 }
819 #endif /* USE_GTK */
820
821
822 /* Functions called only from `x_set_frame_param'
823 to set individual parameters.
824
825 If FRAME_X_WINDOW (f) is 0,
826 the frame is being created and its X-window does not exist yet.
827 In that case, just record the parameter's new value
828 in the standard place; do not attempt to change the window. */
829
830 void
831 x_set_foreground_color (f, arg, oldval)
832 struct frame *f;
833 Lisp_Object arg, oldval;
834 {
835 struct x_output *x = f->output_data.x;
836 unsigned long fg, old_fg;
837
838 fg = x_decode_color (f, arg, BLACK_PIX_DEFAULT (f));
839 old_fg = x->foreground_pixel;
840 x->foreground_pixel = fg;
841
842 if (FRAME_X_WINDOW (f) != 0)
843 {
844 Display *dpy = FRAME_X_DISPLAY (f);
845
846 BLOCK_INPUT;
847 XSetForeground (dpy, x->normal_gc, fg);
848 XSetBackground (dpy, x->reverse_gc, fg);
849
850 if (x->cursor_pixel == old_fg)
851 {
852 unload_color (f, x->cursor_pixel);
853 x->cursor_pixel = x_copy_color (f, fg);
854 XSetBackground (dpy, x->cursor_gc, x->cursor_pixel);
855 }
856
857 UNBLOCK_INPUT;
858
859 update_face_from_frame_parameter (f, Qforeground_color, arg);
860
861 if (FRAME_VISIBLE_P (f))
862 redraw_frame (f);
863 }
864
865 unload_color (f, old_fg);
866 }
867
868 void
869 x_set_background_color (f, arg, oldval)
870 struct frame *f;
871 Lisp_Object arg, oldval;
872 {
873 struct x_output *x = f->output_data.x;
874 unsigned long bg;
875
876 bg = x_decode_color (f, arg, WHITE_PIX_DEFAULT (f));
877 unload_color (f, x->background_pixel);
878 x->background_pixel = bg;
879
880 if (FRAME_X_WINDOW (f) != 0)
881 {
882 Display *dpy = FRAME_X_DISPLAY (f);
883
884 BLOCK_INPUT;
885 XSetBackground (dpy, x->normal_gc, bg);
886 XSetForeground (dpy, x->reverse_gc, bg);
887 XSetWindowBackground (dpy, FRAME_X_WINDOW (f), bg);
888 XSetForeground (dpy, x->cursor_gc, bg);
889
890 #ifdef USE_GTK
891 xg_set_background_color (f, bg);
892 #endif
893
894 #ifndef USE_TOOLKIT_SCROLL_BARS /* Turns out to be annoying with
895 toolkit scroll bars. */
896 {
897 Lisp_Object bar;
898 for (bar = FRAME_SCROLL_BARS (f);
899 !NILP (bar);
900 bar = XSCROLL_BAR (bar)->next)
901 {
902 Window window = SCROLL_BAR_X_WINDOW (XSCROLL_BAR (bar));
903 XSetWindowBackground (dpy, window, bg);
904 }
905 }
906 #endif /* USE_TOOLKIT_SCROLL_BARS */
907
908 UNBLOCK_INPUT;
909 update_face_from_frame_parameter (f, Qbackground_color, arg);
910
911 if (FRAME_VISIBLE_P (f))
912 redraw_frame (f);
913 }
914 }
915
916 void
917 x_set_mouse_color (f, arg, oldval)
918 struct frame *f;
919 Lisp_Object arg, oldval;
920 {
921 struct x_output *x = f->output_data.x;
922 Display *dpy = FRAME_X_DISPLAY (f);
923 Cursor cursor, nontext_cursor, mode_cursor, hand_cursor;
924 Cursor hourglass_cursor, horizontal_drag_cursor;
925 int count;
926 unsigned long pixel = x_decode_color (f, arg, BLACK_PIX_DEFAULT (f));
927 unsigned long mask_color = x->background_pixel;
928
929 /* Don't let pointers be invisible. */
930 if (mask_color == pixel)
931 {
932 x_free_colors (f, &pixel, 1);
933 pixel = x_copy_color (f, x->foreground_pixel);
934 }
935
936 unload_color (f, x->mouse_pixel);
937 x->mouse_pixel = pixel;
938
939 BLOCK_INPUT;
940
941 /* It's not okay to crash if the user selects a screwy cursor. */
942 count = x_catch_errors (dpy);
943
944 if (!NILP (Vx_pointer_shape))
945 {
946 CHECK_NUMBER (Vx_pointer_shape);
947 cursor = XCreateFontCursor (dpy, XINT (Vx_pointer_shape));
948 }
949 else
950 cursor = XCreateFontCursor (dpy, XC_xterm);
951 x_check_errors (dpy, "bad text pointer cursor: %s");
952
953 if (!NILP (Vx_nontext_pointer_shape))
954 {
955 CHECK_NUMBER (Vx_nontext_pointer_shape);
956 nontext_cursor
957 = XCreateFontCursor (dpy, XINT (Vx_nontext_pointer_shape));
958 }
959 else
960 nontext_cursor = XCreateFontCursor (dpy, XC_left_ptr);
961 x_check_errors (dpy, "bad nontext pointer cursor: %s");
962
963 if (!NILP (Vx_hourglass_pointer_shape))
964 {
965 CHECK_NUMBER (Vx_hourglass_pointer_shape);
966 hourglass_cursor
967 = XCreateFontCursor (dpy, XINT (Vx_hourglass_pointer_shape));
968 }
969 else
970 hourglass_cursor = XCreateFontCursor (dpy, XC_watch);
971 x_check_errors (dpy, "bad hourglass pointer cursor: %s");
972
973 if (!NILP (Vx_mode_pointer_shape))
974 {
975 CHECK_NUMBER (Vx_mode_pointer_shape);
976 mode_cursor = XCreateFontCursor (dpy, XINT (Vx_mode_pointer_shape));
977 }
978 else
979 mode_cursor = XCreateFontCursor (dpy, XC_xterm);
980 x_check_errors (dpy, "bad modeline pointer cursor: %s");
981
982 if (!NILP (Vx_sensitive_text_pointer_shape))
983 {
984 CHECK_NUMBER (Vx_sensitive_text_pointer_shape);
985 hand_cursor
986 = XCreateFontCursor (dpy, XINT (Vx_sensitive_text_pointer_shape));
987 }
988 else
989 hand_cursor = XCreateFontCursor (dpy, XC_hand2);
990
991 if (!NILP (Vx_window_horizontal_drag_shape))
992 {
993 CHECK_NUMBER (Vx_window_horizontal_drag_shape);
994 horizontal_drag_cursor
995 = XCreateFontCursor (dpy, XINT (Vx_window_horizontal_drag_shape));
996 }
997 else
998 horizontal_drag_cursor
999 = XCreateFontCursor (dpy, XC_sb_h_double_arrow);
1000
1001 /* Check and report errors with the above calls. */
1002 x_check_errors (dpy, "can't set cursor shape: %s");
1003 x_uncatch_errors (dpy, count);
1004
1005 {
1006 XColor fore_color, back_color;
1007
1008 fore_color.pixel = x->mouse_pixel;
1009 x_query_color (f, &fore_color);
1010 back_color.pixel = mask_color;
1011 x_query_color (f, &back_color);
1012
1013 XRecolorCursor (dpy, cursor, &fore_color, &back_color);
1014 XRecolorCursor (dpy, nontext_cursor, &fore_color, &back_color);
1015 XRecolorCursor (dpy, mode_cursor, &fore_color, &back_color);
1016 XRecolorCursor (dpy, hand_cursor, &fore_color, &back_color);
1017 XRecolorCursor (dpy, hourglass_cursor, &fore_color, &back_color);
1018 XRecolorCursor (dpy, horizontal_drag_cursor, &fore_color, &back_color);
1019 }
1020
1021 if (FRAME_X_WINDOW (f) != 0)
1022 XDefineCursor (dpy, FRAME_X_WINDOW (f), cursor);
1023
1024 if (cursor != x->text_cursor
1025 && x->text_cursor != 0)
1026 XFreeCursor (dpy, x->text_cursor);
1027 x->text_cursor = cursor;
1028
1029 if (nontext_cursor != x->nontext_cursor
1030 && x->nontext_cursor != 0)
1031 XFreeCursor (dpy, x->nontext_cursor);
1032 x->nontext_cursor = nontext_cursor;
1033
1034 if (hourglass_cursor != x->hourglass_cursor
1035 && x->hourglass_cursor != 0)
1036 XFreeCursor (dpy, x->hourglass_cursor);
1037 x->hourglass_cursor = hourglass_cursor;
1038
1039 if (mode_cursor != x->modeline_cursor
1040 && x->modeline_cursor != 0)
1041 XFreeCursor (dpy, f->output_data.x->modeline_cursor);
1042 x->modeline_cursor = mode_cursor;
1043
1044 if (hand_cursor != x->hand_cursor
1045 && x->hand_cursor != 0)
1046 XFreeCursor (dpy, x->hand_cursor);
1047 x->hand_cursor = hand_cursor;
1048
1049 if (horizontal_drag_cursor != x->horizontal_drag_cursor
1050 && x->horizontal_drag_cursor != 0)
1051 XFreeCursor (dpy, x->horizontal_drag_cursor);
1052 x->horizontal_drag_cursor = horizontal_drag_cursor;
1053
1054 XFlush (dpy);
1055 UNBLOCK_INPUT;
1056
1057 update_face_from_frame_parameter (f, Qmouse_color, arg);
1058 }
1059
1060 void
1061 x_set_cursor_color (f, arg, oldval)
1062 struct frame *f;
1063 Lisp_Object arg, oldval;
1064 {
1065 unsigned long fore_pixel, pixel;
1066 int fore_pixel_allocated_p = 0, pixel_allocated_p = 0;
1067 struct x_output *x = f->output_data.x;
1068
1069 if (!NILP (Vx_cursor_fore_pixel))
1070 {
1071 fore_pixel = x_decode_color (f, Vx_cursor_fore_pixel,
1072 WHITE_PIX_DEFAULT (f));
1073 fore_pixel_allocated_p = 1;
1074 }
1075 else
1076 fore_pixel = x->background_pixel;
1077
1078 pixel = x_decode_color (f, arg, BLACK_PIX_DEFAULT (f));
1079 pixel_allocated_p = 1;
1080
1081 /* Make sure that the cursor color differs from the background color. */
1082 if (pixel == x->background_pixel)
1083 {
1084 if (pixel_allocated_p)
1085 {
1086 x_free_colors (f, &pixel, 1);
1087 pixel_allocated_p = 0;
1088 }
1089
1090 pixel = x->mouse_pixel;
1091 if (pixel == fore_pixel)
1092 {
1093 if (fore_pixel_allocated_p)
1094 {
1095 x_free_colors (f, &fore_pixel, 1);
1096 fore_pixel_allocated_p = 0;
1097 }
1098 fore_pixel = x->background_pixel;
1099 }
1100 }
1101
1102 unload_color (f, x->cursor_foreground_pixel);
1103 if (!fore_pixel_allocated_p)
1104 fore_pixel = x_copy_color (f, fore_pixel);
1105 x->cursor_foreground_pixel = fore_pixel;
1106
1107 unload_color (f, x->cursor_pixel);
1108 if (!pixel_allocated_p)
1109 pixel = x_copy_color (f, pixel);
1110 x->cursor_pixel = pixel;
1111
1112 if (FRAME_X_WINDOW (f) != 0)
1113 {
1114 BLOCK_INPUT;
1115 XSetBackground (FRAME_X_DISPLAY (f), x->cursor_gc, x->cursor_pixel);
1116 XSetForeground (FRAME_X_DISPLAY (f), x->cursor_gc, fore_pixel);
1117 UNBLOCK_INPUT;
1118
1119 if (FRAME_VISIBLE_P (f))
1120 {
1121 x_update_cursor (f, 0);
1122 x_update_cursor (f, 1);
1123 }
1124 }
1125
1126 update_face_from_frame_parameter (f, Qcursor_color, arg);
1127 }
1128 \f
1129 /* Set the border-color of frame F to pixel value PIX.
1130 Note that this does not fully take effect if done before
1131 F has an x-window. */
1132
1133 void
1134 x_set_border_pixel (f, pix)
1135 struct frame *f;
1136 int pix;
1137 {
1138 unload_color (f, f->output_data.x->border_pixel);
1139 f->output_data.x->border_pixel = pix;
1140
1141 if (FRAME_X_WINDOW (f) != 0 && f->border_width > 0)
1142 {
1143 BLOCK_INPUT;
1144 XSetWindowBorder (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
1145 (unsigned long)pix);
1146 UNBLOCK_INPUT;
1147
1148 if (FRAME_VISIBLE_P (f))
1149 redraw_frame (f);
1150 }
1151 }
1152
1153 /* Set the border-color of frame F to value described by ARG.
1154 ARG can be a string naming a color.
1155 The border-color is used for the border that is drawn by the X server.
1156 Note that this does not fully take effect if done before
1157 F has an x-window; it must be redone when the window is created.
1158
1159 Note: this is done in two routines because of the way X10 works.
1160
1161 Note: under X11, this is normally the province of the window manager,
1162 and so emacs' border colors may be overridden. */
1163
1164 void
1165 x_set_border_color (f, arg, oldval)
1166 struct frame *f;
1167 Lisp_Object arg, oldval;
1168 {
1169 int pix;
1170
1171 CHECK_STRING (arg);
1172 pix = x_decode_color (f, arg, BLACK_PIX_DEFAULT (f));
1173 x_set_border_pixel (f, pix);
1174 update_face_from_frame_parameter (f, Qborder_color, arg);
1175 }
1176
1177
1178 void
1179 x_set_cursor_type (f, arg, oldval)
1180 FRAME_PTR f;
1181 Lisp_Object arg, oldval;
1182 {
1183 set_frame_cursor_types (f, arg);
1184
1185 /* Make sure the cursor gets redrawn. */
1186 cursor_type_changed = 1;
1187 }
1188 \f
1189 void
1190 x_set_icon_type (f, arg, oldval)
1191 struct frame *f;
1192 Lisp_Object arg, oldval;
1193 {
1194 int result;
1195
1196 if (STRINGP (arg))
1197 {
1198 if (STRINGP (oldval) && EQ (Fstring_equal (oldval, arg), Qt))
1199 return;
1200 }
1201 else if (!STRINGP (oldval) && EQ (oldval, Qnil) == EQ (arg, Qnil))
1202 return;
1203
1204 BLOCK_INPUT;
1205 if (NILP (arg))
1206 result = x_text_icon (f,
1207 (char *) SDATA ((!NILP (f->icon_name)
1208 ? f->icon_name
1209 : f->name)));
1210 else
1211 result = x_bitmap_icon (f, arg);
1212
1213 if (result)
1214 {
1215 UNBLOCK_INPUT;
1216 error ("No icon window available");
1217 }
1218
1219 XFlush (FRAME_X_DISPLAY (f));
1220 UNBLOCK_INPUT;
1221 }
1222
1223 void
1224 x_set_icon_name (f, arg, oldval)
1225 struct frame *f;
1226 Lisp_Object arg, oldval;
1227 {
1228 int result;
1229
1230 if (STRINGP (arg))
1231 {
1232 if (STRINGP (oldval) && EQ (Fstring_equal (oldval, arg), Qt))
1233 return;
1234 }
1235 else if (!STRINGP (oldval) && EQ (oldval, Qnil) == EQ (arg, Qnil))
1236 return;
1237
1238 f->icon_name = arg;
1239
1240 if (f->output_data.x->icon_bitmap != 0)
1241 return;
1242
1243 BLOCK_INPUT;
1244
1245 result = x_text_icon (f,
1246 (char *) SDATA ((!NILP (f->icon_name)
1247 ? f->icon_name
1248 : !NILP (f->title)
1249 ? f->title
1250 : f->name)));
1251
1252 if (result)
1253 {
1254 UNBLOCK_INPUT;
1255 error ("No icon window available");
1256 }
1257
1258 XFlush (FRAME_X_DISPLAY (f));
1259 UNBLOCK_INPUT;
1260 }
1261
1262 \f
1263 void
1264 x_set_menu_bar_lines (f, value, oldval)
1265 struct frame *f;
1266 Lisp_Object value, oldval;
1267 {
1268 int nlines;
1269 #if ! defined (USE_X_TOOLKIT) && ! defined (USE_GTK)
1270 int olines = FRAME_MENU_BAR_LINES (f);
1271 #endif
1272
1273 /* Right now, menu bars don't work properly in minibuf-only frames;
1274 most of the commands try to apply themselves to the minibuffer
1275 frame itself, and get an error because you can't switch buffers
1276 in or split the minibuffer window. */
1277 if (FRAME_MINIBUF_ONLY_P (f))
1278 return;
1279
1280 if (INTEGERP (value))
1281 nlines = XINT (value);
1282 else
1283 nlines = 0;
1284
1285 /* Make sure we redisplay all windows in this frame. */
1286 windows_or_buffers_changed++;
1287
1288 #if defined (USE_X_TOOLKIT) || defined (USE_GTK)
1289 FRAME_MENU_BAR_LINES (f) = 0;
1290 if (nlines)
1291 {
1292 FRAME_EXTERNAL_MENU_BAR (f) = 1;
1293 if (FRAME_X_P (f) && f->output_data.x->menubar_widget == 0)
1294 /* Make sure next redisplay shows the menu bar. */
1295 XWINDOW (FRAME_SELECTED_WINDOW (f))->update_mode_line = Qt;
1296 }
1297 else
1298 {
1299 if (FRAME_EXTERNAL_MENU_BAR (f) == 1)
1300 free_frame_menubar (f);
1301 FRAME_EXTERNAL_MENU_BAR (f) = 0;
1302 if (FRAME_X_P (f))
1303 f->output_data.x->menubar_widget = 0;
1304 }
1305 #else /* not USE_X_TOOLKIT && not USE_GTK */
1306 FRAME_MENU_BAR_LINES (f) = nlines;
1307 change_window_heights (f->root_window, nlines - olines);
1308 #endif /* not USE_X_TOOLKIT */
1309 adjust_glyphs (f);
1310 }
1311
1312
1313 /* Set the number of lines used for the tool bar of frame F to VALUE.
1314 VALUE not an integer, or < 0 means set the lines to zero. OLDVAL
1315 is the old number of tool bar lines. This function changes the
1316 height of all windows on frame F to match the new tool bar height.
1317 The frame's height doesn't change. */
1318
1319 void
1320 x_set_tool_bar_lines (f, value, oldval)
1321 struct frame *f;
1322 Lisp_Object value, oldval;
1323 {
1324 int delta, nlines, root_height;
1325 Lisp_Object root_window;
1326
1327 /* Treat tool bars like menu bars. */
1328 if (FRAME_MINIBUF_ONLY_P (f))
1329 return;
1330
1331 /* Use VALUE only if an integer >= 0. */
1332 if (INTEGERP (value) && XINT (value) >= 0)
1333 nlines = XFASTINT (value);
1334 else
1335 nlines = 0;
1336
1337 #ifdef USE_GTK
1338 FRAME_TOOL_BAR_LINES (f) = 0;
1339 if (nlines)
1340 {
1341 FRAME_EXTERNAL_TOOL_BAR (f) = 1;
1342 if (FRAME_X_P (f) && f->output_data.x->toolbar_widget == 0)
1343 /* Make sure next redisplay shows the tool bar. */
1344 XWINDOW (FRAME_SELECTED_WINDOW (f))->update_mode_line = Qt;
1345 update_frame_tool_bar (f);
1346 }
1347 else
1348 {
1349 if (FRAME_EXTERNAL_TOOL_BAR (f))
1350 free_frame_tool_bar (f);
1351 FRAME_EXTERNAL_TOOL_BAR (f) = 0;
1352 }
1353
1354 return;
1355 #endif
1356
1357 /* Make sure we redisplay all windows in this frame. */
1358 ++windows_or_buffers_changed;
1359
1360 delta = nlines - FRAME_TOOL_BAR_LINES (f);
1361
1362 /* Don't resize the tool-bar to more than we have room for. */
1363 root_window = FRAME_ROOT_WINDOW (f);
1364 root_height = WINDOW_TOTAL_LINES (XWINDOW (root_window));
1365 if (root_height - delta < 1)
1366 {
1367 delta = root_height - 1;
1368 nlines = FRAME_TOOL_BAR_LINES (f) + delta;
1369 }
1370
1371 FRAME_TOOL_BAR_LINES (f) = nlines;
1372 change_window_heights (root_window, delta);
1373 adjust_glyphs (f);
1374
1375 /* We also have to make sure that the internal border at the top of
1376 the frame, below the menu bar or tool bar, is redrawn when the
1377 tool bar disappears. This is so because the internal border is
1378 below the tool bar if one is displayed, but is below the menu bar
1379 if there isn't a tool bar. The tool bar draws into the area
1380 below the menu bar. */
1381 if (FRAME_X_WINDOW (f) && FRAME_TOOL_BAR_LINES (f) == 0)
1382 {
1383 updating_frame = f;
1384 clear_frame ();
1385 clear_current_matrices (f);
1386 updating_frame = NULL;
1387 }
1388
1389 /* If the tool bar gets smaller, the internal border below it
1390 has to be cleared. It was formerly part of the display
1391 of the larger tool bar, and updating windows won't clear it. */
1392 if (delta < 0)
1393 {
1394 int height = FRAME_INTERNAL_BORDER_WIDTH (f);
1395 int width = FRAME_PIXEL_WIDTH (f);
1396 int y = nlines * FRAME_LINE_HEIGHT (f);
1397
1398 BLOCK_INPUT;
1399 x_clear_area (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
1400 0, y, width, height, False);
1401 UNBLOCK_INPUT;
1402
1403 if (WINDOWP (f->tool_bar_window))
1404 clear_glyph_matrix (XWINDOW (f->tool_bar_window)->current_matrix);
1405 }
1406 }
1407
1408
1409 /* Set the foreground color for scroll bars on frame F to VALUE.
1410 VALUE should be a string, a color name. If it isn't a string or
1411 isn't a valid color name, do nothing. OLDVAL is the old value of
1412 the frame parameter. */
1413
1414 void
1415 x_set_scroll_bar_foreground (f, value, oldval)
1416 struct frame *f;
1417 Lisp_Object value, oldval;
1418 {
1419 unsigned long pixel;
1420
1421 if (STRINGP (value))
1422 pixel = x_decode_color (f, value, BLACK_PIX_DEFAULT (f));
1423 else
1424 pixel = -1;
1425
1426 if (f->output_data.x->scroll_bar_foreground_pixel != -1)
1427 unload_color (f, f->output_data.x->scroll_bar_foreground_pixel);
1428
1429 f->output_data.x->scroll_bar_foreground_pixel = pixel;
1430 if (FRAME_X_WINDOW (f) && FRAME_VISIBLE_P (f))
1431 {
1432 /* Remove all scroll bars because they have wrong colors. */
1433 if (condemn_scroll_bars_hook)
1434 (*condemn_scroll_bars_hook) (f);
1435 if (judge_scroll_bars_hook)
1436 (*judge_scroll_bars_hook) (f);
1437
1438 update_face_from_frame_parameter (f, Qscroll_bar_foreground, value);
1439 redraw_frame (f);
1440 }
1441 }
1442
1443
1444 /* Set the background color for scroll bars on frame F to VALUE VALUE
1445 should be a string, a color name. If it isn't a string or isn't a
1446 valid color name, do nothing. OLDVAL is the old value of the frame
1447 parameter. */
1448
1449 void
1450 x_set_scroll_bar_background (f, value, oldval)
1451 struct frame *f;
1452 Lisp_Object value, oldval;
1453 {
1454 unsigned long pixel;
1455
1456 if (STRINGP (value))
1457 pixel = x_decode_color (f, value, WHITE_PIX_DEFAULT (f));
1458 else
1459 pixel = -1;
1460
1461 if (f->output_data.x->scroll_bar_background_pixel != -1)
1462 unload_color (f, f->output_data.x->scroll_bar_background_pixel);
1463
1464 #ifdef USE_TOOLKIT_SCROLL_BARS
1465 /* Scrollbar shadow colors. */
1466 if (f->output_data.x->scroll_bar_top_shadow_pixel != -1)
1467 {
1468 unload_color (f, f->output_data.x->scroll_bar_top_shadow_pixel);
1469 f->output_data.x->scroll_bar_top_shadow_pixel = -1;
1470 }
1471 if (f->output_data.x->scroll_bar_bottom_shadow_pixel != -1)
1472 {
1473 unload_color (f, f->output_data.x->scroll_bar_bottom_shadow_pixel);
1474 f->output_data.x->scroll_bar_bottom_shadow_pixel = -1;
1475 }
1476 #endif /* USE_TOOLKIT_SCROLL_BARS */
1477
1478 f->output_data.x->scroll_bar_background_pixel = pixel;
1479 if (FRAME_X_WINDOW (f) && FRAME_VISIBLE_P (f))
1480 {
1481 /* Remove all scroll bars because they have wrong colors. */
1482 if (condemn_scroll_bars_hook)
1483 (*condemn_scroll_bars_hook) (f);
1484 if (judge_scroll_bars_hook)
1485 (*judge_scroll_bars_hook) (f);
1486
1487 update_face_from_frame_parameter (f, Qscroll_bar_background, value);
1488 redraw_frame (f);
1489 }
1490 }
1491
1492 \f
1493 /* Encode Lisp string STRING as a text in a format appropriate for
1494 XICCC (X Inter Client Communication Conventions).
1495
1496 If STRING contains only ASCII characters, do no conversion and
1497 return the string data of STRING. Otherwise, encode the text by
1498 CODING_SYSTEM, and return a newly allocated memory area which
1499 should be freed by `xfree' by a caller.
1500
1501 SELECTIONP non-zero means the string is being encoded for an X
1502 selection, so it is safe to run pre-write conversions (which
1503 may run Lisp code).
1504
1505 Store the byte length of resulting text in *TEXT_BYTES.
1506
1507 If the text contains only ASCII and Latin-1, store 1 in *STRING_P,
1508 which means that the `encoding' of the result can be `STRING'.
1509 Otherwise store 0 in *STRINGP, which means that the `encoding' of
1510 the result should be `COMPOUND_TEXT'. */
1511
1512 unsigned char *
1513 x_encode_text (string, coding_system, selectionp, text_bytes, stringp)
1514 Lisp_Object string, coding_system;
1515 int *text_bytes, *stringp;
1516 int selectionp;
1517 {
1518 int result = string_xstring_p (string);
1519 struct coding_system coding;
1520
1521 if (result == 0)
1522 {
1523 /* No multibyte character in OBJ. We need not encode it. */
1524 *text_bytes = SBYTES (string);
1525 *stringp = 1;
1526 return SDATA (string);
1527 }
1528
1529 setup_coding_system (coding_system, &coding);
1530 coding.mode |= (CODING_MODE_SAFE_ENCODING | CODING_MODE_LAST_BLOCK);
1531 /* We suppress producing escape sequences for composition. */
1532 coding.common_flags &= ~CODING_ANNOTATION_MASK;
1533 coding.dst_bytes = SCHARS (string) * 2;
1534 coding.destination = (unsigned char *) xmalloc (coding.dst_bytes);
1535 encode_coding_object (&coding, string, 0, 0,
1536 SCHARS (string), SBYTES (string), Qnil);
1537 *text_bytes = coding.produced;
1538 *stringp = (result == 1 || !EQ (coding_system, Qcompound_text));
1539 return coding.destination;
1540 }
1541
1542 \f
1543 /* Set the WM name to NAME for frame F. Also set the icon name.
1544 If the frame already has an icon name, use that, otherwise set the
1545 icon name to NAME. */
1546
1547 static void
1548 x_set_name_internal (f, name)
1549 FRAME_PTR f;
1550 Lisp_Object name;
1551 {
1552 if (FRAME_X_WINDOW (f))
1553 {
1554 BLOCK_INPUT;
1555 #ifdef HAVE_X11R4
1556 {
1557 XTextProperty text, icon;
1558 int bytes, stringp;
1559 int do_free_icon_value = 0, do_free_text_value = 0;
1560 Lisp_Object coding_system;
1561
1562 coding_system = Qcompound_text;
1563 /* Note: Encoding strategy
1564
1565 We encode NAME by compound-text and use "COMPOUND-TEXT" in
1566 text.encoding. But, there are non-internationalized window
1567 managers which don't support that encoding. So, if NAME
1568 contains only ASCII and 8859-1 characters, encode it by
1569 iso-latin-1, and use "STRING" in text.encoding hoping that
1570 such window managers at least analyze this format correctly,
1571 i.e. treat 8-bit bytes as 8859-1 characters.
1572
1573 We may also be able to use "UTF8_STRING" in text.encoding
1574 in the future which can encode all Unicode characters.
1575 But, for the moment, there's no way to know that the
1576 current window manager supports it or not. */
1577 text.value = x_encode_text (name, coding_system, 0, &bytes, &stringp);
1578 text.encoding = (stringp ? XA_STRING
1579 : FRAME_X_DISPLAY_INFO (f)->Xatom_COMPOUND_TEXT);
1580 text.format = 8;
1581 text.nitems = bytes;
1582
1583 /* Check early, because ENCODE_UTF_8 below may GC and name may be
1584 relocated. */
1585 do_free_text_value = text.value != SDATA (name);
1586
1587 if (NILP (f->icon_name))
1588 {
1589 icon = text;
1590 }
1591 else
1592 {
1593 /* See the above comment "Note: Encoding strategy". */
1594 icon.value = x_encode_text (f->icon_name, coding_system, 0,
1595 &bytes, &stringp);
1596 icon.encoding = (stringp ? XA_STRING
1597 : FRAME_X_DISPLAY_INFO (f)->Xatom_COMPOUND_TEXT);
1598 icon.format = 8;
1599 icon.nitems = bytes;
1600 do_free_icon_value = icon.value != SDATA (f->icon_name);
1601 }
1602
1603 #ifdef USE_GTK
1604 gtk_window_set_title (GTK_WINDOW (FRAME_GTK_OUTER_WIDGET (f)),
1605 SDATA (ENCODE_UTF_8 (name)));
1606 #else /* not USE_GTK */
1607 XSetWMName (FRAME_X_DISPLAY (f), FRAME_OUTER_WINDOW (f), &text);
1608 #endif /* not USE_GTK */
1609
1610 XSetWMIconName (FRAME_X_DISPLAY (f), FRAME_OUTER_WINDOW (f), &icon);
1611
1612 if (do_free_icon_value)
1613 xfree (icon.value);
1614 if (do_free_text_value)
1615 xfree (text.value);
1616 }
1617 #else /* not HAVE_X11R4 */
1618 XSetIconName (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
1619 SDATA (name));
1620 XStoreName (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
1621 SDATA (name));
1622 #endif /* not HAVE_X11R4 */
1623 UNBLOCK_INPUT;
1624 }
1625 }
1626
1627 /* Change the name of frame F to NAME. If NAME is nil, set F's name to
1628 x_id_name.
1629
1630 If EXPLICIT is non-zero, that indicates that lisp code is setting the
1631 name; if NAME is a string, set F's name to NAME and set
1632 F->explicit_name; if NAME is Qnil, then clear F->explicit_name.
1633
1634 If EXPLICIT is zero, that indicates that Emacs redisplay code is
1635 suggesting a new name, which lisp code should override; if
1636 F->explicit_name is set, ignore the new name; otherwise, set it. */
1637
1638 void
1639 x_set_name (f, name, explicit)
1640 struct frame *f;
1641 Lisp_Object name;
1642 int explicit;
1643 {
1644 /* Make sure that requests from lisp code override requests from
1645 Emacs redisplay code. */
1646 if (explicit)
1647 {
1648 /* If we're switching from explicit to implicit, we had better
1649 update the mode lines and thereby update the title. */
1650 if (f->explicit_name && NILP (name))
1651 update_mode_lines = 1;
1652
1653 f->explicit_name = ! NILP (name);
1654 }
1655 else if (f->explicit_name)
1656 return;
1657
1658 /* If NAME is nil, set the name to the x_id_name. */
1659 if (NILP (name))
1660 {
1661 /* Check for no change needed in this very common case
1662 before we do any consing. */
1663 if (!strcmp (FRAME_X_DISPLAY_INFO (f)->x_id_name,
1664 SDATA (f->name)))
1665 return;
1666 name = build_string (FRAME_X_DISPLAY_INFO (f)->x_id_name);
1667 }
1668 else
1669 CHECK_STRING (name);
1670
1671 /* Don't change the name if it's already NAME. */
1672 if (! NILP (Fstring_equal (name, f->name)))
1673 return;
1674
1675 f->name = name;
1676
1677 /* For setting the frame title, the title parameter should override
1678 the name parameter. */
1679 if (! NILP (f->title))
1680 name = f->title;
1681
1682 x_set_name_internal (f, name);
1683 }
1684
1685 /* This function should be called when the user's lisp code has
1686 specified a name for the frame; the name will override any set by the
1687 redisplay code. */
1688 void
1689 x_explicitly_set_name (f, arg, oldval)
1690 FRAME_PTR f;
1691 Lisp_Object arg, oldval;
1692 {
1693 x_set_name (f, arg, 1);
1694 }
1695
1696 /* This function should be called by Emacs redisplay code to set the
1697 name; names set this way will never override names set by the user's
1698 lisp code. */
1699 void
1700 x_implicitly_set_name (f, arg, oldval)
1701 FRAME_PTR f;
1702 Lisp_Object arg, oldval;
1703 {
1704 x_set_name (f, arg, 0);
1705 }
1706 \f
1707 /* Change the title of frame F to NAME.
1708 If NAME is nil, use the frame name as the title.
1709
1710 If EXPLICIT is non-zero, that indicates that lisp code is setting the
1711 name; if NAME is a string, set F's name to NAME and set
1712 F->explicit_name; if NAME is Qnil, then clear F->explicit_name.
1713
1714 If EXPLICIT is zero, that indicates that Emacs redisplay code is
1715 suggesting a new name, which lisp code should override; if
1716 F->explicit_name is set, ignore the new name; otherwise, set it. */
1717
1718 void
1719 x_set_title (f, name, old_name)
1720 struct frame *f;
1721 Lisp_Object name, old_name;
1722 {
1723 /* Don't change the title if it's already NAME. */
1724 if (EQ (name, f->title))
1725 return;
1726
1727 update_mode_lines = 1;
1728
1729 f->title = name;
1730
1731 if (NILP (name))
1732 name = f->name;
1733 else
1734 CHECK_STRING (name);
1735
1736 x_set_name_internal (f, name);
1737 }
1738
1739 void
1740 x_set_scroll_bar_default_width (f)
1741 struct frame *f;
1742 {
1743 int wid = FRAME_COLUMN_WIDTH (f);
1744
1745 #ifdef USE_TOOLKIT_SCROLL_BARS
1746 /* A minimum width of 14 doesn't look good for toolkit scroll bars. */
1747 int width = 16 + 2 * VERTICAL_SCROLL_BAR_WIDTH_TRIM;
1748 FRAME_CONFIG_SCROLL_BAR_COLS (f) = (width + wid - 1) / wid;
1749 FRAME_CONFIG_SCROLL_BAR_WIDTH (f) = width;
1750 #else
1751 /* Make the actual width at least 14 pixels and a multiple of a
1752 character width. */
1753 FRAME_CONFIG_SCROLL_BAR_COLS (f) = (14 + wid - 1) / wid;
1754
1755 /* Use all of that space (aside from required margins) for the
1756 scroll bar. */
1757 FRAME_CONFIG_SCROLL_BAR_WIDTH (f) = 0;
1758 #endif
1759 }
1760
1761 \f
1762 /* Record in frame F the specified or default value according to ALIST
1763 of the parameter named PROP (a Lisp symbol). If no value is
1764 specified for PROP, look for an X default for XPROP on the frame
1765 named NAME. If that is not found either, use the value DEFLT. */
1766
1767 static Lisp_Object
1768 x_default_scroll_bar_color_parameter (f, alist, prop, xprop, xclass,
1769 foreground_p)
1770 struct frame *f;
1771 Lisp_Object alist;
1772 Lisp_Object prop;
1773 char *xprop;
1774 char *xclass;
1775 int foreground_p;
1776 {
1777 struct x_display_info *dpyinfo = FRAME_X_DISPLAY_INFO (f);
1778 Lisp_Object tem;
1779
1780 tem = x_get_arg (dpyinfo, alist, prop, xprop, xclass, RES_TYPE_STRING);
1781 if (EQ (tem, Qunbound))
1782 {
1783 #ifdef USE_TOOLKIT_SCROLL_BARS
1784
1785 /* See if an X resource for the scroll bar color has been
1786 specified. */
1787 tem = display_x_get_resource (dpyinfo,
1788 build_string (foreground_p
1789 ? "foreground"
1790 : "background"),
1791 empty_string,
1792 build_string ("verticalScrollBar"),
1793 empty_string);
1794 if (!STRINGP (tem))
1795 {
1796 /* If nothing has been specified, scroll bars will use a
1797 toolkit-dependent default. Because these defaults are
1798 difficult to get at without actually creating a scroll
1799 bar, use nil to indicate that no color has been
1800 specified. */
1801 tem = Qnil;
1802 }
1803
1804 #else /* not USE_TOOLKIT_SCROLL_BARS */
1805
1806 tem = Qnil;
1807
1808 #endif /* not USE_TOOLKIT_SCROLL_BARS */
1809 }
1810
1811 x_set_frame_parameters (f, Fcons (Fcons (prop, tem), Qnil));
1812 return tem;
1813 }
1814
1815
1816
1817 #if !defined (HAVE_X11R4) && !defined (HAVE_XSETWMPROTOCOLS)
1818
1819 Status
1820 XSetWMProtocols (dpy, w, protocols, count)
1821 Display *dpy;
1822 Window w;
1823 Atom *protocols;
1824 int count;
1825 {
1826 Atom prop;
1827 prop = XInternAtom (dpy, "WM_PROTOCOLS", False);
1828 if (prop == None) return False;
1829 XChangeProperty (dpy, w, prop, XA_ATOM, 32, PropModeReplace,
1830 (unsigned char *) protocols, count);
1831 return True;
1832 }
1833 #endif /* not HAVE_X11R4 && not HAVE_XSETWMPROTOCOLS */
1834 \f
1835 #ifdef USE_X_TOOLKIT
1836
1837 /* If the WM_PROTOCOLS property does not already contain WM_TAKE_FOCUS,
1838 WM_DELETE_WINDOW, and WM_SAVE_YOURSELF, then add them. (They may
1839 already be present because of the toolkit (Motif adds some of them,
1840 for example, but Xt doesn't). */
1841
1842 static void
1843 hack_wm_protocols (f, widget)
1844 FRAME_PTR f;
1845 Widget widget;
1846 {
1847 Display *dpy = XtDisplay (widget);
1848 Window w = XtWindow (widget);
1849 int need_delete = 1;
1850 int need_focus = 1;
1851 int need_save = 1;
1852
1853 BLOCK_INPUT;
1854 {
1855 Atom type, *atoms = 0;
1856 int format = 0;
1857 unsigned long nitems = 0;
1858 unsigned long bytes_after;
1859
1860 if ((XGetWindowProperty (dpy, w,
1861 FRAME_X_DISPLAY_INFO (f)->Xatom_wm_protocols,
1862 (long)0, (long)100, False, XA_ATOM,
1863 &type, &format, &nitems, &bytes_after,
1864 (unsigned char **) &atoms)
1865 == Success)
1866 && format == 32 && type == XA_ATOM)
1867 while (nitems > 0)
1868 {
1869 nitems--;
1870 if (atoms[nitems] == FRAME_X_DISPLAY_INFO (f)->Xatom_wm_delete_window)
1871 need_delete = 0;
1872 else if (atoms[nitems] == FRAME_X_DISPLAY_INFO (f)->Xatom_wm_take_focus)
1873 need_focus = 0;
1874 else if (atoms[nitems] == FRAME_X_DISPLAY_INFO (f)->Xatom_wm_save_yourself)
1875 need_save = 0;
1876 }
1877 if (atoms) XFree ((char *) atoms);
1878 }
1879 {
1880 Atom props [10];
1881 int count = 0;
1882 if (need_delete)
1883 props[count++] = FRAME_X_DISPLAY_INFO (f)->Xatom_wm_delete_window;
1884 if (need_focus)
1885 props[count++] = FRAME_X_DISPLAY_INFO (f)->Xatom_wm_take_focus;
1886 if (need_save)
1887 props[count++] = FRAME_X_DISPLAY_INFO (f)->Xatom_wm_save_yourself;
1888 if (count)
1889 XChangeProperty (dpy, w, FRAME_X_DISPLAY_INFO (f)->Xatom_wm_protocols,
1890 XA_ATOM, 32, PropModeAppend,
1891 (unsigned char *) props, count);
1892 }
1893 UNBLOCK_INPUT;
1894 }
1895 #endif
1896
1897
1898 \f
1899 /* Support routines for XIC (X Input Context). */
1900
1901 #ifdef HAVE_X_I18N
1902
1903 static XFontSet xic_create_xfontset P_ ((struct frame *, char *));
1904 static XIMStyle best_xim_style P_ ((XIMStyles *, XIMStyles *));
1905
1906
1907 /* Supported XIM styles, ordered by preference. */
1908
1909 static XIMStyle supported_xim_styles[] =
1910 {
1911 XIMPreeditPosition | XIMStatusArea,
1912 XIMPreeditPosition | XIMStatusNothing,
1913 XIMPreeditPosition | XIMStatusNone,
1914 XIMPreeditNothing | XIMStatusArea,
1915 XIMPreeditNothing | XIMStatusNothing,
1916 XIMPreeditNothing | XIMStatusNone,
1917 XIMPreeditNone | XIMStatusArea,
1918 XIMPreeditNone | XIMStatusNothing,
1919 XIMPreeditNone | XIMStatusNone,
1920 0,
1921 };
1922
1923
1924 /* Create an X fontset on frame F with base font name BASE_FONTNAME. */
1925
1926 static XFontSet
1927 xic_create_xfontset (f, base_fontname)
1928 struct frame *f;
1929 char *base_fontname;
1930 {
1931 XFontSet xfs = NULL;
1932 char **missing_list = NULL;
1933 int missing_count;
1934 char *def_string;
1935 Lisp_Object rest, frame;
1936
1937 /* See if there is another frame already using same fontset. */
1938 FOR_EACH_FRAME (rest, frame)
1939 {
1940 struct frame *cf = XFRAME (frame);
1941 if (cf != f && FRAME_LIVE_P (f) && FRAME_X_P (cf)
1942 && FRAME_X_DISPLAY_INFO (cf) == FRAME_X_DISPLAY_INFO (f)
1943 && FRAME_XIC_BASE_FONTNAME (cf)
1944 && !strcmp (FRAME_XIC_BASE_FONTNAME (cf), base_fontname))
1945 {
1946 xfs = FRAME_XIC_FONTSET (cf);
1947 break;
1948 }
1949 }
1950
1951 if (!xfs)
1952 {
1953 /* New fontset. */
1954 xfs = XCreateFontSet (FRAME_X_DISPLAY (f),
1955 base_fontname, &missing_list,
1956 &missing_count, &def_string);
1957 if (missing_list)
1958 XFreeStringList (missing_list);
1959 }
1960
1961 if (FRAME_XIC_BASE_FONTNAME (f))
1962 xfree (FRAME_XIC_BASE_FONTNAME (f));
1963 FRAME_XIC_BASE_FONTNAME (f) = xstrdup (base_fontname);
1964
1965 /* No need to free def_string. */
1966 return xfs;
1967 }
1968
1969 /* Free the X fontset of frame F if it is the last frame using it. */
1970
1971 void
1972 xic_free_xfontset (f)
1973 struct frame *f;
1974 {
1975 Lisp_Object rest, frame;
1976 int shared_p = 0;
1977
1978 if (!FRAME_XIC_FONTSET (f))
1979 return;
1980
1981 /* See if there is another frame sharing the same fontset. */
1982 FOR_EACH_FRAME (rest, frame)
1983 {
1984 struct frame *cf = XFRAME (frame);
1985 if (cf != f && FRAME_LIVE_P (f) && FRAME_X_P (cf)
1986 && FRAME_X_DISPLAY_INFO (cf) == FRAME_X_DISPLAY_INFO (f)
1987 && FRAME_XIC_FONTSET (cf) == FRAME_XIC_FONTSET (f))
1988 {
1989 shared_p = 1;
1990 break;
1991 }
1992 }
1993
1994 if (!shared_p)
1995 /* The fontset is not used anymore. It is safe to free it. */
1996 XFreeFontSet (FRAME_X_DISPLAY (f), FRAME_XIC_FONTSET (f));
1997
1998 if (FRAME_XIC_BASE_FONTNAME (f))
1999 xfree (FRAME_XIC_BASE_FONTNAME (f));
2000 FRAME_XIC_BASE_FONTNAME (f) = NULL;
2001 FRAME_XIC_FONTSET (f) = NULL;
2002 }
2003
2004
2005 /* Value is the best input style, given user preferences USER (already
2006 checked to be supported by Emacs), and styles supported by the
2007 input method XIM. */
2008
2009 static XIMStyle
2010 best_xim_style (user, xim)
2011 XIMStyles *user;
2012 XIMStyles *xim;
2013 {
2014 int i, j;
2015
2016 for (i = 0; i < user->count_styles; ++i)
2017 for (j = 0; j < xim->count_styles; ++j)
2018 if (user->supported_styles[i] == xim->supported_styles[j])
2019 return user->supported_styles[i];
2020
2021 /* Return the default style. */
2022 return XIMPreeditNothing | XIMStatusNothing;
2023 }
2024
2025 /* Create XIC for frame F. */
2026
2027 static XIMStyle xic_style;
2028
2029 void
2030 create_frame_xic (f)
2031 struct frame *f;
2032 {
2033 XIM xim;
2034 XIC xic = NULL;
2035 XFontSet xfs = NULL;
2036
2037 if (FRAME_XIC (f))
2038 return;
2039
2040 xim = FRAME_X_XIM (f);
2041 if (xim)
2042 {
2043 XRectangle s_area;
2044 XPoint spot;
2045 XVaNestedList preedit_attr;
2046 XVaNestedList status_attr;
2047 char *base_fontname;
2048 int fontset;
2049
2050 s_area.x = 0; s_area.y = 0; s_area.width = 1; s_area.height = 1;
2051 spot.x = 0; spot.y = 1;
2052 /* Create X fontset. */
2053 fontset = FRAME_FONTSET (f);
2054 if (fontset < 0)
2055 base_fontname = "-*-*-*-r-normal--14-*-*-*-*-*-*-*";
2056 else
2057 {
2058 /* Determine the base fontname from the ASCII font name of
2059 FONTSET. */
2060 char *ascii_font = (char *) SDATA (fontset_ascii (fontset));
2061 char *p = ascii_font;
2062 int i;
2063
2064 for (i = 0; *p; p++)
2065 if (*p == '-') i++;
2066 if (i != 14)
2067 /* As the font name doesn't conform to XLFD, we can't
2068 modify it to get a suitable base fontname for the
2069 frame. */
2070 base_fontname = "-*-*-*-r-normal--14-*-*-*-*-*-*-*";
2071 else
2072 {
2073 int len = strlen (ascii_font) + 1;
2074 char *p1 = NULL;
2075
2076 for (i = 0, p = ascii_font; i < 8; p++)
2077 {
2078 if (*p == '-')
2079 {
2080 i++;
2081 if (i == 3)
2082 p1 = p + 1;
2083 }
2084 }
2085 base_fontname = (char *) alloca (len);
2086 bzero (base_fontname, len);
2087 strcpy (base_fontname, "-*-*-");
2088 bcopy (p1, base_fontname + 5, p - p1);
2089 strcat (base_fontname, "*-*-*-*-*-*-*");
2090 }
2091 }
2092 xfs = xic_create_xfontset (f, base_fontname);
2093
2094 /* Determine XIC style. */
2095 if (xic_style == 0)
2096 {
2097 XIMStyles supported_list;
2098 supported_list.count_styles = (sizeof supported_xim_styles
2099 / sizeof supported_xim_styles[0]);
2100 supported_list.supported_styles = supported_xim_styles;
2101 xic_style = best_xim_style (&supported_list,
2102 FRAME_X_XIM_STYLES (f));
2103 }
2104
2105 preedit_attr = XVaCreateNestedList (0,
2106 XNFontSet, xfs,
2107 XNForeground,
2108 FRAME_FOREGROUND_PIXEL (f),
2109 XNBackground,
2110 FRAME_BACKGROUND_PIXEL (f),
2111 (xic_style & XIMPreeditPosition
2112 ? XNSpotLocation
2113 : NULL),
2114 &spot,
2115 NULL);
2116 status_attr = XVaCreateNestedList (0,
2117 XNArea,
2118 &s_area,
2119 XNFontSet,
2120 xfs,
2121 XNForeground,
2122 FRAME_FOREGROUND_PIXEL (f),
2123 XNBackground,
2124 FRAME_BACKGROUND_PIXEL (f),
2125 NULL);
2126
2127 xic = XCreateIC (xim,
2128 XNInputStyle, xic_style,
2129 XNClientWindow, FRAME_X_WINDOW (f),
2130 XNFocusWindow, FRAME_X_WINDOW (f),
2131 XNStatusAttributes, status_attr,
2132 XNPreeditAttributes, preedit_attr,
2133 NULL);
2134 XFree (preedit_attr);
2135 XFree (status_attr);
2136 }
2137
2138 FRAME_XIC (f) = xic;
2139 FRAME_XIC_STYLE (f) = xic_style;
2140 FRAME_XIC_FONTSET (f) = xfs;
2141 }
2142
2143
2144 /* Destroy XIC and free XIC fontset of frame F, if any. */
2145
2146 void
2147 free_frame_xic (f)
2148 struct frame *f;
2149 {
2150 if (FRAME_XIC (f) == NULL)
2151 return;
2152
2153 XDestroyIC (FRAME_XIC (f));
2154 xic_free_xfontset (f);
2155
2156 FRAME_XIC (f) = NULL;
2157 }
2158
2159
2160 /* Place preedit area for XIC of window W's frame to specified
2161 pixel position X/Y. X and Y are relative to window W. */
2162
2163 void
2164 xic_set_preeditarea (w, x, y)
2165 struct window *w;
2166 int x, y;
2167 {
2168 struct frame *f = XFRAME (w->frame);
2169 XVaNestedList attr;
2170 XPoint spot;
2171
2172 spot.x = WINDOW_TO_FRAME_PIXEL_X (w, x) + WINDOW_LEFT_FRINGE_WIDTH (w);
2173 spot.y = WINDOW_TO_FRAME_PIXEL_Y (w, y) + FONT_BASE (FRAME_FONT (f));
2174 attr = XVaCreateNestedList (0, XNSpotLocation, &spot, NULL);
2175 XSetICValues (FRAME_XIC (f), XNPreeditAttributes, attr, NULL);
2176 XFree (attr);
2177 }
2178
2179
2180 /* Place status area for XIC in bottom right corner of frame F.. */
2181
2182 void
2183 xic_set_statusarea (f)
2184 struct frame *f;
2185 {
2186 XIC xic = FRAME_XIC (f);
2187 XVaNestedList attr;
2188 XRectangle area;
2189 XRectangle *needed;
2190
2191 /* Negotiate geometry of status area. If input method has existing
2192 status area, use its current size. */
2193 area.x = area.y = area.width = area.height = 0;
2194 attr = XVaCreateNestedList (0, XNAreaNeeded, &area, NULL);
2195 XSetICValues (xic, XNStatusAttributes, attr, NULL);
2196 XFree (attr);
2197
2198 attr = XVaCreateNestedList (0, XNAreaNeeded, &needed, NULL);
2199 XGetICValues (xic, XNStatusAttributes, attr, NULL);
2200 XFree (attr);
2201
2202 if (needed->width == 0) /* Use XNArea instead of XNAreaNeeded */
2203 {
2204 attr = XVaCreateNestedList (0, XNArea, &needed, NULL);
2205 XGetICValues (xic, XNStatusAttributes, attr, NULL);
2206 XFree (attr);
2207 }
2208
2209 area.width = needed->width;
2210 area.height = needed->height;
2211 area.x = FRAME_PIXEL_WIDTH (f) - area.width - FRAME_INTERNAL_BORDER_WIDTH (f);
2212 area.y = (FRAME_PIXEL_HEIGHT (f) - area.height
2213 - FRAME_MENUBAR_HEIGHT (f)
2214 - FRAME_TOOLBAR_HEIGHT (f)
2215 - FRAME_INTERNAL_BORDER_WIDTH (f));
2216 XFree (needed);
2217
2218 attr = XVaCreateNestedList (0, XNArea, &area, NULL);
2219 XSetICValues (xic, XNStatusAttributes, attr, NULL);
2220 XFree (attr);
2221 }
2222
2223
2224 /* Set X fontset for XIC of frame F, using base font name
2225 BASE_FONTNAME. Called when a new Emacs fontset is chosen. */
2226
2227 void
2228 xic_set_xfontset (f, base_fontname)
2229 struct frame *f;
2230 char *base_fontname;
2231 {
2232 XVaNestedList attr;
2233 XFontSet xfs;
2234
2235 xic_free_xfontset (f);
2236
2237 xfs = xic_create_xfontset (f, base_fontname);
2238
2239 attr = XVaCreateNestedList (0, XNFontSet, xfs, NULL);
2240 if (FRAME_XIC_STYLE (f) & XIMPreeditPosition)
2241 XSetICValues (FRAME_XIC (f), XNPreeditAttributes, attr, NULL);
2242 if (FRAME_XIC_STYLE (f) & XIMStatusArea)
2243 XSetICValues (FRAME_XIC (f), XNStatusAttributes, attr, NULL);
2244 XFree (attr);
2245
2246 FRAME_XIC_FONTSET (f) = xfs;
2247 }
2248
2249 #endif /* HAVE_X_I18N */
2250
2251
2252 \f
2253 #ifdef USE_X_TOOLKIT
2254
2255 /* Create and set up the X widget for frame F. */
2256
2257 static void
2258 x_window (f, window_prompting, minibuffer_only)
2259 struct frame *f;
2260 long window_prompting;
2261 int minibuffer_only;
2262 {
2263 XClassHint class_hints;
2264 XSetWindowAttributes attributes;
2265 unsigned long attribute_mask;
2266 Widget shell_widget;
2267 Widget pane_widget;
2268 Widget frame_widget;
2269 Arg al [25];
2270 int ac;
2271
2272 BLOCK_INPUT;
2273
2274 /* Use the resource name as the top-level widget name
2275 for looking up resources. Make a non-Lisp copy
2276 for the window manager, so GC relocation won't bother it.
2277
2278 Elsewhere we specify the window name for the window manager. */
2279
2280 {
2281 char *str = (char *) SDATA (Vx_resource_name);
2282 f->namebuf = (char *) xmalloc (strlen (str) + 1);
2283 strcpy (f->namebuf, str);
2284 }
2285
2286 ac = 0;
2287 XtSetArg (al[ac], XtNallowShellResize, 1); ac++;
2288 XtSetArg (al[ac], XtNinput, 1); ac++;
2289 XtSetArg (al[ac], XtNmappedWhenManaged, 0); ac++;
2290 XtSetArg (al[ac], XtNborderWidth, f->border_width); ac++;
2291 XtSetArg (al[ac], XtNvisual, FRAME_X_VISUAL (f)); ac++;
2292 XtSetArg (al[ac], XtNdepth, FRAME_X_DISPLAY_INFO (f)->n_planes); ac++;
2293 XtSetArg (al[ac], XtNcolormap, FRAME_X_COLORMAP (f)); ac++;
2294 shell_widget = XtAppCreateShell (f->namebuf, EMACS_CLASS,
2295 applicationShellWidgetClass,
2296 FRAME_X_DISPLAY (f), al, ac);
2297
2298 f->output_data.x->widget = shell_widget;
2299 /* maybe_set_screen_title_format (shell_widget); */
2300
2301 pane_widget = lw_create_widget ("main", "pane", widget_id_tick++,
2302 (widget_value *) NULL,
2303 shell_widget, False,
2304 (lw_callback) NULL,
2305 (lw_callback) NULL,
2306 (lw_callback) NULL,
2307 (lw_callback) NULL);
2308
2309 ac = 0;
2310 XtSetArg (al[ac], XtNvisual, FRAME_X_VISUAL (f)); ac++;
2311 XtSetArg (al[ac], XtNdepth, FRAME_X_DISPLAY_INFO (f)->n_planes); ac++;
2312 XtSetArg (al[ac], XtNcolormap, FRAME_X_COLORMAP (f)); ac++;
2313 XtSetValues (pane_widget, al, ac);
2314 f->output_data.x->column_widget = pane_widget;
2315
2316 /* mappedWhenManaged to false tells to the paned window to not map/unmap
2317 the emacs screen when changing menubar. This reduces flickering. */
2318
2319 ac = 0;
2320 XtSetArg (al[ac], XtNmappedWhenManaged, 0); ac++;
2321 XtSetArg (al[ac], XtNshowGrip, 0); ac++;
2322 XtSetArg (al[ac], XtNallowResize, 1); ac++;
2323 XtSetArg (al[ac], XtNresizeToPreferred, 1); ac++;
2324 XtSetArg (al[ac], XtNemacsFrame, f); ac++;
2325 XtSetArg (al[ac], XtNvisual, FRAME_X_VISUAL (f)); ac++;
2326 XtSetArg (al[ac], XtNdepth, FRAME_X_DISPLAY_INFO (f)->n_planes); ac++;
2327 XtSetArg (al[ac], XtNcolormap, FRAME_X_COLORMAP (f)); ac++;
2328 frame_widget = XtCreateWidget (f->namebuf, emacsFrameClass, pane_widget,
2329 al, ac);
2330
2331 f->output_data.x->edit_widget = frame_widget;
2332
2333 XtManageChild (frame_widget);
2334
2335 /* Do some needed geometry management. */
2336 {
2337 int len;
2338 char *tem, shell_position[32];
2339 Arg al[10];
2340 int ac = 0;
2341 int extra_borders = 0;
2342 int menubar_size
2343 = (f->output_data.x->menubar_widget
2344 ? (f->output_data.x->menubar_widget->core.height
2345 + f->output_data.x->menubar_widget->core.border_width)
2346 : 0);
2347
2348 #if 0 /* Experimentally, we now get the right results
2349 for -geometry -0-0 without this. 24 Aug 96, rms. */
2350 if (FRAME_EXTERNAL_MENU_BAR (f))
2351 {
2352 Dimension ibw = 0;
2353 XtVaGetValues (pane_widget, XtNinternalBorderWidth, &ibw, NULL);
2354 menubar_size += ibw;
2355 }
2356 #endif
2357
2358 f->output_data.x->menubar_height = menubar_size;
2359
2360 #ifndef USE_LUCID
2361 /* Motif seems to need this amount added to the sizes
2362 specified for the shell widget. The Athena/Lucid widgets don't.
2363 Both conclusions reached experimentally. -- rms. */
2364 XtVaGetValues (f->output_data.x->edit_widget, XtNinternalBorderWidth,
2365 &extra_borders, NULL);
2366 extra_borders *= 2;
2367 #endif
2368
2369 /* Convert our geometry parameters into a geometry string
2370 and specify it.
2371 Note that we do not specify here whether the position
2372 is a user-specified or program-specified one.
2373 We pass that information later, in x_wm_set_size_hints. */
2374 {
2375 int left = f->left_pos;
2376 int xneg = window_prompting & XNegative;
2377 int top = f->top_pos;
2378 int yneg = window_prompting & YNegative;
2379 if (xneg)
2380 left = -left;
2381 if (yneg)
2382 top = -top;
2383
2384 if (window_prompting & USPosition)
2385 sprintf (shell_position, "=%dx%d%c%d%c%d",
2386 FRAME_PIXEL_WIDTH (f) + extra_borders,
2387 FRAME_PIXEL_HEIGHT (f) + menubar_size + extra_borders,
2388 (xneg ? '-' : '+'), left,
2389 (yneg ? '-' : '+'), top);
2390 else
2391 {
2392 sprintf (shell_position, "=%dx%d",
2393 FRAME_PIXEL_WIDTH (f) + extra_borders,
2394 FRAME_PIXEL_HEIGHT (f) + menubar_size + extra_borders);
2395
2396 /* Setting x and y when the position is not specified in
2397 the geometry string will set program position in the WM hints.
2398 If Emacs had just one program position, we could set it in
2399 fallback resources, but since each make-frame call can specify
2400 different program positions, this is easier. */
2401 XtSetArg (al[ac], XtNx, left); ac++;
2402 XtSetArg (al[ac], XtNy, top); ac++;
2403 }
2404 }
2405
2406 len = strlen (shell_position) + 1;
2407 /* We don't free this because we don't know whether
2408 it is safe to free it while the frame exists.
2409 It isn't worth the trouble of arranging to free it
2410 when the frame is deleted. */
2411 tem = (char *) xmalloc (len);
2412 strncpy (tem, shell_position, len);
2413 XtSetArg (al[ac], XtNgeometry, tem); ac++;
2414 XtSetValues (shell_widget, al, ac);
2415 }
2416
2417 XtManageChild (pane_widget);
2418 XtRealizeWidget (shell_widget);
2419
2420 FRAME_X_WINDOW (f) = XtWindow (frame_widget);
2421
2422 validate_x_resource_name ();
2423
2424 class_hints.res_name = (char *) SDATA (Vx_resource_name);
2425 class_hints.res_class = (char *) SDATA (Vx_resource_class);
2426 XSetClassHint (FRAME_X_DISPLAY (f), XtWindow (shell_widget), &class_hints);
2427
2428 #ifdef HAVE_X_I18N
2429 FRAME_XIC (f) = NULL;
2430 if (use_xim)
2431 create_frame_xic (f);
2432 #endif
2433
2434 f->output_data.x->wm_hints.input = True;
2435 f->output_data.x->wm_hints.flags |= InputHint;
2436 XSetWMHints (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
2437 &f->output_data.x->wm_hints);
2438
2439 hack_wm_protocols (f, shell_widget);
2440
2441 #ifdef HACK_EDITRES
2442 XtAddEventHandler (shell_widget, 0, True, _XEditResCheckMessages, 0);
2443 #endif
2444
2445 /* Do a stupid property change to force the server to generate a
2446 PropertyNotify event so that the event_stream server timestamp will
2447 be initialized to something relevant to the time we created the window.
2448 */
2449 XChangeProperty (XtDisplay (frame_widget), XtWindow (frame_widget),
2450 FRAME_X_DISPLAY_INFO (f)->Xatom_wm_protocols,
2451 XA_ATOM, 32, PropModeAppend,
2452 (unsigned char*) NULL, 0);
2453
2454 /* Make all the standard events reach the Emacs frame. */
2455 attributes.event_mask = STANDARD_EVENT_SET;
2456
2457 #ifdef HAVE_X_I18N
2458 if (FRAME_XIC (f))
2459 {
2460 /* XIM server might require some X events. */
2461 unsigned long fevent = NoEventMask;
2462 XGetICValues (FRAME_XIC (f), XNFilterEvents, &fevent, NULL);
2463 attributes.event_mask |= fevent;
2464 }
2465 #endif /* HAVE_X_I18N */
2466
2467 attribute_mask = CWEventMask;
2468 XChangeWindowAttributes (XtDisplay (shell_widget), XtWindow (shell_widget),
2469 attribute_mask, &attributes);
2470
2471 XtMapWidget (frame_widget);
2472
2473 /* x_set_name normally ignores requests to set the name if the
2474 requested name is the same as the current name. This is the one
2475 place where that assumption isn't correct; f->name is set, but
2476 the X server hasn't been told. */
2477 {
2478 Lisp_Object name;
2479 int explicit = f->explicit_name;
2480
2481 f->explicit_name = 0;
2482 name = f->name;
2483 f->name = Qnil;
2484 x_set_name (f, name, explicit);
2485 }
2486
2487 XDefineCursor (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
2488 f->output_data.x->text_cursor);
2489
2490 UNBLOCK_INPUT;
2491
2492 /* This is a no-op, except under Motif. Make sure main areas are
2493 set to something reasonable, in case we get an error later. */
2494 lw_set_main_areas (pane_widget, 0, frame_widget);
2495 }
2496
2497 #else /* not USE_X_TOOLKIT */
2498 #ifdef USE_GTK
2499 void
2500 x_window (f)
2501 FRAME_PTR f;
2502 {
2503 if (! xg_create_frame_widgets (f))
2504 error ("Unable to create window");
2505
2506 #ifdef HAVE_X_I18N
2507 FRAME_XIC (f) = NULL;
2508 if (use_xim)
2509 {
2510 BLOCK_INPUT;
2511 create_frame_xic (f);
2512 if (FRAME_XIC (f))
2513 {
2514 /* XIM server might require some X events. */
2515 unsigned long fevent = NoEventMask;
2516 XGetICValues (FRAME_XIC (f), XNFilterEvents, &fevent, NULL);
2517
2518 if (fevent != NoEventMask)
2519 {
2520 XSetWindowAttributes attributes;
2521 XWindowAttributes wattr;
2522 unsigned long attribute_mask;
2523
2524 XGetWindowAttributes (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
2525 &wattr);
2526 attributes.event_mask = wattr.your_event_mask | fevent;
2527 attribute_mask = CWEventMask;
2528 XChangeWindowAttributes (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
2529 attribute_mask, &attributes);
2530 }
2531 }
2532 UNBLOCK_INPUT;
2533 }
2534 #endif
2535 }
2536
2537 #else /*! USE_GTK */
2538 /* Create and set up the X window for frame F. */
2539
2540 void
2541 x_window (f)
2542 struct frame *f;
2543
2544 {
2545 XClassHint class_hints;
2546 XSetWindowAttributes attributes;
2547 unsigned long attribute_mask;
2548
2549 attributes.background_pixel = f->output_data.x->background_pixel;
2550 attributes.border_pixel = f->output_data.x->border_pixel;
2551 attributes.bit_gravity = StaticGravity;
2552 attributes.backing_store = NotUseful;
2553 attributes.save_under = True;
2554 attributes.event_mask = STANDARD_EVENT_SET;
2555 attributes.colormap = FRAME_X_COLORMAP (f);
2556 attribute_mask = (CWBackPixel | CWBorderPixel | CWBitGravity | CWEventMask
2557 | CWColormap);
2558
2559 BLOCK_INPUT;
2560 FRAME_X_WINDOW (f)
2561 = XCreateWindow (FRAME_X_DISPLAY (f),
2562 f->output_data.x->parent_desc,
2563 f->left_pos,
2564 f->top_pos,
2565 FRAME_PIXEL_WIDTH (f), FRAME_PIXEL_HEIGHT (f),
2566 f->border_width,
2567 CopyFromParent, /* depth */
2568 InputOutput, /* class */
2569 FRAME_X_VISUAL (f),
2570 attribute_mask, &attributes);
2571
2572 #ifdef HAVE_X_I18N
2573 if (use_xim)
2574 {
2575 create_frame_xic (f);
2576 if (FRAME_XIC (f))
2577 {
2578 /* XIM server might require some X events. */
2579 unsigned long fevent = NoEventMask;
2580 XGetICValues (FRAME_XIC (f), XNFilterEvents, &fevent, NULL);
2581 attributes.event_mask |= fevent;
2582 attribute_mask = CWEventMask;
2583 XChangeWindowAttributes (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
2584 attribute_mask, &attributes);
2585 }
2586 }
2587 #endif /* HAVE_X_I18N */
2588
2589 validate_x_resource_name ();
2590
2591 class_hints.res_name = (char *) SDATA (Vx_resource_name);
2592 class_hints.res_class = (char *) SDATA (Vx_resource_class);
2593 XSetClassHint (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f), &class_hints);
2594
2595 /* The menubar is part of the ordinary display;
2596 it does not count in addition to the height of the window. */
2597 f->output_data.x->menubar_height = 0;
2598
2599 /* This indicates that we use the "Passive Input" input model.
2600 Unless we do this, we don't get the Focus{In,Out} events that we
2601 need to draw the cursor correctly. Accursed bureaucrats.
2602 XWhipsAndChains (FRAME_X_DISPLAY (f), IronMaiden, &TheRack); */
2603
2604 f->output_data.x->wm_hints.input = True;
2605 f->output_data.x->wm_hints.flags |= InputHint;
2606 XSetWMHints (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
2607 &f->output_data.x->wm_hints);
2608 f->output_data.x->wm_hints.icon_pixmap = None;
2609
2610 /* Request "save yourself" and "delete window" commands from wm. */
2611 {
2612 Atom protocols[2];
2613 protocols[0] = FRAME_X_DISPLAY_INFO (f)->Xatom_wm_delete_window;
2614 protocols[1] = FRAME_X_DISPLAY_INFO (f)->Xatom_wm_save_yourself;
2615 XSetWMProtocols (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f), protocols, 2);
2616 }
2617
2618 /* x_set_name normally ignores requests to set the name if the
2619 requested name is the same as the current name. This is the one
2620 place where that assumption isn't correct; f->name is set, but
2621 the X server hasn't been told. */
2622 {
2623 Lisp_Object name;
2624 int explicit = f->explicit_name;
2625
2626 f->explicit_name = 0;
2627 name = f->name;
2628 f->name = Qnil;
2629 x_set_name (f, name, explicit);
2630 }
2631
2632 XDefineCursor (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
2633 f->output_data.x->text_cursor);
2634
2635 UNBLOCK_INPUT;
2636
2637 if (FRAME_X_WINDOW (f) == 0)
2638 error ("Unable to create window");
2639 }
2640
2641 #endif /* not USE_GTK */
2642 #endif /* not USE_X_TOOLKIT */
2643
2644 /* Verify that the icon position args for this window are valid. */
2645
2646 static void
2647 x_icon_verify (f, parms)
2648 struct frame *f;
2649 Lisp_Object parms;
2650 {
2651 Lisp_Object icon_x, icon_y;
2652
2653 /* Set the position of the icon. Note that twm groups all
2654 icons in an icon window. */
2655 icon_x = x_frame_get_and_record_arg (f, parms, Qicon_left, 0, 0, RES_TYPE_NUMBER);
2656 icon_y = x_frame_get_and_record_arg (f, parms, Qicon_top, 0, 0, RES_TYPE_NUMBER);
2657 if (!EQ (icon_x, Qunbound) && !EQ (icon_y, Qunbound))
2658 {
2659 CHECK_NUMBER (icon_x);
2660 CHECK_NUMBER (icon_y);
2661 }
2662 else if (!EQ (icon_x, Qunbound) || !EQ (icon_y, Qunbound))
2663 error ("Both left and top icon corners of icon must be specified");
2664 }
2665
2666 /* Handle the icon stuff for this window. Perhaps later we might
2667 want an x_set_icon_position which can be called interactively as
2668 well. */
2669
2670 static void
2671 x_icon (f, parms)
2672 struct frame *f;
2673 Lisp_Object parms;
2674 {
2675 Lisp_Object icon_x, icon_y;
2676 struct x_display_info *dpyinfo = FRAME_X_DISPLAY_INFO (f);
2677
2678 /* Set the position of the icon. Note that twm groups all
2679 icons in an icon window. */
2680 icon_x = x_frame_get_and_record_arg (f, parms, Qicon_left, 0, 0, RES_TYPE_NUMBER);
2681 icon_y = x_frame_get_and_record_arg (f, parms, Qicon_top, 0, 0, RES_TYPE_NUMBER);
2682 if (!EQ (icon_x, Qunbound) && !EQ (icon_y, Qunbound))
2683 {
2684 CHECK_NUMBER (icon_x);
2685 CHECK_NUMBER (icon_y);
2686 }
2687 else if (!EQ (icon_x, Qunbound) || !EQ (icon_y, Qunbound))
2688 error ("Both left and top icon corners of icon must be specified");
2689
2690 BLOCK_INPUT;
2691
2692 if (! EQ (icon_x, Qunbound))
2693 x_wm_set_icon_position (f, XINT (icon_x), XINT (icon_y));
2694
2695 /* Start up iconic or window? */
2696 x_wm_set_window_state
2697 (f, (EQ (x_get_arg (dpyinfo, parms, Qvisibility, 0, 0, RES_TYPE_SYMBOL),
2698 Qicon)
2699 ? IconicState
2700 : NormalState));
2701
2702 x_text_icon (f, (char *) SDATA ((!NILP (f->icon_name)
2703 ? f->icon_name
2704 : f->name)));
2705
2706 UNBLOCK_INPUT;
2707 }
2708
2709 /* Make the GCs needed for this window, setting the
2710 background, border and mouse colors; also create the
2711 mouse cursor and the gray border tile. */
2712
2713 static char cursor_bits[] =
2714 {
2715 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
2716 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
2717 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
2718 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00
2719 };
2720
2721 static void
2722 x_make_gc (f)
2723 struct frame *f;
2724 {
2725 XGCValues gc_values;
2726
2727 BLOCK_INPUT;
2728
2729 /* Create the GCs of this frame.
2730 Note that many default values are used. */
2731
2732 /* Normal video */
2733 gc_values.font = FRAME_FONT (f)->fid;
2734 gc_values.foreground = f->output_data.x->foreground_pixel;
2735 gc_values.background = f->output_data.x->background_pixel;
2736 gc_values.line_width = 0; /* Means 1 using fast algorithm. */
2737 f->output_data.x->normal_gc
2738 = XCreateGC (FRAME_X_DISPLAY (f),
2739 FRAME_X_WINDOW (f),
2740 GCLineWidth | GCFont | GCForeground | GCBackground,
2741 &gc_values);
2742
2743 /* Reverse video style. */
2744 gc_values.foreground = f->output_data.x->background_pixel;
2745 gc_values.background = f->output_data.x->foreground_pixel;
2746 f->output_data.x->reverse_gc
2747 = XCreateGC (FRAME_X_DISPLAY (f),
2748 FRAME_X_WINDOW (f),
2749 GCFont | GCForeground | GCBackground | GCLineWidth,
2750 &gc_values);
2751
2752 /* Cursor has cursor-color background, background-color foreground. */
2753 gc_values.foreground = f->output_data.x->background_pixel;
2754 gc_values.background = f->output_data.x->cursor_pixel;
2755 gc_values.fill_style = FillOpaqueStippled;
2756 gc_values.stipple
2757 = XCreateBitmapFromData (FRAME_X_DISPLAY (f),
2758 FRAME_X_DISPLAY_INFO (f)->root_window,
2759 cursor_bits, 16, 16);
2760 f->output_data.x->cursor_gc
2761 = XCreateGC (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
2762 (GCFont | GCForeground | GCBackground
2763 | GCFillStyle /* | GCStipple */ | GCLineWidth),
2764 &gc_values);
2765
2766 /* Reliefs. */
2767 f->output_data.x->white_relief.gc = 0;
2768 f->output_data.x->black_relief.gc = 0;
2769
2770 /* Create the gray border tile used when the pointer is not in
2771 the frame. Since this depends on the frame's pixel values,
2772 this must be done on a per-frame basis. */
2773 f->output_data.x->border_tile
2774 = (XCreatePixmapFromBitmapData
2775 (FRAME_X_DISPLAY (f), FRAME_X_DISPLAY_INFO (f)->root_window,
2776 gray_bits, gray_width, gray_height,
2777 f->output_data.x->foreground_pixel,
2778 f->output_data.x->background_pixel,
2779 DefaultDepth (FRAME_X_DISPLAY (f), FRAME_X_SCREEN_NUMBER (f))));
2780
2781 UNBLOCK_INPUT;
2782 }
2783
2784
2785 /* Free what was was allocated in x_make_gc. */
2786
2787 void
2788 x_free_gcs (f)
2789 struct frame *f;
2790 {
2791 Display *dpy = FRAME_X_DISPLAY (f);
2792
2793 BLOCK_INPUT;
2794
2795 if (f->output_data.x->normal_gc)
2796 {
2797 XFreeGC (dpy, f->output_data.x->normal_gc);
2798 f->output_data.x->normal_gc = 0;
2799 }
2800
2801 if (f->output_data.x->reverse_gc)
2802 {
2803 XFreeGC (dpy, f->output_data.x->reverse_gc);
2804 f->output_data.x->reverse_gc = 0;
2805 }
2806
2807 if (f->output_data.x->cursor_gc)
2808 {
2809 XFreeGC (dpy, f->output_data.x->cursor_gc);
2810 f->output_data.x->cursor_gc = 0;
2811 }
2812
2813 if (f->output_data.x->border_tile)
2814 {
2815 XFreePixmap (dpy, f->output_data.x->border_tile);
2816 f->output_data.x->border_tile = 0;
2817 }
2818
2819 UNBLOCK_INPUT;
2820 }
2821
2822
2823 /* Handler for signals raised during x_create_frame and
2824 x_create_top_frame. FRAME is the frame which is partially
2825 constructed. */
2826
2827 static Lisp_Object
2828 unwind_create_frame (frame)
2829 Lisp_Object frame;
2830 {
2831 struct frame *f = XFRAME (frame);
2832
2833 /* If frame is ``official'', nothing to do. */
2834 if (!CONSP (Vframe_list) || !EQ (XCAR (Vframe_list), frame))
2835 {
2836 #if GLYPH_DEBUG
2837 struct x_display_info *dpyinfo = FRAME_X_DISPLAY_INFO (f);
2838 #endif
2839
2840 x_free_frame_resources (f);
2841
2842 /* Check that reference counts are indeed correct. */
2843 xassert (dpyinfo->reference_count == dpyinfo_refcount);
2844 xassert (dpyinfo->image_cache->refcount == image_cache_refcount);
2845 return Qt;
2846 }
2847
2848 return Qnil;
2849 }
2850
2851
2852 DEFUN ("x-create-frame", Fx_create_frame, Sx_create_frame,
2853 1, 1, 0,
2854 doc: /* Make a new X window, which is called a "frame" in Emacs terms.
2855 Returns an Emacs frame object.
2856 ALIST is an alist of frame parameters.
2857 If the parameters specify that the frame should not have a minibuffer,
2858 and do not specify a specific minibuffer window to use,
2859 then `default-minibuffer-frame' must be a frame whose minibuffer can
2860 be shared by the new frame.
2861
2862 This function is an internal primitive--use `make-frame' instead. */)
2863 (parms)
2864 Lisp_Object parms;
2865 {
2866 struct frame *f;
2867 Lisp_Object frame, tem;
2868 Lisp_Object name;
2869 int minibuffer_only = 0;
2870 long window_prompting = 0;
2871 int width, height;
2872 int count = SPECPDL_INDEX ();
2873 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
2874 Lisp_Object display;
2875 struct x_display_info *dpyinfo = NULL;
2876 Lisp_Object parent;
2877 struct kboard *kb;
2878
2879 check_x ();
2880
2881 /* Use this general default value to start with
2882 until we know if this frame has a specified name. */
2883 Vx_resource_name = Vinvocation_name;
2884
2885 display = x_get_arg (dpyinfo, parms, Qdisplay, 0, 0, RES_TYPE_STRING);
2886 if (EQ (display, Qunbound))
2887 display = Qnil;
2888 dpyinfo = check_x_display_info (display);
2889 #ifdef MULTI_KBOARD
2890 kb = dpyinfo->kboard;
2891 #else
2892 kb = &the_only_kboard;
2893 #endif
2894
2895 name = x_get_arg (dpyinfo, parms, Qname, "name", "Name", RES_TYPE_STRING);
2896 if (!STRINGP (name)
2897 && ! EQ (name, Qunbound)
2898 && ! NILP (name))
2899 error ("Invalid frame name--not a string or nil");
2900
2901 if (STRINGP (name))
2902 Vx_resource_name = name;
2903
2904 /* See if parent window is specified. */
2905 parent = x_get_arg (dpyinfo, parms, Qparent_id, NULL, NULL, RES_TYPE_NUMBER);
2906 if (EQ (parent, Qunbound))
2907 parent = Qnil;
2908 if (! NILP (parent))
2909 CHECK_NUMBER (parent);
2910
2911 /* make_frame_without_minibuffer can run Lisp code and garbage collect. */
2912 /* No need to protect DISPLAY because that's not used after passing
2913 it to make_frame_without_minibuffer. */
2914 frame = Qnil;
2915 GCPRO4 (parms, parent, name, frame);
2916 tem = x_get_arg (dpyinfo, parms, Qminibuffer, "minibuffer", "Minibuffer",
2917 RES_TYPE_SYMBOL);
2918 if (EQ (tem, Qnone) || NILP (tem))
2919 f = make_frame_without_minibuffer (Qnil, kb, display);
2920 else if (EQ (tem, Qonly))
2921 {
2922 f = make_minibuffer_frame ();
2923 minibuffer_only = 1;
2924 }
2925 else if (WINDOWP (tem))
2926 f = make_frame_without_minibuffer (tem, kb, display);
2927 else
2928 f = make_frame (1);
2929
2930 XSETFRAME (frame, f);
2931
2932 /* Note that X Windows does support scroll bars. */
2933 FRAME_CAN_HAVE_SCROLL_BARS (f) = 1;
2934
2935 f->output_method = output_x_window;
2936 f->output_data.x = (struct x_output *) xmalloc (sizeof (struct x_output));
2937 bzero (f->output_data.x, sizeof (struct x_output));
2938 f->output_data.x->icon_bitmap = -1;
2939 FRAME_FONTSET (f) = -1;
2940 f->output_data.x->scroll_bar_foreground_pixel = -1;
2941 f->output_data.x->scroll_bar_background_pixel = -1;
2942 #ifdef USE_TOOLKIT_SCROLL_BARS
2943 f->output_data.x->scroll_bar_top_shadow_pixel = -1;
2944 f->output_data.x->scroll_bar_bottom_shadow_pixel = -1;
2945 #endif /* USE_TOOLKIT_SCROLL_BARS */
2946 record_unwind_protect (unwind_create_frame, frame);
2947
2948 f->icon_name
2949 = x_get_arg (dpyinfo, parms, Qicon_name, "iconName", "Title",
2950 RES_TYPE_STRING);
2951 if (! STRINGP (f->icon_name))
2952 f->icon_name = Qnil;
2953
2954 FRAME_X_DISPLAY_INFO (f) = dpyinfo;
2955 #if GLYPH_DEBUG
2956 image_cache_refcount = FRAME_X_IMAGE_CACHE (f)->refcount;
2957 dpyinfo_refcount = dpyinfo->reference_count;
2958 #endif /* GLYPH_DEBUG */
2959 #ifdef MULTI_KBOARD
2960 FRAME_KBOARD (f) = kb;
2961 #endif
2962
2963 /* These colors will be set anyway later, but it's important
2964 to get the color reference counts right, so initialize them! */
2965 {
2966 Lisp_Object black;
2967 struct gcpro gcpro1;
2968
2969 /* Function x_decode_color can signal an error. Make
2970 sure to initialize color slots so that we won't try
2971 to free colors we haven't allocated. */
2972 f->output_data.x->foreground_pixel = -1;
2973 f->output_data.x->background_pixel = -1;
2974 f->output_data.x->cursor_pixel = -1;
2975 f->output_data.x->cursor_foreground_pixel = -1;
2976 f->output_data.x->border_pixel = -1;
2977 f->output_data.x->mouse_pixel = -1;
2978
2979 black = build_string ("black");
2980 GCPRO1 (black);
2981 f->output_data.x->foreground_pixel
2982 = x_decode_color (f, black, BLACK_PIX_DEFAULT (f));
2983 f->output_data.x->background_pixel
2984 = x_decode_color (f, black, BLACK_PIX_DEFAULT (f));
2985 f->output_data.x->cursor_pixel
2986 = x_decode_color (f, black, BLACK_PIX_DEFAULT (f));
2987 f->output_data.x->cursor_foreground_pixel
2988 = x_decode_color (f, black, BLACK_PIX_DEFAULT (f));
2989 f->output_data.x->border_pixel
2990 = x_decode_color (f, black, BLACK_PIX_DEFAULT (f));
2991 f->output_data.x->mouse_pixel
2992 = x_decode_color (f, black, BLACK_PIX_DEFAULT (f));
2993 UNGCPRO;
2994 }
2995
2996 /* Specify the parent under which to make this X window. */
2997
2998 if (!NILP (parent))
2999 {
3000 f->output_data.x->parent_desc = (Window) XFASTINT (parent);
3001 f->output_data.x->explicit_parent = 1;
3002 }
3003 else
3004 {
3005 f->output_data.x->parent_desc = FRAME_X_DISPLAY_INFO (f)->root_window;
3006 f->output_data.x->explicit_parent = 0;
3007 }
3008
3009 /* Set the name; the functions to which we pass f expect the name to
3010 be set. */
3011 if (EQ (name, Qunbound) || NILP (name))
3012 {
3013 f->name = build_string (dpyinfo->x_id_name);
3014 f->explicit_name = 0;
3015 }
3016 else
3017 {
3018 f->name = name;
3019 f->explicit_name = 1;
3020 /* use the frame's title when getting resources for this frame. */
3021 specbind (Qx_resource_name, name);
3022 }
3023
3024 /* Extract the window parameters from the supplied values
3025 that are needed to determine window geometry. */
3026 {
3027 Lisp_Object font;
3028
3029 font = x_get_arg (dpyinfo, parms, Qfont, "font", "Font", RES_TYPE_STRING);
3030
3031 /* If the caller has specified no font, try out fonts which we
3032 hope have bold and italic variations. */
3033 if (!STRINGP (font))
3034 {
3035 char *names[]
3036 = { "-adobe-courier-medium-r-*-*-*-120-*-*-*-*-iso8859-1",
3037 "-misc-fixed-medium-r-normal-*-*-140-*-*-c-*-iso8859-1",
3038 "-*-*-medium-r-normal-*-*-140-*-*-c-*-iso8859-1",
3039 /* This was formerly the first thing tried, but it finds
3040 too many fonts and takes too long. */
3041 "-*-*-medium-r-*-*-*-*-*-*-c-*-iso8859-1",
3042 /* If those didn't work, look for something which will
3043 at least work. */
3044 "-*-fixed-*-*-*-*-*-140-*-*-c-*-iso8859-1",
3045 NULL };
3046 int i;
3047
3048 BLOCK_INPUT;
3049 for (i = 0; names[i]; i++)
3050 {
3051 Lisp_Object list;
3052
3053 list = x_list_fonts (f, build_string (names[i]), 0, 1);
3054 if (CONSP (list))
3055 {
3056 font = XCAR (list);
3057 break;
3058 }
3059 }
3060 UNBLOCK_INPUT;
3061 if (! STRINGP (font))
3062 font = build_string ("fixed");
3063 }
3064 x_default_parameter (f, parms, Qfont, font,
3065 "font", "Font", RES_TYPE_STRING);
3066 }
3067
3068 #ifdef USE_LUCID
3069 /* Prevent lwlib/xlwmenu.c from crashing because of a bug
3070 whereby it fails to get any font. */
3071 xlwmenu_default_font = FRAME_FONT (f);
3072 #endif
3073
3074 x_default_parameter (f, parms, Qborder_width, make_number (2),
3075 "borderWidth", "BorderWidth", RES_TYPE_NUMBER);
3076
3077 /* This defaults to 1 in order to match xterm. We recognize either
3078 internalBorderWidth or internalBorder (which is what xterm calls
3079 it). */
3080 if (NILP (Fassq (Qinternal_border_width, parms)))
3081 {
3082 Lisp_Object value;
3083
3084 value = x_get_arg (dpyinfo, parms, Qinternal_border_width,
3085 "internalBorder", "internalBorder", RES_TYPE_NUMBER);
3086 if (! EQ (value, Qunbound))
3087 parms = Fcons (Fcons (Qinternal_border_width, value),
3088 parms);
3089 }
3090 x_default_parameter (f, parms, Qinternal_border_width, make_number (1),
3091 "internalBorderWidth", "internalBorderWidth",
3092 RES_TYPE_NUMBER);
3093 x_default_parameter (f, parms, Qvertical_scroll_bars, Qleft,
3094 "verticalScrollBars", "ScrollBars",
3095 RES_TYPE_SYMBOL);
3096
3097 /* Also do the stuff which must be set before the window exists. */
3098 x_default_parameter (f, parms, Qforeground_color, build_string ("black"),
3099 "foreground", "Foreground", RES_TYPE_STRING);
3100 x_default_parameter (f, parms, Qbackground_color, build_string ("white"),
3101 "background", "Background", RES_TYPE_STRING);
3102 x_default_parameter (f, parms, Qmouse_color, build_string ("black"),
3103 "pointerColor", "Foreground", RES_TYPE_STRING);
3104 x_default_parameter (f, parms, Qcursor_color, build_string ("black"),
3105 "cursorColor", "Foreground", RES_TYPE_STRING);
3106 x_default_parameter (f, parms, Qborder_color, build_string ("black"),
3107 "borderColor", "BorderColor", RES_TYPE_STRING);
3108 x_default_parameter (f, parms, Qscreen_gamma, Qnil,
3109 "screenGamma", "ScreenGamma", RES_TYPE_FLOAT);
3110 x_default_parameter (f, parms, Qline_spacing, Qnil,
3111 "lineSpacing", "LineSpacing", RES_TYPE_NUMBER);
3112 x_default_parameter (f, parms, Qleft_fringe, Qnil,
3113 "leftFringe", "LeftFringe", RES_TYPE_NUMBER);
3114 x_default_parameter (f, parms, Qright_fringe, Qnil,
3115 "rightFringe", "RightFringe", RES_TYPE_NUMBER);
3116
3117 x_default_scroll_bar_color_parameter (f, parms, Qscroll_bar_foreground,
3118 "scrollBarForeground",
3119 "ScrollBarForeground", 1);
3120 x_default_scroll_bar_color_parameter (f, parms, Qscroll_bar_background,
3121 "scrollBarBackground",
3122 "ScrollBarBackground", 0);
3123
3124 /* Init faces before x_default_parameter is called for scroll-bar
3125 parameters because that function calls x_set_scroll_bar_width,
3126 which calls change_frame_size, which calls Fset_window_buffer,
3127 which runs hooks, which call Fvertical_motion. At the end, we
3128 end up in init_iterator with a null face cache, which should not
3129 happen. */
3130 init_frame_faces (f);
3131
3132 x_default_parameter (f, parms, Qmenu_bar_lines, make_number (1),
3133 "menuBar", "MenuBar", RES_TYPE_NUMBER);
3134 x_default_parameter (f, parms, Qtool_bar_lines, make_number (1),
3135 "toolBar", "ToolBar", RES_TYPE_NUMBER);
3136 x_default_parameter (f, parms, Qbuffer_predicate, Qnil,
3137 "bufferPredicate", "BufferPredicate",
3138 RES_TYPE_SYMBOL);
3139 x_default_parameter (f, parms, Qtitle, Qnil,
3140 "title", "Title", RES_TYPE_STRING);
3141 x_default_parameter (f, parms, Qwait_for_wm, Qt,
3142 "waitForWM", "WaitForWM", RES_TYPE_BOOLEAN);
3143 x_default_parameter (f, parms, Qfullscreen, Qnil,
3144 "fullscreen", "Fullscreen", RES_TYPE_SYMBOL);
3145
3146 f->output_data.x->parent_desc = FRAME_X_DISPLAY_INFO (f)->root_window;
3147
3148 /* Compute the size of the X window. */
3149 window_prompting = x_figure_window_size (f, parms, 1);
3150
3151 tem = x_get_arg (dpyinfo, parms, Qunsplittable, 0, 0, RES_TYPE_BOOLEAN);
3152 f->no_split = minibuffer_only || EQ (tem, Qt);
3153
3154 x_icon_verify (f, parms);
3155
3156 /* Create the X widget or window. */
3157 #ifdef USE_X_TOOLKIT
3158 x_window (f, window_prompting, minibuffer_only);
3159 #else
3160 x_window (f);
3161 #endif
3162
3163 x_icon (f, parms);
3164 x_make_gc (f);
3165
3166 /* Now consider the frame official. */
3167 FRAME_X_DISPLAY_INFO (f)->reference_count++;
3168 Vframe_list = Fcons (frame, Vframe_list);
3169
3170 /* We need to do this after creating the X window, so that the
3171 icon-creation functions can say whose icon they're describing. */
3172 x_default_parameter (f, parms, Qicon_type, Qnil,
3173 "bitmapIcon", "BitmapIcon", RES_TYPE_SYMBOL);
3174
3175 x_default_parameter (f, parms, Qauto_raise, Qnil,
3176 "autoRaise", "AutoRaiseLower", RES_TYPE_BOOLEAN);
3177 x_default_parameter (f, parms, Qauto_lower, Qnil,
3178 "autoLower", "AutoRaiseLower", RES_TYPE_BOOLEAN);
3179 x_default_parameter (f, parms, Qcursor_type, Qbox,
3180 "cursorType", "CursorType", RES_TYPE_SYMBOL);
3181 x_default_parameter (f, parms, Qscroll_bar_width, Qnil,
3182 "scrollBarWidth", "ScrollBarWidth",
3183 RES_TYPE_NUMBER);
3184
3185 /* Dimensions, especially FRAME_LINES (f), must be done via change_frame_size.
3186 Change will not be effected unless different from the current
3187 FRAME_LINES (f). */
3188 width = FRAME_COLS (f);
3189 height = FRAME_LINES (f);
3190
3191 SET_FRAME_COLS (f, 0);
3192 FRAME_LINES (f) = 0;
3193 change_frame_size (f, height, width, 1, 0, 0);
3194
3195 #if defined (USE_X_TOOLKIT) || defined (USE_GTK)
3196 /* Create the menu bar. */
3197 if (!minibuffer_only && FRAME_EXTERNAL_MENU_BAR (f))
3198 {
3199 /* If this signals an error, we haven't set size hints for the
3200 frame and we didn't make it visible. */
3201 initialize_frame_menubar (f);
3202
3203 #ifndef USE_GTK
3204 /* This is a no-op, except under Motif where it arranges the
3205 main window for the widgets on it. */
3206 lw_set_main_areas (f->output_data.x->column_widget,
3207 f->output_data.x->menubar_widget,
3208 f->output_data.x->edit_widget);
3209 #endif /* not USE_GTK */
3210 }
3211 #endif /* USE_X_TOOLKIT || USE_GTK */
3212
3213 /* Tell the server what size and position, etc, we want, and how
3214 badly we want them. This should be done after we have the menu
3215 bar so that its size can be taken into account. */
3216 BLOCK_INPUT;
3217 x_wm_set_size_hint (f, window_prompting, 0);
3218 UNBLOCK_INPUT;
3219
3220 /* Make the window appear on the frame and enable display, unless
3221 the caller says not to. However, with explicit parent, Emacs
3222 cannot control visibility, so don't try. */
3223 if (! f->output_data.x->explicit_parent)
3224 {
3225 Lisp_Object visibility;
3226
3227 visibility = x_get_arg (dpyinfo, parms, Qvisibility, 0, 0,
3228 RES_TYPE_SYMBOL);
3229 if (EQ (visibility, Qunbound))
3230 visibility = Qt;
3231
3232 if (EQ (visibility, Qicon))
3233 x_iconify_frame (f);
3234 else if (! NILP (visibility))
3235 x_make_frame_visible (f);
3236 else
3237 /* Must have been Qnil. */
3238 ;
3239 }
3240
3241 /* Set the WM leader property. GTK does this itself, so this is not
3242 needed when using GTK. */
3243 if (dpyinfo->client_leader_window != 0)
3244 {
3245 BLOCK_INPUT;
3246 XChangeProperty (FRAME_X_DISPLAY (f),
3247 FRAME_OUTER_WINDOW (f),
3248 dpyinfo->Xatom_wm_client_leader,
3249 XA_WINDOW, 32, PropModeReplace,
3250 (char *) &dpyinfo->client_leader_window, 1);
3251 UNBLOCK_INPUT;
3252 }
3253
3254 UNGCPRO;
3255
3256 /* Make sure windows on this frame appear in calls to next-window
3257 and similar functions. */
3258 Vwindow_list = Qnil;
3259
3260 return unbind_to (count, frame);
3261 }
3262
3263
3264 /* FRAME is used only to get a handle on the X display. We don't pass the
3265 display info directly because we're called from frame.c, which doesn't
3266 know about that structure. */
3267
3268 Lisp_Object
3269 x_get_focus_frame (frame)
3270 struct frame *frame;
3271 {
3272 struct x_display_info *dpyinfo = FRAME_X_DISPLAY_INFO (frame);
3273 Lisp_Object xfocus;
3274 if (! dpyinfo->x_focus_frame)
3275 return Qnil;
3276
3277 XSETFRAME (xfocus, dpyinfo->x_focus_frame);
3278 return xfocus;
3279 }
3280
3281
3282 /* In certain situations, when the window manager follows a
3283 click-to-focus policy, there seems to be no way around calling
3284 XSetInputFocus to give another frame the input focus .
3285
3286 In an ideal world, XSetInputFocus should generally be avoided so
3287 that applications don't interfere with the window manager's focus
3288 policy. But I think it's okay to use when it's clearly done
3289 following a user-command. */
3290
3291 DEFUN ("x-focus-frame", Fx_focus_frame, Sx_focus_frame, 1, 1, 0,
3292 doc: /* Set the input focus to FRAME.
3293 FRAME nil means use the selected frame. */)
3294 (frame)
3295 Lisp_Object frame;
3296 {
3297 struct frame *f = check_x_frame (frame);
3298 Display *dpy = FRAME_X_DISPLAY (f);
3299 int count;
3300
3301 BLOCK_INPUT;
3302 count = x_catch_errors (dpy);
3303 XSetInputFocus (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
3304 RevertToParent, CurrentTime);
3305 x_uncatch_errors (dpy, count);
3306 UNBLOCK_INPUT;
3307
3308 return Qnil;
3309 }
3310
3311 \f
3312 DEFUN ("xw-color-defined-p", Fxw_color_defined_p, Sxw_color_defined_p, 1, 2, 0,
3313 doc: /* Internal function called by `color-defined-p', which see. */)
3314 (color, frame)
3315 Lisp_Object color, frame;
3316 {
3317 XColor foo;
3318 FRAME_PTR f = check_x_frame (frame);
3319
3320 CHECK_STRING (color);
3321
3322 if (x_defined_color (f, SDATA (color), &foo, 0))
3323 return Qt;
3324 else
3325 return Qnil;
3326 }
3327
3328 DEFUN ("xw-color-values", Fxw_color_values, Sxw_color_values, 1, 2, 0,
3329 doc: /* Internal function called by `color-values', which see. */)
3330 (color, frame)
3331 Lisp_Object color, frame;
3332 {
3333 XColor foo;
3334 FRAME_PTR f = check_x_frame (frame);
3335
3336 CHECK_STRING (color);
3337
3338 if (x_defined_color (f, SDATA (color), &foo, 0))
3339 {
3340 Lisp_Object rgb[3];
3341
3342 rgb[0] = make_number (foo.red);
3343 rgb[1] = make_number (foo.green);
3344 rgb[2] = make_number (foo.blue);
3345 return Flist (3, rgb);
3346 }
3347 else
3348 return Qnil;
3349 }
3350
3351 DEFUN ("xw-display-color-p", Fxw_display_color_p, Sxw_display_color_p, 0, 1, 0,
3352 doc: /* Internal function called by `display-color-p', which see. */)
3353 (display)
3354 Lisp_Object display;
3355 {
3356 struct x_display_info *dpyinfo = check_x_display_info (display);
3357
3358 if (dpyinfo->n_planes <= 2)
3359 return Qnil;
3360
3361 switch (dpyinfo->visual->class)
3362 {
3363 case StaticColor:
3364 case PseudoColor:
3365 case TrueColor:
3366 case DirectColor:
3367 return Qt;
3368
3369 default:
3370 return Qnil;
3371 }
3372 }
3373
3374 DEFUN ("x-display-grayscale-p", Fx_display_grayscale_p, Sx_display_grayscale_p,
3375 0, 1, 0,
3376 doc: /* Return t if the X display supports shades of gray.
3377 Note that color displays do support shades of gray.
3378 The optional argument DISPLAY specifies which display to ask about.
3379 DISPLAY should be either a frame or a display name (a string).
3380 If omitted or nil, that stands for the selected frame's display. */)
3381 (display)
3382 Lisp_Object display;
3383 {
3384 struct x_display_info *dpyinfo = check_x_display_info (display);
3385
3386 if (dpyinfo->n_planes <= 1)
3387 return Qnil;
3388
3389 switch (dpyinfo->visual->class)
3390 {
3391 case StaticColor:
3392 case PseudoColor:
3393 case TrueColor:
3394 case DirectColor:
3395 case StaticGray:
3396 case GrayScale:
3397 return Qt;
3398
3399 default:
3400 return Qnil;
3401 }
3402 }
3403
3404 DEFUN ("x-display-pixel-width", Fx_display_pixel_width, Sx_display_pixel_width,
3405 0, 1, 0,
3406 doc: /* Returns the width in pixels of the X display DISPLAY.
3407 The optional argument DISPLAY specifies which display to ask about.
3408 DISPLAY should be either a frame or a display name (a string).
3409 If omitted or nil, that stands for the selected frame's display. */)
3410 (display)
3411 Lisp_Object display;
3412 {
3413 struct x_display_info *dpyinfo = check_x_display_info (display);
3414
3415 return make_number (dpyinfo->width);
3416 }
3417
3418 DEFUN ("x-display-pixel-height", Fx_display_pixel_height,
3419 Sx_display_pixel_height, 0, 1, 0,
3420 doc: /* Returns the height in pixels of the X display DISPLAY.
3421 The optional argument DISPLAY specifies which display to ask about.
3422 DISPLAY should be either a frame or a display name (a string).
3423 If omitted or nil, that stands for the selected frame's display. */)
3424 (display)
3425 Lisp_Object display;
3426 {
3427 struct x_display_info *dpyinfo = check_x_display_info (display);
3428
3429 return make_number (dpyinfo->height);
3430 }
3431
3432 DEFUN ("x-display-planes", Fx_display_planes, Sx_display_planes,
3433 0, 1, 0,
3434 doc: /* Returns the number of bitplanes of the X display DISPLAY.
3435 The optional argument DISPLAY specifies which display to ask about.
3436 DISPLAY should be either a frame or a display name (a string).
3437 If omitted or nil, that stands for the selected frame's display. */)
3438 (display)
3439 Lisp_Object display;
3440 {
3441 struct x_display_info *dpyinfo = check_x_display_info (display);
3442
3443 return make_number (dpyinfo->n_planes);
3444 }
3445
3446 DEFUN ("x-display-color-cells", Fx_display_color_cells, Sx_display_color_cells,
3447 0, 1, 0,
3448 doc: /* Returns the number of color cells of the X display DISPLAY.
3449 The optional argument DISPLAY specifies which display to ask about.
3450 DISPLAY should be either a frame or a display name (a string).
3451 If omitted or nil, that stands for the selected frame's display. */)
3452 (display)
3453 Lisp_Object display;
3454 {
3455 struct x_display_info *dpyinfo = check_x_display_info (display);
3456
3457 int nr_planes = DisplayPlanes (dpyinfo->display,
3458 XScreenNumberOfScreen (dpyinfo->screen));
3459
3460 /* Truncate nr_planes to 24 to avoid integer overflow.
3461 Some displays says 32, but only 24 bits are actually significant.
3462 There are only very few and rare video cards that have more than
3463 24 significant bits. Also 24 bits is more than 16 million colors,
3464 it "should be enough for everyone". */
3465 if (nr_planes > 24) nr_planes = 24;
3466
3467 return make_number (1 << nr_planes);
3468 }
3469
3470 DEFUN ("x-server-max-request-size", Fx_server_max_request_size,
3471 Sx_server_max_request_size,
3472 0, 1, 0,
3473 doc: /* Returns the maximum request size of the X server of display DISPLAY.
3474 The optional argument DISPLAY specifies which display to ask about.
3475 DISPLAY should be either a frame or a display name (a string).
3476 If omitted or nil, that stands for the selected frame's display. */)
3477 (display)
3478 Lisp_Object display;
3479 {
3480 struct x_display_info *dpyinfo = check_x_display_info (display);
3481
3482 return make_number (MAXREQUEST (dpyinfo->display));
3483 }
3484
3485 DEFUN ("x-server-vendor", Fx_server_vendor, Sx_server_vendor, 0, 1, 0,
3486 doc: /* Returns the "vendor ID" string of the X server of display DISPLAY.
3487 \(Labelling every distributor as a "vendor" embodies the false assumption
3488 that operating systems cannot be developed and distributed noncommercially.)
3489 The optional argument DISPLAY specifies which display to ask about.
3490 DISPLAY should be either a frame or a display name (a string).
3491 If omitted or nil, that stands for the selected frame's display. */)
3492 (display)
3493 Lisp_Object display;
3494 {
3495 struct x_display_info *dpyinfo = check_x_display_info (display);
3496 char *vendor = ServerVendor (dpyinfo->display);
3497
3498 if (! vendor) vendor = "";
3499 return build_string (vendor);
3500 }
3501
3502 DEFUN ("x-server-version", Fx_server_version, Sx_server_version, 0, 1, 0,
3503 doc: /* Returns the version numbers of the X server of display DISPLAY.
3504 The value is a list of three integers: the major and minor
3505 version numbers of the X Protocol in use, and the distributor-specific release
3506 number. See also the function `x-server-vendor'.
3507
3508 The optional argument DISPLAY specifies which display to ask about.
3509 DISPLAY should be either a frame or a display name (a string).
3510 If omitted or nil, that stands for the selected frame's display. */)
3511 (display)
3512 Lisp_Object display;
3513 {
3514 struct x_display_info *dpyinfo = check_x_display_info (display);
3515 Display *dpy = dpyinfo->display;
3516
3517 return Fcons (make_number (ProtocolVersion (dpy)),
3518 Fcons (make_number (ProtocolRevision (dpy)),
3519 Fcons (make_number (VendorRelease (dpy)), Qnil)));
3520 }
3521
3522 DEFUN ("x-display-screens", Fx_display_screens, Sx_display_screens, 0, 1, 0,
3523 doc: /* Return the number of screens on the X server of display DISPLAY.
3524 The optional argument DISPLAY specifies which display to ask about.
3525 DISPLAY should be either a frame or a display name (a string).
3526 If omitted or nil, that stands for the selected frame's display. */)
3527 (display)
3528 Lisp_Object display;
3529 {
3530 struct x_display_info *dpyinfo = check_x_display_info (display);
3531
3532 return make_number (ScreenCount (dpyinfo->display));
3533 }
3534
3535 DEFUN ("x-display-mm-height", Fx_display_mm_height, Sx_display_mm_height, 0, 1, 0,
3536 doc: /* Return the height in millimeters of the X display DISPLAY.
3537 The optional argument DISPLAY specifies which display to ask about.
3538 DISPLAY should be either a frame or a display name (a string).
3539 If omitted or nil, that stands for the selected frame's display. */)
3540 (display)
3541 Lisp_Object display;
3542 {
3543 struct x_display_info *dpyinfo = check_x_display_info (display);
3544
3545 return make_number (HeightMMOfScreen (dpyinfo->screen));
3546 }
3547
3548 DEFUN ("x-display-mm-width", Fx_display_mm_width, Sx_display_mm_width, 0, 1, 0,
3549 doc: /* Return the width in millimeters of the X display DISPLAY.
3550 The optional argument DISPLAY specifies which display to ask about.
3551 DISPLAY should be either a frame or a display name (a string).
3552 If omitted or nil, that stands for the selected frame's display. */)
3553 (display)
3554 Lisp_Object display;
3555 {
3556 struct x_display_info *dpyinfo = check_x_display_info (display);
3557
3558 return make_number (WidthMMOfScreen (dpyinfo->screen));
3559 }
3560
3561 DEFUN ("x-display-backing-store", Fx_display_backing_store,
3562 Sx_display_backing_store, 0, 1, 0,
3563 doc: /* Returns an indication of whether X display DISPLAY does backing store.
3564 The value may be `always', `when-mapped', or `not-useful'.
3565 The optional argument DISPLAY specifies which display to ask about.
3566 DISPLAY should be either a frame or a display name (a string).
3567 If omitted or nil, that stands for the selected frame's display. */)
3568 (display)
3569 Lisp_Object display;
3570 {
3571 struct x_display_info *dpyinfo = check_x_display_info (display);
3572 Lisp_Object result;
3573
3574 switch (DoesBackingStore (dpyinfo->screen))
3575 {
3576 case Always:
3577 result = intern ("always");
3578 break;
3579
3580 case WhenMapped:
3581 result = intern ("when-mapped");
3582 break;
3583
3584 case NotUseful:
3585 result = intern ("not-useful");
3586 break;
3587
3588 default:
3589 error ("Strange value for BackingStore parameter of screen");
3590 result = Qnil;
3591 }
3592
3593 return result;
3594 }
3595
3596 DEFUN ("x-display-visual-class", Fx_display_visual_class,
3597 Sx_display_visual_class, 0, 1, 0,
3598 doc: /* Return the visual class of the X display DISPLAY.
3599 The value is one of the symbols `static-gray', `gray-scale',
3600 `static-color', `pseudo-color', `true-color', or `direct-color'.
3601
3602 The optional argument DISPLAY specifies which display to ask about.
3603 DISPLAY should be either a frame or a display name (a string).
3604 If omitted or nil, that stands for the selected frame's display. */)
3605 (display)
3606 Lisp_Object display;
3607 {
3608 struct x_display_info *dpyinfo = check_x_display_info (display);
3609 Lisp_Object result;
3610
3611 switch (dpyinfo->visual->class)
3612 {
3613 case StaticGray:
3614 result = intern ("static-gray");
3615 break;
3616 case GrayScale:
3617 result = intern ("gray-scale");
3618 break;
3619 case StaticColor:
3620 result = intern ("static-color");
3621 break;
3622 case PseudoColor:
3623 result = intern ("pseudo-color");
3624 break;
3625 case TrueColor:
3626 result = intern ("true-color");
3627 break;
3628 case DirectColor:
3629 result = intern ("direct-color");
3630 break;
3631 default:
3632 error ("Display has an unknown visual class");
3633 result = Qnil;
3634 }
3635
3636 return result;
3637 }
3638
3639 DEFUN ("x-display-save-under", Fx_display_save_under,
3640 Sx_display_save_under, 0, 1, 0,
3641 doc: /* Returns t if the X display DISPLAY supports the save-under feature.
3642 The optional argument DISPLAY specifies which display to ask about.
3643 DISPLAY should be either a frame or a display name (a string).
3644 If omitted or nil, that stands for the selected frame's display. */)
3645 (display)
3646 Lisp_Object display;
3647 {
3648 struct x_display_info *dpyinfo = check_x_display_info (display);
3649
3650 if (DoesSaveUnders (dpyinfo->screen) == True)
3651 return Qt;
3652 else
3653 return Qnil;
3654 }
3655 \f
3656 int
3657 x_pixel_width (f)
3658 register struct frame *f;
3659 {
3660 return FRAME_PIXEL_WIDTH (f);
3661 }
3662
3663 int
3664 x_pixel_height (f)
3665 register struct frame *f;
3666 {
3667 return FRAME_PIXEL_HEIGHT (f);
3668 }
3669
3670 int
3671 x_char_width (f)
3672 register struct frame *f;
3673 {
3674 return FRAME_COLUMN_WIDTH (f);
3675 }
3676
3677 int
3678 x_char_height (f)
3679 register struct frame *f;
3680 {
3681 return FRAME_LINE_HEIGHT (f);
3682 }
3683
3684 int
3685 x_screen_planes (f)
3686 register struct frame *f;
3687 {
3688 return FRAME_X_DISPLAY_INFO (f)->n_planes;
3689 }
3690
3691
3692 \f
3693 /************************************************************************
3694 X Displays
3695 ************************************************************************/
3696
3697 \f
3698 /* Mapping visual names to visuals. */
3699
3700 static struct visual_class
3701 {
3702 char *name;
3703 int class;
3704 }
3705 visual_classes[] =
3706 {
3707 {"StaticGray", StaticGray},
3708 {"GrayScale", GrayScale},
3709 {"StaticColor", StaticColor},
3710 {"PseudoColor", PseudoColor},
3711 {"TrueColor", TrueColor},
3712 {"DirectColor", DirectColor},
3713 {NULL, 0}
3714 };
3715
3716
3717 #ifndef HAVE_XSCREENNUMBEROFSCREEN
3718
3719 /* Value is the screen number of screen SCR. This is a substitute for
3720 the X function with the same name when that doesn't exist. */
3721
3722 int
3723 XScreenNumberOfScreen (scr)
3724 register Screen *scr;
3725 {
3726 Display *dpy = scr->display;
3727 int i;
3728
3729 for (i = 0; i < dpy->nscreens; ++i)
3730 if (scr == dpy->screens + i)
3731 break;
3732
3733 return i;
3734 }
3735
3736 #endif /* not HAVE_XSCREENNUMBEROFSCREEN */
3737
3738
3739 /* Select the visual that should be used on display DPYINFO. Set
3740 members of DPYINFO appropriately. Called from x_term_init. */
3741
3742 void
3743 select_visual (dpyinfo)
3744 struct x_display_info *dpyinfo;
3745 {
3746 Display *dpy = dpyinfo->display;
3747 Screen *screen = dpyinfo->screen;
3748 Lisp_Object value;
3749
3750 /* See if a visual is specified. */
3751 value = display_x_get_resource (dpyinfo,
3752 build_string ("visualClass"),
3753 build_string ("VisualClass"),
3754 Qnil, Qnil);
3755 if (STRINGP (value))
3756 {
3757 /* VALUE should be of the form CLASS-DEPTH, where CLASS is one
3758 of `PseudoColor', `TrueColor' etc. and DEPTH is the color
3759 depth, a decimal number. NAME is compared with case ignored. */
3760 char *s = (char *) alloca (SBYTES (value) + 1);
3761 char *dash;
3762 int i, class = -1;
3763 XVisualInfo vinfo;
3764
3765 strcpy (s, SDATA (value));
3766 dash = index (s, '-');
3767 if (dash)
3768 {
3769 dpyinfo->n_planes = atoi (dash + 1);
3770 *dash = '\0';
3771 }
3772 else
3773 /* We won't find a matching visual with depth 0, so that
3774 an error will be printed below. */
3775 dpyinfo->n_planes = 0;
3776
3777 /* Determine the visual class. */
3778 for (i = 0; visual_classes[i].name; ++i)
3779 if (xstricmp (s, visual_classes[i].name) == 0)
3780 {
3781 class = visual_classes[i].class;
3782 break;
3783 }
3784
3785 /* Look up a matching visual for the specified class. */
3786 if (class == -1
3787 || !XMatchVisualInfo (dpy, XScreenNumberOfScreen (screen),
3788 dpyinfo->n_planes, class, &vinfo))
3789 fatal ("Invalid visual specification `%s'", SDATA (value));
3790
3791 dpyinfo->visual = vinfo.visual;
3792 }
3793 else
3794 {
3795 int n_visuals;
3796 XVisualInfo *vinfo, vinfo_template;
3797
3798 dpyinfo->visual = DefaultVisualOfScreen (screen);
3799
3800 #ifdef HAVE_X11R4
3801 vinfo_template.visualid = XVisualIDFromVisual (dpyinfo->visual);
3802 #else
3803 vinfo_template.visualid = dpyinfo->visual->visualid;
3804 #endif
3805 vinfo_template.screen = XScreenNumberOfScreen (screen);
3806 vinfo = XGetVisualInfo (dpy, VisualIDMask | VisualScreenMask,
3807 &vinfo_template, &n_visuals);
3808 if (n_visuals != 1)
3809 fatal ("Can't get proper X visual info");
3810
3811 dpyinfo->n_planes = vinfo->depth;
3812 XFree ((char *) vinfo);
3813 }
3814 }
3815
3816
3817 /* Return the X display structure for the display named NAME.
3818 Open a new connection if necessary. */
3819
3820 struct x_display_info *
3821 x_display_info_for_name (name)
3822 Lisp_Object name;
3823 {
3824 Lisp_Object names;
3825 struct x_display_info *dpyinfo;
3826
3827 CHECK_STRING (name);
3828
3829 if (! EQ (Vwindow_system, intern ("x")))
3830 error ("Not using X Windows");
3831
3832 for (dpyinfo = x_display_list, names = x_display_name_list;
3833 dpyinfo;
3834 dpyinfo = dpyinfo->next, names = XCDR (names))
3835 {
3836 Lisp_Object tem;
3837 tem = Fstring_equal (XCAR (XCAR (names)), name);
3838 if (!NILP (tem))
3839 return dpyinfo;
3840 }
3841
3842 /* Use this general default value to start with. */
3843 Vx_resource_name = Vinvocation_name;
3844
3845 validate_x_resource_name ();
3846
3847 dpyinfo = x_term_init (name, (char *)0,
3848 (char *) SDATA (Vx_resource_name));
3849
3850 if (dpyinfo == 0)
3851 error ("Cannot connect to X server %s", SDATA (name));
3852
3853 x_in_use = 1;
3854 XSETFASTINT (Vwindow_system_version, 11);
3855
3856 return dpyinfo;
3857 }
3858
3859
3860 DEFUN ("x-open-connection", Fx_open_connection, Sx_open_connection,
3861 1, 3, 0,
3862 doc: /* Open a connection to an X server.
3863 DISPLAY is the name of the display to connect to.
3864 Optional second arg XRM-STRING is a string of resources in xrdb format.
3865 If the optional third arg MUST-SUCCEED is non-nil,
3866 terminate Emacs if we can't open the connection. */)
3867 (display, xrm_string, must_succeed)
3868 Lisp_Object display, xrm_string, must_succeed;
3869 {
3870 unsigned char *xrm_option;
3871 struct x_display_info *dpyinfo;
3872
3873 CHECK_STRING (display);
3874 if (! NILP (xrm_string))
3875 CHECK_STRING (xrm_string);
3876
3877 if (! EQ (Vwindow_system, intern ("x")))
3878 error ("Not using X Windows");
3879
3880 if (! NILP (xrm_string))
3881 xrm_option = (unsigned char *) SDATA (xrm_string);
3882 else
3883 xrm_option = (unsigned char *) 0;
3884
3885 validate_x_resource_name ();
3886
3887 /* This is what opens the connection and sets x_current_display.
3888 This also initializes many symbols, such as those used for input. */
3889 dpyinfo = x_term_init (display, xrm_option,
3890 (char *) SDATA (Vx_resource_name));
3891
3892 if (dpyinfo == 0)
3893 {
3894 if (!NILP (must_succeed))
3895 fatal ("Cannot connect to X server %s.\n\
3896 Check the DISPLAY environment variable or use `-d'.\n\
3897 Also use the `xauth' program to verify that you have the proper\n\
3898 authorization information needed to connect the X server.\n\
3899 An insecure way to solve the problem may be to use `xhost'.\n",
3900 SDATA (display));
3901 else
3902 error ("Cannot connect to X server %s", SDATA (display));
3903 }
3904
3905 x_in_use = 1;
3906
3907 XSETFASTINT (Vwindow_system_version, 11);
3908 return Qnil;
3909 }
3910
3911 DEFUN ("x-close-connection", Fx_close_connection,
3912 Sx_close_connection, 1, 1, 0,
3913 doc: /* Close the connection to DISPLAY's X server.
3914 For DISPLAY, specify either a frame or a display name (a string).
3915 If DISPLAY is nil, that stands for the selected frame's display. */)
3916 (display)
3917 Lisp_Object display;
3918 {
3919 struct x_display_info *dpyinfo = check_x_display_info (display);
3920 int i;
3921
3922 if (dpyinfo->reference_count > 0)
3923 error ("Display still has frames on it");
3924
3925 BLOCK_INPUT;
3926 /* Free the fonts in the font table. */
3927 for (i = 0; i < dpyinfo->n_fonts; i++)
3928 if (dpyinfo->font_table[i].name)
3929 {
3930 XFreeFont (dpyinfo->display, dpyinfo->font_table[i].font);
3931 }
3932
3933 x_destroy_all_bitmaps (dpyinfo);
3934 XSetCloseDownMode (dpyinfo->display, DestroyAll);
3935
3936 #ifdef USE_X_TOOLKIT
3937 XtCloseDisplay (dpyinfo->display);
3938 #else
3939 XCloseDisplay (dpyinfo->display);
3940 #endif
3941
3942 x_delete_display (dpyinfo);
3943 UNBLOCK_INPUT;
3944
3945 return Qnil;
3946 }
3947
3948 DEFUN ("x-display-list", Fx_display_list, Sx_display_list, 0, 0, 0,
3949 doc: /* Return the list of display names that Emacs has connections to. */)
3950 ()
3951 {
3952 Lisp_Object tail, result;
3953
3954 result = Qnil;
3955 for (tail = x_display_name_list; ! NILP (tail); tail = XCDR (tail))
3956 result = Fcons (XCAR (XCAR (tail)), result);
3957
3958 return result;
3959 }
3960
3961 DEFUN ("x-synchronize", Fx_synchronize, Sx_synchronize, 1, 2, 0,
3962 doc: /* If ON is non-nil, report X errors as soon as the erring request is made.
3963 If ON is nil, allow buffering of requests.
3964 Turning on synchronization prohibits the Xlib routines from buffering
3965 requests and seriously degrades performance, but makes debugging much
3966 easier.
3967 The optional second argument DISPLAY specifies which display to act on.
3968 DISPLAY should be either a frame or a display name (a string).
3969 If DISPLAY is omitted or nil, that stands for the selected frame's display. */)
3970 (on, display)
3971 Lisp_Object display, on;
3972 {
3973 struct x_display_info *dpyinfo = check_x_display_info (display);
3974
3975 XSynchronize (dpyinfo->display, !EQ (on, Qnil));
3976
3977 return Qnil;
3978 }
3979
3980 /* Wait for responses to all X commands issued so far for frame F. */
3981
3982 void
3983 x_sync (f)
3984 FRAME_PTR f;
3985 {
3986 BLOCK_INPUT;
3987 XSync (FRAME_X_DISPLAY (f), False);
3988 UNBLOCK_INPUT;
3989 }
3990
3991 \f
3992 /***********************************************************************
3993 Window properties
3994 ***********************************************************************/
3995
3996 DEFUN ("x-change-window-property", Fx_change_window_property,
3997 Sx_change_window_property, 2, 6, 0,
3998 doc: /* Change window property PROP to VALUE on the X window of FRAME.
3999 PROP must be a string.
4000 VALUE may be a string or a list of conses, numbers and/or strings.
4001 If an element in the list is a string, it is converted to
4002 an Atom and the value of the Atom is used. If an element is a cons,
4003 it is converted to a 32 bit number where the car is the 16 top bits and the
4004 cdr is the lower 16 bits.
4005 FRAME nil or omitted means use the selected frame.
4006 If TYPE is given and non-nil, it is the name of the type of VALUE.
4007 If TYPE is not given or nil, the type is STRING.
4008 FORMAT gives the size in bits of each element if VALUE is a list.
4009 It must be one of 8, 16 or 32.
4010 If VALUE is a string or FORMAT is nil or not given, FORMAT defaults to 8.
4011 If OUTER_P is non-nil, the property is changed for the outer X window of
4012 FRAME. Default is to change on the edit X window.
4013
4014 Value is VALUE. */)
4015 (prop, value, frame, type, format, outer_p)
4016 Lisp_Object prop, value, frame, type, format, outer_p;
4017 {
4018 struct frame *f = check_x_frame (frame);
4019 Atom prop_atom;
4020 Atom target_type = XA_STRING;
4021 int element_format = 8;
4022 unsigned char *data;
4023 int nelements;
4024 Window w;
4025
4026 CHECK_STRING (prop);
4027
4028 if (! NILP (format))
4029 {
4030 CHECK_NUMBER (format);
4031 element_format = XFASTINT (format);
4032
4033 if (element_format != 8 && element_format != 16
4034 && element_format != 32)
4035 error ("FORMAT must be one of 8, 16 or 32");
4036 }
4037
4038 if (CONSP (value))
4039 {
4040 nelements = x_check_property_data (value);
4041 if (nelements == -1)
4042 error ("Bad data in VALUE, must be number, string or cons");
4043
4044 if (element_format == 8)
4045 data = (unsigned char *) xmalloc (nelements);
4046 else if (element_format == 16)
4047 data = (unsigned char *) xmalloc (nelements*2);
4048 else
4049 data = (unsigned char *) xmalloc (nelements*4);
4050
4051 x_fill_property_data (FRAME_X_DISPLAY (f), value, data, element_format);
4052 }
4053 else
4054 {
4055 CHECK_STRING (value);
4056 data = SDATA (value);
4057 nelements = SCHARS (value);
4058 }
4059
4060 BLOCK_INPUT;
4061 prop_atom = XInternAtom (FRAME_X_DISPLAY (f), SDATA (prop), False);
4062 if (! NILP (type))
4063 {
4064 CHECK_STRING (type);
4065 target_type = XInternAtom (FRAME_X_DISPLAY (f), SDATA (type), False);
4066 }
4067
4068 if (! NILP (outer_p)) w = FRAME_OUTER_WINDOW (f);
4069 else w = FRAME_X_WINDOW (f);
4070
4071 XChangeProperty (FRAME_X_DISPLAY (f), w,
4072 prop_atom, target_type, element_format, PropModeReplace,
4073 data, nelements);
4074
4075 if (CONSP (value)) xfree (data);
4076
4077 /* Make sure the property is set when we return. */
4078 XFlush (FRAME_X_DISPLAY (f));
4079 UNBLOCK_INPUT;
4080
4081 return value;
4082 }
4083
4084
4085 DEFUN ("x-delete-window-property", Fx_delete_window_property,
4086 Sx_delete_window_property, 1, 2, 0,
4087 doc: /* Remove window property PROP from X window of FRAME.
4088 FRAME nil or omitted means use the selected frame. Value is PROP. */)
4089 (prop, frame)
4090 Lisp_Object prop, frame;
4091 {
4092 struct frame *f = check_x_frame (frame);
4093 Atom prop_atom;
4094
4095 CHECK_STRING (prop);
4096 BLOCK_INPUT;
4097 prop_atom = XInternAtom (FRAME_X_DISPLAY (f), SDATA (prop), False);
4098 XDeleteProperty (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f), prop_atom);
4099
4100 /* Make sure the property is removed when we return. */
4101 XFlush (FRAME_X_DISPLAY (f));
4102 UNBLOCK_INPUT;
4103
4104 return prop;
4105 }
4106
4107
4108 DEFUN ("x-window-property", Fx_window_property, Sx_window_property,
4109 1, 6, 0,
4110 doc: /* Value is the value of window property PROP on FRAME.
4111 If FRAME is nil or omitted, use the selected frame.
4112 If TYPE is nil or omitted, get the property as a string. Otherwise TYPE
4113 is the name of the Atom that denotes the type expected.
4114 If SOURCE is non-nil, get the property on that window instead of from
4115 FRAME. The number 0 denotes the root window.
4116 If DELETE_P is non-nil, delete the property after retreiving it.
4117 If VECTOR_RET_P is non-nil, don't return a string but a vector of values.
4118
4119 Value is nil if FRAME hasn't a property with name PROP or if PROP has
4120 no value of TYPE. */)
4121 (prop, frame, type, source, delete_p, vector_ret_p)
4122 Lisp_Object prop, frame, type, source, delete_p, vector_ret_p;
4123 {
4124 struct frame *f = check_x_frame (frame);
4125 Atom prop_atom;
4126 int rc;
4127 Lisp_Object prop_value = Qnil;
4128 char *tmp_data = NULL;
4129 Atom actual_type;
4130 Atom target_type = XA_STRING;
4131 int actual_format;
4132 unsigned long actual_size, bytes_remaining;
4133 Window target_window = FRAME_X_WINDOW (f);
4134 struct gcpro gcpro1;
4135
4136 GCPRO1 (prop_value);
4137 CHECK_STRING (prop);
4138
4139 if (! NILP (source))
4140 {
4141 if (NUMBERP (source))
4142 {
4143 if (FLOATP (source))
4144 target_window = (Window) XFLOAT (source);
4145 else
4146 target_window = XFASTINT (source);
4147
4148 if (target_window == 0)
4149 target_window = FRAME_X_DISPLAY_INFO (f)->root_window;
4150 }
4151 else if (CONSP (source))
4152 target_window = cons_to_long (source);
4153 }
4154
4155 BLOCK_INPUT;
4156 if (STRINGP (type))
4157 {
4158 if (strcmp ("AnyPropertyType", SDATA (type)) == 0)
4159 target_type = AnyPropertyType;
4160 else
4161 target_type = XInternAtom (FRAME_X_DISPLAY (f), SDATA (type), False);
4162 }
4163
4164 prop_atom = XInternAtom (FRAME_X_DISPLAY (f), SDATA (prop), False);
4165 rc = XGetWindowProperty (FRAME_X_DISPLAY (f), target_window,
4166 prop_atom, 0, 0, False, target_type,
4167 &actual_type, &actual_format, &actual_size,
4168 &bytes_remaining, (unsigned char **) &tmp_data);
4169 if (rc == Success)
4170 {
4171 int size = bytes_remaining;
4172
4173 XFree (tmp_data);
4174 tmp_data = NULL;
4175
4176 rc = XGetWindowProperty (FRAME_X_DISPLAY (f), target_window,
4177 prop_atom, 0, bytes_remaining,
4178 ! NILP (delete_p), target_type,
4179 &actual_type, &actual_format,
4180 &actual_size, &bytes_remaining,
4181 (unsigned char **) &tmp_data);
4182 if (rc == Success && tmp_data)
4183 {
4184 if (NILP (vector_ret_p))
4185 prop_value = make_string (tmp_data, size);
4186 else
4187 prop_value = x_property_data_to_lisp (f,
4188 (unsigned char *) tmp_data,
4189 actual_type,
4190 actual_format,
4191 actual_size);
4192 }
4193
4194 if (tmp_data) XFree (tmp_data);
4195 }
4196
4197 UNBLOCK_INPUT;
4198 UNGCPRO;
4199 return prop_value;
4200 }
4201
4202
4203 \f
4204 /***********************************************************************
4205 Busy cursor
4206 ***********************************************************************/
4207
4208 /* If non-null, an asynchronous timer that, when it expires, displays
4209 an hourglass cursor on all frames. */
4210
4211 static struct atimer *hourglass_atimer;
4212
4213 /* Non-zero means an hourglass cursor is currently shown. */
4214
4215 static int hourglass_shown_p;
4216
4217 /* Number of seconds to wait before displaying an hourglass cursor. */
4218
4219 static Lisp_Object Vhourglass_delay;
4220
4221 /* Default number of seconds to wait before displaying an hourglass
4222 cursor. */
4223
4224 #define DEFAULT_HOURGLASS_DELAY 1
4225
4226 /* Function prototypes. */
4227
4228 static void show_hourglass P_ ((struct atimer *));
4229 static void hide_hourglass P_ ((void));
4230
4231
4232 /* Cancel a currently active hourglass timer, and start a new one. */
4233
4234 void
4235 start_hourglass ()
4236 {
4237 EMACS_TIME delay;
4238 int secs, usecs = 0;
4239
4240 cancel_hourglass ();
4241
4242 if (INTEGERP (Vhourglass_delay)
4243 && XINT (Vhourglass_delay) > 0)
4244 secs = XFASTINT (Vhourglass_delay);
4245 else if (FLOATP (Vhourglass_delay)
4246 && XFLOAT_DATA (Vhourglass_delay) > 0)
4247 {
4248 Lisp_Object tem;
4249 tem = Ftruncate (Vhourglass_delay, Qnil);
4250 secs = XFASTINT (tem);
4251 usecs = (XFLOAT_DATA (Vhourglass_delay) - secs) * 1000000;
4252 }
4253 else
4254 secs = DEFAULT_HOURGLASS_DELAY;
4255
4256 EMACS_SET_SECS_USECS (delay, secs, usecs);
4257 hourglass_atimer = start_atimer (ATIMER_RELATIVE, delay,
4258 show_hourglass, NULL);
4259 }
4260
4261
4262 /* Cancel the hourglass cursor timer if active, hide a busy cursor if
4263 shown. */
4264
4265 void
4266 cancel_hourglass ()
4267 {
4268 if (hourglass_atimer)
4269 {
4270 cancel_atimer (hourglass_atimer);
4271 hourglass_atimer = NULL;
4272 }
4273
4274 if (hourglass_shown_p)
4275 hide_hourglass ();
4276 }
4277
4278
4279 /* Timer function of hourglass_atimer. TIMER is equal to
4280 hourglass_atimer.
4281
4282 Display an hourglass pointer on all frames by mapping the frames'
4283 hourglass_window. Set the hourglass_p flag in the frames'
4284 output_data.x structure to indicate that an hourglass cursor is
4285 shown on the frames. */
4286
4287 static void
4288 show_hourglass (timer)
4289 struct atimer *timer;
4290 {
4291 /* The timer implementation will cancel this timer automatically
4292 after this function has run. Set hourglass_atimer to null
4293 so that we know the timer doesn't have to be canceled. */
4294 hourglass_atimer = NULL;
4295
4296 if (!hourglass_shown_p)
4297 {
4298 Lisp_Object rest, frame;
4299
4300 BLOCK_INPUT;
4301
4302 FOR_EACH_FRAME (rest, frame)
4303 {
4304 struct frame *f = XFRAME (frame);
4305
4306 if (FRAME_LIVE_P (f) && FRAME_X_P (f) && FRAME_X_DISPLAY (f))
4307 {
4308 Display *dpy = FRAME_X_DISPLAY (f);
4309
4310 #ifdef USE_X_TOOLKIT
4311 if (f->output_data.x->widget)
4312 #else
4313 if (FRAME_OUTER_WINDOW (f))
4314 #endif
4315 {
4316 f->output_data.x->hourglass_p = 1;
4317
4318 if (!f->output_data.x->hourglass_window)
4319 {
4320 unsigned long mask = CWCursor;
4321 XSetWindowAttributes attrs;
4322
4323 attrs.cursor = f->output_data.x->hourglass_cursor;
4324
4325 f->output_data.x->hourglass_window
4326 = XCreateWindow (dpy, FRAME_OUTER_WINDOW (f),
4327 0, 0, 32000, 32000, 0, 0,
4328 InputOnly,
4329 CopyFromParent,
4330 mask, &attrs);
4331 }
4332
4333 XMapRaised (dpy, f->output_data.x->hourglass_window);
4334 XFlush (dpy);
4335 }
4336 }
4337 }
4338
4339 hourglass_shown_p = 1;
4340 UNBLOCK_INPUT;
4341 }
4342 }
4343
4344
4345 /* Hide the hourglass pointer on all frames, if it is currently
4346 shown. */
4347
4348 static void
4349 hide_hourglass ()
4350 {
4351 if (hourglass_shown_p)
4352 {
4353 Lisp_Object rest, frame;
4354
4355 BLOCK_INPUT;
4356 FOR_EACH_FRAME (rest, frame)
4357 {
4358 struct frame *f = XFRAME (frame);
4359
4360 if (FRAME_X_P (f)
4361 /* Watch out for newly created frames. */
4362 && f->output_data.x->hourglass_window)
4363 {
4364 XUnmapWindow (FRAME_X_DISPLAY (f),
4365 f->output_data.x->hourglass_window);
4366 /* Sync here because XTread_socket looks at the
4367 hourglass_p flag that is reset to zero below. */
4368 XSync (FRAME_X_DISPLAY (f), False);
4369 f->output_data.x->hourglass_p = 0;
4370 }
4371 }
4372
4373 hourglass_shown_p = 0;
4374 UNBLOCK_INPUT;
4375 }
4376 }
4377
4378
4379 \f
4380 /***********************************************************************
4381 Tool tips
4382 ***********************************************************************/
4383
4384 static Lisp_Object x_create_tip_frame P_ ((struct x_display_info *,
4385 Lisp_Object, Lisp_Object));
4386 static void compute_tip_xy P_ ((struct frame *, Lisp_Object, Lisp_Object,
4387 Lisp_Object, int, int, int *, int *));
4388
4389 /* The frame of a currently visible tooltip. */
4390
4391 Lisp_Object tip_frame;
4392
4393 /* If non-nil, a timer started that hides the last tooltip when it
4394 fires. */
4395
4396 Lisp_Object tip_timer;
4397 Window tip_window;
4398
4399 /* If non-nil, a vector of 3 elements containing the last args
4400 with which x-show-tip was called. See there. */
4401
4402 Lisp_Object last_show_tip_args;
4403
4404 /* Maximum size for tooltips; a cons (COLUMNS . ROWS). */
4405
4406 Lisp_Object Vx_max_tooltip_size;
4407
4408
4409 static Lisp_Object
4410 unwind_create_tip_frame (frame)
4411 Lisp_Object frame;
4412 {
4413 Lisp_Object deleted;
4414
4415 deleted = unwind_create_frame (frame);
4416 if (EQ (deleted, Qt))
4417 {
4418 tip_window = None;
4419 tip_frame = Qnil;
4420 }
4421
4422 return deleted;
4423 }
4424
4425
4426 /* Create a frame for a tooltip on the display described by DPYINFO.
4427 PARMS is a list of frame parameters. TEXT is the string to
4428 display in the tip frame. Value is the frame.
4429
4430 Note that functions called here, esp. x_default_parameter can
4431 signal errors, for instance when a specified color name is
4432 undefined. We have to make sure that we're in a consistent state
4433 when this happens. */
4434
4435 static Lisp_Object
4436 x_create_tip_frame (dpyinfo, parms, text)
4437 struct x_display_info *dpyinfo;
4438 Lisp_Object parms, text;
4439 {
4440 struct frame *f;
4441 Lisp_Object frame, tem;
4442 Lisp_Object name;
4443 long window_prompting = 0;
4444 int width, height;
4445 int count = SPECPDL_INDEX ();
4446 struct gcpro gcpro1, gcpro2, gcpro3;
4447 struct kboard *kb;
4448 int face_change_count_before = face_change_count;
4449 Lisp_Object buffer;
4450 struct buffer *old_buffer;
4451
4452 check_x ();
4453
4454 /* Use this general default value to start with until we know if
4455 this frame has a specified name. */
4456 Vx_resource_name = Vinvocation_name;
4457
4458 #ifdef MULTI_KBOARD
4459 kb = dpyinfo->kboard;
4460 #else
4461 kb = &the_only_kboard;
4462 #endif
4463
4464 /* Get the name of the frame to use for resource lookup. */
4465 name = x_get_arg (dpyinfo, parms, Qname, "name", "Name", RES_TYPE_STRING);
4466 if (!STRINGP (name)
4467 && !EQ (name, Qunbound)
4468 && !NILP (name))
4469 error ("Invalid frame name--not a string or nil");
4470 Vx_resource_name = name;
4471
4472 frame = Qnil;
4473 GCPRO3 (parms, name, frame);
4474 f = make_frame (1);
4475 XSETFRAME (frame, f);
4476
4477 buffer = Fget_buffer_create (build_string (" *tip*"));
4478 Fset_window_buffer (FRAME_ROOT_WINDOW (f), buffer, Qnil);
4479 old_buffer = current_buffer;
4480 set_buffer_internal_1 (XBUFFER (buffer));
4481 current_buffer->truncate_lines = Qnil;
4482 specbind (Qinhibit_read_only, Qt);
4483 specbind (Qinhibit_modification_hooks, Qt);
4484 Ferase_buffer ();
4485 Finsert (1, &text);
4486 set_buffer_internal_1 (old_buffer);
4487
4488 FRAME_CAN_HAVE_SCROLL_BARS (f) = 0;
4489 record_unwind_protect (unwind_create_tip_frame, frame);
4490
4491 /* By setting the output method, we're essentially saying that
4492 the frame is live, as per FRAME_LIVE_P. If we get a signal
4493 from this point on, x_destroy_window might screw up reference
4494 counts etc. */
4495 f->output_method = output_x_window;
4496 f->output_data.x = (struct x_output *) xmalloc (sizeof (struct x_output));
4497 bzero (f->output_data.x, sizeof (struct x_output));
4498 f->output_data.x->icon_bitmap = -1;
4499 FRAME_FONTSET (f) = -1;
4500 f->output_data.x->scroll_bar_foreground_pixel = -1;
4501 f->output_data.x->scroll_bar_background_pixel = -1;
4502 #ifdef USE_TOOLKIT_SCROLL_BARS
4503 f->output_data.x->scroll_bar_top_shadow_pixel = -1;
4504 f->output_data.x->scroll_bar_bottom_shadow_pixel = -1;
4505 #endif /* USE_TOOLKIT_SCROLL_BARS */
4506 f->icon_name = Qnil;
4507 FRAME_X_DISPLAY_INFO (f) = dpyinfo;
4508 #if GLYPH_DEBUG
4509 image_cache_refcount = FRAME_X_IMAGE_CACHE (f)->refcount;
4510 dpyinfo_refcount = dpyinfo->reference_count;
4511 #endif /* GLYPH_DEBUG */
4512 #ifdef MULTI_KBOARD
4513 FRAME_KBOARD (f) = kb;
4514 #endif
4515 f->output_data.x->parent_desc = FRAME_X_DISPLAY_INFO (f)->root_window;
4516 f->output_data.x->explicit_parent = 0;
4517
4518 /* These colors will be set anyway later, but it's important
4519 to get the color reference counts right, so initialize them! */
4520 {
4521 Lisp_Object black;
4522 struct gcpro gcpro1;
4523
4524 black = build_string ("black");
4525 GCPRO1 (black);
4526 f->output_data.x->foreground_pixel
4527 = x_decode_color (f, black, BLACK_PIX_DEFAULT (f));
4528 f->output_data.x->background_pixel
4529 = x_decode_color (f, black, BLACK_PIX_DEFAULT (f));
4530 f->output_data.x->cursor_pixel
4531 = x_decode_color (f, black, BLACK_PIX_DEFAULT (f));
4532 f->output_data.x->cursor_foreground_pixel
4533 = x_decode_color (f, black, BLACK_PIX_DEFAULT (f));
4534 f->output_data.x->border_pixel
4535 = x_decode_color (f, black, BLACK_PIX_DEFAULT (f));
4536 f->output_data.x->mouse_pixel
4537 = x_decode_color (f, black, BLACK_PIX_DEFAULT (f));
4538 UNGCPRO;
4539 }
4540
4541 /* Set the name; the functions to which we pass f expect the name to
4542 be set. */
4543 if (EQ (name, Qunbound) || NILP (name))
4544 {
4545 f->name = build_string (dpyinfo->x_id_name);
4546 f->explicit_name = 0;
4547 }
4548 else
4549 {
4550 f->name = name;
4551 f->explicit_name = 1;
4552 /* use the frame's title when getting resources for this frame. */
4553 specbind (Qx_resource_name, name);
4554 }
4555
4556 /* Extract the window parameters from the supplied values that are
4557 needed to determine window geometry. */
4558 {
4559 Lisp_Object font;
4560
4561 font = x_get_arg (dpyinfo, parms, Qfont, "font", "Font", RES_TYPE_STRING);
4562
4563 BLOCK_INPUT;
4564 /* First, try whatever font the caller has specified. */
4565 if (STRINGP (font))
4566 {
4567 tem = Fquery_fontset (font, Qnil);
4568 if (STRINGP (tem))
4569 font = x_new_fontset (f, tem);
4570 else
4571 font = x_new_font (f, SDATA (font));
4572 }
4573
4574 /* Try out a font which we hope has bold and italic variations. */
4575 if (!STRINGP (font))
4576 font = x_new_font (f, "-adobe-courier-medium-r-*-*-*-120-*-*-*-*-iso8859-1");
4577 if (!STRINGP (font))
4578 font = x_new_font (f, "-misc-fixed-medium-r-normal-*-*-140-*-*-c-*-iso8859-1");
4579 if (! STRINGP (font))
4580 font = x_new_font (f, "-*-*-medium-r-normal-*-*-140-*-*-c-*-iso8859-1");
4581 if (! STRINGP (font))
4582 /* This was formerly the first thing tried, but it finds too many fonts
4583 and takes too long. */
4584 font = x_new_font (f, "-*-*-medium-r-*-*-*-*-*-*-c-*-iso8859-1");
4585 /* If those didn't work, look for something which will at least work. */
4586 if (! STRINGP (font))
4587 font = x_new_font (f, "-*-fixed-*-*-*-*-*-140-*-*-c-*-iso8859-1");
4588 UNBLOCK_INPUT;
4589 if (! STRINGP (font))
4590 font = build_string ("fixed");
4591
4592 x_default_parameter (f, parms, Qfont, font,
4593 "font", "Font", RES_TYPE_STRING);
4594 }
4595
4596 x_default_parameter (f, parms, Qborder_width, make_number (2),
4597 "borderWidth", "BorderWidth", RES_TYPE_NUMBER);
4598
4599 /* This defaults to 2 in order to match xterm. We recognize either
4600 internalBorderWidth or internalBorder (which is what xterm calls
4601 it). */
4602 if (NILP (Fassq (Qinternal_border_width, parms)))
4603 {
4604 Lisp_Object value;
4605
4606 value = x_get_arg (dpyinfo, parms, Qinternal_border_width,
4607 "internalBorder", "internalBorder", RES_TYPE_NUMBER);
4608 if (! EQ (value, Qunbound))
4609 parms = Fcons (Fcons (Qinternal_border_width, value),
4610 parms);
4611 }
4612
4613 x_default_parameter (f, parms, Qinternal_border_width, make_number (1),
4614 "internalBorderWidth", "internalBorderWidth",
4615 RES_TYPE_NUMBER);
4616
4617 /* Also do the stuff which must be set before the window exists. */
4618 x_default_parameter (f, parms, Qforeground_color, build_string ("black"),
4619 "foreground", "Foreground", RES_TYPE_STRING);
4620 x_default_parameter (f, parms, Qbackground_color, build_string ("white"),
4621 "background", "Background", RES_TYPE_STRING);
4622 x_default_parameter (f, parms, Qmouse_color, build_string ("black"),
4623 "pointerColor", "Foreground", RES_TYPE_STRING);
4624 x_default_parameter (f, parms, Qcursor_color, build_string ("black"),
4625 "cursorColor", "Foreground", RES_TYPE_STRING);
4626 x_default_parameter (f, parms, Qborder_color, build_string ("black"),
4627 "borderColor", "BorderColor", RES_TYPE_STRING);
4628
4629 /* Init faces before x_default_parameter is called for scroll-bar
4630 parameters because that function calls x_set_scroll_bar_width,
4631 which calls change_frame_size, which calls Fset_window_buffer,
4632 which runs hooks, which call Fvertical_motion. At the end, we
4633 end up in init_iterator with a null face cache, which should not
4634 happen. */
4635 init_frame_faces (f);
4636
4637 f->output_data.x->parent_desc = FRAME_X_DISPLAY_INFO (f)->root_window;
4638
4639 window_prompting = x_figure_window_size (f, parms, 0);
4640
4641 {
4642 XSetWindowAttributes attrs;
4643 unsigned long mask;
4644
4645 BLOCK_INPUT;
4646 mask = CWBackPixel | CWOverrideRedirect | CWEventMask;
4647 if (DoesSaveUnders (dpyinfo->screen))
4648 mask |= CWSaveUnder;
4649
4650 /* Window managers look at the override-redirect flag to determine
4651 whether or net to give windows a decoration (Xlib spec, chapter
4652 3.2.8). */
4653 attrs.override_redirect = True;
4654 attrs.save_under = True;
4655 attrs.background_pixel = FRAME_BACKGROUND_PIXEL (f);
4656 /* Arrange for getting MapNotify and UnmapNotify events. */
4657 attrs.event_mask = StructureNotifyMask;
4658 tip_window
4659 = FRAME_X_WINDOW (f)
4660 = XCreateWindow (FRAME_X_DISPLAY (f),
4661 FRAME_X_DISPLAY_INFO (f)->root_window,
4662 /* x, y, width, height */
4663 0, 0, 1, 1,
4664 /* Border. */
4665 1,
4666 CopyFromParent, InputOutput, CopyFromParent,
4667 mask, &attrs);
4668 UNBLOCK_INPUT;
4669 }
4670
4671 x_make_gc (f);
4672
4673 x_default_parameter (f, parms, Qauto_raise, Qnil,
4674 "autoRaise", "AutoRaiseLower", RES_TYPE_BOOLEAN);
4675 x_default_parameter (f, parms, Qauto_lower, Qnil,
4676 "autoLower", "AutoRaiseLower", RES_TYPE_BOOLEAN);
4677 x_default_parameter (f, parms, Qcursor_type, Qbox,
4678 "cursorType", "CursorType", RES_TYPE_SYMBOL);
4679
4680 /* Dimensions, especially FRAME_LINES (f), must be done via change_frame_size.
4681 Change will not be effected unless different from the current
4682 FRAME_LINES (f). */
4683 width = FRAME_COLS (f);
4684 height = FRAME_LINES (f);
4685 SET_FRAME_COLS (f, 0);
4686 FRAME_LINES (f) = 0;
4687 change_frame_size (f, height, width, 1, 0, 0);
4688
4689 /* Add `tooltip' frame parameter's default value. */
4690 if (NILP (Fframe_parameter (frame, intern ("tooltip"))))
4691 Fmodify_frame_parameters (frame, Fcons (Fcons (intern ("tooltip"), Qt),
4692 Qnil));
4693
4694 /* Set up faces after all frame parameters are known. This call
4695 also merges in face attributes specified for new frames.
4696
4697 Frame parameters may be changed if .Xdefaults contains
4698 specifications for the default font. For example, if there is an
4699 `Emacs.default.attributeBackground: pink', the `background-color'
4700 attribute of the frame get's set, which let's the internal border
4701 of the tooltip frame appear in pink. Prevent this. */
4702 {
4703 Lisp_Object bg = Fframe_parameter (frame, Qbackground_color);
4704
4705 /* Set tip_frame here, so that */
4706 tip_frame = frame;
4707 call1 (Qface_set_after_frame_default, frame);
4708
4709 if (!EQ (bg, Fframe_parameter (frame, Qbackground_color)))
4710 Fmodify_frame_parameters (frame, Fcons (Fcons (Qbackground_color, bg),
4711 Qnil));
4712 }
4713
4714 f->no_split = 1;
4715
4716 UNGCPRO;
4717
4718 /* It is now ok to make the frame official even if we get an error
4719 below. And the frame needs to be on Vframe_list or making it
4720 visible won't work. */
4721 Vframe_list = Fcons (frame, Vframe_list);
4722
4723 /* Now that the frame is official, it counts as a reference to
4724 its display. */
4725 FRAME_X_DISPLAY_INFO (f)->reference_count++;
4726
4727 /* Setting attributes of faces of the tooltip frame from resources
4728 and similar will increment face_change_count, which leads to the
4729 clearing of all current matrices. Since this isn't necessary
4730 here, avoid it by resetting face_change_count to the value it
4731 had before we created the tip frame. */
4732 face_change_count = face_change_count_before;
4733
4734 /* Discard the unwind_protect. */
4735 return unbind_to (count, frame);
4736 }
4737
4738
4739 /* Compute where to display tip frame F. PARMS is the list of frame
4740 parameters for F. DX and DY are specified offsets from the current
4741 location of the mouse. WIDTH and HEIGHT are the width and height
4742 of the tooltip. Return coordinates relative to the root window of
4743 the display in *ROOT_X, and *ROOT_Y. */
4744
4745 static void
4746 compute_tip_xy (f, parms, dx, dy, width, height, root_x, root_y)
4747 struct frame *f;
4748 Lisp_Object parms, dx, dy;
4749 int width, height;
4750 int *root_x, *root_y;
4751 {
4752 Lisp_Object left, top;
4753 int win_x, win_y;
4754 Window root, child;
4755 unsigned pmask;
4756
4757 /* User-specified position? */
4758 left = Fcdr (Fassq (Qleft, parms));
4759 top = Fcdr (Fassq (Qtop, parms));
4760
4761 /* Move the tooltip window where the mouse pointer is. Resize and
4762 show it. */
4763 if (!INTEGERP (left) || !INTEGERP (top))
4764 {
4765 BLOCK_INPUT;
4766 XQueryPointer (FRAME_X_DISPLAY (f), FRAME_X_DISPLAY_INFO (f)->root_window,
4767 &root, &child, root_x, root_y, &win_x, &win_y, &pmask);
4768 UNBLOCK_INPUT;
4769 }
4770
4771 if (INTEGERP (top))
4772 *root_y = XINT (top);
4773 else if (*root_y + XINT (dy) - height < 0)
4774 *root_y -= XINT (dy);
4775 else
4776 {
4777 *root_y -= height;
4778 *root_y += XINT (dy);
4779 }
4780
4781 if (INTEGERP (left))
4782 *root_x = XINT (left);
4783 else if (*root_x + XINT (dx) + width <= FRAME_X_DISPLAY_INFO (f)->width)
4784 /* It fits to the right of the pointer. */
4785 *root_x += XINT (dx);
4786 else if (width + XINT (dx) <= *root_x)
4787 /* It fits to the left of the pointer. */
4788 *root_x -= width + XINT (dx);
4789 else
4790 /* Put it left-justified on the screen--it ought to fit that way. */
4791 *root_x = 0;
4792 }
4793
4794
4795 DEFUN ("x-show-tip", Fx_show_tip, Sx_show_tip, 1, 6, 0,
4796 doc: /* Show STRING in a "tooltip" window on frame FRAME.
4797 A tooltip window is a small X window displaying a string.
4798
4799 FRAME nil or omitted means use the selected frame.
4800
4801 PARMS is an optional list of frame parameters which can be used to
4802 change the tooltip's appearance.
4803
4804 Automatically hide the tooltip after TIMEOUT seconds. TIMEOUT nil
4805 means use the default timeout of 5 seconds.
4806
4807 If the list of frame parameters PARAMS contains a `left' parameters,
4808 the tooltip is displayed at that x-position. Otherwise it is
4809 displayed at the mouse position, with offset DX added (default is 5 if
4810 DX isn't specified). Likewise for the y-position; if a `top' frame
4811 parameter is specified, it determines the y-position of the tooltip
4812 window, otherwise it is displayed at the mouse position, with offset
4813 DY added (default is -10).
4814
4815 A tooltip's maximum size is specified by `x-max-tooltip-size'.
4816 Text larger than the specified size is clipped. */)
4817 (string, frame, parms, timeout, dx, dy)
4818 Lisp_Object string, frame, parms, timeout, dx, dy;
4819 {
4820 struct frame *f;
4821 struct window *w;
4822 int root_x, root_y;
4823 struct buffer *old_buffer;
4824 struct text_pos pos;
4825 int i, width, height;
4826 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
4827 int old_windows_or_buffers_changed = windows_or_buffers_changed;
4828 int count = SPECPDL_INDEX ();
4829
4830 specbind (Qinhibit_redisplay, Qt);
4831
4832 GCPRO4 (string, parms, frame, timeout);
4833
4834 CHECK_STRING (string);
4835 f = check_x_frame (frame);
4836 if (NILP (timeout))
4837 timeout = make_number (5);
4838 else
4839 CHECK_NATNUM (timeout);
4840
4841 if (NILP (dx))
4842 dx = make_number (5);
4843 else
4844 CHECK_NUMBER (dx);
4845
4846 if (NILP (dy))
4847 dy = make_number (-10);
4848 else
4849 CHECK_NUMBER (dy);
4850
4851 if (NILP (last_show_tip_args))
4852 last_show_tip_args = Fmake_vector (make_number (3), Qnil);
4853
4854 if (!NILP (tip_frame))
4855 {
4856 Lisp_Object last_string = AREF (last_show_tip_args, 0);
4857 Lisp_Object last_frame = AREF (last_show_tip_args, 1);
4858 Lisp_Object last_parms = AREF (last_show_tip_args, 2);
4859
4860 if (EQ (frame, last_frame)
4861 && !NILP (Fequal (last_string, string))
4862 && !NILP (Fequal (last_parms, parms)))
4863 {
4864 struct frame *f = XFRAME (tip_frame);
4865
4866 /* Only DX and DY have changed. */
4867 if (!NILP (tip_timer))
4868 {
4869 Lisp_Object timer = tip_timer;
4870 tip_timer = Qnil;
4871 call1 (Qcancel_timer, timer);
4872 }
4873
4874 BLOCK_INPUT;
4875 compute_tip_xy (f, parms, dx, dy, FRAME_PIXEL_WIDTH (f),
4876 FRAME_PIXEL_HEIGHT (f), &root_x, &root_y);
4877 XMoveWindow (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
4878 root_x, root_y);
4879 UNBLOCK_INPUT;
4880 goto start_timer;
4881 }
4882 }
4883
4884 /* Hide a previous tip, if any. */
4885 Fx_hide_tip ();
4886
4887 ASET (last_show_tip_args, 0, string);
4888 ASET (last_show_tip_args, 1, frame);
4889 ASET (last_show_tip_args, 2, parms);
4890
4891 /* Add default values to frame parameters. */
4892 if (NILP (Fassq (Qname, parms)))
4893 parms = Fcons (Fcons (Qname, build_string ("tooltip")), parms);
4894 if (NILP (Fassq (Qinternal_border_width, parms)))
4895 parms = Fcons (Fcons (Qinternal_border_width, make_number (3)), parms);
4896 if (NILP (Fassq (Qborder_width, parms)))
4897 parms = Fcons (Fcons (Qborder_width, make_number (1)), parms);
4898 if (NILP (Fassq (Qborder_color, parms)))
4899 parms = Fcons (Fcons (Qborder_color, build_string ("lightyellow")), parms);
4900 if (NILP (Fassq (Qbackground_color, parms)))
4901 parms = Fcons (Fcons (Qbackground_color, build_string ("lightyellow")),
4902 parms);
4903
4904 /* Create a frame for the tooltip, and record it in the global
4905 variable tip_frame. */
4906 frame = x_create_tip_frame (FRAME_X_DISPLAY_INFO (f), parms, string);
4907 f = XFRAME (frame);
4908
4909 /* Set up the frame's root window. */
4910 w = XWINDOW (FRAME_ROOT_WINDOW (f));
4911 w->left_col = w->top_line = make_number (0);
4912
4913 if (CONSP (Vx_max_tooltip_size)
4914 && INTEGERP (XCAR (Vx_max_tooltip_size))
4915 && XINT (XCAR (Vx_max_tooltip_size)) > 0
4916 && INTEGERP (XCDR (Vx_max_tooltip_size))
4917 && XINT (XCDR (Vx_max_tooltip_size)) > 0)
4918 {
4919 w->total_cols = XCAR (Vx_max_tooltip_size);
4920 w->total_lines = XCDR (Vx_max_tooltip_size);
4921 }
4922 else
4923 {
4924 w->total_cols = make_number (80);
4925 w->total_lines = make_number (40);
4926 }
4927
4928 FRAME_TOTAL_COLS (f) = XINT (w->total_cols);
4929 adjust_glyphs (f);
4930 w->pseudo_window_p = 1;
4931
4932 /* Display the tooltip text in a temporary buffer. */
4933 old_buffer = current_buffer;
4934 set_buffer_internal_1 (XBUFFER (XWINDOW (FRAME_ROOT_WINDOW (f))->buffer));
4935 current_buffer->truncate_lines = Qnil;
4936 clear_glyph_matrix (w->desired_matrix);
4937 clear_glyph_matrix (w->current_matrix);
4938 SET_TEXT_POS (pos, BEGV, BEGV_BYTE);
4939 try_window (FRAME_ROOT_WINDOW (f), pos);
4940
4941 /* Compute width and height of the tooltip. */
4942 width = height = 0;
4943 for (i = 0; i < w->desired_matrix->nrows; ++i)
4944 {
4945 struct glyph_row *row = &w->desired_matrix->rows[i];
4946 struct glyph *last;
4947 int row_width;
4948
4949 /* Stop at the first empty row at the end. */
4950 if (!row->enabled_p || !row->displays_text_p)
4951 break;
4952
4953 /* Let the row go over the full width of the frame. */
4954 row->full_width_p = 1;
4955
4956 /* There's a glyph at the end of rows that is used to place
4957 the cursor there. Don't include the width of this glyph. */
4958 if (row->used[TEXT_AREA])
4959 {
4960 last = &row->glyphs[TEXT_AREA][row->used[TEXT_AREA] - 1];
4961 row_width = row->pixel_width - last->pixel_width;
4962 }
4963 else
4964 row_width = row->pixel_width;
4965
4966 height += row->height;
4967 width = max (width, row_width);
4968 }
4969
4970 /* Add the frame's internal border to the width and height the X
4971 window should have. */
4972 height += 2 * FRAME_INTERNAL_BORDER_WIDTH (f);
4973 width += 2 * FRAME_INTERNAL_BORDER_WIDTH (f);
4974
4975 /* Move the tooltip window where the mouse pointer is. Resize and
4976 show it. */
4977 compute_tip_xy (f, parms, dx, dy, width, height, &root_x, &root_y);
4978
4979 BLOCK_INPUT;
4980 XMoveResizeWindow (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
4981 root_x, root_y, width, height);
4982 XMapRaised (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f));
4983 UNBLOCK_INPUT;
4984
4985 /* Draw into the window. */
4986 w->must_be_updated_p = 1;
4987 update_single_window (w, 1);
4988
4989 /* Restore original current buffer. */
4990 set_buffer_internal_1 (old_buffer);
4991 windows_or_buffers_changed = old_windows_or_buffers_changed;
4992
4993 start_timer:
4994 /* Let the tip disappear after timeout seconds. */
4995 tip_timer = call3 (intern ("run-at-time"), timeout, Qnil,
4996 intern ("x-hide-tip"));
4997
4998 UNGCPRO;
4999 return unbind_to (count, Qnil);
5000 }
5001
5002
5003 DEFUN ("x-hide-tip", Fx_hide_tip, Sx_hide_tip, 0, 0, 0,
5004 doc: /* Hide the current tooltip window, if there is any.
5005 Value is t if tooltip was open, nil otherwise. */)
5006 ()
5007 {
5008 int count;
5009 Lisp_Object deleted, frame, timer;
5010 struct gcpro gcpro1, gcpro2;
5011
5012 /* Return quickly if nothing to do. */
5013 if (NILP (tip_timer) && NILP (tip_frame))
5014 return Qnil;
5015
5016 frame = tip_frame;
5017 timer = tip_timer;
5018 GCPRO2 (frame, timer);
5019 tip_frame = tip_timer = deleted = Qnil;
5020
5021 count = SPECPDL_INDEX ();
5022 specbind (Qinhibit_redisplay, Qt);
5023 specbind (Qinhibit_quit, Qt);
5024
5025 if (!NILP (timer))
5026 call1 (Qcancel_timer, timer);
5027
5028 if (FRAMEP (frame))
5029 {
5030 Fdelete_frame (frame, Qnil);
5031 deleted = Qt;
5032
5033 #ifdef USE_LUCID
5034 /* Bloodcurdling hack alert: The Lucid menu bar widget's
5035 redisplay procedure is not called when a tip frame over menu
5036 items is unmapped. Redisplay the menu manually... */
5037 {
5038 struct frame *f = SELECTED_FRAME ();
5039 Widget w = f->output_data.x->menubar_widget;
5040 extern void xlwmenu_redisplay P_ ((Widget));
5041
5042 if (!DoesSaveUnders (FRAME_X_DISPLAY_INFO (f)->screen)
5043 && w != NULL)
5044 {
5045 BLOCK_INPUT;
5046 xlwmenu_redisplay (w);
5047 UNBLOCK_INPUT;
5048 }
5049 }
5050 #endif /* USE_LUCID */
5051 }
5052
5053 UNGCPRO;
5054 return unbind_to (count, deleted);
5055 }
5056
5057
5058 \f
5059 /***********************************************************************
5060 File selection dialog
5061 ***********************************************************************/
5062
5063 #ifdef USE_MOTIF
5064
5065 /* Callback for "OK" and "Cancel" on file selection dialog. */
5066
5067 static void
5068 file_dialog_cb (widget, client_data, call_data)
5069 Widget widget;
5070 XtPointer call_data, client_data;
5071 {
5072 int *result = (int *) client_data;
5073 XmAnyCallbackStruct *cb = (XmAnyCallbackStruct *) call_data;
5074 *result = cb->reason;
5075 }
5076
5077
5078 /* Callback for unmapping a file selection dialog. This is used to
5079 capture the case where a dialog is closed via a window manager's
5080 closer button, for example. Using a XmNdestroyCallback didn't work
5081 in this case. */
5082
5083 static void
5084 file_dialog_unmap_cb (widget, client_data, call_data)
5085 Widget widget;
5086 XtPointer call_data, client_data;
5087 {
5088 int *result = (int *) client_data;
5089 *result = XmCR_CANCEL;
5090 }
5091
5092 static Lisp_Object
5093 clean_up_file_dialog (arg)
5094 Lisp_Object arg;
5095 {
5096 struct Lisp_Save_Value *p = XSAVE_VALUE (arg);
5097 Widget dialog = (Widget) p->pointer;
5098
5099 /* Clean up. */
5100 BLOCK_INPUT;
5101 XtUnmanageChild (dialog);
5102 XtDestroyWidget (dialog);
5103 x_menu_set_in_use (0);
5104 UNBLOCK_INPUT;
5105
5106 return Qnil;
5107 }
5108
5109
5110 DEFUN ("x-file-dialog", Fx_file_dialog, Sx_file_dialog, 2, 5, 0,
5111 doc: /* Read file name, prompting with PROMPT in directory DIR.
5112 Use a file selection dialog. Select DEFAULT-FILENAME in the dialog's file
5113 selection box, if specified. If MUSTMATCH is non-nil, the returned file
5114 or directory must exist. ONLY-DIR-P is ignored." */)
5115 (prompt, dir, default_filename, mustmatch, only_dir_p)
5116 Lisp_Object prompt, dir, default_filename, mustmatch, only_dir_p;
5117 {
5118 int result;
5119 struct frame *f = SELECTED_FRAME ();
5120 Lisp_Object file = Qnil;
5121 Widget dialog, text, help;
5122 Arg al[10];
5123 int ac = 0;
5124 extern XtAppContext Xt_app_con;
5125 XmString dir_xmstring, pattern_xmstring;
5126 int count = SPECPDL_INDEX ();
5127 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5, gcpro6;
5128
5129 GCPRO6 (prompt, dir, default_filename, mustmatch, only_dir_p, file);
5130
5131 if (popup_activated ())
5132 error ("Trying to use a menu from within a menu-entry");
5133
5134 CHECK_STRING (prompt);
5135 CHECK_STRING (dir);
5136
5137 /* Prevent redisplay. */
5138 specbind (Qinhibit_redisplay, Qt);
5139
5140 BLOCK_INPUT;
5141
5142 /* Create the dialog with PROMPT as title, using DIR as initial
5143 directory and using "*" as pattern. */
5144 dir = Fexpand_file_name (dir, Qnil);
5145 dir_xmstring = XmStringCreateLocalized (SDATA (dir));
5146 pattern_xmstring = XmStringCreateLocalized ("*");
5147
5148 XtSetArg (al[ac], XmNtitle, SDATA (prompt)); ++ac;
5149 XtSetArg (al[ac], XmNdirectory, dir_xmstring); ++ac;
5150 XtSetArg (al[ac], XmNpattern, pattern_xmstring); ++ac;
5151 XtSetArg (al[ac], XmNresizePolicy, XmRESIZE_GROW); ++ac;
5152 XtSetArg (al[ac], XmNdialogStyle, XmDIALOG_APPLICATION_MODAL); ++ac;
5153 dialog = XmCreateFileSelectionDialog (f->output_data.x->widget,
5154 "fsb", al, ac);
5155 XmStringFree (dir_xmstring);
5156 XmStringFree (pattern_xmstring);
5157
5158 /* Add callbacks for OK and Cancel. */
5159 XtAddCallback (dialog, XmNokCallback, file_dialog_cb,
5160 (XtPointer) &result);
5161 XtAddCallback (dialog, XmNcancelCallback, file_dialog_cb,
5162 (XtPointer) &result);
5163 XtAddCallback (dialog, XmNunmapCallback, file_dialog_unmap_cb,
5164 (XtPointer) &result);
5165
5166 /* Remove the help button since we can't display help. */
5167 help = XmFileSelectionBoxGetChild (dialog, XmDIALOG_HELP_BUTTON);
5168 XtUnmanageChild (help);
5169
5170 /* Mark OK button as default. */
5171 XtVaSetValues (XmFileSelectionBoxGetChild (dialog, XmDIALOG_OK_BUTTON),
5172 XmNshowAsDefault, True, NULL);
5173
5174 /* If MUSTMATCH is non-nil, disable the file entry field of the
5175 dialog, so that the user must select a file from the files list
5176 box. We can't remove it because we wouldn't have a way to get at
5177 the result file name, then. */
5178 text = XmFileSelectionBoxGetChild (dialog, XmDIALOG_TEXT);
5179 if (!NILP (mustmatch))
5180 {
5181 Widget label;
5182 label = XmFileSelectionBoxGetChild (dialog, XmDIALOG_SELECTION_LABEL);
5183 XtSetSensitive (text, False);
5184 XtSetSensitive (label, False);
5185 }
5186
5187 /* Manage the dialog, so that list boxes get filled. */
5188 XtManageChild (dialog);
5189
5190 if (STRINGP (default_filename))
5191 {
5192 XmString default_xmstring;
5193 Widget wtext = XmFileSelectionBoxGetChild (dialog, XmDIALOG_TEXT);
5194 Widget list = XmFileSelectionBoxGetChild (dialog, XmDIALOG_LIST);
5195
5196 XmTextPosition last_pos = XmTextFieldGetLastPosition (wtext);
5197 XmTextFieldReplace (wtext, 0, last_pos,
5198 (SDATA (Ffile_name_nondirectory (default_filename))));
5199
5200 /* Select DEFAULT_FILENAME in the files list box. DEFAULT_FILENAME
5201 must include the path for this to work. */
5202
5203 default_xmstring = XmStringCreateLocalized (SDATA (default_filename));
5204
5205 if (XmListItemExists (list, default_xmstring))
5206 {
5207 int item_pos = XmListItemPos (list, default_xmstring);
5208 /* Select the item and scroll it into view. */
5209 XmListSelectPos (list, item_pos, True);
5210 XmListSetPos (list, item_pos);
5211 }
5212
5213 XmStringFree (default_xmstring);
5214 }
5215
5216 record_unwind_protect (clean_up_file_dialog, make_save_value (dialog, 0));
5217
5218 /* Process events until the user presses Cancel or OK. */
5219 x_menu_set_in_use (1);
5220 result = 0;
5221 while (result == 0)
5222 {
5223 XEvent event;
5224 x_menu_wait_for_event (0);
5225 XtAppNextEvent (Xt_app_con, &event);
5226 (void) x_dispatch_event (&event, FRAME_X_DISPLAY (f));
5227 }
5228
5229 /* Get the result. */
5230 if (result == XmCR_OK)
5231 {
5232 XmString text;
5233 String data;
5234
5235 XtVaGetValues (dialog, XmNtextString, &text, NULL);
5236 XmStringGetLtoR (text, XmFONTLIST_DEFAULT_TAG, &data);
5237 XmStringFree (text);
5238 file = build_string (data);
5239 XtFree (data);
5240 }
5241 else
5242 file = Qnil;
5243
5244 UNBLOCK_INPUT;
5245 UNGCPRO;
5246
5247 /* Make "Cancel" equivalent to C-g. */
5248 if (NILP (file))
5249 Fsignal (Qquit, Qnil);
5250
5251 return unbind_to (count, file);
5252 }
5253
5254 #endif /* USE_MOTIF */
5255
5256 #ifdef USE_GTK
5257
5258 static Lisp_Object
5259 clean_up_dialog (arg)
5260 Lisp_Object arg;
5261 {
5262 x_menu_set_in_use (0);
5263
5264 return Qnil;
5265 }
5266
5267 DEFUN ("x-file-dialog", Fx_file_dialog, Sx_file_dialog, 2, 5, 0,
5268 doc: /* Read file name, prompting with PROMPT in directory DIR.
5269 Use a file selection dialog. Select DEFAULT-FILENAME in the dialog's file
5270 selection box, if specified. If MUSTMATCH is non-nil, the returned file
5271 or directory must exist. If ONLY-DIR-P is non-nil, the user can only select
5272 directories. */)
5273 (prompt, dir, default_filename, mustmatch, only_dir_p)
5274 Lisp_Object prompt, dir, default_filename, mustmatch, only_dir_p;
5275 {
5276 FRAME_PTR f = SELECTED_FRAME ();
5277 char *fn;
5278 Lisp_Object file = Qnil;
5279 int count = SPECPDL_INDEX ();
5280 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5, gcpro6;
5281 char *cdef_file;
5282
5283 GCPRO6 (prompt, dir, default_filename, mustmatch, only_dir_p, file);
5284
5285 if (popup_activated ())
5286 error ("Trying to use a menu from within a menu-entry");
5287
5288 CHECK_STRING (prompt);
5289 CHECK_STRING (dir);
5290
5291 /* Prevent redisplay. */
5292 specbind (Qinhibit_redisplay, Qt);
5293 record_unwind_protect (clean_up_dialog, Qnil);
5294
5295 BLOCK_INPUT;
5296
5297 if (STRINGP (default_filename))
5298 cdef_file = SDATA (default_filename);
5299 else
5300 cdef_file = SDATA (dir);
5301
5302 fn = xg_get_file_name (f, SDATA (prompt), cdef_file,
5303 ! NILP (mustmatch),
5304 ! NILP (only_dir_p));
5305
5306 if (fn)
5307 {
5308 file = build_string (fn);
5309 xfree (fn);
5310 }
5311
5312 UNBLOCK_INPUT;
5313 UNGCPRO;
5314
5315 /* Make "Cancel" equivalent to C-g. */
5316 if (NILP (file))
5317 Fsignal (Qquit, Qnil);
5318
5319 return unbind_to (count, file);
5320 }
5321
5322 #endif /* USE_GTK */
5323
5324 \f
5325 /***********************************************************************
5326 Keyboard
5327 ***********************************************************************/
5328
5329 #ifdef HAVE_XKBGETKEYBOARD
5330 #include <X11/XKBlib.h>
5331 #include <X11/keysym.h>
5332 #endif
5333
5334 DEFUN ("x-backspace-delete-keys-p", Fx_backspace_delete_keys_p,
5335 Sx_backspace_delete_keys_p, 0, 1, 0,
5336 doc: /* Check if both Backspace and Delete keys are on the keyboard of FRAME.
5337 FRAME nil means use the selected frame.
5338 Value is t if we know that both keys are present, and are mapped to the
5339 usual X keysyms. */)
5340 (frame)
5341 Lisp_Object frame;
5342 {
5343 #ifdef HAVE_XKBGETKEYBOARD
5344 XkbDescPtr kb;
5345 struct frame *f = check_x_frame (frame);
5346 Display *dpy = FRAME_X_DISPLAY (f);
5347 Lisp_Object have_keys;
5348 int major, minor, op, event, error;
5349
5350 BLOCK_INPUT;
5351
5352 /* Check library version in case we're dynamically linked. */
5353 major = XkbMajorVersion;
5354 minor = XkbMinorVersion;
5355 if (!XkbLibraryVersion (&major, &minor))
5356 {
5357 UNBLOCK_INPUT;
5358 return Qnil;
5359 }
5360
5361 /* Check that the server supports XKB. */
5362 major = XkbMajorVersion;
5363 minor = XkbMinorVersion;
5364 if (!XkbQueryExtension (dpy, &op, &event, &error, &major, &minor))
5365 {
5366 UNBLOCK_INPUT;
5367 return Qnil;
5368 }
5369
5370 have_keys = Qnil;
5371 kb = XkbGetMap (dpy, XkbAllMapComponentsMask, XkbUseCoreKbd);
5372 if (kb)
5373 {
5374 int delete_keycode = 0, backspace_keycode = 0, i;
5375
5376 if (XkbGetNames (dpy, XkbAllNamesMask, kb) == Success)
5377 {
5378 for (i = kb->min_key_code;
5379 (i < kb->max_key_code
5380 && (delete_keycode == 0 || backspace_keycode == 0));
5381 ++i)
5382 {
5383 /* The XKB symbolic key names can be seen most easily in
5384 the PS file generated by `xkbprint -label name
5385 $DISPLAY'. */
5386 if (bcmp ("DELE", kb->names->keys[i].name, 4) == 0)
5387 delete_keycode = i;
5388 else if (bcmp ("BKSP", kb->names->keys[i].name, 4) == 0)
5389 backspace_keycode = i;
5390 }
5391
5392 XkbFreeNames (kb, 0, True);
5393 }
5394
5395 XkbFreeClientMap (kb, 0, True);
5396
5397 if (delete_keycode
5398 && backspace_keycode
5399 && XKeysymToKeycode (dpy, XK_Delete) == delete_keycode
5400 && XKeysymToKeycode (dpy, XK_BackSpace) == backspace_keycode)
5401 have_keys = Qt;
5402 }
5403 UNBLOCK_INPUT;
5404 return have_keys;
5405 #else /* not HAVE_XKBGETKEYBOARD */
5406 return Qnil;
5407 #endif /* not HAVE_XKBGETKEYBOARD */
5408 }
5409
5410
5411 \f
5412 /***********************************************************************
5413 Initialization
5414 ***********************************************************************/
5415
5416 /* Keep this list in the same order as frame_parms in frame.c.
5417 Use 0 for unsupported frame parameters. */
5418
5419 frame_parm_handler x_frame_parm_handlers[] =
5420 {
5421 x_set_autoraise,
5422 x_set_autolower,
5423 x_set_background_color,
5424 x_set_border_color,
5425 x_set_border_width,
5426 x_set_cursor_color,
5427 x_set_cursor_type,
5428 x_set_font,
5429 x_set_foreground_color,
5430 x_set_icon_name,
5431 x_set_icon_type,
5432 x_set_internal_border_width,
5433 x_set_menu_bar_lines,
5434 x_set_mouse_color,
5435 x_explicitly_set_name,
5436 x_set_scroll_bar_width,
5437 x_set_title,
5438 x_set_unsplittable,
5439 x_set_vertical_scroll_bars,
5440 x_set_visibility,
5441 x_set_tool_bar_lines,
5442 x_set_scroll_bar_foreground,
5443 x_set_scroll_bar_background,
5444 x_set_screen_gamma,
5445 x_set_line_spacing,
5446 x_set_fringe_width,
5447 x_set_fringe_width,
5448 x_set_wait_for_wm,
5449 x_set_fullscreen,
5450 };
5451
5452 void
5453 syms_of_xfns ()
5454 {
5455 /* This is zero if not using X windows. */
5456 x_in_use = 0;
5457
5458 /* The section below is built by the lisp expression at the top of the file,
5459 just above where these variables are declared. */
5460 /*&&& init symbols here &&&*/
5461 Qnone = intern ("none");
5462 staticpro (&Qnone);
5463 Qsuppress_icon = intern ("suppress-icon");
5464 staticpro (&Qsuppress_icon);
5465 Qundefined_color = intern ("undefined-color");
5466 staticpro (&Qundefined_color);
5467 Qcompound_text = intern ("compound-text");
5468 staticpro (&Qcompound_text);
5469 Qcancel_timer = intern ("cancel-timer");
5470 staticpro (&Qcancel_timer);
5471 /* This is the end of symbol initialization. */
5472
5473 /* Text property `display' should be nonsticky by default. */
5474 Vtext_property_default_nonsticky
5475 = Fcons (Fcons (Qdisplay, Qt), Vtext_property_default_nonsticky);
5476
5477
5478 Fput (Qundefined_color, Qerror_conditions,
5479 Fcons (Qundefined_color, Fcons (Qerror, Qnil)));
5480 Fput (Qundefined_color, Qerror_message,
5481 build_string ("Undefined color"));
5482
5483 DEFVAR_LISP ("x-pointer-shape", &Vx_pointer_shape,
5484 doc: /* The shape of the pointer when over text.
5485 Changing the value does not affect existing frames
5486 unless you set the mouse color. */);
5487 Vx_pointer_shape = Qnil;
5488
5489 #if 0 /* This doesn't really do anything. */
5490 DEFVAR_LISP ("x-nontext-pointer-shape", &Vx_nontext_pointer_shape,
5491 doc: /* The shape of the pointer when not over text.
5492 This variable takes effect when you create a new frame
5493 or when you set the mouse color. */);
5494 #endif
5495 Vx_nontext_pointer_shape = Qnil;
5496
5497 DEFVAR_LISP ("x-hourglass-pointer-shape", &Vx_hourglass_pointer_shape,
5498 doc: /* The shape of the pointer when Emacs is busy.
5499 This variable takes effect when you create a new frame
5500 or when you set the mouse color. */);
5501 Vx_hourglass_pointer_shape = Qnil;
5502
5503 DEFVAR_BOOL ("display-hourglass", &display_hourglass_p,
5504 doc: /* Non-zero means Emacs displays an hourglass pointer on window systems. */);
5505 display_hourglass_p = 1;
5506
5507 DEFVAR_LISP ("hourglass-delay", &Vhourglass_delay,
5508 doc: /* *Seconds to wait before displaying an hourglass pointer.
5509 Value must be an integer or float. */);
5510 Vhourglass_delay = make_number (DEFAULT_HOURGLASS_DELAY);
5511
5512 #if 0 /* This doesn't really do anything. */
5513 DEFVAR_LISP ("x-mode-pointer-shape", &Vx_mode_pointer_shape,
5514 doc: /* The shape of the pointer when over the mode line.
5515 This variable takes effect when you create a new frame
5516 or when you set the mouse color. */);
5517 #endif
5518 Vx_mode_pointer_shape = Qnil;
5519
5520 DEFVAR_LISP ("x-sensitive-text-pointer-shape",
5521 &Vx_sensitive_text_pointer_shape,
5522 doc: /* The shape of the pointer when over mouse-sensitive text.
5523 This variable takes effect when you create a new frame
5524 or when you set the mouse color. */);
5525 Vx_sensitive_text_pointer_shape = Qnil;
5526
5527 DEFVAR_LISP ("x-window-horizontal-drag-cursor",
5528 &Vx_window_horizontal_drag_shape,
5529 doc: /* Pointer shape to use for indicating a window can be dragged horizontally.
5530 This variable takes effect when you create a new frame
5531 or when you set the mouse color. */);
5532 Vx_window_horizontal_drag_shape = Qnil;
5533
5534 DEFVAR_LISP ("x-cursor-fore-pixel", &Vx_cursor_fore_pixel,
5535 doc: /* A string indicating the foreground color of the cursor box. */);
5536 Vx_cursor_fore_pixel = Qnil;
5537
5538 DEFVAR_LISP ("x-max-tooltip-size", &Vx_max_tooltip_size,
5539 doc: /* Maximum size for tooltips. Value is a pair (COLUMNS . ROWS).
5540 Text larger than this is clipped. */);
5541 Vx_max_tooltip_size = Fcons (make_number (80), make_number (40));
5542
5543 DEFVAR_LISP ("x-no-window-manager", &Vx_no_window_manager,
5544 doc: /* Non-nil if no X window manager is in use.
5545 Emacs doesn't try to figure this out; this is always nil
5546 unless you set it to something else. */);
5547 /* We don't have any way to find this out, so set it to nil
5548 and maybe the user would like to set it to t. */
5549 Vx_no_window_manager = Qnil;
5550
5551 DEFVAR_LISP ("x-pixel-size-width-font-regexp",
5552 &Vx_pixel_size_width_font_regexp,
5553 doc: /* Regexp matching a font name whose width is the same as `PIXEL_SIZE'.
5554
5555 Since Emacs gets width of a font matching with this regexp from
5556 PIXEL_SIZE field of the name, font finding mechanism gets faster for
5557 such a font. This is especially effective for such large fonts as
5558 Chinese, Japanese, and Korean. */);
5559 Vx_pixel_size_width_font_regexp = Qnil;
5560
5561 #ifdef USE_X_TOOLKIT
5562 Fprovide (intern ("x-toolkit"), Qnil);
5563 #ifdef USE_MOTIF
5564 Fprovide (intern ("motif"), Qnil);
5565
5566 DEFVAR_LISP ("motif-version-string", &Vmotif_version_string,
5567 doc: /* Version info for LessTif/Motif. */);
5568 Vmotif_version_string = build_string (XmVERSION_STRING);
5569 #endif /* USE_MOTIF */
5570 #endif /* USE_X_TOOLKIT */
5571
5572 #ifdef USE_GTK
5573 /* Provide x-toolkit also for GTK. Internally GTK does not use Xt so it
5574 is not an X toolkit in that sense (USE_X_TOOLKIT is not defined).
5575 But for a user it is a toolkit for X, and indeed, configure
5576 accepts --with-x-toolkit=gtk. */
5577 Fprovide (intern ("x-toolkit"), Qnil);
5578 Fprovide (intern ("gtk"), Qnil);
5579
5580 #ifdef HAVE_GTK_FILE_BOTH
5581 DEFVAR_BOOL ("use-old-gtk-file-dialog", &use_old_gtk_file_dialog,
5582 doc: /* *Non-nil means that the old GTK file selection dialog is used.
5583 If nil the new GTK file chooser is used instead. To turn off
5584 all file dialogs set the variable `use-file-dialog'. */);
5585 use_old_gtk_file_dialog = 0;
5586 #endif
5587
5588 DEFVAR_LISP ("gtk-version-string", &Vgtk_version_string,
5589 doc: /* Version info for GTK+. */);
5590 {
5591 char gtk_version[40];
5592 g_snprintf (gtk_version, sizeof (gtk_version), "%u.%u.%u",
5593 GTK_MAJOR_VERSION, GTK_MINOR_VERSION, GTK_MICRO_VERSION);
5594 Vgtk_version_string = build_string (gtk_version);
5595 }
5596 #endif /* USE_GTK */
5597
5598 /* X window properties. */
5599 defsubr (&Sx_change_window_property);
5600 defsubr (&Sx_delete_window_property);
5601 defsubr (&Sx_window_property);
5602
5603 defsubr (&Sxw_display_color_p);
5604 defsubr (&Sx_display_grayscale_p);
5605 defsubr (&Sxw_color_defined_p);
5606 defsubr (&Sxw_color_values);
5607 defsubr (&Sx_server_max_request_size);
5608 defsubr (&Sx_server_vendor);
5609 defsubr (&Sx_server_version);
5610 defsubr (&Sx_display_pixel_width);
5611 defsubr (&Sx_display_pixel_height);
5612 defsubr (&Sx_display_mm_width);
5613 defsubr (&Sx_display_mm_height);
5614 defsubr (&Sx_display_screens);
5615 defsubr (&Sx_display_planes);
5616 defsubr (&Sx_display_color_cells);
5617 defsubr (&Sx_display_visual_class);
5618 defsubr (&Sx_display_backing_store);
5619 defsubr (&Sx_display_save_under);
5620 defsubr (&Sx_create_frame);
5621 defsubr (&Sx_open_connection);
5622 defsubr (&Sx_close_connection);
5623 defsubr (&Sx_display_list);
5624 defsubr (&Sx_synchronize);
5625 defsubr (&Sx_focus_frame);
5626 defsubr (&Sx_backspace_delete_keys_p);
5627
5628 /* Setting callback functions for fontset handler. */
5629 get_font_info_func = x_get_font_info;
5630
5631 #if 0 /* This function pointer doesn't seem to be used anywhere.
5632 And the pointer assigned has the wrong type, anyway. */
5633 list_fonts_func = x_list_fonts;
5634 #endif
5635
5636 load_font_func = x_load_font;
5637 find_ccl_program_func = x_find_ccl_program;
5638 query_font_func = x_query_font;
5639 set_frame_fontset_func = x_set_font;
5640 get_font_repertory_func = x_get_font_repertory;
5641 check_window_system_func = check_x;
5642
5643 hourglass_atimer = NULL;
5644 hourglass_shown_p = 0;
5645
5646 defsubr (&Sx_show_tip);
5647 defsubr (&Sx_hide_tip);
5648 tip_timer = Qnil;
5649 staticpro (&tip_timer);
5650 tip_frame = Qnil;
5651 staticpro (&tip_frame);
5652
5653 last_show_tip_args = Qnil;
5654 staticpro (&last_show_tip_args);
5655
5656 #if defined (USE_MOTIF) || defined (USE_GTK)
5657 defsubr (&Sx_file_dialog);
5658 #endif
5659 }
5660
5661 #endif /* HAVE_X_WINDOWS */
5662
5663 /* arch-tag: 55040d02-5485-4d58-8b22-95a7a05f3288
5664 (do not change this comment) */