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