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