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)
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 */
34 #include "dispextern.h"
35 #include "xscrollbar.h"
41 void x_set_screen_param ();
43 #define min(a,b) ((a) < (b) ? (a) : (b))
44 #define max(a,b) ((a) > (b) ? (a) : (b))
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. */
77 /* The vendor supporting this X server. */
78 Lisp_Object Vx_vendor
;
80 /* The vendor's release number for this X server. */
83 /* Height of this X screen in pixels. */
86 /* Height of this X screen in millimeters. */
87 int x_screen_height_mm
;
89 /* Width of this X screen in pixels. */
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? */
101 /* Number of planes for this screen. */
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
[] =
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
;
171 /* Default size of an Emacs window without scroll bar. */
172 static char *default_window
= "=80x24+0+0";
175 char iconidentity
[MAXICID
];
176 #define ICONTAG "emacs@"
177 char minibuffer_iconidentity
[MAXICID
];
178 #define MINIBUFFER_ICONTAG "minibuffer@"
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. */
200 x_window_to_screen (wdesc
)
203 Lisp_Object tail
, screen
;
206 for (tail
= Vscreen_list
; CONSP (tail
); tail
= XCONS (tail
)->cdr
)
208 screen
= XCONS (tail
)->car
;
209 if (XTYPE (screen
) != Lisp_Screen
)
211 s
= XSCREEN (screen
);
212 if (s
->display
.x
->window_desc
== wdesc
213 || s
->display
.x
->icon_desc
== wdesc
)
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. */
224 x_window_to_scrollbar (wdesc
, part_ptr
, prefix_ptr
)
226 Lisp_Object
*part_ptr
;
227 enum scroll_bar_prefix
*prefix_ptr
;
229 Lisp_Object tail
, screen
;
232 for (tail
= Vscreen_list
; CONSP (tail
); tail
= XCONS (tail
)->cdr
)
234 screen
= XCONS (tail
)->car
;
235 if (XTYPE (screen
) != Lisp_Screen
)
238 s
= XSCREEN (screen
);
239 if (part_ptr
== 0 && prefix_ptr
== 0)
242 if (s
->display
.x
->v_scrollbar
== wdesc
)
244 *part_ptr
= Qvscrollbar_part
;
245 *prefix_ptr
= VSCROLL_BAR_PREFIX
;
248 else if (s
->display
.x
->v_slider
== wdesc
)
250 *part_ptr
= Qvslider_part
;
251 *prefix_ptr
= VSCROLL_SLIDER_PREFIX
;
254 else if (s
->display
.x
->v_thumbup
== wdesc
)
256 *part_ptr
= Qvthumbup_part
;
257 *prefix_ptr
= VSCROLL_THUMBUP_PREFIX
;
260 else if (s
->display
.x
->v_thumbdown
== wdesc
)
262 *part_ptr
= Qvthumbdown_part
;
263 *prefix_ptr
= VSCROLL_THUMBDOWN_PREFIX
;
266 else if (s
->display
.x
->h_scrollbar
== wdesc
)
268 *part_ptr
= Qhscrollbar_part
;
269 *prefix_ptr
= HSCROLL_BAR_PREFIX
;
272 else if (s
->display
.x
->h_slider
== wdesc
)
274 *part_ptr
= Qhslider_part
;
275 *prefix_ptr
= HSCROLL_SLIDER_PREFIX
;
278 else if (s
->display
.x
->h_thumbleft
== wdesc
)
280 *part_ptr
= Qhthumbleft_part
;
281 *prefix_ptr
= HSCROLL_THUMBLEFT_PREFIX
;
284 else if (s
->display
.x
->h_thumbright
== wdesc
)
286 *part_ptr
= Qhthumbright_part
;
287 *prefix_ptr
= HSCROLL_THUMBRIGHT_PREFIX
;
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. */
303 X_PARM_FOREGROUND_COLOR
,
304 X_PARM_BACKGROUND_COLOR
,
311 X_PARM_INTERNAL_BORDER_WIDTH
,
315 X_PARM_VERT_SCROLLBAR
,
316 X_PARM_HORIZ_SCROLLBAR
,
320 struct x_screen_parm_table
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 ();
333 void x_set_border_width ();
334 void x_set_internal_border_width ();
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
,
350 "border-width", x_set_border_width
,
351 "internal-border-width", x_set_internal_border_width
,
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 ()
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
,
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. */
381 x_set_screen_param (s
, param
, val
, oldval
)
382 register struct screen
*s
;
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
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
)
403 Lisp_Object
*alistptr
;
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",
418 /* Decide if color named COLOR is valid for the display
419 associated with the selected screen. */
421 defined_color (color
, color_def
)
426 Colormap screen_colormap
;
431 = DefaultColormap (x_current_display
, XDefaultScreen (x_current_display
));
433 foo
= XParseColor (x_current_display
, screen_colormap
,
435 && XAllocColor (x_current_display
, screen_colormap
, color_def
);
437 foo
= XParseColor (color
, color_def
) && XGetHardwareColor (color_def
);
438 #endif /* not HAVE_X11 */
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
453 x_decode_color (arg
, def
)
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
;
467 if (XFASTINT (x_screen_planes
) == 1)
470 if (DISPLAY_CELLS
== 1)
474 if (defined_color (XSTRING (arg
)->data
, &cdef
))
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. */
489 x_set_foreground_color (s
, arg
, oldval
)
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)
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
);
510 XCreatePixmapFromBitmapData (XDISPLAY s
->display
.x
->window_desc
,
512 s
->display
.x
->foreground_pixel
,
513 s
->display
.x
->background_pixel
,
514 DefaultDepth (x_current_display
,
515 XDefaultScreen (x_current_display
)));
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
)));
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
,
533 XSetWindowBackgroundPixmap (XDISPLAY s
->display
.x
->v_thumbdown
,
535 XSetWindowBackgroundPixmap (XDISPLAY s
->display
.x
->v_slider
,
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
);
554 XCreatePixmapFromBitmapData (XDISPLAY s
->display
.x
->window_desc
,
556 s
->display
.x
->foreground_pixel
,
557 s
->display
.x
->background_pixel
,
558 DefaultDepth (x_current_display
,
559 XDefaultScreen (x_current_display
)));
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
)));
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
,
578 XSetWindowBackgroundPixmap (XDISPLAY s
->display
.x
->h_thumbleft
,
580 XSetWindowBackgroundPixmap (XDISPLAY s
->display
.x
->h_thumbright
,
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
);
592 #endif /* HAVE_X11 */
599 x_set_background_color (s
, arg
, oldval
)
601 Lisp_Object arg
, oldval
;
606 s
->display
.x
->background_pixel
= x_decode_color (arg
, WHITE_PIX_DEFAULT
);
608 if (s
->display
.x
->window_desc
!= 0)
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
);
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
);
629 XCreatePixmapFromBitmapData (XDISPLAY s
->display
.x
->window_desc
,
631 s
->display
.x
->foreground_pixel
,
632 s
->display
.x
->background_pixel
,
633 DefaultDepth (x_current_display
,
634 XDefaultScreen (x_current_display
)));
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
)));
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
,
652 XSetWindowBackgroundPixmap (XDISPLAY s
->display
.x
->v_thumbdown
,
654 XSetWindowBackgroundPixmap (XDISPLAY s
->display
.x
->v_slider
,
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
);
673 XCreatePixmapFromBitmapData (XDISPLAY s
->display
.x
->window_desc
,
675 s
->display
.x
->foreground_pixel
,
676 s
->display
.x
->background_pixel
,
677 DefaultDepth (x_current_display
,
678 XDefaultScreen (x_current_display
)));
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
)));
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
,
697 XSetWindowBackgroundPixmap (XDISPLAY s
->display
.x
->h_thumbleft
,
699 XSetWindowBackgroundPixmap (XDISPLAY s
->display
.x
->h_thumbright
,
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
);
711 temp
= XMakeTile (s
->display
.x
->background_pixel
);
712 XChangeBackground (s
->display
.x
->window_desc
, temp
);
714 #endif /* not HAVE_X11 */
723 x_set_mouse_color (s
, arg
, oldval
)
725 Lisp_Object arg
, oldval
;
727 Cursor cursor
, nontext_cursor
, mode_cursor
;
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
;
740 if (!EQ (Qnil
, Vx_pointer_shape
))
742 CHECK_NUMBER (Vx_pointer_shape
, 0);
743 cursor
= XCreateFontCursor (x_current_display
, XINT (Vx_pointer_shape
));
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
));
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
));
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
)),
775 XQueryColor (x_current_display
,
776 DefaultColormap (x_current_display
,
777 DefaultScreen (x_current_display
)),
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
);
787 cursor
= XCreateCursor (16, 16, MouseCursor
, MouseMask
,
789 s
->display
.x
->mouse_pixel
,
790 s
->display
.x
->background_pixel
,
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
;
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 */
819 x_set_cursor_color (s
, arg
, oldval
)
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
);
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)
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
,
847 #endif /* HAVE_X11 */
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. */
869 x_set_border_color (s
, arg
, oldval
)
871 Lisp_Object arg
, oldval
;
876 CHECK_STRING (arg
, 0);
877 str
= XSTRING (arg
)->data
;
880 if (!strcmp (str
, "grey") || !strcmp (str
, "Grey")
881 || !strcmp (str
, "gray") || !strcmp (str
, "Gray"))
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
)
899 s
->display
.x
->border_pixel
= pix
;
901 if (s
->display
.x
->window_desc
!= 0 && s
->display
.x
->border_width
> 0)
908 XSetWindowBorder (x_current_display
, s
->display
.x
->window_desc
,
910 if (s
->display
.x
->h_scrollbar
)
911 XSetWindowBorder (x_current_display
, s
->display
.x
->h_slider
,
913 if (s
->display
.x
->v_scrollbar
)
914 XSetWindowBorder (x_current_display
, s
->display
.x
->v_slider
,
918 temp
= XMakePixmap ((Bitmap
) XStoreBitmap (16, 16, gray_bits
),
919 BLACK_PIX_DEFAULT
, WHITE_PIX_DEFAULT
);
921 temp
= XMakeTile (pix
);
922 XChangeBorder (s
->display
.x
->window_desc
, temp
);
923 XFreePixmap (XDISPLAY temp
);
924 #endif /* not HAVE_X11 */
933 x_set_icon_type (s
, arg
, oldval
)
935 Lisp_Object arg
, oldval
;
940 if (EQ (oldval
, Qnil
) == EQ (arg
, Qnil
))
945 result
= x_text_icon (s
, 0);
947 result
= x_bitmap_icon (s
, 0);
951 error ("No icon window available.");
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. */
958 XMapWindow (XDISPLAY s
->display
.x
->window_desc
);
965 x_set_font (s
, arg
, oldval
)
967 Lisp_Object arg
, oldval
;
972 CHECK_STRING (arg
, 1);
973 name
= XSTRING (arg
)->data
;
976 result
= x_new_font (s
, name
);
980 error ("Font \"%s\" is not defined", name
);
984 x_set_border_width (s
, arg
, oldval
)
986 Lisp_Object arg
, oldval
;
988 CHECK_NUMBER (arg
, 0);
990 if (XINT (arg
) == s
->display
.x
->border_width
)
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
);
1000 x_set_internal_border_width (s
, arg
, oldval
)
1002 Lisp_Object arg
, oldval
;
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
)
1015 if (s
->display
.x
->window_desc
!= 0)
1018 x_set_window_size (s
, s
->width
, s
->height
);
1020 x_set_resize_hint (s
);
1024 SET_SCREEN_GARBAGED (s
);
1029 x_set_name (s
, arg
, oldval
)
1031 Lisp_Object arg
, oldval
;
1033 CHECK_STRING (arg
, 0);
1035 if (s
->display
.x
->window_desc
)
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
);
1048 x_set_autoraise (s
, arg
, oldval
)
1050 Lisp_Object arg
, oldval
;
1052 s
->auto_raise
= !EQ (Qnil
, arg
);
1056 x_set_autolower (s
, arg
, oldval
)
1058 Lisp_Object arg
, oldval
;
1060 s
->auto_lower
= !EQ (Qnil
, arg
);
1066 x_set_face (scr
, font
, background
, foreground
, stipple
)
1069 unsigned long background
, foreground
;
1072 XGCValues gc_values
;
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
)
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
;
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
);
1100 new_face
= (struct face
*) xmalloc (sizeof (struct face
));
1103 XFreeGC (x_current_display
, temp_gc
);
1107 new_face
->font
= font
;
1108 new_face
->foreground
= foreground
;
1109 new_face
->background
= background
;
1110 new_face
->face_gc
= temp_gc
;
1112 new_face
->stipple
= gc_values
.stipple
;
1114 x_face_table
[++n_faces
] = new_face
;
1118 x_set_glyph (scr
, glyph
)
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
;
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
;
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
;
1166 f
= (*newname
== 0 ? 0 : XGetFont (newname
));
1169 error ("Font \"%s\" is not defined", newname
);
1171 fp
= x_face_table
[fn
];
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
))
1181 XFreeGC (FACE_FONT (fn
));
1184 else if (FACE_IS_IMAGE (fn
)) /* This should not happen... */
1187 XFreePixmap (x_current_display
, FACE_IMAGE (fn
));
1188 fp
->face_type
= x_font
;
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
);
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
;
1232 f
= (*newname
== 0 ? 0 : XGetFont (newname
));
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
];
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
)
1250 XLoseFont (fp
->font
);
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
);
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).")
1273 register struct face
*fp
; /* Current face info. */
1274 register int fn
; /* Face number. */
1276 CHECK_NUMBER (face
, 1);
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)
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
)));
1293 /* Subroutines of creating an X screen. */
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
;
1314 CHECK_STRING (attribute
, 0);
1316 CHECK_STRING (name
, 1);
1318 CHECK_STRING (class, 2);
1319 if (NILP (name
) != NILP (class))
1320 error ("x-get-resource: must specify both NAME and CLASS or neither");
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
;
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
);
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'.")
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
);
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
);
1380 return build_string (value
);
1385 #define Fx_get_resource(attribute, name, class) Fx_get_default(attribute)
1389 /* Types we might convert a resource string into. */
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. */
1406 x_get_arg (alist
, param
, screen_name
, attribute
, type
)
1407 Lisp_Object alist
, param
, screen_name
;
1409 enum resource_types type
;
1411 register Lisp_Object tem
;
1413 tem
= Fassq (param
, alist
);
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
1422 if (XTYPE (screen_name
) == Lisp_String
)
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
];
1445 XSTRING (sterile_name
)->data
[i
] = c
;
1449 sterile_name
= Qnil
;
1451 tem
= Fx_get_resource (build_string (attribute
),
1453 (NILP (sterile_name
) ? Qnil
: screen_class
));
1461 return make_number (atoi (XSTRING (tem
)->data
));
1464 tem
= Fdowncase (tem
);
1465 if (!strcmp (XSTRING (tem
)->data
, "on")
1466 || !strcmp (XSTRING (tem
)->data
, "true"))
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. */
1488 x_default_parameter (s
, alist
, propname
, deflt
, xprop
, type
)
1494 enum resource_types type
;
1496 Lisp_Object propsym
= intern (propname
);
1499 tem
= x_get_arg (alist
, propsym
, s
->name
, xprop
, type
);
1502 store_screen_param (s
, propsym
, tem
);
1503 x_set_screen_param (s
, propsym
, tem
, Qnil
);
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) ... ).")
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
))
1528 if (y
== 0 && (geometry
& YNegative
))
1530 values
[0] = Fcons (intern ("left"), make_number (x
));
1531 values
[1] = Fcons (intern ("top"), make_number (y
));
1532 return Flist (2, values
);
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
);
1541 case (XValue
| YValue
| WidthValue
| HeightValue
):
1542 if (x
== 0 && (geometry
& XNegative
))
1544 if (y
== 0 && (geometry
& YNegative
))
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
);
1557 error ("Must specify x and y value, and/or width and height");
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
1569 x_figure_window_size (s
, 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
;
1624 case USSize
: /* Got the size, need the position. */
1625 window_prompting
|= PPosition
;
1626 return window_prompting
;
1629 case USPosition
: /* Got the position, need the size. */
1630 window_prompting
|= PSize
;
1631 return window_prompting
;
1634 case 0: /* Got nothing, take both from geometry. */
1635 window_prompting
|= PPosition
| PSize
;
1636 return window_prompting
;
1640 /* Somehow a bit got set in window_prompting that we didn't
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
1662 | CWBackingStore
| CWSaveUnder
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
);
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
1699 register Lisp_Object tem0
,tem1
;
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");
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
;
1726 hints
.initial_state
= NormalState
; /* the default, actually. */
1727 hints
.input
= False
;
1730 hints
.flags
= StateHint
| IconPositionHint
| InputHint
;
1731 XSetWMHints (x_current_display
, s
->display
.x
->window_desc
, &hints
);
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. */
1743 XGCValues gc_values
;
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. */
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
,
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
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
;
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
),
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
,
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.")
1837 Lisp_Object screen
, tem
;
1839 int minibuffer_only
= 0;
1840 long window_prompting
= 0;
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
);
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);
1863 s
= make_screen_without_minibuffer (tem
);
1865 /* Set the name; the functions to which we pass s expect the
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
);
1907 /* Dimensions, especially s->height, must be done via change_screen_size.
1908 Change will not be effected unless different from the current
1912 s
->height
= s
->width
= 0;
1913 change_screen_size (s
, height
, width
, 1);
1915 x_wm_set_size_hint (s
, window_prompting
);
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
);
1934 Lisp_Object screen
, tem
;
1936 int pixelwidth
, pixelheight
;
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
);
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. */
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
);
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
;
2018 Window
*children
, root
;
2020 CHECK_STRING (tem
, 0);
2021 s
->display
.x
->window_desc
= (Window
) atoi (XSTRING (tem
)->data
);
2024 XGetWindowInfo (s
->display
.x
->window_desc
, &wininfo
);
2025 XQueryTree (s
->display
.x
->window_desc
, &parent
, &nchildren
, &children
);
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
;
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);
2051 tem
= x_get_arg (parms
, intern ("width"), name
, 0, 0);
2054 tem
= x_get_arg (parms
, intern ("top"), name
, 0, 0);
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. */
2063 tem
= x_get_arg (parms
, intern ("geometry"), name
, 0, 0);
2065 &s
->display
.x
->left_pos
, &s
->display
.x
->top_pos
,
2067 (XTYPE (tem
) == Lisp_String
2068 ? (char *) XSTRING (tem
)->data
: ""),
2069 XSTRING (s
->name
)->data
,
2070 !NILP (hscroll
), !NILP (vscroll
));
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);
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);
2084 error ("Width not specified");
2085 CHECK_NUMBER (tem
, 0);
2088 tem
= x_get_arg (parms
, intern ("top"), name
, 0, 0);
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);
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));
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
);
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
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. */
2150 temp
= XMakeTile (s
->display
.x
->background_pixel
);
2151 XChangeBackground (s
->display
.x
->window_desc
, temp
);
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
);
2177 DEFUN ("focus-screen", Ffocus_screen
, Sfocus_screen
, 1, 1, 0,
2178 "Set the focus on SCREEN.")
2182 CHECK_LIVE_SCREEN (screen
, 0);
2184 if (SCREEN_IS_X (XSCREEN (screen
)))
2187 x_focus_on_screen (XSCREEN (screen
));
2195 DEFUN ("unfocus-screen", Funfocus_screen
, Sunfocus_screen
, 0, 0, 0,
2196 "If a screen has been focused, release it.")
2202 x_unfocus_screen (x_focus_screen
);
2210 /* Computes an X-window size and position either from geometry GEO
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
)
2227 int *x
, *y
, *width
, *height
;
2230 int hscroll
, vscroll
;
2236 int background_color
;
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
);
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
)
2275 XQueryWindow (tempwindow
, &wininfo
);
2278 XQueryTree (tempwindow
, &tempwindow
, &nchildren
, &children
);
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. */
2291 x_set_horizontal_scrollbar (s
, val
, oldval
)
2293 Lisp_Object val
, oldval
;
2297 if (s
->display
.x
->window_desc
!= 0)
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
);
2308 if (s
->display
.x
->h_scrollbar
)
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
);
2321 /* Set whether screen S has a vertical scroll bar.
2322 VAL is t or nil to specify it. */
2325 x_set_vertical_scrollbar (s
, val
, oldval
)
2327 Lisp_Object val
, oldval
;
2331 if (s
->display
.x
->window_desc
!= 0)
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
);
2342 if (s
->display
.x
->v_scrollbar
!= 0)
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
);
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. */
2358 install_vertical_scrollbar (s
)
2361 int ibw
= s
->display
.x
->internal_border_width
;
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;
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
)));
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
)));
2391 XCreatePixmapFromBitmapData (x_current_display
, s
->display
.x
->window_desc
,
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
,
2427 s
->display
.x
->v_thumbup
=
2428 XCreateSimpleWindow (x_current_display
, s
->display
.x
->v_scrollbar
,
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
,
2436 XSetWindowBackgroundPixmap (x_current_display
, s
->display
.x
->v_thumbup
,
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
,
2448 XSetWindowBackgroundPixmap (x_current_display
, s
->display
.x
->v_thumbdown
,
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
)),
2457 XQueryColor (x_current_display
,
2458 DefaultColormap (x_current_display
,
2459 DefaultScreen (x_current_display
)),
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
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 */
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
);
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
);
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,
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
,
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
,
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,
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 */
2572 install_horizontal_scrollbar (s
)
2575 int ibw
= s
->display
.x
->internal_border_width
;
2577 Pixmap left_arrow_pixmap
, right_arrow_pixmap
, slider_pixmap
;
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);
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
)));
2605 XCreatePixmapFromBitmapData (x_current_display
, s
->display
.x
->window_desc
,
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
,
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
,
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
,
2636 s
->display
.x
->h_thumbleft
=
2637 XCreateSimpleWindow (x_current_display
, s
->display
.x
->h_scrollbar
,
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
,
2644 XSetWindowBackgroundPixmap (x_current_display
, s
->display
.x
->h_thumbleft
,
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
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 */
2677 Pixmap fore_tile
, back_tile
, bord_tile
;
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. */
2688 adjust_scrollbars (s
)
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
))
2699 if (s
->display
.x
->v_scrollbar
!= 0)
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)
2721 pos
= ((first_char_in_window
- BEGV
- BEG
) * height
2724 pos
= min (pos
, height
- 2);
2726 /* Figure length of the slider */
2728 if (chars_in_buffer
<= 0)
2731 h
= (chars_in_window
* height
) / chars_in_buffer
;
2732 h
= min (h
, height
- pos
);
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
,
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 */
2757 pos
= (w
->hscroll
* length
) / (w
->hscroll
+ s
->width
);
2759 pos
= min (pos
, length
- 2);
2761 /* Length of slider */
2764 /* Add thumbup offset */
2765 pos
+= (s
->display
.x
->h_scrollbar_height
- 2);
2767 XMoveResizeWindow (XDISPLAY
2768 s
->display
.x
->h_slider
,
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. */
2778 x_resize_scrollbars (s
)
2781 int ibw
= s
->display
.x
->internal_border_width
;
2782 int pixelwidth
, pixelheight
;
2785 || s
->display
.x
== 0
2786 || (s
->display
.x
->v_scrollbar
== 0
2787 && s
->display
.x
->h_scrollbar
== 0))
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
)
2799 XMoveResizeWindow (XDISPLAY
2800 s
->display
.x
->v_scrollbar
,
2801 pixelwidth
- s
->display
.x
->v_scrollbar_width
- 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
);
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;
2817 XMoveResizeWindow (XDISPLAY
2818 s
->display
.x
->h_scrollbar
,
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);
2831 register struct screen
*s
;
2833 return PIXEL_WIDTH (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.")
2849 CHECK_STRING (color
, 0);
2851 if (defined_color (XSTRING (color
)->data
, &foo
))
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)
2864 switch (screen_visual
->class)
2877 DEFUN ("x-pixel-width", Fx_pixel_width
, Sx_pixel_width
, 1, 1, 0,
2878 "Return the width in pixels of screen S.")
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.")
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. */
2900 x_rectangle (s
, gc
, left_char
, top_char
, chars
, lines
)
2901 register struct screen
*s
;
2903 register int top_char
, left_char
, chars
, lines
;
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
);
2913 width
= FONT_WIDTH (s
->display
.x
->font
) / 2;
2915 width
= FONT_WIDTH (s
->display
.x
->font
) * chars
;
2917 height
= FONT_HEIGHT (s
->display
.x
->font
) / 2;
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);
2947 n_lines
= y1
- y0
+ 1;
2952 n_lines
= y0
- y1
+ 1;
2958 n_chars
= x1
- x0
+ 1;
2963 n_chars
= x0
- x1
+ 1;
2967 x_rectangle (XSCREEN (screen
), XSCREEN (screen
)->display
.x
->cursor_gc
,
2968 left
, top
, n_chars
, n_lines
);
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);
2996 n_lines
= y1
- y0
+ 1;
3001 n_lines
= y0
- y1
+ 1;
3007 n_chars
= x1
- x0
+ 1;
3012 n_chars
= x0
- x1
+ 1;
3016 x_rectangle (XSCREEN (screen
), XSCREEN (screen
)->display
.x
->reverse_gc
,
3017 left
, top
, n_chars
, n_lines
);
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)])
3030 outline_region (s
, gc
, top_x
, top_y
, bottom_x
, bottom_y
)
3031 register struct screen
*s
;
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
);
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 */
3047 this_point
->x
= ibw
;
3048 this_point
->y
= ibw
+ (font_h
* top_y
);
3051 this_point
->x
= ibw
+ (font_w
/ 2); /* Half-size for newline chars. */
3053 this_point
->x
= ibw
+ (font_w
* x
);
3054 this_point
->y
= (this_point
- 1)->y
;
3058 this_point
->x
= ibw
;
3059 this_point
->y
= ibw
+ (font_h
* (top_y
+ 1));
3061 this_point
->x
= ibw
+ (font_w
* top_x
);
3062 this_point
->y
= (this_point
- 1)->y
;
3064 this_point
->x
= (this_point
- 1)->x
;
3065 this_point
->y
= ibw
+ (font_h
* top_y
);
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 */
3075 this_point
->x
= (this_point
- 1)->x
;
3076 this_point
->y
= ibw
+ (font_h
* (y
+ 1));
3079 y
++; /* Horizontal connection to next line */
3082 this_point
->x
= ibw
+ (font_w
/ 2);
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));
3093 this_point
->x
= (this_point
- 1)->x
;
3094 this_point
->y
= ibw
+ (font_h
* (bottom_y
+ 1));
3096 this_point
->x
= ibw
;
3097 this_point
->y
= (this_point
- 1)->y
;
3099 this_point
->x
= pixel_points
->x
;
3100 this_point
->y
= pixel_points
->y
;
3102 XDrawLines (x_current_display
, s
->display
.x
->window_desc
,
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\
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);
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... */
3129 if (y1
> y0
) /* point below mouse */
3130 outline_region (s
, s
->display
.x
->cursor_gc
,
3132 else if (y1
< y0
) /* point above mouse */
3133 outline_region (s
, s
->display
.x
->cursor_gc
,
3135 else /* same line: draw horizontal rectangle */
3138 x_rectangle (s
, s
->display
.x
->cursor_gc
,
3139 x0
, y0
, (x1
- x0
+ 1), 1);
3141 x_rectangle (s
, s
->display
.x
->cursor_gc
,
3142 x1
, y1
, (x0
- x1
+ 1), 1);
3145 XFlush (x_current_display
);
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.")
3155 register Lisp_Object event
;
3157 register int x0
, y0
, x1
, y1
;
3158 register struct screen
*s
= selected_screen
;
3161 x0
= XINT (Fcar (Fcar (event
)));
3162 y0
= XINT (Fcar (Fcdr (Fcar (event
))));
3166 if (y1
> y0
) /* point below mouse */
3167 outline_region (s
, s
->display
.x
->reverse_gc
,
3169 else if (y1
< y0
) /* point above mouse */
3170 outline_region (s
, s
->display
.x
->reverse_gc
,
3172 else /* same line: draw horizontal rectangle */
3175 x_rectangle (s
, s
->display
.x
->reverse_gc
,
3176 x0
, y0
, (x1
- x0
+ 1), 1);
3178 x_rectangle (s
, s
->display
.x
->reverse_gc
,
3179 x1
, y1
, (x0
- x1
+ 1), 1);
3186 extern unsigned int x_mouse_x
, x_mouse_y
, x_mouse_grabbed
;
3187 extern Lisp_Object unread_command_char
;
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. */
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. */
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
);
3231 p
->x
= ibw
+ (font_w
* (x_pos
+ 1));
3233 p
->y
= begin
->y
+ font_h
;
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. */
3249 extend_contour_top (line
)
3254 clip_contour_bottom (x_pos
, y_pos
)
3260 extend_contour_bottom (x_pos
, y_pos
)
3264 DEFUN ("x-select-region", Fx_select_region
, Sx_select_region
, 1, 1, "e",
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
);
3287 mouse_below_point
= 0;
3288 outline_region (s
, s
->display
.x
->cursor_gc
, x_contour_x
, x_contour_y
,
3294 obj
= read_char (-1);
3295 if (XTYPE (obj
) != Lisp_Cons
)
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
,
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
;
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
;
3361 DEFUN ("x-horizontal-line", Fx_horizontal_line
, Sx_horizontal_line
, 1, 1, "e",
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
;
3372 char dash_list
[] = {6, 4, 6, 4};
3374 XGCValues gc_values
;
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
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
;
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
,
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
,
3406 XSetDashes (x_current_display
, erase_gc
, 0, dash_list
, dashes
);
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
);
3426 obj
= read_char (-1);
3427 if ((XTYPE (obj
) != Lisp_Cons
)
3428 || (! EQ (Fcar (Fcdr (Fcdr (obj
))),
3429 intern ("vertical-scroll-bar")))
3433 XDrawLine (x_current_display
, s
->display
.x
->window_desc
,
3434 erase_gc
, left
, line
, right
, line
);
3436 unread_command_char
= obj
;
3438 XFreeGC (x_current_display
, line_gc
);
3439 XFreeGC (x_current_display
, erase_gc
);
3444 while (x_mouse_y
== previous_y
);
3447 XDrawLine (x_current_display
, s
->display
.x
->window_desc
,
3448 erase_gc
, left
, line
, right
, line
);
3453 /* Offset in buffer of character under the pointer, or 0. */
3454 int mouse_buffer_offset
;
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
;
3468 if (EQ (Vmouse_screen_part
, Qtext_part
)
3469 && (current_pointer_shape
!= s
->display
.x
->nontext_cursor
))
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
);
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.")
3502 struct window
*w
= XWINDOW (Vmouse_window
);
3503 struct screen
*s
= XSCREEN (WINDOW_SCREEN (w
));
3504 struct buffer
*b
= XBUFFER (w
->buffer
);
3507 if (! EQ (Vmouse_window
, selected_window
))
3510 if (EQ (event
, Qnil
))
3514 x_read_mouse_position (selected_screen
, &x
, &y
);
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
);
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
])
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. */
3562 if (mouse_track_top
== mode_line_vpos
)
3568 if (tab_width
<= 0 || tab_width
> 20) tab_width
= 8;
3572 if (len
== s
->width
&& hp
== len
- 1 && c
!= '\n')
3578 mouse_track_width
= tab_width
- (hp
% tab_width
);
3580 hp
+= mouse_track_width
;
3583 mouse_track_left
= hp
- mouse_track_width
;
3589 mouse_track_width
= -1;
3593 if (ctl_arrow_p
&& (c
< 040 || c
== 0177))
3598 mouse_track_width
= 2;
3603 mouse_track_left
= hp
- mouse_track_width
;
3609 mouse_track_width
= 1;
3616 while (hp
<= x_mouse_x
);
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
);
3633 XDefineCursor (x_current_display
,
3634 s
->display
.x
->window_desc
,
3635 s
->display
.x
->nontext_cursor
);
3638 XFlush (x_current_display
);
3641 obj
= read_char (-1);
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 */
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
);
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
)
3683 int x
, y
, width
, height
;
3688 image
= XCreateBitmapFromData (x_current_display
,
3689 s
->display
.x
->window_desc
, image_data
,
3691 XCopyPlane (x_current_display
, image
, s
->display
.x
->window_desc
,
3692 s
->display
.x
->normal_gc
, 0, 0, width
, height
, x
, y
);
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
3708 #define XMouseEvent XButtonEvent
3709 #define WhichMouseButton detail
3710 #define MouseWindow window
3713 #define MouseTime time
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. */
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;
3740 DEFUN ("x-get-mouse-event", Fx_get_mouse_event
, Sx_get_mouse_event
,
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\
3763 register int com_letter
;
3764 register Lisp_Object tempx
;
3765 register Lisp_Object tempy
;
3766 Lisp_Object part
, pos
, timestamp
;
3775 tem
= dequeue_event (&xrep
, &x_mouse_queue
);
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)
3792 if (s
->display
.x
->icon_desc
== xrep
.MouseWindow
)
3794 x_make_screen_visible (s
);
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
));
3807 = Flocate_window_from_coordinates (screen
, pos
);
3811 Fcons (Vmouse_window
,
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)
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
;
3835 = Fcons (Fcons (tempx
, Fcons (tempy
,
3836 Fcons (make_number (s
->display
.x
->v_scrollbar_width
- 2),
3838 Fcons (Vmouse_window
,
3839 Fcons (intern (part
),
3840 Fcons (keyseq
, Fcons (timestamp
,
3842 return Vmouse_event
;
3850 com_letter
= x11_encode_mouse_button (xrep
);
3851 if ((s
= x_window_to_screen (xrep
.MouseWindow
)) != 0)
3855 XSET (tempx
, Lisp_Int
,
3857 max (0, (xrep
.MouseX
- s
->display
.x
->internal_border_width
)
3858 / FONT_WIDTH (s
->display
.x
->font
))));
3859 XSET (tempy
, Lisp_Int
,
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
));
3869 = Flocate_window_from_coordinates (screen
, pos
);
3873 Fcons (Vmouse_window
,
3875 Fcons (Fchar_to_string (make_number (com_letter
)),
3876 Fcons (timestamp
, Qnil
)))));
3877 return Vmouse_event
;
3881 #endif /* HAVE_X11 */
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
;
3895 /* Wait till we get another mouse event. */
3896 wait_reading_process_input (0, 0, 2, 0);
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.")
3907 register Lisp_Object string
;
3911 CHECK_STRING (string
, 1);
3912 if (SCREEN_IS_X (selected_screen
))
3913 error ("Selected screen does not understand X protocol.");
3916 XStoreBytes ((char *) XSTRING (string
)->data
, XSTRING (string
)->size
);
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.")
3927 register Lisp_Object string
;
3932 d
= XFetchBytes (&len
);
3933 string
= make_string (d
, len
);
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
;
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
);
3967 register Lisp_Object rest
, mod
;
3970 for (rest
= modifiers
; !NILP (rest
); rest
= Fcdr (rest
))
3973 error ("Can't have more than 16 modifiers");
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");
3984 XRebindKeysym (x_current_display
, keysym
, modifier_list
, i
,
3985 XSTRING (newstring
)->data
, XSTRING (newstring
)->size
);
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.")
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];
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
);
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
);
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\
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
;
4048 int keysym
, rawshift
;
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
);
4068 rawshift
= (((unsigned) (XINT (shift_mask
))) & 15) << 11;
4069 XRebindCode (keysym
, rawshift
, rawstring
, strsize
);
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.")
4080 register Lisp_Object keycode
;
4081 register Lisp_Object strings
;
4083 register Lisp_Object item
;
4084 register char *rawstring
;
4085 KeySym rawkey
, modifier
[1];
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
);
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
);
4106 #endif /* not HAVE_X11 */
4110 select_visual (screen
, depth
)
4112 unsigned int *depth
;
4115 XVisualInfo
*vinfo
, vinfo_template
;
4118 v
= DefaultVisualOfScreen (screen
);
4119 vinfo_template
.visualid
= XVisualIDFromVisual (v
);
4120 vinfo
= XGetVisualInfo (x_current_display
, VisualIDMask
, &vinfo_template
,
4123 fatal ("Can't get proper X visual info");
4125 if ((1 << vinfo
->depth
) == vinfo
->colormap_size
)
4126 *depth
= vinfo
->depth
;
4130 int n
= vinfo
->colormap_size
- 1;
4139 XFree ((char *) vinfo
);
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
);
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
);
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
))
4190 Vx_backing_store
= intern ("Always");
4194 Vx_backing_store
= intern ("WhenMapped");
4198 Vx_backing_store
= intern ("NotUseful");
4202 error ("Strange value for BackingStore.");
4206 if (DoesSaveUnders (x_screen
) == True
)
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. */
4217 Xatom_emacs_selection
= XInternAtom (x_current_display
, "_EMACS_SELECTION_",
4219 Xatom_clipboard
= XInternAtom (x_current_display
, "CLIPBOARD",
4221 Xatom_clipboard_selection
= XInternAtom (x_current_display
, "_EMACS_CLIPBOARD_",
4223 Xatom_wm_change_state
= XInternAtom (x_current_display
, "WM_CHANGE_STATE",
4225 Xatom_incremental
= XInternAtom (x_current_display
, "INCR",
4227 Xatom_multiple
= XInternAtom (x_current_display
, "MULTIPLE",
4229 Xatom_targets
= XInternAtom (x_current_display
, "TARGETS",
4231 Xatom_timestamp
= XInternAtom (x_current_display
, "TIMESTAMP",
4233 Xatom_delete
= XInternAtom (x_current_display
, "DELETE",
4235 Xatom_insert_selection
= XInternAtom (x_current_display
, "INSERT_SELECTION",
4237 Xatom_pair
= XInternAtom (x_current_display
, "XA_ATOM_PAIR",
4239 Xatom_insert_property
= XInternAtom (x_current_display
, "INSERT_PROPERTY",
4241 Xatom_text
= XInternAtom (x_current_display
, "TEXT",
4244 #else /* not HAVE_X11 */
4245 XFASTINT (Vwindow_system_version
) = 10;
4246 #endif /* not HAVE_X11 */
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.")
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
)
4262 XSetCloseDownMode (x_current_display
, DestroyAll
);
4263 XCloseDisplay (x_current_display
);
4266 fatal ("No current X display connection to close\n");
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\
4280 XSynchronize (x_current_display
, !EQ (on
, Qnil
));
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.");
4305 DEFVAR_INT ("mouse-y-position", &x_mouse_y
,
4306 "The Y coordinate of the mouse position, in characters.");
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.");
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.");
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
);
4374 defsubr (&Sx_track_pointer
);
4375 defsubr (&Sx_grab_pointer
);
4376 defsubr (&Sx_ungrab_pointer
);
4379 defsubr (&Sx_get_default
);
4380 defsubr (&Sx_store_cut_buffer
);
4381 defsubr (&Sx_get_cut_buffer
);
4382 defsubr (&Sx_set_face
);
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
4398 defsubr (&Sx_mouse_events
);
4399 defsubr (&Sx_get_mouse_event
);
4403 #endif /* HAVE_X_WINDOWS */