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 #include <X11/bitmaps/gray>
44 #include "[.bitmaps]gray.xbm"
47 #define min(a,b) ((a) < (b) ? (a) : (b))
48 #define max(a,b) ((a) > (b) ? (a) : (b))
51 /* X Resource data base */
52 static XrmDatabase xrdb
;
54 /* The class of this X application. */
55 #define EMACS_CLASS "Emacs"
57 /* Title name and application name for X stuff. */
58 extern char *x_id_name
;
60 /* The background and shape of the mouse pointer, and shape when not
61 over text or in the modeline. */
62 Lisp_Object Vx_pointer_shape
, Vx_nontext_pointer_shape
, Vx_mode_pointer_shape
;
64 /* Color of chars displayed in cursor box. */
65 Lisp_Object Vx_cursor_fore_pixel
;
67 /* The screen being used. */
68 static Screen
*x_screen
;
70 /* The X Visual we are using for X windows (the default) */
71 Visual
*screen_visual
;
73 /* Height of this X screen in pixels. */
76 /* Width of this X screen in pixels. */
79 /* Number of planes for this screen. */
82 /* Non nil if no window manager is in use. */
83 Lisp_Object Vx_no_window_manager
;
85 /* `t' if a mouse button is depressed. */
87 Lisp_Object Vmouse_depressed
;
89 extern unsigned int x_mouse_x
, x_mouse_y
, x_mouse_grabbed
;
91 /* Atom for indicating window state to the window manager. */
92 extern Atom Xatom_wm_change_state
;
94 /* Communication with window managers. */
95 extern Atom Xatom_wm_protocols
;
97 /* Kinds of protocol things we may receive. */
98 extern Atom Xatom_wm_take_focus
;
99 extern Atom Xatom_wm_save_yourself
;
100 extern Atom Xatom_wm_delete_window
;
102 /* Other WM communication */
103 extern Atom Xatom_wm_configure_denied
; /* When our config request is denied */
104 extern Atom Xatom_wm_window_moved
; /* When the WM moves us. */
108 /* Default size of an Emacs window. */
109 static char *default_window
= "=80x24+0+0";
112 char iconidentity
[MAXICID
];
113 #define ICONTAG "emacs@"
114 char minibuffer_iconidentity
[MAXICID
];
115 #define MINIBUFFER_ICONTAG "minibuffer@"
119 /* The last 23 bits of the timestamp of the last mouse button event. */
120 Time mouse_timestamp
;
122 /* Evaluate this expression to rebuild the section of syms_of_xfns
123 that initializes and staticpros the symbols declared below. Note
124 that Emacs 18 has a bug that keeps C-x C-e from being able to
125 evaluate this expression.
128 ;; Accumulate a list of the symbols we want to initialize from the
129 ;; declarations at the top of the file.
130 (goto-char (point-min))
131 (search-forward "/\*&&& symbols declared here &&&*\/\n")
133 (while (looking-at "Lisp_Object \\(Q[a-z_]+\\)")
135 (cons (buffer-substring (match-beginning 1) (match-end 1))
138 (setq symbol-list (nreverse symbol-list))
139 ;; Delete the section of syms_of_... where we initialize the symbols.
140 (search-forward "\n /\*&&& init symbols here &&&*\/\n")
141 (let ((start (point)))
142 (while (looking-at "^ Q")
144 (kill-region start (point)))
145 ;; Write a new symbol initialization section.
147 (insert (format " %s = intern (\"" (car symbol-list)))
148 (let ((start (point)))
149 (insert (substring (car symbol-list) 1))
150 (subst-char-in-region start (point) ?_ ?-))
151 (insert (format "\");\n staticpro (&%s);\n" (car symbol-list)))
152 (setq symbol-list (cdr symbol-list)))))
156 /*&&& symbols declared here &&&*/
157 Lisp_Object Qauto_raise
;
158 Lisp_Object Qauto_lower
;
159 Lisp_Object Qbackground_color
;
161 Lisp_Object Qborder_color
;
162 Lisp_Object Qborder_width
;
164 Lisp_Object Qcursor_color
;
165 Lisp_Object Qcursor_type
;
167 Lisp_Object Qforeground_color
;
168 Lisp_Object Qgeometry
;
170 Lisp_Object Qicon_left
;
171 Lisp_Object Qicon_top
;
172 Lisp_Object Qicon_type
;
173 Lisp_Object Qinternal_border_width
;
175 Lisp_Object Qmouse_color
;
177 Lisp_Object Qparent_id
;
178 Lisp_Object Qsuppress_icon
;
180 Lisp_Object Qundefined_color
;
181 Lisp_Object Qvertical_scroll_bars
;
182 Lisp_Object Qvisibility
;
183 Lisp_Object Qwindow_id
;
184 Lisp_Object Qx_frame_parameter
;
186 /* The below are defined in frame.c. */
187 extern Lisp_Object Qheight
, Qminibuffer
, Qname
, Qonly
, Qwidth
;
188 extern Lisp_Object Qunsplittable
, Qmenu_bar_lines
, Qicon
;
190 extern Lisp_Object Vwindow_system_version
;
192 /* Mouse map for clicks in windows. */
193 extern Lisp_Object Vglobal_mouse_map
;
195 /* Points to table of defined typefaces. */
196 struct face
*x_face_table
[MAX_FACES_AND_GLYPHS
];
198 /* Error if we are not connected to X. */
202 if (x_current_display
== 0)
203 error ("X windows are not in use or not initialized");
206 /* Return the Emacs frame-object corresponding to an X window.
207 It could be the frame's main window or an icon window. */
209 /* This function can be called during GC, so use XGCTYPE. */
212 x_window_to_frame (wdesc
)
215 Lisp_Object tail
, frame
;
218 for (tail
= Vframe_list
; XGCTYPE (tail
) == Lisp_Cons
;
219 tail
= XCONS (tail
)->cdr
)
221 frame
= XCONS (tail
)->car
;
222 if (XGCTYPE (frame
) != Lisp_Frame
)
225 if (FRAME_X_WINDOW (f
) == wdesc
226 || f
->display
.x
->icon_desc
== wdesc
)
233 /* Connect the frame-parameter names for X frames
234 to the ways of passing the parameter values to the window system.
236 The name of a parameter, as a Lisp symbol,
237 has an `x-frame-parameter' property which is an integer in Lisp
238 but can be interpreted as an `enum x_frame_parm' in C. */
242 X_PARM_FOREGROUND_COLOR
,
243 X_PARM_BACKGROUND_COLOR
,
250 X_PARM_INTERNAL_BORDER_WIDTH
,
254 X_PARM_VERT_SCROLL_BAR
,
256 X_PARM_MENU_BAR_LINES
260 struct x_frame_parm_table
263 void (*setter
)( /* struct frame *frame, Lisp_Object val, oldval */ );
266 void x_set_foreground_color ();
267 void x_set_background_color ();
268 void x_set_mouse_color ();
269 void x_set_cursor_color ();
270 void x_set_border_color ();
271 void x_set_cursor_type ();
272 void x_set_icon_type ();
274 void x_set_border_width ();
275 void x_set_internal_border_width ();
276 void x_explicitly_set_name ();
277 void x_set_autoraise ();
278 void x_set_autolower ();
279 void x_set_vertical_scroll_bars ();
280 void x_set_visibility ();
281 void x_set_menu_bar_lines ();
283 static struct x_frame_parm_table x_frame_parms
[] =
285 "foreground-color", x_set_foreground_color
,
286 "background-color", x_set_background_color
,
287 "mouse-color", x_set_mouse_color
,
288 "cursor-color", x_set_cursor_color
,
289 "border-color", x_set_border_color
,
290 "cursor-type", x_set_cursor_type
,
291 "icon-type", x_set_icon_type
,
293 "border-width", x_set_border_width
,
294 "internal-border-width", x_set_internal_border_width
,
295 "name", x_explicitly_set_name
,
296 "auto-raise", x_set_autoraise
,
297 "auto-lower", x_set_autolower
,
298 "vertical-scroll-bars", x_set_vertical_scroll_bars
,
299 "visibility", x_set_visibility
,
300 "menu-bar-lines", x_set_menu_bar_lines
,
303 /* Attach the `x-frame-parameter' properties to
304 the Lisp symbol names of parameters relevant to X. */
306 init_x_parm_symbols ()
310 for (i
= 0; i
< sizeof (x_frame_parms
) / sizeof (x_frame_parms
[0]); i
++)
311 Fput (intern (x_frame_parms
[i
].name
), Qx_frame_parameter
,
315 /* Change the parameters of FRAME as specified by ALIST.
316 If a parameter is not specially recognized, do nothing;
317 otherwise call the `x_set_...' function for that parameter. */
320 x_set_frame_parameters (f
, alist
)
326 /* If both of these parameters are present, it's more efficient to
327 set them both at once. So we wait until we've looked at the
328 entire list before we set them. */
329 Lisp_Object width
, height
;
332 Lisp_Object left
, top
;
334 XSET (width
, Lisp_Int
, FRAME_WIDTH (f
));
335 XSET (height
, Lisp_Int
, FRAME_HEIGHT (f
));
337 XSET (top
, Lisp_Int
, f
->display
.x
->top_pos
);
338 XSET (left
, Lisp_Int
, f
->display
.x
->left_pos
);
340 for (tail
= alist
; CONSP (tail
); tail
= Fcdr (tail
))
342 Lisp_Object elt
, prop
, val
;
348 if (EQ (prop
, Qwidth
))
350 else if (EQ (prop
, Qheight
))
352 else if (EQ (prop
, Qtop
))
354 else if (EQ (prop
, Qleft
))
358 register Lisp_Object tem
;
359 tem
= Fget (prop
, Qx_frame_parameter
);
360 if (XTYPE (tem
) == Lisp_Int
362 && XINT (tem
) < sizeof (x_frame_parms
)/sizeof (x_frame_parms
[0]))
363 (*x_frame_parms
[XINT (tem
)].setter
)(f
, val
,
364 get_frame_param (f
, prop
));
365 store_frame_param (f
, prop
, val
);
369 /* Don't call these unless they've changed; the window may not actually
374 XSET (frame
, Lisp_Frame
, f
);
375 if (XINT (width
) != FRAME_WIDTH (f
)
376 || XINT (height
) != FRAME_HEIGHT (f
))
377 Fset_frame_size (frame
, width
, height
);
378 if (XINT (left
) != f
->display
.x
->left_pos
379 || XINT (top
) != f
->display
.x
->top_pos
)
380 Fset_frame_position (frame
, left
, top
);
384 /* Insert a description of internally-recorded parameters of frame X
385 into the parameter alist *ALISTPTR that is to be given to the user.
386 Only parameters that are specific to the X window system
387 and whose values are not correctly recorded in the frame's
388 param_alist need to be considered here. */
390 x_report_frame_params (f
, alistptr
)
392 Lisp_Object
*alistptr
;
396 store_in_alist (alistptr
, Qleft
, make_number (f
->display
.x
->left_pos
));
397 store_in_alist (alistptr
, Qtop
, make_number (f
->display
.x
->top_pos
));
398 store_in_alist (alistptr
, Qborder_width
,
399 make_number (f
->display
.x
->border_width
));
400 store_in_alist (alistptr
, Qinternal_border_width
,
401 make_number (f
->display
.x
->internal_border_width
));
402 sprintf (buf
, "%d", FRAME_X_WINDOW (f
));
403 store_in_alist (alistptr
, Qwindow_id
,
405 store_in_alist (alistptr
, Qvisibility
,
406 (FRAME_VISIBLE_P (f
) ? Qt
407 : FRAME_ICONIFIED_P (f
) ? Qicon
: Qnil
));
410 /* Decide if color named COLOR is valid for the display
411 associated with the selected frame. */
413 defined_color (color
, color_def
)
418 Colormap screen_colormap
;
423 = DefaultColormap (x_current_display
, XDefaultScreen (x_current_display
));
425 foo
= XParseColor (x_current_display
, screen_colormap
,
427 && XAllocColor (x_current_display
, screen_colormap
, color_def
);
429 foo
= XParseColor (color
, color_def
) && XGetHardwareColor (color_def
);
430 #endif /* not HAVE_X11 */
439 /* Given a string ARG naming a color, compute a pixel value from it
440 suitable for screen F.
441 If F is not a color screen, return DEF (default) regardless of what
445 x_decode_color (arg
, def
)
451 CHECK_STRING (arg
, 0);
453 if (strcmp (XSTRING (arg
)->data
, "black") == 0)
454 return BLACK_PIX_DEFAULT
;
455 else if (strcmp (XSTRING (arg
)->data
, "white") == 0)
456 return WHITE_PIX_DEFAULT
;
459 if (x_screen_planes
== 1)
462 if (DISPLAY_CELLS
== 1)
466 if (defined_color (XSTRING (arg
)->data
, &cdef
))
469 Fsignal (Qundefined_color
, Fcons (arg
, Qnil
));
472 /* Functions called only from `x_set_frame_param'
473 to set individual parameters.
475 If FRAME_X_WINDOW (f) is 0,
476 the frame is being created and its X-window does not exist yet.
477 In that case, just record the parameter's new value
478 in the standard place; do not attempt to change the window. */
481 x_set_foreground_color (f
, arg
, oldval
)
483 Lisp_Object arg
, oldval
;
485 f
->display
.x
->foreground_pixel
= x_decode_color (arg
, BLACK_PIX_DEFAULT
);
486 if (FRAME_X_WINDOW (f
) != 0)
490 XSetForeground (x_current_display
, f
->display
.x
->normal_gc
,
491 f
->display
.x
->foreground_pixel
);
492 XSetBackground (x_current_display
, f
->display
.x
->reverse_gc
,
493 f
->display
.x
->foreground_pixel
);
495 #endif /* HAVE_X11 */
496 if (FRAME_VISIBLE_P (f
))
502 x_set_background_color (f
, arg
, oldval
)
504 Lisp_Object arg
, oldval
;
509 f
->display
.x
->background_pixel
= x_decode_color (arg
, WHITE_PIX_DEFAULT
);
511 if (FRAME_X_WINDOW (f
) != 0)
515 /* The main frame area. */
516 XSetBackground (x_current_display
, f
->display
.x
->normal_gc
,
517 f
->display
.x
->background_pixel
);
518 XSetForeground (x_current_display
, f
->display
.x
->reverse_gc
,
519 f
->display
.x
->background_pixel
);
520 XSetWindowBackground (x_current_display
, FRAME_X_WINDOW (f
),
521 f
->display
.x
->background_pixel
);
524 temp
= XMakeTile (f
->display
.x
->background_pixel
);
525 XChangeBackground (FRAME_X_WINDOW (f
), temp
);
527 #endif /* not HAVE_X11 */
530 if (FRAME_VISIBLE_P (f
))
536 x_set_mouse_color (f
, arg
, oldval
)
538 Lisp_Object arg
, oldval
;
540 Cursor cursor
, nontext_cursor
, mode_cursor
;
544 f
->display
.x
->mouse_pixel
= x_decode_color (arg
, BLACK_PIX_DEFAULT
);
545 mask_color
= f
->display
.x
->background_pixel
;
546 /* No invisible pointers. */
547 if (mask_color
== f
->display
.x
->mouse_pixel
548 && mask_color
== f
->display
.x
->background_pixel
)
549 f
->display
.x
->mouse_pixel
= f
->display
.x
->foreground_pixel
;
554 /* It's not okay to crash if the user selects a screwey cursor. */
557 if (!EQ (Qnil
, Vx_pointer_shape
))
559 CHECK_NUMBER (Vx_pointer_shape
, 0);
560 cursor
= XCreateFontCursor (x_current_display
, XINT (Vx_pointer_shape
));
563 cursor
= XCreateFontCursor (x_current_display
, XC_xterm
);
564 x_check_errors ("bad text pointer cursor: %s");
566 if (!EQ (Qnil
, Vx_nontext_pointer_shape
))
568 CHECK_NUMBER (Vx_nontext_pointer_shape
, 0);
569 nontext_cursor
= XCreateFontCursor (x_current_display
,
570 XINT (Vx_nontext_pointer_shape
));
573 nontext_cursor
= XCreateFontCursor (x_current_display
, XC_left_ptr
);
574 x_check_errors ("bad nontext pointer cursor: %s");
576 if (!EQ (Qnil
, Vx_mode_pointer_shape
))
578 CHECK_NUMBER (Vx_mode_pointer_shape
, 0);
579 mode_cursor
= XCreateFontCursor (x_current_display
,
580 XINT (Vx_mode_pointer_shape
));
583 mode_cursor
= XCreateFontCursor (x_current_display
, XC_xterm
);
585 /* Check and report errors with the above calls. */
586 x_check_errors ("can't set cursor shape: %s");
590 XColor fore_color
, back_color
;
592 fore_color
.pixel
= f
->display
.x
->mouse_pixel
;
593 back_color
.pixel
= mask_color
;
594 XQueryColor (x_current_display
,
595 DefaultColormap (x_current_display
,
596 DefaultScreen (x_current_display
)),
598 XQueryColor (x_current_display
,
599 DefaultColormap (x_current_display
,
600 DefaultScreen (x_current_display
)),
602 XRecolorCursor (x_current_display
, cursor
,
603 &fore_color
, &back_color
);
604 XRecolorCursor (x_current_display
, nontext_cursor
,
605 &fore_color
, &back_color
);
606 XRecolorCursor (x_current_display
, mode_cursor
,
607 &fore_color
, &back_color
);
610 cursor
= XCreateCursor (16, 16, MouseCursor
, MouseMask
,
612 f
->display
.x
->mouse_pixel
,
613 f
->display
.x
->background_pixel
,
617 if (FRAME_X_WINDOW (f
) != 0)
619 XDefineCursor (XDISPLAY
FRAME_X_WINDOW (f
), cursor
);
622 if (cursor
!= f
->display
.x
->text_cursor
&& f
->display
.x
->text_cursor
!= 0)
623 XFreeCursor (XDISPLAY f
->display
.x
->text_cursor
);
624 f
->display
.x
->text_cursor
= cursor
;
626 if (nontext_cursor
!= f
->display
.x
->nontext_cursor
627 && f
->display
.x
->nontext_cursor
!= 0)
628 XFreeCursor (XDISPLAY f
->display
.x
->nontext_cursor
);
629 f
->display
.x
->nontext_cursor
= nontext_cursor
;
631 if (mode_cursor
!= f
->display
.x
->modeline_cursor
632 && f
->display
.x
->modeline_cursor
!= 0)
633 XFreeCursor (XDISPLAY f
->display
.x
->modeline_cursor
);
634 f
->display
.x
->modeline_cursor
= mode_cursor
;
635 #endif /* HAVE_X11 */
642 x_set_cursor_color (f
, arg
, oldval
)
644 Lisp_Object arg
, oldval
;
646 unsigned long fore_pixel
;
648 if (!EQ (Vx_cursor_fore_pixel
, Qnil
))
649 fore_pixel
= x_decode_color (Vx_cursor_fore_pixel
, WHITE_PIX_DEFAULT
);
651 fore_pixel
= f
->display
.x
->background_pixel
;
652 f
->display
.x
->cursor_pixel
= x_decode_color (arg
, BLACK_PIX_DEFAULT
);
654 /* Make sure that the cursor color differs from the background color. */
655 if (f
->display
.x
->cursor_pixel
== f
->display
.x
->background_pixel
)
657 f
->display
.x
->cursor_pixel
== f
->display
.x
->mouse_pixel
;
658 if (f
->display
.x
->cursor_pixel
== fore_pixel
)
659 fore_pixel
= f
->display
.x
->background_pixel
;
661 f
->display
.x
->cursor_foreground_pixel
= fore_pixel
;
663 if (FRAME_X_WINDOW (f
) != 0)
667 XSetBackground (x_current_display
, f
->display
.x
->cursor_gc
,
668 f
->display
.x
->cursor_pixel
);
669 XSetForeground (x_current_display
, f
->display
.x
->cursor_gc
,
672 #endif /* HAVE_X11 */
674 if (FRAME_VISIBLE_P (f
))
676 x_display_cursor (f
, 0);
677 x_display_cursor (f
, 1);
682 /* Set the border-color of frame F to value described by ARG.
683 ARG can be a string naming a color.
684 The border-color is used for the border that is drawn by the X server.
685 Note that this does not fully take effect if done before
686 F has an x-window; it must be redone when the window is created.
688 Note: this is done in two routines because of the way X10 works.
690 Note: under X11, this is normally the province of the window manager,
691 and so emacs' border colors may be overridden. */
694 x_set_border_color (f
, arg
, oldval
)
696 Lisp_Object arg
, oldval
;
701 CHECK_STRING (arg
, 0);
702 str
= XSTRING (arg
)->data
;
705 if (!strcmp (str
, "grey") || !strcmp (str
, "Grey")
706 || !strcmp (str
, "gray") || !strcmp (str
, "Gray"))
711 pix
= x_decode_color (arg
, BLACK_PIX_DEFAULT
);
713 x_set_border_pixel (f
, pix
);
716 /* Set the border-color of frame F to pixel value PIX.
717 Note that this does not fully take effect if done before
718 F has an x-window. */
720 x_set_border_pixel (f
, pix
)
724 f
->display
.x
->border_pixel
= pix
;
726 if (FRAME_X_WINDOW (f
) != 0 && f
->display
.x
->border_width
> 0)
733 XSetWindowBorder (x_current_display
, FRAME_X_WINDOW (f
),
737 temp
= XMakePixmap ((Bitmap
) XStoreBitmap (gray_width
, gray_height
,
739 BLACK_PIX_DEFAULT
, WHITE_PIX_DEFAULT
);
741 temp
= XMakeTile (pix
);
742 XChangeBorder (FRAME_X_WINDOW (f
), temp
);
743 XFreePixmap (XDISPLAY temp
);
744 #endif /* not HAVE_X11 */
747 if (FRAME_VISIBLE_P (f
))
753 x_set_cursor_type (f
, arg
, oldval
)
755 Lisp_Object arg
, oldval
;
758 FRAME_DESIRED_CURSOR (f
) = bar_cursor
;
759 else if (EQ (arg
, Qbox
))
760 FRAME_DESIRED_CURSOR (f
) = filled_box_cursor
;
763 ("the `cursor-type' frame parameter should be either `bar' or `box'");
765 /* Make sure the cursor gets redrawn. This is overkill, but how
766 often do people change cursor types? */
771 x_set_icon_type (f
, arg
, oldval
)
773 Lisp_Object arg
, oldval
;
778 if (EQ (oldval
, Qnil
) == EQ (arg
, Qnil
))
783 result
= x_text_icon (f
, 0);
785 result
= x_bitmap_icon (f
);
790 error ("No icon window available.");
793 /* If the window was unmapped (and its icon was mapped),
794 the new icon is not mapped, so map the window in its stead. */
795 if (FRAME_VISIBLE_P (f
))
796 XMapWindow (XDISPLAY
FRAME_X_WINDOW (f
));
803 x_set_font (f
, arg
, oldval
)
805 Lisp_Object arg
, oldval
;
810 CHECK_STRING (arg
, 1);
811 name
= XSTRING (arg
)->data
;
814 result
= x_new_font (f
, name
);
818 error ("Font \"%s\" is not defined", name
);
822 x_set_border_width (f
, arg
, oldval
)
824 Lisp_Object arg
, oldval
;
826 CHECK_NUMBER (arg
, 0);
828 if (XINT (arg
) == f
->display
.x
->border_width
)
831 if (FRAME_X_WINDOW (f
) != 0)
832 error ("Cannot change the border width of a window");
834 f
->display
.x
->border_width
= XINT (arg
);
838 x_set_internal_border_width (f
, arg
, oldval
)
840 Lisp_Object arg
, oldval
;
843 int old
= f
->display
.x
->internal_border_width
;
845 CHECK_NUMBER (arg
, 0);
846 f
->display
.x
->internal_border_width
= XINT (arg
);
847 if (f
->display
.x
->internal_border_width
< 0)
848 f
->display
.x
->internal_border_width
= 0;
850 if (f
->display
.x
->internal_border_width
== old
)
853 if (FRAME_X_WINDOW (f
) != 0)
856 x_set_window_size (f
, f
->width
, f
->height
);
858 x_set_resize_hint (f
);
862 SET_FRAME_GARBAGED (f
);
867 x_set_visibility (f
, value
, oldval
)
869 Lisp_Object value
, oldval
;
872 XSET (frame
, Lisp_Frame
, f
);
875 Fmake_frame_invisible (frame
);
876 else if (EQ (value
, Qicon
))
877 Ficonify_frame (frame
);
879 Fmake_frame_visible (frame
);
883 x_set_menu_bar_lines_1 (window
, n
)
887 for (; !NILP (window
); window
= XWINDOW (window
)->next
)
889 struct window
*w
= XWINDOW (window
);
891 XFASTINT (w
->top
) += n
;
893 if (!NILP (w
->vchild
))
894 x_set_menu_bar_lines_1 (w
->vchild
, n
);
896 if (!NILP (w
->hchild
))
897 x_set_menu_bar_lines_1 (w
->hchild
, n
);
902 x_set_menu_bar_lines (f
, value
, oldval
)
904 Lisp_Object value
, oldval
;
907 int olines
= FRAME_MENU_BAR_LINES (f
);
909 /* Right now, menu bars don't work properly in minibuf-only frames;
910 most of the commands try to apply themselves to the minibuffer
911 frame itslef, and get an error because you can't switch buffers
912 in or split the minibuffer window. */
913 if (FRAME_MINIBUF_ONLY_P (f
))
916 if (XTYPE (value
) == Lisp_Int
)
917 nlines
= XINT (value
);
921 FRAME_MENU_BAR_LINES (f
) = nlines
;
922 x_set_menu_bar_lines_1 (f
->root_window
, nlines
- olines
);
923 x_set_window_size (f
, FRAME_WIDTH (f
),
924 FRAME_HEIGHT (f
) + nlines
- olines
);
927 /* Change the name of frame F to ARG. If ARG is nil, set F's name to
930 If EXPLICIT is non-zero, that indicates that lisp code is setting the
931 name; if ARG is a string, set F's name to ARG and set
932 F->explicit_name; if ARG is Qnil, then clear F->explicit_name.
934 If EXPLICIT is zero, that indicates that Emacs redisplay code is
935 suggesting a new name, which lisp code should override; if
936 F->explicit_name is set, ignore the new name; otherwise, set it. */
939 x_set_name (f
, name
, explicit)
944 /* Make sure that requests from lisp code override requests from
945 Emacs redisplay code. */
948 /* If we're switching from explicit to implicit, we had better
949 update the mode lines and thereby update the title. */
950 if (f
->explicit_name
&& NILP (name
))
951 update_mode_lines
= 1;
953 f
->explicit_name
= ! NILP (name
);
955 else if (f
->explicit_name
)
958 /* If NAME is nil, set the name to the x_id_name. */
960 name
= build_string (x_id_name
);
962 CHECK_STRING (name
, 0);
964 /* Don't change the name if it's already NAME. */
965 if (! NILP (Fstring_equal (name
, f
->name
)))
968 if (FRAME_X_WINDOW (f
))
975 text
.value
= XSTRING (name
)->data
;
976 text
.encoding
= XA_STRING
;
978 text
.nitems
= XSTRING (name
)->size
;
979 XSetWMName (x_current_display
, FRAME_X_WINDOW (f
), &text
);
980 XSetWMIconName (x_current_display
, FRAME_X_WINDOW (f
), &text
);
983 XSetIconName (XDISPLAY
FRAME_X_WINDOW (f
),
984 XSTRING (name
)->data
);
985 XStoreName (XDISPLAY
FRAME_X_WINDOW (f
),
986 XSTRING (name
)->data
);
995 /* This function should be called when the user's lisp code has
996 specified a name for the frame; the name will override any set by the
999 x_explicitly_set_name (f
, arg
, oldval
)
1001 Lisp_Object arg
, oldval
;
1003 x_set_name (f
, arg
, 1);
1006 /* This function should be called by Emacs redisplay code to set the
1007 name; names set this way will never override names set by the user's
1010 x_implicitly_set_name (f
, arg
, oldval
)
1012 Lisp_Object arg
, oldval
;
1014 x_set_name (f
, arg
, 0);
1018 x_set_autoraise (f
, arg
, oldval
)
1020 Lisp_Object arg
, oldval
;
1022 f
->auto_raise
= !EQ (Qnil
, arg
);
1026 x_set_autolower (f
, arg
, oldval
)
1028 Lisp_Object arg
, oldval
;
1030 f
->auto_lower
= !EQ (Qnil
, arg
);
1034 x_set_vertical_scroll_bars (f
, arg
, oldval
)
1036 Lisp_Object arg
, oldval
;
1038 if (NILP (arg
) != ! FRAME_HAS_VERTICAL_SCROLL_BARS (f
))
1040 FRAME_HAS_VERTICAL_SCROLL_BARS (f
) = ! NILP (arg
);
1042 /* We set this parameter before creating the X window for the
1043 frame, so we can get the geometry right from the start.
1044 However, if the window hasn't been created yet, we shouldn't
1045 call x_set_window_size. */
1046 if (FRAME_X_WINDOW (f
))
1047 x_set_window_size (f
, FRAME_WIDTH (f
), FRAME_HEIGHT (f
));
1055 /* I believe this function is obsolete with respect to the new face display
1057 x_set_face (scr
, font
, background
, foreground
, stipple
)
1060 unsigned long background
, foreground
;
1063 XGCValues gc_values
;
1065 unsigned long gc_mask
;
1066 struct face
*new_face
;
1067 unsigned int width
= 16;
1068 unsigned int height
= 16;
1070 if (n_faces
== MAX_FACES_AND_GLYPHS
)
1073 /* Create the Graphics Context. */
1074 gc_values
.font
= font
->fid
;
1075 gc_values
.foreground
= foreground
;
1076 gc_values
.background
= background
;
1077 gc_values
.line_width
= 0;
1078 gc_mask
= GCLineWidth
| GCFont
| GCForeground
| GCBackground
;
1082 = XCreateBitmapFromData (x_current_display
, ROOT_WINDOW
,
1083 (char *) stipple
, width
, height
);
1084 gc_mask
|= GCStipple
;
1087 temp_gc
= XCreateGC (x_current_display
, FRAME_X_WINDOW (scr
),
1088 gc_mask
, &gc_values
);
1091 new_face
= (struct face
*) xmalloc (sizeof (struct face
));
1094 XFreeGC (x_current_display
, temp_gc
);
1098 new_face
->font
= font
;
1099 new_face
->foreground
= foreground
;
1100 new_face
->background
= background
;
1101 new_face
->face_gc
= temp_gc
;
1103 new_face
->stipple
= gc_values
.stipple
;
1105 x_face_table
[++n_faces
] = new_face
;
1110 x_set_glyph (scr
, glyph
)
1115 DEFUN ("x-set-face-font", Fx_set_face_font
, Sx_set_face_font
, 4, 2, 0,
1116 "Specify face table entry FACE-CODE to be the font named by FONT,\n\
1117 in colors FOREGROUND and BACKGROUND.")
1118 (face_code
, font_name
, foreground
, background
)
1119 Lisp_Object face_code
;
1120 Lisp_Object font_name
;
1121 Lisp_Object foreground
;
1122 Lisp_Object background
;
1124 register struct face
*fp
; /* Current face info. */
1125 register int fn
; /* Face number. */
1126 register FONT_TYPE
*f
; /* Font data structure. */
1127 unsigned char *newname
;
1130 XGCValues gc_values
;
1132 /* Need to do something about this. */
1133 Drawable drawable
= FRAME_X_WINDOW (selected_frame
);
1135 CHECK_NUMBER (face_code
, 1);
1136 CHECK_STRING (font_name
, 2);
1138 if (EQ (foreground
, Qnil
) || EQ (background
, Qnil
))
1140 fg
= selected_frame
->display
.x
->foreground_pixel
;
1141 bg
= selected_frame
->display
.x
->background_pixel
;
1145 CHECK_NUMBER (foreground
, 0);
1146 CHECK_NUMBER (background
, 1);
1148 fg
= x_decode_color (XINT (foreground
), BLACK_PIX_DEFAULT
);
1149 bg
= x_decode_color (XINT (background
), WHITE_PIX_DEFAULT
);
1152 fn
= XINT (face_code
);
1153 if ((fn
< 1) || (fn
> 255))
1154 error ("Invalid face code, %d", fn
);
1156 newname
= XSTRING (font_name
)->data
;
1158 f
= (*newname
== 0 ? 0 : XGetFont (newname
));
1161 error ("Font \"%s\" is not defined", newname
);
1163 fp
= x_face_table
[fn
];
1166 x_face_table
[fn
] = fp
= (struct face
*) xmalloc (sizeof (struct face
));
1167 bzero (fp
, sizeof (struct face
));
1168 fp
->face_type
= x_pixmap
;
1170 else if (FACE_IS_FONT (fn
))
1173 XFreeGC (FACE_FONT (fn
));
1176 else if (FACE_IS_IMAGE (fn
)) /* This should not happen... */
1179 XFreePixmap (x_current_display
, FACE_IMAGE (fn
));
1180 fp
->face_type
= x_font
;
1186 fp
->face_GLYPH
.font_desc
.font
= f
;
1187 gc_values
.font
= f
->fid
;
1188 gc_values
.foreground
= fg
;
1189 gc_values
.background
= bg
;
1190 fp
->face_GLYPH
.font_desc
.face_gc
= XCreateGC (x_current_display
,
1191 drawable
, GCFont
| GCForeground
1192 | GCBackground
, &gc_values
);
1193 fp
->face_GLYPH
.font_desc
.font_width
= FONT_WIDTH (f
);
1194 fp
->face_GLYPH
.font_desc
.font_height
= FONT_HEIGHT (f
);
1200 DEFUN ("x-set-face", Fx_set_face
, Sx_set_face
, 4, 4, 0,
1201 "Specify face table entry FACE-CODE to be the font named by FONT,\n\
1202 in colors FOREGROUND and BACKGROUND.")
1203 (face_code
, font_name
, foreground
, background
)
1204 Lisp_Object face_code
;
1205 Lisp_Object font_name
;
1206 Lisp_Object foreground
;
1207 Lisp_Object background
;
1209 register struct face
*fp
; /* Current face info. */
1210 register int fn
; /* Face number. */
1211 register FONT_TYPE
*f
; /* Font data structure. */
1212 unsigned char *newname
;
1214 CHECK_NUMBER (face_code
, 1);
1215 CHECK_STRING (font_name
, 2);
1217 fn
= XINT (face_code
);
1218 if ((fn
< 1) || (fn
> 255))
1219 error ("Invalid face code, %d", fn
);
1221 /* Ask the server to find the specified font. */
1222 newname
= XSTRING (font_name
)->data
;
1224 f
= (*newname
== 0 ? 0 : XGetFont (newname
));
1227 error ("Font \"%s\" is not defined", newname
);
1229 /* Get the face structure for face_code in the face table.
1230 Make sure it exists. */
1231 fp
= x_face_table
[fn
];
1234 x_face_table
[fn
] = fp
= (struct face
*) xmalloc (sizeof (struct face
));
1235 bzero (fp
, sizeof (struct face
));
1238 /* If this face code already exists, get rid of the old font. */
1239 if (fp
->font
!= 0 && fp
->font
!= f
)
1242 XLoseFont (fp
->font
);
1246 /* Store the specified information in FP. */
1247 fp
->fg
= x_decode_color (foreground
, BLACK_PIX_DEFAULT
);
1248 fp
->bg
= x_decode_color (background
, WHITE_PIX_DEFAULT
);
1256 /* This is excluded because there is no painless way
1257 to get or to remember the name of the font. */
1259 DEFUN ("x-get-face", Fx_get_face
, Sx_get_face
, 1, 1, 0,
1260 "Get data defining face code FACE. FACE is an integer.\n\
1261 The value is a list (FONT FG-COLOR BG-COLOR).")
1265 register struct face
*fp
; /* Current face info. */
1266 register int fn
; /* Face number. */
1268 CHECK_NUMBER (face
, 1);
1270 if ((fn
< 1) || (fn
> 255))
1271 error ("Invalid face code, %d", fn
);
1273 /* Make sure the face table exists and this face code is defined. */
1274 if (x_face_table
== 0 || x_face_table
[fn
] == 0)
1277 fp
= x_face_table
[fn
];
1279 return Fcons (build_string (fp
->name
),
1280 Fcons (make_number (fp
->fg
),
1281 Fcons (make_number (fp
->bg
), Qnil
)));
1285 /* Subroutines of creating an X frame. */
1288 extern char *x_get_string_resource ();
1289 extern XrmDatabase
x_load_resources ();
1291 DEFUN ("x-get-resource", Fx_get_resource
, Sx_get_resource
, 2, 4, 0,
1292 "Return the value of ATTRIBUTE, of class CLASS, from the X defaults database.\n\
1293 This uses `INSTANCE.ATTRIBUTE' as the key and `Emacs.CLASS' as the\n\
1294 class, where INSTANCE is the name under which Emacs was invoked.\n\
1296 The optional arguments COMPONENT and SUBCLASS add to the key and the\n\
1297 class, respectively. You must specify both of them or neither.\n\
1298 If you specify them, the key is `INSTANCE.COMPONENT.ATTRIBUTE'\n\
1299 and the class is `Emacs.CLASS.SUBCLASS'.")
1300 (attribute
, class, component
, subclass
)
1301 Lisp_Object attribute
, class, component
, subclass
;
1303 register char *value
;
1309 CHECK_STRING (attribute
, 0);
1310 CHECK_STRING (class, 0);
1312 if (!NILP (component
))
1313 CHECK_STRING (component
, 1);
1314 if (!NILP (subclass
))
1315 CHECK_STRING (subclass
, 2);
1316 if (NILP (component
) != NILP (subclass
))
1317 error ("x-get-resource: must specify both COMPONENT and SUBCLASS or neither");
1319 if (NILP (component
))
1321 /* Allocate space for the components, the dots which separate them,
1322 and the final '\0'. */
1323 name_key
= (char *) alloca (XSTRING (Vinvocation_name
)->size
1324 + XSTRING (attribute
)->size
1326 class_key
= (char *) alloca ((sizeof (EMACS_CLASS
) - 1)
1327 + XSTRING (class)->size
1330 sprintf (name_key
, "%s.%s",
1331 XSTRING (Vinvocation_name
)->data
,
1332 XSTRING (attribute
)->data
);
1333 sprintf (class_key
, "%s.%s",
1335 XSTRING (class)->data
);
1339 name_key
= (char *) alloca (XSTRING (Vinvocation_name
)->size
1340 + XSTRING (component
)->size
1341 + XSTRING (attribute
)->size
1344 class_key
= (char *) alloca ((sizeof (EMACS_CLASS
) - 1)
1345 + XSTRING (class)->size
1346 + XSTRING (subclass
)->size
1349 sprintf (name_key
, "%s.%s.%s",
1350 XSTRING (Vinvocation_name
)->data
,
1351 XSTRING (component
)->data
,
1352 XSTRING (attribute
)->data
);
1353 sprintf (class_key
, "%s.%s",
1355 XSTRING (class)->data
,
1356 XSTRING (subclass
)->data
);
1359 value
= x_get_string_resource (xrdb
, name_key
, class_key
);
1361 if (value
!= (char *) 0)
1362 return build_string (value
);
1369 DEFUN ("x-get-default", Fx_get_default
, Sx_get_default
, 1, 1, 0,
1370 "Get X default ATTRIBUTE from the system, or nil if no default.\n\
1371 Value is a string (when not nil) and ATTRIBUTE is also a string.\n\
1372 The defaults are specified in the file `~/.Xdefaults'.")
1376 register unsigned char *value
;
1378 CHECK_STRING (arg
, 1);
1380 value
= (unsigned char *) XGetDefault (XDISPLAY
1381 XSTRING (Vinvocation_name
)->data
,
1382 XSTRING (arg
)->data
);
1384 /* Try reversing last two args, in case this is the buggy version of X. */
1385 value
= (unsigned char *) XGetDefault (XDISPLAY
1386 XSTRING (arg
)->data
,
1387 XSTRING (Vinvocation_name
)->data
);
1389 return build_string (value
);
1394 #define Fx_get_resource(attribute, class, component, subclass) \
1395 Fx_get_default(attribute)
1399 /* Types we might convert a resource string into. */
1402 number
, boolean
, string
, symbol
,
1405 /* Return the value of parameter PARAM.
1407 First search ALIST, then Vdefault_frame_alist, then the X defaults
1408 database, using ATTRIBUTE as the attribute name and CLASS as its class.
1410 Convert the resource to the type specified by desired_type.
1412 If no default is specified, return Qunbound. If you call
1413 x_get_arg, make sure you deal with Qunbound in a reasonable way,
1414 and don't let it get stored in any lisp-visible variables! */
1417 x_get_arg (alist
, param
, attribute
, class, type
)
1418 Lisp_Object alist
, param
;
1421 enum resource_types type
;
1423 register Lisp_Object tem
;
1425 tem
= Fassq (param
, alist
);
1427 tem
= Fassq (param
, Vdefault_frame_alist
);
1433 tem
= Fx_get_resource (build_string (attribute
),
1434 build_string (class),
1443 return make_number (atoi (XSTRING (tem
)->data
));
1446 tem
= Fdowncase (tem
);
1447 if (!strcmp (XSTRING (tem
)->data
, "on")
1448 || !strcmp (XSTRING (tem
)->data
, "true"))
1457 /* As a special case, we map the values `true' and `on'
1458 to Qt, and `false' and `off' to Qnil. */
1460 Lisp_Object lower
= Fdowncase (tem
);
1461 if (!strcmp (XSTRING (tem
)->data
, "on")
1462 || !strcmp (XSTRING (tem
)->data
, "true"))
1464 else if (!strcmp (XSTRING (tem
)->data
, "off")
1465 || !strcmp (XSTRING (tem
)->data
, "false"))
1468 return Fintern (tem
, Qnil
);
1481 /* Record in frame F the specified or default value according to ALIST
1482 of the parameter named PARAM (a Lisp symbol).
1483 If no value is specified for PARAM, look for an X default for XPROP
1484 on the frame named NAME.
1485 If that is not found either, use the value DEFLT. */
1488 x_default_parameter (f
, alist
, prop
, deflt
, xprop
, xclass
, type
)
1495 enum resource_types type
;
1499 tem
= x_get_arg (alist
, prop
, xprop
, xclass
, type
);
1500 if (EQ (tem
, Qunbound
))
1502 x_set_frame_parameters (f
, Fcons (Fcons (prop
, tem
), Qnil
));
1506 DEFUN ("x-parse-geometry", Fx_parse_geometry
, Sx_parse_geometry
, 1, 1, 0,
1507 "Parse an X-style geometry string STRING.\n\
1508 Returns an alist of the form ((top . TOP), (left . LEFT) ... ).")
1513 unsigned int width
, height
;
1514 Lisp_Object values
[4];
1517 CHECK_STRING (string
, 0);
1519 geometry
= XParseGeometry ((char *) XSTRING (string
)->data
,
1520 &x
, &y
, &width
, &height
);
1522 switch (geometry
& 0xf) /* Mask out {X,Y}Negative */
1524 case (XValue
| YValue
):
1525 /* What's one pixel among friends?
1526 Perhaps fix this some day by returning symbol `extreme-top'... */
1527 if (x
== 0 && (geometry
& XNegative
))
1529 if (y
== 0 && (geometry
& YNegative
))
1531 values
[0] = Fcons (Qleft
, make_number (x
));
1532 values
[1] = Fcons (Qtop
, make_number (y
));
1533 return Flist (2, values
);
1536 case (WidthValue
| HeightValue
):
1537 values
[0] = Fcons (Qwidth
, make_number (width
));
1538 values
[1] = Fcons (Qheight
, make_number (height
));
1539 return Flist (2, values
);
1542 case (XValue
| YValue
| WidthValue
| HeightValue
):
1543 if (x
== 0 && (geometry
& XNegative
))
1545 if (y
== 0 && (geometry
& YNegative
))
1547 values
[0] = Fcons (Qwidth
, make_number (width
));
1548 values
[1] = Fcons (Qheight
, make_number (height
));
1549 values
[2] = Fcons (Qleft
, make_number (x
));
1550 values
[3] = Fcons (Qtop
, make_number (y
));
1551 return Flist (4, values
);
1558 error ("Must specify x and y value, and/or width and height");
1563 /* Calculate the desired size and position of this window,
1564 or set rubber-band prompting if none. */
1566 #define DEFAULT_ROWS 40
1567 #define DEFAULT_COLS 80
1570 x_figure_window_size (f
, parms
)
1574 register Lisp_Object tem0
, tem1
;
1575 int height
, width
, left
, top
;
1576 register int geometry
;
1577 long window_prompting
= 0;
1579 /* Default values if we fall through.
1580 Actually, if that happens we should get
1581 window manager prompting. */
1582 f
->width
= DEFAULT_COLS
;
1583 f
->height
= DEFAULT_ROWS
;
1584 f
->display
.x
->top_pos
= 1;
1585 f
->display
.x
->left_pos
= 1;
1587 tem0
= x_get_arg (parms
, Qheight
, 0, 0, number
);
1588 tem1
= x_get_arg (parms
, Qwidth
, 0, 0, number
);
1589 if (! EQ (tem0
, Qunbound
) && ! EQ (tem1
, Qunbound
))
1591 CHECK_NUMBER (tem0
, 0);
1592 CHECK_NUMBER (tem1
, 0);
1593 f
->height
= XINT (tem0
);
1594 f
->width
= XINT (tem1
);
1595 window_prompting
|= USSize
;
1597 else if (! EQ (tem0
, Qunbound
) || ! EQ (tem1
, Qunbound
))
1598 error ("Must specify *both* height and width");
1600 f
->display
.x
->vertical_scroll_bar_extra
=
1601 (FRAME_HAS_VERTICAL_SCROLL_BARS (f
)
1602 ? VERTICAL_SCROLL_BAR_PIXEL_WIDTH (f
)
1604 f
->display
.x
->pixel_width
= CHAR_TO_PIXEL_WIDTH (f
, f
->width
);
1605 f
->display
.x
->pixel_height
= CHAR_TO_PIXEL_HEIGHT (f
, f
->height
);
1607 tem0
= x_get_arg (parms
, Qtop
, 0, 0, number
);
1608 tem1
= x_get_arg (parms
, Qleft
, 0, 0, number
);
1609 if (! EQ (tem0
, Qunbound
) && ! EQ (tem1
, Qunbound
))
1611 CHECK_NUMBER (tem0
, 0);
1612 CHECK_NUMBER (tem1
, 0);
1613 f
->display
.x
->top_pos
= XINT (tem0
);
1614 f
->display
.x
->left_pos
= XINT (tem1
);
1615 x_calc_absolute_position (f
);
1616 window_prompting
|= USPosition
;
1618 else if (! EQ (tem0
, Qunbound
) || ! EQ (tem1
, Qunbound
))
1619 error ("Must specify *both* top and left corners");
1621 switch (window_prompting
)
1623 case USSize
| USPosition
:
1624 return window_prompting
;
1627 case USSize
: /* Got the size, need the position. */
1628 window_prompting
|= PPosition
;
1629 return window_prompting
;
1632 case USPosition
: /* Got the position, need the size. */
1633 window_prompting
|= PSize
;
1634 return window_prompting
;
1637 case 0: /* Got nothing, take both from geometry. */
1638 window_prompting
|= PPosition
| PSize
;
1639 return window_prompting
;
1643 /* Somehow a bit got set in window_prompting that we didn't
1653 XSetWindowAttributes attributes
;
1654 unsigned long attribute_mask
;
1655 XClassHint class_hints
;
1657 attributes
.background_pixel
= f
->display
.x
->background_pixel
;
1658 attributes
.border_pixel
= f
->display
.x
->border_pixel
;
1659 attributes
.bit_gravity
= StaticGravity
;
1660 attributes
.backing_store
= NotUseful
;
1661 attributes
.save_under
= True
;
1662 attributes
.event_mask
= STANDARD_EVENT_SET
;
1663 attribute_mask
= (CWBackPixel
| CWBorderPixel
| CWBitGravity
1665 | CWBackingStore
| CWSaveUnder
1671 = XCreateWindow (x_current_display
, ROOT_WINDOW
,
1672 f
->display
.x
->left_pos
,
1673 f
->display
.x
->top_pos
,
1674 PIXEL_WIDTH (f
), PIXEL_HEIGHT (f
),
1675 f
->display
.x
->border_width
,
1676 CopyFromParent
, /* depth */
1677 InputOutput
, /* class */
1678 screen_visual
, /* set in Fx_open_connection */
1679 attribute_mask
, &attributes
);
1681 class_hints
.res_name
= (char *) XSTRING (f
->name
)->data
;
1682 class_hints
.res_class
= EMACS_CLASS
;
1683 XSetClassHint (x_current_display
, FRAME_X_WINDOW (f
), &class_hints
);
1685 /* This indicates that we use the "Passive Input" input model.
1686 Unless we do this, we don't get the Focus{In,Out} events that we
1687 need to draw the cursor correctly. Accursed bureaucrats.
1688 XWhipsAndChains (x_current_display, IronMaiden, &TheRack); */
1690 f
->display
.x
->wm_hints
.input
= True
;
1691 f
->display
.x
->wm_hints
.flags
|= InputHint
;
1692 XSetWMHints (x_current_display
, FRAME_X_WINDOW (f
), &f
->display
.x
->wm_hints
);
1694 /* x_set_name normally ignores requests to set the name if the
1695 requested name is the same as the current name. This is the one
1696 place where that assumption isn't correct; f->name is set, but
1697 the X server hasn't been told. */
1699 Lisp_Object name
= f
->name
;
1700 int explicit = f
->explicit_name
;
1703 f
->explicit_name
= 0;
1704 x_set_name (f
, name
, explicit);
1707 XDefineCursor (XDISPLAY
FRAME_X_WINDOW (f
),
1708 f
->display
.x
->text_cursor
);
1711 if (FRAME_X_WINDOW (f
) == 0)
1712 error ("Unable to create window.");
1715 /* Handle the icon stuff for this window. Perhaps later we might
1716 want an x_set_icon_position which can be called interactively as
1724 Lisp_Object icon_x
, icon_y
;
1726 /* Set the position of the icon. Note that twm groups all
1727 icons in an icon window. */
1728 icon_x
= x_get_arg (parms
, Qicon_left
, 0, 0, number
);
1729 icon_y
= x_get_arg (parms
, Qicon_top
, 0, 0, number
);
1730 if (!EQ (icon_x
, Qunbound
) && !EQ (icon_y
, Qunbound
))
1732 CHECK_NUMBER (icon_x
, 0);
1733 CHECK_NUMBER (icon_y
, 0);
1735 else if (!EQ (icon_x
, Qunbound
) || !EQ (icon_y
, Qunbound
))
1736 error ("Both left and top icon corners of icon must be specified");
1740 if (! EQ (icon_x
, Qunbound
))
1741 x_wm_set_icon_position (f
, XINT (icon_x
), XINT (icon_y
));
1743 /* Start up iconic or window? */
1744 x_wm_set_window_state
1745 (f
, (EQ (x_get_arg (parms
, Qvisibility
, 0, 0, symbol
), Qicon
)
1752 /* Make the GC's needed for this window, setting the
1753 background, border and mouse colors; also create the
1754 mouse cursor and the gray border tile. */
1756 static char cursor_bits
[] =
1758 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
1759 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
1760 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
1761 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00
1768 XGCValues gc_values
;
1774 /* Create the GC's of this frame.
1775 Note that many default values are used. */
1778 gc_values
.font
= f
->display
.x
->font
->fid
;
1779 gc_values
.foreground
= f
->display
.x
->foreground_pixel
;
1780 gc_values
.background
= f
->display
.x
->background_pixel
;
1781 gc_values
.line_width
= 0; /* Means 1 using fast algorithm. */
1782 f
->display
.x
->normal_gc
= XCreateGC (x_current_display
,
1784 GCLineWidth
| GCFont
1785 | GCForeground
| GCBackground
,
1788 /* Reverse video style. */
1789 gc_values
.foreground
= f
->display
.x
->background_pixel
;
1790 gc_values
.background
= f
->display
.x
->foreground_pixel
;
1791 f
->display
.x
->reverse_gc
= XCreateGC (x_current_display
,
1793 GCFont
| GCForeground
| GCBackground
1797 /* Cursor has cursor-color background, background-color foreground. */
1798 gc_values
.foreground
= f
->display
.x
->background_pixel
;
1799 gc_values
.background
= f
->display
.x
->cursor_pixel
;
1800 gc_values
.fill_style
= FillOpaqueStippled
;
1802 = XCreateBitmapFromData (x_current_display
, ROOT_WINDOW
,
1803 cursor_bits
, 16, 16);
1804 f
->display
.x
->cursor_gc
1805 = XCreateGC (x_current_display
, FRAME_X_WINDOW (f
),
1806 (GCFont
| GCForeground
| GCBackground
1807 | GCFillStyle
| GCStipple
| GCLineWidth
),
1810 /* Create the gray border tile used when the pointer is not in
1811 the frame. Since this depends on the frame's pixel values,
1812 this must be done on a per-frame basis. */
1813 f
->display
.x
->border_tile
1814 = (XCreatePixmapFromBitmapData
1815 (x_current_display
, ROOT_WINDOW
,
1816 gray_bits
, gray_width
, gray_height
,
1817 f
->display
.x
->foreground_pixel
,
1818 f
->display
.x
->background_pixel
,
1819 DefaultDepth (x_current_display
, XDefaultScreen (x_current_display
))));
1821 init_frame_faces (f
);
1825 #endif /* HAVE_X11 */
1827 DEFUN ("x-create-frame", Fx_create_frame
, Sx_create_frame
,
1829 "Make a new X window, which is called a \"frame\" in Emacs terms.\n\
1830 Return an Emacs frame object representing the X window.\n\
1831 ALIST is an alist of frame parameters.\n\
1832 If the parameters specify that the frame should not have a minibuffer,\n\
1833 and do not specify a specific minibuffer window to use,\n\
1834 then `default-minibuffer-frame' must be a frame whose minibuffer can\n\
1835 be shared by the new frame.")
1841 Lisp_Object frame
, tem
;
1843 int minibuffer_only
= 0;
1844 long window_prompting
= 0;
1849 name
= x_get_arg (parms
, Qname
, "title", "Title", string
);
1850 if (XTYPE (name
) != Lisp_String
1851 && ! EQ (name
, Qunbound
)
1853 error ("x-create-frame: name parameter must be a string");
1855 tem
= x_get_arg (parms
, Qminibuffer
, 0, 0, symbol
);
1856 if (EQ (tem
, Qnone
) || NILP (tem
))
1857 f
= make_frame_without_minibuffer (Qnil
);
1858 else if (EQ (tem
, Qonly
))
1860 f
= make_minibuffer_frame ();
1861 minibuffer_only
= 1;
1863 else if (XTYPE (tem
) == Lisp_Window
)
1864 f
= make_frame_without_minibuffer (tem
);
1868 /* Note that X Windows does support scroll bars. */
1869 FRAME_CAN_HAVE_SCROLL_BARS (f
) = 1;
1871 /* Set the name; the functions to which we pass f expect the name to
1873 if (EQ (name
, Qunbound
) || NILP (name
))
1875 f
->name
= build_string (x_id_name
);
1876 f
->explicit_name
= 0;
1881 f
->explicit_name
= 1;
1884 XSET (frame
, Lisp_Frame
, f
);
1885 f
->output_method
= output_x_window
;
1886 f
->display
.x
= (struct x_display
*) xmalloc (sizeof (struct x_display
));
1887 bzero (f
->display
.x
, sizeof (struct x_display
));
1889 /* Note that the frame has no physical cursor right now. */
1890 f
->phys_cursor_x
= -1;
1892 /* Extract the window parameters from the supplied values
1893 that are needed to determine window geometry. */
1894 x_default_parameter (f
, parms
, Qfont
,
1896 /* If we use an XLFD name for this font, the lisp code
1897 knows how to find variants which are bold, italic,
1899 ("-*-fixed-*-*-*-*-*-120-*-*-c-*-iso8859-1"),
1900 "font", "Font", string
);
1901 x_default_parameter (f
, parms
, Qborder_width
, make_number (2),
1902 "borderwidth", "BorderWidth", number
);
1903 /* This defaults to 2 in order to match xterm. */
1904 x_default_parameter (f
, parms
, Qinternal_border_width
, make_number (2),
1905 "internalBorderWidth", "BorderWidth", number
);
1906 x_default_parameter (f
, parms
, Qvertical_scroll_bars
, Qt
,
1907 "verticalScrollBars", "ScrollBars", boolean
);
1909 /* Also do the stuff which must be set before the window exists. */
1910 x_default_parameter (f
, parms
, Qforeground_color
, build_string ("black"),
1911 "foreground", "Foreground", string
);
1912 x_default_parameter (f
, parms
, Qbackground_color
, build_string ("white"),
1913 "background", "Background", string
);
1914 x_default_parameter (f
, parms
, Qmouse_color
, build_string ("black"),
1915 "pointerColor", "Foreground", string
);
1916 x_default_parameter (f
, parms
, Qcursor_color
, build_string ("black"),
1917 "cursorColor", "Foreground", string
);
1918 x_default_parameter (f
, parms
, Qborder_color
, build_string ("black"),
1919 "borderColor", "BorderColor", string
);
1921 f
->display
.x
->parent_desc
= ROOT_WINDOW
;
1922 window_prompting
= x_figure_window_size (f
, parms
);
1928 /* We need to do this after creating the X window, so that the
1929 icon-creation functions can say whose icon they're describing. */
1930 x_default_parameter (f
, parms
, Qicon_type
, Qnil
,
1931 "iconType", "IconType", symbol
);
1933 x_default_parameter (f
, parms
, Qauto_raise
, Qnil
,
1934 "autoRaise", "AutoRaiseLower", boolean
);
1935 x_default_parameter (f
, parms
, Qauto_lower
, Qnil
,
1936 "autoLower", "AutoRaiseLower", boolean
);
1937 x_default_parameter (f
, parms
, Qcursor_type
, Qbox
,
1938 "cursorType", "CursorType", symbol
);
1940 /* Dimensions, especially f->height, must be done via change_frame_size.
1941 Change will not be effected unless different from the current
1945 f
->height
= f
->width
= 0;
1946 change_frame_size (f
, height
, width
, 1, 0);
1948 x_default_parameter (f
, parms
, Qmenu_bar_lines
, make_number (0),
1949 "menuBarLines", "MenuBarLines", number
);
1952 x_wm_set_size_hint (f
, window_prompting
);
1955 tem
= x_get_arg (parms
, Qunsplittable
, 0, 0, boolean
);
1956 f
->no_split
= minibuffer_only
|| EQ (tem
, Qt
);
1958 /* Make the window appear on the frame and enable display,
1959 unless the caller says not to. */
1961 Lisp_Object visibility
= x_get_arg (parms
, Qvisibility
, 0, 0, symbol
);
1963 if (EQ (visibility
, Qunbound
))
1966 if (EQ (visibility
, Qicon
))
1967 x_iconify_frame (f
);
1968 else if (! NILP (visibility
))
1969 x_make_frame_visible (f
);
1971 /* Must have been Qnil. */
1978 Lisp_Object frame
, tem
;
1980 int pixelwidth
, pixelheight
;
1985 int minibuffer_only
= 0;
1986 Lisp_Object vscroll
, hscroll
;
1988 if (x_current_display
== 0)
1989 error ("X windows are not in use or not initialized");
1991 name
= Fassq (Qname
, parms
);
1993 tem
= x_get_arg (parms
, Qminibuffer
, 0, 0, symbol
);
1994 if (EQ (tem
, Qnone
))
1995 f
= make_frame_without_minibuffer (Qnil
);
1996 else if (EQ (tem
, Qonly
))
1998 f
= make_minibuffer_frame ();
1999 minibuffer_only
= 1;
2001 else if (EQ (tem
, Qnil
) || EQ (tem
, Qunbound
))
2004 f
= make_frame_without_minibuffer (tem
);
2006 parent
= ROOT_WINDOW
;
2008 XSET (frame
, Lisp_Frame
, f
);
2009 f
->output_method
= output_x_window
;
2010 f
->display
.x
= (struct x_display
*) xmalloc (sizeof (struct x_display
));
2011 bzero (f
->display
.x
, sizeof (struct x_display
));
2013 /* Some temprorary default values for height and width. */
2016 f
->display
.x
->left_pos
= -1;
2017 f
->display
.x
->top_pos
= -1;
2019 /* Give the frame a default name (which may be overridden with PARMS). */
2021 strncpy (iconidentity
, ICONTAG
, MAXICID
);
2022 if (gethostname (&iconidentity
[sizeof (ICONTAG
) - 1],
2023 (MAXICID
- 1) - sizeof (ICONTAG
)))
2024 iconidentity
[sizeof (ICONTAG
) - 2] = '\0';
2025 f
->name
= build_string (iconidentity
);
2027 /* Extract some window parameters from the supplied values.
2028 These are the parameters that affect window geometry. */
2030 tem
= x_get_arg (parms
, Qfont
, "BodyFont", 0, string
);
2031 if (EQ (tem
, Qunbound
))
2032 tem
= build_string ("9x15");
2033 x_set_font (f
, tem
, Qnil
);
2034 x_default_parameter (f
, parms
, Qborder_color
,
2035 build_string ("black"), "Border", 0, string
);
2036 x_default_parameter (f
, parms
, Qbackground_color
,
2037 build_string ("white"), "Background", 0, string
);
2038 x_default_parameter (f
, parms
, Qforeground_color
,
2039 build_string ("black"), "Foreground", 0, string
);
2040 x_default_parameter (f
, parms
, Qmouse_color
,
2041 build_string ("black"), "Mouse", 0, string
);
2042 x_default_parameter (f
, parms
, Qcursor_color
,
2043 build_string ("black"), "Cursor", 0, string
);
2044 x_default_parameter (f
, parms
, Qborder_width
,
2045 make_number (2), "BorderWidth", 0, number
);
2046 x_default_parameter (f
, parms
, Qinternal_border_width
,
2047 make_number (4), "InternalBorderWidth", 0, number
);
2048 x_default_parameter (f
, parms
, Qauto_raise
,
2049 Qnil
, "AutoRaise", 0, boolean
);
2051 hscroll
= EQ (x_get_arg (parms
, Qhorizontal_scroll_bar
, 0, 0, boolean
), Qt
);
2052 vscroll
= EQ (x_get_arg (parms
, Qvertical_scroll_bar
, 0, 0, boolean
), Qt
);
2054 if (f
->display
.x
->internal_border_width
< 0)
2055 f
->display
.x
->internal_border_width
= 0;
2057 tem
= x_get_arg (parms
, Qwindow_id
, 0, 0, number
);
2058 if (!EQ (tem
, Qunbound
))
2060 WINDOWINFO_TYPE wininfo
;
2062 Window
*children
, root
;
2064 CHECK_NUMBER (tem
, 0);
2065 FRAME_X_WINDOW (f
) = (Window
) XINT (tem
);
2068 XGetWindowInfo (FRAME_X_WINDOW (f
), &wininfo
);
2069 XQueryTree (FRAME_X_WINDOW (f
), &parent
, &nchildren
, &children
);
2073 height
= PIXEL_TO_CHAR_HEIGHT (f
, wininfo
.height
);
2074 width
= PIXEL_TO_CHAR_WIDTH (f
, wininfo
.width
);
2075 f
->display
.x
->left_pos
= wininfo
.x
;
2076 f
->display
.x
->top_pos
= wininfo
.y
;
2077 FRAME_SET_VISIBILITY (f
, wininfo
.mapped
!= 0);
2078 f
->display
.x
->border_width
= wininfo
.bdrwidth
;
2079 f
->display
.x
->parent_desc
= parent
;
2083 tem
= x_get_arg (parms
, Qparent_id
, 0, 0, number
);
2084 if (!EQ (tem
, Qunbound
))
2086 CHECK_NUMBER (tem
, 0);
2087 parent
= (Window
) XINT (tem
);
2089 f
->display
.x
->parent_desc
= parent
;
2090 tem
= x_get_arg (parms
, Qheight
, 0, 0, number
);
2091 if (EQ (tem
, Qunbound
))
2093 tem
= x_get_arg (parms
, Qwidth
, 0, 0, number
);
2094 if (EQ (tem
, Qunbound
))
2096 tem
= x_get_arg (parms
, Qtop
, 0, 0, number
);
2097 if (EQ (tem
, Qunbound
))
2098 tem
= x_get_arg (parms
, Qleft
, 0, 0, number
);
2101 /* Now TEM is Qunbound if no edge or size was specified.
2102 In that case, we must do rubber-banding. */
2103 if (EQ (tem
, Qunbound
))
2105 tem
= x_get_arg (parms
, Qgeometry
, 0, 0, number
);
2107 &f
->display
.x
->left_pos
, &f
->display
.x
->top_pos
,
2109 (XTYPE (tem
) == Lisp_String
2110 ? (char *) XSTRING (tem
)->data
: ""),
2111 XSTRING (f
->name
)->data
,
2112 !NILP (hscroll
), !NILP (vscroll
));
2116 /* Here if at least one edge or size was specified.
2117 Demand that they all were specified, and use them. */
2118 tem
= x_get_arg (parms
, Qheight
, 0, 0, number
);
2119 if (EQ (tem
, Qunbound
))
2120 error ("Height not specified");
2121 CHECK_NUMBER (tem
, 0);
2122 height
= XINT (tem
);
2124 tem
= x_get_arg (parms
, Qwidth
, 0, 0, number
);
2125 if (EQ (tem
, Qunbound
))
2126 error ("Width not specified");
2127 CHECK_NUMBER (tem
, 0);
2130 tem
= x_get_arg (parms
, Qtop
, 0, 0, number
);
2131 if (EQ (tem
, Qunbound
))
2132 error ("Top position not specified");
2133 CHECK_NUMBER (tem
, 0);
2134 f
->display
.x
->left_pos
= XINT (tem
);
2136 tem
= x_get_arg (parms
, Qleft
, 0, 0, number
);
2137 if (EQ (tem
, Qunbound
))
2138 error ("Left position not specified");
2139 CHECK_NUMBER (tem
, 0);
2140 f
->display
.x
->top_pos
= XINT (tem
);
2143 pixelwidth
= CHAR_TO_PIXEL_WIDTH (f
, width
);
2144 pixelheight
= CHAR_TO_PIXEL_HEIGHT (f
, height
);
2148 = XCreateWindow (parent
,
2149 f
->display
.x
->left_pos
, /* Absolute horizontal offset */
2150 f
->display
.x
->top_pos
, /* Absolute Vertical offset */
2151 pixelwidth
, pixelheight
,
2152 f
->display
.x
->border_width
,
2153 BLACK_PIX_DEFAULT
, WHITE_PIX_DEFAULT
);
2155 if (FRAME_X_WINDOW (f
) == 0)
2156 error ("Unable to create window.");
2159 /* Install the now determined height and width
2160 in the windows and in phys_lines and desired_lines. */
2161 change_frame_size (f
, height
, width
, 1, 0);
2162 XSelectInput (FRAME_X_WINDOW (f
), KeyPressed
| ExposeWindow
2163 | ButtonPressed
| ButtonReleased
| ExposeRegion
| ExposeCopy
2164 | EnterWindow
| LeaveWindow
| UnmapWindow
);
2165 x_set_resize_hint (f
);
2167 /* Tell the server the window's default name. */
2168 XStoreName (XDISPLAY
FRAME_X_WINDOW (f
), XSTRING (f
->name
)->data
);
2170 /* Now override the defaults with all the rest of the specified
2172 tem
= x_get_arg (parms
, Qunsplittable
, 0, 0, boolean
);
2173 f
->no_split
= minibuffer_only
|| EQ (tem
, Qt
);
2175 /* Do not create an icon window if the caller says not to */
2176 if (!EQ (x_get_arg (parms
, Qsuppress_icon
, 0, 0, boolean
), Qt
)
2177 || f
->display
.x
->parent_desc
!= ROOT_WINDOW
)
2179 x_text_icon (f
, iconidentity
);
2180 x_default_parameter (f
, parms
, Qicon_type
, Qnil
,
2181 "BitmapIcon", 0, symbol
);
2184 /* Tell the X server the previously set values of the
2185 background, border and mouse colors; also create the mouse cursor. */
2187 temp
= XMakeTile (f
->display
.x
->background_pixel
);
2188 XChangeBackground (FRAME_X_WINDOW (f
), temp
);
2191 x_set_border_pixel (f
, f
->display
.x
->border_pixel
);
2193 x_set_mouse_color (f
, Qnil
, Qnil
);
2195 /* Now override the defaults with all the rest of the specified parms. */
2197 Fmodify_frame_parameters (frame
, parms
);
2199 /* Make the window appear on the frame and enable display. */
2201 Lisp_Object visibility
= x_get_arg (parms
, Qvisibility
, 0, 0, symbol
);
2203 if (EQ (visibility
, Qunbound
))
2206 if (! EQ (visibility
, Qicon
)
2207 && ! NILP (visibility
))
2208 x_make_window_visible (f
);
2211 SET_FRAME_GARBAGED (f
);
2217 DEFUN ("focus-frame", Ffocus_frame
, Sfocus_frame
, 1, 1, 0,
2218 "Set the focus on FRAME.")
2222 CHECK_LIVE_FRAME (frame
, 0);
2224 if (FRAME_X_P (XFRAME (frame
)))
2227 x_focus_on_frame (XFRAME (frame
));
2235 DEFUN ("unfocus-frame", Funfocus_frame
, Sunfocus_frame
, 0, 0, 0,
2236 "If a frame has been focused, release it.")
2242 x_unfocus_frame (x_focus_frame
);
2250 /* Computes an X-window size and position either from geometry GEO
2253 F is a frame. It specifies an X window which is used to
2254 determine which display to compute for. Its font, borders
2255 and colors control how the rectangle will be displayed.
2257 X and Y are where to store the positions chosen.
2258 WIDTH and HEIGHT are where to store the sizes chosen.
2260 GEO is the geometry that may specify some of the info.
2261 STR is a prompt to display.
2262 HSCROLL and VSCROLL say whether we have horiz and vert scroll bars. */
2265 x_rubber_band (f
, x
, y
, width
, height
, geo
, str
, hscroll
, vscroll
)
2267 int *x
, *y
, *width
, *height
;
2270 int hscroll
, vscroll
;
2276 int background_color
;
2282 background_color
= f
->display
.x
->background_pixel
;
2283 border_color
= f
->display
.x
->border_pixel
;
2285 frame
.bdrwidth
= f
->display
.x
->border_width
;
2286 frame
.border
= XMakeTile (border_color
);
2287 frame
.background
= XMakeTile (background_color
);
2288 tempwindow
= XCreateTerm (str
, "emacs", geo
, default_window
, &frame
, 10, 5,
2289 (2 * f
->display
.x
->internal_border_width
2290 + (vscroll
? VSCROLL_WIDTH
: 0)),
2291 (2 * f
->display
.x
->internal_border_width
2292 + (hscroll
? HSCROLL_HEIGHT
: 0)),
2293 width
, height
, f
->display
.x
->font
,
2294 FONT_WIDTH (f
->display
.x
->font
),
2295 FONT_HEIGHT (f
->display
.x
->font
));
2296 XFreePixmap (frame
.border
);
2297 XFreePixmap (frame
.background
);
2299 if (tempwindow
!= 0)
2301 XQueryWindow (tempwindow
, &wininfo
);
2302 XDestroyWindow (tempwindow
);
2307 /* Coordinates we got are relative to the root window.
2308 Convert them to coordinates relative to desired parent window
2309 by scanning from there up to the root. */
2310 tempwindow
= f
->display
.x
->parent_desc
;
2311 while (tempwindow
!= ROOT_WINDOW
)
2315 XQueryWindow (tempwindow
, &wininfo
);
2318 XQueryTree (tempwindow
, &tempwindow
, &nchildren
, &children
);
2323 return tempwindow
!= 0;
2325 #endif /* not HAVE_X11 */
2327 DEFUN ("x-color-defined-p", Fx_color_defined_p
, Sx_color_defined_p
, 1, 1, 0,
2328 "Return t if the current X display supports the color named COLOR.")
2335 CHECK_STRING (color
, 0);
2337 if (defined_color (XSTRING (color
)->data
, &foo
))
2343 DEFUN ("x-display-color-p", Fx_display_color_p
, Sx_display_color_p
, 0, 0, 0,
2344 "Return t if the X screen currently in use supports color.")
2349 if (x_screen_planes
<= 2)
2352 switch (screen_visual
->class)
2365 DEFUN ("x-display-pixel-width", Fx_display_pixel_width
, Sx_display_pixel_width
,
2367 "Returns the width in pixels of the display FRAME is on.")
2371 Display
*dpy
= x_current_display
;
2373 return make_number (DisplayWidth (dpy
, DefaultScreen (dpy
)));
2376 DEFUN ("x-display-pixel-height", Fx_display_pixel_height
,
2377 Sx_display_pixel_height
, 0, 1, 0,
2378 "Returns the height in pixels of the display FRAME is on.")
2382 Display
*dpy
= x_current_display
;
2384 return make_number (DisplayHeight (dpy
, DefaultScreen (dpy
)));
2387 DEFUN ("x-display-planes", Fx_display_planes
, Sx_display_planes
,
2389 "Returns the number of bitplanes of the display FRAME is on.")
2393 Display
*dpy
= x_current_display
;
2395 return make_number (DisplayPlanes (dpy
, DefaultScreen (dpy
)));
2398 DEFUN ("x-display-color-cells", Fx_display_color_cells
, Sx_display_color_cells
,
2400 "Returns the number of color cells of the display FRAME is on.")
2404 Display
*dpy
= x_current_display
;
2406 return make_number (DisplayCells (dpy
, DefaultScreen (dpy
)));
2409 DEFUN ("x-server-vendor", Fx_server_vendor
, Sx_server_vendor
, 0, 1, 0,
2410 "Returns the vendor ID string of the X server FRAME is on.")
2414 Display
*dpy
= x_current_display
;
2417 vendor
= ServerVendor (dpy
);
2418 if (! vendor
) vendor
= "";
2419 return build_string (vendor
);
2422 DEFUN ("x-server-version", Fx_server_version
, Sx_server_version
, 0, 1, 0,
2423 "Returns the version numbers of the X server in use.\n\
2424 The value is a list of three integers: the major and minor\n\
2425 version numbers of the X Protocol in use, and the vendor-specific release\n\
2426 number. See also the variable `x-server-vendor'.")
2430 Display
*dpy
= x_current_display
;
2433 return Fcons (make_number (ProtocolVersion (dpy
)),
2434 Fcons (make_number (ProtocolRevision (dpy
)),
2435 Fcons (make_number (VendorRelease (dpy
)), Qnil
)));
2438 DEFUN ("x-display-screens", Fx_display_screens
, Sx_display_screens
, 0, 1, 0,
2439 "Returns the number of screens on the X server FRAME is on.")
2444 return make_number (ScreenCount (x_current_display
));
2447 DEFUN ("x-display-mm-height", Fx_display_mm_height
, Sx_display_mm_height
, 0, 1, 0,
2448 "Returns the height in millimeters of the X screen FRAME is on.")
2453 return make_number (HeightMMOfScreen (x_screen
));
2456 DEFUN ("x-display-mm-width", Fx_display_mm_width
, Sx_display_mm_width
, 0, 1, 0,
2457 "Returns the width in millimeters of the X screen FRAME is on.")
2462 return make_number (WidthMMOfScreen (x_screen
));
2465 DEFUN ("x-display-backing-store", Fx_display_backing_store
,
2466 Sx_display_backing_store
, 0, 1, 0,
2467 "Returns an indication of whether the X screen FRAME is on does backing store.\n\
2468 The value may be `always', `when-mapped', or `not-useful'.")
2474 switch (DoesBackingStore (x_screen
))
2477 return intern ("always");
2480 return intern ("when-mapped");
2483 return intern ("not-useful");
2486 error ("Strange value for BackingStore parameter of screen");
2490 DEFUN ("x-display-visual-class", Fx_display_visual_class
,
2491 Sx_display_visual_class
, 0, 1, 0,
2492 "Returns the visual class of the display `screen' is on.\n\
2493 The value is one of the symbols `static-gray', `gray-scale',\n\
2494 `static-color', `pseudo-color', `true-color', or `direct-color'.")
2500 switch (screen_visual
->class)
2502 case StaticGray
: return (intern ("static-gray"));
2503 case GrayScale
: return (intern ("gray-scale"));
2504 case StaticColor
: return (intern ("static-color"));
2505 case PseudoColor
: return (intern ("pseudo-color"));
2506 case TrueColor
: return (intern ("true-color"));
2507 case DirectColor
: return (intern ("direct-color"));
2509 error ("Display has an unknown visual class");
2513 DEFUN ("x-display-save-under", Fx_display_save_under
,
2514 Sx_display_save_under
, 0, 1, 0,
2515 "Returns t if the X screen FRAME is on supports the save-under feature.")
2521 if (DoesSaveUnders (x_screen
) == True
)
2528 register struct frame
*f
;
2530 return PIXEL_WIDTH (f
);
2534 register struct frame
*f
;
2536 return PIXEL_HEIGHT (f
);
2540 register struct frame
*f
;
2542 return FONT_WIDTH (f
->display
.x
->font
);
2546 register struct frame
*f
;
2548 return FONT_HEIGHT (f
->display
.x
->font
);
2551 #if 0 /* These no longer seem like the right way to do things. */
2553 /* Draw a rectangle on the frame with left top corner including
2554 the character specified by LEFT_CHAR and TOP_CHAR. The rectangle is
2555 CHARS by LINES wide and long and is the color of the cursor. */
2558 x_rectangle (f
, gc
, left_char
, top_char
, chars
, lines
)
2559 register struct frame
*f
;
2561 register int top_char
, left_char
, chars
, lines
;
2565 int left
= (left_char
* FONT_WIDTH (f
->display
.x
->font
)
2566 + f
->display
.x
->internal_border_width
);
2567 int top
= (top_char
* FONT_HEIGHT (f
->display
.x
->font
)
2568 + f
->display
.x
->internal_border_width
);
2571 width
= FONT_WIDTH (f
->display
.x
->font
) / 2;
2573 width
= FONT_WIDTH (f
->display
.x
->font
) * chars
;
2575 height
= FONT_HEIGHT (f
->display
.x
->font
) / 2;
2577 height
= FONT_HEIGHT (f
->display
.x
->font
) * lines
;
2579 XDrawRectangle (x_current_display
, FRAME_X_WINDOW (f
),
2580 gc
, left
, top
, width
, height
);
2583 DEFUN ("x-draw-rectangle", Fx_draw_rectangle
, Sx_draw_rectangle
, 5, 5, 0,
2584 "Draw a rectangle on FRAME between coordinates specified by\n\
2585 numbers X0, Y0, X1, Y1 in the cursor pixel.")
2586 (frame
, X0
, Y0
, X1
, Y1
)
2587 register Lisp_Object frame
, X0
, X1
, Y0
, Y1
;
2589 register int x0
, y0
, x1
, y1
, top
, left
, n_chars
, n_lines
;
2591 CHECK_LIVE_FRAME (frame
, 0);
2592 CHECK_NUMBER (X0
, 0);
2593 CHECK_NUMBER (Y0
, 1);
2594 CHECK_NUMBER (X1
, 2);
2595 CHECK_NUMBER (Y1
, 3);
2605 n_lines
= y1
- y0
+ 1;
2610 n_lines
= y0
- y1
+ 1;
2616 n_chars
= x1
- x0
+ 1;
2621 n_chars
= x0
- x1
+ 1;
2625 x_rectangle (XFRAME (frame
), XFRAME (frame
)->display
.x
->cursor_gc
,
2626 left
, top
, n_chars
, n_lines
);
2632 DEFUN ("x-erase-rectangle", Fx_erase_rectangle
, Sx_erase_rectangle
, 5, 5, 0,
2633 "Draw a rectangle drawn on FRAME between coordinates\n\
2634 X0, Y0, X1, Y1 in the regular background-pixel.")
2635 (frame
, X0
, Y0
, X1
, Y1
)
2636 register Lisp_Object frame
, X0
, Y0
, X1
, Y1
;
2638 register int x0
, y0
, x1
, y1
, top
, left
, n_chars
, n_lines
;
2640 CHECK_FRAME (frame
, 0);
2641 CHECK_NUMBER (X0
, 0);
2642 CHECK_NUMBER (Y0
, 1);
2643 CHECK_NUMBER (X1
, 2);
2644 CHECK_NUMBER (Y1
, 3);
2654 n_lines
= y1
- y0
+ 1;
2659 n_lines
= y0
- y1
+ 1;
2665 n_chars
= x1
- x0
+ 1;
2670 n_chars
= x0
- x1
+ 1;
2674 x_rectangle (XFRAME (frame
), XFRAME (frame
)->display
.x
->reverse_gc
,
2675 left
, top
, n_chars
, n_lines
);
2681 /* Draw lines around the text region beginning at the character position
2682 TOP_X, TOP_Y and ending at BOTTOM_X and BOTTOM_Y. GC specifies the
2683 pixel and line characteristics. */
2685 #define line_len(line) (FRAME_CURRENT_GLYPHS (f)->used[(line)])
2688 outline_region (f
, gc
, top_x
, top_y
, bottom_x
, bottom_y
)
2689 register struct frame
*f
;
2691 int top_x
, top_y
, bottom_x
, bottom_y
;
2693 register int ibw
= f
->display
.x
->internal_border_width
;
2694 register int font_w
= FONT_WIDTH (f
->display
.x
->font
);
2695 register int font_h
= FONT_HEIGHT (f
->display
.x
->font
);
2697 int x
= line_len (y
);
2698 XPoint
*pixel_points
= (XPoint
*)
2699 alloca (((bottom_y
- top_y
+ 2) * 4) * sizeof (XPoint
));
2700 register XPoint
*this_point
= pixel_points
;
2702 /* Do the horizontal top line/lines */
2705 this_point
->x
= ibw
;
2706 this_point
->y
= ibw
+ (font_h
* top_y
);
2709 this_point
->x
= ibw
+ (font_w
/ 2); /* Half-size for newline chars. */
2711 this_point
->x
= ibw
+ (font_w
* x
);
2712 this_point
->y
= (this_point
- 1)->y
;
2716 this_point
->x
= ibw
;
2717 this_point
->y
= ibw
+ (font_h
* (top_y
+ 1));
2719 this_point
->x
= ibw
+ (font_w
* top_x
);
2720 this_point
->y
= (this_point
- 1)->y
;
2722 this_point
->x
= (this_point
- 1)->x
;
2723 this_point
->y
= ibw
+ (font_h
* top_y
);
2725 this_point
->x
= ibw
+ (font_w
* x
);
2726 this_point
->y
= (this_point
- 1)->y
;
2729 /* Now do the right side. */
2730 while (y
< bottom_y
)
2731 { /* Right vertical edge */
2733 this_point
->x
= (this_point
- 1)->x
;
2734 this_point
->y
= ibw
+ (font_h
* (y
+ 1));
2737 y
++; /* Horizontal connection to next line */
2740 this_point
->x
= ibw
+ (font_w
/ 2);
2742 this_point
->x
= ibw
+ (font_w
* x
);
2744 this_point
->y
= (this_point
- 1)->y
;
2747 /* Now do the bottom and connect to the top left point. */
2748 this_point
->x
= ibw
+ (font_w
* (bottom_x
+ 1));
2751 this_point
->x
= (this_point
- 1)->x
;
2752 this_point
->y
= ibw
+ (font_h
* (bottom_y
+ 1));
2754 this_point
->x
= ibw
;
2755 this_point
->y
= (this_point
- 1)->y
;
2757 this_point
->x
= pixel_points
->x
;
2758 this_point
->y
= pixel_points
->y
;
2760 XDrawLines (x_current_display
, FRAME_X_WINDOW (f
),
2762 (this_point
- pixel_points
+ 1), CoordModeOrigin
);
2765 DEFUN ("x-contour-region", Fx_contour_region
, Sx_contour_region
, 1, 1, 0,
2766 "Highlight the region between point and the character under the mouse\n\
2769 register Lisp_Object event
;
2771 register int x0
, y0
, x1
, y1
;
2772 register struct frame
*f
= selected_frame
;
2773 register int p1
, p2
;
2775 CHECK_CONS (event
, 0);
2778 x0
= XINT (Fcar (Fcar (event
)));
2779 y0
= XINT (Fcar (Fcdr (Fcar (event
))));
2781 /* If the mouse is past the end of the line, don't that area. */
2782 /* ReWrite this... */
2787 if (y1
> y0
) /* point below mouse */
2788 outline_region (f
, f
->display
.x
->cursor_gc
,
2790 else if (y1
< y0
) /* point above mouse */
2791 outline_region (f
, f
->display
.x
->cursor_gc
,
2793 else /* same line: draw horizontal rectangle */
2796 x_rectangle (f
, f
->display
.x
->cursor_gc
,
2797 x0
, y0
, (x1
- x0
+ 1), 1);
2799 x_rectangle (f
, f
->display
.x
->cursor_gc
,
2800 x1
, y1
, (x0
- x1
+ 1), 1);
2803 XFlush (x_current_display
);
2809 DEFUN ("x-uncontour-region", Fx_uncontour_region
, Sx_uncontour_region
, 1, 1, 0,
2810 "Erase any highlighting of the region between point and the character\n\
2811 at X, Y on the selected frame.")
2813 register Lisp_Object event
;
2815 register int x0
, y0
, x1
, y1
;
2816 register struct frame
*f
= selected_frame
;
2819 x0
= XINT (Fcar (Fcar (event
)));
2820 y0
= XINT (Fcar (Fcdr (Fcar (event
))));
2824 if (y1
> y0
) /* point below mouse */
2825 outline_region (f
, f
->display
.x
->reverse_gc
,
2827 else if (y1
< y0
) /* point above mouse */
2828 outline_region (f
, f
->display
.x
->reverse_gc
,
2830 else /* same line: draw horizontal rectangle */
2833 x_rectangle (f
, f
->display
.x
->reverse_gc
,
2834 x0
, y0
, (x1
- x0
+ 1), 1);
2836 x_rectangle (f
, f
->display
.x
->reverse_gc
,
2837 x1
, y1
, (x0
- x1
+ 1), 1);
2845 int contour_begin_x
, contour_begin_y
;
2846 int contour_end_x
, contour_end_y
;
2847 int contour_npoints
;
2849 /* Clip the top part of the contour lines down (and including) line Y_POS.
2850 If X_POS is in the middle (rather than at the end) of the line, drop
2851 down a line at that character. */
2854 clip_contour_top (y_pos
, x_pos
)
2856 register XPoint
*begin
= contour_lines
[y_pos
].top_left
;
2857 register XPoint
*end
;
2858 register int npoints
;
2859 register struct display_line
*line
= selected_frame
->phys_lines
[y_pos
+ 1];
2861 if (x_pos
>= line
->len
- 1) /* Draw one, straight horizontal line. */
2863 end
= contour_lines
[y_pos
].top_right
;
2864 npoints
= (end
- begin
+ 1);
2865 XDrawLines (x_current_display
, contour_window
,
2866 contour_erase_gc
, begin_erase
, npoints
, CoordModeOrigin
);
2868 bcopy (end
, begin
+ 1, contour_last_point
- end
+ 1);
2869 contour_last_point
-= (npoints
- 2);
2870 XDrawLines (x_current_display
, contour_window
,
2871 contour_erase_gc
, begin
, 2, CoordModeOrigin
);
2872 XFlush (x_current_display
);
2874 /* Now, update contour_lines structure. */
2879 register XPoint
*p
= begin
+ 1;
2880 end
= contour_lines
[y_pos
].bottom_right
;
2881 npoints
= (end
- begin
+ 1);
2882 XDrawLines (x_current_display
, contour_window
,
2883 contour_erase_gc
, begin_erase
, npoints
, CoordModeOrigin
);
2886 p
->x
= ibw
+ (font_w
* (x_pos
+ 1));
2888 p
->y
= begin
->y
+ font_h
;
2890 bcopy (end
, begin
+ 3, contour_last_point
- end
+ 1);
2891 contour_last_point
-= (npoints
- 5);
2892 XDrawLines (x_current_display
, contour_window
,
2893 contour_erase_gc
, begin
, 4, CoordModeOrigin
);
2894 XFlush (x_current_display
);
2896 /* Now, update contour_lines structure. */
2900 /* Erase the top horzontal lines of the contour, and then extend
2901 the contour upwards. */
2904 extend_contour_top (line
)
2909 clip_contour_bottom (x_pos
, y_pos
)
2915 extend_contour_bottom (x_pos
, y_pos
)
2919 DEFUN ("x-select-region", Fx_select_region
, Sx_select_region
, 1, 1, "e",
2924 register struct frame
*f
= selected_frame
;
2925 register int point_x
= f
->cursor_x
;
2926 register int point_y
= f
->cursor_y
;
2927 register int mouse_below_point
;
2928 register Lisp_Object obj
;
2929 register int x_contour_x
, x_contour_y
;
2931 x_contour_x
= x_mouse_x
;
2932 x_contour_y
= x_mouse_y
;
2933 if (x_contour_y
> point_y
|| (x_contour_y
== point_y
2934 && x_contour_x
> point_x
))
2936 mouse_below_point
= 1;
2937 outline_region (f
, f
->display
.x
->cursor_gc
, point_x
, point_y
,
2938 x_contour_x
, x_contour_y
);
2942 mouse_below_point
= 0;
2943 outline_region (f
, f
->display
.x
->cursor_gc
, x_contour_x
, x_contour_y
,
2949 obj
= read_char (-1, 0, 0, Qnil
, 0);
2950 if (XTYPE (obj
) != Lisp_Cons
)
2953 if (mouse_below_point
)
2955 if (x_mouse_y
<= point_y
) /* Flipped. */
2957 mouse_below_point
= 0;
2959 outline_region (f
, f
->display
.x
->reverse_gc
, point_x
, point_y
,
2960 x_contour_x
, x_contour_y
);
2961 outline_region (f
, f
->display
.x
->cursor_gc
, x_mouse_x
, x_mouse_y
,
2964 else if (x_mouse_y
< x_contour_y
) /* Bottom clipped. */
2966 clip_contour_bottom (x_mouse_y
);
2968 else if (x_mouse_y
> x_contour_y
) /* Bottom extended. */
2970 extend_bottom_contour (x_mouse_y
);
2973 x_contour_x
= x_mouse_x
;
2974 x_contour_y
= x_mouse_y
;
2976 else /* mouse above or same line as point */
2978 if (x_mouse_y
>= point_y
) /* Flipped. */
2980 mouse_below_point
= 1;
2982 outline_region (f
, f
->display
.x
->reverse_gc
,
2983 x_contour_x
, x_contour_y
, point_x
, point_y
);
2984 outline_region (f
, f
->display
.x
->cursor_gc
, point_x
, point_y
,
2985 x_mouse_x
, x_mouse_y
);
2987 else if (x_mouse_y
> x_contour_y
) /* Top clipped. */
2989 clip_contour_top (x_mouse_y
);
2991 else if (x_mouse_y
< x_contour_y
) /* Top extended. */
2993 extend_contour_top (x_mouse_y
);
2998 unread_command_event
= obj
;
2999 if (mouse_below_point
)
3001 contour_begin_x
= point_x
;
3002 contour_begin_y
= point_y
;
3003 contour_end_x
= x_contour_x
;
3004 contour_end_y
= x_contour_y
;
3008 contour_begin_x
= x_contour_x
;
3009 contour_begin_y
= x_contour_y
;
3010 contour_end_x
= point_x
;
3011 contour_end_y
= point_y
;
3016 DEFUN ("x-horizontal-line", Fx_horizontal_line
, Sx_horizontal_line
, 1, 1, "e",
3021 register Lisp_Object obj
;
3022 struct frame
*f
= selected_frame
;
3023 register struct window
*w
= XWINDOW (selected_window
);
3024 register GC line_gc
= f
->display
.x
->cursor_gc
;
3025 register GC erase_gc
= f
->display
.x
->reverse_gc
;
3027 char dash_list
[] = {6, 4, 6, 4};
3029 XGCValues gc_values
;
3031 register int previous_y
;
3032 register int line
= (x_mouse_y
+ 1) * FONT_HEIGHT (f
->display
.x
->font
)
3033 + f
->display
.x
->internal_border_width
;
3034 register int left
= f
->display
.x
->internal_border_width
3036 * FONT_WIDTH (f
->display
.x
->font
));
3037 register int right
= left
+ (w
->width
3038 * FONT_WIDTH (f
->display
.x
->font
))
3039 - f
->display
.x
->internal_border_width
;
3043 gc_values
.foreground
= f
->display
.x
->cursor_pixel
;
3044 gc_values
.background
= f
->display
.x
->background_pixel
;
3045 gc_values
.line_width
= 1;
3046 gc_values
.line_style
= LineOnOffDash
;
3047 gc_values
.cap_style
= CapRound
;
3048 gc_values
.join_style
= JoinRound
;
3050 line_gc
= XCreateGC (x_current_display
, FRAME_X_WINDOW (f
),
3051 GCLineStyle
| GCJoinStyle
| GCCapStyle
3052 | GCLineWidth
| GCForeground
| GCBackground
,
3054 XSetDashes (x_current_display
, line_gc
, 0, dash_list
, dashes
);
3055 gc_values
.foreground
= f
->display
.x
->background_pixel
;
3056 gc_values
.background
= f
->display
.x
->foreground_pixel
;
3057 erase_gc
= XCreateGC (x_current_display
, FRAME_X_WINDOW (f
),
3058 GCLineStyle
| GCJoinStyle
| GCCapStyle
3059 | GCLineWidth
| GCForeground
| GCBackground
,
3061 XSetDashes (x_current_display
, erase_gc
, 0, dash_list
, dashes
);
3067 if (x_mouse_y
>= XINT (w
->top
)
3068 && x_mouse_y
< XINT (w
->top
) + XINT (w
->height
) - 1)
3070 previous_y
= x_mouse_y
;
3071 line
= (x_mouse_y
+ 1) * FONT_HEIGHT (f
->display
.x
->font
)
3072 + f
->display
.x
->internal_border_width
;
3073 XDrawLine (x_current_display
, FRAME_X_WINDOW (f
),
3074 line_gc
, left
, line
, right
, line
);
3081 obj
= read_char (-1, 0, 0, Qnil
, 0);
3082 if ((XTYPE (obj
) != Lisp_Cons
)
3083 || (! EQ (Fcar (Fcdr (Fcdr (obj
))),
3084 Qvertical_scroll_bar
))
3088 XDrawLine (x_current_display
, FRAME_X_WINDOW (f
),
3089 erase_gc
, left
, line
, right
, line
);
3091 unread_command_event
= obj
;
3093 XFreeGC (x_current_display
, line_gc
);
3094 XFreeGC (x_current_display
, erase_gc
);
3099 while (x_mouse_y
== previous_y
);
3102 XDrawLine (x_current_display
, FRAME_X_WINDOW (f
),
3103 erase_gc
, left
, line
, right
, line
);
3109 /* Offset in buffer of character under the pointer, or 0. */
3110 int mouse_buffer_offset
;
3113 /* These keep track of the rectangle following the pointer. */
3114 int mouse_track_top
, mouse_track_left
, mouse_track_width
;
3116 DEFUN ("x-track-pointer", Fx_track_pointer
, Sx_track_pointer
, 0, 0, 0,
3117 "Track the pointer.")
3120 static Cursor current_pointer_shape
;
3121 FRAME_PTR f
= x_mouse_frame
;
3124 if (EQ (Vmouse_frame_part
, Qtext_part
)
3125 && (current_pointer_shape
!= f
->display
.x
->nontext_cursor
))
3130 current_pointer_shape
= f
->display
.x
->nontext_cursor
;
3131 XDefineCursor (x_current_display
,
3133 current_pointer_shape
);
3135 buf
= XBUFFER (XWINDOW (Vmouse_window
)->buffer
);
3136 c
= *(BUF_CHAR_ADDRESS (buf
, mouse_buffer_offset
));
3138 else if (EQ (Vmouse_frame_part
, Qmodeline_part
)
3139 && (current_pointer_shape
!= f
->display
.x
->modeline_cursor
))
3141 current_pointer_shape
= f
->display
.x
->modeline_cursor
;
3142 XDefineCursor (x_current_display
,
3144 current_pointer_shape
);
3153 DEFUN ("x-track-pointer", Fx_track_pointer
, Sx_track_pointer
, 1, 1, "e",
3154 "Draw rectangle around character under mouse pointer, if there is one.")
3158 struct window
*w
= XWINDOW (Vmouse_window
);
3159 struct frame
*f
= XFRAME (WINDOW_FRAME (w
));
3160 struct buffer
*b
= XBUFFER (w
->buffer
);
3163 if (! EQ (Vmouse_window
, selected_window
))
3166 if (EQ (event
, Qnil
))
3170 x_read_mouse_position (selected_frame
, &x
, &y
);
3174 mouse_track_width
= 0;
3175 mouse_track_left
= mouse_track_top
= -1;
3179 if ((x_mouse_x
!= mouse_track_left
3180 && (x_mouse_x
< mouse_track_left
3181 || x_mouse_x
> (mouse_track_left
+ mouse_track_width
)))
3182 || x_mouse_y
!= mouse_track_top
)
3184 int hp
= 0; /* Horizontal position */
3185 int len
= FRAME_CURRENT_GLYPHS (f
)->used
[x_mouse_y
];
3186 int p
= FRAME_CURRENT_GLYPHS (f
)->bufp
[x_mouse_y
];
3187 int tab_width
= XINT (b
->tab_width
);
3188 int ctl_arrow_p
= !NILP (b
->ctl_arrow
);
3190 int mode_line_vpos
= XFASTINT (w
->height
) + XFASTINT (w
->top
) - 1;
3191 int in_mode_line
= 0;
3193 if (! FRAME_CURRENT_GLYPHS (f
)->enable
[x_mouse_y
])
3196 /* Erase previous rectangle. */
3197 if (mouse_track_width
)
3199 x_rectangle (f
, f
->display
.x
->reverse_gc
,
3200 mouse_track_left
, mouse_track_top
,
3201 mouse_track_width
, 1);
3203 if ((mouse_track_left
== f
->phys_cursor_x
3204 || mouse_track_left
== f
->phys_cursor_x
- 1)
3205 && mouse_track_top
== f
->phys_cursor_y
)
3207 x_display_cursor (f
, 1);
3211 mouse_track_left
= x_mouse_x
;
3212 mouse_track_top
= x_mouse_y
;
3213 mouse_track_width
= 0;
3215 if (mouse_track_left
> len
) /* Past the end of line. */
3218 if (mouse_track_top
== mode_line_vpos
)
3224 if (tab_width
<= 0 || tab_width
> 20) tab_width
= 8;
3228 if (len
== f
->width
&& hp
== len
- 1 && c
!= '\n')
3234 mouse_track_width
= tab_width
- (hp
% tab_width
);
3236 hp
+= mouse_track_width
;
3239 mouse_track_left
= hp
- mouse_track_width
;
3245 mouse_track_width
= -1;
3249 if (ctl_arrow_p
&& (c
< 040 || c
== 0177))
3254 mouse_track_width
= 2;
3259 mouse_track_left
= hp
- mouse_track_width
;
3265 mouse_track_width
= 1;
3272 while (hp
<= x_mouse_x
);
3275 if (mouse_track_width
) /* Over text; use text pointer shape. */
3277 XDefineCursor (x_current_display
,
3279 f
->display
.x
->text_cursor
);
3280 x_rectangle (f
, f
->display
.x
->cursor_gc
,
3281 mouse_track_left
, mouse_track_top
,
3282 mouse_track_width
, 1);
3284 else if (in_mode_line
)
3285 XDefineCursor (x_current_display
,
3287 f
->display
.x
->modeline_cursor
);
3289 XDefineCursor (x_current_display
,
3291 f
->display
.x
->nontext_cursor
);
3294 XFlush (x_current_display
);
3297 obj
= read_char (-1, 0, 0, Qnil
, 0);
3300 while (XTYPE (obj
) == Lisp_Cons
/* Mouse event */
3301 && EQ (Fcar (Fcdr (Fcdr (obj
))), Qnil
) /* Not scroll bar */
3302 && EQ (Vmouse_depressed
, Qnil
) /* Only motion events */
3303 && EQ (Vmouse_window
, selected_window
) /* In this window */
3306 unread_command_event
= obj
;
3308 if (mouse_track_width
)
3310 x_rectangle (f
, f
->display
.x
->reverse_gc
,
3311 mouse_track_left
, mouse_track_top
,
3312 mouse_track_width
, 1);
3313 mouse_track_width
= 0;
3314 if ((mouse_track_left
== f
->phys_cursor_x
3315 || mouse_track_left
- 1 == f
->phys_cursor_x
)
3316 && mouse_track_top
== f
->phys_cursor_y
)
3318 x_display_cursor (f
, 1);
3321 XDefineCursor (x_current_display
,
3323 f
->display
.x
->nontext_cursor
);
3324 XFlush (x_current_display
);
3334 /* Draw a pixmap specified by IMAGE_DATA of dimensions WIDTH and HEIGHT
3335 on the frame F at position X, Y. */
3337 x_draw_pixmap (f
, x
, y
, image_data
, width
, height
)
3339 int x
, y
, width
, height
;
3344 image
= XCreateBitmapFromData (x_current_display
,
3345 FRAME_X_WINDOW (f
), image_data
,
3347 XCopyPlane (x_current_display
, image
, FRAME_X_WINDOW (f
),
3348 f
->display
.x
->normal_gc
, 0, 0, width
, height
, x
, y
);
3353 DEFUN ("x-store-cut-buffer", Fx_store_cut_buffer
, Sx_store_cut_buffer
,
3354 1, 1, "sStore text in cut buffer: ",
3355 "Store contents of STRING into the cut buffer of the X window system.")
3357 register Lisp_Object string
;
3361 CHECK_STRING (string
, 1);
3362 if (! FRAME_X_P (selected_frame
))
3363 error ("Selected frame does not understand X protocol.");
3366 XStoreBytes ((char *) XSTRING (string
)->data
, XSTRING (string
)->size
);
3372 DEFUN ("x-get-cut-buffer", Fx_get_cut_buffer
, Sx_get_cut_buffer
, 0, 0, 0,
3373 "Return contents of cut buffer of the X window system, as a string.")
3377 register Lisp_Object string
;
3382 d
= XFetchBytes (&len
);
3383 string
= make_string (d
, len
);
3391 DEFUN ("x-rebind-key", Fx_rebind_key
, Sx_rebind_key
, 3, 3, 0,
3392 "Rebind X keysym KEYSYM, with MODIFIERS, to generate NEWSTRING.\n\
3393 KEYSYM is a string which conforms to the X keysym definitions found\n\
3394 in X11/keysymdef.h, sans the initial XK_. MODIFIERS is nil or a\n\
3395 list of strings specifying modifier keys such as Control_L, which must\n\
3396 also be depressed for NEWSTRING to appear.")
3397 (x_keysym
, modifiers
, newstring
)
3398 register Lisp_Object x_keysym
;
3399 register Lisp_Object modifiers
;
3400 register Lisp_Object newstring
;
3403 register KeySym keysym
;
3404 KeySym modifier_list
[16];
3407 CHECK_STRING (x_keysym
, 1);
3408 CHECK_STRING (newstring
, 3);
3410 keysym
= XStringToKeysym ((char *) XSTRING (x_keysym
)->data
);
3411 if (keysym
== NoSymbol
)
3412 error ("Keysym does not exist");
3414 if (NILP (modifiers
))
3415 XRebindKeysym (x_current_display
, keysym
, modifier_list
, 0,
3416 XSTRING (newstring
)->data
, XSTRING (newstring
)->size
);
3419 register Lisp_Object rest
, mod
;
3422 for (rest
= modifiers
; !NILP (rest
); rest
= Fcdr (rest
))
3425 error ("Can't have more than 16 modifiers");
3428 CHECK_STRING (mod
, 3);
3429 modifier_list
[i
] = XStringToKeysym ((char *) XSTRING (mod
)->data
);
3430 if (modifier_list
[i
] == NoSymbol
3431 || !IsModifierKey (modifier_list
[i
]))
3432 error ("Element is not a modifier keysym");
3436 XRebindKeysym (x_current_display
, keysym
, modifier_list
, i
,
3437 XSTRING (newstring
)->data
, XSTRING (newstring
)->size
);
3443 DEFUN ("x-rebind-keys", Fx_rebind_keys
, Sx_rebind_keys
, 2, 2, 0,
3444 "Rebind KEYCODE to list of strings STRINGS.\n\
3445 STRINGS should be a list of 16 elements, one for each shift combination.\n\
3446 nil as element means don't change.\n\
3447 See the documentation of `x-rebind-key' for more information.")
3449 register Lisp_Object keycode
;
3450 register Lisp_Object strings
;
3452 register Lisp_Object item
;
3453 register unsigned char *rawstring
;
3454 KeySym rawkey
, modifier
[1];
3456 register unsigned i
;
3459 CHECK_NUMBER (keycode
, 1);
3460 CHECK_CONS (strings
, 2);
3461 rawkey
= (KeySym
) ((unsigned) (XINT (keycode
))) & 255;
3462 for (i
= 0; i
<= 15; strings
= Fcdr (strings
), i
++)
3464 item
= Fcar (strings
);
3467 CHECK_STRING (item
, 2);
3468 strsize
= XSTRING (item
)->size
;
3469 rawstring
= (unsigned char *) xmalloc (strsize
);
3470 bcopy (XSTRING (item
)->data
, rawstring
, strsize
);
3471 modifier
[1] = 1 << i
;
3472 XRebindKeysym (x_current_display
, rawkey
, modifier
, 1,
3473 rawstring
, strsize
);
3479 DEFUN ("x-rebind-key", Fx_rebind_key
, Sx_rebind_key
, 3, 3, 0,
3480 "Rebind KEYCODE, with shift bits SHIFT-MASK, to new string NEWSTRING.\n\
3481 KEYCODE and SHIFT-MASK should be numbers representing the X keyboard code\n\
3482 and shift mask respectively. NEWSTRING is an arbitrary string of keystrokes.\n\
3483 If SHIFT-MASK is nil, then KEYCODE's key will be bound to NEWSTRING for\n\
3484 all shift combinations.\n\
3485 Shift Lock 1 Shift 2\n\
3488 For values of KEYCODE, see /usr/lib/Xkeymap.txt (remember that the codes\n\
3489 in that file are in octal!)\n\
3491 NOTE: due to an X bug, this function will not take effect unless one has\n\
3492 a `~/.Xkeymap' file. (See the documentation for the `keycomp' program.)\n\
3493 This problem will be fixed in X version 11.")
3495 (keycode
, shift_mask
, newstring
)
3496 register Lisp_Object keycode
;
3497 register Lisp_Object shift_mask
;
3498 register Lisp_Object newstring
;
3501 int keysym
, rawshift
;
3504 CHECK_NUMBER (keycode
, 1);
3505 if (!NILP (shift_mask
))
3506 CHECK_NUMBER (shift_mask
, 2);
3507 CHECK_STRING (newstring
, 3);
3508 strsize
= XSTRING (newstring
)->size
;
3509 rawstring
= (char *) xmalloc (strsize
);
3510 bcopy (XSTRING (newstring
)->data
, rawstring
, strsize
);
3512 keysym
= ((unsigned) (XINT (keycode
))) & 255;
3514 if (NILP (shift_mask
))
3516 for (i
= 0; i
<= 15; i
++)
3517 XRebindCode (keysym
, i
<<11, rawstring
, strsize
);
3521 rawshift
= (((unsigned) (XINT (shift_mask
))) & 15) << 11;
3522 XRebindCode (keysym
, rawshift
, rawstring
, strsize
);
3527 DEFUN ("x-rebind-keys", Fx_rebind_keys
, Sx_rebind_keys
, 2, 2, 0,
3528 "Rebind KEYCODE to list of strings STRINGS.\n\
3529 STRINGS should be a list of 16 elements, one for each shift combination.\n\
3530 nil as element means don't change.\n\
3531 See the documentation of `x-rebind-key' for more information.")
3533 register Lisp_Object keycode
;
3534 register Lisp_Object strings
;
3536 register Lisp_Object item
;
3537 register char *rawstring
;
3538 KeySym rawkey
, modifier
[1];
3540 register unsigned i
;
3542 CHECK_NUMBER (keycode
, 1);
3543 CHECK_CONS (strings
, 2);
3544 rawkey
= (KeySym
) ((unsigned) (XINT (keycode
))) & 255;
3545 for (i
= 0; i
<= 15; strings
= Fcdr (strings
), i
++)
3547 item
= Fcar (strings
);
3550 CHECK_STRING (item
, 2);
3551 strsize
= XSTRING (item
)->size
;
3552 rawstring
= (char *) xmalloc (strsize
);
3553 bcopy (XSTRING (item
)->data
, rawstring
, strsize
);
3554 XRebindCode (rawkey
, i
<< 11, rawstring
, strsize
);
3559 #endif /* not HAVE_X11 */
3563 select_visual (screen
, depth
)
3565 unsigned int *depth
;
3568 XVisualInfo
*vinfo
, vinfo_template
;
3571 v
= DefaultVisualOfScreen (screen
);
3574 vinfo_template
.visualid
= XVisualIDFromVisual (v
);
3576 vinfo_template
.visualid
= v
->visualid
;
3579 vinfo
= XGetVisualInfo (x_current_display
, VisualIDMask
, &vinfo_template
,
3582 fatal ("Can't get proper X visual info");
3584 if ((1 << vinfo
->depth
) == vinfo
->colormap_size
)
3585 *depth
= vinfo
->depth
;
3589 int n
= vinfo
->colormap_size
- 1;
3598 XFree ((char *) vinfo
);
3601 #endif /* HAVE_X11 */
3603 DEFUN ("x-open-connection", Fx_open_connection
, Sx_open_connection
,
3604 1, 2, 0, "Open a connection to an X server.\n\
3605 DISPLAY is the name of the display to connect to. Optional second\n\
3606 arg XRM_STRING is a string of resources in xrdb format.")
3607 (display
, xrm_string
)
3608 Lisp_Object display
, xrm_string
;
3610 unsigned int n_planes
;
3611 unsigned char *xrm_option
;
3613 CHECK_STRING (display
, 0);
3614 if (x_current_display
!= 0)
3615 error ("X server connection is already initialized");
3617 /* This is what opens the connection and sets x_current_display.
3618 This also initializes many symbols, such as those used for input. */
3619 x_term_init (XSTRING (display
)->data
);
3622 XFASTINT (Vwindow_system_version
) = 11;
3624 if (!EQ (xrm_string
, Qnil
))
3626 CHECK_STRING (xrm_string
, 1);
3627 xrm_option
= (unsigned char *) XSTRING (xrm_string
);
3630 xrm_option
= (unsigned char *) 0;
3631 xrdb
= x_load_resources (x_current_display
, xrm_option
, EMACS_CLASS
);
3633 XrmSetDatabase (x_current_display
, xrdb
);
3635 x_current_display
->db
= xrdb
;
3638 x_screen
= DefaultScreenOfDisplay (x_current_display
);
3640 screen_visual
= select_visual (x_screen
, &n_planes
);
3641 x_screen_planes
= n_planes
;
3642 x_screen_height
= HeightOfScreen (x_screen
);
3643 x_screen_width
= WidthOfScreen (x_screen
);
3645 /* X Atoms used by emacs. */
3646 Xatoms_of_xselect ();
3648 Xatom_wm_protocols
= XInternAtom (x_current_display
, "WM_PROTOCOLS",
3650 Xatom_wm_take_focus
= XInternAtom (x_current_display
, "WM_TAKE_FOCUS",
3652 Xatom_wm_save_yourself
= XInternAtom (x_current_display
, "WM_SAVE_YOURSELF",
3654 Xatom_wm_delete_window
= XInternAtom (x_current_display
, "WM_DELETE_WINDOW",
3656 Xatom_wm_change_state
= XInternAtom (x_current_display
, "WM_CHANGE_STATE",
3658 Xatom_wm_configure_denied
= XInternAtom (x_current_display
,
3659 "WM_CONFIGURE_DENIED", False
);
3660 Xatom_wm_window_moved
= XInternAtom (x_current_display
, "WM_MOVED",
3663 #else /* not HAVE_X11 */
3664 XFASTINT (Vwindow_system_version
) = 10;
3665 #endif /* not HAVE_X11 */
3669 DEFUN ("x-close-current-connection", Fx_close_current_connection
,
3670 Sx_close_current_connection
,
3671 0, 0, 0, "Close the connection to the current X server.")
3675 /* This is ONLY used when killing emacs; For switching displays
3676 we'll have to take care of setting CloseDownMode elsewhere. */
3678 if (x_current_display
)
3681 XSetCloseDownMode (x_current_display
, DestroyAll
);
3682 XCloseDisplay (x_current_display
);
3685 fatal ("No current X display connection to close\n");
3690 DEFUN ("x-synchronize", Fx_synchronize
, Sx_synchronize
,
3691 1, 1, 0, "If ON is non-nil, report X errors as soon as the erring request is made.\n\
3692 If ON is nil, allow buffering of requests.\n\
3693 Turning on synchronization prohibits the Xlib routines from buffering\n\
3694 requests and seriously degrades performance, but makes debugging much\n\
3701 XSynchronize (x_current_display
, !EQ (on
, Qnil
));
3709 /* This is zero if not using X windows. */
3710 x_current_display
= 0;
3712 /* The section below is built by the lisp expression at the top of the file,
3713 just above where these variables are declared. */
3714 /*&&& init symbols here &&&*/
3715 Qauto_raise
= intern ("auto-raise");
3716 staticpro (&Qauto_raise
);
3717 Qauto_lower
= intern ("auto-lower");
3718 staticpro (&Qauto_lower
);
3719 Qbackground_color
= intern ("background-color");
3720 staticpro (&Qbackground_color
);
3721 Qbar
= intern ("bar");
3723 Qborder_color
= intern ("border-color");
3724 staticpro (&Qborder_color
);
3725 Qborder_width
= intern ("border-width");
3726 staticpro (&Qborder_width
);
3727 Qbox
= intern ("box");
3729 Qcursor_color
= intern ("cursor-color");
3730 staticpro (&Qcursor_color
);
3731 Qcursor_type
= intern ("cursor-type");
3732 staticpro (&Qcursor_type
);
3733 Qfont
= intern ("font");
3735 Qforeground_color
= intern ("foreground-color");
3736 staticpro (&Qforeground_color
);
3737 Qgeometry
= intern ("geometry");
3738 staticpro (&Qgeometry
);
3739 Qicon
= intern ("icon");
3741 Qicon_left
= intern ("icon-left");
3742 staticpro (&Qicon_left
);
3743 Qicon_top
= intern ("icon-top");
3744 staticpro (&Qicon_top
);
3745 Qicon_type
= intern ("icon-type");
3746 staticpro (&Qicon_type
);
3747 Qinternal_border_width
= intern ("internal-border-width");
3748 staticpro (&Qinternal_border_width
);
3749 Qleft
= intern ("left");
3751 Qmouse_color
= intern ("mouse-color");
3752 staticpro (&Qmouse_color
);
3753 Qnone
= intern ("none");
3755 Qparent_id
= intern ("parent-id");
3756 staticpro (&Qparent_id
);
3757 Qsuppress_icon
= intern ("suppress-icon");
3758 staticpro (&Qsuppress_icon
);
3759 Qtop
= intern ("top");
3761 Qundefined_color
= intern ("undefined-color");
3762 staticpro (&Qundefined_color
);
3763 Qvertical_scroll_bars
= intern ("vertical-scroll-bars");
3764 staticpro (&Qvertical_scroll_bars
);
3765 Qvisibility
= intern ("visibility");
3766 staticpro (&Qvisibility
);
3767 Qwindow_id
= intern ("window-id");
3768 staticpro (&Qwindow_id
);
3769 Qx_frame_parameter
= intern ("x-frame-parameter");
3770 staticpro (&Qx_frame_parameter
);
3771 /* This is the end of symbol initialization. */
3773 Fput (Qundefined_color
, Qerror_conditions
,
3774 Fcons (Qundefined_color
, Fcons (Qerror
, Qnil
)));
3775 Fput (Qundefined_color
, Qerror_message
,
3776 build_string ("Undefined color"));
3778 init_x_parm_symbols ();
3780 DEFVAR_INT ("mouse-buffer-offset", &mouse_buffer_offset
,
3781 "The buffer offset of the character under the pointer.");
3782 mouse_buffer_offset
= 0;
3784 DEFVAR_INT ("x-pointer-shape", &Vx_pointer_shape
,
3785 "The shape of the pointer when over text.\n\
3786 Changing the value does not affect existing frames\n\
3787 unless you set the mouse color.");
3788 Vx_pointer_shape
= Qnil
;
3791 DEFVAR_INT ("x-nontext-pointer-shape", &Vx_nontext_pointer_shape
,
3792 "The shape of the pointer when not over text.");
3794 Vx_nontext_pointer_shape
= Qnil
;
3797 DEFVAR_INT ("x-mode-pointer-shape", &Vx_mode_pointer_shape
,
3798 "The shape of the pointer when over the mode line.");
3800 Vx_mode_pointer_shape
= Qnil
;
3802 DEFVAR_LISP ("x-cursor-fore-pixel", &Vx_cursor_fore_pixel
,
3803 "A string indicating the foreground color of the cursor box.");
3804 Vx_cursor_fore_pixel
= Qnil
;
3806 DEFVAR_LISP ("mouse-grabbed", &Vmouse_depressed
,
3807 "Non-nil if a mouse button is currently depressed.");
3808 Vmouse_depressed
= Qnil
;
3810 DEFVAR_LISP ("x-no-window-manager", &Vx_no_window_manager
,
3811 "t if no X window manager is in use.");
3814 defsubr (&Sx_get_resource
);
3816 defsubr (&Sx_draw_rectangle
);
3817 defsubr (&Sx_erase_rectangle
);
3818 defsubr (&Sx_contour_region
);
3819 defsubr (&Sx_uncontour_region
);
3821 defsubr (&Sx_display_color_p
);
3822 defsubr (&Sx_color_defined_p
);
3823 defsubr (&Sx_server_vendor
);
3824 defsubr (&Sx_server_version
);
3825 defsubr (&Sx_display_pixel_width
);
3826 defsubr (&Sx_display_pixel_height
);
3827 defsubr (&Sx_display_mm_width
);
3828 defsubr (&Sx_display_mm_height
);
3829 defsubr (&Sx_display_screens
);
3830 defsubr (&Sx_display_planes
);
3831 defsubr (&Sx_display_color_cells
);
3832 defsubr (&Sx_display_visual_class
);
3833 defsubr (&Sx_display_backing_store
);
3834 defsubr (&Sx_display_save_under
);
3836 defsubr (&Sx_track_pointer
);
3837 defsubr (&Sx_grab_pointer
);
3838 defsubr (&Sx_ungrab_pointer
);
3841 defsubr (&Sx_get_default
);
3842 defsubr (&Sx_store_cut_buffer
);
3843 defsubr (&Sx_get_cut_buffer
);
3844 defsubr (&Sx_set_face
);
3846 defsubr (&Sx_parse_geometry
);
3847 defsubr (&Sx_create_frame
);
3848 defsubr (&Sfocus_frame
);
3849 defsubr (&Sunfocus_frame
);
3851 defsubr (&Sx_horizontal_line
);
3853 defsubr (&Sx_rebind_key
);
3854 defsubr (&Sx_rebind_keys
);
3855 defsubr (&Sx_open_connection
);
3856 defsubr (&Sx_close_current_connection
);
3857 defsubr (&Sx_synchronize
);
3860 #endif /* HAVE_X_WINDOWS */