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