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