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