1 /* Functions for the X window system.
2 Copyright (C) 1989, 1992, 1993 Free Software Foundation.
4 This file is part of GNU Emacs.
6 GNU Emacs is free software; you can redistribute it and/or modify
7 it under the terms of the GNU General Public License as published by
8 the Free Software Foundation; either version 2, or (at your option)
11 GNU Emacs is distributed in the hope that it will be useful,
12 but WITHOUT ANY WARRANTY; without even the implied warranty of
13 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14 GNU General Public License for more details.
16 You should have received a copy of the GNU General Public License
17 along with GNU Emacs; see the file COPYING. If not, write to
18 the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. */
20 /* Completely rewritten by Richard Stallman. */
22 /* Rewritten for X11 by Joseph Arceneaux */
34 #include "dispextern.h"
36 #include "blockinput.h"
42 #if 1 /* Used to be #ifdef EMACS_BITMAP_FILES, but this should always work. */
43 #include "bitmaps/gray.xbm"
45 #include <X11/bitmaps/gray>
48 #include "[.bitmaps]gray.xbm"
51 #define min(a,b) ((a) < (b) ? (a) : (b))
52 #define max(a,b) ((a) > (b) ? (a) : (b))
55 /* X Resource data base */
56 static XrmDatabase xrdb
;
58 /* The class of this X application. */
59 #define EMACS_CLASS "Emacs"
62 #define MAXREQUEST(dpy) (XMaxRequestSize (dpy))
64 #define MAXREQUEST(dpy) ((dpy)->max_request_size)
67 /* The name we're using in resource queries. */
68 Lisp_Object Vx_resource_name
;
70 /* Title name and application name for X stuff. */
71 extern char *x_id_name
;
73 /* The background and shape of the mouse pointer, and shape when not
74 over text or in the modeline. */
75 Lisp_Object Vx_pointer_shape
, Vx_nontext_pointer_shape
, Vx_mode_pointer_shape
;
77 /* Color of chars displayed in cursor box. */
78 Lisp_Object Vx_cursor_fore_pixel
;
80 /* The screen being used. */
81 static Screen
*x_screen
;
83 /* The X Visual we are using for X windows (the default) */
84 Visual
*screen_visual
;
86 /* Height of this X screen in pixels. */
89 /* Width of this X screen in pixels. */
92 /* Number of planes for this screen. */
95 /* Non nil if no window manager is in use. */
96 Lisp_Object Vx_no_window_manager
;
98 /* `t' if a mouse button is depressed. */
100 Lisp_Object Vmouse_depressed
;
102 extern unsigned int x_mouse_x
, x_mouse_y
, x_mouse_grabbed
;
104 /* Atom for indicating window state to the window manager. */
105 extern Atom Xatom_wm_change_state
;
107 /* Communication with window managers. */
108 extern Atom Xatom_wm_protocols
;
110 /* Kinds of protocol things we may receive. */
111 extern Atom Xatom_wm_take_focus
;
112 extern Atom Xatom_wm_save_yourself
;
113 extern Atom Xatom_wm_delete_window
;
115 /* Other WM communication */
116 extern Atom Xatom_wm_configure_denied
; /* When our config request is denied */
117 extern Atom Xatom_wm_window_moved
; /* When the WM moves us. */
121 /* Default size of an Emacs window. */
122 static char *default_window
= "=80x24+0+0";
125 char iconidentity
[MAXICID
];
126 #define ICONTAG "emacs@"
127 char minibuffer_iconidentity
[MAXICID
];
128 #define MINIBUFFER_ICONTAG "minibuffer@"
132 /* The last 23 bits of the timestamp of the last mouse button event. */
133 Time mouse_timestamp
;
135 /* Evaluate this expression to rebuild the section of syms_of_xfns
136 that initializes and staticpros the symbols declared below. Note
137 that Emacs 18 has a bug that keeps C-x C-e from being able to
138 evaluate this expression.
141 ;; Accumulate a list of the symbols we want to initialize from the
142 ;; declarations at the top of the file.
143 (goto-char (point-min))
144 (search-forward "/\*&&& symbols declared here &&&*\/\n")
146 (while (looking-at "Lisp_Object \\(Q[a-z_]+\\)")
148 (cons (buffer-substring (match-beginning 1) (match-end 1))
151 (setq symbol-list (nreverse symbol-list))
152 ;; Delete the section of syms_of_... where we initialize the symbols.
153 (search-forward "\n /\*&&& init symbols here &&&*\/\n")
154 (let ((start (point)))
155 (while (looking-at "^ Q")
157 (kill-region start (point)))
158 ;; Write a new symbol initialization section.
160 (insert (format " %s = intern (\"" (car symbol-list)))
161 (let ((start (point)))
162 (insert (substring (car symbol-list) 1))
163 (subst-char-in-region start (point) ?_ ?-))
164 (insert (format "\");\n staticpro (&%s);\n" (car symbol-list)))
165 (setq symbol-list (cdr symbol-list)))))
169 /*&&& symbols declared here &&&*/
170 Lisp_Object Qauto_raise
;
171 Lisp_Object Qauto_lower
;
172 Lisp_Object Qbackground_color
;
174 Lisp_Object Qborder_color
;
175 Lisp_Object Qborder_width
;
177 Lisp_Object Qcursor_color
;
178 Lisp_Object Qcursor_type
;
180 Lisp_Object Qforeground_color
;
181 Lisp_Object Qgeometry
;
182 /* Lisp_Object Qicon; */
183 Lisp_Object Qicon_left
;
184 Lisp_Object Qicon_top
;
185 Lisp_Object Qicon_type
;
186 Lisp_Object Qinternal_border_width
;
188 Lisp_Object Qmouse_color
;
190 Lisp_Object Qparent_id
;
191 Lisp_Object Qsuppress_icon
;
193 Lisp_Object Qundefined_color
;
194 Lisp_Object Qvertical_scroll_bars
;
195 Lisp_Object Qvisibility
;
196 Lisp_Object Qwindow_id
;
197 Lisp_Object Qx_frame_parameter
;
199 /* The below are defined in frame.c. */
200 extern Lisp_Object Qheight
, Qminibuffer
, Qname
, Qonly
, Qwidth
;
201 extern Lisp_Object Qunsplittable
, Qmenu_bar_lines
;
203 extern Lisp_Object Vwindow_system_version
;
206 /* Error if we are not connected to X. */
210 if (x_current_display
== 0)
211 error ("X windows are not in use or not initialized");
214 /* Return the Emacs frame-object corresponding to an X window.
215 It could be the frame's main window or an icon window. */
217 /* This function can be called during GC, so use XGCTYPE. */
220 x_window_to_frame (wdesc
)
223 Lisp_Object tail
, frame
;
226 for (tail
= Vframe_list
; XGCTYPE (tail
) == Lisp_Cons
;
227 tail
= XCONS (tail
)->cdr
)
229 frame
= XCONS (tail
)->car
;
230 if (XGCTYPE (frame
) != Lisp_Frame
)
233 if (FRAME_X_WINDOW (f
) == wdesc
234 || f
->display
.x
->icon_desc
== wdesc
)
241 /* Connect the frame-parameter names for X frames
242 to the ways of passing the parameter values to the window system.
244 The name of a parameter, as a Lisp symbol,
245 has an `x-frame-parameter' property which is an integer in Lisp
246 but can be interpreted as an `enum x_frame_parm' in C. */
250 X_PARM_FOREGROUND_COLOR
,
251 X_PARM_BACKGROUND_COLOR
,
258 X_PARM_INTERNAL_BORDER_WIDTH
,
262 X_PARM_VERT_SCROLL_BAR
,
264 X_PARM_MENU_BAR_LINES
268 struct x_frame_parm_table
271 void (*setter
)( /* struct frame *frame, Lisp_Object val, oldval */ );
274 void x_set_foreground_color ();
275 void x_set_background_color ();
276 void x_set_mouse_color ();
277 void x_set_cursor_color ();
278 void x_set_border_color ();
279 void x_set_cursor_type ();
280 void x_set_icon_type ();
282 void x_set_border_width ();
283 void x_set_internal_border_width ();
284 void x_explicitly_set_name ();
285 void x_set_autoraise ();
286 void x_set_autolower ();
287 void x_set_vertical_scroll_bars ();
288 void x_set_visibility ();
289 void x_set_menu_bar_lines ();
291 static struct x_frame_parm_table x_frame_parms
[] =
293 "foreground-color", x_set_foreground_color
,
294 "background-color", x_set_background_color
,
295 "mouse-color", x_set_mouse_color
,
296 "cursor-color", x_set_cursor_color
,
297 "border-color", x_set_border_color
,
298 "cursor-type", x_set_cursor_type
,
299 "icon-type", x_set_icon_type
,
301 "border-width", x_set_border_width
,
302 "internal-border-width", x_set_internal_border_width
,
303 "name", x_explicitly_set_name
,
304 "auto-raise", x_set_autoraise
,
305 "auto-lower", x_set_autolower
,
306 "vertical-scroll-bars", x_set_vertical_scroll_bars
,
307 "visibility", x_set_visibility
,
308 "menu-bar-lines", x_set_menu_bar_lines
,
311 /* Attach the `x-frame-parameter' properties to
312 the Lisp symbol names of parameters relevant to X. */
314 init_x_parm_symbols ()
318 for (i
= 0; i
< sizeof (x_frame_parms
) / sizeof (x_frame_parms
[0]); i
++)
319 Fput (intern (x_frame_parms
[i
].name
), Qx_frame_parameter
,
323 /* Change the parameters of FRAME as specified by ALIST.
324 If a parameter is not specially recognized, do nothing;
325 otherwise call the `x_set_...' function for that parameter. */
328 x_set_frame_parameters (f
, alist
)
334 /* If both of these parameters are present, it's more efficient to
335 set them both at once. So we wait until we've looked at the
336 entire list before we set them. */
337 Lisp_Object width
, height
;
340 Lisp_Object left
, top
;
342 /* Record in these vectors all the parms specified. */
348 for (tail
= alist
; CONSP (tail
); tail
= Fcdr (tail
))
351 parms
= (Lisp_Object
*) alloca (i
* sizeof (Lisp_Object
));
352 values
= (Lisp_Object
*) alloca (i
* sizeof (Lisp_Object
));
354 /* Extract parm names and values into those vectors. */
357 for (tail
= alist
; CONSP (tail
); tail
= Fcdr (tail
))
359 Lisp_Object elt
, prop
, val
;
362 parms
[i
] = Fcar (elt
);
363 values
[i
] = Fcdr (elt
);
367 width
= height
= top
= left
= Qunbound
;
369 /* Now process them in reverse of specified order. */
370 for (i
--; i
>= 0; i
--)
372 Lisp_Object prop
, val
;
377 if (EQ (prop
, Qwidth
))
379 else if (EQ (prop
, Qheight
))
381 else if (EQ (prop
, Qtop
))
383 else if (EQ (prop
, Qleft
))
387 register Lisp_Object param_index
= Fget (prop
, Qx_frame_parameter
);
388 register Lisp_Object old_value
= get_frame_param (f
, prop
);
390 store_frame_param (f
, prop
, val
);
391 if (XTYPE (param_index
) == Lisp_Int
392 && XINT (param_index
) >= 0
393 && (XINT (param_index
)
394 < sizeof (x_frame_parms
)/sizeof (x_frame_parms
[0])))
395 (*x_frame_parms
[XINT (param_index
)].setter
)(f
, val
, old_value
);
399 /* Don't die if just one of these was set. */
400 if (EQ (left
, Qunbound
))
401 XSET (left
, Lisp_Int
, f
->display
.x
->left_pos
);
402 if (EQ (top
, Qunbound
))
403 XSET (top
, Lisp_Int
, f
->display
.x
->top_pos
);
405 /* Don't die if just one of these was set. */
406 if (EQ (width
, Qunbound
))
407 XSET (width
, Lisp_Int
, FRAME_WIDTH (f
));
408 if (EQ (height
, Qunbound
))
409 XSET (height
, Lisp_Int
, FRAME_HEIGHT (f
));
411 /* Don't set these parameters these unless they've been explicitly
412 specified. The window might be mapped or resized while we're in
413 this function, and we don't want to override that unless the lisp
414 code has asked for it.
416 Don't set these parameters unless they actually differ from the
417 window's current parameters; the window may not actually exist
422 XSET (frame
, Lisp_Frame
, f
);
424 if ((NUMBERP (width
) && XINT (width
) != FRAME_WIDTH (f
))
425 || (NUMBERP (height
) && XINT (height
) != FRAME_HEIGHT (f
)))
426 Fset_frame_size (frame
, width
, height
);
427 if ((NUMBERP (left
) && XINT (left
) != f
->display
.x
->left_pos
)
428 || (NUMBERP (top
) && XINT (top
) != f
->display
.x
->top_pos
))
429 Fset_frame_position (frame
, left
, top
);
433 /* Insert a description of internally-recorded parameters of frame X
434 into the parameter alist *ALISTPTR that is to be given to the user.
435 Only parameters that are specific to the X window system
436 and whose values are not correctly recorded in the frame's
437 param_alist need to be considered here. */
439 x_report_frame_params (f
, alistptr
)
441 Lisp_Object
*alistptr
;
445 store_in_alist (alistptr
, Qleft
, make_number (f
->display
.x
->left_pos
));
446 store_in_alist (alistptr
, Qtop
, make_number (f
->display
.x
->top_pos
));
447 store_in_alist (alistptr
, Qborder_width
,
448 make_number (f
->display
.x
->border_width
));
449 store_in_alist (alistptr
, Qinternal_border_width
,
450 make_number (f
->display
.x
->internal_border_width
));
451 sprintf (buf
, "%d", FRAME_X_WINDOW (f
));
452 store_in_alist (alistptr
, Qwindow_id
,
454 store_in_alist (alistptr
, Qvisibility
,
455 (FRAME_VISIBLE_P (f
) ? Qt
456 : FRAME_ICONIFIED_P (f
) ? Qicon
: Qnil
));
459 /* Decide if color named COLOR is valid for the display
460 associated with the selected frame. */
462 defined_color (color
, color_def
)
467 Colormap screen_colormap
;
472 = DefaultColormap (x_current_display
, XDefaultScreen (x_current_display
));
474 foo
= XParseColor (x_current_display
, screen_colormap
,
476 && XAllocColor (x_current_display
, screen_colormap
, color_def
);
478 foo
= XParseColor (color
, color_def
) && XGetHardwareColor (color_def
);
479 #endif /* not HAVE_X11 */
488 /* Given a string ARG naming a color, compute a pixel value from it
489 suitable for screen F.
490 If F is not a color screen, return DEF (default) regardless of what
494 x_decode_color (arg
, def
)
500 CHECK_STRING (arg
, 0);
502 if (strcmp (XSTRING (arg
)->data
, "black") == 0)
503 return BLACK_PIX_DEFAULT
;
504 else if (strcmp (XSTRING (arg
)->data
, "white") == 0)
505 return WHITE_PIX_DEFAULT
;
508 if (x_screen_planes
== 1)
511 if (DISPLAY_CELLS
== 1)
515 if (defined_color (XSTRING (arg
)->data
, &cdef
))
518 Fsignal (Qundefined_color
, Fcons (arg
, Qnil
));
521 /* Functions called only from `x_set_frame_param'
522 to set individual parameters.
524 If FRAME_X_WINDOW (f) is 0,
525 the frame is being created and its X-window does not exist yet.
526 In that case, just record the parameter's new value
527 in the standard place; do not attempt to change the window. */
530 x_set_foreground_color (f
, arg
, oldval
)
532 Lisp_Object arg
, oldval
;
534 f
->display
.x
->foreground_pixel
= x_decode_color (arg
, BLACK_PIX_DEFAULT
);
535 if (FRAME_X_WINDOW (f
) != 0)
539 XSetForeground (x_current_display
, f
->display
.x
->normal_gc
,
540 f
->display
.x
->foreground_pixel
);
541 XSetBackground (x_current_display
, f
->display
.x
->reverse_gc
,
542 f
->display
.x
->foreground_pixel
);
544 #endif /* HAVE_X11 */
545 recompute_basic_faces (f
);
546 if (FRAME_VISIBLE_P (f
))
552 x_set_background_color (f
, arg
, oldval
)
554 Lisp_Object arg
, oldval
;
559 f
->display
.x
->background_pixel
= x_decode_color (arg
, WHITE_PIX_DEFAULT
);
561 if (FRAME_X_WINDOW (f
) != 0)
565 /* The main frame area. */
566 XSetBackground (x_current_display
, f
->display
.x
->normal_gc
,
567 f
->display
.x
->background_pixel
);
568 XSetForeground (x_current_display
, f
->display
.x
->reverse_gc
,
569 f
->display
.x
->background_pixel
);
570 XSetForeground (x_current_display
, f
->display
.x
->cursor_gc
,
571 f
->display
.x
->background_pixel
);
572 XSetWindowBackground (x_current_display
, FRAME_X_WINDOW (f
),
573 f
->display
.x
->background_pixel
);
576 temp
= XMakeTile (f
->display
.x
->background_pixel
);
577 XChangeBackground (FRAME_X_WINDOW (f
), temp
);
579 #endif /* not HAVE_X11 */
582 recompute_basic_faces (f
);
584 if (FRAME_VISIBLE_P (f
))
590 x_set_mouse_color (f
, arg
, oldval
)
592 Lisp_Object arg
, oldval
;
594 Cursor cursor
, nontext_cursor
, mode_cursor
;
598 f
->display
.x
->mouse_pixel
= x_decode_color (arg
, BLACK_PIX_DEFAULT
);
599 mask_color
= f
->display
.x
->background_pixel
;
600 /* No invisible pointers. */
601 if (mask_color
== f
->display
.x
->mouse_pixel
602 && mask_color
== f
->display
.x
->background_pixel
)
603 f
->display
.x
->mouse_pixel
= f
->display
.x
->foreground_pixel
;
608 /* It's not okay to crash if the user selects a screwy cursor. */
611 if (!EQ (Qnil
, Vx_pointer_shape
))
613 CHECK_NUMBER (Vx_pointer_shape
, 0);
614 cursor
= XCreateFontCursor (x_current_display
, XINT (Vx_pointer_shape
));
617 cursor
= XCreateFontCursor (x_current_display
, XC_xterm
);
618 x_check_errors ("bad text pointer cursor: %s");
620 if (!EQ (Qnil
, Vx_nontext_pointer_shape
))
622 CHECK_NUMBER (Vx_nontext_pointer_shape
, 0);
623 nontext_cursor
= XCreateFontCursor (x_current_display
,
624 XINT (Vx_nontext_pointer_shape
));
627 nontext_cursor
= XCreateFontCursor (x_current_display
, XC_left_ptr
);
628 x_check_errors ("bad nontext pointer cursor: %s");
630 if (!EQ (Qnil
, Vx_mode_pointer_shape
))
632 CHECK_NUMBER (Vx_mode_pointer_shape
, 0);
633 mode_cursor
= XCreateFontCursor (x_current_display
,
634 XINT (Vx_mode_pointer_shape
));
637 mode_cursor
= XCreateFontCursor (x_current_display
, XC_xterm
);
639 /* Check and report errors with the above calls. */
640 x_check_errors ("can't set cursor shape: %s");
644 XColor fore_color
, back_color
;
646 fore_color
.pixel
= f
->display
.x
->mouse_pixel
;
647 back_color
.pixel
= mask_color
;
648 XQueryColor (x_current_display
,
649 DefaultColormap (x_current_display
,
650 DefaultScreen (x_current_display
)),
652 XQueryColor (x_current_display
,
653 DefaultColormap (x_current_display
,
654 DefaultScreen (x_current_display
)),
656 XRecolorCursor (x_current_display
, cursor
,
657 &fore_color
, &back_color
);
658 XRecolorCursor (x_current_display
, nontext_cursor
,
659 &fore_color
, &back_color
);
660 XRecolorCursor (x_current_display
, mode_cursor
,
661 &fore_color
, &back_color
);
664 cursor
= XCreateCursor (16, 16, MouseCursor
, MouseMask
,
666 f
->display
.x
->mouse_pixel
,
667 f
->display
.x
->background_pixel
,
671 if (FRAME_X_WINDOW (f
) != 0)
673 XDefineCursor (XDISPLAY
FRAME_X_WINDOW (f
), cursor
);
676 if (cursor
!= f
->display
.x
->text_cursor
&& f
->display
.x
->text_cursor
!= 0)
677 XFreeCursor (XDISPLAY f
->display
.x
->text_cursor
);
678 f
->display
.x
->text_cursor
= cursor
;
680 if (nontext_cursor
!= f
->display
.x
->nontext_cursor
681 && f
->display
.x
->nontext_cursor
!= 0)
682 XFreeCursor (XDISPLAY f
->display
.x
->nontext_cursor
);
683 f
->display
.x
->nontext_cursor
= nontext_cursor
;
685 if (mode_cursor
!= f
->display
.x
->modeline_cursor
686 && f
->display
.x
->modeline_cursor
!= 0)
687 XFreeCursor (XDISPLAY f
->display
.x
->modeline_cursor
);
688 f
->display
.x
->modeline_cursor
= mode_cursor
;
689 #endif /* HAVE_X11 */
696 x_set_cursor_color (f
, arg
, oldval
)
698 Lisp_Object arg
, oldval
;
700 unsigned long fore_pixel
;
702 if (!EQ (Vx_cursor_fore_pixel
, Qnil
))
703 fore_pixel
= x_decode_color (Vx_cursor_fore_pixel
, WHITE_PIX_DEFAULT
);
705 fore_pixel
= f
->display
.x
->background_pixel
;
706 f
->display
.x
->cursor_pixel
= x_decode_color (arg
, BLACK_PIX_DEFAULT
);
708 /* Make sure that the cursor color differs from the background color. */
709 if (f
->display
.x
->cursor_pixel
== f
->display
.x
->background_pixel
)
711 f
->display
.x
->cursor_pixel
== f
->display
.x
->mouse_pixel
;
712 if (f
->display
.x
->cursor_pixel
== fore_pixel
)
713 fore_pixel
= f
->display
.x
->background_pixel
;
715 f
->display
.x
->cursor_foreground_pixel
= fore_pixel
;
717 if (FRAME_X_WINDOW (f
) != 0)
721 XSetBackground (x_current_display
, f
->display
.x
->cursor_gc
,
722 f
->display
.x
->cursor_pixel
);
723 XSetForeground (x_current_display
, f
->display
.x
->cursor_gc
,
726 #endif /* HAVE_X11 */
728 if (FRAME_VISIBLE_P (f
))
730 x_display_cursor (f
, 0);
731 x_display_cursor (f
, 1);
736 /* Set the border-color of frame F to value described by ARG.
737 ARG can be a string naming a color.
738 The border-color is used for the border that is drawn by the X server.
739 Note that this does not fully take effect if done before
740 F has an x-window; it must be redone when the window is created.
742 Note: this is done in two routines because of the way X10 works.
744 Note: under X11, this is normally the province of the window manager,
745 and so emacs' border colors may be overridden. */
748 x_set_border_color (f
, arg
, oldval
)
750 Lisp_Object arg
, oldval
;
755 CHECK_STRING (arg
, 0);
756 str
= XSTRING (arg
)->data
;
759 if (!strcmp (str
, "grey") || !strcmp (str
, "Grey")
760 || !strcmp (str
, "gray") || !strcmp (str
, "Gray"))
765 pix
= x_decode_color (arg
, BLACK_PIX_DEFAULT
);
767 x_set_border_pixel (f
, pix
);
770 /* Set the border-color of frame F to pixel value PIX.
771 Note that this does not fully take effect if done before
772 F has an x-window. */
774 x_set_border_pixel (f
, pix
)
778 f
->display
.x
->border_pixel
= pix
;
780 if (FRAME_X_WINDOW (f
) != 0 && f
->display
.x
->border_width
> 0)
787 XSetWindowBorder (x_current_display
, FRAME_X_WINDOW (f
),
791 temp
= XMakePixmap ((Bitmap
) XStoreBitmap (gray_width
, gray_height
,
793 BLACK_PIX_DEFAULT
, WHITE_PIX_DEFAULT
);
795 temp
= XMakeTile (pix
);
796 XChangeBorder (FRAME_X_WINDOW (f
), temp
);
797 XFreePixmap (XDISPLAY temp
);
798 #endif /* not HAVE_X11 */
801 if (FRAME_VISIBLE_P (f
))
807 x_set_cursor_type (f
, arg
, oldval
)
809 Lisp_Object arg
, oldval
;
812 FRAME_DESIRED_CURSOR (f
) = bar_cursor
;
817 FRAME_DESIRED_CURSOR (f
) = filled_box_cursor
;
818 /* Error messages commented out because people have trouble fixing
819 .Xdefaults with Emacs, when it has something bad in it. */
823 ("the `cursor-type' frame parameter should be either `bar' or `box'");
826 /* Make sure the cursor gets redrawn. This is overkill, but how
827 often do people change cursor types? */
832 x_set_icon_type (f
, arg
, oldval
)
834 Lisp_Object arg
, oldval
;
839 if (EQ (oldval
, Qnil
) == EQ (arg
, Qnil
))
844 result
= x_text_icon (f
, 0);
846 result
= x_bitmap_icon (f
);
851 error ("No icon window available.");
854 /* If the window was unmapped (and its icon was mapped),
855 the new icon is not mapped, so map the window in its stead. */
856 if (FRAME_VISIBLE_P (f
))
857 XMapWindow (XDISPLAY
FRAME_X_WINDOW (f
));
863 extern Lisp_Object
x_new_font ();
866 x_set_font (f
, arg
, oldval
)
868 Lisp_Object arg
, oldval
;
872 CHECK_STRING (arg
, 1);
875 result
= x_new_font (f
, XSTRING (arg
)->data
);
878 if (EQ (result
, Qnil
))
879 error ("Font \"%s\" is not defined", XSTRING (arg
)->data
);
880 else if (EQ (result
, Qt
))
881 error ("the characters of the given font have varying widths");
882 else if (STRINGP (result
))
884 recompute_basic_faces (f
);
885 store_frame_param (f
, Qfont
, result
);
892 x_set_border_width (f
, arg
, oldval
)
894 Lisp_Object arg
, oldval
;
896 CHECK_NUMBER (arg
, 0);
898 if (XINT (arg
) == f
->display
.x
->border_width
)
901 if (FRAME_X_WINDOW (f
) != 0)
902 error ("Cannot change the border width of a window");
904 f
->display
.x
->border_width
= XINT (arg
);
908 x_set_internal_border_width (f
, arg
, oldval
)
910 Lisp_Object arg
, oldval
;
913 int old
= f
->display
.x
->internal_border_width
;
915 CHECK_NUMBER (arg
, 0);
916 f
->display
.x
->internal_border_width
= XINT (arg
);
917 if (f
->display
.x
->internal_border_width
< 0)
918 f
->display
.x
->internal_border_width
= 0;
920 if (f
->display
.x
->internal_border_width
== old
)
923 if (FRAME_X_WINDOW (f
) != 0)
926 x_set_window_size (f
, f
->width
, f
->height
);
928 x_set_resize_hint (f
);
932 SET_FRAME_GARBAGED (f
);
937 x_set_visibility (f
, value
, oldval
)
939 Lisp_Object value
, oldval
;
942 XSET (frame
, Lisp_Frame
, f
);
945 Fmake_frame_invisible (frame
);
946 else if (EQ (value
, Qicon
))
947 Ficonify_frame (frame
);
949 Fmake_frame_visible (frame
);
953 x_set_menu_bar_lines_1 (window
, n
)
957 struct window
*w
= XWINDOW (window
);
959 XFASTINT (w
->top
) += n
;
960 XFASTINT (w
->height
) -= n
;
962 /* Handle just the top child in a vertical split. */
963 if (!NILP (w
->vchild
))
964 x_set_menu_bar_lines_1 (w
->vchild
, n
);
966 /* Adjust all children in a horizontal split. */
967 for (window
= w
->hchild
; !NILP (window
); window
= w
->next
)
969 w
= XWINDOW (window
);
970 x_set_menu_bar_lines_1 (window
, n
);
975 x_set_menu_bar_lines (f
, value
, oldval
)
977 Lisp_Object value
, oldval
;
980 int olines
= FRAME_MENU_BAR_LINES (f
);
982 /* Right now, menu bars don't work properly in minibuf-only frames;
983 most of the commands try to apply themselves to the minibuffer
984 frame itslef, and get an error because you can't switch buffers
985 in or split the minibuffer window. */
986 if (FRAME_MINIBUF_ONLY_P (f
))
989 if (XTYPE (value
) == Lisp_Int
)
990 nlines
= XINT (value
);
994 FRAME_MENU_BAR_LINES (f
) = nlines
;
995 x_set_menu_bar_lines_1 (f
->root_window
, nlines
- olines
);
998 /* Change the name of frame F to NAME. If NAME is nil, set F's name to
1001 If EXPLICIT is non-zero, that indicates that lisp code is setting the
1002 name; if NAME is a string, set F's name to NAME and set
1003 F->explicit_name; if NAME is Qnil, then clear F->explicit_name.
1005 If EXPLICIT is zero, that indicates that Emacs redisplay code is
1006 suggesting a new name, which lisp code should override; if
1007 F->explicit_name is set, ignore the new name; otherwise, set it. */
1010 x_set_name (f
, name
, explicit)
1015 /* Make sure that requests from lisp code override requests from
1016 Emacs redisplay code. */
1019 /* If we're switching from explicit to implicit, we had better
1020 update the mode lines and thereby update the title. */
1021 if (f
->explicit_name
&& NILP (name
))
1022 update_mode_lines
= 1;
1024 f
->explicit_name
= ! NILP (name
);
1026 else if (f
->explicit_name
)
1029 /* If NAME is nil, set the name to the x_id_name. */
1031 name
= build_string (x_id_name
);
1033 CHECK_STRING (name
, 0);
1035 /* Don't change the name if it's already NAME. */
1036 if (! NILP (Fstring_equal (name
, f
->name
)))
1039 if (FRAME_X_WINDOW (f
))
1046 text
.value
= XSTRING (name
)->data
;
1047 text
.encoding
= XA_STRING
;
1049 text
.nitems
= XSTRING (name
)->size
;
1050 XSetWMName (x_current_display
, FRAME_X_WINDOW (f
), &text
);
1051 XSetWMIconName (x_current_display
, FRAME_X_WINDOW (f
), &text
);
1054 XSetIconName (XDISPLAY
FRAME_X_WINDOW (f
),
1055 XSTRING (name
)->data
);
1056 XStoreName (XDISPLAY
FRAME_X_WINDOW (f
),
1057 XSTRING (name
)->data
);
1066 /* This function should be called when the user's lisp code has
1067 specified a name for the frame; the name will override any set by the
1070 x_explicitly_set_name (f
, arg
, oldval
)
1072 Lisp_Object arg
, oldval
;
1074 x_set_name (f
, arg
, 1);
1077 /* This function should be called by Emacs redisplay code to set the
1078 name; names set this way will never override names set by the user's
1081 x_implicitly_set_name (f
, arg
, oldval
)
1083 Lisp_Object arg
, oldval
;
1085 x_set_name (f
, arg
, 0);
1089 x_set_autoraise (f
, arg
, oldval
)
1091 Lisp_Object arg
, oldval
;
1093 f
->auto_raise
= !EQ (Qnil
, arg
);
1097 x_set_autolower (f
, arg
, oldval
)
1099 Lisp_Object arg
, oldval
;
1101 f
->auto_lower
= !EQ (Qnil
, arg
);
1105 x_set_vertical_scroll_bars (f
, arg
, oldval
)
1107 Lisp_Object arg
, oldval
;
1109 if (NILP (arg
) != ! FRAME_HAS_VERTICAL_SCROLL_BARS (f
))
1111 FRAME_HAS_VERTICAL_SCROLL_BARS (f
) = ! NILP (arg
);
1113 /* We set this parameter before creating the X window for the
1114 frame, so we can get the geometry right from the start.
1115 However, if the window hasn't been created yet, we shouldn't
1116 call x_set_window_size. */
1117 if (FRAME_X_WINDOW (f
))
1118 x_set_window_size (f
, FRAME_WIDTH (f
), FRAME_HEIGHT (f
));
1122 /* Subroutines of creating an X frame. */
1126 /* Make sure that Vx_resource_name is set to a reasonable value. */
1128 validate_x_resource_name ()
1130 if (! STRINGP (Vx_resource_name
))
1131 Vx_resource_name
= make_string ("emacs", 5);
1135 extern char *x_get_string_resource ();
1136 extern XrmDatabase
x_load_resources ();
1138 DEFUN ("x-get-resource", Fx_get_resource
, Sx_get_resource
, 2, 4, 0,
1139 "Return the value of ATTRIBUTE, of class CLASS, from the X defaults database.\n\
1140 This uses `NAME.ATTRIBUTE' as the key and `Emacs.CLASS' as the\n\
1141 class, where INSTANCE is the name under which Emacs was invoked, or\n\
1142 the name specified by the `-name' or `-rn' command-line arguments.\n\
1144 The optional arguments COMPONENT and SUBCLASS add to the key and the\n\
1145 class, respectively. You must specify both of them or neither.\n\
1146 If you specify them, the key is `NAME.COMPONENT.ATTRIBUTE'\n\
1147 and the class is `Emacs.CLASS.SUBCLASS'.")
1148 (attribute
, class, component
, subclass
)
1149 Lisp_Object attribute
, class, component
, subclass
;
1151 register char *value
;
1157 CHECK_STRING (attribute
, 0);
1158 CHECK_STRING (class, 0);
1160 if (!NILP (component
))
1161 CHECK_STRING (component
, 1);
1162 if (!NILP (subclass
))
1163 CHECK_STRING (subclass
, 2);
1164 if (NILP (component
) != NILP (subclass
))
1165 error ("x-get-resource: must specify both COMPONENT and SUBCLASS or neither");
1167 validate_x_resource_name ();
1169 if (NILP (component
))
1171 /* Allocate space for the components, the dots which separate them,
1172 and the final '\0'. */
1173 name_key
= (char *) alloca (XSTRING (Vx_resource_name
)->size
1174 + XSTRING (attribute
)->size
1176 class_key
= (char *) alloca ((sizeof (EMACS_CLASS
) - 1)
1177 + XSTRING (class)->size
1180 sprintf (name_key
, "%s.%s",
1181 XSTRING (Vx_resource_name
)->data
,
1182 XSTRING (attribute
)->data
);
1183 sprintf (class_key
, "%s.%s",
1185 XSTRING (class)->data
);
1189 name_key
= (char *) alloca (XSTRING (Vx_resource_name
)->size
1190 + XSTRING (component
)->size
1191 + XSTRING (attribute
)->size
1194 class_key
= (char *) alloca ((sizeof (EMACS_CLASS
) - 1)
1195 + XSTRING (class)->size
1196 + XSTRING (subclass
)->size
1199 sprintf (name_key
, "%s.%s.%s",
1200 XSTRING (Vx_resource_name
)->data
,
1201 XSTRING (component
)->data
,
1202 XSTRING (attribute
)->data
);
1203 sprintf (class_key
, "%s.%s.%s",
1205 XSTRING (class)->data
,
1206 XSTRING (subclass
)->data
);
1209 value
= x_get_string_resource (xrdb
, name_key
, class_key
);
1211 if (value
!= (char *) 0)
1212 return build_string (value
);
1217 /* Used when C code wants a resource value. */
1220 x_get_resource_string (attribute
, class)
1221 char *attribute
, *class;
1223 register char *value
;
1227 /* Allocate space for the components, the dots which separate them,
1228 and the final '\0'. */
1229 name_key
= (char *) alloca (XSTRING (Vinvocation_name
)->size
1230 + strlen (attribute
) + 2);
1231 class_key
= (char *) alloca ((sizeof (EMACS_CLASS
) - 1)
1232 + strlen (class) + 2);
1234 sprintf (name_key
, "%s.%s",
1235 XSTRING (Vinvocation_name
)->data
,
1237 sprintf (class_key
, "%s.%s", EMACS_CLASS
, class);
1239 return x_get_string_resource (xrdb
, name_key
, class_key
);
1244 DEFUN ("x-get-default", Fx_get_default
, Sx_get_default
, 1, 1, 0,
1245 "Get X default ATTRIBUTE from the system, or nil if no default.\n\
1246 Value is a string (when not nil) and ATTRIBUTE is also a string.\n\
1247 The defaults are specified in the file `~/.Xdefaults'.")
1251 register unsigned char *value
;
1253 CHECK_STRING (arg
, 1);
1255 value
= (unsigned char *) XGetDefault (XDISPLAY
1256 XSTRING (Vinvocation_name
)->data
,
1257 XSTRING (arg
)->data
);
1259 /* Try reversing last two args, in case this is the buggy version of X. */
1260 value
= (unsigned char *) XGetDefault (XDISPLAY
1261 XSTRING (arg
)->data
,
1262 XSTRING (Vinvocation_name
)->data
);
1264 return build_string (value
);
1269 #define Fx_get_resource(attribute, class, component, subclass) \
1270 Fx_get_default(attribute)
1274 /* Types we might convert a resource string into. */
1277 number
, boolean
, string
, symbol
1280 /* Return the value of parameter PARAM.
1282 First search ALIST, then Vdefault_frame_alist, then the X defaults
1283 database, using ATTRIBUTE as the attribute name and CLASS as its class.
1285 Convert the resource to the type specified by desired_type.
1287 If no default is specified, return Qunbound. If you call
1288 x_get_arg, make sure you deal with Qunbound in a reasonable way,
1289 and don't let it get stored in any lisp-visible variables! */
1292 x_get_arg (alist
, param
, attribute
, class, type
)
1293 Lisp_Object alist
, param
;
1296 enum resource_types type
;
1298 register Lisp_Object tem
;
1300 tem
= Fassq (param
, alist
);
1302 tem
= Fassq (param
, Vdefault_frame_alist
);
1308 tem
= Fx_get_resource (build_string (attribute
),
1309 build_string (class),
1318 return make_number (atoi (XSTRING (tem
)->data
));
1321 tem
= Fdowncase (tem
);
1322 if (!strcmp (XSTRING (tem
)->data
, "on")
1323 || !strcmp (XSTRING (tem
)->data
, "true"))
1332 /* As a special case, we map the values `true' and `on'
1333 to Qt, and `false' and `off' to Qnil. */
1335 Lisp_Object lower
= Fdowncase (tem
);
1336 if (!strcmp (XSTRING (tem
)->data
, "on")
1337 || !strcmp (XSTRING (tem
)->data
, "true"))
1339 else if (!strcmp (XSTRING (tem
)->data
, "off")
1340 || !strcmp (XSTRING (tem
)->data
, "false"))
1343 return Fintern (tem
, Qnil
);
1356 /* Record in frame F the specified or default value according to ALIST
1357 of the parameter named PARAM (a Lisp symbol).
1358 If no value is specified for PARAM, look for an X default for XPROP
1359 on the frame named NAME.
1360 If that is not found either, use the value DEFLT. */
1363 x_default_parameter (f
, alist
, prop
, deflt
, xprop
, xclass
, type
)
1370 enum resource_types type
;
1374 tem
= x_get_arg (alist
, prop
, xprop
, xclass
, type
);
1375 if (EQ (tem
, Qunbound
))
1377 x_set_frame_parameters (f
, Fcons (Fcons (prop
, tem
), Qnil
));
1381 DEFUN ("x-parse-geometry", Fx_parse_geometry
, Sx_parse_geometry
, 1, 1, 0,
1382 "Parse an X-style geometry string STRING.\n\
1383 Returns an alist of the form ((top . TOP), (left . LEFT) ... ).")
1388 unsigned int width
, height
;
1389 Lisp_Object values
[4];
1391 CHECK_STRING (string
, 0);
1393 geometry
= XParseGeometry ((char *) XSTRING (string
)->data
,
1394 &x
, &y
, &width
, &height
);
1396 switch (geometry
& 0xf) /* Mask out {X,Y}Negative */
1398 case (XValue
| YValue
):
1399 /* What's one pixel among friends?
1400 Perhaps fix this some day by returning symbol `extreme-top'... */
1401 if (x
== 0 && (geometry
& XNegative
))
1403 if (y
== 0 && (geometry
& YNegative
))
1405 values
[0] = Fcons (Qleft
, make_number (x
));
1406 values
[1] = Fcons (Qtop
, make_number (y
));
1407 return Flist (2, values
);
1410 case (WidthValue
| HeightValue
):
1411 values
[0] = Fcons (Qwidth
, make_number (width
));
1412 values
[1] = Fcons (Qheight
, make_number (height
));
1413 return Flist (2, values
);
1416 case (XValue
| YValue
| WidthValue
| HeightValue
):
1417 if (x
== 0 && (geometry
& XNegative
))
1419 if (y
== 0 && (geometry
& YNegative
))
1421 values
[0] = Fcons (Qwidth
, make_number (width
));
1422 values
[1] = Fcons (Qheight
, make_number (height
));
1423 values
[2] = Fcons (Qleft
, make_number (x
));
1424 values
[3] = Fcons (Qtop
, make_number (y
));
1425 return Flist (4, values
);
1432 error ("Must specify x and y value, and/or width and height");
1437 /* Calculate the desired size and position of this window,
1438 or set rubber-band prompting if none. */
1440 #define DEFAULT_ROWS 40
1441 #define DEFAULT_COLS 80
1444 x_figure_window_size (f
, parms
)
1448 register Lisp_Object tem0
, tem1
;
1449 int height
, width
, left
, top
;
1450 register int geometry
;
1451 long window_prompting
= 0;
1453 /* Default values if we fall through.
1454 Actually, if that happens we should get
1455 window manager prompting. */
1456 f
->width
= DEFAULT_COLS
;
1457 f
->height
= DEFAULT_ROWS
;
1458 /* Window managers expect that if program-specified
1459 positions are not (0,0), they're intentional, not defaults. */
1460 f
->display
.x
->top_pos
= 0;
1461 f
->display
.x
->left_pos
= 0;
1463 tem0
= x_get_arg (parms
, Qheight
, 0, 0, number
);
1464 tem1
= x_get_arg (parms
, Qwidth
, 0, 0, number
);
1465 if (! EQ (tem0
, Qunbound
) && ! EQ (tem1
, Qunbound
))
1467 CHECK_NUMBER (tem0
, 0);
1468 CHECK_NUMBER (tem1
, 0);
1469 f
->height
= XINT (tem0
);
1470 f
->width
= XINT (tem1
);
1471 window_prompting
|= USSize
;
1473 else if (! EQ (tem0
, Qunbound
) || ! EQ (tem1
, Qunbound
))
1474 error ("Must specify *both* height and width");
1476 f
->display
.x
->vertical_scroll_bar_extra
1477 = (FRAME_HAS_VERTICAL_SCROLL_BARS (f
)
1478 ? VERTICAL_SCROLL_BAR_PIXEL_WIDTH (f
)
1480 f
->display
.x
->pixel_width
= CHAR_TO_PIXEL_WIDTH (f
, f
->width
);
1481 f
->display
.x
->pixel_height
= CHAR_TO_PIXEL_HEIGHT (f
, f
->height
);
1483 tem0
= x_get_arg (parms
, Qtop
, 0, 0, number
);
1484 tem1
= x_get_arg (parms
, Qleft
, 0, 0, number
);
1485 if (! EQ (tem0
, Qunbound
) && ! EQ (tem1
, Qunbound
))
1487 CHECK_NUMBER (tem0
, 0);
1488 CHECK_NUMBER (tem1
, 0);
1489 f
->display
.x
->top_pos
= XINT (tem0
);
1490 f
->display
.x
->left_pos
= XINT (tem1
);
1491 x_calc_absolute_position (f
);
1492 window_prompting
|= USPosition
;
1494 else if (! EQ (tem0
, Qunbound
) || ! EQ (tem1
, Qunbound
))
1495 error ("Must specify *both* top and left corners");
1497 #if 0 /* PPosition and PSize mean "specified explicitly,
1498 by the program rather than by the user". So it is wrong to
1499 set them if nothing was specified. */
1500 switch (window_prompting
)
1502 case USSize
| USPosition
:
1503 return window_prompting
;
1506 case USSize
: /* Got the size, need the position. */
1507 window_prompting
|= PPosition
;
1508 return window_prompting
;
1511 case USPosition
: /* Got the position, need the size. */
1512 window_prompting
|= PSize
;
1513 return window_prompting
;
1516 case 0: /* Got nothing, take both from geometry. */
1517 window_prompting
|= PPosition
| PSize
;
1518 return window_prompting
;
1522 /* Somehow a bit got set in window_prompting that we didn't
1527 return window_prompting
;
1534 XSetWindowAttributes attributes
;
1535 unsigned long attribute_mask
;
1536 XClassHint class_hints
;
1538 attributes
.background_pixel
= f
->display
.x
->background_pixel
;
1539 attributes
.border_pixel
= f
->display
.x
->border_pixel
;
1540 attributes
.bit_gravity
= StaticGravity
;
1541 attributes
.backing_store
= NotUseful
;
1542 attributes
.save_under
= True
;
1543 attributes
.event_mask
= STANDARD_EVENT_SET
;
1544 attribute_mask
= (CWBackPixel
| CWBorderPixel
| CWBitGravity
1546 | CWBackingStore
| CWSaveUnder
1552 = XCreateWindow (x_current_display
, ROOT_WINDOW
,
1553 f
->display
.x
->left_pos
,
1554 f
->display
.x
->top_pos
,
1555 PIXEL_WIDTH (f
), PIXEL_HEIGHT (f
),
1556 f
->display
.x
->border_width
,
1557 CopyFromParent
, /* depth */
1558 InputOutput
, /* class */
1559 screen_visual
, /* set in Fx_open_connection */
1560 attribute_mask
, &attributes
);
1562 validate_x_resource_name ();
1563 class_hints
.res_name
= (char *) XSTRING (Vx_resource_name
)->data
;
1564 class_hints
.res_class
= EMACS_CLASS
;
1565 XSetClassHint (x_current_display
, FRAME_X_WINDOW (f
), &class_hints
);
1567 /* This indicates that we use the "Passive Input" input model.
1568 Unless we do this, we don't get the Focus{In,Out} events that we
1569 need to draw the cursor correctly. Accursed bureaucrats.
1570 XWhipsAndChains (x_current_display, IronMaiden, &TheRack); */
1572 f
->display
.x
->wm_hints
.input
= True
;
1573 f
->display
.x
->wm_hints
.flags
|= InputHint
;
1574 XSetWMHints (x_current_display
, FRAME_X_WINDOW (f
), &f
->display
.x
->wm_hints
);
1576 /* x_set_name normally ignores requests to set the name if the
1577 requested name is the same as the current name. This is the one
1578 place where that assumption isn't correct; f->name is set, but
1579 the X server hasn't been told. */
1581 Lisp_Object name
= f
->name
;
1582 int explicit = f
->explicit_name
;
1585 f
->explicit_name
= 0;
1586 x_set_name (f
, name
, explicit);
1589 XDefineCursor (XDISPLAY
FRAME_X_WINDOW (f
),
1590 f
->display
.x
->text_cursor
);
1593 if (FRAME_X_WINDOW (f
) == 0)
1594 error ("Unable to create window.");
1597 /* Handle the icon stuff for this window. Perhaps later we might
1598 want an x_set_icon_position which can be called interactively as
1606 Lisp_Object icon_x
, icon_y
;
1608 /* Set the position of the icon. Note that twm groups all
1609 icons in an icon window. */
1610 icon_x
= x_get_arg (parms
, Qicon_left
, 0, 0, number
);
1611 icon_y
= x_get_arg (parms
, Qicon_top
, 0, 0, number
);
1612 if (!EQ (icon_x
, Qunbound
) && !EQ (icon_y
, Qunbound
))
1614 CHECK_NUMBER (icon_x
, 0);
1615 CHECK_NUMBER (icon_y
, 0);
1617 else if (!EQ (icon_x
, Qunbound
) || !EQ (icon_y
, Qunbound
))
1618 error ("Both left and top icon corners of icon must be specified");
1622 if (! EQ (icon_x
, Qunbound
))
1623 x_wm_set_icon_position (f
, XINT (icon_x
), XINT (icon_y
));
1625 /* Start up iconic or window? */
1626 x_wm_set_window_state
1627 (f
, (EQ (x_get_arg (parms
, Qvisibility
, 0, 0, symbol
), Qicon
)
1634 /* Make the GC's needed for this window, setting the
1635 background, border and mouse colors; also create the
1636 mouse cursor and the gray border tile. */
1638 static char cursor_bits
[] =
1640 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
1641 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
1642 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
1643 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00
1650 XGCValues gc_values
;
1656 /* Create the GC's of this frame.
1657 Note that many default values are used. */
1660 gc_values
.font
= f
->display
.x
->font
->fid
;
1661 gc_values
.foreground
= f
->display
.x
->foreground_pixel
;
1662 gc_values
.background
= f
->display
.x
->background_pixel
;
1663 gc_values
.line_width
= 0; /* Means 1 using fast algorithm. */
1664 f
->display
.x
->normal_gc
= XCreateGC (x_current_display
,
1666 GCLineWidth
| GCFont
1667 | GCForeground
| GCBackground
,
1670 /* Reverse video style. */
1671 gc_values
.foreground
= f
->display
.x
->background_pixel
;
1672 gc_values
.background
= f
->display
.x
->foreground_pixel
;
1673 f
->display
.x
->reverse_gc
= XCreateGC (x_current_display
,
1675 GCFont
| GCForeground
| GCBackground
1679 /* Cursor has cursor-color background, background-color foreground. */
1680 gc_values
.foreground
= f
->display
.x
->background_pixel
;
1681 gc_values
.background
= f
->display
.x
->cursor_pixel
;
1682 gc_values
.fill_style
= FillOpaqueStippled
;
1684 = XCreateBitmapFromData (x_current_display
, ROOT_WINDOW
,
1685 cursor_bits
, 16, 16);
1686 f
->display
.x
->cursor_gc
1687 = XCreateGC (x_current_display
, FRAME_X_WINDOW (f
),
1688 (GCFont
| GCForeground
| GCBackground
1689 | GCFillStyle
| GCStipple
| GCLineWidth
),
1692 /* Create the gray border tile used when the pointer is not in
1693 the frame. Since this depends on the frame's pixel values,
1694 this must be done on a per-frame basis. */
1695 f
->display
.x
->border_tile
1696 = (XCreatePixmapFromBitmapData
1697 (x_current_display
, ROOT_WINDOW
,
1698 gray_bits
, gray_width
, gray_height
,
1699 f
->display
.x
->foreground_pixel
,
1700 f
->display
.x
->background_pixel
,
1701 DefaultDepth (x_current_display
, XDefaultScreen (x_current_display
))));
1705 #endif /* HAVE_X11 */
1707 DEFUN ("x-create-frame", Fx_create_frame
, Sx_create_frame
,
1709 "Make a new X window, which is called a \"frame\" in Emacs terms.\n\
1710 Return an Emacs frame object representing the X window.\n\
1711 ALIST is an alist of frame parameters.\n\
1712 If the parameters specify that the frame should not have a minibuffer,\n\
1713 and do not specify a specific minibuffer window to use,\n\
1714 then `default-minibuffer-frame' must be a frame whose minibuffer can\n\
1715 be shared by the new frame.")
1721 Lisp_Object frame
, tem
, tem0
, tem1
;
1723 int minibuffer_only
= 0;
1724 long window_prompting
= 0;
1729 name
= x_get_arg (parms
, Qname
, "title", "Title", string
);
1730 if (XTYPE (name
) != Lisp_String
1731 && ! EQ (name
, Qunbound
)
1733 error ("x-create-frame: name parameter must be a string");
1735 tem
= x_get_arg (parms
, Qminibuffer
, 0, 0, symbol
);
1736 if (EQ (tem
, Qnone
) || NILP (tem
))
1737 f
= make_frame_without_minibuffer (Qnil
);
1738 else if (EQ (tem
, Qonly
))
1740 f
= make_minibuffer_frame ();
1741 minibuffer_only
= 1;
1743 else if (XTYPE (tem
) == Lisp_Window
)
1744 f
= make_frame_without_minibuffer (tem
);
1748 /* Note that X Windows does support scroll bars. */
1749 FRAME_CAN_HAVE_SCROLL_BARS (f
) = 1;
1751 /* Set the name; the functions to which we pass f expect the name to
1753 if (EQ (name
, Qunbound
) || NILP (name
))
1755 f
->name
= build_string (x_id_name
);
1756 f
->explicit_name
= 0;
1761 f
->explicit_name
= 1;
1764 XSET (frame
, Lisp_Frame
, f
);
1765 f
->output_method
= output_x_window
;
1766 f
->display
.x
= (struct x_display
*) xmalloc (sizeof (struct x_display
));
1767 bzero (f
->display
.x
, sizeof (struct x_display
));
1769 /* Note that the frame has no physical cursor right now. */
1770 f
->phys_cursor_x
= -1;
1772 /* Extract the window parameters from the supplied values
1773 that are needed to determine window geometry. */
1777 font
= x_get_arg (parms
, Qfont
, "font", "Font", string
);
1779 /* First, try whatever font the caller has specified. */
1781 font
= x_new_font (f
, XSTRING (font
)->data
);
1782 /* Try out a font which we hope has bold and italic variations. */
1783 if (!STRINGP (font
))
1784 font
= x_new_font (f
, "-misc-fixed-medium-r-normal-*-*-120-*-*-c-*-iso8859-1");
1785 if (! STRINGP (font
))
1786 font
= x_new_font (f
, "-*-*-medium-r-normal-*-*-120-*-*-c-*-iso8859-1");
1787 if (! STRINGP (font
))
1788 /* This was formerly the first thing tried, but it finds too many fonts
1789 and takes too long. */
1790 font
= x_new_font (f
, "-*-*-medium-r-*-*-*-*-*-*-c-*-iso8859-1");
1791 /* If those didn't work, look for something which will at least work. */
1792 if (! STRINGP (font
))
1793 font
= x_new_font (f
, "-*-fixed-*-*-*-*-*-120-*-*-c-*-iso8859-1");
1795 if (! STRINGP (font
))
1796 font
= build_string ("fixed");
1798 x_default_parameter (f
, parms
, Qfont
, font
,
1799 "font", "Font", string
);
1801 x_default_parameter (f
, parms
, Qborder_width
, make_number (2),
1802 "borderwidth", "BorderWidth", number
);
1803 /* This defaults to 2 in order to match xterm. We recognize either
1804 internalBorderWidth or internalBorder (which is what xterm calls
1806 if (NILP (Fassq (Qinternal_border_width
, parms
)))
1810 value
= x_get_arg (parms
, Qinternal_border_width
,
1811 "internalBorder", "BorderWidth", number
);
1812 if (! EQ (value
, Qunbound
))
1813 parms
= Fcons (Fcons (Qinternal_border_width
, value
),
1816 x_default_parameter (f
, parms
, Qinternal_border_width
, make_number (2),
1817 "internalBorderWidth", "BorderWidth", number
);
1818 x_default_parameter (f
, parms
, Qvertical_scroll_bars
, Qt
,
1819 "verticalScrollBars", "ScrollBars", boolean
);
1821 /* Also do the stuff which must be set before the window exists. */
1822 x_default_parameter (f
, parms
, Qforeground_color
, build_string ("black"),
1823 "foreground", "Foreground", string
);
1824 x_default_parameter (f
, parms
, Qbackground_color
, build_string ("white"),
1825 "background", "Background", string
);
1826 x_default_parameter (f
, parms
, Qmouse_color
, build_string ("black"),
1827 "pointerColor", "Foreground", string
);
1828 x_default_parameter (f
, parms
, Qcursor_color
, build_string ("black"),
1829 "cursorColor", "Foreground", string
);
1830 x_default_parameter (f
, parms
, Qborder_color
, build_string ("black"),
1831 "borderColor", "BorderColor", string
);
1833 f
->display
.x
->parent_desc
= ROOT_WINDOW
;
1834 window_prompting
= x_figure_window_size (f
, parms
);
1839 init_frame_faces (f
);
1841 /* We need to do this after creating the X window, so that the
1842 icon-creation functions can say whose icon they're describing. */
1843 x_default_parameter (f
, parms
, Qicon_type
, Qnil
,
1844 "bitmapIcon", "BitmapIcon", symbol
);
1846 x_default_parameter (f
, parms
, Qauto_raise
, Qnil
,
1847 "autoRaise", "AutoRaiseLower", boolean
);
1848 x_default_parameter (f
, parms
, Qauto_lower
, Qnil
,
1849 "autoLower", "AutoRaiseLower", boolean
);
1850 x_default_parameter (f
, parms
, Qcursor_type
, Qbox
,
1851 "cursorType", "CursorType", symbol
);
1853 /* Dimensions, especially f->height, must be done via change_frame_size.
1854 Change will not be effected unless different from the current
1858 f
->height
= f
->width
= 0;
1859 change_frame_size (f
, height
, width
, 1, 0);
1861 x_default_parameter (f
, parms
, Qmenu_bar_lines
, make_number (0),
1862 "menuBarLines", "MenuBarLines", number
);
1864 tem0
= x_get_arg (parms
, Qtop
, 0, 0, number
);
1865 tem1
= x_get_arg (parms
, Qleft
, 0, 0, number
);
1867 x_wm_set_size_hint (f
, window_prompting
, XINT (tem0
), XINT (tem1
));
1870 tem
= x_get_arg (parms
, Qunsplittable
, 0, 0, boolean
);
1871 f
->no_split
= minibuffer_only
|| EQ (tem
, Qt
);
1873 /* Make the window appear on the frame and enable display,
1874 unless the caller says not to. */
1876 Lisp_Object visibility
= x_get_arg (parms
, Qvisibility
, 0, 0, symbol
);
1878 if (EQ (visibility
, Qunbound
))
1881 if (EQ (visibility
, Qicon
))
1882 x_iconify_frame (f
);
1883 else if (! NILP (visibility
))
1884 x_make_frame_visible (f
);
1886 /* Must have been Qnil. */
1893 Lisp_Object frame
, tem
;
1895 int pixelwidth
, pixelheight
;
1900 int minibuffer_only
= 0;
1901 Lisp_Object vscroll
, hscroll
;
1903 if (x_current_display
== 0)
1904 error ("X windows are not in use or not initialized");
1906 name
= Fassq (Qname
, parms
);
1908 tem
= x_get_arg (parms
, Qminibuffer
, 0, 0, symbol
);
1909 if (EQ (tem
, Qnone
))
1910 f
= make_frame_without_minibuffer (Qnil
);
1911 else if (EQ (tem
, Qonly
))
1913 f
= make_minibuffer_frame ();
1914 minibuffer_only
= 1;
1916 else if (EQ (tem
, Qnil
) || EQ (tem
, Qunbound
))
1919 f
= make_frame_without_minibuffer (tem
);
1921 parent
= ROOT_WINDOW
;
1923 XSET (frame
, Lisp_Frame
, f
);
1924 f
->output_method
= output_x_window
;
1925 f
->display
.x
= (struct x_display
*) xmalloc (sizeof (struct x_display
));
1926 bzero (f
->display
.x
, sizeof (struct x_display
));
1928 /* Some temporary default values for height and width. */
1931 f
->display
.x
->left_pos
= -1;
1932 f
->display
.x
->top_pos
= -1;
1934 /* Give the frame a default name (which may be overridden with PARMS). */
1936 strncpy (iconidentity
, ICONTAG
, MAXICID
);
1937 if (gethostname (&iconidentity
[sizeof (ICONTAG
) - 1],
1938 (MAXICID
- 1) - sizeof (ICONTAG
)))
1939 iconidentity
[sizeof (ICONTAG
) - 2] = '\0';
1940 f
->name
= build_string (iconidentity
);
1942 /* Extract some window parameters from the supplied values.
1943 These are the parameters that affect window geometry. */
1945 tem
= x_get_arg (parms
, Qfont
, "BodyFont", 0, string
);
1946 if (EQ (tem
, Qunbound
))
1947 tem
= build_string ("9x15");
1948 x_set_font (f
, tem
, Qnil
);
1949 x_default_parameter (f
, parms
, Qborder_color
,
1950 build_string ("black"), "Border", 0, string
);
1951 x_default_parameter (f
, parms
, Qbackground_color
,
1952 build_string ("white"), "Background", 0, string
);
1953 x_default_parameter (f
, parms
, Qforeground_color
,
1954 build_string ("black"), "Foreground", 0, string
);
1955 x_default_parameter (f
, parms
, Qmouse_color
,
1956 build_string ("black"), "Mouse", 0, string
);
1957 x_default_parameter (f
, parms
, Qcursor_color
,
1958 build_string ("black"), "Cursor", 0, string
);
1959 x_default_parameter (f
, parms
, Qborder_width
,
1960 make_number (2), "BorderWidth", 0, number
);
1961 x_default_parameter (f
, parms
, Qinternal_border_width
,
1962 make_number (4), "InternalBorderWidth", 0, number
);
1963 x_default_parameter (f
, parms
, Qauto_raise
,
1964 Qnil
, "AutoRaise", 0, boolean
);
1966 hscroll
= EQ (x_get_arg (parms
, Qhorizontal_scroll_bar
, 0, 0, boolean
), Qt
);
1967 vscroll
= EQ (x_get_arg (parms
, Qvertical_scroll_bar
, 0, 0, boolean
), Qt
);
1969 if (f
->display
.x
->internal_border_width
< 0)
1970 f
->display
.x
->internal_border_width
= 0;
1972 tem
= x_get_arg (parms
, Qwindow_id
, 0, 0, number
);
1973 if (!EQ (tem
, Qunbound
))
1975 WINDOWINFO_TYPE wininfo
;
1977 Window
*children
, root
;
1979 CHECK_NUMBER (tem
, 0);
1980 FRAME_X_WINDOW (f
) = (Window
) XINT (tem
);
1983 XGetWindowInfo (FRAME_X_WINDOW (f
), &wininfo
);
1984 XQueryTree (FRAME_X_WINDOW (f
), &parent
, &nchildren
, &children
);
1988 height
= PIXEL_TO_CHAR_HEIGHT (f
, wininfo
.height
);
1989 width
= PIXEL_TO_CHAR_WIDTH (f
, wininfo
.width
);
1990 f
->display
.x
->left_pos
= wininfo
.x
;
1991 f
->display
.x
->top_pos
= wininfo
.y
;
1992 FRAME_SET_VISIBILITY (f
, wininfo
.mapped
!= 0);
1993 f
->display
.x
->border_width
= wininfo
.bdrwidth
;
1994 f
->display
.x
->parent_desc
= parent
;
1998 tem
= x_get_arg (parms
, Qparent_id
, 0, 0, number
);
1999 if (!EQ (tem
, Qunbound
))
2001 CHECK_NUMBER (tem
, 0);
2002 parent
= (Window
) XINT (tem
);
2004 f
->display
.x
->parent_desc
= parent
;
2005 tem
= x_get_arg (parms
, Qheight
, 0, 0, number
);
2006 if (EQ (tem
, Qunbound
))
2008 tem
= x_get_arg (parms
, Qwidth
, 0, 0, number
);
2009 if (EQ (tem
, Qunbound
))
2011 tem
= x_get_arg (parms
, Qtop
, 0, 0, number
);
2012 if (EQ (tem
, Qunbound
))
2013 tem
= x_get_arg (parms
, Qleft
, 0, 0, number
);
2016 /* Now TEM is Qunbound if no edge or size was specified.
2017 In that case, we must do rubber-banding. */
2018 if (EQ (tem
, Qunbound
))
2020 tem
= x_get_arg (parms
, Qgeometry
, 0, 0, number
);
2022 &f
->display
.x
->left_pos
, &f
->display
.x
->top_pos
,
2024 (XTYPE (tem
) == Lisp_String
2025 ? (char *) XSTRING (tem
)->data
: ""),
2026 XSTRING (f
->name
)->data
,
2027 !NILP (hscroll
), !NILP (vscroll
));
2031 /* Here if at least one edge or size was specified.
2032 Demand that they all were specified, and use them. */
2033 tem
= x_get_arg (parms
, Qheight
, 0, 0, number
);
2034 if (EQ (tem
, Qunbound
))
2035 error ("Height not specified");
2036 CHECK_NUMBER (tem
, 0);
2037 height
= XINT (tem
);
2039 tem
= x_get_arg (parms
, Qwidth
, 0, 0, number
);
2040 if (EQ (tem
, Qunbound
))
2041 error ("Width not specified");
2042 CHECK_NUMBER (tem
, 0);
2045 tem
= x_get_arg (parms
, Qtop
, 0, 0, number
);
2046 if (EQ (tem
, Qunbound
))
2047 error ("Top position not specified");
2048 CHECK_NUMBER (tem
, 0);
2049 f
->display
.x
->left_pos
= XINT (tem
);
2051 tem
= x_get_arg (parms
, Qleft
, 0, 0, number
);
2052 if (EQ (tem
, Qunbound
))
2053 error ("Left position not specified");
2054 CHECK_NUMBER (tem
, 0);
2055 f
->display
.x
->top_pos
= XINT (tem
);
2058 pixelwidth
= CHAR_TO_PIXEL_WIDTH (f
, width
);
2059 pixelheight
= CHAR_TO_PIXEL_HEIGHT (f
, height
);
2063 = XCreateWindow (parent
,
2064 f
->display
.x
->left_pos
, /* Absolute horizontal offset */
2065 f
->display
.x
->top_pos
, /* Absolute Vertical offset */
2066 pixelwidth
, pixelheight
,
2067 f
->display
.x
->border_width
,
2068 BLACK_PIX_DEFAULT
, WHITE_PIX_DEFAULT
);
2070 if (FRAME_X_WINDOW (f
) == 0)
2071 error ("Unable to create window.");
2074 /* Install the now determined height and width
2075 in the windows and in phys_lines and desired_lines. */
2076 change_frame_size (f
, height
, width
, 1, 0);
2077 XSelectInput (FRAME_X_WINDOW (f
), KeyPressed
| ExposeWindow
2078 | ButtonPressed
| ButtonReleased
| ExposeRegion
| ExposeCopy
2079 | EnterWindow
| LeaveWindow
| UnmapWindow
);
2080 x_set_resize_hint (f
);
2082 /* Tell the server the window's default name. */
2083 XStoreName (XDISPLAY
FRAME_X_WINDOW (f
), XSTRING (f
->name
)->data
);
2085 /* Now override the defaults with all the rest of the specified
2087 tem
= x_get_arg (parms
, Qunsplittable
, 0, 0, boolean
);
2088 f
->no_split
= minibuffer_only
|| EQ (tem
, Qt
);
2090 /* Do not create an icon window if the caller says not to */
2091 if (!EQ (x_get_arg (parms
, Qsuppress_icon
, 0, 0, boolean
), Qt
)
2092 || f
->display
.x
->parent_desc
!= ROOT_WINDOW
)
2094 x_text_icon (f
, iconidentity
);
2095 x_default_parameter (f
, parms
, Qicon_type
, Qnil
,
2096 "BitmapIcon", 0, symbol
);
2099 /* Tell the X server the previously set values of the
2100 background, border and mouse colors; also create the mouse cursor. */
2102 temp
= XMakeTile (f
->display
.x
->background_pixel
);
2103 XChangeBackground (FRAME_X_WINDOW (f
), temp
);
2106 x_set_border_pixel (f
, f
->display
.x
->border_pixel
);
2108 x_set_mouse_color (f
, Qnil
, Qnil
);
2110 /* Now override the defaults with all the rest of the specified parms. */
2112 Fmodify_frame_parameters (frame
, parms
);
2114 /* Make the window appear on the frame and enable display. */
2116 Lisp_Object visibility
= x_get_arg (parms
, Qvisibility
, 0, 0, symbol
);
2118 if (EQ (visibility
, Qunbound
))
2121 if (! EQ (visibility
, Qicon
)
2122 && ! NILP (visibility
))
2123 x_make_window_visible (f
);
2126 SET_FRAME_GARBAGED (f
);
2132 DEFUN ("focus-frame", Ffocus_frame
, Sfocus_frame
, 1, 1, 0,
2133 "Set the focus on FRAME.")
2137 CHECK_LIVE_FRAME (frame
, 0);
2139 if (FRAME_X_P (XFRAME (frame
)))
2142 x_focus_on_frame (XFRAME (frame
));
2150 DEFUN ("unfocus-frame", Funfocus_frame
, Sunfocus_frame
, 0, 0, 0,
2151 "If a frame has been focused, release it.")
2157 x_unfocus_frame (x_focus_frame
);
2165 /* Computes an X-window size and position either from geometry GEO
2168 F is a frame. It specifies an X window which is used to
2169 determine which display to compute for. Its font, borders
2170 and colors control how the rectangle will be displayed.
2172 X and Y are where to store the positions chosen.
2173 WIDTH and HEIGHT are where to store the sizes chosen.
2175 GEO is the geometry that may specify some of the info.
2176 STR is a prompt to display.
2177 HSCROLL and VSCROLL say whether we have horiz and vert scroll bars. */
2180 x_rubber_band (f
, x
, y
, width
, height
, geo
, str
, hscroll
, vscroll
)
2182 int *x
, *y
, *width
, *height
;
2185 int hscroll
, vscroll
;
2191 int background_color
;
2197 background_color
= f
->display
.x
->background_pixel
;
2198 border_color
= f
->display
.x
->border_pixel
;
2200 frame
.bdrwidth
= f
->display
.x
->border_width
;
2201 frame
.border
= XMakeTile (border_color
);
2202 frame
.background
= XMakeTile (background_color
);
2203 tempwindow
= XCreateTerm (str
, "emacs", geo
, default_window
, &frame
, 10, 5,
2204 (2 * f
->display
.x
->internal_border_width
2205 + (vscroll
? VSCROLL_WIDTH
: 0)),
2206 (2 * f
->display
.x
->internal_border_width
2207 + (hscroll
? HSCROLL_HEIGHT
: 0)),
2208 width
, height
, f
->display
.x
->font
,
2209 FONT_WIDTH (f
->display
.x
->font
),
2210 FONT_HEIGHT (f
->display
.x
->font
));
2211 XFreePixmap (frame
.border
);
2212 XFreePixmap (frame
.background
);
2214 if (tempwindow
!= 0)
2216 XQueryWindow (tempwindow
, &wininfo
);
2217 XDestroyWindow (tempwindow
);
2222 /* Coordinates we got are relative to the root window.
2223 Convert them to coordinates relative to desired parent window
2224 by scanning from there up to the root. */
2225 tempwindow
= f
->display
.x
->parent_desc
;
2226 while (tempwindow
!= ROOT_WINDOW
)
2230 XQueryWindow (tempwindow
, &wininfo
);
2233 XQueryTree (tempwindow
, &tempwindow
, &nchildren
, &children
);
2238 return tempwindow
!= 0;
2240 #endif /* not HAVE_X11 */
2242 DEFUN ("x-list-fonts", Fx_list_fonts
, Sx_list_fonts
, 1, 3, 0,
2243 "Return a list of the names of available fonts matching PATTERN.\n\
2244 If optional arguments FACE and FRAME are specified, return only fonts\n\
2245 the same size as FACE on FRAME.\n\
2247 PATTERN is a string, perhaps with wildcard characters;\n\
2248 the * character matches any substring, and\n\
2249 the ? character matches any single character.\n\
2250 PATTERN is case-insensitive.\n\
2251 FACE is a face name - a symbol.\n\
2253 The return value is a list of strings, suitable as arguments to\n\
2256 The list does not include fonts Emacs can't use (i.e. proportional\n\
2257 fonts), even if they match PATTERN and FACE.")
2258 (pattern
, face
, frame
)
2259 Lisp_Object pattern
, face
, frame
;
2264 XFontStruct
*size_ref
;
2267 CHECK_STRING (pattern
, 0);
2269 CHECK_SYMBOL (face
, 1);
2271 CHECK_LIVE_FRAME (frame
, 2);
2277 FRAME_PTR f
= NILP (frame
) ? selected_frame
: XFRAME (frame
);
2278 int face_id
= face_name_id_number (f
, face
);
2280 if (face_id
< 0 || face_id
>= FRAME_N_PARAM_FACES (f
)
2281 || FRAME_PARAM_FACES (f
) [face_id
] == 0)
2282 size_ref
= f
->display
.x
->font
;
2285 size_ref
= FRAME_PARAM_FACES (f
) [face_id
]->font
;
2286 if (size_ref
== (XFontStruct
*) (~0))
2287 size_ref
= f
->display
.x
->font
;
2292 names
= XListFontsWithInfo (x_current_display
,
2293 XSTRING (pattern
)->data
,
2294 2000, /* maxnames */
2295 &num_fonts
, /* count_return */
2296 &info
); /* info_return */
2307 for (i
= 0; i
< num_fonts
; i
++)
2309 || same_size_fonts (&info
[i
], size_ref
))
2311 *tail
= Fcons (build_string (names
[i
]), Qnil
);
2312 tail
= &XCONS (*tail
)->cdr
;
2315 XFreeFontInfo (names
, info
, num_fonts
);
2322 DEFUN ("x-color-defined-p", Fx_color_defined_p
, Sx_color_defined_p
, 1, 1, 0,
2323 "Return t if the current X display supports the color named COLOR.")
2330 CHECK_STRING (color
, 0);
2332 if (defined_color (XSTRING (color
)->data
, &foo
))
2338 DEFUN ("x-display-color-p", Fx_display_color_p
, Sx_display_color_p
, 0, 0, 0,
2339 "Return t if the X screen currently in use supports color.")
2344 if (x_screen_planes
<= 2)
2347 switch (screen_visual
->class)
2360 DEFUN ("x-display-pixel-width", Fx_display_pixel_width
, Sx_display_pixel_width
,
2362 "Returns the width in pixels of the display FRAME is on.")
2366 Display
*dpy
= x_current_display
;
2368 return make_number (DisplayWidth (dpy
, DefaultScreen (dpy
)));
2371 DEFUN ("x-display-pixel-height", Fx_display_pixel_height
,
2372 Sx_display_pixel_height
, 0, 1, 0,
2373 "Returns the height in pixels of the display FRAME is on.")
2377 Display
*dpy
= x_current_display
;
2379 return make_number (DisplayHeight (dpy
, DefaultScreen (dpy
)));
2382 DEFUN ("x-display-planes", Fx_display_planes
, Sx_display_planes
,
2384 "Returns the number of bitplanes of the display FRAME is on.")
2388 Display
*dpy
= x_current_display
;
2390 return make_number (DisplayPlanes (dpy
, DefaultScreen (dpy
)));
2393 DEFUN ("x-display-color-cells", Fx_display_color_cells
, Sx_display_color_cells
,
2395 "Returns the number of color cells of the display FRAME is on.")
2399 Display
*dpy
= x_current_display
;
2401 return make_number (DisplayCells (dpy
, DefaultScreen (dpy
)));
2404 DEFUN ("x-server-max-request-size", Fx_server_max_request_size
,
2405 Sx_server_max_request_size
,
2407 "Returns the maximum request size of the X server FRAME is using.")
2411 Display
*dpy
= x_current_display
;
2413 return make_number (MAXREQUEST (dpy
));
2416 DEFUN ("x-server-vendor", Fx_server_vendor
, Sx_server_vendor
, 0, 1, 0,
2417 "Returns the vendor ID string of the X server FRAME is on.")
2421 Display
*dpy
= x_current_display
;
2424 vendor
= ServerVendor (dpy
);
2425 if (! vendor
) vendor
= "";
2426 return build_string (vendor
);
2429 DEFUN ("x-server-version", Fx_server_version
, Sx_server_version
, 0, 1, 0,
2430 "Returns the version numbers of the X server in use.\n\
2431 The value is a list of three integers: the major and minor\n\
2432 version numbers of the X Protocol in use, and the vendor-specific release\n\
2433 number. See also the variable `x-server-vendor'.")
2437 Display
*dpy
= x_current_display
;
2440 return Fcons (make_number (ProtocolVersion (dpy
)),
2441 Fcons (make_number (ProtocolRevision (dpy
)),
2442 Fcons (make_number (VendorRelease (dpy
)), Qnil
)));
2445 DEFUN ("x-display-screens", Fx_display_screens
, Sx_display_screens
, 0, 1, 0,
2446 "Returns the number of screens on the X server FRAME is on.")
2451 return make_number (ScreenCount (x_current_display
));
2454 DEFUN ("x-display-mm-height", Fx_display_mm_height
, Sx_display_mm_height
, 0, 1, 0,
2455 "Returns the height in millimeters of the X screen FRAME is on.")
2460 return make_number (HeightMMOfScreen (x_screen
));
2463 DEFUN ("x-display-mm-width", Fx_display_mm_width
, Sx_display_mm_width
, 0, 1, 0,
2464 "Returns the width in millimeters of the X screen FRAME is on.")
2469 return make_number (WidthMMOfScreen (x_screen
));
2472 DEFUN ("x-display-backing-store", Fx_display_backing_store
,
2473 Sx_display_backing_store
, 0, 1, 0,
2474 "Returns an indication of whether the X screen FRAME is on does backing store.\n\
2475 The value may be `always', `when-mapped', or `not-useful'.")
2481 switch (DoesBackingStore (x_screen
))
2484 return intern ("always");
2487 return intern ("when-mapped");
2490 return intern ("not-useful");
2493 error ("Strange value for BackingStore parameter of screen");
2497 DEFUN ("x-display-visual-class", Fx_display_visual_class
,
2498 Sx_display_visual_class
, 0, 1, 0,
2499 "Returns the visual class of the display `screen' is on.\n\
2500 The value is one of the symbols `static-gray', `gray-scale',\n\
2501 `static-color', `pseudo-color', `true-color', or `direct-color'.")
2507 switch (screen_visual
->class)
2509 case StaticGray
: return (intern ("static-gray"));
2510 case GrayScale
: return (intern ("gray-scale"));
2511 case StaticColor
: return (intern ("static-color"));
2512 case PseudoColor
: return (intern ("pseudo-color"));
2513 case TrueColor
: return (intern ("true-color"));
2514 case DirectColor
: return (intern ("direct-color"));
2516 error ("Display has an unknown visual class");
2520 DEFUN ("x-display-save-under", Fx_display_save_under
,
2521 Sx_display_save_under
, 0, 1, 0,
2522 "Returns t if the X screen FRAME is on supports the save-under feature.")
2528 if (DoesSaveUnders (x_screen
) == True
)
2535 register struct frame
*f
;
2537 return PIXEL_WIDTH (f
);
2541 register struct frame
*f
;
2543 return PIXEL_HEIGHT (f
);
2547 register struct frame
*f
;
2549 return FONT_WIDTH (f
->display
.x
->font
);
2553 register struct frame
*f
;
2555 return FONT_HEIGHT (f
->display
.x
->font
);
2558 #if 0 /* These no longer seem like the right way to do things. */
2560 /* Draw a rectangle on the frame with left top corner including
2561 the character specified by LEFT_CHAR and TOP_CHAR. The rectangle is
2562 CHARS by LINES wide and long and is the color of the cursor. */
2565 x_rectangle (f
, gc
, left_char
, top_char
, chars
, lines
)
2566 register struct frame
*f
;
2568 register int top_char
, left_char
, chars
, lines
;
2572 int left
= (left_char
* FONT_WIDTH (f
->display
.x
->font
)
2573 + f
->display
.x
->internal_border_width
);
2574 int top
= (top_char
* FONT_HEIGHT (f
->display
.x
->font
)
2575 + f
->display
.x
->internal_border_width
);
2578 width
= FONT_WIDTH (f
->display
.x
->font
) / 2;
2580 width
= FONT_WIDTH (f
->display
.x
->font
) * chars
;
2582 height
= FONT_HEIGHT (f
->display
.x
->font
) / 2;
2584 height
= FONT_HEIGHT (f
->display
.x
->font
) * lines
;
2586 XDrawRectangle (x_current_display
, FRAME_X_WINDOW (f
),
2587 gc
, left
, top
, width
, height
);
2590 DEFUN ("x-draw-rectangle", Fx_draw_rectangle
, Sx_draw_rectangle
, 5, 5, 0,
2591 "Draw a rectangle on FRAME between coordinates specified by\n\
2592 numbers X0, Y0, X1, Y1 in the cursor pixel.")
2593 (frame
, X0
, Y0
, X1
, Y1
)
2594 register Lisp_Object frame
, X0
, X1
, Y0
, Y1
;
2596 register int x0
, y0
, x1
, y1
, top
, left
, n_chars
, n_lines
;
2598 CHECK_LIVE_FRAME (frame
, 0);
2599 CHECK_NUMBER (X0
, 0);
2600 CHECK_NUMBER (Y0
, 1);
2601 CHECK_NUMBER (X1
, 2);
2602 CHECK_NUMBER (Y1
, 3);
2612 n_lines
= y1
- y0
+ 1;
2617 n_lines
= y0
- y1
+ 1;
2623 n_chars
= x1
- x0
+ 1;
2628 n_chars
= x0
- x1
+ 1;
2632 x_rectangle (XFRAME (frame
), XFRAME (frame
)->display
.x
->cursor_gc
,
2633 left
, top
, n_chars
, n_lines
);
2639 DEFUN ("x-erase-rectangle", Fx_erase_rectangle
, Sx_erase_rectangle
, 5, 5, 0,
2640 "Draw a rectangle drawn on FRAME between coordinates\n\
2641 X0, Y0, X1, Y1 in the regular background-pixel.")
2642 (frame
, X0
, Y0
, X1
, Y1
)
2643 register Lisp_Object frame
, X0
, Y0
, X1
, Y1
;
2645 register int x0
, y0
, x1
, y1
, top
, left
, n_chars
, n_lines
;
2647 CHECK_FRAME (frame
, 0);
2648 CHECK_NUMBER (X0
, 0);
2649 CHECK_NUMBER (Y0
, 1);
2650 CHECK_NUMBER (X1
, 2);
2651 CHECK_NUMBER (Y1
, 3);
2661 n_lines
= y1
- y0
+ 1;
2666 n_lines
= y0
- y1
+ 1;
2672 n_chars
= x1
- x0
+ 1;
2677 n_chars
= x0
- x1
+ 1;
2681 x_rectangle (XFRAME (frame
), XFRAME (frame
)->display
.x
->reverse_gc
,
2682 left
, top
, n_chars
, n_lines
);
2688 /* Draw lines around the text region beginning at the character position
2689 TOP_X, TOP_Y and ending at BOTTOM_X and BOTTOM_Y. GC specifies the
2690 pixel and line characteristics. */
2692 #define line_len(line) (FRAME_CURRENT_GLYPHS (f)->used[(line)])
2695 outline_region (f
, gc
, top_x
, top_y
, bottom_x
, bottom_y
)
2696 register struct frame
*f
;
2698 int top_x
, top_y
, bottom_x
, bottom_y
;
2700 register int ibw
= f
->display
.x
->internal_border_width
;
2701 register int font_w
= FONT_WIDTH (f
->display
.x
->font
);
2702 register int font_h
= FONT_HEIGHT (f
->display
.x
->font
);
2704 int x
= line_len (y
);
2705 XPoint
*pixel_points
= (XPoint
*)
2706 alloca (((bottom_y
- top_y
+ 2) * 4) * sizeof (XPoint
));
2707 register XPoint
*this_point
= pixel_points
;
2709 /* Do the horizontal top line/lines */
2712 this_point
->x
= ibw
;
2713 this_point
->y
= ibw
+ (font_h
* top_y
);
2716 this_point
->x
= ibw
+ (font_w
/ 2); /* Half-size for newline chars. */
2718 this_point
->x
= ibw
+ (font_w
* x
);
2719 this_point
->y
= (this_point
- 1)->y
;
2723 this_point
->x
= ibw
;
2724 this_point
->y
= ibw
+ (font_h
* (top_y
+ 1));
2726 this_point
->x
= ibw
+ (font_w
* top_x
);
2727 this_point
->y
= (this_point
- 1)->y
;
2729 this_point
->x
= (this_point
- 1)->x
;
2730 this_point
->y
= ibw
+ (font_h
* top_y
);
2732 this_point
->x
= ibw
+ (font_w
* x
);
2733 this_point
->y
= (this_point
- 1)->y
;
2736 /* Now do the right side. */
2737 while (y
< bottom_y
)
2738 { /* Right vertical edge */
2740 this_point
->x
= (this_point
- 1)->x
;
2741 this_point
->y
= ibw
+ (font_h
* (y
+ 1));
2744 y
++; /* Horizontal connection to next line */
2747 this_point
->x
= ibw
+ (font_w
/ 2);
2749 this_point
->x
= ibw
+ (font_w
* x
);
2751 this_point
->y
= (this_point
- 1)->y
;
2754 /* Now do the bottom and connect to the top left point. */
2755 this_point
->x
= ibw
+ (font_w
* (bottom_x
+ 1));
2758 this_point
->x
= (this_point
- 1)->x
;
2759 this_point
->y
= ibw
+ (font_h
* (bottom_y
+ 1));
2761 this_point
->x
= ibw
;
2762 this_point
->y
= (this_point
- 1)->y
;
2764 this_point
->x
= pixel_points
->x
;
2765 this_point
->y
= pixel_points
->y
;
2767 XDrawLines (x_current_display
, FRAME_X_WINDOW (f
),
2769 (this_point
- pixel_points
+ 1), CoordModeOrigin
);
2772 DEFUN ("x-contour-region", Fx_contour_region
, Sx_contour_region
, 1, 1, 0,
2773 "Highlight the region between point and the character under the mouse\n\
2776 register Lisp_Object event
;
2778 register int x0
, y0
, x1
, y1
;
2779 register struct frame
*f
= selected_frame
;
2780 register int p1
, p2
;
2782 CHECK_CONS (event
, 0);
2785 x0
= XINT (Fcar (Fcar (event
)));
2786 y0
= XINT (Fcar (Fcdr (Fcar (event
))));
2788 /* If the mouse is past the end of the line, don't that area. */
2789 /* ReWrite this... */
2794 if (y1
> y0
) /* point below mouse */
2795 outline_region (f
, f
->display
.x
->cursor_gc
,
2797 else if (y1
< y0
) /* point above mouse */
2798 outline_region (f
, f
->display
.x
->cursor_gc
,
2800 else /* same line: draw horizontal rectangle */
2803 x_rectangle (f
, f
->display
.x
->cursor_gc
,
2804 x0
, y0
, (x1
- x0
+ 1), 1);
2806 x_rectangle (f
, f
->display
.x
->cursor_gc
,
2807 x1
, y1
, (x0
- x1
+ 1), 1);
2810 XFlush (x_current_display
);
2816 DEFUN ("x-uncontour-region", Fx_uncontour_region
, Sx_uncontour_region
, 1, 1, 0,
2817 "Erase any highlighting of the region between point and the character\n\
2818 at X, Y on the selected frame.")
2820 register Lisp_Object event
;
2822 register int x0
, y0
, x1
, y1
;
2823 register struct frame
*f
= selected_frame
;
2826 x0
= XINT (Fcar (Fcar (event
)));
2827 y0
= XINT (Fcar (Fcdr (Fcar (event
))));
2831 if (y1
> y0
) /* point below mouse */
2832 outline_region (f
, f
->display
.x
->reverse_gc
,
2834 else if (y1
< y0
) /* point above mouse */
2835 outline_region (f
, f
->display
.x
->reverse_gc
,
2837 else /* same line: draw horizontal rectangle */
2840 x_rectangle (f
, f
->display
.x
->reverse_gc
,
2841 x0
, y0
, (x1
- x0
+ 1), 1);
2843 x_rectangle (f
, f
->display
.x
->reverse_gc
,
2844 x1
, y1
, (x0
- x1
+ 1), 1);
2852 int contour_begin_x
, contour_begin_y
;
2853 int contour_end_x
, contour_end_y
;
2854 int contour_npoints
;
2856 /* Clip the top part of the contour lines down (and including) line Y_POS.
2857 If X_POS is in the middle (rather than at the end) of the line, drop
2858 down a line at that character. */
2861 clip_contour_top (y_pos
, x_pos
)
2863 register XPoint
*begin
= contour_lines
[y_pos
].top_left
;
2864 register XPoint
*end
;
2865 register int npoints
;
2866 register struct display_line
*line
= selected_frame
->phys_lines
[y_pos
+ 1];
2868 if (x_pos
>= line
->len
- 1) /* Draw one, straight horizontal line. */
2870 end
= contour_lines
[y_pos
].top_right
;
2871 npoints
= (end
- begin
+ 1);
2872 XDrawLines (x_current_display
, contour_window
,
2873 contour_erase_gc
, begin_erase
, npoints
, CoordModeOrigin
);
2875 bcopy (end
, begin
+ 1, contour_last_point
- end
+ 1);
2876 contour_last_point
-= (npoints
- 2);
2877 XDrawLines (x_current_display
, contour_window
,
2878 contour_erase_gc
, begin
, 2, CoordModeOrigin
);
2879 XFlush (x_current_display
);
2881 /* Now, update contour_lines structure. */
2886 register XPoint
*p
= begin
+ 1;
2887 end
= contour_lines
[y_pos
].bottom_right
;
2888 npoints
= (end
- begin
+ 1);
2889 XDrawLines (x_current_display
, contour_window
,
2890 contour_erase_gc
, begin_erase
, npoints
, CoordModeOrigin
);
2893 p
->x
= ibw
+ (font_w
* (x_pos
+ 1));
2895 p
->y
= begin
->y
+ font_h
;
2897 bcopy (end
, begin
+ 3, contour_last_point
- end
+ 1);
2898 contour_last_point
-= (npoints
- 5);
2899 XDrawLines (x_current_display
, contour_window
,
2900 contour_erase_gc
, begin
, 4, CoordModeOrigin
);
2901 XFlush (x_current_display
);
2903 /* Now, update contour_lines structure. */
2907 /* Erase the top horizontal lines of the contour, and then extend
2908 the contour upwards. */
2911 extend_contour_top (line
)
2916 clip_contour_bottom (x_pos
, y_pos
)
2922 extend_contour_bottom (x_pos
, y_pos
)
2926 DEFUN ("x-select-region", Fx_select_region
, Sx_select_region
, 1, 1, "e",
2931 register struct frame
*f
= selected_frame
;
2932 register int point_x
= f
->cursor_x
;
2933 register int point_y
= f
->cursor_y
;
2934 register int mouse_below_point
;
2935 register Lisp_Object obj
;
2936 register int x_contour_x
, x_contour_y
;
2938 x_contour_x
= x_mouse_x
;
2939 x_contour_y
= x_mouse_y
;
2940 if (x_contour_y
> point_y
|| (x_contour_y
== point_y
2941 && x_contour_x
> point_x
))
2943 mouse_below_point
= 1;
2944 outline_region (f
, f
->display
.x
->cursor_gc
, point_x
, point_y
,
2945 x_contour_x
, x_contour_y
);
2949 mouse_below_point
= 0;
2950 outline_region (f
, f
->display
.x
->cursor_gc
, x_contour_x
, x_contour_y
,
2956 obj
= read_char (-1, 0, 0, Qnil
, 0);
2957 if (XTYPE (obj
) != Lisp_Cons
)
2960 if (mouse_below_point
)
2962 if (x_mouse_y
<= point_y
) /* Flipped. */
2964 mouse_below_point
= 0;
2966 outline_region (f
, f
->display
.x
->reverse_gc
, point_x
, point_y
,
2967 x_contour_x
, x_contour_y
);
2968 outline_region (f
, f
->display
.x
->cursor_gc
, x_mouse_x
, x_mouse_y
,
2971 else if (x_mouse_y
< x_contour_y
) /* Bottom clipped. */
2973 clip_contour_bottom (x_mouse_y
);
2975 else if (x_mouse_y
> x_contour_y
) /* Bottom extended. */
2977 extend_bottom_contour (x_mouse_y
);
2980 x_contour_x
= x_mouse_x
;
2981 x_contour_y
= x_mouse_y
;
2983 else /* mouse above or same line as point */
2985 if (x_mouse_y
>= point_y
) /* Flipped. */
2987 mouse_below_point
= 1;
2989 outline_region (f
, f
->display
.x
->reverse_gc
,
2990 x_contour_x
, x_contour_y
, point_x
, point_y
);
2991 outline_region (f
, f
->display
.x
->cursor_gc
, point_x
, point_y
,
2992 x_mouse_x
, x_mouse_y
);
2994 else if (x_mouse_y
> x_contour_y
) /* Top clipped. */
2996 clip_contour_top (x_mouse_y
);
2998 else if (x_mouse_y
< x_contour_y
) /* Top extended. */
3000 extend_contour_top (x_mouse_y
);
3005 unread_command_event
= obj
;
3006 if (mouse_below_point
)
3008 contour_begin_x
= point_x
;
3009 contour_begin_y
= point_y
;
3010 contour_end_x
= x_contour_x
;
3011 contour_end_y
= x_contour_y
;
3015 contour_begin_x
= x_contour_x
;
3016 contour_begin_y
= x_contour_y
;
3017 contour_end_x
= point_x
;
3018 contour_end_y
= point_y
;
3023 DEFUN ("x-horizontal-line", Fx_horizontal_line
, Sx_horizontal_line
, 1, 1, "e",
3028 register Lisp_Object obj
;
3029 struct frame
*f
= selected_frame
;
3030 register struct window
*w
= XWINDOW (selected_window
);
3031 register GC line_gc
= f
->display
.x
->cursor_gc
;
3032 register GC erase_gc
= f
->display
.x
->reverse_gc
;
3034 char dash_list
[] = {6, 4, 6, 4};
3036 XGCValues gc_values
;
3038 register int previous_y
;
3039 register int line
= (x_mouse_y
+ 1) * FONT_HEIGHT (f
->display
.x
->font
)
3040 + f
->display
.x
->internal_border_width
;
3041 register int left
= f
->display
.x
->internal_border_width
3043 * FONT_WIDTH (f
->display
.x
->font
));
3044 register int right
= left
+ (w
->width
3045 * FONT_WIDTH (f
->display
.x
->font
))
3046 - f
->display
.x
->internal_border_width
;
3050 gc_values
.foreground
= f
->display
.x
->cursor_pixel
;
3051 gc_values
.background
= f
->display
.x
->background_pixel
;
3052 gc_values
.line_width
= 1;
3053 gc_values
.line_style
= LineOnOffDash
;
3054 gc_values
.cap_style
= CapRound
;
3055 gc_values
.join_style
= JoinRound
;
3057 line_gc
= XCreateGC (x_current_display
, FRAME_X_WINDOW (f
),
3058 GCLineStyle
| GCJoinStyle
| GCCapStyle
3059 | GCLineWidth
| GCForeground
| GCBackground
,
3061 XSetDashes (x_current_display
, line_gc
, 0, dash_list
, dashes
);
3062 gc_values
.foreground
= f
->display
.x
->background_pixel
;
3063 gc_values
.background
= f
->display
.x
->foreground_pixel
;
3064 erase_gc
= XCreateGC (x_current_display
, FRAME_X_WINDOW (f
),
3065 GCLineStyle
| GCJoinStyle
| GCCapStyle
3066 | GCLineWidth
| GCForeground
| GCBackground
,
3068 XSetDashes (x_current_display
, erase_gc
, 0, dash_list
, dashes
);
3074 if (x_mouse_y
>= XINT (w
->top
)
3075 && x_mouse_y
< XINT (w
->top
) + XINT (w
->height
) - 1)
3077 previous_y
= x_mouse_y
;
3078 line
= (x_mouse_y
+ 1) * FONT_HEIGHT (f
->display
.x
->font
)
3079 + f
->display
.x
->internal_border_width
;
3080 XDrawLine (x_current_display
, FRAME_X_WINDOW (f
),
3081 line_gc
, left
, line
, right
, line
);
3088 obj
= read_char (-1, 0, 0, Qnil
, 0);
3089 if ((XTYPE (obj
) != Lisp_Cons
)
3090 || (! EQ (Fcar (Fcdr (Fcdr (obj
))),
3091 Qvertical_scroll_bar
))
3095 XDrawLine (x_current_display
, FRAME_X_WINDOW (f
),
3096 erase_gc
, left
, line
, right
, line
);
3098 unread_command_event
= obj
;
3100 XFreeGC (x_current_display
, line_gc
);
3101 XFreeGC (x_current_display
, erase_gc
);
3106 while (x_mouse_y
== previous_y
);
3109 XDrawLine (x_current_display
, FRAME_X_WINDOW (f
),
3110 erase_gc
, left
, line
, right
, line
);
3116 /* Offset in buffer of character under the pointer, or 0. */
3117 int mouse_buffer_offset
;
3120 /* These keep track of the rectangle following the pointer. */
3121 int mouse_track_top
, mouse_track_left
, mouse_track_width
;
3123 DEFUN ("x-track-pointer", Fx_track_pointer
, Sx_track_pointer
, 0, 0, 0,
3124 "Track the pointer.")
3127 static Cursor current_pointer_shape
;
3128 FRAME_PTR f
= x_mouse_frame
;
3131 if (EQ (Vmouse_frame_part
, Qtext_part
)
3132 && (current_pointer_shape
!= f
->display
.x
->nontext_cursor
))
3137 current_pointer_shape
= f
->display
.x
->nontext_cursor
;
3138 XDefineCursor (x_current_display
,
3140 current_pointer_shape
);
3142 buf
= XBUFFER (XWINDOW (Vmouse_window
)->buffer
);
3143 c
= *(BUF_CHAR_ADDRESS (buf
, mouse_buffer_offset
));
3145 else if (EQ (Vmouse_frame_part
, Qmodeline_part
)
3146 && (current_pointer_shape
!= f
->display
.x
->modeline_cursor
))
3148 current_pointer_shape
= f
->display
.x
->modeline_cursor
;
3149 XDefineCursor (x_current_display
,
3151 current_pointer_shape
);
3160 DEFUN ("x-track-pointer", Fx_track_pointer
, Sx_track_pointer
, 1, 1, "e",
3161 "Draw rectangle around character under mouse pointer, if there is one.")
3165 struct window
*w
= XWINDOW (Vmouse_window
);
3166 struct frame
*f
= XFRAME (WINDOW_FRAME (w
));
3167 struct buffer
*b
= XBUFFER (w
->buffer
);
3170 if (! EQ (Vmouse_window
, selected_window
))
3173 if (EQ (event
, Qnil
))
3177 x_read_mouse_position (selected_frame
, &x
, &y
);
3181 mouse_track_width
= 0;
3182 mouse_track_left
= mouse_track_top
= -1;
3186 if ((x_mouse_x
!= mouse_track_left
3187 && (x_mouse_x
< mouse_track_left
3188 || x_mouse_x
> (mouse_track_left
+ mouse_track_width
)))
3189 || x_mouse_y
!= mouse_track_top
)
3191 int hp
= 0; /* Horizontal position */
3192 int len
= FRAME_CURRENT_GLYPHS (f
)->used
[x_mouse_y
];
3193 int p
= FRAME_CURRENT_GLYPHS (f
)->bufp
[x_mouse_y
];
3194 int tab_width
= XINT (b
->tab_width
);
3195 int ctl_arrow_p
= !NILP (b
->ctl_arrow
);
3197 int mode_line_vpos
= XFASTINT (w
->height
) + XFASTINT (w
->top
) - 1;
3198 int in_mode_line
= 0;
3200 if (! FRAME_CURRENT_GLYPHS (f
)->enable
[x_mouse_y
])
3203 /* Erase previous rectangle. */
3204 if (mouse_track_width
)
3206 x_rectangle (f
, f
->display
.x
->reverse_gc
,
3207 mouse_track_left
, mouse_track_top
,
3208 mouse_track_width
, 1);
3210 if ((mouse_track_left
== f
->phys_cursor_x
3211 || mouse_track_left
== f
->phys_cursor_x
- 1)
3212 && mouse_track_top
== f
->phys_cursor_y
)
3214 x_display_cursor (f
, 1);
3218 mouse_track_left
= x_mouse_x
;
3219 mouse_track_top
= x_mouse_y
;
3220 mouse_track_width
= 0;
3222 if (mouse_track_left
> len
) /* Past the end of line. */
3225 if (mouse_track_top
== mode_line_vpos
)
3231 if (tab_width
<= 0 || tab_width
> 20) tab_width
= 8;
3235 if (len
== f
->width
&& hp
== len
- 1 && c
!= '\n')
3241 mouse_track_width
= tab_width
- (hp
% tab_width
);
3243 hp
+= mouse_track_width
;
3246 mouse_track_left
= hp
- mouse_track_width
;
3252 mouse_track_width
= -1;
3256 if (ctl_arrow_p
&& (c
< 040 || c
== 0177))
3261 mouse_track_width
= 2;
3266 mouse_track_left
= hp
- mouse_track_width
;
3272 mouse_track_width
= 1;
3279 while (hp
<= x_mouse_x
);
3282 if (mouse_track_width
) /* Over text; use text pointer shape. */
3284 XDefineCursor (x_current_display
,
3286 f
->display
.x
->text_cursor
);
3287 x_rectangle (f
, f
->display
.x
->cursor_gc
,
3288 mouse_track_left
, mouse_track_top
,
3289 mouse_track_width
, 1);
3291 else if (in_mode_line
)
3292 XDefineCursor (x_current_display
,
3294 f
->display
.x
->modeline_cursor
);
3296 XDefineCursor (x_current_display
,
3298 f
->display
.x
->nontext_cursor
);
3301 XFlush (x_current_display
);
3304 obj
= read_char (-1, 0, 0, Qnil
, 0);
3307 while (XTYPE (obj
) == Lisp_Cons
/* Mouse event */
3308 && EQ (Fcar (Fcdr (Fcdr (obj
))), Qnil
) /* Not scroll bar */
3309 && EQ (Vmouse_depressed
, Qnil
) /* Only motion events */
3310 && EQ (Vmouse_window
, selected_window
) /* In this window */
3313 unread_command_event
= obj
;
3315 if (mouse_track_width
)
3317 x_rectangle (f
, f
->display
.x
->reverse_gc
,
3318 mouse_track_left
, mouse_track_top
,
3319 mouse_track_width
, 1);
3320 mouse_track_width
= 0;
3321 if ((mouse_track_left
== f
->phys_cursor_x
3322 || mouse_track_left
- 1 == f
->phys_cursor_x
)
3323 && mouse_track_top
== f
->phys_cursor_y
)
3325 x_display_cursor (f
, 1);
3328 XDefineCursor (x_current_display
,
3330 f
->display
.x
->nontext_cursor
);
3331 XFlush (x_current_display
);
3341 /* Draw a pixmap specified by IMAGE_DATA of dimensions WIDTH and HEIGHT
3342 on the frame F at position X, Y. */
3344 x_draw_pixmap (f
, x
, y
, image_data
, width
, height
)
3346 int x
, y
, width
, height
;
3351 image
= XCreateBitmapFromData (x_current_display
,
3352 FRAME_X_WINDOW (f
), image_data
,
3354 XCopyPlane (x_current_display
, image
, FRAME_X_WINDOW (f
),
3355 f
->display
.x
->normal_gc
, 0, 0, width
, height
, x
, y
);
3360 DEFUN ("x-store-cut-buffer", Fx_store_cut_buffer
, Sx_store_cut_buffer
,
3361 1, 1, "sStore text in cut buffer: ",
3362 "Store contents of STRING into the cut buffer of the X window system.")
3364 register Lisp_Object string
;
3368 CHECK_STRING (string
, 1);
3369 if (! FRAME_X_P (selected_frame
))
3370 error ("Selected frame does not understand X protocol.");
3373 XStoreBytes ((char *) XSTRING (string
)->data
, XSTRING (string
)->size
);
3379 DEFUN ("x-get-cut-buffer", Fx_get_cut_buffer
, Sx_get_cut_buffer
, 0, 0, 0,
3380 "Return contents of cut buffer of the X window system, as a string.")
3384 register Lisp_Object string
;
3389 d
= XFetchBytes (&len
);
3390 string
= make_string (d
, len
);
3397 #if 0 /* I'm told these functions are superfluous
3398 given the ability to bind function keys. */
3401 DEFUN ("x-rebind-key", Fx_rebind_key
, Sx_rebind_key
, 3, 3, 0,
3402 "Rebind X keysym KEYSYM, with MODIFIERS, to generate NEWSTRING.\n\
3403 KEYSYM is a string which conforms to the X keysym definitions found\n\
3404 in X11/keysymdef.h, sans the initial XK_. MODIFIERS is nil or a\n\
3405 list of strings specifying modifier keys such as Control_L, which must\n\
3406 also be depressed for NEWSTRING to appear.")
3407 (x_keysym
, modifiers
, newstring
)
3408 register Lisp_Object x_keysym
;
3409 register Lisp_Object modifiers
;
3410 register Lisp_Object newstring
;
3413 register KeySym keysym
;
3414 KeySym modifier_list
[16];
3417 CHECK_STRING (x_keysym
, 1);
3418 CHECK_STRING (newstring
, 3);
3420 keysym
= XStringToKeysym ((char *) XSTRING (x_keysym
)->data
);
3421 if (keysym
== NoSymbol
)
3422 error ("Keysym does not exist");
3424 if (NILP (modifiers
))
3425 XRebindKeysym (x_current_display
, keysym
, modifier_list
, 0,
3426 XSTRING (newstring
)->data
, XSTRING (newstring
)->size
);
3429 register Lisp_Object rest
, mod
;
3432 for (rest
= modifiers
; !NILP (rest
); rest
= Fcdr (rest
))
3435 error ("Can't have more than 16 modifiers");
3438 CHECK_STRING (mod
, 3);
3439 modifier_list
[i
] = XStringToKeysym ((char *) XSTRING (mod
)->data
);
3441 if (modifier_list
[i
] == NoSymbol
3442 || !(IsModifierKey (modifier_list
[i
])
3443 || ((unsigned)(modifier_list
[i
]) == XK_Mode_switch
)
3444 || ((unsigned)(modifier_list
[i
]) == XK_Num_Lock
)))
3446 if (modifier_list
[i
] == NoSymbol
3447 || !IsModifierKey (modifier_list
[i
]))
3449 error ("Element is not a modifier keysym");
3453 XRebindKeysym (x_current_display
, keysym
, modifier_list
, i
,
3454 XSTRING (newstring
)->data
, XSTRING (newstring
)->size
);
3460 DEFUN ("x-rebind-keys", Fx_rebind_keys
, Sx_rebind_keys
, 2, 2, 0,
3461 "Rebind KEYCODE to list of strings STRINGS.\n\
3462 STRINGS should be a list of 16 elements, one for each shift combination.\n\
3463 nil as element means don't change.\n\
3464 See the documentation of `x-rebind-key' for more information.")
3466 register Lisp_Object keycode
;
3467 register Lisp_Object strings
;
3469 register Lisp_Object item
;
3470 register unsigned char *rawstring
;
3471 KeySym rawkey
, modifier
[1];
3473 register unsigned i
;
3476 CHECK_NUMBER (keycode
, 1);
3477 CHECK_CONS (strings
, 2);
3478 rawkey
= (KeySym
) ((unsigned) (XINT (keycode
))) & 255;
3479 for (i
= 0; i
<= 15; strings
= Fcdr (strings
), i
++)
3481 item
= Fcar (strings
);
3484 CHECK_STRING (item
, 2);
3485 strsize
= XSTRING (item
)->size
;
3486 rawstring
= (unsigned char *) xmalloc (strsize
);
3487 bcopy (XSTRING (item
)->data
, rawstring
, strsize
);
3488 modifier
[1] = 1 << i
;
3489 XRebindKeysym (x_current_display
, rawkey
, modifier
, 1,
3490 rawstring
, strsize
);
3495 #endif /* HAVE_X11 */
3500 #ifndef HAVE_XSCREENNUMBEROFSCREEN
3502 XScreenNumberOfScreen (scr
)
3503 register Screen
*scr
;
3505 register Display
*dpy
= scr
->display
;
3506 register Screen
*dpyscr
= dpy
->screens
;
3509 for (i
= 0; i
< dpy
->nscreens
; i
++, dpyscr
++)
3515 #endif /* not HAVE_XSCREENNUMBEROFSCREEN */
3518 select_visual (screen
, depth
)
3520 unsigned int *depth
;
3523 XVisualInfo
*vinfo
, vinfo_template
;
3526 v
= DefaultVisualOfScreen (screen
);
3529 vinfo_template
.visualid
= XVisualIDFromVisual (v
);
3531 vinfo_template
.visualid
= v
->visualid
;
3534 vinfo_template
.screen
= XScreenNumberOfScreen (screen
);
3536 vinfo
= XGetVisualInfo (x_current_display
,
3537 VisualIDMask
| VisualScreenMask
, &vinfo_template
,
3540 fatal ("Can't get proper X visual info");
3542 if ((1 << vinfo
->depth
) == vinfo
->colormap_size
)
3543 *depth
= vinfo
->depth
;
3547 int n
= vinfo
->colormap_size
- 1;
3556 XFree ((char *) vinfo
);
3559 #endif /* HAVE_X11 */
3561 DEFUN ("x-open-connection", Fx_open_connection
, Sx_open_connection
,
3562 1, 2, 0, "Open a connection to an X server.\n\
3563 DISPLAY is the name of the display to connect to.\n\
3564 Optional second arg XRM_STRING is a string of resources in xrdb format.")
3565 (display
, xrm_string
)
3566 Lisp_Object display
, xrm_string
;
3568 unsigned int n_planes
;
3569 unsigned char *xrm_option
;
3571 CHECK_STRING (display
, 0);
3572 if (x_current_display
!= 0)
3573 error ("X server connection is already initialized");
3574 if (! NILP (xrm_string
))
3575 CHECK_STRING (xrm_string
, 1);
3577 /* This is what opens the connection and sets x_current_display.
3578 This also initializes many symbols, such as those used for input. */
3579 x_term_init (XSTRING (display
)->data
);
3582 XFASTINT (Vwindow_system_version
) = 11;
3584 if (! NILP (xrm_string
))
3585 xrm_option
= (unsigned char *) XSTRING (xrm_string
)->data
;
3587 xrm_option
= (unsigned char *) 0;
3589 validate_x_resource_name ();
3592 xrdb
= x_load_resources (x_current_display
, xrm_option
,
3593 (char *) XSTRING (Vx_resource_name
)->data
,
3596 #ifdef HAVE_XRMSETDATABASE
3597 XrmSetDatabase (x_current_display
, xrdb
);
3599 x_current_display
->db
= xrdb
;
3602 x_screen
= DefaultScreenOfDisplay (x_current_display
);
3604 screen_visual
= select_visual (x_screen
, &n_planes
);
3605 x_screen_planes
= n_planes
;
3606 x_screen_height
= HeightOfScreen (x_screen
);
3607 x_screen_width
= WidthOfScreen (x_screen
);
3609 /* X Atoms used by emacs. */
3610 Xatoms_of_xselect ();
3612 Xatom_wm_protocols
= XInternAtom (x_current_display
, "WM_PROTOCOLS",
3614 Xatom_wm_take_focus
= XInternAtom (x_current_display
, "WM_TAKE_FOCUS",
3616 Xatom_wm_save_yourself
= XInternAtom (x_current_display
, "WM_SAVE_YOURSELF",
3618 Xatom_wm_delete_window
= XInternAtom (x_current_display
, "WM_DELETE_WINDOW",
3620 Xatom_wm_change_state
= XInternAtom (x_current_display
, "WM_CHANGE_STATE",
3622 Xatom_wm_configure_denied
= XInternAtom (x_current_display
,
3623 "WM_CONFIGURE_DENIED", False
);
3624 Xatom_wm_window_moved
= XInternAtom (x_current_display
, "WM_MOVED",
3627 #else /* not HAVE_X11 */
3628 XFASTINT (Vwindow_system_version
) = 10;
3629 #endif /* not HAVE_X11 */
3633 DEFUN ("x-close-current-connection", Fx_close_current_connection
,
3634 Sx_close_current_connection
,
3635 0, 0, 0, "Close the connection to the current X server.")
3639 /* This is ONLY used when killing emacs; For switching displays
3640 we'll have to take care of setting CloseDownMode elsewhere. */
3642 if (x_current_display
)
3645 XSetCloseDownMode (x_current_display
, DestroyAll
);
3646 XCloseDisplay (x_current_display
);
3647 x_current_display
= 0;
3650 fatal ("No current X display connection to close\n");
3655 DEFUN ("x-synchronize", Fx_synchronize
, Sx_synchronize
,
3656 1, 1, 0, "If ON is non-nil, report X errors as soon as the erring request is made.\n\
3657 If ON is nil, allow buffering of requests.\n\
3658 Turning on synchronization prohibits the Xlib routines from buffering\n\
3659 requests and seriously degrades performance, but makes debugging much\n\
3666 XSynchronize (x_current_display
, !EQ (on
, Qnil
));
3674 /* This is zero if not using X windows. */
3675 x_current_display
= 0;
3677 /* The section below is built by the lisp expression at the top of the file,
3678 just above where these variables are declared. */
3679 /*&&& init symbols here &&&*/
3680 Qauto_raise
= intern ("auto-raise");
3681 staticpro (&Qauto_raise
);
3682 Qauto_lower
= intern ("auto-lower");
3683 staticpro (&Qauto_lower
);
3684 Qbackground_color
= intern ("background-color");
3685 staticpro (&Qbackground_color
);
3686 Qbar
= intern ("bar");
3688 Qborder_color
= intern ("border-color");
3689 staticpro (&Qborder_color
);
3690 Qborder_width
= intern ("border-width");
3691 staticpro (&Qborder_width
);
3692 Qbox
= intern ("box");
3694 Qcursor_color
= intern ("cursor-color");
3695 staticpro (&Qcursor_color
);
3696 Qcursor_type
= intern ("cursor-type");
3697 staticpro (&Qcursor_type
);
3698 Qfont
= intern ("font");
3700 Qforeground_color
= intern ("foreground-color");
3701 staticpro (&Qforeground_color
);
3702 Qgeometry
= intern ("geometry");
3703 staticpro (&Qgeometry
);
3704 Qicon_left
= intern ("icon-left");
3705 staticpro (&Qicon_left
);
3706 Qicon_top
= intern ("icon-top");
3707 staticpro (&Qicon_top
);
3708 Qicon_type
= intern ("icon-type");
3709 staticpro (&Qicon_type
);
3710 Qinternal_border_width
= intern ("internal-border-width");
3711 staticpro (&Qinternal_border_width
);
3712 Qleft
= intern ("left");
3714 Qmouse_color
= intern ("mouse-color");
3715 staticpro (&Qmouse_color
);
3716 Qnone
= intern ("none");
3718 Qparent_id
= intern ("parent-id");
3719 staticpro (&Qparent_id
);
3720 Qsuppress_icon
= intern ("suppress-icon");
3721 staticpro (&Qsuppress_icon
);
3722 Qtop
= intern ("top");
3724 Qundefined_color
= intern ("undefined-color");
3725 staticpro (&Qundefined_color
);
3726 Qvertical_scroll_bars
= intern ("vertical-scroll-bars");
3727 staticpro (&Qvertical_scroll_bars
);
3728 Qvisibility
= intern ("visibility");
3729 staticpro (&Qvisibility
);
3730 Qwindow_id
= intern ("window-id");
3731 staticpro (&Qwindow_id
);
3732 Qx_frame_parameter
= intern ("x-frame-parameter");
3733 staticpro (&Qx_frame_parameter
);
3734 /* This is the end of symbol initialization. */
3736 Fput (Qundefined_color
, Qerror_conditions
,
3737 Fcons (Qundefined_color
, Fcons (Qerror
, Qnil
)));
3738 Fput (Qundefined_color
, Qerror_message
,
3739 build_string ("Undefined color"));
3741 init_x_parm_symbols ();
3743 DEFVAR_INT ("mouse-buffer-offset", &mouse_buffer_offset
,
3744 "The buffer offset of the character under the pointer.");
3745 mouse_buffer_offset
= 0;
3747 DEFVAR_LISP ("x-pointer-shape", &Vx_pointer_shape
,
3748 "The shape of the pointer when over text.\n\
3749 Changing the value does not affect existing frames\n\
3750 unless you set the mouse color.");
3751 Vx_pointer_shape
= Qnil
;
3753 DEFVAR_LISP ("x-resource-name", &Vx_resource_name
,
3754 "The name Emacs uses to look up X resources; for internal use only.\n\
3755 `x-get-resource' uses this as the first component of the instance name\n\
3756 when requesting resource values.\n\
3757 Emacs initially sets `x-resource-name' to the name under which Emacs\n\
3758 was invoked, or to the value specified with the `-name' or `-rn'\n\
3759 switches, if present.");
3760 Vx_resource_name
= Qnil
;
3763 DEFVAR_INT ("x-nontext-pointer-shape", &Vx_nontext_pointer_shape
,
3764 "The shape of the pointer when not over text.");
3766 Vx_nontext_pointer_shape
= Qnil
;
3769 DEFVAR_INT ("x-mode-pointer-shape", &Vx_mode_pointer_shape
,
3770 "The shape of the pointer when over the mode line.");
3772 Vx_mode_pointer_shape
= Qnil
;
3774 DEFVAR_LISP ("x-cursor-fore-pixel", &Vx_cursor_fore_pixel
,
3775 "A string indicating the foreground color of the cursor box.");
3776 Vx_cursor_fore_pixel
= Qnil
;
3778 DEFVAR_LISP ("mouse-grabbed", &Vmouse_depressed
,
3779 "Non-nil if a mouse button is currently depressed.");
3780 Vmouse_depressed
= Qnil
;
3782 DEFVAR_LISP ("x-no-window-manager", &Vx_no_window_manager
,
3783 "t if no X window manager is in use.");
3786 defsubr (&Sx_get_resource
);
3788 defsubr (&Sx_draw_rectangle
);
3789 defsubr (&Sx_erase_rectangle
);
3790 defsubr (&Sx_contour_region
);
3791 defsubr (&Sx_uncontour_region
);
3793 defsubr (&Sx_display_color_p
);
3794 defsubr (&Sx_list_fonts
);
3795 defsubr (&Sx_color_defined_p
);
3796 defsubr (&Sx_server_max_request_size
);
3797 defsubr (&Sx_server_vendor
);
3798 defsubr (&Sx_server_version
);
3799 defsubr (&Sx_display_pixel_width
);
3800 defsubr (&Sx_display_pixel_height
);
3801 defsubr (&Sx_display_mm_width
);
3802 defsubr (&Sx_display_mm_height
);
3803 defsubr (&Sx_display_screens
);
3804 defsubr (&Sx_display_planes
);
3805 defsubr (&Sx_display_color_cells
);
3806 defsubr (&Sx_display_visual_class
);
3807 defsubr (&Sx_display_backing_store
);
3808 defsubr (&Sx_display_save_under
);
3810 defsubr (&Sx_rebind_key
);
3811 defsubr (&Sx_rebind_keys
);
3812 defsubr (&Sx_track_pointer
);
3813 defsubr (&Sx_grab_pointer
);
3814 defsubr (&Sx_ungrab_pointer
);
3817 defsubr (&Sx_get_default
);
3818 defsubr (&Sx_store_cut_buffer
);
3819 defsubr (&Sx_get_cut_buffer
);
3821 defsubr (&Sx_parse_geometry
);
3822 defsubr (&Sx_create_frame
);
3823 defsubr (&Sfocus_frame
);
3824 defsubr (&Sunfocus_frame
);
3826 defsubr (&Sx_horizontal_line
);
3828 defsubr (&Sx_open_connection
);
3829 defsubr (&Sx_close_current_connection
);
3830 defsubr (&Sx_synchronize
);
3833 #endif /* HAVE_X_WINDOWS */