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 /* Title name and application name for X stuff. */
54 extern char *x_id_name
;
55 extern Lisp_Object invocation_name
;
57 /* The background and shape of the mouse pointer, and shape when not
58 over text or in the modeline. */
59 Lisp_Object Vx_pointer_shape
, Vx_nontext_pointer_shape
, Vx_mode_pointer_shape
;
61 /* Color of chars displayed in cursor box. */
62 Lisp_Object Vx_cursor_fore_pixel
;
64 /* If non-nil, use vertical bar cursor. */
65 Lisp_Object Vbar_cursor
;
67 /* The X Visual we are using for X windows (the default) */
68 Visual
*screen_visual
;
70 /* How many screens this X display has. */
73 /* The vendor supporting this X server. */
74 Lisp_Object Vx_vendor
;
76 /* The vendor's release number for this X server. */
79 /* Height of this X screen in pixels. */
82 /* Height of this X screen in millimeters. */
83 int x_screen_height_mm
;
85 /* Width of this X screen in pixels. */
88 /* Width of this X screen in millimeters. */
89 int x_screen_width_mm
;
91 /* Does this X screen do backing store? */
92 Lisp_Object Vx_backing_store
;
94 /* Does this X screen do save-unders? */
97 /* Number of planes for this screen. */
100 /* X Visual type of this screen. */
101 Lisp_Object Vx_screen_visual
;
103 /* Non nil if no window manager is in use. */
104 Lisp_Object Vx_no_window_manager
;
106 static char *x_visual_strings
[] =
116 /* `t' if a mouse button is depressed. */
118 Lisp_Object Vmouse_depressed
;
120 /* Atom for indicating window state to the window manager. */
121 Atom Xatom_wm_change_state
;
123 /* When emacs became the selection owner. */
124 extern Time x_begin_selection_own
;
126 /* The value of the current emacs selection. */
127 extern Lisp_Object Vx_selection_value
;
129 /* Emacs' selection property identifier. */
130 extern Atom Xatom_emacs_selection
;
132 /* Clipboard selection atom. */
133 extern Atom Xatom_clipboard_selection
;
135 /* Clipboard atom. */
136 extern Atom Xatom_clipboard
;
138 /* Atom for indicating incremental selection transfer. */
139 extern Atom Xatom_incremental
;
141 /* Atom for indicating multiple selection request list */
142 extern Atom Xatom_multiple
;
144 /* Atom for what targets emacs handles. */
145 extern Atom Xatom_targets
;
147 /* Atom for indicating timstamp selection request */
148 extern Atom Xatom_timestamp
;
150 /* Atom requesting we delete our selection. */
151 extern Atom Xatom_delete
;
153 /* Selection magic. */
154 extern Atom Xatom_insert_selection
;
156 /* Type of property for INSERT_SELECTION. */
157 extern Atom Xatom_pair
;
159 /* More selection magic. */
160 extern Atom Xatom_insert_property
;
162 /* Atom for indicating property type TEXT */
163 extern Atom Xatom_text
;
165 /* Communication with window managers. */
166 extern Atom Xatom_wm_protocols
;
168 /* Kinds of protocol things we may receive. */
169 extern Atom Xatom_wm_take_focus
;
170 extern Atom Xatom_wm_save_yourself
;
171 extern Atom Xatom_wm_delete_window
;
173 /* Other WM communication */
174 extern Atom Xatom_wm_configure_denied
; /* When our config request is denied */
175 extern Atom Xatom_wm_window_moved
; /* When the WM moves us. */
179 /* Default size of an Emacs window without scroll bar. */
180 static char *default_window
= "=80x24+0+0";
183 char iconidentity
[MAXICID
];
184 #define ICONTAG "emacs@"
185 char minibuffer_iconidentity
[MAXICID
];
186 #define MINIBUFFER_ICONTAG "minibuffer@"
190 /* The last 23 bits of the timestamp of the last mouse button event. */
191 Time mouse_timestamp
;
193 Lisp_Object Qundefined_color
;
194 Lisp_Object Qx_screen_parameter
;
196 extern Lisp_Object Vwindow_system_version
;
198 /* Mouse map for clicks in windows. */
199 extern Lisp_Object Vglobal_mouse_map
;
201 /* Points to table of defined typefaces. */
202 struct face
*x_face_table
[MAX_FACES_AND_GLYPHS
];
204 /* Return the Emacs screen-object corresponding to an X window.
205 It could be the screen's main window or an icon window. */
208 x_window_to_screen (wdesc
)
211 Lisp_Object tail
, screen
;
214 for (tail
= Vscreen_list
; CONSP (tail
); tail
= XCONS (tail
)->cdr
)
216 screen
= XCONS (tail
)->car
;
217 if (XTYPE (screen
) != Lisp_Screen
)
219 s
= XSCREEN (screen
);
220 if (s
->display
.x
->window_desc
== wdesc
221 || s
->display
.x
->icon_desc
== wdesc
)
227 /* Map an X window that implements a scroll bar to the Emacs screen it
228 belongs to. Also store in *PART a symbol identifying which part of
229 the scroll bar it is. */
232 x_window_to_scrollbar (wdesc
, part_ptr
, prefix_ptr
)
234 Lisp_Object
*part_ptr
;
235 enum scroll_bar_prefix
*prefix_ptr
;
237 Lisp_Object tail
, screen
;
240 for (tail
= Vscreen_list
; CONSP (tail
); tail
= XCONS (tail
)->cdr
)
242 screen
= XCONS (tail
)->car
;
243 if (XTYPE (screen
) != Lisp_Screen
)
246 s
= XSCREEN (screen
);
247 if (part_ptr
== 0 && prefix_ptr
== 0)
250 if (s
->display
.x
->v_scrollbar
== wdesc
)
252 *part_ptr
= Qvscrollbar_part
;
253 *prefix_ptr
= VSCROLL_BAR_PREFIX
;
256 else if (s
->display
.x
->v_slider
== wdesc
)
258 *part_ptr
= Qvslider_part
;
259 *prefix_ptr
= VSCROLL_SLIDER_PREFIX
;
262 else if (s
->display
.x
->v_thumbup
== wdesc
)
264 *part_ptr
= Qvthumbup_part
;
265 *prefix_ptr
= VSCROLL_THUMBUP_PREFIX
;
268 else if (s
->display
.x
->v_thumbdown
== wdesc
)
270 *part_ptr
= Qvthumbdown_part
;
271 *prefix_ptr
= VSCROLL_THUMBDOWN_PREFIX
;
274 else if (s
->display
.x
->h_scrollbar
== wdesc
)
276 *part_ptr
= Qhscrollbar_part
;
277 *prefix_ptr
= HSCROLL_BAR_PREFIX
;
280 else if (s
->display
.x
->h_slider
== wdesc
)
282 *part_ptr
= Qhslider_part
;
283 *prefix_ptr
= HSCROLL_SLIDER_PREFIX
;
286 else if (s
->display
.x
->h_thumbleft
== wdesc
)
288 *part_ptr
= Qhthumbleft_part
;
289 *prefix_ptr
= HSCROLL_THUMBLEFT_PREFIX
;
292 else if (s
->display
.x
->h_thumbright
== wdesc
)
294 *part_ptr
= Qhthumbright_part
;
295 *prefix_ptr
= HSCROLL_THUMBRIGHT_PREFIX
;
302 /* Connect the screen-parameter names for X screens
303 to the ways of passing the parameter values to the window system.
305 The name of a parameter, as a Lisp symbol,
306 has an `x-screen-parameter' property which is an integer in Lisp
307 but can be interpreted as an `enum x_screen_parm' in C. */
311 X_PARM_FOREGROUND_COLOR
,
312 X_PARM_BACKGROUND_COLOR
,
319 X_PARM_INTERNAL_BORDER_WIDTH
,
323 X_PARM_VERT_SCROLLBAR
,
324 X_PARM_HORIZ_SCROLLBAR
,
328 struct x_screen_parm_table
331 void (*setter
)( /* struct screen *screen, Lisp_Object val, oldval */ );
334 void x_set_foreground_color ();
335 void x_set_background_color ();
336 void x_set_mouse_color ();
337 void x_set_cursor_color ();
338 void x_set_border_color ();
339 void x_set_icon_type ();
341 void x_set_border_width ();
342 void x_set_internal_border_width ();
344 void x_set_autoraise ();
345 void x_set_autolower ();
346 void x_set_vertical_scrollbar ();
347 void x_set_horizontal_scrollbar ();
349 static struct x_screen_parm_table x_screen_parms
[] =
351 "foreground-color", x_set_foreground_color
,
352 "background-color", x_set_background_color
,
353 "mouse-color", x_set_mouse_color
,
354 "cursor-color", x_set_cursor_color
,
355 "border-color", x_set_border_color
,
356 "icon-type", x_set_icon_type
,
358 "border-width", x_set_border_width
,
359 "internal-border-width", x_set_internal_border_width
,
361 "autoraise", x_set_autoraise
,
362 "autolower", x_set_autolower
,
363 "vertical-scrollbar", x_set_vertical_scrollbar
,
364 "horizontal-scrollbar", x_set_horizontal_scrollbar
,
367 /* Attach the `x-screen-parameter' properties to
368 the Lisp symbol names of parameters relevant to X. */
370 init_x_parm_symbols ()
374 Qx_screen_parameter
= intern ("x-screen-parameter");
376 for (i
= 0; i
< sizeof (x_screen_parms
)/sizeof (x_screen_parms
[0]); i
++)
377 Fput (intern (x_screen_parms
[i
].name
), Qx_screen_parameter
,
381 /* Report to X that a screen parameter of screen S is being set or changed.
382 PARAM is the symbol that says which parameter.
383 VAL is the new value.
384 OLDVAL is the old value.
385 If the parameter is not specially recognized, do nothing;
386 otherwise the `x_set_...' function for this parameter. */
389 x_set_screen_param (s
, param
, val
, oldval
)
390 register struct screen
*s
;
392 register Lisp_Object val
;
393 register Lisp_Object oldval
;
395 register Lisp_Object tem
;
396 tem
= Fget (param
, Qx_screen_parameter
);
397 if (XTYPE (tem
) == Lisp_Int
399 && XINT (tem
) < sizeof (x_screen_parms
)/sizeof (x_screen_parms
[0]))
400 (*x_screen_parms
[XINT (tem
)].setter
)(s
, val
, oldval
);
403 /* Insert a description of internally-recorded parameters of screen X
404 into the parameter alist *ALISTPTR that is to be given to the user.
405 Only parameters that are specific to the X window system
406 and whose values are not correctly recorded in the screen's
407 param_alist need to be considered here. */
409 x_report_screen_params (s
, alistptr
)
411 Lisp_Object
*alistptr
;
415 store_in_alist (alistptr
, "left", make_number (s
->display
.x
->left_pos
));
416 store_in_alist (alistptr
, "top", make_number (s
->display
.x
->top_pos
));
417 store_in_alist (alistptr
, "border-width",
418 make_number (s
->display
.x
->border_width
));
419 store_in_alist (alistptr
, "internal-border-width",
420 make_number (s
->display
.x
->internal_border_width
));
421 sprintf (buf
, "%d", s
->display
.x
->window_desc
);
422 store_in_alist (alistptr
, "window-id",
426 /* Decide if color named COLOR is valid for the display
427 associated with the selected screen. */
429 defined_color (color
, color_def
)
434 Colormap screen_colormap
;
439 = DefaultColormap (x_current_display
, XDefaultScreen (x_current_display
));
441 foo
= XParseColor (x_current_display
, screen_colormap
,
443 && XAllocColor (x_current_display
, screen_colormap
, color_def
);
445 foo
= XParseColor (color
, color_def
) && XGetHardwareColor (color_def
);
446 #endif /* not HAVE_X11 */
455 /* Given a string ARG naming a color, compute a pixel value from it
456 suitable for screen S.
457 If S is not a color screen, return DEF (default) regardless of what
461 x_decode_color (arg
, def
)
467 CHECK_STRING (arg
, 0);
469 if (strcmp (XSTRING (arg
)->data
, "black") == 0)
470 return BLACK_PIX_DEFAULT
;
471 else if (strcmp (XSTRING (arg
)->data
, "white") == 0)
472 return WHITE_PIX_DEFAULT
;
475 if (XFASTINT (x_screen_planes
) == 1)
478 if (DISPLAY_CELLS
== 1)
482 if (defined_color (XSTRING (arg
)->data
, &cdef
))
485 Fsignal (Qundefined_color
, Fcons (arg
, Qnil
));
488 /* Functions called only from `x_set_screen_param'
489 to set individual parameters.
491 If s->display.x->window_desc is 0,
492 the screen is being created and its X-window does not exist yet.
493 In that case, just record the parameter's new value
494 in the standard place; do not attempt to change the window. */
497 x_set_foreground_color (s
, arg
, oldval
)
499 Lisp_Object arg
, oldval
;
501 s
->display
.x
->foreground_pixel
= x_decode_color (arg
, BLACK_PIX_DEFAULT
);
502 if (s
->display
.x
->window_desc
!= 0)
506 XSetForeground (x_current_display
, s
->display
.x
->normal_gc
,
507 s
->display
.x
->foreground_pixel
);
508 XSetBackground (x_current_display
, s
->display
.x
->reverse_gc
,
509 s
->display
.x
->foreground_pixel
);
510 if (s
->display
.x
->v_scrollbar
)
512 Pixmap up_arrow_pixmap
, down_arrow_pixmap
, slider_pixmap
;
514 XSetWindowBorder (x_current_display
, s
->display
.x
->v_scrollbar
,
515 s
->display
.x
->foreground_pixel
);
518 XCreatePixmapFromBitmapData (XDISPLAY s
->display
.x
->window_desc
,
520 s
->display
.x
->foreground_pixel
,
521 s
->display
.x
->background_pixel
,
522 DefaultDepth (x_current_display
,
523 XDefaultScreen (x_current_display
)));
525 XCreatePixmapFromBitmapData (XDISPLAY s
->display
.x
->window_desc
,
526 up_arrow_bits
, 16, 16,
527 s
->display
.x
->foreground_pixel
,
528 s
->display
.x
->background_pixel
,
529 DefaultDepth (x_current_display
,
530 XDefaultScreen (x_current_display
)));
532 XCreatePixmapFromBitmapData (XDISPLAY s
->display
.x
->window_desc
,
533 down_arrow_bits
, 16, 16,
534 s
->display
.x
->foreground_pixel
,
535 s
->display
.x
->background_pixel
,
536 DefaultDepth (x_current_display
,
537 XDefaultScreen (x_current_display
)));
539 XSetWindowBackgroundPixmap (XDISPLAY s
->display
.x
->v_thumbup
,
541 XSetWindowBackgroundPixmap (XDISPLAY s
->display
.x
->v_thumbdown
,
543 XSetWindowBackgroundPixmap (XDISPLAY s
->display
.x
->v_slider
,
546 XClearWindow (XDISPLAY s
->display
.x
->v_thumbup
);
547 XClearWindow (XDISPLAY s
->display
.x
->v_thumbdown
);
548 XClearWindow (XDISPLAY s
->display
.x
->v_slider
);
550 XFreePixmap (x_current_display
, down_arrow_pixmap
);
551 XFreePixmap (x_current_display
, up_arrow_pixmap
);
552 XFreePixmap (x_current_display
, slider_pixmap
);
554 if (s
->display
.x
->h_scrollbar
)
556 Pixmap left_arrow_pixmap
, right_arrow_pixmap
, slider_pixmap
;
558 XSetWindowBorder (x_current_display
, s
->display
.x
->h_scrollbar
,
559 s
->display
.x
->foreground_pixel
);
562 XCreatePixmapFromBitmapData (XDISPLAY s
->display
.x
->window_desc
,
564 s
->display
.x
->foreground_pixel
,
565 s
->display
.x
->background_pixel
,
566 DefaultDepth (x_current_display
,
567 XDefaultScreen (x_current_display
)));
570 XCreatePixmapFromBitmapData (XDISPLAY s
->display
.x
->window_desc
,
571 up_arrow_bits
, 16, 16,
572 s
->display
.x
->foreground_pixel
,
573 s
->display
.x
->background_pixel
,
574 DefaultDepth (x_current_display
,
575 XDefaultScreen (x_current_display
)));
577 XCreatePixmapFromBitmapData (XDISPLAY s
->display
.x
->window_desc
,
578 down_arrow_bits
, 16, 16,
579 s
->display
.x
->foreground_pixel
,
580 s
->display
.x
->background_pixel
,
581 DefaultDepth (x_current_display
,
582 XDefaultScreen (x_current_display
)));
584 XSetWindowBackgroundPixmap (XDISPLAY s
->display
.x
->h_slider
,
586 XSetWindowBackgroundPixmap (XDISPLAY s
->display
.x
->h_thumbleft
,
588 XSetWindowBackgroundPixmap (XDISPLAY s
->display
.x
->h_thumbright
,
591 XClearWindow (XDISPLAY s
->display
.x
->h_thumbleft
);
592 XClearWindow (XDISPLAY s
->display
.x
->h_thumbright
);
593 XClearWindow (XDISPLAY s
->display
.x
->h_slider
);
595 XFreePixmap (x_current_display
, slider_pixmap
);
596 XFreePixmap (x_current_display
, left_arrow_pixmap
);
597 XFreePixmap (x_current_display
, right_arrow_pixmap
);
600 #endif /* HAVE_X11 */
607 x_set_background_color (s
, arg
, oldval
)
609 Lisp_Object arg
, oldval
;
614 s
->display
.x
->background_pixel
= x_decode_color (arg
, WHITE_PIX_DEFAULT
);
616 if (s
->display
.x
->window_desc
!= 0)
620 /* The main screen. */
621 XSetBackground (x_current_display
, s
->display
.x
->normal_gc
,
622 s
->display
.x
->background_pixel
);
623 XSetForeground (x_current_display
, s
->display
.x
->reverse_gc
,
624 s
->display
.x
->background_pixel
);
625 XSetWindowBackground (x_current_display
, s
->display
.x
->window_desc
,
626 s
->display
.x
->background_pixel
);
629 if (s
->display
.x
->v_scrollbar
)
631 Pixmap up_arrow_pixmap
, down_arrow_pixmap
, slider_pixmap
;
633 XSetWindowBackground (x_current_display
, s
->display
.x
->v_scrollbar
,
634 s
->display
.x
->background_pixel
);
637 XCreatePixmapFromBitmapData (XDISPLAY s
->display
.x
->window_desc
,
639 s
->display
.x
->foreground_pixel
,
640 s
->display
.x
->background_pixel
,
641 DefaultDepth (x_current_display
,
642 XDefaultScreen (x_current_display
)));
644 XCreatePixmapFromBitmapData (XDISPLAY s
->display
.x
->window_desc
,
645 up_arrow_bits
, 16, 16,
646 s
->display
.x
->foreground_pixel
,
647 s
->display
.x
->background_pixel
,
648 DefaultDepth (x_current_display
,
649 XDefaultScreen (x_current_display
)));
651 XCreatePixmapFromBitmapData (XDISPLAY s
->display
.x
->window_desc
,
652 down_arrow_bits
, 16, 16,
653 s
->display
.x
->foreground_pixel
,
654 s
->display
.x
->background_pixel
,
655 DefaultDepth (x_current_display
,
656 XDefaultScreen (x_current_display
)));
658 XSetWindowBackgroundPixmap (XDISPLAY s
->display
.x
->v_thumbup
,
660 XSetWindowBackgroundPixmap (XDISPLAY s
->display
.x
->v_thumbdown
,
662 XSetWindowBackgroundPixmap (XDISPLAY s
->display
.x
->v_slider
,
665 XClearWindow (XDISPLAY s
->display
.x
->v_thumbup
);
666 XClearWindow (XDISPLAY s
->display
.x
->v_thumbdown
);
667 XClearWindow (XDISPLAY s
->display
.x
->v_slider
);
669 XFreePixmap (x_current_display
, down_arrow_pixmap
);
670 XFreePixmap (x_current_display
, up_arrow_pixmap
);
671 XFreePixmap (x_current_display
, slider_pixmap
);
673 if (s
->display
.x
->h_scrollbar
)
675 Pixmap left_arrow_pixmap
, right_arrow_pixmap
, slider_pixmap
;
677 XSetWindowBackground (x_current_display
, s
->display
.x
->h_scrollbar
,
678 s
->display
.x
->background_pixel
);
681 XCreatePixmapFromBitmapData (XDISPLAY s
->display
.x
->window_desc
,
683 s
->display
.x
->foreground_pixel
,
684 s
->display
.x
->background_pixel
,
685 DefaultDepth (x_current_display
,
686 XDefaultScreen (x_current_display
)));
689 XCreatePixmapFromBitmapData (XDISPLAY s
->display
.x
->window_desc
,
690 up_arrow_bits
, 16, 16,
691 s
->display
.x
->foreground_pixel
,
692 s
->display
.x
->background_pixel
,
693 DefaultDepth (x_current_display
,
694 XDefaultScreen (x_current_display
)));
696 XCreatePixmapFromBitmapData (XDISPLAY s
->display
.x
->window_desc
,
697 down_arrow_bits
, 16, 16,
698 s
->display
.x
->foreground_pixel
,
699 s
->display
.x
->background_pixel
,
700 DefaultDepth (x_current_display
,
701 XDefaultScreen (x_current_display
)));
703 XSetWindowBackgroundPixmap (XDISPLAY s
->display
.x
->h_slider
,
705 XSetWindowBackgroundPixmap (XDISPLAY s
->display
.x
->h_thumbleft
,
707 XSetWindowBackgroundPixmap (XDISPLAY s
->display
.x
->h_thumbright
,
710 XClearWindow (XDISPLAY s
->display
.x
->h_thumbleft
);
711 XClearWindow (XDISPLAY s
->display
.x
->h_thumbright
);
712 XClearWindow (XDISPLAY s
->display
.x
->h_slider
);
714 XFreePixmap (x_current_display
, slider_pixmap
);
715 XFreePixmap (x_current_display
, left_arrow_pixmap
);
716 XFreePixmap (x_current_display
, right_arrow_pixmap
);
719 temp
= XMakeTile (s
->display
.x
->background_pixel
);
720 XChangeBackground (s
->display
.x
->window_desc
, temp
);
722 #endif /* not HAVE_X11 */
731 x_set_mouse_color (s
, arg
, oldval
)
733 Lisp_Object arg
, oldval
;
735 Cursor cursor
, nontext_cursor
, mode_cursor
;
739 s
->display
.x
->mouse_pixel
= x_decode_color (arg
, BLACK_PIX_DEFAULT
);
740 mask_color
= s
->display
.x
->background_pixel
;
741 /* No invisible pointers. */
742 if (mask_color
== s
->display
.x
->mouse_pixel
743 && mask_color
== s
->display
.x
->background_pixel
)
744 s
->display
.x
->mouse_pixel
= s
->display
.x
->foreground_pixel
;
748 if (!EQ (Qnil
, Vx_pointer_shape
))
750 CHECK_NUMBER (Vx_pointer_shape
, 0);
751 cursor
= XCreateFontCursor (x_current_display
, XINT (Vx_pointer_shape
));
754 cursor
= XCreateFontCursor (x_current_display
, XC_xterm
);
756 if (!EQ (Qnil
, Vx_nontext_pointer_shape
))
758 CHECK_NUMBER (Vx_nontext_pointer_shape
, 0);
759 nontext_cursor
= XCreateFontCursor (x_current_display
,
760 XINT (Vx_nontext_pointer_shape
));
763 nontext_cursor
= XCreateFontCursor (x_current_display
, XC_left_ptr
);
765 if (!EQ (Qnil
, Vx_mode_pointer_shape
))
767 CHECK_NUMBER (Vx_mode_pointer_shape
, 0);
768 mode_cursor
= XCreateFontCursor (x_current_display
,
769 XINT (Vx_mode_pointer_shape
));
772 mode_cursor
= XCreateFontCursor (x_current_display
, XC_xterm
);
775 XColor fore_color
, back_color
;
777 fore_color
.pixel
= s
->display
.x
->mouse_pixel
;
778 back_color
.pixel
= mask_color
;
779 XQueryColor (x_current_display
,
780 DefaultColormap (x_current_display
,
781 DefaultScreen (x_current_display
)),
783 XQueryColor (x_current_display
,
784 DefaultColormap (x_current_display
,
785 DefaultScreen (x_current_display
)),
787 XRecolorCursor (x_current_display
, cursor
,
788 &fore_color
, &back_color
);
789 XRecolorCursor (x_current_display
, nontext_cursor
,
790 &fore_color
, &back_color
);
791 XRecolorCursor (x_current_display
, mode_cursor
,
792 &fore_color
, &back_color
);
795 cursor
= XCreateCursor (16, 16, MouseCursor
, MouseMask
,
797 s
->display
.x
->mouse_pixel
,
798 s
->display
.x
->background_pixel
,
802 if (s
->display
.x
->window_desc
!= 0)
804 XDefineCursor (XDISPLAY s
->display
.x
->window_desc
, cursor
);
807 if (cursor
!= s
->display
.x
->text_cursor
&& s
->display
.x
->text_cursor
!= 0)
808 XFreeCursor (XDISPLAY s
->display
.x
->text_cursor
);
809 s
->display
.x
->text_cursor
= cursor
;
811 if (nontext_cursor
!= s
->display
.x
->nontext_cursor
812 && s
->display
.x
->nontext_cursor
!= 0)
813 XFreeCursor (XDISPLAY s
->display
.x
->nontext_cursor
);
814 s
->display
.x
->nontext_cursor
= nontext_cursor
;
816 if (mode_cursor
!= s
->display
.x
->modeline_cursor
817 && s
->display
.x
->modeline_cursor
!= 0)
818 XFreeCursor (XDISPLAY s
->display
.x
->modeline_cursor
);
819 s
->display
.x
->modeline_cursor
= mode_cursor
;
820 #endif /* HAVE_X11 */
827 x_set_cursor_color (s
, arg
, oldval
)
829 Lisp_Object arg
, oldval
;
831 unsigned long fore_pixel
;
833 if (!EQ (Vx_cursor_fore_pixel
, Qnil
))
834 fore_pixel
= x_decode_color (Vx_cursor_fore_pixel
, WHITE_PIX_DEFAULT
);
836 fore_pixel
= s
->display
.x
->background_pixel
;
837 s
->display
.x
->cursor_pixel
= x_decode_color (arg
, BLACK_PIX_DEFAULT
);
838 /* No invisible cursors */
839 if (s
->display
.x
->cursor_pixel
== s
->display
.x
->background_pixel
)
841 s
->display
.x
->cursor_pixel
== s
->display
.x
->mouse_pixel
;
842 if (s
->display
.x
->cursor_pixel
== fore_pixel
)
843 fore_pixel
= s
->display
.x
->background_pixel
;
846 if (s
->display
.x
->window_desc
!= 0)
850 XSetBackground (x_current_display
, s
->display
.x
->cursor_gc
,
851 s
->display
.x
->cursor_pixel
);
852 XSetForeground (x_current_display
, s
->display
.x
->cursor_gc
,
855 #endif /* HAVE_X11 */
859 x_display_cursor (s
, 0);
860 x_display_cursor (s
, 1);
865 /* Set the border-color of screen S to value described by ARG.
866 ARG can be a string naming a color.
867 The border-color is used for the border that is drawn by the X server.
868 Note that this does not fully take effect if done before
869 S has an x-window; it must be redone when the window is created.
871 Note: this is done in two routines because of the way X10 works.
873 Note: under X11, this is normally the province of the window manager,
874 and so emacs' border colors may be overridden. */
877 x_set_border_color (s
, arg
, oldval
)
879 Lisp_Object arg
, oldval
;
884 CHECK_STRING (arg
, 0);
885 str
= XSTRING (arg
)->data
;
888 if (!strcmp (str
, "grey") || !strcmp (str
, "Grey")
889 || !strcmp (str
, "gray") || !strcmp (str
, "Gray"))
894 pix
= x_decode_color (arg
, BLACK_PIX_DEFAULT
);
896 x_set_border_pixel (s
, pix
);
899 /* Set the border-color of screen S to pixel value PIX.
900 Note that this does not fully take effect if done before
901 S has an x-window. */
903 x_set_border_pixel (s
, pix
)
907 s
->display
.x
->border_pixel
= pix
;
909 if (s
->display
.x
->window_desc
!= 0 && s
->display
.x
->border_width
> 0)
916 XSetWindowBorder (x_current_display
, s
->display
.x
->window_desc
,
918 if (s
->display
.x
->h_scrollbar
)
919 XSetWindowBorder (x_current_display
, s
->display
.x
->h_slider
,
921 if (s
->display
.x
->v_scrollbar
)
922 XSetWindowBorder (x_current_display
, s
->display
.x
->v_slider
,
926 temp
= XMakePixmap ((Bitmap
) XStoreBitmap (16, 16, gray_bits
),
927 BLACK_PIX_DEFAULT
, WHITE_PIX_DEFAULT
);
929 temp
= XMakeTile (pix
);
930 XChangeBorder (s
->display
.x
->window_desc
, temp
);
931 XFreePixmap (XDISPLAY temp
);
932 #endif /* not HAVE_X11 */
941 x_set_icon_type (s
, arg
, oldval
)
943 Lisp_Object arg
, oldval
;
948 if (EQ (oldval
, Qnil
) == EQ (arg
, Qnil
))
953 result
= x_text_icon (s
, 0);
955 result
= x_bitmap_icon (s
, 0);
959 error ("No icon window available.");
963 /* If the window was unmapped (and its icon was mapped),
964 the new icon is not mapped, so map the window in its stead. */
966 XMapWindow (XDISPLAY s
->display
.x
->window_desc
);
973 x_set_font (s
, arg
, oldval
)
975 Lisp_Object arg
, oldval
;
980 CHECK_STRING (arg
, 1);
981 name
= XSTRING (arg
)->data
;
984 result
= x_new_font (s
, name
);
988 error ("Font \"%s\" is not defined", name
);
992 x_set_border_width (s
, arg
, oldval
)
994 Lisp_Object arg
, oldval
;
996 CHECK_NUMBER (arg
, 0);
998 if (XINT (arg
) == s
->display
.x
->border_width
)
1001 if (s
->display
.x
->window_desc
!= 0)
1002 error ("Cannot change the border width of a window");
1004 s
->display
.x
->border_width
= XINT (arg
);
1008 x_set_internal_border_width (s
, arg
, oldval
)
1010 Lisp_Object arg
, oldval
;
1013 int old
= s
->display
.x
->internal_border_width
;
1015 CHECK_NUMBER (arg
, 0);
1016 s
->display
.x
->internal_border_width
= XINT (arg
);
1017 if (s
->display
.x
->internal_border_width
< 0)
1018 s
->display
.x
->internal_border_width
= 0;
1020 if (s
->display
.x
->internal_border_width
== old
)
1023 if (s
->display
.x
->window_desc
!= 0)
1026 x_set_window_size (s
, s
->width
, s
->height
);
1028 x_set_resize_hint (s
);
1032 SET_SCREEN_GARBAGED (s
);
1037 x_set_name (s
, arg
, oldval
)
1039 Lisp_Object arg
, oldval
;
1041 CHECK_STRING (arg
, 0);
1043 if (s
->display
.x
->window_desc
)
1047 XStoreName (XDISPLAY s
->display
.x
->window_desc
,
1048 (char *) XSTRING (arg
)->data
);
1049 XSetIconName (XDISPLAY s
->display
.x
->window_desc
,
1050 (char *) XSTRING (arg
)->data
);
1056 x_set_autoraise (s
, arg
, oldval
)
1058 Lisp_Object arg
, oldval
;
1060 s
->auto_raise
= !EQ (Qnil
, arg
);
1064 x_set_autolower (s
, arg
, oldval
)
1066 Lisp_Object arg
, oldval
;
1068 s
->auto_lower
= !EQ (Qnil
, arg
);
1074 x_set_face (scr
, font
, background
, foreground
, stipple
)
1077 unsigned long background
, foreground
;
1080 XGCValues gc_values
;
1082 unsigned long gc_mask
;
1083 struct face
*new_face
;
1084 unsigned int width
= 16;
1085 unsigned int height
= 16;
1087 if (n_faces
== MAX_FACES_AND_GLYPHS
)
1090 /* Create the Graphics Context. */
1091 gc_values
.font
= font
->fid
;
1092 gc_values
.foreground
= foreground
;
1093 gc_values
.background
= background
;
1094 gc_values
.line_width
= 0;
1095 gc_mask
= GCLineWidth
| GCFont
| GCForeground
| GCBackground
;
1099 = XCreateBitmapFromData (x_current_display
, ROOT_WINDOW
,
1100 (char *) stipple
, width
, height
);
1101 gc_mask
|= GCStipple
;
1104 temp_gc
= XCreateGC (x_current_display
, scr
->display
.x
->window_desc
,
1105 gc_mask
, &gc_values
);
1108 new_face
= (struct face
*) xmalloc (sizeof (struct face
));
1111 XFreeGC (x_current_display
, temp_gc
);
1115 new_face
->font
= font
;
1116 new_face
->foreground
= foreground
;
1117 new_face
->background
= background
;
1118 new_face
->face_gc
= temp_gc
;
1120 new_face
->stipple
= gc_values
.stipple
;
1122 x_face_table
[++n_faces
] = new_face
;
1126 x_set_glyph (scr
, glyph
)
1131 DEFUN ("x-set-face-font", Fx_set_face_font
, Sx_set_face_font
, 4, 2, 0,
1132 "Specify face table entry FACE-CODE to be the font named by FONT,\n\
1133 in colors FOREGROUND and BACKGROUND.")
1134 (face_code
, font_name
, foreground
, background
)
1135 Lisp_Object face_code
;
1136 Lisp_Object font_name
;
1137 Lisp_Object foreground
;
1138 Lisp_Object background
;
1140 register struct face
*fp
; /* Current face info. */
1141 register int fn
; /* Face number. */
1142 register FONT_TYPE
*f
; /* Font data structure. */
1143 unsigned char *newname
;
1146 XGCValues gc_values
;
1148 /* Need to do something about this. */
1149 Drawable drawable
= selected_screen
->display
.x
->window_desc
;
1151 CHECK_NUMBER (face_code
, 1);
1152 CHECK_STRING (font_name
, 2);
1154 if (EQ (foreground
, Qnil
) || EQ (background
, Qnil
))
1156 fg
= selected_screen
->display
.x
->foreground_pixel
;
1157 bg
= selected_screen
->display
.x
->background_pixel
;
1161 CHECK_NUMBER (foreground
, 0);
1162 CHECK_NUMBER (background
, 1);
1164 fg
= x_decode_color (XINT (foreground
), BLACK_PIX_DEFAULT
);
1165 bg
= x_decode_color (XINT (background
), WHITE_PIX_DEFAULT
);
1168 fn
= XINT (face_code
);
1169 if ((fn
< 1) || (fn
> 255))
1170 error ("Invalid face code, %d", fn
);
1172 newname
= XSTRING (font_name
)->data
;
1174 f
= (*newname
== 0 ? 0 : XGetFont (newname
));
1177 error ("Font \"%s\" is not defined", newname
);
1179 fp
= x_face_table
[fn
];
1182 x_face_table
[fn
] = fp
= (struct face
*) xmalloc (sizeof (struct face
));
1183 bzero (fp
, sizeof (struct face
));
1184 fp
->face_type
= x_pixmap
;
1186 else if (FACE_IS_FONT (fn
))
1189 XFreeGC (FACE_FONT (fn
));
1192 else if (FACE_IS_IMAGE (fn
)) /* This should not happen... */
1195 XFreePixmap (x_current_display
, FACE_IMAGE (fn
));
1196 fp
->face_type
= x_font
;
1202 fp
->face_GLYPH
.font_desc
.font
= f
;
1203 gc_values
.font
= f
->fid
;
1204 gc_values
.foreground
= fg
;
1205 gc_values
.background
= bg
;
1206 fp
->face_GLYPH
.font_desc
.face_gc
= XCreateGC (x_current_display
,
1207 drawable
, GCFont
| GCForeground
1208 | GCBackground
, &gc_values
);
1209 fp
->face_GLYPH
.font_desc
.font_width
= FONT_WIDTH (f
);
1210 fp
->face_GLYPH
.font_desc
.font_height
= FONT_HEIGHT (f
);
1216 DEFUN ("x-set-face", Fx_set_face
, Sx_set_face
, 4, 4, 0,
1217 "Specify face table entry FACE-CODE to be the font named by FONT,\n\
1218 in colors FOREGROUND and BACKGROUND.")
1219 (face_code
, font_name
, foreground
, background
)
1220 Lisp_Object face_code
;
1221 Lisp_Object font_name
;
1222 Lisp_Object foreground
;
1223 Lisp_Object background
;
1225 register struct face
*fp
; /* Current face info. */
1226 register int fn
; /* Face number. */
1227 register FONT_TYPE
*f
; /* Font data structure. */
1228 unsigned char *newname
;
1230 CHECK_NUMBER (face_code
, 1);
1231 CHECK_STRING (font_name
, 2);
1233 fn
= XINT (face_code
);
1234 if ((fn
< 1) || (fn
> 255))
1235 error ("Invalid face code, %d", fn
);
1237 /* Ask the server to find the specified font. */
1238 newname
= XSTRING (font_name
)->data
;
1240 f
= (*newname
== 0 ? 0 : XGetFont (newname
));
1243 error ("Font \"%s\" is not defined", newname
);
1245 /* Get the face structure for face_code in the face table.
1246 Make sure it exists. */
1247 fp
= x_face_table
[fn
];
1250 x_face_table
[fn
] = fp
= (struct face
*) xmalloc (sizeof (struct face
));
1251 bzero (fp
, sizeof (struct face
));
1254 /* If this face code already exists, get rid of the old font. */
1255 if (fp
->font
!= 0 && fp
->font
!= f
)
1258 XLoseFont (fp
->font
);
1262 /* Store the specified information in FP. */
1263 fp
->fg
= x_decode_color (foreground
, BLACK_PIX_DEFAULT
);
1264 fp
->bg
= x_decode_color (background
, WHITE_PIX_DEFAULT
);
1272 /* This is excluded because there is no painless way
1273 to get or to remember the name of the font. */
1275 DEFUN ("x-get-face", Fx_get_face
, Sx_get_face
, 1, 1, 0,
1276 "Get data defining face code FACE. FACE is an integer.\n\
1277 The value is a list (FONT FG-COLOR BG-COLOR).")
1281 register struct face
*fp
; /* Current face info. */
1282 register int fn
; /* Face number. */
1284 CHECK_NUMBER (face
, 1);
1286 if ((fn
< 1) || (fn
> 255))
1287 error ("Invalid face code, %d", fn
);
1289 /* Make sure the face table exists and this face code is defined. */
1290 if (x_face_table
== 0 || x_face_table
[fn
] == 0)
1293 fp
= x_face_table
[fn
];
1295 return Fcons (build_string (fp
->name
),
1296 Fcons (make_number (fp
->fg
),
1297 Fcons (make_number (fp
->bg
), Qnil
)));
1301 /* Subroutines of creating an X screen. */
1304 extern char *x_get_string_resource ();
1305 extern XrmDatabase
x_load_resources ();
1307 DEFUN ("x-get-resource", Fx_get_resource
, Sx_get_resource
, 1, 3, 0,
1308 "Retrieve the value of ATTRIBUTE from the X defaults database. This\n\
1309 searches using a key of the form \"INSTANCE.ATTRIBUTE\", with class\n\
1310 \"Emacs\", where INSTANCE is the name under which Emacs was invoked.\n\
1312 Optional arguments COMPONENT and CLASS specify the component for which\n\
1313 we should look up ATTRIBUTE. When specified, Emacs searches using a\n\
1314 key of the form INSTANCE.COMPONENT.ATTRIBUTE, with class \"Emacs.CLASS\".")
1315 (attribute
, name
, class)
1316 Lisp_Object attribute
, name
, class;
1318 register char *value
;
1322 CHECK_STRING (attribute
, 0);
1324 CHECK_STRING (name
, 1);
1326 CHECK_STRING (class, 2);
1327 if (NILP (name
) != NILP (class))
1328 error ("x-get-resource: must specify both NAME and CLASS or neither");
1332 name_key
= (char *) alloca (XSTRING (invocation_name
)->size
+ 1
1333 + XSTRING (attribute
)->size
+ 1);
1335 sprintf (name_key
, "%s.%s",
1336 XSTRING (invocation_name
)->data
,
1337 XSTRING (attribute
)->data
);
1338 class_key
= EMACS_CLASS
;
1342 name_key
= (char *) alloca (XSTRING (invocation_name
)->size
+ 1
1343 + XSTRING (name
)->size
+ 1
1344 + XSTRING (attribute
)->size
+ 1);
1346 class_key
= (char *) alloca (sizeof (EMACS_CLASS
)
1347 + XSTRING (class)->size
+ 1);
1349 sprintf (name_key
, "%s.%s.%s",
1350 XSTRING (invocation_name
)->data
,
1351 XSTRING (name
)->data
,
1352 XSTRING (attribute
)->data
);
1353 sprintf (class_key
, "%s.%s",
1354 XSTRING (invocation_name
)->data
,
1355 XSTRING (class)->data
);
1358 value
= x_get_string_resource (xrdb
, name_key
, class_key
);
1360 if (value
!= (char *) 0)
1361 return build_string (value
);
1368 DEFUN ("x-get-default", Fx_get_default
, Sx_get_default
, 1, 1, 0,
1369 "Get X default ATTRIBUTE from the system, or nil if no default.\n\
1370 Value is a string (when not nil) and ATTRIBUTE is also a string.\n\
1371 The defaults are specified in the file `~/.Xdefaults'.")
1375 register unsigned char *value
;
1377 CHECK_STRING (arg
, 1);
1379 value
= (unsigned char *) XGetDefault (XDISPLAY
1380 XSTRING (invocation_name
)->data
,
1381 XSTRING (arg
)->data
);
1383 /* Try reversing last two args, in case this is the buggy version of X. */
1384 value
= (unsigned char *) XGetDefault (XDISPLAY
1385 XSTRING (arg
)->data
,
1386 XSTRING (invocation_name
)->data
);
1388 return build_string (value
);
1393 #define Fx_get_resource(attribute, name, class) Fx_get_default(attribute)
1397 /* Types we might convert a resource string into. */
1400 number
, boolean
, string
,
1403 /* Return the value of parameter PARAM.
1405 First search ALIST, then Vdefault_screen_alist, then the X defaults
1406 database, using ATTRIBUTE as the attribute name.
1408 Convert the resource to the type specified by desired_type.
1410 If no default is specified, return nil. */
1413 x_get_arg (alist
, param
, attribute
, type
)
1414 Lisp_Object alist
, param
;
1416 enum resource_types type
;
1418 register Lisp_Object tem
;
1420 tem
= Fassq (param
, alist
);
1422 tem
= Fassq (param
, Vdefault_screen_alist
);
1423 if (EQ (tem
, Qnil
) && attribute
)
1425 tem
= Fx_get_resource (build_string (attribute
), Qnil
, Qnil
);
1433 return make_number (atoi (XSTRING (tem
)->data
));
1436 tem
= Fdowncase (tem
);
1437 if (!strcmp (XSTRING (tem
)->data
, "on")
1438 || !strcmp (XSTRING (tem
)->data
, "true"))
1453 /* Record in screen S the specified or default value according to ALIST
1454 of the parameter named PARAM (a Lisp symbol).
1455 If no value is specified for PARAM, look for an X default for XPROP
1456 on the screen named NAME.
1457 If that is not found either, use the value DEFLT. */
1460 x_default_parameter (s
, alist
, propname
, deflt
, xprop
, type
)
1466 enum resource_types type
;
1468 Lisp_Object propsym
= intern (propname
);
1471 tem
= x_get_arg (alist
, propsym
, xprop
, type
);
1474 store_screen_param (s
, propsym
, tem
);
1475 x_set_screen_param (s
, propsym
, tem
, Qnil
);
1479 DEFUN ("x-geometry", Fx_geometry
, Sx_geometry
, 1, 1, 0,
1480 "Parse an X-style geometry string STRING.\n\
1481 Returns an alist of the form ((top . TOP), (left . LEFT) ... ).")
1485 unsigned int width
, height
;
1486 Lisp_Object values
[4];
1488 CHECK_STRING (string
, 0);
1490 geometry
= XParseGeometry ((char *) XSTRING (string
)->data
,
1491 &x
, &y
, &width
, &height
);
1493 switch (geometry
& 0xf) /* Mask out {X,Y}Negative */
1495 case (XValue
| YValue
):
1496 /* What's one pixel among friends?
1497 Perhaps fix this some day by returning symbol `extreme-top'... */
1498 if (x
== 0 && (geometry
& XNegative
))
1500 if (y
== 0 && (geometry
& YNegative
))
1502 values
[0] = Fcons (intern ("left"), make_number (x
));
1503 values
[1] = Fcons (intern ("top"), make_number (y
));
1504 return Flist (2, values
);
1507 case (WidthValue
| HeightValue
):
1508 values
[0] = Fcons (intern ("width"), make_number (width
));
1509 values
[1] = Fcons (intern ("height"), make_number (height
));
1510 return Flist (2, values
);
1513 case (XValue
| YValue
| WidthValue
| HeightValue
):
1514 if (x
== 0 && (geometry
& XNegative
))
1516 if (y
== 0 && (geometry
& YNegative
))
1518 values
[0] = Fcons (intern ("width"), make_number (width
));
1519 values
[1] = Fcons (intern ("height"), make_number (height
));
1520 values
[2] = Fcons (intern ("left"), make_number (x
));
1521 values
[3] = Fcons (intern ("top"), make_number (y
));
1522 return Flist (4, values
);
1529 error ("Must specify x and y value, and/or width and height");
1534 /* Calculate the desired size and position of this window,
1535 or set rubber-band prompting if none. */
1537 #define DEFAULT_ROWS 40
1538 #define DEFAULT_COLS 80
1541 x_figure_window_size (s
, parms
)
1545 register Lisp_Object tem0
, tem1
;
1546 int height
, width
, left
, top
;
1547 register int geometry
;
1548 long window_prompting
= 0;
1550 /* Default values if we fall through.
1551 Actually, if that happens we should get
1552 window manager prompting. */
1553 s
->width
= DEFAULT_COLS
;
1554 s
->height
= DEFAULT_ROWS
;
1555 s
->display
.x
->top_pos
= 1;
1556 s
->display
.x
->left_pos
= 1;
1558 tem0
= x_get_arg (parms
, intern ("height"), 0, 0);
1559 tem1
= x_get_arg (parms
, intern ("width"), 0, 0);
1560 if (! EQ (tem0
, Qnil
) && ! EQ (tem1
, Qnil
))
1562 CHECK_NUMBER (tem0
, 0);
1563 CHECK_NUMBER (tem1
, 0);
1564 s
->height
= XINT (tem0
);
1565 s
->width
= XINT (tem1
);
1566 window_prompting
|= USSize
;
1568 else if (! EQ (tem0
, Qnil
) || ! EQ (tem1
, Qnil
))
1569 error ("Must specify *both* height and width");
1571 s
->display
.x
->pixel_width
= (FONT_WIDTH (s
->display
.x
->font
) * s
->width
1572 + 2 * s
->display
.x
->internal_border_width
);
1573 s
->display
.x
->pixel_height
= (FONT_HEIGHT (s
->display
.x
->font
) * s
->height
1574 + 2 * s
->display
.x
->internal_border_width
);
1576 tem0
= x_get_arg (parms
, intern ("top"), 0, 0);
1577 tem1
= x_get_arg (parms
, intern ("left"), 0, 0);
1578 if (! EQ (tem0
, Qnil
) && ! EQ (tem1
, Qnil
))
1580 CHECK_NUMBER (tem0
, 0);
1581 CHECK_NUMBER (tem1
, 0);
1582 s
->display
.x
->top_pos
= XINT (tem0
);
1583 s
->display
.x
->left_pos
= XINT (tem1
);
1584 x_calc_absolute_position (s
);
1585 window_prompting
|= USPosition
;
1587 else if (! EQ (tem0
, Qnil
) || ! EQ (tem1
, Qnil
))
1588 error ("Must specify *both* top and left corners");
1590 switch (window_prompting
)
1592 case USSize
| USPosition
:
1593 return window_prompting
;
1596 case USSize
: /* Got the size, need the position. */
1597 window_prompting
|= PPosition
;
1598 return window_prompting
;
1601 case USPosition
: /* Got the position, need the size. */
1602 window_prompting
|= PSize
;
1603 return window_prompting
;
1606 case 0: /* Got nothing, take both from geometry. */
1607 window_prompting
|= PPosition
| PSize
;
1608 return window_prompting
;
1612 /* Somehow a bit got set in window_prompting that we didn't
1622 XSetWindowAttributes attributes
;
1623 unsigned long attribute_mask
;
1624 XClassHint class_hints
;
1626 attributes
.background_pixel
= s
->display
.x
->background_pixel
;
1627 attributes
.border_pixel
= s
->display
.x
->border_pixel
;
1628 attributes
.bit_gravity
= StaticGravity
;
1629 attributes
.backing_store
= NotUseful
;
1630 attributes
.save_under
= True
;
1631 attributes
.event_mask
= STANDARD_EVENT_SET
;
1632 attribute_mask
= (CWBackPixel
| CWBorderPixel
| CWBitGravity
1634 | CWBackingStore
| CWSaveUnder
1639 s
->display
.x
->window_desc
1640 = XCreateWindow (x_current_display
, ROOT_WINDOW
,
1641 s
->display
.x
->left_pos
,
1642 s
->display
.x
->top_pos
,
1643 PIXEL_WIDTH (s
), PIXEL_HEIGHT (s
),
1644 s
->display
.x
->border_width
,
1645 CopyFromParent
, /* depth */
1646 InputOutput
, /* class */
1647 screen_visual
, /* set in Fx_open_connection */
1648 attribute_mask
, &attributes
);
1650 class_hints
.res_name
= (char *) XSTRING (s
->name
)->data
;
1651 class_hints
.res_class
= EMACS_CLASS
;
1652 XSetClassHint (x_current_display
, s
->display
.x
->window_desc
, &class_hints
);
1654 XDefineCursor (XDISPLAY s
->display
.x
->window_desc
,
1655 s
->display
.x
->text_cursor
);
1658 if (s
->display
.x
->window_desc
== 0)
1659 error ("Unable to create window.");
1662 /* Handle the icon stuff for this window. Perhaps later we might
1663 want an x_set_icon_position which can be called interactively as
1671 register Lisp_Object tem0
,tem1
;
1674 /* Set the position of the icon. Note that twm groups all
1675 icons in an icon window. */
1676 tem0
= x_get_arg (parms
, intern ("icon-left"), 0, 0);
1677 tem1
= x_get_arg (parms
, intern ("icon-top"), 0, 0);
1678 if (!EQ (tem0
, Qnil
) && !EQ (tem1
, Qnil
))
1680 CHECK_NUMBER (tem0
, 0);
1681 CHECK_NUMBER (tem1
, 0);
1682 hints
.icon_x
= XINT (tem0
);
1683 hints
.icon_x
= XINT (tem0
);
1685 else if (!EQ (tem0
, Qnil
) || !EQ (tem1
, Qnil
))
1686 error ("Both left and top icon corners of icon must be specified");
1689 hints
.icon_x
= s
->display
.x
->left_pos
;
1690 hints
.icon_y
= s
->display
.x
->top_pos
;
1693 /* Start up iconic or window? */
1694 tem0
= x_get_arg (parms
, intern ("iconic-startup"), 0, 0);
1695 if (!EQ (tem0
, Qnil
))
1696 hints
.initial_state
= IconicState
;
1698 hints
.initial_state
= NormalState
; /* the default, actually. */
1699 hints
.input
= False
;
1702 hints
.flags
= StateHint
| IconPositionHint
| InputHint
;
1703 XSetWMHints (x_current_display
, s
->display
.x
->window_desc
, &hints
);
1707 /* Make the GC's needed for this window, setting the
1708 background, border and mouse colors; also create the
1709 mouse cursor and the gray border tile. */
1715 XGCValues gc_values
;
1718 static char cursor_bits
[] =
1720 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
1721 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
1722 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
1723 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00
1726 /* Create the GC's of this screen.
1727 Note that many default values are used. */
1730 gc_values
.font
= s
->display
.x
->font
->fid
;
1731 gc_values
.foreground
= s
->display
.x
->foreground_pixel
;
1732 gc_values
.background
= s
->display
.x
->background_pixel
;
1733 gc_values
.line_width
= 0; /* Means 1 using fast algorithm. */
1734 s
->display
.x
->normal_gc
= XCreateGC (x_current_display
,
1735 s
->display
.x
->window_desc
,
1736 GCLineWidth
| GCFont
1737 | GCForeground
| GCBackground
,
1740 /* Reverse video style. */
1741 gc_values
.foreground
= s
->display
.x
->background_pixel
;
1742 gc_values
.background
= s
->display
.x
->foreground_pixel
;
1743 s
->display
.x
->reverse_gc
= XCreateGC (x_current_display
,
1744 s
->display
.x
->window_desc
,
1745 GCFont
| GCForeground
| GCBackground
1749 /* Cursor has cursor-color background, background-color foreground. */
1750 gc_values
.foreground
= s
->display
.x
->background_pixel
;
1751 gc_values
.background
= s
->display
.x
->cursor_pixel
;
1752 gc_values
.fill_style
= FillOpaqueStippled
;
1754 = XCreateBitmapFromData (x_current_display
, ROOT_WINDOW
,
1755 cursor_bits
, 16, 16);
1756 s
->display
.x
->cursor_gc
1757 = XCreateGC (x_current_display
, s
->display
.x
->window_desc
,
1758 (GCFont
| GCForeground
| GCBackground
1759 | GCFillStyle
| GCStipple
| GCLineWidth
),
1762 /* Create the gray border tile used when the pointer is not in
1763 the screen. Since this depends on the screen's pixel values,
1764 this must be done on a per-screen basis. */
1765 s
->display
.x
->border_tile
=
1766 XCreatePixmap (x_current_display
, ROOT_WINDOW
, 16, 16,
1767 DefaultDepth (x_current_display
,
1768 XDefaultScreen (x_current_display
)));
1769 gc_values
.foreground
= s
->display
.x
->foreground_pixel
;
1770 gc_values
.background
= s
->display
.x
->background_pixel
;
1771 temp_gc
= XCreateGC (x_current_display
,
1772 (Drawable
) s
->display
.x
->border_tile
,
1773 GCForeground
| GCBackground
, &gc_values
);
1775 /* These are things that should be determined by the server, in
1776 Fx_open_connection */
1777 tileimage
.height
= 16;
1778 tileimage
.width
= 16;
1779 tileimage
.xoffset
= 0;
1780 tileimage
.format
= XYBitmap
;
1781 tileimage
.data
= gray_bits
;
1782 tileimage
.byte_order
= LSBFirst
;
1783 tileimage
.bitmap_unit
= 8;
1784 tileimage
.bitmap_bit_order
= LSBFirst
;
1785 tileimage
.bitmap_pad
= 8;
1786 tileimage
.bytes_per_line
= (16 + 7) >> 3;
1787 tileimage
.depth
= 1;
1788 XPutImage (x_current_display
, s
->display
.x
->border_tile
, temp_gc
,
1789 &tileimage
, 0, 0, 0, 0, 16, 16);
1790 XFreeGC (x_current_display
, temp_gc
);
1792 #endif /* HAVE_X11 */
1794 DEFUN ("x-create-screen", Fx_create_screen
, Sx_create_screen
,
1796 "Make a new X window, which is called a \"screen\" in Emacs terms.\n\
1797 Return an Emacs screen object representing the X window.\n\
1798 ALIST is an alist of screen parameters.\n\
1799 The value of ``x-screen-defaults'' is an additional alist\n\
1800 of default parameters which apply when not overridden by ALIST.\n\
1801 If the parameters specify that the screen should not have a minibuffer,\n\
1802 then ``default-minibuffer-screen'' must be a screen whose minibuffer can\n\
1803 be shared by the new screen.")
1809 Lisp_Object screen
, tem
;
1811 int minibuffer_only
= 0;
1812 long window_prompting
= 0;
1815 if (x_current_display
== 0)
1816 error ("X windows are not in use or not initialized");
1818 name
= x_get_arg (parms
, intern ("name"), "Title", string
);
1820 name
= build_string (x_id_name
);
1821 if (XTYPE (name
) != Lisp_String
)
1822 error ("x-create-screen: name parameter must be a string");
1824 tem
= x_get_arg (parms
, intern ("minibuffer"), 0, 0);
1825 if (EQ (tem
, intern ("none")))
1826 s
= make_screen_without_minibuffer (Qnil
);
1827 else if (EQ (tem
, intern ("only")))
1829 s
= make_minibuffer_screen ();
1830 minibuffer_only
= 1;
1832 else if (EQ (tem
, Qnil
) || EQ (tem
, Qt
))
1833 s
= make_screen (1);
1835 s
= make_screen_without_minibuffer (tem
);
1837 /* Set the name; the functions to which we pass s expect the
1839 XSET (s
->name
, Lisp_String
, name
);
1841 XSET (screen
, Lisp_Screen
, s
);
1842 s
->output_method
= output_x_window
;
1843 s
->display
.x
= (struct x_display
*) xmalloc (sizeof (struct x_display
));
1844 bzero (s
->display
.x
, sizeof (struct x_display
));
1846 /* Note that the screen has no physical cursor right now. */
1847 s
->phys_cursor_x
= -1;
1849 /* Extract the window parameters from the supplied values
1850 that are needed to determine window geometry. */
1851 x_default_parameter (s
, parms
, "font",
1852 build_string ("9x15"), "font", string
);
1853 x_default_parameter (s
, parms
, "background-color",
1854 build_string ("white"), "background", string
);
1855 x_default_parameter (s
, parms
, "border-width",
1856 make_number (2), "BorderWidth", number
);
1857 x_default_parameter (s
, parms
, "internal-border-width",
1858 make_number (1), "InternalBorderWidth", number
);
1860 /* Also do the stuff which must be set before the window exists. */
1861 x_default_parameter (s
, parms
, "foreground-color",
1862 build_string ("black"), "foreground", string
);
1863 x_default_parameter (s
, parms
, "mouse-color",
1864 build_string ("black"), "mouse", string
);
1865 x_default_parameter (s
, parms
, "cursor-color",
1866 build_string ("black"), "cursor", string
);
1867 x_default_parameter (s
, parms
, "border-color",
1868 build_string ("black"), "border", string
);
1870 /* Need to do icon type, auto-raise, auto-lower. */
1872 s
->display
.x
->parent_desc
= ROOT_WINDOW
;
1873 window_prompting
= x_figure_window_size (s
, parms
);
1879 /* Dimensions, especially s->height, must be done via change_screen_size.
1880 Change will not be effected unless different from the current
1884 s
->height
= s
->width
= 0;
1885 change_screen_size (s
, height
, width
, 1);
1887 x_wm_set_size_hint (s
, window_prompting
);
1890 tem
= x_get_arg (parms
, intern ("unsplittable"), 0, 0);
1891 s
->no_split
= minibuffer_only
|| EQ (tem
, Qt
);
1893 /* Now handle the rest of the parameters. */
1894 x_default_parameter (s
, parms
, "horizontal-scroll-bar",
1895 Qnil
, "?HScrollBar", string
);
1896 x_default_parameter (s
, parms
, "vertical-scroll-bar",
1897 Qnil
, "?VScrollBar", string
);
1899 /* Make the window appear on the screen and enable display. */
1900 if (!EQ (x_get_arg (parms
, intern ("suppress-initial-map"), 0, 0), Qt
))
1901 x_make_screen_visible (s
);
1906 Lisp_Object screen
, tem
;
1908 int pixelwidth
, pixelheight
;
1913 int minibuffer_only
= 0;
1914 Lisp_Object vscroll
, hscroll
;
1916 if (x_current_display
== 0)
1917 error ("X windows are not in use or not initialized");
1919 name
= Fassq (intern ("name"), parms
);
1921 tem
= x_get_arg (parms
, intern ("minibuffer"), 0, 0);
1922 if (EQ (tem
, intern ("none")))
1923 s
= make_screen_without_minibuffer (Qnil
);
1924 else if (EQ (tem
, intern ("only")))
1926 s
= make_minibuffer_screen ();
1927 minibuffer_only
= 1;
1929 else if (! EQ (tem
, Qnil
))
1930 s
= make_screen_without_minibuffer (tem
);
1932 s
= make_screen (1);
1934 parent
= ROOT_WINDOW
;
1936 XSET (screen
, Lisp_Screen
, s
);
1937 s
->output_method
= output_x_window
;
1938 s
->display
.x
= (struct x_display
*) xmalloc (sizeof (struct x_display
));
1939 bzero (s
->display
.x
, sizeof (struct x_display
));
1941 /* Some temprorary default values for height and width. */
1944 s
->display
.x
->left_pos
= -1;
1945 s
->display
.x
->top_pos
= -1;
1947 /* Give the screen a default name (which may be overridden with PARMS). */
1949 strncpy (iconidentity
, ICONTAG
, MAXICID
);
1950 if (gethostname (&iconidentity
[sizeof (ICONTAG
) - 1],
1951 (MAXICID
- 1) - sizeof (ICONTAG
)))
1952 iconidentity
[sizeof (ICONTAG
) - 2] = '\0';
1953 s
->name
= build_string (iconidentity
);
1955 /* Extract some window parameters from the supplied values.
1956 These are the parameters that affect window geometry. */
1958 tem
= x_get_arg (parms
, intern ("font"), "BodyFont", string
);
1960 tem
= build_string ("9x15");
1961 x_set_font (s
, tem
);
1962 x_default_parameter (s
, parms
, "border-color",
1963 build_string ("black"), "Border", string
);
1964 x_default_parameter (s
, parms
, "background-color",
1965 build_string ("white"), "Background", string
);
1966 x_default_parameter (s
, parms
, "foreground-color",
1967 build_string ("black"), "Foreground", string
);
1968 x_default_parameter (s
, parms
, "mouse-color",
1969 build_string ("black"), "Mouse", string
);
1970 x_default_parameter (s
, parms
, "cursor-color",
1971 build_string ("black"), "Cursor", string
);
1972 x_default_parameter (s
, parms
, "border-width",
1973 make_number (2), "BorderWidth", number
);
1974 x_default_parameter (s
, parms
, "internal-border-width",
1975 make_number (4), "InternalBorderWidth", number
);
1976 x_default_parameter (s
, parms
, "auto-raise",
1977 Qnil
, "AutoRaise", boolean
);
1979 hscroll
= x_get_arg (parms
, intern ("horizontal-scroll-bar"), 0, 0);
1980 vscroll
= x_get_arg (parms
, intern ("vertical-scroll-bar"), 0, 0);
1982 if (s
->display
.x
->internal_border_width
< 0)
1983 s
->display
.x
->internal_border_width
= 0;
1985 tem
= x_get_arg (parms
, intern ("window-id"), 0, 0);
1986 if (!EQ (tem
, Qnil
))
1988 WINDOWINFO_TYPE wininfo
;
1990 Window
*children
, root
;
1992 CHECK_STRING (tem
, 0);
1993 s
->display
.x
->window_desc
= (Window
) atoi (XSTRING (tem
)->data
);
1996 XGetWindowInfo (s
->display
.x
->window_desc
, &wininfo
);
1997 XQueryTree (s
->display
.x
->window_desc
, &parent
, &nchildren
, &children
);
2001 height
= (wininfo
.height
- 2 * s
->display
.x
->internal_border_width
)
2002 / FONT_HEIGHT (s
->display
.x
->font
);
2003 width
= (wininfo
.width
- 2 * s
->display
.x
->internal_border_width
)
2004 / FONT_WIDTH (s
->display
.x
->font
);
2005 s
->display
.x
->left_pos
= wininfo
.x
;
2006 s
->display
.x
->top_pos
= wininfo
.y
;
2007 s
->visible
= wininfo
.mapped
!= 0;
2008 s
->display
.x
->border_width
= wininfo
.bdrwidth
;
2009 s
->display
.x
->parent_desc
= parent
;
2013 tem
= x_get_arg (parms
, intern ("parent-id"), 0, 0);
2014 if (!EQ (tem
, Qnil
))
2016 CHECK_STRING (tem
, 0);
2017 parent
= (Window
) atoi (XSTRING (tem
)->data
);
2019 s
->display
.x
->parent_desc
= parent
;
2020 tem
= x_get_arg (parms
, intern ("height"), 0, 0);
2023 tem
= x_get_arg (parms
, intern ("width"), 0, 0);
2026 tem
= x_get_arg (parms
, intern ("top"), 0, 0);
2028 tem
= x_get_arg (parms
, intern ("left"), 0, 0);
2031 /* Now TEM is nil if no edge or size was specified.
2032 In that case, we must do rubber-banding. */
2035 tem
= x_get_arg (parms
, intern ("geometry"), 0, 0);
2037 &s
->display
.x
->left_pos
, &s
->display
.x
->top_pos
,
2039 (XTYPE (tem
) == Lisp_String
2040 ? (char *) XSTRING (tem
)->data
: ""),
2041 XSTRING (s
->name
)->data
,
2042 !NILP (hscroll
), !NILP (vscroll
));
2046 /* Here if at least one edge or size was specified.
2047 Demand that they all were specified, and use them. */
2048 tem
= x_get_arg (parms
, intern ("height"), 0, 0);
2050 error ("Height not specified");
2051 CHECK_NUMBER (tem
, 0);
2052 height
= XINT (tem
);
2054 tem
= x_get_arg (parms
, intern ("width"), 0, 0);
2056 error ("Width not specified");
2057 CHECK_NUMBER (tem
, 0);
2060 tem
= x_get_arg (parms
, intern ("top"), 0, 0);
2062 error ("Top position not specified");
2063 CHECK_NUMBER (tem
, 0);
2064 s
->display
.x
->left_pos
= XINT (tem
);
2066 tem
= x_get_arg (parms
, intern ("left"), 0, 0);
2068 error ("Left position not specified");
2069 CHECK_NUMBER (tem
, 0);
2070 s
->display
.x
->top_pos
= XINT (tem
);
2073 pixelwidth
= (width
* FONT_WIDTH (s
->display
.x
->font
)
2074 + 2 * s
->display
.x
->internal_border_width
2075 + (!NILP (vscroll
) ? VSCROLL_WIDTH
: 0));
2076 pixelheight
= (height
* FONT_HEIGHT (s
->display
.x
->font
)
2077 + 2 * s
->display
.x
->internal_border_width
2078 + (!NILP (hscroll
) ? HSCROLL_HEIGHT
: 0));
2081 s
->display
.x
->window_desc
2082 = XCreateWindow (parent
,
2083 s
->display
.x
->left_pos
, /* Absolute horizontal offset */
2084 s
->display
.x
->top_pos
, /* Absolute Vertical offset */
2085 pixelwidth
, pixelheight
,
2086 s
->display
.x
->border_width
,
2087 BLACK_PIX_DEFAULT
, WHITE_PIX_DEFAULT
);
2089 if (s
->display
.x
->window_desc
== 0)
2090 error ("Unable to create window.");
2093 /* Install the now determined height and width
2094 in the windows and in phys_lines and desired_lines. */
2095 /* ??? jla version had 1 here instead of 0. */
2096 change_screen_size (s
, height
, width
, 1);
2097 XSelectInput (s
->display
.x
->window_desc
, KeyPressed
| ExposeWindow
2098 | ButtonPressed
| ButtonReleased
| ExposeRegion
| ExposeCopy
2099 | EnterWindow
| LeaveWindow
| UnmapWindow
);
2100 x_set_resize_hint (s
);
2102 /* Tell the server the window's default name. */
2104 XStoreName (XDISPLAY s
->display
.x
->window_desc
, XSTRING (s
->name
)->data
);
2105 /* Now override the defaults with all the rest of the specified
2107 tem
= x_get_arg (parms
, intern ("unsplittable"), 0, 0);
2108 s
->no_split
= minibuffer_only
|| EQ (tem
, Qt
);
2110 /* Do not create an icon window if the caller says not to */
2111 if (!EQ (x_get_arg (parms
, intern ("suppress-icon"), 0, 0), Qt
)
2112 || s
->display
.x
->parent_desc
!= ROOT_WINDOW
)
2114 x_text_icon (s
, iconidentity
);
2115 x_default_parameter (s
, parms
, "icon-type", Qnil
,
2116 "BitmapIcon", boolean
);
2119 /* Tell the X server the previously set values of the
2120 background, border and mouse colors; also create the mouse cursor. */
2122 temp
= XMakeTile (s
->display
.x
->background_pixel
);
2123 XChangeBackground (s
->display
.x
->window_desc
, temp
);
2126 x_set_border_pixel (s
, s
->display
.x
->border_pixel
);
2128 x_set_mouse_color (s
, Qnil
, Qnil
);
2130 /* Now override the defaults with all the rest of the specified parms. */
2132 Fmodify_screen_parameters (screen
, parms
);
2134 if (!NILP (vscroll
))
2135 install_vertical_scrollbar (s
, pixelwidth
, pixelheight
);
2136 if (!NILP (hscroll
))
2137 install_horizontal_scrollbar (s
, pixelwidth
, pixelheight
);
2139 /* Make the window appear on the screen and enable display. */
2141 if (!EQ (x_get_arg (parms
, intern ("suppress-initial-map"), 0, 0), Qt
))
2142 x_make_window_visible (s
);
2143 SCREEN_GARBAGED (s
);
2149 DEFUN ("focus-screen", Ffocus_screen
, Sfocus_screen
, 1, 1, 0,
2150 "Set the focus on SCREEN.")
2154 CHECK_LIVE_SCREEN (screen
, 0);
2156 if (SCREEN_IS_X (XSCREEN (screen
)))
2159 x_focus_on_screen (XSCREEN (screen
));
2167 DEFUN ("unfocus-screen", Funfocus_screen
, Sunfocus_screen
, 0, 0, 0,
2168 "If a screen has been focused, release it.")
2174 x_unfocus_screen (x_focus_screen
);
2182 /* Computes an X-window size and position either from geometry GEO
2185 S is a screen. It specifies an X window which is used to
2186 determine which display to compute for. Its font, borders
2187 and colors control how the rectangle will be displayed.
2189 X and Y are where to store the positions chosen.
2190 WIDTH and HEIGHT are where to store the sizes chosen.
2192 GEO is the geometry that may specify some of the info.
2193 STR is a prompt to display.
2194 HSCROLL and VSCROLL say whether we have horiz and vert scroll bars. */
2197 x_rubber_band (s
, x
, y
, width
, height
, geo
, str
, hscroll
, vscroll
)
2199 int *x
, *y
, *width
, *height
;
2202 int hscroll
, vscroll
;
2208 int background_color
;
2214 background_color
= s
->display
.x
->background_pixel
;
2215 border_color
= s
->display
.x
->border_pixel
;
2217 frame
.bdrwidth
= s
->display
.x
->border_width
;
2218 frame
.border
= XMakeTile (border_color
);
2219 frame
.background
= XMakeTile (background_color
);
2220 tempwindow
= XCreateTerm (str
, "emacs", geo
, default_window
, &frame
, 10, 5,
2221 (2 * s
->display
.x
->internal_border_width
2222 + (vscroll
? VSCROLL_WIDTH
: 0)),
2223 (2 * s
->display
.x
->internal_border_width
2224 + (hscroll
? HSCROLL_HEIGHT
: 0)),
2225 width
, height
, s
->display
.x
->font
,
2226 FONT_WIDTH (s
->display
.x
->font
),
2227 FONT_HEIGHT (s
->display
.x
->font
));
2228 XFreePixmap (frame
.border
);
2229 XFreePixmap (frame
.background
);
2231 if (tempwindow
!= 0)
2233 XQueryWindow (tempwindow
, &wininfo
);
2234 XDestroyWindow (tempwindow
);
2239 /* Coordinates we got are relative to the root window.
2240 Convert them to coordinates relative to desired parent window
2241 by scanning from there up to the root. */
2242 tempwindow
= s
->display
.x
->parent_desc
;
2243 while (tempwindow
!= ROOT_WINDOW
)
2247 XQueryWindow (tempwindow
, &wininfo
);
2250 XQueryTree (tempwindow
, &tempwindow
, &nchildren
, &children
);
2255 return tempwindow
!= 0;
2257 #endif /* not HAVE_X11 */
2259 /* Set whether screen S has a horizontal scroll bar.
2260 VAL is t or nil to specify it. */
2263 x_set_horizontal_scrollbar (s
, val
, oldval
)
2265 Lisp_Object val
, oldval
;
2269 if (s
->display
.x
->window_desc
!= 0)
2272 s
->display
.x
->h_scrollbar_height
= HSCROLL_HEIGHT
;
2273 x_set_window_size (s
, s
->width
, s
->height
);
2274 install_horizontal_scrollbar (s
);
2275 SET_SCREEN_GARBAGED (s
);
2280 if (s
->display
.x
->h_scrollbar
)
2283 s
->display
.x
->h_scrollbar_height
= 0;
2284 XDestroyWindow (XDISPLAY s
->display
.x
->h_scrollbar
);
2285 s
->display
.x
->h_scrollbar
= 0;
2286 x_set_window_size (s
, s
->width
, s
->height
);
2293 /* Set whether screen S has a vertical scroll bar.
2294 VAL is t or nil to specify it. */
2297 x_set_vertical_scrollbar (s
, val
, oldval
)
2299 Lisp_Object val
, oldval
;
2303 if (s
->display
.x
->window_desc
!= 0)
2306 s
->display
.x
->v_scrollbar_width
= VSCROLL_WIDTH
;
2307 x_set_window_size (s
, s
->width
, s
->height
);
2308 install_vertical_scrollbar (s
);
2309 SET_SCREEN_GARBAGED (s
);
2314 if (s
->display
.x
->v_scrollbar
!= 0)
2317 s
->display
.x
->v_scrollbar_width
= 0;
2318 XDestroyWindow (XDISPLAY s
->display
.x
->v_scrollbar
);
2319 s
->display
.x
->v_scrollbar
= 0;
2320 x_set_window_size (s
, s
->width
, s
->height
);
2321 SET_SCREEN_GARBAGED (s
);
2326 /* Create the X windows for a vertical scroll bar
2327 for a screen X that already has an X window but no scroll bar. */
2330 install_vertical_scrollbar (s
)
2333 int ibw
= s
->display
.x
->internal_border_width
;
2335 XColor fore_color
, back_color
;
2336 Pixmap up_arrow_pixmap
, down_arrow_pixmap
, slider_pixmap
;
2337 int pix_x
, pix_y
, width
, height
, border
;
2339 height
= s
->display
.x
->pixel_height
- ibw
- 2;
2340 width
= VSCROLL_WIDTH
- 2;
2341 pix_x
= s
->display
.x
->pixel_width
- ibw
/2;
2347 XCreatePixmapFromBitmapData (x_current_display
, s
->display
.x
->window_desc
,
2348 up_arrow_bits
, 16, 16,
2349 s
->display
.x
->foreground_pixel
,
2350 s
->display
.x
->background_pixel
,
2351 DefaultDepth (x_current_display
,
2352 XDefaultScreen (x_current_display
)));
2355 XCreatePixmapFromBitmapData (x_current_display
, s
->display
.x
->window_desc
,
2356 down_arrow_bits
, 16, 16,
2357 s
->display
.x
->foreground_pixel
,
2358 s
->display
.x
->background_pixel
,
2359 DefaultDepth (x_current_display
,
2360 XDefaultScreen (x_current_display
)));
2363 XCreatePixmapFromBitmapData (x_current_display
, s
->display
.x
->window_desc
,
2365 s
->display
.x
->foreground_pixel
,
2366 s
->display
.x
->background_pixel
,
2367 DefaultDepth (x_current_display
,
2368 XDefaultScreen (x_current_display
)));
2370 /* These cursor shapes will be installed when the mouse enters
2371 the appropriate window. */
2373 up_arrow_cursor
= XCreateFontCursor (x_current_display
, XC_sb_up_arrow
);
2374 down_arrow_cursor
= XCreateFontCursor (x_current_display
, XC_sb_down_arrow
);
2375 v_double_arrow_cursor
= XCreateFontCursor (x_current_display
, XC_sb_v_double_arrow
);
2377 s
->display
.x
->v_scrollbar
=
2378 XCreateSimpleWindow (x_current_display
, s
->display
.x
->window_desc
,
2379 pix_x
, pix_y
, width
, height
, border
,
2380 s
->display
.x
->foreground_pixel
,
2381 s
->display
.x
->background_pixel
);
2382 XFlush (x_current_display
);
2383 XDefineCursor (x_current_display
, s
->display
.x
->v_scrollbar
,
2384 v_double_arrow_cursor
);
2386 /* Create slider window */
2387 s
->display
.x
->v_slider
=
2388 XCreateSimpleWindow (x_current_display
, s
->display
.x
->v_scrollbar
,
2389 0, VSCROLL_WIDTH
- 2,
2390 VSCROLL_WIDTH
- 4, VSCROLL_WIDTH
- 4,
2391 1, s
->display
.x
->border_pixel
,
2392 s
->display
.x
->foreground_pixel
);
2393 XFlush (x_current_display
);
2394 XDefineCursor (x_current_display
, s
->display
.x
->v_slider
,
2395 v_double_arrow_cursor
);
2396 XSetWindowBackgroundPixmap (x_current_display
, s
->display
.x
->v_slider
,
2399 s
->display
.x
->v_thumbup
=
2400 XCreateSimpleWindow (x_current_display
, s
->display
.x
->v_scrollbar
,
2402 VSCROLL_WIDTH
- 2, VSCROLL_WIDTH
- 2,
2403 0, s
->display
.x
->foreground_pixel
,
2404 s
->display
.x
-> background_pixel
);
2405 XFlush (x_current_display
);
2406 XDefineCursor (x_current_display
, s
->display
.x
->v_thumbup
,
2408 XSetWindowBackgroundPixmap (x_current_display
, s
->display
.x
->v_thumbup
,
2411 s
->display
.x
->v_thumbdown
=
2412 XCreateSimpleWindow (x_current_display
, s
->display
.x
->v_scrollbar
,
2413 0, height
- VSCROLL_WIDTH
+ 2,
2414 VSCROLL_WIDTH
- 2, VSCROLL_WIDTH
- 2,
2415 0, s
->display
.x
->foreground_pixel
,
2416 s
->display
.x
->background_pixel
);
2417 XFlush (x_current_display
);
2418 XDefineCursor (x_current_display
, s
->display
.x
->v_thumbdown
,
2420 XSetWindowBackgroundPixmap (x_current_display
, s
->display
.x
->v_thumbdown
,
2423 fore_color
.pixel
= s
->display
.x
->mouse_pixel
;
2424 back_color
.pixel
= s
->display
.x
->background_pixel
;
2425 XQueryColor (x_current_display
,
2426 DefaultColormap (x_current_display
,
2427 DefaultScreen (x_current_display
)),
2429 XQueryColor (x_current_display
,
2430 DefaultColormap (x_current_display
,
2431 DefaultScreen (x_current_display
)),
2433 XRecolorCursor (x_current_display
, up_arrow_cursor
,
2434 &fore_color
, &back_color
);
2435 XRecolorCursor (x_current_display
, down_arrow_cursor
,
2436 &fore_color
, &back_color
);
2437 XRecolorCursor (x_current_display
, v_double_arrow_cursor
,
2438 &fore_color
, &back_color
);
2440 XFreePixmap (x_current_display
, slider_pixmap
);
2441 XFreePixmap (x_current_display
, up_arrow_pixmap
);
2442 XFreePixmap (x_current_display
, down_arrow_pixmap
);
2443 XFlush (x_current_display
);
2445 XSelectInput (x_current_display
, s
->display
.x
->v_scrollbar
,
2446 ButtonPressMask
| ButtonReleaseMask
2447 | PointerMotionMask
| PointerMotionHintMask
2449 XSelectInput (x_current_display
, s
->display
.x
->v_slider
,
2450 ButtonPressMask
| ButtonReleaseMask
);
2451 XSelectInput (x_current_display
, s
->display
.x
->v_thumbdown
,
2452 ButtonPressMask
| ButtonReleaseMask
);
2453 XSelectInput (x_current_display
, s
->display
.x
->v_thumbup
,
2454 ButtonPressMask
| ButtonReleaseMask
);
2455 XFlush (x_current_display
);
2457 /* This should be done at the same time as the main window. */
2458 XMapWindow (x_current_display
, s
->display
.x
->v_scrollbar
);
2459 XMapSubwindows (x_current_display
, s
->display
.x
->v_scrollbar
);
2460 XFlush (x_current_display
);
2461 #else /* not HAVE_X11 */
2463 Pixmap fore_tile
, back_tile
, bord_tile
;
2464 static short up_arrow_bits
[] = {
2465 0x0000, 0x0180, 0x03c0, 0x07e0,
2466 0x0ff0, 0x1ff8, 0x3ffc, 0x7ffe,
2467 0x0180, 0x0180, 0x0180, 0x0180,
2468 0x0180, 0x0180, 0x0180, 0xffff};
2469 static short down_arrow_bits
[] = {
2470 0xffff, 0x0180, 0x0180, 0x0180,
2471 0x0180, 0x0180, 0x0180, 0x0180,
2472 0x7ffe, 0x3ffc, 0x1ff8, 0x0ff0,
2473 0x07e0, 0x03c0, 0x0180, 0x0000};
2475 fore_tile
= XMakeTile (s
->display
.x
->foreground_pixel
);
2476 back_tile
= XMakeTile (s
->display
.x
->background_pixel
);
2477 bord_tile
= XMakeTile (s
->display
.x
->border_pixel
);
2479 b
= XStoreBitmap (VSCROLL_WIDTH
- 2, VSCROLL_WIDTH
- 2, up_arrow_bits
);
2480 up_arrow_pixmap
= XMakePixmap (b
,
2481 s
->display
.x
->foreground_pixel
,
2482 s
->display
.x
->background_pixel
);
2485 b
= XStoreBitmap (VSCROLL_WIDTH
- 2, VSCROLL_WIDTH
- 2, down_arrow_bits
);
2486 down_arrow_pixmap
= XMakePixmap (b
,
2487 s
->display
.x
->foreground_pixel
,
2488 s
->display
.x
->background_pixel
);
2491 ibw
= s
->display
.x
->internal_border_width
;
2493 s
->display
.x
->v_scrollbar
= XCreateWindow (s
->display
.x
->window_desc
,
2494 width
- VSCROLL_WIDTH
- ibw
/2,
2498 1, bord_tile
, back_tile
);
2500 s
->display
.x
->v_scrollbar_width
= VSCROLL_WIDTH
;
2502 s
->display
.x
->v_thumbup
= XCreateWindow (s
->display
.x
->v_scrollbar
,
2506 0, 0, up_arrow_pixmap
);
2507 XTileAbsolute (s
->display
.x
->v_thumbup
);
2509 s
->display
.x
->v_thumbdown
= XCreateWindow (s
->display
.x
->v_scrollbar
,
2511 height
- ibw
- VSCROLL_WIDTH
,
2514 0, 0, down_arrow_pixmap
);
2515 XTileAbsolute (s
->display
.x
->v_thumbdown
);
2517 s
->display
.x
->v_slider
= XCreateWindow (s
->display
.x
->v_scrollbar
,
2518 0, VSCROLL_WIDTH
- 2,
2521 1, back_tile
, fore_tile
);
2523 XSelectInput (s
->display
.x
->v_scrollbar
,
2524 (ButtonPressed
| ButtonReleased
| KeyPressed
));
2525 XSelectInput (s
->display
.x
->v_thumbup
,
2526 (ButtonPressed
| ButtonReleased
| KeyPressed
));
2528 XSelectInput (s
->display
.x
->v_thumbdown
,
2529 (ButtonPressed
| ButtonReleased
| KeyPressed
));
2531 XMapWindow (s
->display
.x
->v_thumbup
);
2532 XMapWindow (s
->display
.x
->v_thumbdown
);
2533 XMapWindow (s
->display
.x
->v_slider
);
2534 XMapWindow (s
->display
.x
->v_scrollbar
);
2536 XFreePixmap (fore_tile
);
2537 XFreePixmap (back_tile
);
2538 XFreePixmap (up_arrow_pixmap
);
2539 XFreePixmap (down_arrow_pixmap
);
2540 #endif /* not HAVE_X11 */
2544 install_horizontal_scrollbar (s
)
2547 int ibw
= s
->display
.x
->internal_border_width
;
2549 Pixmap left_arrow_pixmap
, right_arrow_pixmap
, slider_pixmap
;
2554 pix_y
= PIXEL_HEIGHT (s
) - HSCROLL_HEIGHT
- ibw
;
2555 width
= PIXEL_WIDTH (s
) - 2 * ibw
;
2556 if (s
->display
.x
->v_scrollbar_width
)
2557 width
-= (s
->display
.x
->v_scrollbar_width
+ 1);
2561 XCreatePixmapFromBitmapData (x_current_display
, s
->display
.x
->window_desc
,
2562 left_arrow_bits
, 16, 16,
2563 s
->display
.x
->foreground_pixel
,
2564 s
->display
.x
->background_pixel
,
2565 DefaultDepth (x_current_display
,
2566 XDefaultScreen (x_current_display
)));
2568 right_arrow_pixmap
=
2569 XCreatePixmapFromBitmapData (x_current_display
, s
->display
.x
->window_desc
,
2570 right_arrow_bits
, 16, 16,
2571 s
->display
.x
->foreground_pixel
,
2572 s
->display
.x
->background_pixel
,
2573 DefaultDepth (x_current_display
,
2574 XDefaultScreen (x_current_display
)));
2577 XCreatePixmapFromBitmapData (x_current_display
, s
->display
.x
->window_desc
,
2579 s
->display
.x
->foreground_pixel
,
2580 s
->display
.x
->background_pixel
,
2581 DefaultDepth (x_current_display
,
2582 XDefaultScreen (x_current_display
)));
2584 left_arrow_cursor
= XCreateFontCursor (x_current_display
, XC_sb_left_arrow
);
2585 right_arrow_cursor
= XCreateFontCursor (x_current_display
, XC_sb_right_arrow
);
2586 h_double_arrow_cursor
= XCreateFontCursor (x_current_display
, XC_sb_h_double_arrow
);
2588 s
->display
.x
->h_scrollbar
=
2589 XCreateSimpleWindow (x_current_display
, s
->display
.x
->window_desc
,
2591 width
- ibw
- 2, HSCROLL_HEIGHT
- 2, 1,
2592 s
->display
.x
->foreground_pixel
,
2593 s
->display
.x
->background_pixel
);
2594 XDefineCursor (x_current_display
, s
->display
.x
->h_scrollbar
,
2595 h_double_arrow_cursor
);
2597 s
->display
.x
->h_slider
=
2598 XCreateSimpleWindow (x_current_display
, s
->display
.x
->h_scrollbar
,
2600 HSCROLL_HEIGHT
- 4, HSCROLL_HEIGHT
- 4,
2601 1, s
->display
.x
->foreground_pixel
,
2602 s
->display
.x
->background_pixel
);
2603 XDefineCursor (x_current_display
, s
->display
.x
->h_slider
,
2604 h_double_arrow_cursor
);
2605 XSetWindowBackgroundPixmap (x_current_display
, s
->display
.x
->h_slider
,
2608 s
->display
.x
->h_thumbleft
=
2609 XCreateSimpleWindow (x_current_display
, s
->display
.x
->h_scrollbar
,
2611 HSCROLL_HEIGHT
- 2, HSCROLL_HEIGHT
- 2,
2612 0, s
->display
.x
->foreground_pixel
,
2613 s
->display
.x
->background_pixel
);
2614 XDefineCursor (x_current_display
, s
->display
.x
->h_thumbleft
,
2616 XSetWindowBackgroundPixmap (x_current_display
, s
->display
.x
->h_thumbleft
,
2619 s
->display
.x
->h_thumbright
=
2620 XCreateSimpleWindow (x_current_display
, s
->display
.x
->h_scrollbar
,
2621 width
- ibw
- HSCROLL_HEIGHT
, 0,
2622 HSCROLL_HEIGHT
- 2, HSCROLL_HEIGHT
-2,
2623 0, s
->display
.x
->foreground_pixel
,
2624 s
->display
.x
->background_pixel
);
2625 XDefineCursor (x_current_display
, s
->display
.x
->h_thumbright
,
2626 right_arrow_cursor
);
2627 XSetWindowBackgroundPixmap (x_current_display
, s
->display
.x
->h_thumbright
,
2628 right_arrow_pixmap
);
2630 XFreePixmap (x_current_display
, slider_pixmap
);
2631 XFreePixmap (x_current_display
, left_arrow_pixmap
);
2632 XFreePixmap (x_current_display
, right_arrow_pixmap
);
2634 XSelectInput (x_current_display
, s
->display
.x
->h_scrollbar
,
2635 ButtonPressMask
| ButtonReleaseMask
2636 | PointerMotionMask
| PointerMotionHintMask
2638 XSelectInput (x_current_display
, s
->display
.x
->h_slider
,
2639 ButtonPressMask
| ButtonReleaseMask
);
2640 XSelectInput (x_current_display
, s
->display
.x
->h_thumbright
,
2641 ButtonPressMask
| ButtonReleaseMask
);
2642 XSelectInput (x_current_display
, s
->display
.x
->h_thumbleft
,
2643 ButtonPressMask
| ButtonReleaseMask
);
2645 XMapWindow (x_current_display
, s
->display
.x
->h_scrollbar
);
2646 XMapSubwindows (x_current_display
, s
->display
.x
->h_scrollbar
);
2647 #else /* not HAVE_X11 */
2649 Pixmap fore_tile
, back_tile
, bord_tile
;
2653 #ifndef HAVE_X11 /* X10 */
2654 #define XMoveResizeWindow XConfigureWindow
2655 #endif /* not HAVE_X11 */
2657 /* Adjust the displayed position in the scroll bar for window W. */
2660 adjust_scrollbars (s
)
2664 int first_char_in_window
, char_beyond_window
, chars_in_window
;
2665 int chars_in_buffer
, buffer_size
;
2666 struct window
*w
= XWINDOW (SCREEN_SELECTED_WINDOW (s
));
2668 if (! SCREEN_IS_X (s
))
2671 if (s
->display
.x
->v_scrollbar
!= 0)
2674 struct buffer
*b
= XBUFFER (w
->buffer
);
2676 buffer_size
= Z
- BEG
;
2677 chars_in_buffer
= ZV
- BEGV
;
2678 first_char_in_window
= marker_position (w
->start
);
2679 char_beyond_window
= buffer_size
+ 1 - XFASTINT (w
->window_end_pos
);
2680 chars_in_window
= char_beyond_window
- first_char_in_window
;
2682 /* Calculate height of scrollbar area */
2684 height
= s
->height
* FONT_HEIGHT (s
->display
.x
->font
)
2685 + s
->display
.x
->internal_border_width
2686 - 2 * (s
->display
.x
->v_scrollbar_width
);
2688 /* Figure starting position for the scrollbar slider */
2690 if (chars_in_buffer
<= 0)
2693 pos
= ((first_char_in_window
- BEGV
- BEG
) * height
2696 pos
= min (pos
, height
- 2);
2698 /* Figure length of the slider */
2700 if (chars_in_buffer
<= 0)
2703 h
= (chars_in_window
* height
) / chars_in_buffer
;
2704 h
= min (h
, height
- pos
);
2707 /* Add thumbup offset to starting position of slider */
2709 pos
+= (s
->display
.x
->v_scrollbar_width
- 2);
2711 XMoveResizeWindow (XDISPLAY
2712 s
->display
.x
->v_slider
,
2714 s
->display
.x
->v_scrollbar_width
- 4, h
);
2717 if (s
->display
.x
->h_scrollbar
!= 0)
2719 int l
, length
; /* Length of the scrollbar area */
2721 length
= s
->width
* FONT_WIDTH (s
->display
.x
->font
)
2722 + s
->display
.x
->internal_border_width
2723 - 2 * (s
->display
.x
->h_scrollbar_height
);
2725 /* Starting position for horizontal slider */
2729 pos
= (w
->hscroll
* length
) / (w
->hscroll
+ s
->width
);
2731 pos
= min (pos
, length
- 2);
2733 /* Length of slider */
2736 /* Add thumbup offset */
2737 pos
+= (s
->display
.x
->h_scrollbar_height
- 2);
2739 XMoveResizeWindow (XDISPLAY
2740 s
->display
.x
->h_slider
,
2742 l
, s
->display
.x
->h_scrollbar_height
- 4);
2746 /* Adjust the size of the scroll bars of screen S,
2747 when the screen size has changed. */
2750 x_resize_scrollbars (s
)
2753 int ibw
= s
->display
.x
->internal_border_width
;
2754 int pixelwidth
, pixelheight
;
2757 || s
->display
.x
== 0
2758 || (s
->display
.x
->v_scrollbar
== 0
2759 && s
->display
.x
->h_scrollbar
== 0))
2762 /* Get the size of the screen. */
2763 pixelwidth
= (s
->width
* FONT_WIDTH (s
->display
.x
->font
)
2764 + 2 * ibw
+ s
->display
.x
->v_scrollbar_width
);
2765 pixelheight
= (s
->height
* FONT_HEIGHT (s
->display
.x
->font
)
2766 + 2 * ibw
+ s
->display
.x
->h_scrollbar_height
);
2768 if (s
->display
.x
->v_scrollbar_width
&& s
->display
.x
->v_scrollbar
)
2771 XMoveResizeWindow (XDISPLAY
2772 s
->display
.x
->v_scrollbar
,
2773 pixelwidth
- s
->display
.x
->v_scrollbar_width
- ibw
/2,
2775 s
->display
.x
->v_scrollbar_width
- 2,
2776 pixelheight
- ibw
- 2);
2777 XMoveWindow (XDISPLAY
2778 s
->display
.x
->v_thumbdown
, 0,
2779 pixelheight
- ibw
- s
->display
.x
->v_scrollbar_width
);
2783 if (s
->display
.x
->h_scrollbar_height
&& s
->display
.x
->h_scrollbar
)
2785 if (s
->display
.x
->v_scrollbar_width
)
2786 pixelwidth
-= s
->display
.x
->v_scrollbar_width
+ 1;
2789 XMoveResizeWindow (XDISPLAY
2790 s
->display
.x
->h_scrollbar
,
2792 pixelheight
- s
->display
.x
->h_scrollbar_height
- ibw
/ 2,
2793 pixelwidth
- ibw
- 2,
2794 s
->display
.x
->h_scrollbar_height
- 2);
2795 XMoveWindow (XDISPLAY
2796 s
->display
.x
->h_thumbright
,
2797 pixelwidth
- ibw
- s
->display
.x
->h_scrollbar_height
, 0);
2803 register struct screen
*s
;
2805 return PIXEL_WIDTH (s
);
2809 register struct screen
*s
;
2811 return PIXEL_HEIGHT (s
);
2814 DEFUN ("x-defined-color", Fx_defined_color
, Sx_defined_color
, 1, 1, 0,
2815 "Return t if the current X display supports the color named COLOR.")
2821 CHECK_STRING (color
, 0);
2823 if (defined_color (XSTRING (color
)->data
, &foo
))
2829 DEFUN ("x-color-display-p", Fx_color_display_p
, Sx_color_display_p
, 0, 0, 0,
2830 "Return t if the X display used currently supports color.")
2833 if (XINT (x_screen_planes
) <= 2)
2836 switch (screen_visual
->class)
2849 DEFUN ("x-pixel-width", Fx_pixel_width
, Sx_pixel_width
, 1, 1, 0,
2850 "Return the width in pixels of screen S.")
2854 CHECK_LIVE_SCREEN (screen
, 0);
2855 return make_number (XSCREEN (screen
)->display
.x
->pixel_width
);
2858 DEFUN ("x-pixel-height", Fx_pixel_height
, Sx_pixel_height
, 1, 1, 0,
2859 "Return the height in pixels of screen S.")
2863 CHECK_LIVE_SCREEN (screen
, 0);
2864 return make_number (XSCREEN (screen
)->display
.x
->pixel_height
);
2867 /* Draw a rectangle on the screen with left top corner including
2868 the character specified by LEFT_CHAR and TOP_CHAR. The rectangle is
2869 CHARS by LINES wide and long and is the color of the cursor. */
2872 x_rectangle (s
, gc
, left_char
, top_char
, chars
, lines
)
2873 register struct screen
*s
;
2875 register int top_char
, left_char
, chars
, lines
;
2879 int left
= (left_char
* FONT_WIDTH (s
->display
.x
->font
)
2880 + s
->display
.x
->internal_border_width
);
2881 int top
= (top_char
* FONT_HEIGHT (s
->display
.x
->font
)
2882 + s
->display
.x
->internal_border_width
);
2885 width
= FONT_WIDTH (s
->display
.x
->font
) / 2;
2887 width
= FONT_WIDTH (s
->display
.x
->font
) * chars
;
2889 height
= FONT_HEIGHT (s
->display
.x
->font
) / 2;
2891 height
= FONT_HEIGHT (s
->display
.x
->font
) * lines
;
2893 XDrawRectangle (x_current_display
, s
->display
.x
->window_desc
,
2894 gc
, left
, top
, width
, height
);
2897 DEFUN ("x-draw-rectangle", Fx_draw_rectangle
, Sx_draw_rectangle
, 5, 5, 0,
2898 "Draw a rectangle on SCREEN between coordinates specified by\n\
2899 numbers X0, Y0, X1, Y1 in the cursor pixel.")
2900 (screen
, X0
, Y0
, X1
, Y1
)
2901 register Lisp_Object screen
, X0
, X1
, Y0
, Y1
;
2903 register int x0
, y0
, x1
, y1
, top
, left
, n_chars
, n_lines
;
2905 CHECK_LIVE_SCREEN (screen
, 0);
2906 CHECK_NUMBER (X0
, 0);
2907 CHECK_NUMBER (Y0
, 1);
2908 CHECK_NUMBER (X1
, 2);
2909 CHECK_NUMBER (Y1
, 3);
2919 n_lines
= y1
- y0
+ 1;
2924 n_lines
= y0
- y1
+ 1;
2930 n_chars
= x1
- x0
+ 1;
2935 n_chars
= x0
- x1
+ 1;
2939 x_rectangle (XSCREEN (screen
), XSCREEN (screen
)->display
.x
->cursor_gc
,
2940 left
, top
, n_chars
, n_lines
);
2946 DEFUN ("x-erase-rectangle", Fx_erase_rectangle
, Sx_erase_rectangle
, 5, 5, 0,
2947 "Draw a rectangle drawn on SCREEN between coordinates\n\
2948 X0, Y0, X1, Y1 in the regular background-pixel.")
2949 (screen
, X0
, Y0
, X1
, Y1
)
2950 register Lisp_Object screen
, X0
, Y0
, X1
, Y1
;
2952 register int x0
, y0
, x1
, y1
, top
, left
, n_chars
, n_lines
;
2954 CHECK_SCREEN (screen
, 0);
2955 CHECK_NUMBER (X0
, 0);
2956 CHECK_NUMBER (Y0
, 1);
2957 CHECK_NUMBER (X1
, 2);
2958 CHECK_NUMBER (Y1
, 3);
2968 n_lines
= y1
- y0
+ 1;
2973 n_lines
= y0
- y1
+ 1;
2979 n_chars
= x1
- x0
+ 1;
2984 n_chars
= x0
- x1
+ 1;
2988 x_rectangle (XSCREEN (screen
), XSCREEN (screen
)->display
.x
->reverse_gc
,
2989 left
, top
, n_chars
, n_lines
);
2995 /* Draw lines around the text region beginning at the character position
2996 TOP_X, TOP_Y and ending at BOTTOM_X and BOTTOM_Y. GC specifies the
2997 pixel and line characteristics. */
2999 #define line_len(line) (SCREEN_CURRENT_GLYPHS (s)->used[(line)])
3002 outline_region (s
, gc
, top_x
, top_y
, bottom_x
, bottom_y
)
3003 register struct screen
*s
;
3005 int top_x
, top_y
, bottom_x
, bottom_y
;
3007 register int ibw
= s
->display
.x
->internal_border_width
;
3008 register int font_w
= FONT_WIDTH (s
->display
.x
->font
);
3009 register int font_h
= FONT_HEIGHT (s
->display
.x
->font
);
3011 int x
= line_len (y
);
3012 XPoint
*pixel_points
= (XPoint
*)
3013 alloca (((bottom_y
- top_y
+ 2) * 4) * sizeof (XPoint
));
3014 register XPoint
*this_point
= pixel_points
;
3016 /* Do the horizontal top line/lines */
3019 this_point
->x
= ibw
;
3020 this_point
->y
= ibw
+ (font_h
* top_y
);
3023 this_point
->x
= ibw
+ (font_w
/ 2); /* Half-size for newline chars. */
3025 this_point
->x
= ibw
+ (font_w
* x
);
3026 this_point
->y
= (this_point
- 1)->y
;
3030 this_point
->x
= ibw
;
3031 this_point
->y
= ibw
+ (font_h
* (top_y
+ 1));
3033 this_point
->x
= ibw
+ (font_w
* top_x
);
3034 this_point
->y
= (this_point
- 1)->y
;
3036 this_point
->x
= (this_point
- 1)->x
;
3037 this_point
->y
= ibw
+ (font_h
* top_y
);
3039 this_point
->x
= ibw
+ (font_w
* x
);
3040 this_point
->y
= (this_point
- 1)->y
;
3043 /* Now do the right side. */
3044 while (y
< bottom_y
)
3045 { /* Right vertical edge */
3047 this_point
->x
= (this_point
- 1)->x
;
3048 this_point
->y
= ibw
+ (font_h
* (y
+ 1));
3051 y
++; /* Horizontal connection to next line */
3054 this_point
->x
= ibw
+ (font_w
/ 2);
3056 this_point
->x
= ibw
+ (font_w
* x
);
3058 this_point
->y
= (this_point
- 1)->y
;
3061 /* Now do the bottom and connect to the top left point. */
3062 this_point
->x
= ibw
+ (font_w
* (bottom_x
+ 1));
3065 this_point
->x
= (this_point
- 1)->x
;
3066 this_point
->y
= ibw
+ (font_h
* (bottom_y
+ 1));
3068 this_point
->x
= ibw
;
3069 this_point
->y
= (this_point
- 1)->y
;
3071 this_point
->x
= pixel_points
->x
;
3072 this_point
->y
= pixel_points
->y
;
3074 XDrawLines (x_current_display
, s
->display
.x
->window_desc
,
3076 (this_point
- pixel_points
+ 1), CoordModeOrigin
);
3079 DEFUN ("x-contour-region", Fx_contour_region
, Sx_contour_region
, 1, 1, 0,
3080 "Highlight the region between point and the character under the mouse\n\
3083 register Lisp_Object event
;
3085 register int x0
, y0
, x1
, y1
;
3086 register struct screen
*s
= selected_screen
;
3087 register int p1
, p2
;
3089 CHECK_CONS (event
, 0);
3092 x0
= XINT (Fcar (Fcar (event
)));
3093 y0
= XINT (Fcar (Fcdr (Fcar (event
))));
3095 /* If the mouse is past the end of the line, don't that area. */
3096 /* ReWrite this... */
3101 if (y1
> y0
) /* point below mouse */
3102 outline_region (s
, s
->display
.x
->cursor_gc
,
3104 else if (y1
< y0
) /* point above mouse */
3105 outline_region (s
, s
->display
.x
->cursor_gc
,
3107 else /* same line: draw horizontal rectangle */
3110 x_rectangle (s
, s
->display
.x
->cursor_gc
,
3111 x0
, y0
, (x1
- x0
+ 1), 1);
3113 x_rectangle (s
, s
->display
.x
->cursor_gc
,
3114 x1
, y1
, (x0
- x1
+ 1), 1);
3117 XFlush (x_current_display
);
3123 DEFUN ("x-uncontour-region", Fx_uncontour_region
, Sx_uncontour_region
, 1, 1, 0,
3124 "Erase any highlighting of the region between point and the character\n\
3125 at X, Y on the selected screen.")
3127 register Lisp_Object event
;
3129 register int x0
, y0
, x1
, y1
;
3130 register struct screen
*s
= selected_screen
;
3133 x0
= XINT (Fcar (Fcar (event
)));
3134 y0
= XINT (Fcar (Fcdr (Fcar (event
))));
3138 if (y1
> y0
) /* point below mouse */
3139 outline_region (s
, s
->display
.x
->reverse_gc
,
3141 else if (y1
< y0
) /* point above mouse */
3142 outline_region (s
, s
->display
.x
->reverse_gc
,
3144 else /* same line: draw horizontal rectangle */
3147 x_rectangle (s
, s
->display
.x
->reverse_gc
,
3148 x0
, y0
, (x1
- x0
+ 1), 1);
3150 x_rectangle (s
, s
->display
.x
->reverse_gc
,
3151 x1
, y1
, (x0
- x1
+ 1), 1);
3158 extern unsigned int x_mouse_x
, x_mouse_y
, x_mouse_grabbed
;
3159 extern Lisp_Object unread_command_char
;
3162 int contour_begin_x
, contour_begin_y
;
3163 int contour_end_x
, contour_end_y
;
3164 int contour_npoints
;
3166 /* Clip the top part of the contour lines down (and including) line Y_POS.
3167 If X_POS is in the middle (rather than at the end) of the line, drop
3168 down a line at that character. */
3171 clip_contour_top (y_pos
, x_pos
)
3173 register XPoint
*begin
= contour_lines
[y_pos
].top_left
;
3174 register XPoint
*end
;
3175 register int npoints
;
3176 register struct display_line
*line
= selected_screen
->phys_lines
[y_pos
+ 1];
3178 if (x_pos
>= line
->len
- 1) /* Draw one, straight horizontal line. */
3180 end
= contour_lines
[y_pos
].top_right
;
3181 npoints
= (end
- begin
+ 1);
3182 XDrawLines (x_current_display
, contour_window
,
3183 contour_erase_gc
, begin_erase
, npoints
, CoordModeOrigin
);
3185 bcopy (end
, begin
+ 1, contour_last_point
- end
+ 1);
3186 contour_last_point
-= (npoints
- 2);
3187 XDrawLines (x_current_display
, contour_window
,
3188 contour_erase_gc
, begin
, 2, CoordModeOrigin
);
3189 XFlush (x_current_display
);
3191 /* Now, update contour_lines structure. */
3196 register XPoint
*p
= begin
+ 1;
3197 end
= contour_lines
[y_pos
].bottom_right
;
3198 npoints
= (end
- begin
+ 1);
3199 XDrawLines (x_current_display
, contour_window
,
3200 contour_erase_gc
, begin_erase
, npoints
, CoordModeOrigin
);
3203 p
->x
= ibw
+ (font_w
* (x_pos
+ 1));
3205 p
->y
= begin
->y
+ font_h
;
3207 bcopy (end
, begin
+ 3, contour_last_point
- end
+ 1);
3208 contour_last_point
-= (npoints
- 5);
3209 XDrawLines (x_current_display
, contour_window
,
3210 contour_erase_gc
, begin
, 4, CoordModeOrigin
);
3211 XFlush (x_current_display
);
3213 /* Now, update contour_lines structure. */
3217 /* Erase the top horzontal lines of the contour, and then extend
3218 the contour upwards. */
3221 extend_contour_top (line
)
3226 clip_contour_bottom (x_pos
, y_pos
)
3232 extend_contour_bottom (x_pos
, y_pos
)
3236 DEFUN ("x-select-region", Fx_select_region
, Sx_select_region
, 1, 1, "e",
3241 register struct screen
*s
= selected_screen
;
3242 register int point_x
= s
->cursor_x
;
3243 register int point_y
= s
->cursor_y
;
3244 register int mouse_below_point
;
3245 register Lisp_Object obj
;
3246 register int x_contour_x
, x_contour_y
;
3248 x_contour_x
= x_mouse_x
;
3249 x_contour_y
= x_mouse_y
;
3250 if (x_contour_y
> point_y
|| (x_contour_y
== point_y
3251 && x_contour_x
> point_x
))
3253 mouse_below_point
= 1;
3254 outline_region (s
, s
->display
.x
->cursor_gc
, point_x
, point_y
,
3255 x_contour_x
, x_contour_y
);
3259 mouse_below_point
= 0;
3260 outline_region (s
, s
->display
.x
->cursor_gc
, x_contour_x
, x_contour_y
,
3266 obj
= read_char (-1);
3267 if (XTYPE (obj
) != Lisp_Cons
)
3270 if (mouse_below_point
)
3272 if (x_mouse_y
<= point_y
) /* Flipped. */
3274 mouse_below_point
= 0;
3276 outline_region (s
, s
->display
.x
->reverse_gc
, point_x
, point_y
,
3277 x_contour_x
, x_contour_y
);
3278 outline_region (s
, s
->display
.x
->cursor_gc
, x_mouse_x
, x_mouse_y
,
3281 else if (x_mouse_y
< x_contour_y
) /* Bottom clipped. */
3283 clip_contour_bottom (x_mouse_y
);
3285 else if (x_mouse_y
> x_contour_y
) /* Bottom extended. */
3287 extend_bottom_contour (x_mouse_y
);
3290 x_contour_x
= x_mouse_x
;
3291 x_contour_y
= x_mouse_y
;
3293 else /* mouse above or same line as point */
3295 if (x_mouse_y
>= point_y
) /* Flipped. */
3297 mouse_below_point
= 1;
3299 outline_region (s
, s
->display
.x
->reverse_gc
,
3300 x_contour_x
, x_contour_y
, point_x
, point_y
);
3301 outline_region (s
, s
->display
.x
->cursor_gc
, point_x
, point_y
,
3302 x_mouse_x
, x_mouse_y
);
3304 else if (x_mouse_y
> x_contour_y
) /* Top clipped. */
3306 clip_contour_top (x_mouse_y
);
3308 else if (x_mouse_y
< x_contour_y
) /* Top extended. */
3310 extend_contour_top (x_mouse_y
);
3315 unread_command_char
= obj
;
3316 if (mouse_below_point
)
3318 contour_begin_x
= point_x
;
3319 contour_begin_y
= point_y
;
3320 contour_end_x
= x_contour_x
;
3321 contour_end_y
= x_contour_y
;
3325 contour_begin_x
= x_contour_x
;
3326 contour_begin_y
= x_contour_y
;
3327 contour_end_x
= point_x
;
3328 contour_end_y
= point_y
;
3334 DEFUN ("x-horizontal-line", Fx_horizontal_line
, Sx_horizontal_line
, 1, 1, "e",
3339 register Lisp_Object obj
;
3340 struct screen
*s
= selected_screen
;
3341 register struct window
*w
= XWINDOW (selected_window
);
3342 register GC line_gc
= s
->display
.x
->cursor_gc
;
3343 register GC erase_gc
= s
->display
.x
->reverse_gc
;
3345 char dash_list
[] = {6, 4, 6, 4};
3347 XGCValues gc_values
;
3349 register int previous_y
;
3350 register int line
= (x_mouse_y
+ 1) * FONT_HEIGHT (s
->display
.x
->font
)
3351 + s
->display
.x
->internal_border_width
;
3352 register int left
= s
->display
.x
->internal_border_width
3354 * FONT_WIDTH (s
->display
.x
->font
));
3355 register int right
= left
+ (w
->width
3356 * FONT_WIDTH (s
->display
.x
->font
))
3357 - s
->display
.x
->internal_border_width
;
3361 gc_values
.foreground
= s
->display
.x
->cursor_pixel
;
3362 gc_values
.background
= s
->display
.x
->background_pixel
;
3363 gc_values
.line_width
= 1;
3364 gc_values
.line_style
= LineOnOffDash
;
3365 gc_values
.cap_style
= CapRound
;
3366 gc_values
.join_style
= JoinRound
;
3368 line_gc
= XCreateGC (x_current_display
, s
->display
.x
->window_desc
,
3369 GCLineStyle
| GCJoinStyle
| GCCapStyle
3370 | GCLineWidth
| GCForeground
| GCBackground
,
3372 XSetDashes (x_current_display
, line_gc
, 0, dash_list
, dashes
);
3373 gc_values
.foreground
= s
->display
.x
->background_pixel
;
3374 gc_values
.background
= s
->display
.x
->foreground_pixel
;
3375 erase_gc
= XCreateGC (x_current_display
, s
->display
.x
->window_desc
,
3376 GCLineStyle
| GCJoinStyle
| GCCapStyle
3377 | GCLineWidth
| GCForeground
| GCBackground
,
3379 XSetDashes (x_current_display
, erase_gc
, 0, dash_list
, dashes
);
3385 if (x_mouse_y
>= XINT (w
->top
)
3386 && x_mouse_y
< XINT (w
->top
) + XINT (w
->height
) - 1)
3388 previous_y
= x_mouse_y
;
3389 line
= (x_mouse_y
+ 1) * FONT_HEIGHT (s
->display
.x
->font
)
3390 + s
->display
.x
->internal_border_width
;
3391 XDrawLine (x_current_display
, s
->display
.x
->window_desc
,
3392 line_gc
, left
, line
, right
, line
);
3399 obj
= read_char (-1);
3400 if ((XTYPE (obj
) != Lisp_Cons
)
3401 || (! EQ (Fcar (Fcdr (Fcdr (obj
))),
3402 intern ("vertical-scroll-bar")))
3406 XDrawLine (x_current_display
, s
->display
.x
->window_desc
,
3407 erase_gc
, left
, line
, right
, line
);
3409 unread_command_char
= obj
;
3411 XFreeGC (x_current_display
, line_gc
);
3412 XFreeGC (x_current_display
, erase_gc
);
3417 while (x_mouse_y
== previous_y
);
3420 XDrawLine (x_current_display
, s
->display
.x
->window_desc
,
3421 erase_gc
, left
, line
, right
, line
);
3427 /* Offset in buffer of character under the pointer, or 0. */
3428 int mouse_buffer_offset
;
3431 /* These keep track of the rectangle following the pointer. */
3432 int mouse_track_top
, mouse_track_left
, mouse_track_width
;
3434 DEFUN ("x-track-pointer", Fx_track_pointer
, Sx_track_pointer
, 0, 0, 0,
3435 "Track the pointer.")
3438 static Cursor current_pointer_shape
;
3439 SCREEN_PTR s
= x_mouse_screen
;
3442 if (EQ (Vmouse_screen_part
, Qtext_part
)
3443 && (current_pointer_shape
!= s
->display
.x
->nontext_cursor
))
3448 current_pointer_shape
= s
->display
.x
->nontext_cursor
;
3449 XDefineCursor (x_current_display
,
3450 s
->display
.x
->window_desc
,
3451 current_pointer_shape
);
3453 buf
= XBUFFER (XWINDOW (Vmouse_window
)->buffer
);
3454 c
= *(BUF_CHAR_ADDRESS (buf
, mouse_buffer_offset
));
3456 else if (EQ (Vmouse_screen_part
, Qmodeline_part
)
3457 && (current_pointer_shape
!= s
->display
.x
->modeline_cursor
))
3459 current_pointer_shape
= s
->display
.x
->modeline_cursor
;
3460 XDefineCursor (x_current_display
,
3461 s
->display
.x
->window_desc
,
3462 current_pointer_shape
);
3471 DEFUN ("x-track-pointer", Fx_track_pointer
, Sx_track_pointer
, 1, 1, "e",
3472 "Draw rectangle around character under mouse pointer, if there is one.")
3476 struct window
*w
= XWINDOW (Vmouse_window
);
3477 struct screen
*s
= XSCREEN (WINDOW_SCREEN (w
));
3478 struct buffer
*b
= XBUFFER (w
->buffer
);
3481 if (! EQ (Vmouse_window
, selected_window
))
3484 if (EQ (event
, Qnil
))
3488 x_read_mouse_position (selected_screen
, &x
, &y
);
3492 mouse_track_width
= 0;
3493 mouse_track_left
= mouse_track_top
= -1;
3497 if ((x_mouse_x
!= mouse_track_left
3498 && (x_mouse_x
< mouse_track_left
3499 || x_mouse_x
> (mouse_track_left
+ mouse_track_width
)))
3500 || x_mouse_y
!= mouse_track_top
)
3502 int hp
= 0; /* Horizontal position */
3503 int len
= SCREEN_CURRENT_GLYPHS (s
)->used
[x_mouse_y
];
3504 int p
= SCREEN_CURRENT_GLYPHS (s
)->bufp
[x_mouse_y
];
3505 int tab_width
= XINT (b
->tab_width
);
3506 int ctl_arrow_p
= !NILP (b
->ctl_arrow
);
3508 int mode_line_vpos
= XFASTINT (w
->height
) + XFASTINT (w
->top
) - 1;
3509 int in_mode_line
= 0;
3511 if (! SCREEN_CURRENT_GLYPHS (s
)->enable
[x_mouse_y
])
3514 /* Erase previous rectangle. */
3515 if (mouse_track_width
)
3517 x_rectangle (s
, s
->display
.x
->reverse_gc
,
3518 mouse_track_left
, mouse_track_top
,
3519 mouse_track_width
, 1);
3521 if ((mouse_track_left
== s
->phys_cursor_x
3522 || mouse_track_left
== s
->phys_cursor_x
- 1)
3523 && mouse_track_top
== s
->phys_cursor_y
)
3525 x_display_cursor (s
, 1);
3529 mouse_track_left
= x_mouse_x
;
3530 mouse_track_top
= x_mouse_y
;
3531 mouse_track_width
= 0;
3533 if (mouse_track_left
> len
) /* Past the end of line. */
3536 if (mouse_track_top
== mode_line_vpos
)
3542 if (tab_width
<= 0 || tab_width
> 20) tab_width
= 8;
3546 if (len
== s
->width
&& hp
== len
- 1 && c
!= '\n')
3552 mouse_track_width
= tab_width
- (hp
% tab_width
);
3554 hp
+= mouse_track_width
;
3557 mouse_track_left
= hp
- mouse_track_width
;
3563 mouse_track_width
= -1;
3567 if (ctl_arrow_p
&& (c
< 040 || c
== 0177))
3572 mouse_track_width
= 2;
3577 mouse_track_left
= hp
- mouse_track_width
;
3583 mouse_track_width
= 1;
3590 while (hp
<= x_mouse_x
);
3593 if (mouse_track_width
) /* Over text; use text pointer shape. */
3595 XDefineCursor (x_current_display
,
3596 s
->display
.x
->window_desc
,
3597 s
->display
.x
->text_cursor
);
3598 x_rectangle (s
, s
->display
.x
->cursor_gc
,
3599 mouse_track_left
, mouse_track_top
,
3600 mouse_track_width
, 1);
3602 else if (in_mode_line
)
3603 XDefineCursor (x_current_display
,
3604 s
->display
.x
->window_desc
,
3605 s
->display
.x
->modeline_cursor
);
3607 XDefineCursor (x_current_display
,
3608 s
->display
.x
->window_desc
,
3609 s
->display
.x
->nontext_cursor
);
3612 XFlush (x_current_display
);
3615 obj
= read_char (-1);
3618 while (XTYPE (obj
) == Lisp_Cons
/* Mouse event */
3619 && EQ (Fcar (Fcdr (Fcdr (obj
))), Qnil
) /* Not scrollbar */
3620 && EQ (Vmouse_depressed
, Qnil
) /* Only motion events */
3621 && EQ (Vmouse_window
, selected_window
) /* In this window */
3624 unread_command_char
= obj
;
3626 if (mouse_track_width
)
3628 x_rectangle (s
, s
->display
.x
->reverse_gc
,
3629 mouse_track_left
, mouse_track_top
,
3630 mouse_track_width
, 1);
3631 mouse_track_width
= 0;
3632 if ((mouse_track_left
== s
->phys_cursor_x
3633 || mouse_track_left
- 1 == s
->phys_cursor_x
)
3634 && mouse_track_top
== s
->phys_cursor_y
)
3636 x_display_cursor (s
, 1);
3639 XDefineCursor (x_current_display
,
3640 s
->display
.x
->window_desc
,
3641 s
->display
.x
->nontext_cursor
);
3642 XFlush (x_current_display
);
3652 /* Draw a pixmap specified by IMAGE_DATA of dimensions WIDTH and HEIGHT
3653 on the screen S at position X, Y. */
3655 x_draw_pixmap (s
, x
, y
, image_data
, width
, height
)
3657 int x
, y
, width
, height
;
3662 image
= XCreateBitmapFromData (x_current_display
,
3663 s
->display
.x
->window_desc
, image_data
,
3665 XCopyPlane (x_current_display
, image
, s
->display
.x
->window_desc
,
3666 s
->display
.x
->normal_gc
, 0, 0, width
, height
, x
, y
);
3673 #define XMouseEvent XEvent
3674 #define WhichMouseButton xbutton.button
3675 #define MouseWindow xbutton.window
3676 #define MouseX xbutton.x
3677 #define MouseY xbutton.y
3678 #define MouseTime xbutton.time
3679 #define ButtonReleased ButtonRelease
3680 #define ButtonPressed ButtonPress
3682 #define XMouseEvent XButtonEvent
3683 #define WhichMouseButton detail
3684 #define MouseWindow window
3687 #define MouseTime time
3690 DEFUN ("x-mouse-events", Fx_mouse_events
, Sx_mouse_events
, 0, 0, 0,
3691 "Return number of pending mouse events from X window system.")
3694 return make_number (queue_event_count (&x_mouse_queue
));
3697 /* Encode the mouse button events in the form expected by the
3698 mouse code in Lisp. For X11, this means moving the masks around. */
3701 encode_mouse_button (mouse_event
)
3702 XMouseEvent mouse_event
;
3704 register int event_code
;
3705 register char key_mask
;
3707 event_code
= mouse_event
.detail
& 3;
3708 key_mask
= (mouse_event
.detail
>> 8) & 0xf0;
3709 event_code
|= key_mask
>> 1;
3710 if (mouse_event
.type
== ButtonReleased
) event_code
|= 0x04;
3714 DEFUN ("x-get-mouse-event", Fx_get_mouse_event
, Sx_get_mouse_event
,
3716 "Get next mouse event out of mouse event buffer.\n\
3717 Optional ARG non-nil means return nil immediately if no pending event;\n\
3718 otherwise, wait for an event. Returns a four-part list:\n\
3719 ((X-POS Y-POS) WINDOW SCREEN-PART KEYSEQ TIMESTAMP).\n\
3720 Normally X-POS and Y-POS are the position of the click on the screen\n\
3721 (measured in characters and lines), and WINDOW is the window clicked in.\n\
3722 KEYSEQ is a string, the key sequence to be looked up in the mouse maps.\n\
3723 If SCREEN-PART is non-nil, the event was on a scrollbar;\n\
3724 then Y-POS is really the total length of the scrollbar, while X-POS is\n\
3725 the relative position of the scrollbar's value within that total length,\n\
3726 and a third element OFFSET appears in that list: the height of the thumb-up\n\
3727 area at the top of the scroll bar.\n\
3728 SCREEN-PART is one of the following symbols:\n\
3729 `vertical-scrollbar', `vertical-thumbup', `vertical-thumbdown',\n\
3730 `horizontal-scrollbar', `horizontal-thumbleft', `horizontal-thumbright'.\n\
3731 TIMESTAMP is the lower 23 bits of the X-server's timestamp for\n\
3737 register int com_letter
;
3738 register Lisp_Object tempx
;
3739 register Lisp_Object tempy
;
3740 Lisp_Object part
, pos
, timestamp
;
3749 tem
= dequeue_event (&xrep
, &x_mouse_queue
);
3757 case ButtonReleased
:
3759 com_letter
= encode_mouse_button (xrep
);
3760 mouse_timestamp
= xrep
.MouseTime
;
3762 if ((s
= x_window_to_screen (xrep
.MouseWindow
)) != 0)
3766 if (s
->display
.x
->icon_desc
== xrep
.MouseWindow
)
3768 x_make_screen_visible (s
);
3772 XSET (tempx
, Lisp_Int
,
3773 min (s
->width
-1, max (0, (xrep
.MouseX
- s
->display
.x
->internal_border_width
)/FONT_WIDTH (s
->display
.x
->font
))));
3774 XSET (tempy
, Lisp_Int
,
3775 min (s
->height
-1, max (0, (xrep
.MouseY
- s
->display
.x
->internal_border_width
)/FONT_HEIGHT (s
->display
.x
->font
))));
3776 XSET (timestamp
, Lisp_Int
, (xrep
.MouseTime
& 0x7fffff));
3777 XSET (screen
, Lisp_Screen
, s
);
3779 pos
= Fcons (tempx
, Fcons (tempy
, Qnil
));
3781 = Flocate_window_from_coordinates (screen
, pos
);
3785 Fcons (Vmouse_window
,
3787 Fcons (Fchar_to_string (make_number (com_letter
)),
3788 Fcons (timestamp
, Qnil
)))));
3789 return Vmouse_event
;
3791 else if ((s
= x_window_to_scrollbar (xrep
.MouseWindow
, &part
, &prefix
)) != 0)
3797 keyseq
= concat2 (Fchar_to_string (make_number (prefix
)),
3798 Fchar_to_string (make_number (com_letter
)));
3800 pos
= xrep
.MouseY
- (s
->display
.x
->v_scrollbar_width
- 2);
3801 XSET (tempx
, Lisp_Int
, pos
);
3802 len
= ((FONT_HEIGHT (s
->display
.x
->font
) * s
->height
)
3803 + s
->display
.x
->internal_border_width
3804 - (2 * (s
->display
.x
->v_scrollbar_width
- 2)));
3805 XSET (tempy
, Lisp_Int
, len
);
3806 XSET (timestamp
, Lisp_Int
, (xrep
.MouseTime
& 0x7fffff));
3807 Vmouse_window
= s
->selected_window
;
3809 = Fcons (Fcons (tempx
, Fcons (tempy
,
3810 Fcons (make_number (s
->display
.x
->v_scrollbar_width
- 2),
3812 Fcons (Vmouse_window
,
3813 Fcons (intern (part
),
3814 Fcons (keyseq
, Fcons (timestamp
,
3816 return Vmouse_event
;
3824 com_letter
= x11_encode_mouse_button (xrep
);
3825 if ((s
= x_window_to_screen (xrep
.MouseWindow
)) != 0)
3829 XSET (tempx
, Lisp_Int
,
3831 max (0, (xrep
.MouseX
- s
->display
.x
->internal_border_width
)
3832 / FONT_WIDTH (s
->display
.x
->font
))));
3833 XSET (tempy
, Lisp_Int
,
3835 max (0, (xrep
.MouseY
- s
->display
.x
->internal_border_width
)
3836 / FONT_HEIGHT (s
->display
.x
->font
))));
3838 XSET (screen
, Lisp_Screen
, s
);
3839 XSET (timestamp
, Lisp_Int
, (xrep
.MouseTime
& 0x7fffff));
3841 pos
= Fcons (tempx
, Fcons (tempy
, Qnil
));
3843 = Flocate_window_from_coordinates (screen
, pos
);
3847 Fcons (Vmouse_window
,
3849 Fcons (Fchar_to_string (make_number (com_letter
)),
3850 Fcons (timestamp
, Qnil
)))));
3851 return Vmouse_event
;
3855 #endif /* HAVE_X11 */
3858 if (s
= x_window_to_screen (xrep
.MouseWindow
))
3859 Vmouse_window
= s
->selected_window
;
3860 else if (s
= x_window_to_scrollbar (xrep
.MouseWindow
, &part
, &prefix
))
3861 Vmouse_window
= s
->selected_window
;
3862 return Vmouse_event
= Qnil
;
3869 /* Wait till we get another mouse event. */
3870 wait_reading_process_input (0, 0, 2, 0);
3877 DEFUN ("x-store-cut-buffer", Fx_store_cut_buffer
, Sx_store_cut_buffer
,
3878 1, 1, "sStore text in cut buffer: ",
3879 "Store contents of STRING into the cut buffer of the X window system.")
3881 register Lisp_Object string
;
3885 CHECK_STRING (string
, 1);
3886 if (SCREEN_IS_X (selected_screen
))
3887 error ("Selected screen does not understand X protocol.");
3890 XStoreBytes ((char *) XSTRING (string
)->data
, XSTRING (string
)->size
);
3896 DEFUN ("x-get-cut-buffer", Fx_get_cut_buffer
, Sx_get_cut_buffer
, 0, 0, 0,
3897 "Return contents of cut buffer of the X window system, as a string.")
3901 register Lisp_Object string
;
3906 d
= XFetchBytes (&len
);
3907 string
= make_string (d
, len
);
3915 DEFUN ("x-rebind-key", Fx_rebind_key
, Sx_rebind_key
, 3, 3, 0,
3916 "Rebind X keysym KEYSYM, with MODIFIERS, to generate NEWSTRING.\n\
3917 KEYSYM is a string which conforms to the X keysym definitions found\n\
3918 in X11/keysymdef.h, sans the initial XK_. MODIFIERS is nil or a\n\
3919 list of strings specifying modifier keys such as Control_L, which must\n\
3920 also be depressed for NEWSTRING to appear.")
3921 (x_keysym
, modifiers
, newstring
)
3922 register Lisp_Object x_keysym
;
3923 register Lisp_Object modifiers
;
3924 register Lisp_Object newstring
;
3927 register KeySym keysym
;
3928 KeySym modifier_list
[16];
3930 CHECK_STRING (x_keysym
, 1);
3931 CHECK_STRING (newstring
, 3);
3933 keysym
= XStringToKeysym ((char *) XSTRING (x_keysym
)->data
);
3934 if (keysym
== NoSymbol
)
3935 error ("Keysym does not exist");
3937 if (NILP (modifiers
))
3938 XRebindKeysym (x_current_display
, keysym
, modifier_list
, 0,
3939 XSTRING (newstring
)->data
, XSTRING (newstring
)->size
);
3942 register Lisp_Object rest
, mod
;
3945 for (rest
= modifiers
; !NILP (rest
); rest
= Fcdr (rest
))
3948 error ("Can't have more than 16 modifiers");
3951 CHECK_STRING (mod
, 3);
3952 modifier_list
[i
] = XStringToKeysym ((char *) XSTRING (mod
)->data
);
3953 if (modifier_list
[i
] == NoSymbol
3954 || !IsModifierKey (modifier_list
[i
]))
3955 error ("Element is not a modifier keysym");
3959 XRebindKeysym (x_current_display
, keysym
, modifier_list
, i
,
3960 XSTRING (newstring
)->data
, XSTRING (newstring
)->size
);
3966 DEFUN ("x-rebind-keys", Fx_rebind_keys
, Sx_rebind_keys
, 2, 2, 0,
3967 "Rebind KEYCODE to list of strings STRINGS.\n\
3968 STRINGS should be a list of 16 elements, one for each shift combination.\n\
3969 nil as element means don't change.\n\
3970 See the documentation of `x-rebind-key' for more information.")
3972 register Lisp_Object keycode
;
3973 register Lisp_Object strings
;
3975 register Lisp_Object item
;
3976 register unsigned char *rawstring
;
3977 KeySym rawkey
, modifier
[1];
3979 register unsigned i
;
3981 CHECK_NUMBER (keycode
, 1);
3982 CHECK_CONS (strings
, 2);
3983 rawkey
= (KeySym
) ((unsigned) (XINT (keycode
))) & 255;
3984 for (i
= 0; i
<= 15; strings
= Fcdr (strings
), i
++)
3986 item
= Fcar (strings
);
3989 CHECK_STRING (item
, 2);
3990 strsize
= XSTRING (item
)->size
;
3991 rawstring
= (unsigned char *) xmalloc (strsize
);
3992 bcopy (XSTRING (item
)->data
, rawstring
, strsize
);
3993 modifier
[1] = 1 << i
;
3994 XRebindKeysym (x_current_display
, rawkey
, modifier
, 1,
3995 rawstring
, strsize
);
4001 DEFUN ("x-rebind-key", Fx_rebind_key
, Sx_rebind_key
, 3, 3, 0,
4002 "Rebind KEYCODE, with shift bits SHIFT-MASK, to new string NEWSTRING.\n\
4003 KEYCODE and SHIFT-MASK should be numbers representing the X keyboard code\n\
4004 and shift mask respectively. NEWSTRING is an arbitrary string of keystrokes.\n\
4005 If SHIFT-MASK is nil, then KEYCODE's key will be bound to NEWSTRING for\n\
4006 all shift combinations.\n\
4007 Shift Lock 1 Shift 2\n\
4010 For values of KEYCODE, see /usr/lib/Xkeymap.txt (remember that the codes\n\
4011 in that file are in octal!)\n\
4013 NOTE: due to an X bug, this function will not take effect unless one has\n\
4014 a `~/.Xkeymap' file. (See the documentation for the `keycomp' program.)\n\
4015 This problem will be fixed in X version 11.")
4017 (keycode
, shift_mask
, newstring
)
4018 register Lisp_Object keycode
;
4019 register Lisp_Object shift_mask
;
4020 register Lisp_Object newstring
;
4023 int keysym
, rawshift
;
4026 CHECK_NUMBER (keycode
, 1);
4027 if (!NILP (shift_mask
))
4028 CHECK_NUMBER (shift_mask
, 2);
4029 CHECK_STRING (newstring
, 3);
4030 strsize
= XSTRING (newstring
)->size
;
4031 rawstring
= (char *) xmalloc (strsize
);
4032 bcopy (XSTRING (newstring
)->data
, rawstring
, strsize
);
4034 keysym
= ((unsigned) (XINT (keycode
))) & 255;
4036 if (NILP (shift_mask
))
4038 for (i
= 0; i
<= 15; i
++)
4039 XRebindCode (keysym
, i
<<11, rawstring
, strsize
);
4043 rawshift
= (((unsigned) (XINT (shift_mask
))) & 15) << 11;
4044 XRebindCode (keysym
, rawshift
, rawstring
, strsize
);
4049 DEFUN ("x-rebind-keys", Fx_rebind_keys
, Sx_rebind_keys
, 2, 2, 0,
4050 "Rebind KEYCODE to list of strings STRINGS.\n\
4051 STRINGS should be a list of 16 elements, one for each shift combination.\n\
4052 nil as element means don't change.\n\
4053 See the documentation of `x-rebind-key' for more information.")
4055 register Lisp_Object keycode
;
4056 register Lisp_Object strings
;
4058 register Lisp_Object item
;
4059 register char *rawstring
;
4060 KeySym rawkey
, modifier
[1];
4062 register unsigned i
;
4064 CHECK_NUMBER (keycode
, 1);
4065 CHECK_CONS (strings
, 2);
4066 rawkey
= (KeySym
) ((unsigned) (XINT (keycode
))) & 255;
4067 for (i
= 0; i
<= 15; strings
= Fcdr (strings
), i
++)
4069 item
= Fcar (strings
);
4072 CHECK_STRING (item
, 2);
4073 strsize
= XSTRING (item
)->size
;
4074 rawstring
= (char *) xmalloc (strsize
);
4075 bcopy (XSTRING (item
)->data
, rawstring
, strsize
);
4076 XRebindCode (rawkey
, i
<< 11, rawstring
, strsize
);
4081 #endif /* not HAVE_X11 */
4085 select_visual (screen
, depth
)
4087 unsigned int *depth
;
4090 XVisualInfo
*vinfo
, vinfo_template
;
4093 v
= DefaultVisualOfScreen (screen
);
4094 vinfo_template
.visualid
= XVisualIDFromVisual (v
);
4095 vinfo
= XGetVisualInfo (x_current_display
, VisualIDMask
, &vinfo_template
,
4098 fatal ("Can't get proper X visual info");
4100 if ((1 << vinfo
->depth
) == vinfo
->colormap_size
)
4101 *depth
= vinfo
->depth
;
4105 int n
= vinfo
->colormap_size
- 1;
4114 XFree ((char *) vinfo
);
4117 #endif /* HAVE_X11 */
4119 DEFUN ("x-open-connection", Fx_open_connection
, Sx_open_connection
,
4120 1, 2, 0, "Open a connection to an X server.\n\
4121 DISPLAY is the name of the display to connect to. Optional second\n\
4122 arg XRM_STRING is a string of resources in xrdb format.")
4123 (display
, xrm_string
)
4124 Lisp_Object display
, xrm_string
;
4126 unsigned int n_planes
;
4127 register Screen
*x_screen
;
4128 unsigned char *xrm_option
;
4130 CHECK_STRING (display
, 0);
4131 if (x_current_display
!= 0)
4132 error ("X server connection is already initialized");
4134 /* This is what opens the connection and sets x_current_display.
4135 This also initializes many symbols, such as those used for input. */
4136 x_term_init (XSTRING (display
)->data
);
4139 XFASTINT (Vwindow_system_version
) = 11;
4141 if (!EQ (xrm_string
, Qnil
))
4143 CHECK_STRING (xrm_string
, 1);
4144 xrm_option
= (unsigned char *) XSTRING (xrm_string
);
4147 xrm_option
= (unsigned char *) 0;
4148 xrdb
= x_load_resources (x_current_display
, xrm_option
, EMACS_CLASS
);
4149 x_current_display
->db
= xrdb
;
4151 x_screen
= DefaultScreenOfDisplay (x_current_display
);
4153 x_screen_count
= make_number (ScreenCount (x_current_display
));
4154 Vx_vendor
= build_string (ServerVendor (x_current_display
));
4155 x_release
= make_number (VendorRelease (x_current_display
));
4157 x_screen_height
= make_number (HeightOfScreen (x_screen
));
4158 x_screen_height_mm
= make_number (HeightMMOfScreen (x_screen
));
4159 x_screen_width
= make_number (WidthOfScreen (x_screen
));
4160 x_screen_width_mm
= make_number (WidthMMOfScreen (x_screen
));
4162 switch (DoesBackingStore (x_screen
))
4165 Vx_backing_store
= intern ("Always");
4169 Vx_backing_store
= intern ("WhenMapped");
4173 Vx_backing_store
= intern ("NotUseful");
4177 error ("Strange value for BackingStore.");
4181 if (DoesSaveUnders (x_screen
) == True
)
4184 x_save_under
= Qnil
;
4186 screen_visual
= select_visual (x_screen
, &n_planes
);
4187 x_screen_planes
= make_number (n_planes
);
4188 Vx_screen_visual
= intern (x_visual_strings
[screen_visual
->class]);
4190 /* X Atoms used by emacs. */
4192 Xatom_emacs_selection
= XInternAtom (x_current_display
, "_EMACS_SELECTION_",
4194 Xatom_clipboard
= XInternAtom (x_current_display
, "CLIPBOARD",
4196 Xatom_clipboard_selection
= XInternAtom (x_current_display
, "_EMACS_CLIPBOARD_",
4198 Xatom_wm_change_state
= XInternAtom (x_current_display
, "WM_CHANGE_STATE",
4200 Xatom_incremental
= XInternAtom (x_current_display
, "INCR",
4202 Xatom_multiple
= XInternAtom (x_current_display
, "MULTIPLE",
4204 Xatom_targets
= XInternAtom (x_current_display
, "TARGETS",
4206 Xatom_timestamp
= XInternAtom (x_current_display
, "TIMESTAMP",
4208 Xatom_delete
= XInternAtom (x_current_display
, "DELETE",
4210 Xatom_insert_selection
= XInternAtom (x_current_display
, "INSERT_SELECTION",
4212 Xatom_pair
= XInternAtom (x_current_display
, "XA_ATOM_PAIR",
4214 Xatom_insert_property
= XInternAtom (x_current_display
, "INSERT_PROPERTY",
4216 Xatom_text
= XInternAtom (x_current_display
, "TEXT",
4218 Xatom_wm_protocols
= XInternAtom (x_current_display
, "WM_PROTOCOLS",
4220 Xatom_wm_take_focus
= XInternAtom (x_current_display
, "WM_TAKE_FOCUS",
4222 Xatom_wm_save_yourself
= XInternAtom (x_current_display
, "WM_SAVE_YOURSELF",
4224 Xatom_wm_delete_window
= XInternAtom (x_current_display
, "WM_DELETE_WINDOW",
4226 Xatom_wm_change_state
= XInternAtom (x_current_display
, "WM_CHANGE_STATE",
4228 Xatom_wm_configure_denied
= XInternAtom (x_current_display
,
4229 "WM_CONFIGURE_DENIED", False
);
4230 Xatom_wm_window_moved
= XInternAtom (x_current_display
, "WM_MOVED",
4233 #else /* not HAVE_X11 */
4234 XFASTINT (Vwindow_system_version
) = 10;
4235 #endif /* not HAVE_X11 */
4239 DEFUN ("x-close-current-connection", Fx_close_current_connection
,
4240 Sx_close_current_connection
,
4241 0, 0, 0, "Close the connection to the current X server.")
4245 /* This is ONLY used when killing emacs; For switching displays
4246 we'll have to take care of setting CloseDownMode elsewhere. */
4248 if (x_current_display
)
4251 XSetCloseDownMode (x_current_display
, DestroyAll
);
4252 XCloseDisplay (x_current_display
);
4255 fatal ("No current X display connection to close\n");
4260 DEFUN ("x-synchronize", Fx_synchronize
, Sx_synchronize
,
4261 1, 1, 0, "If ON is non-nil, report X errors as soon as the erring request is made.\n\
4262 If ON is nil, allow buffering of requests.\n\
4263 Turning on synchronization prohibits the Xlib routines from buffering\n\
4264 requests and seriously degrades performance, but makes debugging much\n\
4269 XSynchronize (x_current_display
, !EQ (on
, Qnil
));
4277 init_x_parm_symbols ();
4279 /* This is zero if not using X windows. */
4280 x_current_display
= 0;
4282 Qundefined_color
= intern ("undefined-color");
4283 Fput (Qundefined_color
, Qerror_conditions
,
4284 Fcons (Qundefined_color
, Fcons (Qerror
, Qnil
)));
4285 Fput (Qundefined_color
, Qerror_message
,
4286 build_string ("Undefined color"));
4288 DEFVAR_INT ("mouse-x-position", &x_mouse_x
,
4289 "The X coordinate of the mouse position, in characters.");
4292 DEFVAR_INT ("mouse-y-position", &x_mouse_y
,
4293 "The Y coordinate of the mouse position, in characters.");
4296 DEFVAR_INT ("mouse-buffer-offset", &mouse_buffer_offset
,
4297 "The buffer offset of the character under the pointer.");
4298 mouse_buffer_offset
= Qnil
;
4300 DEFVAR_INT ("x-pointer-shape", &Vx_pointer_shape
,
4301 "The shape of the pointer when over text.");
4302 Vx_pointer_shape
= Qnil
;
4304 DEFVAR_INT ("x-nontext-pointer-shape", &Vx_nontext_pointer_shape
,
4305 "The shape of the pointer when not over text.");
4306 Vx_nontext_pointer_shape
= Qnil
;
4308 DEFVAR_INT ("x-mode-pointer-shape", &Vx_mode_pointer_shape
,
4309 "The shape of the pointer when over the mode line.");
4310 Vx_mode_pointer_shape
= Qnil
;
4312 DEFVAR_LISP ("x-bar-cursor", &Vbar_cursor
,
4313 "*If non-nil, use a vertical bar cursor. Otherwise, use the traditional box.");
4316 DEFVAR_LISP ("x-cursor-fore-pixel", &Vx_cursor_fore_pixel
,
4317 "A string indicating the foreground color of the cursor box.");
4318 Vx_cursor_fore_pixel
= Qnil
;
4320 DEFVAR_LISP ("mouse-grabbed", &Vmouse_depressed
,
4321 "Non-nil if a mouse button is currently depressed.");
4322 Vmouse_depressed
= Qnil
;
4324 DEFVAR_INT ("x-screen-count", &x_screen_count
,
4325 "The number of screens associated with the current display.");
4326 DEFVAR_INT ("x-release", &x_release
,
4327 "The release number of the X server in use.");
4328 DEFVAR_LISP ("x-vendor", &Vx_vendor
,
4329 "The vendor supporting the X server in use.");
4330 DEFVAR_INT ("x-screen-height", &x_screen_height
,
4331 "The height of this X screen in pixels.");
4332 DEFVAR_INT ("x-screen-height-mm", &x_screen_height_mm
,
4333 "The height of this X screen in millimeters.");
4334 DEFVAR_INT ("x-screen-width", &x_screen_width
,
4335 "The width of this X screen in pixels.");
4336 DEFVAR_INT ("x-screen-width-mm", &x_screen_width_mm
,
4337 "The width of this X screen in millimeters.");
4338 DEFVAR_LISP ("x-backing-store", &Vx_backing_store
,
4339 "The backing store capability of this screen.\n\
4340 Values can be the symbols Always, WhenMapped, or NotUseful.");
4341 DEFVAR_BOOL ("x-save-under", &x_save_under
,
4342 "*Non-nil means this X screen supports the SaveUnder feature.");
4343 DEFVAR_INT ("x-screen-planes", &x_screen_planes
,
4344 "The number of planes this monitor supports.");
4345 DEFVAR_LISP ("x-screen-visual", &Vx_screen_visual
,
4346 "The default X visual for this X screen.");
4347 DEFVAR_LISP ("x-no-window-manager", &Vx_no_window_manager
,
4348 "t if no X window manager is in use.");
4351 defsubr (&Sx_get_resource
);
4352 defsubr (&Sx_pixel_width
);
4353 defsubr (&Sx_pixel_height
);
4354 defsubr (&Sx_draw_rectangle
);
4355 defsubr (&Sx_erase_rectangle
);
4356 defsubr (&Sx_contour_region
);
4357 defsubr (&Sx_uncontour_region
);
4358 defsubr (&Sx_color_display_p
);
4359 defsubr (&Sx_defined_color
);
4361 defsubr (&Sx_track_pointer
);
4362 defsubr (&Sx_grab_pointer
);
4363 defsubr (&Sx_ungrab_pointer
);
4366 defsubr (&Sx_get_default
);
4367 defsubr (&Sx_store_cut_buffer
);
4368 defsubr (&Sx_get_cut_buffer
);
4369 defsubr (&Sx_set_face
);
4371 defsubr (&Sx_geometry
);
4372 defsubr (&Sx_create_screen
);
4373 defsubr (&Sfocus_screen
);
4374 defsubr (&Sunfocus_screen
);
4376 defsubr (&Sx_horizontal_line
);
4378 defsubr (&Sx_rebind_key
);
4379 defsubr (&Sx_rebind_keys
);
4380 defsubr (&Sx_open_connection
);
4381 defsubr (&Sx_close_current_connection
);
4382 defsubr (&Sx_synchronize
);
4384 /* This was used in the old event interface which used a separate
4387 defsubr (&Sx_mouse_events
);
4388 defsubr (&Sx_get_mouse_event
);
4392 #endif /* HAVE_X_WINDOWS */