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