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