Version 5 baseline.
[emacs.git] / src / xfns.c
blob307aa35f0b09bb266b0cd5ee412de79de7531a18
1 /* Functions for the X window system.
2 Copyright (C) 1989, 1992, 1993 Free Software Foundation.
4 This file is part of GNU Emacs.
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.
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.
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. */
20 /* Completely rewritten by Richard Stallman. */
22 /* Rewritten for X11 by Joseph Arceneaux */
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"
37 #ifdef HAVE_X_WINDOWS
38 extern void abort ();
40 #include <X11/bitmaps/gray>
42 #define min(a,b) ((a) < (b) ? (a) : (b))
43 #define max(a,b) ((a) > (b) ? (a) : (b))
45 #ifdef HAVE_X11
46 /* X Resource data base */
47 static XrmDatabase xrdb;
49 /* The class of this X application. */
50 #define EMACS_CLASS "Emacs"
52 /* Title name and application name for X stuff. */
53 extern char *x_id_name;
54 extern Lisp_Object invocation_name;
56 /* The background and shape of the mouse pointer, and shape when not
57 over text or in the modeline. */
58 Lisp_Object Vx_pointer_shape, Vx_nontext_pointer_shape, Vx_mode_pointer_shape;
60 /* Color of chars displayed in cursor box. */
61 Lisp_Object Vx_cursor_fore_pixel;
63 /* The X Visual we are using for X windows (the default) */
64 Visual *screen_visual;
66 /* How many screens this X display has. */
67 int x_screen_count;
69 /* The vendor supporting this X server. */
70 Lisp_Object Vx_vendor;
72 /* The vendor's release number for this X server. */
73 int x_release;
75 /* Height of this X screen in pixels. */
76 int x_screen_height;
78 /* Height of this X screen in millimeters. */
79 int x_screen_height_mm;
81 /* Width of this X screen in pixels. */
82 int x_screen_width;
84 /* Width of this X screen in millimeters. */
85 int x_screen_width_mm;
87 /* Does this X screen do backing store? */
88 Lisp_Object Vx_backing_store;
90 /* Does this X screen do save-unders? */
91 int x_save_under;
93 /* Number of planes for this screen. */
94 int x_screen_planes;
96 /* X Visual type of this screen. */
97 Lisp_Object Vx_screen_visual;
99 /* Non nil if no window manager is in use. */
100 Lisp_Object Vx_no_window_manager;
102 static char *x_visual_strings[] =
104 "StaticGray",
105 "GrayScale",
106 "StaticColor",
107 "PseudoColor",
108 "TrueColor",
109 "DirectColor"
112 /* `t' if a mouse button is depressed. */
114 Lisp_Object Vmouse_depressed;
116 extern unsigned int x_mouse_x, x_mouse_y, x_mouse_grabbed;
118 /* Atom for indicating window state to the window manager. */
119 Atom Xatom_wm_change_state;
121 /* When emacs became the selection owner. */
122 extern Time x_begin_selection_own;
124 /* Emacs' selection property identifier. */
125 extern Atom Xatom_emacs_selection;
127 /* Clipboard selection atom. */
128 extern Atom Xatom_clipboard_selection;
130 /* Clipboard atom. */
131 extern Atom Xatom_clipboard;
133 /* Atom for indicating incremental selection transfer. */
134 extern Atom Xatom_incremental;
136 /* Atom for indicating multiple selection request list */
137 extern Atom Xatom_multiple;
139 /* Atom for what targets emacs handles. */
140 extern Atom Xatom_targets;
142 /* Atom for indicating timstamp selection request */
143 extern Atom Xatom_timestamp;
145 /* Atom requesting we delete our selection. */
146 extern Atom Xatom_delete;
148 /* Selection magic. */
149 extern Atom Xatom_insert_selection;
151 /* Type of property for INSERT_SELECTION. */
152 extern Atom Xatom_pair;
154 /* More selection magic. */
155 extern Atom Xatom_insert_property;
157 /* Atom for indicating property type TEXT */
158 extern Atom Xatom_text;
160 /* Communication with window managers. */
161 extern Atom Xatom_wm_protocols;
163 /* Kinds of protocol things we may receive. */
164 extern Atom Xatom_wm_take_focus;
165 extern Atom Xatom_wm_save_yourself;
166 extern Atom Xatom_wm_delete_window;
168 /* Other WM communication */
169 extern Atom Xatom_wm_configure_denied; /* When our config request is denied */
170 extern Atom Xatom_wm_window_moved; /* When the WM moves us. */
172 #else /* X10 */
174 /* Default size of an Emacs window. */
175 static char *default_window = "=80x24+0+0";
177 #define MAXICID 80
178 char iconidentity[MAXICID];
179 #define ICONTAG "emacs@"
180 char minibuffer_iconidentity[MAXICID];
181 #define MINIBUFFER_ICONTAG "minibuffer@"
183 #endif /* X10 */
185 /* The last 23 bits of the timestamp of the last mouse button event. */
186 Time mouse_timestamp;
188 /* Evaluate this expression to rebuild the section of syms_of_xfns
189 that initializes and staticpros the symbols declared below. Note
190 that Emacs 18 has a bug that keeps C-x C-e from being able to
191 evaluate this expression.
193 (progn
194 ;; Accumulate a list of the symbols we want to initialize from the
195 ;; declarations at the top of the file.
196 (goto-char (point-min))
197 (search-forward "/\*&&& symbols declared here &&&*\/\n")
198 (let (symbol-list)
199 (while (looking-at "Lisp_Object \\(Q[a-z_]+\\)")
200 (setq symbol-list
201 (cons (buffer-substring (match-beginning 1) (match-end 1))
202 symbol-list))
203 (forward-line 1))
204 (setq symbol-list (nreverse symbol-list))
205 ;; Delete the section of syms_of_... where we initialize the symbols.
206 (search-forward "\n /\*&&& init symbols here &&&*\/\n")
207 (let ((start (point)))
208 (while (looking-at "^ Q")
209 (forward-line 2))
210 (kill-region start (point)))
211 ;; Write a new symbol initialization section.
212 (while symbol-list
213 (insert (format " %s = intern (\"" (car symbol-list)))
214 (let ((start (point)))
215 (insert (substring (car symbol-list) 1))
216 (subst-char-in-region start (point) ?_ ?-))
217 (insert (format "\");\n staticpro (&%s);\n" (car symbol-list)))
218 (setq symbol-list (cdr symbol-list)))))
222 /*&&& symbols declared here &&&*/
223 Lisp_Object Qauto_raise;
224 Lisp_Object Qauto_lower;
225 Lisp_Object Qbackground_color;
226 Lisp_Object Qbar;
227 Lisp_Object Qborder_color;
228 Lisp_Object Qborder_width;
229 Lisp_Object Qbox;
230 Lisp_Object Qcursor_color;
231 Lisp_Object Qcursor_type;
232 Lisp_Object Qfont;
233 Lisp_Object Qforeground_color;
234 Lisp_Object Qgeometry;
235 Lisp_Object Qicon_left;
236 Lisp_Object Qicon_top;
237 Lisp_Object Qicon_type;
238 Lisp_Object Qiconic_startup;
239 Lisp_Object Qinternal_border_width;
240 Lisp_Object Qleft;
241 Lisp_Object Qmouse_color;
242 Lisp_Object Qnone;
243 Lisp_Object Qparent_id;
244 Lisp_Object Qsuppress_icon;
245 Lisp_Object Qsuppress_initial_map;
246 Lisp_Object Qtop;
247 Lisp_Object Qundefined_color;
248 Lisp_Object Qvertical_scroll_bars;
249 Lisp_Object Qwindow_id;
250 Lisp_Object Qx_frame_parameter;
252 /* The below are defined in frame.c. */
253 extern Lisp_Object Qheight, Qminibuffer, Qname, Qonly, Qwidth;
254 extern Lisp_Object Qunsplittable;
256 extern Lisp_Object Vwindow_system_version;
258 /* Mouse map for clicks in windows. */
259 extern Lisp_Object Vglobal_mouse_map;
261 /* Points to table of defined typefaces. */
262 struct face *x_face_table[MAX_FACES_AND_GLYPHS];
264 /* Return the Emacs frame-object corresponding to an X window.
265 It could be the frame's main window or an icon window. */
267 struct frame *
268 x_window_to_frame (wdesc)
269 int wdesc;
271 Lisp_Object tail, frame;
272 struct frame *f;
274 for (tail = Vframe_list; CONSP (tail); tail = XCONS (tail)->cdr)
276 frame = XCONS (tail)->car;
277 if (XTYPE (frame) != Lisp_Frame)
278 continue;
279 f = XFRAME (frame);
280 if (FRAME_X_WINDOW (f) == wdesc
281 || f->display.x->icon_desc == wdesc)
282 return f;
284 return 0;
288 /* Connect the frame-parameter names for X frames
289 to the ways of passing the parameter values to the window system.
291 The name of a parameter, as a Lisp symbol,
292 has an `x-frame-parameter' property which is an integer in Lisp
293 but can be interpreted as an `enum x_frame_parm' in C. */
295 enum x_frame_parm
297 X_PARM_FOREGROUND_COLOR,
298 X_PARM_BACKGROUND_COLOR,
299 X_PARM_MOUSE_COLOR,
300 X_PARM_CURSOR_COLOR,
301 X_PARM_BORDER_COLOR,
302 X_PARM_ICON_TYPE,
303 X_PARM_FONT,
304 X_PARM_BORDER_WIDTH,
305 X_PARM_INTERNAL_BORDER_WIDTH,
306 X_PARM_NAME,
307 X_PARM_AUTORAISE,
308 X_PARM_AUTOLOWER,
309 X_PARM_VERT_SCROLL_BAR,
313 struct x_frame_parm_table
315 char *name;
316 void (*setter)( /* struct frame *frame, Lisp_Object val, oldval */ );
319 void x_set_foreground_color ();
320 void x_set_background_color ();
321 void x_set_mouse_color ();
322 void x_set_cursor_color ();
323 void x_set_border_color ();
324 void x_set_cursor_type ();
325 void x_set_icon_type ();
326 void x_set_font ();
327 void x_set_border_width ();
328 void x_set_internal_border_width ();
329 void x_explicitly_set_name ();
330 void x_set_autoraise ();
331 void x_set_autolower ();
332 void x_set_vertical_scroll_bars ();
334 static struct x_frame_parm_table x_frame_parms[] =
336 "foreground-color", x_set_foreground_color,
337 "background-color", x_set_background_color,
338 "mouse-color", x_set_mouse_color,
339 "cursor-color", x_set_cursor_color,
340 "border-color", x_set_border_color,
341 "cursor-type", x_set_cursor_type,
342 "icon-type", x_set_icon_type,
343 "font", x_set_font,
344 "border-width", x_set_border_width,
345 "internal-border-width", x_set_internal_border_width,
346 "name", x_explicitly_set_name,
347 "auto-raise", x_set_autoraise,
348 "auto-lower", x_set_autolower,
349 "vertical-scroll-bars", x_set_vertical_scroll_bars,
352 /* Attach the `x-frame-parameter' properties to
353 the Lisp symbol names of parameters relevant to X. */
355 init_x_parm_symbols ()
357 int i;
359 for (i = 0; i < sizeof (x_frame_parms)/sizeof (x_frame_parms[0]); i++)
360 Fput (intern (x_frame_parms[i].name), Qx_frame_parameter,
361 make_number (i));
364 #if 1
365 /* Change the parameters of FRAME as specified by ALIST.
366 If a parameter is not specially recognized, do nothing;
367 otherwise call the `x_set_...' function for that parameter. */
368 void
369 x_set_frame_parameters (f, alist)
370 FRAME_PTR f;
371 Lisp_Object alist;
373 Lisp_Object tail;
375 /* If both of these parameters are present, it's more efficient to
376 set them both at once. So we wait until we've looked at the
377 entire list before we set them. */
378 Lisp_Object width, height;
380 /* Same here. */
381 Lisp_Object left, top;
383 XSET (width, Lisp_Int, FRAME_WIDTH (f));
384 XSET (height, Lisp_Int, FRAME_HEIGHT (f));
386 XSET (top, Lisp_Int, f->display.x->top_pos);
387 XSET (left, Lisp_Int, f->display.x->left_pos);
389 for (tail = alist; CONSP (tail); tail = Fcdr (tail))
391 Lisp_Object elt, prop, val;
393 elt = Fcar (tail);
394 prop = Fcar (elt);
395 val = Fcdr (elt);
397 if (EQ (prop, Qwidth))
398 width = val;
399 else if (EQ (prop, Qheight))
400 height = val;
401 else if (EQ (prop, Qtop))
402 top = val;
403 else if (EQ (prop, Qleft))
404 left = val;
405 else
407 register Lisp_Object tem;
408 tem = Fget (prop, Qx_frame_parameter);
409 if (XTYPE (tem) == Lisp_Int
410 && XINT (tem) >= 0
411 && XINT (tem) < sizeof (x_frame_parms)/sizeof (x_frame_parms[0]))
412 (*x_frame_parms[XINT (tem)].setter)(f, val,
413 get_frame_param (f, prop));
414 store_frame_param (f, prop, val);
418 /* Don't call these unless they've changed; the window may not actually
419 exist yet. */
421 Lisp_Object frame;
423 XSET (frame, Lisp_Frame, f);
424 if (XINT (width) != FRAME_WIDTH (f)
425 || XINT (height) != FRAME_HEIGHT (f))
426 Fset_frame_size (frame, width, height);
427 if (XINT (left) != f->display.x->left_pos
428 || XINT (top) != f->display.x->top_pos)
429 Fset_frame_position (frame, left, top);
432 #else
433 /* Report to X that a frame parameter of frame F is being set or changed.
434 PARAM is the symbol that says which parameter.
435 VAL is the new value.
436 OLDVAL is the old value.
437 If the parameter is not specially recognized, do nothing;
438 otherwise the `x_set_...' function for this parameter. */
440 void
441 x_set_frame_param (f, param, val, oldval)
442 register struct frame *f;
443 Lisp_Object param;
444 register Lisp_Object val;
445 register Lisp_Object oldval;
447 register Lisp_Object tem;
448 tem = Fget (param, Qx_frame_parameter);
449 if (XTYPE (tem) == Lisp_Int
450 && XINT (tem) >= 0
451 && XINT (tem) < sizeof (x_frame_parms)/sizeof (x_frame_parms[0]))
452 (*x_frame_parms[XINT (tem)].setter)(f, val, oldval);
454 #endif
455 /* Insert a description of internally-recorded parameters of frame X
456 into the parameter alist *ALISTPTR that is to be given to the user.
457 Only parameters that are specific to the X window system
458 and whose values are not correctly recorded in the frame's
459 param_alist need to be considered here. */
461 x_report_frame_params (f, alistptr)
462 struct frame *f;
463 Lisp_Object *alistptr;
465 char buf[16];
467 store_in_alist (alistptr, Qleft, make_number (f->display.x->left_pos));
468 store_in_alist (alistptr, Qtop, make_number (f->display.x->top_pos));
469 store_in_alist (alistptr, Qborder_width,
470 make_number (f->display.x->border_width));
471 store_in_alist (alistptr, Qinternal_border_width,
472 make_number (f->display.x->internal_border_width));
473 sprintf (buf, "%d", FRAME_X_WINDOW (f));
474 store_in_alist (alistptr, Qwindow_id,
475 build_string (buf));
478 /* Decide if color named COLOR is valid for the display
479 associated with the selected frame. */
481 defined_color (color, color_def)
482 char *color;
483 Color *color_def;
485 register int foo;
486 Colormap screen_colormap;
488 BLOCK_INPUT;
489 #ifdef HAVE_X11
490 screen_colormap
491 = DefaultColormap (x_current_display, XDefaultScreen (x_current_display));
493 foo = XParseColor (x_current_display, screen_colormap,
494 color, color_def)
495 && XAllocColor (x_current_display, screen_colormap, color_def);
496 #else
497 foo = XParseColor (color, color_def) && XGetHardwareColor (color_def);
498 #endif /* not HAVE_X11 */
499 UNBLOCK_INPUT;
501 if (foo)
502 return 1;
503 else
504 return 0;
507 /* Given a string ARG naming a color, compute a pixel value from it
508 suitable for screen F.
509 If F is not a color screen, return DEF (default) regardless of what
510 ARG says. */
513 x_decode_color (arg, def)
514 Lisp_Object arg;
515 int def;
517 Color cdef;
519 CHECK_STRING (arg, 0);
521 if (strcmp (XSTRING (arg)->data, "black") == 0)
522 return BLACK_PIX_DEFAULT;
523 else if (strcmp (XSTRING (arg)->data, "white") == 0)
524 return WHITE_PIX_DEFAULT;
526 #ifdef HAVE_X11
527 if (x_screen_planes == 1)
528 return def;
529 #else
530 if (DISPLAY_CELLS == 1)
531 return def;
532 #endif
534 if (defined_color (XSTRING (arg)->data, &cdef))
535 return cdef.pixel;
536 else
537 Fsignal (Qundefined_color, Fcons (arg, Qnil));
540 /* Functions called only from `x_set_frame_param'
541 to set individual parameters.
543 If FRAME_X_WINDOW (f) is 0,
544 the frame is being created and its X-window does not exist yet.
545 In that case, just record the parameter's new value
546 in the standard place; do not attempt to change the window. */
548 void
549 x_set_foreground_color (f, arg, oldval)
550 struct frame *f;
551 Lisp_Object arg, oldval;
553 f->display.x->foreground_pixel = x_decode_color (arg, BLACK_PIX_DEFAULT);
554 if (FRAME_X_WINDOW (f) != 0)
556 #ifdef HAVE_X11
557 BLOCK_INPUT;
558 XSetForeground (x_current_display, f->display.x->normal_gc,
559 f->display.x->foreground_pixel);
560 XSetBackground (x_current_display, f->display.x->reverse_gc,
561 f->display.x->foreground_pixel);
562 UNBLOCK_INPUT;
563 #endif /* HAVE_X11 */
564 if (FRAME_VISIBLE_P (f))
565 redraw_frame (f);
569 void
570 x_set_background_color (f, arg, oldval)
571 struct frame *f;
572 Lisp_Object arg, oldval;
574 Pixmap temp;
575 int mask;
577 f->display.x->background_pixel = x_decode_color (arg, WHITE_PIX_DEFAULT);
579 if (FRAME_X_WINDOW (f) != 0)
581 BLOCK_INPUT;
582 #ifdef HAVE_X11
583 /* The main frame area. */
584 XSetBackground (x_current_display, f->display.x->normal_gc,
585 f->display.x->background_pixel);
586 XSetForeground (x_current_display, f->display.x->reverse_gc,
587 f->display.x->background_pixel);
588 XSetWindowBackground (x_current_display, FRAME_X_WINDOW (f),
589 f->display.x->background_pixel);
591 #else
592 temp = XMakeTile (f->display.x->background_pixel);
593 XChangeBackground (FRAME_X_WINDOW (f), temp);
594 XFreePixmap (temp);
595 #endif /* not HAVE_X11 */
596 UNBLOCK_INPUT;
598 if (FRAME_VISIBLE_P (f))
599 redraw_frame (f);
603 void
604 x_set_mouse_color (f, arg, oldval)
605 struct frame *f;
606 Lisp_Object arg, oldval;
608 Cursor cursor, nontext_cursor, mode_cursor;
609 int mask_color;
611 if (!EQ (Qnil, arg))
612 f->display.x->mouse_pixel = x_decode_color (arg, BLACK_PIX_DEFAULT);
613 mask_color = f->display.x->background_pixel;
614 /* No invisible pointers. */
615 if (mask_color == f->display.x->mouse_pixel
616 && mask_color == f->display.x->background_pixel)
617 f->display.x->mouse_pixel = f->display.x->foreground_pixel;
619 BLOCK_INPUT;
620 #ifdef HAVE_X11
622 /* It's not okay to crash if the user selects a screwey cursor. */
623 x_catch_errors ();
625 if (!EQ (Qnil, Vx_pointer_shape))
627 CHECK_NUMBER (Vx_pointer_shape, 0);
628 cursor = XCreateFontCursor (x_current_display, XINT (Vx_pointer_shape));
630 else
631 cursor = XCreateFontCursor (x_current_display, XC_xterm);
632 x_check_errors ("bad text pointer cursor: %s");
634 if (!EQ (Qnil, Vx_nontext_pointer_shape))
636 CHECK_NUMBER (Vx_nontext_pointer_shape, 0);
637 nontext_cursor = XCreateFontCursor (x_current_display,
638 XINT (Vx_nontext_pointer_shape));
640 else
641 nontext_cursor = XCreateFontCursor (x_current_display, XC_left_ptr);
642 x_check_errors ("bad nontext pointer cursor: %s");
644 if (!EQ (Qnil, Vx_mode_pointer_shape))
646 CHECK_NUMBER (Vx_mode_pointer_shape, 0);
647 mode_cursor = XCreateFontCursor (x_current_display,
648 XINT (Vx_mode_pointer_shape));
650 else
651 mode_cursor = XCreateFontCursor (x_current_display, XC_xterm);
653 /* Check and report errors with the above calls. */
654 x_check_errors ("can't set cursor shape: %s");
655 x_uncatch_errors ();
658 XColor fore_color, back_color;
660 fore_color.pixel = f->display.x->mouse_pixel;
661 back_color.pixel = mask_color;
662 XQueryColor (x_current_display,
663 DefaultColormap (x_current_display,
664 DefaultScreen (x_current_display)),
665 &fore_color);
666 XQueryColor (x_current_display,
667 DefaultColormap (x_current_display,
668 DefaultScreen (x_current_display)),
669 &back_color);
670 XRecolorCursor (x_current_display, cursor,
671 &fore_color, &back_color);
672 XRecolorCursor (x_current_display, nontext_cursor,
673 &fore_color, &back_color);
674 XRecolorCursor (x_current_display, mode_cursor,
675 &fore_color, &back_color);
677 #else /* X10 */
678 cursor = XCreateCursor (16, 16, MouseCursor, MouseMask,
679 0, 0,
680 f->display.x->mouse_pixel,
681 f->display.x->background_pixel,
682 GXcopy);
683 #endif /* X10 */
685 if (FRAME_X_WINDOW (f) != 0)
687 XDefineCursor (XDISPLAY FRAME_X_WINDOW (f), cursor);
690 if (cursor != f->display.x->text_cursor && f->display.x->text_cursor != 0)
691 XFreeCursor (XDISPLAY f->display.x->text_cursor);
692 f->display.x->text_cursor = cursor;
693 #ifdef HAVE_X11
694 if (nontext_cursor != f->display.x->nontext_cursor
695 && f->display.x->nontext_cursor != 0)
696 XFreeCursor (XDISPLAY f->display.x->nontext_cursor);
697 f->display.x->nontext_cursor = nontext_cursor;
699 if (mode_cursor != f->display.x->modeline_cursor
700 && f->display.x->modeline_cursor != 0)
701 XFreeCursor (XDISPLAY f->display.x->modeline_cursor);
702 f->display.x->modeline_cursor = mode_cursor;
703 #endif /* HAVE_X11 */
705 XFlushQueue ();
706 UNBLOCK_INPUT;
709 void
710 x_set_cursor_color (f, arg, oldval)
711 struct frame *f;
712 Lisp_Object arg, oldval;
714 unsigned long fore_pixel;
716 if (!EQ (Vx_cursor_fore_pixel, Qnil))
717 fore_pixel = x_decode_color (Vx_cursor_fore_pixel, WHITE_PIX_DEFAULT);
718 else
719 fore_pixel = f->display.x->background_pixel;
720 f->display.x->cursor_pixel = x_decode_color (arg, BLACK_PIX_DEFAULT);
722 /* Make sure that the cursor color differs from the background color. */
723 if (f->display.x->cursor_pixel == f->display.x->background_pixel)
725 f->display.x->cursor_pixel == f->display.x->mouse_pixel;
726 if (f->display.x->cursor_pixel == fore_pixel)
727 fore_pixel = f->display.x->background_pixel;
730 if (FRAME_X_WINDOW (f) != 0)
732 #ifdef HAVE_X11
733 BLOCK_INPUT;
734 XSetBackground (x_current_display, f->display.x->cursor_gc,
735 f->display.x->cursor_pixel);
736 XSetForeground (x_current_display, f->display.x->cursor_gc,
737 fore_pixel);
738 UNBLOCK_INPUT;
739 #endif /* HAVE_X11 */
741 if (FRAME_VISIBLE_P (f))
743 x_display_cursor (f, 0);
744 x_display_cursor (f, 1);
749 /* Set the border-color of frame F to value described by ARG.
750 ARG can be a string naming a color.
751 The border-color is used for the border that is drawn by the X server.
752 Note that this does not fully take effect if done before
753 F has an x-window; it must be redone when the window is created.
755 Note: this is done in two routines because of the way X10 works.
757 Note: under X11, this is normally the province of the window manager,
758 and so emacs' border colors may be overridden. */
760 void
761 x_set_border_color (f, arg, oldval)
762 struct frame *f;
763 Lisp_Object arg, oldval;
765 unsigned char *str;
766 int pix;
768 CHECK_STRING (arg, 0);
769 str = XSTRING (arg)->data;
771 #ifndef HAVE_X11
772 if (!strcmp (str, "grey") || !strcmp (str, "Grey")
773 || !strcmp (str, "gray") || !strcmp (str, "Gray"))
774 pix = -1;
775 else
776 #endif /* X10 */
778 pix = x_decode_color (arg, BLACK_PIX_DEFAULT);
780 x_set_border_pixel (f, pix);
783 /* Set the border-color of frame F to pixel value PIX.
784 Note that this does not fully take effect if done before
785 F has an x-window. */
787 x_set_border_pixel (f, pix)
788 struct frame *f;
789 int pix;
791 f->display.x->border_pixel = pix;
793 if (FRAME_X_WINDOW (f) != 0 && f->display.x->border_width > 0)
795 Pixmap temp;
796 int mask;
798 BLOCK_INPUT;
799 #ifdef HAVE_X11
800 XSetWindowBorder (x_current_display, FRAME_X_WINDOW (f),
801 pix);
802 #else
803 if (pix < 0)
804 temp = XMakePixmap ((Bitmap) XStoreBitmap (gray_width, gray_height,
805 gray_bits),
806 BLACK_PIX_DEFAULT, WHITE_PIX_DEFAULT);
807 else
808 temp = XMakeTile (pix);
809 XChangeBorder (FRAME_X_WINDOW (f), temp);
810 XFreePixmap (XDISPLAY temp);
811 #endif /* not HAVE_X11 */
812 UNBLOCK_INPUT;
814 if (FRAME_VISIBLE_P (f))
815 redraw_frame (f);
819 void
820 x_set_cursor_type (f, arg, oldval)
821 FRAME_PTR f;
822 Lisp_Object arg, oldval;
824 if (EQ (arg, Qbar))
825 FRAME_DESIRED_CURSOR (f) = bar_cursor;
826 else if (EQ (arg, Qbox))
827 FRAME_DESIRED_CURSOR (f) = filled_box_cursor;
828 else
829 error
830 ("the `cursor-type' frame parameter should be either `bar' or `box'");
832 /* Make sure the cursor gets redrawn. This is overkill, but how
833 often do people change cursor types? */
834 update_mode_lines++;
837 void
838 x_set_icon_type (f, arg, oldval)
839 struct frame *f;
840 Lisp_Object arg, oldval;
842 Lisp_Object tem;
843 int result;
845 if (EQ (oldval, Qnil) == EQ (arg, Qnil))
846 return;
848 BLOCK_INPUT;
849 if (NILP (arg))
850 result = x_text_icon (f, 0);
851 else
852 result = x_bitmap_icon (f);
854 if (result)
856 UNBLOCK_INPUT;
857 error ("No icon window available.");
860 /* If the window was unmapped (and its icon was mapped),
861 the new icon is not mapped, so map the window in its stead. */
862 if (FRAME_VISIBLE_P (f))
863 XMapWindow (XDISPLAY FRAME_X_WINDOW (f));
865 XFlushQueue ();
866 UNBLOCK_INPUT;
869 void
870 x_set_font (f, arg, oldval)
871 struct frame *f;
872 Lisp_Object arg, oldval;
874 unsigned char *name;
875 int result;
877 CHECK_STRING (arg, 1);
878 name = XSTRING (arg)->data;
880 BLOCK_INPUT;
881 result = x_new_font (f, name);
882 UNBLOCK_INPUT;
884 if (result)
885 error ("Font \"%s\" is not defined", name);
888 void
889 x_set_border_width (f, arg, oldval)
890 struct frame *f;
891 Lisp_Object arg, oldval;
893 CHECK_NUMBER (arg, 0);
895 if (XINT (arg) == f->display.x->border_width)
896 return;
898 if (FRAME_X_WINDOW (f) != 0)
899 error ("Cannot change the border width of a window");
901 f->display.x->border_width = XINT (arg);
904 void
905 x_set_internal_border_width (f, arg, oldval)
906 struct frame *f;
907 Lisp_Object arg, oldval;
909 int mask;
910 int old = f->display.x->internal_border_width;
912 CHECK_NUMBER (arg, 0);
913 f->display.x->internal_border_width = XINT (arg);
914 if (f->display.x->internal_border_width < 0)
915 f->display.x->internal_border_width = 0;
917 if (f->display.x->internal_border_width == old)
918 return;
920 if (FRAME_X_WINDOW (f) != 0)
922 BLOCK_INPUT;
923 x_set_window_size (f, f->width, f->height);
924 #if 0
925 x_set_resize_hint (f);
926 #endif
927 XFlushQueue ();
928 UNBLOCK_INPUT;
929 SET_FRAME_GARBAGED (f);
933 /* Change the name of frame F to ARG. If ARG is nil, set F's name to
934 x_id_name.
936 If EXPLICIT is non-zero, that indicates that lisp code is setting the
937 name; if ARG is a string, set F's name to ARG and set
938 F->explicit_name; if ARG is Qnil, then clear F->explicit_name.
940 If EXPLICIT is zero, that indicates that Emacs redisplay code is
941 suggesting a new name, which lisp code should override; if
942 F->explicit_name is set, ignore the new name; otherwise, set it. */
944 void
945 x_set_name (f, name, explicit)
946 struct frame *f;
947 Lisp_Object name;
948 int explicit;
950 /* Make sure that requests from lisp code override requests from
951 Emacs redisplay code. */
952 if (explicit)
954 /* If we're switching from explicit to implicit, we had better
955 update the mode lines and thereby update the title. */
956 if (f->explicit_name && NILP (name))
957 update_mode_lines = 1;
959 f->explicit_name = ! NILP (name);
961 else if (f->explicit_name)
962 return;
964 /* If NAME is nil, set the name to the x_id_name. */
965 if (NILP (name))
966 name = build_string (x_id_name);
967 else
968 CHECK_STRING (name, 0);
970 /* Don't change the name if it's already NAME. */
971 if (! NILP (Fstring_equal (name, f->name)))
972 return;
974 if (FRAME_X_WINDOW (f))
976 BLOCK_INPUT;
978 #ifdef HAVE_X11R4
980 XTextProperty text;
981 text.value = XSTRING (name)->data;
982 text.encoding = XA_STRING;
983 text.format = 8;
984 text.nitems = XSTRING (name)->size;
985 XSetWMName (x_current_display, FRAME_X_WINDOW (f), &text);
986 XSetWMIconName (x_current_display, FRAME_X_WINDOW (f), &text);
988 #else
989 XSetIconName (XDISPLAY FRAME_X_WINDOW (f),
990 XSTRING (name)->data);
991 XStoreName (XDISPLAY FRAME_X_WINDOW (f),
992 XSTRING (name)->data);
993 #endif
995 UNBLOCK_INPUT;
998 f->name = name;
1001 /* This function should be called when the user's lisp code has
1002 specified a name for the frame; the name will override any set by the
1003 redisplay code. */
1004 void
1005 x_explicitly_set_name (f, arg, oldval)
1006 FRAME_PTR f;
1007 Lisp_Object arg, oldval;
1009 x_set_name (f, arg, 1);
1012 /* This function should be called by Emacs redisplay code to set the
1013 name; names set this way will never override names set by the user's
1014 lisp code. */
1015 void
1016 x_implicitly_set_name (f, arg, oldval)
1017 FRAME_PTR f;
1018 Lisp_Object arg, oldval;
1020 x_set_name (f, arg, 0);
1023 void
1024 x_set_autoraise (f, arg, oldval)
1025 struct frame *f;
1026 Lisp_Object arg, oldval;
1028 f->auto_raise = !EQ (Qnil, arg);
1031 void
1032 x_set_autolower (f, arg, oldval)
1033 struct frame *f;
1034 Lisp_Object arg, oldval;
1036 f->auto_lower = !EQ (Qnil, arg);
1039 void
1040 x_set_vertical_scroll_bars (f, arg, oldval)
1041 struct frame *f;
1042 Lisp_Object arg, oldval;
1044 if (NILP (arg) != ! FRAME_HAS_VERTICAL_SCROLL_BARS (f))
1046 FRAME_HAS_VERTICAL_SCROLL_BARS (f) = ! NILP (arg);
1048 /* We set this parameter before creating the X window for the
1049 frame, so we can get the geometry right from the start.
1050 However, if the window hasn't been created yet, we shouldn't
1051 call x_set_window_size. */
1052 if (FRAME_X_WINDOW (f))
1053 x_set_window_size (f, FRAME_WIDTH (f), FRAME_HEIGHT (f));
1057 #ifdef HAVE_X11
1058 int n_faces;
1060 #if 0
1061 /* I believe this function is obsolete with respect to the new face display
1062 changes. */
1063 x_set_face (scr, font, background, foreground, stipple)
1064 struct frame *scr;
1065 XFontStruct *font;
1066 unsigned long background, foreground;
1067 Pixmap stipple;
1069 XGCValues gc_values;
1070 GC temp_gc;
1071 unsigned long gc_mask;
1072 struct face *new_face;
1073 unsigned int width = 16;
1074 unsigned int height = 16;
1076 if (n_faces == MAX_FACES_AND_GLYPHS)
1077 return 1;
1079 /* Create the Graphics Context. */
1080 gc_values.font = font->fid;
1081 gc_values.foreground = foreground;
1082 gc_values.background = background;
1083 gc_values.line_width = 0;
1084 gc_mask = GCLineWidth | GCFont | GCForeground | GCBackground;
1085 if (stipple)
1087 gc_values.stipple
1088 = XCreateBitmapFromData (x_current_display, ROOT_WINDOW,
1089 (char *) stipple, width, height);
1090 gc_mask |= GCStipple;
1093 temp_gc = XCreateGC (x_current_display, FRAME_X_WINDOW (scr),
1094 gc_mask, &gc_values);
1095 if (!temp_gc)
1096 return 1;
1097 new_face = (struct face *) xmalloc (sizeof (struct face));
1098 if (!new_face)
1100 XFreeGC (x_current_display, temp_gc);
1101 return 1;
1104 new_face->font = font;
1105 new_face->foreground = foreground;
1106 new_face->background = background;
1107 new_face->face_gc = temp_gc;
1108 if (stipple)
1109 new_face->stipple = gc_values.stipple;
1111 x_face_table[++n_faces] = new_face;
1112 return 1;
1114 #endif
1116 x_set_glyph (scr, glyph)
1120 #if 0
1121 DEFUN ("x-set-face-font", Fx_set_face_font, Sx_set_face_font, 4, 2, 0,
1122 "Specify face table entry FACE-CODE to be the font named by FONT,\n\
1123 in colors FOREGROUND and BACKGROUND.")
1124 (face_code, font_name, foreground, background)
1125 Lisp_Object face_code;
1126 Lisp_Object font_name;
1127 Lisp_Object foreground;
1128 Lisp_Object background;
1130 register struct face *fp; /* Current face info. */
1131 register int fn; /* Face number. */
1132 register FONT_TYPE *f; /* Font data structure. */
1133 unsigned char *newname;
1134 int fg, bg;
1135 GC temp_gc;
1136 XGCValues gc_values;
1138 /* Need to do something about this. */
1139 Drawable drawable = FRAME_X_WINDOW (selected_frame);
1141 CHECK_NUMBER (face_code, 1);
1142 CHECK_STRING (font_name, 2);
1144 if (EQ (foreground, Qnil) || EQ (background, Qnil))
1146 fg = selected_frame->display.x->foreground_pixel;
1147 bg = selected_frame->display.x->background_pixel;
1149 else
1151 CHECK_NUMBER (foreground, 0);
1152 CHECK_NUMBER (background, 1);
1154 fg = x_decode_color (XINT (foreground), BLACK_PIX_DEFAULT);
1155 bg = x_decode_color (XINT (background), WHITE_PIX_DEFAULT);
1158 fn = XINT (face_code);
1159 if ((fn < 1) || (fn > 255))
1160 error ("Invalid face code, %d", fn);
1162 newname = XSTRING (font_name)->data;
1163 BLOCK_INPUT;
1164 f = (*newname == 0 ? 0 : XGetFont (newname));
1165 UNBLOCK_INPUT;
1166 if (f == 0)
1167 error ("Font \"%s\" is not defined", newname);
1169 fp = x_face_table[fn];
1170 if (fp == 0)
1172 x_face_table[fn] = fp = (struct face *) xmalloc (sizeof (struct face));
1173 bzero (fp, sizeof (struct face));
1174 fp->face_type = x_pixmap;
1176 else if (FACE_IS_FONT (fn))
1178 BLOCK_INPUT;
1179 XFreeGC (FACE_FONT (fn));
1180 UNBLOCK_INPUT;
1182 else if (FACE_IS_IMAGE (fn)) /* This should not happen... */
1184 BLOCK_INPUT;
1185 XFreePixmap (x_current_display, FACE_IMAGE (fn));
1186 fp->face_type = x_font;
1187 UNBLOCK_INPUT;
1189 else
1190 abort ();
1192 fp->face_GLYPH.font_desc.font = f;
1193 gc_values.font = f->fid;
1194 gc_values.foreground = fg;
1195 gc_values.background = bg;
1196 fp->face_GLYPH.font_desc.face_gc = XCreateGC (x_current_display,
1197 drawable, GCFont | GCForeground
1198 | GCBackground, &gc_values);
1199 fp->face_GLYPH.font_desc.font_width = FONT_WIDTH (f);
1200 fp->face_GLYPH.font_desc.font_height = FONT_HEIGHT (f);
1202 return face_code;
1204 #endif
1205 #else /* X10 */
1206 DEFUN ("x-set-face", Fx_set_face, Sx_set_face, 4, 4, 0,
1207 "Specify face table entry FACE-CODE to be the font named by FONT,\n\
1208 in colors FOREGROUND and BACKGROUND.")
1209 (face_code, font_name, foreground, background)
1210 Lisp_Object face_code;
1211 Lisp_Object font_name;
1212 Lisp_Object foreground;
1213 Lisp_Object background;
1215 register struct face *fp; /* Current face info. */
1216 register int fn; /* Face number. */
1217 register FONT_TYPE *f; /* Font data structure. */
1218 unsigned char *newname;
1220 CHECK_NUMBER (face_code, 1);
1221 CHECK_STRING (font_name, 2);
1223 fn = XINT (face_code);
1224 if ((fn < 1) || (fn > 255))
1225 error ("Invalid face code, %d", fn);
1227 /* Ask the server to find the specified font. */
1228 newname = XSTRING (font_name)->data;
1229 BLOCK_INPUT;
1230 f = (*newname == 0 ? 0 : XGetFont (newname));
1231 UNBLOCK_INPUT;
1232 if (f == 0)
1233 error ("Font \"%s\" is not defined", newname);
1235 /* Get the face structure for face_code in the face table.
1236 Make sure it exists. */
1237 fp = x_face_table[fn];
1238 if (fp == 0)
1240 x_face_table[fn] = fp = (struct face *) xmalloc (sizeof (struct face));
1241 bzero (fp, sizeof (struct face));
1244 /* If this face code already exists, get rid of the old font. */
1245 if (fp->font != 0 && fp->font != f)
1247 BLOCK_INPUT;
1248 XLoseFont (fp->font);
1249 UNBLOCK_INPUT;
1252 /* Store the specified information in FP. */
1253 fp->fg = x_decode_color (foreground, BLACK_PIX_DEFAULT);
1254 fp->bg = x_decode_color (background, WHITE_PIX_DEFAULT);
1255 fp->font = f;
1257 return face_code;
1259 #endif /* X10 */
1261 #if 0
1262 /* This is excluded because there is no painless way
1263 to get or to remember the name of the font. */
1265 DEFUN ("x-get-face", Fx_get_face, Sx_get_face, 1, 1, 0,
1266 "Get data defining face code FACE. FACE is an integer.\n\
1267 The value is a list (FONT FG-COLOR BG-COLOR).")
1268 (face)
1269 Lisp_Object face;
1271 register struct face *fp; /* Current face info. */
1272 register int fn; /* Face number. */
1274 CHECK_NUMBER (face, 1);
1275 fn = XINT (face);
1276 if ((fn < 1) || (fn > 255))
1277 error ("Invalid face code, %d", fn);
1279 /* Make sure the face table exists and this face code is defined. */
1280 if (x_face_table == 0 || x_face_table[fn] == 0)
1281 return Qnil;
1283 fp = x_face_table[fn];
1285 return Fcons (build_string (fp->name),
1286 Fcons (make_number (fp->fg),
1287 Fcons (make_number (fp->bg), Qnil)));
1289 #endif /* 0 */
1291 /* Subroutines of creating an X frame. */
1293 #ifdef HAVE_X11
1294 extern char *x_get_string_resource ();
1295 extern XrmDatabase x_load_resources ();
1297 DEFUN ("x-get-resource", Fx_get_resource, Sx_get_resource, 2, 4, 0,
1298 "Return the value of ATTRIBUTE, of class CLASS, from the X defaults database.\n\
1299 This uses `INSTANCE.ATTRIBUTE' as the key and `Emacs.CLASS' as the\n\
1300 class, where INSTANCE is the name under which Emacs was invoked.\n\
1302 The optional arguments COMPONENT and SUBCLASS add to the key and the\n\
1303 class, respectively. You must specify both of them or neither.\n\
1304 If you specify them, the key is `INSTANCE.COMPONENT.ATTRIBUTE'\n\
1305 and the class is `Emacs.CLASS.SUBCLASS'.")
1306 (attribute, class, component, subclass)
1307 Lisp_Object attribute, class, component, subclass;
1309 register char *value;
1310 char *name_key;
1311 char *class_key;
1313 CHECK_STRING (attribute, 0);
1314 CHECK_STRING (class, 0);
1316 if (!NILP (component))
1317 CHECK_STRING (component, 1);
1318 if (!NILP (subclass))
1319 CHECK_STRING (subclass, 2);
1320 if (NILP (component) != NILP (subclass))
1321 error ("x-get-resource: must specify both COMPONENT and SUBCLASS or neither");
1323 if (NILP (component))
1325 /* Allocate space for the components, the dots which separate them,
1326 and the final '\0'. */
1327 name_key = (char *) alloca (XSTRING (invocation_name)->size
1328 + XSTRING (attribute)->size
1329 + 2);
1330 class_key = (char *) alloca ((sizeof (EMACS_CLASS) - 1)
1331 + XSTRING (class)->size
1332 + 2);
1334 sprintf (name_key, "%s.%s",
1335 XSTRING (invocation_name)->data,
1336 XSTRING (attribute)->data);
1337 sprintf (class_key, "%s.%s",
1338 EMACS_CLASS,
1339 XSTRING (class)->data);
1341 else
1343 name_key = (char *) alloca (XSTRING (invocation_name)->size
1344 + XSTRING (component)->size
1345 + XSTRING (attribute)->size
1346 + 3);
1348 class_key = (char *) alloca ((sizeof (EMACS_CLASS) - 1)
1349 + XSTRING (class)->size
1350 + XSTRING (subclass)->size
1351 + 3);
1353 sprintf (name_key, "%s.%s.%s",
1354 XSTRING (invocation_name)->data,
1355 XSTRING (component)->data,
1356 XSTRING (attribute)->data);
1357 sprintf (class_key, "%s.%s",
1358 EMACS_CLASS,
1359 XSTRING (class)->data,
1360 XSTRING (subclass)->data);
1363 value = x_get_string_resource (xrdb, name_key, class_key);
1365 if (value != (char *) 0)
1366 return build_string (value);
1367 else
1368 return Qnil;
1371 #else /* X10 */
1373 DEFUN ("x-get-default", Fx_get_default, Sx_get_default, 1, 1, 0,
1374 "Get X default ATTRIBUTE from the system, or nil if no default.\n\
1375 Value is a string (when not nil) and ATTRIBUTE is also a string.\n\
1376 The defaults are specified in the file `~/.Xdefaults'.")
1377 (arg)
1378 Lisp_Object arg;
1380 register unsigned char *value;
1382 CHECK_STRING (arg, 1);
1384 value = (unsigned char *) XGetDefault (XDISPLAY
1385 XSTRING (invocation_name)->data,
1386 XSTRING (arg)->data);
1387 if (value == 0)
1388 /* Try reversing last two args, in case this is the buggy version of X. */
1389 value = (unsigned char *) XGetDefault (XDISPLAY
1390 XSTRING (arg)->data,
1391 XSTRING (invocation_name)->data);
1392 if (value != 0)
1393 return build_string (value);
1394 else
1395 return (Qnil);
1398 #define Fx_get_resource(attribute, class, component, subclass) \
1399 Fx_get_default(attribute)
1401 #endif /* X10 */
1403 /* Types we might convert a resource string into. */
1404 enum resource_types
1406 number, boolean, string, symbol,
1409 /* Return the value of parameter PARAM.
1411 First search ALIST, then Vdefault_frame_alist, then the X defaults
1412 database, using ATTRIBUTE as the attribute name and CLASS as its class.
1414 Convert the resource to the type specified by desired_type.
1416 If no default is specified, return Qunbound. If you call
1417 x_get_arg, make sure you deal with Qunbound in a reasonable way,
1418 and don't let it get stored in any lisp-visible variables! */
1420 static Lisp_Object
1421 x_get_arg (alist, param, attribute, class, type)
1422 Lisp_Object alist, param;
1423 char *attribute;
1424 char *class;
1425 enum resource_types type;
1427 register Lisp_Object tem;
1429 tem = Fassq (param, alist);
1430 if (EQ (tem, Qnil))
1431 tem = Fassq (param, Vdefault_frame_alist);
1432 if (EQ (tem, Qnil))
1435 if (attribute)
1437 tem = Fx_get_resource (build_string (attribute),
1438 build_string (class),
1439 Qnil, Qnil);
1441 if (NILP (tem))
1442 return Qunbound;
1444 switch (type)
1446 case number:
1447 return make_number (atoi (XSTRING (tem)->data));
1449 case boolean:
1450 tem = Fdowncase (tem);
1451 if (!strcmp (XSTRING (tem)->data, "on")
1452 || !strcmp (XSTRING (tem)->data, "true"))
1453 return Qt;
1454 else
1455 return Qnil;
1457 case string:
1458 return tem;
1460 case symbol:
1461 return intern (tem);
1463 default:
1464 abort ();
1467 else
1468 return Qunbound;
1470 return Fcdr (tem);
1473 /* Record in frame F the specified or default value according to ALIST
1474 of the parameter named PARAM (a Lisp symbol).
1475 If no value is specified for PARAM, look for an X default for XPROP
1476 on the frame named NAME.
1477 If that is not found either, use the value DEFLT. */
1479 static Lisp_Object
1480 x_default_parameter (f, alist, prop, deflt, xprop, xclass, type)
1481 struct frame *f;
1482 Lisp_Object alist;
1483 Lisp_Object prop;
1484 Lisp_Object deflt;
1485 char *xprop;
1486 char *xclass;
1487 enum resource_types type;
1489 Lisp_Object tem;
1491 tem = x_get_arg (alist, prop, xprop, xclass, type);
1492 if (EQ (tem, Qunbound))
1493 tem = deflt;
1494 x_set_frame_parameters (f, Fcons (Fcons (prop, tem), Qnil));
1495 return tem;
1498 DEFUN ("x-geometry", Fx_geometry, Sx_geometry, 1, 1, 0,
1499 "Parse an X-style geometry string STRING.\n\
1500 Returns an alist of the form ((top . TOP), (left . LEFT) ... ).")
1501 (string)
1502 Lisp_Object string;
1504 int geometry, x, y;
1505 unsigned int width, height;
1506 Lisp_Object values[4];
1508 CHECK_STRING (string, 0);
1510 geometry = XParseGeometry ((char *) XSTRING (string)->data,
1511 &x, &y, &width, &height);
1513 switch (geometry & 0xf) /* Mask out {X,Y}Negative */
1515 case (XValue | YValue):
1516 /* What's one pixel among friends?
1517 Perhaps fix this some day by returning symbol `extreme-top'... */
1518 if (x == 0 && (geometry & XNegative))
1519 x = -1;
1520 if (y == 0 && (geometry & YNegative))
1521 y = -1;
1522 values[0] = Fcons (Qleft, make_number (x));
1523 values[1] = Fcons (Qtop, make_number (y));
1524 return Flist (2, values);
1525 break;
1527 case (WidthValue | HeightValue):
1528 values[0] = Fcons (Qwidth, make_number (width));
1529 values[1] = Fcons (Qheight, make_number (height));
1530 return Flist (2, values);
1531 break;
1533 case (XValue | YValue | WidthValue | HeightValue):
1534 if (x == 0 && (geometry & XNegative))
1535 x = -1;
1536 if (y == 0 && (geometry & YNegative))
1537 y = -1;
1538 values[0] = Fcons (Qwidth, make_number (width));
1539 values[1] = Fcons (Qheight, make_number (height));
1540 values[2] = Fcons (Qleft, make_number (x));
1541 values[3] = Fcons (Qtop, make_number (y));
1542 return Flist (4, values);
1543 break;
1545 case 0:
1546 return Qnil;
1548 default:
1549 error ("Must specify x and y value, and/or width and height");
1553 #ifdef HAVE_X11
1554 /* Calculate the desired size and position of this window,
1555 or set rubber-band prompting if none. */
1557 #define DEFAULT_ROWS 40
1558 #define DEFAULT_COLS 80
1560 static int
1561 x_figure_window_size (f, parms)
1562 struct frame *f;
1563 Lisp_Object parms;
1565 register Lisp_Object tem0, tem1;
1566 int height, width, left, top;
1567 register int geometry;
1568 long window_prompting = 0;
1570 /* Default values if we fall through.
1571 Actually, if that happens we should get
1572 window manager prompting. */
1573 f->width = DEFAULT_COLS;
1574 f->height = DEFAULT_ROWS;
1575 f->display.x->top_pos = 1;
1576 f->display.x->left_pos = 1;
1578 tem0 = x_get_arg (parms, Qheight, 0, 0, number);
1579 tem1 = x_get_arg (parms, Qwidth, 0, 0, number);
1580 if (! EQ (tem0, Qunbound) && ! EQ (tem1, Qunbound))
1582 CHECK_NUMBER (tem0, 0);
1583 CHECK_NUMBER (tem1, 0);
1584 f->height = XINT (tem0);
1585 f->width = XINT (tem1);
1586 window_prompting |= USSize;
1588 else if (! EQ (tem0, Qunbound) || ! EQ (tem1, Qunbound))
1589 error ("Must specify *both* height and width");
1591 f->display.x->vertical_scroll_bar_extra =
1592 (FRAME_HAS_VERTICAL_SCROLL_BARS (f)
1593 ? VERTICAL_SCROLL_BAR_PIXEL_WIDTH (f)
1594 : 0);
1595 f->display.x->pixel_width = CHAR_TO_PIXEL_WIDTH (f, f->width);
1596 f->display.x->pixel_height = CHAR_TO_PIXEL_HEIGHT (f, f->height);
1598 tem0 = x_get_arg (parms, Qtop, 0, 0, number);
1599 tem1 = x_get_arg (parms, Qleft, 0, 0, number);
1600 if (! EQ (tem0, Qunbound) && ! EQ (tem1, Qunbound))
1602 CHECK_NUMBER (tem0, 0);
1603 CHECK_NUMBER (tem1, 0);
1604 f->display.x->top_pos = XINT (tem0);
1605 f->display.x->left_pos = XINT (tem1);
1606 x_calc_absolute_position (f);
1607 window_prompting |= USPosition;
1609 else if (! EQ (tem0, Qunbound) || ! EQ (tem1, Qunbound))
1610 error ("Must specify *both* top and left corners");
1612 switch (window_prompting)
1614 case USSize | USPosition:
1615 return window_prompting;
1616 break;
1618 case USSize: /* Got the size, need the position. */
1619 window_prompting |= PPosition;
1620 return window_prompting;
1621 break;
1623 case USPosition: /* Got the position, need the size. */
1624 window_prompting |= PSize;
1625 return window_prompting;
1626 break;
1628 case 0: /* Got nothing, take both from geometry. */
1629 window_prompting |= PPosition | PSize;
1630 return window_prompting;
1631 break;
1633 default:
1634 /* Somehow a bit got set in window_prompting that we didn't
1635 put there. */
1636 abort ();
1640 static void
1641 x_window (f)
1642 struct frame *f;
1644 XSetWindowAttributes attributes;
1645 unsigned long attribute_mask;
1646 XClassHint class_hints;
1648 attributes.background_pixel = f->display.x->background_pixel;
1649 attributes.border_pixel = f->display.x->border_pixel;
1650 attributes.bit_gravity = StaticGravity;
1651 attributes.backing_store = NotUseful;
1652 attributes.save_under = True;
1653 attributes.event_mask = STANDARD_EVENT_SET;
1654 attribute_mask = (CWBackPixel | CWBorderPixel | CWBitGravity
1655 #if 0
1656 | CWBackingStore | CWSaveUnder
1657 #endif
1658 | CWEventMask);
1660 BLOCK_INPUT;
1661 FRAME_X_WINDOW (f)
1662 = XCreateWindow (x_current_display, ROOT_WINDOW,
1663 f->display.x->left_pos,
1664 f->display.x->top_pos,
1665 PIXEL_WIDTH (f), PIXEL_HEIGHT (f),
1666 f->display.x->border_width,
1667 CopyFromParent, /* depth */
1668 InputOutput, /* class */
1669 screen_visual, /* set in Fx_open_connection */
1670 attribute_mask, &attributes);
1672 class_hints.res_name = (char *) XSTRING (f->name)->data;
1673 class_hints.res_class = EMACS_CLASS;
1674 XSetClassHint (x_current_display, FRAME_X_WINDOW (f), &class_hints);
1676 /* This indicates that we use the "Passive Input" input model.
1677 Unless we do this, we don't get the Focus{In,Out} events that we
1678 need to draw the cursor correctly. Accursed bureaucrats.
1679 XWhipsAndChains (x_current_display, IronMaiden, &TheRack); */
1681 f->display.x->wm_hints.input = True;
1682 f->display.x->wm_hints.flags |= InputHint;
1683 XSetWMHints (x_current_display, FRAME_X_WINDOW (f), &f->display.x->wm_hints);
1685 /* x_set_name normally ignores requests to set the name if the
1686 requested name is the same as the current name. This is the one
1687 place where that assumption isn't correct; f->name is set, but
1688 the X server hasn't been told. */
1690 Lisp_Object name = f->name;
1691 int explicit = f->explicit_name;
1693 f->name = Qnil;
1694 f->explicit_name = 0;
1695 x_set_name (f, name, explicit);
1698 XDefineCursor (XDISPLAY FRAME_X_WINDOW (f),
1699 f->display.x->text_cursor);
1700 UNBLOCK_INPUT;
1702 if (FRAME_X_WINDOW (f) == 0)
1703 error ("Unable to create window.");
1706 /* Handle the icon stuff for this window. Perhaps later we might
1707 want an x_set_icon_position which can be called interactively as
1708 well. */
1710 static void
1711 x_icon (f, parms)
1712 struct frame *f;
1713 Lisp_Object parms;
1715 Lisp_Object icon_x, icon_y;
1717 /* Set the position of the icon. Note that twm groups all
1718 icons in an icon window. */
1719 icon_x = x_get_arg (parms, Qicon_left, 0, 0, number);
1720 icon_y = x_get_arg (parms, Qicon_top, 0, 0, number);
1721 if (!EQ (icon_x, Qunbound) && !EQ (icon_y, Qunbound))
1723 CHECK_NUMBER (icon_x, 0);
1724 CHECK_NUMBER (icon_y, 0);
1726 else if (!EQ (icon_x, Qunbound) || !EQ (icon_y, Qunbound))
1727 error ("Both left and top icon corners of icon must be specified");
1729 BLOCK_INPUT;
1731 if (! EQ (icon_x, Qunbound))
1732 x_wm_set_icon_position (f, XINT (icon_x), XINT (icon_y));
1734 /* Start up iconic or window? */
1735 x_wm_set_window_state (f,
1736 (EQ (x_get_arg (parms, Qiconic_startup,
1737 0, 0, boolean),
1739 ? IconicState
1740 : NormalState));
1742 UNBLOCK_INPUT;
1745 /* Make the GC's needed for this window, setting the
1746 background, border and mouse colors; also create the
1747 mouse cursor and the gray border tile. */
1749 static char cursor_bits[] =
1751 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
1752 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
1753 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
1754 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00
1757 static void
1758 x_make_gc (f)
1759 struct frame *f;
1761 XGCValues gc_values;
1762 GC temp_gc;
1763 XImage tileimage;
1765 /* Create the GC's of this frame.
1766 Note that many default values are used. */
1768 /* Normal video */
1769 gc_values.font = f->display.x->font->fid;
1770 gc_values.foreground = f->display.x->foreground_pixel;
1771 gc_values.background = f->display.x->background_pixel;
1772 gc_values.line_width = 0; /* Means 1 using fast algorithm. */
1773 f->display.x->normal_gc = XCreateGC (x_current_display,
1774 FRAME_X_WINDOW (f),
1775 GCLineWidth | GCFont
1776 | GCForeground | GCBackground,
1777 &gc_values);
1779 /* Reverse video style. */
1780 gc_values.foreground = f->display.x->background_pixel;
1781 gc_values.background = f->display.x->foreground_pixel;
1782 f->display.x->reverse_gc = XCreateGC (x_current_display,
1783 FRAME_X_WINDOW (f),
1784 GCFont | GCForeground | GCBackground
1785 | GCLineWidth,
1786 &gc_values);
1788 /* Cursor has cursor-color background, background-color foreground. */
1789 gc_values.foreground = f->display.x->background_pixel;
1790 gc_values.background = f->display.x->cursor_pixel;
1791 gc_values.fill_style = FillOpaqueStippled;
1792 gc_values.stipple
1793 = XCreateBitmapFromData (x_current_display, ROOT_WINDOW,
1794 cursor_bits, 16, 16);
1795 f->display.x->cursor_gc
1796 = XCreateGC (x_current_display, FRAME_X_WINDOW (f),
1797 (GCFont | GCForeground | GCBackground
1798 | GCFillStyle | GCStipple | GCLineWidth),
1799 &gc_values);
1801 /* Create the gray border tile used when the pointer is not in
1802 the frame. Since this depends on the frame's pixel values,
1803 this must be done on a per-frame basis. */
1804 f->display.x->border_tile =
1805 XCreatePixmapFromBitmapData
1806 (x_current_display, ROOT_WINDOW,
1807 gray_bits, gray_width, gray_height,
1808 f->display.x->foreground_pixel,
1809 f->display.x->background_pixel,
1810 DefaultDepth (x_current_display, XDefaultScreen (x_current_display)));
1812 #endif /* HAVE_X11 */
1814 DEFUN ("x-create-frame", Fx_create_frame, Sx_create_frame,
1815 1, 1, 0,
1816 "Make a new X window, which is called a \"frame\" in Emacs terms.\n\
1817 Return an Emacs frame object representing the X window.\n\
1818 ALIST is an alist of frame parameters.\n\
1819 If the parameters specify that the frame should not have a minibuffer,\n\
1820 and do not specify a specific minibuffer window to use,\n\
1821 then `default-minibuffer-frame' must be a frame whose minibuffer can\n\
1822 be shared by the new frame.")
1823 (parms)
1824 Lisp_Object parms;
1826 #ifdef HAVE_X11
1827 struct frame *f;
1828 Lisp_Object frame, tem;
1829 Lisp_Object name;
1830 int minibuffer_only = 0;
1831 long window_prompting = 0;
1832 int width, height;
1834 if (x_current_display == 0)
1835 error ("X windows are not in use or not initialized");
1837 name = x_get_arg (parms, Qname, "title", "Title", string);
1838 if (XTYPE (name) != Lisp_String
1839 && ! EQ (name, Qunbound)
1840 && ! NILP (name))
1841 error ("x-create-frame: name parameter must be a string");
1843 tem = x_get_arg (parms, Qminibuffer, 0, 0, symbol);
1844 if (EQ (tem, Qnone) || NILP (tem))
1845 f = make_frame_without_minibuffer (Qnil);
1846 else if (EQ (tem, Qonly))
1848 f = make_minibuffer_frame ();
1849 minibuffer_only = 1;
1851 else if (XTYPE (tem) == Lisp_Window)
1852 f = make_frame_without_minibuffer (tem);
1853 else
1854 f = make_frame (1);
1856 /* Note that X Windows does support scroll bars. */
1857 FRAME_CAN_HAVE_SCROLL_BARS (f) = 1;
1859 /* Set the name; the functions to which we pass f expect the name to
1860 be set. */
1861 if (EQ (name, Qunbound) || NILP (name))
1863 f->name = build_string (x_id_name);
1864 f->explicit_name = 0;
1866 else
1868 f->name = name;
1869 f->explicit_name = 1;
1872 XSET (frame, Lisp_Frame, f);
1873 f->output_method = output_x_window;
1874 f->display.x = (struct x_display *) xmalloc (sizeof (struct x_display));
1875 bzero (f->display.x, sizeof (struct x_display));
1877 /* Note that the frame has no physical cursor right now. */
1878 f->phys_cursor_x = -1;
1880 /* Extract the window parameters from the supplied values
1881 that are needed to determine window geometry. */
1882 x_default_parameter (f, parms, Qfont, build_string ("9x15"),
1883 "font", "Font", string);
1884 x_default_parameter (f, parms, Qborder_width, make_number (2),
1885 "borderwidth", "BorderWidth", number);
1886 /* This defaults to 2 in order to match xterm. */
1887 x_default_parameter (f, parms, Qinternal_border_width, make_number (2),
1888 "internalBorderWidth", "BorderWidth", number);
1889 x_default_parameter (f, parms, Qvertical_scroll_bars, Qt,
1890 "verticalScrollBars", "ScrollBars", boolean);
1892 /* Also do the stuff which must be set before the window exists. */
1893 x_default_parameter (f, parms, Qforeground_color, build_string ("black"),
1894 "foreground", "Foreground", string);
1895 x_default_parameter (f, parms, Qbackground_color, build_string ("white"),
1896 "background", "Background", string);
1897 x_default_parameter (f, parms, Qmouse_color, build_string ("black"),
1898 "pointerColor", "Foreground", string);
1899 x_default_parameter (f, parms, Qcursor_color, build_string ("black"),
1900 "cursorColor", "Foreground", string);
1901 x_default_parameter (f, parms, Qborder_color, build_string ("black"),
1902 "borderColor", "BorderColor", string);
1904 f->display.x->parent_desc = ROOT_WINDOW;
1905 window_prompting = x_figure_window_size (f, parms);
1907 x_window (f);
1908 x_icon (f, parms);
1909 x_make_gc (f);
1911 /* We need to do this after creating the X window, so that the
1912 icon-creation functions can say whose icon they're describing. */
1913 x_default_parameter (f, parms, Qicon_type, Qnil,
1914 "iconType", "IconType", symbol);
1916 x_default_parameter (f, parms, Qauto_raise, Qnil,
1917 "autoRaise", "AutoRaiseLower", boolean);
1918 x_default_parameter (f, parms, Qauto_lower, Qnil,
1919 "autoLower", "AutoRaiseLower", boolean);
1920 x_default_parameter (f, parms, Qcursor_type, Qbox,
1921 "cursorType", "CursorType", symbol);
1923 /* Dimensions, especially f->height, must be done via change_frame_size.
1924 Change will not be effected unless different from the current
1925 f->height. */
1926 width = f->width;
1927 height = f->height;
1928 f->height = f->width = 0;
1929 change_frame_size (f, height, width, 1, 0);
1930 BLOCK_INPUT;
1931 x_wm_set_size_hint (f, window_prompting);
1932 UNBLOCK_INPUT;
1934 tem = x_get_arg (parms, Qunsplittable, 0, 0, boolean);
1935 f->no_split = minibuffer_only || EQ (tem, Qt);
1937 /* Make the window appear on the frame and enable display. */
1938 if (!EQ (x_get_arg (parms, Qsuppress_initial_map, 0, 0, boolean), Qt))
1939 x_make_frame_visible (f);
1941 return frame;
1942 #else /* X10 */
1943 struct frame *f;
1944 Lisp_Object frame, tem;
1945 Lisp_Object name;
1946 int pixelwidth, pixelheight;
1947 Cursor cursor;
1948 int height, width;
1949 Window parent;
1950 Pixmap temp;
1951 int minibuffer_only = 0;
1952 Lisp_Object vscroll, hscroll;
1954 if (x_current_display == 0)
1955 error ("X windows are not in use or not initialized");
1957 name = Fassq (Qname, parms);
1959 tem = x_get_arg (parms, Qminibuffer, 0, 0, symbol);
1960 if (EQ (tem, Qnone))
1961 f = make_frame_without_minibuffer (Qnil);
1962 else if (EQ (tem, Qonly))
1964 f = make_minibuffer_frame ();
1965 minibuffer_only = 1;
1967 else if (EQ (tem, Qnil) || EQ (tem, Qunbound))
1968 f = make_frame (1);
1969 else
1970 f = make_frame_without_minibuffer (tem);
1972 parent = ROOT_WINDOW;
1974 XSET (frame, Lisp_Frame, f);
1975 f->output_method = output_x_window;
1976 f->display.x = (struct x_display *) xmalloc (sizeof (struct x_display));
1977 bzero (f->display.x, sizeof (struct x_display));
1979 /* Some temprorary default values for height and width. */
1980 width = 80;
1981 height = 40;
1982 f->display.x->left_pos = -1;
1983 f->display.x->top_pos = -1;
1985 /* Give the frame a default name (which may be overridden with PARMS). */
1987 strncpy (iconidentity, ICONTAG, MAXICID);
1988 if (gethostname (&iconidentity[sizeof (ICONTAG) - 1],
1989 (MAXICID - 1) - sizeof (ICONTAG)))
1990 iconidentity[sizeof (ICONTAG) - 2] = '\0';
1991 f->name = build_string (iconidentity);
1993 /* Extract some window parameters from the supplied values.
1994 These are the parameters that affect window geometry. */
1996 tem = x_get_arg (parms, Qfont, "BodyFont", 0, string);
1997 if (EQ (tem, Qunbound))
1998 tem = build_string ("9x15");
1999 x_set_font (f, tem, Qnil);
2000 x_default_parameter (f, parms, Qborder_color,
2001 build_string ("black"), "Border", 0, string);
2002 x_default_parameter (f, parms, Qbackground_color,
2003 build_string ("white"), "Background", 0, string);
2004 x_default_parameter (f, parms, Qforeground_color,
2005 build_string ("black"), "Foreground", 0, string);
2006 x_default_parameter (f, parms, Qmouse_color,
2007 build_string ("black"), "Mouse", 0, string);
2008 x_default_parameter (f, parms, Qcursor_color,
2009 build_string ("black"), "Cursor", 0, string);
2010 x_default_parameter (f, parms, Qborder_width,
2011 make_number (2), "BorderWidth", 0, number);
2012 x_default_parameter (f, parms, Qinternal_border_width,
2013 make_number (4), "InternalBorderWidth", 0, number);
2014 x_default_parameter (f, parms, Qauto_raise,
2015 Qnil, "AutoRaise", 0, boolean);
2017 hscroll = EQ (x_get_arg (parms, Qhorizontal_scroll_bar, 0, 0, boolean), Qt);
2018 vscroll = EQ (x_get_arg (parms, Qvertical_scroll_bar, 0, 0, boolean), Qt);
2020 if (f->display.x->internal_border_width < 0)
2021 f->display.x->internal_border_width = 0;
2023 tem = x_get_arg (parms, Qwindow_id, 0, 0, number);
2024 if (!EQ (tem, Qunbound))
2026 WINDOWINFO_TYPE wininfo;
2027 int nchildren;
2028 Window *children, root;
2030 CHECK_NUMBER (tem, 0);
2031 FRAME_X_WINDOW (f) = (Window) XINT (tem);
2033 BLOCK_INPUT;
2034 XGetWindowInfo (FRAME_X_WINDOW (f), &wininfo);
2035 XQueryTree (FRAME_X_WINDOW (f), &parent, &nchildren, &children);
2036 free (children);
2037 UNBLOCK_INPUT;
2039 height = PIXEL_TO_CHAR_HEIGHT (f, wininfo.height);
2040 width = PIXEL_TO_CHAR_WIDTH (f, wininfo.width);
2041 f->display.x->left_pos = wininfo.x;
2042 f->display.x->top_pos = wininfo.y;
2043 FRAME_SET_VISIBILITY (f, wininfo.mapped != 0);
2044 f->display.x->border_width = wininfo.bdrwidth;
2045 f->display.x->parent_desc = parent;
2047 else
2049 tem = x_get_arg (parms, Qparent_id, 0, 0, number);
2050 if (!EQ (tem, Qunbound))
2052 CHECK_NUMBER (tem, 0);
2053 parent = (Window) XINT (tem);
2055 f->display.x->parent_desc = parent;
2056 tem = x_get_arg (parms, Qheight, 0, 0, number);
2057 if (EQ (tem, Qunbound))
2059 tem = x_get_arg (parms, Qwidth, 0, 0, number);
2060 if (EQ (tem, Qunbound))
2062 tem = x_get_arg (parms, Qtop, 0, 0, number);
2063 if (EQ (tem, Qunbound))
2064 tem = x_get_arg (parms, Qleft, 0, 0, number);
2067 /* Now TEM is Qunbound if no edge or size was specified.
2068 In that case, we must do rubber-banding. */
2069 if (EQ (tem, Qunbound))
2071 tem = x_get_arg (parms, Qgeometry, 0, 0, number);
2072 x_rubber_band (f,
2073 &f->display.x->left_pos, &f->display.x->top_pos,
2074 &width, &height,
2075 (XTYPE (tem) == Lisp_String
2076 ? (char *) XSTRING (tem)->data : ""),
2077 XSTRING (f->name)->data,
2078 !NILP (hscroll), !NILP (vscroll));
2080 else
2082 /* Here if at least one edge or size was specified.
2083 Demand that they all were specified, and use them. */
2084 tem = x_get_arg (parms, Qheight, 0, 0, number);
2085 if (EQ (tem, Qunbound))
2086 error ("Height not specified");
2087 CHECK_NUMBER (tem, 0);
2088 height = XINT (tem);
2090 tem = x_get_arg (parms, Qwidth, 0, 0, number);
2091 if (EQ (tem, Qunbound))
2092 error ("Width not specified");
2093 CHECK_NUMBER (tem, 0);
2094 width = XINT (tem);
2096 tem = x_get_arg (parms, Qtop, 0, 0, number);
2097 if (EQ (tem, Qunbound))
2098 error ("Top position not specified");
2099 CHECK_NUMBER (tem, 0);
2100 f->display.x->left_pos = XINT (tem);
2102 tem = x_get_arg (parms, Qleft, 0, 0, number);
2103 if (EQ (tem, Qunbound))
2104 error ("Left position not specified");
2105 CHECK_NUMBER (tem, 0);
2106 f->display.x->top_pos = XINT (tem);
2109 pixelwidth = CHAR_TO_PIXEL_WIDTH (f, width);
2110 pixelheight = CHAR_TO_PIXEL_HEIGHT (f, height);
2112 BLOCK_INPUT;
2113 FRAME_X_WINDOW (f)
2114 = XCreateWindow (parent,
2115 f->display.x->left_pos, /* Absolute horizontal offset */
2116 f->display.x->top_pos, /* Absolute Vertical offset */
2117 pixelwidth, pixelheight,
2118 f->display.x->border_width,
2119 BLACK_PIX_DEFAULT, WHITE_PIX_DEFAULT);
2120 UNBLOCK_INPUT;
2121 if (FRAME_X_WINDOW (f) == 0)
2122 error ("Unable to create window.");
2125 /* Install the now determined height and width
2126 in the windows and in phys_lines and desired_lines. */
2127 change_frame_size (f, height, width, 1, 0);
2128 XSelectInput (FRAME_X_WINDOW (f), KeyPressed | ExposeWindow
2129 | ButtonPressed | ButtonReleased | ExposeRegion | ExposeCopy
2130 | EnterWindow | LeaveWindow | UnmapWindow );
2131 x_set_resize_hint (f);
2133 /* Tell the server the window's default name. */
2134 XStoreName (XDISPLAY FRAME_X_WINDOW (f), XSTRING (f->name)->data);
2136 /* Now override the defaults with all the rest of the specified
2137 parms. */
2138 tem = x_get_arg (parms, Qunsplittable, 0, 0, boolean);
2139 f->no_split = minibuffer_only || EQ (tem, Qt);
2141 /* Do not create an icon window if the caller says not to */
2142 if (!EQ (x_get_arg (parms, Qsuppress_icon, 0, 0, boolean), Qt)
2143 || f->display.x->parent_desc != ROOT_WINDOW)
2145 x_text_icon (f, iconidentity);
2146 x_default_parameter (f, parms, Qicon_type, Qnil,
2147 "BitmapIcon", 0, symbol);
2150 /* Tell the X server the previously set values of the
2151 background, border and mouse colors; also create the mouse cursor. */
2152 BLOCK_INPUT;
2153 temp = XMakeTile (f->display.x->background_pixel);
2154 XChangeBackground (FRAME_X_WINDOW (f), temp);
2155 XFreePixmap (temp);
2156 UNBLOCK_INPUT;
2157 x_set_border_pixel (f, f->display.x->border_pixel);
2159 x_set_mouse_color (f, Qnil, Qnil);
2161 /* Now override the defaults with all the rest of the specified parms. */
2163 Fmodify_frame_parameters (frame, parms);
2165 /* Make the window appear on the frame and enable display. */
2167 if (!EQ (x_get_arg (parms, Qsuppress_initial_map, 0, 0, boolean), Qt))
2168 x_make_window_visible (f);
2169 SET_FRAME_GARBAGED (f);
2171 return frame;
2172 #endif /* X10 */
2175 DEFUN ("focus-frame", Ffocus_frame, Sfocus_frame, 1, 1, 0,
2176 "Set the focus on FRAME.")
2177 (frame)
2178 Lisp_Object frame;
2180 CHECK_LIVE_FRAME (frame, 0);
2182 if (FRAME_X_P (XFRAME (frame)))
2184 BLOCK_INPUT;
2185 x_focus_on_frame (XFRAME (frame));
2186 UNBLOCK_INPUT;
2187 return frame;
2190 return Qnil;
2193 DEFUN ("unfocus-frame", Funfocus_frame, Sunfocus_frame, 0, 0, 0,
2194 "If a frame has been focused, release it.")
2197 if (x_focus_frame)
2199 BLOCK_INPUT;
2200 x_unfocus_frame (x_focus_frame);
2201 UNBLOCK_INPUT;
2204 return Qnil;
2207 #ifndef HAVE_X11
2208 /* Computes an X-window size and position either from geometry GEO
2209 or with the mouse.
2211 F is a frame. It specifies an X window which is used to
2212 determine which display to compute for. Its font, borders
2213 and colors control how the rectangle will be displayed.
2215 X and Y are where to store the positions chosen.
2216 WIDTH and HEIGHT are where to store the sizes chosen.
2218 GEO is the geometry that may specify some of the info.
2219 STR is a prompt to display.
2220 HSCROLL and VSCROLL say whether we have horiz and vert scroll bars. */
2223 x_rubber_band (f, x, y, width, height, geo, str, hscroll, vscroll)
2224 struct frame *f;
2225 int *x, *y, *width, *height;
2226 char *geo;
2227 char *str;
2228 int hscroll, vscroll;
2230 OpaqueFrame frame;
2231 Window tempwindow;
2232 WindowInfo wininfo;
2233 int border_color;
2234 int background_color;
2235 Lisp_Object tem;
2236 int mask;
2238 BLOCK_INPUT;
2240 background_color = f->display.x->background_pixel;
2241 border_color = f->display.x->border_pixel;
2243 frame.bdrwidth = f->display.x->border_width;
2244 frame.border = XMakeTile (border_color);
2245 frame.background = XMakeTile (background_color);
2246 tempwindow = XCreateTerm (str, "emacs", geo, default_window, &frame, 10, 5,
2247 (2 * f->display.x->internal_border_width
2248 + (vscroll ? VSCROLL_WIDTH : 0)),
2249 (2 * f->display.x->internal_border_width
2250 + (hscroll ? HSCROLL_HEIGHT : 0)),
2251 width, height, f->display.x->font,
2252 FONT_WIDTH (f->display.x->font),
2253 FONT_HEIGHT (f->display.x->font));
2254 XFreePixmap (frame.border);
2255 XFreePixmap (frame.background);
2257 if (tempwindow != 0)
2259 XQueryWindow (tempwindow, &wininfo);
2260 XDestroyWindow (tempwindow);
2261 *x = wininfo.x;
2262 *y = wininfo.y;
2265 /* Coordinates we got are relative to the root window.
2266 Convert them to coordinates relative to desired parent window
2267 by scanning from there up to the root. */
2268 tempwindow = f->display.x->parent_desc;
2269 while (tempwindow != ROOT_WINDOW)
2271 int nchildren;
2272 Window *children;
2273 XQueryWindow (tempwindow, &wininfo);
2274 *x -= wininfo.x;
2275 *y -= wininfo.y;
2276 XQueryTree (tempwindow, &tempwindow, &nchildren, &children);
2277 free (children);
2280 UNBLOCK_INPUT;
2281 return tempwindow != 0;
2283 #endif /* not HAVE_X11 */
2285 DEFUN ("x-defined-color", Fx_defined_color, Sx_defined_color, 1, 1, 0,
2286 "Return t if the current X display supports the color named COLOR.")
2287 (color)
2288 Lisp_Object color;
2290 Color foo;
2292 CHECK_STRING (color, 0);
2294 if (defined_color (XSTRING (color)->data, &foo))
2295 return Qt;
2296 else
2297 return Qnil;
2300 DEFUN ("x-color-display-p", Fx_color_display_p, Sx_color_display_p, 0, 0, 0,
2301 "Return t if the X display used currently supports color.")
2304 if (x_screen_planes <= 2)
2305 return Qnil;
2307 switch (screen_visual->class)
2309 case StaticColor:
2310 case PseudoColor:
2311 case TrueColor:
2312 case DirectColor:
2313 return Qt;
2315 default:
2316 return Qnil;
2320 x_pixel_width (f)
2321 register struct frame *f;
2323 return PIXEL_WIDTH (f);
2326 x_pixel_height (f)
2327 register struct frame *f;
2329 return PIXEL_HEIGHT (f);
2332 x_char_width (f)
2333 register struct frame *f;
2335 return FONT_WIDTH (f->display.x->font);
2338 x_char_height (f)
2339 register struct frame *f;
2341 return FONT_HEIGHT (f->display.x->font);
2344 #if 0 /* These no longer seem like the right way to do things. */
2346 /* Draw a rectangle on the frame with left top corner including
2347 the character specified by LEFT_CHAR and TOP_CHAR. The rectangle is
2348 CHARS by LINES wide and long and is the color of the cursor. */
2350 void
2351 x_rectangle (f, gc, left_char, top_char, chars, lines)
2352 register struct frame *f;
2353 GC gc;
2354 register int top_char, left_char, chars, lines;
2356 int width;
2357 int height;
2358 int left = (left_char * FONT_WIDTH (f->display.x->font)
2359 + f->display.x->internal_border_width);
2360 int top = (top_char * FONT_HEIGHT (f->display.x->font)
2361 + f->display.x->internal_border_width);
2363 if (chars < 0)
2364 width = FONT_WIDTH (f->display.x->font) / 2;
2365 else
2366 width = FONT_WIDTH (f->display.x->font) * chars;
2367 if (lines < 0)
2368 height = FONT_HEIGHT (f->display.x->font) / 2;
2369 else
2370 height = FONT_HEIGHT (f->display.x->font) * lines;
2372 XDrawRectangle (x_current_display, FRAME_X_WINDOW (f),
2373 gc, left, top, width, height);
2376 DEFUN ("x-draw-rectangle", Fx_draw_rectangle, Sx_draw_rectangle, 5, 5, 0,
2377 "Draw a rectangle on FRAME between coordinates specified by\n\
2378 numbers X0, Y0, X1, Y1 in the cursor pixel.")
2379 (frame, X0, Y0, X1, Y1)
2380 register Lisp_Object frame, X0, X1, Y0, Y1;
2382 register int x0, y0, x1, y1, top, left, n_chars, n_lines;
2384 CHECK_LIVE_FRAME (frame, 0);
2385 CHECK_NUMBER (X0, 0);
2386 CHECK_NUMBER (Y0, 1);
2387 CHECK_NUMBER (X1, 2);
2388 CHECK_NUMBER (Y1, 3);
2390 x0 = XINT (X0);
2391 x1 = XINT (X1);
2392 y0 = XINT (Y0);
2393 y1 = XINT (Y1);
2395 if (y1 > y0)
2397 top = y0;
2398 n_lines = y1 - y0 + 1;
2400 else
2402 top = y1;
2403 n_lines = y0 - y1 + 1;
2406 if (x1 > x0)
2408 left = x0;
2409 n_chars = x1 - x0 + 1;
2411 else
2413 left = x1;
2414 n_chars = x0 - x1 + 1;
2417 BLOCK_INPUT;
2418 x_rectangle (XFRAME (frame), XFRAME (frame)->display.x->cursor_gc,
2419 left, top, n_chars, n_lines);
2420 UNBLOCK_INPUT;
2422 return Qt;
2425 DEFUN ("x-erase-rectangle", Fx_erase_rectangle, Sx_erase_rectangle, 5, 5, 0,
2426 "Draw a rectangle drawn on FRAME between coordinates\n\
2427 X0, Y0, X1, Y1 in the regular background-pixel.")
2428 (frame, X0, Y0, X1, Y1)
2429 register Lisp_Object frame, X0, Y0, X1, Y1;
2431 register int x0, y0, x1, y1, top, left, n_chars, n_lines;
2433 CHECK_FRAME (frame, 0);
2434 CHECK_NUMBER (X0, 0);
2435 CHECK_NUMBER (Y0, 1);
2436 CHECK_NUMBER (X1, 2);
2437 CHECK_NUMBER (Y1, 3);
2439 x0 = XINT (X0);
2440 x1 = XINT (X1);
2441 y0 = XINT (Y0);
2442 y1 = XINT (Y1);
2444 if (y1 > y0)
2446 top = y0;
2447 n_lines = y1 - y0 + 1;
2449 else
2451 top = y1;
2452 n_lines = y0 - y1 + 1;
2455 if (x1 > x0)
2457 left = x0;
2458 n_chars = x1 - x0 + 1;
2460 else
2462 left = x1;
2463 n_chars = x0 - x1 + 1;
2466 BLOCK_INPUT;
2467 x_rectangle (XFRAME (frame), XFRAME (frame)->display.x->reverse_gc,
2468 left, top, n_chars, n_lines);
2469 UNBLOCK_INPUT;
2471 return Qt;
2474 /* Draw lines around the text region beginning at the character position
2475 TOP_X, TOP_Y and ending at BOTTOM_X and BOTTOM_Y. GC specifies the
2476 pixel and line characteristics. */
2478 #define line_len(line) (FRAME_CURRENT_GLYPHS (f)->used[(line)])
2480 static void
2481 outline_region (f, gc, top_x, top_y, bottom_x, bottom_y)
2482 register struct frame *f;
2483 GC gc;
2484 int top_x, top_y, bottom_x, bottom_y;
2486 register int ibw = f->display.x->internal_border_width;
2487 register int font_w = FONT_WIDTH (f->display.x->font);
2488 register int font_h = FONT_HEIGHT (f->display.x->font);
2489 int y = top_y;
2490 int x = line_len (y);
2491 XPoint *pixel_points = (XPoint *)
2492 alloca (((bottom_y - top_y + 2) * 4) * sizeof (XPoint));
2493 register XPoint *this_point = pixel_points;
2495 /* Do the horizontal top line/lines */
2496 if (top_x == 0)
2498 this_point->x = ibw;
2499 this_point->y = ibw + (font_h * top_y);
2500 this_point++;
2501 if (x == 0)
2502 this_point->x = ibw + (font_w / 2); /* Half-size for newline chars. */
2503 else
2504 this_point->x = ibw + (font_w * x);
2505 this_point->y = (this_point - 1)->y;
2507 else
2509 this_point->x = ibw;
2510 this_point->y = ibw + (font_h * (top_y + 1));
2511 this_point++;
2512 this_point->x = ibw + (font_w * top_x);
2513 this_point->y = (this_point - 1)->y;
2514 this_point++;
2515 this_point->x = (this_point - 1)->x;
2516 this_point->y = ibw + (font_h * top_y);
2517 this_point++;
2518 this_point->x = ibw + (font_w * x);
2519 this_point->y = (this_point - 1)->y;
2522 /* Now do the right side. */
2523 while (y < bottom_y)
2524 { /* Right vertical edge */
2525 this_point++;
2526 this_point->x = (this_point - 1)->x;
2527 this_point->y = ibw + (font_h * (y + 1));
2528 this_point++;
2530 y++; /* Horizontal connection to next line */
2531 x = line_len (y);
2532 if (x == 0)
2533 this_point->x = ibw + (font_w / 2);
2534 else
2535 this_point->x = ibw + (font_w * x);
2537 this_point->y = (this_point - 1)->y;
2540 /* Now do the bottom and connect to the top left point. */
2541 this_point->x = ibw + (font_w * (bottom_x + 1));
2543 this_point++;
2544 this_point->x = (this_point - 1)->x;
2545 this_point->y = ibw + (font_h * (bottom_y + 1));
2546 this_point++;
2547 this_point->x = ibw;
2548 this_point->y = (this_point - 1)->y;
2549 this_point++;
2550 this_point->x = pixel_points->x;
2551 this_point->y = pixel_points->y;
2553 XDrawLines (x_current_display, FRAME_X_WINDOW (f),
2554 gc, pixel_points,
2555 (this_point - pixel_points + 1), CoordModeOrigin);
2558 DEFUN ("x-contour-region", Fx_contour_region, Sx_contour_region, 1, 1, 0,
2559 "Highlight the region between point and the character under the mouse\n\
2560 selected frame.")
2561 (event)
2562 register Lisp_Object event;
2564 register int x0, y0, x1, y1;
2565 register struct frame *f = selected_frame;
2566 register int p1, p2;
2568 CHECK_CONS (event, 0);
2570 BLOCK_INPUT;
2571 x0 = XINT (Fcar (Fcar (event)));
2572 y0 = XINT (Fcar (Fcdr (Fcar (event))));
2574 /* If the mouse is past the end of the line, don't that area. */
2575 /* ReWrite this... */
2577 x1 = f->cursor_x;
2578 y1 = f->cursor_y;
2580 if (y1 > y0) /* point below mouse */
2581 outline_region (f, f->display.x->cursor_gc,
2582 x0, y0, x1, y1);
2583 else if (y1 < y0) /* point above mouse */
2584 outline_region (f, f->display.x->cursor_gc,
2585 x1, y1, x0, y0);
2586 else /* same line: draw horizontal rectangle */
2588 if (x1 > x0)
2589 x_rectangle (f, f->display.x->cursor_gc,
2590 x0, y0, (x1 - x0 + 1), 1);
2591 else if (x1 < x0)
2592 x_rectangle (f, f->display.x->cursor_gc,
2593 x1, y1, (x0 - x1 + 1), 1);
2596 XFlush (x_current_display);
2597 UNBLOCK_INPUT;
2599 return Qnil;
2602 DEFUN ("x-uncontour-region", Fx_uncontour_region, Sx_uncontour_region, 1, 1, 0,
2603 "Erase any highlighting of the region between point and the character\n\
2604 at X, Y on the selected frame.")
2605 (event)
2606 register Lisp_Object event;
2608 register int x0, y0, x1, y1;
2609 register struct frame *f = selected_frame;
2611 BLOCK_INPUT;
2612 x0 = XINT (Fcar (Fcar (event)));
2613 y0 = XINT (Fcar (Fcdr (Fcar (event))));
2614 x1 = f->cursor_x;
2615 y1 = f->cursor_y;
2617 if (y1 > y0) /* point below mouse */
2618 outline_region (f, f->display.x->reverse_gc,
2619 x0, y0, x1, y1);
2620 else if (y1 < y0) /* point above mouse */
2621 outline_region (f, f->display.x->reverse_gc,
2622 x1, y1, x0, y0);
2623 else /* same line: draw horizontal rectangle */
2625 if (x1 > x0)
2626 x_rectangle (f, f->display.x->reverse_gc,
2627 x0, y0, (x1 - x0 + 1), 1);
2628 else if (x1 < x0)
2629 x_rectangle (f, f->display.x->reverse_gc,
2630 x1, y1, (x0 - x1 + 1), 1);
2632 UNBLOCK_INPUT;
2634 return Qnil;
2637 #if 0
2638 int contour_begin_x, contour_begin_y;
2639 int contour_end_x, contour_end_y;
2640 int contour_npoints;
2642 /* Clip the top part of the contour lines down (and including) line Y_POS.
2643 If X_POS is in the middle (rather than at the end) of the line, drop
2644 down a line at that character. */
2646 static void
2647 clip_contour_top (y_pos, x_pos)
2649 register XPoint *begin = contour_lines[y_pos].top_left;
2650 register XPoint *end;
2651 register int npoints;
2652 register struct display_line *line = selected_frame->phys_lines[y_pos + 1];
2654 if (x_pos >= line->len - 1) /* Draw one, straight horizontal line. */
2656 end = contour_lines[y_pos].top_right;
2657 npoints = (end - begin + 1);
2658 XDrawLines (x_current_display, contour_window,
2659 contour_erase_gc, begin_erase, npoints, CoordModeOrigin);
2661 bcopy (end, begin + 1, contour_last_point - end + 1);
2662 contour_last_point -= (npoints - 2);
2663 XDrawLines (x_current_display, contour_window,
2664 contour_erase_gc, begin, 2, CoordModeOrigin);
2665 XFlush (x_current_display);
2667 /* Now, update contour_lines structure. */
2669 /* ______. */
2670 else /* |________*/
2672 register XPoint *p = begin + 1;
2673 end = contour_lines[y_pos].bottom_right;
2674 npoints = (end - begin + 1);
2675 XDrawLines (x_current_display, contour_window,
2676 contour_erase_gc, begin_erase, npoints, CoordModeOrigin);
2678 p->y = begin->y;
2679 p->x = ibw + (font_w * (x_pos + 1));
2680 p++;
2681 p->y = begin->y + font_h;
2682 p->x = (p - 1)->x;
2683 bcopy (end, begin + 3, contour_last_point - end + 1);
2684 contour_last_point -= (npoints - 5);
2685 XDrawLines (x_current_display, contour_window,
2686 contour_erase_gc, begin, 4, CoordModeOrigin);
2687 XFlush (x_current_display);
2689 /* Now, update contour_lines structure. */
2693 /* Erase the top horzontal lines of the contour, and then extend
2694 the contour upwards. */
2696 static void
2697 extend_contour_top (line)
2701 static void
2702 clip_contour_bottom (x_pos, y_pos)
2703 int x_pos, y_pos;
2707 static void
2708 extend_contour_bottom (x_pos, y_pos)
2712 DEFUN ("x-select-region", Fx_select_region, Sx_select_region, 1, 1, "e",
2714 (event)
2715 Lisp_Object event;
2717 register struct frame *f = selected_frame;
2718 register int point_x = f->cursor_x;
2719 register int point_y = f->cursor_y;
2720 register int mouse_below_point;
2721 register Lisp_Object obj;
2722 register int x_contour_x, x_contour_y;
2724 x_contour_x = x_mouse_x;
2725 x_contour_y = x_mouse_y;
2726 if (x_contour_y > point_y || (x_contour_y == point_y
2727 && x_contour_x > point_x))
2729 mouse_below_point = 1;
2730 outline_region (f, f->display.x->cursor_gc, point_x, point_y,
2731 x_contour_x, x_contour_y);
2733 else
2735 mouse_below_point = 0;
2736 outline_region (f, f->display.x->cursor_gc, x_contour_x, x_contour_y,
2737 point_x, point_y);
2740 while (1)
2742 obj = read_char (-1, 0, 0, Qnil, 0);
2743 if (XTYPE (obj) != Lisp_Cons)
2744 break;
2746 if (mouse_below_point)
2748 if (x_mouse_y <= point_y) /* Flipped. */
2750 mouse_below_point = 0;
2752 outline_region (f, f->display.x->reverse_gc, point_x, point_y,
2753 x_contour_x, x_contour_y);
2754 outline_region (f, f->display.x->cursor_gc, x_mouse_x, x_mouse_y,
2755 point_x, point_y);
2757 else if (x_mouse_y < x_contour_y) /* Bottom clipped. */
2759 clip_contour_bottom (x_mouse_y);
2761 else if (x_mouse_y > x_contour_y) /* Bottom extended. */
2763 extend_bottom_contour (x_mouse_y);
2766 x_contour_x = x_mouse_x;
2767 x_contour_y = x_mouse_y;
2769 else /* mouse above or same line as point */
2771 if (x_mouse_y >= point_y) /* Flipped. */
2773 mouse_below_point = 1;
2775 outline_region (f, f->display.x->reverse_gc,
2776 x_contour_x, x_contour_y, point_x, point_y);
2777 outline_region (f, f->display.x->cursor_gc, point_x, point_y,
2778 x_mouse_x, x_mouse_y);
2780 else if (x_mouse_y > x_contour_y) /* Top clipped. */
2782 clip_contour_top (x_mouse_y);
2784 else if (x_mouse_y < x_contour_y) /* Top extended. */
2786 extend_contour_top (x_mouse_y);
2791 unread_command_event = obj;
2792 if (mouse_below_point)
2794 contour_begin_x = point_x;
2795 contour_begin_y = point_y;
2796 contour_end_x = x_contour_x;
2797 contour_end_y = x_contour_y;
2799 else
2801 contour_begin_x = x_contour_x;
2802 contour_begin_y = x_contour_y;
2803 contour_end_x = point_x;
2804 contour_end_y = point_y;
2807 #endif
2809 DEFUN ("x-horizontal-line", Fx_horizontal_line, Sx_horizontal_line, 1, 1, "e",
2811 (event)
2812 Lisp_Object event;
2814 register Lisp_Object obj;
2815 struct frame *f = selected_frame;
2816 register struct window *w = XWINDOW (selected_window);
2817 register GC line_gc = f->display.x->cursor_gc;
2818 register GC erase_gc = f->display.x->reverse_gc;
2819 #if 0
2820 char dash_list[] = {6, 4, 6, 4};
2821 int dashes = 4;
2822 XGCValues gc_values;
2823 #endif
2824 register int previous_y;
2825 register int line = (x_mouse_y + 1) * FONT_HEIGHT (f->display.x->font)
2826 + f->display.x->internal_border_width;
2827 register int left = f->display.x->internal_border_width
2828 + (w->left
2829 * FONT_WIDTH (f->display.x->font));
2830 register int right = left + (w->width
2831 * FONT_WIDTH (f->display.x->font))
2832 - f->display.x->internal_border_width;
2834 #if 0
2835 BLOCK_INPUT;
2836 gc_values.foreground = f->display.x->cursor_pixel;
2837 gc_values.background = f->display.x->background_pixel;
2838 gc_values.line_width = 1;
2839 gc_values.line_style = LineOnOffDash;
2840 gc_values.cap_style = CapRound;
2841 gc_values.join_style = JoinRound;
2843 line_gc = XCreateGC (x_current_display, FRAME_X_WINDOW (f),
2844 GCLineStyle | GCJoinStyle | GCCapStyle
2845 | GCLineWidth | GCForeground | GCBackground,
2846 &gc_values);
2847 XSetDashes (x_current_display, line_gc, 0, dash_list, dashes);
2848 gc_values.foreground = f->display.x->background_pixel;
2849 gc_values.background = f->display.x->foreground_pixel;
2850 erase_gc = XCreateGC (x_current_display, FRAME_X_WINDOW (f),
2851 GCLineStyle | GCJoinStyle | GCCapStyle
2852 | GCLineWidth | GCForeground | GCBackground,
2853 &gc_values);
2854 XSetDashes (x_current_display, erase_gc, 0, dash_list, dashes);
2855 #endif
2857 while (1)
2859 BLOCK_INPUT;
2860 if (x_mouse_y >= XINT (w->top)
2861 && x_mouse_y < XINT (w->top) + XINT (w->height) - 1)
2863 previous_y = x_mouse_y;
2864 line = (x_mouse_y + 1) * FONT_HEIGHT (f->display.x->font)
2865 + f->display.x->internal_border_width;
2866 XDrawLine (x_current_display, FRAME_X_WINDOW (f),
2867 line_gc, left, line, right, line);
2869 XFlushQueue ();
2870 UNBLOCK_INPUT;
2874 obj = read_char (-1, 0, 0, Qnil, 0);
2875 if ((XTYPE (obj) != Lisp_Cons)
2876 || (! EQ (Fcar (Fcdr (Fcdr (obj))),
2877 Qvertical_scroll_bar))
2878 || x_mouse_grabbed)
2880 BLOCK_INPUT;
2881 XDrawLine (x_current_display, FRAME_X_WINDOW (f),
2882 erase_gc, left, line, right, line);
2883 UNBLOCK_INPUT;
2884 unread_command_event = obj;
2885 #if 0
2886 XFreeGC (x_current_display, line_gc);
2887 XFreeGC (x_current_display, erase_gc);
2888 #endif
2889 return Qnil;
2892 while (x_mouse_y == previous_y);
2894 BLOCK_INPUT;
2895 XDrawLine (x_current_display, FRAME_X_WINDOW (f),
2896 erase_gc, left, line, right, line);
2897 UNBLOCK_INPUT;
2900 #endif
2902 /* Offset in buffer of character under the pointer, or 0. */
2903 int mouse_buffer_offset;
2905 #if 0
2906 /* These keep track of the rectangle following the pointer. */
2907 int mouse_track_top, mouse_track_left, mouse_track_width;
2909 DEFUN ("x-track-pointer", Fx_track_pointer, Sx_track_pointer, 0, 0, 0,
2910 "Track the pointer.")
2913 static Cursor current_pointer_shape;
2914 FRAME_PTR f = x_mouse_frame;
2916 BLOCK_INPUT;
2917 if (EQ (Vmouse_frame_part, Qtext_part)
2918 && (current_pointer_shape != f->display.x->nontext_cursor))
2920 unsigned char c;
2921 struct buffer *buf;
2923 current_pointer_shape = f->display.x->nontext_cursor;
2924 XDefineCursor (x_current_display,
2925 FRAME_X_WINDOW (f),
2926 current_pointer_shape);
2928 buf = XBUFFER (XWINDOW (Vmouse_window)->buffer);
2929 c = *(BUF_CHAR_ADDRESS (buf, mouse_buffer_offset));
2931 else if (EQ (Vmouse_frame_part, Qmodeline_part)
2932 && (current_pointer_shape != f->display.x->modeline_cursor))
2934 current_pointer_shape = f->display.x->modeline_cursor;
2935 XDefineCursor (x_current_display,
2936 FRAME_X_WINDOW (f),
2937 current_pointer_shape);
2940 XFlushQueue ();
2941 UNBLOCK_INPUT;
2943 #endif
2945 #if 0
2946 DEFUN ("x-track-pointer", Fx_track_pointer, Sx_track_pointer, 1, 1, "e",
2947 "Draw rectangle around character under mouse pointer, if there is one.")
2948 (event)
2949 Lisp_Object event;
2951 struct window *w = XWINDOW (Vmouse_window);
2952 struct frame *f = XFRAME (WINDOW_FRAME (w));
2953 struct buffer *b = XBUFFER (w->buffer);
2954 Lisp_Object obj;
2956 if (! EQ (Vmouse_window, selected_window))
2957 return Qnil;
2959 if (EQ (event, Qnil))
2961 int x, y;
2963 x_read_mouse_position (selected_frame, &x, &y);
2966 BLOCK_INPUT;
2967 mouse_track_width = 0;
2968 mouse_track_left = mouse_track_top = -1;
2972 if ((x_mouse_x != mouse_track_left
2973 && (x_mouse_x < mouse_track_left
2974 || x_mouse_x > (mouse_track_left + mouse_track_width)))
2975 || x_mouse_y != mouse_track_top)
2977 int hp = 0; /* Horizontal position */
2978 int len = FRAME_CURRENT_GLYPHS (f)->used[x_mouse_y];
2979 int p = FRAME_CURRENT_GLYPHS (f)->bufp[x_mouse_y];
2980 int tab_width = XINT (b->tab_width);
2981 int ctl_arrow_p = !NILP (b->ctl_arrow);
2982 unsigned char c;
2983 int mode_line_vpos = XFASTINT (w->height) + XFASTINT (w->top) - 1;
2984 int in_mode_line = 0;
2986 if (! FRAME_CURRENT_GLYPHS (f)->enable[x_mouse_y])
2987 break;
2989 /* Erase previous rectangle. */
2990 if (mouse_track_width)
2992 x_rectangle (f, f->display.x->reverse_gc,
2993 mouse_track_left, mouse_track_top,
2994 mouse_track_width, 1);
2996 if ((mouse_track_left == f->phys_cursor_x
2997 || mouse_track_left == f->phys_cursor_x - 1)
2998 && mouse_track_top == f->phys_cursor_y)
3000 x_display_cursor (f, 1);
3004 mouse_track_left = x_mouse_x;
3005 mouse_track_top = x_mouse_y;
3006 mouse_track_width = 0;
3008 if (mouse_track_left > len) /* Past the end of line. */
3009 goto draw_or_not;
3011 if (mouse_track_top == mode_line_vpos)
3013 in_mode_line = 1;
3014 goto draw_or_not;
3017 if (tab_width <= 0 || tab_width > 20) tab_width = 8;
3020 c = FETCH_CHAR (p);
3021 if (len == f->width && hp == len - 1 && c != '\n')
3022 goto draw_or_not;
3024 switch (c)
3026 case '\t':
3027 mouse_track_width = tab_width - (hp % tab_width);
3028 p++;
3029 hp += mouse_track_width;
3030 if (hp > x_mouse_x)
3032 mouse_track_left = hp - mouse_track_width;
3033 goto draw_or_not;
3035 continue;
3037 case '\n':
3038 mouse_track_width = -1;
3039 goto draw_or_not;
3041 default:
3042 if (ctl_arrow_p && (c < 040 || c == 0177))
3044 if (p > ZV)
3045 goto draw_or_not;
3047 mouse_track_width = 2;
3048 p++;
3049 hp +=2;
3050 if (hp > x_mouse_x)
3052 mouse_track_left = hp - mouse_track_width;
3053 goto draw_or_not;
3056 else
3058 mouse_track_width = 1;
3059 p++;
3060 hp++;
3062 continue;
3065 while (hp <= x_mouse_x);
3067 draw_or_not:
3068 if (mouse_track_width) /* Over text; use text pointer shape. */
3070 XDefineCursor (x_current_display,
3071 FRAME_X_WINDOW (f),
3072 f->display.x->text_cursor);
3073 x_rectangle (f, f->display.x->cursor_gc,
3074 mouse_track_left, mouse_track_top,
3075 mouse_track_width, 1);
3077 else if (in_mode_line)
3078 XDefineCursor (x_current_display,
3079 FRAME_X_WINDOW (f),
3080 f->display.x->modeline_cursor);
3081 else
3082 XDefineCursor (x_current_display,
3083 FRAME_X_WINDOW (f),
3084 f->display.x->nontext_cursor);
3087 XFlush (x_current_display);
3088 UNBLOCK_INPUT;
3090 obj = read_char (-1, 0, 0, Qnil, 0);
3091 BLOCK_INPUT;
3093 while (XTYPE (obj) == Lisp_Cons /* Mouse event */
3094 && EQ (Fcar (Fcdr (Fcdr (obj))), Qnil) /* Not scroll bar */
3095 && EQ (Vmouse_depressed, Qnil) /* Only motion events */
3096 && EQ (Vmouse_window, selected_window) /* In this window */
3097 && x_mouse_frame);
3099 unread_command_event = obj;
3101 if (mouse_track_width)
3103 x_rectangle (f, f->display.x->reverse_gc,
3104 mouse_track_left, mouse_track_top,
3105 mouse_track_width, 1);
3106 mouse_track_width = 0;
3107 if ((mouse_track_left == f->phys_cursor_x
3108 || mouse_track_left - 1 == f->phys_cursor_x)
3109 && mouse_track_top == f->phys_cursor_y)
3111 x_display_cursor (f, 1);
3114 XDefineCursor (x_current_display,
3115 FRAME_X_WINDOW (f),
3116 f->display.x->nontext_cursor);
3117 XFlush (x_current_display);
3118 UNBLOCK_INPUT;
3120 return Qnil;
3122 #endif
3124 #if 0
3125 #include "glyphs.h"
3127 /* Draw a pixmap specified by IMAGE_DATA of dimensions WIDTH and HEIGHT
3128 on the frame F at position X, Y. */
3130 x_draw_pixmap (f, x, y, image_data, width, height)
3131 struct frame *f;
3132 int x, y, width, height;
3133 char *image_data;
3135 Pixmap image;
3137 image = XCreateBitmapFromData (x_current_display,
3138 FRAME_X_WINDOW (f), image_data,
3139 width, height);
3140 XCopyPlane (x_current_display, image, FRAME_X_WINDOW (f),
3141 f->display.x->normal_gc, 0, 0, width, height, x, y);
3143 #endif
3145 #if 0
3147 #ifdef HAVE_X11
3148 #define XMouseEvent XEvent
3149 #define WhichMouseButton xbutton.button
3150 #define MouseWindow xbutton.window
3151 #define MouseX xbutton.x
3152 #define MouseY xbutton.y
3153 #define MouseTime xbutton.time
3154 #define ButtonReleased ButtonRelease
3155 #define ButtonPressed ButtonPress
3156 #else
3157 #define XMouseEvent XButtonEvent
3158 #define WhichMouseButton detail
3159 #define MouseWindow window
3160 #define MouseX x
3161 #define MouseY y
3162 #define MouseTime time
3163 #endif /* X11 */
3165 DEFUN ("x-mouse-events", Fx_mouse_events, Sx_mouse_events, 0, 0, 0,
3166 "Return number of pending mouse events from X window system.")
3169 return make_number (queue_event_count (&x_mouse_queue));
3172 /* Encode the mouse button events in the form expected by the
3173 mouse code in Lisp. For X11, this means moving the masks around. */
3175 static int
3176 encode_mouse_button (mouse_event)
3177 XMouseEvent mouse_event;
3179 register int event_code;
3180 register char key_mask;
3182 event_code = mouse_event.detail & 3;
3183 key_mask = (mouse_event.detail >> 8) & 0xf0;
3184 event_code |= key_mask >> 1;
3185 if (mouse_event.type == ButtonReleased) event_code |= 0x04;
3186 return event_code;
3189 DEFUN ("x-get-mouse-event", Fx_get_mouse_event, Sx_get_mouse_event,
3190 0, 1, 0,
3191 "Get next mouse event out of mouse event buffer.\n\
3192 Optional ARG non-nil means return nil immediately if no pending event;\n\
3193 otherwise, wait for an event. Returns a four-part list:\n\
3194 ((X-POS Y-POS) WINDOW FRAME-PART KEYSEQ TIMESTAMP).\n\
3195 Normally X-POS and Y-POS are the position of the click on the frame\n\
3196 (measured in characters and lines), and WINDOW is the window clicked in.\n\
3197 KEYSEQ is a string, the key sequence to be looked up in the mouse maps.\n\
3198 If FRAME-PART is non-nil, the event was on a scroll bar;\n\
3199 then Y-POS is really the total length of the scroll bar, while X-POS is\n\
3200 the relative position of the scroll bar's value within that total length,\n\
3201 and a third element OFFSET appears in that list: the height of the thumb-up\n\
3202 area at the top of the scroll bar.\n\
3203 FRAME-PART is one of the following symbols:\n\
3204 `vertical-scroll-bar', `vertical-thumbup', `vertical-thumbdown',\n\
3205 `horizontal-scroll-bar', `horizontal-thumbleft', `horizontal-thumbright'.\n\
3206 TIMESTAMP is the lower 23 bits of the X-server's timestamp for\n\
3207 the mouse event.")
3208 (arg)
3209 Lisp_Object arg;
3211 XMouseEvent xrep;
3212 register int com_letter;
3213 register Lisp_Object tempx;
3214 register Lisp_Object tempy;
3215 Lisp_Object part, pos, timestamp;
3216 int prefix;
3217 struct frame *f;
3219 int tem;
3221 while (1)
3223 BLOCK_INPUT;
3224 tem = dequeue_event (&xrep, &x_mouse_queue);
3225 UNBLOCK_INPUT;
3227 if (tem)
3229 switch (xrep.type)
3231 case ButtonPressed:
3232 case ButtonReleased:
3234 com_letter = encode_mouse_button (xrep);
3235 mouse_timestamp = xrep.MouseTime;
3237 if ((f = x_window_to_frame (xrep.MouseWindow)) != 0)
3239 Lisp_Object frame;
3241 if (f->display.x->icon_desc == xrep.MouseWindow)
3243 x_make_frame_visible (f);
3244 continue;
3247 XSET (tempx, Lisp_Int,
3248 min (f->width-1, max (0, (xrep.MouseX - f->display.x->internal_border_width)/FONT_WIDTH (f->display.x->font))));
3249 XSET (tempy, Lisp_Int,
3250 min (f->height-1, max (0, (xrep.MouseY - f->display.x->internal_border_width)/FONT_HEIGHT (f->display.x->font))));
3251 XSET (timestamp, Lisp_Int, (xrep.MouseTime & 0x7fffff));
3252 XSET (frame, Lisp_Frame, f);
3254 pos = Fcons (tempx, Fcons (tempy, Qnil));
3255 Vmouse_window
3256 = Flocate_window_from_coordinates (frame, pos);
3258 Vmouse_event
3259 = Fcons (pos,
3260 Fcons (Vmouse_window,
3261 Fcons (Qnil,
3262 Fcons (Fchar_to_string (make_number (com_letter)),
3263 Fcons (timestamp, Qnil)))));
3264 return Vmouse_event;
3266 else if ((f = x_window_to_scroll_bar (xrep.MouseWindow, &part, &prefix)) != 0)
3268 int pos, len;
3269 Lisp_Object keyseq;
3270 char *partname;
3272 keyseq = concat2 (Fchar_to_string (make_number (prefix)),
3273 Fchar_to_string (make_number (com_letter)));
3275 pos = xrep.MouseY - (f->display.x->v_scroll_bar_width - 2);
3276 XSET (tempx, Lisp_Int, pos);
3277 len = ((FONT_HEIGHT (f->display.x->font) * f->height)
3278 + f->display.x->internal_border_width
3279 - (2 * (f->display.x->v_scroll_bar_width - 2)));
3280 XSET (tempy, Lisp_Int, len);
3281 XSET (timestamp, Lisp_Int, (xrep.MouseTime & 0x7fffff));
3282 Vmouse_window = f->selected_window;
3283 Vmouse_event
3284 = Fcons (Fcons (tempx, Fcons (tempy,
3285 Fcons (make_number (f->display.x->v_scroll_bar_width - 2),
3286 Qnil))),
3287 Fcons (Vmouse_window,
3288 Fcons (intern (part),
3289 Fcons (keyseq, Fcons (timestamp,
3290 Qnil)))));
3291 return Vmouse_event;
3293 else
3294 continue;
3296 #ifdef HAVE_X11
3297 case MotionNotify:
3299 com_letter = x11_encode_mouse_button (xrep);
3300 if ((f = x_window_to_frame (xrep.MouseWindow)) != 0)
3302 Lisp_Object frame;
3304 XSET (tempx, Lisp_Int,
3305 min (f->width-1,
3306 max (0, (xrep.MouseX - f->display.x->internal_border_width)
3307 / FONT_WIDTH (f->display.x->font))));
3308 XSET (tempy, Lisp_Int,
3309 min (f->height-1,
3310 max (0, (xrep.MouseY - f->display.x->internal_border_width)
3311 / FONT_HEIGHT (f->display.x->font))));
3313 XSET (frame, Lisp_Frame, f);
3314 XSET (timestamp, Lisp_Int, (xrep.MouseTime & 0x7fffff));
3316 pos = Fcons (tempx, Fcons (tempy, Qnil));
3317 Vmouse_window
3318 = Flocate_window_from_coordinates (frame, pos);
3320 Vmouse_event
3321 = Fcons (pos,
3322 Fcons (Vmouse_window,
3323 Fcons (Qnil,
3324 Fcons (Fchar_to_string (make_number (com_letter)),
3325 Fcons (timestamp, Qnil)))));
3326 return Vmouse_event;
3329 break;
3330 #endif /* HAVE_X11 */
3332 default:
3333 if (f = x_window_to_frame (xrep.MouseWindow))
3334 Vmouse_window = f->selected_window;
3335 else if (f = x_window_to_scroll_bar (xrep.MouseWindow, &part, &prefix))
3336 Vmouse_window = f->selected_window;
3337 return Vmouse_event = Qnil;
3341 if (!NILP (arg))
3342 return Qnil;
3344 /* Wait till we get another mouse event. */
3345 wait_reading_process_input (0, 0, 2, 0);
3348 #endif
3351 #ifndef HAVE_X11
3352 DEFUN ("x-store-cut-buffer", Fx_store_cut_buffer, Sx_store_cut_buffer,
3353 1, 1, "sStore text in cut buffer: ",
3354 "Store contents of STRING into the cut buffer of the X window system.")
3355 (string)
3356 register Lisp_Object string;
3358 int mask;
3360 CHECK_STRING (string, 1);
3361 if (! FRAME_X_P (selected_frame))
3362 error ("Selected frame does not understand X protocol.");
3364 BLOCK_INPUT;
3365 XStoreBytes ((char *) XSTRING (string)->data, XSTRING (string)->size);
3366 UNBLOCK_INPUT;
3368 return Qnil;
3371 DEFUN ("x-get-cut-buffer", Fx_get_cut_buffer, Sx_get_cut_buffer, 0, 0, 0,
3372 "Return contents of cut buffer of the X window system, as a string.")
3375 int len;
3376 register Lisp_Object string;
3377 int mask;
3378 register char *d;
3380 BLOCK_INPUT;
3381 d = XFetchBytes (&len);
3382 string = make_string (d, len);
3383 XFree (d);
3384 UNBLOCK_INPUT;
3385 return string;
3387 #endif /* X10 */
3389 #ifdef HAVE_X11
3390 DEFUN ("x-rebind-key", Fx_rebind_key, Sx_rebind_key, 3, 3, 0,
3391 "Rebind X keysym KEYSYM, with MODIFIERS, to generate NEWSTRING.\n\
3392 KEYSYM is a string which conforms to the X keysym definitions found\n\
3393 in X11/keysymdef.h, sans the initial XK_. MODIFIERS is nil or a\n\
3394 list of strings specifying modifier keys such as Control_L, which must\n\
3395 also be depressed for NEWSTRING to appear.")
3396 (x_keysym, modifiers, newstring)
3397 register Lisp_Object x_keysym;
3398 register Lisp_Object modifiers;
3399 register Lisp_Object newstring;
3401 char *rawstring;
3402 register KeySym keysym;
3403 KeySym modifier_list[16];
3405 CHECK_STRING (x_keysym, 1);
3406 CHECK_STRING (newstring, 3);
3408 keysym = XStringToKeysym ((char *) XSTRING (x_keysym)->data);
3409 if (keysym == NoSymbol)
3410 error ("Keysym does not exist");
3412 if (NILP (modifiers))
3413 XRebindKeysym (x_current_display, keysym, modifier_list, 0,
3414 XSTRING (newstring)->data, XSTRING (newstring)->size);
3415 else
3417 register Lisp_Object rest, mod;
3418 register int i = 0;
3420 for (rest = modifiers; !NILP (rest); rest = Fcdr (rest))
3422 if (i == 16)
3423 error ("Can't have more than 16 modifiers");
3425 mod = Fcar (rest);
3426 CHECK_STRING (mod, 3);
3427 modifier_list[i] = XStringToKeysym ((char *) XSTRING (mod)->data);
3428 if (modifier_list[i] == NoSymbol
3429 || !IsModifierKey (modifier_list[i]))
3430 error ("Element is not a modifier keysym");
3431 i++;
3434 XRebindKeysym (x_current_display, keysym, modifier_list, i,
3435 XSTRING (newstring)->data, XSTRING (newstring)->size);
3438 return Qnil;
3441 DEFUN ("x-rebind-keys", Fx_rebind_keys, Sx_rebind_keys, 2, 2, 0,
3442 "Rebind KEYCODE to list of strings STRINGS.\n\
3443 STRINGS should be a list of 16 elements, one for each shift combination.\n\
3444 nil as element means don't change.\n\
3445 See the documentation of `x-rebind-key' for more information.")
3446 (keycode, strings)
3447 register Lisp_Object keycode;
3448 register Lisp_Object strings;
3450 register Lisp_Object item;
3451 register unsigned char *rawstring;
3452 KeySym rawkey, modifier[1];
3453 int strsize;
3454 register unsigned i;
3456 CHECK_NUMBER (keycode, 1);
3457 CHECK_CONS (strings, 2);
3458 rawkey = (KeySym) ((unsigned) (XINT (keycode))) & 255;
3459 for (i = 0; i <= 15; strings = Fcdr (strings), i++)
3461 item = Fcar (strings);
3462 if (!NILP (item))
3464 CHECK_STRING (item, 2);
3465 strsize = XSTRING (item)->size;
3466 rawstring = (unsigned char *) xmalloc (strsize);
3467 bcopy (XSTRING (item)->data, rawstring, strsize);
3468 modifier[1] = 1 << i;
3469 XRebindKeysym (x_current_display, rawkey, modifier, 1,
3470 rawstring, strsize);
3473 return Qnil;
3475 #else
3476 DEFUN ("x-rebind-key", Fx_rebind_key, Sx_rebind_key, 3, 3, 0,
3477 "Rebind KEYCODE, with shift bits SHIFT-MASK, to new string NEWSTRING.\n\
3478 KEYCODE and SHIFT-MASK should be numbers representing the X keyboard code\n\
3479 and shift mask respectively. NEWSTRING is an arbitrary string of keystrokes.\n\
3480 If SHIFT-MASK is nil, then KEYCODE's key will be bound to NEWSTRING for\n\
3481 all shift combinations.\n\
3482 Shift Lock 1 Shift 2\n\
3483 Meta 4 Control 8\n\
3485 For values of KEYCODE, see /usr/lib/Xkeymap.txt (remember that the codes\n\
3486 in that file are in octal!)\n\
3488 NOTE: due to an X bug, this function will not take effect unless one has\n\
3489 a `~/.Xkeymap' file. (See the documentation for the `keycomp' program.)\n\
3490 This problem will be fixed in X version 11.")
3492 (keycode, shift_mask, newstring)
3493 register Lisp_Object keycode;
3494 register Lisp_Object shift_mask;
3495 register Lisp_Object newstring;
3497 char *rawstring;
3498 int keysym, rawshift;
3499 int i, strsize;
3501 CHECK_NUMBER (keycode, 1);
3502 if (!NILP (shift_mask))
3503 CHECK_NUMBER (shift_mask, 2);
3504 CHECK_STRING (newstring, 3);
3505 strsize = XSTRING (newstring)->size;
3506 rawstring = (char *) xmalloc (strsize);
3507 bcopy (XSTRING (newstring)->data, rawstring, strsize);
3509 keysym = ((unsigned) (XINT (keycode))) & 255;
3511 if (NILP (shift_mask))
3513 for (i = 0; i <= 15; i++)
3514 XRebindCode (keysym, i<<11, rawstring, strsize);
3516 else
3518 rawshift = (((unsigned) (XINT (shift_mask))) & 15) << 11;
3519 XRebindCode (keysym, rawshift, rawstring, strsize);
3521 return Qnil;
3524 DEFUN ("x-rebind-keys", Fx_rebind_keys, Sx_rebind_keys, 2, 2, 0,
3525 "Rebind KEYCODE to list of strings STRINGS.\n\
3526 STRINGS should be a list of 16 elements, one for each shift combination.\n\
3527 nil as element means don't change.\n\
3528 See the documentation of `x-rebind-key' for more information.")
3529 (keycode, strings)
3530 register Lisp_Object keycode;
3531 register Lisp_Object strings;
3533 register Lisp_Object item;
3534 register char *rawstring;
3535 KeySym rawkey, modifier[1];
3536 int strsize;
3537 register unsigned i;
3539 CHECK_NUMBER (keycode, 1);
3540 CHECK_CONS (strings, 2);
3541 rawkey = (KeySym) ((unsigned) (XINT (keycode))) & 255;
3542 for (i = 0; i <= 15; strings = Fcdr (strings), i++)
3544 item = Fcar (strings);
3545 if (!NILP (item))
3547 CHECK_STRING (item, 2);
3548 strsize = XSTRING (item)->size;
3549 rawstring = (char *) xmalloc (strsize);
3550 bcopy (XSTRING (item)->data, rawstring, strsize);
3551 XRebindCode (rawkey, i << 11, rawstring, strsize);
3554 return Qnil;
3556 #endif /* not HAVE_X11 */
3558 #ifdef HAVE_X11
3559 Visual *
3560 select_visual (screen, depth)
3561 Screen *screen;
3562 unsigned int *depth;
3564 Visual *v;
3565 XVisualInfo *vinfo, vinfo_template;
3566 int n_visuals;
3568 v = DefaultVisualOfScreen (screen);
3570 #ifdef HAVE_X11R4
3571 vinfo_template.visualid = XVisualIDFromVisual (v);
3572 #else
3573 vinfo_template.visualid = x->visualid;
3574 #endif
3576 vinfo = XGetVisualInfo (x_current_display, VisualIDMask, &vinfo_template,
3577 &n_visuals);
3578 if (n_visuals != 1)
3579 fatal ("Can't get proper X visual info");
3581 if ((1 << vinfo->depth) == vinfo->colormap_size)
3582 *depth = vinfo->depth;
3583 else
3585 int i = 0;
3586 int n = vinfo->colormap_size - 1;
3587 while (n)
3589 n = n >> 1;
3590 i++;
3592 *depth = i;
3595 XFree ((char *) vinfo);
3596 return v;
3598 #endif /* HAVE_X11 */
3600 DEFUN ("x-open-connection", Fx_open_connection, Sx_open_connection,
3601 1, 2, 0, "Open a connection to an X server.\n\
3602 DISPLAY is the name of the display to connect to. Optional second\n\
3603 arg XRM_STRING is a string of resources in xrdb format.")
3604 (display, xrm_string)
3605 Lisp_Object display, xrm_string;
3607 unsigned int n_planes;
3608 register Screen *x_screen;
3609 unsigned char *xrm_option;
3611 CHECK_STRING (display, 0);
3612 if (x_current_display != 0)
3613 error ("X server connection is already initialized");
3615 /* This is what opens the connection and sets x_current_display.
3616 This also initializes many symbols, such as those used for input. */
3617 x_term_init (XSTRING (display)->data);
3619 #ifdef HAVE_X11
3620 XFASTINT (Vwindow_system_version) = 11;
3622 if (!EQ (xrm_string, Qnil))
3624 CHECK_STRING (xrm_string, 1);
3625 xrm_option = (unsigned char *) XSTRING (xrm_string);
3627 else
3628 xrm_option = (unsigned char *) 0;
3629 xrdb = x_load_resources (x_current_display, xrm_option, EMACS_CLASS);
3630 x_current_display->db = xrdb;
3632 x_screen = DefaultScreenOfDisplay (x_current_display);
3634 x_screen_count = ScreenCount (x_current_display);
3635 Vx_vendor = build_string (ServerVendor (x_current_display));
3636 x_release = VendorRelease (x_current_display);
3638 x_screen_height = HeightOfScreen (x_screen);
3639 x_screen_height_mm = HeightMMOfScreen (x_screen);
3640 x_screen_width = WidthOfScreen (x_screen);
3641 x_screen_width_mm = WidthMMOfScreen (x_screen);
3643 switch (DoesBackingStore (x_screen))
3645 case Always:
3646 Vx_backing_store = intern ("Always");
3647 break;
3649 case WhenMapped:
3650 Vx_backing_store = intern ("WhenMapped");
3651 break;
3653 case NotUseful:
3654 Vx_backing_store = intern ("NotUseful");
3655 break;
3657 default:
3658 error ("Strange value for BackingStore.");
3659 break;
3662 if (DoesSaveUnders (x_screen) == True)
3663 x_save_under = 1;
3664 else
3665 x_save_under = 0;
3667 screen_visual = select_visual (x_screen, &n_planes);
3668 x_screen_planes = n_planes;
3669 Vx_screen_visual = intern (x_visual_strings [screen_visual->class]);
3671 /* X Atoms used by emacs. */
3672 BLOCK_INPUT;
3673 Xatom_emacs_selection = XInternAtom (x_current_display, "_EMACS_SELECTION_",
3674 False);
3675 Xatom_clipboard = XInternAtom (x_current_display, "CLIPBOARD",
3676 False);
3677 Xatom_clipboard_selection = XInternAtom (x_current_display, "_EMACS_CLIPBOARD_",
3678 False);
3679 Xatom_wm_change_state = XInternAtom (x_current_display, "WM_CHANGE_STATE",
3680 False);
3681 Xatom_incremental = XInternAtom (x_current_display, "INCR",
3682 False);
3683 Xatom_multiple = XInternAtom (x_current_display, "MULTIPLE",
3684 False);
3685 Xatom_targets = XInternAtom (x_current_display, "TARGETS",
3686 False);
3687 Xatom_timestamp = XInternAtom (x_current_display, "TIMESTAMP",
3688 False);
3689 Xatom_delete = XInternAtom (x_current_display, "DELETE",
3690 False);
3691 Xatom_insert_selection = XInternAtom (x_current_display, "INSERT_SELECTION",
3692 False);
3693 Xatom_pair = XInternAtom (x_current_display, "XA_ATOM_PAIR",
3694 False);
3695 Xatom_insert_property = XInternAtom (x_current_display, "INSERT_PROPERTY",
3696 False);
3697 Xatom_text = XInternAtom (x_current_display, "TEXT",
3698 False);
3699 Xatom_wm_protocols = XInternAtom (x_current_display, "WM_PROTOCOLS",
3700 False);
3701 Xatom_wm_take_focus = XInternAtom (x_current_display, "WM_TAKE_FOCUS",
3702 False);
3703 Xatom_wm_save_yourself = XInternAtom (x_current_display, "WM_SAVE_YOURSELF",
3704 False);
3705 Xatom_wm_delete_window = XInternAtom (x_current_display, "WM_DELETE_WINDOW",
3706 False);
3707 Xatom_wm_change_state = XInternAtom (x_current_display, "WM_CHANGE_STATE",
3708 False);
3709 Xatom_wm_configure_denied = XInternAtom (x_current_display,
3710 "WM_CONFIGURE_DENIED", False);
3711 Xatom_wm_window_moved = XInternAtom (x_current_display, "WM_MOVED",
3712 False);
3713 UNBLOCK_INPUT;
3714 #else /* not HAVE_X11 */
3715 XFASTINT (Vwindow_system_version) = 10;
3716 #endif /* not HAVE_X11 */
3717 return Qnil;
3720 DEFUN ("x-close-current-connection", Fx_close_current_connection,
3721 Sx_close_current_connection,
3722 0, 0, 0, "Close the connection to the current X server.")
3725 #ifdef HAVE_X11
3726 /* This is ONLY used when killing emacs; For switching displays
3727 we'll have to take care of setting CloseDownMode elsewhere. */
3729 if (x_current_display)
3731 BLOCK_INPUT;
3732 XSetCloseDownMode (x_current_display, DestroyAll);
3733 XCloseDisplay (x_current_display);
3735 else
3736 fatal ("No current X display connection to close\n");
3737 #endif
3738 return Qnil;
3741 DEFUN ("x-synchronize", Fx_synchronize, Sx_synchronize,
3742 1, 1, 0, "If ON is non-nil, report X errors as soon as the erring request is made.\n\
3743 If ON is nil, allow buffering of requests.\n\
3744 Turning on synchronization prohibits the Xlib routines from buffering\n\
3745 requests and seriously degrades performance, but makes debugging much\n\
3746 easier.")
3747 (on)
3748 Lisp_Object on;
3750 XSynchronize (x_current_display, !EQ (on, Qnil));
3752 return Qnil;
3756 syms_of_xfns ()
3758 /* This is zero if not using X windows. */
3759 x_current_display = 0;
3761 /* The section below is built by the lisp expression at the top of the file,
3762 just above where these variables are declared. */
3763 /*&&& init symbols here &&&*/
3764 Qauto_raise = intern ("auto-raise");
3765 staticpro (&Qauto_raise);
3766 Qauto_lower = intern ("auto-lower");
3767 staticpro (&Qauto_lower);
3768 Qbackground_color = intern ("background-color");
3769 staticpro (&Qbackground_color);
3770 Qbar = intern ("bar");
3771 staticpro (&Qbar);
3772 Qborder_color = intern ("border-color");
3773 staticpro (&Qborder_color);
3774 Qborder_width = intern ("border-width");
3775 staticpro (&Qborder_width);
3776 Qbox = intern ("box");
3777 staticpro (&Qbox);
3778 Qcursor_color = intern ("cursor-color");
3779 staticpro (&Qcursor_color);
3780 Qcursor_type = intern ("cursor-type");
3781 staticpro (&Qcursor_type);
3782 Qfont = intern ("font");
3783 staticpro (&Qfont);
3784 Qforeground_color = intern ("foreground-color");
3785 staticpro (&Qforeground_color);
3786 Qgeometry = intern ("geometry");
3787 staticpro (&Qgeometry);
3788 Qicon_left = intern ("icon-left");
3789 staticpro (&Qicon_left);
3790 Qicon_top = intern ("icon-top");
3791 staticpro (&Qicon_top);
3792 Qicon_type = intern ("icon-type");
3793 staticpro (&Qicon_type);
3794 Qiconic_startup = intern ("iconic-startup");
3795 staticpro (&Qiconic_startup);
3796 Qinternal_border_width = intern ("internal-border-width");
3797 staticpro (&Qinternal_border_width);
3798 Qleft = intern ("left");
3799 staticpro (&Qleft);
3800 Qmouse_color = intern ("mouse-color");
3801 staticpro (&Qmouse_color);
3802 Qnone = intern ("none");
3803 staticpro (&Qnone);
3804 Qparent_id = intern ("parent-id");
3805 staticpro (&Qparent_id);
3806 Qsuppress_icon = intern ("suppress-icon");
3807 staticpro (&Qsuppress_icon);
3808 Qsuppress_initial_map = intern ("suppress-initial-map");
3809 staticpro (&Qsuppress_initial_map);
3810 Qtop = intern ("top");
3811 staticpro (&Qtop);
3812 Qundefined_color = intern ("undefined-color");
3813 staticpro (&Qundefined_color);
3814 Qvertical_scroll_bars = intern ("vertical-scroll-bars");
3815 staticpro (&Qvertical_scroll_bars);
3816 Qwindow_id = intern ("window-id");
3817 staticpro (&Qwindow_id);
3818 Qx_frame_parameter = intern ("x-frame-parameter");
3819 staticpro (&Qx_frame_parameter);
3820 /* This is the end of symbol initialization. */
3822 Fput (Qundefined_color, Qerror_conditions,
3823 Fcons (Qundefined_color, Fcons (Qerror, Qnil)));
3824 Fput (Qundefined_color, Qerror_message,
3825 build_string ("Undefined color"));
3827 init_x_parm_symbols ();
3829 DEFVAR_INT ("mouse-buffer-offset", &mouse_buffer_offset,
3830 "The buffer offset of the character under the pointer.");
3831 mouse_buffer_offset = 0;
3833 DEFVAR_INT ("x-pointer-shape", &Vx_pointer_shape,
3834 "The shape of the pointer when over text.");
3835 Vx_pointer_shape = Qnil;
3837 DEFVAR_INT ("x-nontext-pointer-shape", &Vx_nontext_pointer_shape,
3838 "The shape of the pointer when not over text.");
3839 Vx_nontext_pointer_shape = Qnil;
3841 DEFVAR_INT ("x-mode-pointer-shape", &Vx_mode_pointer_shape,
3842 "The shape of the pointer when over the mode line.");
3843 Vx_mode_pointer_shape = Qnil;
3845 DEFVAR_LISP ("x-cursor-fore-pixel", &Vx_cursor_fore_pixel,
3846 "A string indicating the foreground color of the cursor box.");
3847 Vx_cursor_fore_pixel = Qnil;
3849 DEFVAR_LISP ("mouse-grabbed", &Vmouse_depressed,
3850 "Non-nil if a mouse button is currently depressed.");
3851 Vmouse_depressed = Qnil;
3853 DEFVAR_INT ("x-screen-count", &x_screen_count,
3854 "The number of screens associated with the current display.");
3855 DEFVAR_INT ("x-release", &x_release,
3856 "The release number of the X server in use.");
3857 DEFVAR_LISP ("x-vendor", &Vx_vendor,
3858 "The vendor supporting the X server in use.");
3859 DEFVAR_INT ("x-screen-height", &x_screen_height,
3860 "The height of this X screen in pixels.");
3861 DEFVAR_INT ("x-screen-height-mm", &x_screen_height_mm,
3862 "The height of this X screen in millimeters.");
3863 DEFVAR_INT ("x-screen-width", &x_screen_width,
3864 "The width of this X screen in pixels.");
3865 DEFVAR_INT ("x-screen-width-mm", &x_screen_width_mm,
3866 "The width of this X screen in millimeters.");
3867 DEFVAR_LISP ("x-backing-store", &Vx_backing_store,
3868 "The backing store capability of this screen.\n\
3869 Values can be the symbols Always, WhenMapped, or NotUseful.");
3870 DEFVAR_BOOL ("x-save-under", &x_save_under,
3871 "*Non-nil means this X screen supports the SaveUnder feature.");
3872 DEFVAR_INT ("x-screen-planes", &x_screen_planes,
3873 "The number of planes this monitor supports.");
3874 DEFVAR_LISP ("x-screen-visual", &Vx_screen_visual,
3875 "The default X visual for this X screen.");
3876 DEFVAR_LISP ("x-no-window-manager", &Vx_no_window_manager,
3877 "t if no X window manager is in use.");
3879 #ifdef HAVE_X11
3880 defsubr (&Sx_get_resource);
3881 #if 0
3882 defsubr (&Sx_draw_rectangle);
3883 defsubr (&Sx_erase_rectangle);
3884 defsubr (&Sx_contour_region);
3885 defsubr (&Sx_uncontour_region);
3886 #endif
3887 defsubr (&Sx_color_display_p);
3888 defsubr (&Sx_defined_color);
3889 #if 0
3890 defsubr (&Sx_track_pointer);
3891 defsubr (&Sx_grab_pointer);
3892 defsubr (&Sx_ungrab_pointer);
3893 #endif
3894 #else
3895 defsubr (&Sx_get_default);
3896 defsubr (&Sx_store_cut_buffer);
3897 defsubr (&Sx_get_cut_buffer);
3898 defsubr (&Sx_set_face);
3899 #endif
3900 defsubr (&Sx_geometry);
3901 defsubr (&Sx_create_frame);
3902 defsubr (&Sfocus_frame);
3903 defsubr (&Sunfocus_frame);
3904 #if 0
3905 defsubr (&Sx_horizontal_line);
3906 #endif
3907 defsubr (&Sx_rebind_key);
3908 defsubr (&Sx_rebind_keys);
3909 defsubr (&Sx_open_connection);
3910 defsubr (&Sx_close_current_connection);
3911 defsubr (&Sx_synchronize);
3913 /* This was used in the old event interface which used a separate
3914 event queue.*/
3915 #if 0
3916 defsubr (&Sx_mouse_events);
3917 defsubr (&Sx_get_mouse_event);
3918 #endif
3921 #endif /* HAVE_X_WINDOWS */