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