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