*** empty log message ***
[emacs.git] / src / xfns.c
blob4f3a7ff9e2b969f0ce6c76b31c193c17fa75b2d4
1 /* Functions for the X window system.
2 Copyright (C) 1989 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 1, 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 "screen.h"
32 #include "window.h"
33 #include "buffer.h"
34 #include "dispextern.h"
35 #include "xscrollbar.h"
36 #include "keyboard.h"
38 #ifdef HAVE_X_WINDOWS
39 extern void abort ();
41 void x_set_screen_param ();
43 #define min(a,b) ((a) < (b) ? (a) : (b))
44 #define max(a,b) ((a) > (b) ? (a) : (b))
46 #ifdef HAVE_X11
47 /* X Resource data base */
48 static XrmDatabase xrdb;
50 /* The class of this X application. */
51 #define EMACS_CLASS "Emacs"
53 /* The class of Emacs screens. */
54 #define SCREEN_CLASS "Screen"
55 Lisp_Object screen_class;
57 /* Title name and application name for X stuff. */
58 extern char *x_id_name;
59 extern Lisp_Object invocation_name;
61 /* The background and shape of the mouse pointer, and shape when not
62 over text or in the modeline. */
63 Lisp_Object Vx_pointer_shape, Vx_nontext_pointer_shape, Vx_mode_pointer_shape;
65 /* Color of chars displayed in cursor box. */
66 Lisp_Object Vx_cursor_fore_pixel;
68 /* If non-nil, use vertical bar cursor. */
69 Lisp_Object Vbar_cursor;
71 /* The X Visual we are using for X windows (the default) */
72 Visual *screen_visual;
74 /* How many screens this X display has. */
75 int x_screen_count;
77 /* The vendor supporting this X server. */
78 Lisp_Object Vx_vendor;
80 /* The vendor's release number for this X server. */
81 int x_release;
83 /* Height of this X screen in pixels. */
84 int x_screen_height;
86 /* Height of this X screen in millimeters. */
87 int x_screen_height_mm;
89 /* Width of this X screen in pixels. */
90 int x_screen_width;
92 /* Width of this X screen in millimeters. */
93 int x_screen_width_mm;
95 /* Does this X screen do backing store? */
96 Lisp_Object Vx_backing_store;
98 /* Does this X screen do save-unders? */
99 int x_save_under;
101 /* Number of planes for this screen. */
102 int x_screen_planes;
104 /* X Visual type of this screen. */
105 Lisp_Object Vx_screen_visual;
107 /* Non nil if no window manager is in use. */
108 Lisp_Object Vx_no_window_manager;
110 static char *x_visual_strings[] =
112 "StaticGray",
113 "GrayScale",
114 "StaticColor",
115 "PseudoColor",
116 "TrueColor",
117 "DirectColor"
120 /* `t' if a mouse button is depressed. */
122 Lisp_Object Vmouse_depressed;
124 /* Atom for indicating window state to the window manager. */
125 Atom Xatom_wm_change_state;
127 /* When emacs became the selection owner. */
128 extern Time x_begin_selection_own;
130 /* The value of the current emacs selection. */
131 extern Lisp_Object Vx_selection_value;
133 /* Emacs' selection property identifier. */
134 extern Atom Xatom_emacs_selection;
136 /* Clipboard selection atom. */
137 extern Atom Xatom_clipboard_selection;
139 /* Clipboard atom. */
140 extern Atom Xatom_clipboard;
142 /* Atom for indicating incremental selection transfer. */
143 extern Atom Xatom_incremental;
145 /* Atom for indicating multiple selection request list */
146 extern Atom Xatom_multiple;
148 /* Atom for what targets emacs handles. */
149 extern Atom Xatom_targets;
151 /* Atom for indicating timstamp selection request */
152 extern Atom Xatom_timestamp;
154 /* Atom requesting we delete our selection. */
155 extern Atom Xatom_delete;
157 /* Selection magic. */
158 extern Atom Xatom_insert_selection;
160 /* Type of property for INSERT_SELECTION. */
161 extern Atom Xatom_pair;
163 /* More selection magic. */
164 extern Atom Xatom_insert_property;
166 /* Atom for indicating property type TEXT */
167 extern Atom Xatom_text;
169 #else /* X10 */
171 /* Default size of an Emacs window without scroll bar. */
172 static char *default_window = "=80x24+0+0";
174 #define MAXICID 80
175 char iconidentity[MAXICID];
176 #define ICONTAG "emacs@"
177 char minibuffer_iconidentity[MAXICID];
178 #define MINIBUFFER_ICONTAG "minibuffer@"
180 #endif /* X10 */
182 /* The last 23 bits of the timestamp of the last mouse button event. */
183 Time mouse_timestamp;
185 Lisp_Object Qundefined_color;
186 Lisp_Object Qx_screen_parameter;
188 extern Lisp_Object Vwindow_system_version;
190 /* Mouse map for clicks in windows. */
191 extern Lisp_Object Vglobal_mouse_map;
193 /* Points to table of defined typefaces. */
194 struct face *x_face_table[MAX_FACES_AND_GLYPHS];
196 /* Return the Emacs screen-object corresponding to an X window.
197 It could be the screen's main window or an icon window. */
199 struct screen *
200 x_window_to_screen (wdesc)
201 int wdesc;
203 Lisp_Object tail, screen;
204 struct screen *s;
206 for (tail = Vscreen_list; CONSP (tail); tail = XCONS (tail)->cdr)
208 screen = XCONS (tail)->car;
209 if (XTYPE (screen) != Lisp_Screen)
210 continue;
211 s = XSCREEN (screen);
212 if (s->display.x->window_desc == wdesc
213 || s->display.x->icon_desc == wdesc)
214 return s;
216 return 0;
219 /* Map an X window that implements a scroll bar to the Emacs screen it
220 belongs to. Also store in *PART a symbol identifying which part of
221 the scroll bar it is. */
223 struct screen *
224 x_window_to_scrollbar (wdesc, part_ptr, prefix_ptr)
225 int wdesc;
226 Lisp_Object *part_ptr;
227 enum scroll_bar_prefix *prefix_ptr;
229 Lisp_Object tail, screen;
230 struct screen *s;
232 for (tail = Vscreen_list; CONSP (tail); tail = XCONS (tail)->cdr)
234 screen = XCONS (tail)->car;
235 if (XTYPE (screen) != Lisp_Screen)
236 continue;
238 s = XSCREEN (screen);
239 if (part_ptr == 0 && prefix_ptr == 0)
240 return s;
242 if (s->display.x->v_scrollbar == wdesc)
244 *part_ptr = Qvscrollbar_part;
245 *prefix_ptr = VSCROLL_BAR_PREFIX;
246 return s;
248 else if (s->display.x->v_slider == wdesc)
250 *part_ptr = Qvslider_part;
251 *prefix_ptr = VSCROLL_SLIDER_PREFIX;
252 return s;
254 else if (s->display.x->v_thumbup == wdesc)
256 *part_ptr = Qvthumbup_part;
257 *prefix_ptr = VSCROLL_THUMBUP_PREFIX;
258 return s;
260 else if (s->display.x->v_thumbdown == wdesc)
262 *part_ptr = Qvthumbdown_part;
263 *prefix_ptr = VSCROLL_THUMBDOWN_PREFIX;
264 return s;
266 else if (s->display.x->h_scrollbar == wdesc)
268 *part_ptr = Qhscrollbar_part;
269 *prefix_ptr = HSCROLL_BAR_PREFIX;
270 return s;
272 else if (s->display.x->h_slider == wdesc)
274 *part_ptr = Qhslider_part;
275 *prefix_ptr = HSCROLL_SLIDER_PREFIX;
276 return s;
278 else if (s->display.x->h_thumbleft == wdesc)
280 *part_ptr = Qhthumbleft_part;
281 *prefix_ptr = HSCROLL_THUMBLEFT_PREFIX;
282 return s;
284 else if (s->display.x->h_thumbright == wdesc)
286 *part_ptr = Qhthumbright_part;
287 *prefix_ptr = HSCROLL_THUMBRIGHT_PREFIX;
288 return s;
291 return 0;
294 /* Connect the screen-parameter names for X screens
295 to the ways of passing the parameter values to the window system.
297 The name of a parameter, as a Lisp symbol,
298 has an `x-screen-parameter' property which is an integer in Lisp
299 but can be interpreted as an `enum x_screen_parm' in C. */
301 enum x_screen_parm
303 X_PARM_FOREGROUND_COLOR,
304 X_PARM_BACKGROUND_COLOR,
305 X_PARM_MOUSE_COLOR,
306 X_PARM_CURSOR_COLOR,
307 X_PARM_BORDER_COLOR,
308 X_PARM_ICON_TYPE,
309 X_PARM_FONT,
310 X_PARM_BORDER_WIDTH,
311 X_PARM_INTERNAL_BORDER_WIDTH,
312 X_PARM_NAME,
313 X_PARM_AUTORAISE,
314 X_PARM_AUTOLOWER,
315 X_PARM_VERT_SCROLLBAR,
316 X_PARM_HORIZ_SCROLLBAR,
320 struct x_screen_parm_table
322 char *name;
323 void (*setter)( /* struct screen *screen, Lisp_Object val, oldval */ );
326 void x_set_foreground_color ();
327 void x_set_background_color ();
328 void x_set_mouse_color ();
329 void x_set_cursor_color ();
330 void x_set_border_color ();
331 void x_set_icon_type ();
332 void x_set_font ();
333 void x_set_border_width ();
334 void x_set_internal_border_width ();
335 void x_set_name ();
336 void x_set_autoraise ();
337 void x_set_autolower ();
338 void x_set_vertical_scrollbar ();
339 void x_set_horizontal_scrollbar ();
341 static struct x_screen_parm_table x_screen_parms[] =
343 "foreground-color", x_set_foreground_color,
344 "background-color", x_set_background_color,
345 "mouse-color", x_set_mouse_color,
346 "cursor-color", x_set_cursor_color,
347 "border-color", x_set_border_color,
348 "icon-type", x_set_icon_type,
349 "font", x_set_font,
350 "border-width", x_set_border_width,
351 "internal-border-width", x_set_internal_border_width,
352 "name", x_set_name,
353 "autoraise", x_set_autoraise,
354 "autolower", x_set_autolower,
355 "vertical-scrollbar", x_set_vertical_scrollbar,
356 "horizontal-scrollbar", x_set_horizontal_scrollbar,
359 /* Attach the `x-screen-parameter' properties to
360 the Lisp symbol names of parameters relevant to X. */
362 init_x_parm_symbols ()
364 int i;
366 Qx_screen_parameter = intern ("x-screen-parameter");
368 for (i = 0; i < sizeof (x_screen_parms)/sizeof (x_screen_parms[0]); i++)
369 Fput (intern (x_screen_parms[i].name), Qx_screen_parameter,
370 make_number (i));
373 /* Report to X that a screen parameter of screen S is being set or changed.
374 PARAM is the symbol that says which parameter.
375 VAL is the new value.
376 OLDVAL is the old value.
377 If the parameter is not specially recognized, do nothing;
378 otherwise the `x_set_...' function for this parameter. */
380 void
381 x_set_screen_param (s, param, val, oldval)
382 register struct screen *s;
383 Lisp_Object param;
384 register Lisp_Object val;
385 register Lisp_Object oldval;
387 register Lisp_Object tem;
388 tem = Fget (param, Qx_screen_parameter);
389 if (XTYPE (tem) == Lisp_Int
390 && XINT (tem) >= 0
391 && XINT (tem) < sizeof (x_screen_parms)/sizeof (x_screen_parms[0]))
392 (*x_screen_parms[XINT (tem)].setter)(s, val, oldval);
395 /* Insert a description of internally-recorded parameters of screen X
396 into the parameter alist *ALISTPTR that is to be given to the user.
397 Only parameters that are specific to the X window system
398 and whose values are not correctly recorded in the screen's
399 param_alist need to be considered here. */
401 x_report_screen_params (s, alistptr)
402 struct screen *s;
403 Lisp_Object *alistptr;
405 char buf[16];
407 store_in_alist (alistptr, "left", make_number (s->display.x->left_pos));
408 store_in_alist (alistptr, "top", make_number (s->display.x->top_pos));
409 store_in_alist (alistptr, "border-width",
410 make_number (s->display.x->border_width));
411 store_in_alist (alistptr, "internal-border-width",
412 make_number (s->display.x->internal_border_width));
413 sprintf (buf, "%d", s->display.x->window_desc);
414 store_in_alist (alistptr, "window-id",
415 build_string (buf));
418 /* Decide if color named COLOR is valid for the display
419 associated with the selected screen. */
421 defined_color (color, color_def)
422 char *color;
423 Color *color_def;
425 register int foo;
426 Colormap screen_colormap;
428 BLOCK_INPUT;
429 #ifdef HAVE_X11
430 screen_colormap
431 = DefaultColormap (x_current_display, XDefaultScreen (x_current_display));
433 foo = XParseColor (x_current_display, screen_colormap,
434 color, color_def)
435 && XAllocColor (x_current_display, screen_colormap, color_def);
436 #else
437 foo = XParseColor (color, color_def) && XGetHardwareColor (color_def);
438 #endif /* not HAVE_X11 */
439 UNBLOCK_INPUT;
441 if (foo)
442 return 1;
443 else
444 return 0;
447 /* Given a string ARG naming a color, compute a pixel value from it
448 suitable for screen S.
449 If S is not a color screen, return DEF (default) regardless of what
450 ARG says. */
453 x_decode_color (arg, def)
454 Lisp_Object arg;
455 int def;
457 Color cdef;
459 CHECK_STRING (arg, 0);
461 if (strcmp (XSTRING (arg)->data, "black") == 0)
462 return BLACK_PIX_DEFAULT;
463 else if (strcmp (XSTRING (arg)->data, "white") == 0)
464 return WHITE_PIX_DEFAULT;
466 #ifdef HAVE_X11
467 if (XFASTINT (x_screen_planes) == 1)
468 return def;
469 #else
470 if (DISPLAY_CELLS == 1)
471 return def;
472 #endif
474 if (defined_color (XSTRING (arg)->data, &cdef))
475 return cdef.pixel;
476 else
477 Fsignal (Qundefined_color, Fcons (arg, Qnil));
480 /* Functions called only from `x_set_screen_param'
481 to set individual parameters.
483 If s->display.x->window_desc is 0,
484 the screen is being created and its X-window does not exist yet.
485 In that case, just record the parameter's new value
486 in the standard place; do not attempt to change the window. */
488 void
489 x_set_foreground_color (s, arg, oldval)
490 struct screen *s;
491 Lisp_Object arg, oldval;
493 s->display.x->foreground_pixel = x_decode_color (arg, BLACK_PIX_DEFAULT);
494 if (s->display.x->window_desc != 0)
496 #ifdef HAVE_X11
497 BLOCK_INPUT;
498 XSetForeground (x_current_display, s->display.x->normal_gc,
499 s->display.x->foreground_pixel);
500 XSetBackground (x_current_display, s->display.x->reverse_gc,
501 s->display.x->foreground_pixel);
502 if (s->display.x->v_scrollbar)
504 Pixmap up_arrow_pixmap, down_arrow_pixmap, slider_pixmap;
506 XSetWindowBorder (x_current_display, s->display.x->v_scrollbar,
507 s->display.x->foreground_pixel);
509 slider_pixmap =
510 XCreatePixmapFromBitmapData (XDISPLAY s->display.x->window_desc,
511 gray_bits, 16, 16,
512 s->display.x->foreground_pixel,
513 s->display.x->background_pixel,
514 DefaultDepth (x_current_display,
515 XDefaultScreen (x_current_display)));
516 up_arrow_pixmap =
517 XCreatePixmapFromBitmapData (XDISPLAY s->display.x->window_desc,
518 up_arrow_bits, 16, 16,
519 s->display.x->foreground_pixel,
520 s->display.x->background_pixel,
521 DefaultDepth (x_current_display,
522 XDefaultScreen (x_current_display)));
523 down_arrow_pixmap =
524 XCreatePixmapFromBitmapData (XDISPLAY s->display.x->window_desc,
525 down_arrow_bits, 16, 16,
526 s->display.x->foreground_pixel,
527 s->display.x->background_pixel,
528 DefaultDepth (x_current_display,
529 XDefaultScreen (x_current_display)));
531 XSetWindowBackgroundPixmap (XDISPLAY s->display.x->v_thumbup,
532 up_arrow_pixmap);
533 XSetWindowBackgroundPixmap (XDISPLAY s->display.x->v_thumbdown,
534 down_arrow_pixmap);
535 XSetWindowBackgroundPixmap (XDISPLAY s->display.x->v_slider,
536 slider_pixmap);
538 XClearWindow (XDISPLAY s->display.x->v_thumbup);
539 XClearWindow (XDISPLAY s->display.x->v_thumbdown);
540 XClearWindow (XDISPLAY s->display.x->v_slider);
542 XFreePixmap (x_current_display, down_arrow_pixmap);
543 XFreePixmap (x_current_display, up_arrow_pixmap);
544 XFreePixmap (x_current_display, slider_pixmap);
546 if (s->display.x->h_scrollbar)
548 Pixmap left_arrow_pixmap, right_arrow_pixmap, slider_pixmap;
550 XSetWindowBorder (x_current_display, s->display.x->h_scrollbar,
551 s->display.x->foreground_pixel);
553 slider_pixmap =
554 XCreatePixmapFromBitmapData (XDISPLAY s->display.x->window_desc,
555 gray_bits, 16, 16,
556 s->display.x->foreground_pixel,
557 s->display.x->background_pixel,
558 DefaultDepth (x_current_display,
559 XDefaultScreen (x_current_display)));
561 left_arrow_pixmap =
562 XCreatePixmapFromBitmapData (XDISPLAY s->display.x->window_desc,
563 up_arrow_bits, 16, 16,
564 s->display.x->foreground_pixel,
565 s->display.x->background_pixel,
566 DefaultDepth (x_current_display,
567 XDefaultScreen (x_current_display)));
568 right_arrow_pixmap =
569 XCreatePixmapFromBitmapData (XDISPLAY s->display.x->window_desc,
570 down_arrow_bits, 16, 16,
571 s->display.x->foreground_pixel,
572 s->display.x->background_pixel,
573 DefaultDepth (x_current_display,
574 XDefaultScreen (x_current_display)));
576 XSetWindowBackgroundPixmap (XDISPLAY s->display.x->h_slider,
577 slider_pixmap);
578 XSetWindowBackgroundPixmap (XDISPLAY s->display.x->h_thumbleft,
579 left_arrow_pixmap);
580 XSetWindowBackgroundPixmap (XDISPLAY s->display.x->h_thumbright,
581 right_arrow_pixmap);
583 XClearWindow (XDISPLAY s->display.x->h_thumbleft);
584 XClearWindow (XDISPLAY s->display.x->h_thumbright);
585 XClearWindow (XDISPLAY s->display.x->h_slider);
587 XFreePixmap (x_current_display, slider_pixmap);
588 XFreePixmap (x_current_display, left_arrow_pixmap);
589 XFreePixmap (x_current_display, right_arrow_pixmap);
591 UNBLOCK_INPUT;
592 #endif /* HAVE_X11 */
593 if (s->visible)
594 redraw_screen (s);
598 void
599 x_set_background_color (s, arg, oldval)
600 struct screen *s;
601 Lisp_Object arg, oldval;
603 Pixmap temp;
604 int mask;
606 s->display.x->background_pixel = x_decode_color (arg, WHITE_PIX_DEFAULT);
608 if (s->display.x->window_desc != 0)
610 BLOCK_INPUT;
611 #ifdef HAVE_X11
612 /* The main screen. */
613 XSetBackground (x_current_display, s->display.x->normal_gc,
614 s->display.x->background_pixel);
615 XSetForeground (x_current_display, s->display.x->reverse_gc,
616 s->display.x->background_pixel);
617 XSetWindowBackground (x_current_display, s->display.x->window_desc,
618 s->display.x->background_pixel);
620 /* Scroll bars. */
621 if (s->display.x->v_scrollbar)
623 Pixmap up_arrow_pixmap, down_arrow_pixmap, slider_pixmap;
625 XSetWindowBackground (x_current_display, s->display.x->v_scrollbar,
626 s->display.x->background_pixel);
628 slider_pixmap =
629 XCreatePixmapFromBitmapData (XDISPLAY s->display.x->window_desc,
630 gray_bits, 16, 16,
631 s->display.x->foreground_pixel,
632 s->display.x->background_pixel,
633 DefaultDepth (x_current_display,
634 XDefaultScreen (x_current_display)));
635 up_arrow_pixmap =
636 XCreatePixmapFromBitmapData (XDISPLAY s->display.x->window_desc,
637 up_arrow_bits, 16, 16,
638 s->display.x->foreground_pixel,
639 s->display.x->background_pixel,
640 DefaultDepth (x_current_display,
641 XDefaultScreen (x_current_display)));
642 down_arrow_pixmap =
643 XCreatePixmapFromBitmapData (XDISPLAY s->display.x->window_desc,
644 down_arrow_bits, 16, 16,
645 s->display.x->foreground_pixel,
646 s->display.x->background_pixel,
647 DefaultDepth (x_current_display,
648 XDefaultScreen (x_current_display)));
650 XSetWindowBackgroundPixmap (XDISPLAY s->display.x->v_thumbup,
651 up_arrow_pixmap);
652 XSetWindowBackgroundPixmap (XDISPLAY s->display.x->v_thumbdown,
653 down_arrow_pixmap);
654 XSetWindowBackgroundPixmap (XDISPLAY s->display.x->v_slider,
655 slider_pixmap);
657 XClearWindow (XDISPLAY s->display.x->v_thumbup);
658 XClearWindow (XDISPLAY s->display.x->v_thumbdown);
659 XClearWindow (XDISPLAY s->display.x->v_slider);
661 XFreePixmap (x_current_display, down_arrow_pixmap);
662 XFreePixmap (x_current_display, up_arrow_pixmap);
663 XFreePixmap (x_current_display, slider_pixmap);
665 if (s->display.x->h_scrollbar)
667 Pixmap left_arrow_pixmap, right_arrow_pixmap, slider_pixmap;
669 XSetWindowBackground (x_current_display, s->display.x->h_scrollbar,
670 s->display.x->background_pixel);
672 slider_pixmap =
673 XCreatePixmapFromBitmapData (XDISPLAY s->display.x->window_desc,
674 gray_bits, 16, 16,
675 s->display.x->foreground_pixel,
676 s->display.x->background_pixel,
677 DefaultDepth (x_current_display,
678 XDefaultScreen (x_current_display)));
680 left_arrow_pixmap =
681 XCreatePixmapFromBitmapData (XDISPLAY s->display.x->window_desc,
682 up_arrow_bits, 16, 16,
683 s->display.x->foreground_pixel,
684 s->display.x->background_pixel,
685 DefaultDepth (x_current_display,
686 XDefaultScreen (x_current_display)));
687 right_arrow_pixmap =
688 XCreatePixmapFromBitmapData (XDISPLAY s->display.x->window_desc,
689 down_arrow_bits, 16, 16,
690 s->display.x->foreground_pixel,
691 s->display.x->background_pixel,
692 DefaultDepth (x_current_display,
693 XDefaultScreen (x_current_display)));
695 XSetWindowBackgroundPixmap (XDISPLAY s->display.x->h_slider,
696 slider_pixmap);
697 XSetWindowBackgroundPixmap (XDISPLAY s->display.x->h_thumbleft,
698 left_arrow_pixmap);
699 XSetWindowBackgroundPixmap (XDISPLAY s->display.x->h_thumbright,
700 right_arrow_pixmap);
702 XClearWindow (XDISPLAY s->display.x->h_thumbleft);
703 XClearWindow (XDISPLAY s->display.x->h_thumbright);
704 XClearWindow (XDISPLAY s->display.x->h_slider);
706 XFreePixmap (x_current_display, slider_pixmap);
707 XFreePixmap (x_current_display, left_arrow_pixmap);
708 XFreePixmap (x_current_display, right_arrow_pixmap);
710 #else
711 temp = XMakeTile (s->display.x->background_pixel);
712 XChangeBackground (s->display.x->window_desc, temp);
713 XFreePixmap (temp);
714 #endif /* not HAVE_X11 */
715 UNBLOCK_INPUT;
717 if (s->visible)
718 redraw_screen (s);
722 void
723 x_set_mouse_color (s, arg, oldval)
724 struct screen *s;
725 Lisp_Object arg, oldval;
727 Cursor cursor, nontext_cursor, mode_cursor;
728 int mask_color;
730 if (!EQ (Qnil, arg))
731 s->display.x->mouse_pixel = x_decode_color (arg, BLACK_PIX_DEFAULT);
732 mask_color = s->display.x->background_pixel;
733 /* No invisible pointers. */
734 if (mask_color == s->display.x->mouse_pixel
735 && mask_color == s->display.x->background_pixel)
736 s->display.x->mouse_pixel = s->display.x->foreground_pixel;
738 BLOCK_INPUT;
739 #ifdef HAVE_X11
740 if (!EQ (Qnil, Vx_pointer_shape))
742 CHECK_NUMBER (Vx_pointer_shape, 0);
743 cursor = XCreateFontCursor (x_current_display, XINT (Vx_pointer_shape));
745 else
746 cursor = XCreateFontCursor (x_current_display, XC_xterm);
748 if (!EQ (Qnil, Vx_nontext_pointer_shape))
750 CHECK_NUMBER (Vx_nontext_pointer_shape, 0);
751 nontext_cursor = XCreateFontCursor (x_current_display,
752 XINT (Vx_nontext_pointer_shape));
754 else
755 nontext_cursor = XCreateFontCursor (x_current_display, XC_left_ptr);
757 if (!EQ (Qnil, Vx_mode_pointer_shape))
759 CHECK_NUMBER (Vx_mode_pointer_shape, 0);
760 mode_cursor = XCreateFontCursor (x_current_display,
761 XINT (Vx_mode_pointer_shape));
763 else
764 mode_cursor = XCreateFontCursor (x_current_display, XC_xterm);
767 XColor fore_color, back_color;
769 fore_color.pixel = s->display.x->mouse_pixel;
770 back_color.pixel = mask_color;
771 XQueryColor (x_current_display,
772 DefaultColormap (x_current_display,
773 DefaultScreen (x_current_display)),
774 &fore_color);
775 XQueryColor (x_current_display,
776 DefaultColormap (x_current_display,
777 DefaultScreen (x_current_display)),
778 &back_color);
779 XRecolorCursor (x_current_display, cursor,
780 &fore_color, &back_color);
781 XRecolorCursor (x_current_display, nontext_cursor,
782 &fore_color, &back_color);
783 XRecolorCursor (x_current_display, mode_cursor,
784 &fore_color, &back_color);
786 #else /* X10 */
787 cursor = XCreateCursor (16, 16, MouseCursor, MouseMask,
788 0, 0,
789 s->display.x->mouse_pixel,
790 s->display.x->background_pixel,
791 GXcopy);
792 #endif /* X10 */
794 if (s->display.x->window_desc != 0)
796 XDefineCursor (XDISPLAY s->display.x->window_desc, cursor);
799 if (cursor != s->display.x->text_cursor && s->display.x->text_cursor != 0)
800 XFreeCursor (XDISPLAY s->display.x->text_cursor);
801 s->display.x->text_cursor = cursor;
802 #ifdef HAVE_X11
803 if (nontext_cursor != s->display.x->nontext_cursor
804 && s->display.x->nontext_cursor != 0)
805 XFreeCursor (XDISPLAY s->display.x->nontext_cursor);
806 s->display.x->nontext_cursor = nontext_cursor;
808 if (mode_cursor != s->display.x->modeline_cursor
809 && s->display.x->modeline_cursor != 0)
810 XFreeCursor (XDISPLAY s->display.x->modeline_cursor);
811 s->display.x->modeline_cursor = mode_cursor;
812 #endif /* HAVE_X11 */
814 XFlushQueue ();
815 UNBLOCK_INPUT;
818 void
819 x_set_cursor_color (s, arg, oldval)
820 struct screen *s;
821 Lisp_Object arg, oldval;
823 unsigned long fore_pixel;
825 if (!EQ (Vx_cursor_fore_pixel, Qnil))
826 fore_pixel = x_decode_color (Vx_cursor_fore_pixel, WHITE_PIX_DEFAULT);
827 else
828 fore_pixel = s->display.x->background_pixel;
829 s->display.x->cursor_pixel = x_decode_color (arg, BLACK_PIX_DEFAULT);
830 /* No invisible cursors */
831 if (s->display.x->cursor_pixel == s->display.x->background_pixel)
833 s->display.x->cursor_pixel == s->display.x->mouse_pixel;
834 if (s->display.x->cursor_pixel == fore_pixel)
835 fore_pixel = s->display.x->background_pixel;
838 if (s->display.x->window_desc != 0)
840 #ifdef HAVE_X11
841 BLOCK_INPUT;
842 XSetBackground (x_current_display, s->display.x->cursor_gc,
843 s->display.x->cursor_pixel);
844 XSetForeground (x_current_display, s->display.x->cursor_gc,
845 fore_pixel);
846 UNBLOCK_INPUT;
847 #endif /* HAVE_X11 */
849 if (s->visible)
851 x_display_cursor (s, 0);
852 x_display_cursor (s, 1);
857 /* Set the border-color of screen S to value described by ARG.
858 ARG can be a string naming a color.
859 The border-color is used for the border that is drawn by the X server.
860 Note that this does not fully take effect if done before
861 S has an x-window; it must be redone when the window is created.
863 Note: this is done in two routines because of the way X10 works.
865 Note: under X11, this is normally the province of the window manager,
866 and so emacs' border colors may be overridden. */
868 void
869 x_set_border_color (s, arg, oldval)
870 struct screen *s;
871 Lisp_Object arg, oldval;
873 unsigned char *str;
874 int pix;
876 CHECK_STRING (arg, 0);
877 str = XSTRING (arg)->data;
879 #ifndef HAVE_X11
880 if (!strcmp (str, "grey") || !strcmp (str, "Grey")
881 || !strcmp (str, "gray") || !strcmp (str, "Gray"))
882 pix = -1;
883 else
884 #endif /* X10 */
886 pix = x_decode_color (arg, BLACK_PIX_DEFAULT);
888 x_set_border_pixel (s, pix);
891 /* Set the border-color of screen S to pixel value PIX.
892 Note that this does not fully take effect if done before
893 S has an x-window. */
895 x_set_border_pixel (s, pix)
896 struct screen *s;
897 int pix;
899 s->display.x->border_pixel = pix;
901 if (s->display.x->window_desc != 0 && s->display.x->border_width > 0)
903 Pixmap temp;
904 int mask;
906 BLOCK_INPUT;
907 #ifdef HAVE_X11
908 XSetWindowBorder (x_current_display, s->display.x->window_desc,
909 pix);
910 if (s->display.x->h_scrollbar)
911 XSetWindowBorder (x_current_display, s->display.x->h_slider,
912 pix);
913 if (s->display.x->v_scrollbar)
914 XSetWindowBorder (x_current_display, s->display.x->v_slider,
915 pix);
916 #else
917 if (pix < 0)
918 temp = XMakePixmap ((Bitmap) XStoreBitmap (16, 16, gray_bits),
919 BLACK_PIX_DEFAULT, WHITE_PIX_DEFAULT);
920 else
921 temp = XMakeTile (pix);
922 XChangeBorder (s->display.x->window_desc, temp);
923 XFreePixmap (XDISPLAY temp);
924 #endif /* not HAVE_X11 */
925 UNBLOCK_INPUT;
927 if (s->visible)
928 redraw_screen (s);
932 void
933 x_set_icon_type (s, arg, oldval)
934 struct screen *s;
935 Lisp_Object arg, oldval;
937 Lisp_Object tem;
938 int result;
940 if (EQ (oldval, Qnil) == EQ (arg, Qnil))
941 return;
943 BLOCK_INPUT;
944 if (NILP (arg))
945 result = x_text_icon (s, 0);
946 else
947 result = x_bitmap_icon (s, 0);
949 if (result)
951 error ("No icon window available.");
952 UNBLOCK_INPUT;
955 /* If the window was unmapped (and its icon was mapped),
956 the new icon is not mapped, so map the window in its stead. */
957 if (s->visible)
958 XMapWindow (XDISPLAY s->display.x->window_desc);
960 XFlushQueue ();
961 UNBLOCK_INPUT;
964 void
965 x_set_font (s, arg, oldval)
966 struct screen *s;
967 Lisp_Object arg, oldval;
969 unsigned char *name;
970 int result;
972 CHECK_STRING (arg, 1);
973 name = XSTRING (arg)->data;
975 BLOCK_INPUT;
976 result = x_new_font (s, name);
977 UNBLOCK_INPUT;
979 if (result)
980 error ("Font \"%s\" is not defined", name);
983 void
984 x_set_border_width (s, arg, oldval)
985 struct screen *s;
986 Lisp_Object arg, oldval;
988 CHECK_NUMBER (arg, 0);
990 if (XINT (arg) == s->display.x->border_width)
991 return;
993 if (s->display.x->window_desc != 0)
994 error ("Cannot change the border width of a window");
996 s->display.x->border_width = XINT (arg);
999 void
1000 x_set_internal_border_width (s, arg, oldval)
1001 struct screen *s;
1002 Lisp_Object arg, oldval;
1004 int mask;
1005 int old = s->display.x->internal_border_width;
1007 CHECK_NUMBER (arg, 0);
1008 s->display.x->internal_border_width = XINT (arg);
1009 if (s->display.x->internal_border_width < 0)
1010 s->display.x->internal_border_width = 0;
1012 if (s->display.x->internal_border_width == old)
1013 return;
1015 if (s->display.x->window_desc != 0)
1017 BLOCK_INPUT;
1018 x_set_window_size (s, s->width, s->height);
1019 #if 0
1020 x_set_resize_hint (s);
1021 #endif
1022 XFlushQueue ();
1023 UNBLOCK_INPUT;
1024 SET_SCREEN_GARBAGED (s);
1028 void
1029 x_set_name (s, arg, oldval)
1030 struct screen *s;
1031 Lisp_Object arg, oldval;
1033 CHECK_STRING (arg, 0);
1035 if (s->display.x->window_desc)
1037 s->name = arg;
1038 BLOCK_INPUT;
1039 XStoreName (XDISPLAY s->display.x->window_desc,
1040 (char *) XSTRING (arg)->data);
1041 XSetIconName (XDISPLAY s->display.x->window_desc,
1042 (char *) XSTRING (arg)->data);
1043 UNBLOCK_INPUT;
1047 void
1048 x_set_autoraise (s, arg, oldval)
1049 struct screen *s;
1050 Lisp_Object arg, oldval;
1052 s->auto_raise = !EQ (Qnil, arg);
1055 void
1056 x_set_autolower (s, arg, oldval)
1057 struct screen *s;
1058 Lisp_Object arg, oldval;
1060 s->auto_lower = !EQ (Qnil, arg);
1063 #ifdef HAVE_X11
1064 int n_faces;
1066 x_set_face (scr, font, background, foreground, stipple)
1067 struct screen *scr;
1068 XFontStruct *font;
1069 unsigned long background, foreground;
1070 Pixmap stipple;
1072 XGCValues gc_values;
1073 GC temp_gc;
1074 unsigned long gc_mask;
1075 struct face *new_face;
1076 unsigned int width = 16;
1077 unsigned int height = 16;
1079 if (n_faces == MAX_FACES_AND_GLYPHS)
1080 return 1;
1082 /* Create the Graphics Context. */
1083 gc_values.font = font->fid;
1084 gc_values.foreground = foreground;
1085 gc_values.background = background;
1086 gc_values.line_width = 0;
1087 gc_mask = GCLineWidth | GCFont | GCForeground | GCBackground;
1088 if (stipple)
1090 gc_values.stipple
1091 = XCreateBitmapFromData (x_current_display, ROOT_WINDOW,
1092 (char *) stipple, width, height);
1093 gc_mask |= GCStipple;
1096 temp_gc = XCreateGC (x_current_display, scr->display.x->window_desc,
1097 gc_mask, &gc_values);
1098 if (!temp_gc)
1099 return 1;
1100 new_face = (struct face *) xmalloc (sizeof (struct face));
1101 if (!new_face)
1103 XFreeGC (x_current_display, temp_gc);
1104 return 1;
1107 new_face->font = font;
1108 new_face->foreground = foreground;
1109 new_face->background = background;
1110 new_face->face_gc = temp_gc;
1111 if (stipple)
1112 new_face->stipple = gc_values.stipple;
1114 x_face_table[++n_faces] = new_face;
1115 return 1;
1118 x_set_glyph (scr, glyph)
1122 #if 0
1123 DEFUN ("x-set-face-font", Fx_set_face_font, Sx_set_face_font, 4, 2, 0,
1124 "Specify face table entry FACE-CODE to be the font named by FONT,\n\
1125 in colors FOREGROUND and BACKGROUND.")
1126 (face_code, font_name, foreground, background)
1127 Lisp_Object face_code;
1128 Lisp_Object font_name;
1129 Lisp_Object foreground;
1130 Lisp_Object background;
1132 register struct face *fp; /* Current face info. */
1133 register int fn; /* Face number. */
1134 register FONT_TYPE *f; /* Font data structure. */
1135 unsigned char *newname;
1136 int fg, bg;
1137 GC temp_gc;
1138 XGCValues gc_values;
1140 /* Need to do something about this. */
1141 Drawable drawable = selected_screen->display.x->window_desc;
1143 CHECK_NUMBER (face_code, 1);
1144 CHECK_STRING (font_name, 2);
1146 if (EQ (foreground, Qnil) || EQ (background, Qnil))
1148 fg = selected_screen->display.x->foreground_pixel;
1149 bg = selected_screen->display.x->background_pixel;
1151 else
1153 CHECK_NUMBER (foreground, 0);
1154 CHECK_NUMBER (background, 1);
1156 fg = x_decode_color (XINT (foreground), BLACK_PIX_DEFAULT);
1157 bg = x_decode_color (XINT (background), WHITE_PIX_DEFAULT);
1160 fn = XINT (face_code);
1161 if ((fn < 1) || (fn > 255))
1162 error ("Invalid face code, %d", fn);
1164 newname = XSTRING (font_name)->data;
1165 BLOCK_INPUT;
1166 f = (*newname == 0 ? 0 : XGetFont (newname));
1167 UNBLOCK_INPUT;
1168 if (f == 0)
1169 error ("Font \"%s\" is not defined", newname);
1171 fp = x_face_table[fn];
1172 if (fp == 0)
1174 x_face_table[fn] = fp = (struct face *) xmalloc (sizeof (struct face));
1175 bzero (fp, sizeof (struct face));
1176 fp->face_type = x_pixmap;
1178 else if (FACE_IS_FONT (fn))
1180 BLOCK_INPUT;
1181 XFreeGC (FACE_FONT (fn));
1182 UNBLOCK_INPUT;
1184 else if (FACE_IS_IMAGE (fn)) /* This should not happen... */
1186 BLOCK_INPUT;
1187 XFreePixmap (x_current_display, FACE_IMAGE (fn));
1188 fp->face_type = x_font;
1189 UNBLOCK_INPUT;
1191 else
1192 abort ();
1194 fp->face_GLYPH.font_desc.font = f;
1195 gc_values.font = f->fid;
1196 gc_values.foreground = fg;
1197 gc_values.background = bg;
1198 fp->face_GLYPH.font_desc.face_gc = XCreateGC (x_current_display,
1199 drawable, GCFont | GCForeground
1200 | GCBackground, &gc_values);
1201 fp->face_GLYPH.font_desc.font_width = FONT_WIDTH (f);
1202 fp->face_GLYPH.font_desc.font_height = FONT_HEIGHT (f);
1204 return face_code;
1206 #endif
1207 #else /* X10 */
1208 DEFUN ("x-set-face", Fx_set_face, Sx_set_face, 4, 4, 0,
1209 "Specify face table entry FACE-CODE to be the font named by FONT,\n\
1210 in colors FOREGROUND and BACKGROUND.")
1211 (face_code, font_name, foreground, background)
1212 Lisp_Object face_code;
1213 Lisp_Object font_name;
1214 Lisp_Object foreground;
1215 Lisp_Object background;
1217 register struct face *fp; /* Current face info. */
1218 register int fn; /* Face number. */
1219 register FONT_TYPE *f; /* Font data structure. */
1220 unsigned char *newname;
1222 CHECK_NUMBER (face_code, 1);
1223 CHECK_STRING (font_name, 2);
1225 fn = XINT (face_code);
1226 if ((fn < 1) || (fn > 255))
1227 error ("Invalid face code, %d", fn);
1229 /* Ask the server to find the specified font. */
1230 newname = XSTRING (font_name)->data;
1231 BLOCK_INPUT;
1232 f = (*newname == 0 ? 0 : XGetFont (newname));
1233 UNBLOCK_INPUT;
1234 if (f == 0)
1235 error ("Font \"%s\" is not defined", newname);
1237 /* Get the face structure for face_code in the face table.
1238 Make sure it exists. */
1239 fp = x_face_table[fn];
1240 if (fp == 0)
1242 x_face_table[fn] = fp = (struct face *) xmalloc (sizeof (struct face));
1243 bzero (fp, sizeof (struct face));
1246 /* If this face code already exists, get rid of the old font. */
1247 if (fp->font != 0 && fp->font != f)
1249 BLOCK_INPUT;
1250 XLoseFont (fp->font);
1251 UNBLOCK_INPUT;
1254 /* Store the specified information in FP. */
1255 fp->fg = x_decode_color (foreground, BLACK_PIX_DEFAULT);
1256 fp->bg = x_decode_color (background, WHITE_PIX_DEFAULT);
1257 fp->font = f;
1259 return face_code;
1261 #endif /* X10 */
1263 #if 0
1264 /* This is excluded because there is no painless way
1265 to get or to remember the name of the font. */
1267 DEFUN ("x-get-face", Fx_get_face, Sx_get_face, 1, 1, 0,
1268 "Get data defining face code FACE. FACE is an integer.\n\
1269 The value is a list (FONT FG-COLOR BG-COLOR).")
1270 (face)
1271 Lisp_Object face;
1273 register struct face *fp; /* Current face info. */
1274 register int fn; /* Face number. */
1276 CHECK_NUMBER (face, 1);
1277 fn = XINT (face);
1278 if ((fn < 1) || (fn > 255))
1279 error ("Invalid face code, %d", fn);
1281 /* Make sure the face table exists and this face code is defined. */
1282 if (x_face_table == 0 || x_face_table[fn] == 0)
1283 return Qnil;
1285 fp = x_face_table[fn];
1287 return Fcons (build_string (fp->name),
1288 Fcons (make_number (fp->fg),
1289 Fcons (make_number (fp->bg), Qnil)));
1291 #endif /* 0 */
1293 /* Subroutines of creating an X screen. */
1295 #ifdef HAVE_X11
1296 extern char *x_get_string_resource ();
1297 extern XrmDatabase x_load_resources ();
1299 DEFUN ("x-get-resource", Fx_get_resource, Sx_get_resource, 1, 3, 0,
1300 "Retrieve the value of ATTRIBUTE from the X defaults database. This\n\
1301 searches using a key of the form \"INSTANCE.ATTRIBUTE\", with class\n\
1302 \"Emacs\", where INSTANCE is the name under which Emacs was invoked.\n\
1304 Optional arguments COMPONENT and CLASS specify the component for which\n\
1305 we should look up ATTRIBUTE. When specified, Emacs searches using a\n\
1306 key of the form INSTANCE.COMPONENT.ATTRIBUTE, with class \"Emacs.CLASS\".")
1307 (attribute, name, class)
1308 Lisp_Object attribute, name, class;
1310 register char *value;
1311 char *name_key;
1312 char *class_key;
1314 CHECK_STRING (attribute, 0);
1315 if (!NILP (name))
1316 CHECK_STRING (name, 1);
1317 if (!NILP (class))
1318 CHECK_STRING (class, 2);
1319 if (NILP (name) != NILP (class))
1320 error ("x-get-resource: must specify both NAME and CLASS or neither");
1322 if (NILP (name))
1324 name_key = (char *) alloca (XSTRING (invocation_name)->size + 1
1325 + XSTRING (attribute)->size + 1);
1327 sprintf (name_key, "%s.%s",
1328 XSTRING (invocation_name)->data,
1329 XSTRING (attribute)->data);
1330 class_key = EMACS_CLASS;
1332 else
1334 name_key = (char *) alloca (XSTRING (invocation_name)->size + 1
1335 + XSTRING (name)->size + 1
1336 + XSTRING (attribute)->size + 1);
1338 class_key = (char *) alloca (sizeof (EMACS_CLASS)
1339 + XSTRING (class)->size + 1);
1341 sprintf (name_key, "%s.%s.%s",
1342 XSTRING (invocation_name)->data,
1343 XSTRING (name)->data,
1344 XSTRING (attribute)->data);
1345 sprintf (class_key, "%s.%s",
1346 XSTRING (invocation_name)->data,
1347 XSTRING (class)->data);
1350 value = x_get_string_resource (xrdb, name_key, class_key);
1352 if (value != (char *) 0)
1353 return build_string (value);
1354 else
1355 return Qnil;
1358 #else /* X10 */
1360 DEFUN ("x-get-default", Fx_get_default, Sx_get_default, 1, 1, 0,
1361 "Get X default ATTRIBUTE from the system, or nil if no default.\n\
1362 Value is a string (when not nil) and ATTRIBUTE is also a string.\n\
1363 The defaults are specified in the file `~/.Xdefaults'.")
1364 (arg)
1365 Lisp_Object arg;
1367 register unsigned char *value;
1369 CHECK_STRING (arg, 1);
1371 value = (unsigned char *) XGetDefault (XDISPLAY
1372 XSTRING (invocation_name)->data,
1373 XSTRING (arg)->data);
1374 if (value == 0)
1375 /* Try reversing last two args, in case this is the buggy version of X. */
1376 value = (unsigned char *) XGetDefault (XDISPLAY
1377 XSTRING (arg)->data,
1378 XSTRING (invocation_name)->data);
1379 if (value != 0)
1380 return build_string (value);
1381 else
1382 return (Qnil);
1385 #define Fx_get_resource(attribute, name, class) Fx_get_default(attribute)
1387 #endif /* X10 */
1389 /* Types we might convert a resource string into. */
1390 enum resource_types
1392 number, boolean, string,
1395 /* Return the value of parameter PARAM.
1397 First search ALIST, then Vdefault_screen_alist, then the X defaults
1398 database, using SCREEN_NAME as the subcomponent of emacs and
1399 ATTRIBUTE as the attribute name.
1401 Convert the resource to the type specified by desired_type.
1403 If no default is specified, return nil. */
1405 static Lisp_Object
1406 x_get_arg (alist, param, screen_name, attribute, type)
1407 Lisp_Object alist, param, screen_name;
1408 char *attribute;
1409 enum resource_types type;
1411 register Lisp_Object tem;
1413 tem = Fassq (param, alist);
1414 if (EQ (tem, Qnil))
1415 tem = Fassq (param, Vdefault_screen_alist);
1416 if (EQ (tem, Qnil) && attribute)
1418 Lisp_Object sterile_name;
1420 /* Build a version of screen name that is safe to use as a
1421 component name. */
1422 if (XTYPE (screen_name) == Lisp_String)
1424 int i;
1426 sterile_name = make_uninit_string (XSTRING (screen_name)->size);
1427 for (i = 0; i < XSTRING (screen_name)->size; i++)
1429 int c = XSTRING (screen_name)->data[i];
1431 switch (c)
1433 case ':':
1434 case '.':
1435 case '*':
1436 case ' ':
1437 case '\t':
1438 case '\n':
1439 c = '_';
1440 break;
1441 default:
1442 break;
1445 XSTRING (sterile_name)->data[i] = c;
1448 else
1449 sterile_name = Qnil;
1451 tem = Fx_get_resource (build_string (attribute),
1452 sterile_name,
1453 (NILP (sterile_name) ? Qnil : screen_class));
1455 if (NILP (tem))
1456 return Qnil;
1458 switch (type)
1460 case number:
1461 return make_number (atoi (XSTRING (tem)->data));
1463 case boolean:
1464 tem = Fdowncase (tem);
1465 if (!strcmp (XSTRING (tem)->data, "on")
1466 || !strcmp (XSTRING (tem)->data, "true"))
1467 return Qt;
1468 else
1469 return Qnil;
1471 case string:
1472 return tem;
1474 default:
1475 abort ();
1478 return Fcdr (tem);
1481 /* Record in screen S the specified or default value according to ALIST
1482 of the parameter named PARAM (a Lisp symbol).
1483 If no value is specified for PARAM, look for an X default for XPROP
1484 on the screen named NAME.
1485 If that is not found either, use the value DEFLT. */
1487 static Lisp_Object
1488 x_default_parameter (s, alist, propname, deflt, xprop, type)
1489 struct screen *s;
1490 Lisp_Object alist;
1491 char *propname;
1492 Lisp_Object deflt;
1493 char *xprop;
1494 enum resource_types type;
1496 Lisp_Object propsym = intern (propname);
1497 Lisp_Object tem;
1499 tem = x_get_arg (alist, propsym, s->name, xprop, type);
1500 if (EQ (tem, Qnil))
1501 tem = deflt;
1502 store_screen_param (s, propsym, tem);
1503 x_set_screen_param (s, propsym, tem, Qnil);
1504 return tem;
1507 DEFUN ("x-geometry", Fx_geometry, Sx_geometry, 1, 1, 0,
1508 "Parse an X-style geometry string STRING.\n\
1509 Returns an alist of the form ((top . TOP), (left . LEFT) ... ).")
1510 (string)
1512 int geometry, x, y;
1513 unsigned int width, height;
1514 Lisp_Object values[4];
1516 CHECK_STRING (string, 0);
1518 geometry = XParseGeometry ((char *) XSTRING (string)->data,
1519 &x, &y, &width, &height);
1521 switch (geometry & 0xf) /* Mask out {X,Y}Negative */
1523 case (XValue | YValue):
1524 /* What's one pixel among friends?
1525 Perhaps fix this some day by returning symbol `extreme-top'... */
1526 if (x == 0 && (geometry & XNegative))
1527 x = -1;
1528 if (y == 0 && (geometry & YNegative))
1529 y = -1;
1530 values[0] = Fcons (intern ("left"), make_number (x));
1531 values[1] = Fcons (intern ("top"), make_number (y));
1532 return Flist (2, values);
1533 break;
1535 case (WidthValue | HeightValue):
1536 values[0] = Fcons (intern ("width"), make_number (width));
1537 values[1] = Fcons (intern ("height"), make_number (height));
1538 return Flist (2, values);
1539 break;
1541 case (XValue | YValue | WidthValue | HeightValue):
1542 if (x == 0 && (geometry & XNegative))
1543 x = -1;
1544 if (y == 0 && (geometry & YNegative))
1545 y = -1;
1546 values[0] = Fcons (intern ("width"), make_number (width));
1547 values[1] = Fcons (intern ("height"), make_number (height));
1548 values[2] = Fcons (intern ("left"), make_number (x));
1549 values[3] = Fcons (intern ("top"), make_number (y));
1550 return Flist (4, values);
1551 break;
1553 case 0:
1554 return Qnil;
1556 default:
1557 error ("Must specify x and y value, and/or width and height");
1561 #ifdef HAVE_X11
1562 /* Calculate the desired size and position of this window,
1563 or set rubber-band prompting if none. */
1565 #define DEFAULT_ROWS 40
1566 #define DEFAULT_COLS 80
1568 static
1569 x_figure_window_size (s, parms)
1570 struct screen *s;
1571 Lisp_Object parms;
1573 register Lisp_Object tem0, tem1;
1574 int height, width, left, top;
1575 register int geometry;
1576 long window_prompting = 0;
1578 /* Default values if we fall through.
1579 Actually, if that happens we should get
1580 window manager prompting. */
1581 s->width = DEFAULT_COLS;
1582 s->height = DEFAULT_ROWS;
1583 s->display.x->top_pos = 1;
1584 s->display.x->left_pos = 1;
1586 tem0 = x_get_arg (parms, intern ("height"), s->name, 0, 0);
1587 tem1 = x_get_arg (parms, intern ("width"), s->name, 0, 0);
1588 if (! EQ (tem0, Qnil) && ! EQ (tem1, Qnil))
1590 CHECK_NUMBER (tem0, 0);
1591 CHECK_NUMBER (tem1, 0);
1592 s->height = XINT (tem0);
1593 s->width = XINT (tem1);
1594 window_prompting |= USSize;
1596 else if (! EQ (tem0, Qnil) || ! EQ (tem1, Qnil))
1597 error ("Must specify *both* height and width");
1599 s->display.x->pixel_width = (FONT_WIDTH (s->display.x->font) * s->width
1600 + 2 * s->display.x->internal_border_width);
1601 s->display.x->pixel_height = (FONT_HEIGHT (s->display.x->font) * s->height
1602 + 2 * s->display.x->internal_border_width);
1604 tem0 = x_get_arg (parms, intern ("top"), s->name, 0, 0);
1605 tem1 = x_get_arg (parms, intern ("left"), s->name, 0, 0);
1606 if (! EQ (tem0, Qnil) && ! EQ (tem1, Qnil))
1608 CHECK_NUMBER (tem0, 0);
1609 CHECK_NUMBER (tem1, 0);
1610 s->display.x->top_pos = XINT (tem0);
1611 s->display.x->left_pos = XINT (tem1);
1612 x_calc_absolute_position (s);
1613 window_prompting |= USPosition;
1615 else if (! EQ (tem0, Qnil) || ! EQ (tem1, Qnil))
1616 error ("Must specify *both* top and left corners");
1618 switch (window_prompting)
1620 case USSize | USPosition:
1621 return window_prompting;
1622 break;
1624 case USSize: /* Got the size, need the position. */
1625 window_prompting |= PPosition;
1626 return window_prompting;
1627 break;
1629 case USPosition: /* Got the position, need the size. */
1630 window_prompting |= PSize;
1631 return window_prompting;
1632 break;
1634 case 0: /* Got nothing, take both from geometry. */
1635 window_prompting |= PPosition | PSize;
1636 return window_prompting;
1637 break;
1639 default:
1640 /* Somehow a bit got set in window_prompting that we didn't
1641 put there. */
1642 abort ();
1646 static void
1647 x_window (s)
1648 struct screen *s;
1650 XSetWindowAttributes attributes;
1651 unsigned long attribute_mask;
1652 XClassHint class_hints;
1654 attributes.background_pixel = s->display.x->background_pixel;
1655 attributes.border_pixel = s->display.x->border_pixel;
1656 attributes.bit_gravity = StaticGravity;
1657 attributes.backing_store = NotUseful;
1658 attributes.save_under = True;
1659 attributes.event_mask = STANDARD_EVENT_SET;
1660 attribute_mask = (CWBackPixel | CWBorderPixel | CWBitGravity
1661 #if 0
1662 | CWBackingStore | CWSaveUnder
1663 #endif
1664 | CWEventMask);
1666 BLOCK_INPUT;
1667 s->display.x->window_desc
1668 = XCreateWindow (x_current_display, ROOT_WINDOW,
1669 s->display.x->left_pos,
1670 s->display.x->top_pos,
1671 PIXEL_WIDTH (s), PIXEL_HEIGHT (s),
1672 s->display.x->border_width,
1673 CopyFromParent, /* depth */
1674 InputOutput, /* class */
1675 screen_visual, /* set in Fx_open_connection */
1676 attribute_mask, &attributes);
1678 class_hints.res_name = (char *) XSTRING (s->name)->data;
1679 class_hints.res_class = EMACS_CLASS;
1680 XSetClassHint (x_current_display, s->display.x->window_desc, &class_hints);
1682 XDefineCursor (XDISPLAY s->display.x->window_desc,
1683 s->display.x->text_cursor);
1684 UNBLOCK_INPUT;
1686 if (s->display.x->window_desc == 0)
1687 error ("Unable to create window.");
1690 /* Handle the icon stuff for this window. Perhaps later we might
1691 want an x_set_icon_position which can be called interactively as
1692 well. */
1694 static void
1695 x_icon (s, parms)
1696 struct screen *s;
1697 Lisp_Object parms;
1699 register Lisp_Object tem0,tem1;
1700 XWMHints hints;
1702 /* Set the position of the icon. Note that twm groups all
1703 icons in an icon window. */
1704 tem0 = x_get_arg (parms, intern ("icon-left"), s->name, 0, 0);
1705 tem1 = x_get_arg (parms, intern ("icon-top"), s->name, 0, 0);
1706 if (!EQ (tem0, Qnil) && !EQ (tem1, Qnil))
1708 CHECK_NUMBER (tem0, 0);
1709 CHECK_NUMBER (tem1, 0);
1710 hints.icon_x = XINT (tem0);
1711 hints.icon_x = XINT (tem0);
1713 else if (!EQ (tem0, Qnil) || !EQ (tem1, Qnil))
1714 error ("Both left and top icon corners of icon must be specified");
1715 else
1717 hints.icon_x = s->display.x->left_pos;
1718 hints.icon_y = s->display.x->top_pos;
1721 /* Start up iconic or window? */
1722 tem0 = x_get_arg (parms, intern ("iconic-startup"), s->name, 0, 0);
1723 if (!EQ (tem0, Qnil))
1724 hints.initial_state = IconicState;
1725 else
1726 hints.initial_state = NormalState; /* the default, actually. */
1727 hints.input = False;
1729 BLOCK_INPUT;
1730 hints.flags = StateHint | IconPositionHint | InputHint;
1731 XSetWMHints (x_current_display, s->display.x->window_desc, &hints);
1732 UNBLOCK_INPUT;
1735 /* Make the GC's needed for this window, setting the
1736 background, border and mouse colors; also create the
1737 mouse cursor and the gray border tile. */
1739 static void
1740 x_make_gc (s)
1741 struct screen *s;
1743 XGCValues gc_values;
1744 GC temp_gc;
1745 XImage tileimage;
1746 static char cursor_bits[] =
1748 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
1749 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
1750 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
1751 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00
1754 /* Create the GC's of this screen.
1755 Note that many default values are used. */
1757 /* Normal video */
1758 gc_values.font = s->display.x->font->fid;
1759 gc_values.foreground = s->display.x->foreground_pixel;
1760 gc_values.background = s->display.x->background_pixel;
1761 gc_values.line_width = 0; /* Means 1 using fast algorithm. */
1762 s->display.x->normal_gc = XCreateGC (x_current_display,
1763 s->display.x->window_desc,
1764 GCLineWidth | GCFont
1765 | GCForeground | GCBackground,
1766 &gc_values);
1768 /* Reverse video style. */
1769 gc_values.foreground = s->display.x->background_pixel;
1770 gc_values.background = s->display.x->foreground_pixel;
1771 s->display.x->reverse_gc = XCreateGC (x_current_display,
1772 s->display.x->window_desc,
1773 GCFont | GCForeground | GCBackground
1774 | GCLineWidth,
1775 &gc_values);
1777 /* Cursor has cursor-color background, background-color foreground. */
1778 gc_values.foreground = s->display.x->background_pixel;
1779 gc_values.background = s->display.x->cursor_pixel;
1780 gc_values.fill_style = FillOpaqueStippled;
1781 gc_values.stipple
1782 = XCreateBitmapFromData (x_current_display, ROOT_WINDOW,
1783 cursor_bits, 16, 16);
1784 s->display.x->cursor_gc
1785 = XCreateGC (x_current_display, s->display.x->window_desc,
1786 (GCFont | GCForeground | GCBackground
1787 | GCFillStyle | GCStipple | GCLineWidth),
1788 &gc_values);
1790 /* Create the gray border tile used when the pointer is not in
1791 the screen. Since this depends on the screen's pixel values,
1792 this must be done on a per-screen basis. */
1793 s->display.x->border_tile =
1794 XCreatePixmap (x_current_display, ROOT_WINDOW, 16, 16,
1795 DefaultDepth (x_current_display,
1796 XDefaultScreen (x_current_display)));
1797 gc_values.foreground = s->display.x->foreground_pixel;
1798 gc_values.background = s->display.x->background_pixel;
1799 temp_gc = XCreateGC (x_current_display,
1800 (Drawable) s->display.x->border_tile,
1801 GCForeground | GCBackground, &gc_values);
1803 /* These are things that should be determined by the server, in
1804 Fx_open_connection */
1805 tileimage.height = 16;
1806 tileimage.width = 16;
1807 tileimage.xoffset = 0;
1808 tileimage.format = XYBitmap;
1809 tileimage.data = gray_bits;
1810 tileimage.byte_order = LSBFirst;
1811 tileimage.bitmap_unit = 8;
1812 tileimage.bitmap_bit_order = LSBFirst;
1813 tileimage.bitmap_pad = 8;
1814 tileimage.bytes_per_line = (16 + 7) >> 3;
1815 tileimage.depth = 1;
1816 XPutImage (x_current_display, s->display.x->border_tile, temp_gc,
1817 &tileimage, 0, 0, 0, 0, 16, 16);
1818 XFreeGC (x_current_display, temp_gc);
1820 #endif /* HAVE_X11 */
1822 DEFUN ("x-create-screen", Fx_create_screen, Sx_create_screen,
1823 1, 1, 0,
1824 "Make a new X window, which is called a \"screen\" in Emacs terms.\n\
1825 Return an Emacs screen object representing the X window.\n\
1826 ALIST is an alist of screen parameters.\n\
1827 The value of ``x-screen-defaults'' is an additional alist\n\
1828 of default parameters which apply when not overridden by ALIST.\n\
1829 If the parameters specify that the screen should not have a minibuffer,\n\
1830 then ``default-minibuffer-screen'' must be a screen whose minibuffer can\n\
1831 be shared by the new screen.")
1832 (parms)
1833 Lisp_Object parms;
1835 #ifdef HAVE_X11
1836 struct screen *s;
1837 Lisp_Object screen, tem;
1838 Lisp_Object name;
1839 int minibuffer_only = 0;
1840 long window_prompting = 0;
1841 int width, height;
1843 if (x_current_display == 0)
1844 error ("X windows are not in use or not initialized");
1846 name = x_get_arg (parms, intern ("name"), Qnil, "Title", string);
1847 if (NILP (name))
1848 name = build_string (x_id_name);
1849 if (XTYPE (name) != Lisp_String)
1850 error ("x-create-screen: name parameter must be a string");
1852 tem = x_get_arg (parms, intern ("minibuffer"), name, 0, 0);
1853 if (EQ (tem, intern ("none")))
1854 s = make_screen_without_minibuffer (Qnil);
1855 else if (EQ (tem, intern ("only")))
1857 s = make_minibuffer_screen ();
1858 minibuffer_only = 1;
1860 else if (EQ (tem, Qnil) || EQ (tem, Qt))
1861 s = make_screen (1);
1862 else
1863 s = make_screen_without_minibuffer (tem);
1865 /* Set the name; the functions to which we pass s expect the
1866 name to be set. */
1867 XSET (s->name, Lisp_String, name);
1869 XSET (screen, Lisp_Screen, s);
1870 s->output_method = output_x_window;
1871 s->display.x = (struct x_display *) xmalloc (sizeof (struct x_display));
1872 bzero (s->display.x, sizeof (struct x_display));
1874 /* Note that the screen has no physical cursor right now. */
1875 s->phys_cursor_x = -1;
1877 /* Extract the window parameters from the supplied values
1878 that are needed to determine window geometry. */
1879 x_default_parameter (s, parms, "font",
1880 build_string ("9x15"), "font", string);
1881 x_default_parameter (s, parms, "background-color",
1882 build_string ("white"), "background", string);
1883 x_default_parameter (s, parms, "border-width",
1884 make_number (2), "BorderWidth", number);
1885 x_default_parameter (s, parms, "internal-border-width",
1886 make_number (1), "InternalBorderWidth", number);
1888 /* Also do the stuff which must be set before the window exists. */
1889 x_default_parameter (s, parms, "foreground-color",
1890 build_string ("black"), "foreground", string);
1891 x_default_parameter (s, parms, "mouse-color",
1892 build_string ("black"), "mouse", string);
1893 x_default_parameter (s, parms, "cursor-color",
1894 build_string ("black"), "cursor", string);
1895 x_default_parameter (s, parms, "border-color",
1896 build_string ("black"), "border", string);
1898 /* Need to do icon type, auto-raise, auto-lower. */
1900 s->display.x->parent_desc = ROOT_WINDOW;
1901 window_prompting = x_figure_window_size (s, parms);
1903 x_window (s);
1904 x_icon (s, parms);
1905 x_make_gc (s);
1907 /* Dimensions, especially s->height, must be done via change_screen_size.
1908 Change will not be effected unless different from the current
1909 s->height. */
1910 width = s->width;
1911 height = s->height;
1912 s->height = s->width = 0;
1913 change_screen_size (s, height, width, 1);
1914 BLOCK_INPUT;
1915 x_wm_set_size_hint (s, window_prompting);
1916 UNBLOCK_INPUT;
1918 tem = x_get_arg (parms, intern ("unsplittable"), name, 0, 0);
1919 s->no_split = minibuffer_only || EQ (tem, Qt);
1921 /* Now handle the rest of the parameters. */
1922 x_default_parameter (s, parms, "horizontal-scroll-bar",
1923 Qnil, "?HScrollBar", string);
1924 x_default_parameter (s, parms, "vertical-scroll-bar",
1925 Qnil, "?VScrollBar", string);
1927 /* Make the window appear on the screen and enable display. */
1928 if (!EQ (x_get_arg (parms, intern ("suppress-initial-map"), name, 0, 0), Qt))
1929 x_make_screen_visible (s);
1931 return screen;
1932 #else /* X10 */
1933 struct screen *s;
1934 Lisp_Object screen, tem;
1935 Lisp_Object name;
1936 int pixelwidth, pixelheight;
1937 Cursor cursor;
1938 int height, width;
1939 Window parent;
1940 Pixmap temp;
1941 int minibuffer_only = 0;
1942 Lisp_Object vscroll, hscroll;
1944 if (x_current_display == 0)
1945 error ("X windows are not in use or not initialized");
1947 name = Fassq (intern ("name"), parms);
1949 tem = x_get_arg (parms, intern ("minibuffer"), name, 0, 0);
1950 if (EQ (tem, intern ("none")))
1951 s = make_screen_without_minibuffer (Qnil);
1952 else if (EQ (tem, intern ("only")))
1954 s = make_minibuffer_screen ();
1955 minibuffer_only = 1;
1957 else if (! EQ (tem, Qnil))
1958 s = make_screen_without_minibuffer (tem);
1959 else
1960 s = make_screen (1);
1962 parent = ROOT_WINDOW;
1964 XSET (screen, Lisp_Screen, s);
1965 s->output_method = output_x_window;
1966 s->display.x = (struct x_display *) xmalloc (sizeof (struct x_display));
1967 bzero (s->display.x, sizeof (struct x_display));
1969 /* Some temprorary default values for height and width. */
1970 width = 80;
1971 height = 40;
1972 s->display.x->left_pos = -1;
1973 s->display.x->top_pos = -1;
1975 /* Give the screen a default name (which may be overridden with PARMS). */
1977 strncpy (iconidentity, ICONTAG, MAXICID);
1978 if (gethostname (&iconidentity[sizeof (ICONTAG) - 1],
1979 (MAXICID - 1) - sizeof (ICONTAG)))
1980 iconidentity[sizeof (ICONTAG) - 2] = '\0';
1981 s->name = build_string (iconidentity);
1983 /* Extract some window parameters from the supplied values.
1984 These are the parameters that affect window geometry. */
1986 tem = x_get_arg (parms, intern ("font"), name, "BodyFont", string);
1987 if (EQ (tem, Qnil))
1988 tem = build_string ("9x15");
1989 x_set_font (s, tem);
1990 x_default_parameter (s, parms, "border-color",
1991 build_string ("black"), "Border", string);
1992 x_default_parameter (s, parms, "background-color",
1993 build_string ("white"), "Background", string);
1994 x_default_parameter (s, parms, "foreground-color",
1995 build_string ("black"), "Foreground", string);
1996 x_default_parameter (s, parms, "mouse-color",
1997 build_string ("black"), "Mouse", string);
1998 x_default_parameter (s, parms, "cursor-color",
1999 build_string ("black"), "Cursor", string);
2000 x_default_parameter (s, parms, "border-width",
2001 make_number (2), "BorderWidth", number);
2002 x_default_parameter (s, parms, "internal-border-width",
2003 make_number (4), "InternalBorderWidth", number);
2004 x_default_parameter (s, parms, "auto-raise",
2005 Qnil, "AutoRaise", boolean);
2007 hscroll = x_get_arg (parms, intern ("horizontal-scroll-bar"), name, 0, 0);
2008 vscroll = x_get_arg (parms, intern ("vertical-scroll-bar"), name, 0, 0);
2010 if (s->display.x->internal_border_width < 0)
2011 s->display.x->internal_border_width = 0;
2013 tem = x_get_arg (parms, intern ("window-id"), name, 0, 0);
2014 if (!EQ (tem, Qnil))
2016 WINDOWINFO_TYPE wininfo;
2017 int nchildren;
2018 Window *children, root;
2020 CHECK_STRING (tem, 0);
2021 s->display.x->window_desc = (Window) atoi (XSTRING (tem)->data);
2023 BLOCK_INPUT;
2024 XGetWindowInfo (s->display.x->window_desc, &wininfo);
2025 XQueryTree (s->display.x->window_desc, &parent, &nchildren, &children);
2026 free (children);
2027 UNBLOCK_INPUT;
2029 height = (wininfo.height - 2 * s->display.x->internal_border_width)
2030 / FONT_HEIGHT (s->display.x->font);
2031 width = (wininfo.width - 2 * s->display.x->internal_border_width)
2032 / FONT_WIDTH (s->display.x->font);
2033 s->display.x->left_pos = wininfo.x;
2034 s->display.x->top_pos = wininfo.y;
2035 s->visible = wininfo.mapped != 0;
2036 s->display.x->border_width = wininfo.bdrwidth;
2037 s->display.x->parent_desc = parent;
2039 else
2041 tem = x_get_arg (parms, intern ("parent-id"), name, 0, 0);
2042 if (!EQ (tem, Qnil))
2044 CHECK_STRING (tem, 0);
2045 parent = (Window) atoi (XSTRING (tem)->data);
2047 s->display.x->parent_desc = parent;
2048 tem = x_get_arg (parms, intern ("height"), name, 0, 0);
2049 if (EQ (tem, Qnil))
2051 tem = x_get_arg (parms, intern ("width"), name, 0, 0);
2052 if (EQ (tem, Qnil))
2054 tem = x_get_arg (parms, intern ("top"), name, 0, 0);
2055 if (EQ (tem, Qnil))
2056 tem = x_get_arg (parms, intern ("left"), name, 0, 0);
2059 /* Now TEM is nil if no edge or size was specified.
2060 In that case, we must do rubber-banding. */
2061 if (EQ (tem, Qnil))
2063 tem = x_get_arg (parms, intern ("geometry"), name, 0, 0);
2064 x_rubber_band (s,
2065 &s->display.x->left_pos, &s->display.x->top_pos,
2066 &width, &height,
2067 (XTYPE (tem) == Lisp_String
2068 ? (char *) XSTRING (tem)->data : ""),
2069 XSTRING (s->name)->data,
2070 !NILP (hscroll), !NILP (vscroll));
2072 else
2074 /* Here if at least one edge or size was specified.
2075 Demand that they all were specified, and use them. */
2076 tem = x_get_arg (parms, intern ("height"), name, 0, 0);
2077 if (EQ (tem, Qnil))
2078 error ("Height not specified");
2079 CHECK_NUMBER (tem, 0);
2080 height = XINT (tem);
2082 tem = x_get_arg (parms, intern ("width"), name, 0, 0);
2083 if (EQ (tem, Qnil))
2084 error ("Width not specified");
2085 CHECK_NUMBER (tem, 0);
2086 width = XINT (tem);
2088 tem = x_get_arg (parms, intern ("top"), name, 0, 0);
2089 if (EQ (tem, Qnil))
2090 error ("Top position not specified");
2091 CHECK_NUMBER (tem, 0);
2092 s->display.x->left_pos = XINT (tem);
2094 tem = x_get_arg (parms, intern ("left"), name, 0, 0);
2095 if (EQ (tem, Qnil))
2096 error ("Left position not specified");
2097 CHECK_NUMBER (tem, 0);
2098 s->display.x->top_pos = XINT (tem);
2101 pixelwidth = (width * FONT_WIDTH (s->display.x->font)
2102 + 2 * s->display.x->internal_border_width
2103 + (!NILP (vscroll) ? VSCROLL_WIDTH : 0));
2104 pixelheight = (height * FONT_HEIGHT (s->display.x->font)
2105 + 2 * s->display.x->internal_border_width
2106 + (!NILP (hscroll) ? HSCROLL_HEIGHT : 0));
2108 BLOCK_INPUT;
2109 s->display.x->window_desc
2110 = XCreateWindow (parent,
2111 s->display.x->left_pos, /* Absolute horizontal offset */
2112 s->display.x->top_pos, /* Absolute Vertical offset */
2113 pixelwidth, pixelheight,
2114 s->display.x->border_width,
2115 BLACK_PIX_DEFAULT, WHITE_PIX_DEFAULT);
2116 UNBLOCK_INPUT;
2117 if (s->display.x->window_desc == 0)
2118 error ("Unable to create window.");
2121 /* Install the now determined height and width
2122 in the windows and in phys_lines and desired_lines. */
2123 /* ??? jla version had 1 here instead of 0. */
2124 change_screen_size (s, height, width, 1);
2125 XSelectInput (s->display.x->window_desc, KeyPressed | ExposeWindow
2126 | ButtonPressed | ButtonReleased | ExposeRegion | ExposeCopy
2127 | EnterWindow | LeaveWindow | UnmapWindow );
2128 x_set_resize_hint (s);
2130 /* Tell the server the window's default name. */
2132 XStoreName (XDISPLAY s->display.x->window_desc, XSTRING (s->name)->data);
2133 /* Now override the defaults with all the rest of the specified
2134 parms. */
2135 tem = x_get_arg (parms, intern ("unsplittable"), name, 0, 0);
2136 s->no_split = minibuffer_only || EQ (tem, Qt);
2138 /* Do not create an icon window if the caller says not to */
2139 if (!EQ (x_get_arg (parms, intern ("suppress-icon"), name, 0, 0), Qt)
2140 || s->display.x->parent_desc != ROOT_WINDOW)
2142 x_text_icon (s, iconidentity);
2143 x_default_parameter (s, parms, "icon-type", Qnil,
2144 "BitmapIcon", boolean);
2147 /* Tell the X server the previously set values of the
2148 background, border and mouse colors; also create the mouse cursor. */
2149 BLOCK_INPUT;
2150 temp = XMakeTile (s->display.x->background_pixel);
2151 XChangeBackground (s->display.x->window_desc, temp);
2152 XFreePixmap (temp);
2153 UNBLOCK_INPUT;
2154 x_set_border_pixel (s, s->display.x->border_pixel);
2156 x_set_mouse_color (s, Qnil, Qnil);
2158 /* Now override the defaults with all the rest of the specified parms. */
2160 Fmodify_screen_parameters (screen, parms);
2162 if (!NILP (vscroll))
2163 install_vertical_scrollbar (s, pixelwidth, pixelheight);
2164 if (!NILP (hscroll))
2165 install_horizontal_scrollbar (s, pixelwidth, pixelheight);
2167 /* Make the window appear on the screen and enable display. */
2169 if (!EQ (x_get_arg (parms, intern ("suppress-initial-map"), name, 0, 0), Qt))
2170 x_make_window_visible (s);
2171 SCREEN_GARBAGED (s);
2173 return screen;
2174 #endif /* X10 */
2177 DEFUN ("focus-screen", Ffocus_screen, Sfocus_screen, 1, 1, 0,
2178 "Set the focus on SCREEN.")
2179 (screen)
2180 Lisp_Object screen;
2182 CHECK_LIVE_SCREEN (screen, 0);
2184 if (SCREEN_IS_X (XSCREEN (screen)))
2186 BLOCK_INPUT;
2187 x_focus_on_screen (XSCREEN (screen));
2188 UNBLOCK_INPUT;
2189 return screen;
2192 return Qnil;
2195 DEFUN ("unfocus-screen", Funfocus_screen, Sunfocus_screen, 0, 0, 0,
2196 "If a screen has been focused, release it.")
2199 if (x_focus_screen)
2201 BLOCK_INPUT;
2202 x_unfocus_screen (x_focus_screen);
2203 UNBLOCK_INPUT;
2206 return Qnil;
2209 #ifndef HAVE_X11
2210 /* Computes an X-window size and position either from geometry GEO
2211 or with the mouse.
2213 S is a screen. It specifies an X window which is used to
2214 determine which display to compute for. Its font, borders
2215 and colors control how the rectangle will be displayed.
2217 X and Y are where to store the positions chosen.
2218 WIDTH and HEIGHT are where to store the sizes chosen.
2220 GEO is the geometry that may specify some of the info.
2221 STR is a prompt to display.
2222 HSCROLL and VSCROLL say whether we have horiz and vert scroll bars. */
2225 x_rubber_band (s, x, y, width, height, geo, str, hscroll, vscroll)
2226 struct screen *s;
2227 int *x, *y, *width, *height;
2228 char *geo;
2229 char *str;
2230 int hscroll, vscroll;
2232 OpaqueFrame frame;
2233 Window tempwindow;
2234 WindowInfo wininfo;
2235 int border_color;
2236 int background_color;
2237 Lisp_Object tem;
2238 int mask;
2240 BLOCK_INPUT;
2242 background_color = s->display.x->background_pixel;
2243 border_color = s->display.x->border_pixel;
2245 frame.bdrwidth = s->display.x->border_width;
2246 frame.border = XMakeTile (border_color);
2247 frame.background = XMakeTile (background_color);
2248 tempwindow = XCreateTerm (str, "emacs", geo, default_window, &frame, 10, 5,
2249 (2 * s->display.x->internal_border_width
2250 + (vscroll ? VSCROLL_WIDTH : 0)),
2251 (2 * s->display.x->internal_border_width
2252 + (hscroll ? HSCROLL_HEIGHT : 0)),
2253 width, height, s->display.x->font,
2254 FONT_WIDTH (s->display.x->font),
2255 FONT_HEIGHT (s->display.x->font));
2256 XFreePixmap (frame.border);
2257 XFreePixmap (frame.background);
2259 if (tempwindow != 0)
2261 XQueryWindow (tempwindow, &wininfo);
2262 XDestroyWindow (tempwindow);
2263 *x = wininfo.x;
2264 *y = wininfo.y;
2267 /* Coordinates we got are relative to the root window.
2268 Convert them to coordinates relative to desired parent window
2269 by scanning from there up to the root. */
2270 tempwindow = s->display.x->parent_desc;
2271 while (tempwindow != ROOT_WINDOW)
2273 int nchildren;
2274 Window *children;
2275 XQueryWindow (tempwindow, &wininfo);
2276 *x -= wininfo.x;
2277 *y -= wininfo.y;
2278 XQueryTree (tempwindow, &tempwindow, &nchildren, &children);
2279 free (children);
2282 UNBLOCK_INPUT;
2283 return tempwindow != 0;
2285 #endif /* not HAVE_X11 */
2287 /* Set whether screen S has a horizontal scroll bar.
2288 VAL is t or nil to specify it. */
2290 static void
2291 x_set_horizontal_scrollbar (s, val, oldval)
2292 struct screen *s;
2293 Lisp_Object val, oldval;
2295 if (!NILP (val))
2297 if (s->display.x->window_desc != 0)
2299 BLOCK_INPUT;
2300 s->display.x->h_scrollbar_height = HSCROLL_HEIGHT;
2301 x_set_window_size (s, s->width, s->height);
2302 install_horizontal_scrollbar (s);
2303 SET_SCREEN_GARBAGED (s);
2304 UNBLOCK_INPUT;
2307 else
2308 if (s->display.x->h_scrollbar)
2310 BLOCK_INPUT;
2311 s->display.x->h_scrollbar_height = 0;
2312 XDestroyWindow (XDISPLAY s->display.x->h_scrollbar);
2313 s->display.x->h_scrollbar = 0;
2314 x_set_window_size (s, s->width, s->height);
2315 s->garbaged++;
2316 screen_garbaged++;
2317 BLOCK_INPUT;
2321 /* Set whether screen S has a vertical scroll bar.
2322 VAL is t or nil to specify it. */
2324 static void
2325 x_set_vertical_scrollbar (s, val, oldval)
2326 struct screen *s;
2327 Lisp_Object val, oldval;
2329 if (!NILP (val))
2331 if (s->display.x->window_desc != 0)
2333 BLOCK_INPUT;
2334 s->display.x->v_scrollbar_width = VSCROLL_WIDTH;
2335 x_set_window_size (s, s->width, s->height);
2336 install_vertical_scrollbar (s);
2337 SET_SCREEN_GARBAGED (s);
2338 UNBLOCK_INPUT;
2341 else
2342 if (s->display.x->v_scrollbar != 0)
2344 BLOCK_INPUT;
2345 s->display.x->v_scrollbar_width = 0;
2346 XDestroyWindow (XDISPLAY s->display.x->v_scrollbar);
2347 s->display.x->v_scrollbar = 0;
2348 x_set_window_size (s, s->width, s->height);
2349 SET_SCREEN_GARBAGED (s);
2350 UNBLOCK_INPUT;
2354 /* Create the X windows for a vertical scroll bar
2355 for a screen X that already has an X window but no scroll bar. */
2357 static void
2358 install_vertical_scrollbar (s)
2359 struct screen *s;
2361 int ibw = s->display.x->internal_border_width;
2362 Window parent;
2363 XColor fore_color, back_color;
2364 Pixmap up_arrow_pixmap, down_arrow_pixmap, slider_pixmap;
2365 int pix_x, pix_y, width, height, border;
2367 height = s->display.x->pixel_height - ibw - 2;
2368 width = VSCROLL_WIDTH - 2;
2369 pix_x = s->display.x->pixel_width - ibw/2;
2370 pix_y = ibw / 2;
2371 border = 1;
2373 #ifdef HAVE_X11
2374 up_arrow_pixmap =
2375 XCreatePixmapFromBitmapData (x_current_display, s->display.x->window_desc,
2376 up_arrow_bits, 16, 16,
2377 s->display.x->foreground_pixel,
2378 s->display.x->background_pixel,
2379 DefaultDepth (x_current_display,
2380 XDefaultScreen (x_current_display)));
2382 down_arrow_pixmap =
2383 XCreatePixmapFromBitmapData (x_current_display, s->display.x->window_desc,
2384 down_arrow_bits, 16, 16,
2385 s->display.x->foreground_pixel,
2386 s->display.x->background_pixel,
2387 DefaultDepth (x_current_display,
2388 XDefaultScreen (x_current_display)));
2390 slider_pixmap =
2391 XCreatePixmapFromBitmapData (x_current_display, s->display.x->window_desc,
2392 gray_bits, 16, 16,
2393 s->display.x->foreground_pixel,
2394 s->display.x->background_pixel,
2395 DefaultDepth (x_current_display,
2396 XDefaultScreen (x_current_display)));
2398 /* These cursor shapes will be installed when the mouse enters
2399 the appropriate window. */
2401 up_arrow_cursor = XCreateFontCursor (x_current_display, XC_sb_up_arrow);
2402 down_arrow_cursor = XCreateFontCursor (x_current_display, XC_sb_down_arrow);
2403 v_double_arrow_cursor = XCreateFontCursor (x_current_display, XC_sb_v_double_arrow);
2405 s->display.x->v_scrollbar =
2406 XCreateSimpleWindow (x_current_display, s->display.x->window_desc,
2407 pix_x, pix_y, width, height, border,
2408 s->display.x->foreground_pixel,
2409 s->display.x->background_pixel);
2410 XFlush (x_current_display);
2411 XDefineCursor (x_current_display, s->display.x->v_scrollbar,
2412 v_double_arrow_cursor);
2414 /* Create slider window */
2415 s->display.x->v_slider =
2416 XCreateSimpleWindow (x_current_display, s->display.x->v_scrollbar,
2417 0, VSCROLL_WIDTH - 2,
2418 VSCROLL_WIDTH - 4, VSCROLL_WIDTH - 4,
2419 1, s->display.x->border_pixel,
2420 s->display.x->foreground_pixel);
2421 XFlush (x_current_display);
2422 XDefineCursor (x_current_display, s->display.x->v_slider,
2423 v_double_arrow_cursor);
2424 XSetWindowBackgroundPixmap (x_current_display, s->display.x->v_slider,
2425 slider_pixmap);
2427 s->display.x->v_thumbup =
2428 XCreateSimpleWindow (x_current_display, s->display.x->v_scrollbar,
2429 0, 0,
2430 VSCROLL_WIDTH - 2, VSCROLL_WIDTH - 2,
2431 0, s->display.x->foreground_pixel,
2432 s->display.x-> background_pixel);
2433 XFlush (x_current_display);
2434 XDefineCursor (x_current_display, s->display.x->v_thumbup,
2435 up_arrow_cursor);
2436 XSetWindowBackgroundPixmap (x_current_display, s->display.x->v_thumbup,
2437 up_arrow_pixmap);
2439 s->display.x->v_thumbdown =
2440 XCreateSimpleWindow (x_current_display, s->display.x->v_scrollbar,
2441 0, height - VSCROLL_WIDTH + 2,
2442 VSCROLL_WIDTH - 2, VSCROLL_WIDTH - 2,
2443 0, s->display.x->foreground_pixel,
2444 s->display.x->background_pixel);
2445 XFlush (x_current_display);
2446 XDefineCursor (x_current_display, s->display.x->v_thumbdown,
2447 down_arrow_cursor);
2448 XSetWindowBackgroundPixmap (x_current_display, s->display.x->v_thumbdown,
2449 down_arrow_pixmap);
2451 fore_color.pixel = s->display.x->mouse_pixel;
2452 back_color.pixel = s->display.x->background_pixel;
2453 XQueryColor (x_current_display,
2454 DefaultColormap (x_current_display,
2455 DefaultScreen (x_current_display)),
2456 &fore_color);
2457 XQueryColor (x_current_display,
2458 DefaultColormap (x_current_display,
2459 DefaultScreen (x_current_display)),
2460 &back_color);
2461 XRecolorCursor (x_current_display, up_arrow_cursor,
2462 &fore_color, &back_color);
2463 XRecolorCursor (x_current_display, down_arrow_cursor,
2464 &fore_color, &back_color);
2465 XRecolorCursor (x_current_display, v_double_arrow_cursor,
2466 &fore_color, &back_color);
2468 XFreePixmap (x_current_display, slider_pixmap);
2469 XFreePixmap (x_current_display, up_arrow_pixmap);
2470 XFreePixmap (x_current_display, down_arrow_pixmap);
2471 XFlush (x_current_display);
2473 XSelectInput (x_current_display, s->display.x->v_scrollbar,
2474 ButtonPressMask | ButtonReleaseMask
2475 | PointerMotionMask | PointerMotionHintMask
2476 | EnterWindowMask);
2477 XSelectInput (x_current_display, s->display.x->v_slider,
2478 ButtonPressMask | ButtonReleaseMask);
2479 XSelectInput (x_current_display, s->display.x->v_thumbdown,
2480 ButtonPressMask | ButtonReleaseMask);
2481 XSelectInput (x_current_display, s->display.x->v_thumbup,
2482 ButtonPressMask | ButtonReleaseMask);
2483 XFlush (x_current_display);
2485 /* This should be done at the same time as the main window. */
2486 XMapWindow (x_current_display, s->display.x->v_scrollbar);
2487 XMapSubwindows (x_current_display, s->display.x->v_scrollbar);
2488 XFlush (x_current_display);
2489 #else /* not HAVE_X11 */
2490 Bitmap b;
2491 Pixmap fore_tile, back_tile, bord_tile;
2492 static short up_arrow_bits[] = {
2493 0x0000, 0x0180, 0x03c0, 0x07e0,
2494 0x0ff0, 0x1ff8, 0x3ffc, 0x7ffe,
2495 0x0180, 0x0180, 0x0180, 0x0180,
2496 0x0180, 0x0180, 0x0180, 0xffff};
2497 static short down_arrow_bits[] = {
2498 0xffff, 0x0180, 0x0180, 0x0180,
2499 0x0180, 0x0180, 0x0180, 0x0180,
2500 0x7ffe, 0x3ffc, 0x1ff8, 0x0ff0,
2501 0x07e0, 0x03c0, 0x0180, 0x0000};
2503 fore_tile = XMakeTile (s->display.x->foreground_pixel);
2504 back_tile = XMakeTile (s->display.x->background_pixel);
2505 bord_tile = XMakeTile (s->display.x->border_pixel);
2507 b = XStoreBitmap (VSCROLL_WIDTH - 2, VSCROLL_WIDTH - 2, up_arrow_bits);
2508 up_arrow_pixmap = XMakePixmap (b,
2509 s->display.x->foreground_pixel,
2510 s->display.x->background_pixel);
2511 XFreeBitmap (b);
2513 b = XStoreBitmap (VSCROLL_WIDTH - 2, VSCROLL_WIDTH - 2, down_arrow_bits);
2514 down_arrow_pixmap = XMakePixmap (b,
2515 s->display.x->foreground_pixel,
2516 s->display.x->background_pixel);
2517 XFreeBitmap (b);
2519 ibw = s->display.x->internal_border_width;
2521 s->display.x->v_scrollbar = XCreateWindow (s->display.x->window_desc,
2522 width - VSCROLL_WIDTH - ibw/2,
2523 ibw/2,
2524 VSCROLL_WIDTH - 2,
2525 height - ibw - 2,
2526 1, bord_tile, back_tile);
2528 s->display.x->v_scrollbar_width = VSCROLL_WIDTH;
2530 s->display.x->v_thumbup = XCreateWindow (s->display.x->v_scrollbar,
2531 0, 0,
2532 VSCROLL_WIDTH - 2,
2533 VSCROLL_WIDTH - 2,
2534 0, 0, up_arrow_pixmap);
2535 XTileAbsolute (s->display.x->v_thumbup);
2537 s->display.x->v_thumbdown = XCreateWindow (s->display.x->v_scrollbar,
2539 height - ibw - VSCROLL_WIDTH,
2540 VSCROLL_WIDTH - 2,
2541 VSCROLL_WIDTH - 2,
2542 0, 0, down_arrow_pixmap);
2543 XTileAbsolute (s->display.x->v_thumbdown);
2545 s->display.x->v_slider = XCreateWindow (s->display.x->v_scrollbar,
2546 0, VSCROLL_WIDTH - 2,
2547 VSCROLL_WIDTH - 4,
2548 VSCROLL_WIDTH - 4,
2549 1, back_tile, fore_tile);
2551 XSelectInput (s->display.x->v_scrollbar,
2552 (ButtonPressed | ButtonReleased | KeyPressed));
2553 XSelectInput (s->display.x->v_thumbup,
2554 (ButtonPressed | ButtonReleased | KeyPressed));
2556 XSelectInput (s->display.x->v_thumbdown,
2557 (ButtonPressed | ButtonReleased | KeyPressed));
2559 XMapWindow (s->display.x->v_thumbup);
2560 XMapWindow (s->display.x->v_thumbdown);
2561 XMapWindow (s->display.x->v_slider);
2562 XMapWindow (s->display.x->v_scrollbar);
2564 XFreePixmap (fore_tile);
2565 XFreePixmap (back_tile);
2566 XFreePixmap (up_arrow_pixmap);
2567 XFreePixmap (down_arrow_pixmap);
2568 #endif /* not HAVE_X11 */
2571 static void
2572 install_horizontal_scrollbar (s)
2573 struct screen *s;
2575 int ibw = s->display.x->internal_border_width;
2576 Window parent;
2577 Pixmap left_arrow_pixmap, right_arrow_pixmap, slider_pixmap;
2578 int pix_x, pix_y;
2579 int width;
2581 pix_x = ibw;
2582 pix_y = PIXEL_HEIGHT (s) - HSCROLL_HEIGHT - ibw ;
2583 width = PIXEL_WIDTH (s) - 2 * ibw;
2584 if (s->display.x->v_scrollbar_width)
2585 width -= (s->display.x->v_scrollbar_width + 1);
2587 #ifdef HAVE_X11
2588 left_arrow_pixmap =
2589 XCreatePixmapFromBitmapData (x_current_display, s->display.x->window_desc,
2590 left_arrow_bits, 16, 16,
2591 s->display.x->foreground_pixel,
2592 s->display.x->background_pixel,
2593 DefaultDepth (x_current_display,
2594 XDefaultScreen (x_current_display)));
2596 right_arrow_pixmap =
2597 XCreatePixmapFromBitmapData (x_current_display, s->display.x->window_desc,
2598 right_arrow_bits, 16, 16,
2599 s->display.x->foreground_pixel,
2600 s->display.x->background_pixel,
2601 DefaultDepth (x_current_display,
2602 XDefaultScreen (x_current_display)));
2604 slider_pixmap =
2605 XCreatePixmapFromBitmapData (x_current_display, s->display.x->window_desc,
2606 gray_bits, 16, 16,
2607 s->display.x->foreground_pixel,
2608 s->display.x->background_pixel,
2609 DefaultDepth (x_current_display,
2610 XDefaultScreen (x_current_display)));
2612 left_arrow_cursor = XCreateFontCursor (x_current_display, XC_sb_left_arrow);
2613 right_arrow_cursor = XCreateFontCursor (x_current_display, XC_sb_right_arrow);
2614 h_double_arrow_cursor = XCreateFontCursor (x_current_display, XC_sb_h_double_arrow);
2616 s->display.x->h_scrollbar =
2617 XCreateSimpleWindow (x_current_display, s->display.x->window_desc,
2618 pix_x, pix_y,
2619 width - ibw - 2, HSCROLL_HEIGHT - 2, 1,
2620 s->display.x->foreground_pixel,
2621 s->display.x->background_pixel);
2622 XDefineCursor (x_current_display, s->display.x->h_scrollbar,
2623 h_double_arrow_cursor);
2625 s->display.x->h_slider =
2626 XCreateSimpleWindow (x_current_display, s->display.x->h_scrollbar,
2627 0, 0,
2628 HSCROLL_HEIGHT - 4, HSCROLL_HEIGHT - 4,
2629 1, s->display.x->foreground_pixel,
2630 s->display.x->background_pixel);
2631 XDefineCursor (x_current_display, s->display.x->h_slider,
2632 h_double_arrow_cursor);
2633 XSetWindowBackgroundPixmap (x_current_display, s->display.x->h_slider,
2634 slider_pixmap);
2636 s->display.x->h_thumbleft =
2637 XCreateSimpleWindow (x_current_display, s->display.x->h_scrollbar,
2638 0, 0,
2639 HSCROLL_HEIGHT - 2, HSCROLL_HEIGHT - 2,
2640 0, s->display.x->foreground_pixel,
2641 s->display.x->background_pixel);
2642 XDefineCursor (x_current_display, s->display.x->h_thumbleft,
2643 left_arrow_cursor);
2644 XSetWindowBackgroundPixmap (x_current_display, s->display.x->h_thumbleft,
2645 left_arrow_pixmap);
2647 s->display.x->h_thumbright =
2648 XCreateSimpleWindow (x_current_display, s->display.x->h_scrollbar,
2649 width - ibw - HSCROLL_HEIGHT, 0,
2650 HSCROLL_HEIGHT - 2, HSCROLL_HEIGHT -2,
2651 0, s->display.x->foreground_pixel,
2652 s->display.x->background_pixel);
2653 XDefineCursor (x_current_display, s->display.x->h_thumbright,
2654 right_arrow_cursor);
2655 XSetWindowBackgroundPixmap (x_current_display, s->display.x->h_thumbright,
2656 right_arrow_pixmap);
2658 XFreePixmap (x_current_display, slider_pixmap);
2659 XFreePixmap (x_current_display, left_arrow_pixmap);
2660 XFreePixmap (x_current_display, right_arrow_pixmap);
2662 XSelectInput (x_current_display, s->display.x->h_scrollbar,
2663 ButtonPressMask | ButtonReleaseMask
2664 | PointerMotionMask | PointerMotionHintMask
2665 | EnterWindowMask);
2666 XSelectInput (x_current_display, s->display.x->h_slider,
2667 ButtonPressMask | ButtonReleaseMask);
2668 XSelectInput (x_current_display, s->display.x->h_thumbright,
2669 ButtonPressMask | ButtonReleaseMask);
2670 XSelectInput (x_current_display, s->display.x->h_thumbleft,
2671 ButtonPressMask | ButtonReleaseMask);
2673 XMapWindow (x_current_display, s->display.x->h_scrollbar);
2674 XMapSubwindows (x_current_display, s->display.x->h_scrollbar);
2675 #else /* not HAVE_X11 */
2676 Bitmap b;
2677 Pixmap fore_tile, back_tile, bord_tile;
2678 #endif
2681 #ifndef HAVE_X11 /* X10 */
2682 #define XMoveResizeWindow XConfigureWindow
2683 #endif /* not HAVE_X11 */
2685 /* Adjust the displayed position in the scroll bar for window W. */
2687 void
2688 adjust_scrollbars (s)
2689 struct screen *s;
2691 int pos;
2692 int first_char_in_window, char_beyond_window, chars_in_window;
2693 int chars_in_buffer, buffer_size;
2694 struct window *w = XWINDOW (SCREEN_SELECTED_WINDOW (s));
2696 if (! SCREEN_IS_X (s))
2697 return;
2699 if (s->display.x->v_scrollbar != 0)
2701 int h, height;
2702 struct buffer *b = XBUFFER (w->buffer);
2704 buffer_size = Z - BEG;
2705 chars_in_buffer = ZV - BEGV;
2706 first_char_in_window = marker_position (w->start);
2707 char_beyond_window = buffer_size + 1 - XFASTINT (w->window_end_pos);
2708 chars_in_window = char_beyond_window - first_char_in_window;
2710 /* Calculate height of scrollbar area */
2712 height = s->height * FONT_HEIGHT (s->display.x->font)
2713 + s->display.x->internal_border_width
2714 - 2 * (s->display.x->v_scrollbar_width);
2716 /* Figure starting position for the scrollbar slider */
2718 if (chars_in_buffer <= 0)
2719 pos = 0;
2720 else
2721 pos = ((first_char_in_window - BEGV - BEG) * height
2722 / chars_in_buffer);
2723 pos = max (0, pos);
2724 pos = min (pos, height - 2);
2726 /* Figure length of the slider */
2728 if (chars_in_buffer <= 0)
2729 h = height;
2730 else
2731 h = (chars_in_window * height) / chars_in_buffer;
2732 h = min (h, height - pos);
2733 h = max (h, 1);
2735 /* Add thumbup offset to starting position of slider */
2737 pos += (s->display.x->v_scrollbar_width - 2);
2739 XMoveResizeWindow (XDISPLAY
2740 s->display.x->v_slider,
2741 0, pos,
2742 s->display.x->v_scrollbar_width - 4, h);
2745 if (s->display.x->h_scrollbar != 0)
2747 int l, length; /* Length of the scrollbar area */
2749 length = s->width * FONT_WIDTH (s->display.x->font)
2750 + s->display.x->internal_border_width
2751 - 2 * (s->display.x->h_scrollbar_height);
2753 /* Starting position for horizontal slider */
2754 if (! w->hscroll)
2755 pos = 0;
2756 else
2757 pos = (w->hscroll * length) / (w->hscroll + s->width);
2758 pos = max (0, pos);
2759 pos = min (pos, length - 2);
2761 /* Length of slider */
2762 l = length - pos;
2764 /* Add thumbup offset */
2765 pos += (s->display.x->h_scrollbar_height - 2);
2767 XMoveResizeWindow (XDISPLAY
2768 s->display.x->h_slider,
2769 pos, 0,
2770 l, s->display.x->h_scrollbar_height - 4);
2774 /* Adjust the size of the scroll bars of screen S,
2775 when the screen size has changed. */
2777 void
2778 x_resize_scrollbars (s)
2779 struct screen *s;
2781 int ibw = s->display.x->internal_border_width;
2782 int pixelwidth, pixelheight;
2784 if (s == 0
2785 || s->display.x == 0
2786 || (s->display.x->v_scrollbar == 0
2787 && s->display.x->h_scrollbar == 0))
2788 return;
2790 /* Get the size of the screen. */
2791 pixelwidth = (s->width * FONT_WIDTH (s->display.x->font)
2792 + 2 * ibw + s->display.x->v_scrollbar_width);
2793 pixelheight = (s->height * FONT_HEIGHT (s->display.x->font)
2794 + 2 * ibw + s->display.x->h_scrollbar_height);
2796 if (s->display.x->v_scrollbar_width && s->display.x->v_scrollbar)
2798 BLOCK_INPUT;
2799 XMoveResizeWindow (XDISPLAY
2800 s->display.x->v_scrollbar,
2801 pixelwidth - s->display.x->v_scrollbar_width - ibw/2,
2802 ibw/2,
2803 s->display.x->v_scrollbar_width - 2,
2804 pixelheight - ibw - 2);
2805 XMoveWindow (XDISPLAY
2806 s->display.x->v_thumbdown, 0,
2807 pixelheight - ibw - s->display.x->v_scrollbar_width);
2808 UNBLOCK_INPUT;
2811 if (s->display.x->h_scrollbar_height && s->display.x->h_scrollbar)
2813 if (s->display.x->v_scrollbar_width)
2814 pixelwidth -= s->display.x->v_scrollbar_width + 1;
2816 BLOCK_INPUT;
2817 XMoveResizeWindow (XDISPLAY
2818 s->display.x->h_scrollbar,
2819 ibw / 2,
2820 pixelheight - s->display.x->h_scrollbar_height - ibw / 2,
2821 pixelwidth - ibw - 2,
2822 s->display.x->h_scrollbar_height - 2);
2823 XMoveWindow (XDISPLAY
2824 s->display.x->h_thumbright,
2825 pixelwidth - ibw - s->display.x->h_scrollbar_height, 0);
2826 UNBLOCK_INPUT;
2830 x_pixel_width (s)
2831 register struct screen *s;
2833 return PIXEL_WIDTH (s);
2836 x_pixel_height (s)
2837 register struct screen *s;
2839 return PIXEL_HEIGHT (s);
2842 DEFUN ("x-defined-color", Fx_defined_color, Sx_defined_color, 1, 1, 0,
2843 "Return t if the current X display supports the color named COLOR.")
2844 (color)
2845 Lisp_Object color;
2847 Color foo;
2849 CHECK_STRING (color, 0);
2851 if (defined_color (XSTRING (color)->data, &foo))
2852 return Qt;
2853 else
2854 return Qnil;
2857 DEFUN ("x-color-display-p", Fx_color_display_p, Sx_color_display_p, 0, 0, 0,
2858 "Return t if the X display used currently supports color.")
2861 if (XINT (x_screen_planes) <= 2)
2862 return Qnil;
2864 switch (screen_visual->class)
2866 case StaticColor:
2867 case PseudoColor:
2868 case TrueColor:
2869 case DirectColor:
2870 return Qt;
2872 default:
2873 return Qnil;
2877 DEFUN ("x-pixel-width", Fx_pixel_width, Sx_pixel_width, 1, 1, 0,
2878 "Return the width in pixels of screen S.")
2879 (screen)
2880 Lisp_Object screen;
2882 CHECK_LIVE_SCREEN (screen, 0);
2883 return make_number (XSCREEN (screen)->display.x->pixel_width);
2886 DEFUN ("x-pixel-height", Fx_pixel_height, Sx_pixel_height, 1, 1, 0,
2887 "Return the height in pixels of screen S.")
2888 (screen)
2889 Lisp_Object screen;
2891 CHECK_LIVE_SCREEN (screen, 0);
2892 return make_number (XSCREEN (screen)->display.x->pixel_height);
2895 /* Draw a rectangle on the screen with left top corner including
2896 the character specified by LEFT_CHAR and TOP_CHAR. The rectangle is
2897 CHARS by LINES wide and long and is the color of the cursor. */
2899 void
2900 x_rectangle (s, gc, left_char, top_char, chars, lines)
2901 register struct screen *s;
2902 GC gc;
2903 register int top_char, left_char, chars, lines;
2905 int width;
2906 int height;
2907 int left = (left_char * FONT_WIDTH (s->display.x->font)
2908 + s->display.x->internal_border_width);
2909 int top = (top_char * FONT_HEIGHT (s->display.x->font)
2910 + s->display.x->internal_border_width);
2912 if (chars < 0)
2913 width = FONT_WIDTH (s->display.x->font) / 2;
2914 else
2915 width = FONT_WIDTH (s->display.x->font) * chars;
2916 if (lines < 0)
2917 height = FONT_HEIGHT (s->display.x->font) / 2;
2918 else
2919 height = FONT_HEIGHT (s->display.x->font) * lines;
2921 XDrawRectangle (x_current_display, s->display.x->window_desc,
2922 gc, left, top, width, height);
2925 DEFUN ("x-draw-rectangle", Fx_draw_rectangle, Sx_draw_rectangle, 5, 5, 0,
2926 "Draw a rectangle on SCREEN between coordinates specified by\n\
2927 numbers X0, Y0, X1, Y1 in the cursor pixel.")
2928 (screen, X0, Y0, X1, Y1)
2929 register Lisp_Object screen, X0, X1, Y0, Y1;
2931 register int x0, y0, x1, y1, top, left, n_chars, n_lines;
2933 CHECK_LIVE_SCREEN (screen, 0);
2934 CHECK_NUMBER (X0, 0);
2935 CHECK_NUMBER (Y0, 1);
2936 CHECK_NUMBER (X1, 2);
2937 CHECK_NUMBER (Y1, 3);
2939 x0 = XINT (X0);
2940 x1 = XINT (X1);
2941 y0 = XINT (Y0);
2942 y1 = XINT (Y1);
2944 if (y1 > y0)
2946 top = y0;
2947 n_lines = y1 - y0 + 1;
2949 else
2951 top = y1;
2952 n_lines = y0 - y1 + 1;
2955 if (x1 > x0)
2957 left = x0;
2958 n_chars = x1 - x0 + 1;
2960 else
2962 left = x1;
2963 n_chars = x0 - x1 + 1;
2966 BLOCK_INPUT;
2967 x_rectangle (XSCREEN (screen), XSCREEN (screen)->display.x->cursor_gc,
2968 left, top, n_chars, n_lines);
2969 UNBLOCK_INPUT;
2971 return Qt;
2974 DEFUN ("x-erase-rectangle", Fx_erase_rectangle, Sx_erase_rectangle, 5, 5, 0,
2975 "Draw a rectangle drawn on SCREEN between coordinates\n\
2976 X0, Y0, X1, Y1 in the regular background-pixel.")
2977 (screen, X0, Y0, X1, Y1)
2978 register Lisp_Object screen, X0, Y0, X1, Y1;
2980 register int x0, y0, x1, y1, top, left, n_chars, n_lines;
2982 CHECK_SCREEN (screen, 0);
2983 CHECK_NUMBER (X0, 0);
2984 CHECK_NUMBER (Y0, 1);
2985 CHECK_NUMBER (X1, 2);
2986 CHECK_NUMBER (Y1, 3);
2988 x0 = XINT (X0);
2989 x1 = XINT (X1);
2990 y0 = XINT (Y0);
2991 y1 = XINT (Y1);
2993 if (y1 > y0)
2995 top = y0;
2996 n_lines = y1 - y0 + 1;
2998 else
3000 top = y1;
3001 n_lines = y0 - y1 + 1;
3004 if (x1 > x0)
3006 left = x0;
3007 n_chars = x1 - x0 + 1;
3009 else
3011 left = x1;
3012 n_chars = x0 - x1 + 1;
3015 BLOCK_INPUT;
3016 x_rectangle (XSCREEN (screen), XSCREEN (screen)->display.x->reverse_gc,
3017 left, top, n_chars, n_lines);
3018 UNBLOCK_INPUT;
3020 return Qt;
3023 /* Draw lines around the text region beginning at the character position
3024 TOP_X, TOP_Y and ending at BOTTOM_X and BOTTOM_Y. GC specifies the
3025 pixel and line characteristics. */
3027 #define line_len(line) (SCREEN_CURRENT_GLYPHS (s)->used[(line)])
3029 static void
3030 outline_region (s, gc, top_x, top_y, bottom_x, bottom_y)
3031 register struct screen *s;
3032 GC gc;
3033 int top_x, top_y, bottom_x, bottom_y;
3035 register int ibw = s->display.x->internal_border_width;
3036 register int font_w = FONT_WIDTH (s->display.x->font);
3037 register int font_h = FONT_HEIGHT (s->display.x->font);
3038 int y = top_y;
3039 int x = line_len (y);
3040 XPoint *pixel_points = (XPoint *)
3041 alloca (((bottom_y - top_y + 2) * 4) * sizeof (XPoint));
3042 register XPoint *this_point = pixel_points;
3044 /* Do the horizontal top line/lines */
3045 if (top_x == 0)
3047 this_point->x = ibw;
3048 this_point->y = ibw + (font_h * top_y);
3049 this_point++;
3050 if (x == 0)
3051 this_point->x = ibw + (font_w / 2); /* Half-size for newline chars. */
3052 else
3053 this_point->x = ibw + (font_w * x);
3054 this_point->y = (this_point - 1)->y;
3056 else
3058 this_point->x = ibw;
3059 this_point->y = ibw + (font_h * (top_y + 1));
3060 this_point++;
3061 this_point->x = ibw + (font_w * top_x);
3062 this_point->y = (this_point - 1)->y;
3063 this_point++;
3064 this_point->x = (this_point - 1)->x;
3065 this_point->y = ibw + (font_h * top_y);
3066 this_point++;
3067 this_point->x = ibw + (font_w * x);
3068 this_point->y = (this_point - 1)->y;
3071 /* Now do the right side. */
3072 while (y < bottom_y)
3073 { /* Right vertical edge */
3074 this_point++;
3075 this_point->x = (this_point - 1)->x;
3076 this_point->y = ibw + (font_h * (y + 1));
3077 this_point++;
3079 y++; /* Horizontal connection to next line */
3080 x = line_len (y);
3081 if (x == 0)
3082 this_point->x = ibw + (font_w / 2);
3083 else
3084 this_point->x = ibw + (font_w * x);
3086 this_point->y = (this_point - 1)->y;
3089 /* Now do the bottom and connect to the top left point. */
3090 this_point->x = ibw + (font_w * (bottom_x + 1));
3092 this_point++;
3093 this_point->x = (this_point - 1)->x;
3094 this_point->y = ibw + (font_h * (bottom_y + 1));
3095 this_point++;
3096 this_point->x = ibw;
3097 this_point->y = (this_point - 1)->y;
3098 this_point++;
3099 this_point->x = pixel_points->x;
3100 this_point->y = pixel_points->y;
3102 XDrawLines (x_current_display, s->display.x->window_desc,
3103 gc, pixel_points,
3104 (this_point - pixel_points + 1), CoordModeOrigin);
3107 DEFUN ("x-contour-region", Fx_contour_region, Sx_contour_region, 1, 1, 0,
3108 "Highlight the region between point and the character under the mouse\n\
3109 selected screen.")
3110 (event)
3111 register Lisp_Object event;
3113 register int x0, y0, x1, y1;
3114 register struct screen *s = selected_screen;
3115 register int p1, p2;
3117 CHECK_CONS (event, 0);
3119 BLOCK_INPUT;
3120 x0 = XINT (Fcar (Fcar (event)));
3121 y0 = XINT (Fcar (Fcdr (Fcar (event))));
3123 /* If the mouse is past the end of the line, don't that area. */
3124 /* ReWrite this... */
3126 x1 = s->cursor_x;
3127 y1 = s->cursor_y;
3129 if (y1 > y0) /* point below mouse */
3130 outline_region (s, s->display.x->cursor_gc,
3131 x0, y0, x1, y1);
3132 else if (y1 < y0) /* point above mouse */
3133 outline_region (s, s->display.x->cursor_gc,
3134 x1, y1, x0, y0);
3135 else /* same line: draw horizontal rectangle */
3137 if (x1 > x0)
3138 x_rectangle (s, s->display.x->cursor_gc,
3139 x0, y0, (x1 - x0 + 1), 1);
3140 else if (x1 < x0)
3141 x_rectangle (s, s->display.x->cursor_gc,
3142 x1, y1, (x0 - x1 + 1), 1);
3145 XFlush (x_current_display);
3146 UNBLOCK_INPUT;
3148 return Qnil;
3151 DEFUN ("x-uncontour-region", Fx_uncontour_region, Sx_uncontour_region, 1, 1, 0,
3152 "Erase any highlighting of the region between point and the character\n\
3153 at X, Y on the selected screen.")
3154 (event)
3155 register Lisp_Object event;
3157 register int x0, y0, x1, y1;
3158 register struct screen *s = selected_screen;
3160 BLOCK_INPUT;
3161 x0 = XINT (Fcar (Fcar (event)));
3162 y0 = XINT (Fcar (Fcdr (Fcar (event))));
3163 x1 = s->cursor_x;
3164 y1 = s->cursor_y;
3166 if (y1 > y0) /* point below mouse */
3167 outline_region (s, s->display.x->reverse_gc,
3168 x0, y0, x1, y1);
3169 else if (y1 < y0) /* point above mouse */
3170 outline_region (s, s->display.x->reverse_gc,
3171 x1, y1, x0, y0);
3172 else /* same line: draw horizontal rectangle */
3174 if (x1 > x0)
3175 x_rectangle (s, s->display.x->reverse_gc,
3176 x0, y0, (x1 - x0 + 1), 1);
3177 else if (x1 < x0)
3178 x_rectangle (s, s->display.x->reverse_gc,
3179 x1, y1, (x0 - x1 + 1), 1);
3181 UNBLOCK_INPUT;
3183 return Qnil;
3186 extern unsigned int x_mouse_x, x_mouse_y, x_mouse_grabbed;
3187 extern Lisp_Object unread_command_char;
3189 #if 0
3190 int contour_begin_x, contour_begin_y;
3191 int contour_end_x, contour_end_y;
3192 int contour_npoints;
3194 /* Clip the top part of the contour lines down (and including) line Y_POS.
3195 If X_POS is in the middle (rather than at the end) of the line, drop
3196 down a line at that character. */
3198 static void
3199 clip_contour_top (y_pos, x_pos)
3201 register XPoint *begin = contour_lines[y_pos].top_left;
3202 register XPoint *end;
3203 register int npoints;
3204 register struct display_line *line = selected_screen->phys_lines[y_pos + 1];
3206 if (x_pos >= line->len - 1) /* Draw one, straight horizontal line. */
3208 end = contour_lines[y_pos].top_right;
3209 npoints = (end - begin + 1);
3210 XDrawLines (x_current_display, contour_window,
3211 contour_erase_gc, begin_erase, npoints, CoordModeOrigin);
3213 bcopy (end, begin + 1, contour_last_point - end + 1);
3214 contour_last_point -= (npoints - 2);
3215 XDrawLines (x_current_display, contour_window,
3216 contour_erase_gc, begin, 2, CoordModeOrigin);
3217 XFlush (x_current_display);
3219 /* Now, update contour_lines structure. */
3221 /* ______. */
3222 else /* |________*/
3224 register XPoint *p = begin + 1;
3225 end = contour_lines[y_pos].bottom_right;
3226 npoints = (end - begin + 1);
3227 XDrawLines (x_current_display, contour_window,
3228 contour_erase_gc, begin_erase, npoints, CoordModeOrigin);
3230 p->y = begin->y;
3231 p->x = ibw + (font_w * (x_pos + 1));
3232 p++;
3233 p->y = begin->y + font_h;
3234 p->x = (p - 1)->x;
3235 bcopy (end, begin + 3, contour_last_point - end + 1);
3236 contour_last_point -= (npoints - 5);
3237 XDrawLines (x_current_display, contour_window,
3238 contour_erase_gc, begin, 4, CoordModeOrigin);
3239 XFlush (x_current_display);
3241 /* Now, update contour_lines structure. */
3245 /* Erase the top horzontal lines of the contour, and then extend
3246 the contour upwards. */
3248 static void
3249 extend_contour_top (line)
3253 static void
3254 clip_contour_bottom (x_pos, y_pos)
3255 int x_pos, y_pos;
3259 static void
3260 extend_contour_bottom (x_pos, y_pos)
3264 DEFUN ("x-select-region", Fx_select_region, Sx_select_region, 1, 1, "e",
3266 (event)
3267 Lisp_Object event;
3269 register struct screen *s = selected_screen;
3270 register int point_x = s->cursor_x;
3271 register int point_y = s->cursor_y;
3272 register int mouse_below_point;
3273 register Lisp_Object obj;
3274 register int x_contour_x, x_contour_y;
3276 x_contour_x = x_mouse_x;
3277 x_contour_y = x_mouse_y;
3278 if (x_contour_y > point_y || (x_contour_y == point_y
3279 && x_contour_x > point_x))
3281 mouse_below_point = 1;
3282 outline_region (s, s->display.x->cursor_gc, point_x, point_y,
3283 x_contour_x, x_contour_y);
3285 else
3287 mouse_below_point = 0;
3288 outline_region (s, s->display.x->cursor_gc, x_contour_x, x_contour_y,
3289 point_x, point_y);
3292 while (1)
3294 obj = read_char (-1);
3295 if (XTYPE (obj) != Lisp_Cons)
3296 break;
3298 if (mouse_below_point)
3300 if (x_mouse_y <= point_y) /* Flipped. */
3302 mouse_below_point = 0;
3304 outline_region (s, s->display.x->reverse_gc, point_x, point_y,
3305 x_contour_x, x_contour_y);
3306 outline_region (s, s->display.x->cursor_gc, x_mouse_x, x_mouse_y,
3307 point_x, point_y);
3309 else if (x_mouse_y < x_contour_y) /* Bottom clipped. */
3311 clip_contour_bottom (x_mouse_y);
3313 else if (x_mouse_y > x_contour_y) /* Bottom extended. */
3315 extend_bottom_contour (x_mouse_y);
3318 x_contour_x = x_mouse_x;
3319 x_contour_y = x_mouse_y;
3321 else /* mouse above or same line as point */
3323 if (x_mouse_y >= point_y) /* Flipped. */
3325 mouse_below_point = 1;
3327 outline_region (s, s->display.x->reverse_gc,
3328 x_contour_x, x_contour_y, point_x, point_y);
3329 outline_region (s, s->display.x->cursor_gc, point_x, point_y,
3330 x_mouse_x, x_mouse_y);
3332 else if (x_mouse_y > x_contour_y) /* Top clipped. */
3334 clip_contour_top (x_mouse_y);
3336 else if (x_mouse_y < x_contour_y) /* Top extended. */
3338 extend_contour_top (x_mouse_y);
3343 unread_command_char = obj;
3344 if (mouse_below_point)
3346 contour_begin_x = point_x;
3347 contour_begin_y = point_y;
3348 contour_end_x = x_contour_x;
3349 contour_end_y = x_contour_y;
3351 else
3353 contour_begin_x = x_contour_x;
3354 contour_begin_y = x_contour_y;
3355 contour_end_x = point_x;
3356 contour_end_y = point_y;
3359 #endif
3361 DEFUN ("x-horizontal-line", Fx_horizontal_line, Sx_horizontal_line, 1, 1, "e",
3363 (event)
3364 Lisp_Object event;
3366 register Lisp_Object obj;
3367 struct screen *s = selected_screen;
3368 register struct window *w = XWINDOW (selected_window);
3369 register GC line_gc = s->display.x->cursor_gc;
3370 register GC erase_gc = s->display.x->reverse_gc;
3371 #if 0
3372 char dash_list[] = {6, 4, 6, 4};
3373 int dashes = 4;
3374 XGCValues gc_values;
3375 #endif
3376 register int previous_y;
3377 register int line = (x_mouse_y + 1) * FONT_HEIGHT (s->display.x->font)
3378 + s->display.x->internal_border_width;
3379 register int left = s->display.x->internal_border_width
3380 + (w->left
3381 * FONT_WIDTH (s->display.x->font));
3382 register int right = left + (w->width
3383 * FONT_WIDTH (s->display.x->font))
3384 - s->display.x->internal_border_width;
3386 #if 0
3387 BLOCK_INPUT;
3388 gc_values.foreground = s->display.x->cursor_pixel;
3389 gc_values.background = s->display.x->background_pixel;
3390 gc_values.line_width = 1;
3391 gc_values.line_style = LineOnOffDash;
3392 gc_values.cap_style = CapRound;
3393 gc_values.join_style = JoinRound;
3395 line_gc = XCreateGC (x_current_display, s->display.x->window_desc,
3396 GCLineStyle | GCJoinStyle | GCCapStyle
3397 | GCLineWidth | GCForeground | GCBackground,
3398 &gc_values);
3399 XSetDashes (x_current_display, line_gc, 0, dash_list, dashes);
3400 gc_values.foreground = s->display.x->background_pixel;
3401 gc_values.background = s->display.x->foreground_pixel;
3402 erase_gc = XCreateGC (x_current_display, s->display.x->window_desc,
3403 GCLineStyle | GCJoinStyle | GCCapStyle
3404 | GCLineWidth | GCForeground | GCBackground,
3405 &gc_values);
3406 XSetDashes (x_current_display, erase_gc, 0, dash_list, dashes);
3407 #endif
3409 while (1)
3411 BLOCK_INPUT;
3412 if (x_mouse_y >= XINT (w->top)
3413 && x_mouse_y < XINT (w->top) + XINT (w->height) - 1)
3415 previous_y = x_mouse_y;
3416 line = (x_mouse_y + 1) * FONT_HEIGHT (s->display.x->font)
3417 + s->display.x->internal_border_width;
3418 XDrawLine (x_current_display, s->display.x->window_desc,
3419 line_gc, left, line, right, line);
3421 XFlushQueue ();
3422 UNBLOCK_INPUT;
3426 obj = read_char (-1);
3427 if ((XTYPE (obj) != Lisp_Cons)
3428 || (! EQ (Fcar (Fcdr (Fcdr (obj))),
3429 intern ("vertical-scroll-bar")))
3430 || x_mouse_grabbed)
3432 BLOCK_INPUT;
3433 XDrawLine (x_current_display, s->display.x->window_desc,
3434 erase_gc, left, line, right, line);
3435 UNBLOCK_INPUT;
3436 unread_command_char = obj;
3437 #if 0
3438 XFreeGC (x_current_display, line_gc);
3439 XFreeGC (x_current_display, erase_gc);
3440 #endif
3441 return Qnil;
3444 while (x_mouse_y == previous_y);
3446 BLOCK_INPUT;
3447 XDrawLine (x_current_display, s->display.x->window_desc,
3448 erase_gc, left, line, right, line);
3449 UNBLOCK_INPUT;
3453 /* Offset in buffer of character under the pointer, or 0. */
3454 int mouse_buffer_offset;
3456 #if 0
3457 /* These keep track of the rectangle following the pointer. */
3458 int mouse_track_top, mouse_track_left, mouse_track_width;
3460 DEFUN ("x-track-pointer", Fx_track_pointer, Sx_track_pointer, 0, 0, 0,
3461 "Track the pointer.")
3464 static Cursor current_pointer_shape;
3465 SCREEN_PTR s = x_mouse_screen;
3467 BLOCK_INPUT;
3468 if (EQ (Vmouse_screen_part, Qtext_part)
3469 && (current_pointer_shape != s->display.x->nontext_cursor))
3471 unsigned char c;
3472 struct buffer *buf;
3474 current_pointer_shape = s->display.x->nontext_cursor;
3475 XDefineCursor (x_current_display,
3476 s->display.x->window_desc,
3477 current_pointer_shape);
3479 buf = XBUFFER (XWINDOW (Vmouse_window)->buffer);
3480 c = *(BUF_CHAR_ADDRESS (buf, mouse_buffer_offset));
3482 else if (EQ (Vmouse_screen_part, Qmodeline_part)
3483 && (current_pointer_shape != s->display.x->modeline_cursor))
3485 current_pointer_shape = s->display.x->modeline_cursor;
3486 XDefineCursor (x_current_display,
3487 s->display.x->window_desc,
3488 current_pointer_shape);
3491 XFlushQueue ();
3492 UNBLOCK_INPUT;
3494 #endif
3496 #if 0
3497 DEFUN ("x-track-pointer", Fx_track_pointer, Sx_track_pointer, 1, 1, "e",
3498 "Draw rectangle around character under mouse pointer, if there is one.")
3499 (event)
3500 Lisp_Object event;
3502 struct window *w = XWINDOW (Vmouse_window);
3503 struct screen *s = XSCREEN (WINDOW_SCREEN (w));
3504 struct buffer *b = XBUFFER (w->buffer);
3505 Lisp_Object obj;
3507 if (! EQ (Vmouse_window, selected_window))
3508 return Qnil;
3510 if (EQ (event, Qnil))
3512 int x, y;
3514 x_read_mouse_position (selected_screen, &x, &y);
3517 BLOCK_INPUT;
3518 mouse_track_width = 0;
3519 mouse_track_left = mouse_track_top = -1;
3523 if ((x_mouse_x != mouse_track_left
3524 && (x_mouse_x < mouse_track_left
3525 || x_mouse_x > (mouse_track_left + mouse_track_width)))
3526 || x_mouse_y != mouse_track_top)
3528 int hp = 0; /* Horizontal position */
3529 int len = SCREEN_CURRENT_GLYPHS (s)->used[x_mouse_y];
3530 int p = SCREEN_CURRENT_GLYPHS (s)->bufp[x_mouse_y];
3531 int tab_width = XINT (b->tab_width);
3532 int ctl_arrow_p = !NILP (b->ctl_arrow);
3533 unsigned char c;
3534 int mode_line_vpos = XFASTINT (w->height) + XFASTINT (w->top) - 1;
3535 int in_mode_line = 0;
3537 if (! SCREEN_CURRENT_GLYPHS (s)->enable[x_mouse_y])
3538 break;
3540 /* Erase previous rectangle. */
3541 if (mouse_track_width)
3543 x_rectangle (s, s->display.x->reverse_gc,
3544 mouse_track_left, mouse_track_top,
3545 mouse_track_width, 1);
3547 if ((mouse_track_left == s->phys_cursor_x
3548 || mouse_track_left == s->phys_cursor_x - 1)
3549 && mouse_track_top == s->phys_cursor_y)
3551 x_display_cursor (s, 1);
3555 mouse_track_left = x_mouse_x;
3556 mouse_track_top = x_mouse_y;
3557 mouse_track_width = 0;
3559 if (mouse_track_left > len) /* Past the end of line. */
3560 goto draw_or_not;
3562 if (mouse_track_top == mode_line_vpos)
3564 in_mode_line = 1;
3565 goto draw_or_not;
3568 if (tab_width <= 0 || tab_width > 20) tab_width = 8;
3571 c = FETCH_CHAR (p);
3572 if (len == s->width && hp == len - 1 && c != '\n')
3573 goto draw_or_not;
3575 switch (c)
3577 case '\t':
3578 mouse_track_width = tab_width - (hp % tab_width);
3579 p++;
3580 hp += mouse_track_width;
3581 if (hp > x_mouse_x)
3583 mouse_track_left = hp - mouse_track_width;
3584 goto draw_or_not;
3586 continue;
3588 case '\n':
3589 mouse_track_width = -1;
3590 goto draw_or_not;
3592 default:
3593 if (ctl_arrow_p && (c < 040 || c == 0177))
3595 if (p > ZV)
3596 goto draw_or_not;
3598 mouse_track_width = 2;
3599 p++;
3600 hp +=2;
3601 if (hp > x_mouse_x)
3603 mouse_track_left = hp - mouse_track_width;
3604 goto draw_or_not;
3607 else
3609 mouse_track_width = 1;
3610 p++;
3611 hp++;
3613 continue;
3616 while (hp <= x_mouse_x);
3618 draw_or_not:
3619 if (mouse_track_width) /* Over text; use text pointer shape. */
3621 XDefineCursor (x_current_display,
3622 s->display.x->window_desc,
3623 s->display.x->text_cursor);
3624 x_rectangle (s, s->display.x->cursor_gc,
3625 mouse_track_left, mouse_track_top,
3626 mouse_track_width, 1);
3628 else if (in_mode_line)
3629 XDefineCursor (x_current_display,
3630 s->display.x->window_desc,
3631 s->display.x->modeline_cursor);
3632 else
3633 XDefineCursor (x_current_display,
3634 s->display.x->window_desc,
3635 s->display.x->nontext_cursor);
3638 XFlush (x_current_display);
3639 UNBLOCK_INPUT;
3641 obj = read_char (-1);
3642 BLOCK_INPUT;
3644 while (XTYPE (obj) == Lisp_Cons /* Mouse event */
3645 && EQ (Fcar (Fcdr (Fcdr (obj))), Qnil) /* Not scrollbar */
3646 && EQ (Vmouse_depressed, Qnil) /* Only motion events */
3647 && EQ (Vmouse_window, selected_window) /* In this window */
3648 && x_mouse_screen);
3650 unread_command_char = obj;
3652 if (mouse_track_width)
3654 x_rectangle (s, s->display.x->reverse_gc,
3655 mouse_track_left, mouse_track_top,
3656 mouse_track_width, 1);
3657 mouse_track_width = 0;
3658 if ((mouse_track_left == s->phys_cursor_x
3659 || mouse_track_left - 1 == s->phys_cursor_x)
3660 && mouse_track_top == s->phys_cursor_y)
3662 x_display_cursor (s, 1);
3665 XDefineCursor (x_current_display,
3666 s->display.x->window_desc,
3667 s->display.x->nontext_cursor);
3668 XFlush (x_current_display);
3669 UNBLOCK_INPUT;
3671 return Qnil;
3673 #endif
3675 #if 0
3676 #include "glyphs.h"
3678 /* Draw a pixmap specified by IMAGE_DATA of dimensions WIDTH and HEIGHT
3679 on the screen S at position X, Y. */
3681 x_draw_pixmap (s, x, y, image_data, width, height)
3682 struct screen *s;
3683 int x, y, width, height;
3684 char *image_data;
3686 Pixmap image;
3688 image = XCreateBitmapFromData (x_current_display,
3689 s->display.x->window_desc, image_data,
3690 width, height);
3691 XCopyPlane (x_current_display, image, s->display.x->window_desc,
3692 s->display.x->normal_gc, 0, 0, width, height, x, y);
3694 #endif
3696 #if 0
3698 #ifdef HAVE_X11
3699 #define XMouseEvent XEvent
3700 #define WhichMouseButton xbutton.button
3701 #define MouseWindow xbutton.window
3702 #define MouseX xbutton.x
3703 #define MouseY xbutton.y
3704 #define MouseTime xbutton.time
3705 #define ButtonReleased ButtonRelease
3706 #define ButtonPressed ButtonPress
3707 #else
3708 #define XMouseEvent XButtonEvent
3709 #define WhichMouseButton detail
3710 #define MouseWindow window
3711 #define MouseX x
3712 #define MouseY y
3713 #define MouseTime time
3714 #endif /* X11 */
3716 DEFUN ("x-mouse-events", Fx_mouse_events, Sx_mouse_events, 0, 0, 0,
3717 "Return number of pending mouse events from X window system.")
3720 return make_number (queue_event_count (&x_mouse_queue));
3723 /* Encode the mouse button events in the form expected by the
3724 mouse code in Lisp. For X11, this means moving the masks around. */
3726 static int
3727 encode_mouse_button (mouse_event)
3728 XMouseEvent mouse_event;
3730 register int event_code;
3731 register char key_mask;
3733 event_code = mouse_event.detail & 3;
3734 key_mask = (mouse_event.detail >> 8) & 0xf0;
3735 event_code |= key_mask >> 1;
3736 if (mouse_event.type == ButtonReleased) event_code |= 0x04;
3737 return event_code;
3740 DEFUN ("x-get-mouse-event", Fx_get_mouse_event, Sx_get_mouse_event,
3741 0, 1, 0,
3742 "Get next mouse event out of mouse event buffer.\n\
3743 Optional ARG non-nil means return nil immediately if no pending event;\n\
3744 otherwise, wait for an event. Returns a four-part list:\n\
3745 ((X-POS Y-POS) WINDOW SCREEN-PART KEYSEQ TIMESTAMP).\n\
3746 Normally X-POS and Y-POS are the position of the click on the screen\n\
3747 (measured in characters and lines), and WINDOW is the window clicked in.\n\
3748 KEYSEQ is a string, the key sequence to be looked up in the mouse maps.\n\
3749 If SCREEN-PART is non-nil, the event was on a scrollbar;\n\
3750 then Y-POS is really the total length of the scrollbar, while X-POS is\n\
3751 the relative position of the scrollbar's value within that total length,\n\
3752 and a third element OFFSET appears in that list: the height of the thumb-up\n\
3753 area at the top of the scroll bar.\n\
3754 SCREEN-PART is one of the following symbols:\n\
3755 `vertical-scrollbar', `vertical-thumbup', `vertical-thumbdown',\n\
3756 `horizontal-scrollbar', `horizontal-thumbleft', `horizontal-thumbright'.\n\
3757 TIMESTAMP is the lower 23 bits of the X-server's timestamp for\n\
3758 the mouse event.")
3759 (arg)
3760 Lisp_Object arg;
3762 XMouseEvent xrep;
3763 register int com_letter;
3764 register Lisp_Object tempx;
3765 register Lisp_Object tempy;
3766 Lisp_Object part, pos, timestamp;
3767 int prefix;
3768 struct screen *s;
3770 int tem;
3772 while (1)
3774 BLOCK_INPUT;
3775 tem = dequeue_event (&xrep, &x_mouse_queue);
3776 UNBLOCK_INPUT;
3778 if (tem)
3780 switch (xrep.type)
3782 case ButtonPressed:
3783 case ButtonReleased:
3785 com_letter = encode_mouse_button (xrep);
3786 mouse_timestamp = xrep.MouseTime;
3788 if ((s = x_window_to_screen (xrep.MouseWindow)) != 0)
3790 Lisp_Object screen;
3792 if (s->display.x->icon_desc == xrep.MouseWindow)
3794 x_make_screen_visible (s);
3795 continue;
3798 XSET (tempx, Lisp_Int,
3799 min (s->width-1, max (0, (xrep.MouseX - s->display.x->internal_border_width)/FONT_WIDTH (s->display.x->font))));
3800 XSET (tempy, Lisp_Int,
3801 min (s->height-1, max (0, (xrep.MouseY - s->display.x->internal_border_width)/FONT_HEIGHT (s->display.x->font))));
3802 XSET (timestamp, Lisp_Int, (xrep.MouseTime & 0x7fffff));
3803 XSET (screen, Lisp_Screen, s);
3805 pos = Fcons (tempx, Fcons (tempy, Qnil));
3806 Vmouse_window
3807 = Flocate_window_from_coordinates (screen, pos);
3809 Vmouse_event
3810 = Fcons (pos,
3811 Fcons (Vmouse_window,
3812 Fcons (Qnil,
3813 Fcons (Fchar_to_string (make_number (com_letter)),
3814 Fcons (timestamp, Qnil)))));
3815 return Vmouse_event;
3817 else if ((s = x_window_to_scrollbar (xrep.MouseWindow, &part, &prefix)) != 0)
3819 int pos, len;
3820 Lisp_Object keyseq;
3821 char *partname;
3823 keyseq = concat2 (Fchar_to_string (make_number (prefix)),
3824 Fchar_to_string (make_number (com_letter)));
3826 pos = xrep.MouseY - (s->display.x->v_scrollbar_width - 2);
3827 XSET (tempx, Lisp_Int, pos);
3828 len = ((FONT_HEIGHT (s->display.x->font) * s->height)
3829 + s->display.x->internal_border_width
3830 - (2 * (s->display.x->v_scrollbar_width - 2)));
3831 XSET (tempy, Lisp_Int, len);
3832 XSET (timestamp, Lisp_Int, (xrep.MouseTime & 0x7fffff));
3833 Vmouse_window = s->selected_window;
3834 Vmouse_event
3835 = Fcons (Fcons (tempx, Fcons (tempy,
3836 Fcons (make_number (s->display.x->v_scrollbar_width - 2),
3837 Qnil))),
3838 Fcons (Vmouse_window,
3839 Fcons (intern (part),
3840 Fcons (keyseq, Fcons (timestamp,
3841 Qnil)))));
3842 return Vmouse_event;
3844 else
3845 continue;
3847 #ifdef HAVE_X11
3848 case MotionNotify:
3850 com_letter = x11_encode_mouse_button (xrep);
3851 if ((s = x_window_to_screen (xrep.MouseWindow)) != 0)
3853 Lisp_Object screen;
3855 XSET (tempx, Lisp_Int,
3856 min (s->width-1,
3857 max (0, (xrep.MouseX - s->display.x->internal_border_width)
3858 / FONT_WIDTH (s->display.x->font))));
3859 XSET (tempy, Lisp_Int,
3860 min (s->height-1,
3861 max (0, (xrep.MouseY - s->display.x->internal_border_width)
3862 / FONT_HEIGHT (s->display.x->font))));
3864 XSET (screen, Lisp_Screen, s);
3865 XSET (timestamp, Lisp_Int, (xrep.MouseTime & 0x7fffff));
3867 pos = Fcons (tempx, Fcons (tempy, Qnil));
3868 Vmouse_window
3869 = Flocate_window_from_coordinates (screen, pos);
3871 Vmouse_event
3872 = Fcons (pos,
3873 Fcons (Vmouse_window,
3874 Fcons (Qnil,
3875 Fcons (Fchar_to_string (make_number (com_letter)),
3876 Fcons (timestamp, Qnil)))));
3877 return Vmouse_event;
3880 break;
3881 #endif /* HAVE_X11 */
3883 default:
3884 if (s = x_window_to_screen (xrep.MouseWindow))
3885 Vmouse_window = s->selected_window;
3886 else if (s = x_window_to_scrollbar (xrep.MouseWindow, &part, &prefix))
3887 Vmouse_window = s->selected_window;
3888 return Vmouse_event = Qnil;
3892 if (!NILP (arg))
3893 return Qnil;
3895 /* Wait till we get another mouse event. */
3896 wait_reading_process_input (0, 0, 2, 0);
3899 #endif
3902 #ifndef HAVE_X11
3903 DEFUN ("x-store-cut-buffer", Fx_store_cut_buffer, Sx_store_cut_buffer,
3904 1, 1, "sStore text in cut buffer: ",
3905 "Store contents of STRING into the cut buffer of the X window system.")
3906 (string)
3907 register Lisp_Object string;
3909 int mask;
3911 CHECK_STRING (string, 1);
3912 if (SCREEN_IS_X (selected_screen))
3913 error ("Selected screen does not understand X protocol.");
3915 BLOCK_INPUT;
3916 XStoreBytes ((char *) XSTRING (string)->data, XSTRING (string)->size);
3917 UNBLOCK_INPUT;
3919 return Qnil;
3922 DEFUN ("x-get-cut-buffer", Fx_get_cut_buffer, Sx_get_cut_buffer, 0, 0, 0,
3923 "Return contents of cut buffer of the X window system, as a string.")
3926 int len;
3927 register Lisp_Object string;
3928 int mask;
3929 register char *d;
3931 BLOCK_INPUT;
3932 d = XFetchBytes (&len);
3933 string = make_string (d, len);
3934 XFree (d);
3935 UNBLOCK_INPUT;
3936 return string;
3938 #endif /* X10 */
3940 #ifdef HAVE_X11
3941 DEFUN ("x-rebind-key", Fx_rebind_key, Sx_rebind_key, 3, 3, 0,
3942 "Rebind X keysym KEYSYM, with MODIFIERS, to generate NEWSTRING.\n\
3943 KEYSYM is a string which conforms to the X keysym definitions found\n\
3944 in X11/keysymdef.h, sans the initial XK_. MODIFIERS is nil or a\n\
3945 list of strings specifying modifier keys such as Control_L, which must\n\
3946 also be depressed for NEWSTRING to appear.")
3947 (x_keysym, modifiers, newstring)
3948 register Lisp_Object x_keysym;
3949 register Lisp_Object modifiers;
3950 register Lisp_Object newstring;
3952 char *rawstring;
3953 register KeySym keysym, modifier_list[16];
3955 CHECK_STRING (x_keysym, 1);
3956 CHECK_STRING (newstring, 3);
3958 keysym = XStringToKeysym ((char *) XSTRING (x_keysym)->data);
3959 if (keysym == NoSymbol)
3960 error ("Keysym does not exist");
3962 if (NILP (modifiers))
3963 XRebindKeysym (x_current_display, keysym, modifier_list, 0,
3964 XSTRING (newstring)->data, XSTRING (newstring)->size);
3965 else
3967 register Lisp_Object rest, mod;
3968 register int i = 0;
3970 for (rest = modifiers; !NILP (rest); rest = Fcdr (rest))
3972 if (i == 16)
3973 error ("Can't have more than 16 modifiers");
3975 mod = Fcar (rest);
3976 CHECK_STRING (mod, 3);
3977 modifier_list[i] = XStringToKeysym ((char *) XSTRING (mod)->data);
3978 if (modifier_list[i] == NoSymbol
3979 || !IsModifierKey (modifier_list[i]))
3980 error ("Element is not a modifier keysym");
3981 i++;
3984 XRebindKeysym (x_current_display, keysym, modifier_list, i,
3985 XSTRING (newstring)->data, XSTRING (newstring)->size);
3988 return Qnil;
3991 DEFUN ("x-rebind-keys", Fx_rebind_keys, Sx_rebind_keys, 2, 2, 0,
3992 "Rebind KEYCODE to list of strings STRINGS.\n\
3993 STRINGS should be a list of 16 elements, one for each shift combination.\n\
3994 nil as element means don't change.\n\
3995 See the documentation of `x-rebind-key' for more information.")
3996 (keycode, strings)
3997 register Lisp_Object keycode;
3998 register Lisp_Object strings;
4000 register Lisp_Object item;
4001 register unsigned char *rawstring;
4002 KeySym rawkey, modifier[1];
4003 int strsize;
4004 register unsigned i;
4006 CHECK_NUMBER (keycode, 1);
4007 CHECK_CONS (strings, 2);
4008 rawkey = (KeySym) ((unsigned) (XINT (keycode))) & 255;
4009 for (i = 0; i <= 15; strings = Fcdr (strings), i++)
4011 item = Fcar (strings);
4012 if (!NILP (item))
4014 CHECK_STRING (item, 2);
4015 strsize = XSTRING (item)->size;
4016 rawstring = (unsigned char *) xmalloc (strsize);
4017 bcopy (XSTRING (item)->data, rawstring, strsize);
4018 modifier[1] = 1 << i;
4019 XRebindKeysym (x_current_display, rawkey, modifier, 1,
4020 rawstring, strsize);
4023 return Qnil;
4025 #else
4026 DEFUN ("x-rebind-key", Fx_rebind_key, Sx_rebind_key, 3, 3, 0,
4027 "Rebind KEYCODE, with shift bits SHIFT-MASK, to new string NEWSTRING.\n\
4028 KEYCODE and SHIFT-MASK should be numbers representing the X keyboard code\n\
4029 and shift mask respectively. NEWSTRING is an arbitrary string of keystrokes.\n\
4030 If SHIFT-MASK is nil, then KEYCODE's key will be bound to NEWSTRING for\n\
4031 all shift combinations.\n\
4032 Shift Lock 1 Shift 2\n\
4033 Meta 4 Control 8\n\
4035 For values of KEYCODE, see /usr/lib/Xkeymap.txt (remember that the codes\n\
4036 in that file are in octal!)\n\
4038 NOTE: due to an X bug, this function will not take effect unless one has\n\
4039 a `~/.Xkeymap' file. (See the documentation for the `keycomp' program.)\n\
4040 This problem will be fixed in X version 11.")
4042 (keycode, shift_mask, newstring)
4043 register Lisp_Object keycode;
4044 register Lisp_Object shift_mask;
4045 register Lisp_Object newstring;
4047 char *rawstring;
4048 int keysym, rawshift;
4049 int i, strsize;
4051 CHECK_NUMBER (keycode, 1);
4052 if (!NILP (shift_mask))
4053 CHECK_NUMBER (shift_mask, 2);
4054 CHECK_STRING (newstring, 3);
4055 strsize = XSTRING (newstring)->size;
4056 rawstring = (char *) xmalloc (strsize);
4057 bcopy (XSTRING (newstring)->data, rawstring, strsize);
4059 keysym = ((unsigned) (XINT (keycode))) & 255;
4061 if (NILP (shift_mask))
4063 for (i = 0; i <= 15; i++)
4064 XRebindCode (keysym, i<<11, rawstring, strsize);
4066 else
4068 rawshift = (((unsigned) (XINT (shift_mask))) & 15) << 11;
4069 XRebindCode (keysym, rawshift, rawstring, strsize);
4071 return Qnil;
4074 DEFUN ("x-rebind-keys", Fx_rebind_keys, Sx_rebind_keys, 2, 2, 0,
4075 "Rebind KEYCODE to list of strings STRINGS.\n\
4076 STRINGS should be a list of 16 elements, one for each shift combination.\n\
4077 nil as element means don't change.\n\
4078 See the documentation of `x-rebind-key' for more information.")
4079 (keycode, strings)
4080 register Lisp_Object keycode;
4081 register Lisp_Object strings;
4083 register Lisp_Object item;
4084 register char *rawstring;
4085 KeySym rawkey, modifier[1];
4086 int strsize;
4087 register unsigned i;
4089 CHECK_NUMBER (keycode, 1);
4090 CHECK_CONS (strings, 2);
4091 rawkey = (KeySym) ((unsigned) (XINT (keycode))) & 255;
4092 for (i = 0; i <= 15; strings = Fcdr (strings), i++)
4094 item = Fcar (strings);
4095 if (!NILP (item))
4097 CHECK_STRING (item, 2);
4098 strsize = XSTRING (item)->size;
4099 rawstring = (char *) xmalloc (strsize);
4100 bcopy (XSTRING (item)->data, rawstring, strsize);
4101 XRebindCode (rawkey, i << 11, rawstring, strsize);
4104 return Qnil;
4106 #endif /* not HAVE_X11 */
4108 #ifdef HAVE_X11
4109 Visual *
4110 select_visual (screen, depth)
4111 Screen *screen;
4112 unsigned int *depth;
4114 Visual *v;
4115 XVisualInfo *vinfo, vinfo_template;
4116 int n_visuals;
4118 v = DefaultVisualOfScreen (screen);
4119 vinfo_template.visualid = XVisualIDFromVisual (v);
4120 vinfo = XGetVisualInfo (x_current_display, VisualIDMask, &vinfo_template,
4121 &n_visuals);
4122 if (n_visuals != 1)
4123 fatal ("Can't get proper X visual info");
4125 if ((1 << vinfo->depth) == vinfo->colormap_size)
4126 *depth = vinfo->depth;
4127 else
4129 int i = 0;
4130 int n = vinfo->colormap_size - 1;
4131 while (n)
4133 n = n >> 1;
4134 i++;
4136 *depth = i;
4139 XFree ((char *) vinfo);
4140 return v;
4142 #endif /* HAVE_X11 */
4144 DEFUN ("x-open-connection", Fx_open_connection, Sx_open_connection,
4145 1, 2, 0, "Open a connection to an X server.\n\
4146 DISPLAY is the name of the display to connect to. Optional second\n\
4147 arg XRM_STRING is a string of resources in xrdb format.")
4148 (display, xrm_string)
4149 Lisp_Object display, xrm_string;
4151 unsigned int n_planes;
4152 register Screen *x_screen;
4153 unsigned char *xrm_option;
4155 CHECK_STRING (display, 0);
4156 if (x_current_display != 0)
4157 error ("X server connection is already initialized");
4159 /* This is what opens the connection and sets x_current_display.
4160 This also initializes many symbols, such as those used for input. */
4161 x_term_init (XSTRING (display)->data);
4163 #ifdef HAVE_X11
4164 XFASTINT (Vwindow_system_version) = 11;
4166 if (!EQ (xrm_string, Qnil))
4168 CHECK_STRING (xrm_string, 1);
4169 xrm_option = (unsigned char *) XSTRING (xrm_string);
4171 else
4172 xrm_option = (unsigned char *) 0;
4173 xrdb = x_load_resources (x_current_display, xrm_option, EMACS_CLASS);
4174 x_current_display->db = xrdb;
4176 x_screen = DefaultScreenOfDisplay (x_current_display);
4178 x_screen_count = make_number (ScreenCount (x_current_display));
4179 Vx_vendor = build_string (ServerVendor (x_current_display));
4180 x_release = make_number (VendorRelease (x_current_display));
4182 x_screen_height = make_number (HeightOfScreen (x_screen));
4183 x_screen_height_mm = make_number (HeightMMOfScreen (x_screen));
4184 x_screen_width = make_number (WidthOfScreen (x_screen));
4185 x_screen_width_mm = make_number (WidthMMOfScreen (x_screen));
4187 switch (DoesBackingStore (x_screen))
4189 case Always:
4190 Vx_backing_store = intern ("Always");
4191 break;
4193 case WhenMapped:
4194 Vx_backing_store = intern ("WhenMapped");
4195 break;
4197 case NotUseful:
4198 Vx_backing_store = intern ("NotUseful");
4199 break;
4201 default:
4202 error ("Strange value for BackingStore.");
4203 break;
4206 if (DoesSaveUnders (x_screen) == True)
4207 x_save_under = Qt;
4208 else
4209 x_save_under = Qnil;
4211 screen_visual = select_visual (x_screen, &n_planes);
4212 x_screen_planes = make_number (n_planes);
4213 Vx_screen_visual = intern (x_visual_strings [screen_visual->class]);
4215 /* X Atoms used by emacs. */
4216 BLOCK_INPUT;
4217 Xatom_emacs_selection = XInternAtom (x_current_display, "_EMACS_SELECTION_",
4218 False);
4219 Xatom_clipboard = XInternAtom (x_current_display, "CLIPBOARD",
4220 False);
4221 Xatom_clipboard_selection = XInternAtom (x_current_display, "_EMACS_CLIPBOARD_",
4222 False);
4223 Xatom_wm_change_state = XInternAtom (x_current_display, "WM_CHANGE_STATE",
4224 False);
4225 Xatom_incremental = XInternAtom (x_current_display, "INCR",
4226 False);
4227 Xatom_multiple = XInternAtom (x_current_display, "MULTIPLE",
4228 False);
4229 Xatom_targets = XInternAtom (x_current_display, "TARGETS",
4230 False);
4231 Xatom_timestamp = XInternAtom (x_current_display, "TIMESTAMP",
4232 False);
4233 Xatom_delete = XInternAtom (x_current_display, "DELETE",
4234 False);
4235 Xatom_insert_selection = XInternAtom (x_current_display, "INSERT_SELECTION",
4236 False);
4237 Xatom_pair = XInternAtom (x_current_display, "XA_ATOM_PAIR",
4238 False);
4239 Xatom_insert_property = XInternAtom (x_current_display, "INSERT_PROPERTY",
4240 False);
4241 Xatom_text = XInternAtom (x_current_display, "TEXT",
4242 False);
4243 UNBLOCK_INPUT;
4244 #else /* not HAVE_X11 */
4245 XFASTINT (Vwindow_system_version) = 10;
4246 #endif /* not HAVE_X11 */
4247 return Qnil;
4250 DEFUN ("x-close-current-connection", Fx_close_current_connection,
4251 Sx_close_current_connection,
4252 0, 0, 0, "Close the connection to the current X server.")
4255 #ifdef HAVE_X11
4256 /* This is ONLY used when killing emacs; For switching displays
4257 we'll have to take care of setting CloseDownMode elsewhere. */
4259 if (x_current_display)
4261 BLOCK_INPUT;
4262 XSetCloseDownMode (x_current_display, DestroyAll);
4263 XCloseDisplay (x_current_display);
4265 else
4266 fatal ("No current X display connection to close\n");
4267 #endif
4268 return Qnil;
4271 DEFUN ("x-synchronize", Fx_synchronize, Sx_synchronize,
4272 1, 1, 0, "If ON is non-nil, report X errors as soon as the erring request is made.\n\
4273 If ON is nil, allow buffering of requests.\n\
4274 Turning on synchronization prohibits the Xlib routines from buffering\n\
4275 requests and seriously degrades performance, but makes debugging much\n\
4276 easier.")
4277 (on)
4278 Lisp_Object on;
4280 XSynchronize (x_current_display, !EQ (on, Qnil));
4282 return Qnil;
4286 syms_of_xfns ()
4288 init_x_parm_symbols ();
4290 /* This is zero if not using X windows. */
4291 x_current_display = 0;
4293 Qundefined_color = intern ("undefined-color");
4294 Fput (Qundefined_color, Qerror_conditions,
4295 Fcons (Qundefined_color, Fcons (Qerror, Qnil)));
4296 Fput (Qundefined_color, Qerror_message,
4297 build_string ("Undefined color"));
4299 screen_class = make_pure_string (SCREEN_CLASS, sizeof (SCREEN_CLASS)-1);
4301 DEFVAR_INT ("mouse-x-position", &x_mouse_x,
4302 "The X coordinate of the mouse position, in characters.");
4303 x_mouse_x = Qnil;
4305 DEFVAR_INT ("mouse-y-position", &x_mouse_y,
4306 "The Y coordinate of the mouse position, in characters.");
4307 x_mouse_y = Qnil;
4309 DEFVAR_INT ("mouse-buffer-offset", &mouse_buffer_offset,
4310 "The buffer offset of the character under the pointer.");
4311 mouse_buffer_offset = Qnil;
4313 DEFVAR_INT ("x-pointer-shape", &Vx_pointer_shape,
4314 "The shape of the pointer when over text.");
4315 Vx_pointer_shape = Qnil;
4317 DEFVAR_INT ("x-nontext-pointer-shape", &Vx_nontext_pointer_shape,
4318 "The shape of the pointer when not over text.");
4319 Vx_nontext_pointer_shape = Qnil;
4321 DEFVAR_INT ("x-mode-pointer-shape", &Vx_mode_pointer_shape,
4322 "The shape of the pointer when not over text.");
4323 Vx_mode_pointer_shape = Qnil;
4325 DEFVAR_LISP ("x-bar-cursor", &Vbar_cursor,
4326 "*If non-nil, use a vertical bar cursor. Otherwise, use the traditional box.");
4327 Vbar_cursor = Qnil;
4329 DEFVAR_LISP ("x-cursor-fore-pixel", &Vx_cursor_fore_pixel,
4330 "A string indicating the foreground color of the cursor box.");
4331 Vx_cursor_fore_pixel = Qnil;
4333 DEFVAR_LISP ("mouse-grabbed", &Vmouse_depressed,
4334 "Non-nil if a mouse button is currently depressed.");
4335 Vmouse_depressed = Qnil;
4337 DEFVAR_INT ("x-screen-count", &x_screen_count,
4338 "The number of screens associated with the current display.");
4339 DEFVAR_INT ("x-release", &x_release,
4340 "The release number of the X server in use.");
4341 DEFVAR_LISP ("x-vendor", &Vx_vendor,
4342 "The vendor supporting the X server in use.");
4343 DEFVAR_INT ("x-screen-height", &x_screen_height,
4344 "The height of this X screen in pixels.");
4345 DEFVAR_INT ("x-screen-height-mm", &x_screen_height_mm,
4346 "The height of this X screen in millimeters.");
4347 DEFVAR_INT ("x-screen-width", &x_screen_width,
4348 "The width of this X screen in pixels.");
4349 DEFVAR_INT ("x-screen-width-mm", &x_screen_width_mm,
4350 "The width of this X screen in millimeters.");
4351 DEFVAR_LISP ("x-backing-store", &Vx_backing_store,
4352 "The backing store capability of this screen.\n\
4353 Values can be the symbols Always, WhenMapped, or NotUseful.");
4354 DEFVAR_BOOL ("x-save-under", &x_save_under,
4355 "*Non-nil means this X screen supports the SaveUnder feature.");
4356 DEFVAR_INT ("x-screen-planes", &x_screen_planes,
4357 "The number of planes this monitor supports.");
4358 DEFVAR_LISP ("x-screen-visual", &Vx_screen_visual,
4359 "The default X visual for this X screen.");
4360 DEFVAR_LISP ("x-no-window-manager", &Vx_no_window_manager,
4361 "t if no X window manager is in use.");
4363 #ifdef HAVE_X11
4364 defsubr (&Sx_get_resource);
4365 defsubr (&Sx_pixel_width);
4366 defsubr (&Sx_pixel_height);
4367 defsubr (&Sx_draw_rectangle);
4368 defsubr (&Sx_erase_rectangle);
4369 defsubr (&Sx_contour_region);
4370 defsubr (&Sx_uncontour_region);
4371 defsubr (&Sx_color_display_p);
4372 defsubr (&Sx_defined_color);
4373 #if 0
4374 defsubr (&Sx_track_pointer);
4375 defsubr (&Sx_grab_pointer);
4376 defsubr (&Sx_ungrab_pointer);
4377 #endif
4378 #else
4379 defsubr (&Sx_get_default);
4380 defsubr (&Sx_store_cut_buffer);
4381 defsubr (&Sx_get_cut_buffer);
4382 defsubr (&Sx_set_face);
4383 #endif
4384 defsubr (&Sx_geometry);
4385 defsubr (&Sx_create_screen);
4386 defsubr (&Sfocus_screen);
4387 defsubr (&Sunfocus_screen);
4388 defsubr (&Sx_horizontal_line);
4389 defsubr (&Sx_rebind_key);
4390 defsubr (&Sx_rebind_keys);
4391 defsubr (&Sx_open_connection);
4392 defsubr (&Sx_close_current_connection);
4393 defsubr (&Sx_synchronize);
4395 /* This was used in the old event interface which used a separate
4396 event queue.*/
4397 #if 0
4398 defsubr (&Sx_mouse_events);
4399 defsubr (&Sx_get_mouse_event);
4400 #endif
4403 #endif /* HAVE_X_WINDOWS */