]> code.delx.au - gnu-emacs/blob - src/xfns.c
(message): Use message2, not message1.
[gnu-emacs] / src / xfns.c
1 /* Functions for the X window system.
2 Copyright (C) 1989, 1992, 1993 Free Software Foundation.
3
4 This file is part of GNU Emacs.
5
6 GNU Emacs is free software; you can redistribute it and/or modify
7 it under the terms of the GNU General Public License as published by
8 the Free Software Foundation; either version 2, or (at your option)
9 any later version.
10
11 GNU Emacs is distributed in the hope that it will be useful,
12 but WITHOUT ANY WARRANTY; without even the implied warranty of
13 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14 GNU General Public License for more details.
15
16 You should have received a copy of the GNU General Public License
17 along with GNU Emacs; see the file COPYING. If not, write to
18 the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. */
19
20 /* Completely rewritten by Richard Stallman. */
21
22 /* Rewritten for X11 by Joseph Arceneaux */
23
24 #if 0
25 #include <stdio.h>
26 #endif
27 #include <signal.h>
28 #include <config.h>
29 #include "lisp.h"
30 #include "xterm.h"
31 #include "frame.h"
32 #include "window.h"
33 #include "buffer.h"
34 #include "dispextern.h"
35 #include "keyboard.h"
36 #include "blockinput.h"
37
38 #ifdef HAVE_X_WINDOWS
39 extern void abort ();
40
41 #ifndef VMS
42 #if 1 /* Used to be #ifdef EMACS_BITMAP_FILES, but this should always work. */
43 #include "bitmaps/gray.xbm"
44 #else
45 #include <X11/bitmaps/gray>
46 #endif
47 #else
48 #include "[.bitmaps]gray.xbm"
49 #endif
50
51 #define min(a,b) ((a) < (b) ? (a) : (b))
52 #define max(a,b) ((a) > (b) ? (a) : (b))
53
54 #ifdef HAVE_X11
55 /* X Resource data base */
56 static XrmDatabase xrdb;
57
58 /* The class of this X application. */
59 #define EMACS_CLASS "Emacs"
60
61 #ifdef HAVE_X11R4
62 #define MAXREQUEST(dpy) (XMaxRequestSize (dpy))
63 #else
64 #define MAXREQUEST(dpy) ((dpy)->max_request_size)
65 #endif
66
67 /* The name we're using in resource queries. */
68 Lisp_Object Vx_resource_name;
69
70 /* Title name and application name for X stuff. */
71 extern char *x_id_name;
72
73 /* The background and shape of the mouse pointer, and shape when not
74 over text or in the modeline. */
75 Lisp_Object Vx_pointer_shape, Vx_nontext_pointer_shape, Vx_mode_pointer_shape;
76
77 /* Color of chars displayed in cursor box. */
78 Lisp_Object Vx_cursor_fore_pixel;
79
80 /* The screen being used. */
81 static Screen *x_screen;
82
83 /* The X Visual we are using for X windows (the default) */
84 Visual *screen_visual;
85
86 /* Height of this X screen in pixels. */
87 int x_screen_height;
88
89 /* Width of this X screen in pixels. */
90 int x_screen_width;
91
92 /* Number of planes for this screen. */
93 int x_screen_planes;
94
95 /* Non nil if no window manager is in use. */
96 Lisp_Object Vx_no_window_manager;
97
98 /* `t' if a mouse button is depressed. */
99
100 Lisp_Object Vmouse_depressed;
101
102 extern unsigned int x_mouse_x, x_mouse_y, x_mouse_grabbed;
103
104 /* Atom for indicating window state to the window manager. */
105 extern Atom Xatom_wm_change_state;
106
107 /* Communication with window managers. */
108 extern Atom Xatom_wm_protocols;
109
110 /* Kinds of protocol things we may receive. */
111 extern Atom Xatom_wm_take_focus;
112 extern Atom Xatom_wm_save_yourself;
113 extern Atom Xatom_wm_delete_window;
114
115 /* Other WM communication */
116 extern Atom Xatom_wm_configure_denied; /* When our config request is denied */
117 extern Atom Xatom_wm_window_moved; /* When the WM moves us. */
118
119 #else /* X10 */
120
121 /* Default size of an Emacs window. */
122 static char *default_window = "=80x24+0+0";
123
124 #define MAXICID 80
125 char iconidentity[MAXICID];
126 #define ICONTAG "emacs@"
127 char minibuffer_iconidentity[MAXICID];
128 #define MINIBUFFER_ICONTAG "minibuffer@"
129
130 #endif /* X10 */
131
132 /* The last 23 bits of the timestamp of the last mouse button event. */
133 Time mouse_timestamp;
134
135 /* Evaluate this expression to rebuild the section of syms_of_xfns
136 that initializes and staticpros the symbols declared below. Note
137 that Emacs 18 has a bug that keeps C-x C-e from being able to
138 evaluate this expression.
139
140 (progn
141 ;; Accumulate a list of the symbols we want to initialize from the
142 ;; declarations at the top of the file.
143 (goto-char (point-min))
144 (search-forward "/\*&&& symbols declared here &&&*\/\n")
145 (let (symbol-list)
146 (while (looking-at "Lisp_Object \\(Q[a-z_]+\\)")
147 (setq symbol-list
148 (cons (buffer-substring (match-beginning 1) (match-end 1))
149 symbol-list))
150 (forward-line 1))
151 (setq symbol-list (nreverse symbol-list))
152 ;; Delete the section of syms_of_... where we initialize the symbols.
153 (search-forward "\n /\*&&& init symbols here &&&*\/\n")
154 (let ((start (point)))
155 (while (looking-at "^ Q")
156 (forward-line 2))
157 (kill-region start (point)))
158 ;; Write a new symbol initialization section.
159 (while symbol-list
160 (insert (format " %s = intern (\"" (car symbol-list)))
161 (let ((start (point)))
162 (insert (substring (car symbol-list) 1))
163 (subst-char-in-region start (point) ?_ ?-))
164 (insert (format "\");\n staticpro (&%s);\n" (car symbol-list)))
165 (setq symbol-list (cdr symbol-list)))))
166
167 */
168
169 /*&&& symbols declared here &&&*/
170 Lisp_Object Qauto_raise;
171 Lisp_Object Qauto_lower;
172 Lisp_Object Qbackground_color;
173 Lisp_Object Qbar;
174 Lisp_Object Qborder_color;
175 Lisp_Object Qborder_width;
176 Lisp_Object Qbox;
177 Lisp_Object Qcursor_color;
178 Lisp_Object Qcursor_type;
179 Lisp_Object Qfont;
180 Lisp_Object Qforeground_color;
181 Lisp_Object Qgeometry;
182 /* Lisp_Object Qicon; */
183 Lisp_Object Qicon_left;
184 Lisp_Object Qicon_top;
185 Lisp_Object Qicon_type;
186 Lisp_Object Qinternal_border_width;
187 Lisp_Object Qleft;
188 Lisp_Object Qmouse_color;
189 Lisp_Object Qnone;
190 Lisp_Object Qparent_id;
191 Lisp_Object Qsuppress_icon;
192 Lisp_Object Qtop;
193 Lisp_Object Qundefined_color;
194 Lisp_Object Qvertical_scroll_bars;
195 Lisp_Object Qvisibility;
196 Lisp_Object Qwindow_id;
197 Lisp_Object Qx_frame_parameter;
198
199 /* The below are defined in frame.c. */
200 extern Lisp_Object Qheight, Qminibuffer, Qname, Qonly, Qwidth;
201 extern Lisp_Object Qunsplittable, Qmenu_bar_lines;
202
203 extern Lisp_Object Vwindow_system_version;
204
205 \f
206 /* Error if we are not connected to X. */
207 static void
208 check_x ()
209 {
210 if (x_current_display == 0)
211 error ("X windows are not in use or not initialized");
212 }
213
214 /* Return the Emacs frame-object corresponding to an X window.
215 It could be the frame's main window or an icon window. */
216
217 /* This function can be called during GC, so use XGCTYPE. */
218
219 struct frame *
220 x_window_to_frame (wdesc)
221 int wdesc;
222 {
223 Lisp_Object tail, frame;
224 struct frame *f;
225
226 for (tail = Vframe_list; XGCTYPE (tail) == Lisp_Cons;
227 tail = XCONS (tail)->cdr)
228 {
229 frame = XCONS (tail)->car;
230 if (XGCTYPE (frame) != Lisp_Frame)
231 continue;
232 f = XFRAME (frame);
233 if (FRAME_X_WINDOW (f) == wdesc
234 || f->display.x->icon_desc == wdesc)
235 return f;
236 }
237 return 0;
238 }
239
240 \f
241 /* Connect the frame-parameter names for X frames
242 to the ways of passing the parameter values to the window system.
243
244 The name of a parameter, as a Lisp symbol,
245 has an `x-frame-parameter' property which is an integer in Lisp
246 but can be interpreted as an `enum x_frame_parm' in C. */
247
248 enum x_frame_parm
249 {
250 X_PARM_FOREGROUND_COLOR,
251 X_PARM_BACKGROUND_COLOR,
252 X_PARM_MOUSE_COLOR,
253 X_PARM_CURSOR_COLOR,
254 X_PARM_BORDER_COLOR,
255 X_PARM_ICON_TYPE,
256 X_PARM_FONT,
257 X_PARM_BORDER_WIDTH,
258 X_PARM_INTERNAL_BORDER_WIDTH,
259 X_PARM_NAME,
260 X_PARM_AUTORAISE,
261 X_PARM_AUTOLOWER,
262 X_PARM_VERT_SCROLL_BAR,
263 X_PARM_VISIBILITY,
264 X_PARM_MENU_BAR_LINES
265 };
266
267
268 struct x_frame_parm_table
269 {
270 char *name;
271 void (*setter)( /* struct frame *frame, Lisp_Object val, oldval */ );
272 };
273
274 void x_set_foreground_color ();
275 void x_set_background_color ();
276 void x_set_mouse_color ();
277 void x_set_cursor_color ();
278 void x_set_border_color ();
279 void x_set_cursor_type ();
280 void x_set_icon_type ();
281 void x_set_font ();
282 void x_set_border_width ();
283 void x_set_internal_border_width ();
284 void x_explicitly_set_name ();
285 void x_set_autoraise ();
286 void x_set_autolower ();
287 void x_set_vertical_scroll_bars ();
288 void x_set_visibility ();
289 void x_set_menu_bar_lines ();
290
291 static struct x_frame_parm_table x_frame_parms[] =
292 {
293 "foreground-color", x_set_foreground_color,
294 "background-color", x_set_background_color,
295 "mouse-color", x_set_mouse_color,
296 "cursor-color", x_set_cursor_color,
297 "border-color", x_set_border_color,
298 "cursor-type", x_set_cursor_type,
299 "icon-type", x_set_icon_type,
300 "font", x_set_font,
301 "border-width", x_set_border_width,
302 "internal-border-width", x_set_internal_border_width,
303 "name", x_explicitly_set_name,
304 "auto-raise", x_set_autoraise,
305 "auto-lower", x_set_autolower,
306 "vertical-scroll-bars", x_set_vertical_scroll_bars,
307 "visibility", x_set_visibility,
308 "menu-bar-lines", x_set_menu_bar_lines,
309 };
310
311 /* Attach the `x-frame-parameter' properties to
312 the Lisp symbol names of parameters relevant to X. */
313
314 init_x_parm_symbols ()
315 {
316 int i;
317
318 for (i = 0; i < sizeof (x_frame_parms) / sizeof (x_frame_parms[0]); i++)
319 Fput (intern (x_frame_parms[i].name), Qx_frame_parameter,
320 make_number (i));
321 }
322 \f
323 /* Change the parameters of FRAME as specified by ALIST.
324 If a parameter is not specially recognized, do nothing;
325 otherwise call the `x_set_...' function for that parameter. */
326
327 void
328 x_set_frame_parameters (f, alist)
329 FRAME_PTR f;
330 Lisp_Object alist;
331 {
332 Lisp_Object tail;
333
334 /* If both of these parameters are present, it's more efficient to
335 set them both at once. So we wait until we've looked at the
336 entire list before we set them. */
337 Lisp_Object width, height;
338
339 /* Same here. */
340 Lisp_Object left, top;
341
342 /* Record in these vectors all the parms specified. */
343 Lisp_Object *parms;
344 Lisp_Object *values;
345 int i;
346
347 i = 0;
348 for (tail = alist; CONSP (tail); tail = Fcdr (tail))
349 i++;
350
351 parms = (Lisp_Object *) alloca (i * sizeof (Lisp_Object));
352 values = (Lisp_Object *) alloca (i * sizeof (Lisp_Object));
353
354 /* Extract parm names and values into those vectors. */
355
356 i = 0;
357 for (tail = alist; CONSP (tail); tail = Fcdr (tail))
358 {
359 Lisp_Object elt, prop, val;
360
361 elt = Fcar (tail);
362 parms[i] = Fcar (elt);
363 values[i] = Fcdr (elt);
364 i++;
365 }
366
367 width = height = top = left = Qunbound;
368
369 /* Now process them in reverse of specified order. */
370 for (i--; i >= 0; i--)
371 {
372 Lisp_Object prop, val;
373
374 prop = parms[i];
375 val = values[i];
376
377 if (EQ (prop, Qwidth))
378 width = val;
379 else if (EQ (prop, Qheight))
380 height = val;
381 else if (EQ (prop, Qtop))
382 top = val;
383 else if (EQ (prop, Qleft))
384 left = val;
385 else
386 {
387 register Lisp_Object param_index = Fget (prop, Qx_frame_parameter);
388 register Lisp_Object old_value = get_frame_param (f, prop);
389
390 store_frame_param (f, prop, val);
391 if (XTYPE (param_index) == Lisp_Int
392 && XINT (param_index) >= 0
393 && (XINT (param_index)
394 < sizeof (x_frame_parms)/sizeof (x_frame_parms[0])))
395 (*x_frame_parms[XINT (param_index)].setter)(f, val, old_value);
396 }
397 }
398
399 /* Don't 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 /* Make the window appear on the frame and enable display,
1896 unless the caller says not to. */
1897 {
1898 Lisp_Object visibility = x_get_arg (parms, Qvisibility, 0, 0, symbol);
1899
1900 if (EQ (visibility, Qunbound))
1901 visibility = Qt;
1902
1903 if (EQ (visibility, Qicon))
1904 x_iconify_frame (f);
1905 else if (! NILP (visibility))
1906 x_make_frame_visible (f);
1907 else
1908 /* Must have been Qnil. */
1909 ;
1910 }
1911
1912 Vframe_list = Fcons (frame, Vframe_list);
1913 return frame;
1914 #else /* X10 */
1915 struct frame *f;
1916 Lisp_Object frame, tem;
1917 Lisp_Object name;
1918 int pixelwidth, pixelheight;
1919 Cursor cursor;
1920 int height, width;
1921 Window parent;
1922 Pixmap temp;
1923 int minibuffer_only = 0;
1924 Lisp_Object vscroll, hscroll;
1925
1926 if (x_current_display == 0)
1927 error ("X windows are not in use or not initialized");
1928
1929 name = Fassq (Qname, parms);
1930
1931 tem = x_get_arg (parms, Qminibuffer, 0, 0, symbol);
1932 if (EQ (tem, Qnone))
1933 f = make_frame_without_minibuffer (Qnil);
1934 else if (EQ (tem, Qonly))
1935 {
1936 f = make_minibuffer_frame ();
1937 minibuffer_only = 1;
1938 }
1939 else if (EQ (tem, Qnil) || EQ (tem, Qunbound))
1940 f = make_frame (1);
1941 else
1942 f = make_frame_without_minibuffer (tem);
1943
1944 parent = ROOT_WINDOW;
1945
1946 XSET (frame, Lisp_Frame, f);
1947 f->output_method = output_x_window;
1948 f->display.x = (struct x_display *) xmalloc (sizeof (struct x_display));
1949 bzero (f->display.x, sizeof (struct x_display));
1950
1951 /* Some temporary default values for height and width. */
1952 width = 80;
1953 height = 40;
1954 f->display.x->left_pos = -1;
1955 f->display.x->top_pos = -1;
1956
1957 /* Give the frame a default name (which may be overridden with PARMS). */
1958
1959 strncpy (iconidentity, ICONTAG, MAXICID);
1960 if (gethostname (&iconidentity[sizeof (ICONTAG) - 1],
1961 (MAXICID - 1) - sizeof (ICONTAG)))
1962 iconidentity[sizeof (ICONTAG) - 2] = '\0';
1963 f->name = build_string (iconidentity);
1964
1965 /* Extract some window parameters from the supplied values.
1966 These are the parameters that affect window geometry. */
1967
1968 tem = x_get_arg (parms, Qfont, "BodyFont", 0, string);
1969 if (EQ (tem, Qunbound))
1970 tem = build_string ("9x15");
1971 x_set_font (f, tem, Qnil);
1972 x_default_parameter (f, parms, Qborder_color,
1973 build_string ("black"), "Border", 0, string);
1974 x_default_parameter (f, parms, Qbackground_color,
1975 build_string ("white"), "Background", 0, string);
1976 x_default_parameter (f, parms, Qforeground_color,
1977 build_string ("black"), "Foreground", 0, string);
1978 x_default_parameter (f, parms, Qmouse_color,
1979 build_string ("black"), "Mouse", 0, string);
1980 x_default_parameter (f, parms, Qcursor_color,
1981 build_string ("black"), "Cursor", 0, string);
1982 x_default_parameter (f, parms, Qborder_width,
1983 make_number (2), "BorderWidth", 0, number);
1984 x_default_parameter (f, parms, Qinternal_border_width,
1985 make_number (4), "InternalBorderWidth", 0, number);
1986 x_default_parameter (f, parms, Qauto_raise,
1987 Qnil, "AutoRaise", 0, boolean);
1988
1989 hscroll = EQ (x_get_arg (parms, Qhorizontal_scroll_bar, 0, 0, boolean), Qt);
1990 vscroll = EQ (x_get_arg (parms, Qvertical_scroll_bar, 0, 0, boolean), Qt);
1991
1992 if (f->display.x->internal_border_width < 0)
1993 f->display.x->internal_border_width = 0;
1994
1995 tem = x_get_arg (parms, Qwindow_id, 0, 0, number);
1996 if (!EQ (tem, Qunbound))
1997 {
1998 WINDOWINFO_TYPE wininfo;
1999 int nchildren;
2000 Window *children, root;
2001
2002 CHECK_NUMBER (tem, 0);
2003 FRAME_X_WINDOW (f) = (Window) XINT (tem);
2004
2005 BLOCK_INPUT;
2006 XGetWindowInfo (FRAME_X_WINDOW (f), &wininfo);
2007 XQueryTree (FRAME_X_WINDOW (f), &parent, &nchildren, &children);
2008 xfree (children);
2009 UNBLOCK_INPUT;
2010
2011 height = PIXEL_TO_CHAR_HEIGHT (f, wininfo.height);
2012 width = PIXEL_TO_CHAR_WIDTH (f, wininfo.width);
2013 f->display.x->left_pos = wininfo.x;
2014 f->display.x->top_pos = wininfo.y;
2015 FRAME_SET_VISIBILITY (f, wininfo.mapped != 0);
2016 f->display.x->border_width = wininfo.bdrwidth;
2017 f->display.x->parent_desc = parent;
2018 }
2019 else
2020 {
2021 tem = x_get_arg (parms, Qparent_id, 0, 0, number);
2022 if (!EQ (tem, Qunbound))
2023 {
2024 CHECK_NUMBER (tem, 0);
2025 parent = (Window) XINT (tem);
2026 }
2027 f->display.x->parent_desc = parent;
2028 tem = x_get_arg (parms, Qheight, 0, 0, number);
2029 if (EQ (tem, Qunbound))
2030 {
2031 tem = x_get_arg (parms, Qwidth, 0, 0, number);
2032 if (EQ (tem, Qunbound))
2033 {
2034 tem = x_get_arg (parms, Qtop, 0, 0, number);
2035 if (EQ (tem, Qunbound))
2036 tem = x_get_arg (parms, Qleft, 0, 0, number);
2037 }
2038 }
2039 /* Now TEM is Qunbound if no edge or size was specified.
2040 In that case, we must do rubber-banding. */
2041 if (EQ (tem, Qunbound))
2042 {
2043 tem = x_get_arg (parms, Qgeometry, 0, 0, number);
2044 x_rubber_band (f,
2045 &f->display.x->left_pos, &f->display.x->top_pos,
2046 &width, &height,
2047 (XTYPE (tem) == Lisp_String
2048 ? (char *) XSTRING (tem)->data : ""),
2049 XSTRING (f->name)->data,
2050 !NILP (hscroll), !NILP (vscroll));
2051 }
2052 else
2053 {
2054 /* Here if at least one edge or size was specified.
2055 Demand that they all were specified, and use them. */
2056 tem = x_get_arg (parms, Qheight, 0, 0, number);
2057 if (EQ (tem, Qunbound))
2058 error ("Height not specified");
2059 CHECK_NUMBER (tem, 0);
2060 height = XINT (tem);
2061
2062 tem = x_get_arg (parms, Qwidth, 0, 0, number);
2063 if (EQ (tem, Qunbound))
2064 error ("Width not specified");
2065 CHECK_NUMBER (tem, 0);
2066 width = XINT (tem);
2067
2068 tem = x_get_arg (parms, Qtop, 0, 0, number);
2069 if (EQ (tem, Qunbound))
2070 error ("Top position not specified");
2071 CHECK_NUMBER (tem, 0);
2072 f->display.x->left_pos = XINT (tem);
2073
2074 tem = x_get_arg (parms, Qleft, 0, 0, number);
2075 if (EQ (tem, Qunbound))
2076 error ("Left position not specified");
2077 CHECK_NUMBER (tem, 0);
2078 f->display.x->top_pos = XINT (tem);
2079 }
2080
2081 pixelwidth = CHAR_TO_PIXEL_WIDTH (f, width);
2082 pixelheight = CHAR_TO_PIXEL_HEIGHT (f, height);
2083
2084 BLOCK_INPUT;
2085 FRAME_X_WINDOW (f)
2086 = XCreateWindow (parent,
2087 f->display.x->left_pos, /* Absolute horizontal offset */
2088 f->display.x->top_pos, /* Absolute Vertical offset */
2089 pixelwidth, pixelheight,
2090 f->display.x->border_width,
2091 BLACK_PIX_DEFAULT, WHITE_PIX_DEFAULT);
2092 UNBLOCK_INPUT;
2093 if (FRAME_X_WINDOW (f) == 0)
2094 error ("Unable to create window.");
2095 }
2096
2097 /* Install the now determined height and width
2098 in the windows and in phys_lines and desired_lines. */
2099 change_frame_size (f, height, width, 1, 0);
2100 XSelectInput (FRAME_X_WINDOW (f), KeyPressed | ExposeWindow
2101 | ButtonPressed | ButtonReleased | ExposeRegion | ExposeCopy
2102 | EnterWindow | LeaveWindow | UnmapWindow );
2103 x_set_resize_hint (f);
2104
2105 /* Tell the server the window's default name. */
2106 XStoreName (XDISPLAY FRAME_X_WINDOW (f), XSTRING (f->name)->data);
2107
2108 /* Now override the defaults with all the rest of the specified
2109 parms. */
2110 tem = x_get_arg (parms, Qunsplittable, 0, 0, boolean);
2111 f->no_split = minibuffer_only || EQ (tem, Qt);
2112
2113 /* Do not create an icon window if the caller says not to */
2114 if (!EQ (x_get_arg (parms, Qsuppress_icon, 0, 0, boolean), Qt)
2115 || f->display.x->parent_desc != ROOT_WINDOW)
2116 {
2117 x_text_icon (f, iconidentity);
2118 x_default_parameter (f, parms, Qicon_type, Qnil,
2119 "BitmapIcon", 0, symbol);
2120 }
2121
2122 /* Tell the X server the previously set values of the
2123 background, border and mouse colors; also create the mouse cursor. */
2124 BLOCK_INPUT;
2125 temp = XMakeTile (f->display.x->background_pixel);
2126 XChangeBackground (FRAME_X_WINDOW (f), temp);
2127 XFreePixmap (temp);
2128 UNBLOCK_INPUT;
2129 x_set_border_pixel (f, f->display.x->border_pixel);
2130
2131 x_set_mouse_color (f, Qnil, Qnil);
2132
2133 /* Now override the defaults with all the rest of the specified parms. */
2134
2135 Fmodify_frame_parameters (frame, parms);
2136
2137 /* Make the window appear on the frame and enable display. */
2138 {
2139 Lisp_Object visibility = x_get_arg (parms, Qvisibility, 0, 0, symbol);
2140
2141 if (EQ (visibility, Qunbound))
2142 visibility = Qt;
2143
2144 if (! EQ (visibility, Qicon)
2145 && ! NILP (visibility))
2146 x_make_window_visible (f);
2147 }
2148
2149 SET_FRAME_GARBAGED (f);
2150
2151 Vframe_list = Fcons (frame, Vframe_list);
2152 return frame;
2153 #endif /* X10 */
2154 }
2155
2156 DEFUN ("focus-frame", Ffocus_frame, Sfocus_frame, 1, 1, 0,
2157 "Set the focus on FRAME.")
2158 (frame)
2159 Lisp_Object frame;
2160 {
2161 CHECK_LIVE_FRAME (frame, 0);
2162
2163 if (FRAME_X_P (XFRAME (frame)))
2164 {
2165 BLOCK_INPUT;
2166 x_focus_on_frame (XFRAME (frame));
2167 UNBLOCK_INPUT;
2168 return frame;
2169 }
2170
2171 return Qnil;
2172 }
2173
2174 DEFUN ("unfocus-frame", Funfocus_frame, Sunfocus_frame, 0, 0, 0,
2175 "If a frame has been focused, release it.")
2176 ()
2177 {
2178 if (x_focus_frame)
2179 {
2180 BLOCK_INPUT;
2181 x_unfocus_frame (x_focus_frame);
2182 UNBLOCK_INPUT;
2183 }
2184
2185 return Qnil;
2186 }
2187 \f
2188 #ifndef HAVE_X11
2189 /* Computes an X-window size and position either from geometry GEO
2190 or with the mouse.
2191
2192 F is a frame. It specifies an X window which is used to
2193 determine which display to compute for. Its font, borders
2194 and colors control how the rectangle will be displayed.
2195
2196 X and Y are where to store the positions chosen.
2197 WIDTH and HEIGHT are where to store the sizes chosen.
2198
2199 GEO is the geometry that may specify some of the info.
2200 STR is a prompt to display.
2201 HSCROLL and VSCROLL say whether we have horiz and vert scroll bars. */
2202
2203 int
2204 x_rubber_band (f, x, y, width, height, geo, str, hscroll, vscroll)
2205 struct frame *f;
2206 int *x, *y, *width, *height;
2207 char *geo;
2208 char *str;
2209 int hscroll, vscroll;
2210 {
2211 OpaqueFrame frame;
2212 Window tempwindow;
2213 WindowInfo wininfo;
2214 int border_color;
2215 int background_color;
2216 Lisp_Object tem;
2217 int mask;
2218
2219 BLOCK_INPUT;
2220
2221 background_color = f->display.x->background_pixel;
2222 border_color = f->display.x->border_pixel;
2223
2224 frame.bdrwidth = f->display.x->border_width;
2225 frame.border = XMakeTile (border_color);
2226 frame.background = XMakeTile (background_color);
2227 tempwindow = XCreateTerm (str, "emacs", geo, default_window, &frame, 10, 5,
2228 (2 * f->display.x->internal_border_width
2229 + (vscroll ? VSCROLL_WIDTH : 0)),
2230 (2 * f->display.x->internal_border_width
2231 + (hscroll ? HSCROLL_HEIGHT : 0)),
2232 width, height, f->display.x->font,
2233 FONT_WIDTH (f->display.x->font),
2234 FONT_HEIGHT (f->display.x->font));
2235 XFreePixmap (frame.border);
2236 XFreePixmap (frame.background);
2237
2238 if (tempwindow != 0)
2239 {
2240 XQueryWindow (tempwindow, &wininfo);
2241 XDestroyWindow (tempwindow);
2242 *x = wininfo.x;
2243 *y = wininfo.y;
2244 }
2245
2246 /* Coordinates we got are relative to the root window.
2247 Convert them to coordinates relative to desired parent window
2248 by scanning from there up to the root. */
2249 tempwindow = f->display.x->parent_desc;
2250 while (tempwindow != ROOT_WINDOW)
2251 {
2252 int nchildren;
2253 Window *children;
2254 XQueryWindow (tempwindow, &wininfo);
2255 *x -= wininfo.x;
2256 *y -= wininfo.y;
2257 XQueryTree (tempwindow, &tempwindow, &nchildren, &children);
2258 xfree (children);
2259 }
2260
2261 UNBLOCK_INPUT;
2262 return tempwindow != 0;
2263 }
2264 #endif /* not HAVE_X11 */
2265 \f
2266 DEFUN ("x-list-fonts", Fx_list_fonts, Sx_list_fonts, 1, 3, 0,
2267 "Return a list of the names of available fonts matching PATTERN.\n\
2268 If optional arguments FACE and FRAME are specified, return only fonts\n\
2269 the same size as FACE on FRAME.\n\
2270 \n\
2271 PATTERN is a string, perhaps with wildcard characters;\n\
2272 the * character matches any substring, and\n\
2273 the ? character matches any single character.\n\
2274 PATTERN is case-insensitive.\n\
2275 FACE is a face name - a symbol.\n\
2276 \n\
2277 The return value is a list of strings, suitable as arguments to\n\
2278 set-face-font.\n\
2279 \n\
2280 The list does not include fonts Emacs can't use (i.e. proportional\n\
2281 fonts), even if they match PATTERN and FACE.")
2282 (pattern, face, frame)
2283 Lisp_Object pattern, face, frame;
2284 {
2285 int num_fonts;
2286 char **names;
2287 XFontStruct *info;
2288 XFontStruct *size_ref;
2289 Lisp_Object list;
2290
2291 CHECK_STRING (pattern, 0);
2292 if (!NILP (face))
2293 CHECK_SYMBOL (face, 1);
2294 if (!NILP (frame))
2295 CHECK_LIVE_FRAME (frame, 2);
2296
2297 if (NILP (face))
2298 size_ref = 0;
2299 else
2300 {
2301 FRAME_PTR f = NILP (frame) ? selected_frame : XFRAME (frame);
2302 int face_id = face_name_id_number (f, face);
2303
2304 if (face_id < 0 || face_id >= FRAME_N_PARAM_FACES (f)
2305 || FRAME_PARAM_FACES (f) [face_id] == 0)
2306 size_ref = f->display.x->font;
2307 else
2308 {
2309 size_ref = FRAME_PARAM_FACES (f) [face_id]->font;
2310 if (size_ref == (XFontStruct *) (~0))
2311 size_ref = f->display.x->font;
2312 }
2313 }
2314
2315 BLOCK_INPUT;
2316
2317 /* Solaris 2.3 has a bug in XListFontsWithInfo. */
2318 #ifdef BROKEN_XLISTFONTSWITHINFO
2319 names = XListFonts (x_current_display,
2320 XSTRING (pattern)->data,
2321 2000, /* maxnames */
2322 &num_fonts); /* count_return */
2323 #else
2324 names = XListFontsWithInfo (x_current_display,
2325 XSTRING (pattern)->data,
2326 2000, /* maxnames */
2327 &num_fonts, /* count_return */
2328 &info); /* info_return */
2329 #endif
2330 UNBLOCK_INPUT;
2331
2332 list = Qnil;
2333
2334 if (names)
2335 {
2336 Lisp_Object *tail;
2337 int i;
2338
2339 for (i = 0; i < num_fonts; i++)
2340 {
2341 #ifdef BROKEN_XLISTFONTSWITHINFO
2342 BLOCK_INPUT;
2343 info = XLoadQueryFont (x_current_display, names[i]);
2344 UNBLOCK_INPUT;
2345 #else
2346 info = &info[i];
2347 #endif
2348 if (info && (! size_ref
2349 || same_size_fonts (info, size_ref)))
2350 {
2351 *tail = Fcons (build_string (names[i]), Qnil);
2352 tail = &XCONS (*tail)->cdr;
2353 }
2354 }
2355
2356 BLOCK_INPUT;
2357 #ifdef BROKEN_XLISTFONTSWITHINFO
2358 XFreeFontNames (names);
2359 #else
2360 XFreeFontInfo (names, info, num_fonts);
2361 #endif
2362 UNBLOCK_INPUT;
2363 }
2364
2365 return list;
2366 }
2367
2368 \f
2369 DEFUN ("x-color-defined-p", Fx_color_defined_p, Sx_color_defined_p, 1, 1, 0,
2370 "Return t if the current X display supports the color named COLOR.")
2371 (color)
2372 Lisp_Object color;
2373 {
2374 Color foo;
2375
2376 check_x ();
2377 CHECK_STRING (color, 0);
2378
2379 if (defined_color (XSTRING (color)->data, &foo))
2380 return Qt;
2381 else
2382 return Qnil;
2383 }
2384
2385 DEFUN ("x-display-color-p", Fx_display_color_p, Sx_display_color_p, 0, 0, 0,
2386 "Return t if the X screen currently in use supports color.")
2387 ()
2388 {
2389 check_x ();
2390
2391 if (x_screen_planes <= 2)
2392 return Qnil;
2393
2394 switch (screen_visual->class)
2395 {
2396 case StaticColor:
2397 case PseudoColor:
2398 case TrueColor:
2399 case DirectColor:
2400 return Qt;
2401
2402 default:
2403 return Qnil;
2404 }
2405 }
2406
2407 DEFUN ("x-display-pixel-width", Fx_display_pixel_width, Sx_display_pixel_width,
2408 0, 1, 0,
2409 "Returns the width in pixels of the display FRAME is on.")
2410 (frame)
2411 Lisp_Object frame;
2412 {
2413 Display *dpy = x_current_display;
2414 check_x ();
2415 return make_number (DisplayWidth (dpy, DefaultScreen (dpy)));
2416 }
2417
2418 DEFUN ("x-display-pixel-height", Fx_display_pixel_height,
2419 Sx_display_pixel_height, 0, 1, 0,
2420 "Returns the height in pixels of the display FRAME is on.")
2421 (frame)
2422 Lisp_Object frame;
2423 {
2424 Display *dpy = x_current_display;
2425 check_x ();
2426 return make_number (DisplayHeight (dpy, DefaultScreen (dpy)));
2427 }
2428
2429 DEFUN ("x-display-planes", Fx_display_planes, Sx_display_planes,
2430 0, 1, 0,
2431 "Returns the number of bitplanes of the display FRAME is on.")
2432 (frame)
2433 Lisp_Object frame;
2434 {
2435 Display *dpy = x_current_display;
2436 check_x ();
2437 return make_number (DisplayPlanes (dpy, DefaultScreen (dpy)));
2438 }
2439
2440 DEFUN ("x-display-color-cells", Fx_display_color_cells, Sx_display_color_cells,
2441 0, 1, 0,
2442 "Returns the number of color cells of the display FRAME is on.")
2443 (frame)
2444 Lisp_Object frame;
2445 {
2446 Display *dpy = x_current_display;
2447 check_x ();
2448 return make_number (DisplayCells (dpy, DefaultScreen (dpy)));
2449 }
2450
2451 DEFUN ("x-server-max-request-size", Fx_server_max_request_size,
2452 Sx_server_max_request_size,
2453 0, 1, 0,
2454 "Returns the maximum request size of the X server FRAME is using.")
2455 (frame)
2456 Lisp_Object frame;
2457 {
2458 Display *dpy = x_current_display;
2459 check_x ();
2460 return make_number (MAXREQUEST (dpy));
2461 }
2462
2463 DEFUN ("x-server-vendor", Fx_server_vendor, Sx_server_vendor, 0, 1, 0,
2464 "Returns the vendor ID string of the X server FRAME is on.")
2465 (frame)
2466 Lisp_Object frame;
2467 {
2468 Display *dpy = x_current_display;
2469 char *vendor;
2470 check_x ();
2471 vendor = ServerVendor (dpy);
2472 if (! vendor) vendor = "";
2473 return build_string (vendor);
2474 }
2475
2476 DEFUN ("x-server-version", Fx_server_version, Sx_server_version, 0, 1, 0,
2477 "Returns the version numbers of the X server in use.\n\
2478 The value is a list of three integers: the major and minor\n\
2479 version numbers of the X Protocol in use, and the vendor-specific release\n\
2480 number. See also the variable `x-server-vendor'.")
2481 (frame)
2482 Lisp_Object frame;
2483 {
2484 Display *dpy = x_current_display;
2485
2486 check_x ();
2487 return Fcons (make_number (ProtocolVersion (dpy)),
2488 Fcons (make_number (ProtocolRevision (dpy)),
2489 Fcons (make_number (VendorRelease (dpy)), Qnil)));
2490 }
2491
2492 DEFUN ("x-display-screens", Fx_display_screens, Sx_display_screens, 0, 1, 0,
2493 "Returns the number of screens on the X server FRAME is on.")
2494 (frame)
2495 Lisp_Object frame;
2496 {
2497 check_x ();
2498 return make_number (ScreenCount (x_current_display));
2499 }
2500
2501 DEFUN ("x-display-mm-height", Fx_display_mm_height, Sx_display_mm_height, 0, 1, 0,
2502 "Returns the height in millimeters of the X screen FRAME is on.")
2503 (frame)
2504 Lisp_Object frame;
2505 {
2506 check_x ();
2507 return make_number (HeightMMOfScreen (x_screen));
2508 }
2509
2510 DEFUN ("x-display-mm-width", Fx_display_mm_width, Sx_display_mm_width, 0, 1, 0,
2511 "Returns the width in millimeters of the X screen FRAME is on.")
2512 (frame)
2513 Lisp_Object frame;
2514 {
2515 check_x ();
2516 return make_number (WidthMMOfScreen (x_screen));
2517 }
2518
2519 DEFUN ("x-display-backing-store", Fx_display_backing_store,
2520 Sx_display_backing_store, 0, 1, 0,
2521 "Returns an indication of whether the X screen FRAME is on does backing store.\n\
2522 The value may be `always', `when-mapped', or `not-useful'.")
2523 (frame)
2524 Lisp_Object frame;
2525 {
2526 check_x ();
2527
2528 switch (DoesBackingStore (x_screen))
2529 {
2530 case Always:
2531 return intern ("always");
2532
2533 case WhenMapped:
2534 return intern ("when-mapped");
2535
2536 case NotUseful:
2537 return intern ("not-useful");
2538
2539 default:
2540 error ("Strange value for BackingStore parameter of screen");
2541 }
2542 }
2543
2544 DEFUN ("x-display-visual-class", Fx_display_visual_class,
2545 Sx_display_visual_class, 0, 1, 0,
2546 "Returns the visual class of the display `screen' is on.\n\
2547 The value is one of the symbols `static-gray', `gray-scale',\n\
2548 `static-color', `pseudo-color', `true-color', or `direct-color'.")
2549 (screen)
2550 Lisp_Object screen;
2551 {
2552 check_x ();
2553
2554 switch (screen_visual->class)
2555 {
2556 case StaticGray: return (intern ("static-gray"));
2557 case GrayScale: return (intern ("gray-scale"));
2558 case StaticColor: return (intern ("static-color"));
2559 case PseudoColor: return (intern ("pseudo-color"));
2560 case TrueColor: return (intern ("true-color"));
2561 case DirectColor: return (intern ("direct-color"));
2562 default:
2563 error ("Display has an unknown visual class");
2564 }
2565 }
2566
2567 DEFUN ("x-display-save-under", Fx_display_save_under,
2568 Sx_display_save_under, 0, 1, 0,
2569 "Returns t if the X screen FRAME is on supports the save-under feature.")
2570 (frame)
2571 Lisp_Object frame;
2572 {
2573 check_x ();
2574
2575 if (DoesSaveUnders (x_screen) == True)
2576 return Qt;
2577 else
2578 return Qnil;
2579 }
2580 \f
2581 x_pixel_width (f)
2582 register struct frame *f;
2583 {
2584 return PIXEL_WIDTH (f);
2585 }
2586
2587 x_pixel_height (f)
2588 register struct frame *f;
2589 {
2590 return PIXEL_HEIGHT (f);
2591 }
2592
2593 x_char_width (f)
2594 register struct frame *f;
2595 {
2596 return FONT_WIDTH (f->display.x->font);
2597 }
2598
2599 x_char_height (f)
2600 register struct frame *f;
2601 {
2602 return FONT_HEIGHT (f->display.x->font);
2603 }
2604 \f
2605 #if 0 /* These no longer seem like the right way to do things. */
2606
2607 /* Draw a rectangle on the frame with left top corner including
2608 the character specified by LEFT_CHAR and TOP_CHAR. The rectangle is
2609 CHARS by LINES wide and long and is the color of the cursor. */
2610
2611 void
2612 x_rectangle (f, gc, left_char, top_char, chars, lines)
2613 register struct frame *f;
2614 GC gc;
2615 register int top_char, left_char, chars, lines;
2616 {
2617 int width;
2618 int height;
2619 int left = (left_char * FONT_WIDTH (f->display.x->font)
2620 + f->display.x->internal_border_width);
2621 int top = (top_char * FONT_HEIGHT (f->display.x->font)
2622 + f->display.x->internal_border_width);
2623
2624 if (chars < 0)
2625 width = FONT_WIDTH (f->display.x->font) / 2;
2626 else
2627 width = FONT_WIDTH (f->display.x->font) * chars;
2628 if (lines < 0)
2629 height = FONT_HEIGHT (f->display.x->font) / 2;
2630 else
2631 height = FONT_HEIGHT (f->display.x->font) * lines;
2632
2633 XDrawRectangle (x_current_display, FRAME_X_WINDOW (f),
2634 gc, left, top, width, height);
2635 }
2636
2637 DEFUN ("x-draw-rectangle", Fx_draw_rectangle, Sx_draw_rectangle, 5, 5, 0,
2638 "Draw a rectangle on FRAME between coordinates specified by\n\
2639 numbers X0, Y0, X1, Y1 in the cursor pixel.")
2640 (frame, X0, Y0, X1, Y1)
2641 register Lisp_Object frame, X0, X1, Y0, Y1;
2642 {
2643 register int x0, y0, x1, y1, top, left, n_chars, n_lines;
2644
2645 CHECK_LIVE_FRAME (frame, 0);
2646 CHECK_NUMBER (X0, 0);
2647 CHECK_NUMBER (Y0, 1);
2648 CHECK_NUMBER (X1, 2);
2649 CHECK_NUMBER (Y1, 3);
2650
2651 x0 = XINT (X0);
2652 x1 = XINT (X1);
2653 y0 = XINT (Y0);
2654 y1 = XINT (Y1);
2655
2656 if (y1 > y0)
2657 {
2658 top = y0;
2659 n_lines = y1 - y0 + 1;
2660 }
2661 else
2662 {
2663 top = y1;
2664 n_lines = y0 - y1 + 1;
2665 }
2666
2667 if (x1 > x0)
2668 {
2669 left = x0;
2670 n_chars = x1 - x0 + 1;
2671 }
2672 else
2673 {
2674 left = x1;
2675 n_chars = x0 - x1 + 1;
2676 }
2677
2678 BLOCK_INPUT;
2679 x_rectangle (XFRAME (frame), XFRAME (frame)->display.x->cursor_gc,
2680 left, top, n_chars, n_lines);
2681 UNBLOCK_INPUT;
2682
2683 return Qt;
2684 }
2685
2686 DEFUN ("x-erase-rectangle", Fx_erase_rectangle, Sx_erase_rectangle, 5, 5, 0,
2687 "Draw a rectangle drawn on FRAME between coordinates\n\
2688 X0, Y0, X1, Y1 in the regular background-pixel.")
2689 (frame, X0, Y0, X1, Y1)
2690 register Lisp_Object frame, X0, Y0, X1, Y1;
2691 {
2692 register int x0, y0, x1, y1, top, left, n_chars, n_lines;
2693
2694 CHECK_FRAME (frame, 0);
2695 CHECK_NUMBER (X0, 0);
2696 CHECK_NUMBER (Y0, 1);
2697 CHECK_NUMBER (X1, 2);
2698 CHECK_NUMBER (Y1, 3);
2699
2700 x0 = XINT (X0);
2701 x1 = XINT (X1);
2702 y0 = XINT (Y0);
2703 y1 = XINT (Y1);
2704
2705 if (y1 > y0)
2706 {
2707 top = y0;
2708 n_lines = y1 - y0 + 1;
2709 }
2710 else
2711 {
2712 top = y1;
2713 n_lines = y0 - y1 + 1;
2714 }
2715
2716 if (x1 > x0)
2717 {
2718 left = x0;
2719 n_chars = x1 - x0 + 1;
2720 }
2721 else
2722 {
2723 left = x1;
2724 n_chars = x0 - x1 + 1;
2725 }
2726
2727 BLOCK_INPUT;
2728 x_rectangle (XFRAME (frame), XFRAME (frame)->display.x->reverse_gc,
2729 left, top, n_chars, n_lines);
2730 UNBLOCK_INPUT;
2731
2732 return Qt;
2733 }
2734
2735 /* Draw lines around the text region beginning at the character position
2736 TOP_X, TOP_Y and ending at BOTTOM_X and BOTTOM_Y. GC specifies the
2737 pixel and line characteristics. */
2738
2739 #define line_len(line) (FRAME_CURRENT_GLYPHS (f)->used[(line)])
2740
2741 static void
2742 outline_region (f, gc, top_x, top_y, bottom_x, bottom_y)
2743 register struct frame *f;
2744 GC gc;
2745 int top_x, top_y, bottom_x, bottom_y;
2746 {
2747 register int ibw = f->display.x->internal_border_width;
2748 register int font_w = FONT_WIDTH (f->display.x->font);
2749 register int font_h = FONT_HEIGHT (f->display.x->font);
2750 int y = top_y;
2751 int x = line_len (y);
2752 XPoint *pixel_points = (XPoint *)
2753 alloca (((bottom_y - top_y + 2) * 4) * sizeof (XPoint));
2754 register XPoint *this_point = pixel_points;
2755
2756 /* Do the horizontal top line/lines */
2757 if (top_x == 0)
2758 {
2759 this_point->x = ibw;
2760 this_point->y = ibw + (font_h * top_y);
2761 this_point++;
2762 if (x == 0)
2763 this_point->x = ibw + (font_w / 2); /* Half-size for newline chars. */
2764 else
2765 this_point->x = ibw + (font_w * x);
2766 this_point->y = (this_point - 1)->y;
2767 }
2768 else
2769 {
2770 this_point->x = ibw;
2771 this_point->y = ibw + (font_h * (top_y + 1));
2772 this_point++;
2773 this_point->x = ibw + (font_w * top_x);
2774 this_point->y = (this_point - 1)->y;
2775 this_point++;
2776 this_point->x = (this_point - 1)->x;
2777 this_point->y = ibw + (font_h * top_y);
2778 this_point++;
2779 this_point->x = ibw + (font_w * x);
2780 this_point->y = (this_point - 1)->y;
2781 }
2782
2783 /* Now do the right side. */
2784 while (y < bottom_y)
2785 { /* Right vertical edge */
2786 this_point++;
2787 this_point->x = (this_point - 1)->x;
2788 this_point->y = ibw + (font_h * (y + 1));
2789 this_point++;
2790
2791 y++; /* Horizontal connection to next line */
2792 x = line_len (y);
2793 if (x == 0)
2794 this_point->x = ibw + (font_w / 2);
2795 else
2796 this_point->x = ibw + (font_w * x);
2797
2798 this_point->y = (this_point - 1)->y;
2799 }
2800
2801 /* Now do the bottom and connect to the top left point. */
2802 this_point->x = ibw + (font_w * (bottom_x + 1));
2803
2804 this_point++;
2805 this_point->x = (this_point - 1)->x;
2806 this_point->y = ibw + (font_h * (bottom_y + 1));
2807 this_point++;
2808 this_point->x = ibw;
2809 this_point->y = (this_point - 1)->y;
2810 this_point++;
2811 this_point->x = pixel_points->x;
2812 this_point->y = pixel_points->y;
2813
2814 XDrawLines (x_current_display, FRAME_X_WINDOW (f),
2815 gc, pixel_points,
2816 (this_point - pixel_points + 1), CoordModeOrigin);
2817 }
2818
2819 DEFUN ("x-contour-region", Fx_contour_region, Sx_contour_region, 1, 1, 0,
2820 "Highlight the region between point and the character under the mouse\n\
2821 selected frame.")
2822 (event)
2823 register Lisp_Object event;
2824 {
2825 register int x0, y0, x1, y1;
2826 register struct frame *f = selected_frame;
2827 register int p1, p2;
2828
2829 CHECK_CONS (event, 0);
2830
2831 BLOCK_INPUT;
2832 x0 = XINT (Fcar (Fcar (event)));
2833 y0 = XINT (Fcar (Fcdr (Fcar (event))));
2834
2835 /* If the mouse is past the end of the line, don't that area. */
2836 /* ReWrite this... */
2837
2838 x1 = f->cursor_x;
2839 y1 = f->cursor_y;
2840
2841 if (y1 > y0) /* point below mouse */
2842 outline_region (f, f->display.x->cursor_gc,
2843 x0, y0, x1, y1);
2844 else if (y1 < y0) /* point above mouse */
2845 outline_region (f, f->display.x->cursor_gc,
2846 x1, y1, x0, y0);
2847 else /* same line: draw horizontal rectangle */
2848 {
2849 if (x1 > x0)
2850 x_rectangle (f, f->display.x->cursor_gc,
2851 x0, y0, (x1 - x0 + 1), 1);
2852 else if (x1 < x0)
2853 x_rectangle (f, f->display.x->cursor_gc,
2854 x1, y1, (x0 - x1 + 1), 1);
2855 }
2856
2857 XFlush (x_current_display);
2858 UNBLOCK_INPUT;
2859
2860 return Qnil;
2861 }
2862
2863 DEFUN ("x-uncontour-region", Fx_uncontour_region, Sx_uncontour_region, 1, 1, 0,
2864 "Erase any highlighting of the region between point and the character\n\
2865 at X, Y on the selected frame.")
2866 (event)
2867 register Lisp_Object event;
2868 {
2869 register int x0, y0, x1, y1;
2870 register struct frame *f = selected_frame;
2871
2872 BLOCK_INPUT;
2873 x0 = XINT (Fcar (Fcar (event)));
2874 y0 = XINT (Fcar (Fcdr (Fcar (event))));
2875 x1 = f->cursor_x;
2876 y1 = f->cursor_y;
2877
2878 if (y1 > y0) /* point below mouse */
2879 outline_region (f, f->display.x->reverse_gc,
2880 x0, y0, x1, y1);
2881 else if (y1 < y0) /* point above mouse */
2882 outline_region (f, f->display.x->reverse_gc,
2883 x1, y1, x0, y0);
2884 else /* same line: draw horizontal rectangle */
2885 {
2886 if (x1 > x0)
2887 x_rectangle (f, f->display.x->reverse_gc,
2888 x0, y0, (x1 - x0 + 1), 1);
2889 else if (x1 < x0)
2890 x_rectangle (f, f->display.x->reverse_gc,
2891 x1, y1, (x0 - x1 + 1), 1);
2892 }
2893 UNBLOCK_INPUT;
2894
2895 return Qnil;
2896 }
2897
2898 #if 0
2899 int contour_begin_x, contour_begin_y;
2900 int contour_end_x, contour_end_y;
2901 int contour_npoints;
2902
2903 /* Clip the top part of the contour lines down (and including) line Y_POS.
2904 If X_POS is in the middle (rather than at the end) of the line, drop
2905 down a line at that character. */
2906
2907 static void
2908 clip_contour_top (y_pos, x_pos)
2909 {
2910 register XPoint *begin = contour_lines[y_pos].top_left;
2911 register XPoint *end;
2912 register int npoints;
2913 register struct display_line *line = selected_frame->phys_lines[y_pos + 1];
2914
2915 if (x_pos >= line->len - 1) /* Draw one, straight horizontal line. */
2916 {
2917 end = contour_lines[y_pos].top_right;
2918 npoints = (end - begin + 1);
2919 XDrawLines (x_current_display, contour_window,
2920 contour_erase_gc, begin_erase, npoints, CoordModeOrigin);
2921
2922 bcopy (end, begin + 1, contour_last_point - end + 1);
2923 contour_last_point -= (npoints - 2);
2924 XDrawLines (x_current_display, contour_window,
2925 contour_erase_gc, begin, 2, CoordModeOrigin);
2926 XFlush (x_current_display);
2927
2928 /* Now, update contour_lines structure. */
2929 }
2930 /* ______. */
2931 else /* |________*/
2932 {
2933 register XPoint *p = begin + 1;
2934 end = contour_lines[y_pos].bottom_right;
2935 npoints = (end - begin + 1);
2936 XDrawLines (x_current_display, contour_window,
2937 contour_erase_gc, begin_erase, npoints, CoordModeOrigin);
2938
2939 p->y = begin->y;
2940 p->x = ibw + (font_w * (x_pos + 1));
2941 p++;
2942 p->y = begin->y + font_h;
2943 p->x = (p - 1)->x;
2944 bcopy (end, begin + 3, contour_last_point - end + 1);
2945 contour_last_point -= (npoints - 5);
2946 XDrawLines (x_current_display, contour_window,
2947 contour_erase_gc, begin, 4, CoordModeOrigin);
2948 XFlush (x_current_display);
2949
2950 /* Now, update contour_lines structure. */
2951 }
2952 }
2953
2954 /* Erase the top horizontal lines of the contour, and then extend
2955 the contour upwards. */
2956
2957 static void
2958 extend_contour_top (line)
2959 {
2960 }
2961
2962 static void
2963 clip_contour_bottom (x_pos, y_pos)
2964 int x_pos, y_pos;
2965 {
2966 }
2967
2968 static void
2969 extend_contour_bottom (x_pos, y_pos)
2970 {
2971 }
2972
2973 DEFUN ("x-select-region", Fx_select_region, Sx_select_region, 1, 1, "e",
2974 "")
2975 (event)
2976 Lisp_Object event;
2977 {
2978 register struct frame *f = selected_frame;
2979 register int point_x = f->cursor_x;
2980 register int point_y = f->cursor_y;
2981 register int mouse_below_point;
2982 register Lisp_Object obj;
2983 register int x_contour_x, x_contour_y;
2984
2985 x_contour_x = x_mouse_x;
2986 x_contour_y = x_mouse_y;
2987 if (x_contour_y > point_y || (x_contour_y == point_y
2988 && x_contour_x > point_x))
2989 {
2990 mouse_below_point = 1;
2991 outline_region (f, f->display.x->cursor_gc, point_x, point_y,
2992 x_contour_x, x_contour_y);
2993 }
2994 else
2995 {
2996 mouse_below_point = 0;
2997 outline_region (f, f->display.x->cursor_gc, x_contour_x, x_contour_y,
2998 point_x, point_y);
2999 }
3000
3001 while (1)
3002 {
3003 obj = read_char (-1, 0, 0, Qnil, 0);
3004 if (XTYPE (obj) != Lisp_Cons)
3005 break;
3006
3007 if (mouse_below_point)
3008 {
3009 if (x_mouse_y <= point_y) /* Flipped. */
3010 {
3011 mouse_below_point = 0;
3012
3013 outline_region (f, f->display.x->reverse_gc, point_x, point_y,
3014 x_contour_x, x_contour_y);
3015 outline_region (f, f->display.x->cursor_gc, x_mouse_x, x_mouse_y,
3016 point_x, point_y);
3017 }
3018 else if (x_mouse_y < x_contour_y) /* Bottom clipped. */
3019 {
3020 clip_contour_bottom (x_mouse_y);
3021 }
3022 else if (x_mouse_y > x_contour_y) /* Bottom extended. */
3023 {
3024 extend_bottom_contour (x_mouse_y);
3025 }
3026
3027 x_contour_x = x_mouse_x;
3028 x_contour_y = x_mouse_y;
3029 }
3030 else /* mouse above or same line as point */
3031 {
3032 if (x_mouse_y >= point_y) /* Flipped. */
3033 {
3034 mouse_below_point = 1;
3035
3036 outline_region (f, f->display.x->reverse_gc,
3037 x_contour_x, x_contour_y, point_x, point_y);
3038 outline_region (f, f->display.x->cursor_gc, point_x, point_y,
3039 x_mouse_x, x_mouse_y);
3040 }
3041 else if (x_mouse_y > x_contour_y) /* Top clipped. */
3042 {
3043 clip_contour_top (x_mouse_y);
3044 }
3045 else if (x_mouse_y < x_contour_y) /* Top extended. */
3046 {
3047 extend_contour_top (x_mouse_y);
3048 }
3049 }
3050 }
3051
3052 unread_command_event = obj;
3053 if (mouse_below_point)
3054 {
3055 contour_begin_x = point_x;
3056 contour_begin_y = point_y;
3057 contour_end_x = x_contour_x;
3058 contour_end_y = x_contour_y;
3059 }
3060 else
3061 {
3062 contour_begin_x = x_contour_x;
3063 contour_begin_y = x_contour_y;
3064 contour_end_x = point_x;
3065 contour_end_y = point_y;
3066 }
3067 }
3068 #endif
3069
3070 DEFUN ("x-horizontal-line", Fx_horizontal_line, Sx_horizontal_line, 1, 1, "e",
3071 "")
3072 (event)
3073 Lisp_Object event;
3074 {
3075 register Lisp_Object obj;
3076 struct frame *f = selected_frame;
3077 register struct window *w = XWINDOW (selected_window);
3078 register GC line_gc = f->display.x->cursor_gc;
3079 register GC erase_gc = f->display.x->reverse_gc;
3080 #if 0
3081 char dash_list[] = {6, 4, 6, 4};
3082 int dashes = 4;
3083 XGCValues gc_values;
3084 #endif
3085 register int previous_y;
3086 register int line = (x_mouse_y + 1) * FONT_HEIGHT (f->display.x->font)
3087 + f->display.x->internal_border_width;
3088 register int left = f->display.x->internal_border_width
3089 + (w->left
3090 * FONT_WIDTH (f->display.x->font));
3091 register int right = left + (w->width
3092 * FONT_WIDTH (f->display.x->font))
3093 - f->display.x->internal_border_width;
3094
3095 #if 0
3096 BLOCK_INPUT;
3097 gc_values.foreground = f->display.x->cursor_pixel;
3098 gc_values.background = f->display.x->background_pixel;
3099 gc_values.line_width = 1;
3100 gc_values.line_style = LineOnOffDash;
3101 gc_values.cap_style = CapRound;
3102 gc_values.join_style = JoinRound;
3103
3104 line_gc = XCreateGC (x_current_display, FRAME_X_WINDOW (f),
3105 GCLineStyle | GCJoinStyle | GCCapStyle
3106 | GCLineWidth | GCForeground | GCBackground,
3107 &gc_values);
3108 XSetDashes (x_current_display, line_gc, 0, dash_list, dashes);
3109 gc_values.foreground = f->display.x->background_pixel;
3110 gc_values.background = f->display.x->foreground_pixel;
3111 erase_gc = XCreateGC (x_current_display, FRAME_X_WINDOW (f),
3112 GCLineStyle | GCJoinStyle | GCCapStyle
3113 | GCLineWidth | GCForeground | GCBackground,
3114 &gc_values);
3115 XSetDashes (x_current_display, erase_gc, 0, dash_list, dashes);
3116 #endif
3117
3118 while (1)
3119 {
3120 BLOCK_INPUT;
3121 if (x_mouse_y >= XINT (w->top)
3122 && x_mouse_y < XINT (w->top) + XINT (w->height) - 1)
3123 {
3124 previous_y = x_mouse_y;
3125 line = (x_mouse_y + 1) * FONT_HEIGHT (f->display.x->font)
3126 + f->display.x->internal_border_width;
3127 XDrawLine (x_current_display, FRAME_X_WINDOW (f),
3128 line_gc, left, line, right, line);
3129 }
3130 XFlushQueue ();
3131 UNBLOCK_INPUT;
3132
3133 do
3134 {
3135 obj = read_char (-1, 0, 0, Qnil, 0);
3136 if ((XTYPE (obj) != Lisp_Cons)
3137 || (! EQ (Fcar (Fcdr (Fcdr (obj))),
3138 Qvertical_scroll_bar))
3139 || x_mouse_grabbed)
3140 {
3141 BLOCK_INPUT;
3142 XDrawLine (x_current_display, FRAME_X_WINDOW (f),
3143 erase_gc, left, line, right, line);
3144 UNBLOCK_INPUT;
3145 unread_command_event = obj;
3146 #if 0
3147 XFreeGC (x_current_display, line_gc);
3148 XFreeGC (x_current_display, erase_gc);
3149 #endif
3150 return Qnil;
3151 }
3152 }
3153 while (x_mouse_y == previous_y);
3154
3155 BLOCK_INPUT;
3156 XDrawLine (x_current_display, FRAME_X_WINDOW (f),
3157 erase_gc, left, line, right, line);
3158 UNBLOCK_INPUT;
3159 }
3160 }
3161 #endif
3162 \f
3163 /* Offset in buffer of character under the pointer, or 0. */
3164 int mouse_buffer_offset;
3165
3166 #if 0
3167 /* These keep track of the rectangle following the pointer. */
3168 int mouse_track_top, mouse_track_left, mouse_track_width;
3169
3170 DEFUN ("x-track-pointer", Fx_track_pointer, Sx_track_pointer, 0, 0, 0,
3171 "Track the pointer.")
3172 ()
3173 {
3174 static Cursor current_pointer_shape;
3175 FRAME_PTR f = x_mouse_frame;
3176
3177 BLOCK_INPUT;
3178 if (EQ (Vmouse_frame_part, Qtext_part)
3179 && (current_pointer_shape != f->display.x->nontext_cursor))
3180 {
3181 unsigned char c;
3182 struct buffer *buf;
3183
3184 current_pointer_shape = f->display.x->nontext_cursor;
3185 XDefineCursor (x_current_display,
3186 FRAME_X_WINDOW (f),
3187 current_pointer_shape);
3188
3189 buf = XBUFFER (XWINDOW (Vmouse_window)->buffer);
3190 c = *(BUF_CHAR_ADDRESS (buf, mouse_buffer_offset));
3191 }
3192 else if (EQ (Vmouse_frame_part, Qmodeline_part)
3193 && (current_pointer_shape != f->display.x->modeline_cursor))
3194 {
3195 current_pointer_shape = f->display.x->modeline_cursor;
3196 XDefineCursor (x_current_display,
3197 FRAME_X_WINDOW (f),
3198 current_pointer_shape);
3199 }
3200
3201 XFlushQueue ();
3202 UNBLOCK_INPUT;
3203 }
3204 #endif
3205
3206 #if 0
3207 DEFUN ("x-track-pointer", Fx_track_pointer, Sx_track_pointer, 1, 1, "e",
3208 "Draw rectangle around character under mouse pointer, if there is one.")
3209 (event)
3210 Lisp_Object event;
3211 {
3212 struct window *w = XWINDOW (Vmouse_window);
3213 struct frame *f = XFRAME (WINDOW_FRAME (w));
3214 struct buffer *b = XBUFFER (w->buffer);
3215 Lisp_Object obj;
3216
3217 if (! EQ (Vmouse_window, selected_window))
3218 return Qnil;
3219
3220 if (EQ (event, Qnil))
3221 {
3222 int x, y;
3223
3224 x_read_mouse_position (selected_frame, &x, &y);
3225 }
3226
3227 BLOCK_INPUT;
3228 mouse_track_width = 0;
3229 mouse_track_left = mouse_track_top = -1;
3230
3231 do
3232 {
3233 if ((x_mouse_x != mouse_track_left
3234 && (x_mouse_x < mouse_track_left
3235 || x_mouse_x > (mouse_track_left + mouse_track_width)))
3236 || x_mouse_y != mouse_track_top)
3237 {
3238 int hp = 0; /* Horizontal position */
3239 int len = FRAME_CURRENT_GLYPHS (f)->used[x_mouse_y];
3240 int p = FRAME_CURRENT_GLYPHS (f)->bufp[x_mouse_y];
3241 int tab_width = XINT (b->tab_width);
3242 int ctl_arrow_p = !NILP (b->ctl_arrow);
3243 unsigned char c;
3244 int mode_line_vpos = XFASTINT (w->height) + XFASTINT (w->top) - 1;
3245 int in_mode_line = 0;
3246
3247 if (! FRAME_CURRENT_GLYPHS (f)->enable[x_mouse_y])
3248 break;
3249
3250 /* Erase previous rectangle. */
3251 if (mouse_track_width)
3252 {
3253 x_rectangle (f, f->display.x->reverse_gc,
3254 mouse_track_left, mouse_track_top,
3255 mouse_track_width, 1);
3256
3257 if ((mouse_track_left == f->phys_cursor_x
3258 || mouse_track_left == f->phys_cursor_x - 1)
3259 && mouse_track_top == f->phys_cursor_y)
3260 {
3261 x_display_cursor (f, 1);
3262 }
3263 }
3264
3265 mouse_track_left = x_mouse_x;
3266 mouse_track_top = x_mouse_y;
3267 mouse_track_width = 0;
3268
3269 if (mouse_track_left > len) /* Past the end of line. */
3270 goto draw_or_not;
3271
3272 if (mouse_track_top == mode_line_vpos)
3273 {
3274 in_mode_line = 1;
3275 goto draw_or_not;
3276 }
3277
3278 if (tab_width <= 0 || tab_width > 20) tab_width = 8;
3279 do
3280 {
3281 c = FETCH_CHAR (p);
3282 if (len == f->width && hp == len - 1 && c != '\n')
3283 goto draw_or_not;
3284
3285 switch (c)
3286 {
3287 case '\t':
3288 mouse_track_width = tab_width - (hp % tab_width);
3289 p++;
3290 hp += mouse_track_width;
3291 if (hp > x_mouse_x)
3292 {
3293 mouse_track_left = hp - mouse_track_width;
3294 goto draw_or_not;
3295 }
3296 continue;
3297
3298 case '\n':
3299 mouse_track_width = -1;
3300 goto draw_or_not;
3301
3302 default:
3303 if (ctl_arrow_p && (c < 040 || c == 0177))
3304 {
3305 if (p > ZV)
3306 goto draw_or_not;
3307
3308 mouse_track_width = 2;
3309 p++;
3310 hp +=2;
3311 if (hp > x_mouse_x)
3312 {
3313 mouse_track_left = hp - mouse_track_width;
3314 goto draw_or_not;
3315 }
3316 }
3317 else
3318 {
3319 mouse_track_width = 1;
3320 p++;
3321 hp++;
3322 }
3323 continue;
3324 }
3325 }
3326 while (hp <= x_mouse_x);
3327
3328 draw_or_not:
3329 if (mouse_track_width) /* Over text; use text pointer shape. */
3330 {
3331 XDefineCursor (x_current_display,
3332 FRAME_X_WINDOW (f),
3333 f->display.x->text_cursor);
3334 x_rectangle (f, f->display.x->cursor_gc,
3335 mouse_track_left, mouse_track_top,
3336 mouse_track_width, 1);
3337 }
3338 else if (in_mode_line)
3339 XDefineCursor (x_current_display,
3340 FRAME_X_WINDOW (f),
3341 f->display.x->modeline_cursor);
3342 else
3343 XDefineCursor (x_current_display,
3344 FRAME_X_WINDOW (f),
3345 f->display.x->nontext_cursor);
3346 }
3347
3348 XFlush (x_current_display);
3349 UNBLOCK_INPUT;
3350
3351 obj = read_char (-1, 0, 0, Qnil, 0);
3352 BLOCK_INPUT;
3353 }
3354 while (XTYPE (obj) == Lisp_Cons /* Mouse event */
3355 && EQ (Fcar (Fcdr (Fcdr (obj))), Qnil) /* Not scroll bar */
3356 && EQ (Vmouse_depressed, Qnil) /* Only motion events */
3357 && EQ (Vmouse_window, selected_window) /* In this window */
3358 && x_mouse_frame);
3359
3360 unread_command_event = obj;
3361
3362 if (mouse_track_width)
3363 {
3364 x_rectangle (f, f->display.x->reverse_gc,
3365 mouse_track_left, mouse_track_top,
3366 mouse_track_width, 1);
3367 mouse_track_width = 0;
3368 if ((mouse_track_left == f->phys_cursor_x
3369 || mouse_track_left - 1 == f->phys_cursor_x)
3370 && mouse_track_top == f->phys_cursor_y)
3371 {
3372 x_display_cursor (f, 1);
3373 }
3374 }
3375 XDefineCursor (x_current_display,
3376 FRAME_X_WINDOW (f),
3377 f->display.x->nontext_cursor);
3378 XFlush (x_current_display);
3379 UNBLOCK_INPUT;
3380
3381 return Qnil;
3382 }
3383 #endif
3384 \f
3385 #if 0
3386 #include "glyphs.h"
3387
3388 /* Draw a pixmap specified by IMAGE_DATA of dimensions WIDTH and HEIGHT
3389 on the frame F at position X, Y. */
3390
3391 x_draw_pixmap (f, x, y, image_data, width, height)
3392 struct frame *f;
3393 int x, y, width, height;
3394 char *image_data;
3395 {
3396 Pixmap image;
3397
3398 image = XCreateBitmapFromData (x_current_display,
3399 FRAME_X_WINDOW (f), image_data,
3400 width, height);
3401 XCopyPlane (x_current_display, image, FRAME_X_WINDOW (f),
3402 f->display.x->normal_gc, 0, 0, width, height, x, y);
3403 }
3404 #endif
3405 \f
3406 #ifndef HAVE_X11
3407 DEFUN ("x-store-cut-buffer", Fx_store_cut_buffer, Sx_store_cut_buffer,
3408 1, 1, "sStore text in cut buffer: ",
3409 "Store contents of STRING into the cut buffer of the X window system.")
3410 (string)
3411 register Lisp_Object string;
3412 {
3413 int mask;
3414
3415 CHECK_STRING (string, 1);
3416 if (! FRAME_X_P (selected_frame))
3417 error ("Selected frame does not understand X protocol.");
3418
3419 BLOCK_INPUT;
3420 XStoreBytes ((char *) XSTRING (string)->data, XSTRING (string)->size);
3421 UNBLOCK_INPUT;
3422
3423 return Qnil;
3424 }
3425
3426 DEFUN ("x-get-cut-buffer", Fx_get_cut_buffer, Sx_get_cut_buffer, 0, 0, 0,
3427 "Return contents of cut buffer of the X window system, as a string.")
3428 ()
3429 {
3430 int len;
3431 register Lisp_Object string;
3432 int mask;
3433 register char *d;
3434
3435 BLOCK_INPUT;
3436 d = XFetchBytes (&len);
3437 string = make_string (d, len);
3438 XFree (d);
3439 UNBLOCK_INPUT;
3440 return string;
3441 }
3442 #endif /* X10 */
3443 \f
3444 #if 0 /* I'm told these functions are superfluous
3445 given the ability to bind function keys. */
3446
3447 #ifdef HAVE_X11
3448 DEFUN ("x-rebind-key", Fx_rebind_key, Sx_rebind_key, 3, 3, 0,
3449 "Rebind X keysym KEYSYM, with MODIFIERS, to generate NEWSTRING.\n\
3450 KEYSYM is a string which conforms to the X keysym definitions found\n\
3451 in X11/keysymdef.h, sans the initial XK_. MODIFIERS is nil or a\n\
3452 list of strings specifying modifier keys such as Control_L, which must\n\
3453 also be depressed for NEWSTRING to appear.")
3454 (x_keysym, modifiers, newstring)
3455 register Lisp_Object x_keysym;
3456 register Lisp_Object modifiers;
3457 register Lisp_Object newstring;
3458 {
3459 char *rawstring;
3460 register KeySym keysym;
3461 KeySym modifier_list[16];
3462
3463 check_x ();
3464 CHECK_STRING (x_keysym, 1);
3465 CHECK_STRING (newstring, 3);
3466
3467 keysym = XStringToKeysym ((char *) XSTRING (x_keysym)->data);
3468 if (keysym == NoSymbol)
3469 error ("Keysym does not exist");
3470
3471 if (NILP (modifiers))
3472 XRebindKeysym (x_current_display, keysym, modifier_list, 0,
3473 XSTRING (newstring)->data, XSTRING (newstring)->size);
3474 else
3475 {
3476 register Lisp_Object rest, mod;
3477 register int i = 0;
3478
3479 for (rest = modifiers; !NILP (rest); rest = Fcdr (rest))
3480 {
3481 if (i == 16)
3482 error ("Can't have more than 16 modifiers");
3483
3484 mod = Fcar (rest);
3485 CHECK_STRING (mod, 3);
3486 modifier_list[i] = XStringToKeysym ((char *) XSTRING (mod)->data);
3487 #ifndef HAVE_X11R5
3488 if (modifier_list[i] == NoSymbol
3489 || !(IsModifierKey (modifier_list[i])
3490 || ((unsigned)(modifier_list[i]) == XK_Mode_switch)
3491 || ((unsigned)(modifier_list[i]) == XK_Num_Lock)))
3492 #else
3493 if (modifier_list[i] == NoSymbol
3494 || !IsModifierKey (modifier_list[i]))
3495 #endif
3496 error ("Element is not a modifier keysym");
3497 i++;
3498 }
3499
3500 XRebindKeysym (x_current_display, keysym, modifier_list, i,
3501 XSTRING (newstring)->data, XSTRING (newstring)->size);
3502 }
3503
3504 return Qnil;
3505 }
3506
3507 DEFUN ("x-rebind-keys", Fx_rebind_keys, Sx_rebind_keys, 2, 2, 0,
3508 "Rebind KEYCODE to list of strings STRINGS.\n\
3509 STRINGS should be a list of 16 elements, one for each shift combination.\n\
3510 nil as element means don't change.\n\
3511 See the documentation of `x-rebind-key' for more information.")
3512 (keycode, strings)
3513 register Lisp_Object keycode;
3514 register Lisp_Object strings;
3515 {
3516 register Lisp_Object item;
3517 register unsigned char *rawstring;
3518 KeySym rawkey, modifier[1];
3519 int strsize;
3520 register unsigned i;
3521
3522 check_x ();
3523 CHECK_NUMBER (keycode, 1);
3524 CHECK_CONS (strings, 2);
3525 rawkey = (KeySym) ((unsigned) (XINT (keycode))) & 255;
3526 for (i = 0; i <= 15; strings = Fcdr (strings), i++)
3527 {
3528 item = Fcar (strings);
3529 if (!NILP (item))
3530 {
3531 CHECK_STRING (item, 2);
3532 strsize = XSTRING (item)->size;
3533 rawstring = (unsigned char *) xmalloc (strsize);
3534 bcopy (XSTRING (item)->data, rawstring, strsize);
3535 modifier[1] = 1 << i;
3536 XRebindKeysym (x_current_display, rawkey, modifier, 1,
3537 rawstring, strsize);
3538 }
3539 }
3540 return Qnil;
3541 }
3542 #endif /* HAVE_X11 */
3543 #endif /* 0 */
3544 \f
3545 #ifdef HAVE_X11
3546
3547 #ifndef HAVE_XSCREENNUMBEROFSCREEN
3548 int
3549 XScreenNumberOfScreen (scr)
3550 register Screen *scr;
3551 {
3552 register Display *dpy;
3553 register Screen *dpyscr;
3554 register int i;
3555
3556 dpy = scr->display;
3557 dpyscr = dpy->screens;
3558
3559 for (i = 0; i < dpy->nscreens; i++, dpyscr++)
3560 if (scr == dpyscr)
3561 return i;
3562
3563 return -1;
3564 }
3565 #endif /* not HAVE_XSCREENNUMBEROFSCREEN */
3566
3567 Visual *
3568 select_visual (screen, depth)
3569 Screen *screen;
3570 unsigned int *depth;
3571 {
3572 Visual *v;
3573 XVisualInfo *vinfo, vinfo_template;
3574 int n_visuals;
3575
3576 v = DefaultVisualOfScreen (screen);
3577
3578 #ifdef HAVE_X11R4
3579 vinfo_template.visualid = XVisualIDFromVisual (v);
3580 #else
3581 vinfo_template.visualid = v->visualid;
3582 #endif
3583
3584 vinfo_template.screen = XScreenNumberOfScreen (screen);
3585
3586 vinfo = XGetVisualInfo (x_current_display,
3587 VisualIDMask | VisualScreenMask, &vinfo_template,
3588 &n_visuals);
3589 if (n_visuals != 1)
3590 fatal ("Can't get proper X visual info");
3591
3592 if ((1 << vinfo->depth) == vinfo->colormap_size)
3593 *depth = vinfo->depth;
3594 else
3595 {
3596 int i = 0;
3597 int n = vinfo->colormap_size - 1;
3598 while (n)
3599 {
3600 n = n >> 1;
3601 i++;
3602 }
3603 *depth = i;
3604 }
3605
3606 XFree ((char *) vinfo);
3607 return v;
3608 }
3609 #endif /* HAVE_X11 */
3610
3611 DEFUN ("x-open-connection", Fx_open_connection, Sx_open_connection,
3612 1, 2, 0, "Open a connection to an X server.\n\
3613 DISPLAY is the name of the display to connect to.\n\
3614 Optional second arg XRM_STRING is a string of resources in xrdb format.")
3615 (display, xrm_string)
3616 Lisp_Object display, xrm_string;
3617 {
3618 unsigned int n_planes;
3619 unsigned char *xrm_option;
3620
3621 CHECK_STRING (display, 0);
3622 if (x_current_display != 0)
3623 error ("X server connection is already initialized");
3624 if (! NILP (xrm_string))
3625 CHECK_STRING (xrm_string, 1);
3626
3627 /* This is what opens the connection and sets x_current_display.
3628 This also initializes many symbols, such as those used for input. */
3629 x_term_init (XSTRING (display)->data);
3630
3631 #ifdef HAVE_X11
3632 XFASTINT (Vwindow_system_version) = 11;
3633
3634 if (! NILP (xrm_string))
3635 xrm_option = (unsigned char *) XSTRING (xrm_string)->data;
3636 else
3637 xrm_option = (unsigned char *) 0;
3638
3639 validate_x_resource_name ();
3640
3641 BLOCK_INPUT;
3642 xrdb = x_load_resources (x_current_display, xrm_option,
3643 (char *) XSTRING (Vx_resource_name)->data,
3644 EMACS_CLASS);
3645 UNBLOCK_INPUT;
3646 #ifdef HAVE_XRMSETDATABASE
3647 XrmSetDatabase (x_current_display, xrdb);
3648 #else
3649 x_current_display->db = xrdb;
3650 #endif
3651
3652 x_screen = DefaultScreenOfDisplay (x_current_display);
3653
3654 screen_visual = select_visual (x_screen, &n_planes);
3655 x_screen_planes = n_planes;
3656 x_screen_height = HeightOfScreen (x_screen);
3657 x_screen_width = WidthOfScreen (x_screen);
3658
3659 /* X Atoms used by emacs. */
3660 Xatoms_of_xselect ();
3661 BLOCK_INPUT;
3662 Xatom_wm_protocols = XInternAtom (x_current_display, "WM_PROTOCOLS",
3663 False);
3664 Xatom_wm_take_focus = XInternAtom (x_current_display, "WM_TAKE_FOCUS",
3665 False);
3666 Xatom_wm_save_yourself = XInternAtom (x_current_display, "WM_SAVE_YOURSELF",
3667 False);
3668 Xatom_wm_delete_window = XInternAtom (x_current_display, "WM_DELETE_WINDOW",
3669 False);
3670 Xatom_wm_change_state = XInternAtom (x_current_display, "WM_CHANGE_STATE",
3671 False);
3672 Xatom_wm_configure_denied = XInternAtom (x_current_display,
3673 "WM_CONFIGURE_DENIED", False);
3674 Xatom_wm_window_moved = XInternAtom (x_current_display, "WM_MOVED",
3675 False);
3676 UNBLOCK_INPUT;
3677 #else /* not HAVE_X11 */
3678 XFASTINT (Vwindow_system_version) = 10;
3679 #endif /* not HAVE_X11 */
3680 return Qnil;
3681 }
3682
3683 DEFUN ("x-close-current-connection", Fx_close_current_connection,
3684 Sx_close_current_connection,
3685 0, 0, 0, "Close the connection to the current X server.")
3686 ()
3687 {
3688 #ifdef HAVE_X11
3689 /* This is ONLY used when killing emacs; For switching displays
3690 we'll have to take care of setting CloseDownMode elsewhere. */
3691
3692 if (x_current_display)
3693 {
3694 BLOCK_INPUT;
3695 XSetCloseDownMode (x_current_display, DestroyAll);
3696 XCloseDisplay (x_current_display);
3697 x_current_display = 0;
3698 }
3699 else
3700 fatal ("No current X display connection to close\n");
3701 #endif
3702 return Qnil;
3703 }
3704
3705 DEFUN ("x-synchronize", Fx_synchronize, Sx_synchronize,
3706 1, 1, 0, "If ON is non-nil, report X errors as soon as the erring request is made.\n\
3707 If ON is nil, allow buffering of requests.\n\
3708 Turning on synchronization prohibits the Xlib routines from buffering\n\
3709 requests and seriously degrades performance, but makes debugging much\n\
3710 easier.")
3711 (on)
3712 Lisp_Object on;
3713 {
3714 check_x ();
3715
3716 XSynchronize (x_current_display, !EQ (on, Qnil));
3717
3718 return Qnil;
3719 }
3720
3721 \f
3722 syms_of_xfns ()
3723 {
3724 /* This is zero if not using X windows. */
3725 x_current_display = 0;
3726
3727 /* The section below is built by the lisp expression at the top of the file,
3728 just above where these variables are declared. */
3729 /*&&& init symbols here &&&*/
3730 Qauto_raise = intern ("auto-raise");
3731 staticpro (&Qauto_raise);
3732 Qauto_lower = intern ("auto-lower");
3733 staticpro (&Qauto_lower);
3734 Qbackground_color = intern ("background-color");
3735 staticpro (&Qbackground_color);
3736 Qbar = intern ("bar");
3737 staticpro (&Qbar);
3738 Qborder_color = intern ("border-color");
3739 staticpro (&Qborder_color);
3740 Qborder_width = intern ("border-width");
3741 staticpro (&Qborder_width);
3742 Qbox = intern ("box");
3743 staticpro (&Qbox);
3744 Qcursor_color = intern ("cursor-color");
3745 staticpro (&Qcursor_color);
3746 Qcursor_type = intern ("cursor-type");
3747 staticpro (&Qcursor_type);
3748 Qfont = intern ("font");
3749 staticpro (&Qfont);
3750 Qforeground_color = intern ("foreground-color");
3751 staticpro (&Qforeground_color);
3752 Qgeometry = intern ("geometry");
3753 staticpro (&Qgeometry);
3754 Qicon_left = intern ("icon-left");
3755 staticpro (&Qicon_left);
3756 Qicon_top = intern ("icon-top");
3757 staticpro (&Qicon_top);
3758 Qicon_type = intern ("icon-type");
3759 staticpro (&Qicon_type);
3760 Qinternal_border_width = intern ("internal-border-width");
3761 staticpro (&Qinternal_border_width);
3762 Qleft = intern ("left");
3763 staticpro (&Qleft);
3764 Qmouse_color = intern ("mouse-color");
3765 staticpro (&Qmouse_color);
3766 Qnone = intern ("none");
3767 staticpro (&Qnone);
3768 Qparent_id = intern ("parent-id");
3769 staticpro (&Qparent_id);
3770 Qsuppress_icon = intern ("suppress-icon");
3771 staticpro (&Qsuppress_icon);
3772 Qtop = intern ("top");
3773 staticpro (&Qtop);
3774 Qundefined_color = intern ("undefined-color");
3775 staticpro (&Qundefined_color);
3776 Qvertical_scroll_bars = intern ("vertical-scroll-bars");
3777 staticpro (&Qvertical_scroll_bars);
3778 Qvisibility = intern ("visibility");
3779 staticpro (&Qvisibility);
3780 Qwindow_id = intern ("window-id");
3781 staticpro (&Qwindow_id);
3782 Qx_frame_parameter = intern ("x-frame-parameter");
3783 staticpro (&Qx_frame_parameter);
3784 /* This is the end of symbol initialization. */
3785
3786 Fput (Qundefined_color, Qerror_conditions,
3787 Fcons (Qundefined_color, Fcons (Qerror, Qnil)));
3788 Fput (Qundefined_color, Qerror_message,
3789 build_string ("Undefined color"));
3790
3791 init_x_parm_symbols ();
3792
3793 DEFVAR_INT ("mouse-buffer-offset", &mouse_buffer_offset,
3794 "The buffer offset of the character under the pointer.");
3795 mouse_buffer_offset = 0;
3796
3797 DEFVAR_LISP ("x-pointer-shape", &Vx_pointer_shape,
3798 "The shape of the pointer when over text.\n\
3799 Changing the value does not affect existing frames\n\
3800 unless you set the mouse color.");
3801 Vx_pointer_shape = Qnil;
3802
3803 DEFVAR_LISP ("x-resource-name", &Vx_resource_name,
3804 "The name Emacs uses to look up X resources; for internal use only.\n\
3805 `x-get-resource' uses this as the first component of the instance name\n\
3806 when requesting resource values.\n\
3807 Emacs initially sets `x-resource-name' to the name under which Emacs\n\
3808 was invoked, or to the value specified with the `-name' or `-rn'\n\
3809 switches, if present.");
3810 Vx_resource_name = Qnil;
3811
3812 #if 0
3813 DEFVAR_INT ("x-nontext-pointer-shape", &Vx_nontext_pointer_shape,
3814 "The shape of the pointer when not over text.");
3815 #endif
3816 Vx_nontext_pointer_shape = Qnil;
3817
3818 #if 0
3819 DEFVAR_INT ("x-mode-pointer-shape", &Vx_mode_pointer_shape,
3820 "The shape of the pointer when over the mode line.");
3821 #endif
3822 Vx_mode_pointer_shape = Qnil;
3823
3824 DEFVAR_LISP ("x-cursor-fore-pixel", &Vx_cursor_fore_pixel,
3825 "A string indicating the foreground color of the cursor box.");
3826 Vx_cursor_fore_pixel = Qnil;
3827
3828 DEFVAR_LISP ("mouse-grabbed", &Vmouse_depressed,
3829 "Non-nil if a mouse button is currently depressed.");
3830 Vmouse_depressed = Qnil;
3831
3832 DEFVAR_LISP ("x-no-window-manager", &Vx_no_window_manager,
3833 "t if no X window manager is in use.");
3834
3835 #ifdef HAVE_X11
3836 defsubr (&Sx_get_resource);
3837 #if 0
3838 defsubr (&Sx_draw_rectangle);
3839 defsubr (&Sx_erase_rectangle);
3840 defsubr (&Sx_contour_region);
3841 defsubr (&Sx_uncontour_region);
3842 #endif
3843 defsubr (&Sx_display_color_p);
3844 defsubr (&Sx_list_fonts);
3845 defsubr (&Sx_color_defined_p);
3846 defsubr (&Sx_server_max_request_size);
3847 defsubr (&Sx_server_vendor);
3848 defsubr (&Sx_server_version);
3849 defsubr (&Sx_display_pixel_width);
3850 defsubr (&Sx_display_pixel_height);
3851 defsubr (&Sx_display_mm_width);
3852 defsubr (&Sx_display_mm_height);
3853 defsubr (&Sx_display_screens);
3854 defsubr (&Sx_display_planes);
3855 defsubr (&Sx_display_color_cells);
3856 defsubr (&Sx_display_visual_class);
3857 defsubr (&Sx_display_backing_store);
3858 defsubr (&Sx_display_save_under);
3859 #if 0
3860 defsubr (&Sx_rebind_key);
3861 defsubr (&Sx_rebind_keys);
3862 defsubr (&Sx_track_pointer);
3863 defsubr (&Sx_grab_pointer);
3864 defsubr (&Sx_ungrab_pointer);
3865 #endif
3866 #else
3867 defsubr (&Sx_get_default);
3868 defsubr (&Sx_store_cut_buffer);
3869 defsubr (&Sx_get_cut_buffer);
3870 #endif
3871 defsubr (&Sx_parse_geometry);
3872 defsubr (&Sx_create_frame);
3873 defsubr (&Sfocus_frame);
3874 defsubr (&Sunfocus_frame);
3875 #if 0
3876 defsubr (&Sx_horizontal_line);
3877 #endif
3878 defsubr (&Sx_open_connection);
3879 defsubr (&Sx_close_current_connection);
3880 defsubr (&Sx_synchronize);
3881 }
3882
3883 #endif /* HAVE_X_WINDOWS */