(auto-mode-alist): added pairs for .ms, .man, .mk, [Mm]akefile, .lex.
[emacs.git] / src / xfns.c
blob6b43d198667479f5472556ae1bba644f2223609c
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"
37 #ifdef HAVE_X_WINDOWS
38 extern void abort ();
40 #ifndef VMS
41 #include <X11/bitmaps/gray>
42 #else
43 #include "[.bitmaps]gray.xbm"
44 #endif
46 #define min(a,b) ((a) < (b) ? (a) : (b))
47 #define max(a,b) ((a) > (b) ? (a) : (b))
49 #ifdef HAVE_X11
50 /* X Resource data base */
51 static XrmDatabase xrdb;
53 /* The class of this X application. */
54 #define EMACS_CLASS "Emacs"
56 /* Title name and application name for X stuff. */
57 extern char *x_id_name;
59 /* The background and shape of the mouse pointer, and shape when not
60 over text or in the modeline. */
61 Lisp_Object Vx_pointer_shape, Vx_nontext_pointer_shape, Vx_mode_pointer_shape;
63 /* Color of chars displayed in cursor box. */
64 Lisp_Object Vx_cursor_fore_pixel;
66 /* The screen being used. */
67 static Screen *x_screen;
69 /* The X Visual we are using for X windows (the default) */
70 Visual *screen_visual;
72 /* Height of this X screen in pixels. */
73 int x_screen_height;
75 /* Width of this X screen in pixels. */
76 int x_screen_width;
78 /* Number of planes for this screen. */
79 int x_screen_planes;
81 /* Non nil if no window manager is in use. */
82 Lisp_Object Vx_no_window_manager;
84 /* `t' if a mouse button is depressed. */
86 Lisp_Object Vmouse_depressed;
88 extern unsigned int x_mouse_x, x_mouse_y, x_mouse_grabbed;
90 /* Atom for indicating window state to the window manager. */
91 extern Atom Xatom_wm_change_state;
93 /* Communication with window managers. */
94 extern Atom Xatom_wm_protocols;
96 /* Kinds of protocol things we may receive. */
97 extern Atom Xatom_wm_take_focus;
98 extern Atom Xatom_wm_save_yourself;
99 extern Atom Xatom_wm_delete_window;
101 /* Other WM communication */
102 extern Atom Xatom_wm_configure_denied; /* When our config request is denied */
103 extern Atom Xatom_wm_window_moved; /* When the WM moves us. */
105 #else /* X10 */
107 /* Default size of an Emacs window. */
108 static char *default_window = "=80x24+0+0";
110 #define MAXICID 80
111 char iconidentity[MAXICID];
112 #define ICONTAG "emacs@"
113 char minibuffer_iconidentity[MAXICID];
114 #define MINIBUFFER_ICONTAG "minibuffer@"
116 #endif /* X10 */
118 /* The last 23 bits of the timestamp of the last mouse button event. */
119 Time mouse_timestamp;
121 /* Evaluate this expression to rebuild the section of syms_of_xfns
122 that initializes and staticpros the symbols declared below. Note
123 that Emacs 18 has a bug that keeps C-x C-e from being able to
124 evaluate this expression.
126 (progn
127 ;; Accumulate a list of the symbols we want to initialize from the
128 ;; declarations at the top of the file.
129 (goto-char (point-min))
130 (search-forward "/\*&&& symbols declared here &&&*\/\n")
131 (let (symbol-list)
132 (while (looking-at "Lisp_Object \\(Q[a-z_]+\\)")
133 (setq symbol-list
134 (cons (buffer-substring (match-beginning 1) (match-end 1))
135 symbol-list))
136 (forward-line 1))
137 (setq symbol-list (nreverse symbol-list))
138 ;; Delete the section of syms_of_... where we initialize the symbols.
139 (search-forward "\n /\*&&& init symbols here &&&*\/\n")
140 (let ((start (point)))
141 (while (looking-at "^ Q")
142 (forward-line 2))
143 (kill-region start (point)))
144 ;; Write a new symbol initialization section.
145 (while symbol-list
146 (insert (format " %s = intern (\"" (car symbol-list)))
147 (let ((start (point)))
148 (insert (substring (car symbol-list) 1))
149 (subst-char-in-region start (point) ?_ ?-))
150 (insert (format "\");\n staticpro (&%s);\n" (car symbol-list)))
151 (setq symbol-list (cdr symbol-list)))))
155 /*&&& symbols declared here &&&*/
156 Lisp_Object Qauto_raise;
157 Lisp_Object Qauto_lower;
158 Lisp_Object Qbackground_color;
159 Lisp_Object Qbar;
160 Lisp_Object Qborder_color;
161 Lisp_Object Qborder_width;
162 Lisp_Object Qbox;
163 Lisp_Object Qcursor_color;
164 Lisp_Object Qcursor_type;
165 Lisp_Object Qfont;
166 Lisp_Object Qforeground_color;
167 Lisp_Object Qgeometry;
168 Lisp_Object Qicon;
169 Lisp_Object Qicon_left;
170 Lisp_Object Qicon_top;
171 Lisp_Object Qicon_type;
172 Lisp_Object Qinternal_border_width;
173 Lisp_Object Qleft;
174 Lisp_Object Qmouse_color;
175 Lisp_Object Qnone;
176 Lisp_Object Qparent_id;
177 Lisp_Object Qsuppress_icon;
178 Lisp_Object Qtop;
179 Lisp_Object Qundefined_color;
180 Lisp_Object Qvertical_scroll_bars;
181 Lisp_Object Qvisibility;
182 Lisp_Object Qwindow_id;
183 Lisp_Object Qx_frame_parameter;
185 /* The below are defined in frame.c. */
186 extern Lisp_Object Qheight, Qminibuffer, Qname, Qonly, Qwidth;
187 extern Lisp_Object Qunsplittable, Qmenu_bar_lines, Qicon;
189 extern Lisp_Object Vwindow_system_version;
191 /* Mouse map for clicks in windows. */
192 extern Lisp_Object Vglobal_mouse_map;
194 /* Points to table of defined typefaces. */
195 struct face *x_face_table[MAX_FACES_AND_GLYPHS];
197 /* Return the Emacs frame-object corresponding to an X window.
198 It could be the frame's main window or an icon window. */
200 struct frame *
201 x_window_to_frame (wdesc)
202 int wdesc;
204 Lisp_Object tail, frame;
205 struct frame *f;
207 for (tail = Vframe_list; CONSP (tail); tail = XCONS (tail)->cdr)
209 frame = XCONS (tail)->car;
210 if (XTYPE (frame) != Lisp_Frame)
211 continue;
212 f = XFRAME (frame);
213 if (FRAME_X_WINDOW (f) == wdesc
214 || f->display.x->icon_desc == wdesc)
215 return f;
217 return 0;
221 /* Connect the frame-parameter names for X frames
222 to the ways of passing the parameter values to the window system.
224 The name of a parameter, as a Lisp symbol,
225 has an `x-frame-parameter' property which is an integer in Lisp
226 but can be interpreted as an `enum x_frame_parm' in C. */
228 enum x_frame_parm
230 X_PARM_FOREGROUND_COLOR,
231 X_PARM_BACKGROUND_COLOR,
232 X_PARM_MOUSE_COLOR,
233 X_PARM_CURSOR_COLOR,
234 X_PARM_BORDER_COLOR,
235 X_PARM_ICON_TYPE,
236 X_PARM_FONT,
237 X_PARM_BORDER_WIDTH,
238 X_PARM_INTERNAL_BORDER_WIDTH,
239 X_PARM_NAME,
240 X_PARM_AUTORAISE,
241 X_PARM_AUTOLOWER,
242 X_PARM_VERT_SCROLL_BAR,
243 X_PARM_VISIBILITY,
244 X_PARM_MENU_BAR_LINES
248 struct x_frame_parm_table
250 char *name;
251 void (*setter)( /* struct frame *frame, Lisp_Object val, oldval */ );
254 void x_set_foreground_color ();
255 void x_set_background_color ();
256 void x_set_mouse_color ();
257 void x_set_cursor_color ();
258 void x_set_border_color ();
259 void x_set_cursor_type ();
260 void x_set_icon_type ();
261 void x_set_font ();
262 void x_set_border_width ();
263 void x_set_internal_border_width ();
264 void x_explicitly_set_name ();
265 void x_set_autoraise ();
266 void x_set_autolower ();
267 void x_set_vertical_scroll_bars ();
268 void x_set_visibility ();
269 void x_set_menu_bar_lines ();
271 static struct x_frame_parm_table x_frame_parms[] =
273 "foreground-color", x_set_foreground_color,
274 "background-color", x_set_background_color,
275 "mouse-color", x_set_mouse_color,
276 "cursor-color", x_set_cursor_color,
277 "border-color", x_set_border_color,
278 "cursor-type", x_set_cursor_type,
279 "icon-type", x_set_icon_type,
280 "font", x_set_font,
281 "border-width", x_set_border_width,
282 "internal-border-width", x_set_internal_border_width,
283 "name", x_explicitly_set_name,
284 "auto-raise", x_set_autoraise,
285 "auto-lower", x_set_autolower,
286 "vertical-scroll-bars", x_set_vertical_scroll_bars,
287 "visibility", x_set_visibility,
288 "menu-bar-lines", x_set_menu_bar_lines,
291 /* Attach the `x-frame-parameter' properties to
292 the Lisp symbol names of parameters relevant to X. */
294 init_x_parm_symbols ()
296 int i;
298 for (i = 0; i < sizeof (x_frame_parms) / sizeof (x_frame_parms[0]); i++)
299 Fput (intern (x_frame_parms[i].name), Qx_frame_parameter,
300 make_number (i));
303 /* Change the parameters of FRAME as specified by ALIST.
304 If a parameter is not specially recognized, do nothing;
305 otherwise call the `x_set_...' function for that parameter. */
307 void
308 x_set_frame_parameters (f, alist)
309 FRAME_PTR f;
310 Lisp_Object alist;
312 Lisp_Object tail;
314 /* If both of these parameters are present, it's more efficient to
315 set them both at once. So we wait until we've looked at the
316 entire list before we set them. */
317 Lisp_Object width, height;
319 /* Same here. */
320 Lisp_Object left, top;
322 XSET (width, Lisp_Int, FRAME_WIDTH (f));
323 XSET (height, Lisp_Int, FRAME_HEIGHT (f));
325 XSET (top, Lisp_Int, f->display.x->top_pos);
326 XSET (left, Lisp_Int, f->display.x->left_pos);
328 for (tail = alist; CONSP (tail); tail = Fcdr (tail))
330 Lisp_Object elt, prop, val;
332 elt = Fcar (tail);
333 prop = Fcar (elt);
334 val = Fcdr (elt);
336 if (EQ (prop, Qwidth))
337 width = val;
338 else if (EQ (prop, Qheight))
339 height = val;
340 else if (EQ (prop, Qtop))
341 top = val;
342 else if (EQ (prop, Qleft))
343 left = val;
344 else
346 register Lisp_Object tem;
347 tem = Fget (prop, Qx_frame_parameter);
348 if (XTYPE (tem) == Lisp_Int
349 && XINT (tem) >= 0
350 && XINT (tem) < sizeof (x_frame_parms)/sizeof (x_frame_parms[0]))
351 (*x_frame_parms[XINT (tem)].setter)(f, val,
352 get_frame_param (f, prop));
353 store_frame_param (f, prop, val);
357 /* Don't call these unless they've changed; the window may not actually
358 exist yet. */
360 Lisp_Object frame;
362 XSET (frame, Lisp_Frame, f);
363 if (XINT (width) != FRAME_WIDTH (f)
364 || XINT (height) != FRAME_HEIGHT (f))
365 Fset_frame_size (frame, width, height);
366 if (XINT (left) != f->display.x->left_pos
367 || XINT (top) != f->display.x->top_pos)
368 Fset_frame_position (frame, left, top);
372 /* Insert a description of internally-recorded parameters of frame X
373 into the parameter alist *ALISTPTR that is to be given to the user.
374 Only parameters that are specific to the X window system
375 and whose values are not correctly recorded in the frame's
376 param_alist need to be considered here. */
378 x_report_frame_params (f, alistptr)
379 struct frame *f;
380 Lisp_Object *alistptr;
382 char buf[16];
384 store_in_alist (alistptr, Qleft, make_number (f->display.x->left_pos));
385 store_in_alist (alistptr, Qtop, make_number (f->display.x->top_pos));
386 store_in_alist (alistptr, Qborder_width,
387 make_number (f->display.x->border_width));
388 store_in_alist (alistptr, Qinternal_border_width,
389 make_number (f->display.x->internal_border_width));
390 sprintf (buf, "%d", FRAME_X_WINDOW (f));
391 store_in_alist (alistptr, Qwindow_id,
392 build_string (buf));
393 store_in_alist (alistptr, Qvisibility,
394 (FRAME_VISIBLE_P (f) ? Qt
395 : FRAME_ICONIFIED_P (f) ? Qicon : Qnil));
398 /* Decide if color named COLOR is valid for the display
399 associated with the selected frame. */
401 defined_color (color, color_def)
402 char *color;
403 Color *color_def;
405 register int foo;
406 Colormap screen_colormap;
408 BLOCK_INPUT;
409 #ifdef HAVE_X11
410 screen_colormap
411 = DefaultColormap (x_current_display, XDefaultScreen (x_current_display));
413 foo = XParseColor (x_current_display, screen_colormap,
414 color, color_def)
415 && XAllocColor (x_current_display, screen_colormap, color_def);
416 #else
417 foo = XParseColor (color, color_def) && XGetHardwareColor (color_def);
418 #endif /* not HAVE_X11 */
419 UNBLOCK_INPUT;
421 if (foo)
422 return 1;
423 else
424 return 0;
427 /* Given a string ARG naming a color, compute a pixel value from it
428 suitable for screen F.
429 If F is not a color screen, return DEF (default) regardless of what
430 ARG says. */
433 x_decode_color (arg, def)
434 Lisp_Object arg;
435 int def;
437 Color cdef;
439 CHECK_STRING (arg, 0);
441 if (strcmp (XSTRING (arg)->data, "black") == 0)
442 return BLACK_PIX_DEFAULT;
443 else if (strcmp (XSTRING (arg)->data, "white") == 0)
444 return WHITE_PIX_DEFAULT;
446 #ifdef HAVE_X11
447 if (x_screen_planes == 1)
448 return def;
449 #else
450 if (DISPLAY_CELLS == 1)
451 return def;
452 #endif
454 if (defined_color (XSTRING (arg)->data, &cdef))
455 return cdef.pixel;
456 else
457 Fsignal (Qundefined_color, Fcons (arg, Qnil));
460 /* Functions called only from `x_set_frame_param'
461 to set individual parameters.
463 If FRAME_X_WINDOW (f) is 0,
464 the frame is being created and its X-window does not exist yet.
465 In that case, just record the parameter's new value
466 in the standard place; do not attempt to change the window. */
468 void
469 x_set_foreground_color (f, arg, oldval)
470 struct frame *f;
471 Lisp_Object arg, oldval;
473 f->display.x->foreground_pixel = x_decode_color (arg, BLACK_PIX_DEFAULT);
474 if (FRAME_X_WINDOW (f) != 0)
476 #ifdef HAVE_X11
477 BLOCK_INPUT;
478 XSetForeground (x_current_display, f->display.x->normal_gc,
479 f->display.x->foreground_pixel);
480 XSetBackground (x_current_display, f->display.x->reverse_gc,
481 f->display.x->foreground_pixel);
482 UNBLOCK_INPUT;
483 #endif /* HAVE_X11 */
484 if (FRAME_VISIBLE_P (f))
485 redraw_frame (f);
489 void
490 x_set_background_color (f, arg, oldval)
491 struct frame *f;
492 Lisp_Object arg, oldval;
494 Pixmap temp;
495 int mask;
497 f->display.x->background_pixel = x_decode_color (arg, WHITE_PIX_DEFAULT);
499 if (FRAME_X_WINDOW (f) != 0)
501 BLOCK_INPUT;
502 #ifdef HAVE_X11
503 /* The main frame area. */
504 XSetBackground (x_current_display, f->display.x->normal_gc,
505 f->display.x->background_pixel);
506 XSetForeground (x_current_display, f->display.x->reverse_gc,
507 f->display.x->background_pixel);
508 XSetWindowBackground (x_current_display, FRAME_X_WINDOW (f),
509 f->display.x->background_pixel);
511 #else
512 temp = XMakeTile (f->display.x->background_pixel);
513 XChangeBackground (FRAME_X_WINDOW (f), temp);
514 XFreePixmap (temp);
515 #endif /* not HAVE_X11 */
516 UNBLOCK_INPUT;
518 if (FRAME_VISIBLE_P (f))
519 redraw_frame (f);
523 void
524 x_set_mouse_color (f, arg, oldval)
525 struct frame *f;
526 Lisp_Object arg, oldval;
528 Cursor cursor, nontext_cursor, mode_cursor;
529 int mask_color;
531 if (!EQ (Qnil, arg))
532 f->display.x->mouse_pixel = x_decode_color (arg, BLACK_PIX_DEFAULT);
533 mask_color = f->display.x->background_pixel;
534 /* No invisible pointers. */
535 if (mask_color == f->display.x->mouse_pixel
536 && mask_color == f->display.x->background_pixel)
537 f->display.x->mouse_pixel = f->display.x->foreground_pixel;
539 BLOCK_INPUT;
540 #ifdef HAVE_X11
542 /* It's not okay to crash if the user selects a screwey cursor. */
543 x_catch_errors ();
545 if (!EQ (Qnil, Vx_pointer_shape))
547 CHECK_NUMBER (Vx_pointer_shape, 0);
548 cursor = XCreateFontCursor (x_current_display, XINT (Vx_pointer_shape));
550 else
551 cursor = XCreateFontCursor (x_current_display, XC_xterm);
552 x_check_errors ("bad text pointer cursor: %s");
554 if (!EQ (Qnil, Vx_nontext_pointer_shape))
556 CHECK_NUMBER (Vx_nontext_pointer_shape, 0);
557 nontext_cursor = XCreateFontCursor (x_current_display,
558 XINT (Vx_nontext_pointer_shape));
560 else
561 nontext_cursor = XCreateFontCursor (x_current_display, XC_left_ptr);
562 x_check_errors ("bad nontext pointer cursor: %s");
564 if (!EQ (Qnil, Vx_mode_pointer_shape))
566 CHECK_NUMBER (Vx_mode_pointer_shape, 0);
567 mode_cursor = XCreateFontCursor (x_current_display,
568 XINT (Vx_mode_pointer_shape));
570 else
571 mode_cursor = XCreateFontCursor (x_current_display, XC_xterm);
573 /* Check and report errors with the above calls. */
574 x_check_errors ("can't set cursor shape: %s");
575 x_uncatch_errors ();
578 XColor fore_color, back_color;
580 fore_color.pixel = f->display.x->mouse_pixel;
581 back_color.pixel = mask_color;
582 XQueryColor (x_current_display,
583 DefaultColormap (x_current_display,
584 DefaultScreen (x_current_display)),
585 &fore_color);
586 XQueryColor (x_current_display,
587 DefaultColormap (x_current_display,
588 DefaultScreen (x_current_display)),
589 &back_color);
590 XRecolorCursor (x_current_display, cursor,
591 &fore_color, &back_color);
592 XRecolorCursor (x_current_display, nontext_cursor,
593 &fore_color, &back_color);
594 XRecolorCursor (x_current_display, mode_cursor,
595 &fore_color, &back_color);
597 #else /* X10 */
598 cursor = XCreateCursor (16, 16, MouseCursor, MouseMask,
599 0, 0,
600 f->display.x->mouse_pixel,
601 f->display.x->background_pixel,
602 GXcopy);
603 #endif /* X10 */
605 if (FRAME_X_WINDOW (f) != 0)
607 XDefineCursor (XDISPLAY FRAME_X_WINDOW (f), cursor);
610 if (cursor != f->display.x->text_cursor && f->display.x->text_cursor != 0)
611 XFreeCursor (XDISPLAY f->display.x->text_cursor);
612 f->display.x->text_cursor = cursor;
613 #ifdef HAVE_X11
614 if (nontext_cursor != f->display.x->nontext_cursor
615 && f->display.x->nontext_cursor != 0)
616 XFreeCursor (XDISPLAY f->display.x->nontext_cursor);
617 f->display.x->nontext_cursor = nontext_cursor;
619 if (mode_cursor != f->display.x->modeline_cursor
620 && f->display.x->modeline_cursor != 0)
621 XFreeCursor (XDISPLAY f->display.x->modeline_cursor);
622 f->display.x->modeline_cursor = mode_cursor;
623 #endif /* HAVE_X11 */
625 XFlushQueue ();
626 UNBLOCK_INPUT;
629 void
630 x_set_cursor_color (f, arg, oldval)
631 struct frame *f;
632 Lisp_Object arg, oldval;
634 unsigned long fore_pixel;
636 if (!EQ (Vx_cursor_fore_pixel, Qnil))
637 fore_pixel = x_decode_color (Vx_cursor_fore_pixel, WHITE_PIX_DEFAULT);
638 else
639 fore_pixel = f->display.x->background_pixel;
640 f->display.x->cursor_pixel = x_decode_color (arg, BLACK_PIX_DEFAULT);
642 /* Make sure that the cursor color differs from the background color. */
643 if (f->display.x->cursor_pixel == f->display.x->background_pixel)
645 f->display.x->cursor_pixel == f->display.x->mouse_pixel;
646 if (f->display.x->cursor_pixel == fore_pixel)
647 fore_pixel = f->display.x->background_pixel;
650 if (FRAME_X_WINDOW (f) != 0)
652 #ifdef HAVE_X11
653 BLOCK_INPUT;
654 XSetBackground (x_current_display, f->display.x->cursor_gc,
655 f->display.x->cursor_pixel);
656 XSetForeground (x_current_display, f->display.x->cursor_gc,
657 fore_pixel);
658 UNBLOCK_INPUT;
659 #endif /* HAVE_X11 */
661 if (FRAME_VISIBLE_P (f))
663 x_display_cursor (f, 0);
664 x_display_cursor (f, 1);
669 /* Set the border-color of frame F to value described by ARG.
670 ARG can be a string naming a color.
671 The border-color is used for the border that is drawn by the X server.
672 Note that this does not fully take effect if done before
673 F has an x-window; it must be redone when the window is created.
675 Note: this is done in two routines because of the way X10 works.
677 Note: under X11, this is normally the province of the window manager,
678 and so emacs' border colors may be overridden. */
680 void
681 x_set_border_color (f, arg, oldval)
682 struct frame *f;
683 Lisp_Object arg, oldval;
685 unsigned char *str;
686 int pix;
688 CHECK_STRING (arg, 0);
689 str = XSTRING (arg)->data;
691 #ifndef HAVE_X11
692 if (!strcmp (str, "grey") || !strcmp (str, "Grey")
693 || !strcmp (str, "gray") || !strcmp (str, "Gray"))
694 pix = -1;
695 else
696 #endif /* X10 */
698 pix = x_decode_color (arg, BLACK_PIX_DEFAULT);
700 x_set_border_pixel (f, pix);
703 /* Set the border-color of frame F to pixel value PIX.
704 Note that this does not fully take effect if done before
705 F has an x-window. */
707 x_set_border_pixel (f, pix)
708 struct frame *f;
709 int pix;
711 f->display.x->border_pixel = pix;
713 if (FRAME_X_WINDOW (f) != 0 && f->display.x->border_width > 0)
715 Pixmap temp;
716 int mask;
718 BLOCK_INPUT;
719 #ifdef HAVE_X11
720 XSetWindowBorder (x_current_display, FRAME_X_WINDOW (f),
721 pix);
722 #else
723 if (pix < 0)
724 temp = XMakePixmap ((Bitmap) XStoreBitmap (gray_width, gray_height,
725 gray_bits),
726 BLACK_PIX_DEFAULT, WHITE_PIX_DEFAULT);
727 else
728 temp = XMakeTile (pix);
729 XChangeBorder (FRAME_X_WINDOW (f), temp);
730 XFreePixmap (XDISPLAY temp);
731 #endif /* not HAVE_X11 */
732 UNBLOCK_INPUT;
734 if (FRAME_VISIBLE_P (f))
735 redraw_frame (f);
739 void
740 x_set_cursor_type (f, arg, oldval)
741 FRAME_PTR f;
742 Lisp_Object arg, oldval;
744 if (EQ (arg, Qbar))
745 FRAME_DESIRED_CURSOR (f) = bar_cursor;
746 else if (EQ (arg, Qbox))
747 FRAME_DESIRED_CURSOR (f) = filled_box_cursor;
748 else
749 error
750 ("the `cursor-type' frame parameter should be either `bar' or `box'");
752 /* Make sure the cursor gets redrawn. This is overkill, but how
753 often do people change cursor types? */
754 update_mode_lines++;
757 void
758 x_set_icon_type (f, arg, oldval)
759 struct frame *f;
760 Lisp_Object arg, oldval;
762 Lisp_Object tem;
763 int result;
765 if (EQ (oldval, Qnil) == EQ (arg, Qnil))
766 return;
768 BLOCK_INPUT;
769 if (NILP (arg))
770 result = x_text_icon (f, 0);
771 else
772 result = x_bitmap_icon (f);
774 if (result)
776 UNBLOCK_INPUT;
777 error ("No icon window available.");
780 /* If the window was unmapped (and its icon was mapped),
781 the new icon is not mapped, so map the window in its stead. */
782 if (FRAME_VISIBLE_P (f))
783 XMapWindow (XDISPLAY FRAME_X_WINDOW (f));
785 XFlushQueue ();
786 UNBLOCK_INPUT;
789 void
790 x_set_font (f, arg, oldval)
791 struct frame *f;
792 Lisp_Object arg, oldval;
794 unsigned char *name;
795 int result;
797 CHECK_STRING (arg, 1);
798 name = XSTRING (arg)->data;
800 BLOCK_INPUT;
801 result = x_new_font (f, name);
802 UNBLOCK_INPUT;
804 if (result)
805 error ("Font \"%s\" is not defined", name);
808 void
809 x_set_border_width (f, arg, oldval)
810 struct frame *f;
811 Lisp_Object arg, oldval;
813 CHECK_NUMBER (arg, 0);
815 if (XINT (arg) == f->display.x->border_width)
816 return;
818 if (FRAME_X_WINDOW (f) != 0)
819 error ("Cannot change the border width of a window");
821 f->display.x->border_width = XINT (arg);
824 void
825 x_set_internal_border_width (f, arg, oldval)
826 struct frame *f;
827 Lisp_Object arg, oldval;
829 int mask;
830 int old = f->display.x->internal_border_width;
832 CHECK_NUMBER (arg, 0);
833 f->display.x->internal_border_width = XINT (arg);
834 if (f->display.x->internal_border_width < 0)
835 f->display.x->internal_border_width = 0;
837 if (f->display.x->internal_border_width == old)
838 return;
840 if (FRAME_X_WINDOW (f) != 0)
842 BLOCK_INPUT;
843 x_set_window_size (f, f->width, f->height);
844 #if 0
845 x_set_resize_hint (f);
846 #endif
847 XFlushQueue ();
848 UNBLOCK_INPUT;
849 SET_FRAME_GARBAGED (f);
853 void
854 x_set_visibility (f, value, oldval)
855 struct frame *f;
856 Lisp_Object value, oldval;
858 Lisp_Object frame;
859 XSET (frame, Lisp_Frame, f);
861 if (NILP (value))
862 Fmake_frame_invisible (frame);
863 else if (EQ (value, Qicon))
864 Ficonify_frame (frame);
865 else
866 Fmake_frame_visible (frame);
869 static void
870 x_set_menu_bar_lines_1 (window, n)
871 Lisp_Object window;
872 int n;
874 for (; !NILP (window); window = XWINDOW (window)->next)
876 struct window *w = XWINDOW (window);
878 w->top += n;
880 if (!NILP (w->vchild))
881 x_set_menu_bar_lines_1 (w->vchild);
883 if (!NILP (w->hchild))
884 x_set_menu_bar_lines_1 (w->hchild);
888 void
889 x_set_menu_bar_lines (f, value, oldval)
890 struct frame *f;
891 Lisp_Object value, oldval;
893 int nlines;
894 int olines = FRAME_MENU_BAR_LINES (f);
896 if (XTYPE (value) == Lisp_Int)
897 nlines = XINT (value);
898 else
899 nlines = 0;
901 FRAME_MENU_BAR_LINES (f) = nlines;
902 x_set_menu_bar_lines_1 (f->root_window, nlines - olines);
903 x_set_window_size (f, FRAME_WIDTH (f),
904 FRAME_HEIGHT (f) + nlines - olines);
907 /* Change the name of frame F to ARG. If ARG is nil, set F's name to
908 x_id_name.
910 If EXPLICIT is non-zero, that indicates that lisp code is setting the
911 name; if ARG is a string, set F's name to ARG and set
912 F->explicit_name; if ARG is Qnil, then clear F->explicit_name.
914 If EXPLICIT is zero, that indicates that Emacs redisplay code is
915 suggesting a new name, which lisp code should override; if
916 F->explicit_name is set, ignore the new name; otherwise, set it. */
918 void
919 x_set_name (f, name, explicit)
920 struct frame *f;
921 Lisp_Object name;
922 int explicit;
924 /* Make sure that requests from lisp code override requests from
925 Emacs redisplay code. */
926 if (explicit)
928 /* If we're switching from explicit to implicit, we had better
929 update the mode lines and thereby update the title. */
930 if (f->explicit_name && NILP (name))
931 update_mode_lines = 1;
933 f->explicit_name = ! NILP (name);
935 else if (f->explicit_name)
936 return;
938 /* If NAME is nil, set the name to the x_id_name. */
939 if (NILP (name))
940 name = build_string (x_id_name);
941 else
942 CHECK_STRING (name, 0);
944 /* Don't change the name if it's already NAME. */
945 if (! NILP (Fstring_equal (name, f->name)))
946 return;
948 if (FRAME_X_WINDOW (f))
950 BLOCK_INPUT;
952 #ifdef HAVE_X11R4
954 XTextProperty text;
955 text.value = XSTRING (name)->data;
956 text.encoding = XA_STRING;
957 text.format = 8;
958 text.nitems = XSTRING (name)->size;
959 XSetWMName (x_current_display, FRAME_X_WINDOW (f), &text);
960 XSetWMIconName (x_current_display, FRAME_X_WINDOW (f), &text);
962 #else
963 XSetIconName (XDISPLAY FRAME_X_WINDOW (f),
964 XSTRING (name)->data);
965 XStoreName (XDISPLAY FRAME_X_WINDOW (f),
966 XSTRING (name)->data);
967 #endif
969 UNBLOCK_INPUT;
972 f->name = name;
975 /* This function should be called when the user's lisp code has
976 specified a name for the frame; the name will override any set by the
977 redisplay code. */
978 void
979 x_explicitly_set_name (f, arg, oldval)
980 FRAME_PTR f;
981 Lisp_Object arg, oldval;
983 x_set_name (f, arg, 1);
986 /* This function should be called by Emacs redisplay code to set the
987 name; names set this way will never override names set by the user's
988 lisp code. */
989 void
990 x_implicitly_set_name (f, arg, oldval)
991 FRAME_PTR f;
992 Lisp_Object arg, oldval;
994 x_set_name (f, arg, 0);
997 void
998 x_set_autoraise (f, arg, oldval)
999 struct frame *f;
1000 Lisp_Object arg, oldval;
1002 f->auto_raise = !EQ (Qnil, arg);
1005 void
1006 x_set_autolower (f, arg, oldval)
1007 struct frame *f;
1008 Lisp_Object arg, oldval;
1010 f->auto_lower = !EQ (Qnil, arg);
1013 void
1014 x_set_vertical_scroll_bars (f, arg, oldval)
1015 struct frame *f;
1016 Lisp_Object arg, oldval;
1018 if (NILP (arg) != ! FRAME_HAS_VERTICAL_SCROLL_BARS (f))
1020 FRAME_HAS_VERTICAL_SCROLL_BARS (f) = ! NILP (arg);
1022 /* We set this parameter before creating the X window for the
1023 frame, so we can get the geometry right from the start.
1024 However, if the window hasn't been created yet, we shouldn't
1025 call x_set_window_size. */
1026 if (FRAME_X_WINDOW (f))
1027 x_set_window_size (f, FRAME_WIDTH (f), FRAME_HEIGHT (f));
1031 #ifdef HAVE_X11
1032 int n_faces;
1034 #if 0
1035 /* I believe this function is obsolete with respect to the new face display
1036 changes. */
1037 x_set_face (scr, font, background, foreground, stipple)
1038 struct frame *scr;
1039 XFontStruct *font;
1040 unsigned long background, foreground;
1041 Pixmap stipple;
1043 XGCValues gc_values;
1044 GC temp_gc;
1045 unsigned long gc_mask;
1046 struct face *new_face;
1047 unsigned int width = 16;
1048 unsigned int height = 16;
1050 if (n_faces == MAX_FACES_AND_GLYPHS)
1051 return 1;
1053 /* Create the Graphics Context. */
1054 gc_values.font = font->fid;
1055 gc_values.foreground = foreground;
1056 gc_values.background = background;
1057 gc_values.line_width = 0;
1058 gc_mask = GCLineWidth | GCFont | GCForeground | GCBackground;
1059 if (stipple)
1061 gc_values.stipple
1062 = XCreateBitmapFromData (x_current_display, ROOT_WINDOW,
1063 (char *) stipple, width, height);
1064 gc_mask |= GCStipple;
1067 temp_gc = XCreateGC (x_current_display, FRAME_X_WINDOW (scr),
1068 gc_mask, &gc_values);
1069 if (!temp_gc)
1070 return 1;
1071 new_face = (struct face *) xmalloc (sizeof (struct face));
1072 if (!new_face)
1074 XFreeGC (x_current_display, temp_gc);
1075 return 1;
1078 new_face->font = font;
1079 new_face->foreground = foreground;
1080 new_face->background = background;
1081 new_face->face_gc = temp_gc;
1082 if (stipple)
1083 new_face->stipple = gc_values.stipple;
1085 x_face_table[++n_faces] = new_face;
1086 return 1;
1088 #endif
1090 x_set_glyph (scr, glyph)
1094 #if 0
1095 DEFUN ("x-set-face-font", Fx_set_face_font, Sx_set_face_font, 4, 2, 0,
1096 "Specify face table entry FACE-CODE to be the font named by FONT,\n\
1097 in colors FOREGROUND and BACKGROUND.")
1098 (face_code, font_name, foreground, background)
1099 Lisp_Object face_code;
1100 Lisp_Object font_name;
1101 Lisp_Object foreground;
1102 Lisp_Object background;
1104 register struct face *fp; /* Current face info. */
1105 register int fn; /* Face number. */
1106 register FONT_TYPE *f; /* Font data structure. */
1107 unsigned char *newname;
1108 int fg, bg;
1109 GC temp_gc;
1110 XGCValues gc_values;
1112 /* Need to do something about this. */
1113 Drawable drawable = FRAME_X_WINDOW (selected_frame);
1115 CHECK_NUMBER (face_code, 1);
1116 CHECK_STRING (font_name, 2);
1118 if (EQ (foreground, Qnil) || EQ (background, Qnil))
1120 fg = selected_frame->display.x->foreground_pixel;
1121 bg = selected_frame->display.x->background_pixel;
1123 else
1125 CHECK_NUMBER (foreground, 0);
1126 CHECK_NUMBER (background, 1);
1128 fg = x_decode_color (XINT (foreground), BLACK_PIX_DEFAULT);
1129 bg = x_decode_color (XINT (background), WHITE_PIX_DEFAULT);
1132 fn = XINT (face_code);
1133 if ((fn < 1) || (fn > 255))
1134 error ("Invalid face code, %d", fn);
1136 newname = XSTRING (font_name)->data;
1137 BLOCK_INPUT;
1138 f = (*newname == 0 ? 0 : XGetFont (newname));
1139 UNBLOCK_INPUT;
1140 if (f == 0)
1141 error ("Font \"%s\" is not defined", newname);
1143 fp = x_face_table[fn];
1144 if (fp == 0)
1146 x_face_table[fn] = fp = (struct face *) xmalloc (sizeof (struct face));
1147 bzero (fp, sizeof (struct face));
1148 fp->face_type = x_pixmap;
1150 else if (FACE_IS_FONT (fn))
1152 BLOCK_INPUT;
1153 XFreeGC (FACE_FONT (fn));
1154 UNBLOCK_INPUT;
1156 else if (FACE_IS_IMAGE (fn)) /* This should not happen... */
1158 BLOCK_INPUT;
1159 XFreePixmap (x_current_display, FACE_IMAGE (fn));
1160 fp->face_type = x_font;
1161 UNBLOCK_INPUT;
1163 else
1164 abort ();
1166 fp->face_GLYPH.font_desc.font = f;
1167 gc_values.font = f->fid;
1168 gc_values.foreground = fg;
1169 gc_values.background = bg;
1170 fp->face_GLYPH.font_desc.face_gc = XCreateGC (x_current_display,
1171 drawable, GCFont | GCForeground
1172 | GCBackground, &gc_values);
1173 fp->face_GLYPH.font_desc.font_width = FONT_WIDTH (f);
1174 fp->face_GLYPH.font_desc.font_height = FONT_HEIGHT (f);
1176 return face_code;
1178 #endif
1179 #else /* X10 */
1180 DEFUN ("x-set-face", Fx_set_face, Sx_set_face, 4, 4, 0,
1181 "Specify face table entry FACE-CODE to be the font named by FONT,\n\
1182 in colors FOREGROUND and BACKGROUND.")
1183 (face_code, font_name, foreground, background)
1184 Lisp_Object face_code;
1185 Lisp_Object font_name;
1186 Lisp_Object foreground;
1187 Lisp_Object background;
1189 register struct face *fp; /* Current face info. */
1190 register int fn; /* Face number. */
1191 register FONT_TYPE *f; /* Font data structure. */
1192 unsigned char *newname;
1194 CHECK_NUMBER (face_code, 1);
1195 CHECK_STRING (font_name, 2);
1197 fn = XINT (face_code);
1198 if ((fn < 1) || (fn > 255))
1199 error ("Invalid face code, %d", fn);
1201 /* Ask the server to find the specified font. */
1202 newname = XSTRING (font_name)->data;
1203 BLOCK_INPUT;
1204 f = (*newname == 0 ? 0 : XGetFont (newname));
1205 UNBLOCK_INPUT;
1206 if (f == 0)
1207 error ("Font \"%s\" is not defined", newname);
1209 /* Get the face structure for face_code in the face table.
1210 Make sure it exists. */
1211 fp = x_face_table[fn];
1212 if (fp == 0)
1214 x_face_table[fn] = fp = (struct face *) xmalloc (sizeof (struct face));
1215 bzero (fp, sizeof (struct face));
1218 /* If this face code already exists, get rid of the old font. */
1219 if (fp->font != 0 && fp->font != f)
1221 BLOCK_INPUT;
1222 XLoseFont (fp->font);
1223 UNBLOCK_INPUT;
1226 /* Store the specified information in FP. */
1227 fp->fg = x_decode_color (foreground, BLACK_PIX_DEFAULT);
1228 fp->bg = x_decode_color (background, WHITE_PIX_DEFAULT);
1229 fp->font = f;
1231 return face_code;
1233 #endif /* X10 */
1235 #if 0
1236 /* This is excluded because there is no painless way
1237 to get or to remember the name of the font. */
1239 DEFUN ("x-get-face", Fx_get_face, Sx_get_face, 1, 1, 0,
1240 "Get data defining face code FACE. FACE is an integer.\n\
1241 The value is a list (FONT FG-COLOR BG-COLOR).")
1242 (face)
1243 Lisp_Object face;
1245 register struct face *fp; /* Current face info. */
1246 register int fn; /* Face number. */
1248 CHECK_NUMBER (face, 1);
1249 fn = XINT (face);
1250 if ((fn < 1) || (fn > 255))
1251 error ("Invalid face code, %d", fn);
1253 /* Make sure the face table exists and this face code is defined. */
1254 if (x_face_table == 0 || x_face_table[fn] == 0)
1255 return Qnil;
1257 fp = x_face_table[fn];
1259 return Fcons (build_string (fp->name),
1260 Fcons (make_number (fp->fg),
1261 Fcons (make_number (fp->bg), Qnil)));
1263 #endif /* 0 */
1265 /* Subroutines of creating an X frame. */
1267 #ifdef HAVE_X11
1268 extern char *x_get_string_resource ();
1269 extern XrmDatabase x_load_resources ();
1271 DEFUN ("x-get-resource", Fx_get_resource, Sx_get_resource, 2, 4, 0,
1272 "Return the value of ATTRIBUTE, of class CLASS, from the X defaults database.\n\
1273 This uses `INSTANCE.ATTRIBUTE' as the key and `Emacs.CLASS' as the\n\
1274 class, where INSTANCE is the name under which Emacs was invoked.\n\
1276 The optional arguments COMPONENT and SUBCLASS add to the key and the\n\
1277 class, respectively. You must specify both of them or neither.\n\
1278 If you specify them, the key is `INSTANCE.COMPONENT.ATTRIBUTE'\n\
1279 and the class is `Emacs.CLASS.SUBCLASS'.")
1280 (attribute, class, component, subclass)
1281 Lisp_Object attribute, class, component, subclass;
1283 register char *value;
1284 char *name_key;
1285 char *class_key;
1287 CHECK_STRING (attribute, 0);
1288 CHECK_STRING (class, 0);
1290 if (!NILP (component))
1291 CHECK_STRING (component, 1);
1292 if (!NILP (subclass))
1293 CHECK_STRING (subclass, 2);
1294 if (NILP (component) != NILP (subclass))
1295 error ("x-get-resource: must specify both COMPONENT and SUBCLASS or neither");
1297 if (NILP (component))
1299 /* Allocate space for the components, the dots which separate them,
1300 and the final '\0'. */
1301 name_key = (char *) alloca (XSTRING (Vinvocation_name)->size
1302 + XSTRING (attribute)->size
1303 + 2);
1304 class_key = (char *) alloca ((sizeof (EMACS_CLASS) - 1)
1305 + XSTRING (class)->size
1306 + 2);
1308 sprintf (name_key, "%s.%s",
1309 XSTRING (Vinvocation_name)->data,
1310 XSTRING (attribute)->data);
1311 sprintf (class_key, "%s.%s",
1312 EMACS_CLASS,
1313 XSTRING (class)->data);
1315 else
1317 name_key = (char *) alloca (XSTRING (Vinvocation_name)->size
1318 + XSTRING (component)->size
1319 + XSTRING (attribute)->size
1320 + 3);
1322 class_key = (char *) alloca ((sizeof (EMACS_CLASS) - 1)
1323 + XSTRING (class)->size
1324 + XSTRING (subclass)->size
1325 + 3);
1327 sprintf (name_key, "%s.%s.%s",
1328 XSTRING (Vinvocation_name)->data,
1329 XSTRING (component)->data,
1330 XSTRING (attribute)->data);
1331 sprintf (class_key, "%s.%s",
1332 EMACS_CLASS,
1333 XSTRING (class)->data,
1334 XSTRING (subclass)->data);
1337 value = x_get_string_resource (xrdb, name_key, class_key);
1339 if (value != (char *) 0)
1340 return build_string (value);
1341 else
1342 return Qnil;
1345 #else /* X10 */
1347 DEFUN ("x-get-default", Fx_get_default, Sx_get_default, 1, 1, 0,
1348 "Get X default ATTRIBUTE from the system, or nil if no default.\n\
1349 Value is a string (when not nil) and ATTRIBUTE is also a string.\n\
1350 The defaults are specified in the file `~/.Xdefaults'.")
1351 (arg)
1352 Lisp_Object arg;
1354 register unsigned char *value;
1356 CHECK_STRING (arg, 1);
1358 value = (unsigned char *) XGetDefault (XDISPLAY
1359 XSTRING (Vinvocation_name)->data,
1360 XSTRING (arg)->data);
1361 if (value == 0)
1362 /* Try reversing last two args, in case this is the buggy version of X. */
1363 value = (unsigned char *) XGetDefault (XDISPLAY
1364 XSTRING (arg)->data,
1365 XSTRING (Vinvocation_name)->data);
1366 if (value != 0)
1367 return build_string (value);
1368 else
1369 return (Qnil);
1372 #define Fx_get_resource(attribute, class, component, subclass) \
1373 Fx_get_default(attribute)
1375 #endif /* X10 */
1377 /* Types we might convert a resource string into. */
1378 enum resource_types
1380 number, boolean, string, symbol,
1383 /* Return the value of parameter PARAM.
1385 First search ALIST, then Vdefault_frame_alist, then the X defaults
1386 database, using ATTRIBUTE as the attribute name and CLASS as its class.
1388 Convert the resource to the type specified by desired_type.
1390 If no default is specified, return Qunbound. If you call
1391 x_get_arg, make sure you deal with Qunbound in a reasonable way,
1392 and don't let it get stored in any lisp-visible variables! */
1394 static Lisp_Object
1395 x_get_arg (alist, param, attribute, class, type)
1396 Lisp_Object alist, param;
1397 char *attribute;
1398 char *class;
1399 enum resource_types type;
1401 register Lisp_Object tem;
1403 tem = Fassq (param, alist);
1404 if (EQ (tem, Qnil))
1405 tem = Fassq (param, Vdefault_frame_alist);
1406 if (EQ (tem, Qnil))
1409 if (attribute)
1411 tem = Fx_get_resource (build_string (attribute),
1412 build_string (class),
1413 Qnil, Qnil);
1415 if (NILP (tem))
1416 return Qunbound;
1418 switch (type)
1420 case number:
1421 return make_number (atoi (XSTRING (tem)->data));
1423 case boolean:
1424 tem = Fdowncase (tem);
1425 if (!strcmp (XSTRING (tem)->data, "on")
1426 || !strcmp (XSTRING (tem)->data, "true"))
1427 return Qt;
1428 else
1429 return Qnil;
1431 case string:
1432 return tem;
1434 case symbol:
1435 /* As a special case, we map the values `true' and `on'
1436 to Qt, and `false' and `off' to Qnil. */
1438 Lisp_Object lower = Fdowncase (tem);
1439 if (!strcmp (XSTRING (tem)->data, "on")
1440 || !strcmp (XSTRING (tem)->data, "true"))
1441 return Qt;
1442 else if (!strcmp (XSTRING (tem)->data, "off")
1443 || !strcmp (XSTRING (tem)->data, "false"))
1444 return Qnil;
1445 else
1446 return intern (tem);
1449 default:
1450 abort ();
1453 else
1454 return Qunbound;
1456 return Fcdr (tem);
1459 /* Record in frame F the specified or default value according to ALIST
1460 of the parameter named PARAM (a Lisp symbol).
1461 If no value is specified for PARAM, look for an X default for XPROP
1462 on the frame named NAME.
1463 If that is not found either, use the value DEFLT. */
1465 static Lisp_Object
1466 x_default_parameter (f, alist, prop, deflt, xprop, xclass, type)
1467 struct frame *f;
1468 Lisp_Object alist;
1469 Lisp_Object prop;
1470 Lisp_Object deflt;
1471 char *xprop;
1472 char *xclass;
1473 enum resource_types type;
1475 Lisp_Object tem;
1477 tem = x_get_arg (alist, prop, xprop, xclass, type);
1478 if (EQ (tem, Qunbound))
1479 tem = deflt;
1480 x_set_frame_parameters (f, Fcons (Fcons (prop, tem), Qnil));
1481 return tem;
1484 DEFUN ("x-parse-geometry", Fx_parse_geometry, Sx_parse_geometry, 1, 1, 0,
1485 "Parse an X-style geometry string STRING.\n\
1486 Returns an alist of the form ((top . TOP), (left . LEFT) ... ).")
1487 (string)
1488 Lisp_Object string;
1490 int geometry, x, y;
1491 unsigned int width, height;
1492 Lisp_Object values[4];
1494 CHECK_STRING (string, 0);
1496 geometry = XParseGeometry ((char *) XSTRING (string)->data,
1497 &x, &y, &width, &height);
1499 switch (geometry & 0xf) /* Mask out {X,Y}Negative */
1501 case (XValue | YValue):
1502 /* What's one pixel among friends?
1503 Perhaps fix this some day by returning symbol `extreme-top'... */
1504 if (x == 0 && (geometry & XNegative))
1505 x = -1;
1506 if (y == 0 && (geometry & YNegative))
1507 y = -1;
1508 values[0] = Fcons (Qleft, make_number (x));
1509 values[1] = Fcons (Qtop, make_number (y));
1510 return Flist (2, values);
1511 break;
1513 case (WidthValue | HeightValue):
1514 values[0] = Fcons (Qwidth, make_number (width));
1515 values[1] = Fcons (Qheight, make_number (height));
1516 return Flist (2, values);
1517 break;
1519 case (XValue | YValue | WidthValue | HeightValue):
1520 if (x == 0 && (geometry & XNegative))
1521 x = -1;
1522 if (y == 0 && (geometry & YNegative))
1523 y = -1;
1524 values[0] = Fcons (Qwidth, make_number (width));
1525 values[1] = Fcons (Qheight, make_number (height));
1526 values[2] = Fcons (Qleft, make_number (x));
1527 values[3] = Fcons (Qtop, make_number (y));
1528 return Flist (4, values);
1529 break;
1531 case 0:
1532 return Qnil;
1534 default:
1535 error ("Must specify x and y value, and/or width and height");
1539 #ifdef HAVE_X11
1540 /* Calculate the desired size and position of this window,
1541 or set rubber-band prompting if none. */
1543 #define DEFAULT_ROWS 40
1544 #define DEFAULT_COLS 80
1546 static int
1547 x_figure_window_size (f, parms)
1548 struct frame *f;
1549 Lisp_Object parms;
1551 register Lisp_Object tem0, tem1;
1552 int height, width, left, top;
1553 register int geometry;
1554 long window_prompting = 0;
1556 /* Default values if we fall through.
1557 Actually, if that happens we should get
1558 window manager prompting. */
1559 f->width = DEFAULT_COLS;
1560 f->height = DEFAULT_ROWS;
1561 f->display.x->top_pos = 1;
1562 f->display.x->left_pos = 1;
1564 tem0 = x_get_arg (parms, Qheight, 0, 0, number);
1565 tem1 = x_get_arg (parms, Qwidth, 0, 0, number);
1566 if (! EQ (tem0, Qunbound) && ! EQ (tem1, Qunbound))
1568 CHECK_NUMBER (tem0, 0);
1569 CHECK_NUMBER (tem1, 0);
1570 f->height = XINT (tem0);
1571 f->width = XINT (tem1);
1572 window_prompting |= USSize;
1574 else if (! EQ (tem0, Qunbound) || ! EQ (tem1, Qunbound))
1575 error ("Must specify *both* height and width");
1577 f->display.x->vertical_scroll_bar_extra =
1578 (FRAME_HAS_VERTICAL_SCROLL_BARS (f)
1579 ? VERTICAL_SCROLL_BAR_PIXEL_WIDTH (f)
1580 : 0);
1581 f->display.x->pixel_width = CHAR_TO_PIXEL_WIDTH (f, f->width);
1582 f->display.x->pixel_height = CHAR_TO_PIXEL_HEIGHT (f, f->height);
1584 tem0 = x_get_arg (parms, Qtop, 0, 0, number);
1585 tem1 = x_get_arg (parms, Qleft, 0, 0, number);
1586 if (! EQ (tem0, Qunbound) && ! EQ (tem1, Qunbound))
1588 CHECK_NUMBER (tem0, 0);
1589 CHECK_NUMBER (tem1, 0);
1590 f->display.x->top_pos = XINT (tem0);
1591 f->display.x->left_pos = XINT (tem1);
1592 x_calc_absolute_position (f);
1593 window_prompting |= USPosition;
1595 else if (! EQ (tem0, Qunbound) || ! EQ (tem1, Qunbound))
1596 error ("Must specify *both* top and left corners");
1598 switch (window_prompting)
1600 case USSize | USPosition:
1601 return window_prompting;
1602 break;
1604 case USSize: /* Got the size, need the position. */
1605 window_prompting |= PPosition;
1606 return window_prompting;
1607 break;
1609 case USPosition: /* Got the position, need the size. */
1610 window_prompting |= PSize;
1611 return window_prompting;
1612 break;
1614 case 0: /* Got nothing, take both from geometry. */
1615 window_prompting |= PPosition | PSize;
1616 return window_prompting;
1617 break;
1619 default:
1620 /* Somehow a bit got set in window_prompting that we didn't
1621 put there. */
1622 abort ();
1626 static void
1627 x_window (f)
1628 struct frame *f;
1630 XSetWindowAttributes attributes;
1631 unsigned long attribute_mask;
1632 XClassHint class_hints;
1634 attributes.background_pixel = f->display.x->background_pixel;
1635 attributes.border_pixel = f->display.x->border_pixel;
1636 attributes.bit_gravity = StaticGravity;
1637 attributes.backing_store = NotUseful;
1638 attributes.save_under = True;
1639 attributes.event_mask = STANDARD_EVENT_SET;
1640 attribute_mask = (CWBackPixel | CWBorderPixel | CWBitGravity
1641 #if 0
1642 | CWBackingStore | CWSaveUnder
1643 #endif
1644 | CWEventMask);
1646 BLOCK_INPUT;
1647 FRAME_X_WINDOW (f)
1648 = XCreateWindow (x_current_display, ROOT_WINDOW,
1649 f->display.x->left_pos,
1650 f->display.x->top_pos,
1651 PIXEL_WIDTH (f), PIXEL_HEIGHT (f),
1652 f->display.x->border_width,
1653 CopyFromParent, /* depth */
1654 InputOutput, /* class */
1655 screen_visual, /* set in Fx_open_connection */
1656 attribute_mask, &attributes);
1658 class_hints.res_name = (char *) XSTRING (f->name)->data;
1659 class_hints.res_class = EMACS_CLASS;
1660 XSetClassHint (x_current_display, FRAME_X_WINDOW (f), &class_hints);
1662 /* This indicates that we use the "Passive Input" input model.
1663 Unless we do this, we don't get the Focus{In,Out} events that we
1664 need to draw the cursor correctly. Accursed bureaucrats.
1665 XWhipsAndChains (x_current_display, IronMaiden, &TheRack); */
1667 f->display.x->wm_hints.input = True;
1668 f->display.x->wm_hints.flags |= InputHint;
1669 XSetWMHints (x_current_display, FRAME_X_WINDOW (f), &f->display.x->wm_hints);
1671 /* x_set_name normally ignores requests to set the name if the
1672 requested name is the same as the current name. This is the one
1673 place where that assumption isn't correct; f->name is set, but
1674 the X server hasn't been told. */
1676 Lisp_Object name = f->name;
1677 int explicit = f->explicit_name;
1679 f->name = Qnil;
1680 f->explicit_name = 0;
1681 x_set_name (f, name, explicit);
1684 XDefineCursor (XDISPLAY FRAME_X_WINDOW (f),
1685 f->display.x->text_cursor);
1686 UNBLOCK_INPUT;
1688 if (FRAME_X_WINDOW (f) == 0)
1689 error ("Unable to create window.");
1692 /* Handle the icon stuff for this window. Perhaps later we might
1693 want an x_set_icon_position which can be called interactively as
1694 well. */
1696 static void
1697 x_icon (f, parms)
1698 struct frame *f;
1699 Lisp_Object parms;
1701 Lisp_Object icon_x, icon_y;
1703 /* Set the position of the icon. Note that twm groups all
1704 icons in an icon window. */
1705 icon_x = x_get_arg (parms, Qicon_left, 0, 0, number);
1706 icon_y = x_get_arg (parms, Qicon_top, 0, 0, number);
1707 if (!EQ (icon_x, Qunbound) && !EQ (icon_y, Qunbound))
1709 CHECK_NUMBER (icon_x, 0);
1710 CHECK_NUMBER (icon_y, 0);
1712 else if (!EQ (icon_x, Qunbound) || !EQ (icon_y, Qunbound))
1713 error ("Both left and top icon corners of icon must be specified");
1715 BLOCK_INPUT;
1717 if (! EQ (icon_x, Qunbound))
1718 x_wm_set_icon_position (f, XINT (icon_x), XINT (icon_y));
1720 /* Start up iconic or window? */
1721 x_wm_set_window_state
1722 (f, (EQ (x_get_arg (parms, Qvisibility, 0, 0, symbol), Qicon)
1723 ? IconicState
1724 : NormalState));
1726 UNBLOCK_INPUT;
1729 /* Make the GC's needed for this window, setting the
1730 background, border and mouse colors; also create the
1731 mouse cursor and the gray border tile. */
1733 static char cursor_bits[] =
1735 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
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
1741 static void
1742 x_make_gc (f)
1743 struct frame *f;
1745 XGCValues gc_values;
1746 GC temp_gc;
1747 XImage tileimage;
1749 BLOCK_INPUT;
1751 /* Create the GC's of this frame.
1752 Note that many default values are used. */
1754 /* Normal video */
1755 gc_values.font = f->display.x->font->fid;
1756 gc_values.foreground = f->display.x->foreground_pixel;
1757 gc_values.background = f->display.x->background_pixel;
1758 gc_values.line_width = 0; /* Means 1 using fast algorithm. */
1759 f->display.x->normal_gc = XCreateGC (x_current_display,
1760 FRAME_X_WINDOW (f),
1761 GCLineWidth | GCFont
1762 | GCForeground | GCBackground,
1763 &gc_values);
1765 /* Reverse video style. */
1766 gc_values.foreground = f->display.x->background_pixel;
1767 gc_values.background = f->display.x->foreground_pixel;
1768 f->display.x->reverse_gc = XCreateGC (x_current_display,
1769 FRAME_X_WINDOW (f),
1770 GCFont | GCForeground | GCBackground
1771 | GCLineWidth,
1772 &gc_values);
1774 /* Cursor has cursor-color background, background-color foreground. */
1775 gc_values.foreground = f->display.x->background_pixel;
1776 gc_values.background = f->display.x->cursor_pixel;
1777 gc_values.fill_style = FillOpaqueStippled;
1778 gc_values.stipple
1779 = XCreateBitmapFromData (x_current_display, ROOT_WINDOW,
1780 cursor_bits, 16, 16);
1781 f->display.x->cursor_gc
1782 = XCreateGC (x_current_display, FRAME_X_WINDOW (f),
1783 (GCFont | GCForeground | GCBackground
1784 | GCFillStyle | GCStipple | GCLineWidth),
1785 &gc_values);
1787 /* Create the gray border tile used when the pointer is not in
1788 the frame. Since this depends on the frame's pixel values,
1789 this must be done on a per-frame basis. */
1790 f->display.x->border_tile
1791 = (XCreatePixmapFromBitmapData
1792 (x_current_display, ROOT_WINDOW,
1793 gray_bits, gray_width, gray_height,
1794 f->display.x->foreground_pixel,
1795 f->display.x->background_pixel,
1796 DefaultDepth (x_current_display, XDefaultScreen (x_current_display))));
1798 UNBLOCK_INPUT;
1800 #endif /* HAVE_X11 */
1802 DEFUN ("x-create-frame", Fx_create_frame, Sx_create_frame,
1803 1, 1, 0,
1804 "Make a new X window, which is called a \"frame\" in Emacs terms.\n\
1805 Return an Emacs frame object representing the X window.\n\
1806 ALIST is an alist of frame parameters.\n\
1807 If the parameters specify that the frame should not have a minibuffer,\n\
1808 and do not specify a specific minibuffer window to use,\n\
1809 then `default-minibuffer-frame' must be a frame whose minibuffer can\n\
1810 be shared by the new frame.")
1811 (parms)
1812 Lisp_Object parms;
1814 #ifdef HAVE_X11
1815 struct frame *f;
1816 Lisp_Object frame, tem;
1817 Lisp_Object name;
1818 int minibuffer_only = 0;
1819 long window_prompting = 0;
1820 int width, height;
1822 if (x_current_display == 0)
1823 error ("X windows are not in use or not initialized");
1825 name = x_get_arg (parms, Qname, "title", "Title", string);
1826 if (XTYPE (name) != Lisp_String
1827 && ! EQ (name, Qunbound)
1828 && ! NILP (name))
1829 error ("x-create-frame: name parameter must be a string");
1831 tem = x_get_arg (parms, Qminibuffer, 0, 0, symbol);
1832 if (EQ (tem, Qnone) || NILP (tem))
1833 f = make_frame_without_minibuffer (Qnil);
1834 else if (EQ (tem, Qonly))
1836 f = make_minibuffer_frame ();
1837 minibuffer_only = 1;
1839 else if (XTYPE (tem) == Lisp_Window)
1840 f = make_frame_without_minibuffer (tem);
1841 else
1842 f = make_frame (1);
1844 /* Note that X Windows does support scroll bars. */
1845 FRAME_CAN_HAVE_SCROLL_BARS (f) = 1;
1847 /* Set the name; the functions to which we pass f expect the name to
1848 be set. */
1849 if (EQ (name, Qunbound) || NILP (name))
1851 f->name = build_string (x_id_name);
1852 f->explicit_name = 0;
1854 else
1856 f->name = name;
1857 f->explicit_name = 1;
1860 XSET (frame, Lisp_Frame, f);
1861 f->output_method = output_x_window;
1862 f->display.x = (struct x_display *) xmalloc (sizeof (struct x_display));
1863 bzero (f->display.x, sizeof (struct x_display));
1865 /* Note that the frame has no physical cursor right now. */
1866 f->phys_cursor_x = -1;
1868 /* Extract the window parameters from the supplied values
1869 that are needed to determine window geometry. */
1870 x_default_parameter (f, parms, Qfont, build_string ("9x15"),
1871 "font", "Font", string);
1872 x_default_parameter (f, parms, Qborder_width, make_number (2),
1873 "borderwidth", "BorderWidth", number);
1874 /* This defaults to 2 in order to match xterm. */
1875 x_default_parameter (f, parms, Qinternal_border_width, make_number (2),
1876 "internalBorderWidth", "BorderWidth", number);
1877 x_default_parameter (f, parms, Qvertical_scroll_bars, Qt,
1878 "verticalScrollBars", "ScrollBars", boolean);
1880 /* Also do the stuff which must be set before the window exists. */
1881 x_default_parameter (f, parms, Qforeground_color, build_string ("black"),
1882 "foreground", "Foreground", string);
1883 x_default_parameter (f, parms, Qbackground_color, build_string ("white"),
1884 "background", "Background", string);
1885 x_default_parameter (f, parms, Qmouse_color, build_string ("black"),
1886 "pointerColor", "Foreground", string);
1887 x_default_parameter (f, parms, Qcursor_color, build_string ("black"),
1888 "cursorColor", "Foreground", string);
1889 x_default_parameter (f, parms, Qborder_color, build_string ("black"),
1890 "borderColor", "BorderColor", string);
1892 f->display.x->parent_desc = ROOT_WINDOW;
1893 window_prompting = x_figure_window_size (f, parms);
1895 x_window (f);
1896 x_icon (f, parms);
1897 x_make_gc (f);
1899 /* We need to do this after creating the X window, so that the
1900 icon-creation functions can say whose icon they're describing. */
1901 x_default_parameter (f, parms, Qicon_type, Qnil,
1902 "iconType", "IconType", symbol);
1904 x_default_parameter (f, parms, Qauto_raise, Qnil,
1905 "autoRaise", "AutoRaiseLower", boolean);
1906 x_default_parameter (f, parms, Qauto_lower, Qnil,
1907 "autoLower", "AutoRaiseLower", boolean);
1908 x_default_parameter (f, parms, Qcursor_type, Qbox,
1909 "cursorType", "CursorType", symbol);
1911 /* Dimensions, especially f->height, must be done via change_frame_size.
1912 Change will not be effected unless different from the current
1913 f->height. */
1914 width = f->width;
1915 height = f->height;
1916 f->height = f->width = 0;
1917 change_frame_size (f, height, width, 1, 0);
1919 x_default_parameter (f, parms, Qmenu_bar_lines, make_number (0),
1920 "menuBarLines", "MenuBarLines", number);
1922 BLOCK_INPUT;
1923 x_wm_set_size_hint (f, window_prompting);
1924 UNBLOCK_INPUT;
1926 tem = x_get_arg (parms, Qunsplittable, 0, 0, boolean);
1927 f->no_split = minibuffer_only || EQ (tem, Qt);
1929 /* Make the window appear on the frame and enable display,
1930 unless the caller says not to. */
1932 Lisp_Object visibility = x_get_arg (parms, Qvisibility, 0, 0, symbol);
1934 if (EQ (visibility, Qunbound))
1935 visibility = Qt;
1937 if (EQ (visibility, Qicon))
1938 x_iconify_frame (f);
1939 else if (! NILP (visibility))
1940 x_make_frame_visible (f);
1941 else
1942 /* Must have been Qnil. */
1946 return frame;
1947 #else /* X10 */
1948 struct frame *f;
1949 Lisp_Object frame, tem;
1950 Lisp_Object name;
1951 int pixelwidth, pixelheight;
1952 Cursor cursor;
1953 int height, width;
1954 Window parent;
1955 Pixmap temp;
1956 int minibuffer_only = 0;
1957 Lisp_Object vscroll, hscroll;
1959 if (x_current_display == 0)
1960 error ("X windows are not in use or not initialized");
1962 name = Fassq (Qname, parms);
1964 tem = x_get_arg (parms, Qminibuffer, 0, 0, symbol);
1965 if (EQ (tem, Qnone))
1966 f = make_frame_without_minibuffer (Qnil);
1967 else if (EQ (tem, Qonly))
1969 f = make_minibuffer_frame ();
1970 minibuffer_only = 1;
1972 else if (EQ (tem, Qnil) || EQ (tem, Qunbound))
1973 f = make_frame (1);
1974 else
1975 f = make_frame_without_minibuffer (tem);
1977 parent = ROOT_WINDOW;
1979 XSET (frame, Lisp_Frame, f);
1980 f->output_method = output_x_window;
1981 f->display.x = (struct x_display *) xmalloc (sizeof (struct x_display));
1982 bzero (f->display.x, sizeof (struct x_display));
1984 /* Some temprorary default values for height and width. */
1985 width = 80;
1986 height = 40;
1987 f->display.x->left_pos = -1;
1988 f->display.x->top_pos = -1;
1990 /* Give the frame a default name (which may be overridden with PARMS). */
1992 strncpy (iconidentity, ICONTAG, MAXICID);
1993 if (gethostname (&iconidentity[sizeof (ICONTAG) - 1],
1994 (MAXICID - 1) - sizeof (ICONTAG)))
1995 iconidentity[sizeof (ICONTAG) - 2] = '\0';
1996 f->name = build_string (iconidentity);
1998 /* Extract some window parameters from the supplied values.
1999 These are the parameters that affect window geometry. */
2001 tem = x_get_arg (parms, Qfont, "BodyFont", 0, string);
2002 if (EQ (tem, Qunbound))
2003 tem = build_string ("9x15");
2004 x_set_font (f, tem, Qnil);
2005 x_default_parameter (f, parms, Qborder_color,
2006 build_string ("black"), "Border", 0, string);
2007 x_default_parameter (f, parms, Qbackground_color,
2008 build_string ("white"), "Background", 0, string);
2009 x_default_parameter (f, parms, Qforeground_color,
2010 build_string ("black"), "Foreground", 0, string);
2011 x_default_parameter (f, parms, Qmouse_color,
2012 build_string ("black"), "Mouse", 0, string);
2013 x_default_parameter (f, parms, Qcursor_color,
2014 build_string ("black"), "Cursor", 0, string);
2015 x_default_parameter (f, parms, Qborder_width,
2016 make_number (2), "BorderWidth", 0, number);
2017 x_default_parameter (f, parms, Qinternal_border_width,
2018 make_number (4), "InternalBorderWidth", 0, number);
2019 x_default_parameter (f, parms, Qauto_raise,
2020 Qnil, "AutoRaise", 0, boolean);
2022 hscroll = EQ (x_get_arg (parms, Qhorizontal_scroll_bar, 0, 0, boolean), Qt);
2023 vscroll = EQ (x_get_arg (parms, Qvertical_scroll_bar, 0, 0, boolean), Qt);
2025 if (f->display.x->internal_border_width < 0)
2026 f->display.x->internal_border_width = 0;
2028 tem = x_get_arg (parms, Qwindow_id, 0, 0, number);
2029 if (!EQ (tem, Qunbound))
2031 WINDOWINFO_TYPE wininfo;
2032 int nchildren;
2033 Window *children, root;
2035 CHECK_NUMBER (tem, 0);
2036 FRAME_X_WINDOW (f) = (Window) XINT (tem);
2038 BLOCK_INPUT;
2039 XGetWindowInfo (FRAME_X_WINDOW (f), &wininfo);
2040 XQueryTree (FRAME_X_WINDOW (f), &parent, &nchildren, &children);
2041 free (children);
2042 UNBLOCK_INPUT;
2044 height = PIXEL_TO_CHAR_HEIGHT (f, wininfo.height);
2045 width = PIXEL_TO_CHAR_WIDTH (f, wininfo.width);
2046 f->display.x->left_pos = wininfo.x;
2047 f->display.x->top_pos = wininfo.y;
2048 FRAME_SET_VISIBILITY (f, wininfo.mapped != 0);
2049 f->display.x->border_width = wininfo.bdrwidth;
2050 f->display.x->parent_desc = parent;
2052 else
2054 tem = x_get_arg (parms, Qparent_id, 0, 0, number);
2055 if (!EQ (tem, Qunbound))
2057 CHECK_NUMBER (tem, 0);
2058 parent = (Window) XINT (tem);
2060 f->display.x->parent_desc = parent;
2061 tem = x_get_arg (parms, Qheight, 0, 0, number);
2062 if (EQ (tem, Qunbound))
2064 tem = x_get_arg (parms, Qwidth, 0, 0, number);
2065 if (EQ (tem, Qunbound))
2067 tem = x_get_arg (parms, Qtop, 0, 0, number);
2068 if (EQ (tem, Qunbound))
2069 tem = x_get_arg (parms, Qleft, 0, 0, number);
2072 /* Now TEM is Qunbound if no edge or size was specified.
2073 In that case, we must do rubber-banding. */
2074 if (EQ (tem, Qunbound))
2076 tem = x_get_arg (parms, Qgeometry, 0, 0, number);
2077 x_rubber_band (f,
2078 &f->display.x->left_pos, &f->display.x->top_pos,
2079 &width, &height,
2080 (XTYPE (tem) == Lisp_String
2081 ? (char *) XSTRING (tem)->data : ""),
2082 XSTRING (f->name)->data,
2083 !NILP (hscroll), !NILP (vscroll));
2085 else
2087 /* Here if at least one edge or size was specified.
2088 Demand that they all were specified, and use them. */
2089 tem = x_get_arg (parms, Qheight, 0, 0, number);
2090 if (EQ (tem, Qunbound))
2091 error ("Height not specified");
2092 CHECK_NUMBER (tem, 0);
2093 height = XINT (tem);
2095 tem = x_get_arg (parms, Qwidth, 0, 0, number);
2096 if (EQ (tem, Qunbound))
2097 error ("Width not specified");
2098 CHECK_NUMBER (tem, 0);
2099 width = XINT (tem);
2101 tem = x_get_arg (parms, Qtop, 0, 0, number);
2102 if (EQ (tem, Qunbound))
2103 error ("Top position not specified");
2104 CHECK_NUMBER (tem, 0);
2105 f->display.x->left_pos = XINT (tem);
2107 tem = x_get_arg (parms, Qleft, 0, 0, number);
2108 if (EQ (tem, Qunbound))
2109 error ("Left position not specified");
2110 CHECK_NUMBER (tem, 0);
2111 f->display.x->top_pos = XINT (tem);
2114 pixelwidth = CHAR_TO_PIXEL_WIDTH (f, width);
2115 pixelheight = CHAR_TO_PIXEL_HEIGHT (f, height);
2117 BLOCK_INPUT;
2118 FRAME_X_WINDOW (f)
2119 = XCreateWindow (parent,
2120 f->display.x->left_pos, /* Absolute horizontal offset */
2121 f->display.x->top_pos, /* Absolute Vertical offset */
2122 pixelwidth, pixelheight,
2123 f->display.x->border_width,
2124 BLACK_PIX_DEFAULT, WHITE_PIX_DEFAULT);
2125 UNBLOCK_INPUT;
2126 if (FRAME_X_WINDOW (f) == 0)
2127 error ("Unable to create window.");
2130 /* Install the now determined height and width
2131 in the windows and in phys_lines and desired_lines. */
2132 change_frame_size (f, height, width, 1, 0);
2133 XSelectInput (FRAME_X_WINDOW (f), KeyPressed | ExposeWindow
2134 | ButtonPressed | ButtonReleased | ExposeRegion | ExposeCopy
2135 | EnterWindow | LeaveWindow | UnmapWindow );
2136 x_set_resize_hint (f);
2138 /* Tell the server the window's default name. */
2139 XStoreName (XDISPLAY FRAME_X_WINDOW (f), XSTRING (f->name)->data);
2141 /* Now override the defaults with all the rest of the specified
2142 parms. */
2143 tem = x_get_arg (parms, Qunsplittable, 0, 0, boolean);
2144 f->no_split = minibuffer_only || EQ (tem, Qt);
2146 /* Do not create an icon window if the caller says not to */
2147 if (!EQ (x_get_arg (parms, Qsuppress_icon, 0, 0, boolean), Qt)
2148 || f->display.x->parent_desc != ROOT_WINDOW)
2150 x_text_icon (f, iconidentity);
2151 x_default_parameter (f, parms, Qicon_type, Qnil,
2152 "BitmapIcon", 0, symbol);
2155 /* Tell the X server the previously set values of the
2156 background, border and mouse colors; also create the mouse cursor. */
2157 BLOCK_INPUT;
2158 temp = XMakeTile (f->display.x->background_pixel);
2159 XChangeBackground (FRAME_X_WINDOW (f), temp);
2160 XFreePixmap (temp);
2161 UNBLOCK_INPUT;
2162 x_set_border_pixel (f, f->display.x->border_pixel);
2164 x_set_mouse_color (f, Qnil, Qnil);
2166 /* Now override the defaults with all the rest of the specified parms. */
2168 Fmodify_frame_parameters (frame, parms);
2170 /* Make the window appear on the frame and enable display. */
2172 Lisp_Object visibility = x_get_arg (parms, Qvisibility, 0, 0, symbol);
2174 if (EQ (visibility, Qunbound))
2175 visibility = Qt;
2177 if (! EQ (visibility, Qicon)
2178 && ! NILP (visibility))
2179 x_make_window_visible (f);
2182 SET_FRAME_GARBAGED (f);
2184 return frame;
2185 #endif /* X10 */
2188 DEFUN ("focus-frame", Ffocus_frame, Sfocus_frame, 1, 1, 0,
2189 "Set the focus on FRAME.")
2190 (frame)
2191 Lisp_Object frame;
2193 CHECK_LIVE_FRAME (frame, 0);
2195 if (FRAME_X_P (XFRAME (frame)))
2197 BLOCK_INPUT;
2198 x_focus_on_frame (XFRAME (frame));
2199 UNBLOCK_INPUT;
2200 return frame;
2203 return Qnil;
2206 DEFUN ("unfocus-frame", Funfocus_frame, Sunfocus_frame, 0, 0, 0,
2207 "If a frame has been focused, release it.")
2210 if (x_focus_frame)
2212 BLOCK_INPUT;
2213 x_unfocus_frame (x_focus_frame);
2214 UNBLOCK_INPUT;
2217 return Qnil;
2220 #ifndef HAVE_X11
2221 /* Computes an X-window size and position either from geometry GEO
2222 or with the mouse.
2224 F is a frame. It specifies an X window which is used to
2225 determine which display to compute for. Its font, borders
2226 and colors control how the rectangle will be displayed.
2228 X and Y are where to store the positions chosen.
2229 WIDTH and HEIGHT are where to store the sizes chosen.
2231 GEO is the geometry that may specify some of the info.
2232 STR is a prompt to display.
2233 HSCROLL and VSCROLL say whether we have horiz and vert scroll bars. */
2236 x_rubber_band (f, x, y, width, height, geo, str, hscroll, vscroll)
2237 struct frame *f;
2238 int *x, *y, *width, *height;
2239 char *geo;
2240 char *str;
2241 int hscroll, vscroll;
2243 OpaqueFrame frame;
2244 Window tempwindow;
2245 WindowInfo wininfo;
2246 int border_color;
2247 int background_color;
2248 Lisp_Object tem;
2249 int mask;
2251 BLOCK_INPUT;
2253 background_color = f->display.x->background_pixel;
2254 border_color = f->display.x->border_pixel;
2256 frame.bdrwidth = f->display.x->border_width;
2257 frame.border = XMakeTile (border_color);
2258 frame.background = XMakeTile (background_color);
2259 tempwindow = XCreateTerm (str, "emacs", geo, default_window, &frame, 10, 5,
2260 (2 * f->display.x->internal_border_width
2261 + (vscroll ? VSCROLL_WIDTH : 0)),
2262 (2 * f->display.x->internal_border_width
2263 + (hscroll ? HSCROLL_HEIGHT : 0)),
2264 width, height, f->display.x->font,
2265 FONT_WIDTH (f->display.x->font),
2266 FONT_HEIGHT (f->display.x->font));
2267 XFreePixmap (frame.border);
2268 XFreePixmap (frame.background);
2270 if (tempwindow != 0)
2272 XQueryWindow (tempwindow, &wininfo);
2273 XDestroyWindow (tempwindow);
2274 *x = wininfo.x;
2275 *y = wininfo.y;
2278 /* Coordinates we got are relative to the root window.
2279 Convert them to coordinates relative to desired parent window
2280 by scanning from there up to the root. */
2281 tempwindow = f->display.x->parent_desc;
2282 while (tempwindow != ROOT_WINDOW)
2284 int nchildren;
2285 Window *children;
2286 XQueryWindow (tempwindow, &wininfo);
2287 *x -= wininfo.x;
2288 *y -= wininfo.y;
2289 XQueryTree (tempwindow, &tempwindow, &nchildren, &children);
2290 free (children);
2293 UNBLOCK_INPUT;
2294 return tempwindow != 0;
2296 #endif /* not HAVE_X11 */
2298 DEFUN ("x-color-defined-p", Fx_color_defined_p, Sx_color_defined_p, 1, 1, 0,
2299 "Return t if the current X display supports the color named COLOR.")
2300 (color)
2301 Lisp_Object color;
2303 Color foo;
2305 CHECK_STRING (color, 0);
2307 if (defined_color (XSTRING (color)->data, &foo))
2308 return Qt;
2309 else
2310 return Qnil;
2313 DEFUN ("x-display-color-p", Fx_display_color_p, Sx_display_color_p, 0, 0, 0,
2314 "Return t if the X screen currently in use supports color.")
2317 if (x_screen_planes <= 2)
2318 return Qnil;
2320 switch (screen_visual->class)
2322 case StaticColor:
2323 case PseudoColor:
2324 case TrueColor:
2325 case DirectColor:
2326 return Qt;
2328 default:
2329 return Qnil;
2333 DEFUN ("x-display-pixel-width", Fx_display_pixel_width, Sx_display_pixel_width,
2334 0, 1, 0,
2335 "Returns the width in pixels of the display FRAME is on.")
2336 (frame)
2337 Lisp_Object frame;
2339 Display *dpy = x_current_display;
2340 return make_number (DisplayWidth (dpy, DefaultScreen (dpy)));
2343 DEFUN ("x-display-pixel-height", Fx_display_pixel_height,
2344 Sx_display_pixel_height, 0, 1, 0,
2345 "Returns the height in pixels of the display FRAME is on.")
2346 (frame)
2347 Lisp_Object frame;
2349 Display *dpy = x_current_display;
2350 return make_number (DisplayHeight (dpy, DefaultScreen (dpy)));
2353 DEFUN ("x-display-planes", Fx_display_planes, Sx_display_planes,
2354 0, 1, 0,
2355 "Returns the number of bitplanes of the display FRAME is on.")
2356 (frame)
2357 Lisp_Object frame;
2359 Display *dpy = x_current_display;
2360 return make_number (DisplayPlanes (dpy, DefaultScreen (dpy)));
2363 DEFUN ("x-display-color-cells", Fx_display_color_cells, Sx_display_color_cells,
2364 0, 1, 0,
2365 "Returns the number of color cells of the display FRAME is on.")
2366 (frame)
2367 Lisp_Object frame;
2369 Display *dpy = x_current_display;
2370 return make_number (DisplayCells (dpy, DefaultScreen (dpy)));
2373 DEFUN ("x-server-vendor", Fx_server_vendor, Sx_server_vendor, 0, 1, 0,
2374 "Returns the vendor ID string of the X server FRAME is on.")
2375 (frame)
2376 Lisp_Object frame;
2378 Display *dpy = x_current_display;
2379 char *vendor;
2380 vendor = ServerVendor (dpy);
2381 if (! vendor) vendor = "";
2382 return build_string (vendor);
2385 DEFUN ("x-server-version", Fx_server_version, Sx_server_version, 0, 1, 0,
2386 "Returns the version numbers of the X server in use.\n\
2387 The value is a list of three integers: the major and minor\n\
2388 version numbers of the X Protocol in use, and the vendor-specific release\n\
2389 number. See also the variable `x-server-vendor'.")
2390 (frame)
2391 Lisp_Object frame;
2393 Display *dpy = x_current_display;
2394 return Fcons (make_number (ProtocolVersion (dpy)),
2395 Fcons (make_number (ProtocolRevision (dpy)),
2396 Fcons (make_number (VendorRelease (dpy)), Qnil)));
2399 DEFUN ("x-display-screens", Fx_display_screens, Sx_display_screens, 0, 1, 0,
2400 "Returns the number of screens on the X server FRAME is on.")
2401 (frame)
2402 Lisp_Object frame;
2404 return make_number (ScreenCount (x_current_display));
2407 DEFUN ("x-display-mm-height", Fx_display_mm_height, Sx_display_mm_height, 0, 1, 0,
2408 "Returns the height in millimeters of the X screen FRAME is on.")
2409 (frame)
2410 Lisp_Object frame;
2412 return make_number (HeightMMOfScreen (x_screen));
2415 DEFUN ("x-display-mm-width", Fx_display_mm_width, Sx_display_mm_width, 0, 1, 0,
2416 "Returns the width in millimeters of the X screen FRAME is on.")
2417 (frame)
2418 Lisp_Object frame;
2420 return make_number (WidthMMOfScreen (x_screen));
2423 DEFUN ("x-display-backing-store", Fx_display_backing_store,
2424 Sx_display_backing_store, 0, 1, 0,
2425 "Returns an indication of whether the X screen FRAME is on does backing store.\n\
2426 The value may be `always', `when-mapped', or `not-useful'.")
2427 (frame)
2428 Lisp_Object frame;
2430 switch (DoesBackingStore (x_screen))
2432 case Always:
2433 return intern ("always");
2435 case WhenMapped:
2436 return intern ("when-mapped");
2438 case NotUseful:
2439 return intern ("not-useful");
2441 default:
2442 error ("Strange value for BackingStore parameter of screen");
2446 DEFUN ("x-display-visual-class", Fx_display_visual_class,
2447 Sx_display_visual_class, 0, 1, 0,
2448 "Returns the visual class of the display `screen' is on.\n\
2449 The value is one of the symbols `static-gray', `gray-scale',\n\
2450 `static-color', `pseudo-color', `true-color', or `direct-color'.")
2451 (screen)
2452 Lisp_Object screen;
2454 switch (screen_visual->class)
2456 case StaticGray: return (intern ("static-gray"));
2457 case GrayScale: return (intern ("gray-scale"));
2458 case StaticColor: return (intern ("static-color"));
2459 case PseudoColor: return (intern ("pseudo-color"));
2460 case TrueColor: return (intern ("true-color"));
2461 case DirectColor: return (intern ("direct-color"));
2462 default:
2463 error ("Display has an unknown visual class");
2467 DEFUN ("x-display-save-under", Fx_display_save_under,
2468 Sx_display_save_under, 0, 1, 0,
2469 "Returns t if the X screen FRAME is on supports the save-under feature.")
2470 (frame)
2471 Lisp_Object frame;
2473 if (DoesSaveUnders (x_screen) == True)
2474 return Qt;
2475 else
2476 return Qnil;
2479 x_pixel_width (f)
2480 register struct frame *f;
2482 return PIXEL_WIDTH (f);
2485 x_pixel_height (f)
2486 register struct frame *f;
2488 return PIXEL_HEIGHT (f);
2491 x_char_width (f)
2492 register struct frame *f;
2494 return FONT_WIDTH (f->display.x->font);
2497 x_char_height (f)
2498 register struct frame *f;
2500 return FONT_HEIGHT (f->display.x->font);
2503 #if 0 /* These no longer seem like the right way to do things. */
2505 /* Draw a rectangle on the frame with left top corner including
2506 the character specified by LEFT_CHAR and TOP_CHAR. The rectangle is
2507 CHARS by LINES wide and long and is the color of the cursor. */
2509 void
2510 x_rectangle (f, gc, left_char, top_char, chars, lines)
2511 register struct frame *f;
2512 GC gc;
2513 register int top_char, left_char, chars, lines;
2515 int width;
2516 int height;
2517 int left = (left_char * FONT_WIDTH (f->display.x->font)
2518 + f->display.x->internal_border_width);
2519 int top = (top_char * FONT_HEIGHT (f->display.x->font)
2520 + f->display.x->internal_border_width);
2522 if (chars < 0)
2523 width = FONT_WIDTH (f->display.x->font) / 2;
2524 else
2525 width = FONT_WIDTH (f->display.x->font) * chars;
2526 if (lines < 0)
2527 height = FONT_HEIGHT (f->display.x->font) / 2;
2528 else
2529 height = FONT_HEIGHT (f->display.x->font) * lines;
2531 XDrawRectangle (x_current_display, FRAME_X_WINDOW (f),
2532 gc, left, top, width, height);
2535 DEFUN ("x-draw-rectangle", Fx_draw_rectangle, Sx_draw_rectangle, 5, 5, 0,
2536 "Draw a rectangle on FRAME between coordinates specified by\n\
2537 numbers X0, Y0, X1, Y1 in the cursor pixel.")
2538 (frame, X0, Y0, X1, Y1)
2539 register Lisp_Object frame, X0, X1, Y0, Y1;
2541 register int x0, y0, x1, y1, top, left, n_chars, n_lines;
2543 CHECK_LIVE_FRAME (frame, 0);
2544 CHECK_NUMBER (X0, 0);
2545 CHECK_NUMBER (Y0, 1);
2546 CHECK_NUMBER (X1, 2);
2547 CHECK_NUMBER (Y1, 3);
2549 x0 = XINT (X0);
2550 x1 = XINT (X1);
2551 y0 = XINT (Y0);
2552 y1 = XINT (Y1);
2554 if (y1 > y0)
2556 top = y0;
2557 n_lines = y1 - y0 + 1;
2559 else
2561 top = y1;
2562 n_lines = y0 - y1 + 1;
2565 if (x1 > x0)
2567 left = x0;
2568 n_chars = x1 - x0 + 1;
2570 else
2572 left = x1;
2573 n_chars = x0 - x1 + 1;
2576 BLOCK_INPUT;
2577 x_rectangle (XFRAME (frame), XFRAME (frame)->display.x->cursor_gc,
2578 left, top, n_chars, n_lines);
2579 UNBLOCK_INPUT;
2581 return Qt;
2584 DEFUN ("x-erase-rectangle", Fx_erase_rectangle, Sx_erase_rectangle, 5, 5, 0,
2585 "Draw a rectangle drawn on FRAME between coordinates\n\
2586 X0, Y0, X1, Y1 in the regular background-pixel.")
2587 (frame, X0, Y0, X1, Y1)
2588 register Lisp_Object frame, X0, Y0, X1, Y1;
2590 register int x0, y0, x1, y1, top, left, n_chars, n_lines;
2592 CHECK_FRAME (frame, 0);
2593 CHECK_NUMBER (X0, 0);
2594 CHECK_NUMBER (Y0, 1);
2595 CHECK_NUMBER (X1, 2);
2596 CHECK_NUMBER (Y1, 3);
2598 x0 = XINT (X0);
2599 x1 = XINT (X1);
2600 y0 = XINT (Y0);
2601 y1 = XINT (Y1);
2603 if (y1 > y0)
2605 top = y0;
2606 n_lines = y1 - y0 + 1;
2608 else
2610 top = y1;
2611 n_lines = y0 - y1 + 1;
2614 if (x1 > x0)
2616 left = x0;
2617 n_chars = x1 - x0 + 1;
2619 else
2621 left = x1;
2622 n_chars = x0 - x1 + 1;
2625 BLOCK_INPUT;
2626 x_rectangle (XFRAME (frame), XFRAME (frame)->display.x->reverse_gc,
2627 left, top, n_chars, n_lines);
2628 UNBLOCK_INPUT;
2630 return Qt;
2633 /* Draw lines around the text region beginning at the character position
2634 TOP_X, TOP_Y and ending at BOTTOM_X and BOTTOM_Y. GC specifies the
2635 pixel and line characteristics. */
2637 #define line_len(line) (FRAME_CURRENT_GLYPHS (f)->used[(line)])
2639 static void
2640 outline_region (f, gc, top_x, top_y, bottom_x, bottom_y)
2641 register struct frame *f;
2642 GC gc;
2643 int top_x, top_y, bottom_x, bottom_y;
2645 register int ibw = f->display.x->internal_border_width;
2646 register int font_w = FONT_WIDTH (f->display.x->font);
2647 register int font_h = FONT_HEIGHT (f->display.x->font);
2648 int y = top_y;
2649 int x = line_len (y);
2650 XPoint *pixel_points = (XPoint *)
2651 alloca (((bottom_y - top_y + 2) * 4) * sizeof (XPoint));
2652 register XPoint *this_point = pixel_points;
2654 /* Do the horizontal top line/lines */
2655 if (top_x == 0)
2657 this_point->x = ibw;
2658 this_point->y = ibw + (font_h * top_y);
2659 this_point++;
2660 if (x == 0)
2661 this_point->x = ibw + (font_w / 2); /* Half-size for newline chars. */
2662 else
2663 this_point->x = ibw + (font_w * x);
2664 this_point->y = (this_point - 1)->y;
2666 else
2668 this_point->x = ibw;
2669 this_point->y = ibw + (font_h * (top_y + 1));
2670 this_point++;
2671 this_point->x = ibw + (font_w * top_x);
2672 this_point->y = (this_point - 1)->y;
2673 this_point++;
2674 this_point->x = (this_point - 1)->x;
2675 this_point->y = ibw + (font_h * top_y);
2676 this_point++;
2677 this_point->x = ibw + (font_w * x);
2678 this_point->y = (this_point - 1)->y;
2681 /* Now do the right side. */
2682 while (y < bottom_y)
2683 { /* Right vertical edge */
2684 this_point++;
2685 this_point->x = (this_point - 1)->x;
2686 this_point->y = ibw + (font_h * (y + 1));
2687 this_point++;
2689 y++; /* Horizontal connection to next line */
2690 x = line_len (y);
2691 if (x == 0)
2692 this_point->x = ibw + (font_w / 2);
2693 else
2694 this_point->x = ibw + (font_w * x);
2696 this_point->y = (this_point - 1)->y;
2699 /* Now do the bottom and connect to the top left point. */
2700 this_point->x = ibw + (font_w * (bottom_x + 1));
2702 this_point++;
2703 this_point->x = (this_point - 1)->x;
2704 this_point->y = ibw + (font_h * (bottom_y + 1));
2705 this_point++;
2706 this_point->x = ibw;
2707 this_point->y = (this_point - 1)->y;
2708 this_point++;
2709 this_point->x = pixel_points->x;
2710 this_point->y = pixel_points->y;
2712 XDrawLines (x_current_display, FRAME_X_WINDOW (f),
2713 gc, pixel_points,
2714 (this_point - pixel_points + 1), CoordModeOrigin);
2717 DEFUN ("x-contour-region", Fx_contour_region, Sx_contour_region, 1, 1, 0,
2718 "Highlight the region between point and the character under the mouse\n\
2719 selected frame.")
2720 (event)
2721 register Lisp_Object event;
2723 register int x0, y0, x1, y1;
2724 register struct frame *f = selected_frame;
2725 register int p1, p2;
2727 CHECK_CONS (event, 0);
2729 BLOCK_INPUT;
2730 x0 = XINT (Fcar (Fcar (event)));
2731 y0 = XINT (Fcar (Fcdr (Fcar (event))));
2733 /* If the mouse is past the end of the line, don't that area. */
2734 /* ReWrite this... */
2736 x1 = f->cursor_x;
2737 y1 = f->cursor_y;
2739 if (y1 > y0) /* point below mouse */
2740 outline_region (f, f->display.x->cursor_gc,
2741 x0, y0, x1, y1);
2742 else if (y1 < y0) /* point above mouse */
2743 outline_region (f, f->display.x->cursor_gc,
2744 x1, y1, x0, y0);
2745 else /* same line: draw horizontal rectangle */
2747 if (x1 > x0)
2748 x_rectangle (f, f->display.x->cursor_gc,
2749 x0, y0, (x1 - x0 + 1), 1);
2750 else if (x1 < x0)
2751 x_rectangle (f, f->display.x->cursor_gc,
2752 x1, y1, (x0 - x1 + 1), 1);
2755 XFlush (x_current_display);
2756 UNBLOCK_INPUT;
2758 return Qnil;
2761 DEFUN ("x-uncontour-region", Fx_uncontour_region, Sx_uncontour_region, 1, 1, 0,
2762 "Erase any highlighting of the region between point and the character\n\
2763 at X, Y on the selected frame.")
2764 (event)
2765 register Lisp_Object event;
2767 register int x0, y0, x1, y1;
2768 register struct frame *f = selected_frame;
2770 BLOCK_INPUT;
2771 x0 = XINT (Fcar (Fcar (event)));
2772 y0 = XINT (Fcar (Fcdr (Fcar (event))));
2773 x1 = f->cursor_x;
2774 y1 = f->cursor_y;
2776 if (y1 > y0) /* point below mouse */
2777 outline_region (f, f->display.x->reverse_gc,
2778 x0, y0, x1, y1);
2779 else if (y1 < y0) /* point above mouse */
2780 outline_region (f, f->display.x->reverse_gc,
2781 x1, y1, x0, y0);
2782 else /* same line: draw horizontal rectangle */
2784 if (x1 > x0)
2785 x_rectangle (f, f->display.x->reverse_gc,
2786 x0, y0, (x1 - x0 + 1), 1);
2787 else if (x1 < x0)
2788 x_rectangle (f, f->display.x->reverse_gc,
2789 x1, y1, (x0 - x1 + 1), 1);
2791 UNBLOCK_INPUT;
2793 return Qnil;
2796 #if 0
2797 int contour_begin_x, contour_begin_y;
2798 int contour_end_x, contour_end_y;
2799 int contour_npoints;
2801 /* Clip the top part of the contour lines down (and including) line Y_POS.
2802 If X_POS is in the middle (rather than at the end) of the line, drop
2803 down a line at that character. */
2805 static void
2806 clip_contour_top (y_pos, x_pos)
2808 register XPoint *begin = contour_lines[y_pos].top_left;
2809 register XPoint *end;
2810 register int npoints;
2811 register struct display_line *line = selected_frame->phys_lines[y_pos + 1];
2813 if (x_pos >= line->len - 1) /* Draw one, straight horizontal line. */
2815 end = contour_lines[y_pos].top_right;
2816 npoints = (end - begin + 1);
2817 XDrawLines (x_current_display, contour_window,
2818 contour_erase_gc, begin_erase, npoints, CoordModeOrigin);
2820 bcopy (end, begin + 1, contour_last_point - end + 1);
2821 contour_last_point -= (npoints - 2);
2822 XDrawLines (x_current_display, contour_window,
2823 contour_erase_gc, begin, 2, CoordModeOrigin);
2824 XFlush (x_current_display);
2826 /* Now, update contour_lines structure. */
2828 /* ______. */
2829 else /* |________*/
2831 register XPoint *p = begin + 1;
2832 end = contour_lines[y_pos].bottom_right;
2833 npoints = (end - begin + 1);
2834 XDrawLines (x_current_display, contour_window,
2835 contour_erase_gc, begin_erase, npoints, CoordModeOrigin);
2837 p->y = begin->y;
2838 p->x = ibw + (font_w * (x_pos + 1));
2839 p++;
2840 p->y = begin->y + font_h;
2841 p->x = (p - 1)->x;
2842 bcopy (end, begin + 3, contour_last_point - end + 1);
2843 contour_last_point -= (npoints - 5);
2844 XDrawLines (x_current_display, contour_window,
2845 contour_erase_gc, begin, 4, CoordModeOrigin);
2846 XFlush (x_current_display);
2848 /* Now, update contour_lines structure. */
2852 /* Erase the top horzontal lines of the contour, and then extend
2853 the contour upwards. */
2855 static void
2856 extend_contour_top (line)
2860 static void
2861 clip_contour_bottom (x_pos, y_pos)
2862 int x_pos, y_pos;
2866 static void
2867 extend_contour_bottom (x_pos, y_pos)
2871 DEFUN ("x-select-region", Fx_select_region, Sx_select_region, 1, 1, "e",
2873 (event)
2874 Lisp_Object event;
2876 register struct frame *f = selected_frame;
2877 register int point_x = f->cursor_x;
2878 register int point_y = f->cursor_y;
2879 register int mouse_below_point;
2880 register Lisp_Object obj;
2881 register int x_contour_x, x_contour_y;
2883 x_contour_x = x_mouse_x;
2884 x_contour_y = x_mouse_y;
2885 if (x_contour_y > point_y || (x_contour_y == point_y
2886 && x_contour_x > point_x))
2888 mouse_below_point = 1;
2889 outline_region (f, f->display.x->cursor_gc, point_x, point_y,
2890 x_contour_x, x_contour_y);
2892 else
2894 mouse_below_point = 0;
2895 outline_region (f, f->display.x->cursor_gc, x_contour_x, x_contour_y,
2896 point_x, point_y);
2899 while (1)
2901 obj = read_char (-1, 0, 0, Qnil, 0);
2902 if (XTYPE (obj) != Lisp_Cons)
2903 break;
2905 if (mouse_below_point)
2907 if (x_mouse_y <= point_y) /* Flipped. */
2909 mouse_below_point = 0;
2911 outline_region (f, f->display.x->reverse_gc, point_x, point_y,
2912 x_contour_x, x_contour_y);
2913 outline_region (f, f->display.x->cursor_gc, x_mouse_x, x_mouse_y,
2914 point_x, point_y);
2916 else if (x_mouse_y < x_contour_y) /* Bottom clipped. */
2918 clip_contour_bottom (x_mouse_y);
2920 else if (x_mouse_y > x_contour_y) /* Bottom extended. */
2922 extend_bottom_contour (x_mouse_y);
2925 x_contour_x = x_mouse_x;
2926 x_contour_y = x_mouse_y;
2928 else /* mouse above or same line as point */
2930 if (x_mouse_y >= point_y) /* Flipped. */
2932 mouse_below_point = 1;
2934 outline_region (f, f->display.x->reverse_gc,
2935 x_contour_x, x_contour_y, point_x, point_y);
2936 outline_region (f, f->display.x->cursor_gc, point_x, point_y,
2937 x_mouse_x, x_mouse_y);
2939 else if (x_mouse_y > x_contour_y) /* Top clipped. */
2941 clip_contour_top (x_mouse_y);
2943 else if (x_mouse_y < x_contour_y) /* Top extended. */
2945 extend_contour_top (x_mouse_y);
2950 unread_command_event = obj;
2951 if (mouse_below_point)
2953 contour_begin_x = point_x;
2954 contour_begin_y = point_y;
2955 contour_end_x = x_contour_x;
2956 contour_end_y = x_contour_y;
2958 else
2960 contour_begin_x = x_contour_x;
2961 contour_begin_y = x_contour_y;
2962 contour_end_x = point_x;
2963 contour_end_y = point_y;
2966 #endif
2968 DEFUN ("x-horizontal-line", Fx_horizontal_line, Sx_horizontal_line, 1, 1, "e",
2970 (event)
2971 Lisp_Object event;
2973 register Lisp_Object obj;
2974 struct frame *f = selected_frame;
2975 register struct window *w = XWINDOW (selected_window);
2976 register GC line_gc = f->display.x->cursor_gc;
2977 register GC erase_gc = f->display.x->reverse_gc;
2978 #if 0
2979 char dash_list[] = {6, 4, 6, 4};
2980 int dashes = 4;
2981 XGCValues gc_values;
2982 #endif
2983 register int previous_y;
2984 register int line = (x_mouse_y + 1) * FONT_HEIGHT (f->display.x->font)
2985 + f->display.x->internal_border_width;
2986 register int left = f->display.x->internal_border_width
2987 + (w->left
2988 * FONT_WIDTH (f->display.x->font));
2989 register int right = left + (w->width
2990 * FONT_WIDTH (f->display.x->font))
2991 - f->display.x->internal_border_width;
2993 #if 0
2994 BLOCK_INPUT;
2995 gc_values.foreground = f->display.x->cursor_pixel;
2996 gc_values.background = f->display.x->background_pixel;
2997 gc_values.line_width = 1;
2998 gc_values.line_style = LineOnOffDash;
2999 gc_values.cap_style = CapRound;
3000 gc_values.join_style = JoinRound;
3002 line_gc = XCreateGC (x_current_display, FRAME_X_WINDOW (f),
3003 GCLineStyle | GCJoinStyle | GCCapStyle
3004 | GCLineWidth | GCForeground | GCBackground,
3005 &gc_values);
3006 XSetDashes (x_current_display, line_gc, 0, dash_list, dashes);
3007 gc_values.foreground = f->display.x->background_pixel;
3008 gc_values.background = f->display.x->foreground_pixel;
3009 erase_gc = XCreateGC (x_current_display, FRAME_X_WINDOW (f),
3010 GCLineStyle | GCJoinStyle | GCCapStyle
3011 | GCLineWidth | GCForeground | GCBackground,
3012 &gc_values);
3013 XSetDashes (x_current_display, erase_gc, 0, dash_list, dashes);
3014 #endif
3016 while (1)
3018 BLOCK_INPUT;
3019 if (x_mouse_y >= XINT (w->top)
3020 && x_mouse_y < XINT (w->top) + XINT (w->height) - 1)
3022 previous_y = x_mouse_y;
3023 line = (x_mouse_y + 1) * FONT_HEIGHT (f->display.x->font)
3024 + f->display.x->internal_border_width;
3025 XDrawLine (x_current_display, FRAME_X_WINDOW (f),
3026 line_gc, left, line, right, line);
3028 XFlushQueue ();
3029 UNBLOCK_INPUT;
3033 obj = read_char (-1, 0, 0, Qnil, 0);
3034 if ((XTYPE (obj) != Lisp_Cons)
3035 || (! EQ (Fcar (Fcdr (Fcdr (obj))),
3036 Qvertical_scroll_bar))
3037 || x_mouse_grabbed)
3039 BLOCK_INPUT;
3040 XDrawLine (x_current_display, FRAME_X_WINDOW (f),
3041 erase_gc, left, line, right, line);
3042 UNBLOCK_INPUT;
3043 unread_command_event = obj;
3044 #if 0
3045 XFreeGC (x_current_display, line_gc);
3046 XFreeGC (x_current_display, erase_gc);
3047 #endif
3048 return Qnil;
3051 while (x_mouse_y == previous_y);
3053 BLOCK_INPUT;
3054 XDrawLine (x_current_display, FRAME_X_WINDOW (f),
3055 erase_gc, left, line, right, line);
3056 UNBLOCK_INPUT;
3059 #endif
3061 /* Offset in buffer of character under the pointer, or 0. */
3062 int mouse_buffer_offset;
3064 #if 0
3065 /* These keep track of the rectangle following the pointer. */
3066 int mouse_track_top, mouse_track_left, mouse_track_width;
3068 DEFUN ("x-track-pointer", Fx_track_pointer, Sx_track_pointer, 0, 0, 0,
3069 "Track the pointer.")
3072 static Cursor current_pointer_shape;
3073 FRAME_PTR f = x_mouse_frame;
3075 BLOCK_INPUT;
3076 if (EQ (Vmouse_frame_part, Qtext_part)
3077 && (current_pointer_shape != f->display.x->nontext_cursor))
3079 unsigned char c;
3080 struct buffer *buf;
3082 current_pointer_shape = f->display.x->nontext_cursor;
3083 XDefineCursor (x_current_display,
3084 FRAME_X_WINDOW (f),
3085 current_pointer_shape);
3087 buf = XBUFFER (XWINDOW (Vmouse_window)->buffer);
3088 c = *(BUF_CHAR_ADDRESS (buf, mouse_buffer_offset));
3090 else if (EQ (Vmouse_frame_part, Qmodeline_part)
3091 && (current_pointer_shape != f->display.x->modeline_cursor))
3093 current_pointer_shape = f->display.x->modeline_cursor;
3094 XDefineCursor (x_current_display,
3095 FRAME_X_WINDOW (f),
3096 current_pointer_shape);
3099 XFlushQueue ();
3100 UNBLOCK_INPUT;
3102 #endif
3104 #if 0
3105 DEFUN ("x-track-pointer", Fx_track_pointer, Sx_track_pointer, 1, 1, "e",
3106 "Draw rectangle around character under mouse pointer, if there is one.")
3107 (event)
3108 Lisp_Object event;
3110 struct window *w = XWINDOW (Vmouse_window);
3111 struct frame *f = XFRAME (WINDOW_FRAME (w));
3112 struct buffer *b = XBUFFER (w->buffer);
3113 Lisp_Object obj;
3115 if (! EQ (Vmouse_window, selected_window))
3116 return Qnil;
3118 if (EQ (event, Qnil))
3120 int x, y;
3122 x_read_mouse_position (selected_frame, &x, &y);
3125 BLOCK_INPUT;
3126 mouse_track_width = 0;
3127 mouse_track_left = mouse_track_top = -1;
3131 if ((x_mouse_x != mouse_track_left
3132 && (x_mouse_x < mouse_track_left
3133 || x_mouse_x > (mouse_track_left + mouse_track_width)))
3134 || x_mouse_y != mouse_track_top)
3136 int hp = 0; /* Horizontal position */
3137 int len = FRAME_CURRENT_GLYPHS (f)->used[x_mouse_y];
3138 int p = FRAME_CURRENT_GLYPHS (f)->bufp[x_mouse_y];
3139 int tab_width = XINT (b->tab_width);
3140 int ctl_arrow_p = !NILP (b->ctl_arrow);
3141 unsigned char c;
3142 int mode_line_vpos = XFASTINT (w->height) + XFASTINT (w->top) - 1;
3143 int in_mode_line = 0;
3145 if (! FRAME_CURRENT_GLYPHS (f)->enable[x_mouse_y])
3146 break;
3148 /* Erase previous rectangle. */
3149 if (mouse_track_width)
3151 x_rectangle (f, f->display.x->reverse_gc,
3152 mouse_track_left, mouse_track_top,
3153 mouse_track_width, 1);
3155 if ((mouse_track_left == f->phys_cursor_x
3156 || mouse_track_left == f->phys_cursor_x - 1)
3157 && mouse_track_top == f->phys_cursor_y)
3159 x_display_cursor (f, 1);
3163 mouse_track_left = x_mouse_x;
3164 mouse_track_top = x_mouse_y;
3165 mouse_track_width = 0;
3167 if (mouse_track_left > len) /* Past the end of line. */
3168 goto draw_or_not;
3170 if (mouse_track_top == mode_line_vpos)
3172 in_mode_line = 1;
3173 goto draw_or_not;
3176 if (tab_width <= 0 || tab_width > 20) tab_width = 8;
3179 c = FETCH_CHAR (p);
3180 if (len == f->width && hp == len - 1 && c != '\n')
3181 goto draw_or_not;
3183 switch (c)
3185 case '\t':
3186 mouse_track_width = tab_width - (hp % tab_width);
3187 p++;
3188 hp += mouse_track_width;
3189 if (hp > x_mouse_x)
3191 mouse_track_left = hp - mouse_track_width;
3192 goto draw_or_not;
3194 continue;
3196 case '\n':
3197 mouse_track_width = -1;
3198 goto draw_or_not;
3200 default:
3201 if (ctl_arrow_p && (c < 040 || c == 0177))
3203 if (p > ZV)
3204 goto draw_or_not;
3206 mouse_track_width = 2;
3207 p++;
3208 hp +=2;
3209 if (hp > x_mouse_x)
3211 mouse_track_left = hp - mouse_track_width;
3212 goto draw_or_not;
3215 else
3217 mouse_track_width = 1;
3218 p++;
3219 hp++;
3221 continue;
3224 while (hp <= x_mouse_x);
3226 draw_or_not:
3227 if (mouse_track_width) /* Over text; use text pointer shape. */
3229 XDefineCursor (x_current_display,
3230 FRAME_X_WINDOW (f),
3231 f->display.x->text_cursor);
3232 x_rectangle (f, f->display.x->cursor_gc,
3233 mouse_track_left, mouse_track_top,
3234 mouse_track_width, 1);
3236 else if (in_mode_line)
3237 XDefineCursor (x_current_display,
3238 FRAME_X_WINDOW (f),
3239 f->display.x->modeline_cursor);
3240 else
3241 XDefineCursor (x_current_display,
3242 FRAME_X_WINDOW (f),
3243 f->display.x->nontext_cursor);
3246 XFlush (x_current_display);
3247 UNBLOCK_INPUT;
3249 obj = read_char (-1, 0, 0, Qnil, 0);
3250 BLOCK_INPUT;
3252 while (XTYPE (obj) == Lisp_Cons /* Mouse event */
3253 && EQ (Fcar (Fcdr (Fcdr (obj))), Qnil) /* Not scroll bar */
3254 && EQ (Vmouse_depressed, Qnil) /* Only motion events */
3255 && EQ (Vmouse_window, selected_window) /* In this window */
3256 && x_mouse_frame);
3258 unread_command_event = obj;
3260 if (mouse_track_width)
3262 x_rectangle (f, f->display.x->reverse_gc,
3263 mouse_track_left, mouse_track_top,
3264 mouse_track_width, 1);
3265 mouse_track_width = 0;
3266 if ((mouse_track_left == f->phys_cursor_x
3267 || mouse_track_left - 1 == f->phys_cursor_x)
3268 && mouse_track_top == f->phys_cursor_y)
3270 x_display_cursor (f, 1);
3273 XDefineCursor (x_current_display,
3274 FRAME_X_WINDOW (f),
3275 f->display.x->nontext_cursor);
3276 XFlush (x_current_display);
3277 UNBLOCK_INPUT;
3279 return Qnil;
3281 #endif
3283 #if 0
3284 #include "glyphs.h"
3286 /* Draw a pixmap specified by IMAGE_DATA of dimensions WIDTH and HEIGHT
3287 on the frame F at position X, Y. */
3289 x_draw_pixmap (f, x, y, image_data, width, height)
3290 struct frame *f;
3291 int x, y, width, height;
3292 char *image_data;
3294 Pixmap image;
3296 image = XCreateBitmapFromData (x_current_display,
3297 FRAME_X_WINDOW (f), image_data,
3298 width, height);
3299 XCopyPlane (x_current_display, image, FRAME_X_WINDOW (f),
3300 f->display.x->normal_gc, 0, 0, width, height, x, y);
3302 #endif
3304 #if 0
3306 #ifdef HAVE_X11
3307 #define XMouseEvent XEvent
3308 #define WhichMouseButton xbutton.button
3309 #define MouseWindow xbutton.window
3310 #define MouseX xbutton.x
3311 #define MouseY xbutton.y
3312 #define MouseTime xbutton.time
3313 #define ButtonReleased ButtonRelease
3314 #define ButtonPressed ButtonPress
3315 #else
3316 #define XMouseEvent XButtonEvent
3317 #define WhichMouseButton detail
3318 #define MouseWindow window
3319 #define MouseX x
3320 #define MouseY y
3321 #define MouseTime time
3322 #endif /* X11 */
3324 DEFUN ("x-mouse-events", Fx_mouse_events, Sx_mouse_events, 0, 0, 0,
3325 "Return number of pending mouse events from X window system.")
3328 return make_number (queue_event_count (&x_mouse_queue));
3331 /* Encode the mouse button events in the form expected by the
3332 mouse code in Lisp. For X11, this means moving the masks around. */
3334 static int
3335 encode_mouse_button (mouse_event)
3336 XMouseEvent mouse_event;
3338 register int event_code;
3339 register char key_mask;
3341 event_code = mouse_event.detail & 3;
3342 key_mask = (mouse_event.detail >> 8) & 0xf0;
3343 event_code |= key_mask >> 1;
3344 if (mouse_event.type == ButtonReleased) event_code |= 0x04;
3345 return event_code;
3348 DEFUN ("x-get-mouse-event", Fx_get_mouse_event, Sx_get_mouse_event,
3349 0, 1, 0,
3350 "Get next mouse event out of mouse event buffer.\n\
3351 Optional ARG non-nil means return nil immediately if no pending event;\n\
3352 otherwise, wait for an event. Returns a four-part list:\n\
3353 ((X-POS Y-POS) WINDOW FRAME-PART KEYSEQ TIMESTAMP).\n\
3354 Normally X-POS and Y-POS are the position of the click on the frame\n\
3355 (measured in characters and lines), and WINDOW is the window clicked in.\n\
3356 KEYSEQ is a string, the key sequence to be looked up in the mouse maps.\n\
3357 If FRAME-PART is non-nil, the event was on a scroll bar;\n\
3358 then Y-POS is really the total length of the scroll bar, while X-POS is\n\
3359 the relative position of the scroll bar's value within that total length,\n\
3360 and a third element OFFSET appears in that list: the height of the thumb-up\n\
3361 area at the top of the scroll bar.\n\
3362 FRAME-PART is one of the following symbols:\n\
3363 `vertical-scroll-bar', `vertical-thumbup', `vertical-thumbdown',\n\
3364 `horizontal-scroll-bar', `horizontal-thumbleft', `horizontal-thumbright'.\n\
3365 TIMESTAMP is the lower 23 bits of the X-server's timestamp for\n\
3366 the mouse event.")
3367 (arg)
3368 Lisp_Object arg;
3370 XMouseEvent xrep;
3371 register int com_letter;
3372 register Lisp_Object tempx;
3373 register Lisp_Object tempy;
3374 Lisp_Object part, pos, timestamp;
3375 int prefix;
3376 struct frame *f;
3378 int tem;
3380 while (1)
3382 BLOCK_INPUT;
3383 tem = dequeue_event (&xrep, &x_mouse_queue);
3384 UNBLOCK_INPUT;
3386 if (tem)
3388 switch (xrep.type)
3390 case ButtonPressed:
3391 case ButtonReleased:
3393 com_letter = encode_mouse_button (xrep);
3394 mouse_timestamp = xrep.MouseTime;
3396 if ((f = x_window_to_frame (xrep.MouseWindow)) != 0)
3398 Lisp_Object frame;
3400 if (f->display.x->icon_desc == xrep.MouseWindow)
3402 x_make_frame_visible (f);
3403 continue;
3406 XSET (tempx, Lisp_Int,
3407 min (f->width-1, max (0, (xrep.MouseX - f->display.x->internal_border_width)/FONT_WIDTH (f->display.x->font))));
3408 XSET (tempy, Lisp_Int,
3409 min (f->height-1, max (0, (xrep.MouseY - f->display.x->internal_border_width)/FONT_HEIGHT (f->display.x->font))));
3410 XSET (timestamp, Lisp_Int, (xrep.MouseTime & 0x7fffff));
3411 XSET (frame, Lisp_Frame, f);
3413 pos = Fcons (tempx, Fcons (tempy, Qnil));
3414 Vmouse_window
3415 = Flocate_window_from_coordinates (frame, pos);
3417 Vmouse_event
3418 = Fcons (pos,
3419 Fcons (Vmouse_window,
3420 Fcons (Qnil,
3421 Fcons (Fchar_to_string (make_number (com_letter)),
3422 Fcons (timestamp, Qnil)))));
3423 return Vmouse_event;
3425 else if ((f = x_window_to_scroll_bar (xrep.MouseWindow, &part, &prefix)) != 0)
3427 int pos, len;
3428 Lisp_Object keyseq;
3429 char *partname;
3431 keyseq = concat2 (Fchar_to_string (make_number (prefix)),
3432 Fchar_to_string (make_number (com_letter)));
3434 pos = xrep.MouseY - (f->display.x->v_scroll_bar_width - 2);
3435 XSET (tempx, Lisp_Int, pos);
3436 len = ((FONT_HEIGHT (f->display.x->font) * f->height)
3437 + f->display.x->internal_border_width
3438 - (2 * (f->display.x->v_scroll_bar_width - 2)));
3439 XSET (tempy, Lisp_Int, len);
3440 XSET (timestamp, Lisp_Int, (xrep.MouseTime & 0x7fffff));
3441 Vmouse_window = f->selected_window;
3442 Vmouse_event
3443 = Fcons (Fcons (tempx, Fcons (tempy,
3444 Fcons (make_number (f->display.x->v_scroll_bar_width - 2),
3445 Qnil))),
3446 Fcons (Vmouse_window,
3447 Fcons (intern (part),
3448 Fcons (keyseq, Fcons (timestamp,
3449 Qnil)))));
3450 return Vmouse_event;
3452 else
3453 continue;
3455 #ifdef HAVE_X11
3456 case MotionNotify:
3458 com_letter = x11_encode_mouse_button (xrep);
3459 if ((f = x_window_to_frame (xrep.MouseWindow)) != 0)
3461 Lisp_Object frame;
3463 XSET (tempx, Lisp_Int,
3464 min (f->width-1,
3465 max (0, (xrep.MouseX - f->display.x->internal_border_width)
3466 / FONT_WIDTH (f->display.x->font))));
3467 XSET (tempy, Lisp_Int,
3468 min (f->height-1,
3469 max (0, (xrep.MouseY - f->display.x->internal_border_width)
3470 / FONT_HEIGHT (f->display.x->font))));
3472 XSET (frame, Lisp_Frame, f);
3473 XSET (timestamp, Lisp_Int, (xrep.MouseTime & 0x7fffff));
3475 pos = Fcons (tempx, Fcons (tempy, Qnil));
3476 Vmouse_window
3477 = Flocate_window_from_coordinates (frame, pos);
3479 Vmouse_event
3480 = Fcons (pos,
3481 Fcons (Vmouse_window,
3482 Fcons (Qnil,
3483 Fcons (Fchar_to_string (make_number (com_letter)),
3484 Fcons (timestamp, Qnil)))));
3485 return Vmouse_event;
3488 break;
3489 #endif /* HAVE_X11 */
3491 default:
3492 if (f = x_window_to_frame (xrep.MouseWindow))
3493 Vmouse_window = f->selected_window;
3494 else if (f = x_window_to_scroll_bar (xrep.MouseWindow, &part, &prefix))
3495 Vmouse_window = f->selected_window;
3496 return Vmouse_event = Qnil;
3500 if (!NILP (arg))
3501 return Qnil;
3503 /* Wait till we get another mouse event. */
3504 wait_reading_process_input (0, 0, 2, 0);
3507 #endif
3510 #ifndef HAVE_X11
3511 DEFUN ("x-store-cut-buffer", Fx_store_cut_buffer, Sx_store_cut_buffer,
3512 1, 1, "sStore text in cut buffer: ",
3513 "Store contents of STRING into the cut buffer of the X window system.")
3514 (string)
3515 register Lisp_Object string;
3517 int mask;
3519 CHECK_STRING (string, 1);
3520 if (! FRAME_X_P (selected_frame))
3521 error ("Selected frame does not understand X protocol.");
3523 BLOCK_INPUT;
3524 XStoreBytes ((char *) XSTRING (string)->data, XSTRING (string)->size);
3525 UNBLOCK_INPUT;
3527 return Qnil;
3530 DEFUN ("x-get-cut-buffer", Fx_get_cut_buffer, Sx_get_cut_buffer, 0, 0, 0,
3531 "Return contents of cut buffer of the X window system, as a string.")
3534 int len;
3535 register Lisp_Object string;
3536 int mask;
3537 register char *d;
3539 BLOCK_INPUT;
3540 d = XFetchBytes (&len);
3541 string = make_string (d, len);
3542 XFree (d);
3543 UNBLOCK_INPUT;
3544 return string;
3546 #endif /* X10 */
3548 #ifdef HAVE_X11
3549 DEFUN ("x-rebind-key", Fx_rebind_key, Sx_rebind_key, 3, 3, 0,
3550 "Rebind X keysym KEYSYM, with MODIFIERS, to generate NEWSTRING.\n\
3551 KEYSYM is a string which conforms to the X keysym definitions found\n\
3552 in X11/keysymdef.h, sans the initial XK_. MODIFIERS is nil or a\n\
3553 list of strings specifying modifier keys such as Control_L, which must\n\
3554 also be depressed for NEWSTRING to appear.")
3555 (x_keysym, modifiers, newstring)
3556 register Lisp_Object x_keysym;
3557 register Lisp_Object modifiers;
3558 register Lisp_Object newstring;
3560 char *rawstring;
3561 register KeySym keysym;
3562 KeySym modifier_list[16];
3564 CHECK_STRING (x_keysym, 1);
3565 CHECK_STRING (newstring, 3);
3567 keysym = XStringToKeysym ((char *) XSTRING (x_keysym)->data);
3568 if (keysym == NoSymbol)
3569 error ("Keysym does not exist");
3571 if (NILP (modifiers))
3572 XRebindKeysym (x_current_display, keysym, modifier_list, 0,
3573 XSTRING (newstring)->data, XSTRING (newstring)->size);
3574 else
3576 register Lisp_Object rest, mod;
3577 register int i = 0;
3579 for (rest = modifiers; !NILP (rest); rest = Fcdr (rest))
3581 if (i == 16)
3582 error ("Can't have more than 16 modifiers");
3584 mod = Fcar (rest);
3585 CHECK_STRING (mod, 3);
3586 modifier_list[i] = XStringToKeysym ((char *) XSTRING (mod)->data);
3587 if (modifier_list[i] == NoSymbol
3588 || !IsModifierKey (modifier_list[i]))
3589 error ("Element is not a modifier keysym");
3590 i++;
3593 XRebindKeysym (x_current_display, keysym, modifier_list, i,
3594 XSTRING (newstring)->data, XSTRING (newstring)->size);
3597 return Qnil;
3600 DEFUN ("x-rebind-keys", Fx_rebind_keys, Sx_rebind_keys, 2, 2, 0,
3601 "Rebind KEYCODE to list of strings STRINGS.\n\
3602 STRINGS should be a list of 16 elements, one for each shift combination.\n\
3603 nil as element means don't change.\n\
3604 See the documentation of `x-rebind-key' for more information.")
3605 (keycode, strings)
3606 register Lisp_Object keycode;
3607 register Lisp_Object strings;
3609 register Lisp_Object item;
3610 register unsigned char *rawstring;
3611 KeySym rawkey, modifier[1];
3612 int strsize;
3613 register unsigned i;
3615 CHECK_NUMBER (keycode, 1);
3616 CHECK_CONS (strings, 2);
3617 rawkey = (KeySym) ((unsigned) (XINT (keycode))) & 255;
3618 for (i = 0; i <= 15; strings = Fcdr (strings), i++)
3620 item = Fcar (strings);
3621 if (!NILP (item))
3623 CHECK_STRING (item, 2);
3624 strsize = XSTRING (item)->size;
3625 rawstring = (unsigned char *) xmalloc (strsize);
3626 bcopy (XSTRING (item)->data, rawstring, strsize);
3627 modifier[1] = 1 << i;
3628 XRebindKeysym (x_current_display, rawkey, modifier, 1,
3629 rawstring, strsize);
3632 return Qnil;
3634 #else
3635 DEFUN ("x-rebind-key", Fx_rebind_key, Sx_rebind_key, 3, 3, 0,
3636 "Rebind KEYCODE, with shift bits SHIFT-MASK, to new string NEWSTRING.\n\
3637 KEYCODE and SHIFT-MASK should be numbers representing the X keyboard code\n\
3638 and shift mask respectively. NEWSTRING is an arbitrary string of keystrokes.\n\
3639 If SHIFT-MASK is nil, then KEYCODE's key will be bound to NEWSTRING for\n\
3640 all shift combinations.\n\
3641 Shift Lock 1 Shift 2\n\
3642 Meta 4 Control 8\n\
3644 For values of KEYCODE, see /usr/lib/Xkeymap.txt (remember that the codes\n\
3645 in that file are in octal!)\n\
3647 NOTE: due to an X bug, this function will not take effect unless one has\n\
3648 a `~/.Xkeymap' file. (See the documentation for the `keycomp' program.)\n\
3649 This problem will be fixed in X version 11.")
3651 (keycode, shift_mask, newstring)
3652 register Lisp_Object keycode;
3653 register Lisp_Object shift_mask;
3654 register Lisp_Object newstring;
3656 char *rawstring;
3657 int keysym, rawshift;
3658 int i, strsize;
3660 CHECK_NUMBER (keycode, 1);
3661 if (!NILP (shift_mask))
3662 CHECK_NUMBER (shift_mask, 2);
3663 CHECK_STRING (newstring, 3);
3664 strsize = XSTRING (newstring)->size;
3665 rawstring = (char *) xmalloc (strsize);
3666 bcopy (XSTRING (newstring)->data, rawstring, strsize);
3668 keysym = ((unsigned) (XINT (keycode))) & 255;
3670 if (NILP (shift_mask))
3672 for (i = 0; i <= 15; i++)
3673 XRebindCode (keysym, i<<11, rawstring, strsize);
3675 else
3677 rawshift = (((unsigned) (XINT (shift_mask))) & 15) << 11;
3678 XRebindCode (keysym, rawshift, rawstring, strsize);
3680 return Qnil;
3683 DEFUN ("x-rebind-keys", Fx_rebind_keys, Sx_rebind_keys, 2, 2, 0,
3684 "Rebind KEYCODE to list of strings STRINGS.\n\
3685 STRINGS should be a list of 16 elements, one for each shift combination.\n\
3686 nil as element means don't change.\n\
3687 See the documentation of `x-rebind-key' for more information.")
3688 (keycode, strings)
3689 register Lisp_Object keycode;
3690 register Lisp_Object strings;
3692 register Lisp_Object item;
3693 register char *rawstring;
3694 KeySym rawkey, modifier[1];
3695 int strsize;
3696 register unsigned i;
3698 CHECK_NUMBER (keycode, 1);
3699 CHECK_CONS (strings, 2);
3700 rawkey = (KeySym) ((unsigned) (XINT (keycode))) & 255;
3701 for (i = 0; i <= 15; strings = Fcdr (strings), i++)
3703 item = Fcar (strings);
3704 if (!NILP (item))
3706 CHECK_STRING (item, 2);
3707 strsize = XSTRING (item)->size;
3708 rawstring = (char *) xmalloc (strsize);
3709 bcopy (XSTRING (item)->data, rawstring, strsize);
3710 XRebindCode (rawkey, i << 11, rawstring, strsize);
3713 return Qnil;
3715 #endif /* not HAVE_X11 */
3717 #ifdef HAVE_X11
3718 Visual *
3719 select_visual (screen, depth)
3720 Screen *screen;
3721 unsigned int *depth;
3723 Visual *v;
3724 XVisualInfo *vinfo, vinfo_template;
3725 int n_visuals;
3727 v = DefaultVisualOfScreen (screen);
3729 #ifdef HAVE_X11R4
3730 vinfo_template.visualid = XVisualIDFromVisual (v);
3731 #else
3732 vinfo_template.visualid = v->visualid;
3733 #endif
3735 vinfo = XGetVisualInfo (x_current_display, VisualIDMask, &vinfo_template,
3736 &n_visuals);
3737 if (n_visuals != 1)
3738 fatal ("Can't get proper X visual info");
3740 if ((1 << vinfo->depth) == vinfo->colormap_size)
3741 *depth = vinfo->depth;
3742 else
3744 int i = 0;
3745 int n = vinfo->colormap_size - 1;
3746 while (n)
3748 n = n >> 1;
3749 i++;
3751 *depth = i;
3754 XFree ((char *) vinfo);
3755 return v;
3757 #endif /* HAVE_X11 */
3759 DEFUN ("x-open-connection", Fx_open_connection, Sx_open_connection,
3760 1, 2, 0, "Open a connection to an X server.\n\
3761 DISPLAY is the name of the display to connect to. Optional second\n\
3762 arg XRM_STRING is a string of resources in xrdb format.")
3763 (display, xrm_string)
3764 Lisp_Object display, xrm_string;
3766 unsigned int n_planes;
3767 unsigned char *xrm_option;
3769 CHECK_STRING (display, 0);
3770 if (x_current_display != 0)
3771 error ("X server connection is already initialized");
3773 /* This is what opens the connection and sets x_current_display.
3774 This also initializes many symbols, such as those used for input. */
3775 x_term_init (XSTRING (display)->data);
3777 #ifdef HAVE_X11
3778 XFASTINT (Vwindow_system_version) = 11;
3780 if (!EQ (xrm_string, Qnil))
3782 CHECK_STRING (xrm_string, 1);
3783 xrm_option = (unsigned char *) XSTRING (xrm_string);
3785 else
3786 xrm_option = (unsigned char *) 0;
3787 xrdb = x_load_resources (x_current_display, xrm_option, EMACS_CLASS);
3788 #ifdef HAVE_X11R5
3789 XrmSetDatabase (x_current_display, xrdb);
3790 #else
3791 x_current_display->db = xrdb;
3792 #endif
3794 x_screen = DefaultScreenOfDisplay (x_current_display);
3796 screen_visual = select_visual (x_screen, &n_planes);
3797 x_screen_planes = n_planes;
3798 x_screen_height = HeightOfScreen (x_screen);
3799 x_screen_width = WidthOfScreen (x_screen);
3801 /* X Atoms used by emacs. */
3802 Xatoms_of_xselect ();
3803 BLOCK_INPUT;
3804 Xatom_wm_protocols = XInternAtom (x_current_display, "WM_PROTOCOLS",
3805 False);
3806 Xatom_wm_take_focus = XInternAtom (x_current_display, "WM_TAKE_FOCUS",
3807 False);
3808 Xatom_wm_save_yourself = XInternAtom (x_current_display, "WM_SAVE_YOURSELF",
3809 False);
3810 Xatom_wm_delete_window = XInternAtom (x_current_display, "WM_DELETE_WINDOW",
3811 False);
3812 Xatom_wm_change_state = XInternAtom (x_current_display, "WM_CHANGE_STATE",
3813 False);
3814 Xatom_wm_configure_denied = XInternAtom (x_current_display,
3815 "WM_CONFIGURE_DENIED", False);
3816 Xatom_wm_window_moved = XInternAtom (x_current_display, "WM_MOVED",
3817 False);
3818 UNBLOCK_INPUT;
3819 #else /* not HAVE_X11 */
3820 XFASTINT (Vwindow_system_version) = 10;
3821 #endif /* not HAVE_X11 */
3822 return Qnil;
3825 DEFUN ("x-close-current-connection", Fx_close_current_connection,
3826 Sx_close_current_connection,
3827 0, 0, 0, "Close the connection to the current X server.")
3830 #ifdef HAVE_X11
3831 /* This is ONLY used when killing emacs; For switching displays
3832 we'll have to take care of setting CloseDownMode elsewhere. */
3834 if (x_current_display)
3836 BLOCK_INPUT;
3837 XSetCloseDownMode (x_current_display, DestroyAll);
3838 XCloseDisplay (x_current_display);
3840 else
3841 fatal ("No current X display connection to close\n");
3842 #endif
3843 return Qnil;
3846 DEFUN ("x-synchronize", Fx_synchronize, Sx_synchronize,
3847 1, 1, 0, "If ON is non-nil, report X errors as soon as the erring request is made.\n\
3848 If ON is nil, allow buffering of requests.\n\
3849 Turning on synchronization prohibits the Xlib routines from buffering\n\
3850 requests and seriously degrades performance, but makes debugging much\n\
3851 easier.")
3852 (on)
3853 Lisp_Object on;
3855 XSynchronize (x_current_display, !EQ (on, Qnil));
3857 return Qnil;
3861 syms_of_xfns ()
3863 /* This is zero if not using X windows. */
3864 x_current_display = 0;
3866 /* The section below is built by the lisp expression at the top of the file,
3867 just above where these variables are declared. */
3868 /*&&& init symbols here &&&*/
3869 Qauto_raise = intern ("auto-raise");
3870 staticpro (&Qauto_raise);
3871 Qauto_lower = intern ("auto-lower");
3872 staticpro (&Qauto_lower);
3873 Qbackground_color = intern ("background-color");
3874 staticpro (&Qbackground_color);
3875 Qbar = intern ("bar");
3876 staticpro (&Qbar);
3877 Qborder_color = intern ("border-color");
3878 staticpro (&Qborder_color);
3879 Qborder_width = intern ("border-width");
3880 staticpro (&Qborder_width);
3881 Qbox = intern ("box");
3882 staticpro (&Qbox);
3883 Qcursor_color = intern ("cursor-color");
3884 staticpro (&Qcursor_color);
3885 Qcursor_type = intern ("cursor-type");
3886 staticpro (&Qcursor_type);
3887 Qfont = intern ("font");
3888 staticpro (&Qfont);
3889 Qforeground_color = intern ("foreground-color");
3890 staticpro (&Qforeground_color);
3891 Qgeometry = intern ("geometry");
3892 staticpro (&Qgeometry);
3893 Qicon = intern ("icon");
3894 staticpro (&Qicon);
3895 Qicon_left = intern ("icon-left");
3896 staticpro (&Qicon_left);
3897 Qicon_top = intern ("icon-top");
3898 staticpro (&Qicon_top);
3899 Qicon_type = intern ("icon-type");
3900 staticpro (&Qicon_type);
3901 Qinternal_border_width = intern ("internal-border-width");
3902 staticpro (&Qinternal_border_width);
3903 Qleft = intern ("left");
3904 staticpro (&Qleft);
3905 Qmouse_color = intern ("mouse-color");
3906 staticpro (&Qmouse_color);
3907 Qnone = intern ("none");
3908 staticpro (&Qnone);
3909 Qparent_id = intern ("parent-id");
3910 staticpro (&Qparent_id);
3911 Qsuppress_icon = intern ("suppress-icon");
3912 staticpro (&Qsuppress_icon);
3913 Qtop = intern ("top");
3914 staticpro (&Qtop);
3915 Qundefined_color = intern ("undefined-color");
3916 staticpro (&Qundefined_color);
3917 Qvertical_scroll_bars = intern ("vertical-scroll-bars");
3918 staticpro (&Qvertical_scroll_bars);
3919 Qvisibility = intern ("visibility");
3920 staticpro (&Qvisibility);
3921 Qwindow_id = intern ("window-id");
3922 staticpro (&Qwindow_id);
3923 Qx_frame_parameter = intern ("x-frame-parameter");
3924 staticpro (&Qx_frame_parameter);
3925 /* This is the end of symbol initialization. */
3927 Fput (Qundefined_color, Qerror_conditions,
3928 Fcons (Qundefined_color, Fcons (Qerror, Qnil)));
3929 Fput (Qundefined_color, Qerror_message,
3930 build_string ("Undefined color"));
3932 init_x_parm_symbols ();
3934 DEFVAR_INT ("mouse-buffer-offset", &mouse_buffer_offset,
3935 "The buffer offset of the character under the pointer.");
3936 mouse_buffer_offset = 0;
3938 DEFVAR_INT ("x-pointer-shape", &Vx_pointer_shape,
3939 "The shape of the pointer when over text.");
3940 Vx_pointer_shape = Qnil;
3942 DEFVAR_INT ("x-nontext-pointer-shape", &Vx_nontext_pointer_shape,
3943 "The shape of the pointer when not over text.");
3944 Vx_nontext_pointer_shape = Qnil;
3946 DEFVAR_INT ("x-mode-pointer-shape", &Vx_mode_pointer_shape,
3947 "The shape of the pointer when over the mode line.");
3948 Vx_mode_pointer_shape = Qnil;
3950 DEFVAR_LISP ("x-cursor-fore-pixel", &Vx_cursor_fore_pixel,
3951 "A string indicating the foreground color of the cursor box.");
3952 Vx_cursor_fore_pixel = Qnil;
3954 DEFVAR_LISP ("mouse-grabbed", &Vmouse_depressed,
3955 "Non-nil if a mouse button is currently depressed.");
3956 Vmouse_depressed = Qnil;
3958 DEFVAR_LISP ("x-no-window-manager", &Vx_no_window_manager,
3959 "t if no X window manager is in use.");
3961 #ifdef HAVE_X11
3962 defsubr (&Sx_get_resource);
3963 #if 0
3964 defsubr (&Sx_draw_rectangle);
3965 defsubr (&Sx_erase_rectangle);
3966 defsubr (&Sx_contour_region);
3967 defsubr (&Sx_uncontour_region);
3968 #endif
3969 defsubr (&Sx_display_color_p);
3970 defsubr (&Sx_color_defined_p);
3971 defsubr (&Sx_server_vendor);
3972 defsubr (&Sx_server_version);
3973 defsubr (&Sx_display_pixel_width);
3974 defsubr (&Sx_display_pixel_height);
3975 defsubr (&Sx_display_mm_width);
3976 defsubr (&Sx_display_mm_height);
3977 defsubr (&Sx_display_screens);
3978 defsubr (&Sx_display_planes);
3979 defsubr (&Sx_display_color_cells);
3980 defsubr (&Sx_display_visual_class);
3981 defsubr (&Sx_display_backing_store);
3982 defsubr (&Sx_display_save_under);
3983 #if 0
3984 defsubr (&Sx_track_pointer);
3985 defsubr (&Sx_grab_pointer);
3986 defsubr (&Sx_ungrab_pointer);
3987 #endif
3988 #else
3989 defsubr (&Sx_get_default);
3990 defsubr (&Sx_store_cut_buffer);
3991 defsubr (&Sx_get_cut_buffer);
3992 defsubr (&Sx_set_face);
3993 #endif
3994 defsubr (&Sx_parse_geometry);
3995 defsubr (&Sx_create_frame);
3996 defsubr (&Sfocus_frame);
3997 defsubr (&Sunfocus_frame);
3998 #if 0
3999 defsubr (&Sx_horizontal_line);
4000 #endif
4001 defsubr (&Sx_rebind_key);
4002 defsubr (&Sx_rebind_keys);
4003 defsubr (&Sx_open_connection);
4004 defsubr (&Sx_close_current_connection);
4005 defsubr (&Sx_synchronize);
4007 /* This was used in the old event interface which used a separate
4008 event queue.*/
4009 #if 0
4010 defsubr (&Sx_mouse_events);
4011 defsubr (&Sx_get_mouse_event);
4012 #endif
4015 #endif /* HAVE_X_WINDOWS */