*** 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 if (s->display.x->window_desc)
1047 {
1048 #ifdef HAVE_X11
1049 XTextProperty prop;
1050 prop.value = XSTRING (arg)->data;
1051 prop.encoding = XA_STRING;
1052 prop.format = 8;
1053 prop.nitems = XSTRING (arg)->size;
1054 BLOCK_INPUT;
1055 XSetWMName (XDISPLAY s->display.x->window_desc, &prop);
1056 XSetWMIconName (XDISPLAY s->display.x->window_desc, &prop);
1057 UNBLOCK_INPUT;
1058 #else
1059 s->name = arg;
1060 BLOCK_INPUT;
1061 XStoreName (XDISPLAY s->display.x->window_desc,
1062 (char *) XSTRING (arg)->data);
1063 XSetIconName (XDISPLAY s->display.x->window_desc,
1064 (char *) XSTRING (arg)->data);
1065 UNBLOCK_INPUT;
1066 #endif
1067 }
1068 }
1069
1070 void
1071 x_set_autoraise (s, arg, oldval)
1072 struct screen *s;
1073 Lisp_Object arg, oldval;
1074 {
1075 s->auto_raise = !EQ (Qnil, arg);
1076 }
1077
1078 void
1079 x_set_autolower (s, arg, oldval)
1080 struct screen *s;
1081 Lisp_Object arg, oldval;
1082 {
1083 s->auto_lower = !EQ (Qnil, arg);
1084 }
1085 \f
1086 #ifdef HAVE_X11
1087 int n_faces;
1088
1089 x_set_face (scr, font, background, foreground, stipple)
1090 struct screen *scr;
1091 XFontStruct *font;
1092 unsigned long background, foreground;
1093 Pixmap stipple;
1094 {
1095 XGCValues gc_values;
1096 GC temp_gc;
1097 unsigned long gc_mask;
1098 struct face *new_face;
1099 unsigned int width = 16;
1100 unsigned int height = 16;
1101
1102 if (n_faces == MAX_FACES_AND_GLYPHS)
1103 return 1;
1104
1105 /* Create the Graphics Context. */
1106 gc_values.font = font->fid;
1107 gc_values.foreground = foreground;
1108 gc_values.background = background;
1109 gc_values.line_width = 0;
1110 gc_mask = GCLineWidth | GCFont | GCForeground | GCBackground;
1111 if (stipple)
1112 {
1113 gc_values.stipple
1114 = XCreateBitmapFromData (x_current_display, ROOT_WINDOW,
1115 (char *) stipple, width, height);
1116 gc_mask |= GCStipple;
1117 }
1118
1119 temp_gc = XCreateGC (x_current_display, scr->display.x->window_desc,
1120 gc_mask, &gc_values);
1121 if (!temp_gc)
1122 return 1;
1123 new_face = (struct face *) xmalloc (sizeof (struct face));
1124 if (!new_face)
1125 {
1126 XFreeGC (x_current_display, temp_gc);
1127 return 1;
1128 }
1129
1130 new_face->font = font;
1131 new_face->foreground = foreground;
1132 new_face->background = background;
1133 new_face->face_gc = temp_gc;
1134 if (stipple)
1135 new_face->stipple = gc_values.stipple;
1136
1137 x_face_table[++n_faces] = new_face;
1138 return 1;
1139 }
1140
1141 x_set_glyph (scr, glyph)
1142 {
1143 }
1144
1145 #if 0
1146 DEFUN ("x-set-face-font", Fx_set_face_font, Sx_set_face_font, 4, 2, 0,
1147 "Specify face table entry FACE-CODE to be the font named by FONT,\n\
1148 in colors FOREGROUND and BACKGROUND.")
1149 (face_code, font_name, foreground, background)
1150 Lisp_Object face_code;
1151 Lisp_Object font_name;
1152 Lisp_Object foreground;
1153 Lisp_Object background;
1154 {
1155 register struct face *fp; /* Current face info. */
1156 register int fn; /* Face number. */
1157 register FONT_TYPE *f; /* Font data structure. */
1158 unsigned char *newname;
1159 int fg, bg;
1160 GC temp_gc;
1161 XGCValues gc_values;
1162
1163 /* Need to do something about this. */
1164 Drawable drawable = selected_screen->display.x->window_desc;
1165
1166 CHECK_NUMBER (face_code, 1);
1167 CHECK_STRING (font_name, 2);
1168
1169 if (EQ (foreground, Qnil) || EQ (background, Qnil))
1170 {
1171 fg = selected_screen->display.x->foreground_pixel;
1172 bg = selected_screen->display.x->background_pixel;
1173 }
1174 else
1175 {
1176 CHECK_NUMBER (foreground, 0);
1177 CHECK_NUMBER (background, 1);
1178
1179 fg = x_decode_color (XINT (foreground), BLACK_PIX_DEFAULT);
1180 bg = x_decode_color (XINT (background), WHITE_PIX_DEFAULT);
1181 }
1182
1183 fn = XINT (face_code);
1184 if ((fn < 1) || (fn > 255))
1185 error ("Invalid face code, %d", fn);
1186
1187 newname = XSTRING (font_name)->data;
1188 BLOCK_INPUT;
1189 f = (*newname == 0 ? 0 : XGetFont (newname));
1190 UNBLOCK_INPUT;
1191 if (f == 0)
1192 error ("Font \"%s\" is not defined", newname);
1193
1194 fp = x_face_table[fn];
1195 if (fp == 0)
1196 {
1197 x_face_table[fn] = fp = (struct face *) xmalloc (sizeof (struct face));
1198 bzero (fp, sizeof (struct face));
1199 fp->face_type = x_pixmap;
1200 }
1201 else if (FACE_IS_FONT (fn))
1202 {
1203 BLOCK_INPUT;
1204 XFreeGC (FACE_FONT (fn));
1205 UNBLOCK_INPUT;
1206 }
1207 else if (FACE_IS_IMAGE (fn)) /* This should not happen... */
1208 {
1209 BLOCK_INPUT;
1210 XFreePixmap (x_current_display, FACE_IMAGE (fn));
1211 fp->face_type = x_font;
1212 UNBLOCK_INPUT;
1213 }
1214 else
1215 abort ();
1216
1217 fp->face_GLYPH.font_desc.font = f;
1218 gc_values.font = f->fid;
1219 gc_values.foreground = fg;
1220 gc_values.background = bg;
1221 fp->face_GLYPH.font_desc.face_gc = XCreateGC (x_current_display,
1222 drawable, GCFont | GCForeground
1223 | GCBackground, &gc_values);
1224 fp->face_GLYPH.font_desc.font_width = FONT_WIDTH (f);
1225 fp->face_GLYPH.font_desc.font_height = FONT_HEIGHT (f);
1226
1227 return face_code;
1228 }
1229 #endif
1230 #else /* X10 */
1231 DEFUN ("x-set-face", Fx_set_face, Sx_set_face, 4, 4, 0,
1232 "Specify face table entry FACE-CODE to be the font named by FONT,\n\
1233 in colors FOREGROUND and BACKGROUND.")
1234 (face_code, font_name, foreground, background)
1235 Lisp_Object face_code;
1236 Lisp_Object font_name;
1237 Lisp_Object foreground;
1238 Lisp_Object background;
1239 {
1240 register struct face *fp; /* Current face info. */
1241 register int fn; /* Face number. */
1242 register FONT_TYPE *f; /* Font data structure. */
1243 unsigned char *newname;
1244
1245 CHECK_NUMBER (face_code, 1);
1246 CHECK_STRING (font_name, 2);
1247
1248 fn = XINT (face_code);
1249 if ((fn < 1) || (fn > 255))
1250 error ("Invalid face code, %d", fn);
1251
1252 /* Ask the server to find the specified font. */
1253 newname = XSTRING (font_name)->data;
1254 BLOCK_INPUT;
1255 f = (*newname == 0 ? 0 : XGetFont (newname));
1256 UNBLOCK_INPUT;
1257 if (f == 0)
1258 error ("Font \"%s\" is not defined", newname);
1259
1260 /* Get the face structure for face_code in the face table.
1261 Make sure it exists. */
1262 fp = x_face_table[fn];
1263 if (fp == 0)
1264 {
1265 x_face_table[fn] = fp = (struct face *) xmalloc (sizeof (struct face));
1266 bzero (fp, sizeof (struct face));
1267 }
1268
1269 /* If this face code already exists, get rid of the old font. */
1270 if (fp->font != 0 && fp->font != f)
1271 {
1272 BLOCK_INPUT;
1273 XLoseFont (fp->font);
1274 UNBLOCK_INPUT;
1275 }
1276
1277 /* Store the specified information in FP. */
1278 fp->fg = x_decode_color (foreground, BLACK_PIX_DEFAULT);
1279 fp->bg = x_decode_color (background, WHITE_PIX_DEFAULT);
1280 fp->font = f;
1281
1282 return face_code;
1283 }
1284 #endif /* X10 */
1285
1286 #if 0
1287 /* This is excluded because there is no painless way
1288 to get or to remember the name of the font. */
1289
1290 DEFUN ("x-get-face", Fx_get_face, Sx_get_face, 1, 1, 0,
1291 "Get data defining face code FACE. FACE is an integer.\n\
1292 The value is a list (FONT FG-COLOR BG-COLOR).")
1293 (face)
1294 Lisp_Object face;
1295 {
1296 register struct face *fp; /* Current face info. */
1297 register int fn; /* Face number. */
1298
1299 CHECK_NUMBER (face, 1);
1300 fn = XINT (face);
1301 if ((fn < 1) || (fn > 255))
1302 error ("Invalid face code, %d", fn);
1303
1304 /* Make sure the face table exists and this face code is defined. */
1305 if (x_face_table == 0 || x_face_table[fn] == 0)
1306 return Qnil;
1307
1308 fp = x_face_table[fn];
1309
1310 return Fcons (build_string (fp->name),
1311 Fcons (make_number (fp->fg),
1312 Fcons (make_number (fp->bg), Qnil)));
1313 }
1314 #endif /* 0 */
1315 \f
1316 /* Subroutines of creating an X screen. */
1317
1318 #ifdef HAVE_X11
1319 extern char *x_get_string_resource ();
1320 extern XrmDatabase x_load_resources ();
1321
1322 DEFUN ("x-get-resource", Fx_get_resource, Sx_get_resource, 1, 3, 0,
1323 "Retrieve the value of ATTRIBUTE from the X defaults database. This\n\
1324 searches using a key of the form \"INSTANCE.ATTRIBUTE\", with class\n\
1325 \"Emacs\", where INSTANCE is the name under which Emacs was invoked.\n\
1326 \n\
1327 Optional arguments COMPONENT and CLASS specify the component for which\n\
1328 we should look up ATTRIBUTE. When specified, Emacs searches using a\n\
1329 key of the form INSTANCE.COMPONENT.ATTRIBUTE, with class \"Emacs.CLASS\".")
1330 (attribute, name, class)
1331 Lisp_Object attribute, name, class;
1332 {
1333 register char *value;
1334 char *name_key;
1335 char *class_key;
1336
1337 CHECK_STRING (attribute, 0);
1338 if (!NILP (name))
1339 CHECK_STRING (name, 1);
1340 if (!NILP (class))
1341 CHECK_STRING (class, 2);
1342 if (NILP (name) != NILP (class))
1343 error ("x-get-resource: must specify both NAME and CLASS or neither");
1344
1345 if (NILP (name))
1346 {
1347 name_key = (char *) alloca (XSTRING (invocation_name)->size + 1
1348 + XSTRING (attribute)->size + 1);
1349
1350 sprintf (name_key, "%s.%s",
1351 XSTRING (invocation_name)->data,
1352 XSTRING (attribute)->data);
1353 class_key = EMACS_CLASS;
1354 }
1355 else
1356 {
1357 name_key = (char *) alloca (XSTRING (invocation_name)->size + 1
1358 + XSTRING (name)->size + 1
1359 + XSTRING (attribute)->size + 1);
1360
1361 class_key = (char *) alloca (sizeof (EMACS_CLASS)
1362 + XSTRING (class)->size + 1);
1363
1364 sprintf (name_key, "%s.%s.%s",
1365 XSTRING (invocation_name)->data,
1366 XSTRING (name)->data,
1367 XSTRING (attribute)->data);
1368 sprintf (class_key, "%s.%s",
1369 XSTRING (invocation_name)->data,
1370 XSTRING (class)->data);
1371 }
1372
1373 value = x_get_string_resource (xrdb, name_key, class_key);
1374
1375 if (value != (char *) 0)
1376 return build_string (value);
1377 else
1378 return Qnil;
1379 }
1380
1381 #else /* X10 */
1382
1383 DEFUN ("x-get-default", Fx_get_default, Sx_get_default, 1, 1, 0,
1384 "Get X default ATTRIBUTE from the system, or nil if no default.\n\
1385 Value is a string (when not nil) and ATTRIBUTE is also a string.\n\
1386 The defaults are specified in the file `~/.Xdefaults'.")
1387 (arg)
1388 Lisp_Object arg;
1389 {
1390 register unsigned char *value;
1391
1392 CHECK_STRING (arg, 1);
1393
1394 value = (unsigned char *) XGetDefault (XDISPLAY
1395 XSTRING (invocation_name)->data,
1396 XSTRING (arg)->data);
1397 if (value == 0)
1398 /* Try reversing last two args, in case this is the buggy version of X. */
1399 value = (unsigned char *) XGetDefault (XDISPLAY
1400 XSTRING (arg)->data,
1401 XSTRING (invocation_name)->data);
1402 if (value != 0)
1403 return build_string (value);
1404 else
1405 return (Qnil);
1406 }
1407
1408 #define Fx_get_resource(attribute, name, class) Fx_get_default(attribute)
1409
1410 #endif /* X10 */
1411
1412 /* Types we might convert a resource string into. */
1413 enum resource_types
1414 {
1415 number, boolean, string,
1416 };
1417
1418 /* Return the value of parameter PARAM.
1419
1420 First search ALIST, then Vdefault_screen_alist, then the X defaults
1421 database, using ATTRIBUTE as the attribute name.
1422
1423 Convert the resource to the type specified by desired_type.
1424
1425 If no default is specified, return nil. */
1426
1427 static Lisp_Object
1428 x_get_arg (alist, param, attribute, type)
1429 Lisp_Object alist, param;
1430 char *attribute;
1431 enum resource_types type;
1432 {
1433 register Lisp_Object tem;
1434
1435 tem = Fassq (param, alist);
1436 if (EQ (tem, Qnil))
1437 tem = Fassq (param, Vdefault_screen_alist);
1438 if (EQ (tem, Qnil) && attribute)
1439 {
1440 tem = Fx_get_resource (build_string (attribute), Qnil, Qnil);
1441
1442 if (NILP (tem))
1443 return Qnil;
1444
1445 switch (type)
1446 {
1447 case number:
1448 return make_number (atoi (XSTRING (tem)->data));
1449
1450 case boolean:
1451 tem = Fdowncase (tem);
1452 if (!strcmp (XSTRING (tem)->data, "on")
1453 || !strcmp (XSTRING (tem)->data, "true"))
1454 return Qt;
1455 else
1456 return Qnil;
1457
1458 case string:
1459 return tem;
1460
1461 default:
1462 abort ();
1463 }
1464 }
1465 return Fcdr (tem);
1466 }
1467
1468 /* Record in screen S the specified or default value according to ALIST
1469 of the parameter named PARAM (a Lisp symbol).
1470 If no value is specified for PARAM, look for an X default for XPROP
1471 on the screen named NAME.
1472 If that is not found either, use the value DEFLT. */
1473
1474 static Lisp_Object
1475 x_default_parameter (s, alist, propname, deflt, xprop, type)
1476 struct screen *s;
1477 Lisp_Object alist;
1478 char *propname;
1479 Lisp_Object deflt;
1480 char *xprop;
1481 enum resource_types type;
1482 {
1483 Lisp_Object propsym = intern (propname);
1484 Lisp_Object tem;
1485
1486 tem = x_get_arg (alist, propsym, xprop, type);
1487 if (EQ (tem, Qnil))
1488 tem = deflt;
1489 store_screen_param (s, propsym, tem);
1490 x_set_screen_param (s, propsym, tem, Qnil);
1491 return tem;
1492 }
1493 \f
1494 DEFUN ("x-geometry", Fx_geometry, Sx_geometry, 1, 1, 0,
1495 "Parse an X-style geometry string STRING.\n\
1496 Returns an alist of the form ((top . TOP), (left . LEFT) ... ).")
1497 (string)
1498 {
1499 int geometry, x, y;
1500 unsigned int width, height;
1501 Lisp_Object values[4];
1502
1503 CHECK_STRING (string, 0);
1504
1505 geometry = XParseGeometry ((char *) XSTRING (string)->data,
1506 &x, &y, &width, &height);
1507
1508 switch (geometry & 0xf) /* Mask out {X,Y}Negative */
1509 {
1510 case (XValue | YValue):
1511 /* What's one pixel among friends?
1512 Perhaps fix this some day by returning symbol `extreme-top'... */
1513 if (x == 0 && (geometry & XNegative))
1514 x = -1;
1515 if (y == 0 && (geometry & YNegative))
1516 y = -1;
1517 values[0] = Fcons (intern ("left"), make_number (x));
1518 values[1] = Fcons (intern ("top"), make_number (y));
1519 return Flist (2, values);
1520 break;
1521
1522 case (WidthValue | HeightValue):
1523 values[0] = Fcons (intern ("width"), make_number (width));
1524 values[1] = Fcons (intern ("height"), make_number (height));
1525 return Flist (2, values);
1526 break;
1527
1528 case (XValue | YValue | WidthValue | HeightValue):
1529 if (x == 0 && (geometry & XNegative))
1530 x = -1;
1531 if (y == 0 && (geometry & YNegative))
1532 y = -1;
1533 values[0] = Fcons (intern ("width"), make_number (width));
1534 values[1] = Fcons (intern ("height"), make_number (height));
1535 values[2] = Fcons (intern ("left"), make_number (x));
1536 values[3] = Fcons (intern ("top"), make_number (y));
1537 return Flist (4, values);
1538 break;
1539
1540 case 0:
1541 return Qnil;
1542
1543 default:
1544 error ("Must specify x and y value, and/or width and height");
1545 }
1546 }
1547
1548 #ifdef HAVE_X11
1549 /* Calculate the desired size and position of this window,
1550 or set rubber-band prompting if none. */
1551
1552 #define DEFAULT_ROWS 40
1553 #define DEFAULT_COLS 80
1554
1555 static
1556 x_figure_window_size (s, parms)
1557 struct screen *s;
1558 Lisp_Object parms;
1559 {
1560 register Lisp_Object tem0, tem1;
1561 int height, width, left, top;
1562 register int geometry;
1563 long window_prompting = 0;
1564
1565 /* Default values if we fall through.
1566 Actually, if that happens we should get
1567 window manager prompting. */
1568 s->width = DEFAULT_COLS;
1569 s->height = DEFAULT_ROWS;
1570 s->display.x->top_pos = 1;
1571 s->display.x->left_pos = 1;
1572
1573 tem0 = x_get_arg (parms, intern ("height"), 0, 0);
1574 tem1 = x_get_arg (parms, intern ("width"), 0, 0);
1575 if (! EQ (tem0, Qnil) && ! EQ (tem1, Qnil))
1576 {
1577 CHECK_NUMBER (tem0, 0);
1578 CHECK_NUMBER (tem1, 0);
1579 s->height = XINT (tem0);
1580 s->width = XINT (tem1);
1581 window_prompting |= USSize;
1582 }
1583 else if (! EQ (tem0, Qnil) || ! EQ (tem1, Qnil))
1584 error ("Must specify *both* height and width");
1585
1586 s->display.x->pixel_width = (FONT_WIDTH (s->display.x->font) * s->width
1587 + 2 * s->display.x->internal_border_width);
1588 s->display.x->pixel_height = (FONT_HEIGHT (s->display.x->font) * s->height
1589 + 2 * s->display.x->internal_border_width);
1590
1591 tem0 = x_get_arg (parms, intern ("top"), 0, 0);
1592 tem1 = x_get_arg (parms, intern ("left"), 0, 0);
1593 if (! EQ (tem0, Qnil) && ! EQ (tem1, Qnil))
1594 {
1595 CHECK_NUMBER (tem0, 0);
1596 CHECK_NUMBER (tem1, 0);
1597 s->display.x->top_pos = XINT (tem0);
1598 s->display.x->left_pos = XINT (tem1);
1599 x_calc_absolute_position (s);
1600 window_prompting |= USPosition;
1601 }
1602 else if (! EQ (tem0, Qnil) || ! EQ (tem1, Qnil))
1603 error ("Must specify *both* top and left corners");
1604
1605 switch (window_prompting)
1606 {
1607 case USSize | USPosition:
1608 return window_prompting;
1609 break;
1610
1611 case USSize: /* Got the size, need the position. */
1612 window_prompting |= PPosition;
1613 return window_prompting;
1614 break;
1615
1616 case USPosition: /* Got the position, need the size. */
1617 window_prompting |= PSize;
1618 return window_prompting;
1619 break;
1620
1621 case 0: /* Got nothing, take both from geometry. */
1622 window_prompting |= PPosition | PSize;
1623 return window_prompting;
1624 break;
1625
1626 default:
1627 /* Somehow a bit got set in window_prompting that we didn't
1628 put there. */
1629 abort ();
1630 }
1631 }
1632
1633 static void
1634 x_window (s)
1635 struct screen *s;
1636 {
1637 XSetWindowAttributes attributes;
1638 unsigned long attribute_mask;
1639 XClassHint class_hints;
1640
1641 attributes.background_pixel = s->display.x->background_pixel;
1642 attributes.border_pixel = s->display.x->border_pixel;
1643 attributes.bit_gravity = StaticGravity;
1644 attributes.backing_store = NotUseful;
1645 attributes.save_under = True;
1646 attributes.event_mask = STANDARD_EVENT_SET;
1647 attribute_mask = (CWBackPixel | CWBorderPixel | CWBitGravity
1648 #if 0
1649 | CWBackingStore | CWSaveUnder
1650 #endif
1651 | CWEventMask);
1652
1653 BLOCK_INPUT;
1654 s->display.x->window_desc
1655 = XCreateWindow (x_current_display, ROOT_WINDOW,
1656 s->display.x->left_pos,
1657 s->display.x->top_pos,
1658 PIXEL_WIDTH (s), PIXEL_HEIGHT (s),
1659 s->display.x->border_width,
1660 CopyFromParent, /* depth */
1661 InputOutput, /* class */
1662 screen_visual, /* set in Fx_open_connection */
1663 attribute_mask, &attributes);
1664
1665 class_hints.res_name = (char *) XSTRING (s->name)->data;
1666 class_hints.res_class = EMACS_CLASS;
1667 XSetClassHint (x_current_display, s->display.x->window_desc, &class_hints);
1668
1669 XDefineCursor (XDISPLAY s->display.x->window_desc,
1670 s->display.x->text_cursor);
1671 UNBLOCK_INPUT;
1672
1673 if (s->display.x->window_desc == 0)
1674 error ("Unable to create window.");
1675 }
1676
1677 /* Handle the icon stuff for this window. Perhaps later we might
1678 want an x_set_icon_position which can be called interactively as
1679 well. */
1680
1681 static void
1682 x_icon (s, parms)
1683 struct screen *s;
1684 Lisp_Object parms;
1685 {
1686 register Lisp_Object tem0,tem1;
1687 XWMHints hints;
1688
1689 /* Set the position of the icon. Note that twm groups all
1690 icons in an icon window. */
1691 tem0 = x_get_arg (parms, intern ("icon-left"), 0, 0);
1692 tem1 = x_get_arg (parms, intern ("icon-top"), 0, 0);
1693 if (!EQ (tem0, Qnil) && !EQ (tem1, Qnil))
1694 {
1695 CHECK_NUMBER (tem0, 0);
1696 CHECK_NUMBER (tem1, 0);
1697 hints.icon_x = XINT (tem0);
1698 hints.icon_x = XINT (tem0);
1699 }
1700 else if (!EQ (tem0, Qnil) || !EQ (tem1, Qnil))
1701 error ("Both left and top icon corners of icon must be specified");
1702 else
1703 {
1704 hints.icon_x = s->display.x->left_pos;
1705 hints.icon_y = s->display.x->top_pos;
1706 }
1707
1708 /* Start up iconic or window? */
1709 tem0 = x_get_arg (parms, intern ("iconic-startup"), 0, 0);
1710 if (!EQ (tem0, Qnil))
1711 hints.initial_state = IconicState;
1712 else
1713 hints.initial_state = NormalState; /* the default, actually. */
1714 hints.input = False;
1715
1716 BLOCK_INPUT;
1717 hints.flags = StateHint | IconPositionHint | InputHint;
1718 XSetWMHints (x_current_display, s->display.x->window_desc, &hints);
1719 UNBLOCK_INPUT;
1720 }
1721
1722 /* Make the GC's needed for this window, setting the
1723 background, border and mouse colors; also create the
1724 mouse cursor and the gray border tile. */
1725
1726 static void
1727 x_make_gc (s)
1728 struct screen *s;
1729 {
1730 XGCValues gc_values;
1731 GC temp_gc;
1732 XImage tileimage;
1733 static char cursor_bits[] =
1734 {
1735 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
1736 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
1737 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
1738 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00
1739 };
1740
1741 /* Create the GC's of this screen.
1742 Note that many default values are used. */
1743
1744 /* Normal video */
1745 gc_values.font = s->display.x->font->fid;
1746 gc_values.foreground = s->display.x->foreground_pixel;
1747 gc_values.background = s->display.x->background_pixel;
1748 gc_values.line_width = 0; /* Means 1 using fast algorithm. */
1749 s->display.x->normal_gc = XCreateGC (x_current_display,
1750 s->display.x->window_desc,
1751 GCLineWidth | GCFont
1752 | GCForeground | GCBackground,
1753 &gc_values);
1754
1755 /* Reverse video style. */
1756 gc_values.foreground = s->display.x->background_pixel;
1757 gc_values.background = s->display.x->foreground_pixel;
1758 s->display.x->reverse_gc = XCreateGC (x_current_display,
1759 s->display.x->window_desc,
1760 GCFont | GCForeground | GCBackground
1761 | GCLineWidth,
1762 &gc_values);
1763
1764 /* Cursor has cursor-color background, background-color foreground. */
1765 gc_values.foreground = s->display.x->background_pixel;
1766 gc_values.background = s->display.x->cursor_pixel;
1767 gc_values.fill_style = FillOpaqueStippled;
1768 gc_values.stipple
1769 = XCreateBitmapFromData (x_current_display, ROOT_WINDOW,
1770 cursor_bits, 16, 16);
1771 s->display.x->cursor_gc
1772 = XCreateGC (x_current_display, s->display.x->window_desc,
1773 (GCFont | GCForeground | GCBackground
1774 | GCFillStyle | GCStipple | GCLineWidth),
1775 &gc_values);
1776
1777 /* Create the gray border tile used when the pointer is not in
1778 the screen. Since this depends on the screen's pixel values,
1779 this must be done on a per-screen basis. */
1780 s->display.x->border_tile =
1781 XCreatePixmap (x_current_display, ROOT_WINDOW, 16, 16,
1782 DefaultDepth (x_current_display,
1783 XDefaultScreen (x_current_display)));
1784 gc_values.foreground = s->display.x->foreground_pixel;
1785 gc_values.background = s->display.x->background_pixel;
1786 temp_gc = XCreateGC (x_current_display,
1787 (Drawable) s->display.x->border_tile,
1788 GCForeground | GCBackground, &gc_values);
1789
1790 /* These are things that should be determined by the server, in
1791 Fx_open_connection */
1792 tileimage.height = 16;
1793 tileimage.width = 16;
1794 tileimage.xoffset = 0;
1795 tileimage.format = XYBitmap;
1796 tileimage.data = gray_bits;
1797 tileimage.byte_order = LSBFirst;
1798 tileimage.bitmap_unit = 8;
1799 tileimage.bitmap_bit_order = LSBFirst;
1800 tileimage.bitmap_pad = 8;
1801 tileimage.bytes_per_line = (16 + 7) >> 3;
1802 tileimage.depth = 1;
1803 XPutImage (x_current_display, s->display.x->border_tile, temp_gc,
1804 &tileimage, 0, 0, 0, 0, 16, 16);
1805 XFreeGC (x_current_display, temp_gc);
1806 }
1807 #endif /* HAVE_X11 */
1808
1809 DEFUN ("x-create-screen", Fx_create_screen, Sx_create_screen,
1810 1, 1, 0,
1811 "Make a new X window, which is called a \"screen\" in Emacs terms.\n\
1812 Return an Emacs screen object representing the X window.\n\
1813 ALIST is an alist of screen parameters.\n\
1814 If the parameters specify that the screen should not have a minibuffer,\n\
1815 and do not specify a specific minibuffer window to use,\n\
1816 then `default-minibuffer-screen' must be a screen whose minibuffer can\n\
1817 be shared by the new screen.")
1818 (parms)
1819 Lisp_Object parms;
1820 {
1821 #ifdef HAVE_X11
1822 struct screen *s;
1823 Lisp_Object screen, tem;
1824 Lisp_Object name;
1825 int minibuffer_only = 0;
1826 long window_prompting = 0;
1827 int width, height;
1828
1829 if (x_current_display == 0)
1830 error ("X windows are not in use or not initialized");
1831
1832 name = x_get_arg (parms, intern ("name"), "Title", string);
1833 if (NILP (name))
1834 name = build_string (x_id_name);
1835 if (XTYPE (name) != Lisp_String)
1836 error ("x-create-screen: name parameter must be a string");
1837
1838 tem = x_get_arg (parms, intern ("minibuffer"), 0, 0);
1839 if (EQ (tem, intern ("none")))
1840 s = make_screen_without_minibuffer (Qnil);
1841 else if (EQ (tem, intern ("only")))
1842 {
1843 s = make_minibuffer_screen ();
1844 minibuffer_only = 1;
1845 }
1846 else if (EQ (tem, Qnil) || EQ (tem, Qt))
1847 s = make_screen (1);
1848 else
1849 s = make_screen_without_minibuffer (tem);
1850
1851 /* Set the name; the functions to which we pass s expect the
1852 name to be set. */
1853 XSET (s->name, Lisp_String, name);
1854
1855 XSET (screen, Lisp_Screen, s);
1856 s->output_method = output_x_window;
1857 s->display.x = (struct x_display *) xmalloc (sizeof (struct x_display));
1858 bzero (s->display.x, sizeof (struct x_display));
1859
1860 /* Note that the screen has no physical cursor right now. */
1861 s->phys_cursor_x = -1;
1862
1863 /* Extract the window parameters from the supplied values
1864 that are needed to determine window geometry. */
1865 x_default_parameter (s, parms, "font",
1866 build_string ("9x15"), "font", string);
1867 x_default_parameter (s, parms, "background-color",
1868 build_string ("white"), "background", string);
1869 x_default_parameter (s, parms, "border-width",
1870 make_number (2), "BorderWidth", number);
1871 x_default_parameter (s, parms, "internal-border-width",
1872 make_number (1), "InternalBorderWidth", number);
1873
1874 /* Also do the stuff which must be set before the window exists. */
1875 x_default_parameter (s, parms, "foreground-color",
1876 build_string ("black"), "foreground", string);
1877 x_default_parameter (s, parms, "mouse-color",
1878 build_string ("black"), "mouse", string);
1879 x_default_parameter (s, parms, "cursor-color",
1880 build_string ("black"), "cursor", string);
1881 x_default_parameter (s, parms, "border-color",
1882 build_string ("black"), "border", string);
1883
1884 /* Need to do icon type, auto-raise, auto-lower. */
1885
1886 s->display.x->parent_desc = ROOT_WINDOW;
1887 window_prompting = x_figure_window_size (s, parms);
1888
1889 x_window (s);
1890 x_icon (s, parms);
1891 x_make_gc (s);
1892
1893 /* Dimensions, especially s->height, must be done via change_screen_size.
1894 Change will not be effected unless different from the current
1895 s->height. */
1896 width = s->width;
1897 height = s->height;
1898 s->height = s->width = 0;
1899 change_screen_size (s, height, width, 1);
1900 BLOCK_INPUT;
1901 x_wm_set_size_hint (s, window_prompting);
1902 UNBLOCK_INPUT;
1903
1904 tem = x_get_arg (parms, intern ("unsplittable"), 0, 0);
1905 s->no_split = minibuffer_only || EQ (tem, Qt);
1906
1907 /* Now handle the rest of the parameters. */
1908 x_default_parameter (s, parms, "horizontal-scroll-bar",
1909 Qnil, "?HScrollBar", string);
1910 x_default_parameter (s, parms, "vertical-scroll-bar",
1911 Qnil, "?VScrollBar", string);
1912
1913 /* Make the window appear on the screen and enable display. */
1914 if (!EQ (x_get_arg (parms, intern ("suppress-initial-map"), 0, 0), Qt))
1915 x_make_screen_visible (s);
1916
1917 return screen;
1918 #else /* X10 */
1919 struct screen *s;
1920 Lisp_Object screen, tem;
1921 Lisp_Object name;
1922 int pixelwidth, pixelheight;
1923 Cursor cursor;
1924 int height, width;
1925 Window parent;
1926 Pixmap temp;
1927 int minibuffer_only = 0;
1928 Lisp_Object vscroll, hscroll;
1929
1930 if (x_current_display == 0)
1931 error ("X windows are not in use or not initialized");
1932
1933 name = Fassq (intern ("name"), parms);
1934
1935 tem = x_get_arg (parms, intern ("minibuffer"), 0, 0);
1936 if (EQ (tem, intern ("none")))
1937 s = make_screen_without_minibuffer (Qnil);
1938 else if (EQ (tem, intern ("only")))
1939 {
1940 s = make_minibuffer_screen ();
1941 minibuffer_only = 1;
1942 }
1943 else if (! EQ (tem, Qnil))
1944 s = make_screen_without_minibuffer (tem);
1945 else
1946 s = make_screen (1);
1947
1948 parent = ROOT_WINDOW;
1949
1950 XSET (screen, Lisp_Screen, s);
1951 s->output_method = output_x_window;
1952 s->display.x = (struct x_display *) xmalloc (sizeof (struct x_display));
1953 bzero (s->display.x, sizeof (struct x_display));
1954
1955 /* Some temprorary default values for height and width. */
1956 width = 80;
1957 height = 40;
1958 s->display.x->left_pos = -1;
1959 s->display.x->top_pos = -1;
1960
1961 /* Give the screen a default name (which may be overridden with PARMS). */
1962
1963 strncpy (iconidentity, ICONTAG, MAXICID);
1964 if (gethostname (&iconidentity[sizeof (ICONTAG) - 1],
1965 (MAXICID - 1) - sizeof (ICONTAG)))
1966 iconidentity[sizeof (ICONTAG) - 2] = '\0';
1967 s->name = build_string (iconidentity);
1968
1969 /* Extract some window parameters from the supplied values.
1970 These are the parameters that affect window geometry. */
1971
1972 tem = x_get_arg (parms, intern ("font"), "BodyFont", string);
1973 if (EQ (tem, Qnil))
1974 tem = build_string ("9x15");
1975 x_set_font (s, tem);
1976 x_default_parameter (s, parms, "border-color",
1977 build_string ("black"), "Border", string);
1978 x_default_parameter (s, parms, "background-color",
1979 build_string ("white"), "Background", string);
1980 x_default_parameter (s, parms, "foreground-color",
1981 build_string ("black"), "Foreground", string);
1982 x_default_parameter (s, parms, "mouse-color",
1983 build_string ("black"), "Mouse", string);
1984 x_default_parameter (s, parms, "cursor-color",
1985 build_string ("black"), "Cursor", string);
1986 x_default_parameter (s, parms, "border-width",
1987 make_number (2), "BorderWidth", number);
1988 x_default_parameter (s, parms, "internal-border-width",
1989 make_number (4), "InternalBorderWidth", number);
1990 x_default_parameter (s, parms, "auto-raise",
1991 Qnil, "AutoRaise", boolean);
1992
1993 hscroll = x_get_arg (parms, intern ("horizontal-scroll-bar"), 0, 0);
1994 vscroll = x_get_arg (parms, intern ("vertical-scroll-bar"), 0, 0);
1995
1996 if (s->display.x->internal_border_width < 0)
1997 s->display.x->internal_border_width = 0;
1998
1999 tem = x_get_arg (parms, intern ("window-id"), 0, 0);
2000 if (!EQ (tem, Qnil))
2001 {
2002 WINDOWINFO_TYPE wininfo;
2003 int nchildren;
2004 Window *children, root;
2005
2006 CHECK_STRING (tem, 0);
2007 s->display.x->window_desc = (Window) atoi (XSTRING (tem)->data);
2008
2009 BLOCK_INPUT;
2010 XGetWindowInfo (s->display.x->window_desc, &wininfo);
2011 XQueryTree (s->display.x->window_desc, &parent, &nchildren, &children);
2012 free (children);
2013 UNBLOCK_INPUT;
2014
2015 height = (wininfo.height - 2 * s->display.x->internal_border_width)
2016 / FONT_HEIGHT (s->display.x->font);
2017 width = (wininfo.width - 2 * s->display.x->internal_border_width)
2018 / FONT_WIDTH (s->display.x->font);
2019 s->display.x->left_pos = wininfo.x;
2020 s->display.x->top_pos = wininfo.y;
2021 s->visible = wininfo.mapped != 0;
2022 s->display.x->border_width = wininfo.bdrwidth;
2023 s->display.x->parent_desc = parent;
2024 }
2025 else
2026 {
2027 tem = x_get_arg (parms, intern ("parent-id"), 0, 0);
2028 if (!EQ (tem, Qnil))
2029 {
2030 CHECK_STRING (tem, 0);
2031 parent = (Window) atoi (XSTRING (tem)->data);
2032 }
2033 s->display.x->parent_desc = parent;
2034 tem = x_get_arg (parms, intern ("height"), 0, 0);
2035 if (EQ (tem, Qnil))
2036 {
2037 tem = x_get_arg (parms, intern ("width"), 0, 0);
2038 if (EQ (tem, Qnil))
2039 {
2040 tem = x_get_arg (parms, intern ("top"), 0, 0);
2041 if (EQ (tem, Qnil))
2042 tem = x_get_arg (parms, intern ("left"), 0, 0);
2043 }
2044 }
2045 /* Now TEM is nil if no edge or size was specified.
2046 In that case, we must do rubber-banding. */
2047 if (EQ (tem, Qnil))
2048 {
2049 tem = x_get_arg (parms, intern ("geometry"), 0, 0);
2050 x_rubber_band (s,
2051 &s->display.x->left_pos, &s->display.x->top_pos,
2052 &width, &height,
2053 (XTYPE (tem) == Lisp_String
2054 ? (char *) XSTRING (tem)->data : ""),
2055 XSTRING (s->name)->data,
2056 !NILP (hscroll), !NILP (vscroll));
2057 }
2058 else
2059 {
2060 /* Here if at least one edge or size was specified.
2061 Demand that they all were specified, and use them. */
2062 tem = x_get_arg (parms, intern ("height"), 0, 0);
2063 if (EQ (tem, Qnil))
2064 error ("Height not specified");
2065 CHECK_NUMBER (tem, 0);
2066 height = XINT (tem);
2067
2068 tem = x_get_arg (parms, intern ("width"), 0, 0);
2069 if (EQ (tem, Qnil))
2070 error ("Width not specified");
2071 CHECK_NUMBER (tem, 0);
2072 width = XINT (tem);
2073
2074 tem = x_get_arg (parms, intern ("top"), 0, 0);
2075 if (EQ (tem, Qnil))
2076 error ("Top position not specified");
2077 CHECK_NUMBER (tem, 0);
2078 s->display.x->left_pos = XINT (tem);
2079
2080 tem = x_get_arg (parms, intern ("left"), 0, 0);
2081 if (EQ (tem, Qnil))
2082 error ("Left position not specified");
2083 CHECK_NUMBER (tem, 0);
2084 s->display.x->top_pos = XINT (tem);
2085 }
2086
2087 pixelwidth = (width * FONT_WIDTH (s->display.x->font)
2088 + 2 * s->display.x->internal_border_width
2089 + (!NILP (vscroll) ? VSCROLL_WIDTH : 0));
2090 pixelheight = (height * FONT_HEIGHT (s->display.x->font)
2091 + 2 * s->display.x->internal_border_width
2092 + (!NILP (hscroll) ? HSCROLL_HEIGHT : 0));
2093
2094 BLOCK_INPUT;
2095 s->display.x->window_desc
2096 = XCreateWindow (parent,
2097 s->display.x->left_pos, /* Absolute horizontal offset */
2098 s->display.x->top_pos, /* Absolute Vertical offset */
2099 pixelwidth, pixelheight,
2100 s->display.x->border_width,
2101 BLACK_PIX_DEFAULT, WHITE_PIX_DEFAULT);
2102 UNBLOCK_INPUT;
2103 if (s->display.x->window_desc == 0)
2104 error ("Unable to create window.");
2105 }
2106
2107 /* Install the now determined height and width
2108 in the windows and in phys_lines and desired_lines. */
2109 /* ??? jla version had 1 here instead of 0. */
2110 change_screen_size (s, height, width, 1);
2111 XSelectInput (s->display.x->window_desc, KeyPressed | ExposeWindow
2112 | ButtonPressed | ButtonReleased | ExposeRegion | ExposeCopy
2113 | EnterWindow | LeaveWindow | UnmapWindow );
2114 x_set_resize_hint (s);
2115
2116 /* Tell the server the window's default name. */
2117 #ifdef HAVE_X11
2118 {
2119 XTextProperty prop;
2120 prop.value = XSTRING (s->name)->data;
2121 prop.encoding = XA_STRING;
2122 prop.format = 8;
2123 prop.nitems = XSTRING (s->name)->size;
2124 XSetWMName (XDISPLAY s->display.x->window_desc, &prop);
2125 }
2126 #else
2127 XStoreName (XDISPLAY s->display.x->window_desc, XSTRING (s->name)->data);
2128 #endif
2129
2130 /* Now override the defaults with all the rest of the specified
2131 parms. */
2132 tem = x_get_arg (parms, intern ("unsplittable"), 0, 0);
2133 s->no_split = minibuffer_only || EQ (tem, Qt);
2134
2135 /* Do not create an icon window if the caller says not to */
2136 if (!EQ (x_get_arg (parms, intern ("suppress-icon"), 0, 0), Qt)
2137 || s->display.x->parent_desc != ROOT_WINDOW)
2138 {
2139 x_text_icon (s, iconidentity);
2140 x_default_parameter (s, parms, "icon-type", Qnil,
2141 "BitmapIcon", boolean);
2142 }
2143
2144 /* Tell the X server the previously set values of the
2145 background, border and mouse colors; also create the mouse cursor. */
2146 BLOCK_INPUT;
2147 temp = XMakeTile (s->display.x->background_pixel);
2148 XChangeBackground (s->display.x->window_desc, temp);
2149 XFreePixmap (temp);
2150 UNBLOCK_INPUT;
2151 x_set_border_pixel (s, s->display.x->border_pixel);
2152
2153 x_set_mouse_color (s, Qnil, Qnil);
2154
2155 /* Now override the defaults with all the rest of the specified parms. */
2156
2157 Fmodify_screen_parameters (screen, parms);
2158
2159 if (!NILP (vscroll))
2160 install_vertical_scrollbar (s, pixelwidth, pixelheight);
2161 if (!NILP (hscroll))
2162 install_horizontal_scrollbar (s, pixelwidth, pixelheight);
2163
2164 /* Make the window appear on the screen and enable display. */
2165
2166 if (!EQ (x_get_arg (parms, intern ("suppress-initial-map"), 0, 0), Qt))
2167 x_make_window_visible (s);
2168 SCREEN_GARBAGED (s);
2169
2170 return screen;
2171 #endif /* X10 */
2172 }
2173
2174 DEFUN ("focus-screen", Ffocus_screen, Sfocus_screen, 1, 1, 0,
2175 "Set the focus on SCREEN.")
2176 (screen)
2177 Lisp_Object screen;
2178 {
2179 CHECK_LIVE_SCREEN (screen, 0);
2180
2181 if (SCREEN_IS_X (XSCREEN (screen)))
2182 {
2183 BLOCK_INPUT;
2184 x_focus_on_screen (XSCREEN (screen));
2185 UNBLOCK_INPUT;
2186 return screen;
2187 }
2188
2189 return Qnil;
2190 }
2191
2192 DEFUN ("unfocus-screen", Funfocus_screen, Sunfocus_screen, 0, 0, 0,
2193 "If a screen has been focused, release it.")
2194 ()
2195 {
2196 if (x_focus_screen)
2197 {
2198 BLOCK_INPUT;
2199 x_unfocus_screen (x_focus_screen);
2200 UNBLOCK_INPUT;
2201 }
2202
2203 return Qnil;
2204 }
2205 \f
2206 #ifndef HAVE_X11
2207 /* Computes an X-window size and position either from geometry GEO
2208 or with the mouse.
2209
2210 S is a screen. It specifies an X window which is used to
2211 determine which display to compute for. Its font, borders
2212 and colors control how the rectangle will be displayed.
2213
2214 X and Y are where to store the positions chosen.
2215 WIDTH and HEIGHT are where to store the sizes chosen.
2216
2217 GEO is the geometry that may specify some of the info.
2218 STR is a prompt to display.
2219 HSCROLL and VSCROLL say whether we have horiz and vert scroll bars. */
2220
2221 int
2222 x_rubber_band (s, x, y, width, height, geo, str, hscroll, vscroll)
2223 struct screen *s;
2224 int *x, *y, *width, *height;
2225 char *geo;
2226 char *str;
2227 int hscroll, vscroll;
2228 {
2229 OpaqueFrame frame;
2230 Window tempwindow;
2231 WindowInfo wininfo;
2232 int border_color;
2233 int background_color;
2234 Lisp_Object tem;
2235 int mask;
2236
2237 BLOCK_INPUT;
2238
2239 background_color = s->display.x->background_pixel;
2240 border_color = s->display.x->border_pixel;
2241
2242 frame.bdrwidth = s->display.x->border_width;
2243 frame.border = XMakeTile (border_color);
2244 frame.background = XMakeTile (background_color);
2245 tempwindow = XCreateTerm (str, "emacs", geo, default_window, &frame, 10, 5,
2246 (2 * s->display.x->internal_border_width
2247 + (vscroll ? VSCROLL_WIDTH : 0)),
2248 (2 * s->display.x->internal_border_width
2249 + (hscroll ? HSCROLL_HEIGHT : 0)),
2250 width, height, s->display.x->font,
2251 FONT_WIDTH (s->display.x->font),
2252 FONT_HEIGHT (s->display.x->font));
2253 XFreePixmap (frame.border);
2254 XFreePixmap (frame.background);
2255
2256 if (tempwindow != 0)
2257 {
2258 XQueryWindow (tempwindow, &wininfo);
2259 XDestroyWindow (tempwindow);
2260 *x = wininfo.x;
2261 *y = wininfo.y;
2262 }
2263
2264 /* Coordinates we got are relative to the root window.
2265 Convert them to coordinates relative to desired parent window
2266 by scanning from there up to the root. */
2267 tempwindow = s->display.x->parent_desc;
2268 while (tempwindow != ROOT_WINDOW)
2269 {
2270 int nchildren;
2271 Window *children;
2272 XQueryWindow (tempwindow, &wininfo);
2273 *x -= wininfo.x;
2274 *y -= wininfo.y;
2275 XQueryTree (tempwindow, &tempwindow, &nchildren, &children);
2276 free (children);
2277 }
2278
2279 UNBLOCK_INPUT;
2280 return tempwindow != 0;
2281 }
2282 #endif /* not HAVE_X11 */
2283 \f
2284 /* Set whether screen S has a horizontal scroll bar.
2285 VAL is t or nil to specify it. */
2286
2287 static void
2288 x_set_horizontal_scrollbar (s, val, oldval)
2289 struct screen *s;
2290 Lisp_Object val, oldval;
2291 {
2292 if (!NILP (val))
2293 {
2294 if (s->display.x->window_desc != 0)
2295 {
2296 BLOCK_INPUT;
2297 s->display.x->h_scrollbar_height = HSCROLL_HEIGHT;
2298 x_set_window_size (s, s->width, s->height);
2299 install_horizontal_scrollbar (s);
2300 SET_SCREEN_GARBAGED (s);
2301 UNBLOCK_INPUT;
2302 }
2303 }
2304 else
2305 if (s->display.x->h_scrollbar)
2306 {
2307 BLOCK_INPUT;
2308 s->display.x->h_scrollbar_height = 0;
2309 XDestroyWindow (XDISPLAY s->display.x->h_scrollbar);
2310 s->display.x->h_scrollbar = 0;
2311 x_set_window_size (s, s->width, s->height);
2312 s->garbaged++;
2313 screen_garbaged++;
2314 BLOCK_INPUT;
2315 }
2316 }
2317
2318 /* Set whether screen S has a vertical scroll bar.
2319 VAL is t or nil to specify it. */
2320
2321 static void
2322 x_set_vertical_scrollbar (s, val, oldval)
2323 struct screen *s;
2324 Lisp_Object val, oldval;
2325 {
2326 if (!NILP (val))
2327 {
2328 if (s->display.x->window_desc != 0)
2329 {
2330 BLOCK_INPUT;
2331 s->display.x->v_scrollbar_width = VSCROLL_WIDTH;
2332 x_set_window_size (s, s->width, s->height);
2333 install_vertical_scrollbar (s);
2334 SET_SCREEN_GARBAGED (s);
2335 UNBLOCK_INPUT;
2336 }
2337 }
2338 else
2339 if (s->display.x->v_scrollbar != 0)
2340 {
2341 BLOCK_INPUT;
2342 s->display.x->v_scrollbar_width = 0;
2343 XDestroyWindow (XDISPLAY s->display.x->v_scrollbar);
2344 s->display.x->v_scrollbar = 0;
2345 x_set_window_size (s, s->width, s->height);
2346 SET_SCREEN_GARBAGED (s);
2347 UNBLOCK_INPUT;
2348 }
2349 }
2350 \f
2351 /* Create the X windows for a vertical scroll bar
2352 for a screen X that already has an X window but no scroll bar. */
2353
2354 static void
2355 install_vertical_scrollbar (s)
2356 struct screen *s;
2357 {
2358 int ibw = s->display.x->internal_border_width;
2359 Window parent;
2360 XColor fore_color, back_color;
2361 Pixmap up_arrow_pixmap, down_arrow_pixmap, slider_pixmap;
2362 int pix_x, pix_y, width, height, border;
2363
2364 height = s->display.x->pixel_height - ibw - 2;
2365 width = VSCROLL_WIDTH - 2;
2366 pix_x = s->display.x->pixel_width - ibw/2;
2367 pix_y = ibw / 2;
2368 border = 1;
2369
2370 #ifdef HAVE_X11
2371 up_arrow_pixmap =
2372 XCreatePixmapFromBitmapData (x_current_display, s->display.x->window_desc,
2373 up_arrow_bits, 16, 16,
2374 s->display.x->foreground_pixel,
2375 s->display.x->background_pixel,
2376 DefaultDepth (x_current_display,
2377 XDefaultScreen (x_current_display)));
2378
2379 down_arrow_pixmap =
2380 XCreatePixmapFromBitmapData (x_current_display, s->display.x->window_desc,
2381 down_arrow_bits, 16, 16,
2382 s->display.x->foreground_pixel,
2383 s->display.x->background_pixel,
2384 DefaultDepth (x_current_display,
2385 XDefaultScreen (x_current_display)));
2386
2387 slider_pixmap =
2388 XCreatePixmapFromBitmapData (x_current_display, s->display.x->window_desc,
2389 gray_bits, 16, 16,
2390 s->display.x->foreground_pixel,
2391 s->display.x->background_pixel,
2392 DefaultDepth (x_current_display,
2393 XDefaultScreen (x_current_display)));
2394
2395 /* These cursor shapes will be installed when the mouse enters
2396 the appropriate window. */
2397
2398 up_arrow_cursor = XCreateFontCursor (x_current_display, XC_sb_up_arrow);
2399 down_arrow_cursor = XCreateFontCursor (x_current_display, XC_sb_down_arrow);
2400 v_double_arrow_cursor = XCreateFontCursor (x_current_display, XC_sb_v_double_arrow);
2401
2402 s->display.x->v_scrollbar =
2403 XCreateSimpleWindow (x_current_display, s->display.x->window_desc,
2404 pix_x, pix_y, width, height, border,
2405 s->display.x->foreground_pixel,
2406 s->display.x->background_pixel);
2407 XFlush (x_current_display);
2408 XDefineCursor (x_current_display, s->display.x->v_scrollbar,
2409 v_double_arrow_cursor);
2410
2411 /* Create slider window */
2412 s->display.x->v_slider =
2413 XCreateSimpleWindow (x_current_display, s->display.x->v_scrollbar,
2414 0, VSCROLL_WIDTH - 2,
2415 VSCROLL_WIDTH - 4, VSCROLL_WIDTH - 4,
2416 1, s->display.x->border_pixel,
2417 s->display.x->foreground_pixel);
2418 XFlush (x_current_display);
2419 XDefineCursor (x_current_display, s->display.x->v_slider,
2420 v_double_arrow_cursor);
2421 XSetWindowBackgroundPixmap (x_current_display, s->display.x->v_slider,
2422 slider_pixmap);
2423
2424 s->display.x->v_thumbup =
2425 XCreateSimpleWindow (x_current_display, s->display.x->v_scrollbar,
2426 0, 0,
2427 VSCROLL_WIDTH - 2, VSCROLL_WIDTH - 2,
2428 0, s->display.x->foreground_pixel,
2429 s->display.x-> background_pixel);
2430 XFlush (x_current_display);
2431 XDefineCursor (x_current_display, s->display.x->v_thumbup,
2432 up_arrow_cursor);
2433 XSetWindowBackgroundPixmap (x_current_display, s->display.x->v_thumbup,
2434 up_arrow_pixmap);
2435
2436 s->display.x->v_thumbdown =
2437 XCreateSimpleWindow (x_current_display, s->display.x->v_scrollbar,
2438 0, height - VSCROLL_WIDTH + 2,
2439 VSCROLL_WIDTH - 2, VSCROLL_WIDTH - 2,
2440 0, s->display.x->foreground_pixel,
2441 s->display.x->background_pixel);
2442 XFlush (x_current_display);
2443 XDefineCursor (x_current_display, s->display.x->v_thumbdown,
2444 down_arrow_cursor);
2445 XSetWindowBackgroundPixmap (x_current_display, s->display.x->v_thumbdown,
2446 down_arrow_pixmap);
2447
2448 fore_color.pixel = s->display.x->mouse_pixel;
2449 back_color.pixel = s->display.x->background_pixel;
2450 XQueryColor (x_current_display,
2451 DefaultColormap (x_current_display,
2452 DefaultScreen (x_current_display)),
2453 &fore_color);
2454 XQueryColor (x_current_display,
2455 DefaultColormap (x_current_display,
2456 DefaultScreen (x_current_display)),
2457 &back_color);
2458 XRecolorCursor (x_current_display, up_arrow_cursor,
2459 &fore_color, &back_color);
2460 XRecolorCursor (x_current_display, down_arrow_cursor,
2461 &fore_color, &back_color);
2462 XRecolorCursor (x_current_display, v_double_arrow_cursor,
2463 &fore_color, &back_color);
2464
2465 XFreePixmap (x_current_display, slider_pixmap);
2466 XFreePixmap (x_current_display, up_arrow_pixmap);
2467 XFreePixmap (x_current_display, down_arrow_pixmap);
2468 XFlush (x_current_display);
2469
2470 XSelectInput (x_current_display, s->display.x->v_scrollbar,
2471 ButtonPressMask | ButtonReleaseMask
2472 | PointerMotionMask | PointerMotionHintMask
2473 | EnterWindowMask);
2474 XSelectInput (x_current_display, s->display.x->v_slider,
2475 ButtonPressMask | ButtonReleaseMask);
2476 XSelectInput (x_current_display, s->display.x->v_thumbdown,
2477 ButtonPressMask | ButtonReleaseMask);
2478 XSelectInput (x_current_display, s->display.x->v_thumbup,
2479 ButtonPressMask | ButtonReleaseMask);
2480 XFlush (x_current_display);
2481
2482 /* This should be done at the same time as the main window. */
2483 XMapWindow (x_current_display, s->display.x->v_scrollbar);
2484 XMapSubwindows (x_current_display, s->display.x->v_scrollbar);
2485 XFlush (x_current_display);
2486 #else /* not HAVE_X11 */
2487 Bitmap b;
2488 Pixmap fore_tile, back_tile, bord_tile;
2489 static short up_arrow_bits[] = {
2490 0x0000, 0x0180, 0x03c0, 0x07e0,
2491 0x0ff0, 0x1ff8, 0x3ffc, 0x7ffe,
2492 0x0180, 0x0180, 0x0180, 0x0180,
2493 0x0180, 0x0180, 0x0180, 0xffff};
2494 static short down_arrow_bits[] = {
2495 0xffff, 0x0180, 0x0180, 0x0180,
2496 0x0180, 0x0180, 0x0180, 0x0180,
2497 0x7ffe, 0x3ffc, 0x1ff8, 0x0ff0,
2498 0x07e0, 0x03c0, 0x0180, 0x0000};
2499
2500 fore_tile = XMakeTile (s->display.x->foreground_pixel);
2501 back_tile = XMakeTile (s->display.x->background_pixel);
2502 bord_tile = XMakeTile (s->display.x->border_pixel);
2503
2504 b = XStoreBitmap (VSCROLL_WIDTH - 2, VSCROLL_WIDTH - 2, up_arrow_bits);
2505 up_arrow_pixmap = XMakePixmap (b,
2506 s->display.x->foreground_pixel,
2507 s->display.x->background_pixel);
2508 XFreeBitmap (b);
2509
2510 b = XStoreBitmap (VSCROLL_WIDTH - 2, VSCROLL_WIDTH - 2, down_arrow_bits);
2511 down_arrow_pixmap = XMakePixmap (b,
2512 s->display.x->foreground_pixel,
2513 s->display.x->background_pixel);
2514 XFreeBitmap (b);
2515
2516 ibw = s->display.x->internal_border_width;
2517
2518 s->display.x->v_scrollbar = XCreateWindow (s->display.x->window_desc,
2519 width - VSCROLL_WIDTH - ibw/2,
2520 ibw/2,
2521 VSCROLL_WIDTH - 2,
2522 height - ibw - 2,
2523 1, bord_tile, back_tile);
2524
2525 s->display.x->v_scrollbar_width = VSCROLL_WIDTH;
2526
2527 s->display.x->v_thumbup = XCreateWindow (s->display.x->v_scrollbar,
2528 0, 0,
2529 VSCROLL_WIDTH - 2,
2530 VSCROLL_WIDTH - 2,
2531 0, 0, up_arrow_pixmap);
2532 XTileAbsolute (s->display.x->v_thumbup);
2533
2534 s->display.x->v_thumbdown = XCreateWindow (s->display.x->v_scrollbar,
2535 0,
2536 height - ibw - VSCROLL_WIDTH,
2537 VSCROLL_WIDTH - 2,
2538 VSCROLL_WIDTH - 2,
2539 0, 0, down_arrow_pixmap);
2540 XTileAbsolute (s->display.x->v_thumbdown);
2541
2542 s->display.x->v_slider = XCreateWindow (s->display.x->v_scrollbar,
2543 0, VSCROLL_WIDTH - 2,
2544 VSCROLL_WIDTH - 4,
2545 VSCROLL_WIDTH - 4,
2546 1, back_tile, fore_tile);
2547
2548 XSelectInput (s->display.x->v_scrollbar,
2549 (ButtonPressed | ButtonReleased | KeyPressed));
2550 XSelectInput (s->display.x->v_thumbup,
2551 (ButtonPressed | ButtonReleased | KeyPressed));
2552
2553 XSelectInput (s->display.x->v_thumbdown,
2554 (ButtonPressed | ButtonReleased | KeyPressed));
2555
2556 XMapWindow (s->display.x->v_thumbup);
2557 XMapWindow (s->display.x->v_thumbdown);
2558 XMapWindow (s->display.x->v_slider);
2559 XMapWindow (s->display.x->v_scrollbar);
2560
2561 XFreePixmap (fore_tile);
2562 XFreePixmap (back_tile);
2563 XFreePixmap (up_arrow_pixmap);
2564 XFreePixmap (down_arrow_pixmap);
2565 #endif /* not HAVE_X11 */
2566 }
2567
2568 static void
2569 install_horizontal_scrollbar (s)
2570 struct screen *s;
2571 {
2572 int ibw = s->display.x->internal_border_width;
2573 Window parent;
2574 Pixmap left_arrow_pixmap, right_arrow_pixmap, slider_pixmap;
2575 int pix_x, pix_y;
2576 int width;
2577
2578 pix_x = ibw;
2579 pix_y = PIXEL_HEIGHT (s) - HSCROLL_HEIGHT - ibw ;
2580 width = PIXEL_WIDTH (s) - 2 * ibw;
2581 if (s->display.x->v_scrollbar_width)
2582 width -= (s->display.x->v_scrollbar_width + 1);
2583
2584 #ifdef HAVE_X11
2585 left_arrow_pixmap =
2586 XCreatePixmapFromBitmapData (x_current_display, s->display.x->window_desc,
2587 left_arrow_bits, 16, 16,
2588 s->display.x->foreground_pixel,
2589 s->display.x->background_pixel,
2590 DefaultDepth (x_current_display,
2591 XDefaultScreen (x_current_display)));
2592
2593 right_arrow_pixmap =
2594 XCreatePixmapFromBitmapData (x_current_display, s->display.x->window_desc,
2595 right_arrow_bits, 16, 16,
2596 s->display.x->foreground_pixel,
2597 s->display.x->background_pixel,
2598 DefaultDepth (x_current_display,
2599 XDefaultScreen (x_current_display)));
2600
2601 slider_pixmap =
2602 XCreatePixmapFromBitmapData (x_current_display, s->display.x->window_desc,
2603 gray_bits, 16, 16,
2604 s->display.x->foreground_pixel,
2605 s->display.x->background_pixel,
2606 DefaultDepth (x_current_display,
2607 XDefaultScreen (x_current_display)));
2608
2609 left_arrow_cursor = XCreateFontCursor (x_current_display, XC_sb_left_arrow);
2610 right_arrow_cursor = XCreateFontCursor (x_current_display, XC_sb_right_arrow);
2611 h_double_arrow_cursor = XCreateFontCursor (x_current_display, XC_sb_h_double_arrow);
2612
2613 s->display.x->h_scrollbar =
2614 XCreateSimpleWindow (x_current_display, s->display.x->window_desc,
2615 pix_x, pix_y,
2616 width - ibw - 2, HSCROLL_HEIGHT - 2, 1,
2617 s->display.x->foreground_pixel,
2618 s->display.x->background_pixel);
2619 XDefineCursor (x_current_display, s->display.x->h_scrollbar,
2620 h_double_arrow_cursor);
2621
2622 s->display.x->h_slider =
2623 XCreateSimpleWindow (x_current_display, s->display.x->h_scrollbar,
2624 0, 0,
2625 HSCROLL_HEIGHT - 4, HSCROLL_HEIGHT - 4,
2626 1, s->display.x->foreground_pixel,
2627 s->display.x->background_pixel);
2628 XDefineCursor (x_current_display, s->display.x->h_slider,
2629 h_double_arrow_cursor);
2630 XSetWindowBackgroundPixmap (x_current_display, s->display.x->h_slider,
2631 slider_pixmap);
2632
2633 s->display.x->h_thumbleft =
2634 XCreateSimpleWindow (x_current_display, s->display.x->h_scrollbar,
2635 0, 0,
2636 HSCROLL_HEIGHT - 2, HSCROLL_HEIGHT - 2,
2637 0, s->display.x->foreground_pixel,
2638 s->display.x->background_pixel);
2639 XDefineCursor (x_current_display, s->display.x->h_thumbleft,
2640 left_arrow_cursor);
2641 XSetWindowBackgroundPixmap (x_current_display, s->display.x->h_thumbleft,
2642 left_arrow_pixmap);
2643
2644 s->display.x->h_thumbright =
2645 XCreateSimpleWindow (x_current_display, s->display.x->h_scrollbar,
2646 width - ibw - HSCROLL_HEIGHT, 0,
2647 HSCROLL_HEIGHT - 2, HSCROLL_HEIGHT -2,
2648 0, s->display.x->foreground_pixel,
2649 s->display.x->background_pixel);
2650 XDefineCursor (x_current_display, s->display.x->h_thumbright,
2651 right_arrow_cursor);
2652 XSetWindowBackgroundPixmap (x_current_display, s->display.x->h_thumbright,
2653 right_arrow_pixmap);
2654
2655 XFreePixmap (x_current_display, slider_pixmap);
2656 XFreePixmap (x_current_display, left_arrow_pixmap);
2657 XFreePixmap (x_current_display, right_arrow_pixmap);
2658
2659 XSelectInput (x_current_display, s->display.x->h_scrollbar,
2660 ButtonPressMask | ButtonReleaseMask
2661 | PointerMotionMask | PointerMotionHintMask
2662 | EnterWindowMask);
2663 XSelectInput (x_current_display, s->display.x->h_slider,
2664 ButtonPressMask | ButtonReleaseMask);
2665 XSelectInput (x_current_display, s->display.x->h_thumbright,
2666 ButtonPressMask | ButtonReleaseMask);
2667 XSelectInput (x_current_display, s->display.x->h_thumbleft,
2668 ButtonPressMask | ButtonReleaseMask);
2669
2670 XMapWindow (x_current_display, s->display.x->h_scrollbar);
2671 XMapSubwindows (x_current_display, s->display.x->h_scrollbar);
2672 #else /* not HAVE_X11 */
2673 Bitmap b;
2674 Pixmap fore_tile, back_tile, bord_tile;
2675 #endif
2676 }
2677 \f
2678 #ifndef HAVE_X11 /* X10 */
2679 #define XMoveResizeWindow XConfigureWindow
2680 #endif /* not HAVE_X11 */
2681
2682 /* Adjust the displayed position in the scroll bar for window W. */
2683
2684 void
2685 adjust_scrollbars (s)
2686 struct screen *s;
2687 {
2688 int pos;
2689 int first_char_in_window, char_beyond_window, chars_in_window;
2690 int chars_in_buffer, buffer_size;
2691 struct window *w = XWINDOW (SCREEN_SELECTED_WINDOW (s));
2692
2693 if (! SCREEN_IS_X (s))
2694 return;
2695
2696 if (s->display.x->v_scrollbar != 0)
2697 {
2698 int h, height;
2699 struct buffer *b = XBUFFER (w->buffer);
2700
2701 buffer_size = Z - BEG;
2702 chars_in_buffer = ZV - BEGV;
2703 first_char_in_window = marker_position (w->start);
2704 char_beyond_window = buffer_size + 1 - XFASTINT (w->window_end_pos);
2705 chars_in_window = char_beyond_window - first_char_in_window;
2706
2707 /* Calculate height of scrollbar area */
2708
2709 height = s->height * FONT_HEIGHT (s->display.x->font)
2710 + s->display.x->internal_border_width
2711 - 2 * (s->display.x->v_scrollbar_width);
2712
2713 /* Figure starting position for the scrollbar slider */
2714
2715 if (chars_in_buffer <= 0)
2716 pos = 0;
2717 else
2718 pos = ((first_char_in_window - BEGV - BEG) * height
2719 / chars_in_buffer);
2720 pos = max (0, pos);
2721 pos = min (pos, height - 2);
2722
2723 /* Figure length of the slider */
2724
2725 if (chars_in_buffer <= 0)
2726 h = height;
2727 else
2728 h = (chars_in_window * height) / chars_in_buffer;
2729 h = min (h, height - pos);
2730 h = max (h, 1);
2731
2732 /* Add thumbup offset to starting position of slider */
2733
2734 pos += (s->display.x->v_scrollbar_width - 2);
2735
2736 XMoveResizeWindow (XDISPLAY
2737 s->display.x->v_slider,
2738 0, pos,
2739 s->display.x->v_scrollbar_width - 4, h);
2740 }
2741
2742 if (s->display.x->h_scrollbar != 0)
2743 {
2744 int l, length; /* Length of the scrollbar area */
2745
2746 length = s->width * FONT_WIDTH (s->display.x->font)
2747 + s->display.x->internal_border_width
2748 - 2 * (s->display.x->h_scrollbar_height);
2749
2750 /* Starting position for horizontal slider */
2751 if (! w->hscroll)
2752 pos = 0;
2753 else
2754 pos = (w->hscroll * length) / (w->hscroll + s->width);
2755 pos = max (0, pos);
2756 pos = min (pos, length - 2);
2757
2758 /* Length of slider */
2759 l = length - pos;
2760
2761 /* Add thumbup offset */
2762 pos += (s->display.x->h_scrollbar_height - 2);
2763
2764 XMoveResizeWindow (XDISPLAY
2765 s->display.x->h_slider,
2766 pos, 0,
2767 l, s->display.x->h_scrollbar_height - 4);
2768 }
2769 }
2770 \f
2771 /* Adjust the size of the scroll bars of screen S,
2772 when the screen size has changed. */
2773
2774 void
2775 x_resize_scrollbars (s)
2776 struct screen *s;
2777 {
2778 int ibw = s->display.x->internal_border_width;
2779 int pixelwidth, pixelheight;
2780
2781 if (s == 0
2782 || s->display.x == 0
2783 || (s->display.x->v_scrollbar == 0
2784 && s->display.x->h_scrollbar == 0))
2785 return;
2786
2787 /* Get the size of the screen. */
2788 pixelwidth = (s->width * FONT_WIDTH (s->display.x->font)
2789 + 2 * ibw + s->display.x->v_scrollbar_width);
2790 pixelheight = (s->height * FONT_HEIGHT (s->display.x->font)
2791 + 2 * ibw + s->display.x->h_scrollbar_height);
2792
2793 if (s->display.x->v_scrollbar_width && s->display.x->v_scrollbar)
2794 {
2795 BLOCK_INPUT;
2796 XMoveResizeWindow (XDISPLAY
2797 s->display.x->v_scrollbar,
2798 pixelwidth - s->display.x->v_scrollbar_width - ibw/2,
2799 ibw/2,
2800 s->display.x->v_scrollbar_width - 2,
2801 pixelheight - ibw - 2);
2802 XMoveWindow (XDISPLAY
2803 s->display.x->v_thumbdown, 0,
2804 pixelheight - ibw - s->display.x->v_scrollbar_width);
2805 UNBLOCK_INPUT;
2806 }
2807
2808 if (s->display.x->h_scrollbar_height && s->display.x->h_scrollbar)
2809 {
2810 if (s->display.x->v_scrollbar_width)
2811 pixelwidth -= s->display.x->v_scrollbar_width + 1;
2812
2813 BLOCK_INPUT;
2814 XMoveResizeWindow (XDISPLAY
2815 s->display.x->h_scrollbar,
2816 ibw / 2,
2817 pixelheight - s->display.x->h_scrollbar_height - ibw / 2,
2818 pixelwidth - ibw - 2,
2819 s->display.x->h_scrollbar_height - 2);
2820 XMoveWindow (XDISPLAY
2821 s->display.x->h_thumbright,
2822 pixelwidth - ibw - s->display.x->h_scrollbar_height, 0);
2823 UNBLOCK_INPUT;
2824 }
2825 }
2826
2827 x_pixel_width (s)
2828 register struct screen *s;
2829 {
2830 return PIXEL_WIDTH (s);
2831 }
2832
2833 x_pixel_height (s)
2834 register struct screen *s;
2835 {
2836 return PIXEL_HEIGHT (s);
2837 }
2838 \f
2839 DEFUN ("x-defined-color", Fx_defined_color, Sx_defined_color, 1, 1, 0,
2840 "Return t if the current X display supports the color named COLOR.")
2841 (color)
2842 Lisp_Object color;
2843 {
2844 Color foo;
2845
2846 CHECK_STRING (color, 0);
2847
2848 if (defined_color (XSTRING (color)->data, &foo))
2849 return Qt;
2850 else
2851 return Qnil;
2852 }
2853
2854 DEFUN ("x-color-display-p", Fx_color_display_p, Sx_color_display_p, 0, 0, 0,
2855 "Return t if the X display used currently supports color.")
2856 ()
2857 {
2858 if (XINT (x_screen_planes) <= 2)
2859 return Qnil;
2860
2861 switch (screen_visual->class)
2862 {
2863 case StaticColor:
2864 case PseudoColor:
2865 case TrueColor:
2866 case DirectColor:
2867 return Qt;
2868
2869 default:
2870 return Qnil;
2871 }
2872 }
2873
2874 DEFUN ("x-pixel-width", Fx_pixel_width, Sx_pixel_width, 1, 1, 0,
2875 "Return the width in pixels of screen S.")
2876 (screen)
2877 Lisp_Object screen;
2878 {
2879 CHECK_LIVE_SCREEN (screen, 0);
2880 return make_number (XSCREEN (screen)->display.x->pixel_width);
2881 }
2882
2883 DEFUN ("x-pixel-height", Fx_pixel_height, Sx_pixel_height, 1, 1, 0,
2884 "Return the height in pixels of screen S.")
2885 (screen)
2886 Lisp_Object screen;
2887 {
2888 CHECK_LIVE_SCREEN (screen, 0);
2889 return make_number (XSCREEN (screen)->display.x->pixel_height);
2890 }
2891 \f
2892 #if 0 /* These no longer seem like the right way to do things. */
2893
2894 /* Draw a rectangle on the screen with left top corner including
2895 the character specified by LEFT_CHAR and TOP_CHAR. The rectangle is
2896 CHARS by LINES wide and long and is the color of the cursor. */
2897
2898 void
2899 x_rectangle (s, gc, left_char, top_char, chars, lines)
2900 register struct screen *s;
2901 GC gc;
2902 register int top_char, left_char, chars, lines;
2903 {
2904 int width;
2905 int height;
2906 int left = (left_char * FONT_WIDTH (s->display.x->font)
2907 + s->display.x->internal_border_width);
2908 int top = (top_char * FONT_HEIGHT (s->display.x->font)
2909 + s->display.x->internal_border_width);
2910
2911 if (chars < 0)
2912 width = FONT_WIDTH (s->display.x->font) / 2;
2913 else
2914 width = FONT_WIDTH (s->display.x->font) * chars;
2915 if (lines < 0)
2916 height = FONT_HEIGHT (s->display.x->font) / 2;
2917 else
2918 height = FONT_HEIGHT (s->display.x->font) * lines;
2919
2920 XDrawRectangle (x_current_display, s->display.x->window_desc,
2921 gc, left, top, width, height);
2922 }
2923
2924 DEFUN ("x-draw-rectangle", Fx_draw_rectangle, Sx_draw_rectangle, 5, 5, 0,
2925 "Draw a rectangle on SCREEN between coordinates specified by\n\
2926 numbers X0, Y0, X1, Y1 in the cursor pixel.")
2927 (screen, X0, Y0, X1, Y1)
2928 register Lisp_Object screen, X0, X1, Y0, Y1;
2929 {
2930 register int x0, y0, x1, y1, top, left, n_chars, n_lines;
2931
2932 CHECK_LIVE_SCREEN (screen, 0);
2933 CHECK_NUMBER (X0, 0);
2934 CHECK_NUMBER (Y0, 1);
2935 CHECK_NUMBER (X1, 2);
2936 CHECK_NUMBER (Y1, 3);
2937
2938 x0 = XINT (X0);
2939 x1 = XINT (X1);
2940 y0 = XINT (Y0);
2941 y1 = XINT (Y1);
2942
2943 if (y1 > y0)
2944 {
2945 top = y0;
2946 n_lines = y1 - y0 + 1;
2947 }
2948 else
2949 {
2950 top = y1;
2951 n_lines = y0 - y1 + 1;
2952 }
2953
2954 if (x1 > x0)
2955 {
2956 left = x0;
2957 n_chars = x1 - x0 + 1;
2958 }
2959 else
2960 {
2961 left = x1;
2962 n_chars = x0 - x1 + 1;
2963 }
2964
2965 BLOCK_INPUT;
2966 x_rectangle (XSCREEN (screen), XSCREEN (screen)->display.x->cursor_gc,
2967 left, top, n_chars, n_lines);
2968 UNBLOCK_INPUT;
2969
2970 return Qt;
2971 }
2972
2973 DEFUN ("x-erase-rectangle", Fx_erase_rectangle, Sx_erase_rectangle, 5, 5, 0,
2974 "Draw a rectangle drawn on SCREEN between coordinates\n\
2975 X0, Y0, X1, Y1 in the regular background-pixel.")
2976 (screen, X0, Y0, X1, Y1)
2977 register Lisp_Object screen, X0, Y0, X1, Y1;
2978 {
2979 register int x0, y0, x1, y1, top, left, n_chars, n_lines;
2980
2981 CHECK_SCREEN (screen, 0);
2982 CHECK_NUMBER (X0, 0);
2983 CHECK_NUMBER (Y0, 1);
2984 CHECK_NUMBER (X1, 2);
2985 CHECK_NUMBER (Y1, 3);
2986
2987 x0 = XINT (X0);
2988 x1 = XINT (X1);
2989 y0 = XINT (Y0);
2990 y1 = XINT (Y1);
2991
2992 if (y1 > y0)
2993 {
2994 top = y0;
2995 n_lines = y1 - y0 + 1;
2996 }
2997 else
2998 {
2999 top = y1;
3000 n_lines = y0 - y1 + 1;
3001 }
3002
3003 if (x1 > x0)
3004 {
3005 left = x0;
3006 n_chars = x1 - x0 + 1;
3007 }
3008 else
3009 {
3010 left = x1;
3011 n_chars = x0 - x1 + 1;
3012 }
3013
3014 BLOCK_INPUT;
3015 x_rectangle (XSCREEN (screen), XSCREEN (screen)->display.x->reverse_gc,
3016 left, top, n_chars, n_lines);
3017 UNBLOCK_INPUT;
3018
3019 return Qt;
3020 }
3021
3022 /* Draw lines around the text region beginning at the character position
3023 TOP_X, TOP_Y and ending at BOTTOM_X and BOTTOM_Y. GC specifies the
3024 pixel and line characteristics. */
3025
3026 #define line_len(line) (SCREEN_CURRENT_GLYPHS (s)->used[(line)])
3027
3028 static void
3029 outline_region (s, gc, top_x, top_y, bottom_x, bottom_y)
3030 register struct screen *s;
3031 GC gc;
3032 int top_x, top_y, bottom_x, bottom_y;
3033 {
3034 register int ibw = s->display.x->internal_border_width;
3035 register int font_w = FONT_WIDTH (s->display.x->font);
3036 register int font_h = FONT_HEIGHT (s->display.x->font);
3037 int y = top_y;
3038 int x = line_len (y);
3039 XPoint *pixel_points = (XPoint *)
3040 alloca (((bottom_y - top_y + 2) * 4) * sizeof (XPoint));
3041 register XPoint *this_point = pixel_points;
3042
3043 /* Do the horizontal top line/lines */
3044 if (top_x == 0)
3045 {
3046 this_point->x = ibw;
3047 this_point->y = ibw + (font_h * top_y);
3048 this_point++;
3049 if (x == 0)
3050 this_point->x = ibw + (font_w / 2); /* Half-size for newline chars. */
3051 else
3052 this_point->x = ibw + (font_w * x);
3053 this_point->y = (this_point - 1)->y;
3054 }
3055 else
3056 {
3057 this_point->x = ibw;
3058 this_point->y = ibw + (font_h * (top_y + 1));
3059 this_point++;
3060 this_point->x = ibw + (font_w * top_x);
3061 this_point->y = (this_point - 1)->y;
3062 this_point++;
3063 this_point->x = (this_point - 1)->x;
3064 this_point->y = ibw + (font_h * top_y);
3065 this_point++;
3066 this_point->x = ibw + (font_w * x);
3067 this_point->y = (this_point - 1)->y;
3068 }
3069
3070 /* Now do the right side. */
3071 while (y < bottom_y)
3072 { /* Right vertical edge */
3073 this_point++;
3074 this_point->x = (this_point - 1)->x;
3075 this_point->y = ibw + (font_h * (y + 1));
3076 this_point++;
3077
3078 y++; /* Horizontal connection to next line */
3079 x = line_len (y);
3080 if (x == 0)
3081 this_point->x = ibw + (font_w / 2);
3082 else
3083 this_point->x = ibw + (font_w * x);
3084
3085 this_point->y = (this_point - 1)->y;
3086 }
3087
3088 /* Now do the bottom and connect to the top left point. */
3089 this_point->x = ibw + (font_w * (bottom_x + 1));
3090
3091 this_point++;
3092 this_point->x = (this_point - 1)->x;
3093 this_point->y = ibw + (font_h * (bottom_y + 1));
3094 this_point++;
3095 this_point->x = ibw;
3096 this_point->y = (this_point - 1)->y;
3097 this_point++;
3098 this_point->x = pixel_points->x;
3099 this_point->y = pixel_points->y;
3100
3101 XDrawLines (x_current_display, s->display.x->window_desc,
3102 gc, pixel_points,
3103 (this_point - pixel_points + 1), CoordModeOrigin);
3104 }
3105
3106 DEFUN ("x-contour-region", Fx_contour_region, Sx_contour_region, 1, 1, 0,
3107 "Highlight the region between point and the character under the mouse\n\
3108 selected screen.")
3109 (event)
3110 register Lisp_Object event;
3111 {
3112 register int x0, y0, x1, y1;
3113 register struct screen *s = selected_screen;
3114 register int p1, p2;
3115
3116 CHECK_CONS (event, 0);
3117
3118 BLOCK_INPUT;
3119 x0 = XINT (Fcar (Fcar (event)));
3120 y0 = XINT (Fcar (Fcdr (Fcar (event))));
3121
3122 /* If the mouse is past the end of the line, don't that area. */
3123 /* ReWrite this... */
3124
3125 x1 = s->cursor_x;
3126 y1 = s->cursor_y;
3127
3128 if (y1 > y0) /* point below mouse */
3129 outline_region (s, s->display.x->cursor_gc,
3130 x0, y0, x1, y1);
3131 else if (y1 < y0) /* point above mouse */
3132 outline_region (s, s->display.x->cursor_gc,
3133 x1, y1, x0, y0);
3134 else /* same line: draw horizontal rectangle */
3135 {
3136 if (x1 > x0)
3137 x_rectangle (s, s->display.x->cursor_gc,
3138 x0, y0, (x1 - x0 + 1), 1);
3139 else if (x1 < x0)
3140 x_rectangle (s, s->display.x->cursor_gc,
3141 x1, y1, (x0 - x1 + 1), 1);
3142 }
3143
3144 XFlush (x_current_display);
3145 UNBLOCK_INPUT;
3146
3147 return Qnil;
3148 }
3149
3150 DEFUN ("x-uncontour-region", Fx_uncontour_region, Sx_uncontour_region, 1, 1, 0,
3151 "Erase any highlighting of the region between point and the character\n\
3152 at X, Y on the selected screen.")
3153 (event)
3154 register Lisp_Object event;
3155 {
3156 register int x0, y0, x1, y1;
3157 register struct screen *s = selected_screen;
3158
3159 BLOCK_INPUT;
3160 x0 = XINT (Fcar (Fcar (event)));
3161 y0 = XINT (Fcar (Fcdr (Fcar (event))));
3162 x1 = s->cursor_x;
3163 y1 = s->cursor_y;
3164
3165 if (y1 > y0) /* point below mouse */
3166 outline_region (s, s->display.x->reverse_gc,
3167 x0, y0, x1, y1);
3168 else if (y1 < y0) /* point above mouse */
3169 outline_region (s, s->display.x->reverse_gc,
3170 x1, y1, x0, y0);
3171 else /* same line: draw horizontal rectangle */
3172 {
3173 if (x1 > x0)
3174 x_rectangle (s, s->display.x->reverse_gc,
3175 x0, y0, (x1 - x0 + 1), 1);
3176 else if (x1 < x0)
3177 x_rectangle (s, s->display.x->reverse_gc,
3178 x1, y1, (x0 - x1 + 1), 1);
3179 }
3180 UNBLOCK_INPUT;
3181
3182 return Qnil;
3183 }
3184
3185 #if 0
3186 int contour_begin_x, contour_begin_y;
3187 int contour_end_x, contour_end_y;
3188 int contour_npoints;
3189
3190 /* Clip the top part of the contour lines down (and including) line Y_POS.
3191 If X_POS is in the middle (rather than at the end) of the line, drop
3192 down a line at that character. */
3193
3194 static void
3195 clip_contour_top (y_pos, x_pos)
3196 {
3197 register XPoint *begin = contour_lines[y_pos].top_left;
3198 register XPoint *end;
3199 register int npoints;
3200 register struct display_line *line = selected_screen->phys_lines[y_pos + 1];
3201
3202 if (x_pos >= line->len - 1) /* Draw one, straight horizontal line. */
3203 {
3204 end = contour_lines[y_pos].top_right;
3205 npoints = (end - begin + 1);
3206 XDrawLines (x_current_display, contour_window,
3207 contour_erase_gc, begin_erase, npoints, CoordModeOrigin);
3208
3209 bcopy (end, begin + 1, contour_last_point - end + 1);
3210 contour_last_point -= (npoints - 2);
3211 XDrawLines (x_current_display, contour_window,
3212 contour_erase_gc, begin, 2, CoordModeOrigin);
3213 XFlush (x_current_display);
3214
3215 /* Now, update contour_lines structure. */
3216 }
3217 /* ______. */
3218 else /* |________*/
3219 {
3220 register XPoint *p = begin + 1;
3221 end = contour_lines[y_pos].bottom_right;
3222 npoints = (end - begin + 1);
3223 XDrawLines (x_current_display, contour_window,
3224 contour_erase_gc, begin_erase, npoints, CoordModeOrigin);
3225
3226 p->y = begin->y;
3227 p->x = ibw + (font_w * (x_pos + 1));
3228 p++;
3229 p->y = begin->y + font_h;
3230 p->x = (p - 1)->x;
3231 bcopy (end, begin + 3, contour_last_point - end + 1);
3232 contour_last_point -= (npoints - 5);
3233 XDrawLines (x_current_display, contour_window,
3234 contour_erase_gc, begin, 4, CoordModeOrigin);
3235 XFlush (x_current_display);
3236
3237 /* Now, update contour_lines structure. */
3238 }
3239 }
3240
3241 /* Erase the top horzontal lines of the contour, and then extend
3242 the contour upwards. */
3243
3244 static void
3245 extend_contour_top (line)
3246 {
3247 }
3248
3249 static void
3250 clip_contour_bottom (x_pos, y_pos)
3251 int x_pos, y_pos;
3252 {
3253 }
3254
3255 static void
3256 extend_contour_bottom (x_pos, y_pos)
3257 {
3258 }
3259
3260 DEFUN ("x-select-region", Fx_select_region, Sx_select_region, 1, 1, "e",
3261 "")
3262 (event)
3263 Lisp_Object event;
3264 {
3265 register struct screen *s = selected_screen;
3266 register int point_x = s->cursor_x;
3267 register int point_y = s->cursor_y;
3268 register int mouse_below_point;
3269 register Lisp_Object obj;
3270 register int x_contour_x, x_contour_y;
3271
3272 x_contour_x = x_mouse_x;
3273 x_contour_y = x_mouse_y;
3274 if (x_contour_y > point_y || (x_contour_y == point_y
3275 && x_contour_x > point_x))
3276 {
3277 mouse_below_point = 1;
3278 outline_region (s, s->display.x->cursor_gc, point_x, point_y,
3279 x_contour_x, x_contour_y);
3280 }
3281 else
3282 {
3283 mouse_below_point = 0;
3284 outline_region (s, s->display.x->cursor_gc, x_contour_x, x_contour_y,
3285 point_x, point_y);
3286 }
3287
3288 while (1)
3289 {
3290 obj = read_char (-1);
3291 if (XTYPE (obj) != Lisp_Cons)
3292 break;
3293
3294 if (mouse_below_point)
3295 {
3296 if (x_mouse_y <= point_y) /* Flipped. */
3297 {
3298 mouse_below_point = 0;
3299
3300 outline_region (s, s->display.x->reverse_gc, point_x, point_y,
3301 x_contour_x, x_contour_y);
3302 outline_region (s, s->display.x->cursor_gc, x_mouse_x, x_mouse_y,
3303 point_x, point_y);
3304 }
3305 else if (x_mouse_y < x_contour_y) /* Bottom clipped. */
3306 {
3307 clip_contour_bottom (x_mouse_y);
3308 }
3309 else if (x_mouse_y > x_contour_y) /* Bottom extended. */
3310 {
3311 extend_bottom_contour (x_mouse_y);
3312 }
3313
3314 x_contour_x = x_mouse_x;
3315 x_contour_y = x_mouse_y;
3316 }
3317 else /* mouse above or same line as point */
3318 {
3319 if (x_mouse_y >= point_y) /* Flipped. */
3320 {
3321 mouse_below_point = 1;
3322
3323 outline_region (s, s->display.x->reverse_gc,
3324 x_contour_x, x_contour_y, point_x, point_y);
3325 outline_region (s, s->display.x->cursor_gc, point_x, point_y,
3326 x_mouse_x, x_mouse_y);
3327 }
3328 else if (x_mouse_y > x_contour_y) /* Top clipped. */
3329 {
3330 clip_contour_top (x_mouse_y);
3331 }
3332 else if (x_mouse_y < x_contour_y) /* Top extended. */
3333 {
3334 extend_contour_top (x_mouse_y);
3335 }
3336 }
3337 }
3338
3339 unread_command_char = obj;
3340 if (mouse_below_point)
3341 {
3342 contour_begin_x = point_x;
3343 contour_begin_y = point_y;
3344 contour_end_x = x_contour_x;
3345 contour_end_y = x_contour_y;
3346 }
3347 else
3348 {
3349 contour_begin_x = x_contour_x;
3350 contour_begin_y = x_contour_y;
3351 contour_end_x = point_x;
3352 contour_end_y = point_y;
3353 }
3354 }
3355 #endif
3356
3357 DEFUN ("x-horizontal-line", Fx_horizontal_line, Sx_horizontal_line, 1, 1, "e",
3358 "")
3359 (event)
3360 Lisp_Object event;
3361 {
3362 register Lisp_Object obj;
3363 struct screen *s = selected_screen;
3364 register struct window *w = XWINDOW (selected_window);
3365 register GC line_gc = s->display.x->cursor_gc;
3366 register GC erase_gc = s->display.x->reverse_gc;
3367 #if 0
3368 char dash_list[] = {6, 4, 6, 4};
3369 int dashes = 4;
3370 XGCValues gc_values;
3371 #endif
3372 register int previous_y;
3373 register int line = (x_mouse_y + 1) * FONT_HEIGHT (s->display.x->font)
3374 + s->display.x->internal_border_width;
3375 register int left = s->display.x->internal_border_width
3376 + (w->left
3377 * FONT_WIDTH (s->display.x->font));
3378 register int right = left + (w->width
3379 * FONT_WIDTH (s->display.x->font))
3380 - s->display.x->internal_border_width;
3381
3382 #if 0
3383 BLOCK_INPUT;
3384 gc_values.foreground = s->display.x->cursor_pixel;
3385 gc_values.background = s->display.x->background_pixel;
3386 gc_values.line_width = 1;
3387 gc_values.line_style = LineOnOffDash;
3388 gc_values.cap_style = CapRound;
3389 gc_values.join_style = JoinRound;
3390
3391 line_gc = XCreateGC (x_current_display, s->display.x->window_desc,
3392 GCLineStyle | GCJoinStyle | GCCapStyle
3393 | GCLineWidth | GCForeground | GCBackground,
3394 &gc_values);
3395 XSetDashes (x_current_display, line_gc, 0, dash_list, dashes);
3396 gc_values.foreground = s->display.x->background_pixel;
3397 gc_values.background = s->display.x->foreground_pixel;
3398 erase_gc = XCreateGC (x_current_display, s->display.x->window_desc,
3399 GCLineStyle | GCJoinStyle | GCCapStyle
3400 | GCLineWidth | GCForeground | GCBackground,
3401 &gc_values);
3402 XSetDashes (x_current_display, erase_gc, 0, dash_list, dashes);
3403 #endif
3404
3405 while (1)
3406 {
3407 BLOCK_INPUT;
3408 if (x_mouse_y >= XINT (w->top)
3409 && x_mouse_y < XINT (w->top) + XINT (w->height) - 1)
3410 {
3411 previous_y = x_mouse_y;
3412 line = (x_mouse_y + 1) * FONT_HEIGHT (s->display.x->font)
3413 + s->display.x->internal_border_width;
3414 XDrawLine (x_current_display, s->display.x->window_desc,
3415 line_gc, left, line, right, line);
3416 }
3417 XFlushQueue ();
3418 UNBLOCK_INPUT;
3419
3420 do
3421 {
3422 obj = read_char (-1);
3423 if ((XTYPE (obj) != Lisp_Cons)
3424 || (! EQ (Fcar (Fcdr (Fcdr (obj))),
3425 intern ("vertical-scroll-bar")))
3426 || x_mouse_grabbed)
3427 {
3428 BLOCK_INPUT;
3429 XDrawLine (x_current_display, s->display.x->window_desc,
3430 erase_gc, left, line, right, line);
3431 UNBLOCK_INPUT;
3432 unread_command_char = obj;
3433 #if 0
3434 XFreeGC (x_current_display, line_gc);
3435 XFreeGC (x_current_display, erase_gc);
3436 #endif
3437 return Qnil;
3438 }
3439 }
3440 while (x_mouse_y == previous_y);
3441
3442 BLOCK_INPUT;
3443 XDrawLine (x_current_display, s->display.x->window_desc,
3444 erase_gc, left, line, right, line);
3445 UNBLOCK_INPUT;
3446 }
3447 }
3448 #endif
3449 \f
3450 /* Offset in buffer of character under the pointer, or 0. */
3451 int mouse_buffer_offset;
3452
3453 #if 0
3454 /* These keep track of the rectangle following the pointer. */
3455 int mouse_track_top, mouse_track_left, mouse_track_width;
3456
3457 DEFUN ("x-track-pointer", Fx_track_pointer, Sx_track_pointer, 0, 0, 0,
3458 "Track the pointer.")
3459 ()
3460 {
3461 static Cursor current_pointer_shape;
3462 SCREEN_PTR s = x_mouse_screen;
3463
3464 BLOCK_INPUT;
3465 if (EQ (Vmouse_screen_part, Qtext_part)
3466 && (current_pointer_shape != s->display.x->nontext_cursor))
3467 {
3468 unsigned char c;
3469 struct buffer *buf;
3470
3471 current_pointer_shape = s->display.x->nontext_cursor;
3472 XDefineCursor (x_current_display,
3473 s->display.x->window_desc,
3474 current_pointer_shape);
3475
3476 buf = XBUFFER (XWINDOW (Vmouse_window)->buffer);
3477 c = *(BUF_CHAR_ADDRESS (buf, mouse_buffer_offset));
3478 }
3479 else if (EQ (Vmouse_screen_part, Qmodeline_part)
3480 && (current_pointer_shape != s->display.x->modeline_cursor))
3481 {
3482 current_pointer_shape = s->display.x->modeline_cursor;
3483 XDefineCursor (x_current_display,
3484 s->display.x->window_desc,
3485 current_pointer_shape);
3486 }
3487
3488 XFlushQueue ();
3489 UNBLOCK_INPUT;
3490 }
3491 #endif
3492
3493 #if 0
3494 DEFUN ("x-track-pointer", Fx_track_pointer, Sx_track_pointer, 1, 1, "e",
3495 "Draw rectangle around character under mouse pointer, if there is one.")
3496 (event)
3497 Lisp_Object event;
3498 {
3499 struct window *w = XWINDOW (Vmouse_window);
3500 struct screen *s = XSCREEN (WINDOW_SCREEN (w));
3501 struct buffer *b = XBUFFER (w->buffer);
3502 Lisp_Object obj;
3503
3504 if (! EQ (Vmouse_window, selected_window))
3505 return Qnil;
3506
3507 if (EQ (event, Qnil))
3508 {
3509 int x, y;
3510
3511 x_read_mouse_position (selected_screen, &x, &y);
3512 }
3513
3514 BLOCK_INPUT;
3515 mouse_track_width = 0;
3516 mouse_track_left = mouse_track_top = -1;
3517
3518 do
3519 {
3520 if ((x_mouse_x != mouse_track_left
3521 && (x_mouse_x < mouse_track_left
3522 || x_mouse_x > (mouse_track_left + mouse_track_width)))
3523 || x_mouse_y != mouse_track_top)
3524 {
3525 int hp = 0; /* Horizontal position */
3526 int len = SCREEN_CURRENT_GLYPHS (s)->used[x_mouse_y];
3527 int p = SCREEN_CURRENT_GLYPHS (s)->bufp[x_mouse_y];
3528 int tab_width = XINT (b->tab_width);
3529 int ctl_arrow_p = !NILP (b->ctl_arrow);
3530 unsigned char c;
3531 int mode_line_vpos = XFASTINT (w->height) + XFASTINT (w->top) - 1;
3532 int in_mode_line = 0;
3533
3534 if (! SCREEN_CURRENT_GLYPHS (s)->enable[x_mouse_y])
3535 break;
3536
3537 /* Erase previous rectangle. */
3538 if (mouse_track_width)
3539 {
3540 x_rectangle (s, s->display.x->reverse_gc,
3541 mouse_track_left, mouse_track_top,
3542 mouse_track_width, 1);
3543
3544 if ((mouse_track_left == s->phys_cursor_x
3545 || mouse_track_left == s->phys_cursor_x - 1)
3546 && mouse_track_top == s->phys_cursor_y)
3547 {
3548 x_display_cursor (s, 1);
3549 }
3550 }
3551
3552 mouse_track_left = x_mouse_x;
3553 mouse_track_top = x_mouse_y;
3554 mouse_track_width = 0;
3555
3556 if (mouse_track_left > len) /* Past the end of line. */
3557 goto draw_or_not;
3558
3559 if (mouse_track_top == mode_line_vpos)
3560 {
3561 in_mode_line = 1;
3562 goto draw_or_not;
3563 }
3564
3565 if (tab_width <= 0 || tab_width > 20) tab_width = 8;
3566 do
3567 {
3568 c = FETCH_CHAR (p);
3569 if (len == s->width && hp == len - 1 && c != '\n')
3570 goto draw_or_not;
3571
3572 switch (c)
3573 {
3574 case '\t':
3575 mouse_track_width = tab_width - (hp % tab_width);
3576 p++;
3577 hp += mouse_track_width;
3578 if (hp > x_mouse_x)
3579 {
3580 mouse_track_left = hp - mouse_track_width;
3581 goto draw_or_not;
3582 }
3583 continue;
3584
3585 case '\n':
3586 mouse_track_width = -1;
3587 goto draw_or_not;
3588
3589 default:
3590 if (ctl_arrow_p && (c < 040 || c == 0177))
3591 {
3592 if (p > ZV)
3593 goto draw_or_not;
3594
3595 mouse_track_width = 2;
3596 p++;
3597 hp +=2;
3598 if (hp > x_mouse_x)
3599 {
3600 mouse_track_left = hp - mouse_track_width;
3601 goto draw_or_not;
3602 }
3603 }
3604 else
3605 {
3606 mouse_track_width = 1;
3607 p++;
3608 hp++;
3609 }
3610 continue;
3611 }
3612 }
3613 while (hp <= x_mouse_x);
3614
3615 draw_or_not:
3616 if (mouse_track_width) /* Over text; use text pointer shape. */
3617 {
3618 XDefineCursor (x_current_display,
3619 s->display.x->window_desc,
3620 s->display.x->text_cursor);
3621 x_rectangle (s, s->display.x->cursor_gc,
3622 mouse_track_left, mouse_track_top,
3623 mouse_track_width, 1);
3624 }
3625 else if (in_mode_line)
3626 XDefineCursor (x_current_display,
3627 s->display.x->window_desc,
3628 s->display.x->modeline_cursor);
3629 else
3630 XDefineCursor (x_current_display,
3631 s->display.x->window_desc,
3632 s->display.x->nontext_cursor);
3633 }
3634
3635 XFlush (x_current_display);
3636 UNBLOCK_INPUT;
3637
3638 obj = read_char (-1);
3639 BLOCK_INPUT;
3640 }
3641 while (XTYPE (obj) == Lisp_Cons /* Mouse event */
3642 && EQ (Fcar (Fcdr (Fcdr (obj))), Qnil) /* Not scrollbar */
3643 && EQ (Vmouse_depressed, Qnil) /* Only motion events */
3644 && EQ (Vmouse_window, selected_window) /* In this window */
3645 && x_mouse_screen);
3646
3647 unread_command_char = obj;
3648
3649 if (mouse_track_width)
3650 {
3651 x_rectangle (s, s->display.x->reverse_gc,
3652 mouse_track_left, mouse_track_top,
3653 mouse_track_width, 1);
3654 mouse_track_width = 0;
3655 if ((mouse_track_left == s->phys_cursor_x
3656 || mouse_track_left - 1 == s->phys_cursor_x)
3657 && mouse_track_top == s->phys_cursor_y)
3658 {
3659 x_display_cursor (s, 1);
3660 }
3661 }
3662 XDefineCursor (x_current_display,
3663 s->display.x->window_desc,
3664 s->display.x->nontext_cursor);
3665 XFlush (x_current_display);
3666 UNBLOCK_INPUT;
3667
3668 return Qnil;
3669 }
3670 #endif
3671 \f
3672 #if 0
3673 #include "glyphs.h"
3674
3675 /* Draw a pixmap specified by IMAGE_DATA of dimensions WIDTH and HEIGHT
3676 on the screen S at position X, Y. */
3677
3678 x_draw_pixmap (s, x, y, image_data, width, height)
3679 struct screen *s;
3680 int x, y, width, height;
3681 char *image_data;
3682 {
3683 Pixmap image;
3684
3685 image = XCreateBitmapFromData (x_current_display,
3686 s->display.x->window_desc, image_data,
3687 width, height);
3688 XCopyPlane (x_current_display, image, s->display.x->window_desc,
3689 s->display.x->normal_gc, 0, 0, width, height, x, y);
3690 }
3691 #endif
3692 \f
3693 #if 0
3694
3695 #ifdef HAVE_X11
3696 #define XMouseEvent XEvent
3697 #define WhichMouseButton xbutton.button
3698 #define MouseWindow xbutton.window
3699 #define MouseX xbutton.x
3700 #define MouseY xbutton.y
3701 #define MouseTime xbutton.time
3702 #define ButtonReleased ButtonRelease
3703 #define ButtonPressed ButtonPress
3704 #else
3705 #define XMouseEvent XButtonEvent
3706 #define WhichMouseButton detail
3707 #define MouseWindow window
3708 #define MouseX x
3709 #define MouseY y
3710 #define MouseTime time
3711 #endif /* X11 */
3712
3713 DEFUN ("x-mouse-events", Fx_mouse_events, Sx_mouse_events, 0, 0, 0,
3714 "Return number of pending mouse events from X window system.")
3715 ()
3716 {
3717 return make_number (queue_event_count (&x_mouse_queue));
3718 }
3719
3720 /* Encode the mouse button events in the form expected by the
3721 mouse code in Lisp. For X11, this means moving the masks around. */
3722
3723 static int
3724 encode_mouse_button (mouse_event)
3725 XMouseEvent mouse_event;
3726 {
3727 register int event_code;
3728 register char key_mask;
3729
3730 event_code = mouse_event.detail & 3;
3731 key_mask = (mouse_event.detail >> 8) & 0xf0;
3732 event_code |= key_mask >> 1;
3733 if (mouse_event.type == ButtonReleased) event_code |= 0x04;
3734 return event_code;
3735 }
3736
3737 DEFUN ("x-get-mouse-event", Fx_get_mouse_event, Sx_get_mouse_event,
3738 0, 1, 0,
3739 "Get next mouse event out of mouse event buffer.\n\
3740 Optional ARG non-nil means return nil immediately if no pending event;\n\
3741 otherwise, wait for an event. Returns a four-part list:\n\
3742 ((X-POS Y-POS) WINDOW SCREEN-PART KEYSEQ TIMESTAMP).\n\
3743 Normally X-POS and Y-POS are the position of the click on the screen\n\
3744 (measured in characters and lines), and WINDOW is the window clicked in.\n\
3745 KEYSEQ is a string, the key sequence to be looked up in the mouse maps.\n\
3746 If SCREEN-PART is non-nil, the event was on a scrollbar;\n\
3747 then Y-POS is really the total length of the scrollbar, while X-POS is\n\
3748 the relative position of the scrollbar's value within that total length,\n\
3749 and a third element OFFSET appears in that list: the height of the thumb-up\n\
3750 area at the top of the scroll bar.\n\
3751 SCREEN-PART is one of the following symbols:\n\
3752 `vertical-scrollbar', `vertical-thumbup', `vertical-thumbdown',\n\
3753 `horizontal-scrollbar', `horizontal-thumbleft', `horizontal-thumbright'.\n\
3754 TIMESTAMP is the lower 23 bits of the X-server's timestamp for\n\
3755 the mouse event.")
3756 (arg)
3757 Lisp_Object arg;
3758 {
3759 XMouseEvent xrep;
3760 register int com_letter;
3761 register Lisp_Object tempx;
3762 register Lisp_Object tempy;
3763 Lisp_Object part, pos, timestamp;
3764 int prefix;
3765 struct screen *s;
3766
3767 int tem;
3768
3769 while (1)
3770 {
3771 BLOCK_INPUT;
3772 tem = dequeue_event (&xrep, &x_mouse_queue);
3773 UNBLOCK_INPUT;
3774
3775 if (tem)
3776 {
3777 switch (xrep.type)
3778 {
3779 case ButtonPressed:
3780 case ButtonReleased:
3781
3782 com_letter = encode_mouse_button (xrep);
3783 mouse_timestamp = xrep.MouseTime;
3784
3785 if ((s = x_window_to_screen (xrep.MouseWindow)) != 0)
3786 {
3787 Lisp_Object screen;
3788
3789 if (s->display.x->icon_desc == xrep.MouseWindow)
3790 {
3791 x_make_screen_visible (s);
3792 continue;
3793 }
3794
3795 XSET (tempx, Lisp_Int,
3796 min (s->width-1, max (0, (xrep.MouseX - s->display.x->internal_border_width)/FONT_WIDTH (s->display.x->font))));
3797 XSET (tempy, Lisp_Int,
3798 min (s->height-1, max (0, (xrep.MouseY - s->display.x->internal_border_width)/FONT_HEIGHT (s->display.x->font))));
3799 XSET (timestamp, Lisp_Int, (xrep.MouseTime & 0x7fffff));
3800 XSET (screen, Lisp_Screen, s);
3801
3802 pos = Fcons (tempx, Fcons (tempy, Qnil));
3803 Vmouse_window
3804 = Flocate_window_from_coordinates (screen, pos);
3805
3806 Vmouse_event
3807 = Fcons (pos,
3808 Fcons (Vmouse_window,
3809 Fcons (Qnil,
3810 Fcons (Fchar_to_string (make_number (com_letter)),
3811 Fcons (timestamp, Qnil)))));
3812 return Vmouse_event;
3813 }
3814 else if ((s = x_window_to_scrollbar (xrep.MouseWindow, &part, &prefix)) != 0)
3815 {
3816 int pos, len;
3817 Lisp_Object keyseq;
3818 char *partname;
3819
3820 keyseq = concat2 (Fchar_to_string (make_number (prefix)),
3821 Fchar_to_string (make_number (com_letter)));
3822
3823 pos = xrep.MouseY - (s->display.x->v_scrollbar_width - 2);
3824 XSET (tempx, Lisp_Int, pos);
3825 len = ((FONT_HEIGHT (s->display.x->font) * s->height)
3826 + s->display.x->internal_border_width
3827 - (2 * (s->display.x->v_scrollbar_width - 2)));
3828 XSET (tempy, Lisp_Int, len);
3829 XSET (timestamp, Lisp_Int, (xrep.MouseTime & 0x7fffff));
3830 Vmouse_window = s->selected_window;
3831 Vmouse_event
3832 = Fcons (Fcons (tempx, Fcons (tempy,
3833 Fcons (make_number (s->display.x->v_scrollbar_width - 2),
3834 Qnil))),
3835 Fcons (Vmouse_window,
3836 Fcons (intern (part),
3837 Fcons (keyseq, Fcons (timestamp,
3838 Qnil)))));
3839 return Vmouse_event;
3840 }
3841 else
3842 continue;
3843
3844 #ifdef HAVE_X11
3845 case MotionNotify:
3846
3847 com_letter = x11_encode_mouse_button (xrep);
3848 if ((s = x_window_to_screen (xrep.MouseWindow)) != 0)
3849 {
3850 Lisp_Object screen;
3851
3852 XSET (tempx, Lisp_Int,
3853 min (s->width-1,
3854 max (0, (xrep.MouseX - s->display.x->internal_border_width)
3855 / FONT_WIDTH (s->display.x->font))));
3856 XSET (tempy, Lisp_Int,
3857 min (s->height-1,
3858 max (0, (xrep.MouseY - s->display.x->internal_border_width)
3859 / FONT_HEIGHT (s->display.x->font))));
3860
3861 XSET (screen, Lisp_Screen, s);
3862 XSET (timestamp, Lisp_Int, (xrep.MouseTime & 0x7fffff));
3863
3864 pos = Fcons (tempx, Fcons (tempy, Qnil));
3865 Vmouse_window
3866 = Flocate_window_from_coordinates (screen, pos);
3867
3868 Vmouse_event
3869 = Fcons (pos,
3870 Fcons (Vmouse_window,
3871 Fcons (Qnil,
3872 Fcons (Fchar_to_string (make_number (com_letter)),
3873 Fcons (timestamp, Qnil)))));
3874 return Vmouse_event;
3875 }
3876
3877 break;
3878 #endif /* HAVE_X11 */
3879
3880 default:
3881 if (s = x_window_to_screen (xrep.MouseWindow))
3882 Vmouse_window = s->selected_window;
3883 else if (s = x_window_to_scrollbar (xrep.MouseWindow, &part, &prefix))
3884 Vmouse_window = s->selected_window;
3885 return Vmouse_event = Qnil;
3886 }
3887 }
3888
3889 if (!NILP (arg))
3890 return Qnil;
3891
3892 /* Wait till we get another mouse event. */
3893 wait_reading_process_input (0, 0, 2, 0);
3894 }
3895 }
3896 #endif
3897
3898 \f
3899 #ifndef HAVE_X11
3900 DEFUN ("x-store-cut-buffer", Fx_store_cut_buffer, Sx_store_cut_buffer,
3901 1, 1, "sStore text in cut buffer: ",
3902 "Store contents of STRING into the cut buffer of the X window system.")
3903 (string)
3904 register Lisp_Object string;
3905 {
3906 int mask;
3907
3908 CHECK_STRING (string, 1);
3909 if (SCREEN_IS_X (selected_screen))
3910 error ("Selected screen does not understand X protocol.");
3911
3912 BLOCK_INPUT;
3913 XStoreBytes ((char *) XSTRING (string)->data, XSTRING (string)->size);
3914 UNBLOCK_INPUT;
3915
3916 return Qnil;
3917 }
3918
3919 DEFUN ("x-get-cut-buffer", Fx_get_cut_buffer, Sx_get_cut_buffer, 0, 0, 0,
3920 "Return contents of cut buffer of the X window system, as a string.")
3921 ()
3922 {
3923 int len;
3924 register Lisp_Object string;
3925 int mask;
3926 register char *d;
3927
3928 BLOCK_INPUT;
3929 d = XFetchBytes (&len);
3930 string = make_string (d, len);
3931 XFree (d);
3932 UNBLOCK_INPUT;
3933 return string;
3934 }
3935 #endif /* X10 */
3936 \f
3937 #ifdef HAVE_X11
3938 DEFUN ("x-rebind-key", Fx_rebind_key, Sx_rebind_key, 3, 3, 0,
3939 "Rebind X keysym KEYSYM, with MODIFIERS, to generate NEWSTRING.\n\
3940 KEYSYM is a string which conforms to the X keysym definitions found\n\
3941 in X11/keysymdef.h, sans the initial XK_. MODIFIERS is nil or a\n\
3942 list of strings specifying modifier keys such as Control_L, which must\n\
3943 also be depressed for NEWSTRING to appear.")
3944 (x_keysym, modifiers, newstring)
3945 register Lisp_Object x_keysym;
3946 register Lisp_Object modifiers;
3947 register Lisp_Object newstring;
3948 {
3949 char *rawstring;
3950 register KeySym keysym;
3951 KeySym modifier_list[16];
3952
3953 CHECK_STRING (x_keysym, 1);
3954 CHECK_STRING (newstring, 3);
3955
3956 keysym = XStringToKeysym ((char *) XSTRING (x_keysym)->data);
3957 if (keysym == NoSymbol)
3958 error ("Keysym does not exist");
3959
3960 if (NILP (modifiers))
3961 XRebindKeysym (x_current_display, keysym, modifier_list, 0,
3962 XSTRING (newstring)->data, XSTRING (newstring)->size);
3963 else
3964 {
3965 register Lisp_Object rest, mod;
3966 register int i = 0;
3967
3968 for (rest = modifiers; !NILP (rest); rest = Fcdr (rest))
3969 {
3970 if (i == 16)
3971 error ("Can't have more than 16 modifiers");
3972
3973 mod = Fcar (rest);
3974 CHECK_STRING (mod, 3);
3975 modifier_list[i] = XStringToKeysym ((char *) XSTRING (mod)->data);
3976 if (modifier_list[i] == NoSymbol
3977 || !IsModifierKey (modifier_list[i]))
3978 error ("Element is not a modifier keysym");
3979 i++;
3980 }
3981
3982 XRebindKeysym (x_current_display, keysym, modifier_list, i,
3983 XSTRING (newstring)->data, XSTRING (newstring)->size);
3984 }
3985
3986 return Qnil;
3987 }
3988
3989 DEFUN ("x-rebind-keys", Fx_rebind_keys, Sx_rebind_keys, 2, 2, 0,
3990 "Rebind KEYCODE to list of strings STRINGS.\n\
3991 STRINGS should be a list of 16 elements, one for each shift combination.\n\
3992 nil as element means don't change.\n\
3993 See the documentation of `x-rebind-key' for more information.")
3994 (keycode, strings)
3995 register Lisp_Object keycode;
3996 register Lisp_Object strings;
3997 {
3998 register Lisp_Object item;
3999 register unsigned char *rawstring;
4000 KeySym rawkey, modifier[1];
4001 int strsize;
4002 register unsigned i;
4003
4004 CHECK_NUMBER (keycode, 1);
4005 CHECK_CONS (strings, 2);
4006 rawkey = (KeySym) ((unsigned) (XINT (keycode))) & 255;
4007 for (i = 0; i <= 15; strings = Fcdr (strings), i++)
4008 {
4009 item = Fcar (strings);
4010 if (!NILP (item))
4011 {
4012 CHECK_STRING (item, 2);
4013 strsize = XSTRING (item)->size;
4014 rawstring = (unsigned char *) xmalloc (strsize);
4015 bcopy (XSTRING (item)->data, rawstring, strsize);
4016 modifier[1] = 1 << i;
4017 XRebindKeysym (x_current_display, rawkey, modifier, 1,
4018 rawstring, strsize);
4019 }
4020 }
4021 return Qnil;
4022 }
4023 #else
4024 DEFUN ("x-rebind-key", Fx_rebind_key, Sx_rebind_key, 3, 3, 0,
4025 "Rebind KEYCODE, with shift bits SHIFT-MASK, to new string NEWSTRING.\n\
4026 KEYCODE and SHIFT-MASK should be numbers representing the X keyboard code\n\
4027 and shift mask respectively. NEWSTRING is an arbitrary string of keystrokes.\n\
4028 If SHIFT-MASK is nil, then KEYCODE's key will be bound to NEWSTRING for\n\
4029 all shift combinations.\n\
4030 Shift Lock 1 Shift 2\n\
4031 Meta 4 Control 8\n\
4032 \n\
4033 For values of KEYCODE, see /usr/lib/Xkeymap.txt (remember that the codes\n\
4034 in that file are in octal!)\n\
4035 \n\
4036 NOTE: due to an X bug, this function will not take effect unless one has\n\
4037 a `~/.Xkeymap' file. (See the documentation for the `keycomp' program.)\n\
4038 This problem will be fixed in X version 11.")
4039
4040 (keycode, shift_mask, newstring)
4041 register Lisp_Object keycode;
4042 register Lisp_Object shift_mask;
4043 register Lisp_Object newstring;
4044 {
4045 char *rawstring;
4046 int keysym, rawshift;
4047 int i, strsize;
4048
4049 CHECK_NUMBER (keycode, 1);
4050 if (!NILP (shift_mask))
4051 CHECK_NUMBER (shift_mask, 2);
4052 CHECK_STRING (newstring, 3);
4053 strsize = XSTRING (newstring)->size;
4054 rawstring = (char *) xmalloc (strsize);
4055 bcopy (XSTRING (newstring)->data, rawstring, strsize);
4056
4057 keysym = ((unsigned) (XINT (keycode))) & 255;
4058
4059 if (NILP (shift_mask))
4060 {
4061 for (i = 0; i <= 15; i++)
4062 XRebindCode (keysym, i<<11, rawstring, strsize);
4063 }
4064 else
4065 {
4066 rawshift = (((unsigned) (XINT (shift_mask))) & 15) << 11;
4067 XRebindCode (keysym, rawshift, rawstring, strsize);
4068 }
4069 return Qnil;
4070 }
4071
4072 DEFUN ("x-rebind-keys", Fx_rebind_keys, Sx_rebind_keys, 2, 2, 0,
4073 "Rebind KEYCODE to list of strings STRINGS.\n\
4074 STRINGS should be a list of 16 elements, one for each shift combination.\n\
4075 nil as element means don't change.\n\
4076 See the documentation of `x-rebind-key' for more information.")
4077 (keycode, strings)
4078 register Lisp_Object keycode;
4079 register Lisp_Object strings;
4080 {
4081 register Lisp_Object item;
4082 register char *rawstring;
4083 KeySym rawkey, modifier[1];
4084 int strsize;
4085 register unsigned i;
4086
4087 CHECK_NUMBER (keycode, 1);
4088 CHECK_CONS (strings, 2);
4089 rawkey = (KeySym) ((unsigned) (XINT (keycode))) & 255;
4090 for (i = 0; i <= 15; strings = Fcdr (strings), i++)
4091 {
4092 item = Fcar (strings);
4093 if (!NILP (item))
4094 {
4095 CHECK_STRING (item, 2);
4096 strsize = XSTRING (item)->size;
4097 rawstring = (char *) xmalloc (strsize);
4098 bcopy (XSTRING (item)->data, rawstring, strsize);
4099 XRebindCode (rawkey, i << 11, rawstring, strsize);
4100 }
4101 }
4102 return Qnil;
4103 }
4104 #endif /* not HAVE_X11 */
4105 \f
4106 #ifdef HAVE_X11
4107 Visual *
4108 select_visual (screen, depth)
4109 Screen *screen;
4110 unsigned int *depth;
4111 {
4112 Visual *v;
4113 XVisualInfo *vinfo, vinfo_template;
4114 int n_visuals;
4115
4116 v = DefaultVisualOfScreen (screen);
4117 vinfo_template.visualid = XVisualIDFromVisual (v);
4118 vinfo = XGetVisualInfo (x_current_display, VisualIDMask, &vinfo_template,
4119 &n_visuals);
4120 if (n_visuals != 1)
4121 fatal ("Can't get proper X visual info");
4122
4123 if ((1 << vinfo->depth) == vinfo->colormap_size)
4124 *depth = vinfo->depth;
4125 else
4126 {
4127 int i = 0;
4128 int n = vinfo->colormap_size - 1;
4129 while (n)
4130 {
4131 n = n >> 1;
4132 i++;
4133 }
4134 *depth = i;
4135 }
4136
4137 XFree ((char *) vinfo);
4138 return v;
4139 }
4140 #endif /* HAVE_X11 */
4141
4142 DEFUN ("x-open-connection", Fx_open_connection, Sx_open_connection,
4143 1, 2, 0, "Open a connection to an X server.\n\
4144 DISPLAY is the name of the display to connect to. Optional second\n\
4145 arg XRM_STRING is a string of resources in xrdb format.")
4146 (display, xrm_string)
4147 Lisp_Object display, xrm_string;
4148 {
4149 unsigned int n_planes;
4150 register Screen *x_screen;
4151 unsigned char *xrm_option;
4152
4153 CHECK_STRING (display, 0);
4154 if (x_current_display != 0)
4155 error ("X server connection is already initialized");
4156
4157 /* This is what opens the connection and sets x_current_display.
4158 This also initializes many symbols, such as those used for input. */
4159 x_term_init (XSTRING (display)->data);
4160
4161 #ifdef HAVE_X11
4162 XFASTINT (Vwindow_system_version) = 11;
4163
4164 if (!EQ (xrm_string, Qnil))
4165 {
4166 CHECK_STRING (xrm_string, 1);
4167 xrm_option = (unsigned char *) XSTRING (xrm_string);
4168 }
4169 else
4170 xrm_option = (unsigned char *) 0;
4171 xrdb = x_load_resources (x_current_display, xrm_option, EMACS_CLASS);
4172 x_current_display->db = xrdb;
4173
4174 x_screen = DefaultScreenOfDisplay (x_current_display);
4175
4176 x_screen_count = make_number (ScreenCount (x_current_display));
4177 Vx_vendor = build_string (ServerVendor (x_current_display));
4178 x_release = make_number (VendorRelease (x_current_display));
4179
4180 x_screen_height = make_number (HeightOfScreen (x_screen));
4181 x_screen_height_mm = make_number (HeightMMOfScreen (x_screen));
4182 x_screen_width = make_number (WidthOfScreen (x_screen));
4183 x_screen_width_mm = make_number (WidthMMOfScreen (x_screen));
4184
4185 switch (DoesBackingStore (x_screen))
4186 {
4187 case Always:
4188 Vx_backing_store = intern ("Always");
4189 break;
4190
4191 case WhenMapped:
4192 Vx_backing_store = intern ("WhenMapped");
4193 break;
4194
4195 case NotUseful:
4196 Vx_backing_store = intern ("NotUseful");
4197 break;
4198
4199 default:
4200 error ("Strange value for BackingStore.");
4201 break;
4202 }
4203
4204 if (DoesSaveUnders (x_screen) == True)
4205 x_save_under = Qt;
4206 else
4207 x_save_under = Qnil;
4208
4209 screen_visual = select_visual (x_screen, &n_planes);
4210 x_screen_planes = make_number (n_planes);
4211 Vx_screen_visual = intern (x_visual_strings [screen_visual->class]);
4212
4213 /* X Atoms used by emacs. */
4214 BLOCK_INPUT;
4215 Xatom_emacs_selection = XInternAtom (x_current_display, "_EMACS_SELECTION_",
4216 False);
4217 Xatom_clipboard = XInternAtom (x_current_display, "CLIPBOARD",
4218 False);
4219 Xatom_clipboard_selection = XInternAtom (x_current_display, "_EMACS_CLIPBOARD_",
4220 False);
4221 Xatom_wm_change_state = XInternAtom (x_current_display, "WM_CHANGE_STATE",
4222 False);
4223 Xatom_incremental = XInternAtom (x_current_display, "INCR",
4224 False);
4225 Xatom_multiple = XInternAtom (x_current_display, "MULTIPLE",
4226 False);
4227 Xatom_targets = XInternAtom (x_current_display, "TARGETS",
4228 False);
4229 Xatom_timestamp = XInternAtom (x_current_display, "TIMESTAMP",
4230 False);
4231 Xatom_delete = XInternAtom (x_current_display, "DELETE",
4232 False);
4233 Xatom_insert_selection = XInternAtom (x_current_display, "INSERT_SELECTION",
4234 False);
4235 Xatom_pair = XInternAtom (x_current_display, "XA_ATOM_PAIR",
4236 False);
4237 Xatom_insert_property = XInternAtom (x_current_display, "INSERT_PROPERTY",
4238 False);
4239 Xatom_text = XInternAtom (x_current_display, "TEXT",
4240 False);
4241 Xatom_wm_protocols = XInternAtom (x_current_display, "WM_PROTOCOLS",
4242 False);
4243 Xatom_wm_take_focus = XInternAtom (x_current_display, "WM_TAKE_FOCUS",
4244 False);
4245 Xatom_wm_save_yourself = XInternAtom (x_current_display, "WM_SAVE_YOURSELF",
4246 False);
4247 Xatom_wm_delete_window = XInternAtom (x_current_display, "WM_DELETE_WINDOW",
4248 False);
4249 Xatom_wm_change_state = XInternAtom (x_current_display, "WM_CHANGE_STATE",
4250 False);
4251 Xatom_wm_configure_denied = XInternAtom (x_current_display,
4252 "WM_CONFIGURE_DENIED", False);
4253 Xatom_wm_window_moved = XInternAtom (x_current_display, "WM_MOVED",
4254 False);
4255 UNBLOCK_INPUT;
4256 #else /* not HAVE_X11 */
4257 XFASTINT (Vwindow_system_version) = 10;
4258 #endif /* not HAVE_X11 */
4259 return Qnil;
4260 }
4261
4262 DEFUN ("x-close-current-connection", Fx_close_current_connection,
4263 Sx_close_current_connection,
4264 0, 0, 0, "Close the connection to the current X server.")
4265 ()
4266 {
4267 #ifdef HAVE_X11
4268 /* This is ONLY used when killing emacs; For switching displays
4269 we'll have to take care of setting CloseDownMode elsewhere. */
4270
4271 if (x_current_display)
4272 {
4273 BLOCK_INPUT;
4274 XSetCloseDownMode (x_current_display, DestroyAll);
4275 XCloseDisplay (x_current_display);
4276 }
4277 else
4278 fatal ("No current X display connection to close\n");
4279 #endif
4280 return Qnil;
4281 }
4282
4283 DEFUN ("x-synchronize", Fx_synchronize, Sx_synchronize,
4284 1, 1, 0, "If ON is non-nil, report X errors as soon as the erring request is made.\n\
4285 If ON is nil, allow buffering of requests.\n\
4286 Turning on synchronization prohibits the Xlib routines from buffering\n\
4287 requests and seriously degrades performance, but makes debugging much\n\
4288 easier.")
4289 (on)
4290 Lisp_Object on;
4291 {
4292 XSynchronize (x_current_display, !EQ (on, Qnil));
4293
4294 return Qnil;
4295 }
4296
4297 \f
4298 syms_of_xfns ()
4299 {
4300 init_x_parm_symbols ();
4301
4302 /* This is zero if not using X windows. */
4303 x_current_display = 0;
4304
4305 Qundefined_color = intern ("undefined-color");
4306 Fput (Qundefined_color, Qerror_conditions,
4307 Fcons (Qundefined_color, Fcons (Qerror, Qnil)));
4308 Fput (Qundefined_color, Qerror_message,
4309 build_string ("Undefined color"));
4310
4311 DEFVAR_INT ("mouse-x-position", &x_mouse_x,
4312 "The X coordinate of the mouse position, in characters.");
4313 x_mouse_x = Qnil;
4314
4315 DEFVAR_INT ("mouse-y-position", &x_mouse_y,
4316 "The Y coordinate of the mouse position, in characters.");
4317 x_mouse_y = Qnil;
4318
4319 DEFVAR_INT ("mouse-buffer-offset", &mouse_buffer_offset,
4320 "The buffer offset of the character under the pointer.");
4321 mouse_buffer_offset = Qnil;
4322
4323 DEFVAR_INT ("x-pointer-shape", &Vx_pointer_shape,
4324 "The shape of the pointer when over text.");
4325 Vx_pointer_shape = Qnil;
4326
4327 DEFVAR_INT ("x-nontext-pointer-shape", &Vx_nontext_pointer_shape,
4328 "The shape of the pointer when not over text.");
4329 Vx_nontext_pointer_shape = Qnil;
4330
4331 DEFVAR_INT ("x-mode-pointer-shape", &Vx_mode_pointer_shape,
4332 "The shape of the pointer when over the mode line.");
4333 Vx_mode_pointer_shape = Qnil;
4334
4335 DEFVAR_LISP ("x-bar-cursor", &Vbar_cursor,
4336 "*If non-nil, use a vertical bar cursor. Otherwise, use the traditional box.");
4337 Vbar_cursor = Qnil;
4338
4339 DEFVAR_LISP ("x-cursor-fore-pixel", &Vx_cursor_fore_pixel,
4340 "A string indicating the foreground color of the cursor box.");
4341 Vx_cursor_fore_pixel = Qnil;
4342
4343 DEFVAR_LISP ("mouse-grabbed", &Vmouse_depressed,
4344 "Non-nil if a mouse button is currently depressed.");
4345 Vmouse_depressed = Qnil;
4346
4347 DEFVAR_INT ("x-screen-count", &x_screen_count,
4348 "The number of screens associated with the current display.");
4349 DEFVAR_INT ("x-release", &x_release,
4350 "The release number of the X server in use.");
4351 DEFVAR_LISP ("x-vendor", &Vx_vendor,
4352 "The vendor supporting the X server in use.");
4353 DEFVAR_INT ("x-screen-height", &x_screen_height,
4354 "The height of this X screen in pixels.");
4355 DEFVAR_INT ("x-screen-height-mm", &x_screen_height_mm,
4356 "The height of this X screen in millimeters.");
4357 DEFVAR_INT ("x-screen-width", &x_screen_width,
4358 "The width of this X screen in pixels.");
4359 DEFVAR_INT ("x-screen-width-mm", &x_screen_width_mm,
4360 "The width of this X screen in millimeters.");
4361 DEFVAR_LISP ("x-backing-store", &Vx_backing_store,
4362 "The backing store capability of this screen.\n\
4363 Values can be the symbols Always, WhenMapped, or NotUseful.");
4364 DEFVAR_BOOL ("x-save-under", &x_save_under,
4365 "*Non-nil means this X screen supports the SaveUnder feature.");
4366 DEFVAR_INT ("x-screen-planes", &x_screen_planes,
4367 "The number of planes this monitor supports.");
4368 DEFVAR_LISP ("x-screen-visual", &Vx_screen_visual,
4369 "The default X visual for this X screen.");
4370 DEFVAR_LISP ("x-no-window-manager", &Vx_no_window_manager,
4371 "t if no X window manager is in use.");
4372
4373 #ifdef HAVE_X11
4374 defsubr (&Sx_get_resource);
4375 defsubr (&Sx_pixel_width);
4376 defsubr (&Sx_pixel_height);
4377 #if 0
4378 defsubr (&Sx_draw_rectangle);
4379 defsubr (&Sx_erase_rectangle);
4380 defsubr (&Sx_contour_region);
4381 defsubr (&Sx_uncontour_region);
4382 #endif
4383 defsubr (&Sx_color_display_p);
4384 defsubr (&Sx_defined_color);
4385 #if 0
4386 defsubr (&Sx_track_pointer);
4387 defsubr (&Sx_grab_pointer);
4388 defsubr (&Sx_ungrab_pointer);
4389 #endif
4390 #else
4391 defsubr (&Sx_get_default);
4392 defsubr (&Sx_store_cut_buffer);
4393 defsubr (&Sx_get_cut_buffer);
4394 defsubr (&Sx_set_face);
4395 #endif
4396 defsubr (&Sx_geometry);
4397 defsubr (&Sx_create_screen);
4398 defsubr (&Sfocus_screen);
4399 defsubr (&Sunfocus_screen);
4400 #if 0
4401 defsubr (&Sx_horizontal_line);
4402 #endif
4403 defsubr (&Sx_rebind_key);
4404 defsubr (&Sx_rebind_keys);
4405 defsubr (&Sx_open_connection);
4406 defsubr (&Sx_close_current_connection);
4407 defsubr (&Sx_synchronize);
4408
4409 /* This was used in the old event interface which used a separate
4410 event queue.*/
4411 #if 0
4412 defsubr (&Sx_mouse_events);
4413 defsubr (&Sx_get_mouse_event);
4414 #endif
4415 }
4416
4417 #endif /* HAVE_X_WINDOWS */