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 set these parameters these unless they've been explicitly
400 specified. The window might be mapped or resized while we're in
401 this function, and we don't want to override that unless the lisp
402 code has asked for it.
404 Don't set these parameters unless they actually differ from the
405 window's current parameters; the window may not actually exist
410 XSET (frame
, Lisp_Frame
, f
);
411 if ((NUMBERP (width
) && XINT (width
) != FRAME_WIDTH (f
))
412 || (NUMBERP (height
) && XINT (height
) != FRAME_HEIGHT (f
)))
413 Fset_frame_size (frame
, width
, height
);
414 if ((NUMBERP (left
) && XINT (left
) != f
->display
.x
->left_pos
)
415 || (NUMBERP (top
) && XINT (top
) != f
->display
.x
->top_pos
))
416 Fset_frame_position (frame
, left
, top
);
420 /* Insert a description of internally-recorded parameters of frame X
421 into the parameter alist *ALISTPTR that is to be given to the user.
422 Only parameters that are specific to the X window system
423 and whose values are not correctly recorded in the frame's
424 param_alist need to be considered here. */
426 x_report_frame_params (f
, alistptr
)
428 Lisp_Object
*alistptr
;
432 store_in_alist (alistptr
, Qleft
, make_number (f
->display
.x
->left_pos
));
433 store_in_alist (alistptr
, Qtop
, make_number (f
->display
.x
->top_pos
));
434 store_in_alist (alistptr
, Qborder_width
,
435 make_number (f
->display
.x
->border_width
));
436 store_in_alist (alistptr
, Qinternal_border_width
,
437 make_number (f
->display
.x
->internal_border_width
));
438 sprintf (buf
, "%d", FRAME_X_WINDOW (f
));
439 store_in_alist (alistptr
, Qwindow_id
,
441 store_in_alist (alistptr
, Qvisibility
,
442 (FRAME_VISIBLE_P (f
) ? Qt
443 : FRAME_ICONIFIED_P (f
) ? Qicon
: Qnil
));
446 /* Decide if color named COLOR is valid for the display
447 associated with the selected frame. */
449 defined_color (color
, color_def
)
454 Colormap screen_colormap
;
459 = DefaultColormap (x_current_display
, XDefaultScreen (x_current_display
));
461 foo
= XParseColor (x_current_display
, screen_colormap
,
463 && XAllocColor (x_current_display
, screen_colormap
, color_def
);
465 foo
= XParseColor (color
, color_def
) && XGetHardwareColor (color_def
);
466 #endif /* not HAVE_X11 */
475 /* Given a string ARG naming a color, compute a pixel value from it
476 suitable for screen F.
477 If F is not a color screen, return DEF (default) regardless of what
481 x_decode_color (arg
, def
)
487 CHECK_STRING (arg
, 0);
489 if (strcmp (XSTRING (arg
)->data
, "black") == 0)
490 return BLACK_PIX_DEFAULT
;
491 else if (strcmp (XSTRING (arg
)->data
, "white") == 0)
492 return WHITE_PIX_DEFAULT
;
495 if (x_screen_planes
== 1)
498 if (DISPLAY_CELLS
== 1)
502 if (defined_color (XSTRING (arg
)->data
, &cdef
))
505 Fsignal (Qundefined_color
, Fcons (arg
, Qnil
));
508 /* Functions called only from `x_set_frame_param'
509 to set individual parameters.
511 If FRAME_X_WINDOW (f) is 0,
512 the frame is being created and its X-window does not exist yet.
513 In that case, just record the parameter's new value
514 in the standard place; do not attempt to change the window. */
517 x_set_foreground_color (f
, arg
, oldval
)
519 Lisp_Object arg
, oldval
;
521 f
->display
.x
->foreground_pixel
= x_decode_color (arg
, BLACK_PIX_DEFAULT
);
522 if (FRAME_X_WINDOW (f
) != 0)
526 XSetForeground (x_current_display
, f
->display
.x
->normal_gc
,
527 f
->display
.x
->foreground_pixel
);
528 XSetBackground (x_current_display
, f
->display
.x
->reverse_gc
,
529 f
->display
.x
->foreground_pixel
);
531 #endif /* HAVE_X11 */
532 recompute_basic_faces (f
);
533 if (FRAME_VISIBLE_P (f
))
539 x_set_background_color (f
, arg
, oldval
)
541 Lisp_Object arg
, oldval
;
546 f
->display
.x
->background_pixel
= x_decode_color (arg
, WHITE_PIX_DEFAULT
);
548 if (FRAME_X_WINDOW (f
) != 0)
552 /* The main frame area. */
553 XSetBackground (x_current_display
, f
->display
.x
->normal_gc
,
554 f
->display
.x
->background_pixel
);
555 XSetForeground (x_current_display
, f
->display
.x
->reverse_gc
,
556 f
->display
.x
->background_pixel
);
557 XSetWindowBackground (x_current_display
, FRAME_X_WINDOW (f
),
558 f
->display
.x
->background_pixel
);
561 temp
= XMakeTile (f
->display
.x
->background_pixel
);
562 XChangeBackground (FRAME_X_WINDOW (f
), temp
);
564 #endif /* not HAVE_X11 */
567 recompute_basic_faces (f
);
569 if (FRAME_VISIBLE_P (f
))
575 x_set_mouse_color (f
, arg
, oldval
)
577 Lisp_Object arg
, oldval
;
579 Cursor cursor
, nontext_cursor
, mode_cursor
;
583 f
->display
.x
->mouse_pixel
= x_decode_color (arg
, BLACK_PIX_DEFAULT
);
584 mask_color
= f
->display
.x
->background_pixel
;
585 /* No invisible pointers. */
586 if (mask_color
== f
->display
.x
->mouse_pixel
587 && mask_color
== f
->display
.x
->background_pixel
)
588 f
->display
.x
->mouse_pixel
= f
->display
.x
->foreground_pixel
;
593 /* It's not okay to crash if the user selects a screwy cursor. */
596 if (!EQ (Qnil
, Vx_pointer_shape
))
598 CHECK_NUMBER (Vx_pointer_shape
, 0);
599 cursor
= XCreateFontCursor (x_current_display
, XINT (Vx_pointer_shape
));
602 cursor
= XCreateFontCursor (x_current_display
, XC_xterm
);
603 x_check_errors ("bad text pointer cursor: %s");
605 if (!EQ (Qnil
, Vx_nontext_pointer_shape
))
607 CHECK_NUMBER (Vx_nontext_pointer_shape
, 0);
608 nontext_cursor
= XCreateFontCursor (x_current_display
,
609 XINT (Vx_nontext_pointer_shape
));
612 nontext_cursor
= XCreateFontCursor (x_current_display
, XC_left_ptr
);
613 x_check_errors ("bad nontext pointer cursor: %s");
615 if (!EQ (Qnil
, Vx_mode_pointer_shape
))
617 CHECK_NUMBER (Vx_mode_pointer_shape
, 0);
618 mode_cursor
= XCreateFontCursor (x_current_display
,
619 XINT (Vx_mode_pointer_shape
));
622 mode_cursor
= XCreateFontCursor (x_current_display
, XC_xterm
);
624 /* Check and report errors with the above calls. */
625 x_check_errors ("can't set cursor shape: %s");
629 XColor fore_color
, back_color
;
631 fore_color
.pixel
= f
->display
.x
->mouse_pixel
;
632 back_color
.pixel
= mask_color
;
633 XQueryColor (x_current_display
,
634 DefaultColormap (x_current_display
,
635 DefaultScreen (x_current_display
)),
637 XQueryColor (x_current_display
,
638 DefaultColormap (x_current_display
,
639 DefaultScreen (x_current_display
)),
641 XRecolorCursor (x_current_display
, cursor
,
642 &fore_color
, &back_color
);
643 XRecolorCursor (x_current_display
, nontext_cursor
,
644 &fore_color
, &back_color
);
645 XRecolorCursor (x_current_display
, mode_cursor
,
646 &fore_color
, &back_color
);
649 cursor
= XCreateCursor (16, 16, MouseCursor
, MouseMask
,
651 f
->display
.x
->mouse_pixel
,
652 f
->display
.x
->background_pixel
,
656 if (FRAME_X_WINDOW (f
) != 0)
658 XDefineCursor (XDISPLAY
FRAME_X_WINDOW (f
), cursor
);
661 if (cursor
!= f
->display
.x
->text_cursor
&& f
->display
.x
->text_cursor
!= 0)
662 XFreeCursor (XDISPLAY f
->display
.x
->text_cursor
);
663 f
->display
.x
->text_cursor
= cursor
;
665 if (nontext_cursor
!= f
->display
.x
->nontext_cursor
666 && f
->display
.x
->nontext_cursor
!= 0)
667 XFreeCursor (XDISPLAY f
->display
.x
->nontext_cursor
);
668 f
->display
.x
->nontext_cursor
= nontext_cursor
;
670 if (mode_cursor
!= f
->display
.x
->modeline_cursor
671 && f
->display
.x
->modeline_cursor
!= 0)
672 XFreeCursor (XDISPLAY f
->display
.x
->modeline_cursor
);
673 f
->display
.x
->modeline_cursor
= mode_cursor
;
674 #endif /* HAVE_X11 */
681 x_set_cursor_color (f
, arg
, oldval
)
683 Lisp_Object arg
, oldval
;
685 unsigned long fore_pixel
;
687 if (!EQ (Vx_cursor_fore_pixel
, Qnil
))
688 fore_pixel
= x_decode_color (Vx_cursor_fore_pixel
, WHITE_PIX_DEFAULT
);
690 fore_pixel
= f
->display
.x
->background_pixel
;
691 f
->display
.x
->cursor_pixel
= x_decode_color (arg
, BLACK_PIX_DEFAULT
);
693 /* Make sure that the cursor color differs from the background color. */
694 if (f
->display
.x
->cursor_pixel
== f
->display
.x
->background_pixel
)
696 f
->display
.x
->cursor_pixel
== f
->display
.x
->mouse_pixel
;
697 if (f
->display
.x
->cursor_pixel
== fore_pixel
)
698 fore_pixel
= f
->display
.x
->background_pixel
;
700 f
->display
.x
->cursor_foreground_pixel
= fore_pixel
;
702 if (FRAME_X_WINDOW (f
) != 0)
706 XSetBackground (x_current_display
, f
->display
.x
->cursor_gc
,
707 f
->display
.x
->cursor_pixel
);
708 XSetForeground (x_current_display
, f
->display
.x
->cursor_gc
,
711 #endif /* HAVE_X11 */
713 if (FRAME_VISIBLE_P (f
))
715 x_display_cursor (f
, 0);
716 x_display_cursor (f
, 1);
721 /* Set the border-color of frame F to value described by ARG.
722 ARG can be a string naming a color.
723 The border-color is used for the border that is drawn by the X server.
724 Note that this does not fully take effect if done before
725 F has an x-window; it must be redone when the window is created.
727 Note: this is done in two routines because of the way X10 works.
729 Note: under X11, this is normally the province of the window manager,
730 and so emacs' border colors may be overridden. */
733 x_set_border_color (f
, arg
, oldval
)
735 Lisp_Object arg
, oldval
;
740 CHECK_STRING (arg
, 0);
741 str
= XSTRING (arg
)->data
;
744 if (!strcmp (str
, "grey") || !strcmp (str
, "Grey")
745 || !strcmp (str
, "gray") || !strcmp (str
, "Gray"))
750 pix
= x_decode_color (arg
, BLACK_PIX_DEFAULT
);
752 x_set_border_pixel (f
, pix
);
755 /* Set the border-color of frame F to pixel value PIX.
756 Note that this does not fully take effect if done before
757 F has an x-window. */
759 x_set_border_pixel (f
, pix
)
763 f
->display
.x
->border_pixel
= pix
;
765 if (FRAME_X_WINDOW (f
) != 0 && f
->display
.x
->border_width
> 0)
772 XSetWindowBorder (x_current_display
, FRAME_X_WINDOW (f
),
776 temp
= XMakePixmap ((Bitmap
) XStoreBitmap (gray_width
, gray_height
,
778 BLACK_PIX_DEFAULT
, WHITE_PIX_DEFAULT
);
780 temp
= XMakeTile (pix
);
781 XChangeBorder (FRAME_X_WINDOW (f
), temp
);
782 XFreePixmap (XDISPLAY temp
);
783 #endif /* not HAVE_X11 */
786 if (FRAME_VISIBLE_P (f
))
792 x_set_cursor_type (f
, arg
, oldval
)
794 Lisp_Object arg
, oldval
;
797 FRAME_DESIRED_CURSOR (f
) = bar_cursor
;
802 FRAME_DESIRED_CURSOR (f
) = filled_box_cursor
;
803 /* Error messages commented out because people have trouble fixing
804 .Xdefaults with Emacs, when it has something bad in it. */
808 ("the `cursor-type' frame parameter should be either `bar' or `box'");
811 /* Make sure the cursor gets redrawn. This is overkill, but how
812 often do people change cursor types? */
817 x_set_icon_type (f
, arg
, oldval
)
819 Lisp_Object arg
, oldval
;
824 if (EQ (oldval
, Qnil
) == EQ (arg
, Qnil
))
829 result
= x_text_icon (f
, 0);
831 result
= x_bitmap_icon (f
);
836 error ("No icon window available.");
839 /* If the window was unmapped (and its icon was mapped),
840 the new icon is not mapped, so map the window in its stead. */
841 if (FRAME_VISIBLE_P (f
))
842 XMapWindow (XDISPLAY
FRAME_X_WINDOW (f
));
848 extern Lisp_Object
x_new_font ();
851 x_set_font (f
, arg
, oldval
)
853 Lisp_Object arg
, oldval
;
857 CHECK_STRING (arg
, 1);
860 result
= x_new_font (f
, XSTRING (arg
)->data
);
863 if (EQ (result
, Qnil
))
864 error ("Font \"%s\" is not defined", XSTRING (arg
)->data
);
865 else if (EQ (result
, Qt
))
866 error ("the characters of the given font have varying widths");
867 else if (STRINGP (result
))
869 recompute_basic_faces (f
);
870 store_frame_param (f
, Qfont
, result
);
877 x_set_border_width (f
, arg
, oldval
)
879 Lisp_Object arg
, oldval
;
881 CHECK_NUMBER (arg
, 0);
883 if (XINT (arg
) == f
->display
.x
->border_width
)
886 if (FRAME_X_WINDOW (f
) != 0)
887 error ("Cannot change the border width of a window");
889 f
->display
.x
->border_width
= XINT (arg
);
893 x_set_internal_border_width (f
, arg
, oldval
)
895 Lisp_Object arg
, oldval
;
898 int old
= f
->display
.x
->internal_border_width
;
900 CHECK_NUMBER (arg
, 0);
901 f
->display
.x
->internal_border_width
= XINT (arg
);
902 if (f
->display
.x
->internal_border_width
< 0)
903 f
->display
.x
->internal_border_width
= 0;
905 if (f
->display
.x
->internal_border_width
== old
)
908 if (FRAME_X_WINDOW (f
) != 0)
911 x_set_window_size (f
, f
->width
, f
->height
);
913 x_set_resize_hint (f
);
917 SET_FRAME_GARBAGED (f
);
922 x_set_visibility (f
, value
, oldval
)
924 Lisp_Object value
, oldval
;
927 XSET (frame
, Lisp_Frame
, f
);
930 Fmake_frame_invisible (frame
);
931 else if (EQ (value
, Qicon
))
932 Ficonify_frame (frame
);
934 Fmake_frame_visible (frame
);
938 x_set_menu_bar_lines_1 (window
, n
)
942 struct window
*w
= XWINDOW (window
);
944 XFASTINT (w
->top
) += n
;
945 XFASTINT (w
->height
) -= n
;
947 /* Handle just the top child in a vertical split. */
948 if (!NILP (w
->vchild
))
949 x_set_menu_bar_lines_1 (w
->vchild
, n
);
951 /* Adjust all children in a horizontal split. */
952 for (window
= w
->hchild
; !NILP (window
); window
= w
->next
)
954 w
= XWINDOW (window
);
955 x_set_menu_bar_lines_1 (window
, n
);
960 x_set_menu_bar_lines (f
, value
, oldval
)
962 Lisp_Object value
, oldval
;
965 int olines
= FRAME_MENU_BAR_LINES (f
);
967 /* Right now, menu bars don't work properly in minibuf-only frames;
968 most of the commands try to apply themselves to the minibuffer
969 frame itslef, and get an error because you can't switch buffers
970 in or split the minibuffer window. */
971 if (FRAME_MINIBUF_ONLY_P (f
))
974 if (XTYPE (value
) == Lisp_Int
)
975 nlines
= XINT (value
);
979 FRAME_MENU_BAR_LINES (f
) = nlines
;
980 x_set_menu_bar_lines_1 (f
->root_window
, nlines
- olines
);
983 /* Change the name of frame F to ARG. If ARG is nil, set F's name to
986 If EXPLICIT is non-zero, that indicates that lisp code is setting the
987 name; if ARG is a string, set F's name to ARG and set
988 F->explicit_name; if ARG is Qnil, then clear F->explicit_name.
990 If EXPLICIT is zero, that indicates that Emacs redisplay code is
991 suggesting a new name, which lisp code should override; if
992 F->explicit_name is set, ignore the new name; otherwise, set it. */
995 x_set_name (f
, name
, explicit)
1000 /* Make sure that requests from lisp code override requests from
1001 Emacs redisplay code. */
1004 /* If we're switching from explicit to implicit, we had better
1005 update the mode lines and thereby update the title. */
1006 if (f
->explicit_name
&& NILP (name
))
1007 update_mode_lines
= 1;
1009 f
->explicit_name
= ! NILP (name
);
1011 else if (f
->explicit_name
)
1014 /* If NAME is nil, set the name to the x_id_name. */
1016 name
= build_string (x_id_name
);
1018 CHECK_STRING (name
, 0);
1020 /* Don't change the name if it's already NAME. */
1021 if (! NILP (Fstring_equal (name
, f
->name
)))
1024 if (FRAME_X_WINDOW (f
))
1031 text
.value
= XSTRING (name
)->data
;
1032 text
.encoding
= XA_STRING
;
1034 text
.nitems
= XSTRING (name
)->size
;
1035 XSetWMName (x_current_display
, FRAME_X_WINDOW (f
), &text
);
1036 XSetWMIconName (x_current_display
, FRAME_X_WINDOW (f
), &text
);
1039 XSetIconName (XDISPLAY
FRAME_X_WINDOW (f
),
1040 XSTRING (name
)->data
);
1041 XStoreName (XDISPLAY
FRAME_X_WINDOW (f
),
1042 XSTRING (name
)->data
);
1051 /* This function should be called when the user's lisp code has
1052 specified a name for the frame; the name will override any set by the
1055 x_explicitly_set_name (f
, arg
, oldval
)
1057 Lisp_Object arg
, oldval
;
1059 x_set_name (f
, arg
, 1);
1062 /* This function should be called by Emacs redisplay code to set the
1063 name; names set this way will never override names set by the user's
1066 x_implicitly_set_name (f
, arg
, oldval
)
1068 Lisp_Object arg
, oldval
;
1070 x_set_name (f
, arg
, 0);
1074 x_set_autoraise (f
, arg
, oldval
)
1076 Lisp_Object arg
, oldval
;
1078 f
->auto_raise
= !EQ (Qnil
, arg
);
1082 x_set_autolower (f
, arg
, oldval
)
1084 Lisp_Object arg
, oldval
;
1086 f
->auto_lower
= !EQ (Qnil
, arg
);
1090 x_set_vertical_scroll_bars (f
, arg
, oldval
)
1092 Lisp_Object arg
, oldval
;
1094 if (NILP (arg
) != ! FRAME_HAS_VERTICAL_SCROLL_BARS (f
))
1096 FRAME_HAS_VERTICAL_SCROLL_BARS (f
) = ! NILP (arg
);
1098 /* We set this parameter before creating the X window for the
1099 frame, so we can get the geometry right from the start.
1100 However, if the window hasn't been created yet, we shouldn't
1101 call x_set_window_size. */
1102 if (FRAME_X_WINDOW (f
))
1103 x_set_window_size (f
, FRAME_WIDTH (f
), FRAME_HEIGHT (f
));
1107 /* Subroutines of creating an X frame. */
1111 /* Make sure that Vx_resource_name is set to a reasonable value. */
1113 validate_x_resource_name ()
1115 if (! STRINGP (Vx_resource_name
))
1116 Vx_resource_name
= make_string ("emacs", 5);
1120 extern char *x_get_string_resource ();
1121 extern XrmDatabase
x_load_resources ();
1123 DEFUN ("x-get-resource", Fx_get_resource
, Sx_get_resource
, 2, 4, 0,
1124 "Return the value of ATTRIBUTE, of class CLASS, from the X defaults database.\n\
1125 This uses `NAME.ATTRIBUTE' as the key and `Emacs.CLASS' as the\n\
1126 class, where INSTANCE is the name under which Emacs was invoked, or\n\
1127 the name specified by the `-name' or `-rn' command-line arguments.\n\
1129 The optional arguments COMPONENT and SUBCLASS add to the key and the\n\
1130 class, respectively. You must specify both of them or neither.\n\
1131 If you specify them, the key is `NAME.COMPONENT.ATTRIBUTE'\n\
1132 and the class is `Emacs.CLASS.SUBCLASS'.")
1133 (attribute
, class, component
, subclass
)
1134 Lisp_Object attribute
, class, component
, subclass
;
1136 register char *value
;
1142 CHECK_STRING (attribute
, 0);
1143 CHECK_STRING (class, 0);
1145 if (!NILP (component
))
1146 CHECK_STRING (component
, 1);
1147 if (!NILP (subclass
))
1148 CHECK_STRING (subclass
, 2);
1149 if (NILP (component
) != NILP (subclass
))
1150 error ("x-get-resource: must specify both COMPONENT and SUBCLASS or neither");
1152 validate_x_resource_name ();
1154 if (NILP (component
))
1156 /* Allocate space for the components, the dots which separate them,
1157 and the final '\0'. */
1158 name_key
= (char *) alloca (XSTRING (Vx_resource_name
)->size
1159 + XSTRING (attribute
)->size
1161 class_key
= (char *) alloca ((sizeof (EMACS_CLASS
) - 1)
1162 + XSTRING (class)->size
1165 sprintf (name_key
, "%s.%s",
1166 XSTRING (Vx_resource_name
)->data
,
1167 XSTRING (attribute
)->data
);
1168 sprintf (class_key
, "%s.%s",
1170 XSTRING (class)->data
);
1174 name_key
= (char *) alloca (XSTRING (Vx_resource_name
)->size
1175 + XSTRING (component
)->size
1176 + XSTRING (attribute
)->size
1179 class_key
= (char *) alloca ((sizeof (EMACS_CLASS
) - 1)
1180 + XSTRING (class)->size
1181 + XSTRING (subclass
)->size
1184 sprintf (name_key
, "%s.%s.%s",
1185 XSTRING (Vx_resource_name
)->data
,
1186 XSTRING (component
)->data
,
1187 XSTRING (attribute
)->data
);
1188 sprintf (class_key
, "%s.%s.%s",
1190 XSTRING (class)->data
,
1191 XSTRING (subclass
)->data
);
1194 value
= x_get_string_resource (xrdb
, name_key
, class_key
);
1196 if (value
!= (char *) 0)
1197 return build_string (value
);
1202 /* Used when C code wants a resource value. */
1205 x_get_resource_string (attribute
, class)
1206 char *attribute
, *class;
1208 register char *value
;
1212 /* Allocate space for the components, the dots which separate them,
1213 and the final '\0'. */
1214 name_key
= (char *) alloca (XSTRING (Vinvocation_name
)->size
1215 + strlen (attribute
) + 2);
1216 class_key
= (char *) alloca ((sizeof (EMACS_CLASS
) - 1)
1217 + strlen (class) + 2);
1219 sprintf (name_key
, "%s.%s",
1220 XSTRING (Vinvocation_name
)->data
,
1222 sprintf (class_key
, "%s.%s", EMACS_CLASS
, class);
1224 return x_get_string_resource (xrdb
, name_key
, class_key
);
1229 DEFUN ("x-get-default", Fx_get_default
, Sx_get_default
, 1, 1, 0,
1230 "Get X default ATTRIBUTE from the system, or nil if no default.\n\
1231 Value is a string (when not nil) and ATTRIBUTE is also a string.\n\
1232 The defaults are specified in the file `~/.Xdefaults'.")
1236 register unsigned char *value
;
1238 CHECK_STRING (arg
, 1);
1240 value
= (unsigned char *) XGetDefault (XDISPLAY
1241 XSTRING (Vinvocation_name
)->data
,
1242 XSTRING (arg
)->data
);
1244 /* Try reversing last two args, in case this is the buggy version of X. */
1245 value
= (unsigned char *) XGetDefault (XDISPLAY
1246 XSTRING (arg
)->data
,
1247 XSTRING (Vinvocation_name
)->data
);
1249 return build_string (value
);
1254 #define Fx_get_resource(attribute, class, component, subclass) \
1255 Fx_get_default(attribute)
1259 /* Types we might convert a resource string into. */
1262 number
, boolean
, string
, symbol
,
1265 /* Return the value of parameter PARAM.
1267 First search ALIST, then Vdefault_frame_alist, then the X defaults
1268 database, using ATTRIBUTE as the attribute name and CLASS as its class.
1270 Convert the resource to the type specified by desired_type.
1272 If no default is specified, return Qunbound. If you call
1273 x_get_arg, make sure you deal with Qunbound in a reasonable way,
1274 and don't let it get stored in any lisp-visible variables! */
1277 x_get_arg (alist
, param
, attribute
, class, type
)
1278 Lisp_Object alist
, param
;
1281 enum resource_types type
;
1283 register Lisp_Object tem
;
1285 tem
= Fassq (param
, alist
);
1287 tem
= Fassq (param
, Vdefault_frame_alist
);
1293 tem
= Fx_get_resource (build_string (attribute
),
1294 build_string (class),
1303 return make_number (atoi (XSTRING (tem
)->data
));
1306 tem
= Fdowncase (tem
);
1307 if (!strcmp (XSTRING (tem
)->data
, "on")
1308 || !strcmp (XSTRING (tem
)->data
, "true"))
1317 /* As a special case, we map the values `true' and `on'
1318 to Qt, and `false' and `off' to Qnil. */
1320 Lisp_Object lower
= Fdowncase (tem
);
1321 if (!strcmp (XSTRING (tem
)->data
, "on")
1322 || !strcmp (XSTRING (tem
)->data
, "true"))
1324 else if (!strcmp (XSTRING (tem
)->data
, "off")
1325 || !strcmp (XSTRING (tem
)->data
, "false"))
1328 return Fintern (tem
, Qnil
);
1341 /* Record in frame F the specified or default value according to ALIST
1342 of the parameter named PARAM (a Lisp symbol).
1343 If no value is specified for PARAM, look for an X default for XPROP
1344 on the frame named NAME.
1345 If that is not found either, use the value DEFLT. */
1348 x_default_parameter (f
, alist
, prop
, deflt
, xprop
, xclass
, type
)
1355 enum resource_types type
;
1359 tem
= x_get_arg (alist
, prop
, xprop
, xclass
, type
);
1360 if (EQ (tem
, Qunbound
))
1362 x_set_frame_parameters (f
, Fcons (Fcons (prop
, tem
), Qnil
));
1366 DEFUN ("x-parse-geometry", Fx_parse_geometry
, Sx_parse_geometry
, 1, 1, 0,
1367 "Parse an X-style geometry string STRING.\n\
1368 Returns an alist of the form ((top . TOP), (left . LEFT) ... ).")
1373 unsigned int width
, height
;
1374 Lisp_Object values
[4];
1376 CHECK_STRING (string
, 0);
1378 geometry
= XParseGeometry ((char *) XSTRING (string
)->data
,
1379 &x
, &y
, &width
, &height
);
1381 switch (geometry
& 0xf) /* Mask out {X,Y}Negative */
1383 case (XValue
| YValue
):
1384 /* What's one pixel among friends?
1385 Perhaps fix this some day by returning symbol `extreme-top'... */
1386 if (x
== 0 && (geometry
& XNegative
))
1388 if (y
== 0 && (geometry
& YNegative
))
1390 values
[0] = Fcons (Qleft
, make_number (x
));
1391 values
[1] = Fcons (Qtop
, make_number (y
));
1392 return Flist (2, values
);
1395 case (WidthValue
| HeightValue
):
1396 values
[0] = Fcons (Qwidth
, make_number (width
));
1397 values
[1] = Fcons (Qheight
, make_number (height
));
1398 return Flist (2, values
);
1401 case (XValue
| YValue
| WidthValue
| HeightValue
):
1402 if (x
== 0 && (geometry
& XNegative
))
1404 if (y
== 0 && (geometry
& YNegative
))
1406 values
[0] = Fcons (Qwidth
, make_number (width
));
1407 values
[1] = Fcons (Qheight
, make_number (height
));
1408 values
[2] = Fcons (Qleft
, make_number (x
));
1409 values
[3] = Fcons (Qtop
, make_number (y
));
1410 return Flist (4, values
);
1417 error ("Must specify x and y value, and/or width and height");
1422 /* Calculate the desired size and position of this window,
1423 or set rubber-band prompting if none. */
1425 #define DEFAULT_ROWS 40
1426 #define DEFAULT_COLS 80
1429 x_figure_window_size (f
, parms
)
1433 register Lisp_Object tem0
, tem1
;
1434 int height
, width
, left
, top
;
1435 register int geometry
;
1436 long window_prompting
= 0;
1438 /* Default values if we fall through.
1439 Actually, if that happens we should get
1440 window manager prompting. */
1441 f
->width
= DEFAULT_COLS
;
1442 f
->height
= DEFAULT_ROWS
;
1443 /* Window managers expect that if program-specified
1444 positions are not (0,0), they're intentional, not defaults. */
1445 f
->display
.x
->top_pos
= 0;
1446 f
->display
.x
->left_pos
= 0;
1448 tem0
= x_get_arg (parms
, Qheight
, 0, 0, number
);
1449 tem1
= x_get_arg (parms
, Qwidth
, 0, 0, number
);
1450 if (! EQ (tem0
, Qunbound
) && ! EQ (tem1
, Qunbound
))
1452 CHECK_NUMBER (tem0
, 0);
1453 CHECK_NUMBER (tem1
, 0);
1454 f
->height
= XINT (tem0
);
1455 f
->width
= XINT (tem1
);
1456 window_prompting
|= USSize
;
1458 else if (! EQ (tem0
, Qunbound
) || ! EQ (tem1
, Qunbound
))
1459 error ("Must specify *both* height and width");
1461 f
->display
.x
->vertical_scroll_bar_extra
1462 = (FRAME_HAS_VERTICAL_SCROLL_BARS (f
)
1463 ? VERTICAL_SCROLL_BAR_PIXEL_WIDTH (f
)
1465 f
->display
.x
->pixel_width
= CHAR_TO_PIXEL_WIDTH (f
, f
->width
);
1466 f
->display
.x
->pixel_height
= CHAR_TO_PIXEL_HEIGHT (f
, f
->height
);
1468 tem0
= x_get_arg (parms
, Qtop
, 0, 0, number
);
1469 tem1
= x_get_arg (parms
, Qleft
, 0, 0, number
);
1470 if (! EQ (tem0
, Qunbound
) && ! EQ (tem1
, Qunbound
))
1472 CHECK_NUMBER (tem0
, 0);
1473 CHECK_NUMBER (tem1
, 0);
1474 f
->display
.x
->top_pos
= XINT (tem0
);
1475 f
->display
.x
->left_pos
= XINT (tem1
);
1476 x_calc_absolute_position (f
);
1477 window_prompting
|= USPosition
;
1479 else if (! EQ (tem0
, Qunbound
) || ! EQ (tem1
, Qunbound
))
1480 error ("Must specify *both* top and left corners");
1482 #if 0 /* PPosition and PSize mean "specified explicitly,
1483 by the program rather than by the user". So it is wrong to
1484 set them if nothing was specified. */
1485 switch (window_prompting
)
1487 case USSize
| USPosition
:
1488 return window_prompting
;
1491 case USSize
: /* Got the size, need the position. */
1492 window_prompting
|= PPosition
;
1493 return window_prompting
;
1496 case USPosition
: /* Got the position, need the size. */
1497 window_prompting
|= PSize
;
1498 return window_prompting
;
1501 case 0: /* Got nothing, take both from geometry. */
1502 window_prompting
|= PPosition
| PSize
;
1503 return window_prompting
;
1507 /* Somehow a bit got set in window_prompting that we didn't
1512 return window_prompting
;
1519 XSetWindowAttributes attributes
;
1520 unsigned long attribute_mask
;
1521 XClassHint class_hints
;
1523 attributes
.background_pixel
= f
->display
.x
->background_pixel
;
1524 attributes
.border_pixel
= f
->display
.x
->border_pixel
;
1525 attributes
.bit_gravity
= StaticGravity
;
1526 attributes
.backing_store
= NotUseful
;
1527 attributes
.save_under
= True
;
1528 attributes
.event_mask
= STANDARD_EVENT_SET
;
1529 attribute_mask
= (CWBackPixel
| CWBorderPixel
| CWBitGravity
1531 | CWBackingStore
| CWSaveUnder
1537 = XCreateWindow (x_current_display
, ROOT_WINDOW
,
1538 f
->display
.x
->left_pos
,
1539 f
->display
.x
->top_pos
,
1540 PIXEL_WIDTH (f
), PIXEL_HEIGHT (f
),
1541 f
->display
.x
->border_width
,
1542 CopyFromParent
, /* depth */
1543 InputOutput
, /* class */
1544 screen_visual
, /* set in Fx_open_connection */
1545 attribute_mask
, &attributes
);
1547 validate_x_resource_name ();
1548 class_hints
.res_name
= (char *) XSTRING (Vx_resource_name
)->data
;
1549 class_hints
.res_class
= EMACS_CLASS
;
1550 XSetClassHint (x_current_display
, FRAME_X_WINDOW (f
), &class_hints
);
1552 /* This indicates that we use the "Passive Input" input model.
1553 Unless we do this, we don't get the Focus{In,Out} events that we
1554 need to draw the cursor correctly. Accursed bureaucrats.
1555 XWhipsAndChains (x_current_display, IronMaiden, &TheRack); */
1557 f
->display
.x
->wm_hints
.input
= True
;
1558 f
->display
.x
->wm_hints
.flags
|= InputHint
;
1559 XSetWMHints (x_current_display
, FRAME_X_WINDOW (f
), &f
->display
.x
->wm_hints
);
1561 /* x_set_name normally ignores requests to set the name if the
1562 requested name is the same as the current name. This is the one
1563 place where that assumption isn't correct; f->name is set, but
1564 the X server hasn't been told. */
1566 Lisp_Object name
= f
->name
;
1567 int explicit = f
->explicit_name
;
1570 f
->explicit_name
= 0;
1571 x_set_name (f
, name
, explicit);
1574 XDefineCursor (XDISPLAY
FRAME_X_WINDOW (f
),
1575 f
->display
.x
->text_cursor
);
1578 if (FRAME_X_WINDOW (f
) == 0)
1579 error ("Unable to create window.");
1582 /* Handle the icon stuff for this window. Perhaps later we might
1583 want an x_set_icon_position which can be called interactively as
1591 Lisp_Object icon_x
, icon_y
;
1593 /* Set the position of the icon. Note that twm groups all
1594 icons in an icon window. */
1595 icon_x
= x_get_arg (parms
, Qicon_left
, 0, 0, number
);
1596 icon_y
= x_get_arg (parms
, Qicon_top
, 0, 0, number
);
1597 if (!EQ (icon_x
, Qunbound
) && !EQ (icon_y
, Qunbound
))
1599 CHECK_NUMBER (icon_x
, 0);
1600 CHECK_NUMBER (icon_y
, 0);
1602 else if (!EQ (icon_x
, Qunbound
) || !EQ (icon_y
, Qunbound
))
1603 error ("Both left and top icon corners of icon must be specified");
1607 if (! EQ (icon_x
, Qunbound
))
1608 x_wm_set_icon_position (f
, XINT (icon_x
), XINT (icon_y
));
1610 /* Start up iconic or window? */
1611 x_wm_set_window_state
1612 (f
, (EQ (x_get_arg (parms
, Qvisibility
, 0, 0, symbol
), Qicon
)
1619 /* Make the GC's needed for this window, setting the
1620 background, border and mouse colors; also create the
1621 mouse cursor and the gray border tile. */
1623 static char cursor_bits
[] =
1625 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
1626 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
1627 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
1628 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00
1635 XGCValues gc_values
;
1641 /* Create the GC's of this frame.
1642 Note that many default values are used. */
1645 gc_values
.font
= f
->display
.x
->font
->fid
;
1646 gc_values
.foreground
= f
->display
.x
->foreground_pixel
;
1647 gc_values
.background
= f
->display
.x
->background_pixel
;
1648 gc_values
.line_width
= 0; /* Means 1 using fast algorithm. */
1649 f
->display
.x
->normal_gc
= XCreateGC (x_current_display
,
1651 GCLineWidth
| GCFont
1652 | GCForeground
| GCBackground
,
1655 /* Reverse video style. */
1656 gc_values
.foreground
= f
->display
.x
->background_pixel
;
1657 gc_values
.background
= f
->display
.x
->foreground_pixel
;
1658 f
->display
.x
->reverse_gc
= XCreateGC (x_current_display
,
1660 GCFont
| GCForeground
| GCBackground
1664 /* Cursor has cursor-color background, background-color foreground. */
1665 gc_values
.foreground
= f
->display
.x
->background_pixel
;
1666 gc_values
.background
= f
->display
.x
->cursor_pixel
;
1667 gc_values
.fill_style
= FillOpaqueStippled
;
1669 = XCreateBitmapFromData (x_current_display
, ROOT_WINDOW
,
1670 cursor_bits
, 16, 16);
1671 f
->display
.x
->cursor_gc
1672 = XCreateGC (x_current_display
, FRAME_X_WINDOW (f
),
1673 (GCFont
| GCForeground
| GCBackground
1674 | GCFillStyle
| GCStipple
| GCLineWidth
),
1677 /* Create the gray border tile used when the pointer is not in
1678 the frame. Since this depends on the frame's pixel values,
1679 this must be done on a per-frame basis. */
1680 f
->display
.x
->border_tile
1681 = (XCreatePixmapFromBitmapData
1682 (x_current_display
, ROOT_WINDOW
,
1683 gray_bits
, gray_width
, gray_height
,
1684 f
->display
.x
->foreground_pixel
,
1685 f
->display
.x
->background_pixel
,
1686 DefaultDepth (x_current_display
, XDefaultScreen (x_current_display
))));
1690 #endif /* HAVE_X11 */
1692 DEFUN ("x-create-frame", Fx_create_frame
, Sx_create_frame
,
1694 "Make a new X window, which is called a \"frame\" in Emacs terms.\n\
1695 Return an Emacs frame object representing the X window.\n\
1696 ALIST is an alist of frame parameters.\n\
1697 If the parameters specify that the frame should not have a minibuffer,\n\
1698 and do not specify a specific minibuffer window to use,\n\
1699 then `default-minibuffer-frame' must be a frame whose minibuffer can\n\
1700 be shared by the new frame.")
1706 Lisp_Object frame
, tem
;
1708 int minibuffer_only
= 0;
1709 long window_prompting
= 0;
1714 name
= x_get_arg (parms
, Qname
, "title", "Title", string
);
1715 if (XTYPE (name
) != Lisp_String
1716 && ! EQ (name
, Qunbound
)
1718 error ("x-create-frame: name parameter must be a string");
1720 tem
= x_get_arg (parms
, Qminibuffer
, 0, 0, symbol
);
1721 if (EQ (tem
, Qnone
) || NILP (tem
))
1722 f
= make_frame_without_minibuffer (Qnil
);
1723 else if (EQ (tem
, Qonly
))
1725 f
= make_minibuffer_frame ();
1726 minibuffer_only
= 1;
1728 else if (XTYPE (tem
) == Lisp_Window
)
1729 f
= make_frame_without_minibuffer (tem
);
1733 /* Note that X Windows does support scroll bars. */
1734 FRAME_CAN_HAVE_SCROLL_BARS (f
) = 1;
1736 /* Set the name; the functions to which we pass f expect the name to
1738 if (EQ (name
, Qunbound
) || NILP (name
))
1740 f
->name
= build_string (x_id_name
);
1741 f
->explicit_name
= 0;
1746 f
->explicit_name
= 1;
1749 XSET (frame
, Lisp_Frame
, f
);
1750 f
->output_method
= output_x_window
;
1751 f
->display
.x
= (struct x_display
*) xmalloc (sizeof (struct x_display
));
1752 bzero (f
->display
.x
, sizeof (struct x_display
));
1754 /* Note that the frame has no physical cursor right now. */
1755 f
->phys_cursor_x
= -1;
1757 /* Extract the window parameters from the supplied values
1758 that are needed to determine window geometry. */
1762 font
= x_get_arg (parms
, Qfont
, "font", "Font", string
);
1764 /* First, try whatever font the caller has specified. */
1766 font
= x_new_font (f
, XSTRING (font
)->data
);
1767 /* Try out a font which we hope has bold and italic variations. */
1768 if (!STRINGP (font
))
1769 font
= x_new_font (f
, "-misc-fixed-medium-r-normal-*-*-120-*-*-c-*-iso8859-1");
1770 if (! STRINGP (font
))
1771 font
= x_new_font (f
, "-*-*-medium-r-normal-*-*-120-*-*-c-*-iso8859-1");
1772 if (! STRINGP (font
))
1773 /* This was formerly the first thing tried, but it finds too many fonts
1774 and takes too long. */
1775 font
= x_new_font (f
, "-*-*-medium-r-*-*-*-*-*-*-c-*-iso8859-1");
1776 /* If those didn't work, look for something which will at least work. */
1777 if (! STRINGP (font
))
1778 font
= x_new_font (f
, "-*-fixed-*-*-*-*-*-120-*-*-c-*-iso8859-1");
1780 if (! STRINGP (font
))
1781 font
= build_string ("fixed");
1783 x_default_parameter (f
, parms
, Qfont
, font
,
1784 "font", "Font", string
);
1786 x_default_parameter (f
, parms
, Qborder_width
, make_number (2),
1787 "borderwidth", "BorderWidth", number
);
1788 /* This defaults to 2 in order to match xterm. We recognize either
1789 internalBorderWidth or internalBorder (which is what xterm calls
1791 if (NILP (Fassq (Qinternal_border_width
, parms
)))
1795 value
= x_get_arg (parms
, Qinternal_border_width
,
1796 "internalBorder", "BorderWidth", number
);
1797 if (! EQ (value
, Qunbound
))
1798 parms
= Fcons (Fcons (Qinternal_border_width
, value
),
1801 x_default_parameter (f
, parms
, Qinternal_border_width
, make_number (2),
1802 "internalBorderWidth", "BorderWidth", number
);
1803 x_default_parameter (f
, parms
, Qvertical_scroll_bars
, Qt
,
1804 "verticalScrollBars", "ScrollBars", boolean
);
1806 /* Also do the stuff which must be set before the window exists. */
1807 x_default_parameter (f
, parms
, Qforeground_color
, build_string ("black"),
1808 "foreground", "Foreground", string
);
1809 x_default_parameter (f
, parms
, Qbackground_color
, build_string ("white"),
1810 "background", "Background", string
);
1811 x_default_parameter (f
, parms
, Qmouse_color
, build_string ("black"),
1812 "pointerColor", "Foreground", string
);
1813 x_default_parameter (f
, parms
, Qcursor_color
, build_string ("black"),
1814 "cursorColor", "Foreground", string
);
1815 x_default_parameter (f
, parms
, Qborder_color
, build_string ("black"),
1816 "borderColor", "BorderColor", string
);
1818 f
->display
.x
->parent_desc
= ROOT_WINDOW
;
1819 window_prompting
= x_figure_window_size (f
, parms
);
1824 init_frame_faces (f
);
1826 /* We need to do this after creating the X window, so that the
1827 icon-creation functions can say whose icon they're describing. */
1828 x_default_parameter (f
, parms
, Qicon_type
, Qnil
,
1829 "bitmapIcon", "BitmapIcon", symbol
);
1831 x_default_parameter (f
, parms
, Qauto_raise
, Qnil
,
1832 "autoRaise", "AutoRaiseLower", boolean
);
1833 x_default_parameter (f
, parms
, Qauto_lower
, Qnil
,
1834 "autoLower", "AutoRaiseLower", boolean
);
1835 x_default_parameter (f
, parms
, Qcursor_type
, Qbox
,
1836 "cursorType", "CursorType", symbol
);
1838 /* Dimensions, especially f->height, must be done via change_frame_size.
1839 Change will not be effected unless different from the current
1843 f
->height
= f
->width
= 0;
1844 change_frame_size (f
, height
, width
, 1, 0);
1846 x_default_parameter (f
, parms
, Qmenu_bar_lines
, make_number (0),
1847 "menuBarLines", "MenuBarLines", number
);
1850 x_wm_set_size_hint (f
, window_prompting
);
1853 tem
= x_get_arg (parms
, Qunsplittable
, 0, 0, boolean
);
1854 f
->no_split
= minibuffer_only
|| EQ (tem
, Qt
);
1856 /* Make the window appear on the frame and enable display,
1857 unless the caller says not to. */
1859 Lisp_Object visibility
= x_get_arg (parms
, Qvisibility
, 0, 0, symbol
);
1861 if (EQ (visibility
, Qunbound
))
1864 if (EQ (visibility
, Qicon
))
1865 x_iconify_frame (f
);
1866 else if (! NILP (visibility
))
1867 x_make_frame_visible (f
);
1869 /* Must have been Qnil. */
1876 Lisp_Object frame
, tem
;
1878 int pixelwidth
, pixelheight
;
1883 int minibuffer_only
= 0;
1884 Lisp_Object vscroll
, hscroll
;
1886 if (x_current_display
== 0)
1887 error ("X windows are not in use or not initialized");
1889 name
= Fassq (Qname
, parms
);
1891 tem
= x_get_arg (parms
, Qminibuffer
, 0, 0, symbol
);
1892 if (EQ (tem
, Qnone
))
1893 f
= make_frame_without_minibuffer (Qnil
);
1894 else if (EQ (tem
, Qonly
))
1896 f
= make_minibuffer_frame ();
1897 minibuffer_only
= 1;
1899 else if (EQ (tem
, Qnil
) || EQ (tem
, Qunbound
))
1902 f
= make_frame_without_minibuffer (tem
);
1904 parent
= ROOT_WINDOW
;
1906 XSET (frame
, Lisp_Frame
, f
);
1907 f
->output_method
= output_x_window
;
1908 f
->display
.x
= (struct x_display
*) xmalloc (sizeof (struct x_display
));
1909 bzero (f
->display
.x
, sizeof (struct x_display
));
1911 /* Some temporary default values for height and width. */
1914 f
->display
.x
->left_pos
= -1;
1915 f
->display
.x
->top_pos
= -1;
1917 /* Give the frame a default name (which may be overridden with PARMS). */
1919 strncpy (iconidentity
, ICONTAG
, MAXICID
);
1920 if (gethostname (&iconidentity
[sizeof (ICONTAG
) - 1],
1921 (MAXICID
- 1) - sizeof (ICONTAG
)))
1922 iconidentity
[sizeof (ICONTAG
) - 2] = '\0';
1923 f
->name
= build_string (iconidentity
);
1925 /* Extract some window parameters from the supplied values.
1926 These are the parameters that affect window geometry. */
1928 tem
= x_get_arg (parms
, Qfont
, "BodyFont", 0, string
);
1929 if (EQ (tem
, Qunbound
))
1930 tem
= build_string ("9x15");
1931 x_set_font (f
, tem
, Qnil
);
1932 x_default_parameter (f
, parms
, Qborder_color
,
1933 build_string ("black"), "Border", 0, string
);
1934 x_default_parameter (f
, parms
, Qbackground_color
,
1935 build_string ("white"), "Background", 0, string
);
1936 x_default_parameter (f
, parms
, Qforeground_color
,
1937 build_string ("black"), "Foreground", 0, string
);
1938 x_default_parameter (f
, parms
, Qmouse_color
,
1939 build_string ("black"), "Mouse", 0, string
);
1940 x_default_parameter (f
, parms
, Qcursor_color
,
1941 build_string ("black"), "Cursor", 0, string
);
1942 x_default_parameter (f
, parms
, Qborder_width
,
1943 make_number (2), "BorderWidth", 0, number
);
1944 x_default_parameter (f
, parms
, Qinternal_border_width
,
1945 make_number (4), "InternalBorderWidth", 0, number
);
1946 x_default_parameter (f
, parms
, Qauto_raise
,
1947 Qnil
, "AutoRaise", 0, boolean
);
1949 hscroll
= EQ (x_get_arg (parms
, Qhorizontal_scroll_bar
, 0, 0, boolean
), Qt
);
1950 vscroll
= EQ (x_get_arg (parms
, Qvertical_scroll_bar
, 0, 0, boolean
), Qt
);
1952 if (f
->display
.x
->internal_border_width
< 0)
1953 f
->display
.x
->internal_border_width
= 0;
1955 tem
= x_get_arg (parms
, Qwindow_id
, 0, 0, number
);
1956 if (!EQ (tem
, Qunbound
))
1958 WINDOWINFO_TYPE wininfo
;
1960 Window
*children
, root
;
1962 CHECK_NUMBER (tem
, 0);
1963 FRAME_X_WINDOW (f
) = (Window
) XINT (tem
);
1966 XGetWindowInfo (FRAME_X_WINDOW (f
), &wininfo
);
1967 XQueryTree (FRAME_X_WINDOW (f
), &parent
, &nchildren
, &children
);
1971 height
= PIXEL_TO_CHAR_HEIGHT (f
, wininfo
.height
);
1972 width
= PIXEL_TO_CHAR_WIDTH (f
, wininfo
.width
);
1973 f
->display
.x
->left_pos
= wininfo
.x
;
1974 f
->display
.x
->top_pos
= wininfo
.y
;
1975 FRAME_SET_VISIBILITY (f
, wininfo
.mapped
!= 0);
1976 f
->display
.x
->border_width
= wininfo
.bdrwidth
;
1977 f
->display
.x
->parent_desc
= parent
;
1981 tem
= x_get_arg (parms
, Qparent_id
, 0, 0, number
);
1982 if (!EQ (tem
, Qunbound
))
1984 CHECK_NUMBER (tem
, 0);
1985 parent
= (Window
) XINT (tem
);
1987 f
->display
.x
->parent_desc
= parent
;
1988 tem
= x_get_arg (parms
, Qheight
, 0, 0, number
);
1989 if (EQ (tem
, Qunbound
))
1991 tem
= x_get_arg (parms
, Qwidth
, 0, 0, number
);
1992 if (EQ (tem
, Qunbound
))
1994 tem
= x_get_arg (parms
, Qtop
, 0, 0, number
);
1995 if (EQ (tem
, Qunbound
))
1996 tem
= x_get_arg (parms
, Qleft
, 0, 0, number
);
1999 /* Now TEM is Qunbound if no edge or size was specified.
2000 In that case, we must do rubber-banding. */
2001 if (EQ (tem
, Qunbound
))
2003 tem
= x_get_arg (parms
, Qgeometry
, 0, 0, number
);
2005 &f
->display
.x
->left_pos
, &f
->display
.x
->top_pos
,
2007 (XTYPE (tem
) == Lisp_String
2008 ? (char *) XSTRING (tem
)->data
: ""),
2009 XSTRING (f
->name
)->data
,
2010 !NILP (hscroll
), !NILP (vscroll
));
2014 /* Here if at least one edge or size was specified.
2015 Demand that they all were specified, and use them. */
2016 tem
= x_get_arg (parms
, Qheight
, 0, 0, number
);
2017 if (EQ (tem
, Qunbound
))
2018 error ("Height not specified");
2019 CHECK_NUMBER (tem
, 0);
2020 height
= XINT (tem
);
2022 tem
= x_get_arg (parms
, Qwidth
, 0, 0, number
);
2023 if (EQ (tem
, Qunbound
))
2024 error ("Width not specified");
2025 CHECK_NUMBER (tem
, 0);
2028 tem
= x_get_arg (parms
, Qtop
, 0, 0, number
);
2029 if (EQ (tem
, Qunbound
))
2030 error ("Top position not specified");
2031 CHECK_NUMBER (tem
, 0);
2032 f
->display
.x
->left_pos
= XINT (tem
);
2034 tem
= x_get_arg (parms
, Qleft
, 0, 0, number
);
2035 if (EQ (tem
, Qunbound
))
2036 error ("Left position not specified");
2037 CHECK_NUMBER (tem
, 0);
2038 f
->display
.x
->top_pos
= XINT (tem
);
2041 pixelwidth
= CHAR_TO_PIXEL_WIDTH (f
, width
);
2042 pixelheight
= CHAR_TO_PIXEL_HEIGHT (f
, height
);
2046 = XCreateWindow (parent
,
2047 f
->display
.x
->left_pos
, /* Absolute horizontal offset */
2048 f
->display
.x
->top_pos
, /* Absolute Vertical offset */
2049 pixelwidth
, pixelheight
,
2050 f
->display
.x
->border_width
,
2051 BLACK_PIX_DEFAULT
, WHITE_PIX_DEFAULT
);
2053 if (FRAME_X_WINDOW (f
) == 0)
2054 error ("Unable to create window.");
2057 /* Install the now determined height and width
2058 in the windows and in phys_lines and desired_lines. */
2059 change_frame_size (f
, height
, width
, 1, 0);
2060 XSelectInput (FRAME_X_WINDOW (f
), KeyPressed
| ExposeWindow
2061 | ButtonPressed
| ButtonReleased
| ExposeRegion
| ExposeCopy
2062 | EnterWindow
| LeaveWindow
| UnmapWindow
);
2063 x_set_resize_hint (f
);
2065 /* Tell the server the window's default name. */
2066 XStoreName (XDISPLAY
FRAME_X_WINDOW (f
), XSTRING (f
->name
)->data
);
2068 /* Now override the defaults with all the rest of the specified
2070 tem
= x_get_arg (parms
, Qunsplittable
, 0, 0, boolean
);
2071 f
->no_split
= minibuffer_only
|| EQ (tem
, Qt
);
2073 /* Do not create an icon window if the caller says not to */
2074 if (!EQ (x_get_arg (parms
, Qsuppress_icon
, 0, 0, boolean
), Qt
)
2075 || f
->display
.x
->parent_desc
!= ROOT_WINDOW
)
2077 x_text_icon (f
, iconidentity
);
2078 x_default_parameter (f
, parms
, Qicon_type
, Qnil
,
2079 "BitmapIcon", 0, symbol
);
2082 /* Tell the X server the previously set values of the
2083 background, border and mouse colors; also create the mouse cursor. */
2085 temp
= XMakeTile (f
->display
.x
->background_pixel
);
2086 XChangeBackground (FRAME_X_WINDOW (f
), temp
);
2089 x_set_border_pixel (f
, f
->display
.x
->border_pixel
);
2091 x_set_mouse_color (f
, Qnil
, Qnil
);
2093 /* Now override the defaults with all the rest of the specified parms. */
2095 Fmodify_frame_parameters (frame
, parms
);
2097 /* Make the window appear on the frame and enable display. */
2099 Lisp_Object visibility
= x_get_arg (parms
, Qvisibility
, 0, 0, symbol
);
2101 if (EQ (visibility
, Qunbound
))
2104 if (! EQ (visibility
, Qicon
)
2105 && ! NILP (visibility
))
2106 x_make_window_visible (f
);
2109 SET_FRAME_GARBAGED (f
);
2115 DEFUN ("focus-frame", Ffocus_frame
, Sfocus_frame
, 1, 1, 0,
2116 "Set the focus on FRAME.")
2120 CHECK_LIVE_FRAME (frame
, 0);
2122 if (FRAME_X_P (XFRAME (frame
)))
2125 x_focus_on_frame (XFRAME (frame
));
2133 DEFUN ("unfocus-frame", Funfocus_frame
, Sunfocus_frame
, 0, 0, 0,
2134 "If a frame has been focused, release it.")
2140 x_unfocus_frame (x_focus_frame
);
2148 /* Computes an X-window size and position either from geometry GEO
2151 F is a frame. It specifies an X window which is used to
2152 determine which display to compute for. Its font, borders
2153 and colors control how the rectangle will be displayed.
2155 X and Y are where to store the positions chosen.
2156 WIDTH and HEIGHT are where to store the sizes chosen.
2158 GEO is the geometry that may specify some of the info.
2159 STR is a prompt to display.
2160 HSCROLL and VSCROLL say whether we have horiz and vert scroll bars. */
2163 x_rubber_band (f
, x
, y
, width
, height
, geo
, str
, hscroll
, vscroll
)
2165 int *x
, *y
, *width
, *height
;
2168 int hscroll
, vscroll
;
2174 int background_color
;
2180 background_color
= f
->display
.x
->background_pixel
;
2181 border_color
= f
->display
.x
->border_pixel
;
2183 frame
.bdrwidth
= f
->display
.x
->border_width
;
2184 frame
.border
= XMakeTile (border_color
);
2185 frame
.background
= XMakeTile (background_color
);
2186 tempwindow
= XCreateTerm (str
, "emacs", geo
, default_window
, &frame
, 10, 5,
2187 (2 * f
->display
.x
->internal_border_width
2188 + (vscroll
? VSCROLL_WIDTH
: 0)),
2189 (2 * f
->display
.x
->internal_border_width
2190 + (hscroll
? HSCROLL_HEIGHT
: 0)),
2191 width
, height
, f
->display
.x
->font
,
2192 FONT_WIDTH (f
->display
.x
->font
),
2193 FONT_HEIGHT (f
->display
.x
->font
));
2194 XFreePixmap (frame
.border
);
2195 XFreePixmap (frame
.background
);
2197 if (tempwindow
!= 0)
2199 XQueryWindow (tempwindow
, &wininfo
);
2200 XDestroyWindow (tempwindow
);
2205 /* Coordinates we got are relative to the root window.
2206 Convert them to coordinates relative to desired parent window
2207 by scanning from there up to the root. */
2208 tempwindow
= f
->display
.x
->parent_desc
;
2209 while (tempwindow
!= ROOT_WINDOW
)
2213 XQueryWindow (tempwindow
, &wininfo
);
2216 XQueryTree (tempwindow
, &tempwindow
, &nchildren
, &children
);
2221 return tempwindow
!= 0;
2223 #endif /* not HAVE_X11 */
2225 DEFUN ("x-list-fonts", Fx_list_fonts
, Sx_list_fonts
, 1, 3, 0,
2226 "Return a list of the names of available fonts matching PATTERN.\n\
2227 If optional arguments FACE and FRAME are specified, return only fonts\n\
2228 the same size as FACE on FRAME.\n\
2230 PATTERN is a string, perhaps with wildcard characters;\n\
2231 the * character matches any substring, and\n\
2232 the ? character matches any single character.\n\
2233 PATTERN is case-insensitive.\n\
2234 FACE is a face name - a symbol.\n\
2236 The return value is a list of strings, suitable as arguments to\n\
2239 The list does not include fonts Emacs can't use (i.e. proportional\n\
2240 fonts), even if they match PATTERN and FACE.")
2241 (pattern
, face
, frame
)
2242 Lisp_Object pattern
, face
, frame
;
2247 XFontStruct
*size_ref
;
2250 CHECK_STRING (pattern
, 0);
2252 CHECK_SYMBOL (face
, 1);
2254 CHECK_LIVE_FRAME (frame
, 2);
2260 FRAME_PTR f
= NILP (frame
) ? selected_frame
: XFRAME (frame
);
2261 int face_id
= face_name_id_number (f
, face
);
2263 if (face_id
< 0 || face_id
>= FRAME_N_PARAM_FACES (f
)
2264 || FRAME_PARAM_FACES (f
) [face_id
] == 0)
2265 size_ref
= f
->display
.x
->font
;
2268 size_ref
= FRAME_PARAM_FACES (f
) [face_id
]->font
;
2269 if (size_ref
== (XFontStruct
*) (~0))
2270 size_ref
= f
->display
.x
->font
;
2275 names
= XListFontsWithInfo (x_current_display
,
2276 XSTRING (pattern
)->data
,
2277 2000, /* maxnames */
2278 &num_fonts
, /* count_return */
2279 &info
); /* info_return */
2290 for (i
= 0; i
< num_fonts
; i
++)
2292 || same_size_fonts (&info
[i
], size_ref
))
2294 *tail
= Fcons (build_string (names
[i
]), Qnil
);
2295 tail
= &XCONS (*tail
)->cdr
;
2298 XFreeFontInfo (names
, info
, num_fonts
);
2305 DEFUN ("x-color-defined-p", Fx_color_defined_p
, Sx_color_defined_p
, 1, 1, 0,
2306 "Return t if the current X display supports the color named COLOR.")
2313 CHECK_STRING (color
, 0);
2315 if (defined_color (XSTRING (color
)->data
, &foo
))
2321 DEFUN ("x-display-color-p", Fx_display_color_p
, Sx_display_color_p
, 0, 0, 0,
2322 "Return t if the X screen currently in use supports color.")
2327 if (x_screen_planes
<= 2)
2330 switch (screen_visual
->class)
2343 DEFUN ("x-display-pixel-width", Fx_display_pixel_width
, Sx_display_pixel_width
,
2345 "Returns the width in pixels of the display FRAME is on.")
2349 Display
*dpy
= x_current_display
;
2351 return make_number (DisplayWidth (dpy
, DefaultScreen (dpy
)));
2354 DEFUN ("x-display-pixel-height", Fx_display_pixel_height
,
2355 Sx_display_pixel_height
, 0, 1, 0,
2356 "Returns the height in pixels of the display FRAME is on.")
2360 Display
*dpy
= x_current_display
;
2362 return make_number (DisplayHeight (dpy
, DefaultScreen (dpy
)));
2365 DEFUN ("x-display-planes", Fx_display_planes
, Sx_display_planes
,
2367 "Returns the number of bitplanes of the display FRAME is on.")
2371 Display
*dpy
= x_current_display
;
2373 return make_number (DisplayPlanes (dpy
, DefaultScreen (dpy
)));
2376 DEFUN ("x-display-color-cells", Fx_display_color_cells
, Sx_display_color_cells
,
2378 "Returns the number of color cells of the display FRAME is on.")
2382 Display
*dpy
= x_current_display
;
2384 return make_number (DisplayCells (dpy
, DefaultScreen (dpy
)));
2387 DEFUN ("x-server-max-request-size", Fx_server_max_request_size
,
2388 Sx_server_max_request_size
,
2390 "Returns the maximum request size of the X server FRAME is using.")
2394 Display
*dpy
= x_current_display
;
2396 return make_number (MAXREQUEST (dpy
));
2399 DEFUN ("x-server-vendor", Fx_server_vendor
, Sx_server_vendor
, 0, 1, 0,
2400 "Returns the vendor ID string of the X server FRAME is on.")
2404 Display
*dpy
= x_current_display
;
2407 vendor
= ServerVendor (dpy
);
2408 if (! vendor
) vendor
= "";
2409 return build_string (vendor
);
2412 DEFUN ("x-server-version", Fx_server_version
, Sx_server_version
, 0, 1, 0,
2413 "Returns the version numbers of the X server in use.\n\
2414 The value is a list of three integers: the major and minor\n\
2415 version numbers of the X Protocol in use, and the vendor-specific release\n\
2416 number. See also the variable `x-server-vendor'.")
2420 Display
*dpy
= x_current_display
;
2423 return Fcons (make_number (ProtocolVersion (dpy
)),
2424 Fcons (make_number (ProtocolRevision (dpy
)),
2425 Fcons (make_number (VendorRelease (dpy
)), Qnil
)));
2428 DEFUN ("x-display-screens", Fx_display_screens
, Sx_display_screens
, 0, 1, 0,
2429 "Returns the number of screens on the X server FRAME is on.")
2434 return make_number (ScreenCount (x_current_display
));
2437 DEFUN ("x-display-mm-height", Fx_display_mm_height
, Sx_display_mm_height
, 0, 1, 0,
2438 "Returns the height in millimeters of the X screen FRAME is on.")
2443 return make_number (HeightMMOfScreen (x_screen
));
2446 DEFUN ("x-display-mm-width", Fx_display_mm_width
, Sx_display_mm_width
, 0, 1, 0,
2447 "Returns the width in millimeters of the X screen FRAME is on.")
2452 return make_number (WidthMMOfScreen (x_screen
));
2455 DEFUN ("x-display-backing-store", Fx_display_backing_store
,
2456 Sx_display_backing_store
, 0, 1, 0,
2457 "Returns an indication of whether the X screen FRAME is on does backing store.\n\
2458 The value may be `always', `when-mapped', or `not-useful'.")
2464 switch (DoesBackingStore (x_screen
))
2467 return intern ("always");
2470 return intern ("when-mapped");
2473 return intern ("not-useful");
2476 error ("Strange value for BackingStore parameter of screen");
2480 DEFUN ("x-display-visual-class", Fx_display_visual_class
,
2481 Sx_display_visual_class
, 0, 1, 0,
2482 "Returns the visual class of the display `screen' is on.\n\
2483 The value is one of the symbols `static-gray', `gray-scale',\n\
2484 `static-color', `pseudo-color', `true-color', or `direct-color'.")
2490 switch (screen_visual
->class)
2492 case StaticGray
: return (intern ("static-gray"));
2493 case GrayScale
: return (intern ("gray-scale"));
2494 case StaticColor
: return (intern ("static-color"));
2495 case PseudoColor
: return (intern ("pseudo-color"));
2496 case TrueColor
: return (intern ("true-color"));
2497 case DirectColor
: return (intern ("direct-color"));
2499 error ("Display has an unknown visual class");
2503 DEFUN ("x-display-save-under", Fx_display_save_under
,
2504 Sx_display_save_under
, 0, 1, 0,
2505 "Returns t if the X screen FRAME is on supports the save-under feature.")
2511 if (DoesSaveUnders (x_screen
) == True
)
2518 register struct frame
*f
;
2520 return PIXEL_WIDTH (f
);
2524 register struct frame
*f
;
2526 return PIXEL_HEIGHT (f
);
2530 register struct frame
*f
;
2532 return FONT_WIDTH (f
->display
.x
->font
);
2536 register struct frame
*f
;
2538 return FONT_HEIGHT (f
->display
.x
->font
);
2541 #if 0 /* These no longer seem like the right way to do things. */
2543 /* Draw a rectangle on the frame with left top corner including
2544 the character specified by LEFT_CHAR and TOP_CHAR. The rectangle is
2545 CHARS by LINES wide and long and is the color of the cursor. */
2548 x_rectangle (f
, gc
, left_char
, top_char
, chars
, lines
)
2549 register struct frame
*f
;
2551 register int top_char
, left_char
, chars
, lines
;
2555 int left
= (left_char
* FONT_WIDTH (f
->display
.x
->font
)
2556 + f
->display
.x
->internal_border_width
);
2557 int top
= (top_char
* FONT_HEIGHT (f
->display
.x
->font
)
2558 + f
->display
.x
->internal_border_width
);
2561 width
= FONT_WIDTH (f
->display
.x
->font
) / 2;
2563 width
= FONT_WIDTH (f
->display
.x
->font
) * chars
;
2565 height
= FONT_HEIGHT (f
->display
.x
->font
) / 2;
2567 height
= FONT_HEIGHT (f
->display
.x
->font
) * lines
;
2569 XDrawRectangle (x_current_display
, FRAME_X_WINDOW (f
),
2570 gc
, left
, top
, width
, height
);
2573 DEFUN ("x-draw-rectangle", Fx_draw_rectangle
, Sx_draw_rectangle
, 5, 5, 0,
2574 "Draw a rectangle on FRAME between coordinates specified by\n\
2575 numbers X0, Y0, X1, Y1 in the cursor pixel.")
2576 (frame
, X0
, Y0
, X1
, Y1
)
2577 register Lisp_Object frame
, X0
, X1
, Y0
, Y1
;
2579 register int x0
, y0
, x1
, y1
, top
, left
, n_chars
, n_lines
;
2581 CHECK_LIVE_FRAME (frame
, 0);
2582 CHECK_NUMBER (X0
, 0);
2583 CHECK_NUMBER (Y0
, 1);
2584 CHECK_NUMBER (X1
, 2);
2585 CHECK_NUMBER (Y1
, 3);
2595 n_lines
= y1
- y0
+ 1;
2600 n_lines
= y0
- y1
+ 1;
2606 n_chars
= x1
- x0
+ 1;
2611 n_chars
= x0
- x1
+ 1;
2615 x_rectangle (XFRAME (frame
), XFRAME (frame
)->display
.x
->cursor_gc
,
2616 left
, top
, n_chars
, n_lines
);
2622 DEFUN ("x-erase-rectangle", Fx_erase_rectangle
, Sx_erase_rectangle
, 5, 5, 0,
2623 "Draw a rectangle drawn on FRAME between coordinates\n\
2624 X0, Y0, X1, Y1 in the regular background-pixel.")
2625 (frame
, X0
, Y0
, X1
, Y1
)
2626 register Lisp_Object frame
, X0
, Y0
, X1
, Y1
;
2628 register int x0
, y0
, x1
, y1
, top
, left
, n_chars
, n_lines
;
2630 CHECK_FRAME (frame
, 0);
2631 CHECK_NUMBER (X0
, 0);
2632 CHECK_NUMBER (Y0
, 1);
2633 CHECK_NUMBER (X1
, 2);
2634 CHECK_NUMBER (Y1
, 3);
2644 n_lines
= y1
- y0
+ 1;
2649 n_lines
= y0
- y1
+ 1;
2655 n_chars
= x1
- x0
+ 1;
2660 n_chars
= x0
- x1
+ 1;
2664 x_rectangle (XFRAME (frame
), XFRAME (frame
)->display
.x
->reverse_gc
,
2665 left
, top
, n_chars
, n_lines
);
2671 /* Draw lines around the text region beginning at the character position
2672 TOP_X, TOP_Y and ending at BOTTOM_X and BOTTOM_Y. GC specifies the
2673 pixel and line characteristics. */
2675 #define line_len(line) (FRAME_CURRENT_GLYPHS (f)->used[(line)])
2678 outline_region (f
, gc
, top_x
, top_y
, bottom_x
, bottom_y
)
2679 register struct frame
*f
;
2681 int top_x
, top_y
, bottom_x
, bottom_y
;
2683 register int ibw
= f
->display
.x
->internal_border_width
;
2684 register int font_w
= FONT_WIDTH (f
->display
.x
->font
);
2685 register int font_h
= FONT_HEIGHT (f
->display
.x
->font
);
2687 int x
= line_len (y
);
2688 XPoint
*pixel_points
= (XPoint
*)
2689 alloca (((bottom_y
- top_y
+ 2) * 4) * sizeof (XPoint
));
2690 register XPoint
*this_point
= pixel_points
;
2692 /* Do the horizontal top line/lines */
2695 this_point
->x
= ibw
;
2696 this_point
->y
= ibw
+ (font_h
* top_y
);
2699 this_point
->x
= ibw
+ (font_w
/ 2); /* Half-size for newline chars. */
2701 this_point
->x
= ibw
+ (font_w
* x
);
2702 this_point
->y
= (this_point
- 1)->y
;
2706 this_point
->x
= ibw
;
2707 this_point
->y
= ibw
+ (font_h
* (top_y
+ 1));
2709 this_point
->x
= ibw
+ (font_w
* top_x
);
2710 this_point
->y
= (this_point
- 1)->y
;
2712 this_point
->x
= (this_point
- 1)->x
;
2713 this_point
->y
= ibw
+ (font_h
* top_y
);
2715 this_point
->x
= ibw
+ (font_w
* x
);
2716 this_point
->y
= (this_point
- 1)->y
;
2719 /* Now do the right side. */
2720 while (y
< bottom_y
)
2721 { /* Right vertical edge */
2723 this_point
->x
= (this_point
- 1)->x
;
2724 this_point
->y
= ibw
+ (font_h
* (y
+ 1));
2727 y
++; /* Horizontal connection to next line */
2730 this_point
->x
= ibw
+ (font_w
/ 2);
2732 this_point
->x
= ibw
+ (font_w
* x
);
2734 this_point
->y
= (this_point
- 1)->y
;
2737 /* Now do the bottom and connect to the top left point. */
2738 this_point
->x
= ibw
+ (font_w
* (bottom_x
+ 1));
2741 this_point
->x
= (this_point
- 1)->x
;
2742 this_point
->y
= ibw
+ (font_h
* (bottom_y
+ 1));
2744 this_point
->x
= ibw
;
2745 this_point
->y
= (this_point
- 1)->y
;
2747 this_point
->x
= pixel_points
->x
;
2748 this_point
->y
= pixel_points
->y
;
2750 XDrawLines (x_current_display
, FRAME_X_WINDOW (f
),
2752 (this_point
- pixel_points
+ 1), CoordModeOrigin
);
2755 DEFUN ("x-contour-region", Fx_contour_region
, Sx_contour_region
, 1, 1, 0,
2756 "Highlight the region between point and the character under the mouse\n\
2759 register Lisp_Object event
;
2761 register int x0
, y0
, x1
, y1
;
2762 register struct frame
*f
= selected_frame
;
2763 register int p1
, p2
;
2765 CHECK_CONS (event
, 0);
2768 x0
= XINT (Fcar (Fcar (event
)));
2769 y0
= XINT (Fcar (Fcdr (Fcar (event
))));
2771 /* If the mouse is past the end of the line, don't that area. */
2772 /* ReWrite this... */
2777 if (y1
> y0
) /* point below mouse */
2778 outline_region (f
, f
->display
.x
->cursor_gc
,
2780 else if (y1
< y0
) /* point above mouse */
2781 outline_region (f
, f
->display
.x
->cursor_gc
,
2783 else /* same line: draw horizontal rectangle */
2786 x_rectangle (f
, f
->display
.x
->cursor_gc
,
2787 x0
, y0
, (x1
- x0
+ 1), 1);
2789 x_rectangle (f
, f
->display
.x
->cursor_gc
,
2790 x1
, y1
, (x0
- x1
+ 1), 1);
2793 XFlush (x_current_display
);
2799 DEFUN ("x-uncontour-region", Fx_uncontour_region
, Sx_uncontour_region
, 1, 1, 0,
2800 "Erase any highlighting of the region between point and the character\n\
2801 at X, Y on the selected frame.")
2803 register Lisp_Object event
;
2805 register int x0
, y0
, x1
, y1
;
2806 register struct frame
*f
= selected_frame
;
2809 x0
= XINT (Fcar (Fcar (event
)));
2810 y0
= XINT (Fcar (Fcdr (Fcar (event
))));
2814 if (y1
> y0
) /* point below mouse */
2815 outline_region (f
, f
->display
.x
->reverse_gc
,
2817 else if (y1
< y0
) /* point above mouse */
2818 outline_region (f
, f
->display
.x
->reverse_gc
,
2820 else /* same line: draw horizontal rectangle */
2823 x_rectangle (f
, f
->display
.x
->reverse_gc
,
2824 x0
, y0
, (x1
- x0
+ 1), 1);
2826 x_rectangle (f
, f
->display
.x
->reverse_gc
,
2827 x1
, y1
, (x0
- x1
+ 1), 1);
2835 int contour_begin_x
, contour_begin_y
;
2836 int contour_end_x
, contour_end_y
;
2837 int contour_npoints
;
2839 /* Clip the top part of the contour lines down (and including) line Y_POS.
2840 If X_POS is in the middle (rather than at the end) of the line, drop
2841 down a line at that character. */
2844 clip_contour_top (y_pos
, x_pos
)
2846 register XPoint
*begin
= contour_lines
[y_pos
].top_left
;
2847 register XPoint
*end
;
2848 register int npoints
;
2849 register struct display_line
*line
= selected_frame
->phys_lines
[y_pos
+ 1];
2851 if (x_pos
>= line
->len
- 1) /* Draw one, straight horizontal line. */
2853 end
= contour_lines
[y_pos
].top_right
;
2854 npoints
= (end
- begin
+ 1);
2855 XDrawLines (x_current_display
, contour_window
,
2856 contour_erase_gc
, begin_erase
, npoints
, CoordModeOrigin
);
2858 bcopy (end
, begin
+ 1, contour_last_point
- end
+ 1);
2859 contour_last_point
-= (npoints
- 2);
2860 XDrawLines (x_current_display
, contour_window
,
2861 contour_erase_gc
, begin
, 2, CoordModeOrigin
);
2862 XFlush (x_current_display
);
2864 /* Now, update contour_lines structure. */
2869 register XPoint
*p
= begin
+ 1;
2870 end
= contour_lines
[y_pos
].bottom_right
;
2871 npoints
= (end
- begin
+ 1);
2872 XDrawLines (x_current_display
, contour_window
,
2873 contour_erase_gc
, begin_erase
, npoints
, CoordModeOrigin
);
2876 p
->x
= ibw
+ (font_w
* (x_pos
+ 1));
2878 p
->y
= begin
->y
+ font_h
;
2880 bcopy (end
, begin
+ 3, contour_last_point
- end
+ 1);
2881 contour_last_point
-= (npoints
- 5);
2882 XDrawLines (x_current_display
, contour_window
,
2883 contour_erase_gc
, begin
, 4, CoordModeOrigin
);
2884 XFlush (x_current_display
);
2886 /* Now, update contour_lines structure. */
2890 /* Erase the top horizontal lines of the contour, and then extend
2891 the contour upwards. */
2894 extend_contour_top (line
)
2899 clip_contour_bottom (x_pos
, y_pos
)
2905 extend_contour_bottom (x_pos
, y_pos
)
2909 DEFUN ("x-select-region", Fx_select_region
, Sx_select_region
, 1, 1, "e",
2914 register struct frame
*f
= selected_frame
;
2915 register int point_x
= f
->cursor_x
;
2916 register int point_y
= f
->cursor_y
;
2917 register int mouse_below_point
;
2918 register Lisp_Object obj
;
2919 register int x_contour_x
, x_contour_y
;
2921 x_contour_x
= x_mouse_x
;
2922 x_contour_y
= x_mouse_y
;
2923 if (x_contour_y
> point_y
|| (x_contour_y
== point_y
2924 && x_contour_x
> point_x
))
2926 mouse_below_point
= 1;
2927 outline_region (f
, f
->display
.x
->cursor_gc
, point_x
, point_y
,
2928 x_contour_x
, x_contour_y
);
2932 mouse_below_point
= 0;
2933 outline_region (f
, f
->display
.x
->cursor_gc
, x_contour_x
, x_contour_y
,
2939 obj
= read_char (-1, 0, 0, Qnil
, 0);
2940 if (XTYPE (obj
) != Lisp_Cons
)
2943 if (mouse_below_point
)
2945 if (x_mouse_y
<= point_y
) /* Flipped. */
2947 mouse_below_point
= 0;
2949 outline_region (f
, f
->display
.x
->reverse_gc
, point_x
, point_y
,
2950 x_contour_x
, x_contour_y
);
2951 outline_region (f
, f
->display
.x
->cursor_gc
, x_mouse_x
, x_mouse_y
,
2954 else if (x_mouse_y
< x_contour_y
) /* Bottom clipped. */
2956 clip_contour_bottom (x_mouse_y
);
2958 else if (x_mouse_y
> x_contour_y
) /* Bottom extended. */
2960 extend_bottom_contour (x_mouse_y
);
2963 x_contour_x
= x_mouse_x
;
2964 x_contour_y
= x_mouse_y
;
2966 else /* mouse above or same line as point */
2968 if (x_mouse_y
>= point_y
) /* Flipped. */
2970 mouse_below_point
= 1;
2972 outline_region (f
, f
->display
.x
->reverse_gc
,
2973 x_contour_x
, x_contour_y
, point_x
, point_y
);
2974 outline_region (f
, f
->display
.x
->cursor_gc
, point_x
, point_y
,
2975 x_mouse_x
, x_mouse_y
);
2977 else if (x_mouse_y
> x_contour_y
) /* Top clipped. */
2979 clip_contour_top (x_mouse_y
);
2981 else if (x_mouse_y
< x_contour_y
) /* Top extended. */
2983 extend_contour_top (x_mouse_y
);
2988 unread_command_event
= obj
;
2989 if (mouse_below_point
)
2991 contour_begin_x
= point_x
;
2992 contour_begin_y
= point_y
;
2993 contour_end_x
= x_contour_x
;
2994 contour_end_y
= x_contour_y
;
2998 contour_begin_x
= x_contour_x
;
2999 contour_begin_y
= x_contour_y
;
3000 contour_end_x
= point_x
;
3001 contour_end_y
= point_y
;
3006 DEFUN ("x-horizontal-line", Fx_horizontal_line
, Sx_horizontal_line
, 1, 1, "e",
3011 register Lisp_Object obj
;
3012 struct frame
*f
= selected_frame
;
3013 register struct window
*w
= XWINDOW (selected_window
);
3014 register GC line_gc
= f
->display
.x
->cursor_gc
;
3015 register GC erase_gc
= f
->display
.x
->reverse_gc
;
3017 char dash_list
[] = {6, 4, 6, 4};
3019 XGCValues gc_values
;
3021 register int previous_y
;
3022 register int line
= (x_mouse_y
+ 1) * FONT_HEIGHT (f
->display
.x
->font
)
3023 + f
->display
.x
->internal_border_width
;
3024 register int left
= f
->display
.x
->internal_border_width
3026 * FONT_WIDTH (f
->display
.x
->font
));
3027 register int right
= left
+ (w
->width
3028 * FONT_WIDTH (f
->display
.x
->font
))
3029 - f
->display
.x
->internal_border_width
;
3033 gc_values
.foreground
= f
->display
.x
->cursor_pixel
;
3034 gc_values
.background
= f
->display
.x
->background_pixel
;
3035 gc_values
.line_width
= 1;
3036 gc_values
.line_style
= LineOnOffDash
;
3037 gc_values
.cap_style
= CapRound
;
3038 gc_values
.join_style
= JoinRound
;
3040 line_gc
= XCreateGC (x_current_display
, FRAME_X_WINDOW (f
),
3041 GCLineStyle
| GCJoinStyle
| GCCapStyle
3042 | GCLineWidth
| GCForeground
| GCBackground
,
3044 XSetDashes (x_current_display
, line_gc
, 0, dash_list
, dashes
);
3045 gc_values
.foreground
= f
->display
.x
->background_pixel
;
3046 gc_values
.background
= f
->display
.x
->foreground_pixel
;
3047 erase_gc
= XCreateGC (x_current_display
, FRAME_X_WINDOW (f
),
3048 GCLineStyle
| GCJoinStyle
| GCCapStyle
3049 | GCLineWidth
| GCForeground
| GCBackground
,
3051 XSetDashes (x_current_display
, erase_gc
, 0, dash_list
, dashes
);
3057 if (x_mouse_y
>= XINT (w
->top
)
3058 && x_mouse_y
< XINT (w
->top
) + XINT (w
->height
) - 1)
3060 previous_y
= x_mouse_y
;
3061 line
= (x_mouse_y
+ 1) * FONT_HEIGHT (f
->display
.x
->font
)
3062 + f
->display
.x
->internal_border_width
;
3063 XDrawLine (x_current_display
, FRAME_X_WINDOW (f
),
3064 line_gc
, left
, line
, right
, line
);
3071 obj
= read_char (-1, 0, 0, Qnil
, 0);
3072 if ((XTYPE (obj
) != Lisp_Cons
)
3073 || (! EQ (Fcar (Fcdr (Fcdr (obj
))),
3074 Qvertical_scroll_bar
))
3078 XDrawLine (x_current_display
, FRAME_X_WINDOW (f
),
3079 erase_gc
, left
, line
, right
, line
);
3081 unread_command_event
= obj
;
3083 XFreeGC (x_current_display
, line_gc
);
3084 XFreeGC (x_current_display
, erase_gc
);
3089 while (x_mouse_y
== previous_y
);
3092 XDrawLine (x_current_display
, FRAME_X_WINDOW (f
),
3093 erase_gc
, left
, line
, right
, line
);
3099 /* Offset in buffer of character under the pointer, or 0. */
3100 int mouse_buffer_offset
;
3103 /* These keep track of the rectangle following the pointer. */
3104 int mouse_track_top
, mouse_track_left
, mouse_track_width
;
3106 DEFUN ("x-track-pointer", Fx_track_pointer
, Sx_track_pointer
, 0, 0, 0,
3107 "Track the pointer.")
3110 static Cursor current_pointer_shape
;
3111 FRAME_PTR f
= x_mouse_frame
;
3114 if (EQ (Vmouse_frame_part
, Qtext_part
)
3115 && (current_pointer_shape
!= f
->display
.x
->nontext_cursor
))
3120 current_pointer_shape
= f
->display
.x
->nontext_cursor
;
3121 XDefineCursor (x_current_display
,
3123 current_pointer_shape
);
3125 buf
= XBUFFER (XWINDOW (Vmouse_window
)->buffer
);
3126 c
= *(BUF_CHAR_ADDRESS (buf
, mouse_buffer_offset
));
3128 else if (EQ (Vmouse_frame_part
, Qmodeline_part
)
3129 && (current_pointer_shape
!= f
->display
.x
->modeline_cursor
))
3131 current_pointer_shape
= f
->display
.x
->modeline_cursor
;
3132 XDefineCursor (x_current_display
,
3134 current_pointer_shape
);
3143 DEFUN ("x-track-pointer", Fx_track_pointer
, Sx_track_pointer
, 1, 1, "e",
3144 "Draw rectangle around character under mouse pointer, if there is one.")
3148 struct window
*w
= XWINDOW (Vmouse_window
);
3149 struct frame
*f
= XFRAME (WINDOW_FRAME (w
));
3150 struct buffer
*b
= XBUFFER (w
->buffer
);
3153 if (! EQ (Vmouse_window
, selected_window
))
3156 if (EQ (event
, Qnil
))
3160 x_read_mouse_position (selected_frame
, &x
, &y
);
3164 mouse_track_width
= 0;
3165 mouse_track_left
= mouse_track_top
= -1;
3169 if ((x_mouse_x
!= mouse_track_left
3170 && (x_mouse_x
< mouse_track_left
3171 || x_mouse_x
> (mouse_track_left
+ mouse_track_width
)))
3172 || x_mouse_y
!= mouse_track_top
)
3174 int hp
= 0; /* Horizontal position */
3175 int len
= FRAME_CURRENT_GLYPHS (f
)->used
[x_mouse_y
];
3176 int p
= FRAME_CURRENT_GLYPHS (f
)->bufp
[x_mouse_y
];
3177 int tab_width
= XINT (b
->tab_width
);
3178 int ctl_arrow_p
= !NILP (b
->ctl_arrow
);
3180 int mode_line_vpos
= XFASTINT (w
->height
) + XFASTINT (w
->top
) - 1;
3181 int in_mode_line
= 0;
3183 if (! FRAME_CURRENT_GLYPHS (f
)->enable
[x_mouse_y
])
3186 /* Erase previous rectangle. */
3187 if (mouse_track_width
)
3189 x_rectangle (f
, f
->display
.x
->reverse_gc
,
3190 mouse_track_left
, mouse_track_top
,
3191 mouse_track_width
, 1);
3193 if ((mouse_track_left
== f
->phys_cursor_x
3194 || mouse_track_left
== f
->phys_cursor_x
- 1)
3195 && mouse_track_top
== f
->phys_cursor_y
)
3197 x_display_cursor (f
, 1);
3201 mouse_track_left
= x_mouse_x
;
3202 mouse_track_top
= x_mouse_y
;
3203 mouse_track_width
= 0;
3205 if (mouse_track_left
> len
) /* Past the end of line. */
3208 if (mouse_track_top
== mode_line_vpos
)
3214 if (tab_width
<= 0 || tab_width
> 20) tab_width
= 8;
3218 if (len
== f
->width
&& hp
== len
- 1 && c
!= '\n')
3224 mouse_track_width
= tab_width
- (hp
% tab_width
);
3226 hp
+= mouse_track_width
;
3229 mouse_track_left
= hp
- mouse_track_width
;
3235 mouse_track_width
= -1;
3239 if (ctl_arrow_p
&& (c
< 040 || c
== 0177))
3244 mouse_track_width
= 2;
3249 mouse_track_left
= hp
- mouse_track_width
;
3255 mouse_track_width
= 1;
3262 while (hp
<= x_mouse_x
);
3265 if (mouse_track_width
) /* Over text; use text pointer shape. */
3267 XDefineCursor (x_current_display
,
3269 f
->display
.x
->text_cursor
);
3270 x_rectangle (f
, f
->display
.x
->cursor_gc
,
3271 mouse_track_left
, mouse_track_top
,
3272 mouse_track_width
, 1);
3274 else if (in_mode_line
)
3275 XDefineCursor (x_current_display
,
3277 f
->display
.x
->modeline_cursor
);
3279 XDefineCursor (x_current_display
,
3281 f
->display
.x
->nontext_cursor
);
3284 XFlush (x_current_display
);
3287 obj
= read_char (-1, 0, 0, Qnil
, 0);
3290 while (XTYPE (obj
) == Lisp_Cons
/* Mouse event */
3291 && EQ (Fcar (Fcdr (Fcdr (obj
))), Qnil
) /* Not scroll bar */
3292 && EQ (Vmouse_depressed
, Qnil
) /* Only motion events */
3293 && EQ (Vmouse_window
, selected_window
) /* In this window */
3296 unread_command_event
= obj
;
3298 if (mouse_track_width
)
3300 x_rectangle (f
, f
->display
.x
->reverse_gc
,
3301 mouse_track_left
, mouse_track_top
,
3302 mouse_track_width
, 1);
3303 mouse_track_width
= 0;
3304 if ((mouse_track_left
== f
->phys_cursor_x
3305 || mouse_track_left
- 1 == f
->phys_cursor_x
)
3306 && mouse_track_top
== f
->phys_cursor_y
)
3308 x_display_cursor (f
, 1);
3311 XDefineCursor (x_current_display
,
3313 f
->display
.x
->nontext_cursor
);
3314 XFlush (x_current_display
);
3324 /* Draw a pixmap specified by IMAGE_DATA of dimensions WIDTH and HEIGHT
3325 on the frame F at position X, Y. */
3327 x_draw_pixmap (f
, x
, y
, image_data
, width
, height
)
3329 int x
, y
, width
, height
;
3334 image
= XCreateBitmapFromData (x_current_display
,
3335 FRAME_X_WINDOW (f
), image_data
,
3337 XCopyPlane (x_current_display
, image
, FRAME_X_WINDOW (f
),
3338 f
->display
.x
->normal_gc
, 0, 0, width
, height
, x
, y
);
3343 DEFUN ("x-store-cut-buffer", Fx_store_cut_buffer
, Sx_store_cut_buffer
,
3344 1, 1, "sStore text in cut buffer: ",
3345 "Store contents of STRING into the cut buffer of the X window system.")
3347 register Lisp_Object string
;
3351 CHECK_STRING (string
, 1);
3352 if (! FRAME_X_P (selected_frame
))
3353 error ("Selected frame does not understand X protocol.");
3356 XStoreBytes ((char *) XSTRING (string
)->data
, XSTRING (string
)->size
);
3362 DEFUN ("x-get-cut-buffer", Fx_get_cut_buffer
, Sx_get_cut_buffer
, 0, 0, 0,
3363 "Return contents of cut buffer of the X window system, as a string.")
3367 register Lisp_Object string
;
3372 d
= XFetchBytes (&len
);
3373 string
= make_string (d
, len
);
3380 #if 0 /* I'm told these functions are superfluous
3381 given the ability to bind function keys. */
3384 DEFUN ("x-rebind-key", Fx_rebind_key
, Sx_rebind_key
, 3, 3, 0,
3385 "Rebind X keysym KEYSYM, with MODIFIERS, to generate NEWSTRING.\n\
3386 KEYSYM is a string which conforms to the X keysym definitions found\n\
3387 in X11/keysymdef.h, sans the initial XK_. MODIFIERS is nil or a\n\
3388 list of strings specifying modifier keys such as Control_L, which must\n\
3389 also be depressed for NEWSTRING to appear.")
3390 (x_keysym
, modifiers
, newstring
)
3391 register Lisp_Object x_keysym
;
3392 register Lisp_Object modifiers
;
3393 register Lisp_Object newstring
;
3396 register KeySym keysym
;
3397 KeySym modifier_list
[16];
3400 CHECK_STRING (x_keysym
, 1);
3401 CHECK_STRING (newstring
, 3);
3403 keysym
= XStringToKeysym ((char *) XSTRING (x_keysym
)->data
);
3404 if (keysym
== NoSymbol
)
3405 error ("Keysym does not exist");
3407 if (NILP (modifiers
))
3408 XRebindKeysym (x_current_display
, keysym
, modifier_list
, 0,
3409 XSTRING (newstring
)->data
, XSTRING (newstring
)->size
);
3412 register Lisp_Object rest
, mod
;
3415 for (rest
= modifiers
; !NILP (rest
); rest
= Fcdr (rest
))
3418 error ("Can't have more than 16 modifiers");
3421 CHECK_STRING (mod
, 3);
3422 modifier_list
[i
] = XStringToKeysym ((char *) XSTRING (mod
)->data
);
3424 if (modifier_list
[i
] == NoSymbol
3425 || !(IsModifierKey (modifier_list
[i
])
3426 || ((unsigned)(modifier_list
[i
]) == XK_Mode_switch
)
3427 || ((unsigned)(modifier_list
[i
]) == XK_Num_Lock
)))
3429 if (modifier_list
[i
] == NoSymbol
3430 || !IsModifierKey (modifier_list
[i
]))
3432 error ("Element is not a modifier keysym");
3436 XRebindKeysym (x_current_display
, keysym
, modifier_list
, i
,
3437 XSTRING (newstring
)->data
, XSTRING (newstring
)->size
);
3443 DEFUN ("x-rebind-keys", Fx_rebind_keys
, Sx_rebind_keys
, 2, 2, 0,
3444 "Rebind KEYCODE to list of strings STRINGS.\n\
3445 STRINGS should be a list of 16 elements, one for each shift combination.\n\
3446 nil as element means don't change.\n\
3447 See the documentation of `x-rebind-key' for more information.")
3449 register Lisp_Object keycode
;
3450 register Lisp_Object strings
;
3452 register Lisp_Object item
;
3453 register unsigned char *rawstring
;
3454 KeySym rawkey
, modifier
[1];
3456 register unsigned i
;
3459 CHECK_NUMBER (keycode
, 1);
3460 CHECK_CONS (strings
, 2);
3461 rawkey
= (KeySym
) ((unsigned) (XINT (keycode
))) & 255;
3462 for (i
= 0; i
<= 15; strings
= Fcdr (strings
), i
++)
3464 item
= Fcar (strings
);
3467 CHECK_STRING (item
, 2);
3468 strsize
= XSTRING (item
)->size
;
3469 rawstring
= (unsigned char *) xmalloc (strsize
);
3470 bcopy (XSTRING (item
)->data
, rawstring
, strsize
);
3471 modifier
[1] = 1 << i
;
3472 XRebindKeysym (x_current_display
, rawkey
, modifier
, 1,
3473 rawstring
, strsize
);
3478 #endif /* HAVE_X11 */
3483 select_visual (screen
, depth
)
3485 unsigned int *depth
;
3488 XVisualInfo
*vinfo
, vinfo_template
;
3491 v
= DefaultVisualOfScreen (screen
);
3494 vinfo_template
.visualid
= XVisualIDFromVisual (v
);
3496 vinfo_template
.visualid
= v
->visualid
;
3499 vinfo_template
.screen
= XScreenNumberOfScreen (screen
);
3501 vinfo
= XGetVisualInfo (x_current_display
,
3502 VisualIDMask
| VisualScreenMask
, &vinfo_template
,
3505 fatal ("Can't get proper X visual info");
3507 if ((1 << vinfo
->depth
) == vinfo
->colormap_size
)
3508 *depth
= vinfo
->depth
;
3512 int n
= vinfo
->colormap_size
- 1;
3521 XFree ((char *) vinfo
);
3524 #endif /* HAVE_X11 */
3526 DEFUN ("x-open-connection", Fx_open_connection
, Sx_open_connection
,
3527 1, 2, 0, "Open a connection to an X server.\n\
3528 DISPLAY is the name of the display to connect to.\n\
3529 Optional second arg XRM_STRING is a string of resources in xrdb format.")
3530 (display
, xrm_string
)
3531 Lisp_Object display
, xrm_string
;
3533 unsigned int n_planes
;
3534 unsigned char *xrm_option
;
3536 CHECK_STRING (display
, 0);
3537 if (x_current_display
!= 0)
3538 error ("X server connection is already initialized");
3539 if (! NILP (xrm_string
))
3540 CHECK_STRING (xrm_string
, 1);
3542 /* This is what opens the connection and sets x_current_display.
3543 This also initializes many symbols, such as those used for input. */
3544 x_term_init (XSTRING (display
)->data
);
3547 XFASTINT (Vwindow_system_version
) = 11;
3549 if (! NILP (xrm_string
))
3550 xrm_option
= (unsigned char *) XSTRING (xrm_string
)->data
;
3552 xrm_option
= (unsigned char *) 0;
3554 validate_x_resource_name ();
3557 xrdb
= x_load_resources (x_current_display
, xrm_option
,
3558 (char *) XSTRING (Vx_resource_name
)->data
,
3561 #if defined (HAVE_X11R5)
3562 XrmSetDatabase (x_current_display
, xrdb
);
3564 x_current_display
->db
= xrdb
;
3567 x_screen
= DefaultScreenOfDisplay (x_current_display
);
3569 screen_visual
= select_visual (x_screen
, &n_planes
);
3570 x_screen_planes
= n_planes
;
3571 x_screen_height
= HeightOfScreen (x_screen
);
3572 x_screen_width
= WidthOfScreen (x_screen
);
3574 /* X Atoms used by emacs. */
3575 Xatoms_of_xselect ();
3577 Xatom_wm_protocols
= XInternAtom (x_current_display
, "WM_PROTOCOLS",
3579 Xatom_wm_take_focus
= XInternAtom (x_current_display
, "WM_TAKE_FOCUS",
3581 Xatom_wm_save_yourself
= XInternAtom (x_current_display
, "WM_SAVE_YOURSELF",
3583 Xatom_wm_delete_window
= XInternAtom (x_current_display
, "WM_DELETE_WINDOW",
3585 Xatom_wm_change_state
= XInternAtom (x_current_display
, "WM_CHANGE_STATE",
3587 Xatom_wm_configure_denied
= XInternAtom (x_current_display
,
3588 "WM_CONFIGURE_DENIED", False
);
3589 Xatom_wm_window_moved
= XInternAtom (x_current_display
, "WM_MOVED",
3592 #else /* not HAVE_X11 */
3593 XFASTINT (Vwindow_system_version
) = 10;
3594 #endif /* not HAVE_X11 */
3598 DEFUN ("x-close-current-connection", Fx_close_current_connection
,
3599 Sx_close_current_connection
,
3600 0, 0, 0, "Close the connection to the current X server.")
3604 /* This is ONLY used when killing emacs; For switching displays
3605 we'll have to take care of setting CloseDownMode elsewhere. */
3607 if (x_current_display
)
3610 XSetCloseDownMode (x_current_display
, DestroyAll
);
3611 XCloseDisplay (x_current_display
);
3612 x_current_display
= 0;
3615 fatal ("No current X display connection to close\n");
3620 DEFUN ("x-synchronize", Fx_synchronize
, Sx_synchronize
,
3621 1, 1, 0, "If ON is non-nil, report X errors as soon as the erring request is made.\n\
3622 If ON is nil, allow buffering of requests.\n\
3623 Turning on synchronization prohibits the Xlib routines from buffering\n\
3624 requests and seriously degrades performance, but makes debugging much\n\
3631 XSynchronize (x_current_display
, !EQ (on
, Qnil
));
3639 /* This is zero if not using X windows. */
3640 x_current_display
= 0;
3642 /* The section below is built by the lisp expression at the top of the file,
3643 just above where these variables are declared. */
3644 /*&&& init symbols here &&&*/
3645 Qauto_raise
= intern ("auto-raise");
3646 staticpro (&Qauto_raise
);
3647 Qauto_lower
= intern ("auto-lower");
3648 staticpro (&Qauto_lower
);
3649 Qbackground_color
= intern ("background-color");
3650 staticpro (&Qbackground_color
);
3651 Qbar
= intern ("bar");
3653 Qborder_color
= intern ("border-color");
3654 staticpro (&Qborder_color
);
3655 Qborder_width
= intern ("border-width");
3656 staticpro (&Qborder_width
);
3657 Qbox
= intern ("box");
3659 Qcursor_color
= intern ("cursor-color");
3660 staticpro (&Qcursor_color
);
3661 Qcursor_type
= intern ("cursor-type");
3662 staticpro (&Qcursor_type
);
3663 Qfont
= intern ("font");
3665 Qforeground_color
= intern ("foreground-color");
3666 staticpro (&Qforeground_color
);
3667 Qgeometry
= intern ("geometry");
3668 staticpro (&Qgeometry
);
3669 Qicon_left
= intern ("icon-left");
3670 staticpro (&Qicon_left
);
3671 Qicon_top
= intern ("icon-top");
3672 staticpro (&Qicon_top
);
3673 Qicon_type
= intern ("icon-type");
3674 staticpro (&Qicon_type
);
3675 Qinternal_border_width
= intern ("internal-border-width");
3676 staticpro (&Qinternal_border_width
);
3677 Qleft
= intern ("left");
3679 Qmouse_color
= intern ("mouse-color");
3680 staticpro (&Qmouse_color
);
3681 Qnone
= intern ("none");
3683 Qparent_id
= intern ("parent-id");
3684 staticpro (&Qparent_id
);
3685 Qsuppress_icon
= intern ("suppress-icon");
3686 staticpro (&Qsuppress_icon
);
3687 Qtop
= intern ("top");
3689 Qundefined_color
= intern ("undefined-color");
3690 staticpro (&Qundefined_color
);
3691 Qvertical_scroll_bars
= intern ("vertical-scroll-bars");
3692 staticpro (&Qvertical_scroll_bars
);
3693 Qvisibility
= intern ("visibility");
3694 staticpro (&Qvisibility
);
3695 Qwindow_id
= intern ("window-id");
3696 staticpro (&Qwindow_id
);
3697 Qx_frame_parameter
= intern ("x-frame-parameter");
3698 staticpro (&Qx_frame_parameter
);
3699 /* This is the end of symbol initialization. */
3701 Fput (Qundefined_color
, Qerror_conditions
,
3702 Fcons (Qundefined_color
, Fcons (Qerror
, Qnil
)));
3703 Fput (Qundefined_color
, Qerror_message
,
3704 build_string ("Undefined color"));
3706 init_x_parm_symbols ();
3708 DEFVAR_INT ("mouse-buffer-offset", &mouse_buffer_offset
,
3709 "The buffer offset of the character under the pointer.");
3710 mouse_buffer_offset
= 0;
3712 DEFVAR_LISP ("x-pointer-shape", &Vx_pointer_shape
,
3713 "The shape of the pointer when over text.\n\
3714 Changing the value does not affect existing frames\n\
3715 unless you set the mouse color.");
3716 Vx_pointer_shape
= Qnil
;
3718 DEFVAR_LISP ("x-resource-name", &Vx_resource_name
,
3719 "The name Emacs uses to look up X resources; for internal use only.\n\
3720 `x-get-resource' uses this as the first component of the instance name\n\
3721 when requesting resource values.\n\
3722 Emacs initially sets `x-resource-name' to the name under which Emacs\n\
3723 was invoked, or to the value specified with the `-name' or `-rn'\n\
3724 switches, if present.");
3725 Vx_resource_name
= Qnil
;
3728 DEFVAR_INT ("x-nontext-pointer-shape", &Vx_nontext_pointer_shape
,
3729 "The shape of the pointer when not over text.");
3731 Vx_nontext_pointer_shape
= Qnil
;
3734 DEFVAR_INT ("x-mode-pointer-shape", &Vx_mode_pointer_shape
,
3735 "The shape of the pointer when over the mode line.");
3737 Vx_mode_pointer_shape
= Qnil
;
3739 DEFVAR_LISP ("x-cursor-fore-pixel", &Vx_cursor_fore_pixel
,
3740 "A string indicating the foreground color of the cursor box.");
3741 Vx_cursor_fore_pixel
= Qnil
;
3743 DEFVAR_LISP ("mouse-grabbed", &Vmouse_depressed
,
3744 "Non-nil if a mouse button is currently depressed.");
3745 Vmouse_depressed
= Qnil
;
3747 DEFVAR_LISP ("x-no-window-manager", &Vx_no_window_manager
,
3748 "t if no X window manager is in use.");
3751 defsubr (&Sx_get_resource
);
3753 defsubr (&Sx_draw_rectangle
);
3754 defsubr (&Sx_erase_rectangle
);
3755 defsubr (&Sx_contour_region
);
3756 defsubr (&Sx_uncontour_region
);
3758 defsubr (&Sx_display_color_p
);
3759 defsubr (&Sx_list_fonts
);
3760 defsubr (&Sx_color_defined_p
);
3761 defsubr (&Sx_server_max_request_size
);
3762 defsubr (&Sx_server_vendor
);
3763 defsubr (&Sx_server_version
);
3764 defsubr (&Sx_display_pixel_width
);
3765 defsubr (&Sx_display_pixel_height
);
3766 defsubr (&Sx_display_mm_width
);
3767 defsubr (&Sx_display_mm_height
);
3768 defsubr (&Sx_display_screens
);
3769 defsubr (&Sx_display_planes
);
3770 defsubr (&Sx_display_color_cells
);
3771 defsubr (&Sx_display_visual_class
);
3772 defsubr (&Sx_display_backing_store
);
3773 defsubr (&Sx_display_save_under
);
3775 defsubr (&Sx_rebind_key
);
3776 defsubr (&Sx_rebind_keys
);
3777 defsubr (&Sx_track_pointer
);
3778 defsubr (&Sx_grab_pointer
);
3779 defsubr (&Sx_ungrab_pointer
);
3782 defsubr (&Sx_get_default
);
3783 defsubr (&Sx_store_cut_buffer
);
3784 defsubr (&Sx_get_cut_buffer
);
3786 defsubr (&Sx_parse_geometry
);
3787 defsubr (&Sx_create_frame
);
3788 defsubr (&Sfocus_frame
);
3789 defsubr (&Sunfocus_frame
);
3791 defsubr (&Sx_horizontal_line
);
3793 defsubr (&Sx_open_connection
);
3794 defsubr (&Sx_close_current_connection
);
3795 defsubr (&Sx_synchronize
);
3798 #endif /* HAVE_X_WINDOWS */