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