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