(x_window_to_frame): Use XGCTYPE.
[bpt/emacs.git] / src / xfns.c
1 /* Functions for the X window system.
2 Copyright (C) 1989, 1992, 1993 Free Software Foundation.
3
4 This file is part of GNU Emacs.
5
6 GNU Emacs is free software; you can redistribute it and/or modify
7 it under the terms of the GNU General Public License as published by
8 the Free Software Foundation; either version 2, or (at your option)
9 any later version.
10
11 GNU Emacs is distributed in the hope that it will be useful,
12 but WITHOUT ANY WARRANTY; without even the implied warranty of
13 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14 GNU General Public License for more details.
15
16 You should have received a copy of the GNU General Public License
17 along with GNU Emacs; see the file COPYING. If not, write to
18 the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. */
19
20 /* Completely rewritten by Richard Stallman. */
21
22 /* Rewritten for X11 by Joseph Arceneaux */
23
24 #if 0
25 #include <stdio.h>
26 #endif
27 #include <signal.h>
28 #include "config.h"
29 #include "lisp.h"
30 #include "xterm.h"
31 #include "frame.h"
32 #include "window.h"
33 #include "buffer.h"
34 #include "dispextern.h"
35 #include "keyboard.h"
36 #include "blockinput.h"
37
38 #ifdef HAVE_X_WINDOWS
39 extern void abort ();
40
41 #ifndef VMS
42 #include <X11/bitmaps/gray>
43 #else
44 #include "[.bitmaps]gray.xbm"
45 #endif
46
47 #define min(a,b) ((a) < (b) ? (a) : (b))
48 #define max(a,b) ((a) > (b) ? (a) : (b))
49
50 #ifdef HAVE_X11
51 /* X Resource data base */
52 static XrmDatabase xrdb;
53
54 /* The class of this X application. */
55 #define EMACS_CLASS "Emacs"
56
57 /* Title name and application name for X stuff. */
58 extern char *x_id_name;
59
60 /* The background and shape of the mouse pointer, and shape when not
61 over text or in the modeline. */
62 Lisp_Object Vx_pointer_shape, Vx_nontext_pointer_shape, Vx_mode_pointer_shape;
63
64 /* Color of chars displayed in cursor box. */
65 Lisp_Object Vx_cursor_fore_pixel;
66
67 /* The screen being used. */
68 static Screen *x_screen;
69
70 /* The X Visual we are using for X windows (the default) */
71 Visual *screen_visual;
72
73 /* Height of this X screen in pixels. */
74 int x_screen_height;
75
76 /* Width of this X screen in pixels. */
77 int x_screen_width;
78
79 /* Number of planes for this screen. */
80 int x_screen_planes;
81
82 /* Non nil if no window manager is in use. */
83 Lisp_Object Vx_no_window_manager;
84
85 /* `t' if a mouse button is depressed. */
86
87 Lisp_Object Vmouse_depressed;
88
89 extern unsigned int x_mouse_x, x_mouse_y, x_mouse_grabbed;
90
91 /* Atom for indicating window state to the window manager. */
92 extern Atom Xatom_wm_change_state;
93
94 /* Communication with window managers. */
95 extern Atom Xatom_wm_protocols;
96
97 /* Kinds of protocol things we may receive. */
98 extern Atom Xatom_wm_take_focus;
99 extern Atom Xatom_wm_save_yourself;
100 extern Atom Xatom_wm_delete_window;
101
102 /* Other WM communication */
103 extern Atom Xatom_wm_configure_denied; /* When our config request is denied */
104 extern Atom Xatom_wm_window_moved; /* When the WM moves us. */
105
106 #else /* X10 */
107
108 /* Default size of an Emacs window. */
109 static char *default_window = "=80x24+0+0";
110
111 #define MAXICID 80
112 char iconidentity[MAXICID];
113 #define ICONTAG "emacs@"
114 char minibuffer_iconidentity[MAXICID];
115 #define MINIBUFFER_ICONTAG "minibuffer@"
116
117 #endif /* X10 */
118
119 /* The last 23 bits of the timestamp of the last mouse button event. */
120 Time mouse_timestamp;
121
122 /* Evaluate this expression to rebuild the section of syms_of_xfns
123 that initializes and staticpros the symbols declared below. Note
124 that Emacs 18 has a bug that keeps C-x C-e from being able to
125 evaluate this expression.
126
127 (progn
128 ;; Accumulate a list of the symbols we want to initialize from the
129 ;; declarations at the top of the file.
130 (goto-char (point-min))
131 (search-forward "/\*&&& symbols declared here &&&*\/\n")
132 (let (symbol-list)
133 (while (looking-at "Lisp_Object \\(Q[a-z_]+\\)")
134 (setq symbol-list
135 (cons (buffer-substring (match-beginning 1) (match-end 1))
136 symbol-list))
137 (forward-line 1))
138 (setq symbol-list (nreverse symbol-list))
139 ;; Delete the section of syms_of_... where we initialize the symbols.
140 (search-forward "\n /\*&&& init symbols here &&&*\/\n")
141 (let ((start (point)))
142 (while (looking-at "^ Q")
143 (forward-line 2))
144 (kill-region start (point)))
145 ;; Write a new symbol initialization section.
146 (while symbol-list
147 (insert (format " %s = intern (\"" (car symbol-list)))
148 (let ((start (point)))
149 (insert (substring (car symbol-list) 1))
150 (subst-char-in-region start (point) ?_ ?-))
151 (insert (format "\");\n staticpro (&%s);\n" (car symbol-list)))
152 (setq symbol-list (cdr symbol-list)))))
153
154 */
155
156 /*&&& symbols declared here &&&*/
157 Lisp_Object Qauto_raise;
158 Lisp_Object Qauto_lower;
159 Lisp_Object Qbackground_color;
160 Lisp_Object Qbar;
161 Lisp_Object Qborder_color;
162 Lisp_Object Qborder_width;
163 Lisp_Object Qbox;
164 Lisp_Object Qcursor_color;
165 Lisp_Object Qcursor_type;
166 Lisp_Object Qfont;
167 Lisp_Object Qforeground_color;
168 Lisp_Object Qgeometry;
169 Lisp_Object Qicon;
170 Lisp_Object Qicon_left;
171 Lisp_Object Qicon_top;
172 Lisp_Object Qicon_type;
173 Lisp_Object Qinternal_border_width;
174 Lisp_Object Qleft;
175 Lisp_Object Qmouse_color;
176 Lisp_Object Qnone;
177 Lisp_Object Qparent_id;
178 Lisp_Object Qsuppress_icon;
179 Lisp_Object Qtop;
180 Lisp_Object Qundefined_color;
181 Lisp_Object Qvertical_scroll_bars;
182 Lisp_Object Qvisibility;
183 Lisp_Object Qwindow_id;
184 Lisp_Object Qx_frame_parameter;
185
186 /* The below are defined in frame.c. */
187 extern Lisp_Object Qheight, Qminibuffer, Qname, Qonly, Qwidth;
188 extern Lisp_Object Qunsplittable, Qmenu_bar_lines, Qicon;
189
190 extern Lisp_Object Vwindow_system_version;
191
192 /* Mouse map for clicks in windows. */
193 extern Lisp_Object Vglobal_mouse_map;
194
195 /* Points to table of defined typefaces. */
196 struct face *x_face_table[MAX_FACES_AND_GLYPHS];
197 \f
198 /* Return the Emacs frame-object corresponding to an X window.
199 It could be the frame's main window or an icon window. */
200
201 /* This function can be called during GC, so use XGCTYPE. */
202
203 struct frame *
204 x_window_to_frame (wdesc)
205 int wdesc;
206 {
207 Lisp_Object tail, frame;
208 struct frame *f;
209
210 for (tail = Vframe_list; XGCTYPE (tail) == Lisp_Cons;
211 tail = XCONS (tail)->cdr)
212 {
213 frame = XCONS (tail)->car;
214 if (XGCTYPE (frame) != Lisp_Frame)
215 continue;
216 f = XFRAME (frame);
217 if (FRAME_X_WINDOW (f) == wdesc
218 || f->display.x->icon_desc == wdesc)
219 return f;
220 }
221 return 0;
222 }
223
224 \f
225 /* Connect the frame-parameter names for X frames
226 to the ways of passing the parameter values to the window system.
227
228 The name of a parameter, as a Lisp symbol,
229 has an `x-frame-parameter' property which is an integer in Lisp
230 but can be interpreted as an `enum x_frame_parm' in C. */
231
232 enum x_frame_parm
233 {
234 X_PARM_FOREGROUND_COLOR,
235 X_PARM_BACKGROUND_COLOR,
236 X_PARM_MOUSE_COLOR,
237 X_PARM_CURSOR_COLOR,
238 X_PARM_BORDER_COLOR,
239 X_PARM_ICON_TYPE,
240 X_PARM_FONT,
241 X_PARM_BORDER_WIDTH,
242 X_PARM_INTERNAL_BORDER_WIDTH,
243 X_PARM_NAME,
244 X_PARM_AUTORAISE,
245 X_PARM_AUTOLOWER,
246 X_PARM_VERT_SCROLL_BAR,
247 X_PARM_VISIBILITY,
248 X_PARM_MENU_BAR_LINES
249 };
250
251
252 struct x_frame_parm_table
253 {
254 char *name;
255 void (*setter)( /* struct frame *frame, Lisp_Object val, oldval */ );
256 };
257
258 void x_set_foreground_color ();
259 void x_set_background_color ();
260 void x_set_mouse_color ();
261 void x_set_cursor_color ();
262 void x_set_border_color ();
263 void x_set_cursor_type ();
264 void x_set_icon_type ();
265 void x_set_font ();
266 void x_set_border_width ();
267 void x_set_internal_border_width ();
268 void x_explicitly_set_name ();
269 void x_set_autoraise ();
270 void x_set_autolower ();
271 void x_set_vertical_scroll_bars ();
272 void x_set_visibility ();
273 void x_set_menu_bar_lines ();
274
275 static struct x_frame_parm_table x_frame_parms[] =
276 {
277 "foreground-color", x_set_foreground_color,
278 "background-color", x_set_background_color,
279 "mouse-color", x_set_mouse_color,
280 "cursor-color", x_set_cursor_color,
281 "border-color", x_set_border_color,
282 "cursor-type", x_set_cursor_type,
283 "icon-type", x_set_icon_type,
284 "font", x_set_font,
285 "border-width", x_set_border_width,
286 "internal-border-width", x_set_internal_border_width,
287 "name", x_explicitly_set_name,
288 "auto-raise", x_set_autoraise,
289 "auto-lower", x_set_autolower,
290 "vertical-scroll-bars", x_set_vertical_scroll_bars,
291 "visibility", x_set_visibility,
292 "menu-bar-lines", x_set_menu_bar_lines,
293 };
294
295 /* Attach the `x-frame-parameter' properties to
296 the Lisp symbol names of parameters relevant to X. */
297
298 init_x_parm_symbols ()
299 {
300 int i;
301
302 for (i = 0; i < sizeof (x_frame_parms) / sizeof (x_frame_parms[0]); i++)
303 Fput (intern (x_frame_parms[i].name), Qx_frame_parameter,
304 make_number (i));
305 }
306 \f
307 /* Change the parameters of FRAME as specified by ALIST.
308 If a parameter is not specially recognized, do nothing;
309 otherwise call the `x_set_...' function for that parameter. */
310
311 void
312 x_set_frame_parameters (f, alist)
313 FRAME_PTR f;
314 Lisp_Object alist;
315 {
316 Lisp_Object tail;
317
318 /* If both of these parameters are present, it's more efficient to
319 set them both at once. So we wait until we've looked at the
320 entire list before we set them. */
321 Lisp_Object width, height;
322
323 /* Same here. */
324 Lisp_Object left, top;
325
326 XSET (width, Lisp_Int, FRAME_WIDTH (f));
327 XSET (height, Lisp_Int, FRAME_HEIGHT (f));
328
329 XSET (top, Lisp_Int, f->display.x->top_pos);
330 XSET (left, Lisp_Int, f->display.x->left_pos);
331
332 for (tail = alist; CONSP (tail); tail = Fcdr (tail))
333 {
334 Lisp_Object elt, prop, val;
335
336 elt = Fcar (tail);
337 prop = Fcar (elt);
338 val = Fcdr (elt);
339
340 if (EQ (prop, Qwidth))
341 width = val;
342 else if (EQ (prop, Qheight))
343 height = val;
344 else if (EQ (prop, Qtop))
345 top = val;
346 else if (EQ (prop, Qleft))
347 left = val;
348 else
349 {
350 register Lisp_Object tem;
351 tem = Fget (prop, Qx_frame_parameter);
352 if (XTYPE (tem) == Lisp_Int
353 && XINT (tem) >= 0
354 && XINT (tem) < sizeof (x_frame_parms)/sizeof (x_frame_parms[0]))
355 (*x_frame_parms[XINT (tem)].setter)(f, val,
356 get_frame_param (f, prop));
357 store_frame_param (f, prop, val);
358 }
359 }
360
361 /* Don't call these unless they've changed; the window may not actually
362 exist yet. */
363 {
364 Lisp_Object frame;
365
366 XSET (frame, Lisp_Frame, f);
367 if (XINT (width) != FRAME_WIDTH (f)
368 || XINT (height) != FRAME_HEIGHT (f))
369 Fset_frame_size (frame, width, height);
370 if (XINT (left) != f->display.x->left_pos
371 || XINT (top) != f->display.x->top_pos)
372 Fset_frame_position (frame, left, top);
373 }
374 }
375
376 /* Insert a description of internally-recorded parameters of frame X
377 into the parameter alist *ALISTPTR that is to be given to the user.
378 Only parameters that are specific to the X window system
379 and whose values are not correctly recorded in the frame's
380 param_alist need to be considered here. */
381
382 x_report_frame_params (f, alistptr)
383 struct frame *f;
384 Lisp_Object *alistptr;
385 {
386 char buf[16];
387
388 store_in_alist (alistptr, Qleft, make_number (f->display.x->left_pos));
389 store_in_alist (alistptr, Qtop, make_number (f->display.x->top_pos));
390 store_in_alist (alistptr, Qborder_width,
391 make_number (f->display.x->border_width));
392 store_in_alist (alistptr, Qinternal_border_width,
393 make_number (f->display.x->internal_border_width));
394 sprintf (buf, "%d", FRAME_X_WINDOW (f));
395 store_in_alist (alistptr, Qwindow_id,
396 build_string (buf));
397 store_in_alist (alistptr, Qvisibility,
398 (FRAME_VISIBLE_P (f) ? Qt
399 : FRAME_ICONIFIED_P (f) ? Qicon : Qnil));
400 }
401 \f
402 /* Decide if color named COLOR is valid for the display
403 associated with the selected frame. */
404 int
405 defined_color (color, color_def)
406 char *color;
407 Color *color_def;
408 {
409 register int foo;
410 Colormap screen_colormap;
411
412 BLOCK_INPUT;
413 #ifdef HAVE_X11
414 screen_colormap
415 = DefaultColormap (x_current_display, XDefaultScreen (x_current_display));
416
417 foo = XParseColor (x_current_display, screen_colormap,
418 color, color_def)
419 && XAllocColor (x_current_display, screen_colormap, color_def);
420 #else
421 foo = XParseColor (color, color_def) && XGetHardwareColor (color_def);
422 #endif /* not HAVE_X11 */
423 UNBLOCK_INPUT;
424
425 if (foo)
426 return 1;
427 else
428 return 0;
429 }
430
431 /* Given a string ARG naming a color, compute a pixel value from it
432 suitable for screen F.
433 If F is not a color screen, return DEF (default) regardless of what
434 ARG says. */
435
436 int
437 x_decode_color (arg, def)
438 Lisp_Object arg;
439 int def;
440 {
441 Color cdef;
442
443 CHECK_STRING (arg, 0);
444
445 if (strcmp (XSTRING (arg)->data, "black") == 0)
446 return BLACK_PIX_DEFAULT;
447 else if (strcmp (XSTRING (arg)->data, "white") == 0)
448 return WHITE_PIX_DEFAULT;
449
450 #ifdef HAVE_X11
451 if (x_screen_planes == 1)
452 return def;
453 #else
454 if (DISPLAY_CELLS == 1)
455 return def;
456 #endif
457
458 if (defined_color (XSTRING (arg)->data, &cdef))
459 return cdef.pixel;
460 else
461 Fsignal (Qundefined_color, Fcons (arg, Qnil));
462 }
463 \f
464 /* Functions called only from `x_set_frame_param'
465 to set individual parameters.
466
467 If FRAME_X_WINDOW (f) is 0,
468 the frame is being created and its X-window does not exist yet.
469 In that case, just record the parameter's new value
470 in the standard place; do not attempt to change the window. */
471
472 void
473 x_set_foreground_color (f, arg, oldval)
474 struct frame *f;
475 Lisp_Object arg, oldval;
476 {
477 f->display.x->foreground_pixel = x_decode_color (arg, BLACK_PIX_DEFAULT);
478 if (FRAME_X_WINDOW (f) != 0)
479 {
480 #ifdef HAVE_X11
481 BLOCK_INPUT;
482 XSetForeground (x_current_display, f->display.x->normal_gc,
483 f->display.x->foreground_pixel);
484 XSetBackground (x_current_display, f->display.x->reverse_gc,
485 f->display.x->foreground_pixel);
486 UNBLOCK_INPUT;
487 #endif /* HAVE_X11 */
488 if (FRAME_VISIBLE_P (f))
489 redraw_frame (f);
490 }
491 }
492
493 void
494 x_set_background_color (f, arg, oldval)
495 struct frame *f;
496 Lisp_Object arg, oldval;
497 {
498 Pixmap temp;
499 int mask;
500
501 f->display.x->background_pixel = x_decode_color (arg, WHITE_PIX_DEFAULT);
502
503 if (FRAME_X_WINDOW (f) != 0)
504 {
505 BLOCK_INPUT;
506 #ifdef HAVE_X11
507 /* The main frame area. */
508 XSetBackground (x_current_display, f->display.x->normal_gc,
509 f->display.x->background_pixel);
510 XSetForeground (x_current_display, f->display.x->reverse_gc,
511 f->display.x->background_pixel);
512 XSetWindowBackground (x_current_display, FRAME_X_WINDOW (f),
513 f->display.x->background_pixel);
514
515 #else
516 temp = XMakeTile (f->display.x->background_pixel);
517 XChangeBackground (FRAME_X_WINDOW (f), temp);
518 XFreePixmap (temp);
519 #endif /* not HAVE_X11 */
520 UNBLOCK_INPUT;
521
522 if (FRAME_VISIBLE_P (f))
523 redraw_frame (f);
524 }
525 }
526
527 void
528 x_set_mouse_color (f, arg, oldval)
529 struct frame *f;
530 Lisp_Object arg, oldval;
531 {
532 Cursor cursor, nontext_cursor, mode_cursor;
533 int mask_color;
534
535 if (!EQ (Qnil, arg))
536 f->display.x->mouse_pixel = x_decode_color (arg, BLACK_PIX_DEFAULT);
537 mask_color = f->display.x->background_pixel;
538 /* No invisible pointers. */
539 if (mask_color == f->display.x->mouse_pixel
540 && mask_color == f->display.x->background_pixel)
541 f->display.x->mouse_pixel = f->display.x->foreground_pixel;
542
543 BLOCK_INPUT;
544 #ifdef HAVE_X11
545
546 /* It's not okay to crash if the user selects a screwey cursor. */
547 x_catch_errors ();
548
549 if (!EQ (Qnil, Vx_pointer_shape))
550 {
551 CHECK_NUMBER (Vx_pointer_shape, 0);
552 cursor = XCreateFontCursor (x_current_display, XINT (Vx_pointer_shape));
553 }
554 else
555 cursor = XCreateFontCursor (x_current_display, XC_xterm);
556 x_check_errors ("bad text pointer cursor: %s");
557
558 if (!EQ (Qnil, Vx_nontext_pointer_shape))
559 {
560 CHECK_NUMBER (Vx_nontext_pointer_shape, 0);
561 nontext_cursor = XCreateFontCursor (x_current_display,
562 XINT (Vx_nontext_pointer_shape));
563 }
564 else
565 nontext_cursor = XCreateFontCursor (x_current_display, XC_left_ptr);
566 x_check_errors ("bad nontext pointer cursor: %s");
567
568 if (!EQ (Qnil, Vx_mode_pointer_shape))
569 {
570 CHECK_NUMBER (Vx_mode_pointer_shape, 0);
571 mode_cursor = XCreateFontCursor (x_current_display,
572 XINT (Vx_mode_pointer_shape));
573 }
574 else
575 mode_cursor = XCreateFontCursor (x_current_display, XC_xterm);
576
577 /* Check and report errors with the above calls. */
578 x_check_errors ("can't set cursor shape: %s");
579 x_uncatch_errors ();
580
581 {
582 XColor fore_color, back_color;
583
584 fore_color.pixel = f->display.x->mouse_pixel;
585 back_color.pixel = mask_color;
586 XQueryColor (x_current_display,
587 DefaultColormap (x_current_display,
588 DefaultScreen (x_current_display)),
589 &fore_color);
590 XQueryColor (x_current_display,
591 DefaultColormap (x_current_display,
592 DefaultScreen (x_current_display)),
593 &back_color);
594 XRecolorCursor (x_current_display, cursor,
595 &fore_color, &back_color);
596 XRecolorCursor (x_current_display, nontext_cursor,
597 &fore_color, &back_color);
598 XRecolorCursor (x_current_display, mode_cursor,
599 &fore_color, &back_color);
600 }
601 #else /* X10 */
602 cursor = XCreateCursor (16, 16, MouseCursor, MouseMask,
603 0, 0,
604 f->display.x->mouse_pixel,
605 f->display.x->background_pixel,
606 GXcopy);
607 #endif /* X10 */
608
609 if (FRAME_X_WINDOW (f) != 0)
610 {
611 XDefineCursor (XDISPLAY FRAME_X_WINDOW (f), cursor);
612 }
613
614 if (cursor != f->display.x->text_cursor && f->display.x->text_cursor != 0)
615 XFreeCursor (XDISPLAY f->display.x->text_cursor);
616 f->display.x->text_cursor = cursor;
617 #ifdef HAVE_X11
618 if (nontext_cursor != f->display.x->nontext_cursor
619 && f->display.x->nontext_cursor != 0)
620 XFreeCursor (XDISPLAY f->display.x->nontext_cursor);
621 f->display.x->nontext_cursor = nontext_cursor;
622
623 if (mode_cursor != f->display.x->modeline_cursor
624 && f->display.x->modeline_cursor != 0)
625 XFreeCursor (XDISPLAY f->display.x->modeline_cursor);
626 f->display.x->modeline_cursor = mode_cursor;
627 #endif /* HAVE_X11 */
628
629 XFlushQueue ();
630 UNBLOCK_INPUT;
631 }
632
633 void
634 x_set_cursor_color (f, arg, oldval)
635 struct frame *f;
636 Lisp_Object arg, oldval;
637 {
638 unsigned long fore_pixel;
639
640 if (!EQ (Vx_cursor_fore_pixel, Qnil))
641 fore_pixel = x_decode_color (Vx_cursor_fore_pixel, WHITE_PIX_DEFAULT);
642 else
643 fore_pixel = f->display.x->background_pixel;
644 f->display.x->cursor_pixel = x_decode_color (arg, BLACK_PIX_DEFAULT);
645
646 /* Make sure that the cursor color differs from the background color. */
647 if (f->display.x->cursor_pixel == f->display.x->background_pixel)
648 {
649 f->display.x->cursor_pixel == f->display.x->mouse_pixel;
650 if (f->display.x->cursor_pixel == fore_pixel)
651 fore_pixel = f->display.x->background_pixel;
652 }
653 f->display.x->cursor_foreground_pixel = fore_pixel;
654
655 if (FRAME_X_WINDOW (f) != 0)
656 {
657 #ifdef HAVE_X11
658 BLOCK_INPUT;
659 XSetBackground (x_current_display, f->display.x->cursor_gc,
660 f->display.x->cursor_pixel);
661 XSetForeground (x_current_display, f->display.x->cursor_gc,
662 fore_pixel);
663 UNBLOCK_INPUT;
664 #endif /* HAVE_X11 */
665
666 if (FRAME_VISIBLE_P (f))
667 {
668 x_display_cursor (f, 0);
669 x_display_cursor (f, 1);
670 }
671 }
672 }
673
674 /* Set the border-color of frame F to value described by ARG.
675 ARG can be a string naming a color.
676 The border-color is used for the border that is drawn by the X server.
677 Note that this does not fully take effect if done before
678 F has an x-window; it must be redone when the window is created.
679
680 Note: this is done in two routines because of the way X10 works.
681
682 Note: under X11, this is normally the province of the window manager,
683 and so emacs' border colors may be overridden. */
684
685 void
686 x_set_border_color (f, arg, oldval)
687 struct frame *f;
688 Lisp_Object arg, oldval;
689 {
690 unsigned char *str;
691 int pix;
692
693 CHECK_STRING (arg, 0);
694 str = XSTRING (arg)->data;
695
696 #ifndef HAVE_X11
697 if (!strcmp (str, "grey") || !strcmp (str, "Grey")
698 || !strcmp (str, "gray") || !strcmp (str, "Gray"))
699 pix = -1;
700 else
701 #endif /* X10 */
702
703 pix = x_decode_color (arg, BLACK_PIX_DEFAULT);
704
705 x_set_border_pixel (f, pix);
706 }
707
708 /* Set the border-color of frame F to pixel value PIX.
709 Note that this does not fully take effect if done before
710 F has an x-window. */
711
712 x_set_border_pixel (f, pix)
713 struct frame *f;
714 int pix;
715 {
716 f->display.x->border_pixel = pix;
717
718 if (FRAME_X_WINDOW (f) != 0 && f->display.x->border_width > 0)
719 {
720 Pixmap temp;
721 int mask;
722
723 BLOCK_INPUT;
724 #ifdef HAVE_X11
725 XSetWindowBorder (x_current_display, FRAME_X_WINDOW (f),
726 pix);
727 #else
728 if (pix < 0)
729 temp = XMakePixmap ((Bitmap) XStoreBitmap (gray_width, gray_height,
730 gray_bits),
731 BLACK_PIX_DEFAULT, WHITE_PIX_DEFAULT);
732 else
733 temp = XMakeTile (pix);
734 XChangeBorder (FRAME_X_WINDOW (f), temp);
735 XFreePixmap (XDISPLAY temp);
736 #endif /* not HAVE_X11 */
737 UNBLOCK_INPUT;
738
739 if (FRAME_VISIBLE_P (f))
740 redraw_frame (f);
741 }
742 }
743
744 void
745 x_set_cursor_type (f, arg, oldval)
746 FRAME_PTR f;
747 Lisp_Object arg, oldval;
748 {
749 if (EQ (arg, Qbar))
750 FRAME_DESIRED_CURSOR (f) = bar_cursor;
751 else if (EQ (arg, Qbox))
752 FRAME_DESIRED_CURSOR (f) = filled_box_cursor;
753 else
754 error
755 ("the `cursor-type' frame parameter should be either `bar' or `box'");
756
757 /* Make sure the cursor gets redrawn. This is overkill, but how
758 often do people change cursor types? */
759 update_mode_lines++;
760 }
761
762 void
763 x_set_icon_type (f, arg, oldval)
764 struct frame *f;
765 Lisp_Object arg, oldval;
766 {
767 Lisp_Object tem;
768 int result;
769
770 if (EQ (oldval, Qnil) == EQ (arg, Qnil))
771 return;
772
773 BLOCK_INPUT;
774 if (NILP (arg))
775 result = x_text_icon (f, 0);
776 else
777 result = x_bitmap_icon (f);
778
779 if (result)
780 {
781 UNBLOCK_INPUT;
782 error ("No icon window available.");
783 }
784
785 /* If the window was unmapped (and its icon was mapped),
786 the new icon is not mapped, so map the window in its stead. */
787 if (FRAME_VISIBLE_P (f))
788 XMapWindow (XDISPLAY FRAME_X_WINDOW (f));
789
790 XFlushQueue ();
791 UNBLOCK_INPUT;
792 }
793
794 void
795 x_set_font (f, arg, oldval)
796 struct frame *f;
797 Lisp_Object arg, oldval;
798 {
799 unsigned char *name;
800 int result;
801
802 CHECK_STRING (arg, 1);
803 name = XSTRING (arg)->data;
804
805 BLOCK_INPUT;
806 result = x_new_font (f, name);
807 UNBLOCK_INPUT;
808
809 if (result)
810 error ("Font \"%s\" is not defined", name);
811 }
812
813 void
814 x_set_border_width (f, arg, oldval)
815 struct frame *f;
816 Lisp_Object arg, oldval;
817 {
818 CHECK_NUMBER (arg, 0);
819
820 if (XINT (arg) == f->display.x->border_width)
821 return;
822
823 if (FRAME_X_WINDOW (f) != 0)
824 error ("Cannot change the border width of a window");
825
826 f->display.x->border_width = XINT (arg);
827 }
828
829 void
830 x_set_internal_border_width (f, arg, oldval)
831 struct frame *f;
832 Lisp_Object arg, oldval;
833 {
834 int mask;
835 int old = f->display.x->internal_border_width;
836
837 CHECK_NUMBER (arg, 0);
838 f->display.x->internal_border_width = XINT (arg);
839 if (f->display.x->internal_border_width < 0)
840 f->display.x->internal_border_width = 0;
841
842 if (f->display.x->internal_border_width == old)
843 return;
844
845 if (FRAME_X_WINDOW (f) != 0)
846 {
847 BLOCK_INPUT;
848 x_set_window_size (f, f->width, f->height);
849 #if 0
850 x_set_resize_hint (f);
851 #endif
852 XFlushQueue ();
853 UNBLOCK_INPUT;
854 SET_FRAME_GARBAGED (f);
855 }
856 }
857
858 void
859 x_set_visibility (f, value, oldval)
860 struct frame *f;
861 Lisp_Object value, oldval;
862 {
863 Lisp_Object frame;
864 XSET (frame, Lisp_Frame, f);
865
866 if (NILP (value))
867 Fmake_frame_invisible (frame);
868 else if (EQ (value, Qicon))
869 Ficonify_frame (frame);
870 else
871 Fmake_frame_visible (frame);
872 }
873
874 static void
875 x_set_menu_bar_lines_1 (window, n)
876 Lisp_Object window;
877 int n;
878 {
879 for (; !NILP (window); window = XWINDOW (window)->next)
880 {
881 struct window *w = XWINDOW (window);
882
883 w->top += n;
884
885 if (!NILP (w->vchild))
886 x_set_menu_bar_lines_1 (w->vchild);
887
888 if (!NILP (w->hchild))
889 x_set_menu_bar_lines_1 (w->hchild);
890 }
891 }
892
893 void
894 x_set_menu_bar_lines (f, value, oldval)
895 struct frame *f;
896 Lisp_Object value, oldval;
897 {
898 int nlines;
899 int olines = FRAME_MENU_BAR_LINES (f);
900
901 /* Right now, menu bars don't work properly in minibuf-only frames;
902 most of the commands try to apply themselves to the minibuffer
903 frame itslef, and get an error because you can't switch buffers
904 in or split the minibuffer window. */
905 if (FRAME_MINIBUF_ONLY_P (f))
906 return;
907
908 if (XTYPE (value) == Lisp_Int)
909 nlines = XINT (value);
910 else
911 nlines = 0;
912
913 FRAME_MENU_BAR_LINES (f) = nlines;
914 x_set_menu_bar_lines_1 (f->root_window, nlines - olines);
915 x_set_window_size (f, FRAME_WIDTH (f),
916 FRAME_HEIGHT (f) + nlines - olines);
917 }
918
919 /* Change the name of frame F to ARG. If ARG is nil, set F's name to
920 x_id_name.
921
922 If EXPLICIT is non-zero, that indicates that lisp code is setting the
923 name; if ARG is a string, set F's name to ARG and set
924 F->explicit_name; if ARG is Qnil, then clear F->explicit_name.
925
926 If EXPLICIT is zero, that indicates that Emacs redisplay code is
927 suggesting a new name, which lisp code should override; if
928 F->explicit_name is set, ignore the new name; otherwise, set it. */
929
930 void
931 x_set_name (f, name, explicit)
932 struct frame *f;
933 Lisp_Object name;
934 int explicit;
935 {
936 /* Make sure that requests from lisp code override requests from
937 Emacs redisplay code. */
938 if (explicit)
939 {
940 /* If we're switching from explicit to implicit, we had better
941 update the mode lines and thereby update the title. */
942 if (f->explicit_name && NILP (name))
943 update_mode_lines = 1;
944
945 f->explicit_name = ! NILP (name);
946 }
947 else if (f->explicit_name)
948 return;
949
950 /* If NAME is nil, set the name to the x_id_name. */
951 if (NILP (name))
952 name = build_string (x_id_name);
953 else
954 CHECK_STRING (name, 0);
955
956 /* Don't change the name if it's already NAME. */
957 if (! NILP (Fstring_equal (name, f->name)))
958 return;
959
960 if (FRAME_X_WINDOW (f))
961 {
962 BLOCK_INPUT;
963
964 #ifdef HAVE_X11R4
965 {
966 XTextProperty text;
967 text.value = XSTRING (name)->data;
968 text.encoding = XA_STRING;
969 text.format = 8;
970 text.nitems = XSTRING (name)->size;
971 XSetWMName (x_current_display, FRAME_X_WINDOW (f), &text);
972 XSetWMIconName (x_current_display, FRAME_X_WINDOW (f), &text);
973 }
974 #else
975 XSetIconName (XDISPLAY FRAME_X_WINDOW (f),
976 XSTRING (name)->data);
977 XStoreName (XDISPLAY FRAME_X_WINDOW (f),
978 XSTRING (name)->data);
979 #endif
980
981 UNBLOCK_INPUT;
982 }
983
984 f->name = name;
985 }
986
987 /* This function should be called when the user's lisp code has
988 specified a name for the frame; the name will override any set by the
989 redisplay code. */
990 void
991 x_explicitly_set_name (f, arg, oldval)
992 FRAME_PTR f;
993 Lisp_Object arg, oldval;
994 {
995 x_set_name (f, arg, 1);
996 }
997
998 /* This function should be called by Emacs redisplay code to set the
999 name; names set this way will never override names set by the user's
1000 lisp code. */
1001 void
1002 x_implicitly_set_name (f, arg, oldval)
1003 FRAME_PTR f;
1004 Lisp_Object arg, oldval;
1005 {
1006 x_set_name (f, arg, 0);
1007 }
1008
1009 void
1010 x_set_autoraise (f, arg, oldval)
1011 struct frame *f;
1012 Lisp_Object arg, oldval;
1013 {
1014 f->auto_raise = !EQ (Qnil, arg);
1015 }
1016
1017 void
1018 x_set_autolower (f, arg, oldval)
1019 struct frame *f;
1020 Lisp_Object arg, oldval;
1021 {
1022 f->auto_lower = !EQ (Qnil, arg);
1023 }
1024
1025 void
1026 x_set_vertical_scroll_bars (f, arg, oldval)
1027 struct frame *f;
1028 Lisp_Object arg, oldval;
1029 {
1030 if (NILP (arg) != ! FRAME_HAS_VERTICAL_SCROLL_BARS (f))
1031 {
1032 FRAME_HAS_VERTICAL_SCROLL_BARS (f) = ! NILP (arg);
1033
1034 /* We set this parameter before creating the X window for the
1035 frame, so we can get the geometry right from the start.
1036 However, if the window hasn't been created yet, we shouldn't
1037 call x_set_window_size. */
1038 if (FRAME_X_WINDOW (f))
1039 x_set_window_size (f, FRAME_WIDTH (f), FRAME_HEIGHT (f));
1040 }
1041 }
1042 \f
1043 #ifdef HAVE_X11
1044 int n_faces;
1045
1046 #if 0
1047 /* I believe this function is obsolete with respect to the new face display
1048 changes. */
1049 x_set_face (scr, font, background, foreground, stipple)
1050 struct frame *scr;
1051 XFontStruct *font;
1052 unsigned long background, foreground;
1053 Pixmap stipple;
1054 {
1055 XGCValues gc_values;
1056 GC temp_gc;
1057 unsigned long gc_mask;
1058 struct face *new_face;
1059 unsigned int width = 16;
1060 unsigned int height = 16;
1061
1062 if (n_faces == MAX_FACES_AND_GLYPHS)
1063 return 1;
1064
1065 /* Create the Graphics Context. */
1066 gc_values.font = font->fid;
1067 gc_values.foreground = foreground;
1068 gc_values.background = background;
1069 gc_values.line_width = 0;
1070 gc_mask = GCLineWidth | GCFont | GCForeground | GCBackground;
1071 if (stipple)
1072 {
1073 gc_values.stipple
1074 = XCreateBitmapFromData (x_current_display, ROOT_WINDOW,
1075 (char *) stipple, width, height);
1076 gc_mask |= GCStipple;
1077 }
1078
1079 temp_gc = XCreateGC (x_current_display, FRAME_X_WINDOW (scr),
1080 gc_mask, &gc_values);
1081 if (!temp_gc)
1082 return 1;
1083 new_face = (struct face *) xmalloc (sizeof (struct face));
1084 if (!new_face)
1085 {
1086 XFreeGC (x_current_display, temp_gc);
1087 return 1;
1088 }
1089
1090 new_face->font = font;
1091 new_face->foreground = foreground;
1092 new_face->background = background;
1093 new_face->face_gc = temp_gc;
1094 if (stipple)
1095 new_face->stipple = gc_values.stipple;
1096
1097 x_face_table[++n_faces] = new_face;
1098 return 1;
1099 }
1100 #endif
1101
1102 x_set_glyph (scr, glyph)
1103 {
1104 }
1105
1106 #if 0
1107 DEFUN ("x-set-face-font", Fx_set_face_font, Sx_set_face_font, 4, 2, 0,
1108 "Specify face table entry FACE-CODE to be the font named by FONT,\n\
1109 in colors FOREGROUND and BACKGROUND.")
1110 (face_code, font_name, foreground, background)
1111 Lisp_Object face_code;
1112 Lisp_Object font_name;
1113 Lisp_Object foreground;
1114 Lisp_Object background;
1115 {
1116 register struct face *fp; /* Current face info. */
1117 register int fn; /* Face number. */
1118 register FONT_TYPE *f; /* Font data structure. */
1119 unsigned char *newname;
1120 int fg, bg;
1121 GC temp_gc;
1122 XGCValues gc_values;
1123
1124 /* Need to do something about this. */
1125 Drawable drawable = FRAME_X_WINDOW (selected_frame);
1126
1127 CHECK_NUMBER (face_code, 1);
1128 CHECK_STRING (font_name, 2);
1129
1130 if (EQ (foreground, Qnil) || EQ (background, Qnil))
1131 {
1132 fg = selected_frame->display.x->foreground_pixel;
1133 bg = selected_frame->display.x->background_pixel;
1134 }
1135 else
1136 {
1137 CHECK_NUMBER (foreground, 0);
1138 CHECK_NUMBER (background, 1);
1139
1140 fg = x_decode_color (XINT (foreground), BLACK_PIX_DEFAULT);
1141 bg = x_decode_color (XINT (background), WHITE_PIX_DEFAULT);
1142 }
1143
1144 fn = XINT (face_code);
1145 if ((fn < 1) || (fn > 255))
1146 error ("Invalid face code, %d", fn);
1147
1148 newname = XSTRING (font_name)->data;
1149 BLOCK_INPUT;
1150 f = (*newname == 0 ? 0 : XGetFont (newname));
1151 UNBLOCK_INPUT;
1152 if (f == 0)
1153 error ("Font \"%s\" is not defined", newname);
1154
1155 fp = x_face_table[fn];
1156 if (fp == 0)
1157 {
1158 x_face_table[fn] = fp = (struct face *) xmalloc (sizeof (struct face));
1159 bzero (fp, sizeof (struct face));
1160 fp->face_type = x_pixmap;
1161 }
1162 else if (FACE_IS_FONT (fn))
1163 {
1164 BLOCK_INPUT;
1165 XFreeGC (FACE_FONT (fn));
1166 UNBLOCK_INPUT;
1167 }
1168 else if (FACE_IS_IMAGE (fn)) /* This should not happen... */
1169 {
1170 BLOCK_INPUT;
1171 XFreePixmap (x_current_display, FACE_IMAGE (fn));
1172 fp->face_type = x_font;
1173 UNBLOCK_INPUT;
1174 }
1175 else
1176 abort ();
1177
1178 fp->face_GLYPH.font_desc.font = f;
1179 gc_values.font = f->fid;
1180 gc_values.foreground = fg;
1181 gc_values.background = bg;
1182 fp->face_GLYPH.font_desc.face_gc = XCreateGC (x_current_display,
1183 drawable, GCFont | GCForeground
1184 | GCBackground, &gc_values);
1185 fp->face_GLYPH.font_desc.font_width = FONT_WIDTH (f);
1186 fp->face_GLYPH.font_desc.font_height = FONT_HEIGHT (f);
1187
1188 return face_code;
1189 }
1190 #endif
1191 #else /* X10 */
1192 DEFUN ("x-set-face", Fx_set_face, Sx_set_face, 4, 4, 0,
1193 "Specify face table entry FACE-CODE to be the font named by FONT,\n\
1194 in colors FOREGROUND and BACKGROUND.")
1195 (face_code, font_name, foreground, background)
1196 Lisp_Object face_code;
1197 Lisp_Object font_name;
1198 Lisp_Object foreground;
1199 Lisp_Object background;
1200 {
1201 register struct face *fp; /* Current face info. */
1202 register int fn; /* Face number. */
1203 register FONT_TYPE *f; /* Font data structure. */
1204 unsigned char *newname;
1205
1206 CHECK_NUMBER (face_code, 1);
1207 CHECK_STRING (font_name, 2);
1208
1209 fn = XINT (face_code);
1210 if ((fn < 1) || (fn > 255))
1211 error ("Invalid face code, %d", fn);
1212
1213 /* Ask the server to find the specified font. */
1214 newname = XSTRING (font_name)->data;
1215 BLOCK_INPUT;
1216 f = (*newname == 0 ? 0 : XGetFont (newname));
1217 UNBLOCK_INPUT;
1218 if (f == 0)
1219 error ("Font \"%s\" is not defined", newname);
1220
1221 /* Get the face structure for face_code in the face table.
1222 Make sure it exists. */
1223 fp = x_face_table[fn];
1224 if (fp == 0)
1225 {
1226 x_face_table[fn] = fp = (struct face *) xmalloc (sizeof (struct face));
1227 bzero (fp, sizeof (struct face));
1228 }
1229
1230 /* If this face code already exists, get rid of the old font. */
1231 if (fp->font != 0 && fp->font != f)
1232 {
1233 BLOCK_INPUT;
1234 XLoseFont (fp->font);
1235 UNBLOCK_INPUT;
1236 }
1237
1238 /* Store the specified information in FP. */
1239 fp->fg = x_decode_color (foreground, BLACK_PIX_DEFAULT);
1240 fp->bg = x_decode_color (background, WHITE_PIX_DEFAULT);
1241 fp->font = f;
1242
1243 return face_code;
1244 }
1245 #endif /* X10 */
1246
1247 #if 0
1248 /* This is excluded because there is no painless way
1249 to get or to remember the name of the font. */
1250
1251 DEFUN ("x-get-face", Fx_get_face, Sx_get_face, 1, 1, 0,
1252 "Get data defining face code FACE. FACE is an integer.\n\
1253 The value is a list (FONT FG-COLOR BG-COLOR).")
1254 (face)
1255 Lisp_Object face;
1256 {
1257 register struct face *fp; /* Current face info. */
1258 register int fn; /* Face number. */
1259
1260 CHECK_NUMBER (face, 1);
1261 fn = XINT (face);
1262 if ((fn < 1) || (fn > 255))
1263 error ("Invalid face code, %d", fn);
1264
1265 /* Make sure the face table exists and this face code is defined. */
1266 if (x_face_table == 0 || x_face_table[fn] == 0)
1267 return Qnil;
1268
1269 fp = x_face_table[fn];
1270
1271 return Fcons (build_string (fp->name),
1272 Fcons (make_number (fp->fg),
1273 Fcons (make_number (fp->bg), Qnil)));
1274 }
1275 #endif /* 0 */
1276 \f
1277 /* Subroutines of creating an X frame. */
1278
1279 #ifdef HAVE_X11
1280 extern char *x_get_string_resource ();
1281 extern XrmDatabase x_load_resources ();
1282
1283 DEFUN ("x-get-resource", Fx_get_resource, Sx_get_resource, 2, 4, 0,
1284 "Return the value of ATTRIBUTE, of class CLASS, from the X defaults database.\n\
1285 This uses `INSTANCE.ATTRIBUTE' as the key and `Emacs.CLASS' as the\n\
1286 class, where INSTANCE is the name under which Emacs was invoked.\n\
1287 \n\
1288 The optional arguments COMPONENT and SUBCLASS add to the key and the\n\
1289 class, respectively. You must specify both of them or neither.\n\
1290 If you specify them, the key is `INSTANCE.COMPONENT.ATTRIBUTE'\n\
1291 and the class is `Emacs.CLASS.SUBCLASS'.")
1292 (attribute, class, component, subclass)
1293 Lisp_Object attribute, class, component, subclass;
1294 {
1295 register char *value;
1296 char *name_key;
1297 char *class_key;
1298
1299 CHECK_STRING (attribute, 0);
1300 CHECK_STRING (class, 0);
1301
1302 if (!NILP (component))
1303 CHECK_STRING (component, 1);
1304 if (!NILP (subclass))
1305 CHECK_STRING (subclass, 2);
1306 if (NILP (component) != NILP (subclass))
1307 error ("x-get-resource: must specify both COMPONENT and SUBCLASS or neither");
1308
1309 if (NILP (component))
1310 {
1311 /* Allocate space for the components, the dots which separate them,
1312 and the final '\0'. */
1313 name_key = (char *) alloca (XSTRING (Vinvocation_name)->size
1314 + XSTRING (attribute)->size
1315 + 2);
1316 class_key = (char *) alloca ((sizeof (EMACS_CLASS) - 1)
1317 + XSTRING (class)->size
1318 + 2);
1319
1320 sprintf (name_key, "%s.%s",
1321 XSTRING (Vinvocation_name)->data,
1322 XSTRING (attribute)->data);
1323 sprintf (class_key, "%s.%s",
1324 EMACS_CLASS,
1325 XSTRING (class)->data);
1326 }
1327 else
1328 {
1329 name_key = (char *) alloca (XSTRING (Vinvocation_name)->size
1330 + XSTRING (component)->size
1331 + XSTRING (attribute)->size
1332 + 3);
1333
1334 class_key = (char *) alloca ((sizeof (EMACS_CLASS) - 1)
1335 + XSTRING (class)->size
1336 + XSTRING (subclass)->size
1337 + 3);
1338
1339 sprintf (name_key, "%s.%s.%s",
1340 XSTRING (Vinvocation_name)->data,
1341 XSTRING (component)->data,
1342 XSTRING (attribute)->data);
1343 sprintf (class_key, "%s.%s",
1344 EMACS_CLASS,
1345 XSTRING (class)->data,
1346 XSTRING (subclass)->data);
1347 }
1348
1349 value = x_get_string_resource (xrdb, name_key, class_key);
1350
1351 if (value != (char *) 0)
1352 return build_string (value);
1353 else
1354 return Qnil;
1355 }
1356
1357 #else /* X10 */
1358
1359 DEFUN ("x-get-default", Fx_get_default, Sx_get_default, 1, 1, 0,
1360 "Get X default ATTRIBUTE from the system, or nil if no default.\n\
1361 Value is a string (when not nil) and ATTRIBUTE is also a string.\n\
1362 The defaults are specified in the file `~/.Xdefaults'.")
1363 (arg)
1364 Lisp_Object arg;
1365 {
1366 register unsigned char *value;
1367
1368 CHECK_STRING (arg, 1);
1369
1370 value = (unsigned char *) XGetDefault (XDISPLAY
1371 XSTRING (Vinvocation_name)->data,
1372 XSTRING (arg)->data);
1373 if (value == 0)
1374 /* Try reversing last two args, in case this is the buggy version of X. */
1375 value = (unsigned char *) XGetDefault (XDISPLAY
1376 XSTRING (arg)->data,
1377 XSTRING (Vinvocation_name)->data);
1378 if (value != 0)
1379 return build_string (value);
1380 else
1381 return (Qnil);
1382 }
1383
1384 #define Fx_get_resource(attribute, class, component, subclass) \
1385 Fx_get_default(attribute)
1386
1387 #endif /* X10 */
1388
1389 /* Types we might convert a resource string into. */
1390 enum resource_types
1391 {
1392 number, boolean, string, symbol,
1393 };
1394
1395 /* Return the value of parameter PARAM.
1396
1397 First search ALIST, then Vdefault_frame_alist, then the X defaults
1398 database, using ATTRIBUTE as the attribute name and CLASS as its class.
1399
1400 Convert the resource to the type specified by desired_type.
1401
1402 If no default is specified, return Qunbound. If you call
1403 x_get_arg, make sure you deal with Qunbound in a reasonable way,
1404 and don't let it get stored in any lisp-visible variables! */
1405
1406 static Lisp_Object
1407 x_get_arg (alist, param, attribute, class, type)
1408 Lisp_Object alist, param;
1409 char *attribute;
1410 char *class;
1411 enum resource_types type;
1412 {
1413 register Lisp_Object tem;
1414
1415 tem = Fassq (param, alist);
1416 if (EQ (tem, Qnil))
1417 tem = Fassq (param, Vdefault_frame_alist);
1418 if (EQ (tem, Qnil))
1419 {
1420
1421 if (attribute)
1422 {
1423 tem = Fx_get_resource (build_string (attribute),
1424 build_string (class),
1425 Qnil, Qnil);
1426
1427 if (NILP (tem))
1428 return Qunbound;
1429
1430 switch (type)
1431 {
1432 case number:
1433 return make_number (atoi (XSTRING (tem)->data));
1434
1435 case boolean:
1436 tem = Fdowncase (tem);
1437 if (!strcmp (XSTRING (tem)->data, "on")
1438 || !strcmp (XSTRING (tem)->data, "true"))
1439 return Qt;
1440 else
1441 return Qnil;
1442
1443 case string:
1444 return tem;
1445
1446 case symbol:
1447 /* As a special case, we map the values `true' and `on'
1448 to Qt, and `false' and `off' to Qnil. */
1449 {
1450 Lisp_Object lower = Fdowncase (tem);
1451 if (!strcmp (XSTRING (tem)->data, "on")
1452 || !strcmp (XSTRING (tem)->data, "true"))
1453 return Qt;
1454 else if (!strcmp (XSTRING (tem)->data, "off")
1455 || !strcmp (XSTRING (tem)->data, "false"))
1456 return Qnil;
1457 else
1458 return Fintern (tem, Qnil);
1459 }
1460
1461 default:
1462 abort ();
1463 }
1464 }
1465 else
1466 return Qunbound;
1467 }
1468 return Fcdr (tem);
1469 }
1470
1471 /* Record in frame F the specified or default value according to ALIST
1472 of the parameter named PARAM (a Lisp symbol).
1473 If no value is specified for PARAM, look for an X default for XPROP
1474 on the frame named NAME.
1475 If that is not found either, use the value DEFLT. */
1476
1477 static Lisp_Object
1478 x_default_parameter (f, alist, prop, deflt, xprop, xclass, type)
1479 struct frame *f;
1480 Lisp_Object alist;
1481 Lisp_Object prop;
1482 Lisp_Object deflt;
1483 char *xprop;
1484 char *xclass;
1485 enum resource_types type;
1486 {
1487 Lisp_Object tem;
1488
1489 tem = x_get_arg (alist, prop, xprop, xclass, type);
1490 if (EQ (tem, Qunbound))
1491 tem = deflt;
1492 x_set_frame_parameters (f, Fcons (Fcons (prop, tem), Qnil));
1493 return tem;
1494 }
1495 \f
1496 DEFUN ("x-parse-geometry", Fx_parse_geometry, Sx_parse_geometry, 1, 1, 0,
1497 "Parse an X-style geometry string STRING.\n\
1498 Returns an alist of the form ((top . TOP), (left . LEFT) ... ).")
1499 (string)
1500 Lisp_Object string;
1501 {
1502 int geometry, x, y;
1503 unsigned int width, height;
1504 Lisp_Object values[4];
1505
1506 CHECK_STRING (string, 0);
1507
1508 geometry = XParseGeometry ((char *) XSTRING (string)->data,
1509 &x, &y, &width, &height);
1510
1511 switch (geometry & 0xf) /* Mask out {X,Y}Negative */
1512 {
1513 case (XValue | YValue):
1514 /* What's one pixel among friends?
1515 Perhaps fix this some day by returning symbol `extreme-top'... */
1516 if (x == 0 && (geometry & XNegative))
1517 x = -1;
1518 if (y == 0 && (geometry & YNegative))
1519 y = -1;
1520 values[0] = Fcons (Qleft, make_number (x));
1521 values[1] = Fcons (Qtop, make_number (y));
1522 return Flist (2, values);
1523 break;
1524
1525 case (WidthValue | HeightValue):
1526 values[0] = Fcons (Qwidth, make_number (width));
1527 values[1] = Fcons (Qheight, make_number (height));
1528 return Flist (2, values);
1529 break;
1530
1531 case (XValue | YValue | WidthValue | HeightValue):
1532 if (x == 0 && (geometry & XNegative))
1533 x = -1;
1534 if (y == 0 && (geometry & YNegative))
1535 y = -1;
1536 values[0] = Fcons (Qwidth, make_number (width));
1537 values[1] = Fcons (Qheight, make_number (height));
1538 values[2] = Fcons (Qleft, make_number (x));
1539 values[3] = Fcons (Qtop, make_number (y));
1540 return Flist (4, values);
1541 break;
1542
1543 case 0:
1544 return Qnil;
1545
1546 default:
1547 error ("Must specify x and y value, and/or width and height");
1548 }
1549 }
1550
1551 #ifdef HAVE_X11
1552 /* Calculate the desired size and position of this window,
1553 or set rubber-band prompting if none. */
1554
1555 #define DEFAULT_ROWS 40
1556 #define DEFAULT_COLS 80
1557
1558 static int
1559 x_figure_window_size (f, parms)
1560 struct frame *f;
1561 Lisp_Object parms;
1562 {
1563 register Lisp_Object tem0, tem1;
1564 int height, width, left, top;
1565 register int geometry;
1566 long window_prompting = 0;
1567
1568 /* Default values if we fall through.
1569 Actually, if that happens we should get
1570 window manager prompting. */
1571 f->width = DEFAULT_COLS;
1572 f->height = DEFAULT_ROWS;
1573 f->display.x->top_pos = 1;
1574 f->display.x->left_pos = 1;
1575
1576 tem0 = x_get_arg (parms, Qheight, 0, 0, number);
1577 tem1 = x_get_arg (parms, Qwidth, 0, 0, number);
1578 if (! EQ (tem0, Qunbound) && ! EQ (tem1, Qunbound))
1579 {
1580 CHECK_NUMBER (tem0, 0);
1581 CHECK_NUMBER (tem1, 0);
1582 f->height = XINT (tem0);
1583 f->width = XINT (tem1);
1584 window_prompting |= USSize;
1585 }
1586 else if (! EQ (tem0, Qunbound) || ! EQ (tem1, Qunbound))
1587 error ("Must specify *both* height and width");
1588
1589 f->display.x->vertical_scroll_bar_extra =
1590 (FRAME_HAS_VERTICAL_SCROLL_BARS (f)
1591 ? VERTICAL_SCROLL_BAR_PIXEL_WIDTH (f)
1592 : 0);
1593 f->display.x->pixel_width = CHAR_TO_PIXEL_WIDTH (f, f->width);
1594 f->display.x->pixel_height = CHAR_TO_PIXEL_HEIGHT (f, f->height);
1595
1596 tem0 = x_get_arg (parms, Qtop, 0, 0, number);
1597 tem1 = x_get_arg (parms, Qleft, 0, 0, number);
1598 if (! EQ (tem0, Qunbound) && ! EQ (tem1, Qunbound))
1599 {
1600 CHECK_NUMBER (tem0, 0);
1601 CHECK_NUMBER (tem1, 0);
1602 f->display.x->top_pos = XINT (tem0);
1603 f->display.x->left_pos = XINT (tem1);
1604 x_calc_absolute_position (f);
1605 window_prompting |= USPosition;
1606 }
1607 else if (! EQ (tem0, Qunbound) || ! EQ (tem1, Qunbound))
1608 error ("Must specify *both* top and left corners");
1609
1610 switch (window_prompting)
1611 {
1612 case USSize | USPosition:
1613 return window_prompting;
1614 break;
1615
1616 case USSize: /* Got the size, need the position. */
1617 window_prompting |= PPosition;
1618 return window_prompting;
1619 break;
1620
1621 case USPosition: /* Got the position, need the size. */
1622 window_prompting |= PSize;
1623 return window_prompting;
1624 break;
1625
1626 case 0: /* Got nothing, take both from geometry. */
1627 window_prompting |= PPosition | PSize;
1628 return window_prompting;
1629 break;
1630
1631 default:
1632 /* Somehow a bit got set in window_prompting that we didn't
1633 put there. */
1634 abort ();
1635 }
1636 }
1637
1638 static void
1639 x_window (f)
1640 struct frame *f;
1641 {
1642 XSetWindowAttributes attributes;
1643 unsigned long attribute_mask;
1644 XClassHint class_hints;
1645
1646 attributes.background_pixel = f->display.x->background_pixel;
1647 attributes.border_pixel = f->display.x->border_pixel;
1648 attributes.bit_gravity = StaticGravity;
1649 attributes.backing_store = NotUseful;
1650 attributes.save_under = True;
1651 attributes.event_mask = STANDARD_EVENT_SET;
1652 attribute_mask = (CWBackPixel | CWBorderPixel | CWBitGravity
1653 #if 0
1654 | CWBackingStore | CWSaveUnder
1655 #endif
1656 | CWEventMask);
1657
1658 BLOCK_INPUT;
1659 FRAME_X_WINDOW (f)
1660 = XCreateWindow (x_current_display, ROOT_WINDOW,
1661 f->display.x->left_pos,
1662 f->display.x->top_pos,
1663 PIXEL_WIDTH (f), PIXEL_HEIGHT (f),
1664 f->display.x->border_width,
1665 CopyFromParent, /* depth */
1666 InputOutput, /* class */
1667 screen_visual, /* set in Fx_open_connection */
1668 attribute_mask, &attributes);
1669
1670 class_hints.res_name = (char *) XSTRING (f->name)->data;
1671 class_hints.res_class = EMACS_CLASS;
1672 XSetClassHint (x_current_display, FRAME_X_WINDOW (f), &class_hints);
1673
1674 /* This indicates that we use the "Passive Input" input model.
1675 Unless we do this, we don't get the Focus{In,Out} events that we
1676 need to draw the cursor correctly. Accursed bureaucrats.
1677 XWhipsAndChains (x_current_display, IronMaiden, &TheRack); */
1678
1679 f->display.x->wm_hints.input = True;
1680 f->display.x->wm_hints.flags |= InputHint;
1681 XSetWMHints (x_current_display, FRAME_X_WINDOW (f), &f->display.x->wm_hints);
1682
1683 /* x_set_name normally ignores requests to set the name if the
1684 requested name is the same as the current name. This is the one
1685 place where that assumption isn't correct; f->name is set, but
1686 the X server hasn't been told. */
1687 {
1688 Lisp_Object name = f->name;
1689 int explicit = f->explicit_name;
1690
1691 f->name = Qnil;
1692 f->explicit_name = 0;
1693 x_set_name (f, name, explicit);
1694 }
1695
1696 XDefineCursor (XDISPLAY FRAME_X_WINDOW (f),
1697 f->display.x->text_cursor);
1698 UNBLOCK_INPUT;
1699
1700 if (FRAME_X_WINDOW (f) == 0)
1701 error ("Unable to create window.");
1702 }
1703
1704 /* Handle the icon stuff for this window. Perhaps later we might
1705 want an x_set_icon_position which can be called interactively as
1706 well. */
1707
1708 static void
1709 x_icon (f, parms)
1710 struct frame *f;
1711 Lisp_Object parms;
1712 {
1713 Lisp_Object icon_x, icon_y;
1714
1715 /* Set the position of the icon. Note that twm groups all
1716 icons in an icon window. */
1717 icon_x = x_get_arg (parms, Qicon_left, 0, 0, number);
1718 icon_y = x_get_arg (parms, Qicon_top, 0, 0, number);
1719 if (!EQ (icon_x, Qunbound) && !EQ (icon_y, Qunbound))
1720 {
1721 CHECK_NUMBER (icon_x, 0);
1722 CHECK_NUMBER (icon_y, 0);
1723 }
1724 else if (!EQ (icon_x, Qunbound) || !EQ (icon_y, Qunbound))
1725 error ("Both left and top icon corners of icon must be specified");
1726
1727 BLOCK_INPUT;
1728
1729 if (! EQ (icon_x, Qunbound))
1730 x_wm_set_icon_position (f, XINT (icon_x), XINT (icon_y));
1731
1732 /* Start up iconic or window? */
1733 x_wm_set_window_state
1734 (f, (EQ (x_get_arg (parms, Qvisibility, 0, 0, symbol), Qicon)
1735 ? IconicState
1736 : NormalState));
1737
1738 UNBLOCK_INPUT;
1739 }
1740
1741 /* Make the GC's needed for this window, setting the
1742 background, border and mouse colors; also create the
1743 mouse cursor and the gray border tile. */
1744
1745 static char cursor_bits[] =
1746 {
1747 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
1748 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
1749 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
1750 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00
1751 };
1752
1753 static void
1754 x_make_gc (f)
1755 struct frame *f;
1756 {
1757 XGCValues gc_values;
1758 GC temp_gc;
1759 XImage tileimage;
1760
1761 BLOCK_INPUT;
1762
1763 /* Create the GC's of this frame.
1764 Note that many default values are used. */
1765
1766 /* Normal video */
1767 gc_values.font = f->display.x->font->fid;
1768 gc_values.foreground = f->display.x->foreground_pixel;
1769 gc_values.background = f->display.x->background_pixel;
1770 gc_values.line_width = 0; /* Means 1 using fast algorithm. */
1771 f->display.x->normal_gc = XCreateGC (x_current_display,
1772 FRAME_X_WINDOW (f),
1773 GCLineWidth | GCFont
1774 | GCForeground | GCBackground,
1775 &gc_values);
1776
1777 /* Reverse video style. */
1778 gc_values.foreground = f->display.x->background_pixel;
1779 gc_values.background = f->display.x->foreground_pixel;
1780 f->display.x->reverse_gc = XCreateGC (x_current_display,
1781 FRAME_X_WINDOW (f),
1782 GCFont | GCForeground | GCBackground
1783 | GCLineWidth,
1784 &gc_values);
1785
1786 /* Cursor has cursor-color background, background-color foreground. */
1787 gc_values.foreground = f->display.x->background_pixel;
1788 gc_values.background = f->display.x->cursor_pixel;
1789 gc_values.fill_style = FillOpaqueStippled;
1790 gc_values.stipple
1791 = XCreateBitmapFromData (x_current_display, ROOT_WINDOW,
1792 cursor_bits, 16, 16);
1793 f->display.x->cursor_gc
1794 = XCreateGC (x_current_display, FRAME_X_WINDOW (f),
1795 (GCFont | GCForeground | GCBackground
1796 | GCFillStyle | GCStipple | GCLineWidth),
1797 &gc_values);
1798
1799 /* Create the gray border tile used when the pointer is not in
1800 the frame. Since this depends on the frame's pixel values,
1801 this must be done on a per-frame basis. */
1802 f->display.x->border_tile
1803 = (XCreatePixmapFromBitmapData
1804 (x_current_display, ROOT_WINDOW,
1805 gray_bits, gray_width, gray_height,
1806 f->display.x->foreground_pixel,
1807 f->display.x->background_pixel,
1808 DefaultDepth (x_current_display, XDefaultScreen (x_current_display))));
1809
1810 init_frame_faces (f);
1811
1812 UNBLOCK_INPUT;
1813 }
1814 #endif /* HAVE_X11 */
1815
1816 DEFUN ("x-create-frame", Fx_create_frame, Sx_create_frame,
1817 1, 1, 0,
1818 "Make a new X window, which is called a \"frame\" in Emacs terms.\n\
1819 Return an Emacs frame object representing the X window.\n\
1820 ALIST is an alist of frame parameters.\n\
1821 If the parameters specify that the frame should not have a minibuffer,\n\
1822 and do not specify a specific minibuffer window to use,\n\
1823 then `default-minibuffer-frame' must be a frame whose minibuffer can\n\
1824 be shared by the new frame.")
1825 (parms)
1826 Lisp_Object parms;
1827 {
1828 #ifdef HAVE_X11
1829 struct frame *f;
1830 Lisp_Object frame, tem;
1831 Lisp_Object name;
1832 int minibuffer_only = 0;
1833 long window_prompting = 0;
1834 int width, height;
1835
1836 if (x_current_display == 0)
1837 error ("X windows are not in use or not initialized");
1838
1839 name = x_get_arg (parms, Qname, "title", "Title", string);
1840 if (XTYPE (name) != Lisp_String
1841 && ! EQ (name, Qunbound)
1842 && ! NILP (name))
1843 error ("x-create-frame: name parameter must be a string");
1844
1845 tem = x_get_arg (parms, Qminibuffer, 0, 0, symbol);
1846 if (EQ (tem, Qnone) || NILP (tem))
1847 f = make_frame_without_minibuffer (Qnil);
1848 else if (EQ (tem, Qonly))
1849 {
1850 f = make_minibuffer_frame ();
1851 minibuffer_only = 1;
1852 }
1853 else if (XTYPE (tem) == Lisp_Window)
1854 f = make_frame_without_minibuffer (tem);
1855 else
1856 f = make_frame (1);
1857
1858 /* Note that X Windows does support scroll bars. */
1859 FRAME_CAN_HAVE_SCROLL_BARS (f) = 1;
1860
1861 /* Set the name; the functions to which we pass f expect the name to
1862 be set. */
1863 if (EQ (name, Qunbound) || NILP (name))
1864 {
1865 f->name = build_string (x_id_name);
1866 f->explicit_name = 0;
1867 }
1868 else
1869 {
1870 f->name = name;
1871 f->explicit_name = 1;
1872 }
1873
1874 XSET (frame, Lisp_Frame, f);
1875 f->output_method = output_x_window;
1876 f->display.x = (struct x_display *) xmalloc (sizeof (struct x_display));
1877 bzero (f->display.x, sizeof (struct x_display));
1878
1879 /* Note that the frame has no physical cursor right now. */
1880 f->phys_cursor_x = -1;
1881
1882 /* Extract the window parameters from the supplied values
1883 that are needed to determine window geometry. */
1884 x_default_parameter (f, parms, Qfont,
1885 build_string
1886 /* If we use an XLFD name for this font, the lisp code
1887 knows how to find variants which are bold, italic,
1888 etcetera. */
1889 ("-*-fixed-*-*-*-*-*-120-*-*-c-*-iso8859-1"),
1890 "font", "Font", string);
1891 x_default_parameter (f, parms, Qborder_width, make_number (2),
1892 "borderwidth", "BorderWidth", number);
1893 /* This defaults to 2 in order to match xterm. */
1894 x_default_parameter (f, parms, Qinternal_border_width, make_number (2),
1895 "internalBorderWidth", "BorderWidth", number);
1896 x_default_parameter (f, parms, Qvertical_scroll_bars, Qt,
1897 "verticalScrollBars", "ScrollBars", boolean);
1898
1899 /* Also do the stuff which must be set before the window exists. */
1900 x_default_parameter (f, parms, Qforeground_color, build_string ("black"),
1901 "foreground", "Foreground", string);
1902 x_default_parameter (f, parms, Qbackground_color, build_string ("white"),
1903 "background", "Background", string);
1904 x_default_parameter (f, parms, Qmouse_color, build_string ("black"),
1905 "pointerColor", "Foreground", string);
1906 x_default_parameter (f, parms, Qcursor_color, build_string ("black"),
1907 "cursorColor", "Foreground", string);
1908 x_default_parameter (f, parms, Qborder_color, build_string ("black"),
1909 "borderColor", "BorderColor", string);
1910
1911 f->display.x->parent_desc = ROOT_WINDOW;
1912 window_prompting = x_figure_window_size (f, parms);
1913
1914 x_window (f);
1915 x_icon (f, parms);
1916 x_make_gc (f);
1917
1918 /* We need to do this after creating the X window, so that the
1919 icon-creation functions can say whose icon they're describing. */
1920 x_default_parameter (f, parms, Qicon_type, Qnil,
1921 "iconType", "IconType", symbol);
1922
1923 x_default_parameter (f, parms, Qauto_raise, Qnil,
1924 "autoRaise", "AutoRaiseLower", boolean);
1925 x_default_parameter (f, parms, Qauto_lower, Qnil,
1926 "autoLower", "AutoRaiseLower", boolean);
1927 x_default_parameter (f, parms, Qcursor_type, Qbox,
1928 "cursorType", "CursorType", symbol);
1929
1930 /* Dimensions, especially f->height, must be done via change_frame_size.
1931 Change will not be effected unless different from the current
1932 f->height. */
1933 width = f->width;
1934 height = f->height;
1935 f->height = f->width = 0;
1936 change_frame_size (f, height, width, 1, 0);
1937
1938 x_default_parameter (f, parms, Qmenu_bar_lines, make_number (0),
1939 "menuBarLines", "MenuBarLines", number);
1940
1941 BLOCK_INPUT;
1942 x_wm_set_size_hint (f, window_prompting);
1943 UNBLOCK_INPUT;
1944
1945 tem = x_get_arg (parms, Qunsplittable, 0, 0, boolean);
1946 f->no_split = minibuffer_only || EQ (tem, Qt);
1947
1948 /* Make the window appear on the frame and enable display,
1949 unless the caller says not to. */
1950 {
1951 Lisp_Object visibility = x_get_arg (parms, Qvisibility, 0, 0, symbol);
1952
1953 if (EQ (visibility, Qunbound))
1954 visibility = Qt;
1955
1956 if (EQ (visibility, Qicon))
1957 x_iconify_frame (f);
1958 else if (! NILP (visibility))
1959 x_make_frame_visible (f);
1960 else
1961 /* Must have been Qnil. */
1962 ;
1963 }
1964
1965 return frame;
1966 #else /* X10 */
1967 struct frame *f;
1968 Lisp_Object frame, tem;
1969 Lisp_Object name;
1970 int pixelwidth, pixelheight;
1971 Cursor cursor;
1972 int height, width;
1973 Window parent;
1974 Pixmap temp;
1975 int minibuffer_only = 0;
1976 Lisp_Object vscroll, hscroll;
1977
1978 if (x_current_display == 0)
1979 error ("X windows are not in use or not initialized");
1980
1981 name = Fassq (Qname, parms);
1982
1983 tem = x_get_arg (parms, Qminibuffer, 0, 0, symbol);
1984 if (EQ (tem, Qnone))
1985 f = make_frame_without_minibuffer (Qnil);
1986 else if (EQ (tem, Qonly))
1987 {
1988 f = make_minibuffer_frame ();
1989 minibuffer_only = 1;
1990 }
1991 else if (EQ (tem, Qnil) || EQ (tem, Qunbound))
1992 f = make_frame (1);
1993 else
1994 f = make_frame_without_minibuffer (tem);
1995
1996 parent = ROOT_WINDOW;
1997
1998 XSET (frame, Lisp_Frame, f);
1999 f->output_method = output_x_window;
2000 f->display.x = (struct x_display *) xmalloc (sizeof (struct x_display));
2001 bzero (f->display.x, sizeof (struct x_display));
2002
2003 /* Some temprorary default values for height and width. */
2004 width = 80;
2005 height = 40;
2006 f->display.x->left_pos = -1;
2007 f->display.x->top_pos = -1;
2008
2009 /* Give the frame a default name (which may be overridden with PARMS). */
2010
2011 strncpy (iconidentity, ICONTAG, MAXICID);
2012 if (gethostname (&iconidentity[sizeof (ICONTAG) - 1],
2013 (MAXICID - 1) - sizeof (ICONTAG)))
2014 iconidentity[sizeof (ICONTAG) - 2] = '\0';
2015 f->name = build_string (iconidentity);
2016
2017 /* Extract some window parameters from the supplied values.
2018 These are the parameters that affect window geometry. */
2019
2020 tem = x_get_arg (parms, Qfont, "BodyFont", 0, string);
2021 if (EQ (tem, Qunbound))
2022 tem = build_string ("9x15");
2023 x_set_font (f, tem, Qnil);
2024 x_default_parameter (f, parms, Qborder_color,
2025 build_string ("black"), "Border", 0, string);
2026 x_default_parameter (f, parms, Qbackground_color,
2027 build_string ("white"), "Background", 0, string);
2028 x_default_parameter (f, parms, Qforeground_color,
2029 build_string ("black"), "Foreground", 0, string);
2030 x_default_parameter (f, parms, Qmouse_color,
2031 build_string ("black"), "Mouse", 0, string);
2032 x_default_parameter (f, parms, Qcursor_color,
2033 build_string ("black"), "Cursor", 0, string);
2034 x_default_parameter (f, parms, Qborder_width,
2035 make_number (2), "BorderWidth", 0, number);
2036 x_default_parameter (f, parms, Qinternal_border_width,
2037 make_number (4), "InternalBorderWidth", 0, number);
2038 x_default_parameter (f, parms, Qauto_raise,
2039 Qnil, "AutoRaise", 0, boolean);
2040
2041 hscroll = EQ (x_get_arg (parms, Qhorizontal_scroll_bar, 0, 0, boolean), Qt);
2042 vscroll = EQ (x_get_arg (parms, Qvertical_scroll_bar, 0, 0, boolean), Qt);
2043
2044 if (f->display.x->internal_border_width < 0)
2045 f->display.x->internal_border_width = 0;
2046
2047 tem = x_get_arg (parms, Qwindow_id, 0, 0, number);
2048 if (!EQ (tem, Qunbound))
2049 {
2050 WINDOWINFO_TYPE wininfo;
2051 int nchildren;
2052 Window *children, root;
2053
2054 CHECK_NUMBER (tem, 0);
2055 FRAME_X_WINDOW (f) = (Window) XINT (tem);
2056
2057 BLOCK_INPUT;
2058 XGetWindowInfo (FRAME_X_WINDOW (f), &wininfo);
2059 XQueryTree (FRAME_X_WINDOW (f), &parent, &nchildren, &children);
2060 xfree (children);
2061 UNBLOCK_INPUT;
2062
2063 height = PIXEL_TO_CHAR_HEIGHT (f, wininfo.height);
2064 width = PIXEL_TO_CHAR_WIDTH (f, wininfo.width);
2065 f->display.x->left_pos = wininfo.x;
2066 f->display.x->top_pos = wininfo.y;
2067 FRAME_SET_VISIBILITY (f, wininfo.mapped != 0);
2068 f->display.x->border_width = wininfo.bdrwidth;
2069 f->display.x->parent_desc = parent;
2070 }
2071 else
2072 {
2073 tem = x_get_arg (parms, Qparent_id, 0, 0, number);
2074 if (!EQ (tem, Qunbound))
2075 {
2076 CHECK_NUMBER (tem, 0);
2077 parent = (Window) XINT (tem);
2078 }
2079 f->display.x->parent_desc = parent;
2080 tem = x_get_arg (parms, Qheight, 0, 0, number);
2081 if (EQ (tem, Qunbound))
2082 {
2083 tem = x_get_arg (parms, Qwidth, 0, 0, number);
2084 if (EQ (tem, Qunbound))
2085 {
2086 tem = x_get_arg (parms, Qtop, 0, 0, number);
2087 if (EQ (tem, Qunbound))
2088 tem = x_get_arg (parms, Qleft, 0, 0, number);
2089 }
2090 }
2091 /* Now TEM is Qunbound if no edge or size was specified.
2092 In that case, we must do rubber-banding. */
2093 if (EQ (tem, Qunbound))
2094 {
2095 tem = x_get_arg (parms, Qgeometry, 0, 0, number);
2096 x_rubber_band (f,
2097 &f->display.x->left_pos, &f->display.x->top_pos,
2098 &width, &height,
2099 (XTYPE (tem) == Lisp_String
2100 ? (char *) XSTRING (tem)->data : ""),
2101 XSTRING (f->name)->data,
2102 !NILP (hscroll), !NILP (vscroll));
2103 }
2104 else
2105 {
2106 /* Here if at least one edge or size was specified.
2107 Demand that they all were specified, and use them. */
2108 tem = x_get_arg (parms, Qheight, 0, 0, number);
2109 if (EQ (tem, Qunbound))
2110 error ("Height not specified");
2111 CHECK_NUMBER (tem, 0);
2112 height = XINT (tem);
2113
2114 tem = x_get_arg (parms, Qwidth, 0, 0, number);
2115 if (EQ (tem, Qunbound))
2116 error ("Width not specified");
2117 CHECK_NUMBER (tem, 0);
2118 width = XINT (tem);
2119
2120 tem = x_get_arg (parms, Qtop, 0, 0, number);
2121 if (EQ (tem, Qunbound))
2122 error ("Top position not specified");
2123 CHECK_NUMBER (tem, 0);
2124 f->display.x->left_pos = XINT (tem);
2125
2126 tem = x_get_arg (parms, Qleft, 0, 0, number);
2127 if (EQ (tem, Qunbound))
2128 error ("Left position not specified");
2129 CHECK_NUMBER (tem, 0);
2130 f->display.x->top_pos = XINT (tem);
2131 }
2132
2133 pixelwidth = CHAR_TO_PIXEL_WIDTH (f, width);
2134 pixelheight = CHAR_TO_PIXEL_HEIGHT (f, height);
2135
2136 BLOCK_INPUT;
2137 FRAME_X_WINDOW (f)
2138 = XCreateWindow (parent,
2139 f->display.x->left_pos, /* Absolute horizontal offset */
2140 f->display.x->top_pos, /* Absolute Vertical offset */
2141 pixelwidth, pixelheight,
2142 f->display.x->border_width,
2143 BLACK_PIX_DEFAULT, WHITE_PIX_DEFAULT);
2144 UNBLOCK_INPUT;
2145 if (FRAME_X_WINDOW (f) == 0)
2146 error ("Unable to create window.");
2147 }
2148
2149 /* Install the now determined height and width
2150 in the windows and in phys_lines and desired_lines. */
2151 change_frame_size (f, height, width, 1, 0);
2152 XSelectInput (FRAME_X_WINDOW (f), KeyPressed | ExposeWindow
2153 | ButtonPressed | ButtonReleased | ExposeRegion | ExposeCopy
2154 | EnterWindow | LeaveWindow | UnmapWindow );
2155 x_set_resize_hint (f);
2156
2157 /* Tell the server the window's default name. */
2158 XStoreName (XDISPLAY FRAME_X_WINDOW (f), XSTRING (f->name)->data);
2159
2160 /* Now override the defaults with all the rest of the specified
2161 parms. */
2162 tem = x_get_arg (parms, Qunsplittable, 0, 0, boolean);
2163 f->no_split = minibuffer_only || EQ (tem, Qt);
2164
2165 /* Do not create an icon window if the caller says not to */
2166 if (!EQ (x_get_arg (parms, Qsuppress_icon, 0, 0, boolean), Qt)
2167 || f->display.x->parent_desc != ROOT_WINDOW)
2168 {
2169 x_text_icon (f, iconidentity);
2170 x_default_parameter (f, parms, Qicon_type, Qnil,
2171 "BitmapIcon", 0, symbol);
2172 }
2173
2174 /* Tell the X server the previously set values of the
2175 background, border and mouse colors; also create the mouse cursor. */
2176 BLOCK_INPUT;
2177 temp = XMakeTile (f->display.x->background_pixel);
2178 XChangeBackground (FRAME_X_WINDOW (f), temp);
2179 XFreePixmap (temp);
2180 UNBLOCK_INPUT;
2181 x_set_border_pixel (f, f->display.x->border_pixel);
2182
2183 x_set_mouse_color (f, Qnil, Qnil);
2184
2185 /* Now override the defaults with all the rest of the specified parms. */
2186
2187 Fmodify_frame_parameters (frame, parms);
2188
2189 /* Make the window appear on the frame and enable display. */
2190 {
2191 Lisp_Object visibility = x_get_arg (parms, Qvisibility, 0, 0, symbol);
2192
2193 if (EQ (visibility, Qunbound))
2194 visibility = Qt;
2195
2196 if (! EQ (visibility, Qicon)
2197 && ! NILP (visibility))
2198 x_make_window_visible (f);
2199 }
2200
2201 SET_FRAME_GARBAGED (f);
2202
2203 return frame;
2204 #endif /* X10 */
2205 }
2206
2207 DEFUN ("focus-frame", Ffocus_frame, Sfocus_frame, 1, 1, 0,
2208 "Set the focus on FRAME.")
2209 (frame)
2210 Lisp_Object frame;
2211 {
2212 CHECK_LIVE_FRAME (frame, 0);
2213
2214 if (FRAME_X_P (XFRAME (frame)))
2215 {
2216 BLOCK_INPUT;
2217 x_focus_on_frame (XFRAME (frame));
2218 UNBLOCK_INPUT;
2219 return frame;
2220 }
2221
2222 return Qnil;
2223 }
2224
2225 DEFUN ("unfocus-frame", Funfocus_frame, Sunfocus_frame, 0, 0, 0,
2226 "If a frame has been focused, release it.")
2227 ()
2228 {
2229 if (x_focus_frame)
2230 {
2231 BLOCK_INPUT;
2232 x_unfocus_frame (x_focus_frame);
2233 UNBLOCK_INPUT;
2234 }
2235
2236 return Qnil;
2237 }
2238 \f
2239 #ifndef HAVE_X11
2240 /* Computes an X-window size and position either from geometry GEO
2241 or with the mouse.
2242
2243 F is a frame. It specifies an X window which is used to
2244 determine which display to compute for. Its font, borders
2245 and colors control how the rectangle will be displayed.
2246
2247 X and Y are where to store the positions chosen.
2248 WIDTH and HEIGHT are where to store the sizes chosen.
2249
2250 GEO is the geometry that may specify some of the info.
2251 STR is a prompt to display.
2252 HSCROLL and VSCROLL say whether we have horiz and vert scroll bars. */
2253
2254 int
2255 x_rubber_band (f, x, y, width, height, geo, str, hscroll, vscroll)
2256 struct frame *f;
2257 int *x, *y, *width, *height;
2258 char *geo;
2259 char *str;
2260 int hscroll, vscroll;
2261 {
2262 OpaqueFrame frame;
2263 Window tempwindow;
2264 WindowInfo wininfo;
2265 int border_color;
2266 int background_color;
2267 Lisp_Object tem;
2268 int mask;
2269
2270 BLOCK_INPUT;
2271
2272 background_color = f->display.x->background_pixel;
2273 border_color = f->display.x->border_pixel;
2274
2275 frame.bdrwidth = f->display.x->border_width;
2276 frame.border = XMakeTile (border_color);
2277 frame.background = XMakeTile (background_color);
2278 tempwindow = XCreateTerm (str, "emacs", geo, default_window, &frame, 10, 5,
2279 (2 * f->display.x->internal_border_width
2280 + (vscroll ? VSCROLL_WIDTH : 0)),
2281 (2 * f->display.x->internal_border_width
2282 + (hscroll ? HSCROLL_HEIGHT : 0)),
2283 width, height, f->display.x->font,
2284 FONT_WIDTH (f->display.x->font),
2285 FONT_HEIGHT (f->display.x->font));
2286 XFreePixmap (frame.border);
2287 XFreePixmap (frame.background);
2288
2289 if (tempwindow != 0)
2290 {
2291 XQueryWindow (tempwindow, &wininfo);
2292 XDestroyWindow (tempwindow);
2293 *x = wininfo.x;
2294 *y = wininfo.y;
2295 }
2296
2297 /* Coordinates we got are relative to the root window.
2298 Convert them to coordinates relative to desired parent window
2299 by scanning from there up to the root. */
2300 tempwindow = f->display.x->parent_desc;
2301 while (tempwindow != ROOT_WINDOW)
2302 {
2303 int nchildren;
2304 Window *children;
2305 XQueryWindow (tempwindow, &wininfo);
2306 *x -= wininfo.x;
2307 *y -= wininfo.y;
2308 XQueryTree (tempwindow, &tempwindow, &nchildren, &children);
2309 xfree (children);
2310 }
2311
2312 UNBLOCK_INPUT;
2313 return tempwindow != 0;
2314 }
2315 #endif /* not HAVE_X11 */
2316 \f
2317 DEFUN ("x-color-defined-p", Fx_color_defined_p, Sx_color_defined_p, 1, 1, 0,
2318 "Return t if the current X display supports the color named COLOR.")
2319 (color)
2320 Lisp_Object color;
2321 {
2322 Color foo;
2323
2324 CHECK_STRING (color, 0);
2325
2326 if (defined_color (XSTRING (color)->data, &foo))
2327 return Qt;
2328 else
2329 return Qnil;
2330 }
2331
2332 DEFUN ("x-display-color-p", Fx_display_color_p, Sx_display_color_p, 0, 0, 0,
2333 "Return t if the X screen currently in use supports color.")
2334 ()
2335 {
2336 if (x_screen_planes <= 2)
2337 return Qnil;
2338
2339 switch (screen_visual->class)
2340 {
2341 case StaticColor:
2342 case PseudoColor:
2343 case TrueColor:
2344 case DirectColor:
2345 return Qt;
2346
2347 default:
2348 return Qnil;
2349 }
2350 }
2351
2352 DEFUN ("x-display-pixel-width", Fx_display_pixel_width, Sx_display_pixel_width,
2353 0, 1, 0,
2354 "Returns the width in pixels of the display FRAME is on.")
2355 (frame)
2356 Lisp_Object frame;
2357 {
2358 Display *dpy = x_current_display;
2359 return make_number (DisplayWidth (dpy, DefaultScreen (dpy)));
2360 }
2361
2362 DEFUN ("x-display-pixel-height", Fx_display_pixel_height,
2363 Sx_display_pixel_height, 0, 1, 0,
2364 "Returns the height in pixels of the display FRAME is on.")
2365 (frame)
2366 Lisp_Object frame;
2367 {
2368 Display *dpy = x_current_display;
2369 return make_number (DisplayHeight (dpy, DefaultScreen (dpy)));
2370 }
2371
2372 DEFUN ("x-display-planes", Fx_display_planes, Sx_display_planes,
2373 0, 1, 0,
2374 "Returns the number of bitplanes of the display FRAME is on.")
2375 (frame)
2376 Lisp_Object frame;
2377 {
2378 Display *dpy = x_current_display;
2379 return make_number (DisplayPlanes (dpy, DefaultScreen (dpy)));
2380 }
2381
2382 DEFUN ("x-display-color-cells", Fx_display_color_cells, Sx_display_color_cells,
2383 0, 1, 0,
2384 "Returns the number of color cells of the display FRAME is on.")
2385 (frame)
2386 Lisp_Object frame;
2387 {
2388 Display *dpy = x_current_display;
2389 return make_number (DisplayCells (dpy, DefaultScreen (dpy)));
2390 }
2391
2392 DEFUN ("x-server-vendor", Fx_server_vendor, Sx_server_vendor, 0, 1, 0,
2393 "Returns the vendor ID string of the X server FRAME is on.")
2394 (frame)
2395 Lisp_Object frame;
2396 {
2397 Display *dpy = x_current_display;
2398 char *vendor;
2399 vendor = ServerVendor (dpy);
2400 if (! vendor) vendor = "";
2401 return build_string (vendor);
2402 }
2403
2404 DEFUN ("x-server-version", Fx_server_version, Sx_server_version, 0, 1, 0,
2405 "Returns the version numbers of the X server in use.\n\
2406 The value is a list of three integers: the major and minor\n\
2407 version numbers of the X Protocol in use, and the vendor-specific release\n\
2408 number. See also the variable `x-server-vendor'.")
2409 (frame)
2410 Lisp_Object frame;
2411 {
2412 Display *dpy = x_current_display;
2413 return Fcons (make_number (ProtocolVersion (dpy)),
2414 Fcons (make_number (ProtocolRevision (dpy)),
2415 Fcons (make_number (VendorRelease (dpy)), Qnil)));
2416 }
2417
2418 DEFUN ("x-display-screens", Fx_display_screens, Sx_display_screens, 0, 1, 0,
2419 "Returns the number of screens on the X server FRAME is on.")
2420 (frame)
2421 Lisp_Object frame;
2422 {
2423 return make_number (ScreenCount (x_current_display));
2424 }
2425
2426 DEFUN ("x-display-mm-height", Fx_display_mm_height, Sx_display_mm_height, 0, 1, 0,
2427 "Returns the height in millimeters of the X screen FRAME is on.")
2428 (frame)
2429 Lisp_Object frame;
2430 {
2431 return make_number (HeightMMOfScreen (x_screen));
2432 }
2433
2434 DEFUN ("x-display-mm-width", Fx_display_mm_width, Sx_display_mm_width, 0, 1, 0,
2435 "Returns the width in millimeters of the X screen FRAME is on.")
2436 (frame)
2437 Lisp_Object frame;
2438 {
2439 return make_number (WidthMMOfScreen (x_screen));
2440 }
2441
2442 DEFUN ("x-display-backing-store", Fx_display_backing_store,
2443 Sx_display_backing_store, 0, 1, 0,
2444 "Returns an indication of whether the X screen FRAME is on does backing store.\n\
2445 The value may be `always', `when-mapped', or `not-useful'.")
2446 (frame)
2447 Lisp_Object frame;
2448 {
2449 switch (DoesBackingStore (x_screen))
2450 {
2451 case Always:
2452 return intern ("always");
2453
2454 case WhenMapped:
2455 return intern ("when-mapped");
2456
2457 case NotUseful:
2458 return intern ("not-useful");
2459
2460 default:
2461 error ("Strange value for BackingStore parameter of screen");
2462 }
2463 }
2464
2465 DEFUN ("x-display-visual-class", Fx_display_visual_class,
2466 Sx_display_visual_class, 0, 1, 0,
2467 "Returns the visual class of the display `screen' is on.\n\
2468 The value is one of the symbols `static-gray', `gray-scale',\n\
2469 `static-color', `pseudo-color', `true-color', or `direct-color'.")
2470 (screen)
2471 Lisp_Object screen;
2472 {
2473 switch (screen_visual->class)
2474 {
2475 case StaticGray: return (intern ("static-gray"));
2476 case GrayScale: return (intern ("gray-scale"));
2477 case StaticColor: return (intern ("static-color"));
2478 case PseudoColor: return (intern ("pseudo-color"));
2479 case TrueColor: return (intern ("true-color"));
2480 case DirectColor: return (intern ("direct-color"));
2481 default:
2482 error ("Display has an unknown visual class");
2483 }
2484 }
2485
2486 DEFUN ("x-display-save-under", Fx_display_save_under,
2487 Sx_display_save_under, 0, 1, 0,
2488 "Returns t if the X screen FRAME is on supports the save-under feature.")
2489 (frame)
2490 Lisp_Object frame;
2491 {
2492 if (DoesSaveUnders (x_screen) == True)
2493 return Qt;
2494 else
2495 return Qnil;
2496 }
2497 \f
2498 x_pixel_width (f)
2499 register struct frame *f;
2500 {
2501 return PIXEL_WIDTH (f);
2502 }
2503
2504 x_pixel_height (f)
2505 register struct frame *f;
2506 {
2507 return PIXEL_HEIGHT (f);
2508 }
2509
2510 x_char_width (f)
2511 register struct frame *f;
2512 {
2513 return FONT_WIDTH (f->display.x->font);
2514 }
2515
2516 x_char_height (f)
2517 register struct frame *f;
2518 {
2519 return FONT_HEIGHT (f->display.x->font);
2520 }
2521 \f
2522 #if 0 /* These no longer seem like the right way to do things. */
2523
2524 /* Draw a rectangle on the frame with left top corner including
2525 the character specified by LEFT_CHAR and TOP_CHAR. The rectangle is
2526 CHARS by LINES wide and long and is the color of the cursor. */
2527
2528 void
2529 x_rectangle (f, gc, left_char, top_char, chars, lines)
2530 register struct frame *f;
2531 GC gc;
2532 register int top_char, left_char, chars, lines;
2533 {
2534 int width;
2535 int height;
2536 int left = (left_char * FONT_WIDTH (f->display.x->font)
2537 + f->display.x->internal_border_width);
2538 int top = (top_char * FONT_HEIGHT (f->display.x->font)
2539 + f->display.x->internal_border_width);
2540
2541 if (chars < 0)
2542 width = FONT_WIDTH (f->display.x->font) / 2;
2543 else
2544 width = FONT_WIDTH (f->display.x->font) * chars;
2545 if (lines < 0)
2546 height = FONT_HEIGHT (f->display.x->font) / 2;
2547 else
2548 height = FONT_HEIGHT (f->display.x->font) * lines;
2549
2550 XDrawRectangle (x_current_display, FRAME_X_WINDOW (f),
2551 gc, left, top, width, height);
2552 }
2553
2554 DEFUN ("x-draw-rectangle", Fx_draw_rectangle, Sx_draw_rectangle, 5, 5, 0,
2555 "Draw a rectangle on FRAME between coordinates specified by\n\
2556 numbers X0, Y0, X1, Y1 in the cursor pixel.")
2557 (frame, X0, Y0, X1, Y1)
2558 register Lisp_Object frame, X0, X1, Y0, Y1;
2559 {
2560 register int x0, y0, x1, y1, top, left, n_chars, n_lines;
2561
2562 CHECK_LIVE_FRAME (frame, 0);
2563 CHECK_NUMBER (X0, 0);
2564 CHECK_NUMBER (Y0, 1);
2565 CHECK_NUMBER (X1, 2);
2566 CHECK_NUMBER (Y1, 3);
2567
2568 x0 = XINT (X0);
2569 x1 = XINT (X1);
2570 y0 = XINT (Y0);
2571 y1 = XINT (Y1);
2572
2573 if (y1 > y0)
2574 {
2575 top = y0;
2576 n_lines = y1 - y0 + 1;
2577 }
2578 else
2579 {
2580 top = y1;
2581 n_lines = y0 - y1 + 1;
2582 }
2583
2584 if (x1 > x0)
2585 {
2586 left = x0;
2587 n_chars = x1 - x0 + 1;
2588 }
2589 else
2590 {
2591 left = x1;
2592 n_chars = x0 - x1 + 1;
2593 }
2594
2595 BLOCK_INPUT;
2596 x_rectangle (XFRAME (frame), XFRAME (frame)->display.x->cursor_gc,
2597 left, top, n_chars, n_lines);
2598 UNBLOCK_INPUT;
2599
2600 return Qt;
2601 }
2602
2603 DEFUN ("x-erase-rectangle", Fx_erase_rectangle, Sx_erase_rectangle, 5, 5, 0,
2604 "Draw a rectangle drawn on FRAME between coordinates\n\
2605 X0, Y0, X1, Y1 in the regular background-pixel.")
2606 (frame, X0, Y0, X1, Y1)
2607 register Lisp_Object frame, X0, Y0, X1, Y1;
2608 {
2609 register int x0, y0, x1, y1, top, left, n_chars, n_lines;
2610
2611 CHECK_FRAME (frame, 0);
2612 CHECK_NUMBER (X0, 0);
2613 CHECK_NUMBER (Y0, 1);
2614 CHECK_NUMBER (X1, 2);
2615 CHECK_NUMBER (Y1, 3);
2616
2617 x0 = XINT (X0);
2618 x1 = XINT (X1);
2619 y0 = XINT (Y0);
2620 y1 = XINT (Y1);
2621
2622 if (y1 > y0)
2623 {
2624 top = y0;
2625 n_lines = y1 - y0 + 1;
2626 }
2627 else
2628 {
2629 top = y1;
2630 n_lines = y0 - y1 + 1;
2631 }
2632
2633 if (x1 > x0)
2634 {
2635 left = x0;
2636 n_chars = x1 - x0 + 1;
2637 }
2638 else
2639 {
2640 left = x1;
2641 n_chars = x0 - x1 + 1;
2642 }
2643
2644 BLOCK_INPUT;
2645 x_rectangle (XFRAME (frame), XFRAME (frame)->display.x->reverse_gc,
2646 left, top, n_chars, n_lines);
2647 UNBLOCK_INPUT;
2648
2649 return Qt;
2650 }
2651
2652 /* Draw lines around the text region beginning at the character position
2653 TOP_X, TOP_Y and ending at BOTTOM_X and BOTTOM_Y. GC specifies the
2654 pixel and line characteristics. */
2655
2656 #define line_len(line) (FRAME_CURRENT_GLYPHS (f)->used[(line)])
2657
2658 static void
2659 outline_region (f, gc, top_x, top_y, bottom_x, bottom_y)
2660 register struct frame *f;
2661 GC gc;
2662 int top_x, top_y, bottom_x, bottom_y;
2663 {
2664 register int ibw = f->display.x->internal_border_width;
2665 register int font_w = FONT_WIDTH (f->display.x->font);
2666 register int font_h = FONT_HEIGHT (f->display.x->font);
2667 int y = top_y;
2668 int x = line_len (y);
2669 XPoint *pixel_points = (XPoint *)
2670 alloca (((bottom_y - top_y + 2) * 4) * sizeof (XPoint));
2671 register XPoint *this_point = pixel_points;
2672
2673 /* Do the horizontal top line/lines */
2674 if (top_x == 0)
2675 {
2676 this_point->x = ibw;
2677 this_point->y = ibw + (font_h * top_y);
2678 this_point++;
2679 if (x == 0)
2680 this_point->x = ibw + (font_w / 2); /* Half-size for newline chars. */
2681 else
2682 this_point->x = ibw + (font_w * x);
2683 this_point->y = (this_point - 1)->y;
2684 }
2685 else
2686 {
2687 this_point->x = ibw;
2688 this_point->y = ibw + (font_h * (top_y + 1));
2689 this_point++;
2690 this_point->x = ibw + (font_w * top_x);
2691 this_point->y = (this_point - 1)->y;
2692 this_point++;
2693 this_point->x = (this_point - 1)->x;
2694 this_point->y = ibw + (font_h * top_y);
2695 this_point++;
2696 this_point->x = ibw + (font_w * x);
2697 this_point->y = (this_point - 1)->y;
2698 }
2699
2700 /* Now do the right side. */
2701 while (y < bottom_y)
2702 { /* Right vertical edge */
2703 this_point++;
2704 this_point->x = (this_point - 1)->x;
2705 this_point->y = ibw + (font_h * (y + 1));
2706 this_point++;
2707
2708 y++; /* Horizontal connection to next line */
2709 x = line_len (y);
2710 if (x == 0)
2711 this_point->x = ibw + (font_w / 2);
2712 else
2713 this_point->x = ibw + (font_w * x);
2714
2715 this_point->y = (this_point - 1)->y;
2716 }
2717
2718 /* Now do the bottom and connect to the top left point. */
2719 this_point->x = ibw + (font_w * (bottom_x + 1));
2720
2721 this_point++;
2722 this_point->x = (this_point - 1)->x;
2723 this_point->y = ibw + (font_h * (bottom_y + 1));
2724 this_point++;
2725 this_point->x = ibw;
2726 this_point->y = (this_point - 1)->y;
2727 this_point++;
2728 this_point->x = pixel_points->x;
2729 this_point->y = pixel_points->y;
2730
2731 XDrawLines (x_current_display, FRAME_X_WINDOW (f),
2732 gc, pixel_points,
2733 (this_point - pixel_points + 1), CoordModeOrigin);
2734 }
2735
2736 DEFUN ("x-contour-region", Fx_contour_region, Sx_contour_region, 1, 1, 0,
2737 "Highlight the region between point and the character under the mouse\n\
2738 selected frame.")
2739 (event)
2740 register Lisp_Object event;
2741 {
2742 register int x0, y0, x1, y1;
2743 register struct frame *f = selected_frame;
2744 register int p1, p2;
2745
2746 CHECK_CONS (event, 0);
2747
2748 BLOCK_INPUT;
2749 x0 = XINT (Fcar (Fcar (event)));
2750 y0 = XINT (Fcar (Fcdr (Fcar (event))));
2751
2752 /* If the mouse is past the end of the line, don't that area. */
2753 /* ReWrite this... */
2754
2755 x1 = f->cursor_x;
2756 y1 = f->cursor_y;
2757
2758 if (y1 > y0) /* point below mouse */
2759 outline_region (f, f->display.x->cursor_gc,
2760 x0, y0, x1, y1);
2761 else if (y1 < y0) /* point above mouse */
2762 outline_region (f, f->display.x->cursor_gc,
2763 x1, y1, x0, y0);
2764 else /* same line: draw horizontal rectangle */
2765 {
2766 if (x1 > x0)
2767 x_rectangle (f, f->display.x->cursor_gc,
2768 x0, y0, (x1 - x0 + 1), 1);
2769 else if (x1 < x0)
2770 x_rectangle (f, f->display.x->cursor_gc,
2771 x1, y1, (x0 - x1 + 1), 1);
2772 }
2773
2774 XFlush (x_current_display);
2775 UNBLOCK_INPUT;
2776
2777 return Qnil;
2778 }
2779
2780 DEFUN ("x-uncontour-region", Fx_uncontour_region, Sx_uncontour_region, 1, 1, 0,
2781 "Erase any highlighting of the region between point and the character\n\
2782 at X, Y on the selected frame.")
2783 (event)
2784 register Lisp_Object event;
2785 {
2786 register int x0, y0, x1, y1;
2787 register struct frame *f = selected_frame;
2788
2789 BLOCK_INPUT;
2790 x0 = XINT (Fcar (Fcar (event)));
2791 y0 = XINT (Fcar (Fcdr (Fcar (event))));
2792 x1 = f->cursor_x;
2793 y1 = f->cursor_y;
2794
2795 if (y1 > y0) /* point below mouse */
2796 outline_region (f, f->display.x->reverse_gc,
2797 x0, y0, x1, y1);
2798 else if (y1 < y0) /* point above mouse */
2799 outline_region (f, f->display.x->reverse_gc,
2800 x1, y1, x0, y0);
2801 else /* same line: draw horizontal rectangle */
2802 {
2803 if (x1 > x0)
2804 x_rectangle (f, f->display.x->reverse_gc,
2805 x0, y0, (x1 - x0 + 1), 1);
2806 else if (x1 < x0)
2807 x_rectangle (f, f->display.x->reverse_gc,
2808 x1, y1, (x0 - x1 + 1), 1);
2809 }
2810 UNBLOCK_INPUT;
2811
2812 return Qnil;
2813 }
2814
2815 #if 0
2816 int contour_begin_x, contour_begin_y;
2817 int contour_end_x, contour_end_y;
2818 int contour_npoints;
2819
2820 /* Clip the top part of the contour lines down (and including) line Y_POS.
2821 If X_POS is in the middle (rather than at the end) of the line, drop
2822 down a line at that character. */
2823
2824 static void
2825 clip_contour_top (y_pos, x_pos)
2826 {
2827 register XPoint *begin = contour_lines[y_pos].top_left;
2828 register XPoint *end;
2829 register int npoints;
2830 register struct display_line *line = selected_frame->phys_lines[y_pos + 1];
2831
2832 if (x_pos >= line->len - 1) /* Draw one, straight horizontal line. */
2833 {
2834 end = contour_lines[y_pos].top_right;
2835 npoints = (end - begin + 1);
2836 XDrawLines (x_current_display, contour_window,
2837 contour_erase_gc, begin_erase, npoints, CoordModeOrigin);
2838
2839 bcopy (end, begin + 1, contour_last_point - end + 1);
2840 contour_last_point -= (npoints - 2);
2841 XDrawLines (x_current_display, contour_window,
2842 contour_erase_gc, begin, 2, CoordModeOrigin);
2843 XFlush (x_current_display);
2844
2845 /* Now, update contour_lines structure. */
2846 }
2847 /* ______. */
2848 else /* |________*/
2849 {
2850 register XPoint *p = begin + 1;
2851 end = contour_lines[y_pos].bottom_right;
2852 npoints = (end - begin + 1);
2853 XDrawLines (x_current_display, contour_window,
2854 contour_erase_gc, begin_erase, npoints, CoordModeOrigin);
2855
2856 p->y = begin->y;
2857 p->x = ibw + (font_w * (x_pos + 1));
2858 p++;
2859 p->y = begin->y + font_h;
2860 p->x = (p - 1)->x;
2861 bcopy (end, begin + 3, contour_last_point - end + 1);
2862 contour_last_point -= (npoints - 5);
2863 XDrawLines (x_current_display, contour_window,
2864 contour_erase_gc, begin, 4, CoordModeOrigin);
2865 XFlush (x_current_display);
2866
2867 /* Now, update contour_lines structure. */
2868 }
2869 }
2870
2871 /* Erase the top horzontal lines of the contour, and then extend
2872 the contour upwards. */
2873
2874 static void
2875 extend_contour_top (line)
2876 {
2877 }
2878
2879 static void
2880 clip_contour_bottom (x_pos, y_pos)
2881 int x_pos, y_pos;
2882 {
2883 }
2884
2885 static void
2886 extend_contour_bottom (x_pos, y_pos)
2887 {
2888 }
2889
2890 DEFUN ("x-select-region", Fx_select_region, Sx_select_region, 1, 1, "e",
2891 "")
2892 (event)
2893 Lisp_Object event;
2894 {
2895 register struct frame *f = selected_frame;
2896 register int point_x = f->cursor_x;
2897 register int point_y = f->cursor_y;
2898 register int mouse_below_point;
2899 register Lisp_Object obj;
2900 register int x_contour_x, x_contour_y;
2901
2902 x_contour_x = x_mouse_x;
2903 x_contour_y = x_mouse_y;
2904 if (x_contour_y > point_y || (x_contour_y == point_y
2905 && x_contour_x > point_x))
2906 {
2907 mouse_below_point = 1;
2908 outline_region (f, f->display.x->cursor_gc, point_x, point_y,
2909 x_contour_x, x_contour_y);
2910 }
2911 else
2912 {
2913 mouse_below_point = 0;
2914 outline_region (f, f->display.x->cursor_gc, x_contour_x, x_contour_y,
2915 point_x, point_y);
2916 }
2917
2918 while (1)
2919 {
2920 obj = read_char (-1, 0, 0, Qnil, 0);
2921 if (XTYPE (obj) != Lisp_Cons)
2922 break;
2923
2924 if (mouse_below_point)
2925 {
2926 if (x_mouse_y <= point_y) /* Flipped. */
2927 {
2928 mouse_below_point = 0;
2929
2930 outline_region (f, f->display.x->reverse_gc, point_x, point_y,
2931 x_contour_x, x_contour_y);
2932 outline_region (f, f->display.x->cursor_gc, x_mouse_x, x_mouse_y,
2933 point_x, point_y);
2934 }
2935 else if (x_mouse_y < x_contour_y) /* Bottom clipped. */
2936 {
2937 clip_contour_bottom (x_mouse_y);
2938 }
2939 else if (x_mouse_y > x_contour_y) /* Bottom extended. */
2940 {
2941 extend_bottom_contour (x_mouse_y);
2942 }
2943
2944 x_contour_x = x_mouse_x;
2945 x_contour_y = x_mouse_y;
2946 }
2947 else /* mouse above or same line as point */
2948 {
2949 if (x_mouse_y >= point_y) /* Flipped. */
2950 {
2951 mouse_below_point = 1;
2952
2953 outline_region (f, f->display.x->reverse_gc,
2954 x_contour_x, x_contour_y, point_x, point_y);
2955 outline_region (f, f->display.x->cursor_gc, point_x, point_y,
2956 x_mouse_x, x_mouse_y);
2957 }
2958 else if (x_mouse_y > x_contour_y) /* Top clipped. */
2959 {
2960 clip_contour_top (x_mouse_y);
2961 }
2962 else if (x_mouse_y < x_contour_y) /* Top extended. */
2963 {
2964 extend_contour_top (x_mouse_y);
2965 }
2966 }
2967 }
2968
2969 unread_command_event = obj;
2970 if (mouse_below_point)
2971 {
2972 contour_begin_x = point_x;
2973 contour_begin_y = point_y;
2974 contour_end_x = x_contour_x;
2975 contour_end_y = x_contour_y;
2976 }
2977 else
2978 {
2979 contour_begin_x = x_contour_x;
2980 contour_begin_y = x_contour_y;
2981 contour_end_x = point_x;
2982 contour_end_y = point_y;
2983 }
2984 }
2985 #endif
2986
2987 DEFUN ("x-horizontal-line", Fx_horizontal_line, Sx_horizontal_line, 1, 1, "e",
2988 "")
2989 (event)
2990 Lisp_Object event;
2991 {
2992 register Lisp_Object obj;
2993 struct frame *f = selected_frame;
2994 register struct window *w = XWINDOW (selected_window);
2995 register GC line_gc = f->display.x->cursor_gc;
2996 register GC erase_gc = f->display.x->reverse_gc;
2997 #if 0
2998 char dash_list[] = {6, 4, 6, 4};
2999 int dashes = 4;
3000 XGCValues gc_values;
3001 #endif
3002 register int previous_y;
3003 register int line = (x_mouse_y + 1) * FONT_HEIGHT (f->display.x->font)
3004 + f->display.x->internal_border_width;
3005 register int left = f->display.x->internal_border_width
3006 + (w->left
3007 * FONT_WIDTH (f->display.x->font));
3008 register int right = left + (w->width
3009 * FONT_WIDTH (f->display.x->font))
3010 - f->display.x->internal_border_width;
3011
3012 #if 0
3013 BLOCK_INPUT;
3014 gc_values.foreground = f->display.x->cursor_pixel;
3015 gc_values.background = f->display.x->background_pixel;
3016 gc_values.line_width = 1;
3017 gc_values.line_style = LineOnOffDash;
3018 gc_values.cap_style = CapRound;
3019 gc_values.join_style = JoinRound;
3020
3021 line_gc = XCreateGC (x_current_display, FRAME_X_WINDOW (f),
3022 GCLineStyle | GCJoinStyle | GCCapStyle
3023 | GCLineWidth | GCForeground | GCBackground,
3024 &gc_values);
3025 XSetDashes (x_current_display, line_gc, 0, dash_list, dashes);
3026 gc_values.foreground = f->display.x->background_pixel;
3027 gc_values.background = f->display.x->foreground_pixel;
3028 erase_gc = XCreateGC (x_current_display, FRAME_X_WINDOW (f),
3029 GCLineStyle | GCJoinStyle | GCCapStyle
3030 | GCLineWidth | GCForeground | GCBackground,
3031 &gc_values);
3032 XSetDashes (x_current_display, erase_gc, 0, dash_list, dashes);
3033 #endif
3034
3035 while (1)
3036 {
3037 BLOCK_INPUT;
3038 if (x_mouse_y >= XINT (w->top)
3039 && x_mouse_y < XINT (w->top) + XINT (w->height) - 1)
3040 {
3041 previous_y = x_mouse_y;
3042 line = (x_mouse_y + 1) * FONT_HEIGHT (f->display.x->font)
3043 + f->display.x->internal_border_width;
3044 XDrawLine (x_current_display, FRAME_X_WINDOW (f),
3045 line_gc, left, line, right, line);
3046 }
3047 XFlushQueue ();
3048 UNBLOCK_INPUT;
3049
3050 do
3051 {
3052 obj = read_char (-1, 0, 0, Qnil, 0);
3053 if ((XTYPE (obj) != Lisp_Cons)
3054 || (! EQ (Fcar (Fcdr (Fcdr (obj))),
3055 Qvertical_scroll_bar))
3056 || x_mouse_grabbed)
3057 {
3058 BLOCK_INPUT;
3059 XDrawLine (x_current_display, FRAME_X_WINDOW (f),
3060 erase_gc, left, line, right, line);
3061 UNBLOCK_INPUT;
3062 unread_command_event = obj;
3063 #if 0
3064 XFreeGC (x_current_display, line_gc);
3065 XFreeGC (x_current_display, erase_gc);
3066 #endif
3067 return Qnil;
3068 }
3069 }
3070 while (x_mouse_y == previous_y);
3071
3072 BLOCK_INPUT;
3073 XDrawLine (x_current_display, FRAME_X_WINDOW (f),
3074 erase_gc, left, line, right, line);
3075 UNBLOCK_INPUT;
3076 }
3077 }
3078 #endif
3079 \f
3080 /* Offset in buffer of character under the pointer, or 0. */
3081 int mouse_buffer_offset;
3082
3083 #if 0
3084 /* These keep track of the rectangle following the pointer. */
3085 int mouse_track_top, mouse_track_left, mouse_track_width;
3086
3087 DEFUN ("x-track-pointer", Fx_track_pointer, Sx_track_pointer, 0, 0, 0,
3088 "Track the pointer.")
3089 ()
3090 {
3091 static Cursor current_pointer_shape;
3092 FRAME_PTR f = x_mouse_frame;
3093
3094 BLOCK_INPUT;
3095 if (EQ (Vmouse_frame_part, Qtext_part)
3096 && (current_pointer_shape != f->display.x->nontext_cursor))
3097 {
3098 unsigned char c;
3099 struct buffer *buf;
3100
3101 current_pointer_shape = f->display.x->nontext_cursor;
3102 XDefineCursor (x_current_display,
3103 FRAME_X_WINDOW (f),
3104 current_pointer_shape);
3105
3106 buf = XBUFFER (XWINDOW (Vmouse_window)->buffer);
3107 c = *(BUF_CHAR_ADDRESS (buf, mouse_buffer_offset));
3108 }
3109 else if (EQ (Vmouse_frame_part, Qmodeline_part)
3110 && (current_pointer_shape != f->display.x->modeline_cursor))
3111 {
3112 current_pointer_shape = f->display.x->modeline_cursor;
3113 XDefineCursor (x_current_display,
3114 FRAME_X_WINDOW (f),
3115 current_pointer_shape);
3116 }
3117
3118 XFlushQueue ();
3119 UNBLOCK_INPUT;
3120 }
3121 #endif
3122
3123 #if 0
3124 DEFUN ("x-track-pointer", Fx_track_pointer, Sx_track_pointer, 1, 1, "e",
3125 "Draw rectangle around character under mouse pointer, if there is one.")
3126 (event)
3127 Lisp_Object event;
3128 {
3129 struct window *w = XWINDOW (Vmouse_window);
3130 struct frame *f = XFRAME (WINDOW_FRAME (w));
3131 struct buffer *b = XBUFFER (w->buffer);
3132 Lisp_Object obj;
3133
3134 if (! EQ (Vmouse_window, selected_window))
3135 return Qnil;
3136
3137 if (EQ (event, Qnil))
3138 {
3139 int x, y;
3140
3141 x_read_mouse_position (selected_frame, &x, &y);
3142 }
3143
3144 BLOCK_INPUT;
3145 mouse_track_width = 0;
3146 mouse_track_left = mouse_track_top = -1;
3147
3148 do
3149 {
3150 if ((x_mouse_x != mouse_track_left
3151 && (x_mouse_x < mouse_track_left
3152 || x_mouse_x > (mouse_track_left + mouse_track_width)))
3153 || x_mouse_y != mouse_track_top)
3154 {
3155 int hp = 0; /* Horizontal position */
3156 int len = FRAME_CURRENT_GLYPHS (f)->used[x_mouse_y];
3157 int p = FRAME_CURRENT_GLYPHS (f)->bufp[x_mouse_y];
3158 int tab_width = XINT (b->tab_width);
3159 int ctl_arrow_p = !NILP (b->ctl_arrow);
3160 unsigned char c;
3161 int mode_line_vpos = XFASTINT (w->height) + XFASTINT (w->top) - 1;
3162 int in_mode_line = 0;
3163
3164 if (! FRAME_CURRENT_GLYPHS (f)->enable[x_mouse_y])
3165 break;
3166
3167 /* Erase previous rectangle. */
3168 if (mouse_track_width)
3169 {
3170 x_rectangle (f, f->display.x->reverse_gc,
3171 mouse_track_left, mouse_track_top,
3172 mouse_track_width, 1);
3173
3174 if ((mouse_track_left == f->phys_cursor_x
3175 || mouse_track_left == f->phys_cursor_x - 1)
3176 && mouse_track_top == f->phys_cursor_y)
3177 {
3178 x_display_cursor (f, 1);
3179 }
3180 }
3181
3182 mouse_track_left = x_mouse_x;
3183 mouse_track_top = x_mouse_y;
3184 mouse_track_width = 0;
3185
3186 if (mouse_track_left > len) /* Past the end of line. */
3187 goto draw_or_not;
3188
3189 if (mouse_track_top == mode_line_vpos)
3190 {
3191 in_mode_line = 1;
3192 goto draw_or_not;
3193 }
3194
3195 if (tab_width <= 0 || tab_width > 20) tab_width = 8;
3196 do
3197 {
3198 c = FETCH_CHAR (p);
3199 if (len == f->width && hp == len - 1 && c != '\n')
3200 goto draw_or_not;
3201
3202 switch (c)
3203 {
3204 case '\t':
3205 mouse_track_width = tab_width - (hp % tab_width);
3206 p++;
3207 hp += mouse_track_width;
3208 if (hp > x_mouse_x)
3209 {
3210 mouse_track_left = hp - mouse_track_width;
3211 goto draw_or_not;
3212 }
3213 continue;
3214
3215 case '\n':
3216 mouse_track_width = -1;
3217 goto draw_or_not;
3218
3219 default:
3220 if (ctl_arrow_p && (c < 040 || c == 0177))
3221 {
3222 if (p > ZV)
3223 goto draw_or_not;
3224
3225 mouse_track_width = 2;
3226 p++;
3227 hp +=2;
3228 if (hp > x_mouse_x)
3229 {
3230 mouse_track_left = hp - mouse_track_width;
3231 goto draw_or_not;
3232 }
3233 }
3234 else
3235 {
3236 mouse_track_width = 1;
3237 p++;
3238 hp++;
3239 }
3240 continue;
3241 }
3242 }
3243 while (hp <= x_mouse_x);
3244
3245 draw_or_not:
3246 if (mouse_track_width) /* Over text; use text pointer shape. */
3247 {
3248 XDefineCursor (x_current_display,
3249 FRAME_X_WINDOW (f),
3250 f->display.x->text_cursor);
3251 x_rectangle (f, f->display.x->cursor_gc,
3252 mouse_track_left, mouse_track_top,
3253 mouse_track_width, 1);
3254 }
3255 else if (in_mode_line)
3256 XDefineCursor (x_current_display,
3257 FRAME_X_WINDOW (f),
3258 f->display.x->modeline_cursor);
3259 else
3260 XDefineCursor (x_current_display,
3261 FRAME_X_WINDOW (f),
3262 f->display.x->nontext_cursor);
3263 }
3264
3265 XFlush (x_current_display);
3266 UNBLOCK_INPUT;
3267
3268 obj = read_char (-1, 0, 0, Qnil, 0);
3269 BLOCK_INPUT;
3270 }
3271 while (XTYPE (obj) == Lisp_Cons /* Mouse event */
3272 && EQ (Fcar (Fcdr (Fcdr (obj))), Qnil) /* Not scroll bar */
3273 && EQ (Vmouse_depressed, Qnil) /* Only motion events */
3274 && EQ (Vmouse_window, selected_window) /* In this window */
3275 && x_mouse_frame);
3276
3277 unread_command_event = obj;
3278
3279 if (mouse_track_width)
3280 {
3281 x_rectangle (f, f->display.x->reverse_gc,
3282 mouse_track_left, mouse_track_top,
3283 mouse_track_width, 1);
3284 mouse_track_width = 0;
3285 if ((mouse_track_left == f->phys_cursor_x
3286 || mouse_track_left - 1 == f->phys_cursor_x)
3287 && mouse_track_top == f->phys_cursor_y)
3288 {
3289 x_display_cursor (f, 1);
3290 }
3291 }
3292 XDefineCursor (x_current_display,
3293 FRAME_X_WINDOW (f),
3294 f->display.x->nontext_cursor);
3295 XFlush (x_current_display);
3296 UNBLOCK_INPUT;
3297
3298 return Qnil;
3299 }
3300 #endif
3301 \f
3302 #if 0
3303 #include "glyphs.h"
3304
3305 /* Draw a pixmap specified by IMAGE_DATA of dimensions WIDTH and HEIGHT
3306 on the frame F at position X, Y. */
3307
3308 x_draw_pixmap (f, x, y, image_data, width, height)
3309 struct frame *f;
3310 int x, y, width, height;
3311 char *image_data;
3312 {
3313 Pixmap image;
3314
3315 image = XCreateBitmapFromData (x_current_display,
3316 FRAME_X_WINDOW (f), image_data,
3317 width, height);
3318 XCopyPlane (x_current_display, image, FRAME_X_WINDOW (f),
3319 f->display.x->normal_gc, 0, 0, width, height, x, y);
3320 }
3321 #endif
3322 \f
3323 #ifndef HAVE_X11
3324 DEFUN ("x-store-cut-buffer", Fx_store_cut_buffer, Sx_store_cut_buffer,
3325 1, 1, "sStore text in cut buffer: ",
3326 "Store contents of STRING into the cut buffer of the X window system.")
3327 (string)
3328 register Lisp_Object string;
3329 {
3330 int mask;
3331
3332 CHECK_STRING (string, 1);
3333 if (! FRAME_X_P (selected_frame))
3334 error ("Selected frame does not understand X protocol.");
3335
3336 BLOCK_INPUT;
3337 XStoreBytes ((char *) XSTRING (string)->data, XSTRING (string)->size);
3338 UNBLOCK_INPUT;
3339
3340 return Qnil;
3341 }
3342
3343 DEFUN ("x-get-cut-buffer", Fx_get_cut_buffer, Sx_get_cut_buffer, 0, 0, 0,
3344 "Return contents of cut buffer of the X window system, as a string.")
3345 ()
3346 {
3347 int len;
3348 register Lisp_Object string;
3349 int mask;
3350 register char *d;
3351
3352 BLOCK_INPUT;
3353 d = XFetchBytes (&len);
3354 string = make_string (d, len);
3355 XFree (d);
3356 UNBLOCK_INPUT;
3357 return string;
3358 }
3359 #endif /* X10 */
3360 \f
3361 #ifdef HAVE_X11
3362 DEFUN ("x-rebind-key", Fx_rebind_key, Sx_rebind_key, 3, 3, 0,
3363 "Rebind X keysym KEYSYM, with MODIFIERS, to generate NEWSTRING.\n\
3364 KEYSYM is a string which conforms to the X keysym definitions found\n\
3365 in X11/keysymdef.h, sans the initial XK_. MODIFIERS is nil or a\n\
3366 list of strings specifying modifier keys such as Control_L, which must\n\
3367 also be depressed for NEWSTRING to appear.")
3368 (x_keysym, modifiers, newstring)
3369 register Lisp_Object x_keysym;
3370 register Lisp_Object modifiers;
3371 register Lisp_Object newstring;
3372 {
3373 char *rawstring;
3374 register KeySym keysym;
3375 KeySym modifier_list[16];
3376
3377 CHECK_STRING (x_keysym, 1);
3378 CHECK_STRING (newstring, 3);
3379
3380 keysym = XStringToKeysym ((char *) XSTRING (x_keysym)->data);
3381 if (keysym == NoSymbol)
3382 error ("Keysym does not exist");
3383
3384 if (NILP (modifiers))
3385 XRebindKeysym (x_current_display, keysym, modifier_list, 0,
3386 XSTRING (newstring)->data, XSTRING (newstring)->size);
3387 else
3388 {
3389 register Lisp_Object rest, mod;
3390 register int i = 0;
3391
3392 for (rest = modifiers; !NILP (rest); rest = Fcdr (rest))
3393 {
3394 if (i == 16)
3395 error ("Can't have more than 16 modifiers");
3396
3397 mod = Fcar (rest);
3398 CHECK_STRING (mod, 3);
3399 modifier_list[i] = XStringToKeysym ((char *) XSTRING (mod)->data);
3400 if (modifier_list[i] == NoSymbol
3401 || !IsModifierKey (modifier_list[i]))
3402 error ("Element is not a modifier keysym");
3403 i++;
3404 }
3405
3406 XRebindKeysym (x_current_display, keysym, modifier_list, i,
3407 XSTRING (newstring)->data, XSTRING (newstring)->size);
3408 }
3409
3410 return Qnil;
3411 }
3412
3413 DEFUN ("x-rebind-keys", Fx_rebind_keys, Sx_rebind_keys, 2, 2, 0,
3414 "Rebind KEYCODE to list of strings STRINGS.\n\
3415 STRINGS should be a list of 16 elements, one for each shift combination.\n\
3416 nil as element means don't change.\n\
3417 See the documentation of `x-rebind-key' for more information.")
3418 (keycode, strings)
3419 register Lisp_Object keycode;
3420 register Lisp_Object strings;
3421 {
3422 register Lisp_Object item;
3423 register unsigned char *rawstring;
3424 KeySym rawkey, modifier[1];
3425 int strsize;
3426 register unsigned i;
3427
3428 CHECK_NUMBER (keycode, 1);
3429 CHECK_CONS (strings, 2);
3430 rawkey = (KeySym) ((unsigned) (XINT (keycode))) & 255;
3431 for (i = 0; i <= 15; strings = Fcdr (strings), i++)
3432 {
3433 item = Fcar (strings);
3434 if (!NILP (item))
3435 {
3436 CHECK_STRING (item, 2);
3437 strsize = XSTRING (item)->size;
3438 rawstring = (unsigned char *) xmalloc (strsize);
3439 bcopy (XSTRING (item)->data, rawstring, strsize);
3440 modifier[1] = 1 << i;
3441 XRebindKeysym (x_current_display, rawkey, modifier, 1,
3442 rawstring, strsize);
3443 }
3444 }
3445 return Qnil;
3446 }
3447 #else
3448 DEFUN ("x-rebind-key", Fx_rebind_key, Sx_rebind_key, 3, 3, 0,
3449 "Rebind KEYCODE, with shift bits SHIFT-MASK, to new string NEWSTRING.\n\
3450 KEYCODE and SHIFT-MASK should be numbers representing the X keyboard code\n\
3451 and shift mask respectively. NEWSTRING is an arbitrary string of keystrokes.\n\
3452 If SHIFT-MASK is nil, then KEYCODE's key will be bound to NEWSTRING for\n\
3453 all shift combinations.\n\
3454 Shift Lock 1 Shift 2\n\
3455 Meta 4 Control 8\n\
3456 \n\
3457 For values of KEYCODE, see /usr/lib/Xkeymap.txt (remember that the codes\n\
3458 in that file are in octal!)\n\
3459 \n\
3460 NOTE: due to an X bug, this function will not take effect unless one has\n\
3461 a `~/.Xkeymap' file. (See the documentation for the `keycomp' program.)\n\
3462 This problem will be fixed in X version 11.")
3463
3464 (keycode, shift_mask, newstring)
3465 register Lisp_Object keycode;
3466 register Lisp_Object shift_mask;
3467 register Lisp_Object newstring;
3468 {
3469 char *rawstring;
3470 int keysym, rawshift;
3471 int i, strsize;
3472
3473 CHECK_NUMBER (keycode, 1);
3474 if (!NILP (shift_mask))
3475 CHECK_NUMBER (shift_mask, 2);
3476 CHECK_STRING (newstring, 3);
3477 strsize = XSTRING (newstring)->size;
3478 rawstring = (char *) xmalloc (strsize);
3479 bcopy (XSTRING (newstring)->data, rawstring, strsize);
3480
3481 keysym = ((unsigned) (XINT (keycode))) & 255;
3482
3483 if (NILP (shift_mask))
3484 {
3485 for (i = 0; i <= 15; i++)
3486 XRebindCode (keysym, i<<11, rawstring, strsize);
3487 }
3488 else
3489 {
3490 rawshift = (((unsigned) (XINT (shift_mask))) & 15) << 11;
3491 XRebindCode (keysym, rawshift, rawstring, strsize);
3492 }
3493 return Qnil;
3494 }
3495
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;
3504 {
3505 register Lisp_Object item;
3506 register char *rawstring;
3507 KeySym rawkey, modifier[1];
3508 int strsize;
3509 register unsigned i;
3510
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++)
3515 {
3516 item = Fcar (strings);
3517 if (!NILP (item))
3518 {
3519 CHECK_STRING (item, 2);
3520 strsize = XSTRING (item)->size;
3521 rawstring = (char *) xmalloc (strsize);
3522 bcopy (XSTRING (item)->data, rawstring, strsize);
3523 XRebindCode (rawkey, i << 11, rawstring, strsize);
3524 }
3525 }
3526 return Qnil;
3527 }
3528 #endif /* not HAVE_X11 */
3529 \f
3530 #ifdef HAVE_X11
3531 Visual *
3532 select_visual (screen, depth)
3533 Screen *screen;
3534 unsigned int *depth;
3535 {
3536 Visual *v;
3537 XVisualInfo *vinfo, vinfo_template;
3538 int n_visuals;
3539
3540 v = DefaultVisualOfScreen (screen);
3541
3542 #ifdef HAVE_X11R4
3543 vinfo_template.visualid = XVisualIDFromVisual (v);
3544 #else
3545 vinfo_template.visualid = v->visualid;
3546 #endif
3547
3548 vinfo = XGetVisualInfo (x_current_display, VisualIDMask, &vinfo_template,
3549 &n_visuals);
3550 if (n_visuals != 1)
3551 fatal ("Can't get proper X visual info");
3552
3553 if ((1 << vinfo->depth) == vinfo->colormap_size)
3554 *depth = vinfo->depth;
3555 else
3556 {
3557 int i = 0;
3558 int n = vinfo->colormap_size - 1;
3559 while (n)
3560 {
3561 n = n >> 1;
3562 i++;
3563 }
3564 *depth = i;
3565 }
3566
3567 XFree ((char *) vinfo);
3568 return v;
3569 }
3570 #endif /* HAVE_X11 */
3571
3572 DEFUN ("x-open-connection", Fx_open_connection, Sx_open_connection,
3573 1, 2, 0, "Open a connection to an X server.\n\
3574 DISPLAY is the name of the display to connect to. Optional second\n\
3575 arg XRM_STRING is a string of resources in xrdb format.")
3576 (display, xrm_string)
3577 Lisp_Object display, xrm_string;
3578 {
3579 unsigned int n_planes;
3580 unsigned char *xrm_option;
3581
3582 CHECK_STRING (display, 0);
3583 if (x_current_display != 0)
3584 error ("X server connection is already initialized");
3585
3586 /* This is what opens the connection and sets x_current_display.
3587 This also initializes many symbols, such as those used for input. */
3588 x_term_init (XSTRING (display)->data);
3589
3590 #ifdef HAVE_X11
3591 XFASTINT (Vwindow_system_version) = 11;
3592
3593 if (!EQ (xrm_string, Qnil))
3594 {
3595 CHECK_STRING (xrm_string, 1);
3596 xrm_option = (unsigned char *) XSTRING (xrm_string);
3597 }
3598 else
3599 xrm_option = (unsigned char *) 0;
3600 xrdb = x_load_resources (x_current_display, xrm_option, EMACS_CLASS);
3601 #ifdef HAVE_X11R5
3602 XrmSetDatabase (x_current_display, xrdb);
3603 #else
3604 x_current_display->db = xrdb;
3605 #endif
3606
3607 x_screen = DefaultScreenOfDisplay (x_current_display);
3608
3609 screen_visual = select_visual (x_screen, &n_planes);
3610 x_screen_planes = n_planes;
3611 x_screen_height = HeightOfScreen (x_screen);
3612 x_screen_width = WidthOfScreen (x_screen);
3613
3614 /* X Atoms used by emacs. */
3615 Xatoms_of_xselect ();
3616 BLOCK_INPUT;
3617 Xatom_wm_protocols = XInternAtom (x_current_display, "WM_PROTOCOLS",
3618 False);
3619 Xatom_wm_take_focus = XInternAtom (x_current_display, "WM_TAKE_FOCUS",
3620 False);
3621 Xatom_wm_save_yourself = XInternAtom (x_current_display, "WM_SAVE_YOURSELF",
3622 False);
3623 Xatom_wm_delete_window = XInternAtom (x_current_display, "WM_DELETE_WINDOW",
3624 False);
3625 Xatom_wm_change_state = XInternAtom (x_current_display, "WM_CHANGE_STATE",
3626 False);
3627 Xatom_wm_configure_denied = XInternAtom (x_current_display,
3628 "WM_CONFIGURE_DENIED", False);
3629 Xatom_wm_window_moved = XInternAtom (x_current_display, "WM_MOVED",
3630 False);
3631 UNBLOCK_INPUT;
3632 #else /* not HAVE_X11 */
3633 XFASTINT (Vwindow_system_version) = 10;
3634 #endif /* not HAVE_X11 */
3635 return Qnil;
3636 }
3637
3638 DEFUN ("x-close-current-connection", Fx_close_current_connection,
3639 Sx_close_current_connection,
3640 0, 0, 0, "Close the connection to the current X server.")
3641 ()
3642 {
3643 #ifdef HAVE_X11
3644 /* This is ONLY used when killing emacs; For switching displays
3645 we'll have to take care of setting CloseDownMode elsewhere. */
3646
3647 if (x_current_display)
3648 {
3649 BLOCK_INPUT;
3650 XSetCloseDownMode (x_current_display, DestroyAll);
3651 XCloseDisplay (x_current_display);
3652 }
3653 else
3654 fatal ("No current X display connection to close\n");
3655 #endif
3656 return Qnil;
3657 }
3658
3659 DEFUN ("x-synchronize", Fx_synchronize, Sx_synchronize,
3660 1, 1, 0, "If ON is non-nil, report X errors as soon as the erring request is made.\n\
3661 If ON is nil, allow buffering of requests.\n\
3662 Turning on synchronization prohibits the Xlib routines from buffering\n\
3663 requests and seriously degrades performance, but makes debugging much\n\
3664 easier.")
3665 (on)
3666 Lisp_Object on;
3667 {
3668 XSynchronize (x_current_display, !EQ (on, Qnil));
3669
3670 return Qnil;
3671 }
3672
3673 \f
3674 syms_of_xfns ()
3675 {
3676 /* This is zero if not using X windows. */
3677 x_current_display = 0;
3678
3679 /* The section below is built by the lisp expression at the top of the file,
3680 just above where these variables are declared. */
3681 /*&&& init symbols here &&&*/
3682 Qauto_raise = intern ("auto-raise");
3683 staticpro (&Qauto_raise);
3684 Qauto_lower = intern ("auto-lower");
3685 staticpro (&Qauto_lower);
3686 Qbackground_color = intern ("background-color");
3687 staticpro (&Qbackground_color);
3688 Qbar = intern ("bar");
3689 staticpro (&Qbar);
3690 Qborder_color = intern ("border-color");
3691 staticpro (&Qborder_color);
3692 Qborder_width = intern ("border-width");
3693 staticpro (&Qborder_width);
3694 Qbox = intern ("box");
3695 staticpro (&Qbox);
3696 Qcursor_color = intern ("cursor-color");
3697 staticpro (&Qcursor_color);
3698 Qcursor_type = intern ("cursor-type");
3699 staticpro (&Qcursor_type);
3700 Qfont = intern ("font");
3701 staticpro (&Qfont);
3702 Qforeground_color = intern ("foreground-color");
3703 staticpro (&Qforeground_color);
3704 Qgeometry = intern ("geometry");
3705 staticpro (&Qgeometry);
3706 Qicon = intern ("icon");
3707 staticpro (&Qicon);
3708 Qicon_left = intern ("icon-left");
3709 staticpro (&Qicon_left);
3710 Qicon_top = intern ("icon-top");
3711 staticpro (&Qicon_top);
3712 Qicon_type = intern ("icon-type");
3713 staticpro (&Qicon_type);
3714 Qinternal_border_width = intern ("internal-border-width");
3715 staticpro (&Qinternal_border_width);
3716 Qleft = intern ("left");
3717 staticpro (&Qleft);
3718 Qmouse_color = intern ("mouse-color");
3719 staticpro (&Qmouse_color);
3720 Qnone = intern ("none");
3721 staticpro (&Qnone);
3722 Qparent_id = intern ("parent-id");
3723 staticpro (&Qparent_id);
3724 Qsuppress_icon = intern ("suppress-icon");
3725 staticpro (&Qsuppress_icon);
3726 Qtop = intern ("top");
3727 staticpro (&Qtop);
3728 Qundefined_color = intern ("undefined-color");
3729 staticpro (&Qundefined_color);
3730 Qvertical_scroll_bars = intern ("vertical-scroll-bars");
3731 staticpro (&Qvertical_scroll_bars);
3732 Qvisibility = intern ("visibility");
3733 staticpro (&Qvisibility);
3734 Qwindow_id = intern ("window-id");
3735 staticpro (&Qwindow_id);
3736 Qx_frame_parameter = intern ("x-frame-parameter");
3737 staticpro (&Qx_frame_parameter);
3738 /* This is the end of symbol initialization. */
3739
3740 Fput (Qundefined_color, Qerror_conditions,
3741 Fcons (Qundefined_color, Fcons (Qerror, Qnil)));
3742 Fput (Qundefined_color, Qerror_message,
3743 build_string ("Undefined color"));
3744
3745 init_x_parm_symbols ();
3746
3747 DEFVAR_INT ("mouse-buffer-offset", &mouse_buffer_offset,
3748 "The buffer offset of the character under the pointer.");
3749 mouse_buffer_offset = 0;
3750
3751 DEFVAR_INT ("x-pointer-shape", &Vx_pointer_shape,
3752 "The shape of the pointer when over text.\n\
3753 Changing the value does not affect existing frames\n\
3754 unless you set the mouse color.");
3755 Vx_pointer_shape = Qnil;
3756
3757 #if 0
3758 DEFVAR_INT ("x-nontext-pointer-shape", &Vx_nontext_pointer_shape,
3759 "The shape of the pointer when not over text.");
3760 #endif
3761 Vx_nontext_pointer_shape = Qnil;
3762
3763 #if 0
3764 DEFVAR_INT ("x-mode-pointer-shape", &Vx_mode_pointer_shape,
3765 "The shape of the pointer when over the mode line.");
3766 #endif
3767 Vx_mode_pointer_shape = Qnil;
3768
3769 DEFVAR_LISP ("x-cursor-fore-pixel", &Vx_cursor_fore_pixel,
3770 "A string indicating the foreground color of the cursor box.");
3771 Vx_cursor_fore_pixel = Qnil;
3772
3773 DEFVAR_LISP ("mouse-grabbed", &Vmouse_depressed,
3774 "Non-nil if a mouse button is currently depressed.");
3775 Vmouse_depressed = Qnil;
3776
3777 DEFVAR_LISP ("x-no-window-manager", &Vx_no_window_manager,
3778 "t if no X window manager is in use.");
3779
3780 #ifdef HAVE_X11
3781 defsubr (&Sx_get_resource);
3782 #if 0
3783 defsubr (&Sx_draw_rectangle);
3784 defsubr (&Sx_erase_rectangle);
3785 defsubr (&Sx_contour_region);
3786 defsubr (&Sx_uncontour_region);
3787 #endif
3788 defsubr (&Sx_display_color_p);
3789 defsubr (&Sx_color_defined_p);
3790 defsubr (&Sx_server_vendor);
3791 defsubr (&Sx_server_version);
3792 defsubr (&Sx_display_pixel_width);
3793 defsubr (&Sx_display_pixel_height);
3794 defsubr (&Sx_display_mm_width);
3795 defsubr (&Sx_display_mm_height);
3796 defsubr (&Sx_display_screens);
3797 defsubr (&Sx_display_planes);
3798 defsubr (&Sx_display_color_cells);
3799 defsubr (&Sx_display_visual_class);
3800 defsubr (&Sx_display_backing_store);
3801 defsubr (&Sx_display_save_under);
3802 #if 0
3803 defsubr (&Sx_track_pointer);
3804 defsubr (&Sx_grab_pointer);
3805 defsubr (&Sx_ungrab_pointer);
3806 #endif
3807 #else
3808 defsubr (&Sx_get_default);
3809 defsubr (&Sx_store_cut_buffer);
3810 defsubr (&Sx_get_cut_buffer);
3811 defsubr (&Sx_set_face);
3812 #endif
3813 defsubr (&Sx_parse_geometry);
3814 defsubr (&Sx_create_frame);
3815 defsubr (&Sfocus_frame);
3816 defsubr (&Sunfocus_frame);
3817 #if 0
3818 defsubr (&Sx_horizontal_line);
3819 #endif
3820 defsubr (&Sx_rebind_key);
3821 defsubr (&Sx_rebind_keys);
3822 defsubr (&Sx_open_connection);
3823 defsubr (&Sx_close_current_connection);
3824 defsubr (&Sx_synchronize);
3825 }
3826
3827 #endif /* HAVE_X_WINDOWS */