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