1 /* Functions for the X window system.
2 Copyright (C) 1989, 1992, 1993 Free Software Foundation.
4 This file is part of GNU Emacs.
6 GNU Emacs is free software; you can redistribute it and/or modify
7 it under the terms of the GNU General Public License as published by
8 the Free Software Foundation; either version 2, or (at your option)
11 GNU Emacs is distributed in the hope that it will be useful,
12 but WITHOUT ANY WARRANTY; without even the implied warranty of
13 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14 GNU General Public License for more details.
16 You should have received a copy of the GNU General Public License
17 along with GNU Emacs; see the file COPYING. If not, write to
18 the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. */
20 /* Completely rewritten by Richard Stallman. */
22 /* Rewritten for X11 by Joseph Arceneaux */
34 #include "dispextern.h"
36 #include "blockinput.h"
42 #if 1 /* Used to be #ifdef EMACS_BITMAP_FILES, but this should always work. */
43 #include "bitmaps/gray.xbm"
45 #include <X11/bitmaps/gray>
48 #include "[.bitmaps]gray.xbm"
51 #define min(a,b) ((a) < (b) ? (a) : (b))
52 #define max(a,b) ((a) > (b) ? (a) : (b))
55 /* X Resource data base */
56 static XrmDatabase xrdb
;
58 /* The class of this X application. */
59 #define EMACS_CLASS "Emacs"
62 #define MAXREQUEST(dpy) (XMaxRequestSize (dpy))
64 #define MAXREQUEST(dpy) ((dpy)->max_request_size)
67 /* The name we're using in resource queries. */
68 Lisp_Object Vx_resource_name
;
70 /* Title name and application name for X stuff. */
71 extern char *x_id_name
;
73 /* The background and shape of the mouse pointer, and shape when not
74 over text or in the modeline. */
75 Lisp_Object Vx_pointer_shape
, Vx_nontext_pointer_shape
, Vx_mode_pointer_shape
;
77 /* Color of chars displayed in cursor box. */
78 Lisp_Object Vx_cursor_fore_pixel
;
80 /* The screen being used. */
81 static Screen
*x_screen
;
83 /* The X Visual we are using for X windows (the default) */
84 Visual
*screen_visual
;
86 /* Height of this X screen in pixels. */
89 /* Width of this X screen in pixels. */
92 /* Number of planes for this screen. */
95 /* Non nil if no window manager is in use. */
96 Lisp_Object Vx_no_window_manager
;
98 /* `t' if a mouse button is depressed. */
100 Lisp_Object Vmouse_depressed
;
102 extern unsigned int x_mouse_x
, x_mouse_y
, x_mouse_grabbed
;
104 /* Atom for indicating window state to the window manager. */
105 extern Atom Xatom_wm_change_state
;
107 /* Communication with window managers. */
108 extern Atom Xatom_wm_protocols
;
110 /* Kinds of protocol things we may receive. */
111 extern Atom Xatom_wm_take_focus
;
112 extern Atom Xatom_wm_save_yourself
;
113 extern Atom Xatom_wm_delete_window
;
115 /* Other WM communication */
116 extern Atom Xatom_wm_configure_denied
; /* When our config request is denied */
117 extern Atom Xatom_wm_window_moved
; /* When the WM moves us. */
121 /* Default size of an Emacs window. */
122 static char *default_window
= "=80x24+0+0";
125 char iconidentity
[MAXICID
];
126 #define ICONTAG "emacs@"
127 char minibuffer_iconidentity
[MAXICID
];
128 #define MINIBUFFER_ICONTAG "minibuffer@"
132 /* The last 23 bits of the timestamp of the last mouse button event. */
133 Time mouse_timestamp
;
135 /* Evaluate this expression to rebuild the section of syms_of_xfns
136 that initializes and staticpros the symbols declared below. Note
137 that Emacs 18 has a bug that keeps C-x C-e from being able to
138 evaluate this expression.
141 ;; Accumulate a list of the symbols we want to initialize from the
142 ;; declarations at the top of the file.
143 (goto-char (point-min))
144 (search-forward "/\*&&& symbols declared here &&&*\/\n")
146 (while (looking-at "Lisp_Object \\(Q[a-z_]+\\)")
148 (cons (buffer-substring (match-beginning 1) (match-end 1))
151 (setq symbol-list (nreverse symbol-list))
152 ;; Delete the section of syms_of_... where we initialize the symbols.
153 (search-forward "\n /\*&&& init symbols here &&&*\/\n")
154 (let ((start (point)))
155 (while (looking-at "^ Q")
157 (kill-region start (point)))
158 ;; Write a new symbol initialization section.
160 (insert (format " %s = intern (\"" (car symbol-list)))
161 (let ((start (point)))
162 (insert (substring (car symbol-list) 1))
163 (subst-char-in-region start (point) ?_ ?-))
164 (insert (format "\");\n staticpro (&%s);\n" (car symbol-list)))
165 (setq symbol-list (cdr symbol-list)))))
169 /*&&& symbols declared here &&&*/
170 Lisp_Object Qauto_raise
;
171 Lisp_Object Qauto_lower
;
172 Lisp_Object Qbackground_color
;
174 Lisp_Object Qborder_color
;
175 Lisp_Object Qborder_width
;
177 Lisp_Object Qcursor_color
;
178 Lisp_Object Qcursor_type
;
180 Lisp_Object Qforeground_color
;
181 Lisp_Object Qgeometry
;
182 /* Lisp_Object Qicon; */
183 Lisp_Object Qicon_left
;
184 Lisp_Object Qicon_top
;
185 Lisp_Object Qicon_type
;
186 Lisp_Object Qinternal_border_width
;
188 Lisp_Object Qmouse_color
;
190 Lisp_Object Qparent_id
;
191 Lisp_Object Qsuppress_icon
;
193 Lisp_Object Qundefined_color
;
194 Lisp_Object Qvertical_scroll_bars
;
195 Lisp_Object Qvisibility
;
196 Lisp_Object Qwindow_id
;
197 Lisp_Object Qx_frame_parameter
;
199 /* The below are defined in frame.c. */
200 extern Lisp_Object Qheight
, Qminibuffer
, Qname
, Qonly
, Qwidth
;
201 extern Lisp_Object Qunsplittable
, Qmenu_bar_lines
;
203 extern Lisp_Object Vwindow_system_version
;
206 /* Error if we are not connected to X. */
210 if (x_current_display
== 0)
211 error ("X windows are not in use or not initialized");
214 /* Return the Emacs frame-object corresponding to an X window.
215 It could be the frame's main window or an icon window. */
217 /* This function can be called during GC, so use XGCTYPE. */
220 x_window_to_frame (wdesc
)
223 Lisp_Object tail
, frame
;
226 for (tail
= Vframe_list
; XGCTYPE (tail
) == Lisp_Cons
;
227 tail
= XCONS (tail
)->cdr
)
229 frame
= XCONS (tail
)->car
;
230 if (XGCTYPE (frame
) != Lisp_Frame
)
233 if (FRAME_X_WINDOW (f
) == wdesc
234 || f
->display
.x
->icon_desc
== wdesc
)
241 /* Connect the frame-parameter names for X frames
242 to the ways of passing the parameter values to the window system.
244 The name of a parameter, as a Lisp symbol,
245 has an `x-frame-parameter' property which is an integer in Lisp
246 but can be interpreted as an `enum x_frame_parm' in C. */
250 X_PARM_FOREGROUND_COLOR
,
251 X_PARM_BACKGROUND_COLOR
,
258 X_PARM_INTERNAL_BORDER_WIDTH
,
262 X_PARM_VERT_SCROLL_BAR
,
264 X_PARM_MENU_BAR_LINES
268 struct x_frame_parm_table
271 void (*setter
)( /* struct frame *frame, Lisp_Object val, oldval */ );
274 void x_set_foreground_color ();
275 void x_set_background_color ();
276 void x_set_mouse_color ();
277 void x_set_cursor_color ();
278 void x_set_border_color ();
279 void x_set_cursor_type ();
280 void x_set_icon_type ();
282 void x_set_border_width ();
283 void x_set_internal_border_width ();
284 void x_explicitly_set_name ();
285 void x_set_autoraise ();
286 void x_set_autolower ();
287 void x_set_vertical_scroll_bars ();
288 void x_set_visibility ();
289 void x_set_menu_bar_lines ();
291 static struct x_frame_parm_table x_frame_parms
[] =
293 "foreground-color", x_set_foreground_color
,
294 "background-color", x_set_background_color
,
295 "mouse-color", x_set_mouse_color
,
296 "cursor-color", x_set_cursor_color
,
297 "border-color", x_set_border_color
,
298 "cursor-type", x_set_cursor_type
,
299 "icon-type", x_set_icon_type
,
301 "border-width", x_set_border_width
,
302 "internal-border-width", x_set_internal_border_width
,
303 "name", x_explicitly_set_name
,
304 "auto-raise", x_set_autoraise
,
305 "auto-lower", x_set_autolower
,
306 "vertical-scroll-bars", x_set_vertical_scroll_bars
,
307 "visibility", x_set_visibility
,
308 "menu-bar-lines", x_set_menu_bar_lines
,
311 /* Attach the `x-frame-parameter' properties to
312 the Lisp symbol names of parameters relevant to X. */
314 init_x_parm_symbols ()
318 for (i
= 0; i
< sizeof (x_frame_parms
) / sizeof (x_frame_parms
[0]); i
++)
319 Fput (intern (x_frame_parms
[i
].name
), Qx_frame_parameter
,
323 /* Change the parameters of FRAME as specified by ALIST.
324 If a parameter is not specially recognized, do nothing;
325 otherwise call the `x_set_...' function for that parameter. */
328 x_set_frame_parameters (f
, alist
)
334 /* If both of these parameters are present, it's more efficient to
335 set them both at once. So we wait until we've looked at the
336 entire list before we set them. */
337 Lisp_Object width
, height
;
340 Lisp_Object left
, top
;
342 /* Record in these vectors all the parms specified. */
348 for (tail
= alist
; CONSP (tail
); tail
= Fcdr (tail
))
351 parms
= (Lisp_Object
*) alloca (i
* sizeof (Lisp_Object
));
352 values
= (Lisp_Object
*) alloca (i
* sizeof (Lisp_Object
));
354 /* Extract parm names and values into those vectors. */
357 for (tail
= alist
; CONSP (tail
); tail
= Fcdr (tail
))
359 Lisp_Object elt
, prop
, val
;
362 parms
[i
] = Fcar (elt
);
363 values
[i
] = Fcdr (elt
);
367 width
= height
= top
= left
= Qunbound
;
369 /* Now process them in reverse of specified order. */
370 for (i
--; i
>= 0; i
--)
372 Lisp_Object prop
, val
;
377 if (EQ (prop
, Qwidth
))
379 else if (EQ (prop
, Qheight
))
381 else if (EQ (prop
, Qtop
))
383 else if (EQ (prop
, Qleft
))
387 register Lisp_Object param_index
= Fget (prop
, Qx_frame_parameter
);
388 register Lisp_Object old_value
= get_frame_param (f
, prop
);
390 store_frame_param (f
, prop
, val
);
391 if (XTYPE (param_index
) == Lisp_Int
392 && XINT (param_index
) >= 0
393 && (XINT (param_index
)
394 < sizeof (x_frame_parms
)/sizeof (x_frame_parms
[0])))
395 (*x_frame_parms
[XINT (param_index
)].setter
)(f
, val
, old_value
);
399 /* Don't die if just one of these was set. */
400 if (EQ (left
, Qunbound
))
401 XSET (left
, Lisp_Int
, f
->display
.x
->left_pos
);
402 if (EQ (top
, Qunbound
))
403 XSET (top
, Lisp_Int
, f
->display
.x
->top_pos
);
405 /* Don't die if just one of these was set. */
406 if (EQ (width
, Qunbound
))
407 XSET (width
, Lisp_Int
, FRAME_WIDTH (f
));
408 if (EQ (height
, Qunbound
))
409 XSET (height
, Lisp_Int
, FRAME_HEIGHT (f
));
411 /* Don't set these parameters these unless they've been explicitly
412 specified. The window might be mapped or resized while we're in
413 this function, and we don't want to override that unless the lisp
414 code has asked for it.
416 Don't set these parameters unless they actually differ from the
417 window's current parameters; the window may not actually exist
422 check_frame_size (f
, &height
, &width
);
424 XSET (frame
, Lisp_Frame
, f
);
426 if ((NUMBERP (width
) && XINT (width
) != FRAME_WIDTH (f
))
427 || (NUMBERP (height
) && XINT (height
) != FRAME_HEIGHT (f
)))
428 Fset_frame_size (frame
, width
, height
);
429 if ((NUMBERP (left
) && XINT (left
) != f
->display
.x
->left_pos
)
430 || (NUMBERP (top
) && XINT (top
) != f
->display
.x
->top_pos
))
431 Fset_frame_position (frame
, left
, top
);
435 /* Insert a description of internally-recorded parameters of frame X
436 into the parameter alist *ALISTPTR that is to be given to the user.
437 Only parameters that are specific to the X window system
438 and whose values are not correctly recorded in the frame's
439 param_alist need to be considered here. */
441 x_report_frame_params (f
, alistptr
)
443 Lisp_Object
*alistptr
;
447 store_in_alist (alistptr
, Qleft
, make_number (f
->display
.x
->left_pos
));
448 store_in_alist (alistptr
, Qtop
, make_number (f
->display
.x
->top_pos
));
449 store_in_alist (alistptr
, Qborder_width
,
450 make_number (f
->display
.x
->border_width
));
451 store_in_alist (alistptr
, Qinternal_border_width
,
452 make_number (f
->display
.x
->internal_border_width
));
453 sprintf (buf
, "%d", FRAME_X_WINDOW (f
));
454 store_in_alist (alistptr
, Qwindow_id
,
456 store_in_alist (alistptr
, Qvisibility
,
457 (FRAME_VISIBLE_P (f
) ? Qt
458 : FRAME_ICONIFIED_P (f
) ? Qicon
: Qnil
));
461 /* Decide if color named COLOR is valid for the display
462 associated with the selected frame. */
464 defined_color (color
, color_def
)
469 Colormap screen_colormap
;
474 = DefaultColormap (x_current_display
, XDefaultScreen (x_current_display
));
476 foo
= XParseColor (x_current_display
, screen_colormap
,
478 && XAllocColor (x_current_display
, screen_colormap
, color_def
);
480 foo
= XParseColor (color
, color_def
) && XGetHardwareColor (color_def
);
481 #endif /* not HAVE_X11 */
490 /* Given a string ARG naming a color, compute a pixel value from it
491 suitable for screen F.
492 If F is not a color screen, return DEF (default) regardless of what
496 x_decode_color (arg
, def
)
502 CHECK_STRING (arg
, 0);
504 if (strcmp (XSTRING (arg
)->data
, "black") == 0)
505 return BLACK_PIX_DEFAULT
;
506 else if (strcmp (XSTRING (arg
)->data
, "white") == 0)
507 return WHITE_PIX_DEFAULT
;
510 if (x_screen_planes
== 1)
513 if (DISPLAY_CELLS
== 1)
517 if (defined_color (XSTRING (arg
)->data
, &cdef
))
520 Fsignal (Qundefined_color
, Fcons (arg
, Qnil
));
523 /* Functions called only from `x_set_frame_param'
524 to set individual parameters.
526 If FRAME_X_WINDOW (f) is 0,
527 the frame is being created and its X-window does not exist yet.
528 In that case, just record the parameter's new value
529 in the standard place; do not attempt to change the window. */
532 x_set_foreground_color (f
, arg
, oldval
)
534 Lisp_Object arg
, oldval
;
536 f
->display
.x
->foreground_pixel
= x_decode_color (arg
, BLACK_PIX_DEFAULT
);
537 if (FRAME_X_WINDOW (f
) != 0)
541 XSetForeground (x_current_display
, f
->display
.x
->normal_gc
,
542 f
->display
.x
->foreground_pixel
);
543 XSetBackground (x_current_display
, f
->display
.x
->reverse_gc
,
544 f
->display
.x
->foreground_pixel
);
546 #endif /* HAVE_X11 */
547 recompute_basic_faces (f
);
548 if (FRAME_VISIBLE_P (f
))
554 x_set_background_color (f
, arg
, oldval
)
556 Lisp_Object arg
, oldval
;
561 f
->display
.x
->background_pixel
= x_decode_color (arg
, WHITE_PIX_DEFAULT
);
563 if (FRAME_X_WINDOW (f
) != 0)
567 /* The main frame area. */
568 XSetBackground (x_current_display
, f
->display
.x
->normal_gc
,
569 f
->display
.x
->background_pixel
);
570 XSetForeground (x_current_display
, f
->display
.x
->reverse_gc
,
571 f
->display
.x
->background_pixel
);
572 XSetForeground (x_current_display
, f
->display
.x
->cursor_gc
,
573 f
->display
.x
->background_pixel
);
574 XSetWindowBackground (x_current_display
, FRAME_X_WINDOW (f
),
575 f
->display
.x
->background_pixel
);
578 temp
= XMakeTile (f
->display
.x
->background_pixel
);
579 XChangeBackground (FRAME_X_WINDOW (f
), temp
);
581 #endif /* not HAVE_X11 */
584 recompute_basic_faces (f
);
586 if (FRAME_VISIBLE_P (f
))
592 x_set_mouse_color (f
, arg
, oldval
)
594 Lisp_Object arg
, oldval
;
596 Cursor cursor
, nontext_cursor
, mode_cursor
;
600 f
->display
.x
->mouse_pixel
= x_decode_color (arg
, BLACK_PIX_DEFAULT
);
601 mask_color
= f
->display
.x
->background_pixel
;
602 /* No invisible pointers. */
603 if (mask_color
== f
->display
.x
->mouse_pixel
604 && mask_color
== f
->display
.x
->background_pixel
)
605 f
->display
.x
->mouse_pixel
= f
->display
.x
->foreground_pixel
;
610 /* It's not okay to crash if the user selects a screwy cursor. */
613 if (!EQ (Qnil
, Vx_pointer_shape
))
615 CHECK_NUMBER (Vx_pointer_shape
, 0);
616 cursor
= XCreateFontCursor (x_current_display
, XINT (Vx_pointer_shape
));
619 cursor
= XCreateFontCursor (x_current_display
, XC_xterm
);
620 x_check_errors ("bad text pointer cursor: %s");
622 if (!EQ (Qnil
, Vx_nontext_pointer_shape
))
624 CHECK_NUMBER (Vx_nontext_pointer_shape
, 0);
625 nontext_cursor
= XCreateFontCursor (x_current_display
,
626 XINT (Vx_nontext_pointer_shape
));
629 nontext_cursor
= XCreateFontCursor (x_current_display
, XC_left_ptr
);
630 x_check_errors ("bad nontext pointer cursor: %s");
632 if (!EQ (Qnil
, Vx_mode_pointer_shape
))
634 CHECK_NUMBER (Vx_mode_pointer_shape
, 0);
635 mode_cursor
= XCreateFontCursor (x_current_display
,
636 XINT (Vx_mode_pointer_shape
));
639 mode_cursor
= XCreateFontCursor (x_current_display
, XC_xterm
);
641 /* Check and report errors with the above calls. */
642 x_check_errors ("can't set cursor shape: %s");
646 XColor fore_color
, back_color
;
648 fore_color
.pixel
= f
->display
.x
->mouse_pixel
;
649 back_color
.pixel
= mask_color
;
650 XQueryColor (x_current_display
,
651 DefaultColormap (x_current_display
,
652 DefaultScreen (x_current_display
)),
654 XQueryColor (x_current_display
,
655 DefaultColormap (x_current_display
,
656 DefaultScreen (x_current_display
)),
658 XRecolorCursor (x_current_display
, cursor
,
659 &fore_color
, &back_color
);
660 XRecolorCursor (x_current_display
, nontext_cursor
,
661 &fore_color
, &back_color
);
662 XRecolorCursor (x_current_display
, mode_cursor
,
663 &fore_color
, &back_color
);
666 cursor
= XCreateCursor (16, 16, MouseCursor
, MouseMask
,
668 f
->display
.x
->mouse_pixel
,
669 f
->display
.x
->background_pixel
,
673 if (FRAME_X_WINDOW (f
) != 0)
675 XDefineCursor (XDISPLAY
FRAME_X_WINDOW (f
), cursor
);
678 if (cursor
!= f
->display
.x
->text_cursor
&& f
->display
.x
->text_cursor
!= 0)
679 XFreeCursor (XDISPLAY f
->display
.x
->text_cursor
);
680 f
->display
.x
->text_cursor
= cursor
;
682 if (nontext_cursor
!= f
->display
.x
->nontext_cursor
683 && f
->display
.x
->nontext_cursor
!= 0)
684 XFreeCursor (XDISPLAY f
->display
.x
->nontext_cursor
);
685 f
->display
.x
->nontext_cursor
= nontext_cursor
;
687 if (mode_cursor
!= f
->display
.x
->modeline_cursor
688 && f
->display
.x
->modeline_cursor
!= 0)
689 XFreeCursor (XDISPLAY f
->display
.x
->modeline_cursor
);
690 f
->display
.x
->modeline_cursor
= mode_cursor
;
691 #endif /* HAVE_X11 */
698 x_set_cursor_color (f
, arg
, oldval
)
700 Lisp_Object arg
, oldval
;
702 unsigned long fore_pixel
;
704 if (!EQ (Vx_cursor_fore_pixel
, Qnil
))
705 fore_pixel
= x_decode_color (Vx_cursor_fore_pixel
, WHITE_PIX_DEFAULT
);
707 fore_pixel
= f
->display
.x
->background_pixel
;
708 f
->display
.x
->cursor_pixel
= x_decode_color (arg
, BLACK_PIX_DEFAULT
);
710 /* Make sure that the cursor color differs from the background color. */
711 if (f
->display
.x
->cursor_pixel
== f
->display
.x
->background_pixel
)
713 f
->display
.x
->cursor_pixel
== f
->display
.x
->mouse_pixel
;
714 if (f
->display
.x
->cursor_pixel
== fore_pixel
)
715 fore_pixel
= f
->display
.x
->background_pixel
;
717 f
->display
.x
->cursor_foreground_pixel
= fore_pixel
;
719 if (FRAME_X_WINDOW (f
) != 0)
723 XSetBackground (x_current_display
, f
->display
.x
->cursor_gc
,
724 f
->display
.x
->cursor_pixel
);
725 XSetForeground (x_current_display
, f
->display
.x
->cursor_gc
,
728 #endif /* HAVE_X11 */
730 if (FRAME_VISIBLE_P (f
))
732 x_display_cursor (f
, 0);
733 x_display_cursor (f
, 1);
738 /* Set the border-color of frame F to value described by ARG.
739 ARG can be a string naming a color.
740 The border-color is used for the border that is drawn by the X server.
741 Note that this does not fully take effect if done before
742 F has an x-window; it must be redone when the window is created.
744 Note: this is done in two routines because of the way X10 works.
746 Note: under X11, this is normally the province of the window manager,
747 and so emacs' border colors may be overridden. */
750 x_set_border_color (f
, arg
, oldval
)
752 Lisp_Object arg
, oldval
;
757 CHECK_STRING (arg
, 0);
758 str
= XSTRING (arg
)->data
;
761 if (!strcmp (str
, "grey") || !strcmp (str
, "Grey")
762 || !strcmp (str
, "gray") || !strcmp (str
, "Gray"))
767 pix
= x_decode_color (arg
, BLACK_PIX_DEFAULT
);
769 x_set_border_pixel (f
, pix
);
772 /* Set the border-color of frame F to pixel value PIX.
773 Note that this does not fully take effect if done before
774 F has an x-window. */
776 x_set_border_pixel (f
, pix
)
780 f
->display
.x
->border_pixel
= pix
;
782 if (FRAME_X_WINDOW (f
) != 0 && f
->display
.x
->border_width
> 0)
789 XSetWindowBorder (x_current_display
, FRAME_X_WINDOW (f
),
793 temp
= XMakePixmap ((Bitmap
) XStoreBitmap (gray_width
, gray_height
,
795 BLACK_PIX_DEFAULT
, WHITE_PIX_DEFAULT
);
797 temp
= XMakeTile (pix
);
798 XChangeBorder (FRAME_X_WINDOW (f
), temp
);
799 XFreePixmap (XDISPLAY temp
);
800 #endif /* not HAVE_X11 */
803 if (FRAME_VISIBLE_P (f
))
809 x_set_cursor_type (f
, arg
, oldval
)
811 Lisp_Object arg
, oldval
;
814 FRAME_DESIRED_CURSOR (f
) = bar_cursor
;
819 FRAME_DESIRED_CURSOR (f
) = filled_box_cursor
;
820 /* Error messages commented out because people have trouble fixing
821 .Xdefaults with Emacs, when it has something bad in it. */
825 ("the `cursor-type' frame parameter should be either `bar' or `box'");
828 /* Make sure the cursor gets redrawn. This is overkill, but how
829 often do people change cursor types? */
834 x_set_icon_type (f
, arg
, oldval
)
836 Lisp_Object arg
, oldval
;
841 if (EQ (oldval
, Qnil
) == EQ (arg
, Qnil
))
846 result
= x_text_icon (f
, 0);
848 result
= x_bitmap_icon (f
);
853 error ("No icon window available.");
856 /* If the window was unmapped (and its icon was mapped),
857 the new icon is not mapped, so map the window in its stead. */
858 if (FRAME_VISIBLE_P (f
))
859 XMapWindow (XDISPLAY
FRAME_X_WINDOW (f
));
865 extern Lisp_Object
x_new_font ();
868 x_set_font (f
, arg
, oldval
)
870 Lisp_Object arg
, oldval
;
874 CHECK_STRING (arg
, 1);
877 result
= x_new_font (f
, XSTRING (arg
)->data
);
880 if (EQ (result
, Qnil
))
881 error ("Font \"%s\" is not defined", XSTRING (arg
)->data
);
882 else if (EQ (result
, Qt
))
883 error ("the characters of the given font have varying widths");
884 else if (STRINGP (result
))
886 recompute_basic_faces (f
);
887 store_frame_param (f
, Qfont
, result
);
894 x_set_border_width (f
, arg
, oldval
)
896 Lisp_Object arg
, oldval
;
898 CHECK_NUMBER (arg
, 0);
900 if (XINT (arg
) == f
->display
.x
->border_width
)
903 if (FRAME_X_WINDOW (f
) != 0)
904 error ("Cannot change the border width of a window");
906 f
->display
.x
->border_width
= XINT (arg
);
910 x_set_internal_border_width (f
, arg
, oldval
)
912 Lisp_Object arg
, oldval
;
915 int old
= f
->display
.x
->internal_border_width
;
917 CHECK_NUMBER (arg
, 0);
918 f
->display
.x
->internal_border_width
= XINT (arg
);
919 if (f
->display
.x
->internal_border_width
< 0)
920 f
->display
.x
->internal_border_width
= 0;
922 if (f
->display
.x
->internal_border_width
== old
)
925 if (FRAME_X_WINDOW (f
) != 0)
928 x_set_window_size (f
, f
->width
, f
->height
);
930 x_set_resize_hint (f
);
934 SET_FRAME_GARBAGED (f
);
939 x_set_visibility (f
, value
, oldval
)
941 Lisp_Object value
, oldval
;
944 XSET (frame
, Lisp_Frame
, f
);
947 Fmake_frame_invisible (frame
);
948 else if (EQ (value
, Qicon
))
949 Ficonify_frame (frame
);
951 Fmake_frame_visible (frame
);
955 x_set_menu_bar_lines_1 (window
, n
)
959 struct window
*w
= XWINDOW (window
);
961 XFASTINT (w
->top
) += n
;
962 XFASTINT (w
->height
) -= n
;
964 /* Handle just the top child in a vertical split. */
965 if (!NILP (w
->vchild
))
966 x_set_menu_bar_lines_1 (w
->vchild
, n
);
968 /* Adjust all children in a horizontal split. */
969 for (window
= w
->hchild
; !NILP (window
); window
= w
->next
)
971 w
= XWINDOW (window
);
972 x_set_menu_bar_lines_1 (window
, n
);
977 x_set_menu_bar_lines (f
, value
, oldval
)
979 Lisp_Object value
, oldval
;
982 int olines
= FRAME_MENU_BAR_LINES (f
);
984 /* Right now, menu bars don't work properly in minibuf-only frames;
985 most of the commands try to apply themselves to the minibuffer
986 frame itslef, and get an error because you can't switch buffers
987 in or split the minibuffer window. */
988 if (FRAME_MINIBUF_ONLY_P (f
))
991 if (XTYPE (value
) == Lisp_Int
)
992 nlines
= XINT (value
);
996 FRAME_MENU_BAR_LINES (f
) = nlines
;
997 x_set_menu_bar_lines_1 (f
->root_window
, nlines
- olines
);
1000 /* Change the name of frame F to NAME. If NAME is nil, set F's name to
1003 If EXPLICIT is non-zero, that indicates that lisp code is setting the
1004 name; if NAME is a string, set F's name to NAME and set
1005 F->explicit_name; if NAME is Qnil, then clear F->explicit_name.
1007 If EXPLICIT is zero, that indicates that Emacs redisplay code is
1008 suggesting a new name, which lisp code should override; if
1009 F->explicit_name is set, ignore the new name; otherwise, set it. */
1012 x_set_name (f
, name
, explicit)
1017 /* Make sure that requests from lisp code override requests from
1018 Emacs redisplay code. */
1021 /* If we're switching from explicit to implicit, we had better
1022 update the mode lines and thereby update the title. */
1023 if (f
->explicit_name
&& NILP (name
))
1024 update_mode_lines
= 1;
1026 f
->explicit_name
= ! NILP (name
);
1028 else if (f
->explicit_name
)
1031 /* If NAME is nil, set the name to the x_id_name. */
1033 name
= build_string (x_id_name
);
1035 CHECK_STRING (name
, 0);
1037 /* Don't change the name if it's already NAME. */
1038 if (! NILP (Fstring_equal (name
, f
->name
)))
1041 if (FRAME_X_WINDOW (f
))
1048 text
.value
= XSTRING (name
)->data
;
1049 text
.encoding
= XA_STRING
;
1051 text
.nitems
= XSTRING (name
)->size
;
1052 XSetWMName (x_current_display
, FRAME_X_WINDOW (f
), &text
);
1053 XSetWMIconName (x_current_display
, FRAME_X_WINDOW (f
), &text
);
1056 XSetIconName (XDISPLAY
FRAME_X_WINDOW (f
),
1057 XSTRING (name
)->data
);
1058 XStoreName (XDISPLAY
FRAME_X_WINDOW (f
),
1059 XSTRING (name
)->data
);
1068 /* This function should be called when the user's lisp code has
1069 specified a name for the frame; the name will override any set by the
1072 x_explicitly_set_name (f
, arg
, oldval
)
1074 Lisp_Object arg
, oldval
;
1076 x_set_name (f
, arg
, 1);
1079 /* This function should be called by Emacs redisplay code to set the
1080 name; names set this way will never override names set by the user's
1083 x_implicitly_set_name (f
, arg
, oldval
)
1085 Lisp_Object arg
, oldval
;
1087 x_set_name (f
, arg
, 0);
1091 x_set_autoraise (f
, arg
, oldval
)
1093 Lisp_Object arg
, oldval
;
1095 f
->auto_raise
= !EQ (Qnil
, arg
);
1099 x_set_autolower (f
, arg
, oldval
)
1101 Lisp_Object arg
, oldval
;
1103 f
->auto_lower
= !EQ (Qnil
, arg
);
1107 x_set_vertical_scroll_bars (f
, arg
, oldval
)
1109 Lisp_Object arg
, oldval
;
1111 if (NILP (arg
) != ! FRAME_HAS_VERTICAL_SCROLL_BARS (f
))
1113 FRAME_HAS_VERTICAL_SCROLL_BARS (f
) = ! NILP (arg
);
1115 /* We set this parameter before creating the X window for the
1116 frame, so we can get the geometry right from the start.
1117 However, if the window hasn't been created yet, we shouldn't
1118 call x_set_window_size. */
1119 if (FRAME_X_WINDOW (f
))
1120 x_set_window_size (f
, FRAME_WIDTH (f
), FRAME_HEIGHT (f
));
1124 /* Subroutines of creating an X frame. */
1128 /* Make sure that Vx_resource_name is set to a reasonable value. */
1130 validate_x_resource_name ()
1132 if (! STRINGP (Vx_resource_name
))
1133 Vx_resource_name
= make_string ("emacs", 5);
1137 extern char *x_get_string_resource ();
1138 extern XrmDatabase
x_load_resources ();
1140 DEFUN ("x-get-resource", Fx_get_resource
, Sx_get_resource
, 2, 4, 0,
1141 "Return the value of ATTRIBUTE, of class CLASS, from the X defaults database.\n\
1142 This uses `NAME.ATTRIBUTE' as the key and `Emacs.CLASS' as the\n\
1143 class, where INSTANCE is the name under which Emacs was invoked, or\n\
1144 the name specified by the `-name' or `-rn' command-line arguments.\n\
1146 The optional arguments COMPONENT and SUBCLASS add to the key and the\n\
1147 class, respectively. You must specify both of them or neither.\n\
1148 If you specify them, the key is `NAME.COMPONENT.ATTRIBUTE'\n\
1149 and the class is `Emacs.CLASS.SUBCLASS'.")
1150 (attribute
, class, component
, subclass
)
1151 Lisp_Object attribute
, class, component
, subclass
;
1153 register char *value
;
1159 CHECK_STRING (attribute
, 0);
1160 CHECK_STRING (class, 0);
1162 if (!NILP (component
))
1163 CHECK_STRING (component
, 1);
1164 if (!NILP (subclass
))
1165 CHECK_STRING (subclass
, 2);
1166 if (NILP (component
) != NILP (subclass
))
1167 error ("x-get-resource: must specify both COMPONENT and SUBCLASS or neither");
1169 validate_x_resource_name ();
1171 if (NILP (component
))
1173 /* Allocate space for the components, the dots which separate them,
1174 and the final '\0'. */
1175 name_key
= (char *) alloca (XSTRING (Vx_resource_name
)->size
1176 + XSTRING (attribute
)->size
1178 class_key
= (char *) alloca ((sizeof (EMACS_CLASS
) - 1)
1179 + XSTRING (class)->size
1182 sprintf (name_key
, "%s.%s",
1183 XSTRING (Vx_resource_name
)->data
,
1184 XSTRING (attribute
)->data
);
1185 sprintf (class_key
, "%s.%s",
1187 XSTRING (class)->data
);
1191 name_key
= (char *) alloca (XSTRING (Vx_resource_name
)->size
1192 + XSTRING (component
)->size
1193 + XSTRING (attribute
)->size
1196 class_key
= (char *) alloca ((sizeof (EMACS_CLASS
) - 1)
1197 + XSTRING (class)->size
1198 + XSTRING (subclass
)->size
1201 sprintf (name_key
, "%s.%s.%s",
1202 XSTRING (Vx_resource_name
)->data
,
1203 XSTRING (component
)->data
,
1204 XSTRING (attribute
)->data
);
1205 sprintf (class_key
, "%s.%s.%s",
1207 XSTRING (class)->data
,
1208 XSTRING (subclass
)->data
);
1211 value
= x_get_string_resource (xrdb
, name_key
, class_key
);
1213 if (value
!= (char *) 0)
1214 return build_string (value
);
1219 /* Used when C code wants a resource value. */
1222 x_get_resource_string (attribute
, class)
1223 char *attribute
, *class;
1225 register char *value
;
1229 /* Allocate space for the components, the dots which separate them,
1230 and the final '\0'. */
1231 name_key
= (char *) alloca (XSTRING (Vinvocation_name
)->size
1232 + strlen (attribute
) + 2);
1233 class_key
= (char *) alloca ((sizeof (EMACS_CLASS
) - 1)
1234 + strlen (class) + 2);
1236 sprintf (name_key
, "%s.%s",
1237 XSTRING (Vinvocation_name
)->data
,
1239 sprintf (class_key
, "%s.%s", EMACS_CLASS
, class);
1241 return x_get_string_resource (xrdb
, name_key
, class_key
);
1246 DEFUN ("x-get-default", Fx_get_default
, Sx_get_default
, 1, 1, 0,
1247 "Get X default ATTRIBUTE from the system, or nil if no default.\n\
1248 Value is a string (when not nil) and ATTRIBUTE is also a string.\n\
1249 The defaults are specified in the file `~/.Xdefaults'.")
1253 register unsigned char *value
;
1255 CHECK_STRING (arg
, 1);
1257 value
= (unsigned char *) XGetDefault (XDISPLAY
1258 XSTRING (Vinvocation_name
)->data
,
1259 XSTRING (arg
)->data
);
1261 /* Try reversing last two args, in case this is the buggy version of X. */
1262 value
= (unsigned char *) XGetDefault (XDISPLAY
1263 XSTRING (arg
)->data
,
1264 XSTRING (Vinvocation_name
)->data
);
1266 return build_string (value
);
1271 #define Fx_get_resource(attribute, class, component, subclass) \
1272 Fx_get_default(attribute)
1276 /* Types we might convert a resource string into. */
1279 number
, boolean
, string
, symbol
1282 /* Return the value of parameter PARAM.
1284 First search ALIST, then Vdefault_frame_alist, then the X defaults
1285 database, using ATTRIBUTE as the attribute name and CLASS as its class.
1287 Convert the resource to the type specified by desired_type.
1289 If no default is specified, return Qunbound. If you call
1290 x_get_arg, make sure you deal with Qunbound in a reasonable way,
1291 and don't let it get stored in any lisp-visible variables! */
1294 x_get_arg (alist
, param
, attribute
, class, type
)
1295 Lisp_Object alist
, param
;
1298 enum resource_types type
;
1300 register Lisp_Object tem
;
1302 tem
= Fassq (param
, alist
);
1304 tem
= Fassq (param
, Vdefault_frame_alist
);
1310 tem
= Fx_get_resource (build_string (attribute
),
1311 build_string (class),
1320 return make_number (atoi (XSTRING (tem
)->data
));
1323 tem
= Fdowncase (tem
);
1324 if (!strcmp (XSTRING (tem
)->data
, "on")
1325 || !strcmp (XSTRING (tem
)->data
, "true"))
1334 /* As a special case, we map the values `true' and `on'
1335 to Qt, and `false' and `off' to Qnil. */
1337 Lisp_Object lower
= Fdowncase (tem
);
1338 if (!strcmp (XSTRING (tem
)->data
, "on")
1339 || !strcmp (XSTRING (tem
)->data
, "true"))
1341 else if (!strcmp (XSTRING (tem
)->data
, "off")
1342 || !strcmp (XSTRING (tem
)->data
, "false"))
1345 return Fintern (tem
, Qnil
);
1358 /* Record in frame F the specified or default value according to ALIST
1359 of the parameter named PARAM (a Lisp symbol).
1360 If no value is specified for PARAM, look for an X default for XPROP
1361 on the frame named NAME.
1362 If that is not found either, use the value DEFLT. */
1365 x_default_parameter (f
, alist
, prop
, deflt
, xprop
, xclass
, type
)
1372 enum resource_types type
;
1376 tem
= x_get_arg (alist
, prop
, xprop
, xclass
, type
);
1377 if (EQ (tem
, Qunbound
))
1379 x_set_frame_parameters (f
, Fcons (Fcons (prop
, tem
), Qnil
));
1383 DEFUN ("x-parse-geometry", Fx_parse_geometry
, Sx_parse_geometry
, 1, 1, 0,
1384 "Parse an X-style geometry string STRING.\n\
1385 Returns an alist of the form ((top . TOP), (left . LEFT) ... ).")
1390 unsigned int width
, height
;
1391 Lisp_Object values
[4];
1393 CHECK_STRING (string
, 0);
1395 geometry
= XParseGeometry ((char *) XSTRING (string
)->data
,
1396 &x
, &y
, &width
, &height
);
1398 switch (geometry
& 0xf) /* Mask out {X,Y}Negative */
1400 case (XValue
| YValue
):
1401 /* What's one pixel among friends?
1402 Perhaps fix this some day by returning symbol `extreme-top'... */
1403 if (x
== 0 && (geometry
& XNegative
))
1405 if (y
== 0 && (geometry
& YNegative
))
1407 values
[0] = Fcons (Qleft
, make_number (x
));
1408 values
[1] = Fcons (Qtop
, make_number (y
));
1409 return Flist (2, values
);
1412 case (WidthValue
| HeightValue
):
1413 values
[0] = Fcons (Qwidth
, make_number (width
));
1414 values
[1] = Fcons (Qheight
, make_number (height
));
1415 return Flist (2, values
);
1418 case (XValue
| YValue
| WidthValue
| HeightValue
):
1419 if (x
== 0 && (geometry
& XNegative
))
1421 if (y
== 0 && (geometry
& YNegative
))
1423 values
[0] = Fcons (Qwidth
, make_number (width
));
1424 values
[1] = Fcons (Qheight
, make_number (height
));
1425 values
[2] = Fcons (Qleft
, make_number (x
));
1426 values
[3] = Fcons (Qtop
, make_number (y
));
1427 return Flist (4, values
);
1434 error ("Must specify x and y value, and/or width and height");
1439 /* Calculate the desired size and position of this window,
1440 or set rubber-band prompting if none. */
1442 #define DEFAULT_ROWS 40
1443 #define DEFAULT_COLS 80
1446 x_figure_window_size (f
, parms
)
1450 register Lisp_Object tem0
, tem1
;
1451 int height
, width
, left
, top
;
1452 register int geometry
;
1453 long window_prompting
= 0;
1455 /* Default values if we fall through.
1456 Actually, if that happens we should get
1457 window manager prompting. */
1458 f
->width
= DEFAULT_COLS
;
1459 f
->height
= DEFAULT_ROWS
;
1460 /* Window managers expect that if program-specified
1461 positions are not (0,0), they're intentional, not defaults. */
1462 f
->display
.x
->top_pos
= 0;
1463 f
->display
.x
->left_pos
= 0;
1465 tem0
= x_get_arg (parms
, Qheight
, 0, 0, number
);
1466 tem1
= x_get_arg (parms
, Qwidth
, 0, 0, number
);
1467 if (! EQ (tem0
, Qunbound
) && ! EQ (tem1
, Qunbound
))
1469 CHECK_NUMBER (tem0
, 0);
1470 CHECK_NUMBER (tem1
, 0);
1471 f
->height
= XINT (tem0
);
1472 f
->width
= XINT (tem1
);
1473 window_prompting
|= USSize
;
1475 else if (! EQ (tem0
, Qunbound
) || ! EQ (tem1
, Qunbound
))
1476 error ("Must specify *both* height and width");
1478 f
->display
.x
->vertical_scroll_bar_extra
1479 = (FRAME_HAS_VERTICAL_SCROLL_BARS (f
)
1480 ? VERTICAL_SCROLL_BAR_PIXEL_WIDTH (f
)
1482 f
->display
.x
->pixel_width
= CHAR_TO_PIXEL_WIDTH (f
, f
->width
);
1483 f
->display
.x
->pixel_height
= CHAR_TO_PIXEL_HEIGHT (f
, f
->height
);
1485 tem0
= x_get_arg (parms
, Qtop
, 0, 0, number
);
1486 tem1
= x_get_arg (parms
, Qleft
, 0, 0, number
);
1487 if (! EQ (tem0
, Qunbound
) && ! EQ (tem1
, Qunbound
))
1489 CHECK_NUMBER (tem0
, 0);
1490 CHECK_NUMBER (tem1
, 0);
1491 f
->display
.x
->top_pos
= XINT (tem0
);
1492 f
->display
.x
->left_pos
= XINT (tem1
);
1493 x_calc_absolute_position (f
);
1494 window_prompting
|= USPosition
;
1496 else if (! EQ (tem0
, Qunbound
) || ! EQ (tem1
, Qunbound
))
1497 error ("Must specify *both* top and left corners");
1499 #if 0 /* PPosition and PSize mean "specified explicitly,
1500 by the program rather than by the user". So it is wrong to
1501 set them if nothing was specified. */
1502 switch (window_prompting
)
1504 case USSize
| USPosition
:
1505 return window_prompting
;
1508 case USSize
: /* Got the size, need the position. */
1509 window_prompting
|= PPosition
;
1510 return window_prompting
;
1513 case USPosition
: /* Got the position, need the size. */
1514 window_prompting
|= PSize
;
1515 return window_prompting
;
1518 case 0: /* Got nothing, take both from geometry. */
1519 window_prompting
|= PPosition
| PSize
;
1520 return window_prompting
;
1524 /* Somehow a bit got set in window_prompting that we didn't
1529 return window_prompting
;
1532 #if !defined (HAVE_X11R4) && !defined (HAVE_XSETWMPROTOCOLS)
1535 XSetWMProtocols (dpy
, w
, protocols
, count
)
1542 prop
= XInternAtom (dpy
, "WM_PROTOCOLS", False
);
1543 if (prop
== None
) return False
;
1544 XChangeProperty (dpy
, w
, prop
, XA_ATOM
, 32, PropModeReplace
,
1545 (unsigned char *) protocols
, count
);
1548 #endif /* !HAVE_X11R4 && !HAVE_XSETWMPROTOCOLS */
1554 XSetWindowAttributes attributes
;
1555 unsigned long attribute_mask
;
1556 XClassHint class_hints
;
1558 attributes
.background_pixel
= f
->display
.x
->background_pixel
;
1559 attributes
.border_pixel
= f
->display
.x
->border_pixel
;
1560 attributes
.bit_gravity
= StaticGravity
;
1561 attributes
.backing_store
= NotUseful
;
1562 attributes
.save_under
= True
;
1563 attributes
.event_mask
= STANDARD_EVENT_SET
;
1564 attribute_mask
= (CWBackPixel
| CWBorderPixel
| CWBitGravity
1566 | CWBackingStore
| CWSaveUnder
1572 = XCreateWindow (x_current_display
, ROOT_WINDOW
,
1573 f
->display
.x
->left_pos
,
1574 f
->display
.x
->top_pos
,
1575 PIXEL_WIDTH (f
), PIXEL_HEIGHT (f
),
1576 f
->display
.x
->border_width
,
1577 CopyFromParent
, /* depth */
1578 InputOutput
, /* class */
1579 screen_visual
, /* set in Fx_open_connection */
1580 attribute_mask
, &attributes
);
1582 validate_x_resource_name ();
1583 class_hints
.res_name
= (char *) XSTRING (Vx_resource_name
)->data
;
1584 class_hints
.res_class
= EMACS_CLASS
;
1585 XSetClassHint (x_current_display
, FRAME_X_WINDOW (f
), &class_hints
);
1587 /* This indicates that we use the "Passive Input" input model.
1588 Unless we do this, we don't get the Focus{In,Out} events that we
1589 need to draw the cursor correctly. Accursed bureaucrats.
1590 XWhipsAndChains (x_current_display, IronMaiden, &TheRack); */
1592 f
->display
.x
->wm_hints
.input
= True
;
1593 f
->display
.x
->wm_hints
.flags
|= InputHint
;
1594 XSetWMHints (x_current_display
, FRAME_X_WINDOW (f
), &f
->display
.x
->wm_hints
);
1595 XSetWMProtocols (x_current_display
, FRAME_X_WINDOW (f
),
1596 &Xatom_wm_delete_window
, 1);
1598 /* x_set_name normally ignores requests to set the name if the
1599 requested name is the same as the current name. This is the one
1600 place where that assumption isn't correct; f->name is set, but
1601 the X server hasn't been told. */
1603 Lisp_Object name
= f
->name
;
1604 int explicit = f
->explicit_name
;
1607 f
->explicit_name
= 0;
1608 x_set_name (f
, name
, explicit);
1611 XDefineCursor (XDISPLAY
FRAME_X_WINDOW (f
),
1612 f
->display
.x
->text_cursor
);
1615 if (FRAME_X_WINDOW (f
) == 0)
1616 error ("Unable to create window.");
1619 /* Handle the icon stuff for this window. Perhaps later we might
1620 want an x_set_icon_position which can be called interactively as
1628 Lisp_Object icon_x
, icon_y
;
1630 /* Set the position of the icon. Note that twm groups all
1631 icons in an icon window. */
1632 icon_x
= x_get_arg (parms
, Qicon_left
, 0, 0, number
);
1633 icon_y
= x_get_arg (parms
, Qicon_top
, 0, 0, number
);
1634 if (!EQ (icon_x
, Qunbound
) && !EQ (icon_y
, Qunbound
))
1636 CHECK_NUMBER (icon_x
, 0);
1637 CHECK_NUMBER (icon_y
, 0);
1639 else if (!EQ (icon_x
, Qunbound
) || !EQ (icon_y
, Qunbound
))
1640 error ("Both left and top icon corners of icon must be specified");
1644 if (! EQ (icon_x
, Qunbound
))
1645 x_wm_set_icon_position (f
, XINT (icon_x
), XINT (icon_y
));
1647 /* Start up iconic or window? */
1648 x_wm_set_window_state
1649 (f
, (EQ (x_get_arg (parms
, Qvisibility
, 0, 0, symbol
), Qicon
)
1656 /* Make the GC's needed for this window, setting the
1657 background, border and mouse colors; also create the
1658 mouse cursor and the gray border tile. */
1660 static char cursor_bits
[] =
1662 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
1663 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
1664 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
1665 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00
1672 XGCValues gc_values
;
1678 /* Create the GC's of this frame.
1679 Note that many default values are used. */
1682 gc_values
.font
= f
->display
.x
->font
->fid
;
1683 gc_values
.foreground
= f
->display
.x
->foreground_pixel
;
1684 gc_values
.background
= f
->display
.x
->background_pixel
;
1685 gc_values
.line_width
= 0; /* Means 1 using fast algorithm. */
1686 f
->display
.x
->normal_gc
= XCreateGC (x_current_display
,
1688 GCLineWidth
| GCFont
1689 | GCForeground
| GCBackground
,
1692 /* Reverse video style. */
1693 gc_values
.foreground
= f
->display
.x
->background_pixel
;
1694 gc_values
.background
= f
->display
.x
->foreground_pixel
;
1695 f
->display
.x
->reverse_gc
= XCreateGC (x_current_display
,
1697 GCFont
| GCForeground
| GCBackground
1701 /* Cursor has cursor-color background, background-color foreground. */
1702 gc_values
.foreground
= f
->display
.x
->background_pixel
;
1703 gc_values
.background
= f
->display
.x
->cursor_pixel
;
1704 gc_values
.fill_style
= FillOpaqueStippled
;
1706 = XCreateBitmapFromData (x_current_display
, ROOT_WINDOW
,
1707 cursor_bits
, 16, 16);
1708 f
->display
.x
->cursor_gc
1709 = XCreateGC (x_current_display
, FRAME_X_WINDOW (f
),
1710 (GCFont
| GCForeground
| GCBackground
1711 | GCFillStyle
| GCStipple
| GCLineWidth
),
1714 /* Create the gray border tile used when the pointer is not in
1715 the frame. Since this depends on the frame's pixel values,
1716 this must be done on a per-frame basis. */
1717 f
->display
.x
->border_tile
1718 = (XCreatePixmapFromBitmapData
1719 (x_current_display
, ROOT_WINDOW
,
1720 gray_bits
, gray_width
, gray_height
,
1721 f
->display
.x
->foreground_pixel
,
1722 f
->display
.x
->background_pixel
,
1723 DefaultDepth (x_current_display
, XDefaultScreen (x_current_display
))));
1727 #endif /* HAVE_X11 */
1729 DEFUN ("x-create-frame", Fx_create_frame
, Sx_create_frame
,
1731 "Make a new X window, which is called a \"frame\" in Emacs terms.\n\
1732 Return an Emacs frame object representing the X window.\n\
1733 ALIST is an alist of frame parameters.\n\
1734 If the parameters specify that the frame should not have a minibuffer,\n\
1735 and do not specify a specific minibuffer window to use,\n\
1736 then `default-minibuffer-frame' must be a frame whose minibuffer can\n\
1737 be shared by the new frame.")
1743 Lisp_Object frame
, tem
, tem0
, tem1
;
1745 int minibuffer_only
= 0;
1746 long window_prompting
= 0;
1751 name
= x_get_arg (parms
, Qname
, "title", "Title", string
);
1752 if (XTYPE (name
) != Lisp_String
1753 && ! EQ (name
, Qunbound
)
1755 error ("x-create-frame: name parameter must be a string");
1757 tem
= x_get_arg (parms
, Qminibuffer
, 0, 0, symbol
);
1758 if (EQ (tem
, Qnone
) || NILP (tem
))
1759 f
= make_frame_without_minibuffer (Qnil
);
1760 else if (EQ (tem
, Qonly
))
1762 f
= make_minibuffer_frame ();
1763 minibuffer_only
= 1;
1765 else if (XTYPE (tem
) == Lisp_Window
)
1766 f
= make_frame_without_minibuffer (tem
);
1770 /* Note that X Windows does support scroll bars. */
1771 FRAME_CAN_HAVE_SCROLL_BARS (f
) = 1;
1773 /* Set the name; the functions to which we pass f expect the name to
1775 if (EQ (name
, Qunbound
) || NILP (name
))
1777 f
->name
= build_string (x_id_name
);
1778 f
->explicit_name
= 0;
1783 f
->explicit_name
= 1;
1786 XSET (frame
, Lisp_Frame
, f
);
1787 f
->output_method
= output_x_window
;
1788 f
->display
.x
= (struct x_display
*) xmalloc (sizeof (struct x_display
));
1789 bzero (f
->display
.x
, sizeof (struct x_display
));
1791 /* Note that the frame has no physical cursor right now. */
1792 f
->phys_cursor_x
= -1;
1794 /* Extract the window parameters from the supplied values
1795 that are needed to determine window geometry. */
1799 font
= x_get_arg (parms
, Qfont
, "font", "Font", string
);
1801 /* First, try whatever font the caller has specified. */
1803 font
= x_new_font (f
, XSTRING (font
)->data
);
1804 /* Try out a font which we hope has bold and italic variations. */
1805 if (!STRINGP (font
))
1806 font
= x_new_font (f
, "-misc-fixed-medium-r-normal-*-*-120-*-*-c-*-iso8859-1");
1807 if (! STRINGP (font
))
1808 font
= x_new_font (f
, "-*-*-medium-r-normal-*-*-120-*-*-c-*-iso8859-1");
1809 if (! STRINGP (font
))
1810 /* This was formerly the first thing tried, but it finds too many fonts
1811 and takes too long. */
1812 font
= x_new_font (f
, "-*-*-medium-r-*-*-*-*-*-*-c-*-iso8859-1");
1813 /* If those didn't work, look for something which will at least work. */
1814 if (! STRINGP (font
))
1815 font
= x_new_font (f
, "-*-fixed-*-*-*-*-*-120-*-*-c-*-iso8859-1");
1817 if (! STRINGP (font
))
1818 font
= build_string ("fixed");
1820 x_default_parameter (f
, parms
, Qfont
, font
,
1821 "font", "Font", string
);
1823 x_default_parameter (f
, parms
, Qborder_width
, make_number (2),
1824 "borderwidth", "BorderWidth", number
);
1825 /* This defaults to 2 in order to match xterm. We recognize either
1826 internalBorderWidth or internalBorder (which is what xterm calls
1828 if (NILP (Fassq (Qinternal_border_width
, parms
)))
1832 value
= x_get_arg (parms
, Qinternal_border_width
,
1833 "internalBorder", "BorderWidth", number
);
1834 if (! EQ (value
, Qunbound
))
1835 parms
= Fcons (Fcons (Qinternal_border_width
, value
),
1838 x_default_parameter (f
, parms
, Qinternal_border_width
, make_number (2),
1839 "internalBorderWidth", "BorderWidth", number
);
1840 x_default_parameter (f
, parms
, Qvertical_scroll_bars
, Qt
,
1841 "verticalScrollBars", "ScrollBars", boolean
);
1843 /* Also do the stuff which must be set before the window exists. */
1844 x_default_parameter (f
, parms
, Qforeground_color
, build_string ("black"),
1845 "foreground", "Foreground", string
);
1846 x_default_parameter (f
, parms
, Qbackground_color
, build_string ("white"),
1847 "background", "Background", string
);
1848 x_default_parameter (f
, parms
, Qmouse_color
, build_string ("black"),
1849 "pointerColor", "Foreground", string
);
1850 x_default_parameter (f
, parms
, Qcursor_color
, build_string ("black"),
1851 "cursorColor", "Foreground", string
);
1852 x_default_parameter (f
, parms
, Qborder_color
, build_string ("black"),
1853 "borderColor", "BorderColor", string
);
1855 f
->display
.x
->parent_desc
= ROOT_WINDOW
;
1856 window_prompting
= x_figure_window_size (f
, parms
);
1861 init_frame_faces (f
);
1863 /* We need to do this after creating the X window, so that the
1864 icon-creation functions can say whose icon they're describing. */
1865 x_default_parameter (f
, parms
, Qicon_type
, Qnil
,
1866 "bitmapIcon", "BitmapIcon", symbol
);
1868 x_default_parameter (f
, parms
, Qauto_raise
, Qnil
,
1869 "autoRaise", "AutoRaiseLower", boolean
);
1870 x_default_parameter (f
, parms
, Qauto_lower
, Qnil
,
1871 "autoLower", "AutoRaiseLower", boolean
);
1872 x_default_parameter (f
, parms
, Qcursor_type
, Qbox
,
1873 "cursorType", "CursorType", symbol
);
1875 /* Dimensions, especially f->height, must be done via change_frame_size.
1876 Change will not be effected unless different from the current
1880 f
->height
= f
->width
= 0;
1881 change_frame_size (f
, height
, width
, 1, 0);
1883 x_default_parameter (f
, parms
, Qmenu_bar_lines
, make_number (0),
1884 "menuBarLines", "MenuBarLines", number
);
1886 tem0
= x_get_arg (parms
, Qleft
, 0, 0, number
);
1887 tem1
= x_get_arg (parms
, Qtop
, 0, 0, number
);
1889 x_wm_set_size_hint (f
, window_prompting
, XINT (tem0
), XINT (tem1
));
1892 tem
= x_get_arg (parms
, Qunsplittable
, 0, 0, boolean
);
1893 f
->no_split
= minibuffer_only
|| EQ (tem
, Qt
);
1895 /* Make the window appear on the frame and enable display,
1896 unless the caller says not to. */
1898 Lisp_Object visibility
= x_get_arg (parms
, Qvisibility
, 0, 0, symbol
);
1900 if (EQ (visibility
, Qunbound
))
1903 if (EQ (visibility
, Qicon
))
1904 x_iconify_frame (f
);
1905 else if (! NILP (visibility
))
1906 x_make_frame_visible (f
);
1908 /* Must have been Qnil. */
1912 Vframe_list
= Fcons (frame
, Vframe_list
);
1916 Lisp_Object frame
, tem
;
1918 int pixelwidth
, pixelheight
;
1923 int minibuffer_only
= 0;
1924 Lisp_Object vscroll
, hscroll
;
1926 if (x_current_display
== 0)
1927 error ("X windows are not in use or not initialized");
1929 name
= Fassq (Qname
, parms
);
1931 tem
= x_get_arg (parms
, Qminibuffer
, 0, 0, symbol
);
1932 if (EQ (tem
, Qnone
))
1933 f
= make_frame_without_minibuffer (Qnil
);
1934 else if (EQ (tem
, Qonly
))
1936 f
= make_minibuffer_frame ();
1937 minibuffer_only
= 1;
1939 else if (EQ (tem
, Qnil
) || EQ (tem
, Qunbound
))
1942 f
= make_frame_without_minibuffer (tem
);
1944 parent
= ROOT_WINDOW
;
1946 XSET (frame
, Lisp_Frame
, f
);
1947 f
->output_method
= output_x_window
;
1948 f
->display
.x
= (struct x_display
*) xmalloc (sizeof (struct x_display
));
1949 bzero (f
->display
.x
, sizeof (struct x_display
));
1951 /* Some temporary default values for height and width. */
1954 f
->display
.x
->left_pos
= -1;
1955 f
->display
.x
->top_pos
= -1;
1957 /* Give the frame a default name (which may be overridden with PARMS). */
1959 strncpy (iconidentity
, ICONTAG
, MAXICID
);
1960 if (gethostname (&iconidentity
[sizeof (ICONTAG
) - 1],
1961 (MAXICID
- 1) - sizeof (ICONTAG
)))
1962 iconidentity
[sizeof (ICONTAG
) - 2] = '\0';
1963 f
->name
= build_string (iconidentity
);
1965 /* Extract some window parameters from the supplied values.
1966 These are the parameters that affect window geometry. */
1968 tem
= x_get_arg (parms
, Qfont
, "BodyFont", 0, string
);
1969 if (EQ (tem
, Qunbound
))
1970 tem
= build_string ("9x15");
1971 x_set_font (f
, tem
, Qnil
);
1972 x_default_parameter (f
, parms
, Qborder_color
,
1973 build_string ("black"), "Border", 0, string
);
1974 x_default_parameter (f
, parms
, Qbackground_color
,
1975 build_string ("white"), "Background", 0, string
);
1976 x_default_parameter (f
, parms
, Qforeground_color
,
1977 build_string ("black"), "Foreground", 0, string
);
1978 x_default_parameter (f
, parms
, Qmouse_color
,
1979 build_string ("black"), "Mouse", 0, string
);
1980 x_default_parameter (f
, parms
, Qcursor_color
,
1981 build_string ("black"), "Cursor", 0, string
);
1982 x_default_parameter (f
, parms
, Qborder_width
,
1983 make_number (2), "BorderWidth", 0, number
);
1984 x_default_parameter (f
, parms
, Qinternal_border_width
,
1985 make_number (4), "InternalBorderWidth", 0, number
);
1986 x_default_parameter (f
, parms
, Qauto_raise
,
1987 Qnil
, "AutoRaise", 0, boolean
);
1989 hscroll
= EQ (x_get_arg (parms
, Qhorizontal_scroll_bar
, 0, 0, boolean
), Qt
);
1990 vscroll
= EQ (x_get_arg (parms
, Qvertical_scroll_bar
, 0, 0, boolean
), Qt
);
1992 if (f
->display
.x
->internal_border_width
< 0)
1993 f
->display
.x
->internal_border_width
= 0;
1995 tem
= x_get_arg (parms
, Qwindow_id
, 0, 0, number
);
1996 if (!EQ (tem
, Qunbound
))
1998 WINDOWINFO_TYPE wininfo
;
2000 Window
*children
, root
;
2002 CHECK_NUMBER (tem
, 0);
2003 FRAME_X_WINDOW (f
) = (Window
) XINT (tem
);
2006 XGetWindowInfo (FRAME_X_WINDOW (f
), &wininfo
);
2007 XQueryTree (FRAME_X_WINDOW (f
), &parent
, &nchildren
, &children
);
2011 height
= PIXEL_TO_CHAR_HEIGHT (f
, wininfo
.height
);
2012 width
= PIXEL_TO_CHAR_WIDTH (f
, wininfo
.width
);
2013 f
->display
.x
->left_pos
= wininfo
.x
;
2014 f
->display
.x
->top_pos
= wininfo
.y
;
2015 FRAME_SET_VISIBILITY (f
, wininfo
.mapped
!= 0);
2016 f
->display
.x
->border_width
= wininfo
.bdrwidth
;
2017 f
->display
.x
->parent_desc
= parent
;
2021 tem
= x_get_arg (parms
, Qparent_id
, 0, 0, number
);
2022 if (!EQ (tem
, Qunbound
))
2024 CHECK_NUMBER (tem
, 0);
2025 parent
= (Window
) XINT (tem
);
2027 f
->display
.x
->parent_desc
= parent
;
2028 tem
= x_get_arg (parms
, Qheight
, 0, 0, number
);
2029 if (EQ (tem
, Qunbound
))
2031 tem
= x_get_arg (parms
, Qwidth
, 0, 0, number
);
2032 if (EQ (tem
, Qunbound
))
2034 tem
= x_get_arg (parms
, Qtop
, 0, 0, number
);
2035 if (EQ (tem
, Qunbound
))
2036 tem
= x_get_arg (parms
, Qleft
, 0, 0, number
);
2039 /* Now TEM is Qunbound if no edge or size was specified.
2040 In that case, we must do rubber-banding. */
2041 if (EQ (tem
, Qunbound
))
2043 tem
= x_get_arg (parms
, Qgeometry
, 0, 0, number
);
2045 &f
->display
.x
->left_pos
, &f
->display
.x
->top_pos
,
2047 (XTYPE (tem
) == Lisp_String
2048 ? (char *) XSTRING (tem
)->data
: ""),
2049 XSTRING (f
->name
)->data
,
2050 !NILP (hscroll
), !NILP (vscroll
));
2054 /* Here if at least one edge or size was specified.
2055 Demand that they all were specified, and use them. */
2056 tem
= x_get_arg (parms
, Qheight
, 0, 0, number
);
2057 if (EQ (tem
, Qunbound
))
2058 error ("Height not specified");
2059 CHECK_NUMBER (tem
, 0);
2060 height
= XINT (tem
);
2062 tem
= x_get_arg (parms
, Qwidth
, 0, 0, number
);
2063 if (EQ (tem
, Qunbound
))
2064 error ("Width not specified");
2065 CHECK_NUMBER (tem
, 0);
2068 tem
= x_get_arg (parms
, Qtop
, 0, 0, number
);
2069 if (EQ (tem
, Qunbound
))
2070 error ("Top position not specified");
2071 CHECK_NUMBER (tem
, 0);
2072 f
->display
.x
->left_pos
= XINT (tem
);
2074 tem
= x_get_arg (parms
, Qleft
, 0, 0, number
);
2075 if (EQ (tem
, Qunbound
))
2076 error ("Left position not specified");
2077 CHECK_NUMBER (tem
, 0);
2078 f
->display
.x
->top_pos
= XINT (tem
);
2081 pixelwidth
= CHAR_TO_PIXEL_WIDTH (f
, width
);
2082 pixelheight
= CHAR_TO_PIXEL_HEIGHT (f
, height
);
2086 = XCreateWindow (parent
,
2087 f
->display
.x
->left_pos
, /* Absolute horizontal offset */
2088 f
->display
.x
->top_pos
, /* Absolute Vertical offset */
2089 pixelwidth
, pixelheight
,
2090 f
->display
.x
->border_width
,
2091 BLACK_PIX_DEFAULT
, WHITE_PIX_DEFAULT
);
2093 if (FRAME_X_WINDOW (f
) == 0)
2094 error ("Unable to create window.");
2097 /* Install the now determined height and width
2098 in the windows and in phys_lines and desired_lines. */
2099 change_frame_size (f
, height
, width
, 1, 0);
2100 XSelectInput (FRAME_X_WINDOW (f
), KeyPressed
| ExposeWindow
2101 | ButtonPressed
| ButtonReleased
| ExposeRegion
| ExposeCopy
2102 | EnterWindow
| LeaveWindow
| UnmapWindow
);
2103 x_set_resize_hint (f
);
2105 /* Tell the server the window's default name. */
2106 XStoreName (XDISPLAY
FRAME_X_WINDOW (f
), XSTRING (f
->name
)->data
);
2108 /* Now override the defaults with all the rest of the specified
2110 tem
= x_get_arg (parms
, Qunsplittable
, 0, 0, boolean
);
2111 f
->no_split
= minibuffer_only
|| EQ (tem
, Qt
);
2113 /* Do not create an icon window if the caller says not to */
2114 if (!EQ (x_get_arg (parms
, Qsuppress_icon
, 0, 0, boolean
), Qt
)
2115 || f
->display
.x
->parent_desc
!= ROOT_WINDOW
)
2117 x_text_icon (f
, iconidentity
);
2118 x_default_parameter (f
, parms
, Qicon_type
, Qnil
,
2119 "BitmapIcon", 0, symbol
);
2122 /* Tell the X server the previously set values of the
2123 background, border and mouse colors; also create the mouse cursor. */
2125 temp
= XMakeTile (f
->display
.x
->background_pixel
);
2126 XChangeBackground (FRAME_X_WINDOW (f
), temp
);
2129 x_set_border_pixel (f
, f
->display
.x
->border_pixel
);
2131 x_set_mouse_color (f
, Qnil
, Qnil
);
2133 /* Now override the defaults with all the rest of the specified parms. */
2135 Fmodify_frame_parameters (frame
, parms
);
2137 /* Make the window appear on the frame and enable display. */
2139 Lisp_Object visibility
= x_get_arg (parms
, Qvisibility
, 0, 0, symbol
);
2141 if (EQ (visibility
, Qunbound
))
2144 if (! EQ (visibility
, Qicon
)
2145 && ! NILP (visibility
))
2146 x_make_window_visible (f
);
2149 SET_FRAME_GARBAGED (f
);
2151 Vframe_list
= Fcons (frame
, Vframe_list
);
2156 DEFUN ("focus-frame", Ffocus_frame
, Sfocus_frame
, 1, 1, 0,
2157 "Set the focus on FRAME.")
2161 CHECK_LIVE_FRAME (frame
, 0);
2163 if (FRAME_X_P (XFRAME (frame
)))
2166 x_focus_on_frame (XFRAME (frame
));
2174 DEFUN ("unfocus-frame", Funfocus_frame
, Sunfocus_frame
, 0, 0, 0,
2175 "If a frame has been focused, release it.")
2181 x_unfocus_frame (x_focus_frame
);
2189 /* Computes an X-window size and position either from geometry GEO
2192 F is a frame. It specifies an X window which is used to
2193 determine which display to compute for. Its font, borders
2194 and colors control how the rectangle will be displayed.
2196 X and Y are where to store the positions chosen.
2197 WIDTH and HEIGHT are where to store the sizes chosen.
2199 GEO is the geometry that may specify some of the info.
2200 STR is a prompt to display.
2201 HSCROLL and VSCROLL say whether we have horiz and vert scroll bars. */
2204 x_rubber_band (f
, x
, y
, width
, height
, geo
, str
, hscroll
, vscroll
)
2206 int *x
, *y
, *width
, *height
;
2209 int hscroll
, vscroll
;
2215 int background_color
;
2221 background_color
= f
->display
.x
->background_pixel
;
2222 border_color
= f
->display
.x
->border_pixel
;
2224 frame
.bdrwidth
= f
->display
.x
->border_width
;
2225 frame
.border
= XMakeTile (border_color
);
2226 frame
.background
= XMakeTile (background_color
);
2227 tempwindow
= XCreateTerm (str
, "emacs", geo
, default_window
, &frame
, 10, 5,
2228 (2 * f
->display
.x
->internal_border_width
2229 + (vscroll
? VSCROLL_WIDTH
: 0)),
2230 (2 * f
->display
.x
->internal_border_width
2231 + (hscroll
? HSCROLL_HEIGHT
: 0)),
2232 width
, height
, f
->display
.x
->font
,
2233 FONT_WIDTH (f
->display
.x
->font
),
2234 FONT_HEIGHT (f
->display
.x
->font
));
2235 XFreePixmap (frame
.border
);
2236 XFreePixmap (frame
.background
);
2238 if (tempwindow
!= 0)
2240 XQueryWindow (tempwindow
, &wininfo
);
2241 XDestroyWindow (tempwindow
);
2246 /* Coordinates we got are relative to the root window.
2247 Convert them to coordinates relative to desired parent window
2248 by scanning from there up to the root. */
2249 tempwindow
= f
->display
.x
->parent_desc
;
2250 while (tempwindow
!= ROOT_WINDOW
)
2254 XQueryWindow (tempwindow
, &wininfo
);
2257 XQueryTree (tempwindow
, &tempwindow
, &nchildren
, &children
);
2262 return tempwindow
!= 0;
2264 #endif /* not HAVE_X11 */
2266 DEFUN ("x-list-fonts", Fx_list_fonts
, Sx_list_fonts
, 1, 3, 0,
2267 "Return a list of the names of available fonts matching PATTERN.\n\
2268 If optional arguments FACE and FRAME are specified, return only fonts\n\
2269 the same size as FACE on FRAME.\n\
2271 PATTERN is a string, perhaps with wildcard characters;\n\
2272 the * character matches any substring, and\n\
2273 the ? character matches any single character.\n\
2274 PATTERN is case-insensitive.\n\
2275 FACE is a face name - a symbol.\n\
2277 The return value is a list of strings, suitable as arguments to\n\
2280 The list does not include fonts Emacs can't use (i.e. proportional\n\
2281 fonts), even if they match PATTERN and FACE.")
2282 (pattern
, face
, frame
)
2283 Lisp_Object pattern
, face
, frame
;
2288 XFontStruct
*size_ref
;
2291 CHECK_STRING (pattern
, 0);
2293 CHECK_SYMBOL (face
, 1);
2295 CHECK_LIVE_FRAME (frame
, 2);
2301 FRAME_PTR f
= NILP (frame
) ? selected_frame
: XFRAME (frame
);
2302 int face_id
= face_name_id_number (f
, face
);
2304 if (face_id
< 0 || face_id
>= FRAME_N_PARAM_FACES (f
)
2305 || FRAME_PARAM_FACES (f
) [face_id
] == 0)
2306 size_ref
= f
->display
.x
->font
;
2309 size_ref
= FRAME_PARAM_FACES (f
) [face_id
]->font
;
2310 if (size_ref
== (XFontStruct
*) (~0))
2311 size_ref
= f
->display
.x
->font
;
2317 /* Solaris 2.3 has a bug in XListFontsWithInfo. */
2318 #ifdef BROKEN_XLISTFONTSWITHINFO
2319 names
= XListFonts (x_current_display
,
2320 XSTRING (pattern
)->data
,
2321 2000, /* maxnames */
2322 &num_fonts
); /* count_return */
2324 names
= XListFontsWithInfo (x_current_display
,
2325 XSTRING (pattern
)->data
,
2326 2000, /* maxnames */
2327 &num_fonts
, /* count_return */
2328 &info
); /* info_return */
2339 for (i
= 0; i
< num_fonts
; i
++)
2341 #ifdef BROKEN_XLISTFONTSWITHINFO
2343 info
= XLoadQueryFont (x_current_display
, names
[i
]);
2348 if (info
&& (! size_ref
2349 || same_size_fonts (info
, size_ref
)))
2351 *tail
= Fcons (build_string (names
[i
]), Qnil
);
2352 tail
= &XCONS (*tail
)->cdr
;
2357 #ifdef BROKEN_XLISTFONTSWITHINFO
2358 XFreeFontNames (names
);
2360 XFreeFontInfo (names
, info
, num_fonts
);
2369 DEFUN ("x-color-defined-p", Fx_color_defined_p
, Sx_color_defined_p
, 1, 1, 0,
2370 "Return t if the current X display supports the color named COLOR.")
2377 CHECK_STRING (color
, 0);
2379 if (defined_color (XSTRING (color
)->data
, &foo
))
2385 DEFUN ("x-display-color-p", Fx_display_color_p
, Sx_display_color_p
, 0, 0, 0,
2386 "Return t if the X screen currently in use supports color.")
2391 if (x_screen_planes
<= 2)
2394 switch (screen_visual
->class)
2407 DEFUN ("x-display-pixel-width", Fx_display_pixel_width
, Sx_display_pixel_width
,
2409 "Returns the width in pixels of the display FRAME is on.")
2413 Display
*dpy
= x_current_display
;
2415 return make_number (DisplayWidth (dpy
, DefaultScreen (dpy
)));
2418 DEFUN ("x-display-pixel-height", Fx_display_pixel_height
,
2419 Sx_display_pixel_height
, 0, 1, 0,
2420 "Returns the height in pixels of the display FRAME is on.")
2424 Display
*dpy
= x_current_display
;
2426 return make_number (DisplayHeight (dpy
, DefaultScreen (dpy
)));
2429 DEFUN ("x-display-planes", Fx_display_planes
, Sx_display_planes
,
2431 "Returns the number of bitplanes of the display FRAME is on.")
2435 Display
*dpy
= x_current_display
;
2437 return make_number (DisplayPlanes (dpy
, DefaultScreen (dpy
)));
2440 DEFUN ("x-display-color-cells", Fx_display_color_cells
, Sx_display_color_cells
,
2442 "Returns the number of color cells of the display FRAME is on.")
2446 Display
*dpy
= x_current_display
;
2448 return make_number (DisplayCells (dpy
, DefaultScreen (dpy
)));
2451 DEFUN ("x-server-max-request-size", Fx_server_max_request_size
,
2452 Sx_server_max_request_size
,
2454 "Returns the maximum request size of the X server FRAME is using.")
2458 Display
*dpy
= x_current_display
;
2460 return make_number (MAXREQUEST (dpy
));
2463 DEFUN ("x-server-vendor", Fx_server_vendor
, Sx_server_vendor
, 0, 1, 0,
2464 "Returns the vendor ID string of the X server FRAME is on.")
2468 Display
*dpy
= x_current_display
;
2471 vendor
= ServerVendor (dpy
);
2472 if (! vendor
) vendor
= "";
2473 return build_string (vendor
);
2476 DEFUN ("x-server-version", Fx_server_version
, Sx_server_version
, 0, 1, 0,
2477 "Returns the version numbers of the X server in use.\n\
2478 The value is a list of three integers: the major and minor\n\
2479 version numbers of the X Protocol in use, and the vendor-specific release\n\
2480 number. See also the variable `x-server-vendor'.")
2484 Display
*dpy
= x_current_display
;
2487 return Fcons (make_number (ProtocolVersion (dpy
)),
2488 Fcons (make_number (ProtocolRevision (dpy
)),
2489 Fcons (make_number (VendorRelease (dpy
)), Qnil
)));
2492 DEFUN ("x-display-screens", Fx_display_screens
, Sx_display_screens
, 0, 1, 0,
2493 "Returns the number of screens on the X server FRAME is on.")
2498 return make_number (ScreenCount (x_current_display
));
2501 DEFUN ("x-display-mm-height", Fx_display_mm_height
, Sx_display_mm_height
, 0, 1, 0,
2502 "Returns the height in millimeters of the X screen FRAME is on.")
2507 return make_number (HeightMMOfScreen (x_screen
));
2510 DEFUN ("x-display-mm-width", Fx_display_mm_width
, Sx_display_mm_width
, 0, 1, 0,
2511 "Returns the width in millimeters of the X screen FRAME is on.")
2516 return make_number (WidthMMOfScreen (x_screen
));
2519 DEFUN ("x-display-backing-store", Fx_display_backing_store
,
2520 Sx_display_backing_store
, 0, 1, 0,
2521 "Returns an indication of whether the X screen FRAME is on does backing store.\n\
2522 The value may be `always', `when-mapped', or `not-useful'.")
2528 switch (DoesBackingStore (x_screen
))
2531 return intern ("always");
2534 return intern ("when-mapped");
2537 return intern ("not-useful");
2540 error ("Strange value for BackingStore parameter of screen");
2544 DEFUN ("x-display-visual-class", Fx_display_visual_class
,
2545 Sx_display_visual_class
, 0, 1, 0,
2546 "Returns the visual class of the display `screen' is on.\n\
2547 The value is one of the symbols `static-gray', `gray-scale',\n\
2548 `static-color', `pseudo-color', `true-color', or `direct-color'.")
2554 switch (screen_visual
->class)
2556 case StaticGray
: return (intern ("static-gray"));
2557 case GrayScale
: return (intern ("gray-scale"));
2558 case StaticColor
: return (intern ("static-color"));
2559 case PseudoColor
: return (intern ("pseudo-color"));
2560 case TrueColor
: return (intern ("true-color"));
2561 case DirectColor
: return (intern ("direct-color"));
2563 error ("Display has an unknown visual class");
2567 DEFUN ("x-display-save-under", Fx_display_save_under
,
2568 Sx_display_save_under
, 0, 1, 0,
2569 "Returns t if the X screen FRAME is on supports the save-under feature.")
2575 if (DoesSaveUnders (x_screen
) == True
)
2582 register struct frame
*f
;
2584 return PIXEL_WIDTH (f
);
2588 register struct frame
*f
;
2590 return PIXEL_HEIGHT (f
);
2594 register struct frame
*f
;
2596 return FONT_WIDTH (f
->display
.x
->font
);
2600 register struct frame
*f
;
2602 return FONT_HEIGHT (f
->display
.x
->font
);
2605 #if 0 /* These no longer seem like the right way to do things. */
2607 /* Draw a rectangle on the frame with left top corner including
2608 the character specified by LEFT_CHAR and TOP_CHAR. The rectangle is
2609 CHARS by LINES wide and long and is the color of the cursor. */
2612 x_rectangle (f
, gc
, left_char
, top_char
, chars
, lines
)
2613 register struct frame
*f
;
2615 register int top_char
, left_char
, chars
, lines
;
2619 int left
= (left_char
* FONT_WIDTH (f
->display
.x
->font
)
2620 + f
->display
.x
->internal_border_width
);
2621 int top
= (top_char
* FONT_HEIGHT (f
->display
.x
->font
)
2622 + f
->display
.x
->internal_border_width
);
2625 width
= FONT_WIDTH (f
->display
.x
->font
) / 2;
2627 width
= FONT_WIDTH (f
->display
.x
->font
) * chars
;
2629 height
= FONT_HEIGHT (f
->display
.x
->font
) / 2;
2631 height
= FONT_HEIGHT (f
->display
.x
->font
) * lines
;
2633 XDrawRectangle (x_current_display
, FRAME_X_WINDOW (f
),
2634 gc
, left
, top
, width
, height
);
2637 DEFUN ("x-draw-rectangle", Fx_draw_rectangle
, Sx_draw_rectangle
, 5, 5, 0,
2638 "Draw a rectangle on FRAME between coordinates specified by\n\
2639 numbers X0, Y0, X1, Y1 in the cursor pixel.")
2640 (frame
, X0
, Y0
, X1
, Y1
)
2641 register Lisp_Object frame
, X0
, X1
, Y0
, Y1
;
2643 register int x0
, y0
, x1
, y1
, top
, left
, n_chars
, n_lines
;
2645 CHECK_LIVE_FRAME (frame
, 0);
2646 CHECK_NUMBER (X0
, 0);
2647 CHECK_NUMBER (Y0
, 1);
2648 CHECK_NUMBER (X1
, 2);
2649 CHECK_NUMBER (Y1
, 3);
2659 n_lines
= y1
- y0
+ 1;
2664 n_lines
= y0
- y1
+ 1;
2670 n_chars
= x1
- x0
+ 1;
2675 n_chars
= x0
- x1
+ 1;
2679 x_rectangle (XFRAME (frame
), XFRAME (frame
)->display
.x
->cursor_gc
,
2680 left
, top
, n_chars
, n_lines
);
2686 DEFUN ("x-erase-rectangle", Fx_erase_rectangle
, Sx_erase_rectangle
, 5, 5, 0,
2687 "Draw a rectangle drawn on FRAME between coordinates\n\
2688 X0, Y0, X1, Y1 in the regular background-pixel.")
2689 (frame
, X0
, Y0
, X1
, Y1
)
2690 register Lisp_Object frame
, X0
, Y0
, X1
, Y1
;
2692 register int x0
, y0
, x1
, y1
, top
, left
, n_chars
, n_lines
;
2694 CHECK_FRAME (frame
, 0);
2695 CHECK_NUMBER (X0
, 0);
2696 CHECK_NUMBER (Y0
, 1);
2697 CHECK_NUMBER (X1
, 2);
2698 CHECK_NUMBER (Y1
, 3);
2708 n_lines
= y1
- y0
+ 1;
2713 n_lines
= y0
- y1
+ 1;
2719 n_chars
= x1
- x0
+ 1;
2724 n_chars
= x0
- x1
+ 1;
2728 x_rectangle (XFRAME (frame
), XFRAME (frame
)->display
.x
->reverse_gc
,
2729 left
, top
, n_chars
, n_lines
);
2735 /* Draw lines around the text region beginning at the character position
2736 TOP_X, TOP_Y and ending at BOTTOM_X and BOTTOM_Y. GC specifies the
2737 pixel and line characteristics. */
2739 #define line_len(line) (FRAME_CURRENT_GLYPHS (f)->used[(line)])
2742 outline_region (f
, gc
, top_x
, top_y
, bottom_x
, bottom_y
)
2743 register struct frame
*f
;
2745 int top_x
, top_y
, bottom_x
, bottom_y
;
2747 register int ibw
= f
->display
.x
->internal_border_width
;
2748 register int font_w
= FONT_WIDTH (f
->display
.x
->font
);
2749 register int font_h
= FONT_HEIGHT (f
->display
.x
->font
);
2751 int x
= line_len (y
);
2752 XPoint
*pixel_points
= (XPoint
*)
2753 alloca (((bottom_y
- top_y
+ 2) * 4) * sizeof (XPoint
));
2754 register XPoint
*this_point
= pixel_points
;
2756 /* Do the horizontal top line/lines */
2759 this_point
->x
= ibw
;
2760 this_point
->y
= ibw
+ (font_h
* top_y
);
2763 this_point
->x
= ibw
+ (font_w
/ 2); /* Half-size for newline chars. */
2765 this_point
->x
= ibw
+ (font_w
* x
);
2766 this_point
->y
= (this_point
- 1)->y
;
2770 this_point
->x
= ibw
;
2771 this_point
->y
= ibw
+ (font_h
* (top_y
+ 1));
2773 this_point
->x
= ibw
+ (font_w
* top_x
);
2774 this_point
->y
= (this_point
- 1)->y
;
2776 this_point
->x
= (this_point
- 1)->x
;
2777 this_point
->y
= ibw
+ (font_h
* top_y
);
2779 this_point
->x
= ibw
+ (font_w
* x
);
2780 this_point
->y
= (this_point
- 1)->y
;
2783 /* Now do the right side. */
2784 while (y
< bottom_y
)
2785 { /* Right vertical edge */
2787 this_point
->x
= (this_point
- 1)->x
;
2788 this_point
->y
= ibw
+ (font_h
* (y
+ 1));
2791 y
++; /* Horizontal connection to next line */
2794 this_point
->x
= ibw
+ (font_w
/ 2);
2796 this_point
->x
= ibw
+ (font_w
* x
);
2798 this_point
->y
= (this_point
- 1)->y
;
2801 /* Now do the bottom and connect to the top left point. */
2802 this_point
->x
= ibw
+ (font_w
* (bottom_x
+ 1));
2805 this_point
->x
= (this_point
- 1)->x
;
2806 this_point
->y
= ibw
+ (font_h
* (bottom_y
+ 1));
2808 this_point
->x
= ibw
;
2809 this_point
->y
= (this_point
- 1)->y
;
2811 this_point
->x
= pixel_points
->x
;
2812 this_point
->y
= pixel_points
->y
;
2814 XDrawLines (x_current_display
, FRAME_X_WINDOW (f
),
2816 (this_point
- pixel_points
+ 1), CoordModeOrigin
);
2819 DEFUN ("x-contour-region", Fx_contour_region
, Sx_contour_region
, 1, 1, 0,
2820 "Highlight the region between point and the character under the mouse\n\
2823 register Lisp_Object event
;
2825 register int x0
, y0
, x1
, y1
;
2826 register struct frame
*f
= selected_frame
;
2827 register int p1
, p2
;
2829 CHECK_CONS (event
, 0);
2832 x0
= XINT (Fcar (Fcar (event
)));
2833 y0
= XINT (Fcar (Fcdr (Fcar (event
))));
2835 /* If the mouse is past the end of the line, don't that area. */
2836 /* ReWrite this... */
2841 if (y1
> y0
) /* point below mouse */
2842 outline_region (f
, f
->display
.x
->cursor_gc
,
2844 else if (y1
< y0
) /* point above mouse */
2845 outline_region (f
, f
->display
.x
->cursor_gc
,
2847 else /* same line: draw horizontal rectangle */
2850 x_rectangle (f
, f
->display
.x
->cursor_gc
,
2851 x0
, y0
, (x1
- x0
+ 1), 1);
2853 x_rectangle (f
, f
->display
.x
->cursor_gc
,
2854 x1
, y1
, (x0
- x1
+ 1), 1);
2857 XFlush (x_current_display
);
2863 DEFUN ("x-uncontour-region", Fx_uncontour_region
, Sx_uncontour_region
, 1, 1, 0,
2864 "Erase any highlighting of the region between point and the character\n\
2865 at X, Y on the selected frame.")
2867 register Lisp_Object event
;
2869 register int x0
, y0
, x1
, y1
;
2870 register struct frame
*f
= selected_frame
;
2873 x0
= XINT (Fcar (Fcar (event
)));
2874 y0
= XINT (Fcar (Fcdr (Fcar (event
))));
2878 if (y1
> y0
) /* point below mouse */
2879 outline_region (f
, f
->display
.x
->reverse_gc
,
2881 else if (y1
< y0
) /* point above mouse */
2882 outline_region (f
, f
->display
.x
->reverse_gc
,
2884 else /* same line: draw horizontal rectangle */
2887 x_rectangle (f
, f
->display
.x
->reverse_gc
,
2888 x0
, y0
, (x1
- x0
+ 1), 1);
2890 x_rectangle (f
, f
->display
.x
->reverse_gc
,
2891 x1
, y1
, (x0
- x1
+ 1), 1);
2899 int contour_begin_x
, contour_begin_y
;
2900 int contour_end_x
, contour_end_y
;
2901 int contour_npoints
;
2903 /* Clip the top part of the contour lines down (and including) line Y_POS.
2904 If X_POS is in the middle (rather than at the end) of the line, drop
2905 down a line at that character. */
2908 clip_contour_top (y_pos
, x_pos
)
2910 register XPoint
*begin
= contour_lines
[y_pos
].top_left
;
2911 register XPoint
*end
;
2912 register int npoints
;
2913 register struct display_line
*line
= selected_frame
->phys_lines
[y_pos
+ 1];
2915 if (x_pos
>= line
->len
- 1) /* Draw one, straight horizontal line. */
2917 end
= contour_lines
[y_pos
].top_right
;
2918 npoints
= (end
- begin
+ 1);
2919 XDrawLines (x_current_display
, contour_window
,
2920 contour_erase_gc
, begin_erase
, npoints
, CoordModeOrigin
);
2922 bcopy (end
, begin
+ 1, contour_last_point
- end
+ 1);
2923 contour_last_point
-= (npoints
- 2);
2924 XDrawLines (x_current_display
, contour_window
,
2925 contour_erase_gc
, begin
, 2, CoordModeOrigin
);
2926 XFlush (x_current_display
);
2928 /* Now, update contour_lines structure. */
2933 register XPoint
*p
= begin
+ 1;
2934 end
= contour_lines
[y_pos
].bottom_right
;
2935 npoints
= (end
- begin
+ 1);
2936 XDrawLines (x_current_display
, contour_window
,
2937 contour_erase_gc
, begin_erase
, npoints
, CoordModeOrigin
);
2940 p
->x
= ibw
+ (font_w
* (x_pos
+ 1));
2942 p
->y
= begin
->y
+ font_h
;
2944 bcopy (end
, begin
+ 3, contour_last_point
- end
+ 1);
2945 contour_last_point
-= (npoints
- 5);
2946 XDrawLines (x_current_display
, contour_window
,
2947 contour_erase_gc
, begin
, 4, CoordModeOrigin
);
2948 XFlush (x_current_display
);
2950 /* Now, update contour_lines structure. */
2954 /* Erase the top horizontal lines of the contour, and then extend
2955 the contour upwards. */
2958 extend_contour_top (line
)
2963 clip_contour_bottom (x_pos
, y_pos
)
2969 extend_contour_bottom (x_pos
, y_pos
)
2973 DEFUN ("x-select-region", Fx_select_region
, Sx_select_region
, 1, 1, "e",
2978 register struct frame
*f
= selected_frame
;
2979 register int point_x
= f
->cursor_x
;
2980 register int point_y
= f
->cursor_y
;
2981 register int mouse_below_point
;
2982 register Lisp_Object obj
;
2983 register int x_contour_x
, x_contour_y
;
2985 x_contour_x
= x_mouse_x
;
2986 x_contour_y
= x_mouse_y
;
2987 if (x_contour_y
> point_y
|| (x_contour_y
== point_y
2988 && x_contour_x
> point_x
))
2990 mouse_below_point
= 1;
2991 outline_region (f
, f
->display
.x
->cursor_gc
, point_x
, point_y
,
2992 x_contour_x
, x_contour_y
);
2996 mouse_below_point
= 0;
2997 outline_region (f
, f
->display
.x
->cursor_gc
, x_contour_x
, x_contour_y
,
3003 obj
= read_char (-1, 0, 0, Qnil
, 0);
3004 if (XTYPE (obj
) != Lisp_Cons
)
3007 if (mouse_below_point
)
3009 if (x_mouse_y
<= point_y
) /* Flipped. */
3011 mouse_below_point
= 0;
3013 outline_region (f
, f
->display
.x
->reverse_gc
, point_x
, point_y
,
3014 x_contour_x
, x_contour_y
);
3015 outline_region (f
, f
->display
.x
->cursor_gc
, x_mouse_x
, x_mouse_y
,
3018 else if (x_mouse_y
< x_contour_y
) /* Bottom clipped. */
3020 clip_contour_bottom (x_mouse_y
);
3022 else if (x_mouse_y
> x_contour_y
) /* Bottom extended. */
3024 extend_bottom_contour (x_mouse_y
);
3027 x_contour_x
= x_mouse_x
;
3028 x_contour_y
= x_mouse_y
;
3030 else /* mouse above or same line as point */
3032 if (x_mouse_y
>= point_y
) /* Flipped. */
3034 mouse_below_point
= 1;
3036 outline_region (f
, f
->display
.x
->reverse_gc
,
3037 x_contour_x
, x_contour_y
, point_x
, point_y
);
3038 outline_region (f
, f
->display
.x
->cursor_gc
, point_x
, point_y
,
3039 x_mouse_x
, x_mouse_y
);
3041 else if (x_mouse_y
> x_contour_y
) /* Top clipped. */
3043 clip_contour_top (x_mouse_y
);
3045 else if (x_mouse_y
< x_contour_y
) /* Top extended. */
3047 extend_contour_top (x_mouse_y
);
3052 unread_command_event
= obj
;
3053 if (mouse_below_point
)
3055 contour_begin_x
= point_x
;
3056 contour_begin_y
= point_y
;
3057 contour_end_x
= x_contour_x
;
3058 contour_end_y
= x_contour_y
;
3062 contour_begin_x
= x_contour_x
;
3063 contour_begin_y
= x_contour_y
;
3064 contour_end_x
= point_x
;
3065 contour_end_y
= point_y
;
3070 DEFUN ("x-horizontal-line", Fx_horizontal_line
, Sx_horizontal_line
, 1, 1, "e",
3075 register Lisp_Object obj
;
3076 struct frame
*f
= selected_frame
;
3077 register struct window
*w
= XWINDOW (selected_window
);
3078 register GC line_gc
= f
->display
.x
->cursor_gc
;
3079 register GC erase_gc
= f
->display
.x
->reverse_gc
;
3081 char dash_list
[] = {6, 4, 6, 4};
3083 XGCValues gc_values
;
3085 register int previous_y
;
3086 register int line
= (x_mouse_y
+ 1) * FONT_HEIGHT (f
->display
.x
->font
)
3087 + f
->display
.x
->internal_border_width
;
3088 register int left
= f
->display
.x
->internal_border_width
3090 * FONT_WIDTH (f
->display
.x
->font
));
3091 register int right
= left
+ (w
->width
3092 * FONT_WIDTH (f
->display
.x
->font
))
3093 - f
->display
.x
->internal_border_width
;
3097 gc_values
.foreground
= f
->display
.x
->cursor_pixel
;
3098 gc_values
.background
= f
->display
.x
->background_pixel
;
3099 gc_values
.line_width
= 1;
3100 gc_values
.line_style
= LineOnOffDash
;
3101 gc_values
.cap_style
= CapRound
;
3102 gc_values
.join_style
= JoinRound
;
3104 line_gc
= XCreateGC (x_current_display
, FRAME_X_WINDOW (f
),
3105 GCLineStyle
| GCJoinStyle
| GCCapStyle
3106 | GCLineWidth
| GCForeground
| GCBackground
,
3108 XSetDashes (x_current_display
, line_gc
, 0, dash_list
, dashes
);
3109 gc_values
.foreground
= f
->display
.x
->background_pixel
;
3110 gc_values
.background
= f
->display
.x
->foreground_pixel
;
3111 erase_gc
= XCreateGC (x_current_display
, FRAME_X_WINDOW (f
),
3112 GCLineStyle
| GCJoinStyle
| GCCapStyle
3113 | GCLineWidth
| GCForeground
| GCBackground
,
3115 XSetDashes (x_current_display
, erase_gc
, 0, dash_list
, dashes
);
3121 if (x_mouse_y
>= XINT (w
->top
)
3122 && x_mouse_y
< XINT (w
->top
) + XINT (w
->height
) - 1)
3124 previous_y
= x_mouse_y
;
3125 line
= (x_mouse_y
+ 1) * FONT_HEIGHT (f
->display
.x
->font
)
3126 + f
->display
.x
->internal_border_width
;
3127 XDrawLine (x_current_display
, FRAME_X_WINDOW (f
),
3128 line_gc
, left
, line
, right
, line
);
3135 obj
= read_char (-1, 0, 0, Qnil
, 0);
3136 if ((XTYPE (obj
) != Lisp_Cons
)
3137 || (! EQ (Fcar (Fcdr (Fcdr (obj
))),
3138 Qvertical_scroll_bar
))
3142 XDrawLine (x_current_display
, FRAME_X_WINDOW (f
),
3143 erase_gc
, left
, line
, right
, line
);
3145 unread_command_event
= obj
;
3147 XFreeGC (x_current_display
, line_gc
);
3148 XFreeGC (x_current_display
, erase_gc
);
3153 while (x_mouse_y
== previous_y
);
3156 XDrawLine (x_current_display
, FRAME_X_WINDOW (f
),
3157 erase_gc
, left
, line
, right
, line
);
3163 /* Offset in buffer of character under the pointer, or 0. */
3164 int mouse_buffer_offset
;
3167 /* These keep track of the rectangle following the pointer. */
3168 int mouse_track_top
, mouse_track_left
, mouse_track_width
;
3170 DEFUN ("x-track-pointer", Fx_track_pointer
, Sx_track_pointer
, 0, 0, 0,
3171 "Track the pointer.")
3174 static Cursor current_pointer_shape
;
3175 FRAME_PTR f
= x_mouse_frame
;
3178 if (EQ (Vmouse_frame_part
, Qtext_part
)
3179 && (current_pointer_shape
!= f
->display
.x
->nontext_cursor
))
3184 current_pointer_shape
= f
->display
.x
->nontext_cursor
;
3185 XDefineCursor (x_current_display
,
3187 current_pointer_shape
);
3189 buf
= XBUFFER (XWINDOW (Vmouse_window
)->buffer
);
3190 c
= *(BUF_CHAR_ADDRESS (buf
, mouse_buffer_offset
));
3192 else if (EQ (Vmouse_frame_part
, Qmodeline_part
)
3193 && (current_pointer_shape
!= f
->display
.x
->modeline_cursor
))
3195 current_pointer_shape
= f
->display
.x
->modeline_cursor
;
3196 XDefineCursor (x_current_display
,
3198 current_pointer_shape
);
3207 DEFUN ("x-track-pointer", Fx_track_pointer
, Sx_track_pointer
, 1, 1, "e",
3208 "Draw rectangle around character under mouse pointer, if there is one.")
3212 struct window
*w
= XWINDOW (Vmouse_window
);
3213 struct frame
*f
= XFRAME (WINDOW_FRAME (w
));
3214 struct buffer
*b
= XBUFFER (w
->buffer
);
3217 if (! EQ (Vmouse_window
, selected_window
))
3220 if (EQ (event
, Qnil
))
3224 x_read_mouse_position (selected_frame
, &x
, &y
);
3228 mouse_track_width
= 0;
3229 mouse_track_left
= mouse_track_top
= -1;
3233 if ((x_mouse_x
!= mouse_track_left
3234 && (x_mouse_x
< mouse_track_left
3235 || x_mouse_x
> (mouse_track_left
+ mouse_track_width
)))
3236 || x_mouse_y
!= mouse_track_top
)
3238 int hp
= 0; /* Horizontal position */
3239 int len
= FRAME_CURRENT_GLYPHS (f
)->used
[x_mouse_y
];
3240 int p
= FRAME_CURRENT_GLYPHS (f
)->bufp
[x_mouse_y
];
3241 int tab_width
= XINT (b
->tab_width
);
3242 int ctl_arrow_p
= !NILP (b
->ctl_arrow
);
3244 int mode_line_vpos
= XFASTINT (w
->height
) + XFASTINT (w
->top
) - 1;
3245 int in_mode_line
= 0;
3247 if (! FRAME_CURRENT_GLYPHS (f
)->enable
[x_mouse_y
])
3250 /* Erase previous rectangle. */
3251 if (mouse_track_width
)
3253 x_rectangle (f
, f
->display
.x
->reverse_gc
,
3254 mouse_track_left
, mouse_track_top
,
3255 mouse_track_width
, 1);
3257 if ((mouse_track_left
== f
->phys_cursor_x
3258 || mouse_track_left
== f
->phys_cursor_x
- 1)
3259 && mouse_track_top
== f
->phys_cursor_y
)
3261 x_display_cursor (f
, 1);
3265 mouse_track_left
= x_mouse_x
;
3266 mouse_track_top
= x_mouse_y
;
3267 mouse_track_width
= 0;
3269 if (mouse_track_left
> len
) /* Past the end of line. */
3272 if (mouse_track_top
== mode_line_vpos
)
3278 if (tab_width
<= 0 || tab_width
> 20) tab_width
= 8;
3282 if (len
== f
->width
&& hp
== len
- 1 && c
!= '\n')
3288 mouse_track_width
= tab_width
- (hp
% tab_width
);
3290 hp
+= mouse_track_width
;
3293 mouse_track_left
= hp
- mouse_track_width
;
3299 mouse_track_width
= -1;
3303 if (ctl_arrow_p
&& (c
< 040 || c
== 0177))
3308 mouse_track_width
= 2;
3313 mouse_track_left
= hp
- mouse_track_width
;
3319 mouse_track_width
= 1;
3326 while (hp
<= x_mouse_x
);
3329 if (mouse_track_width
) /* Over text; use text pointer shape. */
3331 XDefineCursor (x_current_display
,
3333 f
->display
.x
->text_cursor
);
3334 x_rectangle (f
, f
->display
.x
->cursor_gc
,
3335 mouse_track_left
, mouse_track_top
,
3336 mouse_track_width
, 1);
3338 else if (in_mode_line
)
3339 XDefineCursor (x_current_display
,
3341 f
->display
.x
->modeline_cursor
);
3343 XDefineCursor (x_current_display
,
3345 f
->display
.x
->nontext_cursor
);
3348 XFlush (x_current_display
);
3351 obj
= read_char (-1, 0, 0, Qnil
, 0);
3354 while (XTYPE (obj
) == Lisp_Cons
/* Mouse event */
3355 && EQ (Fcar (Fcdr (Fcdr (obj
))), Qnil
) /* Not scroll bar */
3356 && EQ (Vmouse_depressed
, Qnil
) /* Only motion events */
3357 && EQ (Vmouse_window
, selected_window
) /* In this window */
3360 unread_command_event
= obj
;
3362 if (mouse_track_width
)
3364 x_rectangle (f
, f
->display
.x
->reverse_gc
,
3365 mouse_track_left
, mouse_track_top
,
3366 mouse_track_width
, 1);
3367 mouse_track_width
= 0;
3368 if ((mouse_track_left
== f
->phys_cursor_x
3369 || mouse_track_left
- 1 == f
->phys_cursor_x
)
3370 && mouse_track_top
== f
->phys_cursor_y
)
3372 x_display_cursor (f
, 1);
3375 XDefineCursor (x_current_display
,
3377 f
->display
.x
->nontext_cursor
);
3378 XFlush (x_current_display
);
3388 /* Draw a pixmap specified by IMAGE_DATA of dimensions WIDTH and HEIGHT
3389 on the frame F at position X, Y. */
3391 x_draw_pixmap (f
, x
, y
, image_data
, width
, height
)
3393 int x
, y
, width
, height
;
3398 image
= XCreateBitmapFromData (x_current_display
,
3399 FRAME_X_WINDOW (f
), image_data
,
3401 XCopyPlane (x_current_display
, image
, FRAME_X_WINDOW (f
),
3402 f
->display
.x
->normal_gc
, 0, 0, width
, height
, x
, y
);
3407 DEFUN ("x-store-cut-buffer", Fx_store_cut_buffer
, Sx_store_cut_buffer
,
3408 1, 1, "sStore text in cut buffer: ",
3409 "Store contents of STRING into the cut buffer of the X window system.")
3411 register Lisp_Object string
;
3415 CHECK_STRING (string
, 1);
3416 if (! FRAME_X_P (selected_frame
))
3417 error ("Selected frame does not understand X protocol.");
3420 XStoreBytes ((char *) XSTRING (string
)->data
, XSTRING (string
)->size
);
3426 DEFUN ("x-get-cut-buffer", Fx_get_cut_buffer
, Sx_get_cut_buffer
, 0, 0, 0,
3427 "Return contents of cut buffer of the X window system, as a string.")
3431 register Lisp_Object string
;
3436 d
= XFetchBytes (&len
);
3437 string
= make_string (d
, len
);
3444 #if 0 /* I'm told these functions are superfluous
3445 given the ability to bind function keys. */
3448 DEFUN ("x-rebind-key", Fx_rebind_key
, Sx_rebind_key
, 3, 3, 0,
3449 "Rebind X keysym KEYSYM, with MODIFIERS, to generate NEWSTRING.\n\
3450 KEYSYM is a string which conforms to the X keysym definitions found\n\
3451 in X11/keysymdef.h, sans the initial XK_. MODIFIERS is nil or a\n\
3452 list of strings specifying modifier keys such as Control_L, which must\n\
3453 also be depressed for NEWSTRING to appear.")
3454 (x_keysym
, modifiers
, newstring
)
3455 register Lisp_Object x_keysym
;
3456 register Lisp_Object modifiers
;
3457 register Lisp_Object newstring
;
3460 register KeySym keysym
;
3461 KeySym modifier_list
[16];
3464 CHECK_STRING (x_keysym
, 1);
3465 CHECK_STRING (newstring
, 3);
3467 keysym
= XStringToKeysym ((char *) XSTRING (x_keysym
)->data
);
3468 if (keysym
== NoSymbol
)
3469 error ("Keysym does not exist");
3471 if (NILP (modifiers
))
3472 XRebindKeysym (x_current_display
, keysym
, modifier_list
, 0,
3473 XSTRING (newstring
)->data
, XSTRING (newstring
)->size
);
3476 register Lisp_Object rest
, mod
;
3479 for (rest
= modifiers
; !NILP (rest
); rest
= Fcdr (rest
))
3482 error ("Can't have more than 16 modifiers");
3485 CHECK_STRING (mod
, 3);
3486 modifier_list
[i
] = XStringToKeysym ((char *) XSTRING (mod
)->data
);
3488 if (modifier_list
[i
] == NoSymbol
3489 || !(IsModifierKey (modifier_list
[i
])
3490 || ((unsigned)(modifier_list
[i
]) == XK_Mode_switch
)
3491 || ((unsigned)(modifier_list
[i
]) == XK_Num_Lock
)))
3493 if (modifier_list
[i
] == NoSymbol
3494 || !IsModifierKey (modifier_list
[i
]))
3496 error ("Element is not a modifier keysym");
3500 XRebindKeysym (x_current_display
, keysym
, modifier_list
, i
,
3501 XSTRING (newstring
)->data
, XSTRING (newstring
)->size
);
3507 DEFUN ("x-rebind-keys", Fx_rebind_keys
, Sx_rebind_keys
, 2, 2, 0,
3508 "Rebind KEYCODE to list of strings STRINGS.\n\
3509 STRINGS should be a list of 16 elements, one for each shift combination.\n\
3510 nil as element means don't change.\n\
3511 See the documentation of `x-rebind-key' for more information.")
3513 register Lisp_Object keycode
;
3514 register Lisp_Object strings
;
3516 register Lisp_Object item
;
3517 register unsigned char *rawstring
;
3518 KeySym rawkey
, modifier
[1];
3520 register unsigned i
;
3523 CHECK_NUMBER (keycode
, 1);
3524 CHECK_CONS (strings
, 2);
3525 rawkey
= (KeySym
) ((unsigned) (XINT (keycode
))) & 255;
3526 for (i
= 0; i
<= 15; strings
= Fcdr (strings
), i
++)
3528 item
= Fcar (strings
);
3531 CHECK_STRING (item
, 2);
3532 strsize
= XSTRING (item
)->size
;
3533 rawstring
= (unsigned char *) xmalloc (strsize
);
3534 bcopy (XSTRING (item
)->data
, rawstring
, strsize
);
3535 modifier
[1] = 1 << i
;
3536 XRebindKeysym (x_current_display
, rawkey
, modifier
, 1,
3537 rawstring
, strsize
);
3542 #endif /* HAVE_X11 */
3547 #ifndef HAVE_XSCREENNUMBEROFSCREEN
3549 XScreenNumberOfScreen (scr
)
3550 register Screen
*scr
;
3552 register Display
*dpy
;
3553 register Screen
*dpyscr
;
3557 dpyscr
= dpy
->screens
;
3559 for (i
= 0; i
< dpy
->nscreens
; i
++, dpyscr
++)
3565 #endif /* not HAVE_XSCREENNUMBEROFSCREEN */
3568 select_visual (screen
, depth
)
3570 unsigned int *depth
;
3573 XVisualInfo
*vinfo
, vinfo_template
;
3576 v
= DefaultVisualOfScreen (screen
);
3579 vinfo_template
.visualid
= XVisualIDFromVisual (v
);
3581 vinfo_template
.visualid
= v
->visualid
;
3584 vinfo_template
.screen
= XScreenNumberOfScreen (screen
);
3586 vinfo
= XGetVisualInfo (x_current_display
,
3587 VisualIDMask
| VisualScreenMask
, &vinfo_template
,
3590 fatal ("Can't get proper X visual info");
3592 if ((1 << vinfo
->depth
) == vinfo
->colormap_size
)
3593 *depth
= vinfo
->depth
;
3597 int n
= vinfo
->colormap_size
- 1;
3606 XFree ((char *) vinfo
);
3609 #endif /* HAVE_X11 */
3611 DEFUN ("x-open-connection", Fx_open_connection
, Sx_open_connection
,
3612 1, 2, 0, "Open a connection to an X server.\n\
3613 DISPLAY is the name of the display to connect to.\n\
3614 Optional second arg XRM_STRING is a string of resources in xrdb format.")
3615 (display
, xrm_string
)
3616 Lisp_Object display
, xrm_string
;
3618 unsigned int n_planes
;
3619 unsigned char *xrm_option
;
3621 CHECK_STRING (display
, 0);
3622 if (x_current_display
!= 0)
3623 error ("X server connection is already initialized");
3624 if (! NILP (xrm_string
))
3625 CHECK_STRING (xrm_string
, 1);
3627 /* This is what opens the connection and sets x_current_display.
3628 This also initializes many symbols, such as those used for input. */
3629 x_term_init (XSTRING (display
)->data
);
3632 XFASTINT (Vwindow_system_version
) = 11;
3634 if (! NILP (xrm_string
))
3635 xrm_option
= (unsigned char *) XSTRING (xrm_string
)->data
;
3637 xrm_option
= (unsigned char *) 0;
3639 validate_x_resource_name ();
3642 xrdb
= x_load_resources (x_current_display
, xrm_option
,
3643 (char *) XSTRING (Vx_resource_name
)->data
,
3646 #ifdef HAVE_XRMSETDATABASE
3647 XrmSetDatabase (x_current_display
, xrdb
);
3649 x_current_display
->db
= xrdb
;
3652 x_screen
= DefaultScreenOfDisplay (x_current_display
);
3654 screen_visual
= select_visual (x_screen
, &n_planes
);
3655 x_screen_planes
= n_planes
;
3656 x_screen_height
= HeightOfScreen (x_screen
);
3657 x_screen_width
= WidthOfScreen (x_screen
);
3659 /* X Atoms used by emacs. */
3660 Xatoms_of_xselect ();
3662 Xatom_wm_protocols
= XInternAtom (x_current_display
, "WM_PROTOCOLS",
3664 Xatom_wm_take_focus
= XInternAtom (x_current_display
, "WM_TAKE_FOCUS",
3666 Xatom_wm_save_yourself
= XInternAtom (x_current_display
, "WM_SAVE_YOURSELF",
3668 Xatom_wm_delete_window
= XInternAtom (x_current_display
, "WM_DELETE_WINDOW",
3670 Xatom_wm_change_state
= XInternAtom (x_current_display
, "WM_CHANGE_STATE",
3672 Xatom_wm_configure_denied
= XInternAtom (x_current_display
,
3673 "WM_CONFIGURE_DENIED", False
);
3674 Xatom_wm_window_moved
= XInternAtom (x_current_display
, "WM_MOVED",
3677 #else /* not HAVE_X11 */
3678 XFASTINT (Vwindow_system_version
) = 10;
3679 #endif /* not HAVE_X11 */
3683 DEFUN ("x-close-current-connection", Fx_close_current_connection
,
3684 Sx_close_current_connection
,
3685 0, 0, 0, "Close the connection to the current X server.")
3689 /* This is ONLY used when killing emacs; For switching displays
3690 we'll have to take care of setting CloseDownMode elsewhere. */
3692 if (x_current_display
)
3695 XSetCloseDownMode (x_current_display
, DestroyAll
);
3696 XCloseDisplay (x_current_display
);
3697 x_current_display
= 0;
3700 fatal ("No current X display connection to close\n");
3705 DEFUN ("x-synchronize", Fx_synchronize
, Sx_synchronize
,
3706 1, 1, 0, "If ON is non-nil, report X errors as soon as the erring request is made.\n\
3707 If ON is nil, allow buffering of requests.\n\
3708 Turning on synchronization prohibits the Xlib routines from buffering\n\
3709 requests and seriously degrades performance, but makes debugging much\n\
3716 XSynchronize (x_current_display
, !EQ (on
, Qnil
));
3724 /* This is zero if not using X windows. */
3725 x_current_display
= 0;
3727 /* The section below is built by the lisp expression at the top of the file,
3728 just above where these variables are declared. */
3729 /*&&& init symbols here &&&*/
3730 Qauto_raise
= intern ("auto-raise");
3731 staticpro (&Qauto_raise
);
3732 Qauto_lower
= intern ("auto-lower");
3733 staticpro (&Qauto_lower
);
3734 Qbackground_color
= intern ("background-color");
3735 staticpro (&Qbackground_color
);
3736 Qbar
= intern ("bar");
3738 Qborder_color
= intern ("border-color");
3739 staticpro (&Qborder_color
);
3740 Qborder_width
= intern ("border-width");
3741 staticpro (&Qborder_width
);
3742 Qbox
= intern ("box");
3744 Qcursor_color
= intern ("cursor-color");
3745 staticpro (&Qcursor_color
);
3746 Qcursor_type
= intern ("cursor-type");
3747 staticpro (&Qcursor_type
);
3748 Qfont
= intern ("font");
3750 Qforeground_color
= intern ("foreground-color");
3751 staticpro (&Qforeground_color
);
3752 Qgeometry
= intern ("geometry");
3753 staticpro (&Qgeometry
);
3754 Qicon_left
= intern ("icon-left");
3755 staticpro (&Qicon_left
);
3756 Qicon_top
= intern ("icon-top");
3757 staticpro (&Qicon_top
);
3758 Qicon_type
= intern ("icon-type");
3759 staticpro (&Qicon_type
);
3760 Qinternal_border_width
= intern ("internal-border-width");
3761 staticpro (&Qinternal_border_width
);
3762 Qleft
= intern ("left");
3764 Qmouse_color
= intern ("mouse-color");
3765 staticpro (&Qmouse_color
);
3766 Qnone
= intern ("none");
3768 Qparent_id
= intern ("parent-id");
3769 staticpro (&Qparent_id
);
3770 Qsuppress_icon
= intern ("suppress-icon");
3771 staticpro (&Qsuppress_icon
);
3772 Qtop
= intern ("top");
3774 Qundefined_color
= intern ("undefined-color");
3775 staticpro (&Qundefined_color
);
3776 Qvertical_scroll_bars
= intern ("vertical-scroll-bars");
3777 staticpro (&Qvertical_scroll_bars
);
3778 Qvisibility
= intern ("visibility");
3779 staticpro (&Qvisibility
);
3780 Qwindow_id
= intern ("window-id");
3781 staticpro (&Qwindow_id
);
3782 Qx_frame_parameter
= intern ("x-frame-parameter");
3783 staticpro (&Qx_frame_parameter
);
3784 /* This is the end of symbol initialization. */
3786 Fput (Qundefined_color
, Qerror_conditions
,
3787 Fcons (Qundefined_color
, Fcons (Qerror
, Qnil
)));
3788 Fput (Qundefined_color
, Qerror_message
,
3789 build_string ("Undefined color"));
3791 init_x_parm_symbols ();
3793 DEFVAR_INT ("mouse-buffer-offset", &mouse_buffer_offset
,
3794 "The buffer offset of the character under the pointer.");
3795 mouse_buffer_offset
= 0;
3797 DEFVAR_LISP ("x-pointer-shape", &Vx_pointer_shape
,
3798 "The shape of the pointer when over text.\n\
3799 Changing the value does not affect existing frames\n\
3800 unless you set the mouse color.");
3801 Vx_pointer_shape
= Qnil
;
3803 DEFVAR_LISP ("x-resource-name", &Vx_resource_name
,
3804 "The name Emacs uses to look up X resources; for internal use only.\n\
3805 `x-get-resource' uses this as the first component of the instance name\n\
3806 when requesting resource values.\n\
3807 Emacs initially sets `x-resource-name' to the name under which Emacs\n\
3808 was invoked, or to the value specified with the `-name' or `-rn'\n\
3809 switches, if present.");
3810 Vx_resource_name
= Qnil
;
3813 DEFVAR_INT ("x-nontext-pointer-shape", &Vx_nontext_pointer_shape
,
3814 "The shape of the pointer when not over text.");
3816 Vx_nontext_pointer_shape
= Qnil
;
3819 DEFVAR_INT ("x-mode-pointer-shape", &Vx_mode_pointer_shape
,
3820 "The shape of the pointer when over the mode line.");
3822 Vx_mode_pointer_shape
= Qnil
;
3824 DEFVAR_LISP ("x-cursor-fore-pixel", &Vx_cursor_fore_pixel
,
3825 "A string indicating the foreground color of the cursor box.");
3826 Vx_cursor_fore_pixel
= Qnil
;
3828 DEFVAR_LISP ("mouse-grabbed", &Vmouse_depressed
,
3829 "Non-nil if a mouse button is currently depressed.");
3830 Vmouse_depressed
= Qnil
;
3832 DEFVAR_LISP ("x-no-window-manager", &Vx_no_window_manager
,
3833 "t if no X window manager is in use.");
3836 defsubr (&Sx_get_resource
);
3838 defsubr (&Sx_draw_rectangle
);
3839 defsubr (&Sx_erase_rectangle
);
3840 defsubr (&Sx_contour_region
);
3841 defsubr (&Sx_uncontour_region
);
3843 defsubr (&Sx_display_color_p
);
3844 defsubr (&Sx_list_fonts
);
3845 defsubr (&Sx_color_defined_p
);
3846 defsubr (&Sx_server_max_request_size
);
3847 defsubr (&Sx_server_vendor
);
3848 defsubr (&Sx_server_version
);
3849 defsubr (&Sx_display_pixel_width
);
3850 defsubr (&Sx_display_pixel_height
);
3851 defsubr (&Sx_display_mm_width
);
3852 defsubr (&Sx_display_mm_height
);
3853 defsubr (&Sx_display_screens
);
3854 defsubr (&Sx_display_planes
);
3855 defsubr (&Sx_display_color_cells
);
3856 defsubr (&Sx_display_visual_class
);
3857 defsubr (&Sx_display_backing_store
);
3858 defsubr (&Sx_display_save_under
);
3860 defsubr (&Sx_rebind_key
);
3861 defsubr (&Sx_rebind_keys
);
3862 defsubr (&Sx_track_pointer
);
3863 defsubr (&Sx_grab_pointer
);
3864 defsubr (&Sx_ungrab_pointer
);
3867 defsubr (&Sx_get_default
);
3868 defsubr (&Sx_store_cut_buffer
);
3869 defsubr (&Sx_get_cut_buffer
);
3871 defsubr (&Sx_parse_geometry
);
3872 defsubr (&Sx_create_frame
);
3873 defsubr (&Sfocus_frame
);
3874 defsubr (&Sunfocus_frame
);
3876 defsubr (&Sx_horizontal_line
);
3878 defsubr (&Sx_open_connection
);
3879 defsubr (&Sx_close_current_connection
);
3880 defsubr (&Sx_synchronize
);
3883 #endif /* HAVE_X_WINDOWS */