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