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