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