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
;
1536 XSetWindowAttributes attributes
;
1537 unsigned long attribute_mask
;
1538 XClassHint class_hints
;
1540 attributes
.background_pixel
= f
->display
.x
->background_pixel
;
1541 attributes
.border_pixel
= f
->display
.x
->border_pixel
;
1542 attributes
.bit_gravity
= StaticGravity
;
1543 attributes
.backing_store
= NotUseful
;
1544 attributes
.save_under
= True
;
1545 attributes
.event_mask
= STANDARD_EVENT_SET
;
1546 attribute_mask
= (CWBackPixel
| CWBorderPixel
| CWBitGravity
1548 | CWBackingStore
| CWSaveUnder
1554 = XCreateWindow (x_current_display
, ROOT_WINDOW
,
1555 f
->display
.x
->left_pos
,
1556 f
->display
.x
->top_pos
,
1557 PIXEL_WIDTH (f
), PIXEL_HEIGHT (f
),
1558 f
->display
.x
->border_width
,
1559 CopyFromParent
, /* depth */
1560 InputOutput
, /* class */
1561 screen_visual
, /* set in Fx_open_connection */
1562 attribute_mask
, &attributes
);
1564 validate_x_resource_name ();
1565 class_hints
.res_name
= (char *) XSTRING (Vx_resource_name
)->data
;
1566 class_hints
.res_class
= EMACS_CLASS
;
1567 XSetClassHint (x_current_display
, FRAME_X_WINDOW (f
), &class_hints
);
1569 /* This indicates that we use the "Passive Input" input model.
1570 Unless we do this, we don't get the Focus{In,Out} events that we
1571 need to draw the cursor correctly. Accursed bureaucrats.
1572 XWhipsAndChains (x_current_display, IronMaiden, &TheRack); */
1574 f
->display
.x
->wm_hints
.input
= True
;
1575 f
->display
.x
->wm_hints
.flags
|= InputHint
;
1576 XSetWMHints (x_current_display
, FRAME_X_WINDOW (f
), &f
->display
.x
->wm_hints
);
1578 /* x_set_name normally ignores requests to set the name if the
1579 requested name is the same as the current name. This is the one
1580 place where that assumption isn't correct; f->name is set, but
1581 the X server hasn't been told. */
1583 Lisp_Object name
= f
->name
;
1584 int explicit = f
->explicit_name
;
1587 f
->explicit_name
= 0;
1588 x_set_name (f
, name
, explicit);
1591 XDefineCursor (XDISPLAY
FRAME_X_WINDOW (f
),
1592 f
->display
.x
->text_cursor
);
1595 if (FRAME_X_WINDOW (f
) == 0)
1596 error ("Unable to create window.");
1599 /* Handle the icon stuff for this window. Perhaps later we might
1600 want an x_set_icon_position which can be called interactively as
1608 Lisp_Object icon_x
, icon_y
;
1610 /* Set the position of the icon. Note that twm groups all
1611 icons in an icon window. */
1612 icon_x
= x_get_arg (parms
, Qicon_left
, 0, 0, number
);
1613 icon_y
= x_get_arg (parms
, Qicon_top
, 0, 0, number
);
1614 if (!EQ (icon_x
, Qunbound
) && !EQ (icon_y
, Qunbound
))
1616 CHECK_NUMBER (icon_x
, 0);
1617 CHECK_NUMBER (icon_y
, 0);
1619 else if (!EQ (icon_x
, Qunbound
) || !EQ (icon_y
, Qunbound
))
1620 error ("Both left and top icon corners of icon must be specified");
1624 if (! EQ (icon_x
, Qunbound
))
1625 x_wm_set_icon_position (f
, XINT (icon_x
), XINT (icon_y
));
1627 /* Start up iconic or window? */
1628 x_wm_set_window_state
1629 (f
, (EQ (x_get_arg (parms
, Qvisibility
, 0, 0, symbol
), Qicon
)
1636 /* Make the GC's needed for this window, setting the
1637 background, border and mouse colors; also create the
1638 mouse cursor and the gray border tile. */
1640 static char cursor_bits
[] =
1642 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
1643 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
1644 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
1645 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00
1652 XGCValues gc_values
;
1658 /* Create the GC's of this frame.
1659 Note that many default values are used. */
1662 gc_values
.font
= f
->display
.x
->font
->fid
;
1663 gc_values
.foreground
= f
->display
.x
->foreground_pixel
;
1664 gc_values
.background
= f
->display
.x
->background_pixel
;
1665 gc_values
.line_width
= 0; /* Means 1 using fast algorithm. */
1666 f
->display
.x
->normal_gc
= XCreateGC (x_current_display
,
1668 GCLineWidth
| GCFont
1669 | GCForeground
| GCBackground
,
1672 /* Reverse video style. */
1673 gc_values
.foreground
= f
->display
.x
->background_pixel
;
1674 gc_values
.background
= f
->display
.x
->foreground_pixel
;
1675 f
->display
.x
->reverse_gc
= XCreateGC (x_current_display
,
1677 GCFont
| GCForeground
| GCBackground
1681 /* Cursor has cursor-color background, background-color foreground. */
1682 gc_values
.foreground
= f
->display
.x
->background_pixel
;
1683 gc_values
.background
= f
->display
.x
->cursor_pixel
;
1684 gc_values
.fill_style
= FillOpaqueStippled
;
1686 = XCreateBitmapFromData (x_current_display
, ROOT_WINDOW
,
1687 cursor_bits
, 16, 16);
1688 f
->display
.x
->cursor_gc
1689 = XCreateGC (x_current_display
, FRAME_X_WINDOW (f
),
1690 (GCFont
| GCForeground
| GCBackground
1691 | GCFillStyle
| GCStipple
| GCLineWidth
),
1694 /* Create the gray border tile used when the pointer is not in
1695 the frame. Since this depends on the frame's pixel values,
1696 this must be done on a per-frame basis. */
1697 f
->display
.x
->border_tile
1698 = (XCreatePixmapFromBitmapData
1699 (x_current_display
, ROOT_WINDOW
,
1700 gray_bits
, gray_width
, gray_height
,
1701 f
->display
.x
->foreground_pixel
,
1702 f
->display
.x
->background_pixel
,
1703 DefaultDepth (x_current_display
, XDefaultScreen (x_current_display
))));
1707 #endif /* HAVE_X11 */
1709 DEFUN ("x-create-frame", Fx_create_frame
, Sx_create_frame
,
1711 "Make a new X window, which is called a \"frame\" in Emacs terms.\n\
1712 Return an Emacs frame object representing the X window.\n\
1713 ALIST is an alist of frame parameters.\n\
1714 If the parameters specify that the frame should not have a minibuffer,\n\
1715 and do not specify a specific minibuffer window to use,\n\
1716 then `default-minibuffer-frame' must be a frame whose minibuffer can\n\
1717 be shared by the new frame.")
1723 Lisp_Object frame
, tem
, tem0
, tem1
;
1725 int minibuffer_only
= 0;
1726 long window_prompting
= 0;
1731 name
= x_get_arg (parms
, Qname
, "title", "Title", string
);
1732 if (XTYPE (name
) != Lisp_String
1733 && ! EQ (name
, Qunbound
)
1735 error ("x-create-frame: name parameter must be a string");
1737 tem
= x_get_arg (parms
, Qminibuffer
, 0, 0, symbol
);
1738 if (EQ (tem
, Qnone
) || NILP (tem
))
1739 f
= make_frame_without_minibuffer (Qnil
);
1740 else if (EQ (tem
, Qonly
))
1742 f
= make_minibuffer_frame ();
1743 minibuffer_only
= 1;
1745 else if (XTYPE (tem
) == Lisp_Window
)
1746 f
= make_frame_without_minibuffer (tem
);
1750 /* Note that X Windows does support scroll bars. */
1751 FRAME_CAN_HAVE_SCROLL_BARS (f
) = 1;
1753 /* Set the name; the functions to which we pass f expect the name to
1755 if (EQ (name
, Qunbound
) || NILP (name
))
1757 f
->name
= build_string (x_id_name
);
1758 f
->explicit_name
= 0;
1763 f
->explicit_name
= 1;
1766 XSET (frame
, Lisp_Frame
, f
);
1767 f
->output_method
= output_x_window
;
1768 f
->display
.x
= (struct x_display
*) xmalloc (sizeof (struct x_display
));
1769 bzero (f
->display
.x
, sizeof (struct x_display
));
1771 /* Note that the frame has no physical cursor right now. */
1772 f
->phys_cursor_x
= -1;
1774 /* Extract the window parameters from the supplied values
1775 that are needed to determine window geometry. */
1779 font
= x_get_arg (parms
, Qfont
, "font", "Font", string
);
1781 /* First, try whatever font the caller has specified. */
1783 font
= x_new_font (f
, XSTRING (font
)->data
);
1784 /* Try out a font which we hope has bold and italic variations. */
1785 if (!STRINGP (font
))
1786 font
= x_new_font (f
, "-misc-fixed-medium-r-normal-*-*-120-*-*-c-*-iso8859-1");
1787 if (! STRINGP (font
))
1788 font
= x_new_font (f
, "-*-*-medium-r-normal-*-*-120-*-*-c-*-iso8859-1");
1789 if (! STRINGP (font
))
1790 /* This was formerly the first thing tried, but it finds too many fonts
1791 and takes too long. */
1792 font
= x_new_font (f
, "-*-*-medium-r-*-*-*-*-*-*-c-*-iso8859-1");
1793 /* If those didn't work, look for something which will at least work. */
1794 if (! STRINGP (font
))
1795 font
= x_new_font (f
, "-*-fixed-*-*-*-*-*-120-*-*-c-*-iso8859-1");
1797 if (! STRINGP (font
))
1798 font
= build_string ("fixed");
1800 x_default_parameter (f
, parms
, Qfont
, font
,
1801 "font", "Font", string
);
1803 x_default_parameter (f
, parms
, Qborder_width
, make_number (2),
1804 "borderwidth", "BorderWidth", number
);
1805 /* This defaults to 2 in order to match xterm. We recognize either
1806 internalBorderWidth or internalBorder (which is what xterm calls
1808 if (NILP (Fassq (Qinternal_border_width
, parms
)))
1812 value
= x_get_arg (parms
, Qinternal_border_width
,
1813 "internalBorder", "BorderWidth", number
);
1814 if (! EQ (value
, Qunbound
))
1815 parms
= Fcons (Fcons (Qinternal_border_width
, value
),
1818 x_default_parameter (f
, parms
, Qinternal_border_width
, make_number (2),
1819 "internalBorderWidth", "BorderWidth", number
);
1820 x_default_parameter (f
, parms
, Qvertical_scroll_bars
, Qt
,
1821 "verticalScrollBars", "ScrollBars", boolean
);
1823 /* Also do the stuff which must be set before the window exists. */
1824 x_default_parameter (f
, parms
, Qforeground_color
, build_string ("black"),
1825 "foreground", "Foreground", string
);
1826 x_default_parameter (f
, parms
, Qbackground_color
, build_string ("white"),
1827 "background", "Background", string
);
1828 x_default_parameter (f
, parms
, Qmouse_color
, build_string ("black"),
1829 "pointerColor", "Foreground", string
);
1830 x_default_parameter (f
, parms
, Qcursor_color
, build_string ("black"),
1831 "cursorColor", "Foreground", string
);
1832 x_default_parameter (f
, parms
, Qborder_color
, build_string ("black"),
1833 "borderColor", "BorderColor", string
);
1835 f
->display
.x
->parent_desc
= ROOT_WINDOW
;
1836 window_prompting
= x_figure_window_size (f
, parms
);
1841 init_frame_faces (f
);
1843 /* We need to do this after creating the X window, so that the
1844 icon-creation functions can say whose icon they're describing. */
1845 x_default_parameter (f
, parms
, Qicon_type
, Qnil
,
1846 "bitmapIcon", "BitmapIcon", symbol
);
1848 x_default_parameter (f
, parms
, Qauto_raise
, Qnil
,
1849 "autoRaise", "AutoRaiseLower", boolean
);
1850 x_default_parameter (f
, parms
, Qauto_lower
, Qnil
,
1851 "autoLower", "AutoRaiseLower", boolean
);
1852 x_default_parameter (f
, parms
, Qcursor_type
, Qbox
,
1853 "cursorType", "CursorType", symbol
);
1855 /* Dimensions, especially f->height, must be done via change_frame_size.
1856 Change will not be effected unless different from the current
1860 f
->height
= f
->width
= 0;
1861 change_frame_size (f
, height
, width
, 1, 0);
1863 x_default_parameter (f
, parms
, Qmenu_bar_lines
, make_number (0),
1864 "menuBarLines", "MenuBarLines", number
);
1866 tem0
= x_get_arg (parms
, Qtop
, 0, 0, number
);
1867 tem1
= x_get_arg (parms
, Qleft
, 0, 0, number
);
1869 x_wm_set_size_hint (f
, window_prompting
, XINT (tem0
), XINT (tem1
));
1872 tem
= x_get_arg (parms
, Qunsplittable
, 0, 0, boolean
);
1873 f
->no_split
= minibuffer_only
|| EQ (tem
, Qt
);
1875 /* Make the window appear on the frame and enable display,
1876 unless the caller says not to. */
1878 Lisp_Object visibility
= x_get_arg (parms
, Qvisibility
, 0, 0, symbol
);
1880 if (EQ (visibility
, Qunbound
))
1883 if (EQ (visibility
, Qicon
))
1884 x_iconify_frame (f
);
1885 else if (! NILP (visibility
))
1886 x_make_frame_visible (f
);
1888 /* Must have been Qnil. */
1895 Lisp_Object frame
, tem
;
1897 int pixelwidth
, pixelheight
;
1902 int minibuffer_only
= 0;
1903 Lisp_Object vscroll
, hscroll
;
1905 if (x_current_display
== 0)
1906 error ("X windows are not in use or not initialized");
1908 name
= Fassq (Qname
, parms
);
1910 tem
= x_get_arg (parms
, Qminibuffer
, 0, 0, symbol
);
1911 if (EQ (tem
, Qnone
))
1912 f
= make_frame_without_minibuffer (Qnil
);
1913 else if (EQ (tem
, Qonly
))
1915 f
= make_minibuffer_frame ();
1916 minibuffer_only
= 1;
1918 else if (EQ (tem
, Qnil
) || EQ (tem
, Qunbound
))
1921 f
= make_frame_without_minibuffer (tem
);
1923 parent
= ROOT_WINDOW
;
1925 XSET (frame
, Lisp_Frame
, f
);
1926 f
->output_method
= output_x_window
;
1927 f
->display
.x
= (struct x_display
*) xmalloc (sizeof (struct x_display
));
1928 bzero (f
->display
.x
, sizeof (struct x_display
));
1930 /* Some temporary default values for height and width. */
1933 f
->display
.x
->left_pos
= -1;
1934 f
->display
.x
->top_pos
= -1;
1936 /* Give the frame a default name (which may be overridden with PARMS). */
1938 strncpy (iconidentity
, ICONTAG
, MAXICID
);
1939 if (gethostname (&iconidentity
[sizeof (ICONTAG
) - 1],
1940 (MAXICID
- 1) - sizeof (ICONTAG
)))
1941 iconidentity
[sizeof (ICONTAG
) - 2] = '\0';
1942 f
->name
= build_string (iconidentity
);
1944 /* Extract some window parameters from the supplied values.
1945 These are the parameters that affect window geometry. */
1947 tem
= x_get_arg (parms
, Qfont
, "BodyFont", 0, string
);
1948 if (EQ (tem
, Qunbound
))
1949 tem
= build_string ("9x15");
1950 x_set_font (f
, tem
, Qnil
);
1951 x_default_parameter (f
, parms
, Qborder_color
,
1952 build_string ("black"), "Border", 0, string
);
1953 x_default_parameter (f
, parms
, Qbackground_color
,
1954 build_string ("white"), "Background", 0, string
);
1955 x_default_parameter (f
, parms
, Qforeground_color
,
1956 build_string ("black"), "Foreground", 0, string
);
1957 x_default_parameter (f
, parms
, Qmouse_color
,
1958 build_string ("black"), "Mouse", 0, string
);
1959 x_default_parameter (f
, parms
, Qcursor_color
,
1960 build_string ("black"), "Cursor", 0, string
);
1961 x_default_parameter (f
, parms
, Qborder_width
,
1962 make_number (2), "BorderWidth", 0, number
);
1963 x_default_parameter (f
, parms
, Qinternal_border_width
,
1964 make_number (4), "InternalBorderWidth", 0, number
);
1965 x_default_parameter (f
, parms
, Qauto_raise
,
1966 Qnil
, "AutoRaise", 0, boolean
);
1968 hscroll
= EQ (x_get_arg (parms
, Qhorizontal_scroll_bar
, 0, 0, boolean
), Qt
);
1969 vscroll
= EQ (x_get_arg (parms
, Qvertical_scroll_bar
, 0, 0, boolean
), Qt
);
1971 if (f
->display
.x
->internal_border_width
< 0)
1972 f
->display
.x
->internal_border_width
= 0;
1974 tem
= x_get_arg (parms
, Qwindow_id
, 0, 0, number
);
1975 if (!EQ (tem
, Qunbound
))
1977 WINDOWINFO_TYPE wininfo
;
1979 Window
*children
, root
;
1981 CHECK_NUMBER (tem
, 0);
1982 FRAME_X_WINDOW (f
) = (Window
) XINT (tem
);
1985 XGetWindowInfo (FRAME_X_WINDOW (f
), &wininfo
);
1986 XQueryTree (FRAME_X_WINDOW (f
), &parent
, &nchildren
, &children
);
1990 height
= PIXEL_TO_CHAR_HEIGHT (f
, wininfo
.height
);
1991 width
= PIXEL_TO_CHAR_WIDTH (f
, wininfo
.width
);
1992 f
->display
.x
->left_pos
= wininfo
.x
;
1993 f
->display
.x
->top_pos
= wininfo
.y
;
1994 FRAME_SET_VISIBILITY (f
, wininfo
.mapped
!= 0);
1995 f
->display
.x
->border_width
= wininfo
.bdrwidth
;
1996 f
->display
.x
->parent_desc
= parent
;
2000 tem
= x_get_arg (parms
, Qparent_id
, 0, 0, number
);
2001 if (!EQ (tem
, Qunbound
))
2003 CHECK_NUMBER (tem
, 0);
2004 parent
= (Window
) XINT (tem
);
2006 f
->display
.x
->parent_desc
= parent
;
2007 tem
= x_get_arg (parms
, Qheight
, 0, 0, number
);
2008 if (EQ (tem
, Qunbound
))
2010 tem
= x_get_arg (parms
, Qwidth
, 0, 0, number
);
2011 if (EQ (tem
, Qunbound
))
2013 tem
= x_get_arg (parms
, Qtop
, 0, 0, number
);
2014 if (EQ (tem
, Qunbound
))
2015 tem
= x_get_arg (parms
, Qleft
, 0, 0, number
);
2018 /* Now TEM is Qunbound if no edge or size was specified.
2019 In that case, we must do rubber-banding. */
2020 if (EQ (tem
, Qunbound
))
2022 tem
= x_get_arg (parms
, Qgeometry
, 0, 0, number
);
2024 &f
->display
.x
->left_pos
, &f
->display
.x
->top_pos
,
2026 (XTYPE (tem
) == Lisp_String
2027 ? (char *) XSTRING (tem
)->data
: ""),
2028 XSTRING (f
->name
)->data
,
2029 !NILP (hscroll
), !NILP (vscroll
));
2033 /* Here if at least one edge or size was specified.
2034 Demand that they all were specified, and use them. */
2035 tem
= x_get_arg (parms
, Qheight
, 0, 0, number
);
2036 if (EQ (tem
, Qunbound
))
2037 error ("Height not specified");
2038 CHECK_NUMBER (tem
, 0);
2039 height
= XINT (tem
);
2041 tem
= x_get_arg (parms
, Qwidth
, 0, 0, number
);
2042 if (EQ (tem
, Qunbound
))
2043 error ("Width not specified");
2044 CHECK_NUMBER (tem
, 0);
2047 tem
= x_get_arg (parms
, Qtop
, 0, 0, number
);
2048 if (EQ (tem
, Qunbound
))
2049 error ("Top position not specified");
2050 CHECK_NUMBER (tem
, 0);
2051 f
->display
.x
->left_pos
= XINT (tem
);
2053 tem
= x_get_arg (parms
, Qleft
, 0, 0, number
);
2054 if (EQ (tem
, Qunbound
))
2055 error ("Left position not specified");
2056 CHECK_NUMBER (tem
, 0);
2057 f
->display
.x
->top_pos
= XINT (tem
);
2060 pixelwidth
= CHAR_TO_PIXEL_WIDTH (f
, width
);
2061 pixelheight
= CHAR_TO_PIXEL_HEIGHT (f
, height
);
2065 = XCreateWindow (parent
,
2066 f
->display
.x
->left_pos
, /* Absolute horizontal offset */
2067 f
->display
.x
->top_pos
, /* Absolute Vertical offset */
2068 pixelwidth
, pixelheight
,
2069 f
->display
.x
->border_width
,
2070 BLACK_PIX_DEFAULT
, WHITE_PIX_DEFAULT
);
2072 if (FRAME_X_WINDOW (f
) == 0)
2073 error ("Unable to create window.");
2076 /* Install the now determined height and width
2077 in the windows and in phys_lines and desired_lines. */
2078 change_frame_size (f
, height
, width
, 1, 0);
2079 XSelectInput (FRAME_X_WINDOW (f
), KeyPressed
| ExposeWindow
2080 | ButtonPressed
| ButtonReleased
| ExposeRegion
| ExposeCopy
2081 | EnterWindow
| LeaveWindow
| UnmapWindow
);
2082 x_set_resize_hint (f
);
2084 /* Tell the server the window's default name. */
2085 XStoreName (XDISPLAY
FRAME_X_WINDOW (f
), XSTRING (f
->name
)->data
);
2087 /* Now override the defaults with all the rest of the specified
2089 tem
= x_get_arg (parms
, Qunsplittable
, 0, 0, boolean
);
2090 f
->no_split
= minibuffer_only
|| EQ (tem
, Qt
);
2092 /* Do not create an icon window if the caller says not to */
2093 if (!EQ (x_get_arg (parms
, Qsuppress_icon
, 0, 0, boolean
), Qt
)
2094 || f
->display
.x
->parent_desc
!= ROOT_WINDOW
)
2096 x_text_icon (f
, iconidentity
);
2097 x_default_parameter (f
, parms
, Qicon_type
, Qnil
,
2098 "BitmapIcon", 0, symbol
);
2101 /* Tell the X server the previously set values of the
2102 background, border and mouse colors; also create the mouse cursor. */
2104 temp
= XMakeTile (f
->display
.x
->background_pixel
);
2105 XChangeBackground (FRAME_X_WINDOW (f
), temp
);
2108 x_set_border_pixel (f
, f
->display
.x
->border_pixel
);
2110 x_set_mouse_color (f
, Qnil
, Qnil
);
2112 /* Now override the defaults with all the rest of the specified parms. */
2114 Fmodify_frame_parameters (frame
, parms
);
2116 /* Make the window appear on the frame and enable display. */
2118 Lisp_Object visibility
= x_get_arg (parms
, Qvisibility
, 0, 0, symbol
);
2120 if (EQ (visibility
, Qunbound
))
2123 if (! EQ (visibility
, Qicon
)
2124 && ! NILP (visibility
))
2125 x_make_window_visible (f
);
2128 SET_FRAME_GARBAGED (f
);
2134 DEFUN ("focus-frame", Ffocus_frame
, Sfocus_frame
, 1, 1, 0,
2135 "Set the focus on FRAME.")
2139 CHECK_LIVE_FRAME (frame
, 0);
2141 if (FRAME_X_P (XFRAME (frame
)))
2144 x_focus_on_frame (XFRAME (frame
));
2152 DEFUN ("unfocus-frame", Funfocus_frame
, Sunfocus_frame
, 0, 0, 0,
2153 "If a frame has been focused, release it.")
2159 x_unfocus_frame (x_focus_frame
);
2167 /* Computes an X-window size and position either from geometry GEO
2170 F is a frame. It specifies an X window which is used to
2171 determine which display to compute for. Its font, borders
2172 and colors control how the rectangle will be displayed.
2174 X and Y are where to store the positions chosen.
2175 WIDTH and HEIGHT are where to store the sizes chosen.
2177 GEO is the geometry that may specify some of the info.
2178 STR is a prompt to display.
2179 HSCROLL and VSCROLL say whether we have horiz and vert scroll bars. */
2182 x_rubber_band (f
, x
, y
, width
, height
, geo
, str
, hscroll
, vscroll
)
2184 int *x
, *y
, *width
, *height
;
2187 int hscroll
, vscroll
;
2193 int background_color
;
2199 background_color
= f
->display
.x
->background_pixel
;
2200 border_color
= f
->display
.x
->border_pixel
;
2202 frame
.bdrwidth
= f
->display
.x
->border_width
;
2203 frame
.border
= XMakeTile (border_color
);
2204 frame
.background
= XMakeTile (background_color
);
2205 tempwindow
= XCreateTerm (str
, "emacs", geo
, default_window
, &frame
, 10, 5,
2206 (2 * f
->display
.x
->internal_border_width
2207 + (vscroll
? VSCROLL_WIDTH
: 0)),
2208 (2 * f
->display
.x
->internal_border_width
2209 + (hscroll
? HSCROLL_HEIGHT
: 0)),
2210 width
, height
, f
->display
.x
->font
,
2211 FONT_WIDTH (f
->display
.x
->font
),
2212 FONT_HEIGHT (f
->display
.x
->font
));
2213 XFreePixmap (frame
.border
);
2214 XFreePixmap (frame
.background
);
2216 if (tempwindow
!= 0)
2218 XQueryWindow (tempwindow
, &wininfo
);
2219 XDestroyWindow (tempwindow
);
2224 /* Coordinates we got are relative to the root window.
2225 Convert them to coordinates relative to desired parent window
2226 by scanning from there up to the root. */
2227 tempwindow
= f
->display
.x
->parent_desc
;
2228 while (tempwindow
!= ROOT_WINDOW
)
2232 XQueryWindow (tempwindow
, &wininfo
);
2235 XQueryTree (tempwindow
, &tempwindow
, &nchildren
, &children
);
2240 return tempwindow
!= 0;
2242 #endif /* not HAVE_X11 */
2244 DEFUN ("x-list-fonts", Fx_list_fonts
, Sx_list_fonts
, 1, 3, 0,
2245 "Return a list of the names of available fonts matching PATTERN.\n\
2246 If optional arguments FACE and FRAME are specified, return only fonts\n\
2247 the same size as FACE on FRAME.\n\
2249 PATTERN is a string, perhaps with wildcard characters;\n\
2250 the * character matches any substring, and\n\
2251 the ? character matches any single character.\n\
2252 PATTERN is case-insensitive.\n\
2253 FACE is a face name - a symbol.\n\
2255 The return value is a list of strings, suitable as arguments to\n\
2258 The list does not include fonts Emacs can't use (i.e. proportional\n\
2259 fonts), even if they match PATTERN and FACE.")
2260 (pattern
, face
, frame
)
2261 Lisp_Object pattern
, face
, frame
;
2266 XFontStruct
*size_ref
;
2269 CHECK_STRING (pattern
, 0);
2271 CHECK_SYMBOL (face
, 1);
2273 CHECK_LIVE_FRAME (frame
, 2);
2279 FRAME_PTR f
= NILP (frame
) ? selected_frame
: XFRAME (frame
);
2280 int face_id
= face_name_id_number (f
, face
);
2282 if (face_id
< 0 || face_id
>= FRAME_N_PARAM_FACES (f
)
2283 || FRAME_PARAM_FACES (f
) [face_id
] == 0)
2284 size_ref
= f
->display
.x
->font
;
2287 size_ref
= FRAME_PARAM_FACES (f
) [face_id
]->font
;
2288 if (size_ref
== (XFontStruct
*) (~0))
2289 size_ref
= f
->display
.x
->font
;
2294 names
= XListFontsWithInfo (x_current_display
,
2295 XSTRING (pattern
)->data
,
2296 2000, /* maxnames */
2297 &num_fonts
, /* count_return */
2298 &info
); /* info_return */
2309 for (i
= 0; i
< num_fonts
; i
++)
2311 || same_size_fonts (&info
[i
], size_ref
))
2313 *tail
= Fcons (build_string (names
[i
]), Qnil
);
2314 tail
= &XCONS (*tail
)->cdr
;
2317 XFreeFontInfo (names
, info
, num_fonts
);
2324 DEFUN ("x-color-defined-p", Fx_color_defined_p
, Sx_color_defined_p
, 1, 1, 0,
2325 "Return t if the current X display supports the color named COLOR.")
2332 CHECK_STRING (color
, 0);
2334 if (defined_color (XSTRING (color
)->data
, &foo
))
2340 DEFUN ("x-display-color-p", Fx_display_color_p
, Sx_display_color_p
, 0, 0, 0,
2341 "Return t if the X screen currently in use supports color.")
2346 if (x_screen_planes
<= 2)
2349 switch (screen_visual
->class)
2362 DEFUN ("x-display-pixel-width", Fx_display_pixel_width
, Sx_display_pixel_width
,
2364 "Returns the width in pixels of the display FRAME is on.")
2368 Display
*dpy
= x_current_display
;
2370 return make_number (DisplayWidth (dpy
, DefaultScreen (dpy
)));
2373 DEFUN ("x-display-pixel-height", Fx_display_pixel_height
,
2374 Sx_display_pixel_height
, 0, 1, 0,
2375 "Returns the height in pixels of the display FRAME is on.")
2379 Display
*dpy
= x_current_display
;
2381 return make_number (DisplayHeight (dpy
, DefaultScreen (dpy
)));
2384 DEFUN ("x-display-planes", Fx_display_planes
, Sx_display_planes
,
2386 "Returns the number of bitplanes of the display FRAME is on.")
2390 Display
*dpy
= x_current_display
;
2392 return make_number (DisplayPlanes (dpy
, DefaultScreen (dpy
)));
2395 DEFUN ("x-display-color-cells", Fx_display_color_cells
, Sx_display_color_cells
,
2397 "Returns the number of color cells of the display FRAME is on.")
2401 Display
*dpy
= x_current_display
;
2403 return make_number (DisplayCells (dpy
, DefaultScreen (dpy
)));
2406 DEFUN ("x-server-max-request-size", Fx_server_max_request_size
,
2407 Sx_server_max_request_size
,
2409 "Returns the maximum request size of the X server FRAME is using.")
2413 Display
*dpy
= x_current_display
;
2415 return make_number (MAXREQUEST (dpy
));
2418 DEFUN ("x-server-vendor", Fx_server_vendor
, Sx_server_vendor
, 0, 1, 0,
2419 "Returns the vendor ID string of the X server FRAME is on.")
2423 Display
*dpy
= x_current_display
;
2426 vendor
= ServerVendor (dpy
);
2427 if (! vendor
) vendor
= "";
2428 return build_string (vendor
);
2431 DEFUN ("x-server-version", Fx_server_version
, Sx_server_version
, 0, 1, 0,
2432 "Returns the version numbers of the X server in use.\n\
2433 The value is a list of three integers: the major and minor\n\
2434 version numbers of the X Protocol in use, and the vendor-specific release\n\
2435 number. See also the variable `x-server-vendor'.")
2439 Display
*dpy
= x_current_display
;
2442 return Fcons (make_number (ProtocolVersion (dpy
)),
2443 Fcons (make_number (ProtocolRevision (dpy
)),
2444 Fcons (make_number (VendorRelease (dpy
)), Qnil
)));
2447 DEFUN ("x-display-screens", Fx_display_screens
, Sx_display_screens
, 0, 1, 0,
2448 "Returns the number of screens on the X server FRAME is on.")
2453 return make_number (ScreenCount (x_current_display
));
2456 DEFUN ("x-display-mm-height", Fx_display_mm_height
, Sx_display_mm_height
, 0, 1, 0,
2457 "Returns the height in millimeters of the X screen FRAME is on.")
2462 return make_number (HeightMMOfScreen (x_screen
));
2465 DEFUN ("x-display-mm-width", Fx_display_mm_width
, Sx_display_mm_width
, 0, 1, 0,
2466 "Returns the width in millimeters of the X screen FRAME is on.")
2471 return make_number (WidthMMOfScreen (x_screen
));
2474 DEFUN ("x-display-backing-store", Fx_display_backing_store
,
2475 Sx_display_backing_store
, 0, 1, 0,
2476 "Returns an indication of whether the X screen FRAME is on does backing store.\n\
2477 The value may be `always', `when-mapped', or `not-useful'.")
2483 switch (DoesBackingStore (x_screen
))
2486 return intern ("always");
2489 return intern ("when-mapped");
2492 return intern ("not-useful");
2495 error ("Strange value for BackingStore parameter of screen");
2499 DEFUN ("x-display-visual-class", Fx_display_visual_class
,
2500 Sx_display_visual_class
, 0, 1, 0,
2501 "Returns the visual class of the display `screen' is on.\n\
2502 The value is one of the symbols `static-gray', `gray-scale',\n\
2503 `static-color', `pseudo-color', `true-color', or `direct-color'.")
2509 switch (screen_visual
->class)
2511 case StaticGray
: return (intern ("static-gray"));
2512 case GrayScale
: return (intern ("gray-scale"));
2513 case StaticColor
: return (intern ("static-color"));
2514 case PseudoColor
: return (intern ("pseudo-color"));
2515 case TrueColor
: return (intern ("true-color"));
2516 case DirectColor
: return (intern ("direct-color"));
2518 error ("Display has an unknown visual class");
2522 DEFUN ("x-display-save-under", Fx_display_save_under
,
2523 Sx_display_save_under
, 0, 1, 0,
2524 "Returns t if the X screen FRAME is on supports the save-under feature.")
2530 if (DoesSaveUnders (x_screen
) == True
)
2537 register struct frame
*f
;
2539 return PIXEL_WIDTH (f
);
2543 register struct frame
*f
;
2545 return PIXEL_HEIGHT (f
);
2549 register struct frame
*f
;
2551 return FONT_WIDTH (f
->display
.x
->font
);
2555 register struct frame
*f
;
2557 return FONT_HEIGHT (f
->display
.x
->font
);
2560 #if 0 /* These no longer seem like the right way to do things. */
2562 /* Draw a rectangle on the frame with left top corner including
2563 the character specified by LEFT_CHAR and TOP_CHAR. The rectangle is
2564 CHARS by LINES wide and long and is the color of the cursor. */
2567 x_rectangle (f
, gc
, left_char
, top_char
, chars
, lines
)
2568 register struct frame
*f
;
2570 register int top_char
, left_char
, chars
, lines
;
2574 int left
= (left_char
* FONT_WIDTH (f
->display
.x
->font
)
2575 + f
->display
.x
->internal_border_width
);
2576 int top
= (top_char
* FONT_HEIGHT (f
->display
.x
->font
)
2577 + f
->display
.x
->internal_border_width
);
2580 width
= FONT_WIDTH (f
->display
.x
->font
) / 2;
2582 width
= FONT_WIDTH (f
->display
.x
->font
) * chars
;
2584 height
= FONT_HEIGHT (f
->display
.x
->font
) / 2;
2586 height
= FONT_HEIGHT (f
->display
.x
->font
) * lines
;
2588 XDrawRectangle (x_current_display
, FRAME_X_WINDOW (f
),
2589 gc
, left
, top
, width
, height
);
2592 DEFUN ("x-draw-rectangle", Fx_draw_rectangle
, Sx_draw_rectangle
, 5, 5, 0,
2593 "Draw a rectangle on FRAME between coordinates specified by\n\
2594 numbers X0, Y0, X1, Y1 in the cursor pixel.")
2595 (frame
, X0
, Y0
, X1
, Y1
)
2596 register Lisp_Object frame
, X0
, X1
, Y0
, Y1
;
2598 register int x0
, y0
, x1
, y1
, top
, left
, n_chars
, n_lines
;
2600 CHECK_LIVE_FRAME (frame
, 0);
2601 CHECK_NUMBER (X0
, 0);
2602 CHECK_NUMBER (Y0
, 1);
2603 CHECK_NUMBER (X1
, 2);
2604 CHECK_NUMBER (Y1
, 3);
2614 n_lines
= y1
- y0
+ 1;
2619 n_lines
= y0
- y1
+ 1;
2625 n_chars
= x1
- x0
+ 1;
2630 n_chars
= x0
- x1
+ 1;
2634 x_rectangle (XFRAME (frame
), XFRAME (frame
)->display
.x
->cursor_gc
,
2635 left
, top
, n_chars
, n_lines
);
2641 DEFUN ("x-erase-rectangle", Fx_erase_rectangle
, Sx_erase_rectangle
, 5, 5, 0,
2642 "Draw a rectangle drawn on FRAME between coordinates\n\
2643 X0, Y0, X1, Y1 in the regular background-pixel.")
2644 (frame
, X0
, Y0
, X1
, Y1
)
2645 register Lisp_Object frame
, X0
, Y0
, X1
, Y1
;
2647 register int x0
, y0
, x1
, y1
, top
, left
, n_chars
, n_lines
;
2649 CHECK_FRAME (frame
, 0);
2650 CHECK_NUMBER (X0
, 0);
2651 CHECK_NUMBER (Y0
, 1);
2652 CHECK_NUMBER (X1
, 2);
2653 CHECK_NUMBER (Y1
, 3);
2663 n_lines
= y1
- y0
+ 1;
2668 n_lines
= y0
- y1
+ 1;
2674 n_chars
= x1
- x0
+ 1;
2679 n_chars
= x0
- x1
+ 1;
2683 x_rectangle (XFRAME (frame
), XFRAME (frame
)->display
.x
->reverse_gc
,
2684 left
, top
, n_chars
, n_lines
);
2690 /* Draw lines around the text region beginning at the character position
2691 TOP_X, TOP_Y and ending at BOTTOM_X and BOTTOM_Y. GC specifies the
2692 pixel and line characteristics. */
2694 #define line_len(line) (FRAME_CURRENT_GLYPHS (f)->used[(line)])
2697 outline_region (f
, gc
, top_x
, top_y
, bottom_x
, bottom_y
)
2698 register struct frame
*f
;
2700 int top_x
, top_y
, bottom_x
, bottom_y
;
2702 register int ibw
= f
->display
.x
->internal_border_width
;
2703 register int font_w
= FONT_WIDTH (f
->display
.x
->font
);
2704 register int font_h
= FONT_HEIGHT (f
->display
.x
->font
);
2706 int x
= line_len (y
);
2707 XPoint
*pixel_points
= (XPoint
*)
2708 alloca (((bottom_y
- top_y
+ 2) * 4) * sizeof (XPoint
));
2709 register XPoint
*this_point
= pixel_points
;
2711 /* Do the horizontal top line/lines */
2714 this_point
->x
= ibw
;
2715 this_point
->y
= ibw
+ (font_h
* top_y
);
2718 this_point
->x
= ibw
+ (font_w
/ 2); /* Half-size for newline chars. */
2720 this_point
->x
= ibw
+ (font_w
* x
);
2721 this_point
->y
= (this_point
- 1)->y
;
2725 this_point
->x
= ibw
;
2726 this_point
->y
= ibw
+ (font_h
* (top_y
+ 1));
2728 this_point
->x
= ibw
+ (font_w
* top_x
);
2729 this_point
->y
= (this_point
- 1)->y
;
2731 this_point
->x
= (this_point
- 1)->x
;
2732 this_point
->y
= ibw
+ (font_h
* top_y
);
2734 this_point
->x
= ibw
+ (font_w
* x
);
2735 this_point
->y
= (this_point
- 1)->y
;
2738 /* Now do the right side. */
2739 while (y
< bottom_y
)
2740 { /* Right vertical edge */
2742 this_point
->x
= (this_point
- 1)->x
;
2743 this_point
->y
= ibw
+ (font_h
* (y
+ 1));
2746 y
++; /* Horizontal connection to next line */
2749 this_point
->x
= ibw
+ (font_w
/ 2);
2751 this_point
->x
= ibw
+ (font_w
* x
);
2753 this_point
->y
= (this_point
- 1)->y
;
2756 /* Now do the bottom and connect to the top left point. */
2757 this_point
->x
= ibw
+ (font_w
* (bottom_x
+ 1));
2760 this_point
->x
= (this_point
- 1)->x
;
2761 this_point
->y
= ibw
+ (font_h
* (bottom_y
+ 1));
2763 this_point
->x
= ibw
;
2764 this_point
->y
= (this_point
- 1)->y
;
2766 this_point
->x
= pixel_points
->x
;
2767 this_point
->y
= pixel_points
->y
;
2769 XDrawLines (x_current_display
, FRAME_X_WINDOW (f
),
2771 (this_point
- pixel_points
+ 1), CoordModeOrigin
);
2774 DEFUN ("x-contour-region", Fx_contour_region
, Sx_contour_region
, 1, 1, 0,
2775 "Highlight the region between point and the character under the mouse\n\
2778 register Lisp_Object event
;
2780 register int x0
, y0
, x1
, y1
;
2781 register struct frame
*f
= selected_frame
;
2782 register int p1
, p2
;
2784 CHECK_CONS (event
, 0);
2787 x0
= XINT (Fcar (Fcar (event
)));
2788 y0
= XINT (Fcar (Fcdr (Fcar (event
))));
2790 /* If the mouse is past the end of the line, don't that area. */
2791 /* ReWrite this... */
2796 if (y1
> y0
) /* point below mouse */
2797 outline_region (f
, f
->display
.x
->cursor_gc
,
2799 else if (y1
< y0
) /* point above mouse */
2800 outline_region (f
, f
->display
.x
->cursor_gc
,
2802 else /* same line: draw horizontal rectangle */
2805 x_rectangle (f
, f
->display
.x
->cursor_gc
,
2806 x0
, y0
, (x1
- x0
+ 1), 1);
2808 x_rectangle (f
, f
->display
.x
->cursor_gc
,
2809 x1
, y1
, (x0
- x1
+ 1), 1);
2812 XFlush (x_current_display
);
2818 DEFUN ("x-uncontour-region", Fx_uncontour_region
, Sx_uncontour_region
, 1, 1, 0,
2819 "Erase any highlighting of the region between point and the character\n\
2820 at X, Y on the selected frame.")
2822 register Lisp_Object event
;
2824 register int x0
, y0
, x1
, y1
;
2825 register struct frame
*f
= selected_frame
;
2828 x0
= XINT (Fcar (Fcar (event
)));
2829 y0
= XINT (Fcar (Fcdr (Fcar (event
))));
2833 if (y1
> y0
) /* point below mouse */
2834 outline_region (f
, f
->display
.x
->reverse_gc
,
2836 else if (y1
< y0
) /* point above mouse */
2837 outline_region (f
, f
->display
.x
->reverse_gc
,
2839 else /* same line: draw horizontal rectangle */
2842 x_rectangle (f
, f
->display
.x
->reverse_gc
,
2843 x0
, y0
, (x1
- x0
+ 1), 1);
2845 x_rectangle (f
, f
->display
.x
->reverse_gc
,
2846 x1
, y1
, (x0
- x1
+ 1), 1);
2854 int contour_begin_x
, contour_begin_y
;
2855 int contour_end_x
, contour_end_y
;
2856 int contour_npoints
;
2858 /* Clip the top part of the contour lines down (and including) line Y_POS.
2859 If X_POS is in the middle (rather than at the end) of the line, drop
2860 down a line at that character. */
2863 clip_contour_top (y_pos
, x_pos
)
2865 register XPoint
*begin
= contour_lines
[y_pos
].top_left
;
2866 register XPoint
*end
;
2867 register int npoints
;
2868 register struct display_line
*line
= selected_frame
->phys_lines
[y_pos
+ 1];
2870 if (x_pos
>= line
->len
- 1) /* Draw one, straight horizontal line. */
2872 end
= contour_lines
[y_pos
].top_right
;
2873 npoints
= (end
- begin
+ 1);
2874 XDrawLines (x_current_display
, contour_window
,
2875 contour_erase_gc
, begin_erase
, npoints
, CoordModeOrigin
);
2877 bcopy (end
, begin
+ 1, contour_last_point
- end
+ 1);
2878 contour_last_point
-= (npoints
- 2);
2879 XDrawLines (x_current_display
, contour_window
,
2880 contour_erase_gc
, begin
, 2, CoordModeOrigin
);
2881 XFlush (x_current_display
);
2883 /* Now, update contour_lines structure. */
2888 register XPoint
*p
= begin
+ 1;
2889 end
= contour_lines
[y_pos
].bottom_right
;
2890 npoints
= (end
- begin
+ 1);
2891 XDrawLines (x_current_display
, contour_window
,
2892 contour_erase_gc
, begin_erase
, npoints
, CoordModeOrigin
);
2895 p
->x
= ibw
+ (font_w
* (x_pos
+ 1));
2897 p
->y
= begin
->y
+ font_h
;
2899 bcopy (end
, begin
+ 3, contour_last_point
- end
+ 1);
2900 contour_last_point
-= (npoints
- 5);
2901 XDrawLines (x_current_display
, contour_window
,
2902 contour_erase_gc
, begin
, 4, CoordModeOrigin
);
2903 XFlush (x_current_display
);
2905 /* Now, update contour_lines structure. */
2909 /* Erase the top horizontal lines of the contour, and then extend
2910 the contour upwards. */
2913 extend_contour_top (line
)
2918 clip_contour_bottom (x_pos
, y_pos
)
2924 extend_contour_bottom (x_pos
, y_pos
)
2928 DEFUN ("x-select-region", Fx_select_region
, Sx_select_region
, 1, 1, "e",
2933 register struct frame
*f
= selected_frame
;
2934 register int point_x
= f
->cursor_x
;
2935 register int point_y
= f
->cursor_y
;
2936 register int mouse_below_point
;
2937 register Lisp_Object obj
;
2938 register int x_contour_x
, x_contour_y
;
2940 x_contour_x
= x_mouse_x
;
2941 x_contour_y
= x_mouse_y
;
2942 if (x_contour_y
> point_y
|| (x_contour_y
== point_y
2943 && x_contour_x
> point_x
))
2945 mouse_below_point
= 1;
2946 outline_region (f
, f
->display
.x
->cursor_gc
, point_x
, point_y
,
2947 x_contour_x
, x_contour_y
);
2951 mouse_below_point
= 0;
2952 outline_region (f
, f
->display
.x
->cursor_gc
, x_contour_x
, x_contour_y
,
2958 obj
= read_char (-1, 0, 0, Qnil
, 0);
2959 if (XTYPE (obj
) != Lisp_Cons
)
2962 if (mouse_below_point
)
2964 if (x_mouse_y
<= point_y
) /* Flipped. */
2966 mouse_below_point
= 0;
2968 outline_region (f
, f
->display
.x
->reverse_gc
, point_x
, point_y
,
2969 x_contour_x
, x_contour_y
);
2970 outline_region (f
, f
->display
.x
->cursor_gc
, x_mouse_x
, x_mouse_y
,
2973 else if (x_mouse_y
< x_contour_y
) /* Bottom clipped. */
2975 clip_contour_bottom (x_mouse_y
);
2977 else if (x_mouse_y
> x_contour_y
) /* Bottom extended. */
2979 extend_bottom_contour (x_mouse_y
);
2982 x_contour_x
= x_mouse_x
;
2983 x_contour_y
= x_mouse_y
;
2985 else /* mouse above or same line as point */
2987 if (x_mouse_y
>= point_y
) /* Flipped. */
2989 mouse_below_point
= 1;
2991 outline_region (f
, f
->display
.x
->reverse_gc
,
2992 x_contour_x
, x_contour_y
, point_x
, point_y
);
2993 outline_region (f
, f
->display
.x
->cursor_gc
, point_x
, point_y
,
2994 x_mouse_x
, x_mouse_y
);
2996 else if (x_mouse_y
> x_contour_y
) /* Top clipped. */
2998 clip_contour_top (x_mouse_y
);
3000 else if (x_mouse_y
< x_contour_y
) /* Top extended. */
3002 extend_contour_top (x_mouse_y
);
3007 unread_command_event
= obj
;
3008 if (mouse_below_point
)
3010 contour_begin_x
= point_x
;
3011 contour_begin_y
= point_y
;
3012 contour_end_x
= x_contour_x
;
3013 contour_end_y
= x_contour_y
;
3017 contour_begin_x
= x_contour_x
;
3018 contour_begin_y
= x_contour_y
;
3019 contour_end_x
= point_x
;
3020 contour_end_y
= point_y
;
3025 DEFUN ("x-horizontal-line", Fx_horizontal_line
, Sx_horizontal_line
, 1, 1, "e",
3030 register Lisp_Object obj
;
3031 struct frame
*f
= selected_frame
;
3032 register struct window
*w
= XWINDOW (selected_window
);
3033 register GC line_gc
= f
->display
.x
->cursor_gc
;
3034 register GC erase_gc
= f
->display
.x
->reverse_gc
;
3036 char dash_list
[] = {6, 4, 6, 4};
3038 XGCValues gc_values
;
3040 register int previous_y
;
3041 register int line
= (x_mouse_y
+ 1) * FONT_HEIGHT (f
->display
.x
->font
)
3042 + f
->display
.x
->internal_border_width
;
3043 register int left
= f
->display
.x
->internal_border_width
3045 * FONT_WIDTH (f
->display
.x
->font
));
3046 register int right
= left
+ (w
->width
3047 * FONT_WIDTH (f
->display
.x
->font
))
3048 - f
->display
.x
->internal_border_width
;
3052 gc_values
.foreground
= f
->display
.x
->cursor_pixel
;
3053 gc_values
.background
= f
->display
.x
->background_pixel
;
3054 gc_values
.line_width
= 1;
3055 gc_values
.line_style
= LineOnOffDash
;
3056 gc_values
.cap_style
= CapRound
;
3057 gc_values
.join_style
= JoinRound
;
3059 line_gc
= XCreateGC (x_current_display
, FRAME_X_WINDOW (f
),
3060 GCLineStyle
| GCJoinStyle
| GCCapStyle
3061 | GCLineWidth
| GCForeground
| GCBackground
,
3063 XSetDashes (x_current_display
, line_gc
, 0, dash_list
, dashes
);
3064 gc_values
.foreground
= f
->display
.x
->background_pixel
;
3065 gc_values
.background
= f
->display
.x
->foreground_pixel
;
3066 erase_gc
= XCreateGC (x_current_display
, FRAME_X_WINDOW (f
),
3067 GCLineStyle
| GCJoinStyle
| GCCapStyle
3068 | GCLineWidth
| GCForeground
| GCBackground
,
3070 XSetDashes (x_current_display
, erase_gc
, 0, dash_list
, dashes
);
3076 if (x_mouse_y
>= XINT (w
->top
)
3077 && x_mouse_y
< XINT (w
->top
) + XINT (w
->height
) - 1)
3079 previous_y
= x_mouse_y
;
3080 line
= (x_mouse_y
+ 1) * FONT_HEIGHT (f
->display
.x
->font
)
3081 + f
->display
.x
->internal_border_width
;
3082 XDrawLine (x_current_display
, FRAME_X_WINDOW (f
),
3083 line_gc
, left
, line
, right
, line
);
3090 obj
= read_char (-1, 0, 0, Qnil
, 0);
3091 if ((XTYPE (obj
) != Lisp_Cons
)
3092 || (! EQ (Fcar (Fcdr (Fcdr (obj
))),
3093 Qvertical_scroll_bar
))
3097 XDrawLine (x_current_display
, FRAME_X_WINDOW (f
),
3098 erase_gc
, left
, line
, right
, line
);
3100 unread_command_event
= obj
;
3102 XFreeGC (x_current_display
, line_gc
);
3103 XFreeGC (x_current_display
, erase_gc
);
3108 while (x_mouse_y
== previous_y
);
3111 XDrawLine (x_current_display
, FRAME_X_WINDOW (f
),
3112 erase_gc
, left
, line
, right
, line
);
3118 /* Offset in buffer of character under the pointer, or 0. */
3119 int mouse_buffer_offset
;
3122 /* These keep track of the rectangle following the pointer. */
3123 int mouse_track_top
, mouse_track_left
, mouse_track_width
;
3125 DEFUN ("x-track-pointer", Fx_track_pointer
, Sx_track_pointer
, 0, 0, 0,
3126 "Track the pointer.")
3129 static Cursor current_pointer_shape
;
3130 FRAME_PTR f
= x_mouse_frame
;
3133 if (EQ (Vmouse_frame_part
, Qtext_part
)
3134 && (current_pointer_shape
!= f
->display
.x
->nontext_cursor
))
3139 current_pointer_shape
= f
->display
.x
->nontext_cursor
;
3140 XDefineCursor (x_current_display
,
3142 current_pointer_shape
);
3144 buf
= XBUFFER (XWINDOW (Vmouse_window
)->buffer
);
3145 c
= *(BUF_CHAR_ADDRESS (buf
, mouse_buffer_offset
));
3147 else if (EQ (Vmouse_frame_part
, Qmodeline_part
)
3148 && (current_pointer_shape
!= f
->display
.x
->modeline_cursor
))
3150 current_pointer_shape
= f
->display
.x
->modeline_cursor
;
3151 XDefineCursor (x_current_display
,
3153 current_pointer_shape
);
3162 DEFUN ("x-track-pointer", Fx_track_pointer
, Sx_track_pointer
, 1, 1, "e",
3163 "Draw rectangle around character under mouse pointer, if there is one.")
3167 struct window
*w
= XWINDOW (Vmouse_window
);
3168 struct frame
*f
= XFRAME (WINDOW_FRAME (w
));
3169 struct buffer
*b
= XBUFFER (w
->buffer
);
3172 if (! EQ (Vmouse_window
, selected_window
))
3175 if (EQ (event
, Qnil
))
3179 x_read_mouse_position (selected_frame
, &x
, &y
);
3183 mouse_track_width
= 0;
3184 mouse_track_left
= mouse_track_top
= -1;
3188 if ((x_mouse_x
!= mouse_track_left
3189 && (x_mouse_x
< mouse_track_left
3190 || x_mouse_x
> (mouse_track_left
+ mouse_track_width
)))
3191 || x_mouse_y
!= mouse_track_top
)
3193 int hp
= 0; /* Horizontal position */
3194 int len
= FRAME_CURRENT_GLYPHS (f
)->used
[x_mouse_y
];
3195 int p
= FRAME_CURRENT_GLYPHS (f
)->bufp
[x_mouse_y
];
3196 int tab_width
= XINT (b
->tab_width
);
3197 int ctl_arrow_p
= !NILP (b
->ctl_arrow
);
3199 int mode_line_vpos
= XFASTINT (w
->height
) + XFASTINT (w
->top
) - 1;
3200 int in_mode_line
= 0;
3202 if (! FRAME_CURRENT_GLYPHS (f
)->enable
[x_mouse_y
])
3205 /* Erase previous rectangle. */
3206 if (mouse_track_width
)
3208 x_rectangle (f
, f
->display
.x
->reverse_gc
,
3209 mouse_track_left
, mouse_track_top
,
3210 mouse_track_width
, 1);
3212 if ((mouse_track_left
== f
->phys_cursor_x
3213 || mouse_track_left
== f
->phys_cursor_x
- 1)
3214 && mouse_track_top
== f
->phys_cursor_y
)
3216 x_display_cursor (f
, 1);
3220 mouse_track_left
= x_mouse_x
;
3221 mouse_track_top
= x_mouse_y
;
3222 mouse_track_width
= 0;
3224 if (mouse_track_left
> len
) /* Past the end of line. */
3227 if (mouse_track_top
== mode_line_vpos
)
3233 if (tab_width
<= 0 || tab_width
> 20) tab_width
= 8;
3237 if (len
== f
->width
&& hp
== len
- 1 && c
!= '\n')
3243 mouse_track_width
= tab_width
- (hp
% tab_width
);
3245 hp
+= mouse_track_width
;
3248 mouse_track_left
= hp
- mouse_track_width
;
3254 mouse_track_width
= -1;
3258 if (ctl_arrow_p
&& (c
< 040 || c
== 0177))
3263 mouse_track_width
= 2;
3268 mouse_track_left
= hp
- mouse_track_width
;
3274 mouse_track_width
= 1;
3281 while (hp
<= x_mouse_x
);
3284 if (mouse_track_width
) /* Over text; use text pointer shape. */
3286 XDefineCursor (x_current_display
,
3288 f
->display
.x
->text_cursor
);
3289 x_rectangle (f
, f
->display
.x
->cursor_gc
,
3290 mouse_track_left
, mouse_track_top
,
3291 mouse_track_width
, 1);
3293 else if (in_mode_line
)
3294 XDefineCursor (x_current_display
,
3296 f
->display
.x
->modeline_cursor
);
3298 XDefineCursor (x_current_display
,
3300 f
->display
.x
->nontext_cursor
);
3303 XFlush (x_current_display
);
3306 obj
= read_char (-1, 0, 0, Qnil
, 0);
3309 while (XTYPE (obj
) == Lisp_Cons
/* Mouse event */
3310 && EQ (Fcar (Fcdr (Fcdr (obj
))), Qnil
) /* Not scroll bar */
3311 && EQ (Vmouse_depressed
, Qnil
) /* Only motion events */
3312 && EQ (Vmouse_window
, selected_window
) /* In this window */
3315 unread_command_event
= obj
;
3317 if (mouse_track_width
)
3319 x_rectangle (f
, f
->display
.x
->reverse_gc
,
3320 mouse_track_left
, mouse_track_top
,
3321 mouse_track_width
, 1);
3322 mouse_track_width
= 0;
3323 if ((mouse_track_left
== f
->phys_cursor_x
3324 || mouse_track_left
- 1 == f
->phys_cursor_x
)
3325 && mouse_track_top
== f
->phys_cursor_y
)
3327 x_display_cursor (f
, 1);
3330 XDefineCursor (x_current_display
,
3332 f
->display
.x
->nontext_cursor
);
3333 XFlush (x_current_display
);
3343 /* Draw a pixmap specified by IMAGE_DATA of dimensions WIDTH and HEIGHT
3344 on the frame F at position X, Y. */
3346 x_draw_pixmap (f
, x
, y
, image_data
, width
, height
)
3348 int x
, y
, width
, height
;
3353 image
= XCreateBitmapFromData (x_current_display
,
3354 FRAME_X_WINDOW (f
), image_data
,
3356 XCopyPlane (x_current_display
, image
, FRAME_X_WINDOW (f
),
3357 f
->display
.x
->normal_gc
, 0, 0, width
, height
, x
, y
);
3362 DEFUN ("x-store-cut-buffer", Fx_store_cut_buffer
, Sx_store_cut_buffer
,
3363 1, 1, "sStore text in cut buffer: ",
3364 "Store contents of STRING into the cut buffer of the X window system.")
3366 register Lisp_Object string
;
3370 CHECK_STRING (string
, 1);
3371 if (! FRAME_X_P (selected_frame
))
3372 error ("Selected frame does not understand X protocol.");
3375 XStoreBytes ((char *) XSTRING (string
)->data
, XSTRING (string
)->size
);
3381 DEFUN ("x-get-cut-buffer", Fx_get_cut_buffer
, Sx_get_cut_buffer
, 0, 0, 0,
3382 "Return contents of cut buffer of the X window system, as a string.")
3386 register Lisp_Object string
;
3391 d
= XFetchBytes (&len
);
3392 string
= make_string (d
, len
);
3399 #if 0 /* I'm told these functions are superfluous
3400 given the ability to bind function keys. */
3403 DEFUN ("x-rebind-key", Fx_rebind_key
, Sx_rebind_key
, 3, 3, 0,
3404 "Rebind X keysym KEYSYM, with MODIFIERS, to generate NEWSTRING.\n\
3405 KEYSYM is a string which conforms to the X keysym definitions found\n\
3406 in X11/keysymdef.h, sans the initial XK_. MODIFIERS is nil or a\n\
3407 list of strings specifying modifier keys such as Control_L, which must\n\
3408 also be depressed for NEWSTRING to appear.")
3409 (x_keysym
, modifiers
, newstring
)
3410 register Lisp_Object x_keysym
;
3411 register Lisp_Object modifiers
;
3412 register Lisp_Object newstring
;
3415 register KeySym keysym
;
3416 KeySym modifier_list
[16];
3419 CHECK_STRING (x_keysym
, 1);
3420 CHECK_STRING (newstring
, 3);
3422 keysym
= XStringToKeysym ((char *) XSTRING (x_keysym
)->data
);
3423 if (keysym
== NoSymbol
)
3424 error ("Keysym does not exist");
3426 if (NILP (modifiers
))
3427 XRebindKeysym (x_current_display
, keysym
, modifier_list
, 0,
3428 XSTRING (newstring
)->data
, XSTRING (newstring
)->size
);
3431 register Lisp_Object rest
, mod
;
3434 for (rest
= modifiers
; !NILP (rest
); rest
= Fcdr (rest
))
3437 error ("Can't have more than 16 modifiers");
3440 CHECK_STRING (mod
, 3);
3441 modifier_list
[i
] = XStringToKeysym ((char *) XSTRING (mod
)->data
);
3443 if (modifier_list
[i
] == NoSymbol
3444 || !(IsModifierKey (modifier_list
[i
])
3445 || ((unsigned)(modifier_list
[i
]) == XK_Mode_switch
)
3446 || ((unsigned)(modifier_list
[i
]) == XK_Num_Lock
)))
3448 if (modifier_list
[i
] == NoSymbol
3449 || !IsModifierKey (modifier_list
[i
]))
3451 error ("Element is not a modifier keysym");
3455 XRebindKeysym (x_current_display
, keysym
, modifier_list
, i
,
3456 XSTRING (newstring
)->data
, XSTRING (newstring
)->size
);
3462 DEFUN ("x-rebind-keys", Fx_rebind_keys
, Sx_rebind_keys
, 2, 2, 0,
3463 "Rebind KEYCODE to list of strings STRINGS.\n\
3464 STRINGS should be a list of 16 elements, one for each shift combination.\n\
3465 nil as element means don't change.\n\
3466 See the documentation of `x-rebind-key' for more information.")
3468 register Lisp_Object keycode
;
3469 register Lisp_Object strings
;
3471 register Lisp_Object item
;
3472 register unsigned char *rawstring
;
3473 KeySym rawkey
, modifier
[1];
3475 register unsigned i
;
3478 CHECK_NUMBER (keycode
, 1);
3479 CHECK_CONS (strings
, 2);
3480 rawkey
= (KeySym
) ((unsigned) (XINT (keycode
))) & 255;
3481 for (i
= 0; i
<= 15; strings
= Fcdr (strings
), i
++)
3483 item
= Fcar (strings
);
3486 CHECK_STRING (item
, 2);
3487 strsize
= XSTRING (item
)->size
;
3488 rawstring
= (unsigned char *) xmalloc (strsize
);
3489 bcopy (XSTRING (item
)->data
, rawstring
, strsize
);
3490 modifier
[1] = 1 << i
;
3491 XRebindKeysym (x_current_display
, rawkey
, modifier
, 1,
3492 rawstring
, strsize
);
3497 #endif /* HAVE_X11 */
3502 #ifndef HAVE_XSCREENNUMBEROFSCREEN
3504 XScreenNumberOfScreen (scr
)
3505 register Screen
*scr
;
3507 register Display
*dpy
;
3508 register Screen
*dpyscr
;
3512 dpyscr
= dpy
->screens
;
3514 for (i
= 0; i
< dpy
->nscreens
; i
++, dpyscr
++)
3520 #endif /* not HAVE_XSCREENNUMBEROFSCREEN */
3523 select_visual (screen
, depth
)
3525 unsigned int *depth
;
3528 XVisualInfo
*vinfo
, vinfo_template
;
3531 v
= DefaultVisualOfScreen (screen
);
3534 vinfo_template
.visualid
= XVisualIDFromVisual (v
);
3536 vinfo_template
.visualid
= v
->visualid
;
3539 vinfo_template
.screen
= XScreenNumberOfScreen (screen
);
3541 vinfo
= XGetVisualInfo (x_current_display
,
3542 VisualIDMask
| VisualScreenMask
, &vinfo_template
,
3545 fatal ("Can't get proper X visual info");
3547 if ((1 << vinfo
->depth
) == vinfo
->colormap_size
)
3548 *depth
= vinfo
->depth
;
3552 int n
= vinfo
->colormap_size
- 1;
3561 XFree ((char *) vinfo
);
3564 #endif /* HAVE_X11 */
3566 DEFUN ("x-open-connection", Fx_open_connection
, Sx_open_connection
,
3567 1, 2, 0, "Open a connection to an X server.\n\
3568 DISPLAY is the name of the display to connect to.\n\
3569 Optional second arg XRM_STRING is a string of resources in xrdb format.")
3570 (display
, xrm_string
)
3571 Lisp_Object display
, xrm_string
;
3573 unsigned int n_planes
;
3574 unsigned char *xrm_option
;
3576 CHECK_STRING (display
, 0);
3577 if (x_current_display
!= 0)
3578 error ("X server connection is already initialized");
3579 if (! NILP (xrm_string
))
3580 CHECK_STRING (xrm_string
, 1);
3582 /* This is what opens the connection and sets x_current_display.
3583 This also initializes many symbols, such as those used for input. */
3584 x_term_init (XSTRING (display
)->data
);
3587 XFASTINT (Vwindow_system_version
) = 11;
3589 if (! NILP (xrm_string
))
3590 xrm_option
= (unsigned char *) XSTRING (xrm_string
)->data
;
3592 xrm_option
= (unsigned char *) 0;
3594 validate_x_resource_name ();
3597 xrdb
= x_load_resources (x_current_display
, xrm_option
,
3598 (char *) XSTRING (Vx_resource_name
)->data
,
3601 #ifdef HAVE_XRMSETDATABASE
3602 XrmSetDatabase (x_current_display
, xrdb
);
3604 x_current_display
->db
= xrdb
;
3607 x_screen
= DefaultScreenOfDisplay (x_current_display
);
3609 screen_visual
= select_visual (x_screen
, &n_planes
);
3610 x_screen_planes
= n_planes
;
3611 x_screen_height
= HeightOfScreen (x_screen
);
3612 x_screen_width
= WidthOfScreen (x_screen
);
3614 /* X Atoms used by emacs. */
3615 Xatoms_of_xselect ();
3617 Xatom_wm_protocols
= XInternAtom (x_current_display
, "WM_PROTOCOLS",
3619 Xatom_wm_take_focus
= XInternAtom (x_current_display
, "WM_TAKE_FOCUS",
3621 Xatom_wm_save_yourself
= XInternAtom (x_current_display
, "WM_SAVE_YOURSELF",
3623 Xatom_wm_delete_window
= XInternAtom (x_current_display
, "WM_DELETE_WINDOW",
3625 Xatom_wm_change_state
= XInternAtom (x_current_display
, "WM_CHANGE_STATE",
3627 Xatom_wm_configure_denied
= XInternAtom (x_current_display
,
3628 "WM_CONFIGURE_DENIED", False
);
3629 Xatom_wm_window_moved
= XInternAtom (x_current_display
, "WM_MOVED",
3632 #else /* not HAVE_X11 */
3633 XFASTINT (Vwindow_system_version
) = 10;
3634 #endif /* not HAVE_X11 */
3638 DEFUN ("x-close-current-connection", Fx_close_current_connection
,
3639 Sx_close_current_connection
,
3640 0, 0, 0, "Close the connection to the current X server.")
3644 /* This is ONLY used when killing emacs; For switching displays
3645 we'll have to take care of setting CloseDownMode elsewhere. */
3647 if (x_current_display
)
3650 XSetCloseDownMode (x_current_display
, DestroyAll
);
3651 XCloseDisplay (x_current_display
);
3652 x_current_display
= 0;
3655 fatal ("No current X display connection to close\n");
3660 DEFUN ("x-synchronize", Fx_synchronize
, Sx_synchronize
,
3661 1, 1, 0, "If ON is non-nil, report X errors as soon as the erring request is made.\n\
3662 If ON is nil, allow buffering of requests.\n\
3663 Turning on synchronization prohibits the Xlib routines from buffering\n\
3664 requests and seriously degrades performance, but makes debugging much\n\
3671 XSynchronize (x_current_display
, !EQ (on
, Qnil
));
3679 /* This is zero if not using X windows. */
3680 x_current_display
= 0;
3682 /* The section below is built by the lisp expression at the top of the file,
3683 just above where these variables are declared. */
3684 /*&&& init symbols here &&&*/
3685 Qauto_raise
= intern ("auto-raise");
3686 staticpro (&Qauto_raise
);
3687 Qauto_lower
= intern ("auto-lower");
3688 staticpro (&Qauto_lower
);
3689 Qbackground_color
= intern ("background-color");
3690 staticpro (&Qbackground_color
);
3691 Qbar
= intern ("bar");
3693 Qborder_color
= intern ("border-color");
3694 staticpro (&Qborder_color
);
3695 Qborder_width
= intern ("border-width");
3696 staticpro (&Qborder_width
);
3697 Qbox
= intern ("box");
3699 Qcursor_color
= intern ("cursor-color");
3700 staticpro (&Qcursor_color
);
3701 Qcursor_type
= intern ("cursor-type");
3702 staticpro (&Qcursor_type
);
3703 Qfont
= intern ("font");
3705 Qforeground_color
= intern ("foreground-color");
3706 staticpro (&Qforeground_color
);
3707 Qgeometry
= intern ("geometry");
3708 staticpro (&Qgeometry
);
3709 Qicon_left
= intern ("icon-left");
3710 staticpro (&Qicon_left
);
3711 Qicon_top
= intern ("icon-top");
3712 staticpro (&Qicon_top
);
3713 Qicon_type
= intern ("icon-type");
3714 staticpro (&Qicon_type
);
3715 Qinternal_border_width
= intern ("internal-border-width");
3716 staticpro (&Qinternal_border_width
);
3717 Qleft
= intern ("left");
3719 Qmouse_color
= intern ("mouse-color");
3720 staticpro (&Qmouse_color
);
3721 Qnone
= intern ("none");
3723 Qparent_id
= intern ("parent-id");
3724 staticpro (&Qparent_id
);
3725 Qsuppress_icon
= intern ("suppress-icon");
3726 staticpro (&Qsuppress_icon
);
3727 Qtop
= intern ("top");
3729 Qundefined_color
= intern ("undefined-color");
3730 staticpro (&Qundefined_color
);
3731 Qvertical_scroll_bars
= intern ("vertical-scroll-bars");
3732 staticpro (&Qvertical_scroll_bars
);
3733 Qvisibility
= intern ("visibility");
3734 staticpro (&Qvisibility
);
3735 Qwindow_id
= intern ("window-id");
3736 staticpro (&Qwindow_id
);
3737 Qx_frame_parameter
= intern ("x-frame-parameter");
3738 staticpro (&Qx_frame_parameter
);
3739 /* This is the end of symbol initialization. */
3741 Fput (Qundefined_color
, Qerror_conditions
,
3742 Fcons (Qundefined_color
, Fcons (Qerror
, Qnil
)));
3743 Fput (Qundefined_color
, Qerror_message
,
3744 build_string ("Undefined color"));
3746 init_x_parm_symbols ();
3748 DEFVAR_INT ("mouse-buffer-offset", &mouse_buffer_offset
,
3749 "The buffer offset of the character under the pointer.");
3750 mouse_buffer_offset
= 0;
3752 DEFVAR_LISP ("x-pointer-shape", &Vx_pointer_shape
,
3753 "The shape of the pointer when over text.\n\
3754 Changing the value does not affect existing frames\n\
3755 unless you set the mouse color.");
3756 Vx_pointer_shape
= Qnil
;
3758 DEFVAR_LISP ("x-resource-name", &Vx_resource_name
,
3759 "The name Emacs uses to look up X resources; for internal use only.\n\
3760 `x-get-resource' uses this as the first component of the instance name\n\
3761 when requesting resource values.\n\
3762 Emacs initially sets `x-resource-name' to the name under which Emacs\n\
3763 was invoked, or to the value specified with the `-name' or `-rn'\n\
3764 switches, if present.");
3765 Vx_resource_name
= Qnil
;
3768 DEFVAR_INT ("x-nontext-pointer-shape", &Vx_nontext_pointer_shape
,
3769 "The shape of the pointer when not over text.");
3771 Vx_nontext_pointer_shape
= Qnil
;
3774 DEFVAR_INT ("x-mode-pointer-shape", &Vx_mode_pointer_shape
,
3775 "The shape of the pointer when over the mode line.");
3777 Vx_mode_pointer_shape
= Qnil
;
3779 DEFVAR_LISP ("x-cursor-fore-pixel", &Vx_cursor_fore_pixel
,
3780 "A string indicating the foreground color of the cursor box.");
3781 Vx_cursor_fore_pixel
= Qnil
;
3783 DEFVAR_LISP ("mouse-grabbed", &Vmouse_depressed
,
3784 "Non-nil if a mouse button is currently depressed.");
3785 Vmouse_depressed
= Qnil
;
3787 DEFVAR_LISP ("x-no-window-manager", &Vx_no_window_manager
,
3788 "t if no X window manager is in use.");
3791 defsubr (&Sx_get_resource
);
3793 defsubr (&Sx_draw_rectangle
);
3794 defsubr (&Sx_erase_rectangle
);
3795 defsubr (&Sx_contour_region
);
3796 defsubr (&Sx_uncontour_region
);
3798 defsubr (&Sx_display_color_p
);
3799 defsubr (&Sx_list_fonts
);
3800 defsubr (&Sx_color_defined_p
);
3801 defsubr (&Sx_server_max_request_size
);
3802 defsubr (&Sx_server_vendor
);
3803 defsubr (&Sx_server_version
);
3804 defsubr (&Sx_display_pixel_width
);
3805 defsubr (&Sx_display_pixel_height
);
3806 defsubr (&Sx_display_mm_width
);
3807 defsubr (&Sx_display_mm_height
);
3808 defsubr (&Sx_display_screens
);
3809 defsubr (&Sx_display_planes
);
3810 defsubr (&Sx_display_color_cells
);
3811 defsubr (&Sx_display_visual_class
);
3812 defsubr (&Sx_display_backing_store
);
3813 defsubr (&Sx_display_save_under
);
3815 defsubr (&Sx_rebind_key
);
3816 defsubr (&Sx_rebind_keys
);
3817 defsubr (&Sx_track_pointer
);
3818 defsubr (&Sx_grab_pointer
);
3819 defsubr (&Sx_ungrab_pointer
);
3822 defsubr (&Sx_get_default
);
3823 defsubr (&Sx_store_cut_buffer
);
3824 defsubr (&Sx_get_cut_buffer
);
3826 defsubr (&Sx_parse_geometry
);
3827 defsubr (&Sx_create_frame
);
3828 defsubr (&Sfocus_frame
);
3829 defsubr (&Sunfocus_frame
);
3831 defsubr (&Sx_horizontal_line
);
3833 defsubr (&Sx_open_connection
);
3834 defsubr (&Sx_close_current_connection
);
3835 defsubr (&Sx_synchronize
);
3838 #endif /* HAVE_X_WINDOWS */