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