(Fx_create_frame): Delete excess args to x_wm_set_size_hint.
[bpt/emacs.git] / src / xfns.c
1 /* Functions for the X window system.
2 Copyright (C) 1989, 1992, 1993 Free Software Foundation.
3
4 This file is part of GNU Emacs.
5
6 GNU Emacs is free software; you can redistribute it and/or modify
7 it under the terms of the GNU General Public License as published by
8 the Free Software Foundation; either version 2, or (at your option)
9 any later version.
10
11 GNU Emacs is distributed in the hope that it will be useful,
12 but WITHOUT ANY WARRANTY; without even the implied warranty of
13 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14 GNU General Public License for more details.
15
16 You should have received a copy of the GNU General Public License
17 along with GNU Emacs; see the file COPYING. If not, write to
18 the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. */
19
20 /* Completely rewritten by Richard Stallman. */
21
22 /* Rewritten for X11 by Joseph Arceneaux */
23
24 #if 0
25 #include <stdio.h>
26 #endif
27 #include <signal.h>
28 #include <config.h>
29 #include "lisp.h"
30 #include "xterm.h"
31 #include "frame.h"
32 #include "window.h"
33 #include "buffer.h"
34 #include "dispextern.h"
35 #include "keyboard.h"
36 #include "blockinput.h"
37
38 #ifdef HAVE_X_WINDOWS
39 extern void abort ();
40
41 #ifndef VMS
42 #if 1 /* Used to be #ifdef EMACS_BITMAP_FILES, but this should always work. */
43 #include "bitmaps/gray.xbm"
44 #else
45 #include <X11/bitmaps/gray>
46 #endif
47 #else
48 #include "[.bitmaps]gray.xbm"
49 #endif
50
51 #ifdef USE_X_TOOLKIT
52 #include <X11/Shell.h>
53
54 #include <X11/Xaw/Paned.h>
55 #include <X11/Xaw/Label.h>
56
57 #ifdef USG
58 #undef USG /* ####KLUDGE for Solaris 2.2 and up */
59 #include <X11/Xos.h>
60 #define USG
61 #else
62 #include <X11/Xos.h>
63 #endif
64
65 #include "widget.h"
66
67 #include "../lwlib/lwlib.h"
68
69 /* The one and only application context associated with the connection
70 to the one and only X display that Emacs uses. */
71 XtAppContext Xt_app_con;
72
73 /* The one and only application shell. Emacs screens are popup shells of this
74 application. */
75 Widget Xt_app_shell;
76
77 extern void free_frame_menubar ();
78 extern void free_frame_menubar ();
79 #endif /* USE_X_TOOLKIT */
80
81 #define min(a,b) ((a) < (b) ? (a) : (b))
82 #define max(a,b) ((a) > (b) ? (a) : (b))
83
84 #ifdef HAVE_X11
85 /* X Resource data base */
86 static XrmDatabase xrdb;
87
88 /* The class of this X application. */
89 #define EMACS_CLASS "Emacs"
90
91 #ifdef HAVE_X11R4
92 #define MAXREQUEST(dpy) (XMaxRequestSize (dpy))
93 #else
94 #define MAXREQUEST(dpy) ((dpy)->max_request_size)
95 #endif
96
97 /* The name we're using in resource queries. */
98 Lisp_Object Vx_resource_name;
99
100 /* Title name and application name for X stuff. */
101 extern char *x_id_name;
102
103 /* The background and shape of the mouse pointer, and shape when not
104 over text or in the modeline. */
105 Lisp_Object Vx_pointer_shape, Vx_nontext_pointer_shape, Vx_mode_pointer_shape;
106 Lisp_Object Vx_cross_pointer_shape;
107
108 /* Color of chars displayed in cursor box. */
109 Lisp_Object Vx_cursor_fore_pixel;
110
111 /* The screen being used. */
112 static Screen *x_screen;
113
114 /* The X Visual we are using for X windows (the default) */
115 Visual *screen_visual;
116
117 /* Height of this X screen in pixels. */
118 int x_screen_height;
119
120 /* Width of this X screen in pixels. */
121 int x_screen_width;
122
123 /* Number of planes for this screen. */
124 int x_screen_planes;
125
126 /* Non nil if no window manager is in use. */
127 Lisp_Object Vx_no_window_manager;
128
129 /* `t' if a mouse button is depressed. */
130
131 Lisp_Object Vmouse_depressed;
132
133 extern unsigned int x_mouse_x, x_mouse_y, x_mouse_grabbed;
134
135 /* Atom for indicating window state to the window manager. */
136 extern Atom Xatom_wm_change_state;
137
138 /* Communication with window managers. */
139 extern Atom Xatom_wm_protocols;
140
141 /* Kinds of protocol things we may receive. */
142 extern Atom Xatom_wm_take_focus;
143 extern Atom Xatom_wm_save_yourself;
144 extern Atom Xatom_wm_delete_window;
145
146 /* Other WM communication */
147 extern Atom Xatom_wm_configure_denied; /* When our config request is denied */
148 extern Atom Xatom_wm_window_moved; /* When the WM moves us. */
149
150 #else /* X10 */
151
152 /* Default size of an Emacs window. */
153 static char *default_window = "=80x24+0+0";
154
155 #define MAXICID 80
156 char iconidentity[MAXICID];
157 #define ICONTAG "emacs@"
158 char minibuffer_iconidentity[MAXICID];
159 #define MINIBUFFER_ICONTAG "minibuffer@"
160
161 #endif /* X10 */
162
163 /* The last 23 bits of the timestamp of the last mouse button event. */
164 Time mouse_timestamp;
165
166 /* Evaluate this expression to rebuild the section of syms_of_xfns
167 that initializes and staticpros the symbols declared below. Note
168 that Emacs 18 has a bug that keeps C-x C-e from being able to
169 evaluate this expression.
170
171 (progn
172 ;; Accumulate a list of the symbols we want to initialize from the
173 ;; declarations at the top of the file.
174 (goto-char (point-min))
175 (search-forward "/\*&&& symbols declared here &&&*\/\n")
176 (let (symbol-list)
177 (while (looking-at "Lisp_Object \\(Q[a-z_]+\\)")
178 (setq symbol-list
179 (cons (buffer-substring (match-beginning 1) (match-end 1))
180 symbol-list))
181 (forward-line 1))
182 (setq symbol-list (nreverse symbol-list))
183 ;; Delete the section of syms_of_... where we initialize the symbols.
184 (search-forward "\n /\*&&& init symbols here &&&*\/\n")
185 (let ((start (point)))
186 (while (looking-at "^ Q")
187 (forward-line 2))
188 (kill-region start (point)))
189 ;; Write a new symbol initialization section.
190 (while symbol-list
191 (insert (format " %s = intern (\"" (car symbol-list)))
192 (let ((start (point)))
193 (insert (substring (car symbol-list) 1))
194 (subst-char-in-region start (point) ?_ ?-))
195 (insert (format "\");\n staticpro (&%s);\n" (car symbol-list)))
196 (setq symbol-list (cdr symbol-list)))))
197
198 */
199
200 /*&&& symbols declared here &&&*/
201 Lisp_Object Qauto_raise;
202 Lisp_Object Qauto_lower;
203 Lisp_Object Qbackground_color;
204 Lisp_Object Qbar;
205 Lisp_Object Qborder_color;
206 Lisp_Object Qborder_width;
207 Lisp_Object Qbox;
208 Lisp_Object Qcursor_color;
209 Lisp_Object Qcursor_type;
210 Lisp_Object Qfont;
211 Lisp_Object Qforeground_color;
212 Lisp_Object Qgeometry;
213 /* Lisp_Object Qicon; */
214 Lisp_Object Qicon_left;
215 Lisp_Object Qicon_top;
216 Lisp_Object Qicon_type;
217 Lisp_Object Qinternal_border_width;
218 Lisp_Object Qleft;
219 Lisp_Object Qmouse_color;
220 Lisp_Object Qnone;
221 Lisp_Object Qparent_id;
222 Lisp_Object Qsuppress_icon;
223 Lisp_Object Qtop;
224 Lisp_Object Qundefined_color;
225 Lisp_Object Qvertical_scroll_bars;
226 Lisp_Object Qvisibility;
227 Lisp_Object Qwindow_id;
228 Lisp_Object Qx_frame_parameter;
229 Lisp_Object Qx_resource_name;
230
231 /* The below are defined in frame.c. */
232 extern Lisp_Object Qheight, Qminibuffer, Qname, Qonly, Qwidth;
233 extern Lisp_Object Qunsplittable, Qmenu_bar_lines;
234
235 extern Lisp_Object Vwindow_system_version;
236
237 \f
238 /* Error if we are not connected to X. */
239 void
240 check_x ()
241 {
242 if (x_current_display == 0)
243 error ("X windows are not in use or not initialized");
244 }
245
246 /* Return the Emacs frame-object corresponding to an X window.
247 It could be the frame's main window or an icon window. */
248
249 /* This function can be called during GC, so use XGCTYPE. */
250
251 struct frame *
252 x_window_to_frame (wdesc)
253 int wdesc;
254 {
255 Lisp_Object tail, frame;
256 struct frame *f;
257
258 for (tail = Vframe_list; XGCTYPE (tail) == Lisp_Cons;
259 tail = XCONS (tail)->cdr)
260 {
261 frame = XCONS (tail)->car;
262 if (XGCTYPE (frame) != Lisp_Frame)
263 continue;
264 f = XFRAME (frame);
265 #ifdef USE_X_TOOLKIT
266 if (f->display.nothing == 1)
267 return 0;
268 if ((f->display.x->edit_widget
269 && XtWindow (f->display.x->edit_widget) == wdesc)
270 || f->display.x->icon_desc == wdesc)
271 return f;
272 #else /* not USE_X_TOOLKIT */
273 if (FRAME_X_WINDOW (f) == wdesc
274 || f->display.x->icon_desc == wdesc)
275 return f;
276 #endif /* not USE_X_TOOLKIT */
277 }
278 return 0;
279 }
280
281 #ifdef USE_X_TOOLKIT
282 /* Like x_window_to_frame but also compares the window with the widget's
283 windows. */
284
285 struct frame *
286 x_any_window_to_frame (wdesc)
287 int wdesc;
288 {
289 Lisp_Object tail, frame;
290 struct frame *f;
291 struct x_display *x;
292
293 for (tail = Vframe_list; XGCTYPE (tail) == Lisp_Cons;
294 tail = XCONS (tail)->cdr)
295 {
296 frame = XCONS (tail)->car;
297 if (XGCTYPE (frame) != Lisp_Frame)
298 continue;
299 f = XFRAME (frame);
300 if (f->display.nothing == 1)
301 return 0;
302 x = f->display.x;
303 /* This frame matches if the window is any of its widgets. */
304 if (wdesc == XtWindow (x->widget)
305 || wdesc == XtWindow (x->column_widget)
306 || wdesc == XtWindow (x->edit_widget))
307 return f;
308 /* Match if the window is this frame's menubar. */
309 if (x->menubar_widget
310 && wdesc == XtWindow (x->menubar_widget))
311 return f;
312 }
313 return 0;
314 }
315 #endif /* USE_X_TOOLKIT */
316
317 \f
318 /* Connect the frame-parameter names for X frames
319 to the ways of passing the parameter values to the window system.
320
321 The name of a parameter, as a Lisp symbol,
322 has an `x-frame-parameter' property which is an integer in Lisp
323 but can be interpreted as an `enum x_frame_parm' in C. */
324
325 enum x_frame_parm
326 {
327 X_PARM_FOREGROUND_COLOR,
328 X_PARM_BACKGROUND_COLOR,
329 X_PARM_MOUSE_COLOR,
330 X_PARM_CURSOR_COLOR,
331 X_PARM_BORDER_COLOR,
332 X_PARM_ICON_TYPE,
333 X_PARM_FONT,
334 X_PARM_BORDER_WIDTH,
335 X_PARM_INTERNAL_BORDER_WIDTH,
336 X_PARM_NAME,
337 X_PARM_AUTORAISE,
338 X_PARM_AUTOLOWER,
339 X_PARM_VERT_SCROLL_BAR,
340 X_PARM_VISIBILITY,
341 X_PARM_MENU_BAR_LINES
342 };
343
344
345 struct x_frame_parm_table
346 {
347 char *name;
348 void (*setter)( /* struct frame *frame, Lisp_Object val, oldval */ );
349 };
350
351 void x_set_foreground_color ();
352 void x_set_background_color ();
353 void x_set_mouse_color ();
354 void x_set_cursor_color ();
355 void x_set_border_color ();
356 void x_set_cursor_type ();
357 void x_set_icon_type ();
358 void x_set_font ();
359 void x_set_border_width ();
360 void x_set_internal_border_width ();
361 void x_explicitly_set_name ();
362 void x_set_autoraise ();
363 void x_set_autolower ();
364 void x_set_vertical_scroll_bars ();
365 void x_set_visibility ();
366 void x_set_menu_bar_lines ();
367
368 static struct x_frame_parm_table x_frame_parms[] =
369 {
370 "foreground-color", x_set_foreground_color,
371 "background-color", x_set_background_color,
372 "mouse-color", x_set_mouse_color,
373 "cursor-color", x_set_cursor_color,
374 "border-color", x_set_border_color,
375 "cursor-type", x_set_cursor_type,
376 "icon-type", x_set_icon_type,
377 "font", x_set_font,
378 "border-width", x_set_border_width,
379 "internal-border-width", x_set_internal_border_width,
380 "name", x_explicitly_set_name,
381 "auto-raise", x_set_autoraise,
382 "auto-lower", x_set_autolower,
383 "vertical-scroll-bars", x_set_vertical_scroll_bars,
384 "visibility", x_set_visibility,
385 "menu-bar-lines", x_set_menu_bar_lines,
386 };
387
388 /* Attach the `x-frame-parameter' properties to
389 the Lisp symbol names of parameters relevant to X. */
390
391 init_x_parm_symbols ()
392 {
393 int i;
394
395 for (i = 0; i < sizeof (x_frame_parms) / sizeof (x_frame_parms[0]); i++)
396 Fput (intern (x_frame_parms[i].name), Qx_frame_parameter,
397 make_number (i));
398 }
399 \f
400 /* Change the parameters of FRAME as specified by ALIST.
401 If a parameter is not specially recognized, do nothing;
402 otherwise call the `x_set_...' function for that parameter. */
403
404 void
405 x_set_frame_parameters (f, alist)
406 FRAME_PTR f;
407 Lisp_Object alist;
408 {
409 Lisp_Object tail;
410
411 /* If both of these parameters are present, it's more efficient to
412 set them both at once. So we wait until we've looked at the
413 entire list before we set them. */
414 Lisp_Object width, height;
415
416 /* Same here. */
417 Lisp_Object left, top;
418
419 /* Record in these vectors all the parms specified. */
420 Lisp_Object *parms;
421 Lisp_Object *values;
422 int i;
423
424 i = 0;
425 for (tail = alist; CONSP (tail); tail = Fcdr (tail))
426 i++;
427
428 parms = (Lisp_Object *) alloca (i * sizeof (Lisp_Object));
429 values = (Lisp_Object *) alloca (i * sizeof (Lisp_Object));
430
431 /* Extract parm names and values into those vectors. */
432
433 i = 0;
434 for (tail = alist; CONSP (tail); tail = Fcdr (tail))
435 {
436 Lisp_Object elt, prop, val;
437
438 elt = Fcar (tail);
439 parms[i] = Fcar (elt);
440 values[i] = Fcdr (elt);
441 i++;
442 }
443
444 width = height = top = left = Qunbound;
445
446 /* Now process them in reverse of specified order. */
447 for (i--; i >= 0; i--)
448 {
449 Lisp_Object prop, val;
450
451 prop = parms[i];
452 val = values[i];
453
454 if (EQ (prop, Qwidth))
455 width = val;
456 else if (EQ (prop, Qheight))
457 height = val;
458 else if (EQ (prop, Qtop))
459 top = val;
460 else if (EQ (prop, Qleft))
461 left = val;
462 else
463 {
464 register Lisp_Object param_index, old_value;
465
466 param_index = Fget (prop, Qx_frame_parameter);
467 old_value = get_frame_param (f, prop);
468 store_frame_param (f, prop, val);
469 if (XTYPE (param_index) == Lisp_Int
470 && XINT (param_index) >= 0
471 && (XINT (param_index)
472 < sizeof (x_frame_parms)/sizeof (x_frame_parms[0])))
473 (*x_frame_parms[XINT (param_index)].setter)(f, val, old_value);
474 }
475 }
476
477 /* Don't die if just one of these was set. */
478 if (EQ (left, Qunbound))
479 XSET (left, Lisp_Int, f->display.x->left_pos);
480 if (EQ (top, Qunbound))
481 XSET (top, Lisp_Int, f->display.x->top_pos);
482
483 /* Don't die if just one of these was set. */
484 if (EQ (width, Qunbound))
485 XSET (width, Lisp_Int, FRAME_WIDTH (f));
486 if (EQ (height, Qunbound))
487 XSET (height, Lisp_Int, FRAME_HEIGHT (f));
488
489 /* Don't set these parameters these unless they've been explicitly
490 specified. The window might be mapped or resized while we're in
491 this function, and we don't want to override that unless the lisp
492 code has asked for it.
493
494 Don't set these parameters unless they actually differ from the
495 window's current parameters; the window may not actually exist
496 yet. */
497 {
498 Lisp_Object frame;
499
500 check_frame_size (f, &height, &width);
501
502 XSET (frame, Lisp_Frame, f);
503
504 if ((NUMBERP (width) && XINT (width) != FRAME_WIDTH (f))
505 || (NUMBERP (height) && XINT (height) != FRAME_HEIGHT (f)))
506 Fset_frame_size (frame, width, height);
507 if ((NUMBERP (left) && XINT (left) != f->display.x->left_pos)
508 || (NUMBERP (top) && XINT (top) != f->display.x->top_pos))
509 Fset_frame_position (frame, left, top);
510 }
511 }
512
513 /* Insert a description of internally-recorded parameters of frame X
514 into the parameter alist *ALISTPTR that is to be given to the user.
515 Only parameters that are specific to the X window system
516 and whose values are not correctly recorded in the frame's
517 param_alist need to be considered here. */
518
519 x_report_frame_params (f, alistptr)
520 struct frame *f;
521 Lisp_Object *alistptr;
522 {
523 char buf[16];
524
525 store_in_alist (alistptr, Qleft, make_number (f->display.x->left_pos));
526 store_in_alist (alistptr, Qtop, make_number (f->display.x->top_pos));
527 store_in_alist (alistptr, Qborder_width,
528 make_number (f->display.x->border_width));
529 store_in_alist (alistptr, Qinternal_border_width,
530 make_number (f->display.x->internal_border_width));
531 sprintf (buf, "%d", FRAME_X_WINDOW (f));
532 store_in_alist (alistptr, Qwindow_id,
533 build_string (buf));
534 FRAME_SAMPLE_VISIBILITY (f);
535 store_in_alist (alistptr, Qvisibility,
536 (FRAME_VISIBLE_P (f) ? Qt
537 : FRAME_ICONIFIED_P (f) ? Qicon : Qnil));
538 }
539 \f
540 /* Decide if color named COLOR is valid for the display
541 associated with the selected frame. */
542 int
543 defined_color (color, color_def)
544 char *color;
545 Color *color_def;
546 {
547 register int foo;
548 Colormap screen_colormap;
549
550 BLOCK_INPUT;
551 #ifdef HAVE_X11
552 screen_colormap
553 = DefaultColormap (x_current_display, XDefaultScreen (x_current_display));
554
555 foo = XParseColor (x_current_display, screen_colormap,
556 color, color_def)
557 && XAllocColor (x_current_display, screen_colormap, color_def);
558 #else
559 foo = XParseColor (color, color_def) && XGetHardwareColor (color_def);
560 #endif /* not HAVE_X11 */
561 UNBLOCK_INPUT;
562
563 if (foo)
564 return 1;
565 else
566 return 0;
567 }
568
569 /* Given a string ARG naming a color, compute a pixel value from it
570 suitable for screen F.
571 If F is not a color screen, return DEF (default) regardless of what
572 ARG says. */
573
574 int
575 x_decode_color (arg, def)
576 Lisp_Object arg;
577 int def;
578 {
579 Color cdef;
580
581 CHECK_STRING (arg, 0);
582
583 if (strcmp (XSTRING (arg)->data, "black") == 0)
584 return BLACK_PIX_DEFAULT;
585 else if (strcmp (XSTRING (arg)->data, "white") == 0)
586 return WHITE_PIX_DEFAULT;
587
588 #ifdef HAVE_X11
589 if (x_screen_planes == 1)
590 return def;
591 #else
592 if (DISPLAY_CELLS == 1)
593 return def;
594 #endif
595
596 if (defined_color (XSTRING (arg)->data, &cdef))
597 return cdef.pixel;
598 else
599 Fsignal (Qundefined_color, Fcons (arg, Qnil));
600 }
601 \f
602 /* Functions called only from `x_set_frame_param'
603 to set individual parameters.
604
605 If FRAME_X_WINDOW (f) is 0,
606 the frame is being created and its X-window does not exist yet.
607 In that case, just record the parameter's new value
608 in the standard place; do not attempt to change the window. */
609
610 void
611 x_set_foreground_color (f, arg, oldval)
612 struct frame *f;
613 Lisp_Object arg, oldval;
614 {
615 f->display.x->foreground_pixel = x_decode_color (arg, BLACK_PIX_DEFAULT);
616 if (FRAME_X_WINDOW (f) != 0)
617 {
618 #ifdef HAVE_X11
619 BLOCK_INPUT;
620 XSetForeground (x_current_display, f->display.x->normal_gc,
621 f->display.x->foreground_pixel);
622 XSetBackground (x_current_display, f->display.x->reverse_gc,
623 f->display.x->foreground_pixel);
624 UNBLOCK_INPUT;
625 #endif /* HAVE_X11 */
626 recompute_basic_faces (f);
627 if (FRAME_VISIBLE_P (f))
628 redraw_frame (f);
629 }
630 }
631
632 void
633 x_set_background_color (f, arg, oldval)
634 struct frame *f;
635 Lisp_Object arg, oldval;
636 {
637 Pixmap temp;
638 int mask;
639
640 f->display.x->background_pixel = x_decode_color (arg, WHITE_PIX_DEFAULT);
641
642 if (FRAME_X_WINDOW (f) != 0)
643 {
644 BLOCK_INPUT;
645 #ifdef HAVE_X11
646 /* The main frame area. */
647 XSetBackground (x_current_display, f->display.x->normal_gc,
648 f->display.x->background_pixel);
649 XSetForeground (x_current_display, f->display.x->reverse_gc,
650 f->display.x->background_pixel);
651 XSetForeground (x_current_display, f->display.x->cursor_gc,
652 f->display.x->background_pixel);
653 XSetWindowBackground (x_current_display, FRAME_X_WINDOW (f),
654 f->display.x->background_pixel);
655
656 #else
657 temp = XMakeTile (f->display.x->background_pixel);
658 XChangeBackground (FRAME_X_WINDOW (f), temp);
659 XFreePixmap (temp);
660 #endif /* not HAVE_X11 */
661 UNBLOCK_INPUT;
662
663 recompute_basic_faces (f);
664
665 if (FRAME_VISIBLE_P (f))
666 redraw_frame (f);
667 }
668 }
669
670 void
671 x_set_mouse_color (f, arg, oldval)
672 struct frame *f;
673 Lisp_Object arg, oldval;
674 {
675 Cursor cursor, nontext_cursor, mode_cursor, cross_cursor;
676 int mask_color;
677
678 if (!EQ (Qnil, arg))
679 f->display.x->mouse_pixel = x_decode_color (arg, BLACK_PIX_DEFAULT);
680 mask_color = f->display.x->background_pixel;
681 /* No invisible pointers. */
682 if (mask_color == f->display.x->mouse_pixel
683 && mask_color == f->display.x->background_pixel)
684 f->display.x->mouse_pixel = f->display.x->foreground_pixel;
685
686 BLOCK_INPUT;
687 #ifdef HAVE_X11
688
689 /* It's not okay to crash if the user selects a screwy cursor. */
690 x_catch_errors ();
691
692 if (!EQ (Qnil, Vx_pointer_shape))
693 {
694 CHECK_NUMBER (Vx_pointer_shape, 0);
695 cursor = XCreateFontCursor (x_current_display, XINT (Vx_pointer_shape));
696 }
697 else
698 cursor = XCreateFontCursor (x_current_display, XC_xterm);
699 x_check_errors ("bad text pointer cursor: %s");
700
701 if (!EQ (Qnil, Vx_nontext_pointer_shape))
702 {
703 CHECK_NUMBER (Vx_nontext_pointer_shape, 0);
704 nontext_cursor = XCreateFontCursor (x_current_display,
705 XINT (Vx_nontext_pointer_shape));
706 }
707 else
708 nontext_cursor = XCreateFontCursor (x_current_display, XC_left_ptr);
709 x_check_errors ("bad nontext pointer cursor: %s");
710
711 if (!EQ (Qnil, Vx_mode_pointer_shape))
712 {
713 CHECK_NUMBER (Vx_mode_pointer_shape, 0);
714 mode_cursor = XCreateFontCursor (x_current_display,
715 XINT (Vx_mode_pointer_shape));
716 }
717 else
718 mode_cursor = XCreateFontCursor (x_current_display, XC_xterm);
719 x_check_errors ("bad modeline pointer cursor: %s");
720
721 if (!EQ (Qnil, Vx_cross_pointer_shape))
722 {
723 CHECK_NUMBER (Vx_cross_pointer_shape, 0);
724 cross_cursor = XCreateFontCursor (x_current_display,
725 XINT (Vx_cross_pointer_shape));
726 }
727 else
728 cross_cursor = XCreateFontCursor (x_current_display, XC_crosshair);
729
730 /* Check and report errors with the above calls. */
731 x_check_errors ("can't set cursor shape: %s");
732 x_uncatch_errors ();
733
734 {
735 XColor fore_color, back_color;
736
737 fore_color.pixel = f->display.x->mouse_pixel;
738 back_color.pixel = mask_color;
739 XQueryColor (x_current_display,
740 DefaultColormap (x_current_display,
741 DefaultScreen (x_current_display)),
742 &fore_color);
743 XQueryColor (x_current_display,
744 DefaultColormap (x_current_display,
745 DefaultScreen (x_current_display)),
746 &back_color);
747 XRecolorCursor (x_current_display, cursor,
748 &fore_color, &back_color);
749 XRecolorCursor (x_current_display, nontext_cursor,
750 &fore_color, &back_color);
751 XRecolorCursor (x_current_display, mode_cursor,
752 &fore_color, &back_color);
753 XRecolorCursor (x_current_display, cross_cursor,
754 &fore_color, &back_color);
755 }
756 #else /* X10 */
757 cursor = XCreateCursor (16, 16, MouseCursor, MouseMask,
758 0, 0,
759 f->display.x->mouse_pixel,
760 f->display.x->background_pixel,
761 GXcopy);
762 #endif /* X10 */
763
764 if (FRAME_X_WINDOW (f) != 0)
765 {
766 XDefineCursor (XDISPLAY FRAME_X_WINDOW (f), cursor);
767 }
768
769 if (cursor != f->display.x->text_cursor && f->display.x->text_cursor != 0)
770 XFreeCursor (XDISPLAY f->display.x->text_cursor);
771 f->display.x->text_cursor = cursor;
772 #ifdef HAVE_X11
773 if (nontext_cursor != f->display.x->nontext_cursor
774 && f->display.x->nontext_cursor != 0)
775 XFreeCursor (XDISPLAY f->display.x->nontext_cursor);
776 f->display.x->nontext_cursor = nontext_cursor;
777
778 if (mode_cursor != f->display.x->modeline_cursor
779 && f->display.x->modeline_cursor != 0)
780 XFreeCursor (XDISPLAY f->display.x->modeline_cursor);
781 f->display.x->modeline_cursor = mode_cursor;
782 if (cross_cursor != f->display.x->cross_cursor
783 && f->display.x->cross_cursor != 0)
784 XFreeCursor (XDISPLAY f->display.x->cross_cursor);
785 f->display.x->cross_cursor = cross_cursor;
786 #endif /* HAVE_X11 */
787
788 XFlushQueue ();
789 UNBLOCK_INPUT;
790 }
791
792 void
793 x_set_cursor_color (f, arg, oldval)
794 struct frame *f;
795 Lisp_Object arg, oldval;
796 {
797 unsigned long fore_pixel;
798
799 if (!EQ (Vx_cursor_fore_pixel, Qnil))
800 fore_pixel = x_decode_color (Vx_cursor_fore_pixel, WHITE_PIX_DEFAULT);
801 else
802 fore_pixel = f->display.x->background_pixel;
803 f->display.x->cursor_pixel = x_decode_color (arg, BLACK_PIX_DEFAULT);
804
805 /* Make sure that the cursor color differs from the background color. */
806 if (f->display.x->cursor_pixel == f->display.x->background_pixel)
807 {
808 f->display.x->cursor_pixel == f->display.x->mouse_pixel;
809 if (f->display.x->cursor_pixel == fore_pixel)
810 fore_pixel = f->display.x->background_pixel;
811 }
812 f->display.x->cursor_foreground_pixel = fore_pixel;
813
814 if (FRAME_X_WINDOW (f) != 0)
815 {
816 #ifdef HAVE_X11
817 BLOCK_INPUT;
818 XSetBackground (x_current_display, f->display.x->cursor_gc,
819 f->display.x->cursor_pixel);
820 XSetForeground (x_current_display, f->display.x->cursor_gc,
821 fore_pixel);
822 UNBLOCK_INPUT;
823 #endif /* HAVE_X11 */
824
825 if (FRAME_VISIBLE_P (f))
826 {
827 x_display_cursor (f, 0);
828 x_display_cursor (f, 1);
829 }
830 }
831 }
832
833 /* Set the border-color of frame F to value described by ARG.
834 ARG can be a string naming a color.
835 The border-color is used for the border that is drawn by the X server.
836 Note that this does not fully take effect if done before
837 F has an x-window; it must be redone when the window is created.
838
839 Note: this is done in two routines because of the way X10 works.
840
841 Note: under X11, this is normally the province of the window manager,
842 and so emacs' border colors may be overridden. */
843
844 void
845 x_set_border_color (f, arg, oldval)
846 struct frame *f;
847 Lisp_Object arg, oldval;
848 {
849 unsigned char *str;
850 int pix;
851
852 CHECK_STRING (arg, 0);
853 str = XSTRING (arg)->data;
854
855 #ifndef HAVE_X11
856 if (!strcmp (str, "grey") || !strcmp (str, "Grey")
857 || !strcmp (str, "gray") || !strcmp (str, "Gray"))
858 pix = -1;
859 else
860 #endif /* X10 */
861
862 pix = x_decode_color (arg, BLACK_PIX_DEFAULT);
863
864 x_set_border_pixel (f, pix);
865 }
866
867 /* Set the border-color of frame F to pixel value PIX.
868 Note that this does not fully take effect if done before
869 F has an x-window. */
870
871 x_set_border_pixel (f, pix)
872 struct frame *f;
873 int pix;
874 {
875 f->display.x->border_pixel = pix;
876
877 if (FRAME_X_WINDOW (f) != 0 && f->display.x->border_width > 0)
878 {
879 Pixmap temp;
880 int mask;
881
882 BLOCK_INPUT;
883 #ifdef HAVE_X11
884 XSetWindowBorder (x_current_display, FRAME_X_WINDOW (f),
885 pix);
886 #else
887 if (pix < 0)
888 temp = XMakePixmap ((Bitmap) XStoreBitmap (gray_width, gray_height,
889 gray_bits),
890 BLACK_PIX_DEFAULT, WHITE_PIX_DEFAULT);
891 else
892 temp = XMakeTile (pix);
893 XChangeBorder (FRAME_X_WINDOW (f), temp);
894 XFreePixmap (XDISPLAY temp);
895 #endif /* not HAVE_X11 */
896 UNBLOCK_INPUT;
897
898 if (FRAME_VISIBLE_P (f))
899 redraw_frame (f);
900 }
901 }
902
903 void
904 x_set_cursor_type (f, arg, oldval)
905 FRAME_PTR f;
906 Lisp_Object arg, oldval;
907 {
908 if (EQ (arg, Qbar))
909 FRAME_DESIRED_CURSOR (f) = bar_cursor;
910 else
911 #if 0
912 if (EQ (arg, Qbox))
913 #endif
914 FRAME_DESIRED_CURSOR (f) = filled_box_cursor;
915 /* Error messages commented out because people have trouble fixing
916 .Xdefaults with Emacs, when it has something bad in it. */
917 #if 0
918 else
919 error
920 ("the `cursor-type' frame parameter should be either `bar' or `box'");
921 #endif
922
923 /* Make sure the cursor gets redrawn. This is overkill, but how
924 often do people change cursor types? */
925 update_mode_lines++;
926 }
927
928 void
929 x_set_icon_type (f, arg, oldval)
930 struct frame *f;
931 Lisp_Object arg, oldval;
932 {
933 Lisp_Object tem;
934 int result;
935
936 if (EQ (oldval, Qnil) == EQ (arg, Qnil))
937 return;
938
939 BLOCK_INPUT;
940 if (NILP (arg))
941 result = x_text_icon (f, 0);
942 else
943 result = x_bitmap_icon (f);
944
945 if (result)
946 {
947 UNBLOCK_INPUT;
948 error ("No icon window available.");
949 }
950
951 /* If the window was unmapped (and its icon was mapped),
952 the new icon is not mapped, so map the window in its stead. */
953 if (FRAME_VISIBLE_P (f))
954 #ifdef USE_X_TOOLKIT
955 XtPopup (f->display.x->widget, XtGrabNone);
956 #endif
957 XMapWindow (XDISPLAY FRAME_X_WINDOW (f));
958
959 XFlushQueue ();
960 UNBLOCK_INPUT;
961 }
962
963 extern Lisp_Object x_new_font ();
964
965 void
966 x_set_font (f, arg, oldval)
967 struct frame *f;
968 Lisp_Object arg, oldval;
969 {
970 Lisp_Object result;
971
972 CHECK_STRING (arg, 1);
973
974 BLOCK_INPUT;
975 result = x_new_font (f, XSTRING (arg)->data);
976 UNBLOCK_INPUT;
977
978 if (EQ (result, Qnil))
979 error ("Font \"%s\" is not defined", XSTRING (arg)->data);
980 else if (EQ (result, Qt))
981 error ("the characters of the given font have varying widths");
982 else if (STRINGP (result))
983 {
984 recompute_basic_faces (f);
985 store_frame_param (f, Qfont, result);
986 }
987 else
988 abort ();
989 }
990
991 void
992 x_set_border_width (f, arg, oldval)
993 struct frame *f;
994 Lisp_Object arg, oldval;
995 {
996 CHECK_NUMBER (arg, 0);
997
998 if (XINT (arg) == f->display.x->border_width)
999 return;
1000
1001 if (FRAME_X_WINDOW (f) != 0)
1002 error ("Cannot change the border width of a window");
1003
1004 f->display.x->border_width = XINT (arg);
1005 }
1006
1007 void
1008 x_set_internal_border_width (f, arg, oldval)
1009 struct frame *f;
1010 Lisp_Object arg, oldval;
1011 {
1012 int mask;
1013 int old = f->display.x->internal_border_width;
1014
1015 CHECK_NUMBER (arg, 0);
1016 f->display.x->internal_border_width = XINT (arg);
1017 if (f->display.x->internal_border_width < 0)
1018 f->display.x->internal_border_width = 0;
1019
1020 if (f->display.x->internal_border_width == old)
1021 return;
1022
1023 if (FRAME_X_WINDOW (f) != 0)
1024 {
1025 BLOCK_INPUT;
1026 x_set_window_size (f, 0, f->width, f->height);
1027 #if 0
1028 x_set_resize_hint (f);
1029 #endif
1030 XFlushQueue ();
1031 UNBLOCK_INPUT;
1032 SET_FRAME_GARBAGED (f);
1033 }
1034 }
1035
1036 void
1037 x_set_visibility (f, value, oldval)
1038 struct frame *f;
1039 Lisp_Object value, oldval;
1040 {
1041 Lisp_Object frame;
1042 XSET (frame, Lisp_Frame, f);
1043
1044 if (NILP (value))
1045 Fmake_frame_invisible (frame, Qt);
1046 else if (EQ (value, Qicon))
1047 Ficonify_frame (frame);
1048 else
1049 Fmake_frame_visible (frame);
1050 }
1051
1052 static void
1053 x_set_menu_bar_lines_1 (window, n)
1054 Lisp_Object window;
1055 int n;
1056 {
1057 struct window *w = XWINDOW (window);
1058
1059 XFASTINT (w->top) += n;
1060 XFASTINT (w->height) -= n;
1061
1062 /* Handle just the top child in a vertical split. */
1063 if (!NILP (w->vchild))
1064 x_set_menu_bar_lines_1 (w->vchild, n);
1065
1066 /* Adjust all children in a horizontal split. */
1067 for (window = w->hchild; !NILP (window); window = w->next)
1068 {
1069 w = XWINDOW (window);
1070 x_set_menu_bar_lines_1 (window, n);
1071 }
1072 }
1073
1074 void
1075 x_set_menu_bar_lines (f, value, oldval)
1076 struct frame *f;
1077 Lisp_Object value, oldval;
1078 {
1079 int nlines;
1080 int olines = FRAME_MENU_BAR_LINES (f);
1081
1082 /* Right now, menu bars don't work properly in minibuf-only frames;
1083 most of the commands try to apply themselves to the minibuffer
1084 frame itslef, and get an error because you can't switch buffers
1085 in or split the minibuffer window. */
1086 if (FRAME_MINIBUF_ONLY_P (f))
1087 return;
1088
1089 if (XTYPE (value) == Lisp_Int)
1090 nlines = XINT (value);
1091 else
1092 nlines = 0;
1093
1094 #ifdef USE_X_TOOLKIT
1095 FRAME_MENU_BAR_LINES (f) = 0;
1096 if (nlines)
1097 FRAME_EXTERNAL_MENU_BAR (f) = 1;
1098 else
1099 {
1100 if (FRAME_EXTERNAL_MENU_BAR (f) == 1)
1101 free_frame_menubar (f);
1102 FRAME_EXTERNAL_MENU_BAR (f) = 0;
1103 f->display.x->menubar_widget = 0;
1104 }
1105 #else /* not USE_X_TOOLKIT */
1106 FRAME_MENU_BAR_LINES (f) = nlines;
1107 x_set_menu_bar_lines_1 (f->root_window, nlines - olines);
1108 #endif /* not USE_X_TOOLKIT */
1109 }
1110
1111 /* Change the name of frame F to NAME. If NAME is nil, set F's name to
1112 x_id_name.
1113
1114 If EXPLICIT is non-zero, that indicates that lisp code is setting the
1115 name; if NAME is a string, set F's name to NAME and set
1116 F->explicit_name; if NAME is Qnil, then clear F->explicit_name.
1117
1118 If EXPLICIT is zero, that indicates that Emacs redisplay code is
1119 suggesting a new name, which lisp code should override; if
1120 F->explicit_name is set, ignore the new name; otherwise, set it. */
1121
1122 void
1123 x_set_name (f, name, explicit)
1124 struct frame *f;
1125 Lisp_Object name;
1126 int explicit;
1127 {
1128 /* Make sure that requests from lisp code override requests from
1129 Emacs redisplay code. */
1130 if (explicit)
1131 {
1132 /* If we're switching from explicit to implicit, we had better
1133 update the mode lines and thereby update the title. */
1134 if (f->explicit_name && NILP (name))
1135 update_mode_lines = 1;
1136
1137 f->explicit_name = ! NILP (name);
1138 }
1139 else if (f->explicit_name)
1140 return;
1141
1142 /* If NAME is nil, set the name to the x_id_name. */
1143 if (NILP (name))
1144 name = build_string (x_id_name);
1145 else
1146 CHECK_STRING (name, 0);
1147
1148 /* Don't change the name if it's already NAME. */
1149 if (! NILP (Fstring_equal (name, f->name)))
1150 return;
1151
1152 if (FRAME_X_WINDOW (f))
1153 {
1154 BLOCK_INPUT;
1155 #ifdef HAVE_X11R4
1156 {
1157 XTextProperty text;
1158 text.value = XSTRING (name)->data;
1159 text.encoding = XA_STRING;
1160 text.format = 8;
1161 text.nitems = XSTRING (name)->size;
1162 #ifdef USE_X_TOOLKIT
1163 XSetWMName (x_current_display, XtWindow (f->display.x->widget), &text);
1164 XSetWMIconName (x_current_display, XtWindow (f->display.x->widget),
1165 &text);
1166 #else /* not USE_X_TOOLKIT */
1167 XSetWMName (x_current_display, FRAME_X_WINDOW (f), &text);
1168 XSetWMIconName (x_current_display, FRAME_X_WINDOW (f), &text);
1169 #endif /* not USE_X_TOOLKIT */
1170 }
1171 #else /* not HAVE_X11R4 */
1172 XSetIconName (XDISPLAY FRAME_X_WINDOW (f),
1173 XSTRING (name)->data);
1174 XStoreName (XDISPLAY FRAME_X_WINDOW (f),
1175 XSTRING (name)->data);
1176 #endif /* not HAVE_X11R4 */
1177 UNBLOCK_INPUT;
1178 }
1179
1180 f->name = name;
1181 }
1182
1183 /* This function should be called when the user's lisp code has
1184 specified a name for the frame; the name will override any set by the
1185 redisplay code. */
1186 void
1187 x_explicitly_set_name (f, arg, oldval)
1188 FRAME_PTR f;
1189 Lisp_Object arg, oldval;
1190 {
1191 x_set_name (f, arg, 1);
1192 }
1193
1194 /* This function should be called by Emacs redisplay code to set the
1195 name; names set this way will never override names set by the user's
1196 lisp code. */
1197 void
1198 x_implicitly_set_name (f, arg, oldval)
1199 FRAME_PTR f;
1200 Lisp_Object arg, oldval;
1201 {
1202 x_set_name (f, arg, 0);
1203 }
1204
1205 void
1206 x_set_autoraise (f, arg, oldval)
1207 struct frame *f;
1208 Lisp_Object arg, oldval;
1209 {
1210 f->auto_raise = !EQ (Qnil, arg);
1211 }
1212
1213 void
1214 x_set_autolower (f, arg, oldval)
1215 struct frame *f;
1216 Lisp_Object arg, oldval;
1217 {
1218 f->auto_lower = !EQ (Qnil, arg);
1219 }
1220
1221 void
1222 x_set_vertical_scroll_bars (f, arg, oldval)
1223 struct frame *f;
1224 Lisp_Object arg, oldval;
1225 {
1226 if (NILP (arg) != ! FRAME_HAS_VERTICAL_SCROLL_BARS (f))
1227 {
1228 FRAME_HAS_VERTICAL_SCROLL_BARS (f) = ! NILP (arg);
1229
1230 /* We set this parameter before creating the X window for the
1231 frame, so we can get the geometry right from the start.
1232 However, if the window hasn't been created yet, we shouldn't
1233 call x_set_window_size. */
1234 if (FRAME_X_WINDOW (f))
1235 x_set_window_size (f, 0, FRAME_WIDTH (f), FRAME_HEIGHT (f));
1236 }
1237 }
1238 \f
1239 /* Subroutines of creating an X frame. */
1240
1241 #ifdef HAVE_X11
1242
1243 /* Make sure that Vx_resource_name is set to a reasonable value. */
1244 static void
1245 validate_x_resource_name ()
1246 {
1247 if (! STRINGP (Vx_resource_name))
1248 Vx_resource_name = make_string ("emacs", 5);
1249 }
1250
1251
1252 extern char *x_get_string_resource ();
1253 extern XrmDatabase x_load_resources ();
1254
1255 DEFUN ("x-get-resource", Fx_get_resource, Sx_get_resource, 2, 4, 0,
1256 "Return the value of ATTRIBUTE, of class CLASS, from the X defaults database.\n\
1257 This uses `NAME.ATTRIBUTE' as the key and `Emacs.CLASS' as the\n\
1258 class, where INSTANCE is the name under which Emacs was invoked, or\n\
1259 the name specified by the `-name' or `-rn' command-line arguments.\n\
1260 \n\
1261 The optional arguments COMPONENT and SUBCLASS add to the key and the\n\
1262 class, respectively. You must specify both of them or neither.\n\
1263 If you specify them, the key is `NAME.COMPONENT.ATTRIBUTE'\n\
1264 and the class is `Emacs.CLASS.SUBCLASS'.")
1265 (attribute, class, component, subclass)
1266 Lisp_Object attribute, class, component, subclass;
1267 {
1268 register char *value;
1269 char *name_key;
1270 char *class_key;
1271 Lisp_Object resname;
1272
1273 check_x ();
1274
1275 CHECK_STRING (attribute, 0);
1276 CHECK_STRING (class, 0);
1277
1278 if (!NILP (component))
1279 CHECK_STRING (component, 1);
1280 if (!NILP (subclass))
1281 CHECK_STRING (subclass, 2);
1282 if (NILP (component) != NILP (subclass))
1283 error ("x-get-resource: must specify both COMPONENT and SUBCLASS or neither");
1284
1285 validate_x_resource_name ();
1286 resname = Vx_resource_name;
1287
1288 if (NILP (component))
1289 {
1290 /* Allocate space for the components, the dots which separate them,
1291 and the final '\0'. */
1292 name_key = (char *) alloca (XSTRING (resname)->size
1293 + XSTRING (attribute)->size
1294 + 2);
1295 class_key = (char *) alloca ((sizeof (EMACS_CLASS) - 1)
1296 + XSTRING (class)->size
1297 + 2);
1298
1299 sprintf (name_key, "%s.%s",
1300 XSTRING (resname)->data,
1301 XSTRING (attribute)->data);
1302 sprintf (class_key, "%s.%s",
1303 EMACS_CLASS,
1304 XSTRING (class)->data);
1305 }
1306 else
1307 {
1308 name_key = (char *) alloca (XSTRING (resname)->size
1309 + XSTRING (component)->size
1310 + XSTRING (attribute)->size
1311 + 3);
1312
1313 class_key = (char *) alloca ((sizeof (EMACS_CLASS) - 1)
1314 + XSTRING (class)->size
1315 + XSTRING (subclass)->size
1316 + 3);
1317
1318 sprintf (name_key, "%s.%s.%s",
1319 XSTRING (resname)->data,
1320 XSTRING (component)->data,
1321 XSTRING (attribute)->data);
1322 sprintf (class_key, "%s.%s.%s",
1323 EMACS_CLASS,
1324 XSTRING (class)->data,
1325 XSTRING (subclass)->data);
1326 }
1327
1328 value = x_get_string_resource (xrdb, name_key, class_key);
1329
1330 if (value != (char *) 0)
1331 return build_string (value);
1332 else
1333 return Qnil;
1334 }
1335
1336 /* Used when C code wants a resource value. */
1337
1338 char *
1339 x_get_resource_string (attribute, class)
1340 char *attribute, *class;
1341 {
1342 register char *value;
1343 char *name_key;
1344 char *class_key;
1345
1346 /* Allocate space for the components, the dots which separate them,
1347 and the final '\0'. */
1348 name_key = (char *) alloca (XSTRING (Vinvocation_name)->size
1349 + strlen (attribute) + 2);
1350 class_key = (char *) alloca ((sizeof (EMACS_CLASS) - 1)
1351 + strlen (class) + 2);
1352
1353 sprintf (name_key, "%s.%s",
1354 XSTRING (Vinvocation_name)->data,
1355 attribute);
1356 sprintf (class_key, "%s.%s", EMACS_CLASS, class);
1357
1358 return x_get_string_resource (xrdb, name_key, class_key);
1359 }
1360
1361 #else /* X10 */
1362
1363 DEFUN ("x-get-default", Fx_get_default, Sx_get_default, 1, 1, 0,
1364 "Get X default ATTRIBUTE from the system, or nil if no default.\n\
1365 Value is a string (when not nil) and ATTRIBUTE is also a string.\n\
1366 The defaults are specified in the file `~/.Xdefaults'.")
1367 (arg)
1368 Lisp_Object arg;
1369 {
1370 register unsigned char *value;
1371
1372 CHECK_STRING (arg, 1);
1373
1374 value = (unsigned char *) XGetDefault (XDISPLAY
1375 XSTRING (Vinvocation_name)->data,
1376 XSTRING (arg)->data);
1377 if (value == 0)
1378 /* Try reversing last two args, in case this is the buggy version of X. */
1379 value = (unsigned char *) XGetDefault (XDISPLAY
1380 XSTRING (arg)->data,
1381 XSTRING (Vinvocation_name)->data);
1382 if (value != 0)
1383 return build_string (value);
1384 else
1385 return (Qnil);
1386 }
1387
1388 #define Fx_get_resource(attribute, class, component, subclass) \
1389 Fx_get_default (attribute)
1390
1391 #endif /* X10 */
1392
1393 /* Types we might convert a resource string into. */
1394 enum resource_types
1395 {
1396 number, boolean, string, symbol
1397 };
1398
1399 /* Return the value of parameter PARAM.
1400
1401 First search ALIST, then Vdefault_frame_alist, then the X defaults
1402 database, using ATTRIBUTE as the attribute name and CLASS as its class.
1403
1404 Convert the resource to the type specified by desired_type.
1405
1406 If no default is specified, return Qunbound. If you call
1407 x_get_arg, make sure you deal with Qunbound in a reasonable way,
1408 and don't let it get stored in any lisp-visible variables! */
1409
1410 static Lisp_Object
1411 x_get_arg (alist, param, attribute, class, type)
1412 Lisp_Object alist, param;
1413 char *attribute;
1414 char *class;
1415 enum resource_types type;
1416 {
1417 register Lisp_Object tem;
1418
1419 tem = Fassq (param, alist);
1420 if (EQ (tem, Qnil))
1421 tem = Fassq (param, Vdefault_frame_alist);
1422 if (EQ (tem, Qnil))
1423 {
1424
1425 if (attribute)
1426 {
1427 tem = Fx_get_resource (build_string (attribute),
1428 build_string (class),
1429 Qnil, Qnil);
1430
1431 if (NILP (tem))
1432 return Qunbound;
1433
1434 switch (type)
1435 {
1436 case number:
1437 return make_number (atoi (XSTRING (tem)->data));
1438
1439 case boolean:
1440 tem = Fdowncase (tem);
1441 if (!strcmp (XSTRING (tem)->data, "on")
1442 || !strcmp (XSTRING (tem)->data, "true"))
1443 return Qt;
1444 else
1445 return Qnil;
1446
1447 case string:
1448 return tem;
1449
1450 case symbol:
1451 /* As a special case, we map the values `true' and `on'
1452 to Qt, and `false' and `off' to Qnil. */
1453 {
1454 Lisp_Object lower;
1455 lower = Fdowncase (tem);
1456 if (!strcmp (XSTRING (lower)->data, "on")
1457 || !strcmp (XSTRING (lower)->data, "true"))
1458 return Qt;
1459 else if (!strcmp (XSTRING (lower)->data, "off")
1460 || !strcmp (XSTRING (lower)->data, "false"))
1461 return Qnil;
1462 else
1463 return Fintern (tem, Qnil);
1464 }
1465
1466 default:
1467 abort ();
1468 }
1469 }
1470 else
1471 return Qunbound;
1472 }
1473 return Fcdr (tem);
1474 }
1475
1476 /* Record in frame F the specified or default value according to ALIST
1477 of the parameter named PARAM (a Lisp symbol).
1478 If no value is specified for PARAM, look for an X default for XPROP
1479 on the frame named NAME.
1480 If that is not found either, use the value DEFLT. */
1481
1482 static Lisp_Object
1483 x_default_parameter (f, alist, prop, deflt, xprop, xclass, type)
1484 struct frame *f;
1485 Lisp_Object alist;
1486 Lisp_Object prop;
1487 Lisp_Object deflt;
1488 char *xprop;
1489 char *xclass;
1490 enum resource_types type;
1491 {
1492 Lisp_Object tem;
1493
1494 tem = x_get_arg (alist, prop, xprop, xclass, type);
1495 if (EQ (tem, Qunbound))
1496 tem = deflt;
1497 x_set_frame_parameters (f, Fcons (Fcons (prop, tem), Qnil));
1498 return tem;
1499 }
1500 \f
1501 DEFUN ("x-parse-geometry", Fx_parse_geometry, Sx_parse_geometry, 1, 1, 0,
1502 "Parse an X-style geometry string STRING.\n\
1503 Returns an alist of the form ((top . TOP), (left . LEFT) ... ).")
1504 (string)
1505 Lisp_Object string;
1506 {
1507 int geometry, x, y;
1508 unsigned int width, height;
1509 Lisp_Object values[4];
1510
1511 CHECK_STRING (string, 0);
1512
1513 geometry = XParseGeometry ((char *) XSTRING (string)->data,
1514 &x, &y, &width, &height);
1515
1516 switch (geometry & 0xf) /* Mask out {X,Y}Negative */
1517 {
1518 case (XValue | YValue):
1519 /* What's one pixel among friends?
1520 Perhaps fix this some day by returning symbol `extreme-top'... */
1521 if (x == 0 && (geometry & XNegative))
1522 x = -1;
1523 if (y == 0 && (geometry & YNegative))
1524 y = -1;
1525 values[0] = Fcons (Qleft, make_number (x));
1526 values[1] = Fcons (Qtop, make_number (y));
1527 return Flist (2, values);
1528 break;
1529
1530 case (WidthValue | HeightValue):
1531 values[0] = Fcons (Qwidth, make_number (width));
1532 values[1] = Fcons (Qheight, make_number (height));
1533 return Flist (2, values);
1534 break;
1535
1536 case (XValue | YValue | WidthValue | HeightValue):
1537 if (x == 0 && (geometry & XNegative))
1538 x = -1;
1539 if (y == 0 && (geometry & YNegative))
1540 y = -1;
1541 values[0] = Fcons (Qwidth, make_number (width));
1542 values[1] = Fcons (Qheight, make_number (height));
1543 values[2] = Fcons (Qleft, make_number (x));
1544 values[3] = Fcons (Qtop, make_number (y));
1545 return Flist (4, values);
1546 break;
1547
1548 case 0:
1549 return Qnil;
1550
1551 default:
1552 error ("Must specify x and y value, and/or width and height");
1553 }
1554 }
1555
1556 #ifdef HAVE_X11
1557 /* Calculate the desired size and position of this window,
1558 and return the attributes saying which aspects were specified.
1559
1560 This function does not make the coordinates positive. */
1561
1562 #define DEFAULT_ROWS 40
1563 #define DEFAULT_COLS 80
1564
1565 static int
1566 x_figure_window_size (f, parms)
1567 struct frame *f;
1568 Lisp_Object parms;
1569 {
1570 register Lisp_Object tem0, tem1;
1571 int height, width, left, top;
1572 register int geometry;
1573 long window_prompting = 0;
1574
1575 /* Default values if we fall through.
1576 Actually, if that happens we should get
1577 window manager prompting. */
1578 f->width = DEFAULT_COLS;
1579 f->height = DEFAULT_ROWS;
1580 /* Window managers expect that if program-specified
1581 positions are not (0,0), they're intentional, not defaults. */
1582 f->display.x->top_pos = 0;
1583 f->display.x->left_pos = 0;
1584
1585 tem0 = x_get_arg (parms, Qheight, 0, 0, number);
1586 tem1 = x_get_arg (parms, Qwidth, 0, 0, number);
1587 if (! EQ (tem0, Qunbound) && ! EQ (tem1, Qunbound))
1588 {
1589 CHECK_NUMBER (tem0, 0);
1590 CHECK_NUMBER (tem1, 0);
1591 f->height = XINT (tem0);
1592 f->width = XINT (tem1);
1593 window_prompting |= USSize;
1594 }
1595 else if (! EQ (tem0, Qunbound) || ! EQ (tem1, Qunbound))
1596 error ("Must specify *both* height and width");
1597
1598 f->display.x->vertical_scroll_bar_extra
1599 = (FRAME_HAS_VERTICAL_SCROLL_BARS (f)
1600 ? VERTICAL_SCROLL_BAR_PIXEL_WIDTH (f)
1601 : 0);
1602 f->display.x->pixel_width = CHAR_TO_PIXEL_WIDTH (f, f->width);
1603 f->display.x->pixel_height = CHAR_TO_PIXEL_HEIGHT (f, f->height);
1604
1605 tem0 = x_get_arg (parms, Qtop, 0, 0, number);
1606 tem1 = x_get_arg (parms, Qleft, 0, 0, number);
1607 if (! EQ (tem0, Qunbound) && ! EQ (tem1, Qunbound))
1608 {
1609 CHECK_NUMBER (tem0, 0);
1610 CHECK_NUMBER (tem1, 0);
1611 f->display.x->top_pos = XINT (tem0);
1612 f->display.x->left_pos = XINT (tem1);
1613 if (f->display.x->top_pos < 0)
1614 window_prompting |= YNegative;
1615 if (f->display.x->left_pos < 0)
1616 window_prompting |= YNegative;
1617 window_prompting |= USPosition;
1618 }
1619 else if (! EQ (tem0, Qunbound) || ! EQ (tem1, Qunbound))
1620 error ("Must specify *both* top and left corners");
1621
1622 #if 0 /* PPosition and PSize mean "specified explicitly,
1623 by the program rather than by the user". So it is wrong to
1624 set them if nothing was specified. */
1625 switch (window_prompting)
1626 {
1627 case USSize | USPosition:
1628 return window_prompting;
1629 break;
1630
1631 case USSize: /* Got the size, need the position. */
1632 window_prompting |= PPosition;
1633 return window_prompting;
1634 break;
1635
1636 case USPosition: /* Got the position, need the size. */
1637 window_prompting |= PSize;
1638 return window_prompting;
1639 break;
1640
1641 case 0: /* Got nothing, take both from geometry. */
1642 window_prompting |= PPosition | PSize;
1643 return window_prompting;
1644 break;
1645
1646 default:
1647 /* Somehow a bit got set in window_prompting that we didn't
1648 put there. */
1649 abort ();
1650 }
1651 #endif
1652 return window_prompting;
1653 }
1654
1655 #if !defined (HAVE_X11R4) && !defined (HAVE_XSETWMPROTOCOLS)
1656
1657 Status
1658 XSetWMProtocols (dpy, w, protocols, count)
1659 Display *dpy;
1660 Window w;
1661 Atom *protocols;
1662 int count;
1663 {
1664 Atom prop;
1665 prop = XInternAtom (dpy, "WM_PROTOCOLS", False);
1666 if (prop == None) return False;
1667 XChangeProperty (dpy, w, prop, XA_ATOM, 32, PropModeReplace,
1668 (unsigned char *) protocols, count);
1669 return True;
1670 }
1671 #endif /* not HAVE_X11R4 && not HAVE_XSETWMPROTOCOLS */
1672 \f
1673 #ifdef USE_X_TOOLKIT
1674
1675 /* If the WM_PROTOCOLS property does not already contain WM_TAKE_FOCUS
1676 and WM_DELETE_WINDOW, then add them. (They may already be present
1677 because of the toolkit (Motif adds them, for example, but Xt doesn't). */
1678
1679 static void
1680 hack_wm_protocols (widget)
1681 Widget widget;
1682 {
1683 Display *dpy = XtDisplay (widget);
1684 Window w = XtWindow (widget);
1685 int need_delete = 1;
1686 int need_focus = 1;
1687
1688 BLOCK_INPUT;
1689 {
1690 Atom type, *atoms = 0;
1691 int format = 0;
1692 unsigned long nitems = 0;
1693 unsigned long bytes_after;
1694
1695 if (Success == XGetWindowProperty (dpy, w, Xatom_wm_protocols,
1696 0, 100, False, XA_ATOM,
1697 &type, &format, &nitems, &bytes_after,
1698 (unsigned char **) &atoms)
1699 && format == 32 && type == XA_ATOM)
1700 while (nitems > 0)
1701 {
1702 nitems--;
1703 if (atoms [nitems] == Xatom_wm_delete_window) need_delete = 0;
1704 else if (atoms [nitems] == Xatom_wm_take_focus) need_focus = 0;
1705 }
1706 if (atoms) XFree ((char *) atoms);
1707 }
1708 {
1709 Atom props [10];
1710 int count = 0;
1711 if (need_delete) props [count++] = Xatom_wm_delete_window;
1712 if (need_focus) props [count++] = Xatom_wm_take_focus;
1713 if (count)
1714 XChangeProperty (dpy, w, Xatom_wm_protocols, XA_ATOM, 32, PropModeAppend,
1715 (unsigned char *) props, count);
1716 }
1717 UNBLOCK_INPUT;
1718 }
1719 #endif
1720 \f
1721 #ifdef USE_X_TOOLKIT
1722
1723 /* Create and set up the X widget for frame F. */
1724
1725 static void
1726 x_window (f, window_prompting, minibuffer_only)
1727 struct frame *f;
1728 long window_prompting;
1729 int minibuffer_only;
1730 {
1731 XClassHint class_hints;
1732 XSetWindowAttributes attributes;
1733 unsigned long attribute_mask;
1734
1735 Widget shell_widget;
1736 Widget pane_widget;
1737 Widget screen_widget;
1738 char* name;
1739 Arg al [25];
1740 int ac;
1741
1742 BLOCK_INPUT;
1743
1744 if (STRINGP (f->name))
1745 name = (char*) XSTRING (f->name)->data;
1746 else
1747 name = "emacs";
1748
1749 ac = 0;
1750 XtSetArg (al[ac], XtNallowShellResize, 1); ac++;
1751 XtSetArg (al[ac], XtNinput, 1); ac++;
1752 shell_widget = XtCreatePopupShell ("shell",
1753 topLevelShellWidgetClass,
1754 Xt_app_shell, al, ac);
1755
1756 f->display.x->widget = shell_widget;
1757 /* maybe_set_screen_title_format (shell_widget); */
1758
1759
1760 ac = 0;
1761 XtSetArg (al[ac], XtNborderWidth, 0); ac++;
1762 pane_widget = XtCreateWidget ("pane",
1763 panedWidgetClass,
1764 shell_widget, al, ac);
1765
1766 f->display.x->column_widget = pane_widget;
1767
1768 if (!minibuffer_only && FRAME_MENU_BAR_LINES (f) > 0)
1769 initialize_frame_menubar (f);
1770
1771 /* mappedWhenManaged to false tells to the paned window to not map/unmap
1772 * the emacs screen when changing menubar. This reduces flickering a lot.
1773 */
1774
1775 ac = 0;
1776 XtSetArg (al[ac], XtNmappedWhenManaged, 0); ac++;
1777 XtSetArg (al[ac], XtNshowGrip, 0); ac++;
1778 XtSetArg (al[ac], XtNallowResize, 1); ac++;
1779 XtSetArg (al[ac], XtNresizeToPreferred, 1); ac++;
1780 XtSetArg (al[ac], XtNemacsFrame, f); ac++;
1781 screen_widget = XtCreateWidget (name,
1782 emacsFrameClass,
1783 pane_widget, al, ac);
1784
1785 f->display.x->edit_widget = screen_widget;
1786
1787 if (f->display.x->menubar_widget)
1788 XtManageChild (f->display.x->menubar_widget);
1789 XtManageChild (screen_widget);
1790
1791 /* Do some needed geometry management. */
1792 {
1793 int len;
1794 char *tem, shell_position[32];
1795 Arg al[2];
1796 int ac = 0;
1797 int menubar_size
1798 = (f->display.x->menubar_widget
1799 ? (f->display.x->menubar_widget->core.height
1800 + f->display.x->menubar_widget->core.border_width)
1801 : 0);
1802
1803 if (window_prompting & USPosition)
1804 {
1805 int left = f->display.x->left_pos;
1806 int xneg = left < 0;
1807 int top = f->display.x->top_pos;
1808 int yneg = top < 0;
1809 if (left < 0)
1810 left = -left;
1811 if (top < 0)
1812 top = -top;
1813 sprintf (shell_position, "=%dx%d%c%d%c%d", PIXEL_WIDTH (f),
1814 PIXEL_HEIGHT (f) + menubar_size,
1815 (xneg ? '-' : '+'), left,
1816 (yneg ? '-' : '+'), top);
1817 }
1818 else
1819 sprintf (shell_position, "=%dx%d", PIXEL_WIDTH (f),
1820 PIXEL_HEIGHT (f) + menubar_size);
1821 len = strlen (shell_position) + 1;
1822 tem = (char *) xmalloc (len);
1823 strncpy (tem, shell_position, len);
1824 XtSetArg (al[ac], XtNgeometry, tem); ac++;
1825 XtSetValues (shell_widget, al, ac);
1826 }
1827
1828 x_calc_absolute_position (f);
1829
1830 XtManageChild (pane_widget);
1831 XtRealizeWidget (shell_widget);
1832
1833 FRAME_X_WINDOW (f) = XtWindow (screen_widget);
1834
1835 validate_x_resource_name ();
1836 class_hints.res_name = (char *) XSTRING (Vx_resource_name)->data;
1837 class_hints.res_class = EMACS_CLASS;
1838 XSetClassHint (x_current_display, XtWindow (shell_widget), &class_hints);
1839
1840 hack_wm_protocols (shell_widget);
1841
1842 /* Do a stupid property change to force the server to generate a
1843 propertyNotify event so that the event_stream server timestamp will
1844 be initialized to something relevant to the time we created the window.
1845 */
1846 XChangeProperty (XtDisplay (screen_widget), XtWindow (screen_widget),
1847 Xatom_wm_protocols, XA_ATOM, 32, PropModeAppend,
1848 (unsigned char*) NULL, 0);
1849
1850 /* Make all the standard events reach the Emacs frame. */
1851 attributes.event_mask = STANDARD_EVENT_SET;
1852 attribute_mask = CWEventMask;
1853 XChangeWindowAttributes (XtDisplay (shell_widget), XtWindow (shell_widget),
1854 attribute_mask, &attributes);
1855
1856 XtMapWidget (screen_widget);
1857
1858 /* x_set_name normally ignores requests to set the name if the
1859 requested name is the same as the current name. This is the one
1860 place where that assumption isn't correct; f->name is set, but
1861 the X server hasn't been told. */
1862 {
1863 Lisp_Object name;
1864 int explicit = f->explicit_name;
1865
1866 f->explicit_name = 0;
1867 name = f->name;
1868 f->name = Qnil;
1869 x_set_name (f, name, explicit);
1870 }
1871
1872 XDefineCursor (XDISPLAY FRAME_X_WINDOW (f),
1873 f->display.x->text_cursor);
1874
1875 UNBLOCK_INPUT;
1876
1877 if (FRAME_X_WINDOW (f) == 0)
1878 error ("Unable to create window");
1879 }
1880
1881 #else /* not USE_X_TOOLKIT */
1882
1883 /* Create and set up the X window for frame F. */
1884
1885 x_window (f)
1886 struct frame *f;
1887
1888 {
1889 XClassHint class_hints;
1890 XSetWindowAttributes attributes;
1891 unsigned long attribute_mask;
1892
1893 attributes.background_pixel = f->display.x->background_pixel;
1894 attributes.border_pixel = f->display.x->border_pixel;
1895 attributes.bit_gravity = StaticGravity;
1896 attributes.backing_store = NotUseful;
1897 attributes.save_under = True;
1898 attributes.event_mask = STANDARD_EVENT_SET;
1899 attribute_mask = (CWBackPixel | CWBorderPixel | CWBitGravity
1900 #if 0
1901 | CWBackingStore | CWSaveUnder
1902 #endif
1903 | CWEventMask);
1904
1905 BLOCK_INPUT;
1906 FRAME_X_WINDOW (f)
1907 = XCreateWindow (x_current_display, ROOT_WINDOW,
1908 f->display.x->left_pos,
1909 f->display.x->top_pos,
1910 PIXEL_WIDTH (f), PIXEL_HEIGHT (f),
1911 f->display.x->border_width,
1912 CopyFromParent, /* depth */
1913 InputOutput, /* class */
1914 screen_visual, /* set in Fx_open_connection */
1915 attribute_mask, &attributes);
1916
1917 validate_x_resource_name ();
1918 class_hints.res_name = (char *) XSTRING (Vx_resource_name)->data;
1919 class_hints.res_class = EMACS_CLASS;
1920 XSetClassHint (x_current_display, FRAME_X_WINDOW (f), &class_hints);
1921
1922 /* This indicates that we use the "Passive Input" input model.
1923 Unless we do this, we don't get the Focus{In,Out} events that we
1924 need to draw the cursor correctly. Accursed bureaucrats.
1925 XWhipsAndChains (x_current_display, IronMaiden, &TheRack); */
1926
1927 f->display.x->wm_hints.input = True;
1928 f->display.x->wm_hints.flags |= InputHint;
1929 XSetWMHints (x_current_display, FRAME_X_WINDOW (f), &f->display.x->wm_hints);
1930 XSetWMProtocols (x_current_display, FRAME_X_WINDOW (f),
1931 &Xatom_wm_delete_window, 1);
1932
1933
1934 /* x_set_name normally ignores requests to set the name if the
1935 requested name is the same as the current name. This is the one
1936 place where that assumption isn't correct; f->name is set, but
1937 the X server hasn't been told. */
1938 {
1939 Lisp_Object name;
1940 int explicit = f->explicit_name;
1941
1942 f->explicit_name = 0;
1943 name = f->name;
1944 f->name = Qnil;
1945 x_set_name (f, name, explicit);
1946 }
1947
1948 XDefineCursor (XDISPLAY FRAME_X_WINDOW (f),
1949 f->display.x->text_cursor);
1950
1951 UNBLOCK_INPUT;
1952
1953 if (FRAME_X_WINDOW (f) == 0)
1954 error ("Unable to create window");
1955 }
1956
1957 #endif /* not USE_X_TOOLKIT */
1958
1959 /* Handle the icon stuff for this window. Perhaps later we might
1960 want an x_set_icon_position which can be called interactively as
1961 well. */
1962
1963 static void
1964 x_icon (f, parms)
1965 struct frame *f;
1966 Lisp_Object parms;
1967 {
1968 Lisp_Object icon_x, icon_y;
1969
1970 /* Set the position of the icon. Note that twm groups all
1971 icons in an icon window. */
1972 icon_x = x_get_arg (parms, Qicon_left, 0, 0, number);
1973 icon_y = x_get_arg (parms, Qicon_top, 0, 0, number);
1974 if (!EQ (icon_x, Qunbound) && !EQ (icon_y, Qunbound))
1975 {
1976 CHECK_NUMBER (icon_x, 0);
1977 CHECK_NUMBER (icon_y, 0);
1978 }
1979 else if (!EQ (icon_x, Qunbound) || !EQ (icon_y, Qunbound))
1980 error ("Both left and top icon corners of icon must be specified");
1981
1982 BLOCK_INPUT;
1983
1984 if (! EQ (icon_x, Qunbound))
1985 x_wm_set_icon_position (f, XINT (icon_x), XINT (icon_y));
1986
1987 /* Start up iconic or window? */
1988 x_wm_set_window_state
1989 (f, (EQ (x_get_arg (parms, Qvisibility, 0, 0, symbol), Qicon)
1990 ? IconicState
1991 : NormalState));
1992
1993 UNBLOCK_INPUT;
1994 }
1995
1996 /* Make the GC's needed for this window, setting the
1997 background, border and mouse colors; also create the
1998 mouse cursor and the gray border tile. */
1999
2000 static char cursor_bits[] =
2001 {
2002 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
2003 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
2004 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
2005 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00
2006 };
2007
2008 static void
2009 x_make_gc (f)
2010 struct frame *f;
2011 {
2012 XGCValues gc_values;
2013 GC temp_gc;
2014 XImage tileimage;
2015
2016 BLOCK_INPUT;
2017
2018 /* Create the GC's of this frame.
2019 Note that many default values are used. */
2020
2021 /* Normal video */
2022 gc_values.font = f->display.x->font->fid;
2023 gc_values.foreground = f->display.x->foreground_pixel;
2024 gc_values.background = f->display.x->background_pixel;
2025 gc_values.line_width = 0; /* Means 1 using fast algorithm. */
2026 f->display.x->normal_gc = XCreateGC (x_current_display,
2027 FRAME_X_WINDOW (f),
2028 GCLineWidth | GCFont
2029 | GCForeground | GCBackground,
2030 &gc_values);
2031
2032 /* Reverse video style. */
2033 gc_values.foreground = f->display.x->background_pixel;
2034 gc_values.background = f->display.x->foreground_pixel;
2035 f->display.x->reverse_gc = XCreateGC (x_current_display,
2036 FRAME_X_WINDOW (f),
2037 GCFont | GCForeground | GCBackground
2038 | GCLineWidth,
2039 &gc_values);
2040
2041 /* Cursor has cursor-color background, background-color foreground. */
2042 gc_values.foreground = f->display.x->background_pixel;
2043 gc_values.background = f->display.x->cursor_pixel;
2044 gc_values.fill_style = FillOpaqueStippled;
2045 gc_values.stipple
2046 = XCreateBitmapFromData (x_current_display, ROOT_WINDOW,
2047 cursor_bits, 16, 16);
2048 f->display.x->cursor_gc
2049 = XCreateGC (x_current_display, FRAME_X_WINDOW (f),
2050 (GCFont | GCForeground | GCBackground
2051 | GCFillStyle | GCStipple | GCLineWidth),
2052 &gc_values);
2053
2054 /* Create the gray border tile used when the pointer is not in
2055 the frame. Since this depends on the frame's pixel values,
2056 this must be done on a per-frame basis. */
2057 f->display.x->border_tile
2058 = (XCreatePixmapFromBitmapData
2059 (x_current_display, ROOT_WINDOW,
2060 gray_bits, gray_width, gray_height,
2061 f->display.x->foreground_pixel,
2062 f->display.x->background_pixel,
2063 DefaultDepth (x_current_display, XDefaultScreen (x_current_display))));
2064
2065 UNBLOCK_INPUT;
2066 }
2067 #endif /* HAVE_X11 */
2068
2069 DEFUN ("x-create-frame", Fx_create_frame, Sx_create_frame,
2070 1, 1, 0,
2071 "Make a new X window, which is called a \"frame\" in Emacs terms.\n\
2072 Return an Emacs frame object representing the X window.\n\
2073 ALIST is an alist of frame parameters.\n\
2074 If the parameters specify that the frame should not have a minibuffer,\n\
2075 and do not specify a specific minibuffer window to use,\n\
2076 then `default-minibuffer-frame' must be a frame whose minibuffer can\n\
2077 be shared by the new frame.")
2078 (parms)
2079 Lisp_Object parms;
2080 {
2081 #ifdef HAVE_X11
2082 struct frame *f;
2083 Lisp_Object frame, tem;
2084 Lisp_Object name;
2085 int minibuffer_only = 0;
2086 long window_prompting = 0;
2087 int width, height;
2088 int count = specpdl_ptr - specpdl;
2089
2090 check_x ();
2091
2092 name = x_get_arg (parms, Qname, "title", "Title", string);
2093 if (XTYPE (name) != Lisp_String
2094 && ! EQ (name, Qunbound)
2095 && ! NILP (name))
2096 error ("x-create-frame: name parameter must be a string");
2097
2098 tem = x_get_arg (parms, Qminibuffer, 0, 0, symbol);
2099 if (EQ (tem, Qnone) || NILP (tem))
2100 f = make_frame_without_minibuffer (Qnil);
2101 else if (EQ (tem, Qonly))
2102 {
2103 f = make_minibuffer_frame ();
2104 minibuffer_only = 1;
2105 }
2106 else if (XTYPE (tem) == Lisp_Window)
2107 f = make_frame_without_minibuffer (tem);
2108 else
2109 f = make_frame (1);
2110
2111 /* Note that X Windows does support scroll bars. */
2112 FRAME_CAN_HAVE_SCROLL_BARS (f) = 1;
2113
2114 /* Set the name; the functions to which we pass f expect the name to
2115 be set. */
2116 if (EQ (name, Qunbound) || NILP (name))
2117 {
2118 f->name = build_string (x_id_name);
2119 f->explicit_name = 0;
2120 }
2121 else
2122 {
2123 f->name = name;
2124 f->explicit_name = 1;
2125 /* use the frame's title when getting resources for this frame. */
2126 specbind (Qx_resource_name, name);
2127 }
2128
2129 XSET (frame, Lisp_Frame, f);
2130 f->output_method = output_x_window;
2131 f->display.x = (struct x_display *) xmalloc (sizeof (struct x_display));
2132 bzero (f->display.x, sizeof (struct x_display));
2133
2134 /* Note that the frame has no physical cursor right now. */
2135 f->phys_cursor_x = -1;
2136
2137 /* Extract the window parameters from the supplied values
2138 that are needed to determine window geometry. */
2139 {
2140 Lisp_Object font;
2141
2142 font = x_get_arg (parms, Qfont, "font", "Font", string);
2143 BLOCK_INPUT;
2144 /* First, try whatever font the caller has specified. */
2145 if (STRINGP (font))
2146 font = x_new_font (f, XSTRING (font)->data);
2147 /* Try out a font which we hope has bold and italic variations. */
2148 if (!STRINGP (font))
2149 font = x_new_font (f, "-misc-fixed-medium-r-normal-*-*-120-*-*-c-*-iso8859-1");
2150 if (! STRINGP (font))
2151 font = x_new_font (f, "-*-*-medium-r-normal-*-*-120-*-*-c-*-iso8859-1");
2152 if (! STRINGP (font))
2153 /* This was formerly the first thing tried, but it finds too many fonts
2154 and takes too long. */
2155 font = x_new_font (f, "-*-*-medium-r-*-*-*-*-*-*-c-*-iso8859-1");
2156 /* If those didn't work, look for something which will at least work. */
2157 if (! STRINGP (font))
2158 font = x_new_font (f, "-*-fixed-*-*-*-*-*-120-*-*-c-*-iso8859-1");
2159 UNBLOCK_INPUT;
2160 if (! STRINGP (font))
2161 font = build_string ("fixed");
2162
2163 x_default_parameter (f, parms, Qfont, font,
2164 "font", "Font", string);
2165 }
2166
2167 x_default_parameter (f, parms, Qborder_width, make_number (2),
2168 "borderwidth", "BorderWidth", number);
2169 /* This defaults to 2 in order to match xterm. We recognize either
2170 internalBorderWidth or internalBorder (which is what xterm calls
2171 it). */
2172 if (NILP (Fassq (Qinternal_border_width, parms)))
2173 {
2174 Lisp_Object value;
2175
2176 value = x_get_arg (parms, Qinternal_border_width,
2177 "internalBorder", "BorderWidth", number);
2178 if (! EQ (value, Qunbound))
2179 parms = Fcons (Fcons (Qinternal_border_width, value),
2180 parms);
2181 }
2182 x_default_parameter (f, parms, Qinternal_border_width, make_number (2),
2183 "internalBorderWidth", "BorderWidth", number);
2184 x_default_parameter (f, parms, Qvertical_scroll_bars, Qt,
2185 "verticalScrollBars", "ScrollBars", boolean);
2186
2187 /* Also do the stuff which must be set before the window exists. */
2188 x_default_parameter (f, parms, Qforeground_color, build_string ("black"),
2189 "foreground", "Foreground", string);
2190 x_default_parameter (f, parms, Qbackground_color, build_string ("white"),
2191 "background", "Background", string);
2192 x_default_parameter (f, parms, Qmouse_color, build_string ("black"),
2193 "pointerColor", "Foreground", string);
2194 x_default_parameter (f, parms, Qcursor_color, build_string ("black"),
2195 "cursorColor", "Foreground", string);
2196 x_default_parameter (f, parms, Qborder_color, build_string ("black"),
2197 "borderColor", "BorderColor", string);
2198
2199 x_default_parameter (f, parms, Qmenu_bar_lines, make_number (0),
2200 "menuBarLines", "MenuBarLines", number);
2201
2202 f->display.x->parent_desc = ROOT_WINDOW;
2203 window_prompting = x_figure_window_size (f, parms);
2204
2205 switch (((f->display.x->left_pos < 0) << 1) + (f->display.x->top_pos < 0))
2206 {
2207 case 0:
2208 f->display.x->win_gravity = NorthWestGravity;
2209 break;
2210 case 1:
2211 f->display.x->win_gravity = SouthWestGravity;
2212 break;
2213 case 2:
2214 f->display.x->win_gravity = NorthEastGravity;
2215 break;
2216 case 3:
2217 f->display.x->win_gravity = SouthEastGravity;
2218 break;
2219 }
2220
2221 #ifdef USE_X_TOOLKIT
2222 x_window (f, window_prompting, minibuffer_only);
2223 #else
2224 x_window (f);
2225 #endif
2226 x_icon (f, parms);
2227 x_make_gc (f);
2228 init_frame_faces (f);
2229
2230 /* We need to do this after creating the X window, so that the
2231 icon-creation functions can say whose icon they're describing. */
2232 x_default_parameter (f, parms, Qicon_type, Qnil,
2233 "bitmapIcon", "BitmapIcon", symbol);
2234
2235 x_default_parameter (f, parms, Qauto_raise, Qnil,
2236 "autoRaise", "AutoRaiseLower", boolean);
2237 x_default_parameter (f, parms, Qauto_lower, Qnil,
2238 "autoLower", "AutoRaiseLower", boolean);
2239 x_default_parameter (f, parms, Qcursor_type, Qbox,
2240 "cursorType", "CursorType", symbol);
2241
2242 /* Dimensions, especially f->height, must be done via change_frame_size.
2243 Change will not be effected unless different from the current
2244 f->height. */
2245 width = f->width;
2246 height = f->height;
2247 f->height = f->width = 0;
2248 change_frame_size (f, height, width, 1, 0);
2249
2250 /* With the toolkit, the geometry management is done in x_window. */
2251 #ifndef USE_X_TOOLKIT
2252 BLOCK_INPUT;
2253 x_wm_set_size_hint (f, window_prompting, 1);
2254 UNBLOCK_INPUT;
2255 #endif /* USE_X_TOOLKIT */
2256
2257 tem = x_get_arg (parms, Qunsplittable, 0, 0, boolean);
2258 f->no_split = minibuffer_only || EQ (tem, Qt);
2259
2260 /* It is now ok to make the frame official
2261 even if we get an error below.
2262 And the frame needs to be on Vframe_list
2263 or making it visible won't work. */
2264 Vframe_list = Fcons (frame, Vframe_list);
2265
2266 /* Make the window appear on the frame and enable display,
2267 unless the caller says not to. */
2268 {
2269 Lisp_Object visibility;
2270
2271 visibility = x_get_arg (parms, Qvisibility, 0, 0, symbol);
2272 if (EQ (visibility, Qunbound))
2273 visibility = Qt;
2274
2275 if (EQ (visibility, Qicon))
2276 x_iconify_frame (f);
2277 else if (! NILP (visibility))
2278 x_make_frame_visible (f);
2279 else
2280 /* Must have been Qnil. */
2281 ;
2282 }
2283
2284 return unbind_to (count, frame);
2285 #else /* X10 */
2286 struct frame *f;
2287 Lisp_Object frame, tem;
2288 Lisp_Object name;
2289 int pixelwidth, pixelheight;
2290 Cursor cursor;
2291 int height, width;
2292 Window parent;
2293 Pixmap temp;
2294 int minibuffer_only = 0;
2295 Lisp_Object vscroll, hscroll;
2296
2297 if (x_current_display == 0)
2298 error ("X windows are not in use or not initialized");
2299
2300 name = Fassq (Qname, parms);
2301
2302 tem = x_get_arg (parms, Qminibuffer, 0, 0, symbol);
2303 if (EQ (tem, Qnone))
2304 f = make_frame_without_minibuffer (Qnil);
2305 else if (EQ (tem, Qonly))
2306 {
2307 f = make_minibuffer_frame ();
2308 minibuffer_only = 1;
2309 }
2310 else if (EQ (tem, Qnil) || EQ (tem, Qunbound))
2311 f = make_frame (1);
2312 else
2313 f = make_frame_without_minibuffer (tem);
2314
2315 parent = ROOT_WINDOW;
2316
2317 XSET (frame, Lisp_Frame, f);
2318 f->output_method = output_x_window;
2319 f->display.x = (struct x_display *) xmalloc (sizeof (struct x_display));
2320 bzero (f->display.x, sizeof (struct x_display));
2321
2322 /* Some temporary default values for height and width. */
2323 width = 80;
2324 height = 40;
2325 f->display.x->left_pos = -1;
2326 f->display.x->top_pos = -1;
2327
2328 /* Give the frame a default name (which may be overridden with PARMS). */
2329
2330 strncpy (iconidentity, ICONTAG, MAXICID);
2331 if (gethostname (&iconidentity[sizeof (ICONTAG) - 1],
2332 (MAXICID - 1) - sizeof (ICONTAG)))
2333 iconidentity[sizeof (ICONTAG) - 2] = '\0';
2334 f->name = build_string (iconidentity);
2335
2336 /* Extract some window parameters from the supplied values.
2337 These are the parameters that affect window geometry. */
2338
2339 tem = x_get_arg (parms, Qfont, "BodyFont", 0, string);
2340 if (EQ (tem, Qunbound))
2341 tem = build_string ("9x15");
2342 x_set_font (f, tem, Qnil);
2343 x_default_parameter (f, parms, Qborder_color,
2344 build_string ("black"), "Border", 0, string);
2345 x_default_parameter (f, parms, Qbackground_color,
2346 build_string ("white"), "Background", 0, string);
2347 x_default_parameter (f, parms, Qforeground_color,
2348 build_string ("black"), "Foreground", 0, string);
2349 x_default_parameter (f, parms, Qmouse_color,
2350 build_string ("black"), "Mouse", 0, string);
2351 x_default_parameter (f, parms, Qcursor_color,
2352 build_string ("black"), "Cursor", 0, string);
2353 x_default_parameter (f, parms, Qborder_width,
2354 make_number (2), "BorderWidth", 0, number);
2355 x_default_parameter (f, parms, Qinternal_border_width,
2356 make_number (4), "InternalBorderWidth", 0, number);
2357 x_default_parameter (f, parms, Qauto_raise,
2358 Qnil, "AutoRaise", 0, boolean);
2359
2360 hscroll = EQ (x_get_arg (parms, Qhorizontal_scroll_bar, 0, 0, boolean), Qt);
2361 vscroll = EQ (x_get_arg (parms, Qvertical_scroll_bar, 0, 0, boolean), Qt);
2362
2363 if (f->display.x->internal_border_width < 0)
2364 f->display.x->internal_border_width = 0;
2365
2366 tem = x_get_arg (parms, Qwindow_id, 0, 0, number);
2367 if (!EQ (tem, Qunbound))
2368 {
2369 WINDOWINFO_TYPE wininfo;
2370 int nchildren;
2371 Window *children, root;
2372
2373 CHECK_NUMBER (tem, 0);
2374 FRAME_X_WINDOW (f) = (Window) XINT (tem);
2375
2376 BLOCK_INPUT;
2377 XGetWindowInfo (FRAME_X_WINDOW (f), &wininfo);
2378 XQueryTree (FRAME_X_WINDOW (f), &parent, &nchildren, &children);
2379 xfree (children);
2380 UNBLOCK_INPUT;
2381
2382 height = PIXEL_TO_CHAR_HEIGHT (f, wininfo.height);
2383 width = PIXEL_TO_CHAR_WIDTH (f, wininfo.width);
2384 f->display.x->left_pos = wininfo.x;
2385 f->display.x->top_pos = wininfo.y;
2386 FRAME_SET_VISIBILITY (f, wininfo.mapped != 0);
2387 f->display.x->border_width = wininfo.bdrwidth;
2388 f->display.x->parent_desc = parent;
2389 }
2390 else
2391 {
2392 tem = x_get_arg (parms, Qparent_id, 0, 0, number);
2393 if (!EQ (tem, Qunbound))
2394 {
2395 CHECK_NUMBER (tem, 0);
2396 parent = (Window) XINT (tem);
2397 }
2398 f->display.x->parent_desc = parent;
2399 tem = x_get_arg (parms, Qheight, 0, 0, number);
2400 if (EQ (tem, Qunbound))
2401 {
2402 tem = x_get_arg (parms, Qwidth, 0, 0, number);
2403 if (EQ (tem, Qunbound))
2404 {
2405 tem = x_get_arg (parms, Qtop, 0, 0, number);
2406 if (EQ (tem, Qunbound))
2407 tem = x_get_arg (parms, Qleft, 0, 0, number);
2408 }
2409 }
2410 /* Now TEM is Qunbound if no edge or size was specified.
2411 In that case, we must do rubber-banding. */
2412 if (EQ (tem, Qunbound))
2413 {
2414 tem = x_get_arg (parms, Qgeometry, 0, 0, number);
2415 x_rubber_band (f,
2416 &f->display.x->left_pos, &f->display.x->top_pos,
2417 &width, &height,
2418 (XTYPE (tem) == Lisp_String
2419 ? (char *) XSTRING (tem)->data : ""),
2420 XSTRING (f->name)->data,
2421 !NILP (hscroll), !NILP (vscroll));
2422 }
2423 else
2424 {
2425 /* Here if at least one edge or size was specified.
2426 Demand that they all were specified, and use them. */
2427 tem = x_get_arg (parms, Qheight, 0, 0, number);
2428 if (EQ (tem, Qunbound))
2429 error ("Height not specified");
2430 CHECK_NUMBER (tem, 0);
2431 height = XINT (tem);
2432
2433 tem = x_get_arg (parms, Qwidth, 0, 0, number);
2434 if (EQ (tem, Qunbound))
2435 error ("Width not specified");
2436 CHECK_NUMBER (tem, 0);
2437 width = XINT (tem);
2438
2439 tem = x_get_arg (parms, Qtop, 0, 0, number);
2440 if (EQ (tem, Qunbound))
2441 error ("Top position not specified");
2442 CHECK_NUMBER (tem, 0);
2443 f->display.x->left_pos = XINT (tem);
2444
2445 tem = x_get_arg (parms, Qleft, 0, 0, number);
2446 if (EQ (tem, Qunbound))
2447 error ("Left position not specified");
2448 CHECK_NUMBER (tem, 0);
2449 f->display.x->top_pos = XINT (tem);
2450 }
2451
2452 pixelwidth = CHAR_TO_PIXEL_WIDTH (f, width);
2453 pixelheight = CHAR_TO_PIXEL_HEIGHT (f, height);
2454
2455 BLOCK_INPUT;
2456 FRAME_X_WINDOW (f)
2457 = XCreateWindow (parent,
2458 f->display.x->left_pos, /* Absolute horizontal offset */
2459 f->display.x->top_pos, /* Absolute Vertical offset */
2460 pixelwidth, pixelheight,
2461 f->display.x->border_width,
2462 BLACK_PIX_DEFAULT, WHITE_PIX_DEFAULT);
2463 UNBLOCK_INPUT;
2464 if (FRAME_X_WINDOW (f) == 0)
2465 error ("Unable to create window.");
2466 }
2467
2468 /* Install the now determined height and width
2469 in the windows and in phys_lines and desired_lines. */
2470 change_frame_size (f, height, width, 1, 0);
2471 XSelectInput (FRAME_X_WINDOW (f), KeyPressed | ExposeWindow
2472 | ButtonPressed | ButtonReleased | ExposeRegion | ExposeCopy
2473 | EnterWindow | LeaveWindow | UnmapWindow );
2474 x_set_resize_hint (f);
2475
2476 /* Tell the server the window's default name. */
2477 XStoreName (XDISPLAY FRAME_X_WINDOW (f), XSTRING (f->name)->data);
2478
2479 /* Now override the defaults with all the rest of the specified
2480 parms. */
2481 tem = x_get_arg (parms, Qunsplittable, 0, 0, boolean);
2482 f->no_split = minibuffer_only || EQ (tem, Qt);
2483
2484 /* Do not create an icon window if the caller says not to */
2485 if (!EQ (x_get_arg (parms, Qsuppress_icon, 0, 0, boolean), Qt)
2486 || f->display.x->parent_desc != ROOT_WINDOW)
2487 {
2488 x_text_icon (f, iconidentity);
2489 x_default_parameter (f, parms, Qicon_type, Qnil,
2490 "BitmapIcon", 0, symbol);
2491 }
2492
2493 /* Tell the X server the previously set values of the
2494 background, border and mouse colors; also create the mouse cursor. */
2495 BLOCK_INPUT;
2496 temp = XMakeTile (f->display.x->background_pixel);
2497 XChangeBackground (FRAME_X_WINDOW (f), temp);
2498 XFreePixmap (temp);
2499 UNBLOCK_INPUT;
2500 x_set_border_pixel (f, f->display.x->border_pixel);
2501
2502 x_set_mouse_color (f, Qnil, Qnil);
2503
2504 /* Now override the defaults with all the rest of the specified parms. */
2505
2506 Fmodify_frame_parameters (frame, parms);
2507
2508 /* Make the window appear on the frame and enable display. */
2509 {
2510 Lisp_Object visibility;
2511
2512 visibility = x_get_arg (parms, Qvisibility, 0, 0, symbol);
2513 if (EQ (visibility, Qunbound))
2514 visibility = Qt;
2515
2516 if (! EQ (visibility, Qicon)
2517 && ! NILP (visibility))
2518 x_make_window_visible (f);
2519 }
2520
2521 SET_FRAME_GARBAGED (f);
2522
2523 Vframe_list = Fcons (frame, Vframe_list);
2524 return frame;
2525 #endif /* X10 */
2526 }
2527
2528 Lisp_Object
2529 x_get_focus_frame ()
2530 {
2531 Lisp_Object xfocus;
2532 if (! x_focus_frame)
2533 return Qnil;
2534
2535 XSET (xfocus, Lisp_Frame, x_focus_frame);
2536 return xfocus;
2537 }
2538
2539 DEFUN ("focus-frame", Ffocus_frame, Sfocus_frame, 1, 1, 0,
2540 "Set the focus on FRAME.")
2541 (frame)
2542 Lisp_Object frame;
2543 {
2544 CHECK_LIVE_FRAME (frame, 0);
2545
2546 if (FRAME_X_P (XFRAME (frame)))
2547 {
2548 BLOCK_INPUT;
2549 x_focus_on_frame (XFRAME (frame));
2550 UNBLOCK_INPUT;
2551 return frame;
2552 }
2553
2554 return Qnil;
2555 }
2556
2557 DEFUN ("unfocus-frame", Funfocus_frame, Sunfocus_frame, 0, 0, 0,
2558 "If a frame has been focused, release it.")
2559 ()
2560 {
2561 if (x_focus_frame)
2562 {
2563 BLOCK_INPUT;
2564 x_unfocus_frame (x_focus_frame);
2565 UNBLOCK_INPUT;
2566 }
2567
2568 return Qnil;
2569 }
2570 \f
2571 #ifndef HAVE_X11
2572 /* Computes an X-window size and position either from geometry GEO
2573 or with the mouse.
2574
2575 F is a frame. It specifies an X window which is used to
2576 determine which display to compute for. Its font, borders
2577 and colors control how the rectangle will be displayed.
2578
2579 X and Y are where to store the positions chosen.
2580 WIDTH and HEIGHT are where to store the sizes chosen.
2581
2582 GEO is the geometry that may specify some of the info.
2583 STR is a prompt to display.
2584 HSCROLL and VSCROLL say whether we have horiz and vert scroll bars. */
2585
2586 int
2587 x_rubber_band (f, x, y, width, height, geo, str, hscroll, vscroll)
2588 struct frame *f;
2589 int *x, *y, *width, *height;
2590 char *geo;
2591 char *str;
2592 int hscroll, vscroll;
2593 {
2594 OpaqueFrame frame;
2595 Window tempwindow;
2596 WindowInfo wininfo;
2597 int border_color;
2598 int background_color;
2599 Lisp_Object tem;
2600 int mask;
2601
2602 BLOCK_INPUT;
2603
2604 background_color = f->display.x->background_pixel;
2605 border_color = f->display.x->border_pixel;
2606
2607 frame.bdrwidth = f->display.x->border_width;
2608 frame.border = XMakeTile (border_color);
2609 frame.background = XMakeTile (background_color);
2610 tempwindow = XCreateTerm (str, "emacs", geo, default_window, &frame, 10, 5,
2611 (2 * f->display.x->internal_border_width
2612 + (vscroll ? VSCROLL_WIDTH : 0)),
2613 (2 * f->display.x->internal_border_width
2614 + (hscroll ? HSCROLL_HEIGHT : 0)),
2615 width, height, f->display.x->font,
2616 FONT_WIDTH (f->display.x->font),
2617 f->display.x->line_height);
2618 XFreePixmap (frame.border);
2619 XFreePixmap (frame.background);
2620
2621 if (tempwindow != 0)
2622 {
2623 XQueryWindow (tempwindow, &wininfo);
2624 XDestroyWindow (tempwindow);
2625 *x = wininfo.x;
2626 *y = wininfo.y;
2627 }
2628
2629 /* Coordinates we got are relative to the root window.
2630 Convert them to coordinates relative to desired parent window
2631 by scanning from there up to the root. */
2632 tempwindow = f->display.x->parent_desc;
2633 while (tempwindow != ROOT_WINDOW)
2634 {
2635 int nchildren;
2636 Window *children;
2637 XQueryWindow (tempwindow, &wininfo);
2638 *x -= wininfo.x;
2639 *y -= wininfo.y;
2640 XQueryTree (tempwindow, &tempwindow, &nchildren, &children);
2641 xfree (children);
2642 }
2643
2644 UNBLOCK_INPUT;
2645 return tempwindow != 0;
2646 }
2647 #endif /* not HAVE_X11 */
2648 \f
2649 DEFUN ("x-list-fonts", Fx_list_fonts, Sx_list_fonts, 1, 3, 0,
2650 "Return a list of the names of available fonts matching PATTERN.\n\
2651 If optional arguments FACE and FRAME are specified, return only fonts\n\
2652 the same size as FACE on FRAME.\n\
2653 \n\
2654 PATTERN is a string, perhaps with wildcard characters;\n\
2655 the * character matches any substring, and\n\
2656 the ? character matches any single character.\n\
2657 PATTERN is case-insensitive.\n\
2658 FACE is a face name - a symbol.\n\
2659 \n\
2660 The return value is a list of strings, suitable as arguments to\n\
2661 set-face-font.\n\
2662 \n\
2663 Fonts Emacs can't use (i.e. proportional fonts) may or may not be excluded\n\
2664 even if they match PATTERN and FACE.")
2665 (pattern, face, frame)
2666 Lisp_Object pattern, face, frame;
2667 {
2668 int num_fonts;
2669 char **names;
2670 XFontStruct *info;
2671 XFontStruct *size_ref;
2672 Lisp_Object list;
2673
2674 check_x ();
2675 CHECK_STRING (pattern, 0);
2676 if (!NILP (face))
2677 CHECK_SYMBOL (face, 1);
2678 if (!NILP (frame))
2679 CHECK_LIVE_FRAME (frame, 2);
2680
2681 if (NILP (face))
2682 size_ref = 0;
2683 else
2684 {
2685 FRAME_PTR f = NILP (frame) ? selected_frame : XFRAME (frame);
2686 int face_id;
2687
2688 /* Don't die if we get called with a terminal frame. */
2689 if (! FRAME_X_P (f))
2690 error ("non-X frame used in `x-list-fonts'");
2691
2692 face_id = face_name_id_number (f, face);
2693
2694 if (face_id < 0 || face_id >= FRAME_N_PARAM_FACES (f)
2695 || FRAME_PARAM_FACES (f) [face_id] == 0)
2696 size_ref = f->display.x->font;
2697 else
2698 {
2699 size_ref = FRAME_PARAM_FACES (f) [face_id]->font;
2700 if (size_ref == (XFontStruct *) (~0))
2701 size_ref = f->display.x->font;
2702 }
2703 }
2704
2705 BLOCK_INPUT;
2706
2707 /* Solaris 2.3 has a bug in XListFontsWithInfo. */
2708 #ifdef BROKEN_XLISTFONTSWITHINFO
2709 names = XListFonts (x_current_display,
2710 XSTRING (pattern)->data,
2711 2000, /* maxnames */
2712 &num_fonts); /* count_return */
2713 #else
2714 names = XListFontsWithInfo (x_current_display,
2715 XSTRING (pattern)->data,
2716 2000, /* maxnames */
2717 &num_fonts, /* count_return */
2718 &info); /* info_return */
2719 #endif
2720 UNBLOCK_INPUT;
2721
2722 list = Qnil;
2723
2724 if (names)
2725 {
2726 Lisp_Object *tail;
2727 int i;
2728
2729 tail = &list;
2730 for (i = 0; i < num_fonts; i++)
2731 {
2732 XFontStruct *thisinfo;
2733
2734 #ifdef BROKEN_XLISTFONTSWITHINFO
2735 BLOCK_INPUT;
2736 thisinfo = XLoadQueryFont (x_current_display, names[i]);
2737 UNBLOCK_INPUT;
2738 #else
2739 thisinfo = &info[i];
2740 #endif
2741 if (thisinfo && (! size_ref
2742 || same_size_fonts (thisinfo, size_ref)))
2743 {
2744 *tail = Fcons (build_string (names[i]), Qnil);
2745 tail = &XCONS (*tail)->cdr;
2746 }
2747 }
2748
2749 BLOCK_INPUT;
2750 #ifdef BROKEN_XLISTFONTSWITHINFO
2751 XFreeFontNames (names);
2752 #else
2753 XFreeFontInfo (names, info, num_fonts);
2754 #endif
2755 UNBLOCK_INPUT;
2756 }
2757
2758 return list;
2759 }
2760
2761 \f
2762 DEFUN ("x-color-defined-p", Fx_color_defined_p, Sx_color_defined_p, 1, 1, 0,
2763 "Return t if the current X display supports the color named COLOR.")
2764 (color)
2765 Lisp_Object color;
2766 {
2767 Color foo;
2768
2769 check_x ();
2770 CHECK_STRING (color, 0);
2771
2772 if (defined_color (XSTRING (color)->data, &foo))
2773 return Qt;
2774 else
2775 return Qnil;
2776 }
2777
2778 DEFUN ("x-display-color-p", Fx_display_color_p, Sx_display_color_p, 0, 0, 0,
2779 "Return t if the X screen currently in use supports color.")
2780 ()
2781 {
2782 check_x ();
2783
2784 if (x_screen_planes <= 2)
2785 return Qnil;
2786
2787 switch (screen_visual->class)
2788 {
2789 case StaticColor:
2790 case PseudoColor:
2791 case TrueColor:
2792 case DirectColor:
2793 return Qt;
2794
2795 default:
2796 return Qnil;
2797 }
2798 }
2799
2800 DEFUN ("x-display-pixel-width", Fx_display_pixel_width, Sx_display_pixel_width,
2801 0, 1, 0,
2802 "Returns the width in pixels of the display FRAME is on.")
2803 (frame)
2804 Lisp_Object frame;
2805 {
2806 Display *dpy = x_current_display;
2807 check_x ();
2808 return make_number (DisplayWidth (dpy, DefaultScreen (dpy)));
2809 }
2810
2811 DEFUN ("x-display-pixel-height", Fx_display_pixel_height,
2812 Sx_display_pixel_height, 0, 1, 0,
2813 "Returns the height in pixels of the display FRAME is on.")
2814 (frame)
2815 Lisp_Object frame;
2816 {
2817 Display *dpy = x_current_display;
2818 check_x ();
2819 return make_number (DisplayHeight (dpy, DefaultScreen (dpy)));
2820 }
2821
2822 DEFUN ("x-display-planes", Fx_display_planes, Sx_display_planes,
2823 0, 1, 0,
2824 "Returns the number of bitplanes of the display FRAME is on.")
2825 (frame)
2826 Lisp_Object frame;
2827 {
2828 Display *dpy = x_current_display;
2829 check_x ();
2830 return make_number (DisplayPlanes (dpy, DefaultScreen (dpy)));
2831 }
2832
2833 DEFUN ("x-display-color-cells", Fx_display_color_cells, Sx_display_color_cells,
2834 0, 1, 0,
2835 "Returns the number of color cells of the display FRAME is on.")
2836 (frame)
2837 Lisp_Object frame;
2838 {
2839 Display *dpy = x_current_display;
2840 check_x ();
2841 return make_number (DisplayCells (dpy, DefaultScreen (dpy)));
2842 }
2843
2844 DEFUN ("x-server-max-request-size", Fx_server_max_request_size,
2845 Sx_server_max_request_size,
2846 0, 1, 0,
2847 "Returns the maximum request size of the X server FRAME is using.")
2848 (frame)
2849 Lisp_Object frame;
2850 {
2851 Display *dpy = x_current_display;
2852 check_x ();
2853 return make_number (MAXREQUEST (dpy));
2854 }
2855
2856 DEFUN ("x-server-vendor", Fx_server_vendor, Sx_server_vendor, 0, 1, 0,
2857 "Returns the vendor ID string of the X server FRAME is on.")
2858 (frame)
2859 Lisp_Object frame;
2860 {
2861 Display *dpy = x_current_display;
2862 char *vendor;
2863 check_x ();
2864 vendor = ServerVendor (dpy);
2865 if (! vendor) vendor = "";
2866 return build_string (vendor);
2867 }
2868
2869 DEFUN ("x-server-version", Fx_server_version, Sx_server_version, 0, 1, 0,
2870 "Returns the version numbers of the X server in use.\n\
2871 The value is a list of three integers: the major and minor\n\
2872 version numbers of the X Protocol in use, and the vendor-specific release\n\
2873 number. See also the variable `x-server-vendor'.")
2874 (frame)
2875 Lisp_Object frame;
2876 {
2877 Display *dpy = x_current_display;
2878
2879 check_x ();
2880 return Fcons (make_number (ProtocolVersion (dpy)),
2881 Fcons (make_number (ProtocolRevision (dpy)),
2882 Fcons (make_number (VendorRelease (dpy)), Qnil)));
2883 }
2884
2885 DEFUN ("x-display-screens", Fx_display_screens, Sx_display_screens, 0, 1, 0,
2886 "Returns the number of screens on the X server FRAME is on.")
2887 (frame)
2888 Lisp_Object frame;
2889 {
2890 check_x ();
2891 return make_number (ScreenCount (x_current_display));
2892 }
2893
2894 DEFUN ("x-display-mm-height", Fx_display_mm_height, Sx_display_mm_height, 0, 1, 0,
2895 "Returns the height in millimeters of the X screen FRAME is on.")
2896 (frame)
2897 Lisp_Object frame;
2898 {
2899 check_x ();
2900 return make_number (HeightMMOfScreen (x_screen));
2901 }
2902
2903 DEFUN ("x-display-mm-width", Fx_display_mm_width, Sx_display_mm_width, 0, 1, 0,
2904 "Returns the width in millimeters of the X screen FRAME is on.")
2905 (frame)
2906 Lisp_Object frame;
2907 {
2908 check_x ();
2909 return make_number (WidthMMOfScreen (x_screen));
2910 }
2911
2912 DEFUN ("x-display-backing-store", Fx_display_backing_store,
2913 Sx_display_backing_store, 0, 1, 0,
2914 "Returns an indication of whether the X screen FRAME is on does backing store.\n\
2915 The value may be `always', `when-mapped', or `not-useful'.")
2916 (frame)
2917 Lisp_Object frame;
2918 {
2919 check_x ();
2920
2921 switch (DoesBackingStore (x_screen))
2922 {
2923 case Always:
2924 return intern ("always");
2925
2926 case WhenMapped:
2927 return intern ("when-mapped");
2928
2929 case NotUseful:
2930 return intern ("not-useful");
2931
2932 default:
2933 error ("Strange value for BackingStore parameter of screen");
2934 }
2935 }
2936
2937 DEFUN ("x-display-visual-class", Fx_display_visual_class,
2938 Sx_display_visual_class, 0, 1, 0,
2939 "Returns the visual class of the display `screen' is on.\n\
2940 The value is one of the symbols `static-gray', `gray-scale',\n\
2941 `static-color', `pseudo-color', `true-color', or `direct-color'.")
2942 (screen)
2943 Lisp_Object screen;
2944 {
2945 check_x ();
2946
2947 switch (screen_visual->class)
2948 {
2949 case StaticGray: return (intern ("static-gray"));
2950 case GrayScale: return (intern ("gray-scale"));
2951 case StaticColor: return (intern ("static-color"));
2952 case PseudoColor: return (intern ("pseudo-color"));
2953 case TrueColor: return (intern ("true-color"));
2954 case DirectColor: return (intern ("direct-color"));
2955 default:
2956 error ("Display has an unknown visual class");
2957 }
2958 }
2959
2960 DEFUN ("x-display-save-under", Fx_display_save_under,
2961 Sx_display_save_under, 0, 1, 0,
2962 "Returns t if the X screen FRAME is on supports the save-under feature.")
2963 (frame)
2964 Lisp_Object frame;
2965 {
2966 check_x ();
2967
2968 if (DoesSaveUnders (x_screen) == True)
2969 return Qt;
2970 else
2971 return Qnil;
2972 }
2973 \f
2974 x_pixel_width (f)
2975 register struct frame *f;
2976 {
2977 return PIXEL_WIDTH (f);
2978 }
2979
2980 x_pixel_height (f)
2981 register struct frame *f;
2982 {
2983 return PIXEL_HEIGHT (f);
2984 }
2985
2986 x_char_width (f)
2987 register struct frame *f;
2988 {
2989 return FONT_WIDTH (f->display.x->font);
2990 }
2991
2992 x_char_height (f)
2993 register struct frame *f;
2994 {
2995 return f->display.x->line_height;
2996 }
2997 \f
2998 #if 0 /* These no longer seem like the right way to do things. */
2999
3000 /* Draw a rectangle on the frame with left top corner including
3001 the character specified by LEFT_CHAR and TOP_CHAR. The rectangle is
3002 CHARS by LINES wide and long and is the color of the cursor. */
3003
3004 void
3005 x_rectangle (f, gc, left_char, top_char, chars, lines)
3006 register struct frame *f;
3007 GC gc;
3008 register int top_char, left_char, chars, lines;
3009 {
3010 int width;
3011 int height;
3012 int left = (left_char * FONT_WIDTH (f->display.x->font)
3013 + f->display.x->internal_border_width);
3014 int top = (top_char * f->display.x->line_height
3015 + f->display.x->internal_border_width);
3016
3017 if (chars < 0)
3018 width = FONT_WIDTH (f->display.x->font) / 2;
3019 else
3020 width = FONT_WIDTH (f->display.x->font) * chars;
3021 if (lines < 0)
3022 height = f->display.x->line_height / 2;
3023 else
3024 height = f->display.x->line_height * lines;
3025
3026 XDrawRectangle (x_current_display, FRAME_X_WINDOW (f),
3027 gc, left, top, width, height);
3028 }
3029
3030 DEFUN ("x-draw-rectangle", Fx_draw_rectangle, Sx_draw_rectangle, 5, 5, 0,
3031 "Draw a rectangle on FRAME between coordinates specified by\n\
3032 numbers X0, Y0, X1, Y1 in the cursor pixel.")
3033 (frame, X0, Y0, X1, Y1)
3034 register Lisp_Object frame, X0, X1, Y0, Y1;
3035 {
3036 register int x0, y0, x1, y1, top, left, n_chars, n_lines;
3037
3038 CHECK_LIVE_FRAME (frame, 0);
3039 CHECK_NUMBER (X0, 0);
3040 CHECK_NUMBER (Y0, 1);
3041 CHECK_NUMBER (X1, 2);
3042 CHECK_NUMBER (Y1, 3);
3043
3044 x0 = XINT (X0);
3045 x1 = XINT (X1);
3046 y0 = XINT (Y0);
3047 y1 = XINT (Y1);
3048
3049 if (y1 > y0)
3050 {
3051 top = y0;
3052 n_lines = y1 - y0 + 1;
3053 }
3054 else
3055 {
3056 top = y1;
3057 n_lines = y0 - y1 + 1;
3058 }
3059
3060 if (x1 > x0)
3061 {
3062 left = x0;
3063 n_chars = x1 - x0 + 1;
3064 }
3065 else
3066 {
3067 left = x1;
3068 n_chars = x0 - x1 + 1;
3069 }
3070
3071 BLOCK_INPUT;
3072 x_rectangle (XFRAME (frame), XFRAME (frame)->display.x->cursor_gc,
3073 left, top, n_chars, n_lines);
3074 UNBLOCK_INPUT;
3075
3076 return Qt;
3077 }
3078
3079 DEFUN ("x-erase-rectangle", Fx_erase_rectangle, Sx_erase_rectangle, 5, 5, 0,
3080 "Draw a rectangle drawn on FRAME between coordinates\n\
3081 X0, Y0, X1, Y1 in the regular background-pixel.")
3082 (frame, X0, Y0, X1, Y1)
3083 register Lisp_Object frame, X0, Y0, X1, Y1;
3084 {
3085 register int x0, y0, x1, y1, top, left, n_chars, n_lines;
3086
3087 CHECK_FRAME (frame, 0);
3088 CHECK_NUMBER (X0, 0);
3089 CHECK_NUMBER (Y0, 1);
3090 CHECK_NUMBER (X1, 2);
3091 CHECK_NUMBER (Y1, 3);
3092
3093 x0 = XINT (X0);
3094 x1 = XINT (X1);
3095 y0 = XINT (Y0);
3096 y1 = XINT (Y1);
3097
3098 if (y1 > y0)
3099 {
3100 top = y0;
3101 n_lines = y1 - y0 + 1;
3102 }
3103 else
3104 {
3105 top = y1;
3106 n_lines = y0 - y1 + 1;
3107 }
3108
3109 if (x1 > x0)
3110 {
3111 left = x0;
3112 n_chars = x1 - x0 + 1;
3113 }
3114 else
3115 {
3116 left = x1;
3117 n_chars = x0 - x1 + 1;
3118 }
3119
3120 BLOCK_INPUT;
3121 x_rectangle (XFRAME (frame), XFRAME (frame)->display.x->reverse_gc,
3122 left, top, n_chars, n_lines);
3123 UNBLOCK_INPUT;
3124
3125 return Qt;
3126 }
3127
3128 /* Draw lines around the text region beginning at the character position
3129 TOP_X, TOP_Y and ending at BOTTOM_X and BOTTOM_Y. GC specifies the
3130 pixel and line characteristics. */
3131
3132 #define line_len(line) (FRAME_CURRENT_GLYPHS (f)->used[(line)])
3133
3134 static void
3135 outline_region (f, gc, top_x, top_y, bottom_x, bottom_y)
3136 register struct frame *f;
3137 GC gc;
3138 int top_x, top_y, bottom_x, bottom_y;
3139 {
3140 register int ibw = f->display.x->internal_border_width;
3141 register int font_w = FONT_WIDTH (f->display.x->font);
3142 register int font_h = f->display.x->line_height;
3143 int y = top_y;
3144 int x = line_len (y);
3145 XPoint *pixel_points
3146 = (XPoint *) alloca (((bottom_y - top_y + 2) * 4) * sizeof (XPoint));
3147 register XPoint *this_point = pixel_points;
3148
3149 /* Do the horizontal top line/lines */
3150 if (top_x == 0)
3151 {
3152 this_point->x = ibw;
3153 this_point->y = ibw + (font_h * top_y);
3154 this_point++;
3155 if (x == 0)
3156 this_point->x = ibw + (font_w / 2); /* Half-size for newline chars. */
3157 else
3158 this_point->x = ibw + (font_w * x);
3159 this_point->y = (this_point - 1)->y;
3160 }
3161 else
3162 {
3163 this_point->x = ibw;
3164 this_point->y = ibw + (font_h * (top_y + 1));
3165 this_point++;
3166 this_point->x = ibw + (font_w * top_x);
3167 this_point->y = (this_point - 1)->y;
3168 this_point++;
3169 this_point->x = (this_point - 1)->x;
3170 this_point->y = ibw + (font_h * top_y);
3171 this_point++;
3172 this_point->x = ibw + (font_w * x);
3173 this_point->y = (this_point - 1)->y;
3174 }
3175
3176 /* Now do the right side. */
3177 while (y < bottom_y)
3178 { /* Right vertical edge */
3179 this_point++;
3180 this_point->x = (this_point - 1)->x;
3181 this_point->y = ibw + (font_h * (y + 1));
3182 this_point++;
3183
3184 y++; /* Horizontal connection to next line */
3185 x = line_len (y);
3186 if (x == 0)
3187 this_point->x = ibw + (font_w / 2);
3188 else
3189 this_point->x = ibw + (font_w * x);
3190
3191 this_point->y = (this_point - 1)->y;
3192 }
3193
3194 /* Now do the bottom and connect to the top left point. */
3195 this_point->x = ibw + (font_w * (bottom_x + 1));
3196
3197 this_point++;
3198 this_point->x = (this_point - 1)->x;
3199 this_point->y = ibw + (font_h * (bottom_y + 1));
3200 this_point++;
3201 this_point->x = ibw;
3202 this_point->y = (this_point - 1)->y;
3203 this_point++;
3204 this_point->x = pixel_points->x;
3205 this_point->y = pixel_points->y;
3206
3207 XDrawLines (x_current_display, FRAME_X_WINDOW (f),
3208 gc, pixel_points,
3209 (this_point - pixel_points + 1), CoordModeOrigin);
3210 }
3211
3212 DEFUN ("x-contour-region", Fx_contour_region, Sx_contour_region, 1, 1, 0,
3213 "Highlight the region between point and the character under the mouse\n\
3214 selected frame.")
3215 (event)
3216 register Lisp_Object event;
3217 {
3218 register int x0, y0, x1, y1;
3219 register struct frame *f = selected_frame;
3220 register int p1, p2;
3221
3222 CHECK_CONS (event, 0);
3223
3224 BLOCK_INPUT;
3225 x0 = XINT (Fcar (Fcar (event)));
3226 y0 = XINT (Fcar (Fcdr (Fcar (event))));
3227
3228 /* If the mouse is past the end of the line, don't that area. */
3229 /* ReWrite this... */
3230
3231 x1 = f->cursor_x;
3232 y1 = f->cursor_y;
3233
3234 if (y1 > y0) /* point below mouse */
3235 outline_region (f, f->display.x->cursor_gc,
3236 x0, y0, x1, y1);
3237 else if (y1 < y0) /* point above mouse */
3238 outline_region (f, f->display.x->cursor_gc,
3239 x1, y1, x0, y0);
3240 else /* same line: draw horizontal rectangle */
3241 {
3242 if (x1 > x0)
3243 x_rectangle (f, f->display.x->cursor_gc,
3244 x0, y0, (x1 - x0 + 1), 1);
3245 else if (x1 < x0)
3246 x_rectangle (f, f->display.x->cursor_gc,
3247 x1, y1, (x0 - x1 + 1), 1);
3248 }
3249
3250 XFlush (x_current_display);
3251 UNBLOCK_INPUT;
3252
3253 return Qnil;
3254 }
3255
3256 DEFUN ("x-uncontour-region", Fx_uncontour_region, Sx_uncontour_region, 1, 1, 0,
3257 "Erase any highlighting of the region between point and the character\n\
3258 at X, Y on the selected frame.")
3259 (event)
3260 register Lisp_Object event;
3261 {
3262 register int x0, y0, x1, y1;
3263 register struct frame *f = selected_frame;
3264
3265 BLOCK_INPUT;
3266 x0 = XINT (Fcar (Fcar (event)));
3267 y0 = XINT (Fcar (Fcdr (Fcar (event))));
3268 x1 = f->cursor_x;
3269 y1 = f->cursor_y;
3270
3271 if (y1 > y0) /* point below mouse */
3272 outline_region (f, f->display.x->reverse_gc,
3273 x0, y0, x1, y1);
3274 else if (y1 < y0) /* point above mouse */
3275 outline_region (f, f->display.x->reverse_gc,
3276 x1, y1, x0, y0);
3277 else /* same line: draw horizontal rectangle */
3278 {
3279 if (x1 > x0)
3280 x_rectangle (f, f->display.x->reverse_gc,
3281 x0, y0, (x1 - x0 + 1), 1);
3282 else if (x1 < x0)
3283 x_rectangle (f, f->display.x->reverse_gc,
3284 x1, y1, (x0 - x1 + 1), 1);
3285 }
3286 UNBLOCK_INPUT;
3287
3288 return Qnil;
3289 }
3290
3291 #if 0
3292 int contour_begin_x, contour_begin_y;
3293 int contour_end_x, contour_end_y;
3294 int contour_npoints;
3295
3296 /* Clip the top part of the contour lines down (and including) line Y_POS.
3297 If X_POS is in the middle (rather than at the end) of the line, drop
3298 down a line at that character. */
3299
3300 static void
3301 clip_contour_top (y_pos, x_pos)
3302 {
3303 register XPoint *begin = contour_lines[y_pos].top_left;
3304 register XPoint *end;
3305 register int npoints;
3306 register struct display_line *line = selected_frame->phys_lines[y_pos + 1];
3307
3308 if (x_pos >= line->len - 1) /* Draw one, straight horizontal line. */
3309 {
3310 end = contour_lines[y_pos].top_right;
3311 npoints = (end - begin + 1);
3312 XDrawLines (x_current_display, contour_window,
3313 contour_erase_gc, begin_erase, npoints, CoordModeOrigin);
3314
3315 bcopy (end, begin + 1, contour_last_point - end + 1);
3316 contour_last_point -= (npoints - 2);
3317 XDrawLines (x_current_display, contour_window,
3318 contour_erase_gc, begin, 2, CoordModeOrigin);
3319 XFlush (x_current_display);
3320
3321 /* Now, update contour_lines structure. */
3322 }
3323 /* ______. */
3324 else /* |________*/
3325 {
3326 register XPoint *p = begin + 1;
3327 end = contour_lines[y_pos].bottom_right;
3328 npoints = (end - begin + 1);
3329 XDrawLines (x_current_display, contour_window,
3330 contour_erase_gc, begin_erase, npoints, CoordModeOrigin);
3331
3332 p->y = begin->y;
3333 p->x = ibw + (font_w * (x_pos + 1));
3334 p++;
3335 p->y = begin->y + font_h;
3336 p->x = (p - 1)->x;
3337 bcopy (end, begin + 3, contour_last_point - end + 1);
3338 contour_last_point -= (npoints - 5);
3339 XDrawLines (x_current_display, contour_window,
3340 contour_erase_gc, begin, 4, CoordModeOrigin);
3341 XFlush (x_current_display);
3342
3343 /* Now, update contour_lines structure. */
3344 }
3345 }
3346
3347 /* Erase the top horizontal lines of the contour, and then extend
3348 the contour upwards. */
3349
3350 static void
3351 extend_contour_top (line)
3352 {
3353 }
3354
3355 static void
3356 clip_contour_bottom (x_pos, y_pos)
3357 int x_pos, y_pos;
3358 {
3359 }
3360
3361 static void
3362 extend_contour_bottom (x_pos, y_pos)
3363 {
3364 }
3365
3366 DEFUN ("x-select-region", Fx_select_region, Sx_select_region, 1, 1, "e",
3367 "")
3368 (event)
3369 Lisp_Object event;
3370 {
3371 register struct frame *f = selected_frame;
3372 register int point_x = f->cursor_x;
3373 register int point_y = f->cursor_y;
3374 register int mouse_below_point;
3375 register Lisp_Object obj;
3376 register int x_contour_x, x_contour_y;
3377
3378 x_contour_x = x_mouse_x;
3379 x_contour_y = x_mouse_y;
3380 if (x_contour_y > point_y || (x_contour_y == point_y
3381 && x_contour_x > point_x))
3382 {
3383 mouse_below_point = 1;
3384 outline_region (f, f->display.x->cursor_gc, point_x, point_y,
3385 x_contour_x, x_contour_y);
3386 }
3387 else
3388 {
3389 mouse_below_point = 0;
3390 outline_region (f, f->display.x->cursor_gc, x_contour_x, x_contour_y,
3391 point_x, point_y);
3392 }
3393
3394 while (1)
3395 {
3396 obj = read_char (-1, 0, 0, Qnil, 0);
3397 if (XTYPE (obj) != Lisp_Cons)
3398 break;
3399
3400 if (mouse_below_point)
3401 {
3402 if (x_mouse_y <= point_y) /* Flipped. */
3403 {
3404 mouse_below_point = 0;
3405
3406 outline_region (f, f->display.x->reverse_gc, point_x, point_y,
3407 x_contour_x, x_contour_y);
3408 outline_region (f, f->display.x->cursor_gc, x_mouse_x, x_mouse_y,
3409 point_x, point_y);
3410 }
3411 else if (x_mouse_y < x_contour_y) /* Bottom clipped. */
3412 {
3413 clip_contour_bottom (x_mouse_y);
3414 }
3415 else if (x_mouse_y > x_contour_y) /* Bottom extended. */
3416 {
3417 extend_bottom_contour (x_mouse_y);
3418 }
3419
3420 x_contour_x = x_mouse_x;
3421 x_contour_y = x_mouse_y;
3422 }
3423 else /* mouse above or same line as point */
3424 {
3425 if (x_mouse_y >= point_y) /* Flipped. */
3426 {
3427 mouse_below_point = 1;
3428
3429 outline_region (f, f->display.x->reverse_gc,
3430 x_contour_x, x_contour_y, point_x, point_y);
3431 outline_region (f, f->display.x->cursor_gc, point_x, point_y,
3432 x_mouse_x, x_mouse_y);
3433 }
3434 else if (x_mouse_y > x_contour_y) /* Top clipped. */
3435 {
3436 clip_contour_top (x_mouse_y);
3437 }
3438 else if (x_mouse_y < x_contour_y) /* Top extended. */
3439 {
3440 extend_contour_top (x_mouse_y);
3441 }
3442 }
3443 }
3444
3445 unread_command_event = obj;
3446 if (mouse_below_point)
3447 {
3448 contour_begin_x = point_x;
3449 contour_begin_y = point_y;
3450 contour_end_x = x_contour_x;
3451 contour_end_y = x_contour_y;
3452 }
3453 else
3454 {
3455 contour_begin_x = x_contour_x;
3456 contour_begin_y = x_contour_y;
3457 contour_end_x = point_x;
3458 contour_end_y = point_y;
3459 }
3460 }
3461 #endif
3462
3463 DEFUN ("x-horizontal-line", Fx_horizontal_line, Sx_horizontal_line, 1, 1, "e",
3464 "")
3465 (event)
3466 Lisp_Object event;
3467 {
3468 register Lisp_Object obj;
3469 struct frame *f = selected_frame;
3470 register struct window *w = XWINDOW (selected_window);
3471 register GC line_gc = f->display.x->cursor_gc;
3472 register GC erase_gc = f->display.x->reverse_gc;
3473 #if 0
3474 char dash_list[] = {6, 4, 6, 4};
3475 int dashes = 4;
3476 XGCValues gc_values;
3477 #endif
3478 register int previous_y;
3479 register int line = (x_mouse_y + 1) * f->display.x->line_height
3480 + f->display.x->internal_border_width;
3481 register int left = f->display.x->internal_border_width
3482 + (w->left
3483 * FONT_WIDTH (f->display.x->font));
3484 register int right = left + (w->width
3485 * FONT_WIDTH (f->display.x->font))
3486 - f->display.x->internal_border_width;
3487
3488 #if 0
3489 BLOCK_INPUT;
3490 gc_values.foreground = f->display.x->cursor_pixel;
3491 gc_values.background = f->display.x->background_pixel;
3492 gc_values.line_width = 1;
3493 gc_values.line_style = LineOnOffDash;
3494 gc_values.cap_style = CapRound;
3495 gc_values.join_style = JoinRound;
3496
3497 line_gc = XCreateGC (x_current_display, FRAME_X_WINDOW (f),
3498 GCLineStyle | GCJoinStyle | GCCapStyle
3499 | GCLineWidth | GCForeground | GCBackground,
3500 &gc_values);
3501 XSetDashes (x_current_display, line_gc, 0, dash_list, dashes);
3502 gc_values.foreground = f->display.x->background_pixel;
3503 gc_values.background = f->display.x->foreground_pixel;
3504 erase_gc = XCreateGC (x_current_display, FRAME_X_WINDOW (f),
3505 GCLineStyle | GCJoinStyle | GCCapStyle
3506 | GCLineWidth | GCForeground | GCBackground,
3507 &gc_values);
3508 XSetDashes (x_current_display, erase_gc, 0, dash_list, dashes);
3509 #endif
3510
3511 while (1)
3512 {
3513 BLOCK_INPUT;
3514 if (x_mouse_y >= XINT (w->top)
3515 && x_mouse_y < XINT (w->top) + XINT (w->height) - 1)
3516 {
3517 previous_y = x_mouse_y;
3518 line = (x_mouse_y + 1) * f->display.x->line_height
3519 + f->display.x->internal_border_width;
3520 XDrawLine (x_current_display, FRAME_X_WINDOW (f),
3521 line_gc, left, line, right, line);
3522 }
3523 XFlushQueue ();
3524 UNBLOCK_INPUT;
3525
3526 do
3527 {
3528 obj = read_char (-1, 0, 0, Qnil, 0);
3529 if ((XTYPE (obj) != Lisp_Cons)
3530 || (! EQ (Fcar (Fcdr (Fcdr (obj))),
3531 Qvertical_scroll_bar))
3532 || x_mouse_grabbed)
3533 {
3534 BLOCK_INPUT;
3535 XDrawLine (x_current_display, FRAME_X_WINDOW (f),
3536 erase_gc, left, line, right, line);
3537 UNBLOCK_INPUT;
3538 unread_command_event = obj;
3539 #if 0
3540 XFreeGC (x_current_display, line_gc);
3541 XFreeGC (x_current_display, erase_gc);
3542 #endif
3543 return Qnil;
3544 }
3545 }
3546 while (x_mouse_y == previous_y);
3547
3548 BLOCK_INPUT;
3549 XDrawLine (x_current_display, FRAME_X_WINDOW (f),
3550 erase_gc, left, line, right, line);
3551 UNBLOCK_INPUT;
3552 }
3553 }
3554 #endif
3555 \f
3556 /* Offset in buffer of character under the pointer, or 0. */
3557 int mouse_buffer_offset;
3558
3559 #if 0
3560 /* These keep track of the rectangle following the pointer. */
3561 int mouse_track_top, mouse_track_left, mouse_track_width;
3562
3563 DEFUN ("x-track-pointer", Fx_track_pointer, Sx_track_pointer, 0, 0, 0,
3564 "Track the pointer.")
3565 ()
3566 {
3567 static Cursor current_pointer_shape;
3568 FRAME_PTR f = x_mouse_frame;
3569
3570 BLOCK_INPUT;
3571 if (EQ (Vmouse_frame_part, Qtext_part)
3572 && (current_pointer_shape != f->display.x->nontext_cursor))
3573 {
3574 unsigned char c;
3575 struct buffer *buf;
3576
3577 current_pointer_shape = f->display.x->nontext_cursor;
3578 XDefineCursor (x_current_display,
3579 FRAME_X_WINDOW (f),
3580 current_pointer_shape);
3581
3582 buf = XBUFFER (XWINDOW (Vmouse_window)->buffer);
3583 c = *(BUF_CHAR_ADDRESS (buf, mouse_buffer_offset));
3584 }
3585 else if (EQ (Vmouse_frame_part, Qmodeline_part)
3586 && (current_pointer_shape != f->display.x->modeline_cursor))
3587 {
3588 current_pointer_shape = f->display.x->modeline_cursor;
3589 XDefineCursor (x_current_display,
3590 FRAME_X_WINDOW (f),
3591 current_pointer_shape);
3592 }
3593
3594 XFlushQueue ();
3595 UNBLOCK_INPUT;
3596 }
3597 #endif
3598
3599 #if 0
3600 DEFUN ("x-track-pointer", Fx_track_pointer, Sx_track_pointer, 1, 1, "e",
3601 "Draw rectangle around character under mouse pointer, if there is one.")
3602 (event)
3603 Lisp_Object event;
3604 {
3605 struct window *w = XWINDOW (Vmouse_window);
3606 struct frame *f = XFRAME (WINDOW_FRAME (w));
3607 struct buffer *b = XBUFFER (w->buffer);
3608 Lisp_Object obj;
3609
3610 if (! EQ (Vmouse_window, selected_window))
3611 return Qnil;
3612
3613 if (EQ (event, Qnil))
3614 {
3615 int x, y;
3616
3617 x_read_mouse_position (selected_frame, &x, &y);
3618 }
3619
3620 BLOCK_INPUT;
3621 mouse_track_width = 0;
3622 mouse_track_left = mouse_track_top = -1;
3623
3624 do
3625 {
3626 if ((x_mouse_x != mouse_track_left
3627 && (x_mouse_x < mouse_track_left
3628 || x_mouse_x > (mouse_track_left + mouse_track_width)))
3629 || x_mouse_y != mouse_track_top)
3630 {
3631 int hp = 0; /* Horizontal position */
3632 int len = FRAME_CURRENT_GLYPHS (f)->used[x_mouse_y];
3633 int p = FRAME_CURRENT_GLYPHS (f)->bufp[x_mouse_y];
3634 int tab_width = XINT (b->tab_width);
3635 int ctl_arrow_p = !NILP (b->ctl_arrow);
3636 unsigned char c;
3637 int mode_line_vpos = XFASTINT (w->height) + XFASTINT (w->top) - 1;
3638 int in_mode_line = 0;
3639
3640 if (! FRAME_CURRENT_GLYPHS (f)->enable[x_mouse_y])
3641 break;
3642
3643 /* Erase previous rectangle. */
3644 if (mouse_track_width)
3645 {
3646 x_rectangle (f, f->display.x->reverse_gc,
3647 mouse_track_left, mouse_track_top,
3648 mouse_track_width, 1);
3649
3650 if ((mouse_track_left == f->phys_cursor_x
3651 || mouse_track_left == f->phys_cursor_x - 1)
3652 && mouse_track_top == f->phys_cursor_y)
3653 {
3654 x_display_cursor (f, 1);
3655 }
3656 }
3657
3658 mouse_track_left = x_mouse_x;
3659 mouse_track_top = x_mouse_y;
3660 mouse_track_width = 0;
3661
3662 if (mouse_track_left > len) /* Past the end of line. */
3663 goto draw_or_not;
3664
3665 if (mouse_track_top == mode_line_vpos)
3666 {
3667 in_mode_line = 1;
3668 goto draw_or_not;
3669 }
3670
3671 if (tab_width <= 0 || tab_width > 20) tab_width = 8;
3672 do
3673 {
3674 c = FETCH_CHAR (p);
3675 if (len == f->width && hp == len - 1 && c != '\n')
3676 goto draw_or_not;
3677
3678 switch (c)
3679 {
3680 case '\t':
3681 mouse_track_width = tab_width - (hp % tab_width);
3682 p++;
3683 hp += mouse_track_width;
3684 if (hp > x_mouse_x)
3685 {
3686 mouse_track_left = hp - mouse_track_width;
3687 goto draw_or_not;
3688 }
3689 continue;
3690
3691 case '\n':
3692 mouse_track_width = -1;
3693 goto draw_or_not;
3694
3695 default:
3696 if (ctl_arrow_p && (c < 040 || c == 0177))
3697 {
3698 if (p > ZV)
3699 goto draw_or_not;
3700
3701 mouse_track_width = 2;
3702 p++;
3703 hp +=2;
3704 if (hp > x_mouse_x)
3705 {
3706 mouse_track_left = hp - mouse_track_width;
3707 goto draw_or_not;
3708 }
3709 }
3710 else
3711 {
3712 mouse_track_width = 1;
3713 p++;
3714 hp++;
3715 }
3716 continue;
3717 }
3718 }
3719 while (hp <= x_mouse_x);
3720
3721 draw_or_not:
3722 if (mouse_track_width) /* Over text; use text pointer shape. */
3723 {
3724 XDefineCursor (x_current_display,
3725 FRAME_X_WINDOW (f),
3726 f->display.x->text_cursor);
3727 x_rectangle (f, f->display.x->cursor_gc,
3728 mouse_track_left, mouse_track_top,
3729 mouse_track_width, 1);
3730 }
3731 else if (in_mode_line)
3732 XDefineCursor (x_current_display,
3733 FRAME_X_WINDOW (f),
3734 f->display.x->modeline_cursor);
3735 else
3736 XDefineCursor (x_current_display,
3737 FRAME_X_WINDOW (f),
3738 f->display.x->nontext_cursor);
3739 }
3740
3741 XFlush (x_current_display);
3742 UNBLOCK_INPUT;
3743
3744 obj = read_char (-1, 0, 0, Qnil, 0);
3745 BLOCK_INPUT;
3746 }
3747 while (XTYPE (obj) == Lisp_Cons /* Mouse event */
3748 && EQ (Fcar (Fcdr (Fcdr (obj))), Qnil) /* Not scroll bar */
3749 && EQ (Vmouse_depressed, Qnil) /* Only motion events */
3750 && EQ (Vmouse_window, selected_window) /* In this window */
3751 && x_mouse_frame);
3752
3753 unread_command_event = obj;
3754
3755 if (mouse_track_width)
3756 {
3757 x_rectangle (f, f->display.x->reverse_gc,
3758 mouse_track_left, mouse_track_top,
3759 mouse_track_width, 1);
3760 mouse_track_width = 0;
3761 if ((mouse_track_left == f->phys_cursor_x
3762 || mouse_track_left - 1 == f->phys_cursor_x)
3763 && mouse_track_top == f->phys_cursor_y)
3764 {
3765 x_display_cursor (f, 1);
3766 }
3767 }
3768 XDefineCursor (x_current_display,
3769 FRAME_X_WINDOW (f),
3770 f->display.x->nontext_cursor);
3771 XFlush (x_current_display);
3772 UNBLOCK_INPUT;
3773
3774 return Qnil;
3775 }
3776 #endif
3777 \f
3778 #if 0
3779 #include "glyphs.h"
3780
3781 /* Draw a pixmap specified by IMAGE_DATA of dimensions WIDTH and HEIGHT
3782 on the frame F at position X, Y. */
3783
3784 x_draw_pixmap (f, x, y, image_data, width, height)
3785 struct frame *f;
3786 int x, y, width, height;
3787 char *image_data;
3788 {
3789 Pixmap image;
3790
3791 image = XCreateBitmapFromData (x_current_display,
3792 FRAME_X_WINDOW (f), image_data,
3793 width, height);
3794 XCopyPlane (x_current_display, image, FRAME_X_WINDOW (f),
3795 f->display.x->normal_gc, 0, 0, width, height, x, y);
3796 }
3797 #endif
3798 \f
3799 #ifndef HAVE_X11
3800 DEFUN ("x-store-cut-buffer", Fx_store_cut_buffer, Sx_store_cut_buffer,
3801 1, 1, "sStore text in cut buffer: ",
3802 "Store contents of STRING into the cut buffer of the X window system.")
3803 (string)
3804 register Lisp_Object string;
3805 {
3806 int mask;
3807
3808 CHECK_STRING (string, 1);
3809 if (! FRAME_X_P (selected_frame))
3810 error ("Selected frame does not understand X protocol.");
3811
3812 BLOCK_INPUT;
3813 XStoreBytes ((char *) XSTRING (string)->data, XSTRING (string)->size);
3814 UNBLOCK_INPUT;
3815
3816 return Qnil;
3817 }
3818
3819 DEFUN ("x-get-cut-buffer", Fx_get_cut_buffer, Sx_get_cut_buffer, 0, 0, 0,
3820 "Return contents of cut buffer of the X window system, as a string.")
3821 ()
3822 {
3823 int len;
3824 register Lisp_Object string;
3825 int mask;
3826 register char *d;
3827
3828 BLOCK_INPUT;
3829 d = XFetchBytes (&len);
3830 string = make_string (d, len);
3831 XFree (d);
3832 UNBLOCK_INPUT;
3833 return string;
3834 }
3835 #endif /* X10 */
3836 \f
3837 #if 0 /* I'm told these functions are superfluous
3838 given the ability to bind function keys. */
3839
3840 #ifdef HAVE_X11
3841 DEFUN ("x-rebind-key", Fx_rebind_key, Sx_rebind_key, 3, 3, 0,
3842 "Rebind X keysym KEYSYM, with MODIFIERS, to generate NEWSTRING.\n\
3843 KEYSYM is a string which conforms to the X keysym definitions found\n\
3844 in X11/keysymdef.h, sans the initial XK_. MODIFIERS is nil or a\n\
3845 list of strings specifying modifier keys such as Control_L, which must\n\
3846 also be depressed for NEWSTRING to appear.")
3847 (x_keysym, modifiers, newstring)
3848 register Lisp_Object x_keysym;
3849 register Lisp_Object modifiers;
3850 register Lisp_Object newstring;
3851 {
3852 char *rawstring;
3853 register KeySym keysym;
3854 KeySym modifier_list[16];
3855
3856 check_x ();
3857 CHECK_STRING (x_keysym, 1);
3858 CHECK_STRING (newstring, 3);
3859
3860 keysym = XStringToKeysym ((char *) XSTRING (x_keysym)->data);
3861 if (keysym == NoSymbol)
3862 error ("Keysym does not exist");
3863
3864 if (NILP (modifiers))
3865 XRebindKeysym (x_current_display, keysym, modifier_list, 0,
3866 XSTRING (newstring)->data, XSTRING (newstring)->size);
3867 else
3868 {
3869 register Lisp_Object rest, mod;
3870 register int i = 0;
3871
3872 for (rest = modifiers; !NILP (rest); rest = Fcdr (rest))
3873 {
3874 if (i == 16)
3875 error ("Can't have more than 16 modifiers");
3876
3877 mod = Fcar (rest);
3878 CHECK_STRING (mod, 3);
3879 modifier_list[i] = XStringToKeysym ((char *) XSTRING (mod)->data);
3880 #ifndef HAVE_X11R5
3881 if (modifier_list[i] == NoSymbol
3882 || !(IsModifierKey (modifier_list[i])
3883 || ((unsigned)(modifier_list[i]) == XK_Mode_switch)
3884 || ((unsigned)(modifier_list[i]) == XK_Num_Lock)))
3885 #else
3886 if (modifier_list[i] == NoSymbol
3887 || !IsModifierKey (modifier_list[i]))
3888 #endif
3889 error ("Element is not a modifier keysym");
3890 i++;
3891 }
3892
3893 XRebindKeysym (x_current_display, keysym, modifier_list, i,
3894 XSTRING (newstring)->data, XSTRING (newstring)->size);
3895 }
3896
3897 return Qnil;
3898 }
3899
3900 DEFUN ("x-rebind-keys", Fx_rebind_keys, Sx_rebind_keys, 2, 2, 0,
3901 "Rebind KEYCODE to list of strings STRINGS.\n\
3902 STRINGS should be a list of 16 elements, one for each shift combination.\n\
3903 nil as element means don't change.\n\
3904 See the documentation of `x-rebind-key' for more information.")
3905 (keycode, strings)
3906 register Lisp_Object keycode;
3907 register Lisp_Object strings;
3908 {
3909 register Lisp_Object item;
3910 register unsigned char *rawstring;
3911 KeySym rawkey, modifier[1];
3912 int strsize;
3913 register unsigned i;
3914
3915 check_x ();
3916 CHECK_NUMBER (keycode, 1);
3917 CHECK_CONS (strings, 2);
3918 rawkey = (KeySym) ((unsigned) (XINT (keycode))) & 255;
3919 for (i = 0; i <= 15; strings = Fcdr (strings), i++)
3920 {
3921 item = Fcar (strings);
3922 if (!NILP (item))
3923 {
3924 CHECK_STRING (item, 2);
3925 strsize = XSTRING (item)->size;
3926 rawstring = (unsigned char *) xmalloc (strsize);
3927 bcopy (XSTRING (item)->data, rawstring, strsize);
3928 modifier[1] = 1 << i;
3929 XRebindKeysym (x_current_display, rawkey, modifier, 1,
3930 rawstring, strsize);
3931 }
3932 }
3933 return Qnil;
3934 }
3935 #endif /* HAVE_X11 */
3936 #endif /* 0 */
3937 \f
3938 #ifdef HAVE_X11
3939
3940 #ifndef HAVE_XSCREENNUMBEROFSCREEN
3941 int
3942 XScreenNumberOfScreen (scr)
3943 register Screen *scr;
3944 {
3945 register Display *dpy;
3946 register Screen *dpyscr;
3947 register int i;
3948
3949 dpy = scr->display;
3950 dpyscr = dpy->screens;
3951
3952 for (i = 0; i < dpy->nscreens; i++, dpyscr++)
3953 if (scr == dpyscr)
3954 return i;
3955
3956 return -1;
3957 }
3958 #endif /* not HAVE_XSCREENNUMBEROFSCREEN */
3959
3960 Visual *
3961 select_visual (screen, depth)
3962 Screen *screen;
3963 unsigned int *depth;
3964 {
3965 Visual *v;
3966 XVisualInfo *vinfo, vinfo_template;
3967 int n_visuals;
3968
3969 v = DefaultVisualOfScreen (screen);
3970
3971 #ifdef HAVE_X11R4
3972 vinfo_template.visualid = XVisualIDFromVisual (v);
3973 #else
3974 vinfo_template.visualid = v->visualid;
3975 #endif
3976
3977 vinfo_template.screen = XScreenNumberOfScreen (screen);
3978
3979 vinfo = XGetVisualInfo (x_current_display,
3980 VisualIDMask | VisualScreenMask, &vinfo_template,
3981 &n_visuals);
3982 if (n_visuals != 1)
3983 fatal ("Can't get proper X visual info");
3984
3985 if ((1 << vinfo->depth) == vinfo->colormap_size)
3986 *depth = vinfo->depth;
3987 else
3988 {
3989 int i = 0;
3990 int n = vinfo->colormap_size - 1;
3991 while (n)
3992 {
3993 n = n >> 1;
3994 i++;
3995 }
3996 *depth = i;
3997 }
3998
3999 XFree ((char *) vinfo);
4000 return v;
4001 }
4002 #endif /* HAVE_X11 */
4003
4004 DEFUN ("x-open-connection", Fx_open_connection, Sx_open_connection,
4005 1, 2, 0, "Open a connection to an X server.\n\
4006 DISPLAY is the name of the display to connect to.\n\
4007 Optional second arg XRM_STRING is a string of resources in xrdb format.")
4008 (display, xrm_string)
4009 Lisp_Object display, xrm_string;
4010 {
4011 unsigned int n_planes;
4012 unsigned char *xrm_option;
4013
4014 CHECK_STRING (display, 0);
4015 if (x_current_display != 0)
4016 error ("X server connection is already initialized");
4017 if (! NILP (xrm_string))
4018 CHECK_STRING (xrm_string, 1);
4019
4020 /* This is what opens the connection and sets x_current_display.
4021 This also initializes many symbols, such as those used for input. */
4022 x_term_init (XSTRING (display)->data);
4023
4024 #ifdef HAVE_X11
4025 XFASTINT (Vwindow_system_version) = 11;
4026
4027 if (! NILP (xrm_string))
4028 xrm_option = (unsigned char *) XSTRING (xrm_string)->data;
4029 else
4030 xrm_option = (unsigned char *) 0;
4031
4032 validate_x_resource_name ();
4033
4034 BLOCK_INPUT;
4035 xrdb = x_load_resources (x_current_display, xrm_option,
4036 (char *) XSTRING (Vx_resource_name)->data,
4037 EMACS_CLASS);
4038 UNBLOCK_INPUT;
4039 #ifdef HAVE_XRMSETDATABASE
4040 XrmSetDatabase (x_current_display, xrdb);
4041 #else
4042 x_current_display->db = xrdb;
4043 #endif
4044
4045 x_screen = DefaultScreenOfDisplay (x_current_display);
4046
4047 screen_visual = select_visual (x_screen, &n_planes);
4048 x_screen_planes = n_planes;
4049 x_screen_height = HeightOfScreen (x_screen);
4050 x_screen_width = WidthOfScreen (x_screen);
4051
4052 /* X Atoms used by emacs. */
4053 Xatoms_of_xselect ();
4054 BLOCK_INPUT;
4055 Xatom_wm_protocols = XInternAtom (x_current_display, "WM_PROTOCOLS",
4056 False);
4057 Xatom_wm_take_focus = XInternAtom (x_current_display, "WM_TAKE_FOCUS",
4058 False);
4059 Xatom_wm_save_yourself = XInternAtom (x_current_display, "WM_SAVE_YOURSELF",
4060 False);
4061 Xatom_wm_delete_window = XInternAtom (x_current_display, "WM_DELETE_WINDOW",
4062 False);
4063 Xatom_wm_change_state = XInternAtom (x_current_display, "WM_CHANGE_STATE",
4064 False);
4065 Xatom_wm_configure_denied = XInternAtom (x_current_display,
4066 "WM_CONFIGURE_DENIED", False);
4067 Xatom_wm_window_moved = XInternAtom (x_current_display, "WM_MOVED",
4068 False);
4069 UNBLOCK_INPUT;
4070 #else /* not HAVE_X11 */
4071 XFASTINT (Vwindow_system_version) = 10;
4072 #endif /* not HAVE_X11 */
4073 return Qnil;
4074 }
4075
4076 DEFUN ("x-close-current-connection", Fx_close_current_connection,
4077 Sx_close_current_connection,
4078 0, 0, 0, "Close the connection to the current X server.")
4079 ()
4080 {
4081 /* Note: If we're going to call check_x here, then the fatal error
4082 can't happen. For the moment, this check is just for safety,
4083 so a user won't try out the function and get a crash. If it's
4084 really intended only to be called when killing emacs, then there's
4085 no reason for it to have a lisp interface at all. */
4086 check_x();
4087 #ifdef HAVE_X11
4088 /* This is ONLY used when killing emacs; For switching displays
4089 we'll have to take care of setting CloseDownMode elsewhere. */
4090
4091 if (x_current_display)
4092 {
4093 BLOCK_INPUT;
4094 XSetCloseDownMode (x_current_display, DestroyAll);
4095 XCloseDisplay (x_current_display);
4096 x_current_display = 0;
4097 }
4098 else
4099 fatal ("No current X display connection to close\n");
4100 #endif
4101 return Qnil;
4102 }
4103
4104 DEFUN ("x-synchronize", Fx_synchronize, Sx_synchronize,
4105 1, 1, 0, "If ON is non-nil, report X errors as soon as the erring request is made.\n\
4106 If ON is nil, allow buffering of requests.\n\
4107 Turning on synchronization prohibits the Xlib routines from buffering\n\
4108 requests and seriously degrades performance, but makes debugging much\n\
4109 easier.")
4110 (on)
4111 Lisp_Object on;
4112 {
4113 check_x ();
4114
4115 XSynchronize (x_current_display, !EQ (on, Qnil));
4116
4117 return Qnil;
4118 }
4119
4120 /* Wait for responses to all X commands issued so far for FRAME. */
4121
4122 void
4123 x_sync (frame)
4124 Lisp_Object frame;
4125 {
4126 BLOCK_INPUT;
4127 XSync (x_current_display, False);
4128 UNBLOCK_INPUT;
4129 }
4130 \f
4131 syms_of_xfns ()
4132 {
4133 /* This is zero if not using X windows. */
4134 x_current_display = 0;
4135
4136 /* The section below is built by the lisp expression at the top of the file,
4137 just above where these variables are declared. */
4138 /*&&& init symbols here &&&*/
4139 Qauto_raise = intern ("auto-raise");
4140 staticpro (&Qauto_raise);
4141 Qauto_lower = intern ("auto-lower");
4142 staticpro (&Qauto_lower);
4143 Qbackground_color = intern ("background-color");
4144 staticpro (&Qbackground_color);
4145 Qbar = intern ("bar");
4146 staticpro (&Qbar);
4147 Qborder_color = intern ("border-color");
4148 staticpro (&Qborder_color);
4149 Qborder_width = intern ("border-width");
4150 staticpro (&Qborder_width);
4151 Qbox = intern ("box");
4152 staticpro (&Qbox);
4153 Qcursor_color = intern ("cursor-color");
4154 staticpro (&Qcursor_color);
4155 Qcursor_type = intern ("cursor-type");
4156 staticpro (&Qcursor_type);
4157 Qfont = intern ("font");
4158 staticpro (&Qfont);
4159 Qforeground_color = intern ("foreground-color");
4160 staticpro (&Qforeground_color);
4161 Qgeometry = intern ("geometry");
4162 staticpro (&Qgeometry);
4163 Qicon_left = intern ("icon-left");
4164 staticpro (&Qicon_left);
4165 Qicon_top = intern ("icon-top");
4166 staticpro (&Qicon_top);
4167 Qicon_type = intern ("icon-type");
4168 staticpro (&Qicon_type);
4169 Qinternal_border_width = intern ("internal-border-width");
4170 staticpro (&Qinternal_border_width);
4171 Qleft = intern ("left");
4172 staticpro (&Qleft);
4173 Qmouse_color = intern ("mouse-color");
4174 staticpro (&Qmouse_color);
4175 Qnone = intern ("none");
4176 staticpro (&Qnone);
4177 Qparent_id = intern ("parent-id");
4178 staticpro (&Qparent_id);
4179 Qsuppress_icon = intern ("suppress-icon");
4180 staticpro (&Qsuppress_icon);
4181 Qtop = intern ("top");
4182 staticpro (&Qtop);
4183 Qundefined_color = intern ("undefined-color");
4184 staticpro (&Qundefined_color);
4185 Qvertical_scroll_bars = intern ("vertical-scroll-bars");
4186 staticpro (&Qvertical_scroll_bars);
4187 Qvisibility = intern ("visibility");
4188 staticpro (&Qvisibility);
4189 Qwindow_id = intern ("window-id");
4190 staticpro (&Qwindow_id);
4191 Qx_frame_parameter = intern ("x-frame-parameter");
4192 staticpro (&Qx_frame_parameter);
4193 Qx_resource_name = intern ("x-resource-name");
4194 staticpro (&Qx_resource_name);
4195 /* This is the end of symbol initialization. */
4196
4197 Fput (Qundefined_color, Qerror_conditions,
4198 Fcons (Qundefined_color, Fcons (Qerror, Qnil)));
4199 Fput (Qundefined_color, Qerror_message,
4200 build_string ("Undefined color"));
4201
4202 init_x_parm_symbols ();
4203
4204 DEFVAR_INT ("mouse-buffer-offset", &mouse_buffer_offset,
4205 "The buffer offset of the character under the pointer.");
4206 mouse_buffer_offset = 0;
4207
4208 DEFVAR_LISP ("x-pointer-shape", &Vx_pointer_shape,
4209 "The shape of the pointer when over text.\n\
4210 Changing the value does not affect existing frames\n\
4211 unless you set the mouse color.");
4212 Vx_pointer_shape = Qnil;
4213
4214 DEFVAR_LISP ("x-resource-name", &Vx_resource_name,
4215 "The name Emacs uses to look up X resources; for internal use only.\n\
4216 `x-get-resource' uses this as the first component of the instance name\n\
4217 when requesting resource values.\n\
4218 Emacs initially sets `x-resource-name' to the name under which Emacs\n\
4219 was invoked, or to the value specified with the `-name' or `-rn'\n\
4220 switches, if present.");
4221 Vx_resource_name = Qnil;
4222
4223 #if 0
4224 DEFVAR_INT ("x-nontext-pointer-shape", &Vx_nontext_pointer_shape,
4225 "The shape of the pointer when not over text.");
4226 #endif
4227 Vx_nontext_pointer_shape = Qnil;
4228
4229 #if 0
4230 DEFVAR_INT ("x-mode-pointer-shape", &Vx_mode_pointer_shape,
4231 "The shape of the pointer when over the mode line.");
4232 #endif
4233 Vx_mode_pointer_shape = Qnil;
4234
4235 Vx_cross_pointer_shape = Qnil;
4236
4237 DEFVAR_LISP ("x-cursor-fore-pixel", &Vx_cursor_fore_pixel,
4238 "A string indicating the foreground color of the cursor box.");
4239 Vx_cursor_fore_pixel = Qnil;
4240
4241 DEFVAR_LISP ("mouse-grabbed", &Vmouse_depressed,
4242 "Non-nil if a mouse button is currently depressed.");
4243 Vmouse_depressed = Qnil;
4244
4245 DEFVAR_LISP ("x-no-window-manager", &Vx_no_window_manager,
4246 "t if no X window manager is in use.");
4247
4248 #ifdef HAVE_X11
4249 defsubr (&Sx_get_resource);
4250 #if 0
4251 defsubr (&Sx_draw_rectangle);
4252 defsubr (&Sx_erase_rectangle);
4253 defsubr (&Sx_contour_region);
4254 defsubr (&Sx_uncontour_region);
4255 #endif
4256 defsubr (&Sx_display_color_p);
4257 defsubr (&Sx_list_fonts);
4258 defsubr (&Sx_color_defined_p);
4259 defsubr (&Sx_server_max_request_size);
4260 defsubr (&Sx_server_vendor);
4261 defsubr (&Sx_server_version);
4262 defsubr (&Sx_display_pixel_width);
4263 defsubr (&Sx_display_pixel_height);
4264 defsubr (&Sx_display_mm_width);
4265 defsubr (&Sx_display_mm_height);
4266 defsubr (&Sx_display_screens);
4267 defsubr (&Sx_display_planes);
4268 defsubr (&Sx_display_color_cells);
4269 defsubr (&Sx_display_visual_class);
4270 defsubr (&Sx_display_backing_store);
4271 defsubr (&Sx_display_save_under);
4272 #if 0
4273 defsubr (&Sx_rebind_key);
4274 defsubr (&Sx_rebind_keys);
4275 defsubr (&Sx_track_pointer);
4276 defsubr (&Sx_grab_pointer);
4277 defsubr (&Sx_ungrab_pointer);
4278 #endif
4279 #else
4280 defsubr (&Sx_get_default);
4281 defsubr (&Sx_store_cut_buffer);
4282 defsubr (&Sx_get_cut_buffer);
4283 #endif
4284 defsubr (&Sx_parse_geometry);
4285 defsubr (&Sx_create_frame);
4286 defsubr (&Sfocus_frame);
4287 defsubr (&Sunfocus_frame);
4288 #if 0
4289 defsubr (&Sx_horizontal_line);
4290 #endif
4291 defsubr (&Sx_open_connection);
4292 defsubr (&Sx_close_current_connection);
4293 defsubr (&Sx_synchronize);
4294 }
4295
4296 #endif /* HAVE_X_WINDOWS */