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