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