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