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