Initial revision
[emacs.git] / src / xfns.c
blobd9dacbccb8d397c2761092191d896d09b0c60936
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"
36 #include "blockinput.h"
38 #ifdef HAVE_X_WINDOWS
39 extern void abort ();
41 #ifndef VMS
42 #if 1 /* Used to be #ifdef EMACS_BITMAP_FILES, but this should always work. */
43 #include "bitmaps/gray.xbm"
44 #else
45 #include <X11/bitmaps/gray>
46 #endif
47 #else
48 #include "[.bitmaps]gray.xbm"
49 #endif
51 #define min(a,b) ((a) < (b) ? (a) : (b))
52 #define max(a,b) ((a) > (b) ? (a) : (b))
54 #ifdef HAVE_X11
55 /* X Resource data base */
56 static XrmDatabase xrdb;
58 /* The class of this X application. */
59 #define EMACS_CLASS "Emacs"
61 /* The name we're using for this X application. */
62 Lisp_Object Vxrdb_name;
64 /* Title name and application name for X stuff. */
65 extern char *x_id_name;
67 /* The background and shape of the mouse pointer, and shape when not
68 over text or in the modeline. */
69 Lisp_Object Vx_pointer_shape, Vx_nontext_pointer_shape, Vx_mode_pointer_shape;
71 /* Color of chars displayed in cursor box. */
72 Lisp_Object Vx_cursor_fore_pixel;
74 /* The screen being used. */
75 static Screen *x_screen;
77 /* The X Visual we are using for X windows (the default) */
78 Visual *screen_visual;
80 /* Height of this X screen in pixels. */
81 int x_screen_height;
83 /* Width of this X screen in pixels. */
84 int x_screen_width;
86 /* Number of planes for this screen. */
87 int x_screen_planes;
89 /* Non nil if no window manager is in use. */
90 Lisp_Object Vx_no_window_manager;
92 /* `t' if a mouse button is depressed. */
94 Lisp_Object Vmouse_depressed;
96 extern unsigned int x_mouse_x, x_mouse_y, x_mouse_grabbed;
98 /* Atom for indicating window state to the window manager. */
99 extern Atom Xatom_wm_change_state;
101 /* Communication with window managers. */
102 extern Atom Xatom_wm_protocols;
104 /* Kinds of protocol things we may receive. */
105 extern Atom Xatom_wm_take_focus;
106 extern Atom Xatom_wm_save_yourself;
107 extern Atom Xatom_wm_delete_window;
109 /* Other WM communication */
110 extern Atom Xatom_wm_configure_denied; /* When our config request is denied */
111 extern Atom Xatom_wm_window_moved; /* When the WM moves us. */
113 #else /* X10 */
115 /* Default size of an Emacs window. */
116 static char *default_window = "=80x24+0+0";
118 #define MAXICID 80
119 char iconidentity[MAXICID];
120 #define ICONTAG "emacs@"
121 char minibuffer_iconidentity[MAXICID];
122 #define MINIBUFFER_ICONTAG "minibuffer@"
124 #endif /* X10 */
126 /* The last 23 bits of the timestamp of the last mouse button event. */
127 Time mouse_timestamp;
129 /* Evaluate this expression to rebuild the section of syms_of_xfns
130 that initializes and staticpros the symbols declared below. Note
131 that Emacs 18 has a bug that keeps C-x C-e from being able to
132 evaluate this expression.
134 (progn
135 ;; Accumulate a list of the symbols we want to initialize from the
136 ;; declarations at the top of the file.
137 (goto-char (point-min))
138 (search-forward "/\*&&& symbols declared here &&&*\/\n")
139 (let (symbol-list)
140 (while (looking-at "Lisp_Object \\(Q[a-z_]+\\)")
141 (setq symbol-list
142 (cons (buffer-substring (match-beginning 1) (match-end 1))
143 symbol-list))
144 (forward-line 1))
145 (setq symbol-list (nreverse symbol-list))
146 ;; Delete the section of syms_of_... where we initialize the symbols.
147 (search-forward "\n /\*&&& init symbols here &&&*\/\n")
148 (let ((start (point)))
149 (while (looking-at "^ Q")
150 (forward-line 2))
151 (kill-region start (point)))
152 ;; Write a new symbol initialization section.
153 (while symbol-list
154 (insert (format " %s = intern (\"" (car symbol-list)))
155 (let ((start (point)))
156 (insert (substring (car symbol-list) 1))
157 (subst-char-in-region start (point) ?_ ?-))
158 (insert (format "\");\n staticpro (&%s);\n" (car symbol-list)))
159 (setq symbol-list (cdr symbol-list)))))
163 /*&&& symbols declared here &&&*/
164 Lisp_Object Qauto_raise;
165 Lisp_Object Qauto_lower;
166 Lisp_Object Qbackground_color;
167 Lisp_Object Qbar;
168 Lisp_Object Qborder_color;
169 Lisp_Object Qborder_width;
170 Lisp_Object Qbox;
171 Lisp_Object Qcursor_color;
172 Lisp_Object Qcursor_type;
173 Lisp_Object Qfont;
174 Lisp_Object Qforeground_color;
175 Lisp_Object Qgeometry;
176 /* Lisp_Object Qicon; */
177 Lisp_Object Qicon_left;
178 Lisp_Object Qicon_top;
179 Lisp_Object Qicon_type;
180 Lisp_Object Qinternal_border_width;
181 Lisp_Object Qleft;
182 Lisp_Object Qmouse_color;
183 Lisp_Object Qnone;
184 Lisp_Object Qparent_id;
185 Lisp_Object Qsuppress_icon;
186 Lisp_Object Qtop;
187 Lisp_Object Qundefined_color;
188 Lisp_Object Qvertical_scroll_bars;
189 Lisp_Object Qvisibility;
190 Lisp_Object Qwindow_id;
191 Lisp_Object Qx_frame_parameter;
193 /* The below are defined in frame.c. */
194 extern Lisp_Object Qheight, Qminibuffer, Qname, Qonly, Qwidth;
195 extern Lisp_Object Qunsplittable, Qmenu_bar_lines;
197 extern Lisp_Object Vwindow_system_version;
200 /* Error if we are not connected to X. */
201 static void
202 check_x ()
204 if (x_current_display == 0)
205 error ("X windows are not in use or not initialized");
208 /* Return the Emacs frame-object corresponding to an X window.
209 It could be the frame's main window or an icon window. */
211 /* This function can be called during GC, so use XGCTYPE. */
213 struct frame *
214 x_window_to_frame (wdesc)
215 int wdesc;
217 Lisp_Object tail, frame;
218 struct frame *f;
220 for (tail = Vframe_list; XGCTYPE (tail) == Lisp_Cons;
221 tail = XCONS (tail)->cdr)
223 frame = XCONS (tail)->car;
224 if (XGCTYPE (frame) != Lisp_Frame)
225 continue;
226 f = XFRAME (frame);
227 if (FRAME_X_WINDOW (f) == wdesc
228 || f->display.x->icon_desc == wdesc)
229 return f;
231 return 0;
235 /* Connect the frame-parameter names for X frames
236 to the ways of passing the parameter values to the window system.
238 The name of a parameter, as a Lisp symbol,
239 has an `x-frame-parameter' property which is an integer in Lisp
240 but can be interpreted as an `enum x_frame_parm' in C. */
242 enum x_frame_parm
244 X_PARM_FOREGROUND_COLOR,
245 X_PARM_BACKGROUND_COLOR,
246 X_PARM_MOUSE_COLOR,
247 X_PARM_CURSOR_COLOR,
248 X_PARM_BORDER_COLOR,
249 X_PARM_ICON_TYPE,
250 X_PARM_FONT,
251 X_PARM_BORDER_WIDTH,
252 X_PARM_INTERNAL_BORDER_WIDTH,
253 X_PARM_NAME,
254 X_PARM_AUTORAISE,
255 X_PARM_AUTOLOWER,
256 X_PARM_VERT_SCROLL_BAR,
257 X_PARM_VISIBILITY,
258 X_PARM_MENU_BAR_LINES
262 struct x_frame_parm_table
264 char *name;
265 void (*setter)( /* struct frame *frame, Lisp_Object val, oldval */ );
268 void x_set_foreground_color ();
269 void x_set_background_color ();
270 void x_set_mouse_color ();
271 void x_set_cursor_color ();
272 void x_set_border_color ();
273 void x_set_cursor_type ();
274 void x_set_icon_type ();
275 void x_set_font ();
276 void x_set_border_width ();
277 void x_set_internal_border_width ();
278 void x_explicitly_set_name ();
279 void x_set_autoraise ();
280 void x_set_autolower ();
281 void x_set_vertical_scroll_bars ();
282 void x_set_visibility ();
283 void x_set_menu_bar_lines ();
285 static struct x_frame_parm_table x_frame_parms[] =
287 "foreground-color", x_set_foreground_color,
288 "background-color", x_set_background_color,
289 "mouse-color", x_set_mouse_color,
290 "cursor-color", x_set_cursor_color,
291 "border-color", x_set_border_color,
292 "cursor-type", x_set_cursor_type,
293 "icon-type", x_set_icon_type,
294 "font", x_set_font,
295 "border-width", x_set_border_width,
296 "internal-border-width", x_set_internal_border_width,
297 "name", x_explicitly_set_name,
298 "auto-raise", x_set_autoraise,
299 "auto-lower", x_set_autolower,
300 "vertical-scroll-bars", x_set_vertical_scroll_bars,
301 "visibility", x_set_visibility,
302 "menu-bar-lines", x_set_menu_bar_lines,
305 /* Attach the `x-frame-parameter' properties to
306 the Lisp symbol names of parameters relevant to X. */
308 init_x_parm_symbols ()
310 int i;
312 for (i = 0; i < sizeof (x_frame_parms) / sizeof (x_frame_parms[0]); i++)
313 Fput (intern (x_frame_parms[i].name), Qx_frame_parameter,
314 make_number (i));
317 /* Change the parameters of FRAME as specified by ALIST.
318 If a parameter is not specially recognized, do nothing;
319 otherwise call the `x_set_...' function for that parameter. */
321 void
322 x_set_frame_parameters (f, alist)
323 FRAME_PTR f;
324 Lisp_Object alist;
326 Lisp_Object tail;
328 /* If both of these parameters are present, it's more efficient to
329 set them both at once. So we wait until we've looked at the
330 entire list before we set them. */
331 Lisp_Object width, height;
333 /* Same here. */
334 Lisp_Object left, top;
336 /* Record in these vectors all the parms specified. */
337 Lisp_Object *parms;
338 Lisp_Object *values;
339 int i;
341 i = 0;
342 for (tail = alist; CONSP (tail); tail = Fcdr (tail))
343 i++;
345 parms = (Lisp_Object *) alloca (i * sizeof (Lisp_Object));
346 values = (Lisp_Object *) alloca (i * sizeof (Lisp_Object));
348 /* Extract parm names and values into those vectors. */
350 i = 0;
351 for (tail = alist; CONSP (tail); tail = Fcdr (tail))
353 Lisp_Object elt, prop, val;
355 elt = Fcar (tail);
356 parms[i] = Fcar (elt);
357 values[i] = Fcdr (elt);
358 i++;
361 XSET (width, Lisp_Int, FRAME_WIDTH (f));
362 XSET (height, Lisp_Int, FRAME_HEIGHT (f));
363 XSET (top, Lisp_Int, f->display.x->top_pos);
364 XSET (left, Lisp_Int, f->display.x->left_pos);
366 /* Now process them in reverse of specified order. */
367 for (i--; i >= 0; i--)
369 Lisp_Object prop, val;
371 prop = parms[i];
372 val = values[i];
374 if (EQ (prop, Qwidth))
375 width = val;
376 else if (EQ (prop, Qheight))
377 height = val;
378 else if (EQ (prop, Qtop))
379 top = val;
380 else if (EQ (prop, Qleft))
381 left = val;
382 else
384 register Lisp_Object param_index = Fget (prop, Qx_frame_parameter);
385 register Lisp_Object old_value = get_frame_param (f, prop);
387 store_frame_param (f, prop, val);
388 if (XTYPE (param_index) == Lisp_Int
389 && XINT (param_index) >= 0
390 && (XINT (param_index)
391 < sizeof (x_frame_parms)/sizeof (x_frame_parms[0])))
392 (*x_frame_parms[XINT (param_index)].setter)(f, val, old_value);
396 /* Don't call these unless they've changed; the window may not actually
397 exist yet. */
399 Lisp_Object frame;
401 XSET (frame, Lisp_Frame, f);
402 if (XINT (width) != FRAME_WIDTH (f)
403 || XINT (height) != FRAME_HEIGHT (f))
404 Fset_frame_size (frame, width, height);
405 if (XINT (left) != f->display.x->left_pos
406 || XINT (top) != f->display.x->top_pos)
407 Fset_frame_position (frame, left, top);
411 /* Insert a description of internally-recorded parameters of frame X
412 into the parameter alist *ALISTPTR that is to be given to the user.
413 Only parameters that are specific to the X window system
414 and whose values are not correctly recorded in the frame's
415 param_alist need to be considered here. */
417 x_report_frame_params (f, alistptr)
418 struct frame *f;
419 Lisp_Object *alistptr;
421 char buf[16];
423 store_in_alist (alistptr, Qleft, make_number (f->display.x->left_pos));
424 store_in_alist (alistptr, Qtop, make_number (f->display.x->top_pos));
425 store_in_alist (alistptr, Qborder_width,
426 make_number (f->display.x->border_width));
427 store_in_alist (alistptr, Qinternal_border_width,
428 make_number (f->display.x->internal_border_width));
429 sprintf (buf, "%d", FRAME_X_WINDOW (f));
430 store_in_alist (alistptr, Qwindow_id,
431 build_string (buf));
432 store_in_alist (alistptr, Qvisibility,
433 (FRAME_VISIBLE_P (f) ? Qt
434 : FRAME_ICONIFIED_P (f) ? Qicon : Qnil));
437 /* Decide if color named COLOR is valid for the display
438 associated with the selected frame. */
440 defined_color (color, color_def)
441 char *color;
442 Color *color_def;
444 register int foo;
445 Colormap screen_colormap;
447 BLOCK_INPUT;
448 #ifdef HAVE_X11
449 screen_colormap
450 = DefaultColormap (x_current_display, XDefaultScreen (x_current_display));
452 foo = XParseColor (x_current_display, screen_colormap,
453 color, color_def)
454 && XAllocColor (x_current_display, screen_colormap, color_def);
455 #else
456 foo = XParseColor (color, color_def) && XGetHardwareColor (color_def);
457 #endif /* not HAVE_X11 */
458 UNBLOCK_INPUT;
460 if (foo)
461 return 1;
462 else
463 return 0;
466 /* Given a string ARG naming a color, compute a pixel value from it
467 suitable for screen F.
468 If F is not a color screen, return DEF (default) regardless of what
469 ARG says. */
472 x_decode_color (arg, def)
473 Lisp_Object arg;
474 int def;
476 Color cdef;
478 CHECK_STRING (arg, 0);
480 if (strcmp (XSTRING (arg)->data, "black") == 0)
481 return BLACK_PIX_DEFAULT;
482 else if (strcmp (XSTRING (arg)->data, "white") == 0)
483 return WHITE_PIX_DEFAULT;
485 #ifdef HAVE_X11
486 if (x_screen_planes == 1)
487 return def;
488 #else
489 if (DISPLAY_CELLS == 1)
490 return def;
491 #endif
493 if (defined_color (XSTRING (arg)->data, &cdef))
494 return cdef.pixel;
495 else
496 Fsignal (Qundefined_color, Fcons (arg, Qnil));
499 /* Functions called only from `x_set_frame_param'
500 to set individual parameters.
502 If FRAME_X_WINDOW (f) is 0,
503 the frame is being created and its X-window does not exist yet.
504 In that case, just record the parameter's new value
505 in the standard place; do not attempt to change the window. */
507 void
508 x_set_foreground_color (f, arg, oldval)
509 struct frame *f;
510 Lisp_Object arg, oldval;
512 f->display.x->foreground_pixel = x_decode_color (arg, BLACK_PIX_DEFAULT);
513 if (FRAME_X_WINDOW (f) != 0)
515 #ifdef HAVE_X11
516 BLOCK_INPUT;
517 XSetForeground (x_current_display, f->display.x->normal_gc,
518 f->display.x->foreground_pixel);
519 XSetBackground (x_current_display, f->display.x->reverse_gc,
520 f->display.x->foreground_pixel);
521 UNBLOCK_INPUT;
522 #endif /* HAVE_X11 */
523 recompute_basic_faces (f);
524 if (FRAME_VISIBLE_P (f))
525 redraw_frame (f);
529 void
530 x_set_background_color (f, arg, oldval)
531 struct frame *f;
532 Lisp_Object arg, oldval;
534 Pixmap temp;
535 int mask;
537 f->display.x->background_pixel = x_decode_color (arg, WHITE_PIX_DEFAULT);
539 if (FRAME_X_WINDOW (f) != 0)
541 BLOCK_INPUT;
542 #ifdef HAVE_X11
543 /* The main frame area. */
544 XSetBackground (x_current_display, f->display.x->normal_gc,
545 f->display.x->background_pixel);
546 XSetForeground (x_current_display, f->display.x->reverse_gc,
547 f->display.x->background_pixel);
548 XSetWindowBackground (x_current_display, FRAME_X_WINDOW (f),
549 f->display.x->background_pixel);
551 #else
552 temp = XMakeTile (f->display.x->background_pixel);
553 XChangeBackground (FRAME_X_WINDOW (f), temp);
554 XFreePixmap (temp);
555 #endif /* not HAVE_X11 */
556 UNBLOCK_INPUT;
558 recompute_basic_faces (f);
560 if (FRAME_VISIBLE_P (f))
561 redraw_frame (f);
565 void
566 x_set_mouse_color (f, arg, oldval)
567 struct frame *f;
568 Lisp_Object arg, oldval;
570 Cursor cursor, nontext_cursor, mode_cursor;
571 int mask_color;
573 if (!EQ (Qnil, arg))
574 f->display.x->mouse_pixel = x_decode_color (arg, BLACK_PIX_DEFAULT);
575 mask_color = f->display.x->background_pixel;
576 /* No invisible pointers. */
577 if (mask_color == f->display.x->mouse_pixel
578 && mask_color == f->display.x->background_pixel)
579 f->display.x->mouse_pixel = f->display.x->foreground_pixel;
581 BLOCK_INPUT;
582 #ifdef HAVE_X11
584 /* It's not okay to crash if the user selects a screwy cursor. */
585 x_catch_errors ();
587 if (!EQ (Qnil, Vx_pointer_shape))
589 CHECK_NUMBER (Vx_pointer_shape, 0);
590 cursor = XCreateFontCursor (x_current_display, XINT (Vx_pointer_shape));
592 else
593 cursor = XCreateFontCursor (x_current_display, XC_xterm);
594 x_check_errors ("bad text pointer cursor: %s");
596 if (!EQ (Qnil, Vx_nontext_pointer_shape))
598 CHECK_NUMBER (Vx_nontext_pointer_shape, 0);
599 nontext_cursor = XCreateFontCursor (x_current_display,
600 XINT (Vx_nontext_pointer_shape));
602 else
603 nontext_cursor = XCreateFontCursor (x_current_display, XC_left_ptr);
604 x_check_errors ("bad nontext pointer cursor: %s");
606 if (!EQ (Qnil, Vx_mode_pointer_shape))
608 CHECK_NUMBER (Vx_mode_pointer_shape, 0);
609 mode_cursor = XCreateFontCursor (x_current_display,
610 XINT (Vx_mode_pointer_shape));
612 else
613 mode_cursor = XCreateFontCursor (x_current_display, XC_xterm);
615 /* Check and report errors with the above calls. */
616 x_check_errors ("can't set cursor shape: %s");
617 x_uncatch_errors ();
620 XColor fore_color, back_color;
622 fore_color.pixel = f->display.x->mouse_pixel;
623 back_color.pixel = mask_color;
624 XQueryColor (x_current_display,
625 DefaultColormap (x_current_display,
626 DefaultScreen (x_current_display)),
627 &fore_color);
628 XQueryColor (x_current_display,
629 DefaultColormap (x_current_display,
630 DefaultScreen (x_current_display)),
631 &back_color);
632 XRecolorCursor (x_current_display, cursor,
633 &fore_color, &back_color);
634 XRecolorCursor (x_current_display, nontext_cursor,
635 &fore_color, &back_color);
636 XRecolorCursor (x_current_display, mode_cursor,
637 &fore_color, &back_color);
639 #else /* X10 */
640 cursor = XCreateCursor (16, 16, MouseCursor, MouseMask,
641 0, 0,
642 f->display.x->mouse_pixel,
643 f->display.x->background_pixel,
644 GXcopy);
645 #endif /* X10 */
647 if (FRAME_X_WINDOW (f) != 0)
649 XDefineCursor (XDISPLAY FRAME_X_WINDOW (f), cursor);
652 if (cursor != f->display.x->text_cursor && f->display.x->text_cursor != 0)
653 XFreeCursor (XDISPLAY f->display.x->text_cursor);
654 f->display.x->text_cursor = cursor;
655 #ifdef HAVE_X11
656 if (nontext_cursor != f->display.x->nontext_cursor
657 && f->display.x->nontext_cursor != 0)
658 XFreeCursor (XDISPLAY f->display.x->nontext_cursor);
659 f->display.x->nontext_cursor = nontext_cursor;
661 if (mode_cursor != f->display.x->modeline_cursor
662 && f->display.x->modeline_cursor != 0)
663 XFreeCursor (XDISPLAY f->display.x->modeline_cursor);
664 f->display.x->modeline_cursor = mode_cursor;
665 #endif /* HAVE_X11 */
667 XFlushQueue ();
668 UNBLOCK_INPUT;
671 void
672 x_set_cursor_color (f, arg, oldval)
673 struct frame *f;
674 Lisp_Object arg, oldval;
676 unsigned long fore_pixel;
678 if (!EQ (Vx_cursor_fore_pixel, Qnil))
679 fore_pixel = x_decode_color (Vx_cursor_fore_pixel, WHITE_PIX_DEFAULT);
680 else
681 fore_pixel = f->display.x->background_pixel;
682 f->display.x->cursor_pixel = x_decode_color (arg, BLACK_PIX_DEFAULT);
684 /* Make sure that the cursor color differs from the background color. */
685 if (f->display.x->cursor_pixel == f->display.x->background_pixel)
687 f->display.x->cursor_pixel == f->display.x->mouse_pixel;
688 if (f->display.x->cursor_pixel == fore_pixel)
689 fore_pixel = f->display.x->background_pixel;
691 f->display.x->cursor_foreground_pixel = fore_pixel;
693 if (FRAME_X_WINDOW (f) != 0)
695 #ifdef HAVE_X11
696 BLOCK_INPUT;
697 XSetBackground (x_current_display, f->display.x->cursor_gc,
698 f->display.x->cursor_pixel);
699 XSetForeground (x_current_display, f->display.x->cursor_gc,
700 fore_pixel);
701 UNBLOCK_INPUT;
702 #endif /* HAVE_X11 */
704 if (FRAME_VISIBLE_P (f))
706 x_display_cursor (f, 0);
707 x_display_cursor (f, 1);
712 /* Set the border-color of frame F to value described by ARG.
713 ARG can be a string naming a color.
714 The border-color is used for the border that is drawn by the X server.
715 Note that this does not fully take effect if done before
716 F has an x-window; it must be redone when the window is created.
718 Note: this is done in two routines because of the way X10 works.
720 Note: under X11, this is normally the province of the window manager,
721 and so emacs' border colors may be overridden. */
723 void
724 x_set_border_color (f, arg, oldval)
725 struct frame *f;
726 Lisp_Object arg, oldval;
728 unsigned char *str;
729 int pix;
731 CHECK_STRING (arg, 0);
732 str = XSTRING (arg)->data;
734 #ifndef HAVE_X11
735 if (!strcmp (str, "grey") || !strcmp (str, "Grey")
736 || !strcmp (str, "gray") || !strcmp (str, "Gray"))
737 pix = -1;
738 else
739 #endif /* X10 */
741 pix = x_decode_color (arg, BLACK_PIX_DEFAULT);
743 x_set_border_pixel (f, pix);
746 /* Set the border-color of frame F to pixel value PIX.
747 Note that this does not fully take effect if done before
748 F has an x-window. */
750 x_set_border_pixel (f, pix)
751 struct frame *f;
752 int pix;
754 f->display.x->border_pixel = pix;
756 if (FRAME_X_WINDOW (f) != 0 && f->display.x->border_width > 0)
758 Pixmap temp;
759 int mask;
761 BLOCK_INPUT;
762 #ifdef HAVE_X11
763 XSetWindowBorder (x_current_display, FRAME_X_WINDOW (f),
764 pix);
765 #else
766 if (pix < 0)
767 temp = XMakePixmap ((Bitmap) XStoreBitmap (gray_width, gray_height,
768 gray_bits),
769 BLACK_PIX_DEFAULT, WHITE_PIX_DEFAULT);
770 else
771 temp = XMakeTile (pix);
772 XChangeBorder (FRAME_X_WINDOW (f), temp);
773 XFreePixmap (XDISPLAY temp);
774 #endif /* not HAVE_X11 */
775 UNBLOCK_INPUT;
777 if (FRAME_VISIBLE_P (f))
778 redraw_frame (f);
782 void
783 x_set_cursor_type (f, arg, oldval)
784 FRAME_PTR f;
785 Lisp_Object arg, oldval;
787 if (EQ (arg, Qbar))
788 FRAME_DESIRED_CURSOR (f) = bar_cursor;
789 else
790 #if 0
791 if (EQ (arg, Qbox))
792 #endif
793 FRAME_DESIRED_CURSOR (f) = filled_box_cursor;
794 /* Error messages commented out because people have trouble fixing
795 .Xdefaults with Emacs, when it has something bad in it. */
796 #if 0
797 else
798 error
799 ("the `cursor-type' frame parameter should be either `bar' or `box'");
800 #endif
802 /* Make sure the cursor gets redrawn. This is overkill, but how
803 often do people change cursor types? */
804 update_mode_lines++;
807 void
808 x_set_icon_type (f, arg, oldval)
809 struct frame *f;
810 Lisp_Object arg, oldval;
812 Lisp_Object tem;
813 int result;
815 if (EQ (oldval, Qnil) == EQ (arg, Qnil))
816 return;
818 BLOCK_INPUT;
819 if (NILP (arg))
820 result = x_text_icon (f, 0);
821 else
822 result = x_bitmap_icon (f);
824 if (result)
826 UNBLOCK_INPUT;
827 error ("No icon window available.");
830 /* If the window was unmapped (and its icon was mapped),
831 the new icon is not mapped, so map the window in its stead. */
832 if (FRAME_VISIBLE_P (f))
833 XMapWindow (XDISPLAY FRAME_X_WINDOW (f));
835 XFlushQueue ();
836 UNBLOCK_INPUT;
839 extern Lisp_Object x_new_font ();
841 void
842 x_set_font (f, arg, oldval)
843 struct frame *f;
844 Lisp_Object arg, oldval;
846 Lisp_Object result;
848 CHECK_STRING (arg, 1);
850 BLOCK_INPUT;
851 result = x_new_font (f, XSTRING (arg)->data);
852 UNBLOCK_INPUT;
854 if (EQ (result, Qnil))
855 error ("Font \"%s\" is not defined", XSTRING (arg)->data);
856 else if (EQ (result, Qt))
857 error ("the characters of the given font have varying widths");
858 else if (STRINGP (result))
860 recompute_basic_faces (f);
861 store_frame_param (f, Qfont, result);
863 else
864 abort ();
867 void
868 x_set_border_width (f, arg, oldval)
869 struct frame *f;
870 Lisp_Object arg, oldval;
872 CHECK_NUMBER (arg, 0);
874 if (XINT (arg) == f->display.x->border_width)
875 return;
877 if (FRAME_X_WINDOW (f) != 0)
878 error ("Cannot change the border width of a window");
880 f->display.x->border_width = XINT (arg);
883 void
884 x_set_internal_border_width (f, arg, oldval)
885 struct frame *f;
886 Lisp_Object arg, oldval;
888 int mask;
889 int old = f->display.x->internal_border_width;
891 CHECK_NUMBER (arg, 0);
892 f->display.x->internal_border_width = XINT (arg);
893 if (f->display.x->internal_border_width < 0)
894 f->display.x->internal_border_width = 0;
896 if (f->display.x->internal_border_width == old)
897 return;
899 if (FRAME_X_WINDOW (f) != 0)
901 BLOCK_INPUT;
902 x_set_window_size (f, f->width, f->height);
903 #if 0
904 x_set_resize_hint (f);
905 #endif
906 XFlushQueue ();
907 UNBLOCK_INPUT;
908 SET_FRAME_GARBAGED (f);
912 void
913 x_set_visibility (f, value, oldval)
914 struct frame *f;
915 Lisp_Object value, oldval;
917 Lisp_Object frame;
918 XSET (frame, Lisp_Frame, f);
920 if (NILP (value))
921 Fmake_frame_invisible (frame);
922 else if (EQ (value, Qicon))
923 Ficonify_frame (frame);
924 else
925 Fmake_frame_visible (frame);
928 static void
929 x_set_menu_bar_lines_1 (window, n)
930 Lisp_Object window;
931 int n;
933 struct window *w = XWINDOW (window);
935 XFASTINT (w->top) += n;
936 XFASTINT (w->height) -= n;
938 /* Handle just the top child in a vertical split. */
939 if (!NILP (w->vchild))
940 x_set_menu_bar_lines_1 (w->vchild, n);
942 /* Adjust all children in a horizontal split. */
943 for (window = w->hchild; !NILP (window); window = w->next)
945 w = XWINDOW (window);
946 x_set_menu_bar_lines_1 (window, n);
950 void
951 x_set_menu_bar_lines (f, value, oldval)
952 struct frame *f;
953 Lisp_Object value, oldval;
955 int nlines;
956 int olines = FRAME_MENU_BAR_LINES (f);
958 /* Right now, menu bars don't work properly in minibuf-only frames;
959 most of the commands try to apply themselves to the minibuffer
960 frame itslef, and get an error because you can't switch buffers
961 in or split the minibuffer window. */
962 if (FRAME_MINIBUF_ONLY_P (f))
963 return;
965 if (XTYPE (value) == Lisp_Int)
966 nlines = XINT (value);
967 else
968 nlines = 0;
970 FRAME_MENU_BAR_LINES (f) = nlines;
971 x_set_menu_bar_lines_1 (f->root_window, nlines - olines);
974 /* Change the name of frame F to ARG. If ARG is nil, set F's name to
975 x_id_name.
977 If EXPLICIT is non-zero, that indicates that lisp code is setting the
978 name; if ARG is a string, set F's name to ARG and set
979 F->explicit_name; if ARG is Qnil, then clear F->explicit_name.
981 If EXPLICIT is zero, that indicates that Emacs redisplay code is
982 suggesting a new name, which lisp code should override; if
983 F->explicit_name is set, ignore the new name; otherwise, set it. */
985 void
986 x_set_name (f, name, explicit)
987 struct frame *f;
988 Lisp_Object name;
989 int explicit;
991 /* Make sure that requests from lisp code override requests from
992 Emacs redisplay code. */
993 if (explicit)
995 /* If we're switching from explicit to implicit, we had better
996 update the mode lines and thereby update the title. */
997 if (f->explicit_name && NILP (name))
998 update_mode_lines = 1;
1000 f->explicit_name = ! NILP (name);
1002 else if (f->explicit_name)
1003 return;
1005 /* If NAME is nil, set the name to the x_id_name. */
1006 if (NILP (name))
1007 name = build_string (x_id_name);
1008 else
1009 CHECK_STRING (name, 0);
1011 /* Don't change the name if it's already NAME. */
1012 if (! NILP (Fstring_equal (name, f->name)))
1013 return;
1015 if (FRAME_X_WINDOW (f))
1017 BLOCK_INPUT;
1019 #ifdef HAVE_X11R4
1021 XTextProperty text;
1022 text.value = XSTRING (name)->data;
1023 text.encoding = XA_STRING;
1024 text.format = 8;
1025 text.nitems = XSTRING (name)->size;
1026 XSetWMName (x_current_display, FRAME_X_WINDOW (f), &text);
1027 XSetWMIconName (x_current_display, FRAME_X_WINDOW (f), &text);
1029 #else
1030 XSetIconName (XDISPLAY FRAME_X_WINDOW (f),
1031 XSTRING (name)->data);
1032 XStoreName (XDISPLAY FRAME_X_WINDOW (f),
1033 XSTRING (name)->data);
1034 #endif
1036 UNBLOCK_INPUT;
1039 f->name = name;
1042 /* This function should be called when the user's lisp code has
1043 specified a name for the frame; the name will override any set by the
1044 redisplay code. */
1045 void
1046 x_explicitly_set_name (f, arg, oldval)
1047 FRAME_PTR f;
1048 Lisp_Object arg, oldval;
1050 x_set_name (f, arg, 1);
1053 /* This function should be called by Emacs redisplay code to set the
1054 name; names set this way will never override names set by the user's
1055 lisp code. */
1056 void
1057 x_implicitly_set_name (f, arg, oldval)
1058 FRAME_PTR f;
1059 Lisp_Object arg, oldval;
1061 x_set_name (f, arg, 0);
1064 void
1065 x_set_autoraise (f, arg, oldval)
1066 struct frame *f;
1067 Lisp_Object arg, oldval;
1069 f->auto_raise = !EQ (Qnil, arg);
1072 void
1073 x_set_autolower (f, arg, oldval)
1074 struct frame *f;
1075 Lisp_Object arg, oldval;
1077 f->auto_lower = !EQ (Qnil, arg);
1080 void
1081 x_set_vertical_scroll_bars (f, arg, oldval)
1082 struct frame *f;
1083 Lisp_Object arg, oldval;
1085 if (NILP (arg) != ! FRAME_HAS_VERTICAL_SCROLL_BARS (f))
1087 FRAME_HAS_VERTICAL_SCROLL_BARS (f) = ! NILP (arg);
1089 /* We set this parameter before creating the X window for the
1090 frame, so we can get the geometry right from the start.
1091 However, if the window hasn't been created yet, we shouldn't
1092 call x_set_window_size. */
1093 if (FRAME_X_WINDOW (f))
1094 x_set_window_size (f, FRAME_WIDTH (f), FRAME_HEIGHT (f));
1098 /* Subroutines of creating an X frame. */
1100 #ifdef HAVE_X11
1101 extern char *x_get_string_resource ();
1102 extern XrmDatabase x_load_resources ();
1104 DEFUN ("x-get-resource", Fx_get_resource, Sx_get_resource, 2, 4, 0,
1105 "Return the value of ATTRIBUTE, of class CLASS, from the X defaults database.\n\
1106 This uses `INSTANCE.ATTRIBUTE' as the key and `Emacs.CLASS' as the\n\
1107 class, where INSTANCE is the name under which Emacs was invoked.\n\
1109 The optional arguments COMPONENT and SUBCLASS add to the key and the\n\
1110 class, respectively. You must specify both of them or neither.\n\
1111 If you specify them, the key is `INSTANCE.COMPONENT.ATTRIBUTE'\n\
1112 and the class is `Emacs.CLASS.SUBCLASS'.")
1113 (attribute, class, component, subclass)
1114 Lisp_Object attribute, class, component, subclass;
1116 register char *value;
1117 char *name_key;
1118 char *class_key;
1120 check_x ();
1122 CHECK_STRING (attribute, 0);
1123 CHECK_STRING (class, 0);
1125 if (!NILP (component))
1126 CHECK_STRING (component, 1);
1127 if (!NILP (subclass))
1128 CHECK_STRING (subclass, 2);
1129 if (NILP (component) != NILP (subclass))
1130 error ("x-get-resource: must specify both COMPONENT and SUBCLASS or neither");
1132 if (NILP (component))
1134 /* Allocate space for the components, the dots which separate them,
1135 and the final '\0'. */
1136 name_key = (char *) alloca (XSTRING (Vxrdb_name)->size
1137 + XSTRING (attribute)->size
1138 + 2);
1139 class_key = (char *) alloca ((sizeof (EMACS_CLASS) - 1)
1140 + XSTRING (class)->size
1141 + 2);
1143 sprintf (name_key, "%s.%s",
1144 XSTRING (Vxrdb_name)->data,
1145 XSTRING (attribute)->data);
1146 sprintf (class_key, "%s.%s",
1147 EMACS_CLASS,
1148 XSTRING (class)->data);
1150 else
1152 name_key = (char *) alloca (XSTRING (Vxrdb_name)->size
1153 + XSTRING (component)->size
1154 + XSTRING (attribute)->size
1155 + 3);
1157 class_key = (char *) alloca ((sizeof (EMACS_CLASS) - 1)
1158 + XSTRING (class)->size
1159 + XSTRING (subclass)->size
1160 + 3);
1162 sprintf (name_key, "%s.%s.%s",
1163 XSTRING (Vxrdb_name)->data,
1164 XSTRING (component)->data,
1165 XSTRING (attribute)->data);
1166 sprintf (class_key, "%s.%s.%s",
1167 EMACS_CLASS,
1168 XSTRING (class)->data,
1169 XSTRING (subclass)->data);
1172 value = x_get_string_resource (xrdb, name_key, class_key);
1174 if (value != (char *) 0)
1175 return build_string (value);
1176 else
1177 return Qnil;
1180 /* Used when C code wants a resource value. */
1182 char *
1183 x_get_resource_string (attribute, class)
1184 char *attribute, *class;
1186 register char *value;
1187 char *name_key;
1188 char *class_key;
1190 /* Allocate space for the components, the dots which separate them,
1191 and the final '\0'. */
1192 name_key = (char *) alloca (XSTRING (Vinvocation_name)->size
1193 + strlen (attribute) + 2);
1194 class_key = (char *) alloca ((sizeof (EMACS_CLASS) - 1)
1195 + strlen (class) + 2);
1197 sprintf (name_key, "%s.%s",
1198 XSTRING (Vinvocation_name)->data,
1199 attribute);
1200 sprintf (class_key, "%s.%s", EMACS_CLASS, class);
1202 return x_get_string_resource (xrdb, name_key, class_key);
1205 #else /* X10 */
1207 DEFUN ("x-get-default", Fx_get_default, Sx_get_default, 1, 1, 0,
1208 "Get X default ATTRIBUTE from the system, or nil if no default.\n\
1209 Value is a string (when not nil) and ATTRIBUTE is also a string.\n\
1210 The defaults are specified in the file `~/.Xdefaults'.")
1211 (arg)
1212 Lisp_Object arg;
1214 register unsigned char *value;
1216 CHECK_STRING (arg, 1);
1218 value = (unsigned char *) XGetDefault (XDISPLAY
1219 XSTRING (Vinvocation_name)->data,
1220 XSTRING (arg)->data);
1221 if (value == 0)
1222 /* Try reversing last two args, in case this is the buggy version of X. */
1223 value = (unsigned char *) XGetDefault (XDISPLAY
1224 XSTRING (arg)->data,
1225 XSTRING (Vinvocation_name)->data);
1226 if (value != 0)
1227 return build_string (value);
1228 else
1229 return (Qnil);
1232 #define Fx_get_resource(attribute, class, component, subclass) \
1233 Fx_get_default(attribute)
1235 #endif /* X10 */
1237 /* Types we might convert a resource string into. */
1238 enum resource_types
1240 number, boolean, string, symbol,
1243 /* Return the value of parameter PARAM.
1245 First search ALIST, then Vdefault_frame_alist, then the X defaults
1246 database, using ATTRIBUTE as the attribute name and CLASS as its class.
1248 Convert the resource to the type specified by desired_type.
1250 If no default is specified, return Qunbound. If you call
1251 x_get_arg, make sure you deal with Qunbound in a reasonable way,
1252 and don't let it get stored in any lisp-visible variables! */
1254 static Lisp_Object
1255 x_get_arg (alist, param, attribute, class, type)
1256 Lisp_Object alist, param;
1257 char *attribute;
1258 char *class;
1259 enum resource_types type;
1261 register Lisp_Object tem;
1263 tem = Fassq (param, alist);
1264 if (EQ (tem, Qnil))
1265 tem = Fassq (param, Vdefault_frame_alist);
1266 if (EQ (tem, Qnil))
1269 if (attribute)
1271 tem = Fx_get_resource (build_string (attribute),
1272 build_string (class),
1273 Qnil, Qnil);
1275 if (NILP (tem))
1276 return Qunbound;
1278 switch (type)
1280 case number:
1281 return make_number (atoi (XSTRING (tem)->data));
1283 case boolean:
1284 tem = Fdowncase (tem);
1285 if (!strcmp (XSTRING (tem)->data, "on")
1286 || !strcmp (XSTRING (tem)->data, "true"))
1287 return Qt;
1288 else
1289 return Qnil;
1291 case string:
1292 return tem;
1294 case symbol:
1295 /* As a special case, we map the values `true' and `on'
1296 to Qt, and `false' and `off' to Qnil. */
1298 Lisp_Object lower = Fdowncase (tem);
1299 if (!strcmp (XSTRING (tem)->data, "on")
1300 || !strcmp (XSTRING (tem)->data, "true"))
1301 return Qt;
1302 else if (!strcmp (XSTRING (tem)->data, "off")
1303 || !strcmp (XSTRING (tem)->data, "false"))
1304 return Qnil;
1305 else
1306 return Fintern (tem, Qnil);
1309 default:
1310 abort ();
1313 else
1314 return Qunbound;
1316 return Fcdr (tem);
1319 /* Record in frame F the specified or default value according to ALIST
1320 of the parameter named PARAM (a Lisp symbol).
1321 If no value is specified for PARAM, look for an X default for XPROP
1322 on the frame named NAME.
1323 If that is not found either, use the value DEFLT. */
1325 static Lisp_Object
1326 x_default_parameter (f, alist, prop, deflt, xprop, xclass, type)
1327 struct frame *f;
1328 Lisp_Object alist;
1329 Lisp_Object prop;
1330 Lisp_Object deflt;
1331 char *xprop;
1332 char *xclass;
1333 enum resource_types type;
1335 Lisp_Object tem;
1337 tem = x_get_arg (alist, prop, xprop, xclass, type);
1338 if (EQ (tem, Qunbound))
1339 tem = deflt;
1340 x_set_frame_parameters (f, Fcons (Fcons (prop, tem), Qnil));
1341 return tem;
1344 DEFUN ("x-parse-geometry", Fx_parse_geometry, Sx_parse_geometry, 1, 1, 0,
1345 "Parse an X-style geometry string STRING.\n\
1346 Returns an alist of the form ((top . TOP), (left . LEFT) ... ).")
1347 (string)
1348 Lisp_Object string;
1350 int geometry, x, y;
1351 unsigned int width, height;
1352 Lisp_Object values[4];
1354 CHECK_STRING (string, 0);
1356 geometry = XParseGeometry ((char *) XSTRING (string)->data,
1357 &x, &y, &width, &height);
1359 switch (geometry & 0xf) /* Mask out {X,Y}Negative */
1361 case (XValue | YValue):
1362 /* What's one pixel among friends?
1363 Perhaps fix this some day by returning symbol `extreme-top'... */
1364 if (x == 0 && (geometry & XNegative))
1365 x = -1;
1366 if (y == 0 && (geometry & YNegative))
1367 y = -1;
1368 values[0] = Fcons (Qleft, make_number (x));
1369 values[1] = Fcons (Qtop, make_number (y));
1370 return Flist (2, values);
1371 break;
1373 case (WidthValue | HeightValue):
1374 values[0] = Fcons (Qwidth, make_number (width));
1375 values[1] = Fcons (Qheight, make_number (height));
1376 return Flist (2, values);
1377 break;
1379 case (XValue | YValue | WidthValue | HeightValue):
1380 if (x == 0 && (geometry & XNegative))
1381 x = -1;
1382 if (y == 0 && (geometry & YNegative))
1383 y = -1;
1384 values[0] = Fcons (Qwidth, make_number (width));
1385 values[1] = Fcons (Qheight, make_number (height));
1386 values[2] = Fcons (Qleft, make_number (x));
1387 values[3] = Fcons (Qtop, make_number (y));
1388 return Flist (4, values);
1389 break;
1391 case 0:
1392 return Qnil;
1394 default:
1395 error ("Must specify x and y value, and/or width and height");
1399 #ifdef HAVE_X11
1400 /* Calculate the desired size and position of this window,
1401 or set rubber-band prompting if none. */
1403 #define DEFAULT_ROWS 40
1404 #define DEFAULT_COLS 80
1406 static int
1407 x_figure_window_size (f, parms)
1408 struct frame *f;
1409 Lisp_Object parms;
1411 register Lisp_Object tem0, tem1;
1412 int height, width, left, top;
1413 register int geometry;
1414 long window_prompting = 0;
1416 /* Default values if we fall through.
1417 Actually, if that happens we should get
1418 window manager prompting. */
1419 f->width = DEFAULT_COLS;
1420 f->height = DEFAULT_ROWS;
1421 /* Window managers expect that if program-specified
1422 positions are not (0,0), they're intentional, not defaults. */
1423 f->display.x->top_pos = 0;
1424 f->display.x->left_pos = 0;
1426 tem0 = x_get_arg (parms, Qheight, 0, 0, number);
1427 tem1 = x_get_arg (parms, Qwidth, 0, 0, number);
1428 if (! EQ (tem0, Qunbound) && ! EQ (tem1, Qunbound))
1430 CHECK_NUMBER (tem0, 0);
1431 CHECK_NUMBER (tem1, 0);
1432 f->height = XINT (tem0);
1433 f->width = XINT (tem1);
1434 window_prompting |= USSize;
1436 else if (! EQ (tem0, Qunbound) || ! EQ (tem1, Qunbound))
1437 error ("Must specify *both* height and width");
1439 f->display.x->vertical_scroll_bar_extra
1440 = (FRAME_HAS_VERTICAL_SCROLL_BARS (f)
1441 ? VERTICAL_SCROLL_BAR_PIXEL_WIDTH (f)
1442 : 0);
1443 f->display.x->pixel_width = CHAR_TO_PIXEL_WIDTH (f, f->width);
1444 f->display.x->pixel_height = CHAR_TO_PIXEL_HEIGHT (f, f->height);
1446 tem0 = x_get_arg (parms, Qtop, 0, 0, number);
1447 tem1 = x_get_arg (parms, Qleft, 0, 0, number);
1448 if (! EQ (tem0, Qunbound) && ! EQ (tem1, Qunbound))
1450 CHECK_NUMBER (tem0, 0);
1451 CHECK_NUMBER (tem1, 0);
1452 f->display.x->top_pos = XINT (tem0);
1453 f->display.x->left_pos = XINT (tem1);
1454 x_calc_absolute_position (f);
1455 window_prompting |= USPosition;
1457 else if (! EQ (tem0, Qunbound) || ! EQ (tem1, Qunbound))
1458 error ("Must specify *both* top and left corners");
1460 #if 0 /* PPosition and PSize mean "specified explicitly,
1461 by the program rather than by the user". So it is wrong to
1462 set them if nothing was specified. */
1463 switch (window_prompting)
1465 case USSize | USPosition:
1466 return window_prompting;
1467 break;
1469 case USSize: /* Got the size, need the position. */
1470 window_prompting |= PPosition;
1471 return window_prompting;
1472 break;
1474 case USPosition: /* Got the position, need the size. */
1475 window_prompting |= PSize;
1476 return window_prompting;
1477 break;
1479 case 0: /* Got nothing, take both from geometry. */
1480 window_prompting |= PPosition | PSize;
1481 return window_prompting;
1482 break;
1484 default:
1485 /* Somehow a bit got set in window_prompting that we didn't
1486 put there. */
1487 abort ();
1489 #endif
1490 return window_prompting;
1493 static void
1494 x_window (f)
1495 struct frame *f;
1497 XSetWindowAttributes attributes;
1498 unsigned long attribute_mask;
1499 XClassHint class_hints;
1501 attributes.background_pixel = f->display.x->background_pixel;
1502 attributes.border_pixel = f->display.x->border_pixel;
1503 attributes.bit_gravity = StaticGravity;
1504 attributes.backing_store = NotUseful;
1505 attributes.save_under = True;
1506 attributes.event_mask = STANDARD_EVENT_SET;
1507 attribute_mask = (CWBackPixel | CWBorderPixel | CWBitGravity
1508 #if 0
1509 | CWBackingStore | CWSaveUnder
1510 #endif
1511 | CWEventMask);
1513 BLOCK_INPUT;
1514 FRAME_X_WINDOW (f)
1515 = XCreateWindow (x_current_display, ROOT_WINDOW,
1516 f->display.x->left_pos,
1517 f->display.x->top_pos,
1518 PIXEL_WIDTH (f), PIXEL_HEIGHT (f),
1519 f->display.x->border_width,
1520 CopyFromParent, /* depth */
1521 InputOutput, /* class */
1522 screen_visual, /* set in Fx_open_connection */
1523 attribute_mask, &attributes);
1525 class_hints.res_name = (char *) XSTRING (Vxrdb_name)->data;
1526 class_hints.res_class = EMACS_CLASS;
1527 XSetClassHint (x_current_display, FRAME_X_WINDOW (f), &class_hints);
1529 /* This indicates that we use the "Passive Input" input model.
1530 Unless we do this, we don't get the Focus{In,Out} events that we
1531 need to draw the cursor correctly. Accursed bureaucrats.
1532 XWhipsAndChains (x_current_display, IronMaiden, &TheRack); */
1534 f->display.x->wm_hints.input = True;
1535 f->display.x->wm_hints.flags |= InputHint;
1536 XSetWMHints (x_current_display, FRAME_X_WINDOW (f), &f->display.x->wm_hints);
1538 /* x_set_name normally ignores requests to set the name if the
1539 requested name is the same as the current name. This is the one
1540 place where that assumption isn't correct; f->name is set, but
1541 the X server hasn't been told. */
1543 Lisp_Object name = f->name;
1544 int explicit = f->explicit_name;
1546 f->name = Qnil;
1547 f->explicit_name = 0;
1548 x_set_name (f, name, explicit);
1551 XDefineCursor (XDISPLAY FRAME_X_WINDOW (f),
1552 f->display.x->text_cursor);
1553 UNBLOCK_INPUT;
1555 if (FRAME_X_WINDOW (f) == 0)
1556 error ("Unable to create window.");
1559 /* Handle the icon stuff for this window. Perhaps later we might
1560 want an x_set_icon_position which can be called interactively as
1561 well. */
1563 static void
1564 x_icon (f, parms)
1565 struct frame *f;
1566 Lisp_Object parms;
1568 Lisp_Object icon_x, icon_y;
1570 /* Set the position of the icon. Note that twm groups all
1571 icons in an icon window. */
1572 icon_x = x_get_arg (parms, Qicon_left, 0, 0, number);
1573 icon_y = x_get_arg (parms, Qicon_top, 0, 0, number);
1574 if (!EQ (icon_x, Qunbound) && !EQ (icon_y, Qunbound))
1576 CHECK_NUMBER (icon_x, 0);
1577 CHECK_NUMBER (icon_y, 0);
1579 else if (!EQ (icon_x, Qunbound) || !EQ (icon_y, Qunbound))
1580 error ("Both left and top icon corners of icon must be specified");
1582 BLOCK_INPUT;
1584 if (! EQ (icon_x, Qunbound))
1585 x_wm_set_icon_position (f, XINT (icon_x), XINT (icon_y));
1587 /* Start up iconic or window? */
1588 x_wm_set_window_state
1589 (f, (EQ (x_get_arg (parms, Qvisibility, 0, 0, symbol), Qicon)
1590 ? IconicState
1591 : NormalState));
1593 UNBLOCK_INPUT;
1596 /* Make the GC's needed for this window, setting the
1597 background, border and mouse colors; also create the
1598 mouse cursor and the gray border tile. */
1600 static char cursor_bits[] =
1602 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
1603 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
1604 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
1605 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00
1608 static void
1609 x_make_gc (f)
1610 struct frame *f;
1612 XGCValues gc_values;
1613 GC temp_gc;
1614 XImage tileimage;
1616 BLOCK_INPUT;
1618 /* Create the GC's of this frame.
1619 Note that many default values are used. */
1621 /* Normal video */
1622 gc_values.font = f->display.x->font->fid;
1623 gc_values.foreground = f->display.x->foreground_pixel;
1624 gc_values.background = f->display.x->background_pixel;
1625 gc_values.line_width = 0; /* Means 1 using fast algorithm. */
1626 f->display.x->normal_gc = XCreateGC (x_current_display,
1627 FRAME_X_WINDOW (f),
1628 GCLineWidth | GCFont
1629 | GCForeground | GCBackground,
1630 &gc_values);
1632 /* Reverse video style. */
1633 gc_values.foreground = f->display.x->background_pixel;
1634 gc_values.background = f->display.x->foreground_pixel;
1635 f->display.x->reverse_gc = XCreateGC (x_current_display,
1636 FRAME_X_WINDOW (f),
1637 GCFont | GCForeground | GCBackground
1638 | GCLineWidth,
1639 &gc_values);
1641 /* Cursor has cursor-color background, background-color foreground. */
1642 gc_values.foreground = f->display.x->background_pixel;
1643 gc_values.background = f->display.x->cursor_pixel;
1644 gc_values.fill_style = FillOpaqueStippled;
1645 gc_values.stipple
1646 = XCreateBitmapFromData (x_current_display, ROOT_WINDOW,
1647 cursor_bits, 16, 16);
1648 f->display.x->cursor_gc
1649 = XCreateGC (x_current_display, FRAME_X_WINDOW (f),
1650 (GCFont | GCForeground | GCBackground
1651 | GCFillStyle | GCStipple | GCLineWidth),
1652 &gc_values);
1654 /* Create the gray border tile used when the pointer is not in
1655 the frame. Since this depends on the frame's pixel values,
1656 this must be done on a per-frame basis. */
1657 f->display.x->border_tile
1658 = (XCreatePixmapFromBitmapData
1659 (x_current_display, ROOT_WINDOW,
1660 gray_bits, gray_width, gray_height,
1661 f->display.x->foreground_pixel,
1662 f->display.x->background_pixel,
1663 DefaultDepth (x_current_display, XDefaultScreen (x_current_display))));
1665 UNBLOCK_INPUT;
1667 #endif /* HAVE_X11 */
1669 DEFUN ("x-create-frame", Fx_create_frame, Sx_create_frame,
1670 1, 1, 0,
1671 "Make a new X window, which is called a \"frame\" in Emacs terms.\n\
1672 Return an Emacs frame object representing the X window.\n\
1673 ALIST is an alist of frame parameters.\n\
1674 If the parameters specify that the frame should not have a minibuffer,\n\
1675 and do not specify a specific minibuffer window to use,\n\
1676 then `default-minibuffer-frame' must be a frame whose minibuffer can\n\
1677 be shared by the new frame.")
1678 (parms)
1679 Lisp_Object parms;
1681 #ifdef HAVE_X11
1682 struct frame *f;
1683 Lisp_Object frame, tem;
1684 Lisp_Object name;
1685 int minibuffer_only = 0;
1686 long window_prompting = 0;
1687 int width, height;
1689 check_x ();
1691 name = x_get_arg (parms, Qname, "title", "Title", string);
1692 if (XTYPE (name) != Lisp_String
1693 && ! EQ (name, Qunbound)
1694 && ! NILP (name))
1695 error ("x-create-frame: name parameter must be a string");
1697 tem = x_get_arg (parms, Qminibuffer, 0, 0, symbol);
1698 if (EQ (tem, Qnone) || NILP (tem))
1699 f = make_frame_without_minibuffer (Qnil);
1700 else if (EQ (tem, Qonly))
1702 f = make_minibuffer_frame ();
1703 minibuffer_only = 1;
1705 else if (XTYPE (tem) == Lisp_Window)
1706 f = make_frame_without_minibuffer (tem);
1707 else
1708 f = make_frame (1);
1710 /* Note that X Windows does support scroll bars. */
1711 FRAME_CAN_HAVE_SCROLL_BARS (f) = 1;
1713 /* Set the name; the functions to which we pass f expect the name to
1714 be set. */
1715 if (EQ (name, Qunbound) || NILP (name))
1717 f->name = build_string (x_id_name);
1718 f->explicit_name = 0;
1720 else
1722 f->name = name;
1723 f->explicit_name = 1;
1726 XSET (frame, Lisp_Frame, f);
1727 f->output_method = output_x_window;
1728 f->display.x = (struct x_display *) xmalloc (sizeof (struct x_display));
1729 bzero (f->display.x, sizeof (struct x_display));
1731 /* Note that the frame has no physical cursor right now. */
1732 f->phys_cursor_x = -1;
1734 /* Extract the window parameters from the supplied values
1735 that are needed to determine window geometry. */
1736 x_default_parameter (f, parms, Qfont,
1737 build_string
1738 /* If we use an XLFD name for this font, the lisp code
1739 knows how to find variants which are bold, italic,
1740 etcetera. */
1741 ("-*-fixed-*-*-*-*-*-120-*-*-c-*-iso8859-1"),
1742 "font", "Font", string);
1743 x_default_parameter (f, parms, Qborder_width, make_number (2),
1744 "borderwidth", "BorderWidth", number);
1745 /* This defaults to 2 in order to match xterm. We recognize either
1746 internalBorderWidth or internalBorder (which is what xterm calls
1747 it). */
1748 if (NILP (Fassq (Qinternal_border_width, parms)))
1750 Lisp_Object value;
1752 value = x_get_arg (parms, Qinternal_border_width,
1753 "internalBorder", "BorderWidth", number);
1754 if (! EQ (value, Qunbound))
1755 parms = Fcons (Fcons (Qinternal_border_width, value),
1756 parms);
1758 x_default_parameter (f, parms, Qinternal_border_width, make_number (2),
1759 "internalBorderWidth", "BorderWidth", number);
1760 x_default_parameter (f, parms, Qvertical_scroll_bars, Qt,
1761 "verticalScrollBars", "ScrollBars", boolean);
1763 /* Also do the stuff which must be set before the window exists. */
1764 x_default_parameter (f, parms, Qforeground_color, build_string ("black"),
1765 "foreground", "Foreground", string);
1766 x_default_parameter (f, parms, Qbackground_color, build_string ("white"),
1767 "background", "Background", string);
1768 x_default_parameter (f, parms, Qmouse_color, build_string ("black"),
1769 "pointerColor", "Foreground", string);
1770 x_default_parameter (f, parms, Qcursor_color, build_string ("black"),
1771 "cursorColor", "Foreground", string);
1772 x_default_parameter (f, parms, Qborder_color, build_string ("black"),
1773 "borderColor", "BorderColor", string);
1775 f->display.x->parent_desc = ROOT_WINDOW;
1776 window_prompting = x_figure_window_size (f, parms);
1778 x_window (f);
1779 x_icon (f, parms);
1780 x_make_gc (f);
1781 init_frame_faces (f);
1783 /* We need to do this after creating the X window, so that the
1784 icon-creation functions can say whose icon they're describing. */
1785 x_default_parameter (f, parms, Qicon_type, Qnil,
1786 "bitmapIcon", "BitmapIcon", symbol);
1788 x_default_parameter (f, parms, Qauto_raise, Qnil,
1789 "autoRaise", "AutoRaiseLower", boolean);
1790 x_default_parameter (f, parms, Qauto_lower, Qnil,
1791 "autoLower", "AutoRaiseLower", boolean);
1792 x_default_parameter (f, parms, Qcursor_type, Qbox,
1793 "cursorType", "CursorType", symbol);
1795 /* Dimensions, especially f->height, must be done via change_frame_size.
1796 Change will not be effected unless different from the current
1797 f->height. */
1798 width = f->width;
1799 height = f->height;
1800 f->height = f->width = 0;
1801 change_frame_size (f, height, width, 1, 0);
1803 x_default_parameter (f, parms, Qmenu_bar_lines, make_number (0),
1804 "menuBarLines", "MenuBarLines", number);
1806 BLOCK_INPUT;
1807 x_wm_set_size_hint (f, window_prompting);
1808 UNBLOCK_INPUT;
1810 tem = x_get_arg (parms, Qunsplittable, 0, 0, boolean);
1811 f->no_split = minibuffer_only || EQ (tem, Qt);
1813 /* Make the window appear on the frame and enable display,
1814 unless the caller says not to. */
1816 Lisp_Object visibility = x_get_arg (parms, Qvisibility, 0, 0, symbol);
1818 if (EQ (visibility, Qunbound))
1819 visibility = Qt;
1821 if (EQ (visibility, Qicon))
1822 x_iconify_frame (f);
1823 else if (! NILP (visibility))
1824 x_make_frame_visible (f);
1825 else
1826 /* Must have been Qnil. */
1830 return frame;
1831 #else /* X10 */
1832 struct frame *f;
1833 Lisp_Object frame, tem;
1834 Lisp_Object name;
1835 int pixelwidth, pixelheight;
1836 Cursor cursor;
1837 int height, width;
1838 Window parent;
1839 Pixmap temp;
1840 int minibuffer_only = 0;
1841 Lisp_Object vscroll, hscroll;
1843 if (x_current_display == 0)
1844 error ("X windows are not in use or not initialized");
1846 name = Fassq (Qname, parms);
1848 tem = x_get_arg (parms, Qminibuffer, 0, 0, symbol);
1849 if (EQ (tem, Qnone))
1850 f = make_frame_without_minibuffer (Qnil);
1851 else if (EQ (tem, Qonly))
1853 f = make_minibuffer_frame ();
1854 minibuffer_only = 1;
1856 else if (EQ (tem, Qnil) || EQ (tem, Qunbound))
1857 f = make_frame (1);
1858 else
1859 f = make_frame_without_minibuffer (tem);
1861 parent = ROOT_WINDOW;
1863 XSET (frame, Lisp_Frame, f);
1864 f->output_method = output_x_window;
1865 f->display.x = (struct x_display *) xmalloc (sizeof (struct x_display));
1866 bzero (f->display.x, sizeof (struct x_display));
1868 /* Some temporary default values for height and width. */
1869 width = 80;
1870 height = 40;
1871 f->display.x->left_pos = -1;
1872 f->display.x->top_pos = -1;
1874 /* Give the frame a default name (which may be overridden with PARMS). */
1876 strncpy (iconidentity, ICONTAG, MAXICID);
1877 if (gethostname (&iconidentity[sizeof (ICONTAG) - 1],
1878 (MAXICID - 1) - sizeof (ICONTAG)))
1879 iconidentity[sizeof (ICONTAG) - 2] = '\0';
1880 f->name = build_string (iconidentity);
1882 /* Extract some window parameters from the supplied values.
1883 These are the parameters that affect window geometry. */
1885 tem = x_get_arg (parms, Qfont, "BodyFont", 0, string);
1886 if (EQ (tem, Qunbound))
1887 tem = build_string ("9x15");
1888 x_set_font (f, tem, Qnil);
1889 x_default_parameter (f, parms, Qborder_color,
1890 build_string ("black"), "Border", 0, string);
1891 x_default_parameter (f, parms, Qbackground_color,
1892 build_string ("white"), "Background", 0, string);
1893 x_default_parameter (f, parms, Qforeground_color,
1894 build_string ("black"), "Foreground", 0, string);
1895 x_default_parameter (f, parms, Qmouse_color,
1896 build_string ("black"), "Mouse", 0, string);
1897 x_default_parameter (f, parms, Qcursor_color,
1898 build_string ("black"), "Cursor", 0, string);
1899 x_default_parameter (f, parms, Qborder_width,
1900 make_number (2), "BorderWidth", 0, number);
1901 x_default_parameter (f, parms, Qinternal_border_width,
1902 make_number (4), "InternalBorderWidth", 0, number);
1903 x_default_parameter (f, parms, Qauto_raise,
1904 Qnil, "AutoRaise", 0, boolean);
1906 hscroll = EQ (x_get_arg (parms, Qhorizontal_scroll_bar, 0, 0, boolean), Qt);
1907 vscroll = EQ (x_get_arg (parms, Qvertical_scroll_bar, 0, 0, boolean), Qt);
1909 if (f->display.x->internal_border_width < 0)
1910 f->display.x->internal_border_width = 0;
1912 tem = x_get_arg (parms, Qwindow_id, 0, 0, number);
1913 if (!EQ (tem, Qunbound))
1915 WINDOWINFO_TYPE wininfo;
1916 int nchildren;
1917 Window *children, root;
1919 CHECK_NUMBER (tem, 0);
1920 FRAME_X_WINDOW (f) = (Window) XINT (tem);
1922 BLOCK_INPUT;
1923 XGetWindowInfo (FRAME_X_WINDOW (f), &wininfo);
1924 XQueryTree (FRAME_X_WINDOW (f), &parent, &nchildren, &children);
1925 xfree (children);
1926 UNBLOCK_INPUT;
1928 height = PIXEL_TO_CHAR_HEIGHT (f, wininfo.height);
1929 width = PIXEL_TO_CHAR_WIDTH (f, wininfo.width);
1930 f->display.x->left_pos = wininfo.x;
1931 f->display.x->top_pos = wininfo.y;
1932 FRAME_SET_VISIBILITY (f, wininfo.mapped != 0);
1933 f->display.x->border_width = wininfo.bdrwidth;
1934 f->display.x->parent_desc = parent;
1936 else
1938 tem = x_get_arg (parms, Qparent_id, 0, 0, number);
1939 if (!EQ (tem, Qunbound))
1941 CHECK_NUMBER (tem, 0);
1942 parent = (Window) XINT (tem);
1944 f->display.x->parent_desc = parent;
1945 tem = x_get_arg (parms, Qheight, 0, 0, number);
1946 if (EQ (tem, Qunbound))
1948 tem = x_get_arg (parms, Qwidth, 0, 0, number);
1949 if (EQ (tem, Qunbound))
1951 tem = x_get_arg (parms, Qtop, 0, 0, number);
1952 if (EQ (tem, Qunbound))
1953 tem = x_get_arg (parms, Qleft, 0, 0, number);
1956 /* Now TEM is Qunbound if no edge or size was specified.
1957 In that case, we must do rubber-banding. */
1958 if (EQ (tem, Qunbound))
1960 tem = x_get_arg (parms, Qgeometry, 0, 0, number);
1961 x_rubber_band (f,
1962 &f->display.x->left_pos, &f->display.x->top_pos,
1963 &width, &height,
1964 (XTYPE (tem) == Lisp_String
1965 ? (char *) XSTRING (tem)->data : ""),
1966 XSTRING (f->name)->data,
1967 !NILP (hscroll), !NILP (vscroll));
1969 else
1971 /* Here if at least one edge or size was specified.
1972 Demand that they all were specified, and use them. */
1973 tem = x_get_arg (parms, Qheight, 0, 0, number);
1974 if (EQ (tem, Qunbound))
1975 error ("Height not specified");
1976 CHECK_NUMBER (tem, 0);
1977 height = XINT (tem);
1979 tem = x_get_arg (parms, Qwidth, 0, 0, number);
1980 if (EQ (tem, Qunbound))
1981 error ("Width not specified");
1982 CHECK_NUMBER (tem, 0);
1983 width = XINT (tem);
1985 tem = x_get_arg (parms, Qtop, 0, 0, number);
1986 if (EQ (tem, Qunbound))
1987 error ("Top position not specified");
1988 CHECK_NUMBER (tem, 0);
1989 f->display.x->left_pos = XINT (tem);
1991 tem = x_get_arg (parms, Qleft, 0, 0, number);
1992 if (EQ (tem, Qunbound))
1993 error ("Left position not specified");
1994 CHECK_NUMBER (tem, 0);
1995 f->display.x->top_pos = XINT (tem);
1998 pixelwidth = CHAR_TO_PIXEL_WIDTH (f, width);
1999 pixelheight = CHAR_TO_PIXEL_HEIGHT (f, height);
2001 BLOCK_INPUT;
2002 FRAME_X_WINDOW (f)
2003 = XCreateWindow (parent,
2004 f->display.x->left_pos, /* Absolute horizontal offset */
2005 f->display.x->top_pos, /* Absolute Vertical offset */
2006 pixelwidth, pixelheight,
2007 f->display.x->border_width,
2008 BLACK_PIX_DEFAULT, WHITE_PIX_DEFAULT);
2009 UNBLOCK_INPUT;
2010 if (FRAME_X_WINDOW (f) == 0)
2011 error ("Unable to create window.");
2014 /* Install the now determined height and width
2015 in the windows and in phys_lines and desired_lines. */
2016 change_frame_size (f, height, width, 1, 0);
2017 XSelectInput (FRAME_X_WINDOW (f), KeyPressed | ExposeWindow
2018 | ButtonPressed | ButtonReleased | ExposeRegion | ExposeCopy
2019 | EnterWindow | LeaveWindow | UnmapWindow );
2020 x_set_resize_hint (f);
2022 /* Tell the server the window's default name. */
2023 XStoreName (XDISPLAY FRAME_X_WINDOW (f), XSTRING (f->name)->data);
2025 /* Now override the defaults with all the rest of the specified
2026 parms. */
2027 tem = x_get_arg (parms, Qunsplittable, 0, 0, boolean);
2028 f->no_split = minibuffer_only || EQ (tem, Qt);
2030 /* Do not create an icon window if the caller says not to */
2031 if (!EQ (x_get_arg (parms, Qsuppress_icon, 0, 0, boolean), Qt)
2032 || f->display.x->parent_desc != ROOT_WINDOW)
2034 x_text_icon (f, iconidentity);
2035 x_default_parameter (f, parms, Qicon_type, Qnil,
2036 "BitmapIcon", 0, symbol);
2039 /* Tell the X server the previously set values of the
2040 background, border and mouse colors; also create the mouse cursor. */
2041 BLOCK_INPUT;
2042 temp = XMakeTile (f->display.x->background_pixel);
2043 XChangeBackground (FRAME_X_WINDOW (f), temp);
2044 XFreePixmap (temp);
2045 UNBLOCK_INPUT;
2046 x_set_border_pixel (f, f->display.x->border_pixel);
2048 x_set_mouse_color (f, Qnil, Qnil);
2050 /* Now override the defaults with all the rest of the specified parms. */
2052 Fmodify_frame_parameters (frame, parms);
2054 /* Make the window appear on the frame and enable display. */
2056 Lisp_Object visibility = x_get_arg (parms, Qvisibility, 0, 0, symbol);
2058 if (EQ (visibility, Qunbound))
2059 visibility = Qt;
2061 if (! EQ (visibility, Qicon)
2062 && ! NILP (visibility))
2063 x_make_window_visible (f);
2066 SET_FRAME_GARBAGED (f);
2068 return frame;
2069 #endif /* X10 */
2072 DEFUN ("focus-frame", Ffocus_frame, Sfocus_frame, 1, 1, 0,
2073 "Set the focus on FRAME.")
2074 (frame)
2075 Lisp_Object frame;
2077 CHECK_LIVE_FRAME (frame, 0);
2079 if (FRAME_X_P (XFRAME (frame)))
2081 BLOCK_INPUT;
2082 x_focus_on_frame (XFRAME (frame));
2083 UNBLOCK_INPUT;
2084 return frame;
2087 return Qnil;
2090 DEFUN ("unfocus-frame", Funfocus_frame, Sunfocus_frame, 0, 0, 0,
2091 "If a frame has been focused, release it.")
2094 if (x_focus_frame)
2096 BLOCK_INPUT;
2097 x_unfocus_frame (x_focus_frame);
2098 UNBLOCK_INPUT;
2101 return Qnil;
2104 #ifndef HAVE_X11
2105 /* Computes an X-window size and position either from geometry GEO
2106 or with the mouse.
2108 F is a frame. It specifies an X window which is used to
2109 determine which display to compute for. Its font, borders
2110 and colors control how the rectangle will be displayed.
2112 X and Y are where to store the positions chosen.
2113 WIDTH and HEIGHT are where to store the sizes chosen.
2115 GEO is the geometry that may specify some of the info.
2116 STR is a prompt to display.
2117 HSCROLL and VSCROLL say whether we have horiz and vert scroll bars. */
2120 x_rubber_band (f, x, y, width, height, geo, str, hscroll, vscroll)
2121 struct frame *f;
2122 int *x, *y, *width, *height;
2123 char *geo;
2124 char *str;
2125 int hscroll, vscroll;
2127 OpaqueFrame frame;
2128 Window tempwindow;
2129 WindowInfo wininfo;
2130 int border_color;
2131 int background_color;
2132 Lisp_Object tem;
2133 int mask;
2135 BLOCK_INPUT;
2137 background_color = f->display.x->background_pixel;
2138 border_color = f->display.x->border_pixel;
2140 frame.bdrwidth = f->display.x->border_width;
2141 frame.border = XMakeTile (border_color);
2142 frame.background = XMakeTile (background_color);
2143 tempwindow = XCreateTerm (str, "emacs", geo, default_window, &frame, 10, 5,
2144 (2 * f->display.x->internal_border_width
2145 + (vscroll ? VSCROLL_WIDTH : 0)),
2146 (2 * f->display.x->internal_border_width
2147 + (hscroll ? HSCROLL_HEIGHT : 0)),
2148 width, height, f->display.x->font,
2149 FONT_WIDTH (f->display.x->font),
2150 FONT_HEIGHT (f->display.x->font));
2151 XFreePixmap (frame.border);
2152 XFreePixmap (frame.background);
2154 if (tempwindow != 0)
2156 XQueryWindow (tempwindow, &wininfo);
2157 XDestroyWindow (tempwindow);
2158 *x = wininfo.x;
2159 *y = wininfo.y;
2162 /* Coordinates we got are relative to the root window.
2163 Convert them to coordinates relative to desired parent window
2164 by scanning from there up to the root. */
2165 tempwindow = f->display.x->parent_desc;
2166 while (tempwindow != ROOT_WINDOW)
2168 int nchildren;
2169 Window *children;
2170 XQueryWindow (tempwindow, &wininfo);
2171 *x -= wininfo.x;
2172 *y -= wininfo.y;
2173 XQueryTree (tempwindow, &tempwindow, &nchildren, &children);
2174 xfree (children);
2177 UNBLOCK_INPUT;
2178 return tempwindow != 0;
2180 #endif /* not HAVE_X11 */
2182 DEFUN ("x-list-fonts", Fx_list_fonts, Sx_list_fonts, 1, 3, 0,
2183 "Return a list of the names of available fonts matching PATTERN.\n\
2184 If optional arguments FACE and FRAME are specified, return only fonts\n\
2185 the same size as FACE on FRAME.\n\
2187 PATTERN is a string, perhaps with wildcard characters;\n\
2188 the * character matches any substring, and\n\
2189 the ? character matches any single character.\n\
2190 PATTERN is case-insensitive.\n\
2191 FACE is a face name - a symbol.\n\
2193 The return value is a list of strings, suitable as arguments to\n\
2194 set-face-font.\n\
2196 The list does not include fonts Emacs can't use (i.e. proportional\n\
2197 fonts), even if they match PATTERN and FACE.")
2198 (pattern, face, frame)
2199 Lisp_Object pattern, face, frame;
2201 int num_fonts;
2202 char **names;
2203 XFontStruct *info;
2204 XFontStruct *size_ref;
2205 Lisp_Object list;
2207 CHECK_STRING (pattern, 0);
2208 if (!NILP (face))
2209 CHECK_SYMBOL (face, 1);
2210 if (!NILP (frame))
2211 CHECK_LIVE_FRAME (frame, 2);
2213 if (NILP (face))
2214 size_ref = 0;
2215 else
2217 FRAME_PTR f = NILP (frame) ? selected_frame : XFRAME (frame);
2218 int face_id = face_name_id_number (f, face);
2220 if (face_id < 0 || face_id >= FRAME_N_PARAM_FACES (f)
2221 || FRAME_PARAM_FACES (f) [face_id] == 0)
2222 size_ref = f->display.x->font;
2223 else
2225 size_ref = FRAME_PARAM_FACES (f) [face_id]->font;
2226 if (size_ref == (XFontStruct *) (~0))
2227 size_ref = f->display.x->font;
2231 BLOCK_INPUT;
2232 names = XListFontsWithInfo (x_current_display,
2233 XSTRING (pattern)->data,
2234 2000, /* maxnames */
2235 &num_fonts, /* count_return */
2236 &info); /* info_return */
2237 UNBLOCK_INPUT;
2239 list = Qnil;
2241 if (names)
2243 Lisp_Object *tail;
2244 int i;
2246 tail = &list;
2247 for (i = 0; i < num_fonts; i++)
2248 if (! size_ref
2249 || same_size_fonts (&info[i], size_ref))
2251 *tail = Fcons (build_string (names[i]), Qnil);
2252 tail = &XCONS (*tail)->cdr;
2255 XFreeFontInfo (names, info, num_fonts);
2258 return list;
2262 DEFUN ("x-color-defined-p", Fx_color_defined_p, Sx_color_defined_p, 1, 1, 0,
2263 "Return t if the current X display supports the color named COLOR.")
2264 (color)
2265 Lisp_Object color;
2267 Color foo;
2269 check_x ();
2270 CHECK_STRING (color, 0);
2272 if (defined_color (XSTRING (color)->data, &foo))
2273 return Qt;
2274 else
2275 return Qnil;
2278 DEFUN ("x-display-color-p", Fx_display_color_p, Sx_display_color_p, 0, 0, 0,
2279 "Return t if the X screen currently in use supports color.")
2282 check_x ();
2284 if (x_screen_planes <= 2)
2285 return Qnil;
2287 switch (screen_visual->class)
2289 case StaticColor:
2290 case PseudoColor:
2291 case TrueColor:
2292 case DirectColor:
2293 return Qt;
2295 default:
2296 return Qnil;
2300 DEFUN ("x-display-pixel-width", Fx_display_pixel_width, Sx_display_pixel_width,
2301 0, 1, 0,
2302 "Returns the width in pixels of the display FRAME is on.")
2303 (frame)
2304 Lisp_Object frame;
2306 Display *dpy = x_current_display;
2307 check_x ();
2308 return make_number (DisplayWidth (dpy, DefaultScreen (dpy)));
2311 DEFUN ("x-display-pixel-height", Fx_display_pixel_height,
2312 Sx_display_pixel_height, 0, 1, 0,
2313 "Returns the height in pixels of the display FRAME is on.")
2314 (frame)
2315 Lisp_Object frame;
2317 Display *dpy = x_current_display;
2318 check_x ();
2319 return make_number (DisplayHeight (dpy, DefaultScreen (dpy)));
2322 DEFUN ("x-display-planes", Fx_display_planes, Sx_display_planes,
2323 0, 1, 0,
2324 "Returns the number of bitplanes of the display FRAME is on.")
2325 (frame)
2326 Lisp_Object frame;
2328 Display *dpy = x_current_display;
2329 check_x ();
2330 return make_number (DisplayPlanes (dpy, DefaultScreen (dpy)));
2333 DEFUN ("x-display-color-cells", Fx_display_color_cells, Sx_display_color_cells,
2334 0, 1, 0,
2335 "Returns the number of color cells of the display FRAME is on.")
2336 (frame)
2337 Lisp_Object frame;
2339 Display *dpy = x_current_display;
2340 check_x ();
2341 return make_number (DisplayCells (dpy, DefaultScreen (dpy)));
2344 DEFUN ("x-server-vendor", Fx_server_vendor, Sx_server_vendor, 0, 1, 0,
2345 "Returns the vendor ID string of the X server FRAME is on.")
2346 (frame)
2347 Lisp_Object frame;
2349 Display *dpy = x_current_display;
2350 char *vendor;
2351 check_x ();
2352 vendor = ServerVendor (dpy);
2353 if (! vendor) vendor = "";
2354 return build_string (vendor);
2357 DEFUN ("x-server-version", Fx_server_version, Sx_server_version, 0, 1, 0,
2358 "Returns the version numbers of the X server in use.\n\
2359 The value is a list of three integers: the major and minor\n\
2360 version numbers of the X Protocol in use, and the vendor-specific release\n\
2361 number. See also the variable `x-server-vendor'.")
2362 (frame)
2363 Lisp_Object frame;
2365 Display *dpy = x_current_display;
2367 check_x ();
2368 return Fcons (make_number (ProtocolVersion (dpy)),
2369 Fcons (make_number (ProtocolRevision (dpy)),
2370 Fcons (make_number (VendorRelease (dpy)), Qnil)));
2373 DEFUN ("x-display-screens", Fx_display_screens, Sx_display_screens, 0, 1, 0,
2374 "Returns the number of screens on the X server FRAME is on.")
2375 (frame)
2376 Lisp_Object frame;
2378 check_x ();
2379 return make_number (ScreenCount (x_current_display));
2382 DEFUN ("x-display-mm-height", Fx_display_mm_height, Sx_display_mm_height, 0, 1, 0,
2383 "Returns the height in millimeters of the X screen FRAME is on.")
2384 (frame)
2385 Lisp_Object frame;
2387 check_x ();
2388 return make_number (HeightMMOfScreen (x_screen));
2391 DEFUN ("x-display-mm-width", Fx_display_mm_width, Sx_display_mm_width, 0, 1, 0,
2392 "Returns the width in millimeters of the X screen FRAME is on.")
2393 (frame)
2394 Lisp_Object frame;
2396 check_x ();
2397 return make_number (WidthMMOfScreen (x_screen));
2400 DEFUN ("x-display-backing-store", Fx_display_backing_store,
2401 Sx_display_backing_store, 0, 1, 0,
2402 "Returns an indication of whether the X screen FRAME is on does backing store.\n\
2403 The value may be `always', `when-mapped', or `not-useful'.")
2404 (frame)
2405 Lisp_Object frame;
2407 check_x ();
2409 switch (DoesBackingStore (x_screen))
2411 case Always:
2412 return intern ("always");
2414 case WhenMapped:
2415 return intern ("when-mapped");
2417 case NotUseful:
2418 return intern ("not-useful");
2420 default:
2421 error ("Strange value for BackingStore parameter of screen");
2425 DEFUN ("x-display-visual-class", Fx_display_visual_class,
2426 Sx_display_visual_class, 0, 1, 0,
2427 "Returns the visual class of the display `screen' is on.\n\
2428 The value is one of the symbols `static-gray', `gray-scale',\n\
2429 `static-color', `pseudo-color', `true-color', or `direct-color'.")
2430 (screen)
2431 Lisp_Object screen;
2433 check_x ();
2435 switch (screen_visual->class)
2437 case StaticGray: return (intern ("static-gray"));
2438 case GrayScale: return (intern ("gray-scale"));
2439 case StaticColor: return (intern ("static-color"));
2440 case PseudoColor: return (intern ("pseudo-color"));
2441 case TrueColor: return (intern ("true-color"));
2442 case DirectColor: return (intern ("direct-color"));
2443 default:
2444 error ("Display has an unknown visual class");
2448 DEFUN ("x-display-save-under", Fx_display_save_under,
2449 Sx_display_save_under, 0, 1, 0,
2450 "Returns t if the X screen FRAME is on supports the save-under feature.")
2451 (frame)
2452 Lisp_Object frame;
2454 check_x ();
2456 if (DoesSaveUnders (x_screen) == True)
2457 return Qt;
2458 else
2459 return Qnil;
2462 x_pixel_width (f)
2463 register struct frame *f;
2465 return PIXEL_WIDTH (f);
2468 x_pixel_height (f)
2469 register struct frame *f;
2471 return PIXEL_HEIGHT (f);
2474 x_char_width (f)
2475 register struct frame *f;
2477 return FONT_WIDTH (f->display.x->font);
2480 x_char_height (f)
2481 register struct frame *f;
2483 return FONT_HEIGHT (f->display.x->font);
2486 #if 0 /* These no longer seem like the right way to do things. */
2488 /* Draw a rectangle on the frame with left top corner including
2489 the character specified by LEFT_CHAR and TOP_CHAR. The rectangle is
2490 CHARS by LINES wide and long and is the color of the cursor. */
2492 void
2493 x_rectangle (f, gc, left_char, top_char, chars, lines)
2494 register struct frame *f;
2495 GC gc;
2496 register int top_char, left_char, chars, lines;
2498 int width;
2499 int height;
2500 int left = (left_char * FONT_WIDTH (f->display.x->font)
2501 + f->display.x->internal_border_width);
2502 int top = (top_char * FONT_HEIGHT (f->display.x->font)
2503 + f->display.x->internal_border_width);
2505 if (chars < 0)
2506 width = FONT_WIDTH (f->display.x->font) / 2;
2507 else
2508 width = FONT_WIDTH (f->display.x->font) * chars;
2509 if (lines < 0)
2510 height = FONT_HEIGHT (f->display.x->font) / 2;
2511 else
2512 height = FONT_HEIGHT (f->display.x->font) * lines;
2514 XDrawRectangle (x_current_display, FRAME_X_WINDOW (f),
2515 gc, left, top, width, height);
2518 DEFUN ("x-draw-rectangle", Fx_draw_rectangle, Sx_draw_rectangle, 5, 5, 0,
2519 "Draw a rectangle on FRAME between coordinates specified by\n\
2520 numbers X0, Y0, X1, Y1 in the cursor pixel.")
2521 (frame, X0, Y0, X1, Y1)
2522 register Lisp_Object frame, X0, X1, Y0, Y1;
2524 register int x0, y0, x1, y1, top, left, n_chars, n_lines;
2526 CHECK_LIVE_FRAME (frame, 0);
2527 CHECK_NUMBER (X0, 0);
2528 CHECK_NUMBER (Y0, 1);
2529 CHECK_NUMBER (X1, 2);
2530 CHECK_NUMBER (Y1, 3);
2532 x0 = XINT (X0);
2533 x1 = XINT (X1);
2534 y0 = XINT (Y0);
2535 y1 = XINT (Y1);
2537 if (y1 > y0)
2539 top = y0;
2540 n_lines = y1 - y0 + 1;
2542 else
2544 top = y1;
2545 n_lines = y0 - y1 + 1;
2548 if (x1 > x0)
2550 left = x0;
2551 n_chars = x1 - x0 + 1;
2553 else
2555 left = x1;
2556 n_chars = x0 - x1 + 1;
2559 BLOCK_INPUT;
2560 x_rectangle (XFRAME (frame), XFRAME (frame)->display.x->cursor_gc,
2561 left, top, n_chars, n_lines);
2562 UNBLOCK_INPUT;
2564 return Qt;
2567 DEFUN ("x-erase-rectangle", Fx_erase_rectangle, Sx_erase_rectangle, 5, 5, 0,
2568 "Draw a rectangle drawn on FRAME between coordinates\n\
2569 X0, Y0, X1, Y1 in the regular background-pixel.")
2570 (frame, X0, Y0, X1, Y1)
2571 register Lisp_Object frame, X0, Y0, X1, Y1;
2573 register int x0, y0, x1, y1, top, left, n_chars, n_lines;
2575 CHECK_FRAME (frame, 0);
2576 CHECK_NUMBER (X0, 0);
2577 CHECK_NUMBER (Y0, 1);
2578 CHECK_NUMBER (X1, 2);
2579 CHECK_NUMBER (Y1, 3);
2581 x0 = XINT (X0);
2582 x1 = XINT (X1);
2583 y0 = XINT (Y0);
2584 y1 = XINT (Y1);
2586 if (y1 > y0)
2588 top = y0;
2589 n_lines = y1 - y0 + 1;
2591 else
2593 top = y1;
2594 n_lines = y0 - y1 + 1;
2597 if (x1 > x0)
2599 left = x0;
2600 n_chars = x1 - x0 + 1;
2602 else
2604 left = x1;
2605 n_chars = x0 - x1 + 1;
2608 BLOCK_INPUT;
2609 x_rectangle (XFRAME (frame), XFRAME (frame)->display.x->reverse_gc,
2610 left, top, n_chars, n_lines);
2611 UNBLOCK_INPUT;
2613 return Qt;
2616 /* Draw lines around the text region beginning at the character position
2617 TOP_X, TOP_Y and ending at BOTTOM_X and BOTTOM_Y. GC specifies the
2618 pixel and line characteristics. */
2620 #define line_len(line) (FRAME_CURRENT_GLYPHS (f)->used[(line)])
2622 static void
2623 outline_region (f, gc, top_x, top_y, bottom_x, bottom_y)
2624 register struct frame *f;
2625 GC gc;
2626 int top_x, top_y, bottom_x, bottom_y;
2628 register int ibw = f->display.x->internal_border_width;
2629 register int font_w = FONT_WIDTH (f->display.x->font);
2630 register int font_h = FONT_HEIGHT (f->display.x->font);
2631 int y = top_y;
2632 int x = line_len (y);
2633 XPoint *pixel_points = (XPoint *)
2634 alloca (((bottom_y - top_y + 2) * 4) * sizeof (XPoint));
2635 register XPoint *this_point = pixel_points;
2637 /* Do the horizontal top line/lines */
2638 if (top_x == 0)
2640 this_point->x = ibw;
2641 this_point->y = ibw + (font_h * top_y);
2642 this_point++;
2643 if (x == 0)
2644 this_point->x = ibw + (font_w / 2); /* Half-size for newline chars. */
2645 else
2646 this_point->x = ibw + (font_w * x);
2647 this_point->y = (this_point - 1)->y;
2649 else
2651 this_point->x = ibw;
2652 this_point->y = ibw + (font_h * (top_y + 1));
2653 this_point++;
2654 this_point->x = ibw + (font_w * top_x);
2655 this_point->y = (this_point - 1)->y;
2656 this_point++;
2657 this_point->x = (this_point - 1)->x;
2658 this_point->y = ibw + (font_h * top_y);
2659 this_point++;
2660 this_point->x = ibw + (font_w * x);
2661 this_point->y = (this_point - 1)->y;
2664 /* Now do the right side. */
2665 while (y < bottom_y)
2666 { /* Right vertical edge */
2667 this_point++;
2668 this_point->x = (this_point - 1)->x;
2669 this_point->y = ibw + (font_h * (y + 1));
2670 this_point++;
2672 y++; /* Horizontal connection to next line */
2673 x = line_len (y);
2674 if (x == 0)
2675 this_point->x = ibw + (font_w / 2);
2676 else
2677 this_point->x = ibw + (font_w * x);
2679 this_point->y = (this_point - 1)->y;
2682 /* Now do the bottom and connect to the top left point. */
2683 this_point->x = ibw + (font_w * (bottom_x + 1));
2685 this_point++;
2686 this_point->x = (this_point - 1)->x;
2687 this_point->y = ibw + (font_h * (bottom_y + 1));
2688 this_point++;
2689 this_point->x = ibw;
2690 this_point->y = (this_point - 1)->y;
2691 this_point++;
2692 this_point->x = pixel_points->x;
2693 this_point->y = pixel_points->y;
2695 XDrawLines (x_current_display, FRAME_X_WINDOW (f),
2696 gc, pixel_points,
2697 (this_point - pixel_points + 1), CoordModeOrigin);
2700 DEFUN ("x-contour-region", Fx_contour_region, Sx_contour_region, 1, 1, 0,
2701 "Highlight the region between point and the character under the mouse\n\
2702 selected frame.")
2703 (event)
2704 register Lisp_Object event;
2706 register int x0, y0, x1, y1;
2707 register struct frame *f = selected_frame;
2708 register int p1, p2;
2710 CHECK_CONS (event, 0);
2712 BLOCK_INPUT;
2713 x0 = XINT (Fcar (Fcar (event)));
2714 y0 = XINT (Fcar (Fcdr (Fcar (event))));
2716 /* If the mouse is past the end of the line, don't that area. */
2717 /* ReWrite this... */
2719 x1 = f->cursor_x;
2720 y1 = f->cursor_y;
2722 if (y1 > y0) /* point below mouse */
2723 outline_region (f, f->display.x->cursor_gc,
2724 x0, y0, x1, y1);
2725 else if (y1 < y0) /* point above mouse */
2726 outline_region (f, f->display.x->cursor_gc,
2727 x1, y1, x0, y0);
2728 else /* same line: draw horizontal rectangle */
2730 if (x1 > x0)
2731 x_rectangle (f, f->display.x->cursor_gc,
2732 x0, y0, (x1 - x0 + 1), 1);
2733 else if (x1 < x0)
2734 x_rectangle (f, f->display.x->cursor_gc,
2735 x1, y1, (x0 - x1 + 1), 1);
2738 XFlush (x_current_display);
2739 UNBLOCK_INPUT;
2741 return Qnil;
2744 DEFUN ("x-uncontour-region", Fx_uncontour_region, Sx_uncontour_region, 1, 1, 0,
2745 "Erase any highlighting of the region between point and the character\n\
2746 at X, Y on the selected frame.")
2747 (event)
2748 register Lisp_Object event;
2750 register int x0, y0, x1, y1;
2751 register struct frame *f = selected_frame;
2753 BLOCK_INPUT;
2754 x0 = XINT (Fcar (Fcar (event)));
2755 y0 = XINT (Fcar (Fcdr (Fcar (event))));
2756 x1 = f->cursor_x;
2757 y1 = f->cursor_y;
2759 if (y1 > y0) /* point below mouse */
2760 outline_region (f, f->display.x->reverse_gc,
2761 x0, y0, x1, y1);
2762 else if (y1 < y0) /* point above mouse */
2763 outline_region (f, f->display.x->reverse_gc,
2764 x1, y1, x0, y0);
2765 else /* same line: draw horizontal rectangle */
2767 if (x1 > x0)
2768 x_rectangle (f, f->display.x->reverse_gc,
2769 x0, y0, (x1 - x0 + 1), 1);
2770 else if (x1 < x0)
2771 x_rectangle (f, f->display.x->reverse_gc,
2772 x1, y1, (x0 - x1 + 1), 1);
2774 UNBLOCK_INPUT;
2776 return Qnil;
2779 #if 0
2780 int contour_begin_x, contour_begin_y;
2781 int contour_end_x, contour_end_y;
2782 int contour_npoints;
2784 /* Clip the top part of the contour lines down (and including) line Y_POS.
2785 If X_POS is in the middle (rather than at the end) of the line, drop
2786 down a line at that character. */
2788 static void
2789 clip_contour_top (y_pos, x_pos)
2791 register XPoint *begin = contour_lines[y_pos].top_left;
2792 register XPoint *end;
2793 register int npoints;
2794 register struct display_line *line = selected_frame->phys_lines[y_pos + 1];
2796 if (x_pos >= line->len - 1) /* Draw one, straight horizontal line. */
2798 end = contour_lines[y_pos].top_right;
2799 npoints = (end - begin + 1);
2800 XDrawLines (x_current_display, contour_window,
2801 contour_erase_gc, begin_erase, npoints, CoordModeOrigin);
2803 bcopy (end, begin + 1, contour_last_point - end + 1);
2804 contour_last_point -= (npoints - 2);
2805 XDrawLines (x_current_display, contour_window,
2806 contour_erase_gc, begin, 2, CoordModeOrigin);
2807 XFlush (x_current_display);
2809 /* Now, update contour_lines structure. */
2811 /* ______. */
2812 else /* |________*/
2814 register XPoint *p = begin + 1;
2815 end = contour_lines[y_pos].bottom_right;
2816 npoints = (end - begin + 1);
2817 XDrawLines (x_current_display, contour_window,
2818 contour_erase_gc, begin_erase, npoints, CoordModeOrigin);
2820 p->y = begin->y;
2821 p->x = ibw + (font_w * (x_pos + 1));
2822 p++;
2823 p->y = begin->y + font_h;
2824 p->x = (p - 1)->x;
2825 bcopy (end, begin + 3, contour_last_point - end + 1);
2826 contour_last_point -= (npoints - 5);
2827 XDrawLines (x_current_display, contour_window,
2828 contour_erase_gc, begin, 4, CoordModeOrigin);
2829 XFlush (x_current_display);
2831 /* Now, update contour_lines structure. */
2835 /* Erase the top horizontal lines of the contour, and then extend
2836 the contour upwards. */
2838 static void
2839 extend_contour_top (line)
2843 static void
2844 clip_contour_bottom (x_pos, y_pos)
2845 int x_pos, y_pos;
2849 static void
2850 extend_contour_bottom (x_pos, y_pos)
2854 DEFUN ("x-select-region", Fx_select_region, Sx_select_region, 1, 1, "e",
2856 (event)
2857 Lisp_Object event;
2859 register struct frame *f = selected_frame;
2860 register int point_x = f->cursor_x;
2861 register int point_y = f->cursor_y;
2862 register int mouse_below_point;
2863 register Lisp_Object obj;
2864 register int x_contour_x, x_contour_y;
2866 x_contour_x = x_mouse_x;
2867 x_contour_y = x_mouse_y;
2868 if (x_contour_y > point_y || (x_contour_y == point_y
2869 && x_contour_x > point_x))
2871 mouse_below_point = 1;
2872 outline_region (f, f->display.x->cursor_gc, point_x, point_y,
2873 x_contour_x, x_contour_y);
2875 else
2877 mouse_below_point = 0;
2878 outline_region (f, f->display.x->cursor_gc, x_contour_x, x_contour_y,
2879 point_x, point_y);
2882 while (1)
2884 obj = read_char (-1, 0, 0, Qnil, 0);
2885 if (XTYPE (obj) != Lisp_Cons)
2886 break;
2888 if (mouse_below_point)
2890 if (x_mouse_y <= point_y) /* Flipped. */
2892 mouse_below_point = 0;
2894 outline_region (f, f->display.x->reverse_gc, point_x, point_y,
2895 x_contour_x, x_contour_y);
2896 outline_region (f, f->display.x->cursor_gc, x_mouse_x, x_mouse_y,
2897 point_x, point_y);
2899 else if (x_mouse_y < x_contour_y) /* Bottom clipped. */
2901 clip_contour_bottom (x_mouse_y);
2903 else if (x_mouse_y > x_contour_y) /* Bottom extended. */
2905 extend_bottom_contour (x_mouse_y);
2908 x_contour_x = x_mouse_x;
2909 x_contour_y = x_mouse_y;
2911 else /* mouse above or same line as point */
2913 if (x_mouse_y >= point_y) /* Flipped. */
2915 mouse_below_point = 1;
2917 outline_region (f, f->display.x->reverse_gc,
2918 x_contour_x, x_contour_y, point_x, point_y);
2919 outline_region (f, f->display.x->cursor_gc, point_x, point_y,
2920 x_mouse_x, x_mouse_y);
2922 else if (x_mouse_y > x_contour_y) /* Top clipped. */
2924 clip_contour_top (x_mouse_y);
2926 else if (x_mouse_y < x_contour_y) /* Top extended. */
2928 extend_contour_top (x_mouse_y);
2933 unread_command_event = obj;
2934 if (mouse_below_point)
2936 contour_begin_x = point_x;
2937 contour_begin_y = point_y;
2938 contour_end_x = x_contour_x;
2939 contour_end_y = x_contour_y;
2941 else
2943 contour_begin_x = x_contour_x;
2944 contour_begin_y = x_contour_y;
2945 contour_end_x = point_x;
2946 contour_end_y = point_y;
2949 #endif
2951 DEFUN ("x-horizontal-line", Fx_horizontal_line, Sx_horizontal_line, 1, 1, "e",
2953 (event)
2954 Lisp_Object event;
2956 register Lisp_Object obj;
2957 struct frame *f = selected_frame;
2958 register struct window *w = XWINDOW (selected_window);
2959 register GC line_gc = f->display.x->cursor_gc;
2960 register GC erase_gc = f->display.x->reverse_gc;
2961 #if 0
2962 char dash_list[] = {6, 4, 6, 4};
2963 int dashes = 4;
2964 XGCValues gc_values;
2965 #endif
2966 register int previous_y;
2967 register int line = (x_mouse_y + 1) * FONT_HEIGHT (f->display.x->font)
2968 + f->display.x->internal_border_width;
2969 register int left = f->display.x->internal_border_width
2970 + (w->left
2971 * FONT_WIDTH (f->display.x->font));
2972 register int right = left + (w->width
2973 * FONT_WIDTH (f->display.x->font))
2974 - f->display.x->internal_border_width;
2976 #if 0
2977 BLOCK_INPUT;
2978 gc_values.foreground = f->display.x->cursor_pixel;
2979 gc_values.background = f->display.x->background_pixel;
2980 gc_values.line_width = 1;
2981 gc_values.line_style = LineOnOffDash;
2982 gc_values.cap_style = CapRound;
2983 gc_values.join_style = JoinRound;
2985 line_gc = XCreateGC (x_current_display, FRAME_X_WINDOW (f),
2986 GCLineStyle | GCJoinStyle | GCCapStyle
2987 | GCLineWidth | GCForeground | GCBackground,
2988 &gc_values);
2989 XSetDashes (x_current_display, line_gc, 0, dash_list, dashes);
2990 gc_values.foreground = f->display.x->background_pixel;
2991 gc_values.background = f->display.x->foreground_pixel;
2992 erase_gc = XCreateGC (x_current_display, FRAME_X_WINDOW (f),
2993 GCLineStyle | GCJoinStyle | GCCapStyle
2994 | GCLineWidth | GCForeground | GCBackground,
2995 &gc_values);
2996 XSetDashes (x_current_display, erase_gc, 0, dash_list, dashes);
2997 #endif
2999 while (1)
3001 BLOCK_INPUT;
3002 if (x_mouse_y >= XINT (w->top)
3003 && x_mouse_y < XINT (w->top) + XINT (w->height) - 1)
3005 previous_y = x_mouse_y;
3006 line = (x_mouse_y + 1) * FONT_HEIGHT (f->display.x->font)
3007 + f->display.x->internal_border_width;
3008 XDrawLine (x_current_display, FRAME_X_WINDOW (f),
3009 line_gc, left, line, right, line);
3011 XFlushQueue ();
3012 UNBLOCK_INPUT;
3016 obj = read_char (-1, 0, 0, Qnil, 0);
3017 if ((XTYPE (obj) != Lisp_Cons)
3018 || (! EQ (Fcar (Fcdr (Fcdr (obj))),
3019 Qvertical_scroll_bar))
3020 || x_mouse_grabbed)
3022 BLOCK_INPUT;
3023 XDrawLine (x_current_display, FRAME_X_WINDOW (f),
3024 erase_gc, left, line, right, line);
3025 UNBLOCK_INPUT;
3026 unread_command_event = obj;
3027 #if 0
3028 XFreeGC (x_current_display, line_gc);
3029 XFreeGC (x_current_display, erase_gc);
3030 #endif
3031 return Qnil;
3034 while (x_mouse_y == previous_y);
3036 BLOCK_INPUT;
3037 XDrawLine (x_current_display, FRAME_X_WINDOW (f),
3038 erase_gc, left, line, right, line);
3039 UNBLOCK_INPUT;
3042 #endif
3044 /* Offset in buffer of character under the pointer, or 0. */
3045 int mouse_buffer_offset;
3047 #if 0
3048 /* These keep track of the rectangle following the pointer. */
3049 int mouse_track_top, mouse_track_left, mouse_track_width;
3051 DEFUN ("x-track-pointer", Fx_track_pointer, Sx_track_pointer, 0, 0, 0,
3052 "Track the pointer.")
3055 static Cursor current_pointer_shape;
3056 FRAME_PTR f = x_mouse_frame;
3058 BLOCK_INPUT;
3059 if (EQ (Vmouse_frame_part, Qtext_part)
3060 && (current_pointer_shape != f->display.x->nontext_cursor))
3062 unsigned char c;
3063 struct buffer *buf;
3065 current_pointer_shape = f->display.x->nontext_cursor;
3066 XDefineCursor (x_current_display,
3067 FRAME_X_WINDOW (f),
3068 current_pointer_shape);
3070 buf = XBUFFER (XWINDOW (Vmouse_window)->buffer);
3071 c = *(BUF_CHAR_ADDRESS (buf, mouse_buffer_offset));
3073 else if (EQ (Vmouse_frame_part, Qmodeline_part)
3074 && (current_pointer_shape != f->display.x->modeline_cursor))
3076 current_pointer_shape = f->display.x->modeline_cursor;
3077 XDefineCursor (x_current_display,
3078 FRAME_X_WINDOW (f),
3079 current_pointer_shape);
3082 XFlushQueue ();
3083 UNBLOCK_INPUT;
3085 #endif
3087 #if 0
3088 DEFUN ("x-track-pointer", Fx_track_pointer, Sx_track_pointer, 1, 1, "e",
3089 "Draw rectangle around character under mouse pointer, if there is one.")
3090 (event)
3091 Lisp_Object event;
3093 struct window *w = XWINDOW (Vmouse_window);
3094 struct frame *f = XFRAME (WINDOW_FRAME (w));
3095 struct buffer *b = XBUFFER (w->buffer);
3096 Lisp_Object obj;
3098 if (! EQ (Vmouse_window, selected_window))
3099 return Qnil;
3101 if (EQ (event, Qnil))
3103 int x, y;
3105 x_read_mouse_position (selected_frame, &x, &y);
3108 BLOCK_INPUT;
3109 mouse_track_width = 0;
3110 mouse_track_left = mouse_track_top = -1;
3114 if ((x_mouse_x != mouse_track_left
3115 && (x_mouse_x < mouse_track_left
3116 || x_mouse_x > (mouse_track_left + mouse_track_width)))
3117 || x_mouse_y != mouse_track_top)
3119 int hp = 0; /* Horizontal position */
3120 int len = FRAME_CURRENT_GLYPHS (f)->used[x_mouse_y];
3121 int p = FRAME_CURRENT_GLYPHS (f)->bufp[x_mouse_y];
3122 int tab_width = XINT (b->tab_width);
3123 int ctl_arrow_p = !NILP (b->ctl_arrow);
3124 unsigned char c;
3125 int mode_line_vpos = XFASTINT (w->height) + XFASTINT (w->top) - 1;
3126 int in_mode_line = 0;
3128 if (! FRAME_CURRENT_GLYPHS (f)->enable[x_mouse_y])
3129 break;
3131 /* Erase previous rectangle. */
3132 if (mouse_track_width)
3134 x_rectangle (f, f->display.x->reverse_gc,
3135 mouse_track_left, mouse_track_top,
3136 mouse_track_width, 1);
3138 if ((mouse_track_left == f->phys_cursor_x
3139 || mouse_track_left == f->phys_cursor_x - 1)
3140 && mouse_track_top == f->phys_cursor_y)
3142 x_display_cursor (f, 1);
3146 mouse_track_left = x_mouse_x;
3147 mouse_track_top = x_mouse_y;
3148 mouse_track_width = 0;
3150 if (mouse_track_left > len) /* Past the end of line. */
3151 goto draw_or_not;
3153 if (mouse_track_top == mode_line_vpos)
3155 in_mode_line = 1;
3156 goto draw_or_not;
3159 if (tab_width <= 0 || tab_width > 20) tab_width = 8;
3162 c = FETCH_CHAR (p);
3163 if (len == f->width && hp == len - 1 && c != '\n')
3164 goto draw_or_not;
3166 switch (c)
3168 case '\t':
3169 mouse_track_width = tab_width - (hp % tab_width);
3170 p++;
3171 hp += mouse_track_width;
3172 if (hp > x_mouse_x)
3174 mouse_track_left = hp - mouse_track_width;
3175 goto draw_or_not;
3177 continue;
3179 case '\n':
3180 mouse_track_width = -1;
3181 goto draw_or_not;
3183 default:
3184 if (ctl_arrow_p && (c < 040 || c == 0177))
3186 if (p > ZV)
3187 goto draw_or_not;
3189 mouse_track_width = 2;
3190 p++;
3191 hp +=2;
3192 if (hp > x_mouse_x)
3194 mouse_track_left = hp - mouse_track_width;
3195 goto draw_or_not;
3198 else
3200 mouse_track_width = 1;
3201 p++;
3202 hp++;
3204 continue;
3207 while (hp <= x_mouse_x);
3209 draw_or_not:
3210 if (mouse_track_width) /* Over text; use text pointer shape. */
3212 XDefineCursor (x_current_display,
3213 FRAME_X_WINDOW (f),
3214 f->display.x->text_cursor);
3215 x_rectangle (f, f->display.x->cursor_gc,
3216 mouse_track_left, mouse_track_top,
3217 mouse_track_width, 1);
3219 else if (in_mode_line)
3220 XDefineCursor (x_current_display,
3221 FRAME_X_WINDOW (f),
3222 f->display.x->modeline_cursor);
3223 else
3224 XDefineCursor (x_current_display,
3225 FRAME_X_WINDOW (f),
3226 f->display.x->nontext_cursor);
3229 XFlush (x_current_display);
3230 UNBLOCK_INPUT;
3232 obj = read_char (-1, 0, 0, Qnil, 0);
3233 BLOCK_INPUT;
3235 while (XTYPE (obj) == Lisp_Cons /* Mouse event */
3236 && EQ (Fcar (Fcdr (Fcdr (obj))), Qnil) /* Not scroll bar */
3237 && EQ (Vmouse_depressed, Qnil) /* Only motion events */
3238 && EQ (Vmouse_window, selected_window) /* In this window */
3239 && x_mouse_frame);
3241 unread_command_event = obj;
3243 if (mouse_track_width)
3245 x_rectangle (f, f->display.x->reverse_gc,
3246 mouse_track_left, mouse_track_top,
3247 mouse_track_width, 1);
3248 mouse_track_width = 0;
3249 if ((mouse_track_left == f->phys_cursor_x
3250 || mouse_track_left - 1 == f->phys_cursor_x)
3251 && mouse_track_top == f->phys_cursor_y)
3253 x_display_cursor (f, 1);
3256 XDefineCursor (x_current_display,
3257 FRAME_X_WINDOW (f),
3258 f->display.x->nontext_cursor);
3259 XFlush (x_current_display);
3260 UNBLOCK_INPUT;
3262 return Qnil;
3264 #endif
3266 #if 0
3267 #include "glyphs.h"
3269 /* Draw a pixmap specified by IMAGE_DATA of dimensions WIDTH and HEIGHT
3270 on the frame F at position X, Y. */
3272 x_draw_pixmap (f, x, y, image_data, width, height)
3273 struct frame *f;
3274 int x, y, width, height;
3275 char *image_data;
3277 Pixmap image;
3279 image = XCreateBitmapFromData (x_current_display,
3280 FRAME_X_WINDOW (f), image_data,
3281 width, height);
3282 XCopyPlane (x_current_display, image, FRAME_X_WINDOW (f),
3283 f->display.x->normal_gc, 0, 0, width, height, x, y);
3285 #endif
3287 #ifndef HAVE_X11
3288 DEFUN ("x-store-cut-buffer", Fx_store_cut_buffer, Sx_store_cut_buffer,
3289 1, 1, "sStore text in cut buffer: ",
3290 "Store contents of STRING into the cut buffer of the X window system.")
3291 (string)
3292 register Lisp_Object string;
3294 int mask;
3296 CHECK_STRING (string, 1);
3297 if (! FRAME_X_P (selected_frame))
3298 error ("Selected frame does not understand X protocol.");
3300 BLOCK_INPUT;
3301 XStoreBytes ((char *) XSTRING (string)->data, XSTRING (string)->size);
3302 UNBLOCK_INPUT;
3304 return Qnil;
3307 DEFUN ("x-get-cut-buffer", Fx_get_cut_buffer, Sx_get_cut_buffer, 0, 0, 0,
3308 "Return contents of cut buffer of the X window system, as a string.")
3311 int len;
3312 register Lisp_Object string;
3313 int mask;
3314 register char *d;
3316 BLOCK_INPUT;
3317 d = XFetchBytes (&len);
3318 string = make_string (d, len);
3319 XFree (d);
3320 UNBLOCK_INPUT;
3321 return string;
3323 #endif /* X10 */
3325 #ifdef HAVE_X11
3326 DEFUN ("x-rebind-key", Fx_rebind_key, Sx_rebind_key, 3, 3, 0,
3327 "Rebind X keysym KEYSYM, with MODIFIERS, to generate NEWSTRING.\n\
3328 KEYSYM is a string which conforms to the X keysym definitions found\n\
3329 in X11/keysymdef.h, sans the initial XK_. MODIFIERS is nil or a\n\
3330 list of strings specifying modifier keys such as Control_L, which must\n\
3331 also be depressed for NEWSTRING to appear.")
3332 (x_keysym, modifiers, newstring)
3333 register Lisp_Object x_keysym;
3334 register Lisp_Object modifiers;
3335 register Lisp_Object newstring;
3337 char *rawstring;
3338 register KeySym keysym;
3339 KeySym modifier_list[16];
3341 check_x ();
3342 CHECK_STRING (x_keysym, 1);
3343 CHECK_STRING (newstring, 3);
3345 keysym = XStringToKeysym ((char *) XSTRING (x_keysym)->data);
3346 if (keysym == NoSymbol)
3347 error ("Keysym does not exist");
3349 if (NILP (modifiers))
3350 XRebindKeysym (x_current_display, keysym, modifier_list, 0,
3351 XSTRING (newstring)->data, XSTRING (newstring)->size);
3352 else
3354 register Lisp_Object rest, mod;
3355 register int i = 0;
3357 for (rest = modifiers; !NILP (rest); rest = Fcdr (rest))
3359 if (i == 16)
3360 error ("Can't have more than 16 modifiers");
3362 mod = Fcar (rest);
3363 CHECK_STRING (mod, 3);
3364 modifier_list[i] = XStringToKeysym ((char *) XSTRING (mod)->data);
3365 #ifndef HAVE_X11R5
3366 if (modifier_list[i] == NoSymbol
3367 || !(IsModifierKey (modifier_list[i])
3368 || ((unsigned)(modifier_list[i]) == XK_Mode_switch)
3369 || ((unsigned)(modifier_list[i]) == XK_Num_Lock)))
3370 #else
3371 if (modifier_list[i] == NoSymbol
3372 || !IsModifierKey (modifier_list[i]))
3373 #endif
3374 error ("Element is not a modifier keysym");
3375 i++;
3378 XRebindKeysym (x_current_display, keysym, modifier_list, i,
3379 XSTRING (newstring)->data, XSTRING (newstring)->size);
3382 return Qnil;
3385 DEFUN ("x-rebind-keys", Fx_rebind_keys, Sx_rebind_keys, 2, 2, 0,
3386 "Rebind KEYCODE to list of strings STRINGS.\n\
3387 STRINGS should be a list of 16 elements, one for each shift combination.\n\
3388 nil as element means don't change.\n\
3389 See the documentation of `x-rebind-key' for more information.")
3390 (keycode, strings)
3391 register Lisp_Object keycode;
3392 register Lisp_Object strings;
3394 register Lisp_Object item;
3395 register unsigned char *rawstring;
3396 KeySym rawkey, modifier[1];
3397 int strsize;
3398 register unsigned i;
3400 check_x ();
3401 CHECK_NUMBER (keycode, 1);
3402 CHECK_CONS (strings, 2);
3403 rawkey = (KeySym) ((unsigned) (XINT (keycode))) & 255;
3404 for (i = 0; i <= 15; strings = Fcdr (strings), i++)
3406 item = Fcar (strings);
3407 if (!NILP (item))
3409 CHECK_STRING (item, 2);
3410 strsize = XSTRING (item)->size;
3411 rawstring = (unsigned char *) xmalloc (strsize);
3412 bcopy (XSTRING (item)->data, rawstring, strsize);
3413 modifier[1] = 1 << i;
3414 XRebindKeysym (x_current_display, rawkey, modifier, 1,
3415 rawstring, strsize);
3418 return Qnil;
3420 #endif /* HAVE_X11 */
3422 #ifdef HAVE_X11
3423 Visual *
3424 select_visual (screen, depth)
3425 Screen *screen;
3426 unsigned int *depth;
3428 Visual *v;
3429 XVisualInfo *vinfo, vinfo_template;
3430 int n_visuals;
3432 v = DefaultVisualOfScreen (screen);
3434 #ifdef HAVE_X11R4
3435 vinfo_template.visualid = XVisualIDFromVisual (v);
3436 #else
3437 vinfo_template.visualid = v->visualid;
3438 #endif
3440 vinfo_template.screen = XScreenNumberOfScreen (screen);
3442 vinfo = XGetVisualInfo (x_current_display,
3443 VisualIDMask | VisualScreenMask, &vinfo_template,
3444 &n_visuals);
3445 if (n_visuals != 1)
3446 fatal ("Can't get proper X visual info");
3448 if ((1 << vinfo->depth) == vinfo->colormap_size)
3449 *depth = vinfo->depth;
3450 else
3452 int i = 0;
3453 int n = vinfo->colormap_size - 1;
3454 while (n)
3456 n = n >> 1;
3457 i++;
3459 *depth = i;
3462 XFree ((char *) vinfo);
3463 return v;
3465 #endif /* HAVE_X11 */
3467 DEFUN ("x-open-connection", Fx_open_connection, Sx_open_connection,
3468 1, 2, 0, "Open a connection to an X server.\n\
3469 DISPLAY is the name of the display to connect to. Optional second\n\
3470 arg XRM_STRING is a string of resources in xrdb format.")
3471 (display, xrm_string)
3472 Lisp_Object display, xrm_string;
3474 unsigned int n_planes;
3475 unsigned char *xrm_option;
3477 CHECK_STRING (display, 0);
3478 if (x_current_display != 0)
3479 error ("X server connection is already initialized");
3481 /* This is what opens the connection and sets x_current_display.
3482 This also initializes many symbols, such as those used for input. */
3483 x_term_init (XSTRING (display)->data);
3485 #ifdef HAVE_X11
3486 XFASTINT (Vwindow_system_version) = 11;
3488 if (!EQ (xrm_string, Qnil))
3490 CHECK_STRING (xrm_string, 1);
3491 xrm_option = (unsigned char *) XSTRING (xrm_string)->data;
3493 else
3494 xrm_option = (unsigned char *) 0;
3495 BLOCK_INPUT;
3496 xrdb = x_load_resources (x_current_display, xrm_option, EMACS_CLASS);
3497 UNBLOCK_INPUT;
3498 #if defined (HAVE_X11R5) || defined (HAVE_XRMSETDATABASE)
3499 XrmSetDatabase (x_current_display, xrdb);
3500 #else
3501 x_current_display->db = xrdb;
3502 #endif
3504 /* Make a version of Vinvocation_name suitable for use in xrdb
3505 queries - i.e. containing no dots or asterisks. */
3506 Vxrdb_name = Fcopy_sequence (Vinvocation_name);
3508 int i;
3509 int len = XSTRING (Vxrdb_name)->size;
3510 unsigned char *data = XSTRING (Vxrdb_name)->data;
3512 for (i = 0; i < len; i++)
3513 if (data[i] == '.' || data[i] == '*')
3514 data[i] = '-';
3517 x_screen = DefaultScreenOfDisplay (x_current_display);
3519 screen_visual = select_visual (x_screen, &n_planes);
3520 x_screen_planes = n_planes;
3521 x_screen_height = HeightOfScreen (x_screen);
3522 x_screen_width = WidthOfScreen (x_screen);
3524 /* X Atoms used by emacs. */
3525 Xatoms_of_xselect ();
3526 BLOCK_INPUT;
3527 Xatom_wm_protocols = XInternAtom (x_current_display, "WM_PROTOCOLS",
3528 False);
3529 Xatom_wm_take_focus = XInternAtom (x_current_display, "WM_TAKE_FOCUS",
3530 False);
3531 Xatom_wm_save_yourself = XInternAtom (x_current_display, "WM_SAVE_YOURSELF",
3532 False);
3533 Xatom_wm_delete_window = XInternAtom (x_current_display, "WM_DELETE_WINDOW",
3534 False);
3535 Xatom_wm_change_state = XInternAtom (x_current_display, "WM_CHANGE_STATE",
3536 False);
3537 Xatom_wm_configure_denied = XInternAtom (x_current_display,
3538 "WM_CONFIGURE_DENIED", False);
3539 Xatom_wm_window_moved = XInternAtom (x_current_display, "WM_MOVED",
3540 False);
3541 UNBLOCK_INPUT;
3542 #else /* not HAVE_X11 */
3543 XFASTINT (Vwindow_system_version) = 10;
3544 #endif /* not HAVE_X11 */
3545 return Qnil;
3548 DEFUN ("x-close-current-connection", Fx_close_current_connection,
3549 Sx_close_current_connection,
3550 0, 0, 0, "Close the connection to the current X server.")
3553 #ifdef HAVE_X11
3554 /* This is ONLY used when killing emacs; For switching displays
3555 we'll have to take care of setting CloseDownMode elsewhere. */
3557 if (x_current_display)
3559 BLOCK_INPUT;
3560 XSetCloseDownMode (x_current_display, DestroyAll);
3561 XCloseDisplay (x_current_display);
3562 x_current_display = 0;
3564 else
3565 fatal ("No current X display connection to close\n");
3566 #endif
3567 return Qnil;
3570 DEFUN ("x-synchronize", Fx_synchronize, Sx_synchronize,
3571 1, 1, 0, "If ON is non-nil, report X errors as soon as the erring request is made.\n\
3572 If ON is nil, allow buffering of requests.\n\
3573 Turning on synchronization prohibits the Xlib routines from buffering\n\
3574 requests and seriously degrades performance, but makes debugging much\n\
3575 easier.")
3576 (on)
3577 Lisp_Object on;
3579 check_x ();
3581 XSynchronize (x_current_display, !EQ (on, Qnil));
3583 return Qnil;
3587 syms_of_xfns ()
3589 /* This is zero if not using X windows. */
3590 x_current_display = 0;
3592 /* The section below is built by the lisp expression at the top of the file,
3593 just above where these variables are declared. */
3594 /*&&& init symbols here &&&*/
3595 Qauto_raise = intern ("auto-raise");
3596 staticpro (&Qauto_raise);
3597 Qauto_lower = intern ("auto-lower");
3598 staticpro (&Qauto_lower);
3599 Qbackground_color = intern ("background-color");
3600 staticpro (&Qbackground_color);
3601 Qbar = intern ("bar");
3602 staticpro (&Qbar);
3603 Qborder_color = intern ("border-color");
3604 staticpro (&Qborder_color);
3605 Qborder_width = intern ("border-width");
3606 staticpro (&Qborder_width);
3607 Qbox = intern ("box");
3608 staticpro (&Qbox);
3609 Qcursor_color = intern ("cursor-color");
3610 staticpro (&Qcursor_color);
3611 Qcursor_type = intern ("cursor-type");
3612 staticpro (&Qcursor_type);
3613 Qfont = intern ("font");
3614 staticpro (&Qfont);
3615 Qforeground_color = intern ("foreground-color");
3616 staticpro (&Qforeground_color);
3617 Qgeometry = intern ("geometry");
3618 staticpro (&Qgeometry);
3619 Qicon_left = intern ("icon-left");
3620 staticpro (&Qicon_left);
3621 Qicon_top = intern ("icon-top");
3622 staticpro (&Qicon_top);
3623 Qicon_type = intern ("icon-type");
3624 staticpro (&Qicon_type);
3625 Qinternal_border_width = intern ("internal-border-width");
3626 staticpro (&Qinternal_border_width);
3627 Qleft = intern ("left");
3628 staticpro (&Qleft);
3629 Qmouse_color = intern ("mouse-color");
3630 staticpro (&Qmouse_color);
3631 Qnone = intern ("none");
3632 staticpro (&Qnone);
3633 Qparent_id = intern ("parent-id");
3634 staticpro (&Qparent_id);
3635 Qsuppress_icon = intern ("suppress-icon");
3636 staticpro (&Qsuppress_icon);
3637 Qtop = intern ("top");
3638 staticpro (&Qtop);
3639 Qundefined_color = intern ("undefined-color");
3640 staticpro (&Qundefined_color);
3641 Qvertical_scroll_bars = intern ("vertical-scroll-bars");
3642 staticpro (&Qvertical_scroll_bars);
3643 Qvisibility = intern ("visibility");
3644 staticpro (&Qvisibility);
3645 Qwindow_id = intern ("window-id");
3646 staticpro (&Qwindow_id);
3647 Qx_frame_parameter = intern ("x-frame-parameter");
3648 staticpro (&Qx_frame_parameter);
3649 /* This is the end of symbol initialization. */
3651 Fput (Qundefined_color, Qerror_conditions,
3652 Fcons (Qundefined_color, Fcons (Qerror, Qnil)));
3653 Fput (Qundefined_color, Qerror_message,
3654 build_string ("Undefined color"));
3656 init_x_parm_symbols ();
3658 DEFVAR_INT ("mouse-buffer-offset", &mouse_buffer_offset,
3659 "The buffer offset of the character under the pointer.");
3660 mouse_buffer_offset = 0;
3662 DEFVAR_INT ("x-pointer-shape", &Vx_pointer_shape,
3663 "The shape of the pointer when over text.\n\
3664 Changing the value does not affect existing frames\n\
3665 unless you set the mouse color.");
3666 Vx_pointer_shape = Qnil;
3668 staticpro (&Vxrdb_name);
3670 #if 0
3671 DEFVAR_INT ("x-nontext-pointer-shape", &Vx_nontext_pointer_shape,
3672 "The shape of the pointer when not over text.");
3673 #endif
3674 Vx_nontext_pointer_shape = Qnil;
3676 #if 0
3677 DEFVAR_INT ("x-mode-pointer-shape", &Vx_mode_pointer_shape,
3678 "The shape of the pointer when over the mode line.");
3679 #endif
3680 Vx_mode_pointer_shape = Qnil;
3682 DEFVAR_LISP ("x-cursor-fore-pixel", &Vx_cursor_fore_pixel,
3683 "A string indicating the foreground color of the cursor box.");
3684 Vx_cursor_fore_pixel = Qnil;
3686 DEFVAR_LISP ("mouse-grabbed", &Vmouse_depressed,
3687 "Non-nil if a mouse button is currently depressed.");
3688 Vmouse_depressed = Qnil;
3690 DEFVAR_LISP ("x-no-window-manager", &Vx_no_window_manager,
3691 "t if no X window manager is in use.");
3693 #ifdef HAVE_X11
3694 defsubr (&Sx_get_resource);
3695 #if 0
3696 defsubr (&Sx_draw_rectangle);
3697 defsubr (&Sx_erase_rectangle);
3698 defsubr (&Sx_contour_region);
3699 defsubr (&Sx_uncontour_region);
3700 #endif
3701 defsubr (&Sx_display_color_p);
3702 defsubr (&Sx_list_fonts);
3703 defsubr (&Sx_color_defined_p);
3704 defsubr (&Sx_server_vendor);
3705 defsubr (&Sx_server_version);
3706 defsubr (&Sx_display_pixel_width);
3707 defsubr (&Sx_display_pixel_height);
3708 defsubr (&Sx_display_mm_width);
3709 defsubr (&Sx_display_mm_height);
3710 defsubr (&Sx_display_screens);
3711 defsubr (&Sx_display_planes);
3712 defsubr (&Sx_display_color_cells);
3713 defsubr (&Sx_display_visual_class);
3714 defsubr (&Sx_display_backing_store);
3715 defsubr (&Sx_display_save_under);
3716 defsubr (&Sx_rebind_key);
3717 defsubr (&Sx_rebind_keys);
3718 #if 0
3719 defsubr (&Sx_track_pointer);
3720 defsubr (&Sx_grab_pointer);
3721 defsubr (&Sx_ungrab_pointer);
3722 #endif
3723 #else
3724 defsubr (&Sx_get_default);
3725 defsubr (&Sx_store_cut_buffer);
3726 defsubr (&Sx_get_cut_buffer);
3727 #endif
3728 defsubr (&Sx_parse_geometry);
3729 defsubr (&Sx_create_frame);
3730 defsubr (&Sfocus_frame);
3731 defsubr (&Sunfocus_frame);
3732 #if 0
3733 defsubr (&Sx_horizontal_line);
3734 #endif
3735 defsubr (&Sx_open_connection);
3736 defsubr (&Sx_close_current_connection);
3737 defsubr (&Sx_synchronize);
3740 #endif /* HAVE_X_WINDOWS */