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