Added library headers.
[emacs.git] / src / xfns.c
blobf4632b40987f984f8514a5afd41dd4b3f1017c18
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 #include <X11/bitmaps/gray>
42 #define min(a,b) ((a) < (b) ? (a) : (b))
43 #define max(a,b) ((a) > (b) ? (a) : (b))
45 #ifdef HAVE_X11
46 /* X Resource data base */
47 static XrmDatabase xrdb;
49 /* The class of this X application. */
50 #define EMACS_CLASS "Emacs"
52 /* Title name and application name for X stuff. */
53 extern char *x_id_name;
54 extern Lisp_Object invocation_name;
56 /* The background and shape of the mouse pointer, and shape when not
57 over text or in the modeline. */
58 Lisp_Object Vx_pointer_shape, Vx_nontext_pointer_shape, Vx_mode_pointer_shape;
60 /* Color of chars displayed in cursor box. */
61 Lisp_Object Vx_cursor_fore_pixel;
63 /* The X Visual we are using for X windows (the default) */
64 Visual *screen_visual;
66 /* How many screens this X display has. */
67 int x_screen_count;
69 /* The vendor supporting this X server. */
70 Lisp_Object Vx_vendor;
72 /* The vendor's release number for this X server. */
73 int x_release;
75 /* Height of this X screen in pixels. */
76 int x_screen_height;
78 /* Height of this X screen in millimeters. */
79 int x_screen_height_mm;
81 /* Width of this X screen in pixels. */
82 int x_screen_width;
84 /* Width of this X screen in millimeters. */
85 int x_screen_width_mm;
87 /* Does this X screen do backing store? */
88 Lisp_Object Vx_backing_store;
90 /* Does this X screen do save-unders? */
91 int x_save_under;
93 /* Number of planes for this screen. */
94 int x_screen_planes;
96 /* X Visual type of this screen. */
97 Lisp_Object Vx_screen_visual;
99 /* Non nil if no window manager is in use. */
100 Lisp_Object Vx_no_window_manager;
102 static char *x_visual_strings[] =
104 "StaticGray",
105 "GrayScale",
106 "StaticColor",
107 "PseudoColor",
108 "TrueColor",
109 "DirectColor"
112 /* `t' if a mouse button is depressed. */
114 Lisp_Object Vmouse_depressed;
116 extern unsigned int x_mouse_x, x_mouse_y, x_mouse_grabbed;
118 /* Atom for indicating window state to the window manager. */
119 Atom Xatom_wm_change_state;
121 /* When emacs became the selection owner. */
122 extern Time x_begin_selection_own;
124 /* Emacs' selection property identifier. */
125 extern Atom Xatom_emacs_selection;
127 /* Clipboard selection atom. */
128 extern Atom Xatom_clipboard_selection;
130 /* Clipboard atom. */
131 extern Atom Xatom_clipboard;
133 /* Atom for indicating incremental selection transfer. */
134 extern Atom Xatom_incremental;
136 /* Atom for indicating multiple selection request list */
137 extern Atom Xatom_multiple;
139 /* Atom for what targets emacs handles. */
140 extern Atom Xatom_targets;
142 /* Atom for indicating timstamp selection request */
143 extern Atom Xatom_timestamp;
145 /* Atom requesting we delete our selection. */
146 extern Atom Xatom_delete;
148 /* Selection magic. */
149 extern Atom Xatom_insert_selection;
151 /* Type of property for INSERT_SELECTION. */
152 extern Atom Xatom_pair;
154 /* More selection magic. */
155 extern Atom Xatom_insert_property;
157 /* Atom for indicating property type TEXT */
158 extern Atom Xatom_text;
160 /* Communication with window managers. */
161 extern Atom Xatom_wm_protocols;
163 /* Kinds of protocol things we may receive. */
164 extern Atom Xatom_wm_take_focus;
165 extern Atom Xatom_wm_save_yourself;
166 extern Atom Xatom_wm_delete_window;
168 /* Other WM communication */
169 extern Atom Xatom_wm_configure_denied; /* When our config request is denied */
170 extern Atom Xatom_wm_window_moved; /* When the WM moves us. */
172 #else /* X10 */
174 /* Default size of an Emacs window. */
175 static char *default_window = "=80x24+0+0";
177 #define MAXICID 80
178 char iconidentity[MAXICID];
179 #define ICONTAG "emacs@"
180 char minibuffer_iconidentity[MAXICID];
181 #define MINIBUFFER_ICONTAG "minibuffer@"
183 #endif /* X10 */
185 /* The last 23 bits of the timestamp of the last mouse button event. */
186 Time mouse_timestamp;
188 /* Evaluate this expression to rebuild the section of syms_of_xfns
189 that initializes and staticpros the symbols declared below. Note
190 that Emacs 18 has a bug that keeps C-x C-e from being able to
191 evaluate this expression.
193 (progn
194 ;; Accumulate a list of the symbols we want to initialize from the
195 ;; declarations at the top of the file.
196 (goto-char (point-min))
197 (search-forward "/\*&&& symbols declared here &&&*\/\n")
198 (let (symbol-list)
199 (while (looking-at "Lisp_Object \\(Q[a-z_]+\\)")
200 (setq symbol-list
201 (cons (buffer-substring (match-beginning 1) (match-end 1))
202 symbol-list))
203 (forward-line 1))
204 (setq symbol-list (nreverse symbol-list))
205 ;; Delete the section of syms_of_... where we initialize the symbols.
206 (search-forward "\n /\*&&& init symbols here &&&*\/\n")
207 (let ((start (point)))
208 (while (looking-at "^ Q")
209 (forward-line 2))
210 (kill-region start (point)))
211 ;; Write a new symbol initialization section.
212 (while symbol-list
213 (insert (format " %s = intern (\"" (car symbol-list)))
214 (let ((start (point)))
215 (insert (substring (car symbol-list) 1))
216 (subst-char-in-region start (point) ?_ ?-))
217 (insert (format "\");\n staticpro (&%s);\n" (car symbol-list)))
218 (setq symbol-list (cdr symbol-list)))))
222 /*&&& symbols declared here &&&*/
223 Lisp_Object Qauto_raise;
224 Lisp_Object Qauto_lower;
225 Lisp_Object Qbackground_color;
226 Lisp_Object Qbar;
227 Lisp_Object Qborder_color;
228 Lisp_Object Qborder_width;
229 Lisp_Object Qbox;
230 Lisp_Object Qcursor_color;
231 Lisp_Object Qcursor_type;
232 Lisp_Object Qfont;
233 Lisp_Object Qforeground_color;
234 Lisp_Object Qgeometry;
235 Lisp_Object Qicon_left;
236 Lisp_Object Qicon_top;
237 Lisp_Object Qicon_type;
238 Lisp_Object Qiconic_startup;
239 Lisp_Object Qinternal_border_width;
240 Lisp_Object Qleft;
241 Lisp_Object Qmouse_color;
242 Lisp_Object Qnone;
243 Lisp_Object Qparent_id;
244 Lisp_Object Qsuppress_icon;
245 Lisp_Object Qsuppress_initial_map;
246 Lisp_Object Qtop;
247 Lisp_Object Qundefined_color;
248 Lisp_Object Qvertical_scroll_bars;
249 Lisp_Object Qwindow_id;
250 Lisp_Object Qx_frame_parameter;
251 Lisp_Object Qvisibility;
253 /* The below are defined in frame.c. */
254 extern Lisp_Object Qheight, Qminibuffer, Qname, Qonly, Qwidth;
255 extern Lisp_Object Qunsplittable, Qmenu_bar_lines, Qicon;
257 extern Lisp_Object Vwindow_system_version;
259 /* Mouse map for clicks in windows. */
260 extern Lisp_Object Vglobal_mouse_map;
262 /* Points to table of defined typefaces. */
263 struct face *x_face_table[MAX_FACES_AND_GLYPHS];
265 /* Return the Emacs frame-object corresponding to an X window.
266 It could be the frame's main window or an icon window. */
268 struct frame *
269 x_window_to_frame (wdesc)
270 int wdesc;
272 Lisp_Object tail, frame;
273 struct frame *f;
275 for (tail = Vframe_list; CONSP (tail); tail = XCONS (tail)->cdr)
277 frame = XCONS (tail)->car;
278 if (XTYPE (frame) != Lisp_Frame)
279 continue;
280 f = XFRAME (frame);
281 if (FRAME_X_WINDOW (f) == wdesc
282 || f->display.x->icon_desc == wdesc)
283 return f;
285 return 0;
289 /* Connect the frame-parameter names for X frames
290 to the ways of passing the parameter values to the window system.
292 The name of a parameter, as a Lisp symbol,
293 has an `x-frame-parameter' property which is an integer in Lisp
294 but can be interpreted as an `enum x_frame_parm' in C. */
296 enum x_frame_parm
298 X_PARM_FOREGROUND_COLOR,
299 X_PARM_BACKGROUND_COLOR,
300 X_PARM_MOUSE_COLOR,
301 X_PARM_CURSOR_COLOR,
302 X_PARM_BORDER_COLOR,
303 X_PARM_ICON_TYPE,
304 X_PARM_FONT,
305 X_PARM_BORDER_WIDTH,
306 X_PARM_INTERNAL_BORDER_WIDTH,
307 X_PARM_NAME,
308 X_PARM_AUTORAISE,
309 X_PARM_AUTOLOWER,
310 X_PARM_VERT_SCROLL_BAR,
311 X_PARM_VISIBILITY,
312 X_PARM_MENU_BAR_LINES
316 struct x_frame_parm_table
318 char *name;
319 void (*setter)( /* struct frame *frame, Lisp_Object val, oldval */ );
322 void x_set_foreground_color ();
323 void x_set_background_color ();
324 void x_set_mouse_color ();
325 void x_set_cursor_color ();
326 void x_set_border_color ();
327 void x_set_cursor_type ();
328 void x_set_icon_type ();
329 void x_set_font ();
330 void x_set_border_width ();
331 void x_set_internal_border_width ();
332 void x_explicitly_set_name ();
333 void x_set_autoraise ();
334 void x_set_autolower ();
335 void x_set_vertical_scroll_bars ();
336 void x_set_visibility ();
337 void x_set_menu_bar_lines ();
339 static struct x_frame_parm_table x_frame_parms[] =
341 "foreground-color", x_set_foreground_color,
342 "background-color", x_set_background_color,
343 "mouse-color", x_set_mouse_color,
344 "cursor-color", x_set_cursor_color,
345 "border-color", x_set_border_color,
346 "cursor-type", x_set_cursor_type,
347 "icon-type", x_set_icon_type,
348 "font", x_set_font,
349 "border-width", x_set_border_width,
350 "internal-border-width", x_set_internal_border_width,
351 "name", x_explicitly_set_name,
352 "auto-raise", x_set_autoraise,
353 "auto-lower", x_set_autolower,
354 "vertical-scroll-bars", x_set_vertical_scroll_bars,
355 "visibility", x_set_visibility,
356 "menu-bar-lines", x_set_menu_bar_lines,
359 /* Attach the `x-frame-parameter' properties to
360 the Lisp symbol names of parameters relevant to X. */
362 init_x_parm_symbols ()
364 int i;
366 for (i = 0; i < sizeof (x_frame_parms) / sizeof (x_frame_parms[0]); i++)
367 Fput (intern (x_frame_parms[i].name), Qx_frame_parameter,
368 make_number (i));
371 /* Change the parameters of FRAME as specified by ALIST.
372 If a parameter is not specially recognized, do nothing;
373 otherwise call the `x_set_...' function for that parameter. */
375 void
376 x_set_frame_parameters (f, alist)
377 FRAME_PTR f;
378 Lisp_Object alist;
380 Lisp_Object tail;
382 /* If both of these parameters are present, it's more efficient to
383 set them both at once. So we wait until we've looked at the
384 entire list before we set them. */
385 Lisp_Object width, height;
387 /* Same here. */
388 Lisp_Object left, top;
390 XSET (width, Lisp_Int, FRAME_WIDTH (f));
391 XSET (height, Lisp_Int, FRAME_HEIGHT (f));
393 XSET (top, Lisp_Int, f->display.x->top_pos);
394 XSET (left, Lisp_Int, f->display.x->left_pos);
396 for (tail = alist; CONSP (tail); tail = Fcdr (tail))
398 Lisp_Object elt, prop, val;
400 elt = Fcar (tail);
401 prop = Fcar (elt);
402 val = Fcdr (elt);
404 if (EQ (prop, Qwidth))
405 width = val;
406 else if (EQ (prop, Qheight))
407 height = val;
408 else if (EQ (prop, Qtop))
409 top = val;
410 else if (EQ (prop, Qleft))
411 left = val;
412 else
414 register Lisp_Object tem;
415 tem = Fget (prop, Qx_frame_parameter);
416 if (XTYPE (tem) == Lisp_Int
417 && XINT (tem) >= 0
418 && XINT (tem) < sizeof (x_frame_parms)/sizeof (x_frame_parms[0]))
419 (*x_frame_parms[XINT (tem)].setter)(f, val,
420 get_frame_param (f, prop));
421 store_frame_param (f, prop, val);
425 /* Don't call these unless they've changed; the window may not actually
426 exist yet. */
428 Lisp_Object frame;
430 XSET (frame, Lisp_Frame, f);
431 if (XINT (width) != FRAME_WIDTH (f)
432 || XINT (height) != FRAME_HEIGHT (f))
433 Fset_frame_size (frame, width, height);
434 if (XINT (left) != f->display.x->left_pos
435 || XINT (top) != f->display.x->top_pos)
436 Fset_frame_position (frame, left, top);
440 /* Insert a description of internally-recorded parameters of frame X
441 into the parameter alist *ALISTPTR that is to be given to the user.
442 Only parameters that are specific to the X window system
443 and whose values are not correctly recorded in the frame's
444 param_alist need to be considered here. */
446 x_report_frame_params (f, alistptr)
447 struct frame *f;
448 Lisp_Object *alistptr;
450 char buf[16];
452 store_in_alist (alistptr, Qleft, make_number (f->display.x->left_pos));
453 store_in_alist (alistptr, Qtop, make_number (f->display.x->top_pos));
454 store_in_alist (alistptr, Qborder_width,
455 make_number (f->display.x->border_width));
456 store_in_alist (alistptr, Qinternal_border_width,
457 make_number (f->display.x->internal_border_width));
458 sprintf (buf, "%d", FRAME_X_WINDOW (f));
459 store_in_alist (alistptr, Qwindow_id,
460 build_string (buf));
461 store_in_alist (alistptr, Qvisibility,
462 (FRAME_VISIBLE_P (f) ? Qt
463 : FRAME_ICONIFIED_P (f) ? Qicon : Qnil));
466 /* Decide if color named COLOR is valid for the display
467 associated with the selected frame. */
469 defined_color (color, color_def)
470 char *color;
471 Color *color_def;
473 register int foo;
474 Colormap screen_colormap;
476 BLOCK_INPUT;
477 #ifdef HAVE_X11
478 screen_colormap
479 = DefaultColormap (x_current_display, XDefaultScreen (x_current_display));
481 foo = XParseColor (x_current_display, screen_colormap,
482 color, color_def)
483 && XAllocColor (x_current_display, screen_colormap, color_def);
484 #else
485 foo = XParseColor (color, color_def) && XGetHardwareColor (color_def);
486 #endif /* not HAVE_X11 */
487 UNBLOCK_INPUT;
489 if (foo)
490 return 1;
491 else
492 return 0;
495 /* Given a string ARG naming a color, compute a pixel value from it
496 suitable for screen F.
497 If F is not a color screen, return DEF (default) regardless of what
498 ARG says. */
501 x_decode_color (arg, def)
502 Lisp_Object arg;
503 int def;
505 Color cdef;
507 CHECK_STRING (arg, 0);
509 if (strcmp (XSTRING (arg)->data, "black") == 0)
510 return BLACK_PIX_DEFAULT;
511 else if (strcmp (XSTRING (arg)->data, "white") == 0)
512 return WHITE_PIX_DEFAULT;
514 #ifdef HAVE_X11
515 if (x_screen_planes == 1)
516 return def;
517 #else
518 if (DISPLAY_CELLS == 1)
519 return def;
520 #endif
522 if (defined_color (XSTRING (arg)->data, &cdef))
523 return cdef.pixel;
524 else
525 Fsignal (Qundefined_color, Fcons (arg, Qnil));
528 /* Functions called only from `x_set_frame_param'
529 to set individual parameters.
531 If FRAME_X_WINDOW (f) is 0,
532 the frame is being created and its X-window does not exist yet.
533 In that case, just record the parameter's new value
534 in the standard place; do not attempt to change the window. */
536 void
537 x_set_foreground_color (f, arg, oldval)
538 struct frame *f;
539 Lisp_Object arg, oldval;
541 f->display.x->foreground_pixel = x_decode_color (arg, BLACK_PIX_DEFAULT);
542 if (FRAME_X_WINDOW (f) != 0)
544 #ifdef HAVE_X11
545 BLOCK_INPUT;
546 XSetForeground (x_current_display, f->display.x->normal_gc,
547 f->display.x->foreground_pixel);
548 XSetBackground (x_current_display, f->display.x->reverse_gc,
549 f->display.x->foreground_pixel);
550 UNBLOCK_INPUT;
551 #endif /* HAVE_X11 */
552 if (FRAME_VISIBLE_P (f))
553 redraw_frame (f);
557 void
558 x_set_background_color (f, arg, oldval)
559 struct frame *f;
560 Lisp_Object arg, oldval;
562 Pixmap temp;
563 int mask;
565 f->display.x->background_pixel = x_decode_color (arg, WHITE_PIX_DEFAULT);
567 if (FRAME_X_WINDOW (f) != 0)
569 BLOCK_INPUT;
570 #ifdef HAVE_X11
571 /* The main frame area. */
572 XSetBackground (x_current_display, f->display.x->normal_gc,
573 f->display.x->background_pixel);
574 XSetForeground (x_current_display, f->display.x->reverse_gc,
575 f->display.x->background_pixel);
576 XSetWindowBackground (x_current_display, FRAME_X_WINDOW (f),
577 f->display.x->background_pixel);
579 #else
580 temp = XMakeTile (f->display.x->background_pixel);
581 XChangeBackground (FRAME_X_WINDOW (f), temp);
582 XFreePixmap (temp);
583 #endif /* not HAVE_X11 */
584 UNBLOCK_INPUT;
586 if (FRAME_VISIBLE_P (f))
587 redraw_frame (f);
591 void
592 x_set_mouse_color (f, arg, oldval)
593 struct frame *f;
594 Lisp_Object arg, oldval;
596 Cursor cursor, nontext_cursor, mode_cursor;
597 int mask_color;
599 if (!EQ (Qnil, arg))
600 f->display.x->mouse_pixel = x_decode_color (arg, BLACK_PIX_DEFAULT);
601 mask_color = f->display.x->background_pixel;
602 /* No invisible pointers. */
603 if (mask_color == f->display.x->mouse_pixel
604 && mask_color == f->display.x->background_pixel)
605 f->display.x->mouse_pixel = f->display.x->foreground_pixel;
607 BLOCK_INPUT;
608 #ifdef HAVE_X11
610 /* It's not okay to crash if the user selects a screwey cursor. */
611 x_catch_errors ();
613 if (!EQ (Qnil, Vx_pointer_shape))
615 CHECK_NUMBER (Vx_pointer_shape, 0);
616 cursor = XCreateFontCursor (x_current_display, XINT (Vx_pointer_shape));
618 else
619 cursor = XCreateFontCursor (x_current_display, XC_xterm);
620 x_check_errors ("bad text pointer cursor: %s");
622 if (!EQ (Qnil, Vx_nontext_pointer_shape))
624 CHECK_NUMBER (Vx_nontext_pointer_shape, 0);
625 nontext_cursor = XCreateFontCursor (x_current_display,
626 XINT (Vx_nontext_pointer_shape));
628 else
629 nontext_cursor = XCreateFontCursor (x_current_display, XC_left_ptr);
630 x_check_errors ("bad nontext pointer cursor: %s");
632 if (!EQ (Qnil, Vx_mode_pointer_shape))
634 CHECK_NUMBER (Vx_mode_pointer_shape, 0);
635 mode_cursor = XCreateFontCursor (x_current_display,
636 XINT (Vx_mode_pointer_shape));
638 else
639 mode_cursor = XCreateFontCursor (x_current_display, XC_xterm);
641 /* Check and report errors with the above calls. */
642 x_check_errors ("can't set cursor shape: %s");
643 x_uncatch_errors ();
646 XColor fore_color, back_color;
648 fore_color.pixel = f->display.x->mouse_pixel;
649 back_color.pixel = mask_color;
650 XQueryColor (x_current_display,
651 DefaultColormap (x_current_display,
652 DefaultScreen (x_current_display)),
653 &fore_color);
654 XQueryColor (x_current_display,
655 DefaultColormap (x_current_display,
656 DefaultScreen (x_current_display)),
657 &back_color);
658 XRecolorCursor (x_current_display, cursor,
659 &fore_color, &back_color);
660 XRecolorCursor (x_current_display, nontext_cursor,
661 &fore_color, &back_color);
662 XRecolorCursor (x_current_display, mode_cursor,
663 &fore_color, &back_color);
665 #else /* X10 */
666 cursor = XCreateCursor (16, 16, MouseCursor, MouseMask,
667 0, 0,
668 f->display.x->mouse_pixel,
669 f->display.x->background_pixel,
670 GXcopy);
671 #endif /* X10 */
673 if (FRAME_X_WINDOW (f) != 0)
675 XDefineCursor (XDISPLAY FRAME_X_WINDOW (f), cursor);
678 if (cursor != f->display.x->text_cursor && f->display.x->text_cursor != 0)
679 XFreeCursor (XDISPLAY f->display.x->text_cursor);
680 f->display.x->text_cursor = cursor;
681 #ifdef HAVE_X11
682 if (nontext_cursor != f->display.x->nontext_cursor
683 && f->display.x->nontext_cursor != 0)
684 XFreeCursor (XDISPLAY f->display.x->nontext_cursor);
685 f->display.x->nontext_cursor = nontext_cursor;
687 if (mode_cursor != f->display.x->modeline_cursor
688 && f->display.x->modeline_cursor != 0)
689 XFreeCursor (XDISPLAY f->display.x->modeline_cursor);
690 f->display.x->modeline_cursor = mode_cursor;
691 #endif /* HAVE_X11 */
693 XFlushQueue ();
694 UNBLOCK_INPUT;
697 void
698 x_set_cursor_color (f, arg, oldval)
699 struct frame *f;
700 Lisp_Object arg, oldval;
702 unsigned long fore_pixel;
704 if (!EQ (Vx_cursor_fore_pixel, Qnil))
705 fore_pixel = x_decode_color (Vx_cursor_fore_pixel, WHITE_PIX_DEFAULT);
706 else
707 fore_pixel = f->display.x->background_pixel;
708 f->display.x->cursor_pixel = x_decode_color (arg, BLACK_PIX_DEFAULT);
710 /* Make sure that the cursor color differs from the background color. */
711 if (f->display.x->cursor_pixel == f->display.x->background_pixel)
713 f->display.x->cursor_pixel == f->display.x->mouse_pixel;
714 if (f->display.x->cursor_pixel == fore_pixel)
715 fore_pixel = f->display.x->background_pixel;
718 if (FRAME_X_WINDOW (f) != 0)
720 #ifdef HAVE_X11
721 BLOCK_INPUT;
722 XSetBackground (x_current_display, f->display.x->cursor_gc,
723 f->display.x->cursor_pixel);
724 XSetForeground (x_current_display, f->display.x->cursor_gc,
725 fore_pixel);
726 UNBLOCK_INPUT;
727 #endif /* HAVE_X11 */
729 if (FRAME_VISIBLE_P (f))
731 x_display_cursor (f, 0);
732 x_display_cursor (f, 1);
737 /* Set the border-color of frame F to value described by ARG.
738 ARG can be a string naming a color.
739 The border-color is used for the border that is drawn by the X server.
740 Note that this does not fully take effect if done before
741 F has an x-window; it must be redone when the window is created.
743 Note: this is done in two routines because of the way X10 works.
745 Note: under X11, this is normally the province of the window manager,
746 and so emacs' border colors may be overridden. */
748 void
749 x_set_border_color (f, arg, oldval)
750 struct frame *f;
751 Lisp_Object arg, oldval;
753 unsigned char *str;
754 int pix;
756 CHECK_STRING (arg, 0);
757 str = XSTRING (arg)->data;
759 #ifndef HAVE_X11
760 if (!strcmp (str, "grey") || !strcmp (str, "Grey")
761 || !strcmp (str, "gray") || !strcmp (str, "Gray"))
762 pix = -1;
763 else
764 #endif /* X10 */
766 pix = x_decode_color (arg, BLACK_PIX_DEFAULT);
768 x_set_border_pixel (f, pix);
771 /* Set the border-color of frame F to pixel value PIX.
772 Note that this does not fully take effect if done before
773 F has an x-window. */
775 x_set_border_pixel (f, pix)
776 struct frame *f;
777 int pix;
779 f->display.x->border_pixel = pix;
781 if (FRAME_X_WINDOW (f) != 0 && f->display.x->border_width > 0)
783 Pixmap temp;
784 int mask;
786 BLOCK_INPUT;
787 #ifdef HAVE_X11
788 XSetWindowBorder (x_current_display, FRAME_X_WINDOW (f),
789 pix);
790 #else
791 if (pix < 0)
792 temp = XMakePixmap ((Bitmap) XStoreBitmap (gray_width, gray_height,
793 gray_bits),
794 BLACK_PIX_DEFAULT, WHITE_PIX_DEFAULT);
795 else
796 temp = XMakeTile (pix);
797 XChangeBorder (FRAME_X_WINDOW (f), temp);
798 XFreePixmap (XDISPLAY temp);
799 #endif /* not HAVE_X11 */
800 UNBLOCK_INPUT;
802 if (FRAME_VISIBLE_P (f))
803 redraw_frame (f);
807 void
808 x_set_cursor_type (f, arg, oldval)
809 FRAME_PTR f;
810 Lisp_Object arg, oldval;
812 if (EQ (arg, Qbar))
813 FRAME_DESIRED_CURSOR (f) = bar_cursor;
814 else if (EQ (arg, Qbox))
815 FRAME_DESIRED_CURSOR (f) = filled_box_cursor;
816 else
817 error
818 ("the `cursor-type' frame parameter should be either `bar' or `box'");
820 /* Make sure the cursor gets redrawn. This is overkill, but how
821 often do people change cursor types? */
822 update_mode_lines++;
825 void
826 x_set_icon_type (f, arg, oldval)
827 struct frame *f;
828 Lisp_Object arg, oldval;
830 Lisp_Object tem;
831 int result;
833 if (EQ (oldval, Qnil) == EQ (arg, Qnil))
834 return;
836 BLOCK_INPUT;
837 if (NILP (arg))
838 result = x_text_icon (f, 0);
839 else
840 result = x_bitmap_icon (f);
842 if (result)
844 UNBLOCK_INPUT;
845 error ("No icon window available.");
848 /* If the window was unmapped (and its icon was mapped),
849 the new icon is not mapped, so map the window in its stead. */
850 if (FRAME_VISIBLE_P (f))
851 XMapWindow (XDISPLAY FRAME_X_WINDOW (f));
853 XFlushQueue ();
854 UNBLOCK_INPUT;
857 void
858 x_set_font (f, arg, oldval)
859 struct frame *f;
860 Lisp_Object arg, oldval;
862 unsigned char *name;
863 int result;
865 CHECK_STRING (arg, 1);
866 name = XSTRING (arg)->data;
868 BLOCK_INPUT;
869 result = x_new_font (f, name);
870 UNBLOCK_INPUT;
872 if (result)
873 error ("Font \"%s\" is not defined", name);
876 void
877 x_set_border_width (f, arg, oldval)
878 struct frame *f;
879 Lisp_Object arg, oldval;
881 CHECK_NUMBER (arg, 0);
883 if (XINT (arg) == f->display.x->border_width)
884 return;
886 if (FRAME_X_WINDOW (f) != 0)
887 error ("Cannot change the border width of a window");
889 f->display.x->border_width = XINT (arg);
892 void
893 x_set_internal_border_width (f, arg, oldval)
894 struct frame *f;
895 Lisp_Object arg, oldval;
897 int mask;
898 int old = f->display.x->internal_border_width;
900 CHECK_NUMBER (arg, 0);
901 f->display.x->internal_border_width = XINT (arg);
902 if (f->display.x->internal_border_width < 0)
903 f->display.x->internal_border_width = 0;
905 if (f->display.x->internal_border_width == old)
906 return;
908 if (FRAME_X_WINDOW (f) != 0)
910 BLOCK_INPUT;
911 x_set_window_size (f, f->width, f->height);
912 #if 0
913 x_set_resize_hint (f);
914 #endif
915 XFlushQueue ();
916 UNBLOCK_INPUT;
917 SET_FRAME_GARBAGED (f);
921 void
922 x_set_visibility (f, value, oldval)
923 struct frame *f;
924 Lisp_Object value, oldval;
926 Lisp_Object frame;
927 XSET (frame, Lisp_Frame, f);
929 if (NILP (value))
930 Fmake_frame_invisible (frame);
931 else if (EQ (value, Qt))
932 Fmake_frame_visible (frame);
933 else
934 Ficonify_frame (frame);
937 static void
938 x_set_menu_bar_lines_1 (window, n)
939 Lisp_Object window;
940 int n;
942 for (; !NILP (window); window = XWINDOW (window)->next)
944 struct window *w = XWINDOW (window);
946 w->top += n;
948 if (!NILP (w->vchild))
949 x_set_menu_bar_lines_1 (w->vchild);
951 if (!NILP (w->hchild))
952 x_set_menu_bar_lines_1 (w->hchild);
956 void
957 x_set_menu_bar_lines (f, value, oldval)
958 struct frame *f;
959 Lisp_Object value, oldval;
961 int nlines;
962 int olines = FRAME_MENU_BAR_LINES (f);
964 if (XTYPE (value) == Lisp_Int)
965 nlines = XINT (value);
966 else
967 nlines = 0;
969 FRAME_MENU_BAR_LINES (f) = nlines;
970 x_set_menu_bar_lines_1 (f->root_window, nlines - olines);
971 x_set_window_size (f, FRAME_WIDTH (f),
972 FRAME_HEIGHT (f) + nlines - olines);
975 /* Change the name of frame F to ARG. If ARG is nil, set F's name to
976 x_id_name.
978 If EXPLICIT is non-zero, that indicates that lisp code is setting the
979 name; if ARG is a string, set F's name to ARG and set
980 F->explicit_name; if ARG is Qnil, then clear F->explicit_name.
982 If EXPLICIT is zero, that indicates that Emacs redisplay code is
983 suggesting a new name, which lisp code should override; if
984 F->explicit_name is set, ignore the new name; otherwise, set it. */
986 void
987 x_set_name (f, name, explicit)
988 struct frame *f;
989 Lisp_Object name;
990 int explicit;
992 /* Make sure that requests from lisp code override requests from
993 Emacs redisplay code. */
994 if (explicit)
996 /* If we're switching from explicit to implicit, we had better
997 update the mode lines and thereby update the title. */
998 if (f->explicit_name && NILP (name))
999 update_mode_lines = 1;
1001 f->explicit_name = ! NILP (name);
1003 else if (f->explicit_name)
1004 return;
1006 /* If NAME is nil, set the name to the x_id_name. */
1007 if (NILP (name))
1008 name = build_string (x_id_name);
1009 else
1010 CHECK_STRING (name, 0);
1012 /* Don't change the name if it's already NAME. */
1013 if (! NILP (Fstring_equal (name, f->name)))
1014 return;
1016 if (FRAME_X_WINDOW (f))
1018 BLOCK_INPUT;
1020 #ifdef HAVE_X11R4
1022 XTextProperty text;
1023 text.value = XSTRING (name)->data;
1024 text.encoding = XA_STRING;
1025 text.format = 8;
1026 text.nitems = XSTRING (name)->size;
1027 XSetWMName (x_current_display, FRAME_X_WINDOW (f), &text);
1028 XSetWMIconName (x_current_display, FRAME_X_WINDOW (f), &text);
1030 #else
1031 XSetIconName (XDISPLAY FRAME_X_WINDOW (f),
1032 XSTRING (name)->data);
1033 XStoreName (XDISPLAY FRAME_X_WINDOW (f),
1034 XSTRING (name)->data);
1035 #endif
1037 UNBLOCK_INPUT;
1040 f->name = name;
1043 /* This function should be called when the user's lisp code has
1044 specified a name for the frame; the name will override any set by the
1045 redisplay code. */
1046 void
1047 x_explicitly_set_name (f, arg, oldval)
1048 FRAME_PTR f;
1049 Lisp_Object arg, oldval;
1051 x_set_name (f, arg, 1);
1054 /* This function should be called by Emacs redisplay code to set the
1055 name; names set this way will never override names set by the user's
1056 lisp code. */
1057 void
1058 x_implicitly_set_name (f, arg, oldval)
1059 FRAME_PTR f;
1060 Lisp_Object arg, oldval;
1062 x_set_name (f, arg, 0);
1065 void
1066 x_set_autoraise (f, arg, oldval)
1067 struct frame *f;
1068 Lisp_Object arg, oldval;
1070 f->auto_raise = !EQ (Qnil, arg);
1073 void
1074 x_set_autolower (f, arg, oldval)
1075 struct frame *f;
1076 Lisp_Object arg, oldval;
1078 f->auto_lower = !EQ (Qnil, arg);
1081 void
1082 x_set_vertical_scroll_bars (f, arg, oldval)
1083 struct frame *f;
1084 Lisp_Object arg, oldval;
1086 if (NILP (arg) != ! FRAME_HAS_VERTICAL_SCROLL_BARS (f))
1088 FRAME_HAS_VERTICAL_SCROLL_BARS (f) = ! NILP (arg);
1090 /* We set this parameter before creating the X window for the
1091 frame, so we can get the geometry right from the start.
1092 However, if the window hasn't been created yet, we shouldn't
1093 call x_set_window_size. */
1094 if (FRAME_X_WINDOW (f))
1095 x_set_window_size (f, FRAME_WIDTH (f), FRAME_HEIGHT (f));
1099 #ifdef HAVE_X11
1100 int n_faces;
1102 #if 0
1103 /* I believe this function is obsolete with respect to the new face display
1104 changes. */
1105 x_set_face (scr, font, background, foreground, stipple)
1106 struct frame *scr;
1107 XFontStruct *font;
1108 unsigned long background, foreground;
1109 Pixmap stipple;
1111 XGCValues gc_values;
1112 GC temp_gc;
1113 unsigned long gc_mask;
1114 struct face *new_face;
1115 unsigned int width = 16;
1116 unsigned int height = 16;
1118 if (n_faces == MAX_FACES_AND_GLYPHS)
1119 return 1;
1121 /* Create the Graphics Context. */
1122 gc_values.font = font->fid;
1123 gc_values.foreground = foreground;
1124 gc_values.background = background;
1125 gc_values.line_width = 0;
1126 gc_mask = GCLineWidth | GCFont | GCForeground | GCBackground;
1127 if (stipple)
1129 gc_values.stipple
1130 = XCreateBitmapFromData (x_current_display, ROOT_WINDOW,
1131 (char *) stipple, width, height);
1132 gc_mask |= GCStipple;
1135 temp_gc = XCreateGC (x_current_display, FRAME_X_WINDOW (scr),
1136 gc_mask, &gc_values);
1137 if (!temp_gc)
1138 return 1;
1139 new_face = (struct face *) xmalloc (sizeof (struct face));
1140 if (!new_face)
1142 XFreeGC (x_current_display, temp_gc);
1143 return 1;
1146 new_face->font = font;
1147 new_face->foreground = foreground;
1148 new_face->background = background;
1149 new_face->face_gc = temp_gc;
1150 if (stipple)
1151 new_face->stipple = gc_values.stipple;
1153 x_face_table[++n_faces] = new_face;
1154 return 1;
1156 #endif
1158 x_set_glyph (scr, glyph)
1162 #if 0
1163 DEFUN ("x-set-face-font", Fx_set_face_font, Sx_set_face_font, 4, 2, 0,
1164 "Specify face table entry FACE-CODE to be the font named by FONT,\n\
1165 in colors FOREGROUND and BACKGROUND.")
1166 (face_code, font_name, foreground, background)
1167 Lisp_Object face_code;
1168 Lisp_Object font_name;
1169 Lisp_Object foreground;
1170 Lisp_Object background;
1172 register struct face *fp; /* Current face info. */
1173 register int fn; /* Face number. */
1174 register FONT_TYPE *f; /* Font data structure. */
1175 unsigned char *newname;
1176 int fg, bg;
1177 GC temp_gc;
1178 XGCValues gc_values;
1180 /* Need to do something about this. */
1181 Drawable drawable = FRAME_X_WINDOW (selected_frame);
1183 CHECK_NUMBER (face_code, 1);
1184 CHECK_STRING (font_name, 2);
1186 if (EQ (foreground, Qnil) || EQ (background, Qnil))
1188 fg = selected_frame->display.x->foreground_pixel;
1189 bg = selected_frame->display.x->background_pixel;
1191 else
1193 CHECK_NUMBER (foreground, 0);
1194 CHECK_NUMBER (background, 1);
1196 fg = x_decode_color (XINT (foreground), BLACK_PIX_DEFAULT);
1197 bg = x_decode_color (XINT (background), WHITE_PIX_DEFAULT);
1200 fn = XINT (face_code);
1201 if ((fn < 1) || (fn > 255))
1202 error ("Invalid face code, %d", fn);
1204 newname = XSTRING (font_name)->data;
1205 BLOCK_INPUT;
1206 f = (*newname == 0 ? 0 : XGetFont (newname));
1207 UNBLOCK_INPUT;
1208 if (f == 0)
1209 error ("Font \"%s\" is not defined", newname);
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));
1216 fp->face_type = x_pixmap;
1218 else if (FACE_IS_FONT (fn))
1220 BLOCK_INPUT;
1221 XFreeGC (FACE_FONT (fn));
1222 UNBLOCK_INPUT;
1224 else if (FACE_IS_IMAGE (fn)) /* This should not happen... */
1226 BLOCK_INPUT;
1227 XFreePixmap (x_current_display, FACE_IMAGE (fn));
1228 fp->face_type = x_font;
1229 UNBLOCK_INPUT;
1231 else
1232 abort ();
1234 fp->face_GLYPH.font_desc.font = f;
1235 gc_values.font = f->fid;
1236 gc_values.foreground = fg;
1237 gc_values.background = bg;
1238 fp->face_GLYPH.font_desc.face_gc = XCreateGC (x_current_display,
1239 drawable, GCFont | GCForeground
1240 | GCBackground, &gc_values);
1241 fp->face_GLYPH.font_desc.font_width = FONT_WIDTH (f);
1242 fp->face_GLYPH.font_desc.font_height = FONT_HEIGHT (f);
1244 return face_code;
1246 #endif
1247 #else /* X10 */
1248 DEFUN ("x-set-face", Fx_set_face, Sx_set_face, 4, 4, 0,
1249 "Specify face table entry FACE-CODE to be the font named by FONT,\n\
1250 in colors FOREGROUND and BACKGROUND.")
1251 (face_code, font_name, foreground, background)
1252 Lisp_Object face_code;
1253 Lisp_Object font_name;
1254 Lisp_Object foreground;
1255 Lisp_Object background;
1257 register struct face *fp; /* Current face info. */
1258 register int fn; /* Face number. */
1259 register FONT_TYPE *f; /* Font data structure. */
1260 unsigned char *newname;
1262 CHECK_NUMBER (face_code, 1);
1263 CHECK_STRING (font_name, 2);
1265 fn = XINT (face_code);
1266 if ((fn < 1) || (fn > 255))
1267 error ("Invalid face code, %d", fn);
1269 /* Ask the server to find the specified font. */
1270 newname = XSTRING (font_name)->data;
1271 BLOCK_INPUT;
1272 f = (*newname == 0 ? 0 : XGetFont (newname));
1273 UNBLOCK_INPUT;
1274 if (f == 0)
1275 error ("Font \"%s\" is not defined", newname);
1277 /* Get the face structure for face_code in the face table.
1278 Make sure it exists. */
1279 fp = x_face_table[fn];
1280 if (fp == 0)
1282 x_face_table[fn] = fp = (struct face *) xmalloc (sizeof (struct face));
1283 bzero (fp, sizeof (struct face));
1286 /* If this face code already exists, get rid of the old font. */
1287 if (fp->font != 0 && fp->font != f)
1289 BLOCK_INPUT;
1290 XLoseFont (fp->font);
1291 UNBLOCK_INPUT;
1294 /* Store the specified information in FP. */
1295 fp->fg = x_decode_color (foreground, BLACK_PIX_DEFAULT);
1296 fp->bg = x_decode_color (background, WHITE_PIX_DEFAULT);
1297 fp->font = f;
1299 return face_code;
1301 #endif /* X10 */
1303 #if 0
1304 /* This is excluded because there is no painless way
1305 to get or to remember the name of the font. */
1307 DEFUN ("x-get-face", Fx_get_face, Sx_get_face, 1, 1, 0,
1308 "Get data defining face code FACE. FACE is an integer.\n\
1309 The value is a list (FONT FG-COLOR BG-COLOR).")
1310 (face)
1311 Lisp_Object face;
1313 register struct face *fp; /* Current face info. */
1314 register int fn; /* Face number. */
1316 CHECK_NUMBER (face, 1);
1317 fn = XINT (face);
1318 if ((fn < 1) || (fn > 255))
1319 error ("Invalid face code, %d", fn);
1321 /* Make sure the face table exists and this face code is defined. */
1322 if (x_face_table == 0 || x_face_table[fn] == 0)
1323 return Qnil;
1325 fp = x_face_table[fn];
1327 return Fcons (build_string (fp->name),
1328 Fcons (make_number (fp->fg),
1329 Fcons (make_number (fp->bg), Qnil)));
1331 #endif /* 0 */
1333 /* Subroutines of creating an X frame. */
1335 #ifdef HAVE_X11
1336 extern char *x_get_string_resource ();
1337 extern XrmDatabase x_load_resources ();
1339 DEFUN ("x-get-resource", Fx_get_resource, Sx_get_resource, 2, 4, 0,
1340 "Return the value of ATTRIBUTE, of class CLASS, from the X defaults database.\n\
1341 This uses `INSTANCE.ATTRIBUTE' as the key and `Emacs.CLASS' as the\n\
1342 class, where INSTANCE is the name under which Emacs was invoked.\n\
1344 The optional arguments COMPONENT and SUBCLASS add to the key and the\n\
1345 class, respectively. You must specify both of them or neither.\n\
1346 If you specify them, the key is `INSTANCE.COMPONENT.ATTRIBUTE'\n\
1347 and the class is `Emacs.CLASS.SUBCLASS'.")
1348 (attribute, class, component, subclass)
1349 Lisp_Object attribute, class, component, subclass;
1351 register char *value;
1352 char *name_key;
1353 char *class_key;
1355 CHECK_STRING (attribute, 0);
1356 CHECK_STRING (class, 0);
1358 if (!NILP (component))
1359 CHECK_STRING (component, 1);
1360 if (!NILP (subclass))
1361 CHECK_STRING (subclass, 2);
1362 if (NILP (component) != NILP (subclass))
1363 error ("x-get-resource: must specify both COMPONENT and SUBCLASS or neither");
1365 if (NILP (component))
1367 /* Allocate space for the components, the dots which separate them,
1368 and the final '\0'. */
1369 name_key = (char *) alloca (XSTRING (invocation_name)->size
1370 + XSTRING (attribute)->size
1371 + 2);
1372 class_key = (char *) alloca ((sizeof (EMACS_CLASS) - 1)
1373 + XSTRING (class)->size
1374 + 2);
1376 sprintf (name_key, "%s.%s",
1377 XSTRING (invocation_name)->data,
1378 XSTRING (attribute)->data);
1379 sprintf (class_key, "%s.%s",
1380 EMACS_CLASS,
1381 XSTRING (class)->data);
1383 else
1385 name_key = (char *) alloca (XSTRING (invocation_name)->size
1386 + XSTRING (component)->size
1387 + XSTRING (attribute)->size
1388 + 3);
1390 class_key = (char *) alloca ((sizeof (EMACS_CLASS) - 1)
1391 + XSTRING (class)->size
1392 + XSTRING (subclass)->size
1393 + 3);
1395 sprintf (name_key, "%s.%s.%s",
1396 XSTRING (invocation_name)->data,
1397 XSTRING (component)->data,
1398 XSTRING (attribute)->data);
1399 sprintf (class_key, "%s.%s",
1400 EMACS_CLASS,
1401 XSTRING (class)->data,
1402 XSTRING (subclass)->data);
1405 value = x_get_string_resource (xrdb, name_key, class_key);
1407 if (value != (char *) 0)
1408 return build_string (value);
1409 else
1410 return Qnil;
1413 #else /* X10 */
1415 DEFUN ("x-get-default", Fx_get_default, Sx_get_default, 1, 1, 0,
1416 "Get X default ATTRIBUTE from the system, or nil if no default.\n\
1417 Value is a string (when not nil) and ATTRIBUTE is also a string.\n\
1418 The defaults are specified in the file `~/.Xdefaults'.")
1419 (arg)
1420 Lisp_Object arg;
1422 register unsigned char *value;
1424 CHECK_STRING (arg, 1);
1426 value = (unsigned char *) XGetDefault (XDISPLAY
1427 XSTRING (invocation_name)->data,
1428 XSTRING (arg)->data);
1429 if (value == 0)
1430 /* Try reversing last two args, in case this is the buggy version of X. */
1431 value = (unsigned char *) XGetDefault (XDISPLAY
1432 XSTRING (arg)->data,
1433 XSTRING (invocation_name)->data);
1434 if (value != 0)
1435 return build_string (value);
1436 else
1437 return (Qnil);
1440 #define Fx_get_resource(attribute, class, component, subclass) \
1441 Fx_get_default(attribute)
1443 #endif /* X10 */
1445 /* Types we might convert a resource string into. */
1446 enum resource_types
1448 number, boolean, string, symbol,
1451 /* Return the value of parameter PARAM.
1453 First search ALIST, then Vdefault_frame_alist, then the X defaults
1454 database, using ATTRIBUTE as the attribute name and CLASS as its class.
1456 Convert the resource to the type specified by desired_type.
1458 If no default is specified, return Qunbound. If you call
1459 x_get_arg, make sure you deal with Qunbound in a reasonable way,
1460 and don't let it get stored in any lisp-visible variables! */
1462 static Lisp_Object
1463 x_get_arg (alist, param, attribute, class, type)
1464 Lisp_Object alist, param;
1465 char *attribute;
1466 char *class;
1467 enum resource_types type;
1469 register Lisp_Object tem;
1471 tem = Fassq (param, alist);
1472 if (EQ (tem, Qnil))
1473 tem = Fassq (param, Vdefault_frame_alist);
1474 if (EQ (tem, Qnil))
1477 if (attribute)
1479 tem = Fx_get_resource (build_string (attribute),
1480 build_string (class),
1481 Qnil, Qnil);
1483 if (NILP (tem))
1484 return Qunbound;
1486 switch (type)
1488 case number:
1489 return make_number (atoi (XSTRING (tem)->data));
1491 case boolean:
1492 tem = Fdowncase (tem);
1493 if (!strcmp (XSTRING (tem)->data, "on")
1494 || !strcmp (XSTRING (tem)->data, "true"))
1495 return Qt;
1496 else
1497 return Qnil;
1499 case string:
1500 return tem;
1502 case symbol:
1503 return intern (tem);
1505 default:
1506 abort ();
1509 else
1510 return Qunbound;
1512 return Fcdr (tem);
1515 /* Record in frame F the specified or default value according to ALIST
1516 of the parameter named PARAM (a Lisp symbol).
1517 If no value is specified for PARAM, look for an X default for XPROP
1518 on the frame named NAME.
1519 If that is not found either, use the value DEFLT. */
1521 static Lisp_Object
1522 x_default_parameter (f, alist, prop, deflt, xprop, xclass, type)
1523 struct frame *f;
1524 Lisp_Object alist;
1525 Lisp_Object prop;
1526 Lisp_Object deflt;
1527 char *xprop;
1528 char *xclass;
1529 enum resource_types type;
1531 Lisp_Object tem;
1533 tem = x_get_arg (alist, prop, xprop, xclass, type);
1534 if (EQ (tem, Qunbound))
1535 tem = deflt;
1536 x_set_frame_parameters (f, Fcons (Fcons (prop, tem), Qnil));
1537 return tem;
1540 DEFUN ("x-geometry", Fx_geometry, Sx_geometry, 1, 1, 0,
1541 "Parse an X-style geometry string STRING.\n\
1542 Returns an alist of the form ((top . TOP), (left . LEFT) ... ).")
1543 (string)
1544 Lisp_Object string;
1546 int geometry, x, y;
1547 unsigned int width, height;
1548 Lisp_Object values[4];
1550 CHECK_STRING (string, 0);
1552 geometry = XParseGeometry ((char *) XSTRING (string)->data,
1553 &x, &y, &width, &height);
1555 switch (geometry & 0xf) /* Mask out {X,Y}Negative */
1557 case (XValue | YValue):
1558 /* What's one pixel among friends?
1559 Perhaps fix this some day by returning symbol `extreme-top'... */
1560 if (x == 0 && (geometry & XNegative))
1561 x = -1;
1562 if (y == 0 && (geometry & YNegative))
1563 y = -1;
1564 values[0] = Fcons (Qleft, make_number (x));
1565 values[1] = Fcons (Qtop, make_number (y));
1566 return Flist (2, values);
1567 break;
1569 case (WidthValue | HeightValue):
1570 values[0] = Fcons (Qwidth, make_number (width));
1571 values[1] = Fcons (Qheight, make_number (height));
1572 return Flist (2, values);
1573 break;
1575 case (XValue | YValue | WidthValue | HeightValue):
1576 if (x == 0 && (geometry & XNegative))
1577 x = -1;
1578 if (y == 0 && (geometry & YNegative))
1579 y = -1;
1580 values[0] = Fcons (Qwidth, make_number (width));
1581 values[1] = Fcons (Qheight, make_number (height));
1582 values[2] = Fcons (Qleft, make_number (x));
1583 values[3] = Fcons (Qtop, make_number (y));
1584 return Flist (4, values);
1585 break;
1587 case 0:
1588 return Qnil;
1590 default:
1591 error ("Must specify x and y value, and/or width and height");
1595 #ifdef HAVE_X11
1596 /* Calculate the desired size and position of this window,
1597 or set rubber-band prompting if none. */
1599 #define DEFAULT_ROWS 40
1600 #define DEFAULT_COLS 80
1602 static int
1603 x_figure_window_size (f, parms)
1604 struct frame *f;
1605 Lisp_Object parms;
1607 register Lisp_Object tem0, tem1;
1608 int height, width, left, top;
1609 register int geometry;
1610 long window_prompting = 0;
1612 /* Default values if we fall through.
1613 Actually, if that happens we should get
1614 window manager prompting. */
1615 f->width = DEFAULT_COLS;
1616 f->height = DEFAULT_ROWS;
1617 f->display.x->top_pos = 1;
1618 f->display.x->left_pos = 1;
1620 tem0 = x_get_arg (parms, Qheight, 0, 0, number);
1621 tem1 = x_get_arg (parms, Qwidth, 0, 0, number);
1622 if (! EQ (tem0, Qunbound) && ! EQ (tem1, Qunbound))
1624 CHECK_NUMBER (tem0, 0);
1625 CHECK_NUMBER (tem1, 0);
1626 f->height = XINT (tem0);
1627 f->width = XINT (tem1);
1628 window_prompting |= USSize;
1630 else if (! EQ (tem0, Qunbound) || ! EQ (tem1, Qunbound))
1631 error ("Must specify *both* height and width");
1633 f->display.x->vertical_scroll_bar_extra =
1634 (FRAME_HAS_VERTICAL_SCROLL_BARS (f)
1635 ? VERTICAL_SCROLL_BAR_PIXEL_WIDTH (f)
1636 : 0);
1637 f->display.x->pixel_width = CHAR_TO_PIXEL_WIDTH (f, f->width);
1638 f->display.x->pixel_height = CHAR_TO_PIXEL_HEIGHT (f, f->height);
1640 tem0 = x_get_arg (parms, Qtop, 0, 0, number);
1641 tem1 = x_get_arg (parms, Qleft, 0, 0, number);
1642 if (! EQ (tem0, Qunbound) && ! EQ (tem1, Qunbound))
1644 CHECK_NUMBER (tem0, 0);
1645 CHECK_NUMBER (tem1, 0);
1646 f->display.x->top_pos = XINT (tem0);
1647 f->display.x->left_pos = XINT (tem1);
1648 x_calc_absolute_position (f);
1649 window_prompting |= USPosition;
1651 else if (! EQ (tem0, Qunbound) || ! EQ (tem1, Qunbound))
1652 error ("Must specify *both* top and left corners");
1654 switch (window_prompting)
1656 case USSize | USPosition:
1657 return window_prompting;
1658 break;
1660 case USSize: /* Got the size, need the position. */
1661 window_prompting |= PPosition;
1662 return window_prompting;
1663 break;
1665 case USPosition: /* Got the position, need the size. */
1666 window_prompting |= PSize;
1667 return window_prompting;
1668 break;
1670 case 0: /* Got nothing, take both from geometry. */
1671 window_prompting |= PPosition | PSize;
1672 return window_prompting;
1673 break;
1675 default:
1676 /* Somehow a bit got set in window_prompting that we didn't
1677 put there. */
1678 abort ();
1682 static void
1683 x_window (f)
1684 struct frame *f;
1686 XSetWindowAttributes attributes;
1687 unsigned long attribute_mask;
1688 XClassHint class_hints;
1690 attributes.background_pixel = f->display.x->background_pixel;
1691 attributes.border_pixel = f->display.x->border_pixel;
1692 attributes.bit_gravity = StaticGravity;
1693 attributes.backing_store = NotUseful;
1694 attributes.save_under = True;
1695 attributes.event_mask = STANDARD_EVENT_SET;
1696 attribute_mask = (CWBackPixel | CWBorderPixel | CWBitGravity
1697 #if 0
1698 | CWBackingStore | CWSaveUnder
1699 #endif
1700 | CWEventMask);
1702 BLOCK_INPUT;
1703 FRAME_X_WINDOW (f)
1704 = XCreateWindow (x_current_display, ROOT_WINDOW,
1705 f->display.x->left_pos,
1706 f->display.x->top_pos,
1707 PIXEL_WIDTH (f), PIXEL_HEIGHT (f),
1708 f->display.x->border_width,
1709 CopyFromParent, /* depth */
1710 InputOutput, /* class */
1711 screen_visual, /* set in Fx_open_connection */
1712 attribute_mask, &attributes);
1714 class_hints.res_name = (char *) XSTRING (f->name)->data;
1715 class_hints.res_class = EMACS_CLASS;
1716 XSetClassHint (x_current_display, FRAME_X_WINDOW (f), &class_hints);
1718 /* This indicates that we use the "Passive Input" input model.
1719 Unless we do this, we don't get the Focus{In,Out} events that we
1720 need to draw the cursor correctly. Accursed bureaucrats.
1721 XWhipsAndChains (x_current_display, IronMaiden, &TheRack); */
1723 f->display.x->wm_hints.input = True;
1724 f->display.x->wm_hints.flags |= InputHint;
1725 XSetWMHints (x_current_display, FRAME_X_WINDOW (f), &f->display.x->wm_hints);
1727 /* x_set_name normally ignores requests to set the name if the
1728 requested name is the same as the current name. This is the one
1729 place where that assumption isn't correct; f->name is set, but
1730 the X server hasn't been told. */
1732 Lisp_Object name = f->name;
1733 int explicit = f->explicit_name;
1735 f->name = Qnil;
1736 f->explicit_name = 0;
1737 x_set_name (f, name, explicit);
1740 XDefineCursor (XDISPLAY FRAME_X_WINDOW (f),
1741 f->display.x->text_cursor);
1742 UNBLOCK_INPUT;
1744 if (FRAME_X_WINDOW (f) == 0)
1745 error ("Unable to create window.");
1748 /* Handle the icon stuff for this window. Perhaps later we might
1749 want an x_set_icon_position which can be called interactively as
1750 well. */
1752 static void
1753 x_icon (f, parms)
1754 struct frame *f;
1755 Lisp_Object parms;
1757 Lisp_Object icon_x, icon_y;
1759 /* Set the position of the icon. Note that twm groups all
1760 icons in an icon window. */
1761 icon_x = x_get_arg (parms, Qicon_left, 0, 0, number);
1762 icon_y = x_get_arg (parms, Qicon_top, 0, 0, number);
1763 if (!EQ (icon_x, Qunbound) && !EQ (icon_y, Qunbound))
1765 CHECK_NUMBER (icon_x, 0);
1766 CHECK_NUMBER (icon_y, 0);
1768 else if (!EQ (icon_x, Qunbound) || !EQ (icon_y, Qunbound))
1769 error ("Both left and top icon corners of icon must be specified");
1771 BLOCK_INPUT;
1773 if (! EQ (icon_x, Qunbound))
1774 x_wm_set_icon_position (f, XINT (icon_x), XINT (icon_y));
1776 /* Start up iconic or window? */
1777 x_wm_set_window_state (f,
1778 (EQ (x_get_arg (parms, Qiconic_startup,
1779 0, 0, boolean),
1781 ? IconicState
1782 : NormalState));
1784 UNBLOCK_INPUT;
1787 /* Make the GC's needed for this window, setting the
1788 background, border and mouse colors; also create the
1789 mouse cursor and the gray border tile. */
1791 static char cursor_bits[] =
1793 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
1794 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
1795 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
1796 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00
1799 static void
1800 x_make_gc (f)
1801 struct frame *f;
1803 XGCValues gc_values;
1804 GC temp_gc;
1805 XImage tileimage;
1807 /* Create the GC's of this frame.
1808 Note that many default values are used. */
1810 /* Normal video */
1811 gc_values.font = f->display.x->font->fid;
1812 gc_values.foreground = f->display.x->foreground_pixel;
1813 gc_values.background = f->display.x->background_pixel;
1814 gc_values.line_width = 0; /* Means 1 using fast algorithm. */
1815 f->display.x->normal_gc = XCreateGC (x_current_display,
1816 FRAME_X_WINDOW (f),
1817 GCLineWidth | GCFont
1818 | GCForeground | GCBackground,
1819 &gc_values);
1821 /* Reverse video style. */
1822 gc_values.foreground = f->display.x->background_pixel;
1823 gc_values.background = f->display.x->foreground_pixel;
1824 f->display.x->reverse_gc = XCreateGC (x_current_display,
1825 FRAME_X_WINDOW (f),
1826 GCFont | GCForeground | GCBackground
1827 | GCLineWidth,
1828 &gc_values);
1830 /* Cursor has cursor-color background, background-color foreground. */
1831 gc_values.foreground = f->display.x->background_pixel;
1832 gc_values.background = f->display.x->cursor_pixel;
1833 gc_values.fill_style = FillOpaqueStippled;
1834 gc_values.stipple
1835 = XCreateBitmapFromData (x_current_display, ROOT_WINDOW,
1836 cursor_bits, 16, 16);
1837 f->display.x->cursor_gc
1838 = XCreateGC (x_current_display, FRAME_X_WINDOW (f),
1839 (GCFont | GCForeground | GCBackground
1840 | GCFillStyle | GCStipple | GCLineWidth),
1841 &gc_values);
1843 /* Create the gray border tile used when the pointer is not in
1844 the frame. Since this depends on the frame's pixel values,
1845 this must be done on a per-frame basis. */
1846 f->display.x->border_tile
1847 = (XCreatePixmapFromBitmapData
1848 (x_current_display, ROOT_WINDOW,
1849 gray_bits, gray_width, gray_height,
1850 f->display.x->foreground_pixel,
1851 f->display.x->background_pixel,
1852 DefaultDepth (x_current_display, XDefaultScreen (x_current_display))));
1854 #endif /* HAVE_X11 */
1856 DEFUN ("x-create-frame", Fx_create_frame, Sx_create_frame,
1857 1, 1, 0,
1858 "Make a new X window, which is called a \"frame\" in Emacs terms.\n\
1859 Return an Emacs frame object representing the X window.\n\
1860 ALIST is an alist of frame parameters.\n\
1861 If the parameters specify that the frame should not have a minibuffer,\n\
1862 and do not specify a specific minibuffer window to use,\n\
1863 then `default-minibuffer-frame' must be a frame whose minibuffer can\n\
1864 be shared by the new frame.")
1865 (parms)
1866 Lisp_Object parms;
1868 #ifdef HAVE_X11
1869 struct frame *f;
1870 Lisp_Object frame, tem;
1871 Lisp_Object name;
1872 int minibuffer_only = 0;
1873 long window_prompting = 0;
1874 int width, height;
1876 if (x_current_display == 0)
1877 error ("X windows are not in use or not initialized");
1879 name = x_get_arg (parms, Qname, "title", "Title", string);
1880 if (XTYPE (name) != Lisp_String
1881 && ! EQ (name, Qunbound)
1882 && ! NILP (name))
1883 error ("x-create-frame: name parameter must be a string");
1885 tem = x_get_arg (parms, Qminibuffer, 0, 0, symbol);
1886 if (EQ (tem, Qnone) || NILP (tem))
1887 f = make_frame_without_minibuffer (Qnil);
1888 else if (EQ (tem, Qonly))
1890 f = make_minibuffer_frame ();
1891 minibuffer_only = 1;
1893 else if (XTYPE (tem) == Lisp_Window)
1894 f = make_frame_without_minibuffer (tem);
1895 else
1896 f = make_frame (1);
1898 /* Note that X Windows does support scroll bars. */
1899 FRAME_CAN_HAVE_SCROLL_BARS (f) = 1;
1901 /* Set the name; the functions to which we pass f expect the name to
1902 be set. */
1903 if (EQ (name, Qunbound) || NILP (name))
1905 f->name = build_string (x_id_name);
1906 f->explicit_name = 0;
1908 else
1910 f->name = name;
1911 f->explicit_name = 1;
1914 XSET (frame, Lisp_Frame, f);
1915 f->output_method = output_x_window;
1916 f->display.x = (struct x_display *) xmalloc (sizeof (struct x_display));
1917 bzero (f->display.x, sizeof (struct x_display));
1919 /* Note that the frame has no physical cursor right now. */
1920 f->phys_cursor_x = -1;
1922 /* Extract the window parameters from the supplied values
1923 that are needed to determine window geometry. */
1924 x_default_parameter (f, parms, Qfont, build_string ("9x15"),
1925 "font", "Font", string);
1926 x_default_parameter (f, parms, Qborder_width, make_number (2),
1927 "borderwidth", "BorderWidth", number);
1928 /* This defaults to 2 in order to match xterm. */
1929 x_default_parameter (f, parms, Qinternal_border_width, make_number (2),
1930 "internalBorderWidth", "BorderWidth", number);
1931 x_default_parameter (f, parms, Qvertical_scroll_bars, Qt,
1932 "verticalScrollBars", "ScrollBars", boolean);
1934 /* Also do the stuff which must be set before the window exists. */
1935 x_default_parameter (f, parms, Qforeground_color, build_string ("black"),
1936 "foreground", "Foreground", string);
1937 x_default_parameter (f, parms, Qbackground_color, build_string ("white"),
1938 "background", "Background", string);
1939 x_default_parameter (f, parms, Qmouse_color, build_string ("black"),
1940 "pointerColor", "Foreground", string);
1941 x_default_parameter (f, parms, Qcursor_color, build_string ("black"),
1942 "cursorColor", "Foreground", string);
1943 x_default_parameter (f, parms, Qborder_color, build_string ("black"),
1944 "borderColor", "BorderColor", string);
1946 f->display.x->parent_desc = ROOT_WINDOW;
1947 window_prompting = x_figure_window_size (f, parms);
1949 x_window (f);
1950 x_icon (f, parms);
1951 x_make_gc (f);
1953 /* We need to do this after creating the X window, so that the
1954 icon-creation functions can say whose icon they're describing. */
1955 x_default_parameter (f, parms, Qicon_type, Qnil,
1956 "iconType", "IconType", symbol);
1958 x_default_parameter (f, parms, Qauto_raise, Qnil,
1959 "autoRaise", "AutoRaiseLower", boolean);
1960 x_default_parameter (f, parms, Qauto_lower, Qnil,
1961 "autoLower", "AutoRaiseLower", boolean);
1962 x_default_parameter (f, parms, Qcursor_type, Qbox,
1963 "cursorType", "CursorType", symbol);
1965 /* Dimensions, especially f->height, must be done via change_frame_size.
1966 Change will not be effected unless different from the current
1967 f->height. */
1968 width = f->width;
1969 height = f->height;
1970 f->height = f->width = 0;
1971 change_frame_size (f, height, width, 1, 0);
1973 x_default_parameter (f, parms, Qmenu_bar_lines, make_number (0),
1974 "menuBarLines", "MenuBarLines", number);
1976 BLOCK_INPUT;
1977 x_wm_set_size_hint (f, window_prompting);
1978 UNBLOCK_INPUT;
1980 tem = x_get_arg (parms, Qunsplittable, 0, 0, boolean);
1981 f->no_split = minibuffer_only || EQ (tem, Qt);
1983 /* Make the window appear on the frame and enable display,
1984 unless the caller says not to. */
1985 if (!EQ (x_get_arg (parms, Qsuppress_initial_map, 0, 0, boolean), Qt))
1987 tem = x_get_arg (parms, Qvisibility, 0, 0, boolean);
1988 if (EQ (tem, Qicon))
1989 x_iconify_frame (f);
1990 /* Note that the default is Qunbound,
1991 so by default we do make visible. */
1992 else if (!EQ (tem, Qnil))
1993 x_make_frame_visible (f);
1996 return frame;
1997 #else /* X10 */
1998 struct frame *f;
1999 Lisp_Object frame, tem;
2000 Lisp_Object name;
2001 int pixelwidth, pixelheight;
2002 Cursor cursor;
2003 int height, width;
2004 Window parent;
2005 Pixmap temp;
2006 int minibuffer_only = 0;
2007 Lisp_Object vscroll, hscroll;
2009 if (x_current_display == 0)
2010 error ("X windows are not in use or not initialized");
2012 name = Fassq (Qname, parms);
2014 tem = x_get_arg (parms, Qminibuffer, 0, 0, symbol);
2015 if (EQ (tem, Qnone))
2016 f = make_frame_without_minibuffer (Qnil);
2017 else if (EQ (tem, Qonly))
2019 f = make_minibuffer_frame ();
2020 minibuffer_only = 1;
2022 else if (EQ (tem, Qnil) || EQ (tem, Qunbound))
2023 f = make_frame (1);
2024 else
2025 f = make_frame_without_minibuffer (tem);
2027 parent = ROOT_WINDOW;
2029 XSET (frame, Lisp_Frame, f);
2030 f->output_method = output_x_window;
2031 f->display.x = (struct x_display *) xmalloc (sizeof (struct x_display));
2032 bzero (f->display.x, sizeof (struct x_display));
2034 /* Some temprorary default values for height and width. */
2035 width = 80;
2036 height = 40;
2037 f->display.x->left_pos = -1;
2038 f->display.x->top_pos = -1;
2040 /* Give the frame a default name (which may be overridden with PARMS). */
2042 strncpy (iconidentity, ICONTAG, MAXICID);
2043 if (gethostname (&iconidentity[sizeof (ICONTAG) - 1],
2044 (MAXICID - 1) - sizeof (ICONTAG)))
2045 iconidentity[sizeof (ICONTAG) - 2] = '\0';
2046 f->name = build_string (iconidentity);
2048 /* Extract some window parameters from the supplied values.
2049 These are the parameters that affect window geometry. */
2051 tem = x_get_arg (parms, Qfont, "BodyFont", 0, string);
2052 if (EQ (tem, Qunbound))
2053 tem = build_string ("9x15");
2054 x_set_font (f, tem, Qnil);
2055 x_default_parameter (f, parms, Qborder_color,
2056 build_string ("black"), "Border", 0, string);
2057 x_default_parameter (f, parms, Qbackground_color,
2058 build_string ("white"), "Background", 0, string);
2059 x_default_parameter (f, parms, Qforeground_color,
2060 build_string ("black"), "Foreground", 0, string);
2061 x_default_parameter (f, parms, Qmouse_color,
2062 build_string ("black"), "Mouse", 0, string);
2063 x_default_parameter (f, parms, Qcursor_color,
2064 build_string ("black"), "Cursor", 0, string);
2065 x_default_parameter (f, parms, Qborder_width,
2066 make_number (2), "BorderWidth", 0, number);
2067 x_default_parameter (f, parms, Qinternal_border_width,
2068 make_number (4), "InternalBorderWidth", 0, number);
2069 x_default_parameter (f, parms, Qauto_raise,
2070 Qnil, "AutoRaise", 0, boolean);
2072 hscroll = EQ (x_get_arg (parms, Qhorizontal_scroll_bar, 0, 0, boolean), Qt);
2073 vscroll = EQ (x_get_arg (parms, Qvertical_scroll_bar, 0, 0, boolean), Qt);
2075 if (f->display.x->internal_border_width < 0)
2076 f->display.x->internal_border_width = 0;
2078 tem = x_get_arg (parms, Qwindow_id, 0, 0, number);
2079 if (!EQ (tem, Qunbound))
2081 WINDOWINFO_TYPE wininfo;
2082 int nchildren;
2083 Window *children, root;
2085 CHECK_NUMBER (tem, 0);
2086 FRAME_X_WINDOW (f) = (Window) XINT (tem);
2088 BLOCK_INPUT;
2089 XGetWindowInfo (FRAME_X_WINDOW (f), &wininfo);
2090 XQueryTree (FRAME_X_WINDOW (f), &parent, &nchildren, &children);
2091 free (children);
2092 UNBLOCK_INPUT;
2094 height = PIXEL_TO_CHAR_HEIGHT (f, wininfo.height);
2095 width = PIXEL_TO_CHAR_WIDTH (f, wininfo.width);
2096 f->display.x->left_pos = wininfo.x;
2097 f->display.x->top_pos = wininfo.y;
2098 FRAME_SET_VISIBILITY (f, wininfo.mapped != 0);
2099 f->display.x->border_width = wininfo.bdrwidth;
2100 f->display.x->parent_desc = parent;
2102 else
2104 tem = x_get_arg (parms, Qparent_id, 0, 0, number);
2105 if (!EQ (tem, Qunbound))
2107 CHECK_NUMBER (tem, 0);
2108 parent = (Window) XINT (tem);
2110 f->display.x->parent_desc = parent;
2111 tem = x_get_arg (parms, Qheight, 0, 0, number);
2112 if (EQ (tem, Qunbound))
2114 tem = x_get_arg (parms, Qwidth, 0, 0, number);
2115 if (EQ (tem, Qunbound))
2117 tem = x_get_arg (parms, Qtop, 0, 0, number);
2118 if (EQ (tem, Qunbound))
2119 tem = x_get_arg (parms, Qleft, 0, 0, number);
2122 /* Now TEM is Qunbound if no edge or size was specified.
2123 In that case, we must do rubber-banding. */
2124 if (EQ (tem, Qunbound))
2126 tem = x_get_arg (parms, Qgeometry, 0, 0, number);
2127 x_rubber_band (f,
2128 &f->display.x->left_pos, &f->display.x->top_pos,
2129 &width, &height,
2130 (XTYPE (tem) == Lisp_String
2131 ? (char *) XSTRING (tem)->data : ""),
2132 XSTRING (f->name)->data,
2133 !NILP (hscroll), !NILP (vscroll));
2135 else
2137 /* Here if at least one edge or size was specified.
2138 Demand that they all were specified, and use them. */
2139 tem = x_get_arg (parms, Qheight, 0, 0, number);
2140 if (EQ (tem, Qunbound))
2141 error ("Height not specified");
2142 CHECK_NUMBER (tem, 0);
2143 height = XINT (tem);
2145 tem = x_get_arg (parms, Qwidth, 0, 0, number);
2146 if (EQ (tem, Qunbound))
2147 error ("Width not specified");
2148 CHECK_NUMBER (tem, 0);
2149 width = XINT (tem);
2151 tem = x_get_arg (parms, Qtop, 0, 0, number);
2152 if (EQ (tem, Qunbound))
2153 error ("Top position not specified");
2154 CHECK_NUMBER (tem, 0);
2155 f->display.x->left_pos = XINT (tem);
2157 tem = x_get_arg (parms, Qleft, 0, 0, number);
2158 if (EQ (tem, Qunbound))
2159 error ("Left position not specified");
2160 CHECK_NUMBER (tem, 0);
2161 f->display.x->top_pos = XINT (tem);
2164 pixelwidth = CHAR_TO_PIXEL_WIDTH (f, width);
2165 pixelheight = CHAR_TO_PIXEL_HEIGHT (f, height);
2167 BLOCK_INPUT;
2168 FRAME_X_WINDOW (f)
2169 = XCreateWindow (parent,
2170 f->display.x->left_pos, /* Absolute horizontal offset */
2171 f->display.x->top_pos, /* Absolute Vertical offset */
2172 pixelwidth, pixelheight,
2173 f->display.x->border_width,
2174 BLACK_PIX_DEFAULT, WHITE_PIX_DEFAULT);
2175 UNBLOCK_INPUT;
2176 if (FRAME_X_WINDOW (f) == 0)
2177 error ("Unable to create window.");
2180 /* Install the now determined height and width
2181 in the windows and in phys_lines and desired_lines. */
2182 change_frame_size (f, height, width, 1, 0);
2183 XSelectInput (FRAME_X_WINDOW (f), KeyPressed | ExposeWindow
2184 | ButtonPressed | ButtonReleased | ExposeRegion | ExposeCopy
2185 | EnterWindow | LeaveWindow | UnmapWindow );
2186 x_set_resize_hint (f);
2188 /* Tell the server the window's default name. */
2189 XStoreName (XDISPLAY FRAME_X_WINDOW (f), XSTRING (f->name)->data);
2191 /* Now override the defaults with all the rest of the specified
2192 parms. */
2193 tem = x_get_arg (parms, Qunsplittable, 0, 0, boolean);
2194 f->no_split = minibuffer_only || EQ (tem, Qt);
2196 /* Do not create an icon window if the caller says not to */
2197 if (!EQ (x_get_arg (parms, Qsuppress_icon, 0, 0, boolean), Qt)
2198 || f->display.x->parent_desc != ROOT_WINDOW)
2200 x_text_icon (f, iconidentity);
2201 x_default_parameter (f, parms, Qicon_type, Qnil,
2202 "BitmapIcon", 0, symbol);
2205 /* Tell the X server the previously set values of the
2206 background, border and mouse colors; also create the mouse cursor. */
2207 BLOCK_INPUT;
2208 temp = XMakeTile (f->display.x->background_pixel);
2209 XChangeBackground (FRAME_X_WINDOW (f), temp);
2210 XFreePixmap (temp);
2211 UNBLOCK_INPUT;
2212 x_set_border_pixel (f, f->display.x->border_pixel);
2214 x_set_mouse_color (f, Qnil, Qnil);
2216 /* Now override the defaults with all the rest of the specified parms. */
2218 Fmodify_frame_parameters (frame, parms);
2220 /* Make the window appear on the frame and enable display. */
2222 if (!EQ (x_get_arg (parms, Qsuppress_initial_map, 0, 0, boolean), Qt))
2223 x_make_window_visible (f);
2224 SET_FRAME_GARBAGED (f);
2226 return frame;
2227 #endif /* X10 */
2230 DEFUN ("focus-frame", Ffocus_frame, Sfocus_frame, 1, 1, 0,
2231 "Set the focus on FRAME.")
2232 (frame)
2233 Lisp_Object frame;
2235 CHECK_LIVE_FRAME (frame, 0);
2237 if (FRAME_X_P (XFRAME (frame)))
2239 BLOCK_INPUT;
2240 x_focus_on_frame (XFRAME (frame));
2241 UNBLOCK_INPUT;
2242 return frame;
2245 return Qnil;
2248 DEFUN ("unfocus-frame", Funfocus_frame, Sunfocus_frame, 0, 0, 0,
2249 "If a frame has been focused, release it.")
2252 if (x_focus_frame)
2254 BLOCK_INPUT;
2255 x_unfocus_frame (x_focus_frame);
2256 UNBLOCK_INPUT;
2259 return Qnil;
2262 #ifndef HAVE_X11
2263 /* Computes an X-window size and position either from geometry GEO
2264 or with the mouse.
2266 F is a frame. It specifies an X window which is used to
2267 determine which display to compute for. Its font, borders
2268 and colors control how the rectangle will be displayed.
2270 X and Y are where to store the positions chosen.
2271 WIDTH and HEIGHT are where to store the sizes chosen.
2273 GEO is the geometry that may specify some of the info.
2274 STR is a prompt to display.
2275 HSCROLL and VSCROLL say whether we have horiz and vert scroll bars. */
2278 x_rubber_band (f, x, y, width, height, geo, str, hscroll, vscroll)
2279 struct frame *f;
2280 int *x, *y, *width, *height;
2281 char *geo;
2282 char *str;
2283 int hscroll, vscroll;
2285 OpaqueFrame frame;
2286 Window tempwindow;
2287 WindowInfo wininfo;
2288 int border_color;
2289 int background_color;
2290 Lisp_Object tem;
2291 int mask;
2293 BLOCK_INPUT;
2295 background_color = f->display.x->background_pixel;
2296 border_color = f->display.x->border_pixel;
2298 frame.bdrwidth = f->display.x->border_width;
2299 frame.border = XMakeTile (border_color);
2300 frame.background = XMakeTile (background_color);
2301 tempwindow = XCreateTerm (str, "emacs", geo, default_window, &frame, 10, 5,
2302 (2 * f->display.x->internal_border_width
2303 + (vscroll ? VSCROLL_WIDTH : 0)),
2304 (2 * f->display.x->internal_border_width
2305 + (hscroll ? HSCROLL_HEIGHT : 0)),
2306 width, height, f->display.x->font,
2307 FONT_WIDTH (f->display.x->font),
2308 FONT_HEIGHT (f->display.x->font));
2309 XFreePixmap (frame.border);
2310 XFreePixmap (frame.background);
2312 if (tempwindow != 0)
2314 XQueryWindow (tempwindow, &wininfo);
2315 XDestroyWindow (tempwindow);
2316 *x = wininfo.x;
2317 *y = wininfo.y;
2320 /* Coordinates we got are relative to the root window.
2321 Convert them to coordinates relative to desired parent window
2322 by scanning from there up to the root. */
2323 tempwindow = f->display.x->parent_desc;
2324 while (tempwindow != ROOT_WINDOW)
2326 int nchildren;
2327 Window *children;
2328 XQueryWindow (tempwindow, &wininfo);
2329 *x -= wininfo.x;
2330 *y -= wininfo.y;
2331 XQueryTree (tempwindow, &tempwindow, &nchildren, &children);
2332 free (children);
2335 UNBLOCK_INPUT;
2336 return tempwindow != 0;
2338 #endif /* not HAVE_X11 */
2340 DEFUN ("x-defined-color", Fx_defined_color, Sx_defined_color, 1, 1, 0,
2341 "Return t if the current X display supports the color named COLOR.")
2342 (color)
2343 Lisp_Object color;
2345 Color foo;
2347 CHECK_STRING (color, 0);
2349 if (defined_color (XSTRING (color)->data, &foo))
2350 return Qt;
2351 else
2352 return Qnil;
2355 DEFUN ("x-color-display-p", Fx_color_display_p, Sx_color_display_p, 0, 0, 0,
2356 "Return t if the X display used currently supports color.")
2359 if (x_screen_planes <= 2)
2360 return Qnil;
2362 switch (screen_visual->class)
2364 case StaticColor:
2365 case PseudoColor:
2366 case TrueColor:
2367 case DirectColor:
2368 return Qt;
2370 default:
2371 return Qnil;
2375 x_pixel_width (f)
2376 register struct frame *f;
2378 return PIXEL_WIDTH (f);
2381 x_pixel_height (f)
2382 register struct frame *f;
2384 return PIXEL_HEIGHT (f);
2387 x_char_width (f)
2388 register struct frame *f;
2390 return FONT_WIDTH (f->display.x->font);
2393 x_char_height (f)
2394 register struct frame *f;
2396 return FONT_HEIGHT (f->display.x->font);
2399 #if 0 /* These no longer seem like the right way to do things. */
2401 /* Draw a rectangle on the frame with left top corner including
2402 the character specified by LEFT_CHAR and TOP_CHAR. The rectangle is
2403 CHARS by LINES wide and long and is the color of the cursor. */
2405 void
2406 x_rectangle (f, gc, left_char, top_char, chars, lines)
2407 register struct frame *f;
2408 GC gc;
2409 register int top_char, left_char, chars, lines;
2411 int width;
2412 int height;
2413 int left = (left_char * FONT_WIDTH (f->display.x->font)
2414 + f->display.x->internal_border_width);
2415 int top = (top_char * FONT_HEIGHT (f->display.x->font)
2416 + f->display.x->internal_border_width);
2418 if (chars < 0)
2419 width = FONT_WIDTH (f->display.x->font) / 2;
2420 else
2421 width = FONT_WIDTH (f->display.x->font) * chars;
2422 if (lines < 0)
2423 height = FONT_HEIGHT (f->display.x->font) / 2;
2424 else
2425 height = FONT_HEIGHT (f->display.x->font) * lines;
2427 XDrawRectangle (x_current_display, FRAME_X_WINDOW (f),
2428 gc, left, top, width, height);
2431 DEFUN ("x-draw-rectangle", Fx_draw_rectangle, Sx_draw_rectangle, 5, 5, 0,
2432 "Draw a rectangle on FRAME between coordinates specified by\n\
2433 numbers X0, Y0, X1, Y1 in the cursor pixel.")
2434 (frame, X0, Y0, X1, Y1)
2435 register Lisp_Object frame, X0, X1, Y0, Y1;
2437 register int x0, y0, x1, y1, top, left, n_chars, n_lines;
2439 CHECK_LIVE_FRAME (frame, 0);
2440 CHECK_NUMBER (X0, 0);
2441 CHECK_NUMBER (Y0, 1);
2442 CHECK_NUMBER (X1, 2);
2443 CHECK_NUMBER (Y1, 3);
2445 x0 = XINT (X0);
2446 x1 = XINT (X1);
2447 y0 = XINT (Y0);
2448 y1 = XINT (Y1);
2450 if (y1 > y0)
2452 top = y0;
2453 n_lines = y1 - y0 + 1;
2455 else
2457 top = y1;
2458 n_lines = y0 - y1 + 1;
2461 if (x1 > x0)
2463 left = x0;
2464 n_chars = x1 - x0 + 1;
2466 else
2468 left = x1;
2469 n_chars = x0 - x1 + 1;
2472 BLOCK_INPUT;
2473 x_rectangle (XFRAME (frame), XFRAME (frame)->display.x->cursor_gc,
2474 left, top, n_chars, n_lines);
2475 UNBLOCK_INPUT;
2477 return Qt;
2480 DEFUN ("x-erase-rectangle", Fx_erase_rectangle, Sx_erase_rectangle, 5, 5, 0,
2481 "Draw a rectangle drawn on FRAME between coordinates\n\
2482 X0, Y0, X1, Y1 in the regular background-pixel.")
2483 (frame, X0, Y0, X1, Y1)
2484 register Lisp_Object frame, X0, Y0, X1, Y1;
2486 register int x0, y0, x1, y1, top, left, n_chars, n_lines;
2488 CHECK_FRAME (frame, 0);
2489 CHECK_NUMBER (X0, 0);
2490 CHECK_NUMBER (Y0, 1);
2491 CHECK_NUMBER (X1, 2);
2492 CHECK_NUMBER (Y1, 3);
2494 x0 = XINT (X0);
2495 x1 = XINT (X1);
2496 y0 = XINT (Y0);
2497 y1 = XINT (Y1);
2499 if (y1 > y0)
2501 top = y0;
2502 n_lines = y1 - y0 + 1;
2504 else
2506 top = y1;
2507 n_lines = y0 - y1 + 1;
2510 if (x1 > x0)
2512 left = x0;
2513 n_chars = x1 - x0 + 1;
2515 else
2517 left = x1;
2518 n_chars = x0 - x1 + 1;
2521 BLOCK_INPUT;
2522 x_rectangle (XFRAME (frame), XFRAME (frame)->display.x->reverse_gc,
2523 left, top, n_chars, n_lines);
2524 UNBLOCK_INPUT;
2526 return Qt;
2529 /* Draw lines around the text region beginning at the character position
2530 TOP_X, TOP_Y and ending at BOTTOM_X and BOTTOM_Y. GC specifies the
2531 pixel and line characteristics. */
2533 #define line_len(line) (FRAME_CURRENT_GLYPHS (f)->used[(line)])
2535 static void
2536 outline_region (f, gc, top_x, top_y, bottom_x, bottom_y)
2537 register struct frame *f;
2538 GC gc;
2539 int top_x, top_y, bottom_x, bottom_y;
2541 register int ibw = f->display.x->internal_border_width;
2542 register int font_w = FONT_WIDTH (f->display.x->font);
2543 register int font_h = FONT_HEIGHT (f->display.x->font);
2544 int y = top_y;
2545 int x = line_len (y);
2546 XPoint *pixel_points = (XPoint *)
2547 alloca (((bottom_y - top_y + 2) * 4) * sizeof (XPoint));
2548 register XPoint *this_point = pixel_points;
2550 /* Do the horizontal top line/lines */
2551 if (top_x == 0)
2553 this_point->x = ibw;
2554 this_point->y = ibw + (font_h * top_y);
2555 this_point++;
2556 if (x == 0)
2557 this_point->x = ibw + (font_w / 2); /* Half-size for newline chars. */
2558 else
2559 this_point->x = ibw + (font_w * x);
2560 this_point->y = (this_point - 1)->y;
2562 else
2564 this_point->x = ibw;
2565 this_point->y = ibw + (font_h * (top_y + 1));
2566 this_point++;
2567 this_point->x = ibw + (font_w * top_x);
2568 this_point->y = (this_point - 1)->y;
2569 this_point++;
2570 this_point->x = (this_point - 1)->x;
2571 this_point->y = ibw + (font_h * top_y);
2572 this_point++;
2573 this_point->x = ibw + (font_w * x);
2574 this_point->y = (this_point - 1)->y;
2577 /* Now do the right side. */
2578 while (y < bottom_y)
2579 { /* Right vertical edge */
2580 this_point++;
2581 this_point->x = (this_point - 1)->x;
2582 this_point->y = ibw + (font_h * (y + 1));
2583 this_point++;
2585 y++; /* Horizontal connection to next line */
2586 x = line_len (y);
2587 if (x == 0)
2588 this_point->x = ibw + (font_w / 2);
2589 else
2590 this_point->x = ibw + (font_w * x);
2592 this_point->y = (this_point - 1)->y;
2595 /* Now do the bottom and connect to the top left point. */
2596 this_point->x = ibw + (font_w * (bottom_x + 1));
2598 this_point++;
2599 this_point->x = (this_point - 1)->x;
2600 this_point->y = ibw + (font_h * (bottom_y + 1));
2601 this_point++;
2602 this_point->x = ibw;
2603 this_point->y = (this_point - 1)->y;
2604 this_point++;
2605 this_point->x = pixel_points->x;
2606 this_point->y = pixel_points->y;
2608 XDrawLines (x_current_display, FRAME_X_WINDOW (f),
2609 gc, pixel_points,
2610 (this_point - pixel_points + 1), CoordModeOrigin);
2613 DEFUN ("x-contour-region", Fx_contour_region, Sx_contour_region, 1, 1, 0,
2614 "Highlight the region between point and the character under the mouse\n\
2615 selected frame.")
2616 (event)
2617 register Lisp_Object event;
2619 register int x0, y0, x1, y1;
2620 register struct frame *f = selected_frame;
2621 register int p1, p2;
2623 CHECK_CONS (event, 0);
2625 BLOCK_INPUT;
2626 x0 = XINT (Fcar (Fcar (event)));
2627 y0 = XINT (Fcar (Fcdr (Fcar (event))));
2629 /* If the mouse is past the end of the line, don't that area. */
2630 /* ReWrite this... */
2632 x1 = f->cursor_x;
2633 y1 = f->cursor_y;
2635 if (y1 > y0) /* point below mouse */
2636 outline_region (f, f->display.x->cursor_gc,
2637 x0, y0, x1, y1);
2638 else if (y1 < y0) /* point above mouse */
2639 outline_region (f, f->display.x->cursor_gc,
2640 x1, y1, x0, y0);
2641 else /* same line: draw horizontal rectangle */
2643 if (x1 > x0)
2644 x_rectangle (f, f->display.x->cursor_gc,
2645 x0, y0, (x1 - x0 + 1), 1);
2646 else if (x1 < x0)
2647 x_rectangle (f, f->display.x->cursor_gc,
2648 x1, y1, (x0 - x1 + 1), 1);
2651 XFlush (x_current_display);
2652 UNBLOCK_INPUT;
2654 return Qnil;
2657 DEFUN ("x-uncontour-region", Fx_uncontour_region, Sx_uncontour_region, 1, 1, 0,
2658 "Erase any highlighting of the region between point and the character\n\
2659 at X, Y on the selected frame.")
2660 (event)
2661 register Lisp_Object event;
2663 register int x0, y0, x1, y1;
2664 register struct frame *f = selected_frame;
2666 BLOCK_INPUT;
2667 x0 = XINT (Fcar (Fcar (event)));
2668 y0 = XINT (Fcar (Fcdr (Fcar (event))));
2669 x1 = f->cursor_x;
2670 y1 = f->cursor_y;
2672 if (y1 > y0) /* point below mouse */
2673 outline_region (f, f->display.x->reverse_gc,
2674 x0, y0, x1, y1);
2675 else if (y1 < y0) /* point above mouse */
2676 outline_region (f, f->display.x->reverse_gc,
2677 x1, y1, x0, y0);
2678 else /* same line: draw horizontal rectangle */
2680 if (x1 > x0)
2681 x_rectangle (f, f->display.x->reverse_gc,
2682 x0, y0, (x1 - x0 + 1), 1);
2683 else if (x1 < x0)
2684 x_rectangle (f, f->display.x->reverse_gc,
2685 x1, y1, (x0 - x1 + 1), 1);
2687 UNBLOCK_INPUT;
2689 return Qnil;
2692 #if 0
2693 int contour_begin_x, contour_begin_y;
2694 int contour_end_x, contour_end_y;
2695 int contour_npoints;
2697 /* Clip the top part of the contour lines down (and including) line Y_POS.
2698 If X_POS is in the middle (rather than at the end) of the line, drop
2699 down a line at that character. */
2701 static void
2702 clip_contour_top (y_pos, x_pos)
2704 register XPoint *begin = contour_lines[y_pos].top_left;
2705 register XPoint *end;
2706 register int npoints;
2707 register struct display_line *line = selected_frame->phys_lines[y_pos + 1];
2709 if (x_pos >= line->len - 1) /* Draw one, straight horizontal line. */
2711 end = contour_lines[y_pos].top_right;
2712 npoints = (end - begin + 1);
2713 XDrawLines (x_current_display, contour_window,
2714 contour_erase_gc, begin_erase, npoints, CoordModeOrigin);
2716 bcopy (end, begin + 1, contour_last_point - end + 1);
2717 contour_last_point -= (npoints - 2);
2718 XDrawLines (x_current_display, contour_window,
2719 contour_erase_gc, begin, 2, CoordModeOrigin);
2720 XFlush (x_current_display);
2722 /* Now, update contour_lines structure. */
2724 /* ______. */
2725 else /* |________*/
2727 register XPoint *p = begin + 1;
2728 end = contour_lines[y_pos].bottom_right;
2729 npoints = (end - begin + 1);
2730 XDrawLines (x_current_display, contour_window,
2731 contour_erase_gc, begin_erase, npoints, CoordModeOrigin);
2733 p->y = begin->y;
2734 p->x = ibw + (font_w * (x_pos + 1));
2735 p++;
2736 p->y = begin->y + font_h;
2737 p->x = (p - 1)->x;
2738 bcopy (end, begin + 3, contour_last_point - end + 1);
2739 contour_last_point -= (npoints - 5);
2740 XDrawLines (x_current_display, contour_window,
2741 contour_erase_gc, begin, 4, CoordModeOrigin);
2742 XFlush (x_current_display);
2744 /* Now, update contour_lines structure. */
2748 /* Erase the top horzontal lines of the contour, and then extend
2749 the contour upwards. */
2751 static void
2752 extend_contour_top (line)
2756 static void
2757 clip_contour_bottom (x_pos, y_pos)
2758 int x_pos, y_pos;
2762 static void
2763 extend_contour_bottom (x_pos, y_pos)
2767 DEFUN ("x-select-region", Fx_select_region, Sx_select_region, 1, 1, "e",
2769 (event)
2770 Lisp_Object event;
2772 register struct frame *f = selected_frame;
2773 register int point_x = f->cursor_x;
2774 register int point_y = f->cursor_y;
2775 register int mouse_below_point;
2776 register Lisp_Object obj;
2777 register int x_contour_x, x_contour_y;
2779 x_contour_x = x_mouse_x;
2780 x_contour_y = x_mouse_y;
2781 if (x_contour_y > point_y || (x_contour_y == point_y
2782 && x_contour_x > point_x))
2784 mouse_below_point = 1;
2785 outline_region (f, f->display.x->cursor_gc, point_x, point_y,
2786 x_contour_x, x_contour_y);
2788 else
2790 mouse_below_point = 0;
2791 outline_region (f, f->display.x->cursor_gc, x_contour_x, x_contour_y,
2792 point_x, point_y);
2795 while (1)
2797 obj = read_char (-1, 0, 0, Qnil, 0);
2798 if (XTYPE (obj) != Lisp_Cons)
2799 break;
2801 if (mouse_below_point)
2803 if (x_mouse_y <= point_y) /* Flipped. */
2805 mouse_below_point = 0;
2807 outline_region (f, f->display.x->reverse_gc, point_x, point_y,
2808 x_contour_x, x_contour_y);
2809 outline_region (f, f->display.x->cursor_gc, x_mouse_x, x_mouse_y,
2810 point_x, point_y);
2812 else if (x_mouse_y < x_contour_y) /* Bottom clipped. */
2814 clip_contour_bottom (x_mouse_y);
2816 else if (x_mouse_y > x_contour_y) /* Bottom extended. */
2818 extend_bottom_contour (x_mouse_y);
2821 x_contour_x = x_mouse_x;
2822 x_contour_y = x_mouse_y;
2824 else /* mouse above or same line as point */
2826 if (x_mouse_y >= point_y) /* Flipped. */
2828 mouse_below_point = 1;
2830 outline_region (f, f->display.x->reverse_gc,
2831 x_contour_x, x_contour_y, point_x, point_y);
2832 outline_region (f, f->display.x->cursor_gc, point_x, point_y,
2833 x_mouse_x, x_mouse_y);
2835 else if (x_mouse_y > x_contour_y) /* Top clipped. */
2837 clip_contour_top (x_mouse_y);
2839 else if (x_mouse_y < x_contour_y) /* Top extended. */
2841 extend_contour_top (x_mouse_y);
2846 unread_command_event = obj;
2847 if (mouse_below_point)
2849 contour_begin_x = point_x;
2850 contour_begin_y = point_y;
2851 contour_end_x = x_contour_x;
2852 contour_end_y = x_contour_y;
2854 else
2856 contour_begin_x = x_contour_x;
2857 contour_begin_y = x_contour_y;
2858 contour_end_x = point_x;
2859 contour_end_y = point_y;
2862 #endif
2864 DEFUN ("x-horizontal-line", Fx_horizontal_line, Sx_horizontal_line, 1, 1, "e",
2866 (event)
2867 Lisp_Object event;
2869 register Lisp_Object obj;
2870 struct frame *f = selected_frame;
2871 register struct window *w = XWINDOW (selected_window);
2872 register GC line_gc = f->display.x->cursor_gc;
2873 register GC erase_gc = f->display.x->reverse_gc;
2874 #if 0
2875 char dash_list[] = {6, 4, 6, 4};
2876 int dashes = 4;
2877 XGCValues gc_values;
2878 #endif
2879 register int previous_y;
2880 register int line = (x_mouse_y + 1) * FONT_HEIGHT (f->display.x->font)
2881 + f->display.x->internal_border_width;
2882 register int left = f->display.x->internal_border_width
2883 + (w->left
2884 * FONT_WIDTH (f->display.x->font));
2885 register int right = left + (w->width
2886 * FONT_WIDTH (f->display.x->font))
2887 - f->display.x->internal_border_width;
2889 #if 0
2890 BLOCK_INPUT;
2891 gc_values.foreground = f->display.x->cursor_pixel;
2892 gc_values.background = f->display.x->background_pixel;
2893 gc_values.line_width = 1;
2894 gc_values.line_style = LineOnOffDash;
2895 gc_values.cap_style = CapRound;
2896 gc_values.join_style = JoinRound;
2898 line_gc = XCreateGC (x_current_display, FRAME_X_WINDOW (f),
2899 GCLineStyle | GCJoinStyle | GCCapStyle
2900 | GCLineWidth | GCForeground | GCBackground,
2901 &gc_values);
2902 XSetDashes (x_current_display, line_gc, 0, dash_list, dashes);
2903 gc_values.foreground = f->display.x->background_pixel;
2904 gc_values.background = f->display.x->foreground_pixel;
2905 erase_gc = XCreateGC (x_current_display, FRAME_X_WINDOW (f),
2906 GCLineStyle | GCJoinStyle | GCCapStyle
2907 | GCLineWidth | GCForeground | GCBackground,
2908 &gc_values);
2909 XSetDashes (x_current_display, erase_gc, 0, dash_list, dashes);
2910 #endif
2912 while (1)
2914 BLOCK_INPUT;
2915 if (x_mouse_y >= XINT (w->top)
2916 && x_mouse_y < XINT (w->top) + XINT (w->height) - 1)
2918 previous_y = x_mouse_y;
2919 line = (x_mouse_y + 1) * FONT_HEIGHT (f->display.x->font)
2920 + f->display.x->internal_border_width;
2921 XDrawLine (x_current_display, FRAME_X_WINDOW (f),
2922 line_gc, left, line, right, line);
2924 XFlushQueue ();
2925 UNBLOCK_INPUT;
2929 obj = read_char (-1, 0, 0, Qnil, 0);
2930 if ((XTYPE (obj) != Lisp_Cons)
2931 || (! EQ (Fcar (Fcdr (Fcdr (obj))),
2932 Qvertical_scroll_bar))
2933 || x_mouse_grabbed)
2935 BLOCK_INPUT;
2936 XDrawLine (x_current_display, FRAME_X_WINDOW (f),
2937 erase_gc, left, line, right, line);
2938 UNBLOCK_INPUT;
2939 unread_command_event = obj;
2940 #if 0
2941 XFreeGC (x_current_display, line_gc);
2942 XFreeGC (x_current_display, erase_gc);
2943 #endif
2944 return Qnil;
2947 while (x_mouse_y == previous_y);
2949 BLOCK_INPUT;
2950 XDrawLine (x_current_display, FRAME_X_WINDOW (f),
2951 erase_gc, left, line, right, line);
2952 UNBLOCK_INPUT;
2955 #endif
2957 /* Offset in buffer of character under the pointer, or 0. */
2958 int mouse_buffer_offset;
2960 #if 0
2961 /* These keep track of the rectangle following the pointer. */
2962 int mouse_track_top, mouse_track_left, mouse_track_width;
2964 DEFUN ("x-track-pointer", Fx_track_pointer, Sx_track_pointer, 0, 0, 0,
2965 "Track the pointer.")
2968 static Cursor current_pointer_shape;
2969 FRAME_PTR f = x_mouse_frame;
2971 BLOCK_INPUT;
2972 if (EQ (Vmouse_frame_part, Qtext_part)
2973 && (current_pointer_shape != f->display.x->nontext_cursor))
2975 unsigned char c;
2976 struct buffer *buf;
2978 current_pointer_shape = f->display.x->nontext_cursor;
2979 XDefineCursor (x_current_display,
2980 FRAME_X_WINDOW (f),
2981 current_pointer_shape);
2983 buf = XBUFFER (XWINDOW (Vmouse_window)->buffer);
2984 c = *(BUF_CHAR_ADDRESS (buf, mouse_buffer_offset));
2986 else if (EQ (Vmouse_frame_part, Qmodeline_part)
2987 && (current_pointer_shape != f->display.x->modeline_cursor))
2989 current_pointer_shape = f->display.x->modeline_cursor;
2990 XDefineCursor (x_current_display,
2991 FRAME_X_WINDOW (f),
2992 current_pointer_shape);
2995 XFlushQueue ();
2996 UNBLOCK_INPUT;
2998 #endif
3000 #if 0
3001 DEFUN ("x-track-pointer", Fx_track_pointer, Sx_track_pointer, 1, 1, "e",
3002 "Draw rectangle around character under mouse pointer, if there is one.")
3003 (event)
3004 Lisp_Object event;
3006 struct window *w = XWINDOW (Vmouse_window);
3007 struct frame *f = XFRAME (WINDOW_FRAME (w));
3008 struct buffer *b = XBUFFER (w->buffer);
3009 Lisp_Object obj;
3011 if (! EQ (Vmouse_window, selected_window))
3012 return Qnil;
3014 if (EQ (event, Qnil))
3016 int x, y;
3018 x_read_mouse_position (selected_frame, &x, &y);
3021 BLOCK_INPUT;
3022 mouse_track_width = 0;
3023 mouse_track_left = mouse_track_top = -1;
3027 if ((x_mouse_x != mouse_track_left
3028 && (x_mouse_x < mouse_track_left
3029 || x_mouse_x > (mouse_track_left + mouse_track_width)))
3030 || x_mouse_y != mouse_track_top)
3032 int hp = 0; /* Horizontal position */
3033 int len = FRAME_CURRENT_GLYPHS (f)->used[x_mouse_y];
3034 int p = FRAME_CURRENT_GLYPHS (f)->bufp[x_mouse_y];
3035 int tab_width = XINT (b->tab_width);
3036 int ctl_arrow_p = !NILP (b->ctl_arrow);
3037 unsigned char c;
3038 int mode_line_vpos = XFASTINT (w->height) + XFASTINT (w->top) - 1;
3039 int in_mode_line = 0;
3041 if (! FRAME_CURRENT_GLYPHS (f)->enable[x_mouse_y])
3042 break;
3044 /* Erase previous rectangle. */
3045 if (mouse_track_width)
3047 x_rectangle (f, f->display.x->reverse_gc,
3048 mouse_track_left, mouse_track_top,
3049 mouse_track_width, 1);
3051 if ((mouse_track_left == f->phys_cursor_x
3052 || mouse_track_left == f->phys_cursor_x - 1)
3053 && mouse_track_top == f->phys_cursor_y)
3055 x_display_cursor (f, 1);
3059 mouse_track_left = x_mouse_x;
3060 mouse_track_top = x_mouse_y;
3061 mouse_track_width = 0;
3063 if (mouse_track_left > len) /* Past the end of line. */
3064 goto draw_or_not;
3066 if (mouse_track_top == mode_line_vpos)
3068 in_mode_line = 1;
3069 goto draw_or_not;
3072 if (tab_width <= 0 || tab_width > 20) tab_width = 8;
3075 c = FETCH_CHAR (p);
3076 if (len == f->width && hp == len - 1 && c != '\n')
3077 goto draw_or_not;
3079 switch (c)
3081 case '\t':
3082 mouse_track_width = tab_width - (hp % tab_width);
3083 p++;
3084 hp += mouse_track_width;
3085 if (hp > x_mouse_x)
3087 mouse_track_left = hp - mouse_track_width;
3088 goto draw_or_not;
3090 continue;
3092 case '\n':
3093 mouse_track_width = -1;
3094 goto draw_or_not;
3096 default:
3097 if (ctl_arrow_p && (c < 040 || c == 0177))
3099 if (p > ZV)
3100 goto draw_or_not;
3102 mouse_track_width = 2;
3103 p++;
3104 hp +=2;
3105 if (hp > x_mouse_x)
3107 mouse_track_left = hp - mouse_track_width;
3108 goto draw_or_not;
3111 else
3113 mouse_track_width = 1;
3114 p++;
3115 hp++;
3117 continue;
3120 while (hp <= x_mouse_x);
3122 draw_or_not:
3123 if (mouse_track_width) /* Over text; use text pointer shape. */
3125 XDefineCursor (x_current_display,
3126 FRAME_X_WINDOW (f),
3127 f->display.x->text_cursor);
3128 x_rectangle (f, f->display.x->cursor_gc,
3129 mouse_track_left, mouse_track_top,
3130 mouse_track_width, 1);
3132 else if (in_mode_line)
3133 XDefineCursor (x_current_display,
3134 FRAME_X_WINDOW (f),
3135 f->display.x->modeline_cursor);
3136 else
3137 XDefineCursor (x_current_display,
3138 FRAME_X_WINDOW (f),
3139 f->display.x->nontext_cursor);
3142 XFlush (x_current_display);
3143 UNBLOCK_INPUT;
3145 obj = read_char (-1, 0, 0, Qnil, 0);
3146 BLOCK_INPUT;
3148 while (XTYPE (obj) == Lisp_Cons /* Mouse event */
3149 && EQ (Fcar (Fcdr (Fcdr (obj))), Qnil) /* Not scroll bar */
3150 && EQ (Vmouse_depressed, Qnil) /* Only motion events */
3151 && EQ (Vmouse_window, selected_window) /* In this window */
3152 && x_mouse_frame);
3154 unread_command_event = obj;
3156 if (mouse_track_width)
3158 x_rectangle (f, f->display.x->reverse_gc,
3159 mouse_track_left, mouse_track_top,
3160 mouse_track_width, 1);
3161 mouse_track_width = 0;
3162 if ((mouse_track_left == f->phys_cursor_x
3163 || mouse_track_left - 1 == f->phys_cursor_x)
3164 && mouse_track_top == f->phys_cursor_y)
3166 x_display_cursor (f, 1);
3169 XDefineCursor (x_current_display,
3170 FRAME_X_WINDOW (f),
3171 f->display.x->nontext_cursor);
3172 XFlush (x_current_display);
3173 UNBLOCK_INPUT;
3175 return Qnil;
3177 #endif
3179 #if 0
3180 #include "glyphs.h"
3182 /* Draw a pixmap specified by IMAGE_DATA of dimensions WIDTH and HEIGHT
3183 on the frame F at position X, Y. */
3185 x_draw_pixmap (f, x, y, image_data, width, height)
3186 struct frame *f;
3187 int x, y, width, height;
3188 char *image_data;
3190 Pixmap image;
3192 image = XCreateBitmapFromData (x_current_display,
3193 FRAME_X_WINDOW (f), image_data,
3194 width, height);
3195 XCopyPlane (x_current_display, image, FRAME_X_WINDOW (f),
3196 f->display.x->normal_gc, 0, 0, width, height, x, y);
3198 #endif
3200 #if 0
3202 #ifdef HAVE_X11
3203 #define XMouseEvent XEvent
3204 #define WhichMouseButton xbutton.button
3205 #define MouseWindow xbutton.window
3206 #define MouseX xbutton.x
3207 #define MouseY xbutton.y
3208 #define MouseTime xbutton.time
3209 #define ButtonReleased ButtonRelease
3210 #define ButtonPressed ButtonPress
3211 #else
3212 #define XMouseEvent XButtonEvent
3213 #define WhichMouseButton detail
3214 #define MouseWindow window
3215 #define MouseX x
3216 #define MouseY y
3217 #define MouseTime time
3218 #endif /* X11 */
3220 DEFUN ("x-mouse-events", Fx_mouse_events, Sx_mouse_events, 0, 0, 0,
3221 "Return number of pending mouse events from X window system.")
3224 return make_number (queue_event_count (&x_mouse_queue));
3227 /* Encode the mouse button events in the form expected by the
3228 mouse code in Lisp. For X11, this means moving the masks around. */
3230 static int
3231 encode_mouse_button (mouse_event)
3232 XMouseEvent mouse_event;
3234 register int event_code;
3235 register char key_mask;
3237 event_code = mouse_event.detail & 3;
3238 key_mask = (mouse_event.detail >> 8) & 0xf0;
3239 event_code |= key_mask >> 1;
3240 if (mouse_event.type == ButtonReleased) event_code |= 0x04;
3241 return event_code;
3244 DEFUN ("x-get-mouse-event", Fx_get_mouse_event, Sx_get_mouse_event,
3245 0, 1, 0,
3246 "Get next mouse event out of mouse event buffer.\n\
3247 Optional ARG non-nil means return nil immediately if no pending event;\n\
3248 otherwise, wait for an event. Returns a four-part list:\n\
3249 ((X-POS Y-POS) WINDOW FRAME-PART KEYSEQ TIMESTAMP).\n\
3250 Normally X-POS and Y-POS are the position of the click on the frame\n\
3251 (measured in characters and lines), and WINDOW is the window clicked in.\n\
3252 KEYSEQ is a string, the key sequence to be looked up in the mouse maps.\n\
3253 If FRAME-PART is non-nil, the event was on a scroll bar;\n\
3254 then Y-POS is really the total length of the scroll bar, while X-POS is\n\
3255 the relative position of the scroll bar's value within that total length,\n\
3256 and a third element OFFSET appears in that list: the height of the thumb-up\n\
3257 area at the top of the scroll bar.\n\
3258 FRAME-PART is one of the following symbols:\n\
3259 `vertical-scroll-bar', `vertical-thumbup', `vertical-thumbdown',\n\
3260 `horizontal-scroll-bar', `horizontal-thumbleft', `horizontal-thumbright'.\n\
3261 TIMESTAMP is the lower 23 bits of the X-server's timestamp for\n\
3262 the mouse event.")
3263 (arg)
3264 Lisp_Object arg;
3266 XMouseEvent xrep;
3267 register int com_letter;
3268 register Lisp_Object tempx;
3269 register Lisp_Object tempy;
3270 Lisp_Object part, pos, timestamp;
3271 int prefix;
3272 struct frame *f;
3274 int tem;
3276 while (1)
3278 BLOCK_INPUT;
3279 tem = dequeue_event (&xrep, &x_mouse_queue);
3280 UNBLOCK_INPUT;
3282 if (tem)
3284 switch (xrep.type)
3286 case ButtonPressed:
3287 case ButtonReleased:
3289 com_letter = encode_mouse_button (xrep);
3290 mouse_timestamp = xrep.MouseTime;
3292 if ((f = x_window_to_frame (xrep.MouseWindow)) != 0)
3294 Lisp_Object frame;
3296 if (f->display.x->icon_desc == xrep.MouseWindow)
3298 x_make_frame_visible (f);
3299 continue;
3302 XSET (tempx, Lisp_Int,
3303 min (f->width-1, max (0, (xrep.MouseX - f->display.x->internal_border_width)/FONT_WIDTH (f->display.x->font))));
3304 XSET (tempy, Lisp_Int,
3305 min (f->height-1, max (0, (xrep.MouseY - f->display.x->internal_border_width)/FONT_HEIGHT (f->display.x->font))));
3306 XSET (timestamp, Lisp_Int, (xrep.MouseTime & 0x7fffff));
3307 XSET (frame, Lisp_Frame, f);
3309 pos = Fcons (tempx, Fcons (tempy, Qnil));
3310 Vmouse_window
3311 = Flocate_window_from_coordinates (frame, pos);
3313 Vmouse_event
3314 = Fcons (pos,
3315 Fcons (Vmouse_window,
3316 Fcons (Qnil,
3317 Fcons (Fchar_to_string (make_number (com_letter)),
3318 Fcons (timestamp, Qnil)))));
3319 return Vmouse_event;
3321 else if ((f = x_window_to_scroll_bar (xrep.MouseWindow, &part, &prefix)) != 0)
3323 int pos, len;
3324 Lisp_Object keyseq;
3325 char *partname;
3327 keyseq = concat2 (Fchar_to_string (make_number (prefix)),
3328 Fchar_to_string (make_number (com_letter)));
3330 pos = xrep.MouseY - (f->display.x->v_scroll_bar_width - 2);
3331 XSET (tempx, Lisp_Int, pos);
3332 len = ((FONT_HEIGHT (f->display.x->font) * f->height)
3333 + f->display.x->internal_border_width
3334 - (2 * (f->display.x->v_scroll_bar_width - 2)));
3335 XSET (tempy, Lisp_Int, len);
3336 XSET (timestamp, Lisp_Int, (xrep.MouseTime & 0x7fffff));
3337 Vmouse_window = f->selected_window;
3338 Vmouse_event
3339 = Fcons (Fcons (tempx, Fcons (tempy,
3340 Fcons (make_number (f->display.x->v_scroll_bar_width - 2),
3341 Qnil))),
3342 Fcons (Vmouse_window,
3343 Fcons (intern (part),
3344 Fcons (keyseq, Fcons (timestamp,
3345 Qnil)))));
3346 return Vmouse_event;
3348 else
3349 continue;
3351 #ifdef HAVE_X11
3352 case MotionNotify:
3354 com_letter = x11_encode_mouse_button (xrep);
3355 if ((f = x_window_to_frame (xrep.MouseWindow)) != 0)
3357 Lisp_Object frame;
3359 XSET (tempx, Lisp_Int,
3360 min (f->width-1,
3361 max (0, (xrep.MouseX - f->display.x->internal_border_width)
3362 / FONT_WIDTH (f->display.x->font))));
3363 XSET (tempy, Lisp_Int,
3364 min (f->height-1,
3365 max (0, (xrep.MouseY - f->display.x->internal_border_width)
3366 / FONT_HEIGHT (f->display.x->font))));
3368 XSET (frame, Lisp_Frame, f);
3369 XSET (timestamp, Lisp_Int, (xrep.MouseTime & 0x7fffff));
3371 pos = Fcons (tempx, Fcons (tempy, Qnil));
3372 Vmouse_window
3373 = Flocate_window_from_coordinates (frame, pos);
3375 Vmouse_event
3376 = Fcons (pos,
3377 Fcons (Vmouse_window,
3378 Fcons (Qnil,
3379 Fcons (Fchar_to_string (make_number (com_letter)),
3380 Fcons (timestamp, Qnil)))));
3381 return Vmouse_event;
3384 break;
3385 #endif /* HAVE_X11 */
3387 default:
3388 if (f = x_window_to_frame (xrep.MouseWindow))
3389 Vmouse_window = f->selected_window;
3390 else if (f = x_window_to_scroll_bar (xrep.MouseWindow, &part, &prefix))
3391 Vmouse_window = f->selected_window;
3392 return Vmouse_event = Qnil;
3396 if (!NILP (arg))
3397 return Qnil;
3399 /* Wait till we get another mouse event. */
3400 wait_reading_process_input (0, 0, 2, 0);
3403 #endif
3406 #ifndef HAVE_X11
3407 DEFUN ("x-store-cut-buffer", Fx_store_cut_buffer, Sx_store_cut_buffer,
3408 1, 1, "sStore text in cut buffer: ",
3409 "Store contents of STRING into the cut buffer of the X window system.")
3410 (string)
3411 register Lisp_Object string;
3413 int mask;
3415 CHECK_STRING (string, 1);
3416 if (! FRAME_X_P (selected_frame))
3417 error ("Selected frame does not understand X protocol.");
3419 BLOCK_INPUT;
3420 XStoreBytes ((char *) XSTRING (string)->data, XSTRING (string)->size);
3421 UNBLOCK_INPUT;
3423 return Qnil;
3426 DEFUN ("x-get-cut-buffer", Fx_get_cut_buffer, Sx_get_cut_buffer, 0, 0, 0,
3427 "Return contents of cut buffer of the X window system, as a string.")
3430 int len;
3431 register Lisp_Object string;
3432 int mask;
3433 register char *d;
3435 BLOCK_INPUT;
3436 d = XFetchBytes (&len);
3437 string = make_string (d, len);
3438 XFree (d);
3439 UNBLOCK_INPUT;
3440 return string;
3442 #endif /* X10 */
3444 #ifdef HAVE_X11
3445 DEFUN ("x-rebind-key", Fx_rebind_key, Sx_rebind_key, 3, 3, 0,
3446 "Rebind X keysym KEYSYM, with MODIFIERS, to generate NEWSTRING.\n\
3447 KEYSYM is a string which conforms to the X keysym definitions found\n\
3448 in X11/keysymdef.h, sans the initial XK_. MODIFIERS is nil or a\n\
3449 list of strings specifying modifier keys such as Control_L, which must\n\
3450 also be depressed for NEWSTRING to appear.")
3451 (x_keysym, modifiers, newstring)
3452 register Lisp_Object x_keysym;
3453 register Lisp_Object modifiers;
3454 register Lisp_Object newstring;
3456 char *rawstring;
3457 register KeySym keysym;
3458 KeySym modifier_list[16];
3460 CHECK_STRING (x_keysym, 1);
3461 CHECK_STRING (newstring, 3);
3463 keysym = XStringToKeysym ((char *) XSTRING (x_keysym)->data);
3464 if (keysym == NoSymbol)
3465 error ("Keysym does not exist");
3467 if (NILP (modifiers))
3468 XRebindKeysym (x_current_display, keysym, modifier_list, 0,
3469 XSTRING (newstring)->data, XSTRING (newstring)->size);
3470 else
3472 register Lisp_Object rest, mod;
3473 register int i = 0;
3475 for (rest = modifiers; !NILP (rest); rest = Fcdr (rest))
3477 if (i == 16)
3478 error ("Can't have more than 16 modifiers");
3480 mod = Fcar (rest);
3481 CHECK_STRING (mod, 3);
3482 modifier_list[i] = XStringToKeysym ((char *) XSTRING (mod)->data);
3483 if (modifier_list[i] == NoSymbol
3484 || !IsModifierKey (modifier_list[i]))
3485 error ("Element is not a modifier keysym");
3486 i++;
3489 XRebindKeysym (x_current_display, keysym, modifier_list, i,
3490 XSTRING (newstring)->data, XSTRING (newstring)->size);
3493 return Qnil;
3496 DEFUN ("x-rebind-keys", Fx_rebind_keys, Sx_rebind_keys, 2, 2, 0,
3497 "Rebind KEYCODE to list of strings STRINGS.\n\
3498 STRINGS should be a list of 16 elements, one for each shift combination.\n\
3499 nil as element means don't change.\n\
3500 See the documentation of `x-rebind-key' for more information.")
3501 (keycode, strings)
3502 register Lisp_Object keycode;
3503 register Lisp_Object strings;
3505 register Lisp_Object item;
3506 register unsigned char *rawstring;
3507 KeySym rawkey, modifier[1];
3508 int strsize;
3509 register unsigned i;
3511 CHECK_NUMBER (keycode, 1);
3512 CHECK_CONS (strings, 2);
3513 rawkey = (KeySym) ((unsigned) (XINT (keycode))) & 255;
3514 for (i = 0; i <= 15; strings = Fcdr (strings), i++)
3516 item = Fcar (strings);
3517 if (!NILP (item))
3519 CHECK_STRING (item, 2);
3520 strsize = XSTRING (item)->size;
3521 rawstring = (unsigned char *) xmalloc (strsize);
3522 bcopy (XSTRING (item)->data, rawstring, strsize);
3523 modifier[1] = 1 << i;
3524 XRebindKeysym (x_current_display, rawkey, modifier, 1,
3525 rawstring, strsize);
3528 return Qnil;
3530 #else
3531 DEFUN ("x-rebind-key", Fx_rebind_key, Sx_rebind_key, 3, 3, 0,
3532 "Rebind KEYCODE, with shift bits SHIFT-MASK, to new string NEWSTRING.\n\
3533 KEYCODE and SHIFT-MASK should be numbers representing the X keyboard code\n\
3534 and shift mask respectively. NEWSTRING is an arbitrary string of keystrokes.\n\
3535 If SHIFT-MASK is nil, then KEYCODE's key will be bound to NEWSTRING for\n\
3536 all shift combinations.\n\
3537 Shift Lock 1 Shift 2\n\
3538 Meta 4 Control 8\n\
3540 For values of KEYCODE, see /usr/lib/Xkeymap.txt (remember that the codes\n\
3541 in that file are in octal!)\n\
3543 NOTE: due to an X bug, this function will not take effect unless one has\n\
3544 a `~/.Xkeymap' file. (See the documentation for the `keycomp' program.)\n\
3545 This problem will be fixed in X version 11.")
3547 (keycode, shift_mask, newstring)
3548 register Lisp_Object keycode;
3549 register Lisp_Object shift_mask;
3550 register Lisp_Object newstring;
3552 char *rawstring;
3553 int keysym, rawshift;
3554 int i, strsize;
3556 CHECK_NUMBER (keycode, 1);
3557 if (!NILP (shift_mask))
3558 CHECK_NUMBER (shift_mask, 2);
3559 CHECK_STRING (newstring, 3);
3560 strsize = XSTRING (newstring)->size;
3561 rawstring = (char *) xmalloc (strsize);
3562 bcopy (XSTRING (newstring)->data, rawstring, strsize);
3564 keysym = ((unsigned) (XINT (keycode))) & 255;
3566 if (NILP (shift_mask))
3568 for (i = 0; i <= 15; i++)
3569 XRebindCode (keysym, i<<11, rawstring, strsize);
3571 else
3573 rawshift = (((unsigned) (XINT (shift_mask))) & 15) << 11;
3574 XRebindCode (keysym, rawshift, rawstring, strsize);
3576 return Qnil;
3579 DEFUN ("x-rebind-keys", Fx_rebind_keys, Sx_rebind_keys, 2, 2, 0,
3580 "Rebind KEYCODE to list of strings STRINGS.\n\
3581 STRINGS should be a list of 16 elements, one for each shift combination.\n\
3582 nil as element means don't change.\n\
3583 See the documentation of `x-rebind-key' for more information.")
3584 (keycode, strings)
3585 register Lisp_Object keycode;
3586 register Lisp_Object strings;
3588 register Lisp_Object item;
3589 register char *rawstring;
3590 KeySym rawkey, modifier[1];
3591 int strsize;
3592 register unsigned i;
3594 CHECK_NUMBER (keycode, 1);
3595 CHECK_CONS (strings, 2);
3596 rawkey = (KeySym) ((unsigned) (XINT (keycode))) & 255;
3597 for (i = 0; i <= 15; strings = Fcdr (strings), i++)
3599 item = Fcar (strings);
3600 if (!NILP (item))
3602 CHECK_STRING (item, 2);
3603 strsize = XSTRING (item)->size;
3604 rawstring = (char *) xmalloc (strsize);
3605 bcopy (XSTRING (item)->data, rawstring, strsize);
3606 XRebindCode (rawkey, i << 11, rawstring, strsize);
3609 return Qnil;
3611 #endif /* not HAVE_X11 */
3613 #ifdef HAVE_X11
3614 Visual *
3615 select_visual (screen, depth)
3616 Screen *screen;
3617 unsigned int *depth;
3619 Visual *v;
3620 XVisualInfo *vinfo, vinfo_template;
3621 int n_visuals;
3623 v = DefaultVisualOfScreen (screen);
3625 #ifdef HAVE_X11R4
3626 vinfo_template.visualid = XVisualIDFromVisual (v);
3627 #else
3628 vinfo_template.visualid = x->visualid;
3629 #endif
3631 vinfo = XGetVisualInfo (x_current_display, VisualIDMask, &vinfo_template,
3632 &n_visuals);
3633 if (n_visuals != 1)
3634 fatal ("Can't get proper X visual info");
3636 if ((1 << vinfo->depth) == vinfo->colormap_size)
3637 *depth = vinfo->depth;
3638 else
3640 int i = 0;
3641 int n = vinfo->colormap_size - 1;
3642 while (n)
3644 n = n >> 1;
3645 i++;
3647 *depth = i;
3650 XFree ((char *) vinfo);
3651 return v;
3653 #endif /* HAVE_X11 */
3655 DEFUN ("x-open-connection", Fx_open_connection, Sx_open_connection,
3656 1, 2, 0, "Open a connection to an X server.\n\
3657 DISPLAY is the name of the display to connect to. Optional second\n\
3658 arg XRM_STRING is a string of resources in xrdb format.")
3659 (display, xrm_string)
3660 Lisp_Object display, xrm_string;
3662 unsigned int n_planes;
3663 register Screen *x_screen;
3664 unsigned char *xrm_option;
3666 CHECK_STRING (display, 0);
3667 if (x_current_display != 0)
3668 error ("X server connection is already initialized");
3670 /* This is what opens the connection and sets x_current_display.
3671 This also initializes many symbols, such as those used for input. */
3672 x_term_init (XSTRING (display)->data);
3674 #ifdef HAVE_X11
3675 XFASTINT (Vwindow_system_version) = 11;
3677 if (!EQ (xrm_string, Qnil))
3679 CHECK_STRING (xrm_string, 1);
3680 xrm_option = (unsigned char *) XSTRING (xrm_string);
3682 else
3683 xrm_option = (unsigned char *) 0;
3684 xrdb = x_load_resources (x_current_display, xrm_option, EMACS_CLASS);
3685 x_current_display->db = xrdb;
3687 x_screen = DefaultScreenOfDisplay (x_current_display);
3689 x_screen_count = ScreenCount (x_current_display);
3690 Vx_vendor = build_string (ServerVendor (x_current_display));
3691 x_release = VendorRelease (x_current_display);
3693 x_screen_height = HeightOfScreen (x_screen);
3694 x_screen_height_mm = HeightMMOfScreen (x_screen);
3695 x_screen_width = WidthOfScreen (x_screen);
3696 x_screen_width_mm = WidthMMOfScreen (x_screen);
3698 switch (DoesBackingStore (x_screen))
3700 case Always:
3701 Vx_backing_store = intern ("Always");
3702 break;
3704 case WhenMapped:
3705 Vx_backing_store = intern ("WhenMapped");
3706 break;
3708 case NotUseful:
3709 Vx_backing_store = intern ("NotUseful");
3710 break;
3712 default:
3713 error ("Strange value for BackingStore.");
3714 break;
3717 if (DoesSaveUnders (x_screen) == True)
3718 x_save_under = 1;
3719 else
3720 x_save_under = 0;
3722 screen_visual = select_visual (x_screen, &n_planes);
3723 x_screen_planes = n_planes;
3724 Vx_screen_visual = intern (x_visual_strings [screen_visual->class]);
3726 /* X Atoms used by emacs. */
3727 BLOCK_INPUT;
3728 Xatom_emacs_selection = XInternAtom (x_current_display, "_EMACS_SELECTION_",
3729 False);
3730 Xatom_clipboard = XInternAtom (x_current_display, "CLIPBOARD",
3731 False);
3732 Xatom_clipboard_selection = XInternAtom (x_current_display, "_EMACS_CLIPBOARD_",
3733 False);
3734 Xatom_wm_change_state = XInternAtom (x_current_display, "WM_CHANGE_STATE",
3735 False);
3736 Xatom_incremental = XInternAtom (x_current_display, "INCR",
3737 False);
3738 Xatom_multiple = XInternAtom (x_current_display, "MULTIPLE",
3739 False);
3740 Xatom_targets = XInternAtom (x_current_display, "TARGETS",
3741 False);
3742 Xatom_timestamp = XInternAtom (x_current_display, "TIMESTAMP",
3743 False);
3744 Xatom_delete = XInternAtom (x_current_display, "DELETE",
3745 False);
3746 Xatom_insert_selection = XInternAtom (x_current_display, "INSERT_SELECTION",
3747 False);
3748 Xatom_pair = XInternAtom (x_current_display, "XA_ATOM_PAIR",
3749 False);
3750 Xatom_insert_property = XInternAtom (x_current_display, "INSERT_PROPERTY",
3751 False);
3752 Xatom_text = XInternAtom (x_current_display, "TEXT",
3753 False);
3754 Xatom_wm_protocols = XInternAtom (x_current_display, "WM_PROTOCOLS",
3755 False);
3756 Xatom_wm_take_focus = XInternAtom (x_current_display, "WM_TAKE_FOCUS",
3757 False);
3758 Xatom_wm_save_yourself = XInternAtom (x_current_display, "WM_SAVE_YOURSELF",
3759 False);
3760 Xatom_wm_delete_window = XInternAtom (x_current_display, "WM_DELETE_WINDOW",
3761 False);
3762 Xatom_wm_change_state = XInternAtom (x_current_display, "WM_CHANGE_STATE",
3763 False);
3764 Xatom_wm_configure_denied = XInternAtom (x_current_display,
3765 "WM_CONFIGURE_DENIED", False);
3766 Xatom_wm_window_moved = XInternAtom (x_current_display, "WM_MOVED",
3767 False);
3768 UNBLOCK_INPUT;
3769 #else /* not HAVE_X11 */
3770 XFASTINT (Vwindow_system_version) = 10;
3771 #endif /* not HAVE_X11 */
3772 return Qnil;
3775 DEFUN ("x-close-current-connection", Fx_close_current_connection,
3776 Sx_close_current_connection,
3777 0, 0, 0, "Close the connection to the current X server.")
3780 #ifdef HAVE_X11
3781 /* This is ONLY used when killing emacs; For switching displays
3782 we'll have to take care of setting CloseDownMode elsewhere. */
3784 if (x_current_display)
3786 BLOCK_INPUT;
3787 XSetCloseDownMode (x_current_display, DestroyAll);
3788 XCloseDisplay (x_current_display);
3790 else
3791 fatal ("No current X display connection to close\n");
3792 #endif
3793 return Qnil;
3796 DEFUN ("x-synchronize", Fx_synchronize, Sx_synchronize,
3797 1, 1, 0, "If ON is non-nil, report X errors as soon as the erring request is made.\n\
3798 If ON is nil, allow buffering of requests.\n\
3799 Turning on synchronization prohibits the Xlib routines from buffering\n\
3800 requests and seriously degrades performance, but makes debugging much\n\
3801 easier.")
3802 (on)
3803 Lisp_Object on;
3805 XSynchronize (x_current_display, !EQ (on, Qnil));
3807 return Qnil;
3811 syms_of_xfns ()
3813 /* This is zero if not using X windows. */
3814 x_current_display = 0;
3816 /* The section below is built by the lisp expression at the top of the file,
3817 just above where these variables are declared. */
3818 /*&&& init symbols here &&&*/
3819 Qauto_raise = intern ("auto-raise");
3820 staticpro (&Qauto_raise);
3821 Qauto_lower = intern ("auto-lower");
3822 staticpro (&Qauto_lower);
3823 Qbackground_color = intern ("background-color");
3824 staticpro (&Qbackground_color);
3825 Qbar = intern ("bar");
3826 staticpro (&Qbar);
3827 Qborder_color = intern ("border-color");
3828 staticpro (&Qborder_color);
3829 Qborder_width = intern ("border-width");
3830 staticpro (&Qborder_width);
3831 Qbox = intern ("box");
3832 staticpro (&Qbox);
3833 Qcursor_color = intern ("cursor-color");
3834 staticpro (&Qcursor_color);
3835 Qcursor_type = intern ("cursor-type");
3836 staticpro (&Qcursor_type);
3837 Qfont = intern ("font");
3838 staticpro (&Qfont);
3839 Qforeground_color = intern ("foreground-color");
3840 staticpro (&Qforeground_color);
3841 Qgeometry = intern ("geometry");
3842 staticpro (&Qgeometry);
3843 Qicon_left = intern ("icon-left");
3844 staticpro (&Qicon_left);
3845 Qicon_top = intern ("icon-top");
3846 staticpro (&Qicon_top);
3847 Qicon_type = intern ("icon-type");
3848 staticpro (&Qicon_type);
3849 Qiconic_startup = intern ("iconic-startup");
3850 staticpro (&Qiconic_startup);
3851 Qinternal_border_width = intern ("internal-border-width");
3852 staticpro (&Qinternal_border_width);
3853 Qleft = intern ("left");
3854 staticpro (&Qleft);
3855 Qmouse_color = intern ("mouse-color");
3856 staticpro (&Qmouse_color);
3857 Qnone = intern ("none");
3858 staticpro (&Qnone);
3859 Qparent_id = intern ("parent-id");
3860 staticpro (&Qparent_id);
3861 Qsuppress_icon = intern ("suppress-icon");
3862 staticpro (&Qsuppress_icon);
3863 Qsuppress_initial_map = intern ("suppress-initial-map");
3864 staticpro (&Qsuppress_initial_map);
3865 Qtop = intern ("top");
3866 staticpro (&Qtop);
3867 Qundefined_color = intern ("undefined-color");
3868 staticpro (&Qundefined_color);
3869 Qvertical_scroll_bars = intern ("vertical-scroll-bars");
3870 staticpro (&Qvertical_scroll_bars);
3871 Qwindow_id = intern ("window-id");
3872 staticpro (&Qwindow_id);
3873 Qx_frame_parameter = intern ("x-frame-parameter");
3874 staticpro (&Qx_frame_parameter);
3875 /* This is the end of symbol initialization. */
3876 Qvisibility = intern ("visibility");
3877 staticpro (&Qvisibility);
3879 Fput (Qundefined_color, Qerror_conditions,
3880 Fcons (Qundefined_color, Fcons (Qerror, Qnil)));
3881 Fput (Qundefined_color, Qerror_message,
3882 build_string ("Undefined color"));
3884 init_x_parm_symbols ();
3886 DEFVAR_INT ("mouse-buffer-offset", &mouse_buffer_offset,
3887 "The buffer offset of the character under the pointer.");
3888 mouse_buffer_offset = 0;
3890 DEFVAR_INT ("x-pointer-shape", &Vx_pointer_shape,
3891 "The shape of the pointer when over text.");
3892 Vx_pointer_shape = Qnil;
3894 DEFVAR_INT ("x-nontext-pointer-shape", &Vx_nontext_pointer_shape,
3895 "The shape of the pointer when not over text.");
3896 Vx_nontext_pointer_shape = Qnil;
3898 DEFVAR_INT ("x-mode-pointer-shape", &Vx_mode_pointer_shape,
3899 "The shape of the pointer when over the mode line.");
3900 Vx_mode_pointer_shape = Qnil;
3902 DEFVAR_LISP ("x-cursor-fore-pixel", &Vx_cursor_fore_pixel,
3903 "A string indicating the foreground color of the cursor box.");
3904 Vx_cursor_fore_pixel = Qnil;
3906 DEFVAR_LISP ("mouse-grabbed", &Vmouse_depressed,
3907 "Non-nil if a mouse button is currently depressed.");
3908 Vmouse_depressed = Qnil;
3910 DEFVAR_INT ("x-screen-count", &x_screen_count,
3911 "The number of screens associated with the current display.");
3912 DEFVAR_INT ("x-release", &x_release,
3913 "The release number of the X server in use.");
3914 DEFVAR_LISP ("x-vendor", &Vx_vendor,
3915 "The vendor supporting the X server in use.");
3916 DEFVAR_INT ("x-screen-height", &x_screen_height,
3917 "The height of this X screen in pixels.");
3918 DEFVAR_INT ("x-screen-height-mm", &x_screen_height_mm,
3919 "The height of this X screen in millimeters.");
3920 DEFVAR_INT ("x-screen-width", &x_screen_width,
3921 "The width of this X screen in pixels.");
3922 DEFVAR_INT ("x-screen-width-mm", &x_screen_width_mm,
3923 "The width of this X screen in millimeters.");
3924 DEFVAR_LISP ("x-backing-store", &Vx_backing_store,
3925 "The backing store capability of this screen.\n\
3926 Values can be the symbols Always, WhenMapped, or NotUseful.");
3927 DEFVAR_BOOL ("x-save-under", &x_save_under,
3928 "*Non-nil means this X screen supports the SaveUnder feature.");
3929 DEFVAR_INT ("x-screen-planes", &x_screen_planes,
3930 "The number of planes this monitor supports.");
3931 DEFVAR_LISP ("x-screen-visual", &Vx_screen_visual,
3932 "The default X visual for this X screen.");
3933 DEFVAR_LISP ("x-no-window-manager", &Vx_no_window_manager,
3934 "t if no X window manager is in use.");
3936 #ifdef HAVE_X11
3937 defsubr (&Sx_get_resource);
3938 #if 0
3939 defsubr (&Sx_draw_rectangle);
3940 defsubr (&Sx_erase_rectangle);
3941 defsubr (&Sx_contour_region);
3942 defsubr (&Sx_uncontour_region);
3943 #endif
3944 defsubr (&Sx_color_display_p);
3945 defsubr (&Sx_defined_color);
3946 #if 0
3947 defsubr (&Sx_track_pointer);
3948 defsubr (&Sx_grab_pointer);
3949 defsubr (&Sx_ungrab_pointer);
3950 #endif
3951 #else
3952 defsubr (&Sx_get_default);
3953 defsubr (&Sx_store_cut_buffer);
3954 defsubr (&Sx_get_cut_buffer);
3955 defsubr (&Sx_set_face);
3956 #endif
3957 defsubr (&Sx_geometry);
3958 defsubr (&Sx_create_frame);
3959 defsubr (&Sfocus_frame);
3960 defsubr (&Sunfocus_frame);
3961 #if 0
3962 defsubr (&Sx_horizontal_line);
3963 #endif
3964 defsubr (&Sx_rebind_key);
3965 defsubr (&Sx_rebind_keys);
3966 defsubr (&Sx_open_connection);
3967 defsubr (&Sx_close_current_connection);
3968 defsubr (&Sx_synchronize);
3970 /* This was used in the old event interface which used a separate
3971 event queue.*/
3972 #if 0
3973 defsubr (&Sx_mouse_events);
3974 defsubr (&Sx_get_mouse_event);
3975 #endif
3978 #endif /* HAVE_X_WINDOWS */