(global-map): Dyke out the last two event-to-function bindings. These belong
[emacs.git] / src / xfns.c
blob98987b33fba9543d7fd4d0dfe74fe892170948af
1 /* Functions for the X window system.
2 Copyright (C) 1989, 1992, 1993 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 "keyboard.h"
36 #include "blockinput.h"
38 #ifdef HAVE_X_WINDOWS
39 extern void abort ();
41 #ifndef VMS
42 #include <X11/bitmaps/gray>
43 #else
44 #include "[.bitmaps]gray.xbm"
45 #endif
47 #define min(a,b) ((a) < (b) ? (a) : (b))
48 #define max(a,b) ((a) > (b) ? (a) : (b))
50 #ifdef HAVE_X11
51 /* X Resource data base */
52 static XrmDatabase xrdb;
54 /* The class of this X application. */
55 #define EMACS_CLASS "Emacs"
57 /* Title name and application name for X stuff. */
58 extern char *x_id_name;
60 /* The background and shape of the mouse pointer, and shape when not
61 over text or in the modeline. */
62 Lisp_Object Vx_pointer_shape, Vx_nontext_pointer_shape, Vx_mode_pointer_shape;
64 /* Color of chars displayed in cursor box. */
65 Lisp_Object Vx_cursor_fore_pixel;
67 /* The screen being used. */
68 static Screen *x_screen;
70 /* The X Visual we are using for X windows (the default) */
71 Visual *screen_visual;
73 /* Height of this X screen in pixels. */
74 int x_screen_height;
76 /* Width of this X screen in pixels. */
77 int x_screen_width;
79 /* Number of planes for this screen. */
80 int x_screen_planes;
82 /* Non nil if no window manager is in use. */
83 Lisp_Object Vx_no_window_manager;
85 /* `t' if a mouse button is depressed. */
87 Lisp_Object Vmouse_depressed;
89 extern unsigned int x_mouse_x, x_mouse_y, x_mouse_grabbed;
91 /* Atom for indicating window state to the window manager. */
92 extern Atom Xatom_wm_change_state;
94 /* Communication with window managers. */
95 extern Atom Xatom_wm_protocols;
97 /* Kinds of protocol things we may receive. */
98 extern Atom Xatom_wm_take_focus;
99 extern Atom Xatom_wm_save_yourself;
100 extern Atom Xatom_wm_delete_window;
102 /* Other WM communication */
103 extern Atom Xatom_wm_configure_denied; /* When our config request is denied */
104 extern Atom Xatom_wm_window_moved; /* When the WM moves us. */
106 #else /* X10 */
108 /* Default size of an Emacs window. */
109 static char *default_window = "=80x24+0+0";
111 #define MAXICID 80
112 char iconidentity[MAXICID];
113 #define ICONTAG "emacs@"
114 char minibuffer_iconidentity[MAXICID];
115 #define MINIBUFFER_ICONTAG "minibuffer@"
117 #endif /* X10 */
119 /* The last 23 bits of the timestamp of the last mouse button event. */
120 Time mouse_timestamp;
122 /* Evaluate this expression to rebuild the section of syms_of_xfns
123 that initializes and staticpros the symbols declared below. Note
124 that Emacs 18 has a bug that keeps C-x C-e from being able to
125 evaluate this expression.
127 (progn
128 ;; Accumulate a list of the symbols we want to initialize from the
129 ;; declarations at the top of the file.
130 (goto-char (point-min))
131 (search-forward "/\*&&& symbols declared here &&&*\/\n")
132 (let (symbol-list)
133 (while (looking-at "Lisp_Object \\(Q[a-z_]+\\)")
134 (setq symbol-list
135 (cons (buffer-substring (match-beginning 1) (match-end 1))
136 symbol-list))
137 (forward-line 1))
138 (setq symbol-list (nreverse symbol-list))
139 ;; Delete the section of syms_of_... where we initialize the symbols.
140 (search-forward "\n /\*&&& init symbols here &&&*\/\n")
141 (let ((start (point)))
142 (while (looking-at "^ Q")
143 (forward-line 2))
144 (kill-region start (point)))
145 ;; Write a new symbol initialization section.
146 (while symbol-list
147 (insert (format " %s = intern (\"" (car symbol-list)))
148 (let ((start (point)))
149 (insert (substring (car symbol-list) 1))
150 (subst-char-in-region start (point) ?_ ?-))
151 (insert (format "\");\n staticpro (&%s);\n" (car symbol-list)))
152 (setq symbol-list (cdr symbol-list)))))
156 /*&&& symbols declared here &&&*/
157 Lisp_Object Qauto_raise;
158 Lisp_Object Qauto_lower;
159 Lisp_Object Qbackground_color;
160 Lisp_Object Qbar;
161 Lisp_Object Qborder_color;
162 Lisp_Object Qborder_width;
163 Lisp_Object Qbox;
164 Lisp_Object Qcursor_color;
165 Lisp_Object Qcursor_type;
166 Lisp_Object Qfont;
167 Lisp_Object Qforeground_color;
168 Lisp_Object Qgeometry;
169 Lisp_Object Qicon;
170 Lisp_Object Qicon_left;
171 Lisp_Object Qicon_top;
172 Lisp_Object Qicon_type;
173 Lisp_Object Qinternal_border_width;
174 Lisp_Object Qleft;
175 Lisp_Object Qmouse_color;
176 Lisp_Object Qnone;
177 Lisp_Object Qparent_id;
178 Lisp_Object Qsuppress_icon;
179 Lisp_Object Qtop;
180 Lisp_Object Qundefined_color;
181 Lisp_Object Qvertical_scroll_bars;
182 Lisp_Object Qvisibility;
183 Lisp_Object Qwindow_id;
184 Lisp_Object Qx_frame_parameter;
186 /* The below are defined in frame.c. */
187 extern Lisp_Object Qheight, Qminibuffer, Qname, Qonly, Qwidth;
188 extern Lisp_Object Qunsplittable, Qmenu_bar_lines, Qicon;
190 extern Lisp_Object Vwindow_system_version;
192 /* Mouse map for clicks in windows. */
193 extern Lisp_Object Vglobal_mouse_map;
195 /* Points to table of defined typefaces. */
196 struct face *x_face_table[MAX_FACES_AND_GLYPHS];
198 /* Return the Emacs frame-object corresponding to an X window.
199 It could be the frame's main window or an icon window. */
201 struct frame *
202 x_window_to_frame (wdesc)
203 int wdesc;
205 Lisp_Object tail, frame;
206 struct frame *f;
208 for (tail = Vframe_list; CONSP (tail); tail = XCONS (tail)->cdr)
210 frame = XCONS (tail)->car;
211 if (XTYPE (frame) != Lisp_Frame)
212 continue;
213 f = XFRAME (frame);
214 if (FRAME_X_WINDOW (f) == wdesc
215 || f->display.x->icon_desc == wdesc)
216 return f;
218 return 0;
222 /* Connect the frame-parameter names for X frames
223 to the ways of passing the parameter values to the window system.
225 The name of a parameter, as a Lisp symbol,
226 has an `x-frame-parameter' property which is an integer in Lisp
227 but can be interpreted as an `enum x_frame_parm' in C. */
229 enum x_frame_parm
231 X_PARM_FOREGROUND_COLOR,
232 X_PARM_BACKGROUND_COLOR,
233 X_PARM_MOUSE_COLOR,
234 X_PARM_CURSOR_COLOR,
235 X_PARM_BORDER_COLOR,
236 X_PARM_ICON_TYPE,
237 X_PARM_FONT,
238 X_PARM_BORDER_WIDTH,
239 X_PARM_INTERNAL_BORDER_WIDTH,
240 X_PARM_NAME,
241 X_PARM_AUTORAISE,
242 X_PARM_AUTOLOWER,
243 X_PARM_VERT_SCROLL_BAR,
244 X_PARM_VISIBILITY,
245 X_PARM_MENU_BAR_LINES
249 struct x_frame_parm_table
251 char *name;
252 void (*setter)( /* struct frame *frame, Lisp_Object val, oldval */ );
255 void x_set_foreground_color ();
256 void x_set_background_color ();
257 void x_set_mouse_color ();
258 void x_set_cursor_color ();
259 void x_set_border_color ();
260 void x_set_cursor_type ();
261 void x_set_icon_type ();
262 void x_set_font ();
263 void x_set_border_width ();
264 void x_set_internal_border_width ();
265 void x_explicitly_set_name ();
266 void x_set_autoraise ();
267 void x_set_autolower ();
268 void x_set_vertical_scroll_bars ();
269 void x_set_visibility ();
270 void x_set_menu_bar_lines ();
272 static struct x_frame_parm_table x_frame_parms[] =
274 "foreground-color", x_set_foreground_color,
275 "background-color", x_set_background_color,
276 "mouse-color", x_set_mouse_color,
277 "cursor-color", x_set_cursor_color,
278 "border-color", x_set_border_color,
279 "cursor-type", x_set_cursor_type,
280 "icon-type", x_set_icon_type,
281 "font", x_set_font,
282 "border-width", x_set_border_width,
283 "internal-border-width", x_set_internal_border_width,
284 "name", x_explicitly_set_name,
285 "auto-raise", x_set_autoraise,
286 "auto-lower", x_set_autolower,
287 "vertical-scroll-bars", x_set_vertical_scroll_bars,
288 "visibility", x_set_visibility,
289 "menu-bar-lines", x_set_menu_bar_lines,
292 /* Attach the `x-frame-parameter' properties to
293 the Lisp symbol names of parameters relevant to X. */
295 init_x_parm_symbols ()
297 int i;
299 for (i = 0; i < sizeof (x_frame_parms) / sizeof (x_frame_parms[0]); i++)
300 Fput (intern (x_frame_parms[i].name), Qx_frame_parameter,
301 make_number (i));
304 /* Change the parameters of FRAME as specified by ALIST.
305 If a parameter is not specially recognized, do nothing;
306 otherwise call the `x_set_...' function for that parameter. */
308 void
309 x_set_frame_parameters (f, alist)
310 FRAME_PTR f;
311 Lisp_Object alist;
313 Lisp_Object tail;
315 /* If both of these parameters are present, it's more efficient to
316 set them both at once. So we wait until we've looked at the
317 entire list before we set them. */
318 Lisp_Object width, height;
320 /* Same here. */
321 Lisp_Object left, top;
323 XSET (width, Lisp_Int, FRAME_WIDTH (f));
324 XSET (height, Lisp_Int, FRAME_HEIGHT (f));
326 XSET (top, Lisp_Int, f->display.x->top_pos);
327 XSET (left, Lisp_Int, f->display.x->left_pos);
329 for (tail = alist; CONSP (tail); tail = Fcdr (tail))
331 Lisp_Object elt, prop, val;
333 elt = Fcar (tail);
334 prop = Fcar (elt);
335 val = Fcdr (elt);
337 if (EQ (prop, Qwidth))
338 width = val;
339 else if (EQ (prop, Qheight))
340 height = val;
341 else if (EQ (prop, Qtop))
342 top = val;
343 else if (EQ (prop, Qleft))
344 left = val;
345 else
347 register Lisp_Object tem;
348 tem = Fget (prop, Qx_frame_parameter);
349 if (XTYPE (tem) == Lisp_Int
350 && XINT (tem) >= 0
351 && XINT (tem) < sizeof (x_frame_parms)/sizeof (x_frame_parms[0]))
352 (*x_frame_parms[XINT (tem)].setter)(f, val,
353 get_frame_param (f, prop));
354 store_frame_param (f, prop, val);
358 /* Don't call these unless they've changed; the window may not actually
359 exist yet. */
361 Lisp_Object frame;
363 XSET (frame, Lisp_Frame, f);
364 if (XINT (width) != FRAME_WIDTH (f)
365 || XINT (height) != FRAME_HEIGHT (f))
366 Fset_frame_size (frame, width, height);
367 if (XINT (left) != f->display.x->left_pos
368 || XINT (top) != f->display.x->top_pos)
369 Fset_frame_position (frame, left, top);
373 /* Insert a description of internally-recorded parameters of frame X
374 into the parameter alist *ALISTPTR that is to be given to the user.
375 Only parameters that are specific to the X window system
376 and whose values are not correctly recorded in the frame's
377 param_alist need to be considered here. */
379 x_report_frame_params (f, alistptr)
380 struct frame *f;
381 Lisp_Object *alistptr;
383 char buf[16];
385 store_in_alist (alistptr, Qleft, make_number (f->display.x->left_pos));
386 store_in_alist (alistptr, Qtop, make_number (f->display.x->top_pos));
387 store_in_alist (alistptr, Qborder_width,
388 make_number (f->display.x->border_width));
389 store_in_alist (alistptr, Qinternal_border_width,
390 make_number (f->display.x->internal_border_width));
391 sprintf (buf, "%d", FRAME_X_WINDOW (f));
392 store_in_alist (alistptr, Qwindow_id,
393 build_string (buf));
394 store_in_alist (alistptr, Qvisibility,
395 (FRAME_VISIBLE_P (f) ? Qt
396 : FRAME_ICONIFIED_P (f) ? Qicon : Qnil));
399 /* Decide if color named COLOR is valid for the display
400 associated with the selected frame. */
402 defined_color (color, color_def)
403 char *color;
404 Color *color_def;
406 register int foo;
407 Colormap screen_colormap;
409 BLOCK_INPUT;
410 #ifdef HAVE_X11
411 screen_colormap
412 = DefaultColormap (x_current_display, XDefaultScreen (x_current_display));
414 foo = XParseColor (x_current_display, screen_colormap,
415 color, color_def)
416 && XAllocColor (x_current_display, screen_colormap, color_def);
417 #else
418 foo = XParseColor (color, color_def) && XGetHardwareColor (color_def);
419 #endif /* not HAVE_X11 */
420 UNBLOCK_INPUT;
422 if (foo)
423 return 1;
424 else
425 return 0;
428 /* Given a string ARG naming a color, compute a pixel value from it
429 suitable for screen F.
430 If F is not a color screen, return DEF (default) regardless of what
431 ARG says. */
434 x_decode_color (arg, def)
435 Lisp_Object arg;
436 int def;
438 Color cdef;
440 CHECK_STRING (arg, 0);
442 if (strcmp (XSTRING (arg)->data, "black") == 0)
443 return BLACK_PIX_DEFAULT;
444 else if (strcmp (XSTRING (arg)->data, "white") == 0)
445 return WHITE_PIX_DEFAULT;
447 #ifdef HAVE_X11
448 if (x_screen_planes == 1)
449 return def;
450 #else
451 if (DISPLAY_CELLS == 1)
452 return def;
453 #endif
455 if (defined_color (XSTRING (arg)->data, &cdef))
456 return cdef.pixel;
457 else
458 Fsignal (Qundefined_color, Fcons (arg, Qnil));
461 /* Functions called only from `x_set_frame_param'
462 to set individual parameters.
464 If FRAME_X_WINDOW (f) is 0,
465 the frame is being created and its X-window does not exist yet.
466 In that case, just record the parameter's new value
467 in the standard place; do not attempt to change the window. */
469 void
470 x_set_foreground_color (f, arg, oldval)
471 struct frame *f;
472 Lisp_Object arg, oldval;
474 f->display.x->foreground_pixel = x_decode_color (arg, BLACK_PIX_DEFAULT);
475 if (FRAME_X_WINDOW (f) != 0)
477 #ifdef HAVE_X11
478 BLOCK_INPUT;
479 XSetForeground (x_current_display, f->display.x->normal_gc,
480 f->display.x->foreground_pixel);
481 XSetBackground (x_current_display, f->display.x->reverse_gc,
482 f->display.x->foreground_pixel);
483 UNBLOCK_INPUT;
484 #endif /* HAVE_X11 */
485 if (FRAME_VISIBLE_P (f))
486 redraw_frame (f);
490 void
491 x_set_background_color (f, arg, oldval)
492 struct frame *f;
493 Lisp_Object arg, oldval;
495 Pixmap temp;
496 int mask;
498 f->display.x->background_pixel = x_decode_color (arg, WHITE_PIX_DEFAULT);
500 if (FRAME_X_WINDOW (f) != 0)
502 BLOCK_INPUT;
503 #ifdef HAVE_X11
504 /* The main frame area. */
505 XSetBackground (x_current_display, f->display.x->normal_gc,
506 f->display.x->background_pixel);
507 XSetForeground (x_current_display, f->display.x->reverse_gc,
508 f->display.x->background_pixel);
509 XSetWindowBackground (x_current_display, FRAME_X_WINDOW (f),
510 f->display.x->background_pixel);
512 #else
513 temp = XMakeTile (f->display.x->background_pixel);
514 XChangeBackground (FRAME_X_WINDOW (f), temp);
515 XFreePixmap (temp);
516 #endif /* not HAVE_X11 */
517 UNBLOCK_INPUT;
519 if (FRAME_VISIBLE_P (f))
520 redraw_frame (f);
524 void
525 x_set_mouse_color (f, arg, oldval)
526 struct frame *f;
527 Lisp_Object arg, oldval;
529 Cursor cursor, nontext_cursor, mode_cursor;
530 int mask_color;
532 if (!EQ (Qnil, arg))
533 f->display.x->mouse_pixel = x_decode_color (arg, BLACK_PIX_DEFAULT);
534 mask_color = f->display.x->background_pixel;
535 /* No invisible pointers. */
536 if (mask_color == f->display.x->mouse_pixel
537 && mask_color == f->display.x->background_pixel)
538 f->display.x->mouse_pixel = f->display.x->foreground_pixel;
540 BLOCK_INPUT;
541 #ifdef HAVE_X11
543 /* It's not okay to crash if the user selects a screwey cursor. */
544 x_catch_errors ();
546 if (!EQ (Qnil, Vx_pointer_shape))
548 CHECK_NUMBER (Vx_pointer_shape, 0);
549 cursor = XCreateFontCursor (x_current_display, XINT (Vx_pointer_shape));
551 else
552 cursor = XCreateFontCursor (x_current_display, XC_xterm);
553 x_check_errors ("bad text pointer cursor: %s");
555 if (!EQ (Qnil, Vx_nontext_pointer_shape))
557 CHECK_NUMBER (Vx_nontext_pointer_shape, 0);
558 nontext_cursor = XCreateFontCursor (x_current_display,
559 XINT (Vx_nontext_pointer_shape));
561 else
562 nontext_cursor = XCreateFontCursor (x_current_display, XC_left_ptr);
563 x_check_errors ("bad nontext pointer cursor: %s");
565 if (!EQ (Qnil, Vx_mode_pointer_shape))
567 CHECK_NUMBER (Vx_mode_pointer_shape, 0);
568 mode_cursor = XCreateFontCursor (x_current_display,
569 XINT (Vx_mode_pointer_shape));
571 else
572 mode_cursor = XCreateFontCursor (x_current_display, XC_xterm);
574 /* Check and report errors with the above calls. */
575 x_check_errors ("can't set cursor shape: %s");
576 x_uncatch_errors ();
579 XColor fore_color, back_color;
581 fore_color.pixel = f->display.x->mouse_pixel;
582 back_color.pixel = mask_color;
583 XQueryColor (x_current_display,
584 DefaultColormap (x_current_display,
585 DefaultScreen (x_current_display)),
586 &fore_color);
587 XQueryColor (x_current_display,
588 DefaultColormap (x_current_display,
589 DefaultScreen (x_current_display)),
590 &back_color);
591 XRecolorCursor (x_current_display, cursor,
592 &fore_color, &back_color);
593 XRecolorCursor (x_current_display, nontext_cursor,
594 &fore_color, &back_color);
595 XRecolorCursor (x_current_display, mode_cursor,
596 &fore_color, &back_color);
598 #else /* X10 */
599 cursor = XCreateCursor (16, 16, MouseCursor, MouseMask,
600 0, 0,
601 f->display.x->mouse_pixel,
602 f->display.x->background_pixel,
603 GXcopy);
604 #endif /* X10 */
606 if (FRAME_X_WINDOW (f) != 0)
608 XDefineCursor (XDISPLAY FRAME_X_WINDOW (f), cursor);
611 if (cursor != f->display.x->text_cursor && f->display.x->text_cursor != 0)
612 XFreeCursor (XDISPLAY f->display.x->text_cursor);
613 f->display.x->text_cursor = cursor;
614 #ifdef HAVE_X11
615 if (nontext_cursor != f->display.x->nontext_cursor
616 && f->display.x->nontext_cursor != 0)
617 XFreeCursor (XDISPLAY f->display.x->nontext_cursor);
618 f->display.x->nontext_cursor = nontext_cursor;
620 if (mode_cursor != f->display.x->modeline_cursor
621 && f->display.x->modeline_cursor != 0)
622 XFreeCursor (XDISPLAY f->display.x->modeline_cursor);
623 f->display.x->modeline_cursor = mode_cursor;
624 #endif /* HAVE_X11 */
626 XFlushQueue ();
627 UNBLOCK_INPUT;
630 void
631 x_set_cursor_color (f, arg, oldval)
632 struct frame *f;
633 Lisp_Object arg, oldval;
635 unsigned long fore_pixel;
637 if (!EQ (Vx_cursor_fore_pixel, Qnil))
638 fore_pixel = x_decode_color (Vx_cursor_fore_pixel, WHITE_PIX_DEFAULT);
639 else
640 fore_pixel = f->display.x->background_pixel;
641 f->display.x->cursor_pixel = x_decode_color (arg, BLACK_PIX_DEFAULT);
643 /* Make sure that the cursor color differs from the background color. */
644 if (f->display.x->cursor_pixel == f->display.x->background_pixel)
646 f->display.x->cursor_pixel == f->display.x->mouse_pixel;
647 if (f->display.x->cursor_pixel == fore_pixel)
648 fore_pixel = f->display.x->background_pixel;
651 if (FRAME_X_WINDOW (f) != 0)
653 #ifdef HAVE_X11
654 BLOCK_INPUT;
655 XSetBackground (x_current_display, f->display.x->cursor_gc,
656 f->display.x->cursor_pixel);
657 XSetForeground (x_current_display, f->display.x->cursor_gc,
658 fore_pixel);
659 UNBLOCK_INPUT;
660 #endif /* HAVE_X11 */
662 if (FRAME_VISIBLE_P (f))
664 x_display_cursor (f, 0);
665 x_display_cursor (f, 1);
670 /* Set the border-color of frame F to value described by ARG.
671 ARG can be a string naming a color.
672 The border-color is used for the border that is drawn by the X server.
673 Note that this does not fully take effect if done before
674 F has an x-window; it must be redone when the window is created.
676 Note: this is done in two routines because of the way X10 works.
678 Note: under X11, this is normally the province of the window manager,
679 and so emacs' border colors may be overridden. */
681 void
682 x_set_border_color (f, arg, oldval)
683 struct frame *f;
684 Lisp_Object arg, oldval;
686 unsigned char *str;
687 int pix;
689 CHECK_STRING (arg, 0);
690 str = XSTRING (arg)->data;
692 #ifndef HAVE_X11
693 if (!strcmp (str, "grey") || !strcmp (str, "Grey")
694 || !strcmp (str, "gray") || !strcmp (str, "Gray"))
695 pix = -1;
696 else
697 #endif /* X10 */
699 pix = x_decode_color (arg, BLACK_PIX_DEFAULT);
701 x_set_border_pixel (f, pix);
704 /* Set the border-color of frame F to pixel value PIX.
705 Note that this does not fully take effect if done before
706 F has an x-window. */
708 x_set_border_pixel (f, pix)
709 struct frame *f;
710 int pix;
712 f->display.x->border_pixel = pix;
714 if (FRAME_X_WINDOW (f) != 0 && f->display.x->border_width > 0)
716 Pixmap temp;
717 int mask;
719 BLOCK_INPUT;
720 #ifdef HAVE_X11
721 XSetWindowBorder (x_current_display, FRAME_X_WINDOW (f),
722 pix);
723 #else
724 if (pix < 0)
725 temp = XMakePixmap ((Bitmap) XStoreBitmap (gray_width, gray_height,
726 gray_bits),
727 BLACK_PIX_DEFAULT, WHITE_PIX_DEFAULT);
728 else
729 temp = XMakeTile (pix);
730 XChangeBorder (FRAME_X_WINDOW (f), temp);
731 XFreePixmap (XDISPLAY temp);
732 #endif /* not HAVE_X11 */
733 UNBLOCK_INPUT;
735 if (FRAME_VISIBLE_P (f))
736 redraw_frame (f);
740 void
741 x_set_cursor_type (f, arg, oldval)
742 FRAME_PTR f;
743 Lisp_Object arg, oldval;
745 if (EQ (arg, Qbar))
746 FRAME_DESIRED_CURSOR (f) = bar_cursor;
747 else if (EQ (arg, Qbox))
748 FRAME_DESIRED_CURSOR (f) = filled_box_cursor;
749 else
750 error
751 ("the `cursor-type' frame parameter should be either `bar' or `box'");
753 /* Make sure the cursor gets redrawn. This is overkill, but how
754 often do people change cursor types? */
755 update_mode_lines++;
758 void
759 x_set_icon_type (f, arg, oldval)
760 struct frame *f;
761 Lisp_Object arg, oldval;
763 Lisp_Object tem;
764 int result;
766 if (EQ (oldval, Qnil) == EQ (arg, Qnil))
767 return;
769 BLOCK_INPUT;
770 if (NILP (arg))
771 result = x_text_icon (f, 0);
772 else
773 result = x_bitmap_icon (f);
775 if (result)
777 UNBLOCK_INPUT;
778 error ("No icon window available.");
781 /* If the window was unmapped (and its icon was mapped),
782 the new icon is not mapped, so map the window in its stead. */
783 if (FRAME_VISIBLE_P (f))
784 XMapWindow (XDISPLAY FRAME_X_WINDOW (f));
786 XFlushQueue ();
787 UNBLOCK_INPUT;
790 void
791 x_set_font (f, arg, oldval)
792 struct frame *f;
793 Lisp_Object arg, oldval;
795 unsigned char *name;
796 int result;
798 CHECK_STRING (arg, 1);
799 name = XSTRING (arg)->data;
801 BLOCK_INPUT;
802 result = x_new_font (f, name);
803 UNBLOCK_INPUT;
805 if (result)
806 error ("Font \"%s\" is not defined", name);
809 void
810 x_set_border_width (f, arg, oldval)
811 struct frame *f;
812 Lisp_Object arg, oldval;
814 CHECK_NUMBER (arg, 0);
816 if (XINT (arg) == f->display.x->border_width)
817 return;
819 if (FRAME_X_WINDOW (f) != 0)
820 error ("Cannot change the border width of a window");
822 f->display.x->border_width = XINT (arg);
825 void
826 x_set_internal_border_width (f, arg, oldval)
827 struct frame *f;
828 Lisp_Object arg, oldval;
830 int mask;
831 int old = f->display.x->internal_border_width;
833 CHECK_NUMBER (arg, 0);
834 f->display.x->internal_border_width = XINT (arg);
835 if (f->display.x->internal_border_width < 0)
836 f->display.x->internal_border_width = 0;
838 if (f->display.x->internal_border_width == old)
839 return;
841 if (FRAME_X_WINDOW (f) != 0)
843 BLOCK_INPUT;
844 x_set_window_size (f, f->width, f->height);
845 #if 0
846 x_set_resize_hint (f);
847 #endif
848 XFlushQueue ();
849 UNBLOCK_INPUT;
850 SET_FRAME_GARBAGED (f);
854 void
855 x_set_visibility (f, value, oldval)
856 struct frame *f;
857 Lisp_Object value, oldval;
859 Lisp_Object frame;
860 XSET (frame, Lisp_Frame, f);
862 if (NILP (value))
863 Fmake_frame_invisible (frame);
864 else if (EQ (value, Qicon))
865 Ficonify_frame (frame);
866 else
867 Fmake_frame_visible (frame);
870 static void
871 x_set_menu_bar_lines_1 (window, n)
872 Lisp_Object window;
873 int n;
875 for (; !NILP (window); window = XWINDOW (window)->next)
877 struct window *w = XWINDOW (window);
879 w->top += n;
881 if (!NILP (w->vchild))
882 x_set_menu_bar_lines_1 (w->vchild);
884 if (!NILP (w->hchild))
885 x_set_menu_bar_lines_1 (w->hchild);
889 void
890 x_set_menu_bar_lines (f, value, oldval)
891 struct frame *f;
892 Lisp_Object value, oldval;
894 int nlines;
895 int olines = FRAME_MENU_BAR_LINES (f);
897 if (XTYPE (value) == Lisp_Int)
898 nlines = XINT (value);
899 else
900 nlines = 0;
902 FRAME_MENU_BAR_LINES (f) = nlines;
903 x_set_menu_bar_lines_1 (f->root_window, nlines - olines);
904 x_set_window_size (f, FRAME_WIDTH (f),
905 FRAME_HEIGHT (f) + nlines - olines);
908 /* Change the name of frame F to ARG. If ARG is nil, set F's name to
909 x_id_name.
911 If EXPLICIT is non-zero, that indicates that lisp code is setting the
912 name; if ARG is a string, set F's name to ARG and set
913 F->explicit_name; if ARG is Qnil, then clear F->explicit_name.
915 If EXPLICIT is zero, that indicates that Emacs redisplay code is
916 suggesting a new name, which lisp code should override; if
917 F->explicit_name is set, ignore the new name; otherwise, set it. */
919 void
920 x_set_name (f, name, explicit)
921 struct frame *f;
922 Lisp_Object name;
923 int explicit;
925 /* Make sure that requests from lisp code override requests from
926 Emacs redisplay code. */
927 if (explicit)
929 /* If we're switching from explicit to implicit, we had better
930 update the mode lines and thereby update the title. */
931 if (f->explicit_name && NILP (name))
932 update_mode_lines = 1;
934 f->explicit_name = ! NILP (name);
936 else if (f->explicit_name)
937 return;
939 /* If NAME is nil, set the name to the x_id_name. */
940 if (NILP (name))
941 name = build_string (x_id_name);
942 else
943 CHECK_STRING (name, 0);
945 /* Don't change the name if it's already NAME. */
946 if (! NILP (Fstring_equal (name, f->name)))
947 return;
949 if (FRAME_X_WINDOW (f))
951 BLOCK_INPUT;
953 #ifdef HAVE_X11R4
955 XTextProperty text;
956 text.value = XSTRING (name)->data;
957 text.encoding = XA_STRING;
958 text.format = 8;
959 text.nitems = XSTRING (name)->size;
960 XSetWMName (x_current_display, FRAME_X_WINDOW (f), &text);
961 XSetWMIconName (x_current_display, FRAME_X_WINDOW (f), &text);
963 #else
964 XSetIconName (XDISPLAY FRAME_X_WINDOW (f),
965 XSTRING (name)->data);
966 XStoreName (XDISPLAY FRAME_X_WINDOW (f),
967 XSTRING (name)->data);
968 #endif
970 UNBLOCK_INPUT;
973 f->name = name;
976 /* This function should be called when the user's lisp code has
977 specified a name for the frame; the name will override any set by the
978 redisplay code. */
979 void
980 x_explicitly_set_name (f, arg, oldval)
981 FRAME_PTR f;
982 Lisp_Object arg, oldval;
984 x_set_name (f, arg, 1);
987 /* This function should be called by Emacs redisplay code to set the
988 name; names set this way will never override names set by the user's
989 lisp code. */
990 void
991 x_implicitly_set_name (f, arg, oldval)
992 FRAME_PTR f;
993 Lisp_Object arg, oldval;
995 x_set_name (f, arg, 0);
998 void
999 x_set_autoraise (f, arg, oldval)
1000 struct frame *f;
1001 Lisp_Object arg, oldval;
1003 f->auto_raise = !EQ (Qnil, arg);
1006 void
1007 x_set_autolower (f, arg, oldval)
1008 struct frame *f;
1009 Lisp_Object arg, oldval;
1011 f->auto_lower = !EQ (Qnil, arg);
1014 void
1015 x_set_vertical_scroll_bars (f, arg, oldval)
1016 struct frame *f;
1017 Lisp_Object arg, oldval;
1019 if (NILP (arg) != ! FRAME_HAS_VERTICAL_SCROLL_BARS (f))
1021 FRAME_HAS_VERTICAL_SCROLL_BARS (f) = ! NILP (arg);
1023 /* We set this parameter before creating the X window for the
1024 frame, so we can get the geometry right from the start.
1025 However, if the window hasn't been created yet, we shouldn't
1026 call x_set_window_size. */
1027 if (FRAME_X_WINDOW (f))
1028 x_set_window_size (f, FRAME_WIDTH (f), FRAME_HEIGHT (f));
1032 #ifdef HAVE_X11
1033 int n_faces;
1035 #if 0
1036 /* I believe this function is obsolete with respect to the new face display
1037 changes. */
1038 x_set_face (scr, font, background, foreground, stipple)
1039 struct frame *scr;
1040 XFontStruct *font;
1041 unsigned long background, foreground;
1042 Pixmap stipple;
1044 XGCValues gc_values;
1045 GC temp_gc;
1046 unsigned long gc_mask;
1047 struct face *new_face;
1048 unsigned int width = 16;
1049 unsigned int height = 16;
1051 if (n_faces == MAX_FACES_AND_GLYPHS)
1052 return 1;
1054 /* Create the Graphics Context. */
1055 gc_values.font = font->fid;
1056 gc_values.foreground = foreground;
1057 gc_values.background = background;
1058 gc_values.line_width = 0;
1059 gc_mask = GCLineWidth | GCFont | GCForeground | GCBackground;
1060 if (stipple)
1062 gc_values.stipple
1063 = XCreateBitmapFromData (x_current_display, ROOT_WINDOW,
1064 (char *) stipple, width, height);
1065 gc_mask |= GCStipple;
1068 temp_gc = XCreateGC (x_current_display, FRAME_X_WINDOW (scr),
1069 gc_mask, &gc_values);
1070 if (!temp_gc)
1071 return 1;
1072 new_face = (struct face *) xmalloc (sizeof (struct face));
1073 if (!new_face)
1075 XFreeGC (x_current_display, temp_gc);
1076 return 1;
1079 new_face->font = font;
1080 new_face->foreground = foreground;
1081 new_face->background = background;
1082 new_face->face_gc = temp_gc;
1083 if (stipple)
1084 new_face->stipple = gc_values.stipple;
1086 x_face_table[++n_faces] = new_face;
1087 return 1;
1089 #endif
1091 x_set_glyph (scr, glyph)
1095 #if 0
1096 DEFUN ("x-set-face-font", Fx_set_face_font, Sx_set_face_font, 4, 2, 0,
1097 "Specify face table entry FACE-CODE to be the font named by FONT,\n\
1098 in colors FOREGROUND and BACKGROUND.")
1099 (face_code, font_name, foreground, background)
1100 Lisp_Object face_code;
1101 Lisp_Object font_name;
1102 Lisp_Object foreground;
1103 Lisp_Object background;
1105 register struct face *fp; /* Current face info. */
1106 register int fn; /* Face number. */
1107 register FONT_TYPE *f; /* Font data structure. */
1108 unsigned char *newname;
1109 int fg, bg;
1110 GC temp_gc;
1111 XGCValues gc_values;
1113 /* Need to do something about this. */
1114 Drawable drawable = FRAME_X_WINDOW (selected_frame);
1116 CHECK_NUMBER (face_code, 1);
1117 CHECK_STRING (font_name, 2);
1119 if (EQ (foreground, Qnil) || EQ (background, Qnil))
1121 fg = selected_frame->display.x->foreground_pixel;
1122 bg = selected_frame->display.x->background_pixel;
1124 else
1126 CHECK_NUMBER (foreground, 0);
1127 CHECK_NUMBER (background, 1);
1129 fg = x_decode_color (XINT (foreground), BLACK_PIX_DEFAULT);
1130 bg = x_decode_color (XINT (background), WHITE_PIX_DEFAULT);
1133 fn = XINT (face_code);
1134 if ((fn < 1) || (fn > 255))
1135 error ("Invalid face code, %d", fn);
1137 newname = XSTRING (font_name)->data;
1138 BLOCK_INPUT;
1139 f = (*newname == 0 ? 0 : XGetFont (newname));
1140 UNBLOCK_INPUT;
1141 if (f == 0)
1142 error ("Font \"%s\" is not defined", newname);
1144 fp = x_face_table[fn];
1145 if (fp == 0)
1147 x_face_table[fn] = fp = (struct face *) xmalloc (sizeof (struct face));
1148 bzero (fp, sizeof (struct face));
1149 fp->face_type = x_pixmap;
1151 else if (FACE_IS_FONT (fn))
1153 BLOCK_INPUT;
1154 XFreeGC (FACE_FONT (fn));
1155 UNBLOCK_INPUT;
1157 else if (FACE_IS_IMAGE (fn)) /* This should not happen... */
1159 BLOCK_INPUT;
1160 XFreePixmap (x_current_display, FACE_IMAGE (fn));
1161 fp->face_type = x_font;
1162 UNBLOCK_INPUT;
1164 else
1165 abort ();
1167 fp->face_GLYPH.font_desc.font = f;
1168 gc_values.font = f->fid;
1169 gc_values.foreground = fg;
1170 gc_values.background = bg;
1171 fp->face_GLYPH.font_desc.face_gc = XCreateGC (x_current_display,
1172 drawable, GCFont | GCForeground
1173 | GCBackground, &gc_values);
1174 fp->face_GLYPH.font_desc.font_width = FONT_WIDTH (f);
1175 fp->face_GLYPH.font_desc.font_height = FONT_HEIGHT (f);
1177 return face_code;
1179 #endif
1180 #else /* X10 */
1181 DEFUN ("x-set-face", Fx_set_face, Sx_set_face, 4, 4, 0,
1182 "Specify face table entry FACE-CODE to be the font named by FONT,\n\
1183 in colors FOREGROUND and BACKGROUND.")
1184 (face_code, font_name, foreground, background)
1185 Lisp_Object face_code;
1186 Lisp_Object font_name;
1187 Lisp_Object foreground;
1188 Lisp_Object background;
1190 register struct face *fp; /* Current face info. */
1191 register int fn; /* Face number. */
1192 register FONT_TYPE *f; /* Font data structure. */
1193 unsigned char *newname;
1195 CHECK_NUMBER (face_code, 1);
1196 CHECK_STRING (font_name, 2);
1198 fn = XINT (face_code);
1199 if ((fn < 1) || (fn > 255))
1200 error ("Invalid face code, %d", fn);
1202 /* Ask the server to find the specified font. */
1203 newname = XSTRING (font_name)->data;
1204 BLOCK_INPUT;
1205 f = (*newname == 0 ? 0 : XGetFont (newname));
1206 UNBLOCK_INPUT;
1207 if (f == 0)
1208 error ("Font \"%s\" is not defined", newname);
1210 /* Get the face structure for face_code in the face table.
1211 Make sure it exists. */
1212 fp = x_face_table[fn];
1213 if (fp == 0)
1215 x_face_table[fn] = fp = (struct face *) xmalloc (sizeof (struct face));
1216 bzero (fp, sizeof (struct face));
1219 /* If this face code already exists, get rid of the old font. */
1220 if (fp->font != 0 && fp->font != f)
1222 BLOCK_INPUT;
1223 XLoseFont (fp->font);
1224 UNBLOCK_INPUT;
1227 /* Store the specified information in FP. */
1228 fp->fg = x_decode_color (foreground, BLACK_PIX_DEFAULT);
1229 fp->bg = x_decode_color (background, WHITE_PIX_DEFAULT);
1230 fp->font = f;
1232 return face_code;
1234 #endif /* X10 */
1236 #if 0
1237 /* This is excluded because there is no painless way
1238 to get or to remember the name of the font. */
1240 DEFUN ("x-get-face", Fx_get_face, Sx_get_face, 1, 1, 0,
1241 "Get data defining face code FACE. FACE is an integer.\n\
1242 The value is a list (FONT FG-COLOR BG-COLOR).")
1243 (face)
1244 Lisp_Object face;
1246 register struct face *fp; /* Current face info. */
1247 register int fn; /* Face number. */
1249 CHECK_NUMBER (face, 1);
1250 fn = XINT (face);
1251 if ((fn < 1) || (fn > 255))
1252 error ("Invalid face code, %d", fn);
1254 /* Make sure the face table exists and this face code is defined. */
1255 if (x_face_table == 0 || x_face_table[fn] == 0)
1256 return Qnil;
1258 fp = x_face_table[fn];
1260 return Fcons (build_string (fp->name),
1261 Fcons (make_number (fp->fg),
1262 Fcons (make_number (fp->bg), Qnil)));
1264 #endif /* 0 */
1266 /* Subroutines of creating an X frame. */
1268 #ifdef HAVE_X11
1269 extern char *x_get_string_resource ();
1270 extern XrmDatabase x_load_resources ();
1272 DEFUN ("x-get-resource", Fx_get_resource, Sx_get_resource, 2, 4, 0,
1273 "Return the value of ATTRIBUTE, of class CLASS, from the X defaults database.\n\
1274 This uses `INSTANCE.ATTRIBUTE' as the key and `Emacs.CLASS' as the\n\
1275 class, where INSTANCE is the name under which Emacs was invoked.\n\
1277 The optional arguments COMPONENT and SUBCLASS add to the key and the\n\
1278 class, respectively. You must specify both of them or neither.\n\
1279 If you specify them, the key is `INSTANCE.COMPONENT.ATTRIBUTE'\n\
1280 and the class is `Emacs.CLASS.SUBCLASS'.")
1281 (attribute, class, component, subclass)
1282 Lisp_Object attribute, class, component, subclass;
1284 register char *value;
1285 char *name_key;
1286 char *class_key;
1288 CHECK_STRING (attribute, 0);
1289 CHECK_STRING (class, 0);
1291 if (!NILP (component))
1292 CHECK_STRING (component, 1);
1293 if (!NILP (subclass))
1294 CHECK_STRING (subclass, 2);
1295 if (NILP (component) != NILP (subclass))
1296 error ("x-get-resource: must specify both COMPONENT and SUBCLASS or neither");
1298 if (NILP (component))
1300 /* Allocate space for the components, the dots which separate them,
1301 and the final '\0'. */
1302 name_key = (char *) alloca (XSTRING (Vinvocation_name)->size
1303 + XSTRING (attribute)->size
1304 + 2);
1305 class_key = (char *) alloca ((sizeof (EMACS_CLASS) - 1)
1306 + XSTRING (class)->size
1307 + 2);
1309 sprintf (name_key, "%s.%s",
1310 XSTRING (Vinvocation_name)->data,
1311 XSTRING (attribute)->data);
1312 sprintf (class_key, "%s.%s",
1313 EMACS_CLASS,
1314 XSTRING (class)->data);
1316 else
1318 name_key = (char *) alloca (XSTRING (Vinvocation_name)->size
1319 + XSTRING (component)->size
1320 + XSTRING (attribute)->size
1321 + 3);
1323 class_key = (char *) alloca ((sizeof (EMACS_CLASS) - 1)
1324 + XSTRING (class)->size
1325 + XSTRING (subclass)->size
1326 + 3);
1328 sprintf (name_key, "%s.%s.%s",
1329 XSTRING (Vinvocation_name)->data,
1330 XSTRING (component)->data,
1331 XSTRING (attribute)->data);
1332 sprintf (class_key, "%s.%s",
1333 EMACS_CLASS,
1334 XSTRING (class)->data,
1335 XSTRING (subclass)->data);
1338 value = x_get_string_resource (xrdb, name_key, class_key);
1340 if (value != (char *) 0)
1341 return build_string (value);
1342 else
1343 return Qnil;
1346 #else /* X10 */
1348 DEFUN ("x-get-default", Fx_get_default, Sx_get_default, 1, 1, 0,
1349 "Get X default ATTRIBUTE from the system, or nil if no default.\n\
1350 Value is a string (when not nil) and ATTRIBUTE is also a string.\n\
1351 The defaults are specified in the file `~/.Xdefaults'.")
1352 (arg)
1353 Lisp_Object arg;
1355 register unsigned char *value;
1357 CHECK_STRING (arg, 1);
1359 value = (unsigned char *) XGetDefault (XDISPLAY
1360 XSTRING (Vinvocation_name)->data,
1361 XSTRING (arg)->data);
1362 if (value == 0)
1363 /* Try reversing last two args, in case this is the buggy version of X. */
1364 value = (unsigned char *) XGetDefault (XDISPLAY
1365 XSTRING (arg)->data,
1366 XSTRING (Vinvocation_name)->data);
1367 if (value != 0)
1368 return build_string (value);
1369 else
1370 return (Qnil);
1373 #define Fx_get_resource(attribute, class, component, subclass) \
1374 Fx_get_default(attribute)
1376 #endif /* X10 */
1378 /* Types we might convert a resource string into. */
1379 enum resource_types
1381 number, boolean, string, symbol,
1384 /* Return the value of parameter PARAM.
1386 First search ALIST, then Vdefault_frame_alist, then the X defaults
1387 database, using ATTRIBUTE as the attribute name and CLASS as its class.
1389 Convert the resource to the type specified by desired_type.
1391 If no default is specified, return Qunbound. If you call
1392 x_get_arg, make sure you deal with Qunbound in a reasonable way,
1393 and don't let it get stored in any lisp-visible variables! */
1395 static Lisp_Object
1396 x_get_arg (alist, param, attribute, class, type)
1397 Lisp_Object alist, param;
1398 char *attribute;
1399 char *class;
1400 enum resource_types type;
1402 register Lisp_Object tem;
1404 tem = Fassq (param, alist);
1405 if (EQ (tem, Qnil))
1406 tem = Fassq (param, Vdefault_frame_alist);
1407 if (EQ (tem, Qnil))
1410 if (attribute)
1412 tem = Fx_get_resource (build_string (attribute),
1413 build_string (class),
1414 Qnil, Qnil);
1416 if (NILP (tem))
1417 return Qunbound;
1419 switch (type)
1421 case number:
1422 return make_number (atoi (XSTRING (tem)->data));
1424 case boolean:
1425 tem = Fdowncase (tem);
1426 if (!strcmp (XSTRING (tem)->data, "on")
1427 || !strcmp (XSTRING (tem)->data, "true"))
1428 return Qt;
1429 else
1430 return Qnil;
1432 case string:
1433 return tem;
1435 case symbol:
1436 /* As a special case, we map the values `true' and `on'
1437 to Qt, and `false' and `off' to Qnil. */
1439 Lisp_Object lower = Fdowncase (tem);
1440 if (!strcmp (XSTRING (tem)->data, "on")
1441 || !strcmp (XSTRING (tem)->data, "true"))
1442 return Qt;
1443 else if (!strcmp (XSTRING (tem)->data, "off")
1444 || !strcmp (XSTRING (tem)->data, "false"))
1445 return Qnil;
1446 else
1447 return intern (tem);
1450 default:
1451 abort ();
1454 else
1455 return Qunbound;
1457 return Fcdr (tem);
1460 /* Record in frame F the specified or default value according to ALIST
1461 of the parameter named PARAM (a Lisp symbol).
1462 If no value is specified for PARAM, look for an X default for XPROP
1463 on the frame named NAME.
1464 If that is not found either, use the value DEFLT. */
1466 static Lisp_Object
1467 x_default_parameter (f, alist, prop, deflt, xprop, xclass, type)
1468 struct frame *f;
1469 Lisp_Object alist;
1470 Lisp_Object prop;
1471 Lisp_Object deflt;
1472 char *xprop;
1473 char *xclass;
1474 enum resource_types type;
1476 Lisp_Object tem;
1478 tem = x_get_arg (alist, prop, xprop, xclass, type);
1479 if (EQ (tem, Qunbound))
1480 tem = deflt;
1481 x_set_frame_parameters (f, Fcons (Fcons (prop, tem), Qnil));
1482 return tem;
1485 DEFUN ("x-parse-geometry", Fx_parse_geometry, Sx_parse_geometry, 1, 1, 0,
1486 "Parse an X-style geometry string STRING.\n\
1487 Returns an alist of the form ((top . TOP), (left . LEFT) ... ).")
1488 (string)
1489 Lisp_Object string;
1491 int geometry, x, y;
1492 unsigned int width, height;
1493 Lisp_Object values[4];
1495 CHECK_STRING (string, 0);
1497 geometry = XParseGeometry ((char *) XSTRING (string)->data,
1498 &x, &y, &width, &height);
1500 switch (geometry & 0xf) /* Mask out {X,Y}Negative */
1502 case (XValue | YValue):
1503 /* What's one pixel among friends?
1504 Perhaps fix this some day by returning symbol `extreme-top'... */
1505 if (x == 0 && (geometry & XNegative))
1506 x = -1;
1507 if (y == 0 && (geometry & YNegative))
1508 y = -1;
1509 values[0] = Fcons (Qleft, make_number (x));
1510 values[1] = Fcons (Qtop, make_number (y));
1511 return Flist (2, values);
1512 break;
1514 case (WidthValue | HeightValue):
1515 values[0] = Fcons (Qwidth, make_number (width));
1516 values[1] = Fcons (Qheight, make_number (height));
1517 return Flist (2, values);
1518 break;
1520 case (XValue | YValue | WidthValue | HeightValue):
1521 if (x == 0 && (geometry & XNegative))
1522 x = -1;
1523 if (y == 0 && (geometry & YNegative))
1524 y = -1;
1525 values[0] = Fcons (Qwidth, make_number (width));
1526 values[1] = Fcons (Qheight, make_number (height));
1527 values[2] = Fcons (Qleft, make_number (x));
1528 values[3] = Fcons (Qtop, make_number (y));
1529 return Flist (4, values);
1530 break;
1532 case 0:
1533 return Qnil;
1535 default:
1536 error ("Must specify x and y value, and/or width and height");
1540 #ifdef HAVE_X11
1541 /* Calculate the desired size and position of this window,
1542 or set rubber-band prompting if none. */
1544 #define DEFAULT_ROWS 40
1545 #define DEFAULT_COLS 80
1547 static int
1548 x_figure_window_size (f, parms)
1549 struct frame *f;
1550 Lisp_Object parms;
1552 register Lisp_Object tem0, tem1;
1553 int height, width, left, top;
1554 register int geometry;
1555 long window_prompting = 0;
1557 /* Default values if we fall through.
1558 Actually, if that happens we should get
1559 window manager prompting. */
1560 f->width = DEFAULT_COLS;
1561 f->height = DEFAULT_ROWS;
1562 f->display.x->top_pos = 1;
1563 f->display.x->left_pos = 1;
1565 tem0 = x_get_arg (parms, Qheight, 0, 0, number);
1566 tem1 = x_get_arg (parms, Qwidth, 0, 0, number);
1567 if (! EQ (tem0, Qunbound) && ! EQ (tem1, Qunbound))
1569 CHECK_NUMBER (tem0, 0);
1570 CHECK_NUMBER (tem1, 0);
1571 f->height = XINT (tem0);
1572 f->width = XINT (tem1);
1573 window_prompting |= USSize;
1575 else if (! EQ (tem0, Qunbound) || ! EQ (tem1, Qunbound))
1576 error ("Must specify *both* height and width");
1578 f->display.x->vertical_scroll_bar_extra =
1579 (FRAME_HAS_VERTICAL_SCROLL_BARS (f)
1580 ? VERTICAL_SCROLL_BAR_PIXEL_WIDTH (f)
1581 : 0);
1582 f->display.x->pixel_width = CHAR_TO_PIXEL_WIDTH (f, f->width);
1583 f->display.x->pixel_height = CHAR_TO_PIXEL_HEIGHT (f, f->height);
1585 tem0 = x_get_arg (parms, Qtop, 0, 0, number);
1586 tem1 = x_get_arg (parms, Qleft, 0, 0, number);
1587 if (! EQ (tem0, Qunbound) && ! EQ (tem1, Qunbound))
1589 CHECK_NUMBER (tem0, 0);
1590 CHECK_NUMBER (tem1, 0);
1591 f->display.x->top_pos = XINT (tem0);
1592 f->display.x->left_pos = XINT (tem1);
1593 x_calc_absolute_position (f);
1594 window_prompting |= USPosition;
1596 else if (! EQ (tem0, Qunbound) || ! EQ (tem1, Qunbound))
1597 error ("Must specify *both* top and left corners");
1599 switch (window_prompting)
1601 case USSize | USPosition:
1602 return window_prompting;
1603 break;
1605 case USSize: /* Got the size, need the position. */
1606 window_prompting |= PPosition;
1607 return window_prompting;
1608 break;
1610 case USPosition: /* Got the position, need the size. */
1611 window_prompting |= PSize;
1612 return window_prompting;
1613 break;
1615 case 0: /* Got nothing, take both from geometry. */
1616 window_prompting |= PPosition | PSize;
1617 return window_prompting;
1618 break;
1620 default:
1621 /* Somehow a bit got set in window_prompting that we didn't
1622 put there. */
1623 abort ();
1627 static void
1628 x_window (f)
1629 struct frame *f;
1631 XSetWindowAttributes attributes;
1632 unsigned long attribute_mask;
1633 XClassHint class_hints;
1635 attributes.background_pixel = f->display.x->background_pixel;
1636 attributes.border_pixel = f->display.x->border_pixel;
1637 attributes.bit_gravity = StaticGravity;
1638 attributes.backing_store = NotUseful;
1639 attributes.save_under = True;
1640 attributes.event_mask = STANDARD_EVENT_SET;
1641 attribute_mask = (CWBackPixel | CWBorderPixel | CWBitGravity
1642 #if 0
1643 | CWBackingStore | CWSaveUnder
1644 #endif
1645 | CWEventMask);
1647 BLOCK_INPUT;
1648 FRAME_X_WINDOW (f)
1649 = XCreateWindow (x_current_display, ROOT_WINDOW,
1650 f->display.x->left_pos,
1651 f->display.x->top_pos,
1652 PIXEL_WIDTH (f), PIXEL_HEIGHT (f),
1653 f->display.x->border_width,
1654 CopyFromParent, /* depth */
1655 InputOutput, /* class */
1656 screen_visual, /* set in Fx_open_connection */
1657 attribute_mask, &attributes);
1659 class_hints.res_name = (char *) XSTRING (f->name)->data;
1660 class_hints.res_class = EMACS_CLASS;
1661 XSetClassHint (x_current_display, FRAME_X_WINDOW (f), &class_hints);
1663 /* This indicates that we use the "Passive Input" input model.
1664 Unless we do this, we don't get the Focus{In,Out} events that we
1665 need to draw the cursor correctly. Accursed bureaucrats.
1666 XWhipsAndChains (x_current_display, IronMaiden, &TheRack); */
1668 f->display.x->wm_hints.input = True;
1669 f->display.x->wm_hints.flags |= InputHint;
1670 XSetWMHints (x_current_display, FRAME_X_WINDOW (f), &f->display.x->wm_hints);
1672 /* x_set_name normally ignores requests to set the name if the
1673 requested name is the same as the current name. This is the one
1674 place where that assumption isn't correct; f->name is set, but
1675 the X server hasn't been told. */
1677 Lisp_Object name = f->name;
1678 int explicit = f->explicit_name;
1680 f->name = Qnil;
1681 f->explicit_name = 0;
1682 x_set_name (f, name, explicit);
1685 XDefineCursor (XDISPLAY FRAME_X_WINDOW (f),
1686 f->display.x->text_cursor);
1687 UNBLOCK_INPUT;
1689 if (FRAME_X_WINDOW (f) == 0)
1690 error ("Unable to create window.");
1693 /* Handle the icon stuff for this window. Perhaps later we might
1694 want an x_set_icon_position which can be called interactively as
1695 well. */
1697 static void
1698 x_icon (f, parms)
1699 struct frame *f;
1700 Lisp_Object parms;
1702 Lisp_Object icon_x, icon_y;
1704 /* Set the position of the icon. Note that twm groups all
1705 icons in an icon window. */
1706 icon_x = x_get_arg (parms, Qicon_left, 0, 0, number);
1707 icon_y = x_get_arg (parms, Qicon_top, 0, 0, number);
1708 if (!EQ (icon_x, Qunbound) && !EQ (icon_y, Qunbound))
1710 CHECK_NUMBER (icon_x, 0);
1711 CHECK_NUMBER (icon_y, 0);
1713 else if (!EQ (icon_x, Qunbound) || !EQ (icon_y, Qunbound))
1714 error ("Both left and top icon corners of icon must be specified");
1716 BLOCK_INPUT;
1718 if (! EQ (icon_x, Qunbound))
1719 x_wm_set_icon_position (f, XINT (icon_x), XINT (icon_y));
1721 /* Start up iconic or window? */
1722 x_wm_set_window_state
1723 (f, (EQ (x_get_arg (parms, Qvisibility, 0, 0, symbol), Qicon)
1724 ? IconicState
1725 : NormalState));
1727 UNBLOCK_INPUT;
1730 /* Make the GC's needed for this window, setting the
1731 background, border and mouse colors; also create the
1732 mouse cursor and the gray border tile. */
1734 static char cursor_bits[] =
1736 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
1737 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
1738 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
1739 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00
1742 static void
1743 x_make_gc (f)
1744 struct frame *f;
1746 XGCValues gc_values;
1747 GC temp_gc;
1748 XImage tileimage;
1750 BLOCK_INPUT;
1752 /* Create the GC's of this frame.
1753 Note that many default values are used. */
1755 /* Normal video */
1756 gc_values.font = f->display.x->font->fid;
1757 gc_values.foreground = f->display.x->foreground_pixel;
1758 gc_values.background = f->display.x->background_pixel;
1759 gc_values.line_width = 0; /* Means 1 using fast algorithm. */
1760 f->display.x->normal_gc = XCreateGC (x_current_display,
1761 FRAME_X_WINDOW (f),
1762 GCLineWidth | GCFont
1763 | GCForeground | GCBackground,
1764 &gc_values);
1766 /* Reverse video style. */
1767 gc_values.foreground = f->display.x->background_pixel;
1768 gc_values.background = f->display.x->foreground_pixel;
1769 f->display.x->reverse_gc = XCreateGC (x_current_display,
1770 FRAME_X_WINDOW (f),
1771 GCFont | GCForeground | GCBackground
1772 | GCLineWidth,
1773 &gc_values);
1775 /* Cursor has cursor-color background, background-color foreground. */
1776 gc_values.foreground = f->display.x->background_pixel;
1777 gc_values.background = f->display.x->cursor_pixel;
1778 gc_values.fill_style = FillOpaqueStippled;
1779 gc_values.stipple
1780 = XCreateBitmapFromData (x_current_display, ROOT_WINDOW,
1781 cursor_bits, 16, 16);
1782 f->display.x->cursor_gc
1783 = XCreateGC (x_current_display, FRAME_X_WINDOW (f),
1784 (GCFont | GCForeground | GCBackground
1785 | GCFillStyle | GCStipple | GCLineWidth),
1786 &gc_values);
1788 /* Create the gray border tile used when the pointer is not in
1789 the frame. Since this depends on the frame's pixel values,
1790 this must be done on a per-frame basis. */
1791 f->display.x->border_tile
1792 = (XCreatePixmapFromBitmapData
1793 (x_current_display, ROOT_WINDOW,
1794 gray_bits, gray_width, gray_height,
1795 f->display.x->foreground_pixel,
1796 f->display.x->background_pixel,
1797 DefaultDepth (x_current_display, XDefaultScreen (x_current_display))));
1799 UNBLOCK_INPUT;
1801 #endif /* HAVE_X11 */
1803 DEFUN ("x-create-frame", Fx_create_frame, Sx_create_frame,
1804 1, 1, 0,
1805 "Make a new X window, which is called a \"frame\" in Emacs terms.\n\
1806 Return an Emacs frame object representing the X window.\n\
1807 ALIST is an alist of frame parameters.\n\
1808 If the parameters specify that the frame should not have a minibuffer,\n\
1809 and do not specify a specific minibuffer window to use,\n\
1810 then `default-minibuffer-frame' must be a frame whose minibuffer can\n\
1811 be shared by the new frame.")
1812 (parms)
1813 Lisp_Object parms;
1815 #ifdef HAVE_X11
1816 struct frame *f;
1817 Lisp_Object frame, tem;
1818 Lisp_Object name;
1819 int minibuffer_only = 0;
1820 long window_prompting = 0;
1821 int width, height;
1823 if (x_current_display == 0)
1824 error ("X windows are not in use or not initialized");
1826 name = x_get_arg (parms, Qname, "title", "Title", string);
1827 if (XTYPE (name) != Lisp_String
1828 && ! EQ (name, Qunbound)
1829 && ! NILP (name))
1830 error ("x-create-frame: name parameter must be a string");
1832 tem = x_get_arg (parms, Qminibuffer, 0, 0, symbol);
1833 if (EQ (tem, Qnone) || NILP (tem))
1834 f = make_frame_without_minibuffer (Qnil);
1835 else if (EQ (tem, Qonly))
1837 f = make_minibuffer_frame ();
1838 minibuffer_only = 1;
1840 else if (XTYPE (tem) == Lisp_Window)
1841 f = make_frame_without_minibuffer (tem);
1842 else
1843 f = make_frame (1);
1845 /* Note that X Windows does support scroll bars. */
1846 FRAME_CAN_HAVE_SCROLL_BARS (f) = 1;
1848 /* Set the name; the functions to which we pass f expect the name to
1849 be set. */
1850 if (EQ (name, Qunbound) || NILP (name))
1852 f->name = build_string (x_id_name);
1853 f->explicit_name = 0;
1855 else
1857 f->name = name;
1858 f->explicit_name = 1;
1861 XSET (frame, Lisp_Frame, f);
1862 f->output_method = output_x_window;
1863 f->display.x = (struct x_display *) xmalloc (sizeof (struct x_display));
1864 bzero (f->display.x, sizeof (struct x_display));
1866 /* Note that the frame has no physical cursor right now. */
1867 f->phys_cursor_x = -1;
1869 /* Extract the window parameters from the supplied values
1870 that are needed to determine window geometry. */
1871 x_default_parameter (f, parms, Qfont, build_string ("9x15"),
1872 "font", "Font", string);
1873 x_default_parameter (f, parms, Qborder_width, make_number (2),
1874 "borderwidth", "BorderWidth", number);
1875 /* This defaults to 2 in order to match xterm. */
1876 x_default_parameter (f, parms, Qinternal_border_width, make_number (2),
1877 "internalBorderWidth", "BorderWidth", number);
1878 x_default_parameter (f, parms, Qvertical_scroll_bars, Qt,
1879 "verticalScrollBars", "ScrollBars", boolean);
1881 /* Also do the stuff which must be set before the window exists. */
1882 x_default_parameter (f, parms, Qforeground_color, build_string ("black"),
1883 "foreground", "Foreground", string);
1884 x_default_parameter (f, parms, Qbackground_color, build_string ("white"),
1885 "background", "Background", string);
1886 x_default_parameter (f, parms, Qmouse_color, build_string ("black"),
1887 "pointerColor", "Foreground", string);
1888 x_default_parameter (f, parms, Qcursor_color, build_string ("black"),
1889 "cursorColor", "Foreground", string);
1890 x_default_parameter (f, parms, Qborder_color, build_string ("black"),
1891 "borderColor", "BorderColor", string);
1893 f->display.x->parent_desc = ROOT_WINDOW;
1894 window_prompting = x_figure_window_size (f, parms);
1896 x_window (f);
1897 x_icon (f, parms);
1898 x_make_gc (f);
1900 /* We need to do this after creating the X window, so that the
1901 icon-creation functions can say whose icon they're describing. */
1902 x_default_parameter (f, parms, Qicon_type, Qnil,
1903 "iconType", "IconType", symbol);
1905 x_default_parameter (f, parms, Qauto_raise, Qnil,
1906 "autoRaise", "AutoRaiseLower", boolean);
1907 x_default_parameter (f, parms, Qauto_lower, Qnil,
1908 "autoLower", "AutoRaiseLower", boolean);
1909 x_default_parameter (f, parms, Qcursor_type, Qbox,
1910 "cursorType", "CursorType", symbol);
1912 /* Dimensions, especially f->height, must be done via change_frame_size.
1913 Change will not be effected unless different from the current
1914 f->height. */
1915 width = f->width;
1916 height = f->height;
1917 f->height = f->width = 0;
1918 change_frame_size (f, height, width, 1, 0);
1920 x_default_parameter (f, parms, Qmenu_bar_lines, make_number (0),
1921 "menuBarLines", "MenuBarLines", number);
1923 BLOCK_INPUT;
1924 x_wm_set_size_hint (f, window_prompting);
1925 UNBLOCK_INPUT;
1927 tem = x_get_arg (parms, Qunsplittable, 0, 0, boolean);
1928 f->no_split = minibuffer_only || EQ (tem, Qt);
1930 /* Make the window appear on the frame and enable display,
1931 unless the caller says not to. */
1933 Lisp_Object visibility = x_get_arg (parms, Qvisibility, 0, 0, symbol);
1935 if (EQ (visibility, Qunbound))
1936 visibility = Qt;
1938 if (EQ (visibility, Qicon))
1939 x_iconify_frame (f);
1940 else if (! NILP (visibility))
1941 x_make_frame_visible (f);
1942 else
1943 /* Must have been Qnil. */
1947 return frame;
1948 #else /* X10 */
1949 struct frame *f;
1950 Lisp_Object frame, tem;
1951 Lisp_Object name;
1952 int pixelwidth, pixelheight;
1953 Cursor cursor;
1954 int height, width;
1955 Window parent;
1956 Pixmap temp;
1957 int minibuffer_only = 0;
1958 Lisp_Object vscroll, hscroll;
1960 if (x_current_display == 0)
1961 error ("X windows are not in use or not initialized");
1963 name = Fassq (Qname, parms);
1965 tem = x_get_arg (parms, Qminibuffer, 0, 0, symbol);
1966 if (EQ (tem, Qnone))
1967 f = make_frame_without_minibuffer (Qnil);
1968 else if (EQ (tem, Qonly))
1970 f = make_minibuffer_frame ();
1971 minibuffer_only = 1;
1973 else if (EQ (tem, Qnil) || EQ (tem, Qunbound))
1974 f = make_frame (1);
1975 else
1976 f = make_frame_without_minibuffer (tem);
1978 parent = ROOT_WINDOW;
1980 XSET (frame, Lisp_Frame, f);
1981 f->output_method = output_x_window;
1982 f->display.x = (struct x_display *) xmalloc (sizeof (struct x_display));
1983 bzero (f->display.x, sizeof (struct x_display));
1985 /* Some temprorary default values for height and width. */
1986 width = 80;
1987 height = 40;
1988 f->display.x->left_pos = -1;
1989 f->display.x->top_pos = -1;
1991 /* Give the frame a default name (which may be overridden with PARMS). */
1993 strncpy (iconidentity, ICONTAG, MAXICID);
1994 if (gethostname (&iconidentity[sizeof (ICONTAG) - 1],
1995 (MAXICID - 1) - sizeof (ICONTAG)))
1996 iconidentity[sizeof (ICONTAG) - 2] = '\0';
1997 f->name = build_string (iconidentity);
1999 /* Extract some window parameters from the supplied values.
2000 These are the parameters that affect window geometry. */
2002 tem = x_get_arg (parms, Qfont, "BodyFont", 0, string);
2003 if (EQ (tem, Qunbound))
2004 tem = build_string ("9x15");
2005 x_set_font (f, tem, Qnil);
2006 x_default_parameter (f, parms, Qborder_color,
2007 build_string ("black"), "Border", 0, string);
2008 x_default_parameter (f, parms, Qbackground_color,
2009 build_string ("white"), "Background", 0, string);
2010 x_default_parameter (f, parms, Qforeground_color,
2011 build_string ("black"), "Foreground", 0, string);
2012 x_default_parameter (f, parms, Qmouse_color,
2013 build_string ("black"), "Mouse", 0, string);
2014 x_default_parameter (f, parms, Qcursor_color,
2015 build_string ("black"), "Cursor", 0, string);
2016 x_default_parameter (f, parms, Qborder_width,
2017 make_number (2), "BorderWidth", 0, number);
2018 x_default_parameter (f, parms, Qinternal_border_width,
2019 make_number (4), "InternalBorderWidth", 0, number);
2020 x_default_parameter (f, parms, Qauto_raise,
2021 Qnil, "AutoRaise", 0, boolean);
2023 hscroll = EQ (x_get_arg (parms, Qhorizontal_scroll_bar, 0, 0, boolean), Qt);
2024 vscroll = EQ (x_get_arg (parms, Qvertical_scroll_bar, 0, 0, boolean), Qt);
2026 if (f->display.x->internal_border_width < 0)
2027 f->display.x->internal_border_width = 0;
2029 tem = x_get_arg (parms, Qwindow_id, 0, 0, number);
2030 if (!EQ (tem, Qunbound))
2032 WINDOWINFO_TYPE wininfo;
2033 int nchildren;
2034 Window *children, root;
2036 CHECK_NUMBER (tem, 0);
2037 FRAME_X_WINDOW (f) = (Window) XINT (tem);
2039 BLOCK_INPUT;
2040 XGetWindowInfo (FRAME_X_WINDOW (f), &wininfo);
2041 XQueryTree (FRAME_X_WINDOW (f), &parent, &nchildren, &children);
2042 xfree (children);
2043 UNBLOCK_INPUT;
2045 height = PIXEL_TO_CHAR_HEIGHT (f, wininfo.height);
2046 width = PIXEL_TO_CHAR_WIDTH (f, wininfo.width);
2047 f->display.x->left_pos = wininfo.x;
2048 f->display.x->top_pos = wininfo.y;
2049 FRAME_SET_VISIBILITY (f, wininfo.mapped != 0);
2050 f->display.x->border_width = wininfo.bdrwidth;
2051 f->display.x->parent_desc = parent;
2053 else
2055 tem = x_get_arg (parms, Qparent_id, 0, 0, number);
2056 if (!EQ (tem, Qunbound))
2058 CHECK_NUMBER (tem, 0);
2059 parent = (Window) XINT (tem);
2061 f->display.x->parent_desc = parent;
2062 tem = x_get_arg (parms, Qheight, 0, 0, number);
2063 if (EQ (tem, Qunbound))
2065 tem = x_get_arg (parms, Qwidth, 0, 0, number);
2066 if (EQ (tem, Qunbound))
2068 tem = x_get_arg (parms, Qtop, 0, 0, number);
2069 if (EQ (tem, Qunbound))
2070 tem = x_get_arg (parms, Qleft, 0, 0, number);
2073 /* Now TEM is Qunbound if no edge or size was specified.
2074 In that case, we must do rubber-banding. */
2075 if (EQ (tem, Qunbound))
2077 tem = x_get_arg (parms, Qgeometry, 0, 0, number);
2078 x_rubber_band (f,
2079 &f->display.x->left_pos, &f->display.x->top_pos,
2080 &width, &height,
2081 (XTYPE (tem) == Lisp_String
2082 ? (char *) XSTRING (tem)->data : ""),
2083 XSTRING (f->name)->data,
2084 !NILP (hscroll), !NILP (vscroll));
2086 else
2088 /* Here if at least one edge or size was specified.
2089 Demand that they all were specified, and use them. */
2090 tem = x_get_arg (parms, Qheight, 0, 0, number);
2091 if (EQ (tem, Qunbound))
2092 error ("Height not specified");
2093 CHECK_NUMBER (tem, 0);
2094 height = XINT (tem);
2096 tem = x_get_arg (parms, Qwidth, 0, 0, number);
2097 if (EQ (tem, Qunbound))
2098 error ("Width not specified");
2099 CHECK_NUMBER (tem, 0);
2100 width = XINT (tem);
2102 tem = x_get_arg (parms, Qtop, 0, 0, number);
2103 if (EQ (tem, Qunbound))
2104 error ("Top position not specified");
2105 CHECK_NUMBER (tem, 0);
2106 f->display.x->left_pos = XINT (tem);
2108 tem = x_get_arg (parms, Qleft, 0, 0, number);
2109 if (EQ (tem, Qunbound))
2110 error ("Left position not specified");
2111 CHECK_NUMBER (tem, 0);
2112 f->display.x->top_pos = XINT (tem);
2115 pixelwidth = CHAR_TO_PIXEL_WIDTH (f, width);
2116 pixelheight = CHAR_TO_PIXEL_HEIGHT (f, height);
2118 BLOCK_INPUT;
2119 FRAME_X_WINDOW (f)
2120 = XCreateWindow (parent,
2121 f->display.x->left_pos, /* Absolute horizontal offset */
2122 f->display.x->top_pos, /* Absolute Vertical offset */
2123 pixelwidth, pixelheight,
2124 f->display.x->border_width,
2125 BLACK_PIX_DEFAULT, WHITE_PIX_DEFAULT);
2126 UNBLOCK_INPUT;
2127 if (FRAME_X_WINDOW (f) == 0)
2128 error ("Unable to create window.");
2131 /* Install the now determined height and width
2132 in the windows and in phys_lines and desired_lines. */
2133 change_frame_size (f, height, width, 1, 0);
2134 XSelectInput (FRAME_X_WINDOW (f), KeyPressed | ExposeWindow
2135 | ButtonPressed | ButtonReleased | ExposeRegion | ExposeCopy
2136 | EnterWindow | LeaveWindow | UnmapWindow );
2137 x_set_resize_hint (f);
2139 /* Tell the server the window's default name. */
2140 XStoreName (XDISPLAY FRAME_X_WINDOW (f), XSTRING (f->name)->data);
2142 /* Now override the defaults with all the rest of the specified
2143 parms. */
2144 tem = x_get_arg (parms, Qunsplittable, 0, 0, boolean);
2145 f->no_split = minibuffer_only || EQ (tem, Qt);
2147 /* Do not create an icon window if the caller says not to */
2148 if (!EQ (x_get_arg (parms, Qsuppress_icon, 0, 0, boolean), Qt)
2149 || f->display.x->parent_desc != ROOT_WINDOW)
2151 x_text_icon (f, iconidentity);
2152 x_default_parameter (f, parms, Qicon_type, Qnil,
2153 "BitmapIcon", 0, symbol);
2156 /* Tell the X server the previously set values of the
2157 background, border and mouse colors; also create the mouse cursor. */
2158 BLOCK_INPUT;
2159 temp = XMakeTile (f->display.x->background_pixel);
2160 XChangeBackground (FRAME_X_WINDOW (f), temp);
2161 XFreePixmap (temp);
2162 UNBLOCK_INPUT;
2163 x_set_border_pixel (f, f->display.x->border_pixel);
2165 x_set_mouse_color (f, Qnil, Qnil);
2167 /* Now override the defaults with all the rest of the specified parms. */
2169 Fmodify_frame_parameters (frame, parms);
2171 /* Make the window appear on the frame and enable display. */
2173 Lisp_Object visibility = x_get_arg (parms, Qvisibility, 0, 0, symbol);
2175 if (EQ (visibility, Qunbound))
2176 visibility = Qt;
2178 if (! EQ (visibility, Qicon)
2179 && ! NILP (visibility))
2180 x_make_window_visible (f);
2183 SET_FRAME_GARBAGED (f);
2185 return frame;
2186 #endif /* X10 */
2189 DEFUN ("focus-frame", Ffocus_frame, Sfocus_frame, 1, 1, 0,
2190 "Set the focus on FRAME.")
2191 (frame)
2192 Lisp_Object frame;
2194 CHECK_LIVE_FRAME (frame, 0);
2196 if (FRAME_X_P (XFRAME (frame)))
2198 BLOCK_INPUT;
2199 x_focus_on_frame (XFRAME (frame));
2200 UNBLOCK_INPUT;
2201 return frame;
2204 return Qnil;
2207 DEFUN ("unfocus-frame", Funfocus_frame, Sunfocus_frame, 0, 0, 0,
2208 "If a frame has been focused, release it.")
2211 if (x_focus_frame)
2213 BLOCK_INPUT;
2214 x_unfocus_frame (x_focus_frame);
2215 UNBLOCK_INPUT;
2218 return Qnil;
2221 #ifndef HAVE_X11
2222 /* Computes an X-window size and position either from geometry GEO
2223 or with the mouse.
2225 F is a frame. It specifies an X window which is used to
2226 determine which display to compute for. Its font, borders
2227 and colors control how the rectangle will be displayed.
2229 X and Y are where to store the positions chosen.
2230 WIDTH and HEIGHT are where to store the sizes chosen.
2232 GEO is the geometry that may specify some of the info.
2233 STR is a prompt to display.
2234 HSCROLL and VSCROLL say whether we have horiz and vert scroll bars. */
2237 x_rubber_band (f, x, y, width, height, geo, str, hscroll, vscroll)
2238 struct frame *f;
2239 int *x, *y, *width, *height;
2240 char *geo;
2241 char *str;
2242 int hscroll, vscroll;
2244 OpaqueFrame frame;
2245 Window tempwindow;
2246 WindowInfo wininfo;
2247 int border_color;
2248 int background_color;
2249 Lisp_Object tem;
2250 int mask;
2252 BLOCK_INPUT;
2254 background_color = f->display.x->background_pixel;
2255 border_color = f->display.x->border_pixel;
2257 frame.bdrwidth = f->display.x->border_width;
2258 frame.border = XMakeTile (border_color);
2259 frame.background = XMakeTile (background_color);
2260 tempwindow = XCreateTerm (str, "emacs", geo, default_window, &frame, 10, 5,
2261 (2 * f->display.x->internal_border_width
2262 + (vscroll ? VSCROLL_WIDTH : 0)),
2263 (2 * f->display.x->internal_border_width
2264 + (hscroll ? HSCROLL_HEIGHT : 0)),
2265 width, height, f->display.x->font,
2266 FONT_WIDTH (f->display.x->font),
2267 FONT_HEIGHT (f->display.x->font));
2268 XFreePixmap (frame.border);
2269 XFreePixmap (frame.background);
2271 if (tempwindow != 0)
2273 XQueryWindow (tempwindow, &wininfo);
2274 XDestroyWindow (tempwindow);
2275 *x = wininfo.x;
2276 *y = wininfo.y;
2279 /* Coordinates we got are relative to the root window.
2280 Convert them to coordinates relative to desired parent window
2281 by scanning from there up to the root. */
2282 tempwindow = f->display.x->parent_desc;
2283 while (tempwindow != ROOT_WINDOW)
2285 int nchildren;
2286 Window *children;
2287 XQueryWindow (tempwindow, &wininfo);
2288 *x -= wininfo.x;
2289 *y -= wininfo.y;
2290 XQueryTree (tempwindow, &tempwindow, &nchildren, &children);
2291 xfree (children);
2294 UNBLOCK_INPUT;
2295 return tempwindow != 0;
2297 #endif /* not HAVE_X11 */
2299 DEFUN ("x-color-defined-p", Fx_color_defined_p, Sx_color_defined_p, 1, 1, 0,
2300 "Return t if the current X display supports the color named COLOR.")
2301 (color)
2302 Lisp_Object color;
2304 Color foo;
2306 CHECK_STRING (color, 0);
2308 if (defined_color (XSTRING (color)->data, &foo))
2309 return Qt;
2310 else
2311 return Qnil;
2314 DEFUN ("x-display-color-p", Fx_display_color_p, Sx_display_color_p, 0, 0, 0,
2315 "Return t if the X screen currently in use supports color.")
2318 if (x_screen_planes <= 2)
2319 return Qnil;
2321 switch (screen_visual->class)
2323 case StaticColor:
2324 case PseudoColor:
2325 case TrueColor:
2326 case DirectColor:
2327 return Qt;
2329 default:
2330 return Qnil;
2334 DEFUN ("x-display-pixel-width", Fx_display_pixel_width, Sx_display_pixel_width,
2335 0, 1, 0,
2336 "Returns the width in pixels of the display FRAME is on.")
2337 (frame)
2338 Lisp_Object frame;
2340 Display *dpy = x_current_display;
2341 return make_number (DisplayWidth (dpy, DefaultScreen (dpy)));
2344 DEFUN ("x-display-pixel-height", Fx_display_pixel_height,
2345 Sx_display_pixel_height, 0, 1, 0,
2346 "Returns the height in pixels of the display FRAME is on.")
2347 (frame)
2348 Lisp_Object frame;
2350 Display *dpy = x_current_display;
2351 return make_number (DisplayHeight (dpy, DefaultScreen (dpy)));
2354 DEFUN ("x-display-planes", Fx_display_planes, Sx_display_planes,
2355 0, 1, 0,
2356 "Returns the number of bitplanes of the display FRAME is on.")
2357 (frame)
2358 Lisp_Object frame;
2360 Display *dpy = x_current_display;
2361 return make_number (DisplayPlanes (dpy, DefaultScreen (dpy)));
2364 DEFUN ("x-display-color-cells", Fx_display_color_cells, Sx_display_color_cells,
2365 0, 1, 0,
2366 "Returns the number of color cells of the display FRAME is on.")
2367 (frame)
2368 Lisp_Object frame;
2370 Display *dpy = x_current_display;
2371 return make_number (DisplayCells (dpy, DefaultScreen (dpy)));
2374 DEFUN ("x-server-vendor", Fx_server_vendor, Sx_server_vendor, 0, 1, 0,
2375 "Returns the vendor ID string of the X server FRAME is on.")
2376 (frame)
2377 Lisp_Object frame;
2379 Display *dpy = x_current_display;
2380 char *vendor;
2381 vendor = ServerVendor (dpy);
2382 if (! vendor) vendor = "";
2383 return build_string (vendor);
2386 DEFUN ("x-server-version", Fx_server_version, Sx_server_version, 0, 1, 0,
2387 "Returns the version numbers of the X server in use.\n\
2388 The value is a list of three integers: the major and minor\n\
2389 version numbers of the X Protocol in use, and the vendor-specific release\n\
2390 number. See also the variable `x-server-vendor'.")
2391 (frame)
2392 Lisp_Object frame;
2394 Display *dpy = x_current_display;
2395 return Fcons (make_number (ProtocolVersion (dpy)),
2396 Fcons (make_number (ProtocolRevision (dpy)),
2397 Fcons (make_number (VendorRelease (dpy)), Qnil)));
2400 DEFUN ("x-display-screens", Fx_display_screens, Sx_display_screens, 0, 1, 0,
2401 "Returns the number of screens on the X server FRAME is on.")
2402 (frame)
2403 Lisp_Object frame;
2405 return make_number (ScreenCount (x_current_display));
2408 DEFUN ("x-display-mm-height", Fx_display_mm_height, Sx_display_mm_height, 0, 1, 0,
2409 "Returns the height in millimeters of the X screen FRAME is on.")
2410 (frame)
2411 Lisp_Object frame;
2413 return make_number (HeightMMOfScreen (x_screen));
2416 DEFUN ("x-display-mm-width", Fx_display_mm_width, Sx_display_mm_width, 0, 1, 0,
2417 "Returns the width in millimeters of the X screen FRAME is on.")
2418 (frame)
2419 Lisp_Object frame;
2421 return make_number (WidthMMOfScreen (x_screen));
2424 DEFUN ("x-display-backing-store", Fx_display_backing_store,
2425 Sx_display_backing_store, 0, 1, 0,
2426 "Returns an indication of whether the X screen FRAME is on does backing store.\n\
2427 The value may be `always', `when-mapped', or `not-useful'.")
2428 (frame)
2429 Lisp_Object frame;
2431 switch (DoesBackingStore (x_screen))
2433 case Always:
2434 return intern ("always");
2436 case WhenMapped:
2437 return intern ("when-mapped");
2439 case NotUseful:
2440 return intern ("not-useful");
2442 default:
2443 error ("Strange value for BackingStore parameter of screen");
2447 DEFUN ("x-display-visual-class", Fx_display_visual_class,
2448 Sx_display_visual_class, 0, 1, 0,
2449 "Returns the visual class of the display `screen' is on.\n\
2450 The value is one of the symbols `static-gray', `gray-scale',\n\
2451 `static-color', `pseudo-color', `true-color', or `direct-color'.")
2452 (screen)
2453 Lisp_Object screen;
2455 switch (screen_visual->class)
2457 case StaticGray: return (intern ("static-gray"));
2458 case GrayScale: return (intern ("gray-scale"));
2459 case StaticColor: return (intern ("static-color"));
2460 case PseudoColor: return (intern ("pseudo-color"));
2461 case TrueColor: return (intern ("true-color"));
2462 case DirectColor: return (intern ("direct-color"));
2463 default:
2464 error ("Display has an unknown visual class");
2468 DEFUN ("x-display-save-under", Fx_display_save_under,
2469 Sx_display_save_under, 0, 1, 0,
2470 "Returns t if the X screen FRAME is on supports the save-under feature.")
2471 (frame)
2472 Lisp_Object frame;
2474 if (DoesSaveUnders (x_screen) == True)
2475 return Qt;
2476 else
2477 return Qnil;
2480 x_pixel_width (f)
2481 register struct frame *f;
2483 return PIXEL_WIDTH (f);
2486 x_pixel_height (f)
2487 register struct frame *f;
2489 return PIXEL_HEIGHT (f);
2492 x_char_width (f)
2493 register struct frame *f;
2495 return FONT_WIDTH (f->display.x->font);
2498 x_char_height (f)
2499 register struct frame *f;
2501 return FONT_HEIGHT (f->display.x->font);
2504 #if 0 /* These no longer seem like the right way to do things. */
2506 /* Draw a rectangle on the frame with left top corner including
2507 the character specified by LEFT_CHAR and TOP_CHAR. The rectangle is
2508 CHARS by LINES wide and long and is the color of the cursor. */
2510 void
2511 x_rectangle (f, gc, left_char, top_char, chars, lines)
2512 register struct frame *f;
2513 GC gc;
2514 register int top_char, left_char, chars, lines;
2516 int width;
2517 int height;
2518 int left = (left_char * FONT_WIDTH (f->display.x->font)
2519 + f->display.x->internal_border_width);
2520 int top = (top_char * FONT_HEIGHT (f->display.x->font)
2521 + f->display.x->internal_border_width);
2523 if (chars < 0)
2524 width = FONT_WIDTH (f->display.x->font) / 2;
2525 else
2526 width = FONT_WIDTH (f->display.x->font) * chars;
2527 if (lines < 0)
2528 height = FONT_HEIGHT (f->display.x->font) / 2;
2529 else
2530 height = FONT_HEIGHT (f->display.x->font) * lines;
2532 XDrawRectangle (x_current_display, FRAME_X_WINDOW (f),
2533 gc, left, top, width, height);
2536 DEFUN ("x-draw-rectangle", Fx_draw_rectangle, Sx_draw_rectangle, 5, 5, 0,
2537 "Draw a rectangle on FRAME between coordinates specified by\n\
2538 numbers X0, Y0, X1, Y1 in the cursor pixel.")
2539 (frame, X0, Y0, X1, Y1)
2540 register Lisp_Object frame, X0, X1, Y0, Y1;
2542 register int x0, y0, x1, y1, top, left, n_chars, n_lines;
2544 CHECK_LIVE_FRAME (frame, 0);
2545 CHECK_NUMBER (X0, 0);
2546 CHECK_NUMBER (Y0, 1);
2547 CHECK_NUMBER (X1, 2);
2548 CHECK_NUMBER (Y1, 3);
2550 x0 = XINT (X0);
2551 x1 = XINT (X1);
2552 y0 = XINT (Y0);
2553 y1 = XINT (Y1);
2555 if (y1 > y0)
2557 top = y0;
2558 n_lines = y1 - y0 + 1;
2560 else
2562 top = y1;
2563 n_lines = y0 - y1 + 1;
2566 if (x1 > x0)
2568 left = x0;
2569 n_chars = x1 - x0 + 1;
2571 else
2573 left = x1;
2574 n_chars = x0 - x1 + 1;
2577 BLOCK_INPUT;
2578 x_rectangle (XFRAME (frame), XFRAME (frame)->display.x->cursor_gc,
2579 left, top, n_chars, n_lines);
2580 UNBLOCK_INPUT;
2582 return Qt;
2585 DEFUN ("x-erase-rectangle", Fx_erase_rectangle, Sx_erase_rectangle, 5, 5, 0,
2586 "Draw a rectangle drawn on FRAME between coordinates\n\
2587 X0, Y0, X1, Y1 in the regular background-pixel.")
2588 (frame, X0, Y0, X1, Y1)
2589 register Lisp_Object frame, X0, Y0, X1, Y1;
2591 register int x0, y0, x1, y1, top, left, n_chars, n_lines;
2593 CHECK_FRAME (frame, 0);
2594 CHECK_NUMBER (X0, 0);
2595 CHECK_NUMBER (Y0, 1);
2596 CHECK_NUMBER (X1, 2);
2597 CHECK_NUMBER (Y1, 3);
2599 x0 = XINT (X0);
2600 x1 = XINT (X1);
2601 y0 = XINT (Y0);
2602 y1 = XINT (Y1);
2604 if (y1 > y0)
2606 top = y0;
2607 n_lines = y1 - y0 + 1;
2609 else
2611 top = y1;
2612 n_lines = y0 - y1 + 1;
2615 if (x1 > x0)
2617 left = x0;
2618 n_chars = x1 - x0 + 1;
2620 else
2622 left = x1;
2623 n_chars = x0 - x1 + 1;
2626 BLOCK_INPUT;
2627 x_rectangle (XFRAME (frame), XFRAME (frame)->display.x->reverse_gc,
2628 left, top, n_chars, n_lines);
2629 UNBLOCK_INPUT;
2631 return Qt;
2634 /* Draw lines around the text region beginning at the character position
2635 TOP_X, TOP_Y and ending at BOTTOM_X and BOTTOM_Y. GC specifies the
2636 pixel and line characteristics. */
2638 #define line_len(line) (FRAME_CURRENT_GLYPHS (f)->used[(line)])
2640 static void
2641 outline_region (f, gc, top_x, top_y, bottom_x, bottom_y)
2642 register struct frame *f;
2643 GC gc;
2644 int top_x, top_y, bottom_x, bottom_y;
2646 register int ibw = f->display.x->internal_border_width;
2647 register int font_w = FONT_WIDTH (f->display.x->font);
2648 register int font_h = FONT_HEIGHT (f->display.x->font);
2649 int y = top_y;
2650 int x = line_len (y);
2651 XPoint *pixel_points = (XPoint *)
2652 alloca (((bottom_y - top_y + 2) * 4) * sizeof (XPoint));
2653 register XPoint *this_point = pixel_points;
2655 /* Do the horizontal top line/lines */
2656 if (top_x == 0)
2658 this_point->x = ibw;
2659 this_point->y = ibw + (font_h * top_y);
2660 this_point++;
2661 if (x == 0)
2662 this_point->x = ibw + (font_w / 2); /* Half-size for newline chars. */
2663 else
2664 this_point->x = ibw + (font_w * x);
2665 this_point->y = (this_point - 1)->y;
2667 else
2669 this_point->x = ibw;
2670 this_point->y = ibw + (font_h * (top_y + 1));
2671 this_point++;
2672 this_point->x = ibw + (font_w * top_x);
2673 this_point->y = (this_point - 1)->y;
2674 this_point++;
2675 this_point->x = (this_point - 1)->x;
2676 this_point->y = ibw + (font_h * top_y);
2677 this_point++;
2678 this_point->x = ibw + (font_w * x);
2679 this_point->y = (this_point - 1)->y;
2682 /* Now do the right side. */
2683 while (y < bottom_y)
2684 { /* Right vertical edge */
2685 this_point++;
2686 this_point->x = (this_point - 1)->x;
2687 this_point->y = ibw + (font_h * (y + 1));
2688 this_point++;
2690 y++; /* Horizontal connection to next line */
2691 x = line_len (y);
2692 if (x == 0)
2693 this_point->x = ibw + (font_w / 2);
2694 else
2695 this_point->x = ibw + (font_w * x);
2697 this_point->y = (this_point - 1)->y;
2700 /* Now do the bottom and connect to the top left point. */
2701 this_point->x = ibw + (font_w * (bottom_x + 1));
2703 this_point++;
2704 this_point->x = (this_point - 1)->x;
2705 this_point->y = ibw + (font_h * (bottom_y + 1));
2706 this_point++;
2707 this_point->x = ibw;
2708 this_point->y = (this_point - 1)->y;
2709 this_point++;
2710 this_point->x = pixel_points->x;
2711 this_point->y = pixel_points->y;
2713 XDrawLines (x_current_display, FRAME_X_WINDOW (f),
2714 gc, pixel_points,
2715 (this_point - pixel_points + 1), CoordModeOrigin);
2718 DEFUN ("x-contour-region", Fx_contour_region, Sx_contour_region, 1, 1, 0,
2719 "Highlight the region between point and the character under the mouse\n\
2720 selected frame.")
2721 (event)
2722 register Lisp_Object event;
2724 register int x0, y0, x1, y1;
2725 register struct frame *f = selected_frame;
2726 register int p1, p2;
2728 CHECK_CONS (event, 0);
2730 BLOCK_INPUT;
2731 x0 = XINT (Fcar (Fcar (event)));
2732 y0 = XINT (Fcar (Fcdr (Fcar (event))));
2734 /* If the mouse is past the end of the line, don't that area. */
2735 /* ReWrite this... */
2737 x1 = f->cursor_x;
2738 y1 = f->cursor_y;
2740 if (y1 > y0) /* point below mouse */
2741 outline_region (f, f->display.x->cursor_gc,
2742 x0, y0, x1, y1);
2743 else if (y1 < y0) /* point above mouse */
2744 outline_region (f, f->display.x->cursor_gc,
2745 x1, y1, x0, y0);
2746 else /* same line: draw horizontal rectangle */
2748 if (x1 > x0)
2749 x_rectangle (f, f->display.x->cursor_gc,
2750 x0, y0, (x1 - x0 + 1), 1);
2751 else if (x1 < x0)
2752 x_rectangle (f, f->display.x->cursor_gc,
2753 x1, y1, (x0 - x1 + 1), 1);
2756 XFlush (x_current_display);
2757 UNBLOCK_INPUT;
2759 return Qnil;
2762 DEFUN ("x-uncontour-region", Fx_uncontour_region, Sx_uncontour_region, 1, 1, 0,
2763 "Erase any highlighting of the region between point and the character\n\
2764 at X, Y on the selected frame.")
2765 (event)
2766 register Lisp_Object event;
2768 register int x0, y0, x1, y1;
2769 register struct frame *f = selected_frame;
2771 BLOCK_INPUT;
2772 x0 = XINT (Fcar (Fcar (event)));
2773 y0 = XINT (Fcar (Fcdr (Fcar (event))));
2774 x1 = f->cursor_x;
2775 y1 = f->cursor_y;
2777 if (y1 > y0) /* point below mouse */
2778 outline_region (f, f->display.x->reverse_gc,
2779 x0, y0, x1, y1);
2780 else if (y1 < y0) /* point above mouse */
2781 outline_region (f, f->display.x->reverse_gc,
2782 x1, y1, x0, y0);
2783 else /* same line: draw horizontal rectangle */
2785 if (x1 > x0)
2786 x_rectangle (f, f->display.x->reverse_gc,
2787 x0, y0, (x1 - x0 + 1), 1);
2788 else if (x1 < x0)
2789 x_rectangle (f, f->display.x->reverse_gc,
2790 x1, y1, (x0 - x1 + 1), 1);
2792 UNBLOCK_INPUT;
2794 return Qnil;
2797 #if 0
2798 int contour_begin_x, contour_begin_y;
2799 int contour_end_x, contour_end_y;
2800 int contour_npoints;
2802 /* Clip the top part of the contour lines down (and including) line Y_POS.
2803 If X_POS is in the middle (rather than at the end) of the line, drop
2804 down a line at that character. */
2806 static void
2807 clip_contour_top (y_pos, x_pos)
2809 register XPoint *begin = contour_lines[y_pos].top_left;
2810 register XPoint *end;
2811 register int npoints;
2812 register struct display_line *line = selected_frame->phys_lines[y_pos + 1];
2814 if (x_pos >= line->len - 1) /* Draw one, straight horizontal line. */
2816 end = contour_lines[y_pos].top_right;
2817 npoints = (end - begin + 1);
2818 XDrawLines (x_current_display, contour_window,
2819 contour_erase_gc, begin_erase, npoints, CoordModeOrigin);
2821 bcopy (end, begin + 1, contour_last_point - end + 1);
2822 contour_last_point -= (npoints - 2);
2823 XDrawLines (x_current_display, contour_window,
2824 contour_erase_gc, begin, 2, CoordModeOrigin);
2825 XFlush (x_current_display);
2827 /* Now, update contour_lines structure. */
2829 /* ______. */
2830 else /* |________*/
2832 register XPoint *p = begin + 1;
2833 end = contour_lines[y_pos].bottom_right;
2834 npoints = (end - begin + 1);
2835 XDrawLines (x_current_display, contour_window,
2836 contour_erase_gc, begin_erase, npoints, CoordModeOrigin);
2838 p->y = begin->y;
2839 p->x = ibw + (font_w * (x_pos + 1));
2840 p++;
2841 p->y = begin->y + font_h;
2842 p->x = (p - 1)->x;
2843 bcopy (end, begin + 3, contour_last_point - end + 1);
2844 contour_last_point -= (npoints - 5);
2845 XDrawLines (x_current_display, contour_window,
2846 contour_erase_gc, begin, 4, CoordModeOrigin);
2847 XFlush (x_current_display);
2849 /* Now, update contour_lines structure. */
2853 /* Erase the top horzontal lines of the contour, and then extend
2854 the contour upwards. */
2856 static void
2857 extend_contour_top (line)
2861 static void
2862 clip_contour_bottom (x_pos, y_pos)
2863 int x_pos, y_pos;
2867 static void
2868 extend_contour_bottom (x_pos, y_pos)
2872 DEFUN ("x-select-region", Fx_select_region, Sx_select_region, 1, 1, "e",
2874 (event)
2875 Lisp_Object event;
2877 register struct frame *f = selected_frame;
2878 register int point_x = f->cursor_x;
2879 register int point_y = f->cursor_y;
2880 register int mouse_below_point;
2881 register Lisp_Object obj;
2882 register int x_contour_x, x_contour_y;
2884 x_contour_x = x_mouse_x;
2885 x_contour_y = x_mouse_y;
2886 if (x_contour_y > point_y || (x_contour_y == point_y
2887 && x_contour_x > point_x))
2889 mouse_below_point = 1;
2890 outline_region (f, f->display.x->cursor_gc, point_x, point_y,
2891 x_contour_x, x_contour_y);
2893 else
2895 mouse_below_point = 0;
2896 outline_region (f, f->display.x->cursor_gc, x_contour_x, x_contour_y,
2897 point_x, point_y);
2900 while (1)
2902 obj = read_char (-1, 0, 0, Qnil, 0);
2903 if (XTYPE (obj) != Lisp_Cons)
2904 break;
2906 if (mouse_below_point)
2908 if (x_mouse_y <= point_y) /* Flipped. */
2910 mouse_below_point = 0;
2912 outline_region (f, f->display.x->reverse_gc, point_x, point_y,
2913 x_contour_x, x_contour_y);
2914 outline_region (f, f->display.x->cursor_gc, x_mouse_x, x_mouse_y,
2915 point_x, point_y);
2917 else if (x_mouse_y < x_contour_y) /* Bottom clipped. */
2919 clip_contour_bottom (x_mouse_y);
2921 else if (x_mouse_y > x_contour_y) /* Bottom extended. */
2923 extend_bottom_contour (x_mouse_y);
2926 x_contour_x = x_mouse_x;
2927 x_contour_y = x_mouse_y;
2929 else /* mouse above or same line as point */
2931 if (x_mouse_y >= point_y) /* Flipped. */
2933 mouse_below_point = 1;
2935 outline_region (f, f->display.x->reverse_gc,
2936 x_contour_x, x_contour_y, point_x, point_y);
2937 outline_region (f, f->display.x->cursor_gc, point_x, point_y,
2938 x_mouse_x, x_mouse_y);
2940 else if (x_mouse_y > x_contour_y) /* Top clipped. */
2942 clip_contour_top (x_mouse_y);
2944 else if (x_mouse_y < x_contour_y) /* Top extended. */
2946 extend_contour_top (x_mouse_y);
2951 unread_command_event = obj;
2952 if (mouse_below_point)
2954 contour_begin_x = point_x;
2955 contour_begin_y = point_y;
2956 contour_end_x = x_contour_x;
2957 contour_end_y = x_contour_y;
2959 else
2961 contour_begin_x = x_contour_x;
2962 contour_begin_y = x_contour_y;
2963 contour_end_x = point_x;
2964 contour_end_y = point_y;
2967 #endif
2969 DEFUN ("x-horizontal-line", Fx_horizontal_line, Sx_horizontal_line, 1, 1, "e",
2971 (event)
2972 Lisp_Object event;
2974 register Lisp_Object obj;
2975 struct frame *f = selected_frame;
2976 register struct window *w = XWINDOW (selected_window);
2977 register GC line_gc = f->display.x->cursor_gc;
2978 register GC erase_gc = f->display.x->reverse_gc;
2979 #if 0
2980 char dash_list[] = {6, 4, 6, 4};
2981 int dashes = 4;
2982 XGCValues gc_values;
2983 #endif
2984 register int previous_y;
2985 register int line = (x_mouse_y + 1) * FONT_HEIGHT (f->display.x->font)
2986 + f->display.x->internal_border_width;
2987 register int left = f->display.x->internal_border_width
2988 + (w->left
2989 * FONT_WIDTH (f->display.x->font));
2990 register int right = left + (w->width
2991 * FONT_WIDTH (f->display.x->font))
2992 - f->display.x->internal_border_width;
2994 #if 0
2995 BLOCK_INPUT;
2996 gc_values.foreground = f->display.x->cursor_pixel;
2997 gc_values.background = f->display.x->background_pixel;
2998 gc_values.line_width = 1;
2999 gc_values.line_style = LineOnOffDash;
3000 gc_values.cap_style = CapRound;
3001 gc_values.join_style = JoinRound;
3003 line_gc = XCreateGC (x_current_display, FRAME_X_WINDOW (f),
3004 GCLineStyle | GCJoinStyle | GCCapStyle
3005 | GCLineWidth | GCForeground | GCBackground,
3006 &gc_values);
3007 XSetDashes (x_current_display, line_gc, 0, dash_list, dashes);
3008 gc_values.foreground = f->display.x->background_pixel;
3009 gc_values.background = f->display.x->foreground_pixel;
3010 erase_gc = XCreateGC (x_current_display, FRAME_X_WINDOW (f),
3011 GCLineStyle | GCJoinStyle | GCCapStyle
3012 | GCLineWidth | GCForeground | GCBackground,
3013 &gc_values);
3014 XSetDashes (x_current_display, erase_gc, 0, dash_list, dashes);
3015 #endif
3017 while (1)
3019 BLOCK_INPUT;
3020 if (x_mouse_y >= XINT (w->top)
3021 && x_mouse_y < XINT (w->top) + XINT (w->height) - 1)
3023 previous_y = x_mouse_y;
3024 line = (x_mouse_y + 1) * FONT_HEIGHT (f->display.x->font)
3025 + f->display.x->internal_border_width;
3026 XDrawLine (x_current_display, FRAME_X_WINDOW (f),
3027 line_gc, left, line, right, line);
3029 XFlushQueue ();
3030 UNBLOCK_INPUT;
3034 obj = read_char (-1, 0, 0, Qnil, 0);
3035 if ((XTYPE (obj) != Lisp_Cons)
3036 || (! EQ (Fcar (Fcdr (Fcdr (obj))),
3037 Qvertical_scroll_bar))
3038 || x_mouse_grabbed)
3040 BLOCK_INPUT;
3041 XDrawLine (x_current_display, FRAME_X_WINDOW (f),
3042 erase_gc, left, line, right, line);
3043 UNBLOCK_INPUT;
3044 unread_command_event = obj;
3045 #if 0
3046 XFreeGC (x_current_display, line_gc);
3047 XFreeGC (x_current_display, erase_gc);
3048 #endif
3049 return Qnil;
3052 while (x_mouse_y == previous_y);
3054 BLOCK_INPUT;
3055 XDrawLine (x_current_display, FRAME_X_WINDOW (f),
3056 erase_gc, left, line, right, line);
3057 UNBLOCK_INPUT;
3060 #endif
3062 /* Offset in buffer of character under the pointer, or 0. */
3063 int mouse_buffer_offset;
3065 #if 0
3066 /* These keep track of the rectangle following the pointer. */
3067 int mouse_track_top, mouse_track_left, mouse_track_width;
3069 DEFUN ("x-track-pointer", Fx_track_pointer, Sx_track_pointer, 0, 0, 0,
3070 "Track the pointer.")
3073 static Cursor current_pointer_shape;
3074 FRAME_PTR f = x_mouse_frame;
3076 BLOCK_INPUT;
3077 if (EQ (Vmouse_frame_part, Qtext_part)
3078 && (current_pointer_shape != f->display.x->nontext_cursor))
3080 unsigned char c;
3081 struct buffer *buf;
3083 current_pointer_shape = f->display.x->nontext_cursor;
3084 XDefineCursor (x_current_display,
3085 FRAME_X_WINDOW (f),
3086 current_pointer_shape);
3088 buf = XBUFFER (XWINDOW (Vmouse_window)->buffer);
3089 c = *(BUF_CHAR_ADDRESS (buf, mouse_buffer_offset));
3091 else if (EQ (Vmouse_frame_part, Qmodeline_part)
3092 && (current_pointer_shape != f->display.x->modeline_cursor))
3094 current_pointer_shape = f->display.x->modeline_cursor;
3095 XDefineCursor (x_current_display,
3096 FRAME_X_WINDOW (f),
3097 current_pointer_shape);
3100 XFlushQueue ();
3101 UNBLOCK_INPUT;
3103 #endif
3105 #if 0
3106 DEFUN ("x-track-pointer", Fx_track_pointer, Sx_track_pointer, 1, 1, "e",
3107 "Draw rectangle around character under mouse pointer, if there is one.")
3108 (event)
3109 Lisp_Object event;
3111 struct window *w = XWINDOW (Vmouse_window);
3112 struct frame *f = XFRAME (WINDOW_FRAME (w));
3113 struct buffer *b = XBUFFER (w->buffer);
3114 Lisp_Object obj;
3116 if (! EQ (Vmouse_window, selected_window))
3117 return Qnil;
3119 if (EQ (event, Qnil))
3121 int x, y;
3123 x_read_mouse_position (selected_frame, &x, &y);
3126 BLOCK_INPUT;
3127 mouse_track_width = 0;
3128 mouse_track_left = mouse_track_top = -1;
3132 if ((x_mouse_x != mouse_track_left
3133 && (x_mouse_x < mouse_track_left
3134 || x_mouse_x > (mouse_track_left + mouse_track_width)))
3135 || x_mouse_y != mouse_track_top)
3137 int hp = 0; /* Horizontal position */
3138 int len = FRAME_CURRENT_GLYPHS (f)->used[x_mouse_y];
3139 int p = FRAME_CURRENT_GLYPHS (f)->bufp[x_mouse_y];
3140 int tab_width = XINT (b->tab_width);
3141 int ctl_arrow_p = !NILP (b->ctl_arrow);
3142 unsigned char c;
3143 int mode_line_vpos = XFASTINT (w->height) + XFASTINT (w->top) - 1;
3144 int in_mode_line = 0;
3146 if (! FRAME_CURRENT_GLYPHS (f)->enable[x_mouse_y])
3147 break;
3149 /* Erase previous rectangle. */
3150 if (mouse_track_width)
3152 x_rectangle (f, f->display.x->reverse_gc,
3153 mouse_track_left, mouse_track_top,
3154 mouse_track_width, 1);
3156 if ((mouse_track_left == f->phys_cursor_x
3157 || mouse_track_left == f->phys_cursor_x - 1)
3158 && mouse_track_top == f->phys_cursor_y)
3160 x_display_cursor (f, 1);
3164 mouse_track_left = x_mouse_x;
3165 mouse_track_top = x_mouse_y;
3166 mouse_track_width = 0;
3168 if (mouse_track_left > len) /* Past the end of line. */
3169 goto draw_or_not;
3171 if (mouse_track_top == mode_line_vpos)
3173 in_mode_line = 1;
3174 goto draw_or_not;
3177 if (tab_width <= 0 || tab_width > 20) tab_width = 8;
3180 c = FETCH_CHAR (p);
3181 if (len == f->width && hp == len - 1 && c != '\n')
3182 goto draw_or_not;
3184 switch (c)
3186 case '\t':
3187 mouse_track_width = tab_width - (hp % tab_width);
3188 p++;
3189 hp += mouse_track_width;
3190 if (hp > x_mouse_x)
3192 mouse_track_left = hp - mouse_track_width;
3193 goto draw_or_not;
3195 continue;
3197 case '\n':
3198 mouse_track_width = -1;
3199 goto draw_or_not;
3201 default:
3202 if (ctl_arrow_p && (c < 040 || c == 0177))
3204 if (p > ZV)
3205 goto draw_or_not;
3207 mouse_track_width = 2;
3208 p++;
3209 hp +=2;
3210 if (hp > x_mouse_x)
3212 mouse_track_left = hp - mouse_track_width;
3213 goto draw_or_not;
3216 else
3218 mouse_track_width = 1;
3219 p++;
3220 hp++;
3222 continue;
3225 while (hp <= x_mouse_x);
3227 draw_or_not:
3228 if (mouse_track_width) /* Over text; use text pointer shape. */
3230 XDefineCursor (x_current_display,
3231 FRAME_X_WINDOW (f),
3232 f->display.x->text_cursor);
3233 x_rectangle (f, f->display.x->cursor_gc,
3234 mouse_track_left, mouse_track_top,
3235 mouse_track_width, 1);
3237 else if (in_mode_line)
3238 XDefineCursor (x_current_display,
3239 FRAME_X_WINDOW (f),
3240 f->display.x->modeline_cursor);
3241 else
3242 XDefineCursor (x_current_display,
3243 FRAME_X_WINDOW (f),
3244 f->display.x->nontext_cursor);
3247 XFlush (x_current_display);
3248 UNBLOCK_INPUT;
3250 obj = read_char (-1, 0, 0, Qnil, 0);
3251 BLOCK_INPUT;
3253 while (XTYPE (obj) == Lisp_Cons /* Mouse event */
3254 && EQ (Fcar (Fcdr (Fcdr (obj))), Qnil) /* Not scroll bar */
3255 && EQ (Vmouse_depressed, Qnil) /* Only motion events */
3256 && EQ (Vmouse_window, selected_window) /* In this window */
3257 && x_mouse_frame);
3259 unread_command_event = obj;
3261 if (mouse_track_width)
3263 x_rectangle (f, f->display.x->reverse_gc,
3264 mouse_track_left, mouse_track_top,
3265 mouse_track_width, 1);
3266 mouse_track_width = 0;
3267 if ((mouse_track_left == f->phys_cursor_x
3268 || mouse_track_left - 1 == f->phys_cursor_x)
3269 && mouse_track_top == f->phys_cursor_y)
3271 x_display_cursor (f, 1);
3274 XDefineCursor (x_current_display,
3275 FRAME_X_WINDOW (f),
3276 f->display.x->nontext_cursor);
3277 XFlush (x_current_display);
3278 UNBLOCK_INPUT;
3280 return Qnil;
3282 #endif
3284 #if 0
3285 #include "glyphs.h"
3287 /* Draw a pixmap specified by IMAGE_DATA of dimensions WIDTH and HEIGHT
3288 on the frame F at position X, Y. */
3290 x_draw_pixmap (f, x, y, image_data, width, height)
3291 struct frame *f;
3292 int x, y, width, height;
3293 char *image_data;
3295 Pixmap image;
3297 image = XCreateBitmapFromData (x_current_display,
3298 FRAME_X_WINDOW (f), image_data,
3299 width, height);
3300 XCopyPlane (x_current_display, image, FRAME_X_WINDOW (f),
3301 f->display.x->normal_gc, 0, 0, width, height, x, y);
3303 #endif
3305 #if 0
3307 #ifdef HAVE_X11
3308 #define XMouseEvent XEvent
3309 #define WhichMouseButton xbutton.button
3310 #define MouseWindow xbutton.window
3311 #define MouseX xbutton.x
3312 #define MouseY xbutton.y
3313 #define MouseTime xbutton.time
3314 #define ButtonReleased ButtonRelease
3315 #define ButtonPressed ButtonPress
3316 #else
3317 #define XMouseEvent XButtonEvent
3318 #define WhichMouseButton detail
3319 #define MouseWindow window
3320 #define MouseX x
3321 #define MouseY y
3322 #define MouseTime time
3323 #endif /* X11 */
3325 DEFUN ("x-mouse-events", Fx_mouse_events, Sx_mouse_events, 0, 0, 0,
3326 "Return number of pending mouse events from X window system.")
3329 return make_number (queue_event_count (&x_mouse_queue));
3332 /* Encode the mouse button events in the form expected by the
3333 mouse code in Lisp. For X11, this means moving the masks around. */
3335 static int
3336 encode_mouse_button (mouse_event)
3337 XMouseEvent mouse_event;
3339 register int event_code;
3340 register char key_mask;
3342 event_code = mouse_event.detail & 3;
3343 key_mask = (mouse_event.detail >> 8) & 0xf0;
3344 event_code |= key_mask >> 1;
3345 if (mouse_event.type == ButtonReleased) event_code |= 0x04;
3346 return event_code;
3349 DEFUN ("x-get-mouse-event", Fx_get_mouse_event, Sx_get_mouse_event,
3350 0, 1, 0,
3351 "Get next mouse event out of mouse event buffer.\n\
3352 Optional ARG non-nil means return nil immediately if no pending event;\n\
3353 otherwise, wait for an event. Returns a four-part list:\n\
3354 ((X-POS Y-POS) WINDOW FRAME-PART KEYSEQ TIMESTAMP).\n\
3355 Normally X-POS and Y-POS are the position of the click on the frame\n\
3356 (measured in characters and lines), and WINDOW is the window clicked in.\n\
3357 KEYSEQ is a string, the key sequence to be looked up in the mouse maps.\n\
3358 If FRAME-PART is non-nil, the event was on a scroll bar;\n\
3359 then Y-POS is really the total length of the scroll bar, while X-POS is\n\
3360 the relative position of the scroll bar's value within that total length,\n\
3361 and a third element OFFSET appears in that list: the height of the thumb-up\n\
3362 area at the top of the scroll bar.\n\
3363 FRAME-PART is one of the following symbols:\n\
3364 `vertical-scroll-bar', `vertical-thumbup', `vertical-thumbdown',\n\
3365 `horizontal-scroll-bar', `horizontal-thumbleft', `horizontal-thumbright'.\n\
3366 TIMESTAMP is the lower 23 bits of the X-server's timestamp for\n\
3367 the mouse event.")
3368 (arg)
3369 Lisp_Object arg;
3371 XMouseEvent xrep;
3372 register int com_letter;
3373 register Lisp_Object tempx;
3374 register Lisp_Object tempy;
3375 Lisp_Object part, pos, timestamp;
3376 int prefix;
3377 struct frame *f;
3379 int tem;
3381 while (1)
3383 BLOCK_INPUT;
3384 tem = dequeue_event (&xrep, &x_mouse_queue);
3385 UNBLOCK_INPUT;
3387 if (tem)
3389 switch (xrep.type)
3391 case ButtonPressed:
3392 case ButtonReleased:
3394 com_letter = encode_mouse_button (xrep);
3395 mouse_timestamp = xrep.MouseTime;
3397 if ((f = x_window_to_frame (xrep.MouseWindow)) != 0)
3399 Lisp_Object frame;
3401 if (f->display.x->icon_desc == xrep.MouseWindow)
3403 x_make_frame_visible (f);
3404 continue;
3407 XSET (tempx, Lisp_Int,
3408 min (f->width-1, max (0, (xrep.MouseX - f->display.x->internal_border_width)/FONT_WIDTH (f->display.x->font))));
3409 XSET (tempy, Lisp_Int,
3410 min (f->height-1, max (0, (xrep.MouseY - f->display.x->internal_border_width)/FONT_HEIGHT (f->display.x->font))));
3411 XSET (timestamp, Lisp_Int, (xrep.MouseTime & 0x7fffff));
3412 XSET (frame, Lisp_Frame, f);
3414 pos = Fcons (tempx, Fcons (tempy, Qnil));
3415 Vmouse_window
3416 = Flocate_window_from_coordinates (frame, pos);
3418 Vmouse_event
3419 = Fcons (pos,
3420 Fcons (Vmouse_window,
3421 Fcons (Qnil,
3422 Fcons (Fchar_to_string (make_number (com_letter)),
3423 Fcons (timestamp, Qnil)))));
3424 return Vmouse_event;
3426 else if ((f = x_window_to_scroll_bar (xrep.MouseWindow, &part, &prefix)) != 0)
3428 int pos, len;
3429 Lisp_Object keyseq;
3430 char *partname;
3432 keyseq = concat2 (Fchar_to_string (make_number (prefix)),
3433 Fchar_to_string (make_number (com_letter)));
3435 pos = xrep.MouseY - (f->display.x->v_scroll_bar_width - 2);
3436 XSET (tempx, Lisp_Int, pos);
3437 len = ((FONT_HEIGHT (f->display.x->font) * f->height)
3438 + f->display.x->internal_border_width
3439 - (2 * (f->display.x->v_scroll_bar_width - 2)));
3440 XSET (tempy, Lisp_Int, len);
3441 XSET (timestamp, Lisp_Int, (xrep.MouseTime & 0x7fffff));
3442 Vmouse_window = f->selected_window;
3443 Vmouse_event
3444 = Fcons (Fcons (tempx, Fcons (tempy,
3445 Fcons (make_number (f->display.x->v_scroll_bar_width - 2),
3446 Qnil))),
3447 Fcons (Vmouse_window,
3448 Fcons (intern (part),
3449 Fcons (keyseq, Fcons (timestamp,
3450 Qnil)))));
3451 return Vmouse_event;
3453 else
3454 continue;
3456 #ifdef HAVE_X11
3457 case MotionNotify:
3459 com_letter = x11_encode_mouse_button (xrep);
3460 if ((f = x_window_to_frame (xrep.MouseWindow)) != 0)
3462 Lisp_Object frame;
3464 XSET (tempx, Lisp_Int,
3465 min (f->width-1,
3466 max (0, (xrep.MouseX - f->display.x->internal_border_width)
3467 / FONT_WIDTH (f->display.x->font))));
3468 XSET (tempy, Lisp_Int,
3469 min (f->height-1,
3470 max (0, (xrep.MouseY - f->display.x->internal_border_width)
3471 / FONT_HEIGHT (f->display.x->font))));
3473 XSET (frame, Lisp_Frame, f);
3474 XSET (timestamp, Lisp_Int, (xrep.MouseTime & 0x7fffff));
3476 pos = Fcons (tempx, Fcons (tempy, Qnil));
3477 Vmouse_window
3478 = Flocate_window_from_coordinates (frame, pos);
3480 Vmouse_event
3481 = Fcons (pos,
3482 Fcons (Vmouse_window,
3483 Fcons (Qnil,
3484 Fcons (Fchar_to_string (make_number (com_letter)),
3485 Fcons (timestamp, Qnil)))));
3486 return Vmouse_event;
3489 break;
3490 #endif /* HAVE_X11 */
3492 default:
3493 if (f = x_window_to_frame (xrep.MouseWindow))
3494 Vmouse_window = f->selected_window;
3495 else if (f = x_window_to_scroll_bar (xrep.MouseWindow, &part, &prefix))
3496 Vmouse_window = f->selected_window;
3497 return Vmouse_event = Qnil;
3501 if (!NILP (arg))
3502 return Qnil;
3504 /* Wait till we get another mouse event. */
3505 wait_reading_process_input (0, 0, 2, 0);
3508 #endif
3511 #ifndef HAVE_X11
3512 DEFUN ("x-store-cut-buffer", Fx_store_cut_buffer, Sx_store_cut_buffer,
3513 1, 1, "sStore text in cut buffer: ",
3514 "Store contents of STRING into the cut buffer of the X window system.")
3515 (string)
3516 register Lisp_Object string;
3518 int mask;
3520 CHECK_STRING (string, 1);
3521 if (! FRAME_X_P (selected_frame))
3522 error ("Selected frame does not understand X protocol.");
3524 BLOCK_INPUT;
3525 XStoreBytes ((char *) XSTRING (string)->data, XSTRING (string)->size);
3526 UNBLOCK_INPUT;
3528 return Qnil;
3531 DEFUN ("x-get-cut-buffer", Fx_get_cut_buffer, Sx_get_cut_buffer, 0, 0, 0,
3532 "Return contents of cut buffer of the X window system, as a string.")
3535 int len;
3536 register Lisp_Object string;
3537 int mask;
3538 register char *d;
3540 BLOCK_INPUT;
3541 d = XFetchBytes (&len);
3542 string = make_string (d, len);
3543 XFree (d);
3544 UNBLOCK_INPUT;
3545 return string;
3547 #endif /* X10 */
3549 #ifdef HAVE_X11
3550 DEFUN ("x-rebind-key", Fx_rebind_key, Sx_rebind_key, 3, 3, 0,
3551 "Rebind X keysym KEYSYM, with MODIFIERS, to generate NEWSTRING.\n\
3552 KEYSYM is a string which conforms to the X keysym definitions found\n\
3553 in X11/keysymdef.h, sans the initial XK_. MODIFIERS is nil or a\n\
3554 list of strings specifying modifier keys such as Control_L, which must\n\
3555 also be depressed for NEWSTRING to appear.")
3556 (x_keysym, modifiers, newstring)
3557 register Lisp_Object x_keysym;
3558 register Lisp_Object modifiers;
3559 register Lisp_Object newstring;
3561 char *rawstring;
3562 register KeySym keysym;
3563 KeySym modifier_list[16];
3565 CHECK_STRING (x_keysym, 1);
3566 CHECK_STRING (newstring, 3);
3568 keysym = XStringToKeysym ((char *) XSTRING (x_keysym)->data);
3569 if (keysym == NoSymbol)
3570 error ("Keysym does not exist");
3572 if (NILP (modifiers))
3573 XRebindKeysym (x_current_display, keysym, modifier_list, 0,
3574 XSTRING (newstring)->data, XSTRING (newstring)->size);
3575 else
3577 register Lisp_Object rest, mod;
3578 register int i = 0;
3580 for (rest = modifiers; !NILP (rest); rest = Fcdr (rest))
3582 if (i == 16)
3583 error ("Can't have more than 16 modifiers");
3585 mod = Fcar (rest);
3586 CHECK_STRING (mod, 3);
3587 modifier_list[i] = XStringToKeysym ((char *) XSTRING (mod)->data);
3588 if (modifier_list[i] == NoSymbol
3589 || !IsModifierKey (modifier_list[i]))
3590 error ("Element is not a modifier keysym");
3591 i++;
3594 XRebindKeysym (x_current_display, keysym, modifier_list, i,
3595 XSTRING (newstring)->data, XSTRING (newstring)->size);
3598 return Qnil;
3601 DEFUN ("x-rebind-keys", Fx_rebind_keys, Sx_rebind_keys, 2, 2, 0,
3602 "Rebind KEYCODE to list of strings STRINGS.\n\
3603 STRINGS should be a list of 16 elements, one for each shift combination.\n\
3604 nil as element means don't change.\n\
3605 See the documentation of `x-rebind-key' for more information.")
3606 (keycode, strings)
3607 register Lisp_Object keycode;
3608 register Lisp_Object strings;
3610 register Lisp_Object item;
3611 register unsigned char *rawstring;
3612 KeySym rawkey, modifier[1];
3613 int strsize;
3614 register unsigned i;
3616 CHECK_NUMBER (keycode, 1);
3617 CHECK_CONS (strings, 2);
3618 rawkey = (KeySym) ((unsigned) (XINT (keycode))) & 255;
3619 for (i = 0; i <= 15; strings = Fcdr (strings), i++)
3621 item = Fcar (strings);
3622 if (!NILP (item))
3624 CHECK_STRING (item, 2);
3625 strsize = XSTRING (item)->size;
3626 rawstring = (unsigned char *) xmalloc (strsize);
3627 bcopy (XSTRING (item)->data, rawstring, strsize);
3628 modifier[1] = 1 << i;
3629 XRebindKeysym (x_current_display, rawkey, modifier, 1,
3630 rawstring, strsize);
3633 return Qnil;
3635 #else
3636 DEFUN ("x-rebind-key", Fx_rebind_key, Sx_rebind_key, 3, 3, 0,
3637 "Rebind KEYCODE, with shift bits SHIFT-MASK, to new string NEWSTRING.\n\
3638 KEYCODE and SHIFT-MASK should be numbers representing the X keyboard code\n\
3639 and shift mask respectively. NEWSTRING is an arbitrary string of keystrokes.\n\
3640 If SHIFT-MASK is nil, then KEYCODE's key will be bound to NEWSTRING for\n\
3641 all shift combinations.\n\
3642 Shift Lock 1 Shift 2\n\
3643 Meta 4 Control 8\n\
3645 For values of KEYCODE, see /usr/lib/Xkeymap.txt (remember that the codes\n\
3646 in that file are in octal!)\n\
3648 NOTE: due to an X bug, this function will not take effect unless one has\n\
3649 a `~/.Xkeymap' file. (See the documentation for the `keycomp' program.)\n\
3650 This problem will be fixed in X version 11.")
3652 (keycode, shift_mask, newstring)
3653 register Lisp_Object keycode;
3654 register Lisp_Object shift_mask;
3655 register Lisp_Object newstring;
3657 char *rawstring;
3658 int keysym, rawshift;
3659 int i, strsize;
3661 CHECK_NUMBER (keycode, 1);
3662 if (!NILP (shift_mask))
3663 CHECK_NUMBER (shift_mask, 2);
3664 CHECK_STRING (newstring, 3);
3665 strsize = XSTRING (newstring)->size;
3666 rawstring = (char *) xmalloc (strsize);
3667 bcopy (XSTRING (newstring)->data, rawstring, strsize);
3669 keysym = ((unsigned) (XINT (keycode))) & 255;
3671 if (NILP (shift_mask))
3673 for (i = 0; i <= 15; i++)
3674 XRebindCode (keysym, i<<11, rawstring, strsize);
3676 else
3678 rawshift = (((unsigned) (XINT (shift_mask))) & 15) << 11;
3679 XRebindCode (keysym, rawshift, rawstring, strsize);
3681 return Qnil;
3684 DEFUN ("x-rebind-keys", Fx_rebind_keys, Sx_rebind_keys, 2, 2, 0,
3685 "Rebind KEYCODE to list of strings STRINGS.\n\
3686 STRINGS should be a list of 16 elements, one for each shift combination.\n\
3687 nil as element means don't change.\n\
3688 See the documentation of `x-rebind-key' for more information.")
3689 (keycode, strings)
3690 register Lisp_Object keycode;
3691 register Lisp_Object strings;
3693 register Lisp_Object item;
3694 register char *rawstring;
3695 KeySym rawkey, modifier[1];
3696 int strsize;
3697 register unsigned i;
3699 CHECK_NUMBER (keycode, 1);
3700 CHECK_CONS (strings, 2);
3701 rawkey = (KeySym) ((unsigned) (XINT (keycode))) & 255;
3702 for (i = 0; i <= 15; strings = Fcdr (strings), i++)
3704 item = Fcar (strings);
3705 if (!NILP (item))
3707 CHECK_STRING (item, 2);
3708 strsize = XSTRING (item)->size;
3709 rawstring = (char *) xmalloc (strsize);
3710 bcopy (XSTRING (item)->data, rawstring, strsize);
3711 XRebindCode (rawkey, i << 11, rawstring, strsize);
3714 return Qnil;
3716 #endif /* not HAVE_X11 */
3718 #ifdef HAVE_X11
3719 Visual *
3720 select_visual (screen, depth)
3721 Screen *screen;
3722 unsigned int *depth;
3724 Visual *v;
3725 XVisualInfo *vinfo, vinfo_template;
3726 int n_visuals;
3728 v = DefaultVisualOfScreen (screen);
3730 #ifdef HAVE_X11R4
3731 vinfo_template.visualid = XVisualIDFromVisual (v);
3732 #else
3733 vinfo_template.visualid = v->visualid;
3734 #endif
3736 vinfo = XGetVisualInfo (x_current_display, VisualIDMask, &vinfo_template,
3737 &n_visuals);
3738 if (n_visuals != 1)
3739 fatal ("Can't get proper X visual info");
3741 if ((1 << vinfo->depth) == vinfo->colormap_size)
3742 *depth = vinfo->depth;
3743 else
3745 int i = 0;
3746 int n = vinfo->colormap_size - 1;
3747 while (n)
3749 n = n >> 1;
3750 i++;
3752 *depth = i;
3755 XFree ((char *) vinfo);
3756 return v;
3758 #endif /* HAVE_X11 */
3760 DEFUN ("x-open-connection", Fx_open_connection, Sx_open_connection,
3761 1, 2, 0, "Open a connection to an X server.\n\
3762 DISPLAY is the name of the display to connect to. Optional second\n\
3763 arg XRM_STRING is a string of resources in xrdb format.")
3764 (display, xrm_string)
3765 Lisp_Object display, xrm_string;
3767 unsigned int n_planes;
3768 unsigned char *xrm_option;
3770 CHECK_STRING (display, 0);
3771 if (x_current_display != 0)
3772 error ("X server connection is already initialized");
3774 /* This is what opens the connection and sets x_current_display.
3775 This also initializes many symbols, such as those used for input. */
3776 x_term_init (XSTRING (display)->data);
3778 #ifdef HAVE_X11
3779 XFASTINT (Vwindow_system_version) = 11;
3781 if (!EQ (xrm_string, Qnil))
3783 CHECK_STRING (xrm_string, 1);
3784 xrm_option = (unsigned char *) XSTRING (xrm_string);
3786 else
3787 xrm_option = (unsigned char *) 0;
3788 xrdb = x_load_resources (x_current_display, xrm_option, EMACS_CLASS);
3789 #ifdef HAVE_X11R5
3790 XrmSetDatabase (x_current_display, xrdb);
3791 #else
3792 x_current_display->db = xrdb;
3793 #endif
3795 x_screen = DefaultScreenOfDisplay (x_current_display);
3797 screen_visual = select_visual (x_screen, &n_planes);
3798 x_screen_planes = n_planes;
3799 x_screen_height = HeightOfScreen (x_screen);
3800 x_screen_width = WidthOfScreen (x_screen);
3802 /* X Atoms used by emacs. */
3803 Xatoms_of_xselect ();
3804 BLOCK_INPUT;
3805 Xatom_wm_protocols = XInternAtom (x_current_display, "WM_PROTOCOLS",
3806 False);
3807 Xatom_wm_take_focus = XInternAtom (x_current_display, "WM_TAKE_FOCUS",
3808 False);
3809 Xatom_wm_save_yourself = XInternAtom (x_current_display, "WM_SAVE_YOURSELF",
3810 False);
3811 Xatom_wm_delete_window = XInternAtom (x_current_display, "WM_DELETE_WINDOW",
3812 False);
3813 Xatom_wm_change_state = XInternAtom (x_current_display, "WM_CHANGE_STATE",
3814 False);
3815 Xatom_wm_configure_denied = XInternAtom (x_current_display,
3816 "WM_CONFIGURE_DENIED", False);
3817 Xatom_wm_window_moved = XInternAtom (x_current_display, "WM_MOVED",
3818 False);
3819 UNBLOCK_INPUT;
3820 #else /* not HAVE_X11 */
3821 XFASTINT (Vwindow_system_version) = 10;
3822 #endif /* not HAVE_X11 */
3823 return Qnil;
3826 DEFUN ("x-close-current-connection", Fx_close_current_connection,
3827 Sx_close_current_connection,
3828 0, 0, 0, "Close the connection to the current X server.")
3831 #ifdef HAVE_X11
3832 /* This is ONLY used when killing emacs; For switching displays
3833 we'll have to take care of setting CloseDownMode elsewhere. */
3835 if (x_current_display)
3837 BLOCK_INPUT;
3838 XSetCloseDownMode (x_current_display, DestroyAll);
3839 XCloseDisplay (x_current_display);
3841 else
3842 fatal ("No current X display connection to close\n");
3843 #endif
3844 return Qnil;
3847 DEFUN ("x-synchronize", Fx_synchronize, Sx_synchronize,
3848 1, 1, 0, "If ON is non-nil, report X errors as soon as the erring request is made.\n\
3849 If ON is nil, allow buffering of requests.\n\
3850 Turning on synchronization prohibits the Xlib routines from buffering\n\
3851 requests and seriously degrades performance, but makes debugging much\n\
3852 easier.")
3853 (on)
3854 Lisp_Object on;
3856 XSynchronize (x_current_display, !EQ (on, Qnil));
3858 return Qnil;
3862 syms_of_xfns ()
3864 /* This is zero if not using X windows. */
3865 x_current_display = 0;
3867 /* The section below is built by the lisp expression at the top of the file,
3868 just above where these variables are declared. */
3869 /*&&& init symbols here &&&*/
3870 Qauto_raise = intern ("auto-raise");
3871 staticpro (&Qauto_raise);
3872 Qauto_lower = intern ("auto-lower");
3873 staticpro (&Qauto_lower);
3874 Qbackground_color = intern ("background-color");
3875 staticpro (&Qbackground_color);
3876 Qbar = intern ("bar");
3877 staticpro (&Qbar);
3878 Qborder_color = intern ("border-color");
3879 staticpro (&Qborder_color);
3880 Qborder_width = intern ("border-width");
3881 staticpro (&Qborder_width);
3882 Qbox = intern ("box");
3883 staticpro (&Qbox);
3884 Qcursor_color = intern ("cursor-color");
3885 staticpro (&Qcursor_color);
3886 Qcursor_type = intern ("cursor-type");
3887 staticpro (&Qcursor_type);
3888 Qfont = intern ("font");
3889 staticpro (&Qfont);
3890 Qforeground_color = intern ("foreground-color");
3891 staticpro (&Qforeground_color);
3892 Qgeometry = intern ("geometry");
3893 staticpro (&Qgeometry);
3894 Qicon = intern ("icon");
3895 staticpro (&Qicon);
3896 Qicon_left = intern ("icon-left");
3897 staticpro (&Qicon_left);
3898 Qicon_top = intern ("icon-top");
3899 staticpro (&Qicon_top);
3900 Qicon_type = intern ("icon-type");
3901 staticpro (&Qicon_type);
3902 Qinternal_border_width = intern ("internal-border-width");
3903 staticpro (&Qinternal_border_width);
3904 Qleft = intern ("left");
3905 staticpro (&Qleft);
3906 Qmouse_color = intern ("mouse-color");
3907 staticpro (&Qmouse_color);
3908 Qnone = intern ("none");
3909 staticpro (&Qnone);
3910 Qparent_id = intern ("parent-id");
3911 staticpro (&Qparent_id);
3912 Qsuppress_icon = intern ("suppress-icon");
3913 staticpro (&Qsuppress_icon);
3914 Qtop = intern ("top");
3915 staticpro (&Qtop);
3916 Qundefined_color = intern ("undefined-color");
3917 staticpro (&Qundefined_color);
3918 Qvertical_scroll_bars = intern ("vertical-scroll-bars");
3919 staticpro (&Qvertical_scroll_bars);
3920 Qvisibility = intern ("visibility");
3921 staticpro (&Qvisibility);
3922 Qwindow_id = intern ("window-id");
3923 staticpro (&Qwindow_id);
3924 Qx_frame_parameter = intern ("x-frame-parameter");
3925 staticpro (&Qx_frame_parameter);
3926 /* This is the end of symbol initialization. */
3928 Fput (Qundefined_color, Qerror_conditions,
3929 Fcons (Qundefined_color, Fcons (Qerror, Qnil)));
3930 Fput (Qundefined_color, Qerror_message,
3931 build_string ("Undefined color"));
3933 init_x_parm_symbols ();
3935 DEFVAR_INT ("mouse-buffer-offset", &mouse_buffer_offset,
3936 "The buffer offset of the character under the pointer.");
3937 mouse_buffer_offset = 0;
3939 DEFVAR_INT ("x-pointer-shape", &Vx_pointer_shape,
3940 "The shape of the pointer when over text.");
3941 Vx_pointer_shape = Qnil;
3943 DEFVAR_INT ("x-nontext-pointer-shape", &Vx_nontext_pointer_shape,
3944 "The shape of the pointer when not over text.");
3945 Vx_nontext_pointer_shape = Qnil;
3947 DEFVAR_INT ("x-mode-pointer-shape", &Vx_mode_pointer_shape,
3948 "The shape of the pointer when over the mode line.");
3949 Vx_mode_pointer_shape = Qnil;
3951 DEFVAR_LISP ("x-cursor-fore-pixel", &Vx_cursor_fore_pixel,
3952 "A string indicating the foreground color of the cursor box.");
3953 Vx_cursor_fore_pixel = Qnil;
3955 DEFVAR_LISP ("mouse-grabbed", &Vmouse_depressed,
3956 "Non-nil if a mouse button is currently depressed.");
3957 Vmouse_depressed = Qnil;
3959 DEFVAR_LISP ("x-no-window-manager", &Vx_no_window_manager,
3960 "t if no X window manager is in use.");
3962 #ifdef HAVE_X11
3963 defsubr (&Sx_get_resource);
3964 #if 0
3965 defsubr (&Sx_draw_rectangle);
3966 defsubr (&Sx_erase_rectangle);
3967 defsubr (&Sx_contour_region);
3968 defsubr (&Sx_uncontour_region);
3969 #endif
3970 defsubr (&Sx_display_color_p);
3971 defsubr (&Sx_color_defined_p);
3972 defsubr (&Sx_server_vendor);
3973 defsubr (&Sx_server_version);
3974 defsubr (&Sx_display_pixel_width);
3975 defsubr (&Sx_display_pixel_height);
3976 defsubr (&Sx_display_mm_width);
3977 defsubr (&Sx_display_mm_height);
3978 defsubr (&Sx_display_screens);
3979 defsubr (&Sx_display_planes);
3980 defsubr (&Sx_display_color_cells);
3981 defsubr (&Sx_display_visual_class);
3982 defsubr (&Sx_display_backing_store);
3983 defsubr (&Sx_display_save_under);
3984 #if 0
3985 defsubr (&Sx_track_pointer);
3986 defsubr (&Sx_grab_pointer);
3987 defsubr (&Sx_ungrab_pointer);
3988 #endif
3989 #else
3990 defsubr (&Sx_get_default);
3991 defsubr (&Sx_store_cut_buffer);
3992 defsubr (&Sx_get_cut_buffer);
3993 defsubr (&Sx_set_face);
3994 #endif
3995 defsubr (&Sx_parse_geometry);
3996 defsubr (&Sx_create_frame);
3997 defsubr (&Sfocus_frame);
3998 defsubr (&Sunfocus_frame);
3999 #if 0
4000 defsubr (&Sx_horizontal_line);
4001 #endif
4002 defsubr (&Sx_rebind_key);
4003 defsubr (&Sx_rebind_keys);
4004 defsubr (&Sx_open_connection);
4005 defsubr (&Sx_close_current_connection);
4006 defsubr (&Sx_synchronize);
4008 /* This was used in the old event interface which used a separate
4009 event queue.*/
4010 #if 0
4011 defsubr (&Sx_mouse_events);
4012 defsubr (&Sx_get_mouse_event);
4013 #endif
4016 #endif /* HAVE_X_WINDOWS */