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