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