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 /* Return the Emacs frame-object corresponding to an X window.
199 It could be the frame's main window or an icon window. */
201 /* This function can be called during GC, so use XGCTYPE. */
204 x_window_to_frame (wdesc
)
207 Lisp_Object tail
, frame
;
210 for (tail
= Vframe_list
; XGCTYPE (tail
) == Lisp_Cons
;
211 tail
= XCONS (tail
)->cdr
)
213 frame
= XCONS (tail
)->car
;
214 if (XGCTYPE (frame
) != Lisp_Frame
)
217 if (FRAME_X_WINDOW (f
) == wdesc
218 || f
->display
.x
->icon_desc
== wdesc
)
225 /* Connect the frame-parameter names for X frames
226 to the ways of passing the parameter values to the window system.
228 The name of a parameter, as a Lisp symbol,
229 has an `x-frame-parameter' property which is an integer in Lisp
230 but can be interpreted as an `enum x_frame_parm' in C. */
234 X_PARM_FOREGROUND_COLOR
,
235 X_PARM_BACKGROUND_COLOR
,
242 X_PARM_INTERNAL_BORDER_WIDTH
,
246 X_PARM_VERT_SCROLL_BAR
,
248 X_PARM_MENU_BAR_LINES
252 struct x_frame_parm_table
255 void (*setter
)( /* struct frame *frame, Lisp_Object val, oldval */ );
258 void x_set_foreground_color ();
259 void x_set_background_color ();
260 void x_set_mouse_color ();
261 void x_set_cursor_color ();
262 void x_set_border_color ();
263 void x_set_cursor_type ();
264 void x_set_icon_type ();
266 void x_set_border_width ();
267 void x_set_internal_border_width ();
268 void x_explicitly_set_name ();
269 void x_set_autoraise ();
270 void x_set_autolower ();
271 void x_set_vertical_scroll_bars ();
272 void x_set_visibility ();
273 void x_set_menu_bar_lines ();
275 static struct x_frame_parm_table x_frame_parms
[] =
277 "foreground-color", x_set_foreground_color
,
278 "background-color", x_set_background_color
,
279 "mouse-color", x_set_mouse_color
,
280 "cursor-color", x_set_cursor_color
,
281 "border-color", x_set_border_color
,
282 "cursor-type", x_set_cursor_type
,
283 "icon-type", x_set_icon_type
,
285 "border-width", x_set_border_width
,
286 "internal-border-width", x_set_internal_border_width
,
287 "name", x_explicitly_set_name
,
288 "auto-raise", x_set_autoraise
,
289 "auto-lower", x_set_autolower
,
290 "vertical-scroll-bars", x_set_vertical_scroll_bars
,
291 "visibility", x_set_visibility
,
292 "menu-bar-lines", x_set_menu_bar_lines
,
295 /* Attach the `x-frame-parameter' properties to
296 the Lisp symbol names of parameters relevant to X. */
298 init_x_parm_symbols ()
302 for (i
= 0; i
< sizeof (x_frame_parms
) / sizeof (x_frame_parms
[0]); i
++)
303 Fput (intern (x_frame_parms
[i
].name
), Qx_frame_parameter
,
307 /* Change the parameters of FRAME as specified by ALIST.
308 If a parameter is not specially recognized, do nothing;
309 otherwise call the `x_set_...' function for that parameter. */
312 x_set_frame_parameters (f
, alist
)
318 /* If both of these parameters are present, it's more efficient to
319 set them both at once. So we wait until we've looked at the
320 entire list before we set them. */
321 Lisp_Object width
, height
;
324 Lisp_Object left
, top
;
326 XSET (width
, Lisp_Int
, FRAME_WIDTH (f
));
327 XSET (height
, Lisp_Int
, FRAME_HEIGHT (f
));
329 XSET (top
, Lisp_Int
, f
->display
.x
->top_pos
);
330 XSET (left
, Lisp_Int
, f
->display
.x
->left_pos
);
332 for (tail
= alist
; CONSP (tail
); tail
= Fcdr (tail
))
334 Lisp_Object elt
, prop
, val
;
340 if (EQ (prop
, Qwidth
))
342 else if (EQ (prop
, Qheight
))
344 else if (EQ (prop
, Qtop
))
346 else if (EQ (prop
, Qleft
))
350 register Lisp_Object tem
;
351 tem
= Fget (prop
, Qx_frame_parameter
);
352 if (XTYPE (tem
) == Lisp_Int
354 && XINT (tem
) < sizeof (x_frame_parms
)/sizeof (x_frame_parms
[0]))
355 (*x_frame_parms
[XINT (tem
)].setter
)(f
, val
,
356 get_frame_param (f
, prop
));
357 store_frame_param (f
, prop
, val
);
361 /* Don't call these unless they've changed; the window may not actually
366 XSET (frame
, Lisp_Frame
, f
);
367 if (XINT (width
) != FRAME_WIDTH (f
)
368 || XINT (height
) != FRAME_HEIGHT (f
))
369 Fset_frame_size (frame
, width
, height
);
370 if (XINT (left
) != f
->display
.x
->left_pos
371 || XINT (top
) != f
->display
.x
->top_pos
)
372 Fset_frame_position (frame
, left
, top
);
376 /* Insert a description of internally-recorded parameters of frame X
377 into the parameter alist *ALISTPTR that is to be given to the user.
378 Only parameters that are specific to the X window system
379 and whose values are not correctly recorded in the frame's
380 param_alist need to be considered here. */
382 x_report_frame_params (f
, alistptr
)
384 Lisp_Object
*alistptr
;
388 store_in_alist (alistptr
, Qleft
, make_number (f
->display
.x
->left_pos
));
389 store_in_alist (alistptr
, Qtop
, make_number (f
->display
.x
->top_pos
));
390 store_in_alist (alistptr
, Qborder_width
,
391 make_number (f
->display
.x
->border_width
));
392 store_in_alist (alistptr
, Qinternal_border_width
,
393 make_number (f
->display
.x
->internal_border_width
));
394 sprintf (buf
, "%d", FRAME_X_WINDOW (f
));
395 store_in_alist (alistptr
, Qwindow_id
,
397 store_in_alist (alistptr
, Qvisibility
,
398 (FRAME_VISIBLE_P (f
) ? Qt
399 : FRAME_ICONIFIED_P (f
) ? Qicon
: Qnil
));
402 /* Decide if color named COLOR is valid for the display
403 associated with the selected frame. */
405 defined_color (color
, color_def
)
410 Colormap screen_colormap
;
415 = DefaultColormap (x_current_display
, XDefaultScreen (x_current_display
));
417 foo
= XParseColor (x_current_display
, screen_colormap
,
419 && XAllocColor (x_current_display
, screen_colormap
, color_def
);
421 foo
= XParseColor (color
, color_def
) && XGetHardwareColor (color_def
);
422 #endif /* not HAVE_X11 */
431 /* Given a string ARG naming a color, compute a pixel value from it
432 suitable for screen F.
433 If F is not a color screen, return DEF (default) regardless of what
437 x_decode_color (arg
, def
)
443 CHECK_STRING (arg
, 0);
445 if (strcmp (XSTRING (arg
)->data
, "black") == 0)
446 return BLACK_PIX_DEFAULT
;
447 else if (strcmp (XSTRING (arg
)->data
, "white") == 0)
448 return WHITE_PIX_DEFAULT
;
451 if (x_screen_planes
== 1)
454 if (DISPLAY_CELLS
== 1)
458 if (defined_color (XSTRING (arg
)->data
, &cdef
))
461 Fsignal (Qundefined_color
, Fcons (arg
, Qnil
));
464 /* Functions called only from `x_set_frame_param'
465 to set individual parameters.
467 If FRAME_X_WINDOW (f) is 0,
468 the frame is being created and its X-window does not exist yet.
469 In that case, just record the parameter's new value
470 in the standard place; do not attempt to change the window. */
473 x_set_foreground_color (f
, arg
, oldval
)
475 Lisp_Object arg
, oldval
;
477 f
->display
.x
->foreground_pixel
= x_decode_color (arg
, BLACK_PIX_DEFAULT
);
478 if (FRAME_X_WINDOW (f
) != 0)
482 XSetForeground (x_current_display
, f
->display
.x
->normal_gc
,
483 f
->display
.x
->foreground_pixel
);
484 XSetBackground (x_current_display
, f
->display
.x
->reverse_gc
,
485 f
->display
.x
->foreground_pixel
);
487 #endif /* HAVE_X11 */
488 if (FRAME_VISIBLE_P (f
))
494 x_set_background_color (f
, arg
, oldval
)
496 Lisp_Object arg
, oldval
;
501 f
->display
.x
->background_pixel
= x_decode_color (arg
, WHITE_PIX_DEFAULT
);
503 if (FRAME_X_WINDOW (f
) != 0)
507 /* The main frame area. */
508 XSetBackground (x_current_display
, f
->display
.x
->normal_gc
,
509 f
->display
.x
->background_pixel
);
510 XSetForeground (x_current_display
, f
->display
.x
->reverse_gc
,
511 f
->display
.x
->background_pixel
);
512 XSetWindowBackground (x_current_display
, FRAME_X_WINDOW (f
),
513 f
->display
.x
->background_pixel
);
516 temp
= XMakeTile (f
->display
.x
->background_pixel
);
517 XChangeBackground (FRAME_X_WINDOW (f
), temp
);
519 #endif /* not HAVE_X11 */
522 if (FRAME_VISIBLE_P (f
))
528 x_set_mouse_color (f
, arg
, oldval
)
530 Lisp_Object arg
, oldval
;
532 Cursor cursor
, nontext_cursor
, mode_cursor
;
536 f
->display
.x
->mouse_pixel
= x_decode_color (arg
, BLACK_PIX_DEFAULT
);
537 mask_color
= f
->display
.x
->background_pixel
;
538 /* No invisible pointers. */
539 if (mask_color
== f
->display
.x
->mouse_pixel
540 && mask_color
== f
->display
.x
->background_pixel
)
541 f
->display
.x
->mouse_pixel
= f
->display
.x
->foreground_pixel
;
546 /* It's not okay to crash if the user selects a screwey cursor. */
549 if (!EQ (Qnil
, Vx_pointer_shape
))
551 CHECK_NUMBER (Vx_pointer_shape
, 0);
552 cursor
= XCreateFontCursor (x_current_display
, XINT (Vx_pointer_shape
));
555 cursor
= XCreateFontCursor (x_current_display
, XC_xterm
);
556 x_check_errors ("bad text pointer cursor: %s");
558 if (!EQ (Qnil
, Vx_nontext_pointer_shape
))
560 CHECK_NUMBER (Vx_nontext_pointer_shape
, 0);
561 nontext_cursor
= XCreateFontCursor (x_current_display
,
562 XINT (Vx_nontext_pointer_shape
));
565 nontext_cursor
= XCreateFontCursor (x_current_display
, XC_left_ptr
);
566 x_check_errors ("bad nontext pointer cursor: %s");
568 if (!EQ (Qnil
, Vx_mode_pointer_shape
))
570 CHECK_NUMBER (Vx_mode_pointer_shape
, 0);
571 mode_cursor
= XCreateFontCursor (x_current_display
,
572 XINT (Vx_mode_pointer_shape
));
575 mode_cursor
= XCreateFontCursor (x_current_display
, XC_xterm
);
577 /* Check and report errors with the above calls. */
578 x_check_errors ("can't set cursor shape: %s");
582 XColor fore_color
, back_color
;
584 fore_color
.pixel
= f
->display
.x
->mouse_pixel
;
585 back_color
.pixel
= mask_color
;
586 XQueryColor (x_current_display
,
587 DefaultColormap (x_current_display
,
588 DefaultScreen (x_current_display
)),
590 XQueryColor (x_current_display
,
591 DefaultColormap (x_current_display
,
592 DefaultScreen (x_current_display
)),
594 XRecolorCursor (x_current_display
, cursor
,
595 &fore_color
, &back_color
);
596 XRecolorCursor (x_current_display
, nontext_cursor
,
597 &fore_color
, &back_color
);
598 XRecolorCursor (x_current_display
, mode_cursor
,
599 &fore_color
, &back_color
);
602 cursor
= XCreateCursor (16, 16, MouseCursor
, MouseMask
,
604 f
->display
.x
->mouse_pixel
,
605 f
->display
.x
->background_pixel
,
609 if (FRAME_X_WINDOW (f
) != 0)
611 XDefineCursor (XDISPLAY
FRAME_X_WINDOW (f
), cursor
);
614 if (cursor
!= f
->display
.x
->text_cursor
&& f
->display
.x
->text_cursor
!= 0)
615 XFreeCursor (XDISPLAY f
->display
.x
->text_cursor
);
616 f
->display
.x
->text_cursor
= cursor
;
618 if (nontext_cursor
!= f
->display
.x
->nontext_cursor
619 && f
->display
.x
->nontext_cursor
!= 0)
620 XFreeCursor (XDISPLAY f
->display
.x
->nontext_cursor
);
621 f
->display
.x
->nontext_cursor
= nontext_cursor
;
623 if (mode_cursor
!= f
->display
.x
->modeline_cursor
624 && f
->display
.x
->modeline_cursor
!= 0)
625 XFreeCursor (XDISPLAY f
->display
.x
->modeline_cursor
);
626 f
->display
.x
->modeline_cursor
= mode_cursor
;
627 #endif /* HAVE_X11 */
634 x_set_cursor_color (f
, arg
, oldval
)
636 Lisp_Object arg
, oldval
;
638 unsigned long fore_pixel
;
640 if (!EQ (Vx_cursor_fore_pixel
, Qnil
))
641 fore_pixel
= x_decode_color (Vx_cursor_fore_pixel
, WHITE_PIX_DEFAULT
);
643 fore_pixel
= f
->display
.x
->background_pixel
;
644 f
->display
.x
->cursor_pixel
= x_decode_color (arg
, BLACK_PIX_DEFAULT
);
646 /* Make sure that the cursor color differs from the background color. */
647 if (f
->display
.x
->cursor_pixel
== f
->display
.x
->background_pixel
)
649 f
->display
.x
->cursor_pixel
== f
->display
.x
->mouse_pixel
;
650 if (f
->display
.x
->cursor_pixel
== fore_pixel
)
651 fore_pixel
= f
->display
.x
->background_pixel
;
653 f
->display
.x
->cursor_foreground_pixel
= fore_pixel
;
655 if (FRAME_X_WINDOW (f
) != 0)
659 XSetBackground (x_current_display
, f
->display
.x
->cursor_gc
,
660 f
->display
.x
->cursor_pixel
);
661 XSetForeground (x_current_display
, f
->display
.x
->cursor_gc
,
664 #endif /* HAVE_X11 */
666 if (FRAME_VISIBLE_P (f
))
668 x_display_cursor (f
, 0);
669 x_display_cursor (f
, 1);
674 /* Set the border-color of frame F to value described by ARG.
675 ARG can be a string naming a color.
676 The border-color is used for the border that is drawn by the X server.
677 Note that this does not fully take effect if done before
678 F has an x-window; it must be redone when the window is created.
680 Note: this is done in two routines because of the way X10 works.
682 Note: under X11, this is normally the province of the window manager,
683 and so emacs' border colors may be overridden. */
686 x_set_border_color (f
, arg
, oldval
)
688 Lisp_Object arg
, oldval
;
693 CHECK_STRING (arg
, 0);
694 str
= XSTRING (arg
)->data
;
697 if (!strcmp (str
, "grey") || !strcmp (str
, "Grey")
698 || !strcmp (str
, "gray") || !strcmp (str
, "Gray"))
703 pix
= x_decode_color (arg
, BLACK_PIX_DEFAULT
);
705 x_set_border_pixel (f
, pix
);
708 /* Set the border-color of frame F to pixel value PIX.
709 Note that this does not fully take effect if done before
710 F has an x-window. */
712 x_set_border_pixel (f
, pix
)
716 f
->display
.x
->border_pixel
= pix
;
718 if (FRAME_X_WINDOW (f
) != 0 && f
->display
.x
->border_width
> 0)
725 XSetWindowBorder (x_current_display
, FRAME_X_WINDOW (f
),
729 temp
= XMakePixmap ((Bitmap
) XStoreBitmap (gray_width
, gray_height
,
731 BLACK_PIX_DEFAULT
, WHITE_PIX_DEFAULT
);
733 temp
= XMakeTile (pix
);
734 XChangeBorder (FRAME_X_WINDOW (f
), temp
);
735 XFreePixmap (XDISPLAY temp
);
736 #endif /* not HAVE_X11 */
739 if (FRAME_VISIBLE_P (f
))
745 x_set_cursor_type (f
, arg
, oldval
)
747 Lisp_Object arg
, oldval
;
750 FRAME_DESIRED_CURSOR (f
) = bar_cursor
;
751 else if (EQ (arg
, Qbox
))
752 FRAME_DESIRED_CURSOR (f
) = filled_box_cursor
;
755 ("the `cursor-type' frame parameter should be either `bar' or `box'");
757 /* Make sure the cursor gets redrawn. This is overkill, but how
758 often do people change cursor types? */
763 x_set_icon_type (f
, arg
, oldval
)
765 Lisp_Object arg
, oldval
;
770 if (EQ (oldval
, Qnil
) == EQ (arg
, Qnil
))
775 result
= x_text_icon (f
, 0);
777 result
= x_bitmap_icon (f
);
782 error ("No icon window available.");
785 /* If the window was unmapped (and its icon was mapped),
786 the new icon is not mapped, so map the window in its stead. */
787 if (FRAME_VISIBLE_P (f
))
788 XMapWindow (XDISPLAY
FRAME_X_WINDOW (f
));
795 x_set_font (f
, arg
, oldval
)
797 Lisp_Object arg
, oldval
;
802 CHECK_STRING (arg
, 1);
803 name
= XSTRING (arg
)->data
;
806 result
= x_new_font (f
, name
);
810 error ("Font \"%s\" is not defined", name
);
814 x_set_border_width (f
, arg
, oldval
)
816 Lisp_Object arg
, oldval
;
818 CHECK_NUMBER (arg
, 0);
820 if (XINT (arg
) == f
->display
.x
->border_width
)
823 if (FRAME_X_WINDOW (f
) != 0)
824 error ("Cannot change the border width of a window");
826 f
->display
.x
->border_width
= XINT (arg
);
830 x_set_internal_border_width (f
, arg
, oldval
)
832 Lisp_Object arg
, oldval
;
835 int old
= f
->display
.x
->internal_border_width
;
837 CHECK_NUMBER (arg
, 0);
838 f
->display
.x
->internal_border_width
= XINT (arg
);
839 if (f
->display
.x
->internal_border_width
< 0)
840 f
->display
.x
->internal_border_width
= 0;
842 if (f
->display
.x
->internal_border_width
== old
)
845 if (FRAME_X_WINDOW (f
) != 0)
848 x_set_window_size (f
, f
->width
, f
->height
);
850 x_set_resize_hint (f
);
854 SET_FRAME_GARBAGED (f
);
859 x_set_visibility (f
, value
, oldval
)
861 Lisp_Object value
, oldval
;
864 XSET (frame
, Lisp_Frame
, f
);
867 Fmake_frame_invisible (frame
);
868 else if (EQ (value
, Qicon
))
869 Ficonify_frame (frame
);
871 Fmake_frame_visible (frame
);
875 x_set_menu_bar_lines_1 (window
, n
)
879 for (; !NILP (window
); window
= XWINDOW (window
)->next
)
881 struct window
*w
= XWINDOW (window
);
885 if (!NILP (w
->vchild
))
886 x_set_menu_bar_lines_1 (w
->vchild
);
888 if (!NILP (w
->hchild
))
889 x_set_menu_bar_lines_1 (w
->hchild
);
894 x_set_menu_bar_lines (f
, value
, oldval
)
896 Lisp_Object value
, oldval
;
899 int olines
= FRAME_MENU_BAR_LINES (f
);
901 /* Right now, menu bars don't work properly in minibuf-only frames;
902 most of the commands try to apply themselves to the minibuffer
903 frame itslef, and get an error because you can't switch buffers
904 in or split the minibuffer window. */
905 if (FRAME_MINIBUF_ONLY_P (f
))
908 if (XTYPE (value
) == Lisp_Int
)
909 nlines
= XINT (value
);
913 FRAME_MENU_BAR_LINES (f
) = nlines
;
914 x_set_menu_bar_lines_1 (f
->root_window
, nlines
- olines
);
915 x_set_window_size (f
, FRAME_WIDTH (f
),
916 FRAME_HEIGHT (f
) + nlines
- olines
);
919 /* Change the name of frame F to ARG. If ARG is nil, set F's name to
922 If EXPLICIT is non-zero, that indicates that lisp code is setting the
923 name; if ARG is a string, set F's name to ARG and set
924 F->explicit_name; if ARG is Qnil, then clear F->explicit_name.
926 If EXPLICIT is zero, that indicates that Emacs redisplay code is
927 suggesting a new name, which lisp code should override; if
928 F->explicit_name is set, ignore the new name; otherwise, set it. */
931 x_set_name (f
, name
, explicit)
936 /* Make sure that requests from lisp code override requests from
937 Emacs redisplay code. */
940 /* If we're switching from explicit to implicit, we had better
941 update the mode lines and thereby update the title. */
942 if (f
->explicit_name
&& NILP (name
))
943 update_mode_lines
= 1;
945 f
->explicit_name
= ! NILP (name
);
947 else if (f
->explicit_name
)
950 /* If NAME is nil, set the name to the x_id_name. */
952 name
= build_string (x_id_name
);
954 CHECK_STRING (name
, 0);
956 /* Don't change the name if it's already NAME. */
957 if (! NILP (Fstring_equal (name
, f
->name
)))
960 if (FRAME_X_WINDOW (f
))
967 text
.value
= XSTRING (name
)->data
;
968 text
.encoding
= XA_STRING
;
970 text
.nitems
= XSTRING (name
)->size
;
971 XSetWMName (x_current_display
, FRAME_X_WINDOW (f
), &text
);
972 XSetWMIconName (x_current_display
, FRAME_X_WINDOW (f
), &text
);
975 XSetIconName (XDISPLAY
FRAME_X_WINDOW (f
),
976 XSTRING (name
)->data
);
977 XStoreName (XDISPLAY
FRAME_X_WINDOW (f
),
978 XSTRING (name
)->data
);
987 /* This function should be called when the user's lisp code has
988 specified a name for the frame; the name will override any set by the
991 x_explicitly_set_name (f
, arg
, oldval
)
993 Lisp_Object arg
, oldval
;
995 x_set_name (f
, arg
, 1);
998 /* This function should be called by Emacs redisplay code to set the
999 name; names set this way will never override names set by the user's
1002 x_implicitly_set_name (f
, arg
, oldval
)
1004 Lisp_Object arg
, oldval
;
1006 x_set_name (f
, arg
, 0);
1010 x_set_autoraise (f
, arg
, oldval
)
1012 Lisp_Object arg
, oldval
;
1014 f
->auto_raise
= !EQ (Qnil
, arg
);
1018 x_set_autolower (f
, arg
, oldval
)
1020 Lisp_Object arg
, oldval
;
1022 f
->auto_lower
= !EQ (Qnil
, arg
);
1026 x_set_vertical_scroll_bars (f
, arg
, oldval
)
1028 Lisp_Object arg
, oldval
;
1030 if (NILP (arg
) != ! FRAME_HAS_VERTICAL_SCROLL_BARS (f
))
1032 FRAME_HAS_VERTICAL_SCROLL_BARS (f
) = ! NILP (arg
);
1034 /* We set this parameter before creating the X window for the
1035 frame, so we can get the geometry right from the start.
1036 However, if the window hasn't been created yet, we shouldn't
1037 call x_set_window_size. */
1038 if (FRAME_X_WINDOW (f
))
1039 x_set_window_size (f
, FRAME_WIDTH (f
), FRAME_HEIGHT (f
));
1047 /* I believe this function is obsolete with respect to the new face display
1049 x_set_face (scr
, font
, background
, foreground
, stipple
)
1052 unsigned long background
, foreground
;
1055 XGCValues gc_values
;
1057 unsigned long gc_mask
;
1058 struct face
*new_face
;
1059 unsigned int width
= 16;
1060 unsigned int height
= 16;
1062 if (n_faces
== MAX_FACES_AND_GLYPHS
)
1065 /* Create the Graphics Context. */
1066 gc_values
.font
= font
->fid
;
1067 gc_values
.foreground
= foreground
;
1068 gc_values
.background
= background
;
1069 gc_values
.line_width
= 0;
1070 gc_mask
= GCLineWidth
| GCFont
| GCForeground
| GCBackground
;
1074 = XCreateBitmapFromData (x_current_display
, ROOT_WINDOW
,
1075 (char *) stipple
, width
, height
);
1076 gc_mask
|= GCStipple
;
1079 temp_gc
= XCreateGC (x_current_display
, FRAME_X_WINDOW (scr
),
1080 gc_mask
, &gc_values
);
1083 new_face
= (struct face
*) xmalloc (sizeof (struct face
));
1086 XFreeGC (x_current_display
, temp_gc
);
1090 new_face
->font
= font
;
1091 new_face
->foreground
= foreground
;
1092 new_face
->background
= background
;
1093 new_face
->face_gc
= temp_gc
;
1095 new_face
->stipple
= gc_values
.stipple
;
1097 x_face_table
[++n_faces
] = new_face
;
1102 x_set_glyph (scr
, glyph
)
1107 DEFUN ("x-set-face-font", Fx_set_face_font
, Sx_set_face_font
, 4, 2, 0,
1108 "Specify face table entry FACE-CODE to be the font named by FONT,\n\
1109 in colors FOREGROUND and BACKGROUND.")
1110 (face_code
, font_name
, foreground
, background
)
1111 Lisp_Object face_code
;
1112 Lisp_Object font_name
;
1113 Lisp_Object foreground
;
1114 Lisp_Object background
;
1116 register struct face
*fp
; /* Current face info. */
1117 register int fn
; /* Face number. */
1118 register FONT_TYPE
*f
; /* Font data structure. */
1119 unsigned char *newname
;
1122 XGCValues gc_values
;
1124 /* Need to do something about this. */
1125 Drawable drawable
= FRAME_X_WINDOW (selected_frame
);
1127 CHECK_NUMBER (face_code
, 1);
1128 CHECK_STRING (font_name
, 2);
1130 if (EQ (foreground
, Qnil
) || EQ (background
, Qnil
))
1132 fg
= selected_frame
->display
.x
->foreground_pixel
;
1133 bg
= selected_frame
->display
.x
->background_pixel
;
1137 CHECK_NUMBER (foreground
, 0);
1138 CHECK_NUMBER (background
, 1);
1140 fg
= x_decode_color (XINT (foreground
), BLACK_PIX_DEFAULT
);
1141 bg
= x_decode_color (XINT (background
), WHITE_PIX_DEFAULT
);
1144 fn
= XINT (face_code
);
1145 if ((fn
< 1) || (fn
> 255))
1146 error ("Invalid face code, %d", fn
);
1148 newname
= XSTRING (font_name
)->data
;
1150 f
= (*newname
== 0 ? 0 : XGetFont (newname
));
1153 error ("Font \"%s\" is not defined", newname
);
1155 fp
= x_face_table
[fn
];
1158 x_face_table
[fn
] = fp
= (struct face
*) xmalloc (sizeof (struct face
));
1159 bzero (fp
, sizeof (struct face
));
1160 fp
->face_type
= x_pixmap
;
1162 else if (FACE_IS_FONT (fn
))
1165 XFreeGC (FACE_FONT (fn
));
1168 else if (FACE_IS_IMAGE (fn
)) /* This should not happen... */
1171 XFreePixmap (x_current_display
, FACE_IMAGE (fn
));
1172 fp
->face_type
= x_font
;
1178 fp
->face_GLYPH
.font_desc
.font
= f
;
1179 gc_values
.font
= f
->fid
;
1180 gc_values
.foreground
= fg
;
1181 gc_values
.background
= bg
;
1182 fp
->face_GLYPH
.font_desc
.face_gc
= XCreateGC (x_current_display
,
1183 drawable
, GCFont
| GCForeground
1184 | GCBackground
, &gc_values
);
1185 fp
->face_GLYPH
.font_desc
.font_width
= FONT_WIDTH (f
);
1186 fp
->face_GLYPH
.font_desc
.font_height
= FONT_HEIGHT (f
);
1192 DEFUN ("x-set-face", Fx_set_face
, Sx_set_face
, 4, 4, 0,
1193 "Specify face table entry FACE-CODE to be the font named by FONT,\n\
1194 in colors FOREGROUND and BACKGROUND.")
1195 (face_code
, font_name
, foreground
, background
)
1196 Lisp_Object face_code
;
1197 Lisp_Object font_name
;
1198 Lisp_Object foreground
;
1199 Lisp_Object background
;
1201 register struct face
*fp
; /* Current face info. */
1202 register int fn
; /* Face number. */
1203 register FONT_TYPE
*f
; /* Font data structure. */
1204 unsigned char *newname
;
1206 CHECK_NUMBER (face_code
, 1);
1207 CHECK_STRING (font_name
, 2);
1209 fn
= XINT (face_code
);
1210 if ((fn
< 1) || (fn
> 255))
1211 error ("Invalid face code, %d", fn
);
1213 /* Ask the server to find the specified font. */
1214 newname
= XSTRING (font_name
)->data
;
1216 f
= (*newname
== 0 ? 0 : XGetFont (newname
));
1219 error ("Font \"%s\" is not defined", newname
);
1221 /* Get the face structure for face_code in the face table.
1222 Make sure it exists. */
1223 fp
= x_face_table
[fn
];
1226 x_face_table
[fn
] = fp
= (struct face
*) xmalloc (sizeof (struct face
));
1227 bzero (fp
, sizeof (struct face
));
1230 /* If this face code already exists, get rid of the old font. */
1231 if (fp
->font
!= 0 && fp
->font
!= f
)
1234 XLoseFont (fp
->font
);
1238 /* Store the specified information in FP. */
1239 fp
->fg
= x_decode_color (foreground
, BLACK_PIX_DEFAULT
);
1240 fp
->bg
= x_decode_color (background
, WHITE_PIX_DEFAULT
);
1248 /* This is excluded because there is no painless way
1249 to get or to remember the name of the font. */
1251 DEFUN ("x-get-face", Fx_get_face
, Sx_get_face
, 1, 1, 0,
1252 "Get data defining face code FACE. FACE is an integer.\n\
1253 The value is a list (FONT FG-COLOR BG-COLOR).")
1257 register struct face
*fp
; /* Current face info. */
1258 register int fn
; /* Face number. */
1260 CHECK_NUMBER (face
, 1);
1262 if ((fn
< 1) || (fn
> 255))
1263 error ("Invalid face code, %d", fn
);
1265 /* Make sure the face table exists and this face code is defined. */
1266 if (x_face_table
== 0 || x_face_table
[fn
] == 0)
1269 fp
= x_face_table
[fn
];
1271 return Fcons (build_string (fp
->name
),
1272 Fcons (make_number (fp
->fg
),
1273 Fcons (make_number (fp
->bg
), Qnil
)));
1277 /* Subroutines of creating an X frame. */
1280 extern char *x_get_string_resource ();
1281 extern XrmDatabase
x_load_resources ();
1283 DEFUN ("x-get-resource", Fx_get_resource
, Sx_get_resource
, 2, 4, 0,
1284 "Return the value of ATTRIBUTE, of class CLASS, from the X defaults database.\n\
1285 This uses `INSTANCE.ATTRIBUTE' as the key and `Emacs.CLASS' as the\n\
1286 class, where INSTANCE is the name under which Emacs was invoked.\n\
1288 The optional arguments COMPONENT and SUBCLASS add to the key and the\n\
1289 class, respectively. You must specify both of them or neither.\n\
1290 If you specify them, the key is `INSTANCE.COMPONENT.ATTRIBUTE'\n\
1291 and the class is `Emacs.CLASS.SUBCLASS'.")
1292 (attribute
, class, component
, subclass
)
1293 Lisp_Object attribute
, class, component
, subclass
;
1295 register char *value
;
1299 CHECK_STRING (attribute
, 0);
1300 CHECK_STRING (class, 0);
1302 if (!NILP (component
))
1303 CHECK_STRING (component
, 1);
1304 if (!NILP (subclass
))
1305 CHECK_STRING (subclass
, 2);
1306 if (NILP (component
) != NILP (subclass
))
1307 error ("x-get-resource: must specify both COMPONENT and SUBCLASS or neither");
1309 if (NILP (component
))
1311 /* Allocate space for the components, the dots which separate them,
1312 and the final '\0'. */
1313 name_key
= (char *) alloca (XSTRING (Vinvocation_name
)->size
1314 + XSTRING (attribute
)->size
1316 class_key
= (char *) alloca ((sizeof (EMACS_CLASS
) - 1)
1317 + XSTRING (class)->size
1320 sprintf (name_key
, "%s.%s",
1321 XSTRING (Vinvocation_name
)->data
,
1322 XSTRING (attribute
)->data
);
1323 sprintf (class_key
, "%s.%s",
1325 XSTRING (class)->data
);
1329 name_key
= (char *) alloca (XSTRING (Vinvocation_name
)->size
1330 + XSTRING (component
)->size
1331 + XSTRING (attribute
)->size
1334 class_key
= (char *) alloca ((sizeof (EMACS_CLASS
) - 1)
1335 + XSTRING (class)->size
1336 + XSTRING (subclass
)->size
1339 sprintf (name_key
, "%s.%s.%s",
1340 XSTRING (Vinvocation_name
)->data
,
1341 XSTRING (component
)->data
,
1342 XSTRING (attribute
)->data
);
1343 sprintf (class_key
, "%s.%s",
1345 XSTRING (class)->data
,
1346 XSTRING (subclass
)->data
);
1349 value
= x_get_string_resource (xrdb
, name_key
, class_key
);
1351 if (value
!= (char *) 0)
1352 return build_string (value
);
1359 DEFUN ("x-get-default", Fx_get_default
, Sx_get_default
, 1, 1, 0,
1360 "Get X default ATTRIBUTE from the system, or nil if no default.\n\
1361 Value is a string (when not nil) and ATTRIBUTE is also a string.\n\
1362 The defaults are specified in the file `~/.Xdefaults'.")
1366 register unsigned char *value
;
1368 CHECK_STRING (arg
, 1);
1370 value
= (unsigned char *) XGetDefault (XDISPLAY
1371 XSTRING (Vinvocation_name
)->data
,
1372 XSTRING (arg
)->data
);
1374 /* Try reversing last two args, in case this is the buggy version of X. */
1375 value
= (unsigned char *) XGetDefault (XDISPLAY
1376 XSTRING (arg
)->data
,
1377 XSTRING (Vinvocation_name
)->data
);
1379 return build_string (value
);
1384 #define Fx_get_resource(attribute, class, component, subclass) \
1385 Fx_get_default(attribute)
1389 /* Types we might convert a resource string into. */
1392 number
, boolean
, string
, symbol
,
1395 /* Return the value of parameter PARAM.
1397 First search ALIST, then Vdefault_frame_alist, then the X defaults
1398 database, using ATTRIBUTE as the attribute name and CLASS as its class.
1400 Convert the resource to the type specified by desired_type.
1402 If no default is specified, return Qunbound. If you call
1403 x_get_arg, make sure you deal with Qunbound in a reasonable way,
1404 and don't let it get stored in any lisp-visible variables! */
1407 x_get_arg (alist
, param
, attribute
, class, type
)
1408 Lisp_Object alist
, param
;
1411 enum resource_types type
;
1413 register Lisp_Object tem
;
1415 tem
= Fassq (param
, alist
);
1417 tem
= Fassq (param
, Vdefault_frame_alist
);
1423 tem
= Fx_get_resource (build_string (attribute
),
1424 build_string (class),
1433 return make_number (atoi (XSTRING (tem
)->data
));
1436 tem
= Fdowncase (tem
);
1437 if (!strcmp (XSTRING (tem
)->data
, "on")
1438 || !strcmp (XSTRING (tem
)->data
, "true"))
1447 /* As a special case, we map the values `true' and `on'
1448 to Qt, and `false' and `off' to Qnil. */
1450 Lisp_Object lower
= Fdowncase (tem
);
1451 if (!strcmp (XSTRING (tem
)->data
, "on")
1452 || !strcmp (XSTRING (tem
)->data
, "true"))
1454 else if (!strcmp (XSTRING (tem
)->data
, "off")
1455 || !strcmp (XSTRING (tem
)->data
, "false"))
1458 return Fintern (tem
, Qnil
);
1471 /* Record in frame F the specified or default value according to ALIST
1472 of the parameter named PARAM (a Lisp symbol).
1473 If no value is specified for PARAM, look for an X default for XPROP
1474 on the frame named NAME.
1475 If that is not found either, use the value DEFLT. */
1478 x_default_parameter (f
, alist
, prop
, deflt
, xprop
, xclass
, type
)
1485 enum resource_types type
;
1489 tem
= x_get_arg (alist
, prop
, xprop
, xclass
, type
);
1490 if (EQ (tem
, Qunbound
))
1492 x_set_frame_parameters (f
, Fcons (Fcons (prop
, tem
), Qnil
));
1496 DEFUN ("x-parse-geometry", Fx_parse_geometry
, Sx_parse_geometry
, 1, 1, 0,
1497 "Parse an X-style geometry string STRING.\n\
1498 Returns an alist of the form ((top . TOP), (left . LEFT) ... ).")
1503 unsigned int width
, height
;
1504 Lisp_Object values
[4];
1506 CHECK_STRING (string
, 0);
1508 geometry
= XParseGeometry ((char *) XSTRING (string
)->data
,
1509 &x
, &y
, &width
, &height
);
1511 switch (geometry
& 0xf) /* Mask out {X,Y}Negative */
1513 case (XValue
| YValue
):
1514 /* What's one pixel among friends?
1515 Perhaps fix this some day by returning symbol `extreme-top'... */
1516 if (x
== 0 && (geometry
& XNegative
))
1518 if (y
== 0 && (geometry
& YNegative
))
1520 values
[0] = Fcons (Qleft
, make_number (x
));
1521 values
[1] = Fcons (Qtop
, make_number (y
));
1522 return Flist (2, values
);
1525 case (WidthValue
| HeightValue
):
1526 values
[0] = Fcons (Qwidth
, make_number (width
));
1527 values
[1] = Fcons (Qheight
, make_number (height
));
1528 return Flist (2, values
);
1531 case (XValue
| YValue
| WidthValue
| HeightValue
):
1532 if (x
== 0 && (geometry
& XNegative
))
1534 if (y
== 0 && (geometry
& YNegative
))
1536 values
[0] = Fcons (Qwidth
, make_number (width
));
1537 values
[1] = Fcons (Qheight
, make_number (height
));
1538 values
[2] = Fcons (Qleft
, make_number (x
));
1539 values
[3] = Fcons (Qtop
, make_number (y
));
1540 return Flist (4, values
);
1547 error ("Must specify x and y value, and/or width and height");
1552 /* Calculate the desired size and position of this window,
1553 or set rubber-band prompting if none. */
1555 #define DEFAULT_ROWS 40
1556 #define DEFAULT_COLS 80
1559 x_figure_window_size (f
, parms
)
1563 register Lisp_Object tem0
, tem1
;
1564 int height
, width
, left
, top
;
1565 register int geometry
;
1566 long window_prompting
= 0;
1568 /* Default values if we fall through.
1569 Actually, if that happens we should get
1570 window manager prompting. */
1571 f
->width
= DEFAULT_COLS
;
1572 f
->height
= DEFAULT_ROWS
;
1573 f
->display
.x
->top_pos
= 1;
1574 f
->display
.x
->left_pos
= 1;
1576 tem0
= x_get_arg (parms
, Qheight
, 0, 0, number
);
1577 tem1
= x_get_arg (parms
, Qwidth
, 0, 0, number
);
1578 if (! EQ (tem0
, Qunbound
) && ! EQ (tem1
, Qunbound
))
1580 CHECK_NUMBER (tem0
, 0);
1581 CHECK_NUMBER (tem1
, 0);
1582 f
->height
= XINT (tem0
);
1583 f
->width
= XINT (tem1
);
1584 window_prompting
|= USSize
;
1586 else if (! EQ (tem0
, Qunbound
) || ! EQ (tem1
, Qunbound
))
1587 error ("Must specify *both* height and width");
1589 f
->display
.x
->vertical_scroll_bar_extra
=
1590 (FRAME_HAS_VERTICAL_SCROLL_BARS (f
)
1591 ? VERTICAL_SCROLL_BAR_PIXEL_WIDTH (f
)
1593 f
->display
.x
->pixel_width
= CHAR_TO_PIXEL_WIDTH (f
, f
->width
);
1594 f
->display
.x
->pixel_height
= CHAR_TO_PIXEL_HEIGHT (f
, f
->height
);
1596 tem0
= x_get_arg (parms
, Qtop
, 0, 0, number
);
1597 tem1
= x_get_arg (parms
, Qleft
, 0, 0, number
);
1598 if (! EQ (tem0
, Qunbound
) && ! EQ (tem1
, Qunbound
))
1600 CHECK_NUMBER (tem0
, 0);
1601 CHECK_NUMBER (tem1
, 0);
1602 f
->display
.x
->top_pos
= XINT (tem0
);
1603 f
->display
.x
->left_pos
= XINT (tem1
);
1604 x_calc_absolute_position (f
);
1605 window_prompting
|= USPosition
;
1607 else if (! EQ (tem0
, Qunbound
) || ! EQ (tem1
, Qunbound
))
1608 error ("Must specify *both* top and left corners");
1610 switch (window_prompting
)
1612 case USSize
| USPosition
:
1613 return window_prompting
;
1616 case USSize
: /* Got the size, need the position. */
1617 window_prompting
|= PPosition
;
1618 return window_prompting
;
1621 case USPosition
: /* Got the position, need the size. */
1622 window_prompting
|= PSize
;
1623 return window_prompting
;
1626 case 0: /* Got nothing, take both from geometry. */
1627 window_prompting
|= PPosition
| PSize
;
1628 return window_prompting
;
1632 /* Somehow a bit got set in window_prompting that we didn't
1642 XSetWindowAttributes attributes
;
1643 unsigned long attribute_mask
;
1644 XClassHint class_hints
;
1646 attributes
.background_pixel
= f
->display
.x
->background_pixel
;
1647 attributes
.border_pixel
= f
->display
.x
->border_pixel
;
1648 attributes
.bit_gravity
= StaticGravity
;
1649 attributes
.backing_store
= NotUseful
;
1650 attributes
.save_under
= True
;
1651 attributes
.event_mask
= STANDARD_EVENT_SET
;
1652 attribute_mask
= (CWBackPixel
| CWBorderPixel
| CWBitGravity
1654 | CWBackingStore
| CWSaveUnder
1660 = XCreateWindow (x_current_display
, ROOT_WINDOW
,
1661 f
->display
.x
->left_pos
,
1662 f
->display
.x
->top_pos
,
1663 PIXEL_WIDTH (f
), PIXEL_HEIGHT (f
),
1664 f
->display
.x
->border_width
,
1665 CopyFromParent
, /* depth */
1666 InputOutput
, /* class */
1667 screen_visual
, /* set in Fx_open_connection */
1668 attribute_mask
, &attributes
);
1670 class_hints
.res_name
= (char *) XSTRING (f
->name
)->data
;
1671 class_hints
.res_class
= EMACS_CLASS
;
1672 XSetClassHint (x_current_display
, FRAME_X_WINDOW (f
), &class_hints
);
1674 /* This indicates that we use the "Passive Input" input model.
1675 Unless we do this, we don't get the Focus{In,Out} events that we
1676 need to draw the cursor correctly. Accursed bureaucrats.
1677 XWhipsAndChains (x_current_display, IronMaiden, &TheRack); */
1679 f
->display
.x
->wm_hints
.input
= True
;
1680 f
->display
.x
->wm_hints
.flags
|= InputHint
;
1681 XSetWMHints (x_current_display
, FRAME_X_WINDOW (f
), &f
->display
.x
->wm_hints
);
1683 /* x_set_name normally ignores requests to set the name if the
1684 requested name is the same as the current name. This is the one
1685 place where that assumption isn't correct; f->name is set, but
1686 the X server hasn't been told. */
1688 Lisp_Object name
= f
->name
;
1689 int explicit = f
->explicit_name
;
1692 f
->explicit_name
= 0;
1693 x_set_name (f
, name
, explicit);
1696 XDefineCursor (XDISPLAY
FRAME_X_WINDOW (f
),
1697 f
->display
.x
->text_cursor
);
1700 if (FRAME_X_WINDOW (f
) == 0)
1701 error ("Unable to create window.");
1704 /* Handle the icon stuff for this window. Perhaps later we might
1705 want an x_set_icon_position which can be called interactively as
1713 Lisp_Object icon_x
, icon_y
;
1715 /* Set the position of the icon. Note that twm groups all
1716 icons in an icon window. */
1717 icon_x
= x_get_arg (parms
, Qicon_left
, 0, 0, number
);
1718 icon_y
= x_get_arg (parms
, Qicon_top
, 0, 0, number
);
1719 if (!EQ (icon_x
, Qunbound
) && !EQ (icon_y
, Qunbound
))
1721 CHECK_NUMBER (icon_x
, 0);
1722 CHECK_NUMBER (icon_y
, 0);
1724 else if (!EQ (icon_x
, Qunbound
) || !EQ (icon_y
, Qunbound
))
1725 error ("Both left and top icon corners of icon must be specified");
1729 if (! EQ (icon_x
, Qunbound
))
1730 x_wm_set_icon_position (f
, XINT (icon_x
), XINT (icon_y
));
1732 /* Start up iconic or window? */
1733 x_wm_set_window_state
1734 (f
, (EQ (x_get_arg (parms
, Qvisibility
, 0, 0, symbol
), Qicon
)
1741 /* Make the GC's needed for this window, setting the
1742 background, border and mouse colors; also create the
1743 mouse cursor and the gray border tile. */
1745 static char cursor_bits
[] =
1747 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
1748 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
1749 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
1750 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00
1757 XGCValues gc_values
;
1763 /* Create the GC's of this frame.
1764 Note that many default values are used. */
1767 gc_values
.font
= f
->display
.x
->font
->fid
;
1768 gc_values
.foreground
= f
->display
.x
->foreground_pixel
;
1769 gc_values
.background
= f
->display
.x
->background_pixel
;
1770 gc_values
.line_width
= 0; /* Means 1 using fast algorithm. */
1771 f
->display
.x
->normal_gc
= XCreateGC (x_current_display
,
1773 GCLineWidth
| GCFont
1774 | GCForeground
| GCBackground
,
1777 /* Reverse video style. */
1778 gc_values
.foreground
= f
->display
.x
->background_pixel
;
1779 gc_values
.background
= f
->display
.x
->foreground_pixel
;
1780 f
->display
.x
->reverse_gc
= XCreateGC (x_current_display
,
1782 GCFont
| GCForeground
| GCBackground
1786 /* Cursor has cursor-color background, background-color foreground. */
1787 gc_values
.foreground
= f
->display
.x
->background_pixel
;
1788 gc_values
.background
= f
->display
.x
->cursor_pixel
;
1789 gc_values
.fill_style
= FillOpaqueStippled
;
1791 = XCreateBitmapFromData (x_current_display
, ROOT_WINDOW
,
1792 cursor_bits
, 16, 16);
1793 f
->display
.x
->cursor_gc
1794 = XCreateGC (x_current_display
, FRAME_X_WINDOW (f
),
1795 (GCFont
| GCForeground
| GCBackground
1796 | GCFillStyle
| GCStipple
| GCLineWidth
),
1799 /* Create the gray border tile used when the pointer is not in
1800 the frame. Since this depends on the frame's pixel values,
1801 this must be done on a per-frame basis. */
1802 f
->display
.x
->border_tile
1803 = (XCreatePixmapFromBitmapData
1804 (x_current_display
, ROOT_WINDOW
,
1805 gray_bits
, gray_width
, gray_height
,
1806 f
->display
.x
->foreground_pixel
,
1807 f
->display
.x
->background_pixel
,
1808 DefaultDepth (x_current_display
, XDefaultScreen (x_current_display
))));
1810 init_frame_faces (f
);
1814 #endif /* HAVE_X11 */
1816 DEFUN ("x-create-frame", Fx_create_frame
, Sx_create_frame
,
1818 "Make a new X window, which is called a \"frame\" in Emacs terms.\n\
1819 Return an Emacs frame object representing the X window.\n\
1820 ALIST is an alist of frame parameters.\n\
1821 If the parameters specify that the frame should not have a minibuffer,\n\
1822 and do not specify a specific minibuffer window to use,\n\
1823 then `default-minibuffer-frame' must be a frame whose minibuffer can\n\
1824 be shared by the new frame.")
1830 Lisp_Object frame
, tem
;
1832 int minibuffer_only
= 0;
1833 long window_prompting
= 0;
1836 if (x_current_display
== 0)
1837 error ("X windows are not in use or not initialized");
1839 name
= x_get_arg (parms
, Qname
, "title", "Title", string
);
1840 if (XTYPE (name
) != Lisp_String
1841 && ! EQ (name
, Qunbound
)
1843 error ("x-create-frame: name parameter must be a string");
1845 tem
= x_get_arg (parms
, Qminibuffer
, 0, 0, symbol
);
1846 if (EQ (tem
, Qnone
) || NILP (tem
))
1847 f
= make_frame_without_minibuffer (Qnil
);
1848 else if (EQ (tem
, Qonly
))
1850 f
= make_minibuffer_frame ();
1851 minibuffer_only
= 1;
1853 else if (XTYPE (tem
) == Lisp_Window
)
1854 f
= make_frame_without_minibuffer (tem
);
1858 /* Note that X Windows does support scroll bars. */
1859 FRAME_CAN_HAVE_SCROLL_BARS (f
) = 1;
1861 /* Set the name; the functions to which we pass f expect the name to
1863 if (EQ (name
, Qunbound
) || NILP (name
))
1865 f
->name
= build_string (x_id_name
);
1866 f
->explicit_name
= 0;
1871 f
->explicit_name
= 1;
1874 XSET (frame
, Lisp_Frame
, f
);
1875 f
->output_method
= output_x_window
;
1876 f
->display
.x
= (struct x_display
*) xmalloc (sizeof (struct x_display
));
1877 bzero (f
->display
.x
, sizeof (struct x_display
));
1879 /* Note that the frame has no physical cursor right now. */
1880 f
->phys_cursor_x
= -1;
1882 /* Extract the window parameters from the supplied values
1883 that are needed to determine window geometry. */
1884 x_default_parameter (f
, parms
, Qfont
,
1886 /* If we use an XLFD name for this font, the lisp code
1887 knows how to find variants which are bold, italic,
1889 ("-*-fixed-*-*-*-*-*-120-*-*-c-*-iso8859-1"),
1890 "font", "Font", string
);
1891 x_default_parameter (f
, parms
, Qborder_width
, make_number (2),
1892 "borderwidth", "BorderWidth", number
);
1893 /* This defaults to 2 in order to match xterm. */
1894 x_default_parameter (f
, parms
, Qinternal_border_width
, make_number (2),
1895 "internalBorderWidth", "BorderWidth", number
);
1896 x_default_parameter (f
, parms
, Qvertical_scroll_bars
, Qt
,
1897 "verticalScrollBars", "ScrollBars", boolean
);
1899 /* Also do the stuff which must be set before the window exists. */
1900 x_default_parameter (f
, parms
, Qforeground_color
, build_string ("black"),
1901 "foreground", "Foreground", string
);
1902 x_default_parameter (f
, parms
, Qbackground_color
, build_string ("white"),
1903 "background", "Background", string
);
1904 x_default_parameter (f
, parms
, Qmouse_color
, build_string ("black"),
1905 "pointerColor", "Foreground", string
);
1906 x_default_parameter (f
, parms
, Qcursor_color
, build_string ("black"),
1907 "cursorColor", "Foreground", string
);
1908 x_default_parameter (f
, parms
, Qborder_color
, build_string ("black"),
1909 "borderColor", "BorderColor", string
);
1911 f
->display
.x
->parent_desc
= ROOT_WINDOW
;
1912 window_prompting
= x_figure_window_size (f
, parms
);
1918 /* We need to do this after creating the X window, so that the
1919 icon-creation functions can say whose icon they're describing. */
1920 x_default_parameter (f
, parms
, Qicon_type
, Qnil
,
1921 "iconType", "IconType", symbol
);
1923 x_default_parameter (f
, parms
, Qauto_raise
, Qnil
,
1924 "autoRaise", "AutoRaiseLower", boolean
);
1925 x_default_parameter (f
, parms
, Qauto_lower
, Qnil
,
1926 "autoLower", "AutoRaiseLower", boolean
);
1927 x_default_parameter (f
, parms
, Qcursor_type
, Qbox
,
1928 "cursorType", "CursorType", symbol
);
1930 /* Dimensions, especially f->height, must be done via change_frame_size.
1931 Change will not be effected unless different from the current
1935 f
->height
= f
->width
= 0;
1936 change_frame_size (f
, height
, width
, 1, 0);
1938 x_default_parameter (f
, parms
, Qmenu_bar_lines
, make_number (0),
1939 "menuBarLines", "MenuBarLines", number
);
1942 x_wm_set_size_hint (f
, window_prompting
);
1945 tem
= x_get_arg (parms
, Qunsplittable
, 0, 0, boolean
);
1946 f
->no_split
= minibuffer_only
|| EQ (tem
, Qt
);
1948 /* Make the window appear on the frame and enable display,
1949 unless the caller says not to. */
1951 Lisp_Object visibility
= x_get_arg (parms
, Qvisibility
, 0, 0, symbol
);
1953 if (EQ (visibility
, Qunbound
))
1956 if (EQ (visibility
, Qicon
))
1957 x_iconify_frame (f
);
1958 else if (! NILP (visibility
))
1959 x_make_frame_visible (f
);
1961 /* Must have been Qnil. */
1968 Lisp_Object frame
, tem
;
1970 int pixelwidth
, pixelheight
;
1975 int minibuffer_only
= 0;
1976 Lisp_Object vscroll
, hscroll
;
1978 if (x_current_display
== 0)
1979 error ("X windows are not in use or not initialized");
1981 name
= Fassq (Qname
, parms
);
1983 tem
= x_get_arg (parms
, Qminibuffer
, 0, 0, symbol
);
1984 if (EQ (tem
, Qnone
))
1985 f
= make_frame_without_minibuffer (Qnil
);
1986 else if (EQ (tem
, Qonly
))
1988 f
= make_minibuffer_frame ();
1989 minibuffer_only
= 1;
1991 else if (EQ (tem
, Qnil
) || EQ (tem
, Qunbound
))
1994 f
= make_frame_without_minibuffer (tem
);
1996 parent
= ROOT_WINDOW
;
1998 XSET (frame
, Lisp_Frame
, f
);
1999 f
->output_method
= output_x_window
;
2000 f
->display
.x
= (struct x_display
*) xmalloc (sizeof (struct x_display
));
2001 bzero (f
->display
.x
, sizeof (struct x_display
));
2003 /* Some temprorary default values for height and width. */
2006 f
->display
.x
->left_pos
= -1;
2007 f
->display
.x
->top_pos
= -1;
2009 /* Give the frame a default name (which may be overridden with PARMS). */
2011 strncpy (iconidentity
, ICONTAG
, MAXICID
);
2012 if (gethostname (&iconidentity
[sizeof (ICONTAG
) - 1],
2013 (MAXICID
- 1) - sizeof (ICONTAG
)))
2014 iconidentity
[sizeof (ICONTAG
) - 2] = '\0';
2015 f
->name
= build_string (iconidentity
);
2017 /* Extract some window parameters from the supplied values.
2018 These are the parameters that affect window geometry. */
2020 tem
= x_get_arg (parms
, Qfont
, "BodyFont", 0, string
);
2021 if (EQ (tem
, Qunbound
))
2022 tem
= build_string ("9x15");
2023 x_set_font (f
, tem
, Qnil
);
2024 x_default_parameter (f
, parms
, Qborder_color
,
2025 build_string ("black"), "Border", 0, string
);
2026 x_default_parameter (f
, parms
, Qbackground_color
,
2027 build_string ("white"), "Background", 0, string
);
2028 x_default_parameter (f
, parms
, Qforeground_color
,
2029 build_string ("black"), "Foreground", 0, string
);
2030 x_default_parameter (f
, parms
, Qmouse_color
,
2031 build_string ("black"), "Mouse", 0, string
);
2032 x_default_parameter (f
, parms
, Qcursor_color
,
2033 build_string ("black"), "Cursor", 0, string
);
2034 x_default_parameter (f
, parms
, Qborder_width
,
2035 make_number (2), "BorderWidth", 0, number
);
2036 x_default_parameter (f
, parms
, Qinternal_border_width
,
2037 make_number (4), "InternalBorderWidth", 0, number
);
2038 x_default_parameter (f
, parms
, Qauto_raise
,
2039 Qnil
, "AutoRaise", 0, boolean
);
2041 hscroll
= EQ (x_get_arg (parms
, Qhorizontal_scroll_bar
, 0, 0, boolean
), Qt
);
2042 vscroll
= EQ (x_get_arg (parms
, Qvertical_scroll_bar
, 0, 0, boolean
), Qt
);
2044 if (f
->display
.x
->internal_border_width
< 0)
2045 f
->display
.x
->internal_border_width
= 0;
2047 tem
= x_get_arg (parms
, Qwindow_id
, 0, 0, number
);
2048 if (!EQ (tem
, Qunbound
))
2050 WINDOWINFO_TYPE wininfo
;
2052 Window
*children
, root
;
2054 CHECK_NUMBER (tem
, 0);
2055 FRAME_X_WINDOW (f
) = (Window
) XINT (tem
);
2058 XGetWindowInfo (FRAME_X_WINDOW (f
), &wininfo
);
2059 XQueryTree (FRAME_X_WINDOW (f
), &parent
, &nchildren
, &children
);
2063 height
= PIXEL_TO_CHAR_HEIGHT (f
, wininfo
.height
);
2064 width
= PIXEL_TO_CHAR_WIDTH (f
, wininfo
.width
);
2065 f
->display
.x
->left_pos
= wininfo
.x
;
2066 f
->display
.x
->top_pos
= wininfo
.y
;
2067 FRAME_SET_VISIBILITY (f
, wininfo
.mapped
!= 0);
2068 f
->display
.x
->border_width
= wininfo
.bdrwidth
;
2069 f
->display
.x
->parent_desc
= parent
;
2073 tem
= x_get_arg (parms
, Qparent_id
, 0, 0, number
);
2074 if (!EQ (tem
, Qunbound
))
2076 CHECK_NUMBER (tem
, 0);
2077 parent
= (Window
) XINT (tem
);
2079 f
->display
.x
->parent_desc
= parent
;
2080 tem
= x_get_arg (parms
, Qheight
, 0, 0, number
);
2081 if (EQ (tem
, Qunbound
))
2083 tem
= x_get_arg (parms
, Qwidth
, 0, 0, number
);
2084 if (EQ (tem
, Qunbound
))
2086 tem
= x_get_arg (parms
, Qtop
, 0, 0, number
);
2087 if (EQ (tem
, Qunbound
))
2088 tem
= x_get_arg (parms
, Qleft
, 0, 0, number
);
2091 /* Now TEM is Qunbound if no edge or size was specified.
2092 In that case, we must do rubber-banding. */
2093 if (EQ (tem
, Qunbound
))
2095 tem
= x_get_arg (parms
, Qgeometry
, 0, 0, number
);
2097 &f
->display
.x
->left_pos
, &f
->display
.x
->top_pos
,
2099 (XTYPE (tem
) == Lisp_String
2100 ? (char *) XSTRING (tem
)->data
: ""),
2101 XSTRING (f
->name
)->data
,
2102 !NILP (hscroll
), !NILP (vscroll
));
2106 /* Here if at least one edge or size was specified.
2107 Demand that they all were specified, and use them. */
2108 tem
= x_get_arg (parms
, Qheight
, 0, 0, number
);
2109 if (EQ (tem
, Qunbound
))
2110 error ("Height not specified");
2111 CHECK_NUMBER (tem
, 0);
2112 height
= XINT (tem
);
2114 tem
= x_get_arg (parms
, Qwidth
, 0, 0, number
);
2115 if (EQ (tem
, Qunbound
))
2116 error ("Width not specified");
2117 CHECK_NUMBER (tem
, 0);
2120 tem
= x_get_arg (parms
, Qtop
, 0, 0, number
);
2121 if (EQ (tem
, Qunbound
))
2122 error ("Top position not specified");
2123 CHECK_NUMBER (tem
, 0);
2124 f
->display
.x
->left_pos
= XINT (tem
);
2126 tem
= x_get_arg (parms
, Qleft
, 0, 0, number
);
2127 if (EQ (tem
, Qunbound
))
2128 error ("Left position not specified");
2129 CHECK_NUMBER (tem
, 0);
2130 f
->display
.x
->top_pos
= XINT (tem
);
2133 pixelwidth
= CHAR_TO_PIXEL_WIDTH (f
, width
);
2134 pixelheight
= CHAR_TO_PIXEL_HEIGHT (f
, height
);
2138 = XCreateWindow (parent
,
2139 f
->display
.x
->left_pos
, /* Absolute horizontal offset */
2140 f
->display
.x
->top_pos
, /* Absolute Vertical offset */
2141 pixelwidth
, pixelheight
,
2142 f
->display
.x
->border_width
,
2143 BLACK_PIX_DEFAULT
, WHITE_PIX_DEFAULT
);
2145 if (FRAME_X_WINDOW (f
) == 0)
2146 error ("Unable to create window.");
2149 /* Install the now determined height and width
2150 in the windows and in phys_lines and desired_lines. */
2151 change_frame_size (f
, height
, width
, 1, 0);
2152 XSelectInput (FRAME_X_WINDOW (f
), KeyPressed
| ExposeWindow
2153 | ButtonPressed
| ButtonReleased
| ExposeRegion
| ExposeCopy
2154 | EnterWindow
| LeaveWindow
| UnmapWindow
);
2155 x_set_resize_hint (f
);
2157 /* Tell the server the window's default name. */
2158 XStoreName (XDISPLAY
FRAME_X_WINDOW (f
), XSTRING (f
->name
)->data
);
2160 /* Now override the defaults with all the rest of the specified
2162 tem
= x_get_arg (parms
, Qunsplittable
, 0, 0, boolean
);
2163 f
->no_split
= minibuffer_only
|| EQ (tem
, Qt
);
2165 /* Do not create an icon window if the caller says not to */
2166 if (!EQ (x_get_arg (parms
, Qsuppress_icon
, 0, 0, boolean
), Qt
)
2167 || f
->display
.x
->parent_desc
!= ROOT_WINDOW
)
2169 x_text_icon (f
, iconidentity
);
2170 x_default_parameter (f
, parms
, Qicon_type
, Qnil
,
2171 "BitmapIcon", 0, symbol
);
2174 /* Tell the X server the previously set values of the
2175 background, border and mouse colors; also create the mouse cursor. */
2177 temp
= XMakeTile (f
->display
.x
->background_pixel
);
2178 XChangeBackground (FRAME_X_WINDOW (f
), temp
);
2181 x_set_border_pixel (f
, f
->display
.x
->border_pixel
);
2183 x_set_mouse_color (f
, Qnil
, Qnil
);
2185 /* Now override the defaults with all the rest of the specified parms. */
2187 Fmodify_frame_parameters (frame
, parms
);
2189 /* Make the window appear on the frame and enable display. */
2191 Lisp_Object visibility
= x_get_arg (parms
, Qvisibility
, 0, 0, symbol
);
2193 if (EQ (visibility
, Qunbound
))
2196 if (! EQ (visibility
, Qicon
)
2197 && ! NILP (visibility
))
2198 x_make_window_visible (f
);
2201 SET_FRAME_GARBAGED (f
);
2207 DEFUN ("focus-frame", Ffocus_frame
, Sfocus_frame
, 1, 1, 0,
2208 "Set the focus on FRAME.")
2212 CHECK_LIVE_FRAME (frame
, 0);
2214 if (FRAME_X_P (XFRAME (frame
)))
2217 x_focus_on_frame (XFRAME (frame
));
2225 DEFUN ("unfocus-frame", Funfocus_frame
, Sunfocus_frame
, 0, 0, 0,
2226 "If a frame has been focused, release it.")
2232 x_unfocus_frame (x_focus_frame
);
2240 /* Computes an X-window size and position either from geometry GEO
2243 F is a frame. It specifies an X window which is used to
2244 determine which display to compute for. Its font, borders
2245 and colors control how the rectangle will be displayed.
2247 X and Y are where to store the positions chosen.
2248 WIDTH and HEIGHT are where to store the sizes chosen.
2250 GEO is the geometry that may specify some of the info.
2251 STR is a prompt to display.
2252 HSCROLL and VSCROLL say whether we have horiz and vert scroll bars. */
2255 x_rubber_band (f
, x
, y
, width
, height
, geo
, str
, hscroll
, vscroll
)
2257 int *x
, *y
, *width
, *height
;
2260 int hscroll
, vscroll
;
2266 int background_color
;
2272 background_color
= f
->display
.x
->background_pixel
;
2273 border_color
= f
->display
.x
->border_pixel
;
2275 frame
.bdrwidth
= f
->display
.x
->border_width
;
2276 frame
.border
= XMakeTile (border_color
);
2277 frame
.background
= XMakeTile (background_color
);
2278 tempwindow
= XCreateTerm (str
, "emacs", geo
, default_window
, &frame
, 10, 5,
2279 (2 * f
->display
.x
->internal_border_width
2280 + (vscroll
? VSCROLL_WIDTH
: 0)),
2281 (2 * f
->display
.x
->internal_border_width
2282 + (hscroll
? HSCROLL_HEIGHT
: 0)),
2283 width
, height
, f
->display
.x
->font
,
2284 FONT_WIDTH (f
->display
.x
->font
),
2285 FONT_HEIGHT (f
->display
.x
->font
));
2286 XFreePixmap (frame
.border
);
2287 XFreePixmap (frame
.background
);
2289 if (tempwindow
!= 0)
2291 XQueryWindow (tempwindow
, &wininfo
);
2292 XDestroyWindow (tempwindow
);
2297 /* Coordinates we got are relative to the root window.
2298 Convert them to coordinates relative to desired parent window
2299 by scanning from there up to the root. */
2300 tempwindow
= f
->display
.x
->parent_desc
;
2301 while (tempwindow
!= ROOT_WINDOW
)
2305 XQueryWindow (tempwindow
, &wininfo
);
2308 XQueryTree (tempwindow
, &tempwindow
, &nchildren
, &children
);
2313 return tempwindow
!= 0;
2315 #endif /* not HAVE_X11 */
2317 DEFUN ("x-color-defined-p", Fx_color_defined_p
, Sx_color_defined_p
, 1, 1, 0,
2318 "Return t if the current X display supports the color named COLOR.")
2324 CHECK_STRING (color
, 0);
2326 if (defined_color (XSTRING (color
)->data
, &foo
))
2332 DEFUN ("x-display-color-p", Fx_display_color_p
, Sx_display_color_p
, 0, 0, 0,
2333 "Return t if the X screen currently in use supports color.")
2336 if (x_screen_planes
<= 2)
2339 switch (screen_visual
->class)
2352 DEFUN ("x-display-pixel-width", Fx_display_pixel_width
, Sx_display_pixel_width
,
2354 "Returns the width in pixels of the display FRAME is on.")
2358 Display
*dpy
= x_current_display
;
2359 return make_number (DisplayWidth (dpy
, DefaultScreen (dpy
)));
2362 DEFUN ("x-display-pixel-height", Fx_display_pixel_height
,
2363 Sx_display_pixel_height
, 0, 1, 0,
2364 "Returns the height in pixels of the display FRAME is on.")
2368 Display
*dpy
= x_current_display
;
2369 return make_number (DisplayHeight (dpy
, DefaultScreen (dpy
)));
2372 DEFUN ("x-display-planes", Fx_display_planes
, Sx_display_planes
,
2374 "Returns the number of bitplanes of the display FRAME is on.")
2378 Display
*dpy
= x_current_display
;
2379 return make_number (DisplayPlanes (dpy
, DefaultScreen (dpy
)));
2382 DEFUN ("x-display-color-cells", Fx_display_color_cells
, Sx_display_color_cells
,
2384 "Returns the number of color cells of the display FRAME is on.")
2388 Display
*dpy
= x_current_display
;
2389 return make_number (DisplayCells (dpy
, DefaultScreen (dpy
)));
2392 DEFUN ("x-server-vendor", Fx_server_vendor
, Sx_server_vendor
, 0, 1, 0,
2393 "Returns the vendor ID string of the X server FRAME is on.")
2397 Display
*dpy
= x_current_display
;
2399 vendor
= ServerVendor (dpy
);
2400 if (! vendor
) vendor
= "";
2401 return build_string (vendor
);
2404 DEFUN ("x-server-version", Fx_server_version
, Sx_server_version
, 0, 1, 0,
2405 "Returns the version numbers of the X server in use.\n\
2406 The value is a list of three integers: the major and minor\n\
2407 version numbers of the X Protocol in use, and the vendor-specific release\n\
2408 number. See also the variable `x-server-vendor'.")
2412 Display
*dpy
= x_current_display
;
2413 return Fcons (make_number (ProtocolVersion (dpy
)),
2414 Fcons (make_number (ProtocolRevision (dpy
)),
2415 Fcons (make_number (VendorRelease (dpy
)), Qnil
)));
2418 DEFUN ("x-display-screens", Fx_display_screens
, Sx_display_screens
, 0, 1, 0,
2419 "Returns the number of screens on the X server FRAME is on.")
2423 return make_number (ScreenCount (x_current_display
));
2426 DEFUN ("x-display-mm-height", Fx_display_mm_height
, Sx_display_mm_height
, 0, 1, 0,
2427 "Returns the height in millimeters of the X screen FRAME is on.")
2431 return make_number (HeightMMOfScreen (x_screen
));
2434 DEFUN ("x-display-mm-width", Fx_display_mm_width
, Sx_display_mm_width
, 0, 1, 0,
2435 "Returns the width in millimeters of the X screen FRAME is on.")
2439 return make_number (WidthMMOfScreen (x_screen
));
2442 DEFUN ("x-display-backing-store", Fx_display_backing_store
,
2443 Sx_display_backing_store
, 0, 1, 0,
2444 "Returns an indication of whether the X screen FRAME is on does backing store.\n\
2445 The value may be `always', `when-mapped', or `not-useful'.")
2449 switch (DoesBackingStore (x_screen
))
2452 return intern ("always");
2455 return intern ("when-mapped");
2458 return intern ("not-useful");
2461 error ("Strange value for BackingStore parameter of screen");
2465 DEFUN ("x-display-visual-class", Fx_display_visual_class
,
2466 Sx_display_visual_class
, 0, 1, 0,
2467 "Returns the visual class of the display `screen' is on.\n\
2468 The value is one of the symbols `static-gray', `gray-scale',\n\
2469 `static-color', `pseudo-color', `true-color', or `direct-color'.")
2473 switch (screen_visual
->class)
2475 case StaticGray
: return (intern ("static-gray"));
2476 case GrayScale
: return (intern ("gray-scale"));
2477 case StaticColor
: return (intern ("static-color"));
2478 case PseudoColor
: return (intern ("pseudo-color"));
2479 case TrueColor
: return (intern ("true-color"));
2480 case DirectColor
: return (intern ("direct-color"));
2482 error ("Display has an unknown visual class");
2486 DEFUN ("x-display-save-under", Fx_display_save_under
,
2487 Sx_display_save_under
, 0, 1, 0,
2488 "Returns t if the X screen FRAME is on supports the save-under feature.")
2492 if (DoesSaveUnders (x_screen
) == True
)
2499 register struct frame
*f
;
2501 return PIXEL_WIDTH (f
);
2505 register struct frame
*f
;
2507 return PIXEL_HEIGHT (f
);
2511 register struct frame
*f
;
2513 return FONT_WIDTH (f
->display
.x
->font
);
2517 register struct frame
*f
;
2519 return FONT_HEIGHT (f
->display
.x
->font
);
2522 #if 0 /* These no longer seem like the right way to do things. */
2524 /* Draw a rectangle on the frame with left top corner including
2525 the character specified by LEFT_CHAR and TOP_CHAR. The rectangle is
2526 CHARS by LINES wide and long and is the color of the cursor. */
2529 x_rectangle (f
, gc
, left_char
, top_char
, chars
, lines
)
2530 register struct frame
*f
;
2532 register int top_char
, left_char
, chars
, lines
;
2536 int left
= (left_char
* FONT_WIDTH (f
->display
.x
->font
)
2537 + f
->display
.x
->internal_border_width
);
2538 int top
= (top_char
* FONT_HEIGHT (f
->display
.x
->font
)
2539 + f
->display
.x
->internal_border_width
);
2542 width
= FONT_WIDTH (f
->display
.x
->font
) / 2;
2544 width
= FONT_WIDTH (f
->display
.x
->font
) * chars
;
2546 height
= FONT_HEIGHT (f
->display
.x
->font
) / 2;
2548 height
= FONT_HEIGHT (f
->display
.x
->font
) * lines
;
2550 XDrawRectangle (x_current_display
, FRAME_X_WINDOW (f
),
2551 gc
, left
, top
, width
, height
);
2554 DEFUN ("x-draw-rectangle", Fx_draw_rectangle
, Sx_draw_rectangle
, 5, 5, 0,
2555 "Draw a rectangle on FRAME between coordinates specified by\n\
2556 numbers X0, Y0, X1, Y1 in the cursor pixel.")
2557 (frame
, X0
, Y0
, X1
, Y1
)
2558 register Lisp_Object frame
, X0
, X1
, Y0
, Y1
;
2560 register int x0
, y0
, x1
, y1
, top
, left
, n_chars
, n_lines
;
2562 CHECK_LIVE_FRAME (frame
, 0);
2563 CHECK_NUMBER (X0
, 0);
2564 CHECK_NUMBER (Y0
, 1);
2565 CHECK_NUMBER (X1
, 2);
2566 CHECK_NUMBER (Y1
, 3);
2576 n_lines
= y1
- y0
+ 1;
2581 n_lines
= y0
- y1
+ 1;
2587 n_chars
= x1
- x0
+ 1;
2592 n_chars
= x0
- x1
+ 1;
2596 x_rectangle (XFRAME (frame
), XFRAME (frame
)->display
.x
->cursor_gc
,
2597 left
, top
, n_chars
, n_lines
);
2603 DEFUN ("x-erase-rectangle", Fx_erase_rectangle
, Sx_erase_rectangle
, 5, 5, 0,
2604 "Draw a rectangle drawn on FRAME between coordinates\n\
2605 X0, Y0, X1, Y1 in the regular background-pixel.")
2606 (frame
, X0
, Y0
, X1
, Y1
)
2607 register Lisp_Object frame
, X0
, Y0
, X1
, Y1
;
2609 register int x0
, y0
, x1
, y1
, top
, left
, n_chars
, n_lines
;
2611 CHECK_FRAME (frame
, 0);
2612 CHECK_NUMBER (X0
, 0);
2613 CHECK_NUMBER (Y0
, 1);
2614 CHECK_NUMBER (X1
, 2);
2615 CHECK_NUMBER (Y1
, 3);
2625 n_lines
= y1
- y0
+ 1;
2630 n_lines
= y0
- y1
+ 1;
2636 n_chars
= x1
- x0
+ 1;
2641 n_chars
= x0
- x1
+ 1;
2645 x_rectangle (XFRAME (frame
), XFRAME (frame
)->display
.x
->reverse_gc
,
2646 left
, top
, n_chars
, n_lines
);
2652 /* Draw lines around the text region beginning at the character position
2653 TOP_X, TOP_Y and ending at BOTTOM_X and BOTTOM_Y. GC specifies the
2654 pixel and line characteristics. */
2656 #define line_len(line) (FRAME_CURRENT_GLYPHS (f)->used[(line)])
2659 outline_region (f
, gc
, top_x
, top_y
, bottom_x
, bottom_y
)
2660 register struct frame
*f
;
2662 int top_x
, top_y
, bottom_x
, bottom_y
;
2664 register int ibw
= f
->display
.x
->internal_border_width
;
2665 register int font_w
= FONT_WIDTH (f
->display
.x
->font
);
2666 register int font_h
= FONT_HEIGHT (f
->display
.x
->font
);
2668 int x
= line_len (y
);
2669 XPoint
*pixel_points
= (XPoint
*)
2670 alloca (((bottom_y
- top_y
+ 2) * 4) * sizeof (XPoint
));
2671 register XPoint
*this_point
= pixel_points
;
2673 /* Do the horizontal top line/lines */
2676 this_point
->x
= ibw
;
2677 this_point
->y
= ibw
+ (font_h
* top_y
);
2680 this_point
->x
= ibw
+ (font_w
/ 2); /* Half-size for newline chars. */
2682 this_point
->x
= ibw
+ (font_w
* x
);
2683 this_point
->y
= (this_point
- 1)->y
;
2687 this_point
->x
= ibw
;
2688 this_point
->y
= ibw
+ (font_h
* (top_y
+ 1));
2690 this_point
->x
= ibw
+ (font_w
* top_x
);
2691 this_point
->y
= (this_point
- 1)->y
;
2693 this_point
->x
= (this_point
- 1)->x
;
2694 this_point
->y
= ibw
+ (font_h
* top_y
);
2696 this_point
->x
= ibw
+ (font_w
* x
);
2697 this_point
->y
= (this_point
- 1)->y
;
2700 /* Now do the right side. */
2701 while (y
< bottom_y
)
2702 { /* Right vertical edge */
2704 this_point
->x
= (this_point
- 1)->x
;
2705 this_point
->y
= ibw
+ (font_h
* (y
+ 1));
2708 y
++; /* Horizontal connection to next line */
2711 this_point
->x
= ibw
+ (font_w
/ 2);
2713 this_point
->x
= ibw
+ (font_w
* x
);
2715 this_point
->y
= (this_point
- 1)->y
;
2718 /* Now do the bottom and connect to the top left point. */
2719 this_point
->x
= ibw
+ (font_w
* (bottom_x
+ 1));
2722 this_point
->x
= (this_point
- 1)->x
;
2723 this_point
->y
= ibw
+ (font_h
* (bottom_y
+ 1));
2725 this_point
->x
= ibw
;
2726 this_point
->y
= (this_point
- 1)->y
;
2728 this_point
->x
= pixel_points
->x
;
2729 this_point
->y
= pixel_points
->y
;
2731 XDrawLines (x_current_display
, FRAME_X_WINDOW (f
),
2733 (this_point
- pixel_points
+ 1), CoordModeOrigin
);
2736 DEFUN ("x-contour-region", Fx_contour_region
, Sx_contour_region
, 1, 1, 0,
2737 "Highlight the region between point and the character under the mouse\n\
2740 register Lisp_Object event
;
2742 register int x0
, y0
, x1
, y1
;
2743 register struct frame
*f
= selected_frame
;
2744 register int p1
, p2
;
2746 CHECK_CONS (event
, 0);
2749 x0
= XINT (Fcar (Fcar (event
)));
2750 y0
= XINT (Fcar (Fcdr (Fcar (event
))));
2752 /* If the mouse is past the end of the line, don't that area. */
2753 /* ReWrite this... */
2758 if (y1
> y0
) /* point below mouse */
2759 outline_region (f
, f
->display
.x
->cursor_gc
,
2761 else if (y1
< y0
) /* point above mouse */
2762 outline_region (f
, f
->display
.x
->cursor_gc
,
2764 else /* same line: draw horizontal rectangle */
2767 x_rectangle (f
, f
->display
.x
->cursor_gc
,
2768 x0
, y0
, (x1
- x0
+ 1), 1);
2770 x_rectangle (f
, f
->display
.x
->cursor_gc
,
2771 x1
, y1
, (x0
- x1
+ 1), 1);
2774 XFlush (x_current_display
);
2780 DEFUN ("x-uncontour-region", Fx_uncontour_region
, Sx_uncontour_region
, 1, 1, 0,
2781 "Erase any highlighting of the region between point and the character\n\
2782 at X, Y on the selected frame.")
2784 register Lisp_Object event
;
2786 register int x0
, y0
, x1
, y1
;
2787 register struct frame
*f
= selected_frame
;
2790 x0
= XINT (Fcar (Fcar (event
)));
2791 y0
= XINT (Fcar (Fcdr (Fcar (event
))));
2795 if (y1
> y0
) /* point below mouse */
2796 outline_region (f
, f
->display
.x
->reverse_gc
,
2798 else if (y1
< y0
) /* point above mouse */
2799 outline_region (f
, f
->display
.x
->reverse_gc
,
2801 else /* same line: draw horizontal rectangle */
2804 x_rectangle (f
, f
->display
.x
->reverse_gc
,
2805 x0
, y0
, (x1
- x0
+ 1), 1);
2807 x_rectangle (f
, f
->display
.x
->reverse_gc
,
2808 x1
, y1
, (x0
- x1
+ 1), 1);
2816 int contour_begin_x
, contour_begin_y
;
2817 int contour_end_x
, contour_end_y
;
2818 int contour_npoints
;
2820 /* Clip the top part of the contour lines down (and including) line Y_POS.
2821 If X_POS is in the middle (rather than at the end) of the line, drop
2822 down a line at that character. */
2825 clip_contour_top (y_pos
, x_pos
)
2827 register XPoint
*begin
= contour_lines
[y_pos
].top_left
;
2828 register XPoint
*end
;
2829 register int npoints
;
2830 register struct display_line
*line
= selected_frame
->phys_lines
[y_pos
+ 1];
2832 if (x_pos
>= line
->len
- 1) /* Draw one, straight horizontal line. */
2834 end
= contour_lines
[y_pos
].top_right
;
2835 npoints
= (end
- begin
+ 1);
2836 XDrawLines (x_current_display
, contour_window
,
2837 contour_erase_gc
, begin_erase
, npoints
, CoordModeOrigin
);
2839 bcopy (end
, begin
+ 1, contour_last_point
- end
+ 1);
2840 contour_last_point
-= (npoints
- 2);
2841 XDrawLines (x_current_display
, contour_window
,
2842 contour_erase_gc
, begin
, 2, CoordModeOrigin
);
2843 XFlush (x_current_display
);
2845 /* Now, update contour_lines structure. */
2850 register XPoint
*p
= begin
+ 1;
2851 end
= contour_lines
[y_pos
].bottom_right
;
2852 npoints
= (end
- begin
+ 1);
2853 XDrawLines (x_current_display
, contour_window
,
2854 contour_erase_gc
, begin_erase
, npoints
, CoordModeOrigin
);
2857 p
->x
= ibw
+ (font_w
* (x_pos
+ 1));
2859 p
->y
= begin
->y
+ font_h
;
2861 bcopy (end
, begin
+ 3, contour_last_point
- end
+ 1);
2862 contour_last_point
-= (npoints
- 5);
2863 XDrawLines (x_current_display
, contour_window
,
2864 contour_erase_gc
, begin
, 4, CoordModeOrigin
);
2865 XFlush (x_current_display
);
2867 /* Now, update contour_lines structure. */
2871 /* Erase the top horzontal lines of the contour, and then extend
2872 the contour upwards. */
2875 extend_contour_top (line
)
2880 clip_contour_bottom (x_pos
, y_pos
)
2886 extend_contour_bottom (x_pos
, y_pos
)
2890 DEFUN ("x-select-region", Fx_select_region
, Sx_select_region
, 1, 1, "e",
2895 register struct frame
*f
= selected_frame
;
2896 register int point_x
= f
->cursor_x
;
2897 register int point_y
= f
->cursor_y
;
2898 register int mouse_below_point
;
2899 register Lisp_Object obj
;
2900 register int x_contour_x
, x_contour_y
;
2902 x_contour_x
= x_mouse_x
;
2903 x_contour_y
= x_mouse_y
;
2904 if (x_contour_y
> point_y
|| (x_contour_y
== point_y
2905 && x_contour_x
> point_x
))
2907 mouse_below_point
= 1;
2908 outline_region (f
, f
->display
.x
->cursor_gc
, point_x
, point_y
,
2909 x_contour_x
, x_contour_y
);
2913 mouse_below_point
= 0;
2914 outline_region (f
, f
->display
.x
->cursor_gc
, x_contour_x
, x_contour_y
,
2920 obj
= read_char (-1, 0, 0, Qnil
, 0);
2921 if (XTYPE (obj
) != Lisp_Cons
)
2924 if (mouse_below_point
)
2926 if (x_mouse_y
<= point_y
) /* Flipped. */
2928 mouse_below_point
= 0;
2930 outline_region (f
, f
->display
.x
->reverse_gc
, point_x
, point_y
,
2931 x_contour_x
, x_contour_y
);
2932 outline_region (f
, f
->display
.x
->cursor_gc
, x_mouse_x
, x_mouse_y
,
2935 else if (x_mouse_y
< x_contour_y
) /* Bottom clipped. */
2937 clip_contour_bottom (x_mouse_y
);
2939 else if (x_mouse_y
> x_contour_y
) /* Bottom extended. */
2941 extend_bottom_contour (x_mouse_y
);
2944 x_contour_x
= x_mouse_x
;
2945 x_contour_y
= x_mouse_y
;
2947 else /* mouse above or same line as point */
2949 if (x_mouse_y
>= point_y
) /* Flipped. */
2951 mouse_below_point
= 1;
2953 outline_region (f
, f
->display
.x
->reverse_gc
,
2954 x_contour_x
, x_contour_y
, point_x
, point_y
);
2955 outline_region (f
, f
->display
.x
->cursor_gc
, point_x
, point_y
,
2956 x_mouse_x
, x_mouse_y
);
2958 else if (x_mouse_y
> x_contour_y
) /* Top clipped. */
2960 clip_contour_top (x_mouse_y
);
2962 else if (x_mouse_y
< x_contour_y
) /* Top extended. */
2964 extend_contour_top (x_mouse_y
);
2969 unread_command_event
= obj
;
2970 if (mouse_below_point
)
2972 contour_begin_x
= point_x
;
2973 contour_begin_y
= point_y
;
2974 contour_end_x
= x_contour_x
;
2975 contour_end_y
= x_contour_y
;
2979 contour_begin_x
= x_contour_x
;
2980 contour_begin_y
= x_contour_y
;
2981 contour_end_x
= point_x
;
2982 contour_end_y
= point_y
;
2987 DEFUN ("x-horizontal-line", Fx_horizontal_line
, Sx_horizontal_line
, 1, 1, "e",
2992 register Lisp_Object obj
;
2993 struct frame
*f
= selected_frame
;
2994 register struct window
*w
= XWINDOW (selected_window
);
2995 register GC line_gc
= f
->display
.x
->cursor_gc
;
2996 register GC erase_gc
= f
->display
.x
->reverse_gc
;
2998 char dash_list
[] = {6, 4, 6, 4};
3000 XGCValues gc_values
;
3002 register int previous_y
;
3003 register int line
= (x_mouse_y
+ 1) * FONT_HEIGHT (f
->display
.x
->font
)
3004 + f
->display
.x
->internal_border_width
;
3005 register int left
= f
->display
.x
->internal_border_width
3007 * FONT_WIDTH (f
->display
.x
->font
));
3008 register int right
= left
+ (w
->width
3009 * FONT_WIDTH (f
->display
.x
->font
))
3010 - f
->display
.x
->internal_border_width
;
3014 gc_values
.foreground
= f
->display
.x
->cursor_pixel
;
3015 gc_values
.background
= f
->display
.x
->background_pixel
;
3016 gc_values
.line_width
= 1;
3017 gc_values
.line_style
= LineOnOffDash
;
3018 gc_values
.cap_style
= CapRound
;
3019 gc_values
.join_style
= JoinRound
;
3021 line_gc
= XCreateGC (x_current_display
, FRAME_X_WINDOW (f
),
3022 GCLineStyle
| GCJoinStyle
| GCCapStyle
3023 | GCLineWidth
| GCForeground
| GCBackground
,
3025 XSetDashes (x_current_display
, line_gc
, 0, dash_list
, dashes
);
3026 gc_values
.foreground
= f
->display
.x
->background_pixel
;
3027 gc_values
.background
= f
->display
.x
->foreground_pixel
;
3028 erase_gc
= XCreateGC (x_current_display
, FRAME_X_WINDOW (f
),
3029 GCLineStyle
| GCJoinStyle
| GCCapStyle
3030 | GCLineWidth
| GCForeground
| GCBackground
,
3032 XSetDashes (x_current_display
, erase_gc
, 0, dash_list
, dashes
);
3038 if (x_mouse_y
>= XINT (w
->top
)
3039 && x_mouse_y
< XINT (w
->top
) + XINT (w
->height
) - 1)
3041 previous_y
= x_mouse_y
;
3042 line
= (x_mouse_y
+ 1) * FONT_HEIGHT (f
->display
.x
->font
)
3043 + f
->display
.x
->internal_border_width
;
3044 XDrawLine (x_current_display
, FRAME_X_WINDOW (f
),
3045 line_gc
, left
, line
, right
, line
);
3052 obj
= read_char (-1, 0, 0, Qnil
, 0);
3053 if ((XTYPE (obj
) != Lisp_Cons
)
3054 || (! EQ (Fcar (Fcdr (Fcdr (obj
))),
3055 Qvertical_scroll_bar
))
3059 XDrawLine (x_current_display
, FRAME_X_WINDOW (f
),
3060 erase_gc
, left
, line
, right
, line
);
3062 unread_command_event
= obj
;
3064 XFreeGC (x_current_display
, line_gc
);
3065 XFreeGC (x_current_display
, erase_gc
);
3070 while (x_mouse_y
== previous_y
);
3073 XDrawLine (x_current_display
, FRAME_X_WINDOW (f
),
3074 erase_gc
, left
, line
, right
, line
);
3080 /* Offset in buffer of character under the pointer, or 0. */
3081 int mouse_buffer_offset
;
3084 /* These keep track of the rectangle following the pointer. */
3085 int mouse_track_top
, mouse_track_left
, mouse_track_width
;
3087 DEFUN ("x-track-pointer", Fx_track_pointer
, Sx_track_pointer
, 0, 0, 0,
3088 "Track the pointer.")
3091 static Cursor current_pointer_shape
;
3092 FRAME_PTR f
= x_mouse_frame
;
3095 if (EQ (Vmouse_frame_part
, Qtext_part
)
3096 && (current_pointer_shape
!= f
->display
.x
->nontext_cursor
))
3101 current_pointer_shape
= f
->display
.x
->nontext_cursor
;
3102 XDefineCursor (x_current_display
,
3104 current_pointer_shape
);
3106 buf
= XBUFFER (XWINDOW (Vmouse_window
)->buffer
);
3107 c
= *(BUF_CHAR_ADDRESS (buf
, mouse_buffer_offset
));
3109 else if (EQ (Vmouse_frame_part
, Qmodeline_part
)
3110 && (current_pointer_shape
!= f
->display
.x
->modeline_cursor
))
3112 current_pointer_shape
= f
->display
.x
->modeline_cursor
;
3113 XDefineCursor (x_current_display
,
3115 current_pointer_shape
);
3124 DEFUN ("x-track-pointer", Fx_track_pointer
, Sx_track_pointer
, 1, 1, "e",
3125 "Draw rectangle around character under mouse pointer, if there is one.")
3129 struct window
*w
= XWINDOW (Vmouse_window
);
3130 struct frame
*f
= XFRAME (WINDOW_FRAME (w
));
3131 struct buffer
*b
= XBUFFER (w
->buffer
);
3134 if (! EQ (Vmouse_window
, selected_window
))
3137 if (EQ (event
, Qnil
))
3141 x_read_mouse_position (selected_frame
, &x
, &y
);
3145 mouse_track_width
= 0;
3146 mouse_track_left
= mouse_track_top
= -1;
3150 if ((x_mouse_x
!= mouse_track_left
3151 && (x_mouse_x
< mouse_track_left
3152 || x_mouse_x
> (mouse_track_left
+ mouse_track_width
)))
3153 || x_mouse_y
!= mouse_track_top
)
3155 int hp
= 0; /* Horizontal position */
3156 int len
= FRAME_CURRENT_GLYPHS (f
)->used
[x_mouse_y
];
3157 int p
= FRAME_CURRENT_GLYPHS (f
)->bufp
[x_mouse_y
];
3158 int tab_width
= XINT (b
->tab_width
);
3159 int ctl_arrow_p
= !NILP (b
->ctl_arrow
);
3161 int mode_line_vpos
= XFASTINT (w
->height
) + XFASTINT (w
->top
) - 1;
3162 int in_mode_line
= 0;
3164 if (! FRAME_CURRENT_GLYPHS (f
)->enable
[x_mouse_y
])
3167 /* Erase previous rectangle. */
3168 if (mouse_track_width
)
3170 x_rectangle (f
, f
->display
.x
->reverse_gc
,
3171 mouse_track_left
, mouse_track_top
,
3172 mouse_track_width
, 1);
3174 if ((mouse_track_left
== f
->phys_cursor_x
3175 || mouse_track_left
== f
->phys_cursor_x
- 1)
3176 && mouse_track_top
== f
->phys_cursor_y
)
3178 x_display_cursor (f
, 1);
3182 mouse_track_left
= x_mouse_x
;
3183 mouse_track_top
= x_mouse_y
;
3184 mouse_track_width
= 0;
3186 if (mouse_track_left
> len
) /* Past the end of line. */
3189 if (mouse_track_top
== mode_line_vpos
)
3195 if (tab_width
<= 0 || tab_width
> 20) tab_width
= 8;
3199 if (len
== f
->width
&& hp
== len
- 1 && c
!= '\n')
3205 mouse_track_width
= tab_width
- (hp
% tab_width
);
3207 hp
+= mouse_track_width
;
3210 mouse_track_left
= hp
- mouse_track_width
;
3216 mouse_track_width
= -1;
3220 if (ctl_arrow_p
&& (c
< 040 || c
== 0177))
3225 mouse_track_width
= 2;
3230 mouse_track_left
= hp
- mouse_track_width
;
3236 mouse_track_width
= 1;
3243 while (hp
<= x_mouse_x
);
3246 if (mouse_track_width
) /* Over text; use text pointer shape. */
3248 XDefineCursor (x_current_display
,
3250 f
->display
.x
->text_cursor
);
3251 x_rectangle (f
, f
->display
.x
->cursor_gc
,
3252 mouse_track_left
, mouse_track_top
,
3253 mouse_track_width
, 1);
3255 else if (in_mode_line
)
3256 XDefineCursor (x_current_display
,
3258 f
->display
.x
->modeline_cursor
);
3260 XDefineCursor (x_current_display
,
3262 f
->display
.x
->nontext_cursor
);
3265 XFlush (x_current_display
);
3268 obj
= read_char (-1, 0, 0, Qnil
, 0);
3271 while (XTYPE (obj
) == Lisp_Cons
/* Mouse event */
3272 && EQ (Fcar (Fcdr (Fcdr (obj
))), Qnil
) /* Not scroll bar */
3273 && EQ (Vmouse_depressed
, Qnil
) /* Only motion events */
3274 && EQ (Vmouse_window
, selected_window
) /* In this window */
3277 unread_command_event
= obj
;
3279 if (mouse_track_width
)
3281 x_rectangle (f
, f
->display
.x
->reverse_gc
,
3282 mouse_track_left
, mouse_track_top
,
3283 mouse_track_width
, 1);
3284 mouse_track_width
= 0;
3285 if ((mouse_track_left
== f
->phys_cursor_x
3286 || mouse_track_left
- 1 == f
->phys_cursor_x
)
3287 && mouse_track_top
== f
->phys_cursor_y
)
3289 x_display_cursor (f
, 1);
3292 XDefineCursor (x_current_display
,
3294 f
->display
.x
->nontext_cursor
);
3295 XFlush (x_current_display
);
3305 /* Draw a pixmap specified by IMAGE_DATA of dimensions WIDTH and HEIGHT
3306 on the frame F at position X, Y. */
3308 x_draw_pixmap (f
, x
, y
, image_data
, width
, height
)
3310 int x
, y
, width
, height
;
3315 image
= XCreateBitmapFromData (x_current_display
,
3316 FRAME_X_WINDOW (f
), image_data
,
3318 XCopyPlane (x_current_display
, image
, FRAME_X_WINDOW (f
),
3319 f
->display
.x
->normal_gc
, 0, 0, width
, height
, x
, y
);
3324 DEFUN ("x-store-cut-buffer", Fx_store_cut_buffer
, Sx_store_cut_buffer
,
3325 1, 1, "sStore text in cut buffer: ",
3326 "Store contents of STRING into the cut buffer of the X window system.")
3328 register Lisp_Object string
;
3332 CHECK_STRING (string
, 1);
3333 if (! FRAME_X_P (selected_frame
))
3334 error ("Selected frame does not understand X protocol.");
3337 XStoreBytes ((char *) XSTRING (string
)->data
, XSTRING (string
)->size
);
3343 DEFUN ("x-get-cut-buffer", Fx_get_cut_buffer
, Sx_get_cut_buffer
, 0, 0, 0,
3344 "Return contents of cut buffer of the X window system, as a string.")
3348 register Lisp_Object string
;
3353 d
= XFetchBytes (&len
);
3354 string
= make_string (d
, len
);
3362 DEFUN ("x-rebind-key", Fx_rebind_key
, Sx_rebind_key
, 3, 3, 0,
3363 "Rebind X keysym KEYSYM, with MODIFIERS, to generate NEWSTRING.\n\
3364 KEYSYM is a string which conforms to the X keysym definitions found\n\
3365 in X11/keysymdef.h, sans the initial XK_. MODIFIERS is nil or a\n\
3366 list of strings specifying modifier keys such as Control_L, which must\n\
3367 also be depressed for NEWSTRING to appear.")
3368 (x_keysym
, modifiers
, newstring
)
3369 register Lisp_Object x_keysym
;
3370 register Lisp_Object modifiers
;
3371 register Lisp_Object newstring
;
3374 register KeySym keysym
;
3375 KeySym modifier_list
[16];
3377 CHECK_STRING (x_keysym
, 1);
3378 CHECK_STRING (newstring
, 3);
3380 keysym
= XStringToKeysym ((char *) XSTRING (x_keysym
)->data
);
3381 if (keysym
== NoSymbol
)
3382 error ("Keysym does not exist");
3384 if (NILP (modifiers
))
3385 XRebindKeysym (x_current_display
, keysym
, modifier_list
, 0,
3386 XSTRING (newstring
)->data
, XSTRING (newstring
)->size
);
3389 register Lisp_Object rest
, mod
;
3392 for (rest
= modifiers
; !NILP (rest
); rest
= Fcdr (rest
))
3395 error ("Can't have more than 16 modifiers");
3398 CHECK_STRING (mod
, 3);
3399 modifier_list
[i
] = XStringToKeysym ((char *) XSTRING (mod
)->data
);
3400 if (modifier_list
[i
] == NoSymbol
3401 || !IsModifierKey (modifier_list
[i
]))
3402 error ("Element is not a modifier keysym");
3406 XRebindKeysym (x_current_display
, keysym
, modifier_list
, i
,
3407 XSTRING (newstring
)->data
, XSTRING (newstring
)->size
);
3413 DEFUN ("x-rebind-keys", Fx_rebind_keys
, Sx_rebind_keys
, 2, 2, 0,
3414 "Rebind KEYCODE to list of strings STRINGS.\n\
3415 STRINGS should be a list of 16 elements, one for each shift combination.\n\
3416 nil as element means don't change.\n\
3417 See the documentation of `x-rebind-key' for more information.")
3419 register Lisp_Object keycode
;
3420 register Lisp_Object strings
;
3422 register Lisp_Object item
;
3423 register unsigned char *rawstring
;
3424 KeySym rawkey
, modifier
[1];
3426 register unsigned i
;
3428 CHECK_NUMBER (keycode
, 1);
3429 CHECK_CONS (strings
, 2);
3430 rawkey
= (KeySym
) ((unsigned) (XINT (keycode
))) & 255;
3431 for (i
= 0; i
<= 15; strings
= Fcdr (strings
), i
++)
3433 item
= Fcar (strings
);
3436 CHECK_STRING (item
, 2);
3437 strsize
= XSTRING (item
)->size
;
3438 rawstring
= (unsigned char *) xmalloc (strsize
);
3439 bcopy (XSTRING (item
)->data
, rawstring
, strsize
);
3440 modifier
[1] = 1 << i
;
3441 XRebindKeysym (x_current_display
, rawkey
, modifier
, 1,
3442 rawstring
, strsize
);
3448 DEFUN ("x-rebind-key", Fx_rebind_key
, Sx_rebind_key
, 3, 3, 0,
3449 "Rebind KEYCODE, with shift bits SHIFT-MASK, to new string NEWSTRING.\n\
3450 KEYCODE and SHIFT-MASK should be numbers representing the X keyboard code\n\
3451 and shift mask respectively. NEWSTRING is an arbitrary string of keystrokes.\n\
3452 If SHIFT-MASK is nil, then KEYCODE's key will be bound to NEWSTRING for\n\
3453 all shift combinations.\n\
3454 Shift Lock 1 Shift 2\n\
3457 For values of KEYCODE, see /usr/lib/Xkeymap.txt (remember that the codes\n\
3458 in that file are in octal!)\n\
3460 NOTE: due to an X bug, this function will not take effect unless one has\n\
3461 a `~/.Xkeymap' file. (See the documentation for the `keycomp' program.)\n\
3462 This problem will be fixed in X version 11.")
3464 (keycode
, shift_mask
, newstring
)
3465 register Lisp_Object keycode
;
3466 register Lisp_Object shift_mask
;
3467 register Lisp_Object newstring
;
3470 int keysym
, rawshift
;
3473 CHECK_NUMBER (keycode
, 1);
3474 if (!NILP (shift_mask
))
3475 CHECK_NUMBER (shift_mask
, 2);
3476 CHECK_STRING (newstring
, 3);
3477 strsize
= XSTRING (newstring
)->size
;
3478 rawstring
= (char *) xmalloc (strsize
);
3479 bcopy (XSTRING (newstring
)->data
, rawstring
, strsize
);
3481 keysym
= ((unsigned) (XINT (keycode
))) & 255;
3483 if (NILP (shift_mask
))
3485 for (i
= 0; i
<= 15; i
++)
3486 XRebindCode (keysym
, i
<<11, rawstring
, strsize
);
3490 rawshift
= (((unsigned) (XINT (shift_mask
))) & 15) << 11;
3491 XRebindCode (keysym
, rawshift
, rawstring
, strsize
);
3496 DEFUN ("x-rebind-keys", Fx_rebind_keys
, Sx_rebind_keys
, 2, 2, 0,
3497 "Rebind KEYCODE to list of strings STRINGS.\n\
3498 STRINGS should be a list of 16 elements, one for each shift combination.\n\
3499 nil as element means don't change.\n\
3500 See the documentation of `x-rebind-key' for more information.")
3502 register Lisp_Object keycode
;
3503 register Lisp_Object strings
;
3505 register Lisp_Object item
;
3506 register char *rawstring
;
3507 KeySym rawkey
, modifier
[1];
3509 register unsigned i
;
3511 CHECK_NUMBER (keycode
, 1);
3512 CHECK_CONS (strings
, 2);
3513 rawkey
= (KeySym
) ((unsigned) (XINT (keycode
))) & 255;
3514 for (i
= 0; i
<= 15; strings
= Fcdr (strings
), i
++)
3516 item
= Fcar (strings
);
3519 CHECK_STRING (item
, 2);
3520 strsize
= XSTRING (item
)->size
;
3521 rawstring
= (char *) xmalloc (strsize
);
3522 bcopy (XSTRING (item
)->data
, rawstring
, strsize
);
3523 XRebindCode (rawkey
, i
<< 11, rawstring
, strsize
);
3528 #endif /* not HAVE_X11 */
3532 select_visual (screen
, depth
)
3534 unsigned int *depth
;
3537 XVisualInfo
*vinfo
, vinfo_template
;
3540 v
= DefaultVisualOfScreen (screen
);
3543 vinfo_template
.visualid
= XVisualIDFromVisual (v
);
3545 vinfo_template
.visualid
= v
->visualid
;
3548 vinfo
= XGetVisualInfo (x_current_display
, VisualIDMask
, &vinfo_template
,
3551 fatal ("Can't get proper X visual info");
3553 if ((1 << vinfo
->depth
) == vinfo
->colormap_size
)
3554 *depth
= vinfo
->depth
;
3558 int n
= vinfo
->colormap_size
- 1;
3567 XFree ((char *) vinfo
);
3570 #endif /* HAVE_X11 */
3572 DEFUN ("x-open-connection", Fx_open_connection
, Sx_open_connection
,
3573 1, 2, 0, "Open a connection to an X server.\n\
3574 DISPLAY is the name of the display to connect to. Optional second\n\
3575 arg XRM_STRING is a string of resources in xrdb format.")
3576 (display
, xrm_string
)
3577 Lisp_Object display
, xrm_string
;
3579 unsigned int n_planes
;
3580 unsigned char *xrm_option
;
3582 CHECK_STRING (display
, 0);
3583 if (x_current_display
!= 0)
3584 error ("X server connection is already initialized");
3586 /* This is what opens the connection and sets x_current_display.
3587 This also initializes many symbols, such as those used for input. */
3588 x_term_init (XSTRING (display
)->data
);
3591 XFASTINT (Vwindow_system_version
) = 11;
3593 if (!EQ (xrm_string
, Qnil
))
3595 CHECK_STRING (xrm_string
, 1);
3596 xrm_option
= (unsigned char *) XSTRING (xrm_string
);
3599 xrm_option
= (unsigned char *) 0;
3600 xrdb
= x_load_resources (x_current_display
, xrm_option
, EMACS_CLASS
);
3602 XrmSetDatabase (x_current_display
, xrdb
);
3604 x_current_display
->db
= xrdb
;
3607 x_screen
= DefaultScreenOfDisplay (x_current_display
);
3609 screen_visual
= select_visual (x_screen
, &n_planes
);
3610 x_screen_planes
= n_planes
;
3611 x_screen_height
= HeightOfScreen (x_screen
);
3612 x_screen_width
= WidthOfScreen (x_screen
);
3614 /* X Atoms used by emacs. */
3615 Xatoms_of_xselect ();
3617 Xatom_wm_protocols
= XInternAtom (x_current_display
, "WM_PROTOCOLS",
3619 Xatom_wm_take_focus
= XInternAtom (x_current_display
, "WM_TAKE_FOCUS",
3621 Xatom_wm_save_yourself
= XInternAtom (x_current_display
, "WM_SAVE_YOURSELF",
3623 Xatom_wm_delete_window
= XInternAtom (x_current_display
, "WM_DELETE_WINDOW",
3625 Xatom_wm_change_state
= XInternAtom (x_current_display
, "WM_CHANGE_STATE",
3627 Xatom_wm_configure_denied
= XInternAtom (x_current_display
,
3628 "WM_CONFIGURE_DENIED", False
);
3629 Xatom_wm_window_moved
= XInternAtom (x_current_display
, "WM_MOVED",
3632 #else /* not HAVE_X11 */
3633 XFASTINT (Vwindow_system_version
) = 10;
3634 #endif /* not HAVE_X11 */
3638 DEFUN ("x-close-current-connection", Fx_close_current_connection
,
3639 Sx_close_current_connection
,
3640 0, 0, 0, "Close the connection to the current X server.")
3644 /* This is ONLY used when killing emacs; For switching displays
3645 we'll have to take care of setting CloseDownMode elsewhere. */
3647 if (x_current_display
)
3650 XSetCloseDownMode (x_current_display
, DestroyAll
);
3651 XCloseDisplay (x_current_display
);
3654 fatal ("No current X display connection to close\n");
3659 DEFUN ("x-synchronize", Fx_synchronize
, Sx_synchronize
,
3660 1, 1, 0, "If ON is non-nil, report X errors as soon as the erring request is made.\n\
3661 If ON is nil, allow buffering of requests.\n\
3662 Turning on synchronization prohibits the Xlib routines from buffering\n\
3663 requests and seriously degrades performance, but makes debugging much\n\
3668 XSynchronize (x_current_display
, !EQ (on
, Qnil
));
3676 /* This is zero if not using X windows. */
3677 x_current_display
= 0;
3679 /* The section below is built by the lisp expression at the top of the file,
3680 just above where these variables are declared. */
3681 /*&&& init symbols here &&&*/
3682 Qauto_raise
= intern ("auto-raise");
3683 staticpro (&Qauto_raise
);
3684 Qauto_lower
= intern ("auto-lower");
3685 staticpro (&Qauto_lower
);
3686 Qbackground_color
= intern ("background-color");
3687 staticpro (&Qbackground_color
);
3688 Qbar
= intern ("bar");
3690 Qborder_color
= intern ("border-color");
3691 staticpro (&Qborder_color
);
3692 Qborder_width
= intern ("border-width");
3693 staticpro (&Qborder_width
);
3694 Qbox
= intern ("box");
3696 Qcursor_color
= intern ("cursor-color");
3697 staticpro (&Qcursor_color
);
3698 Qcursor_type
= intern ("cursor-type");
3699 staticpro (&Qcursor_type
);
3700 Qfont
= intern ("font");
3702 Qforeground_color
= intern ("foreground-color");
3703 staticpro (&Qforeground_color
);
3704 Qgeometry
= intern ("geometry");
3705 staticpro (&Qgeometry
);
3706 Qicon
= intern ("icon");
3708 Qicon_left
= intern ("icon-left");
3709 staticpro (&Qicon_left
);
3710 Qicon_top
= intern ("icon-top");
3711 staticpro (&Qicon_top
);
3712 Qicon_type
= intern ("icon-type");
3713 staticpro (&Qicon_type
);
3714 Qinternal_border_width
= intern ("internal-border-width");
3715 staticpro (&Qinternal_border_width
);
3716 Qleft
= intern ("left");
3718 Qmouse_color
= intern ("mouse-color");
3719 staticpro (&Qmouse_color
);
3720 Qnone
= intern ("none");
3722 Qparent_id
= intern ("parent-id");
3723 staticpro (&Qparent_id
);
3724 Qsuppress_icon
= intern ("suppress-icon");
3725 staticpro (&Qsuppress_icon
);
3726 Qtop
= intern ("top");
3728 Qundefined_color
= intern ("undefined-color");
3729 staticpro (&Qundefined_color
);
3730 Qvertical_scroll_bars
= intern ("vertical-scroll-bars");
3731 staticpro (&Qvertical_scroll_bars
);
3732 Qvisibility
= intern ("visibility");
3733 staticpro (&Qvisibility
);
3734 Qwindow_id
= intern ("window-id");
3735 staticpro (&Qwindow_id
);
3736 Qx_frame_parameter
= intern ("x-frame-parameter");
3737 staticpro (&Qx_frame_parameter
);
3738 /* This is the end of symbol initialization. */
3740 Fput (Qundefined_color
, Qerror_conditions
,
3741 Fcons (Qundefined_color
, Fcons (Qerror
, Qnil
)));
3742 Fput (Qundefined_color
, Qerror_message
,
3743 build_string ("Undefined color"));
3745 init_x_parm_symbols ();
3747 DEFVAR_INT ("mouse-buffer-offset", &mouse_buffer_offset
,
3748 "The buffer offset of the character under the pointer.");
3749 mouse_buffer_offset
= 0;
3751 DEFVAR_INT ("x-pointer-shape", &Vx_pointer_shape
,
3752 "The shape of the pointer when over text.\n\
3753 Changing the value does not affect existing frames\n\
3754 unless you set the mouse color.");
3755 Vx_pointer_shape
= Qnil
;
3758 DEFVAR_INT ("x-nontext-pointer-shape", &Vx_nontext_pointer_shape
,
3759 "The shape of the pointer when not over text.");
3761 Vx_nontext_pointer_shape
= Qnil
;
3764 DEFVAR_INT ("x-mode-pointer-shape", &Vx_mode_pointer_shape
,
3765 "The shape of the pointer when over the mode line.");
3767 Vx_mode_pointer_shape
= Qnil
;
3769 DEFVAR_LISP ("x-cursor-fore-pixel", &Vx_cursor_fore_pixel
,
3770 "A string indicating the foreground color of the cursor box.");
3771 Vx_cursor_fore_pixel
= Qnil
;
3773 DEFVAR_LISP ("mouse-grabbed", &Vmouse_depressed
,
3774 "Non-nil if a mouse button is currently depressed.");
3775 Vmouse_depressed
= Qnil
;
3777 DEFVAR_LISP ("x-no-window-manager", &Vx_no_window_manager
,
3778 "t if no X window manager is in use.");
3781 defsubr (&Sx_get_resource
);
3783 defsubr (&Sx_draw_rectangle
);
3784 defsubr (&Sx_erase_rectangle
);
3785 defsubr (&Sx_contour_region
);
3786 defsubr (&Sx_uncontour_region
);
3788 defsubr (&Sx_display_color_p
);
3789 defsubr (&Sx_color_defined_p
);
3790 defsubr (&Sx_server_vendor
);
3791 defsubr (&Sx_server_version
);
3792 defsubr (&Sx_display_pixel_width
);
3793 defsubr (&Sx_display_pixel_height
);
3794 defsubr (&Sx_display_mm_width
);
3795 defsubr (&Sx_display_mm_height
);
3796 defsubr (&Sx_display_screens
);
3797 defsubr (&Sx_display_planes
);
3798 defsubr (&Sx_display_color_cells
);
3799 defsubr (&Sx_display_visual_class
);
3800 defsubr (&Sx_display_backing_store
);
3801 defsubr (&Sx_display_save_under
);
3803 defsubr (&Sx_track_pointer
);
3804 defsubr (&Sx_grab_pointer
);
3805 defsubr (&Sx_ungrab_pointer
);
3808 defsubr (&Sx_get_default
);
3809 defsubr (&Sx_store_cut_buffer
);
3810 defsubr (&Sx_get_cut_buffer
);
3811 defsubr (&Sx_set_face
);
3813 defsubr (&Sx_parse_geometry
);
3814 defsubr (&Sx_create_frame
);
3815 defsubr (&Sfocus_frame
);
3816 defsubr (&Sunfocus_frame
);
3818 defsubr (&Sx_horizontal_line
);
3820 defsubr (&Sx_rebind_key
);
3821 defsubr (&Sx_rebind_keys
);
3822 defsubr (&Sx_open_connection
);
3823 defsubr (&Sx_close_current_connection
);
3824 defsubr (&Sx_synchronize
);
3827 #endif /* HAVE_X_WINDOWS */