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. */
202 x_window_to_frame (wdesc
)
205 Lisp_Object tail
, frame
;
208 for (tail
= Vframe_list
; CONSP (tail
); tail
= XCONS (tail
)->cdr
)
210 frame
= XCONS (tail
)->car
;
211 if (XTYPE (frame
) != Lisp_Frame
)
214 if (FRAME_X_WINDOW (f
) == wdesc
215 || f
->display
.x
->icon_desc
== wdesc
)
222 /* Connect the frame-parameter names for X frames
223 to the ways of passing the parameter values to the window system.
225 The name of a parameter, as a Lisp symbol,
226 has an `x-frame-parameter' property which is an integer in Lisp
227 but can be interpreted as an `enum x_frame_parm' in C. */
231 X_PARM_FOREGROUND_COLOR
,
232 X_PARM_BACKGROUND_COLOR
,
239 X_PARM_INTERNAL_BORDER_WIDTH
,
243 X_PARM_VERT_SCROLL_BAR
,
245 X_PARM_MENU_BAR_LINES
249 struct x_frame_parm_table
252 void (*setter
)( /* struct frame *frame, Lisp_Object val, oldval */ );
255 void x_set_foreground_color ();
256 void x_set_background_color ();
257 void x_set_mouse_color ();
258 void x_set_cursor_color ();
259 void x_set_border_color ();
260 void x_set_cursor_type ();
261 void x_set_icon_type ();
263 void x_set_border_width ();
264 void x_set_internal_border_width ();
265 void x_explicitly_set_name ();
266 void x_set_autoraise ();
267 void x_set_autolower ();
268 void x_set_vertical_scroll_bars ();
269 void x_set_visibility ();
270 void x_set_menu_bar_lines ();
272 static struct x_frame_parm_table x_frame_parms
[] =
274 "foreground-color", x_set_foreground_color
,
275 "background-color", x_set_background_color
,
276 "mouse-color", x_set_mouse_color
,
277 "cursor-color", x_set_cursor_color
,
278 "border-color", x_set_border_color
,
279 "cursor-type", x_set_cursor_type
,
280 "icon-type", x_set_icon_type
,
282 "border-width", x_set_border_width
,
283 "internal-border-width", x_set_internal_border_width
,
284 "name", x_explicitly_set_name
,
285 "auto-raise", x_set_autoraise
,
286 "auto-lower", x_set_autolower
,
287 "vertical-scroll-bars", x_set_vertical_scroll_bars
,
288 "visibility", x_set_visibility
,
289 "menu-bar-lines", x_set_menu_bar_lines
,
292 /* Attach the `x-frame-parameter' properties to
293 the Lisp symbol names of parameters relevant to X. */
295 init_x_parm_symbols ()
299 for (i
= 0; i
< sizeof (x_frame_parms
) / sizeof (x_frame_parms
[0]); i
++)
300 Fput (intern (x_frame_parms
[i
].name
), Qx_frame_parameter
,
304 /* Change the parameters of FRAME as specified by ALIST.
305 If a parameter is not specially recognized, do nothing;
306 otherwise call the `x_set_...' function for that parameter. */
309 x_set_frame_parameters (f
, alist
)
315 /* If both of these parameters are present, it's more efficient to
316 set them both at once. So we wait until we've looked at the
317 entire list before we set them. */
318 Lisp_Object width
, height
;
321 Lisp_Object left
, top
;
323 XSET (width
, Lisp_Int
, FRAME_WIDTH (f
));
324 XSET (height
, Lisp_Int
, FRAME_HEIGHT (f
));
326 XSET (top
, Lisp_Int
, f
->display
.x
->top_pos
);
327 XSET (left
, Lisp_Int
, f
->display
.x
->left_pos
);
329 for (tail
= alist
; CONSP (tail
); tail
= Fcdr (tail
))
331 Lisp_Object elt
, prop
, val
;
337 if (EQ (prop
, Qwidth
))
339 else if (EQ (prop
, Qheight
))
341 else if (EQ (prop
, Qtop
))
343 else if (EQ (prop
, Qleft
))
347 register Lisp_Object tem
;
348 tem
= Fget (prop
, Qx_frame_parameter
);
349 if (XTYPE (tem
) == Lisp_Int
351 && XINT (tem
) < sizeof (x_frame_parms
)/sizeof (x_frame_parms
[0]))
352 (*x_frame_parms
[XINT (tem
)].setter
)(f
, val
,
353 get_frame_param (f
, prop
));
354 store_frame_param (f
, prop
, val
);
358 /* Don't call these unless they've changed; the window may not actually
363 XSET (frame
, Lisp_Frame
, f
);
364 if (XINT (width
) != FRAME_WIDTH (f
)
365 || XINT (height
) != FRAME_HEIGHT (f
))
366 Fset_frame_size (frame
, width
, height
);
367 if (XINT (left
) != f
->display
.x
->left_pos
368 || XINT (top
) != f
->display
.x
->top_pos
)
369 Fset_frame_position (frame
, left
, top
);
373 /* Insert a description of internally-recorded parameters of frame X
374 into the parameter alist *ALISTPTR that is to be given to the user.
375 Only parameters that are specific to the X window system
376 and whose values are not correctly recorded in the frame's
377 param_alist need to be considered here. */
379 x_report_frame_params (f
, alistptr
)
381 Lisp_Object
*alistptr
;
385 store_in_alist (alistptr
, Qleft
, make_number (f
->display
.x
->left_pos
));
386 store_in_alist (alistptr
, Qtop
, make_number (f
->display
.x
->top_pos
));
387 store_in_alist (alistptr
, Qborder_width
,
388 make_number (f
->display
.x
->border_width
));
389 store_in_alist (alistptr
, Qinternal_border_width
,
390 make_number (f
->display
.x
->internal_border_width
));
391 sprintf (buf
, "%d", FRAME_X_WINDOW (f
));
392 store_in_alist (alistptr
, Qwindow_id
,
394 store_in_alist (alistptr
, Qvisibility
,
395 (FRAME_VISIBLE_P (f
) ? Qt
396 : FRAME_ICONIFIED_P (f
) ? Qicon
: Qnil
));
399 /* Decide if color named COLOR is valid for the display
400 associated with the selected frame. */
402 defined_color (color
, color_def
)
407 Colormap screen_colormap
;
412 = DefaultColormap (x_current_display
, XDefaultScreen (x_current_display
));
414 foo
= XParseColor (x_current_display
, screen_colormap
,
416 && XAllocColor (x_current_display
, screen_colormap
, color_def
);
418 foo
= XParseColor (color
, color_def
) && XGetHardwareColor (color_def
);
419 #endif /* not HAVE_X11 */
428 /* Given a string ARG naming a color, compute a pixel value from it
429 suitable for screen F.
430 If F is not a color screen, return DEF (default) regardless of what
434 x_decode_color (arg
, def
)
440 CHECK_STRING (arg
, 0);
442 if (strcmp (XSTRING (arg
)->data
, "black") == 0)
443 return BLACK_PIX_DEFAULT
;
444 else if (strcmp (XSTRING (arg
)->data
, "white") == 0)
445 return WHITE_PIX_DEFAULT
;
448 if (x_screen_planes
== 1)
451 if (DISPLAY_CELLS
== 1)
455 if (defined_color (XSTRING (arg
)->data
, &cdef
))
458 Fsignal (Qundefined_color
, Fcons (arg
, Qnil
));
461 /* Functions called only from `x_set_frame_param'
462 to set individual parameters.
464 If FRAME_X_WINDOW (f) is 0,
465 the frame is being created and its X-window does not exist yet.
466 In that case, just record the parameter's new value
467 in the standard place; do not attempt to change the window. */
470 x_set_foreground_color (f
, arg
, oldval
)
472 Lisp_Object arg
, oldval
;
474 f
->display
.x
->foreground_pixel
= x_decode_color (arg
, BLACK_PIX_DEFAULT
);
475 if (FRAME_X_WINDOW (f
) != 0)
479 XSetForeground (x_current_display
, f
->display
.x
->normal_gc
,
480 f
->display
.x
->foreground_pixel
);
481 XSetBackground (x_current_display
, f
->display
.x
->reverse_gc
,
482 f
->display
.x
->foreground_pixel
);
484 #endif /* HAVE_X11 */
485 if (FRAME_VISIBLE_P (f
))
491 x_set_background_color (f
, arg
, oldval
)
493 Lisp_Object arg
, oldval
;
498 f
->display
.x
->background_pixel
= x_decode_color (arg
, WHITE_PIX_DEFAULT
);
500 if (FRAME_X_WINDOW (f
) != 0)
504 /* The main frame area. */
505 XSetBackground (x_current_display
, f
->display
.x
->normal_gc
,
506 f
->display
.x
->background_pixel
);
507 XSetForeground (x_current_display
, f
->display
.x
->reverse_gc
,
508 f
->display
.x
->background_pixel
);
509 XSetWindowBackground (x_current_display
, FRAME_X_WINDOW (f
),
510 f
->display
.x
->background_pixel
);
513 temp
= XMakeTile (f
->display
.x
->background_pixel
);
514 XChangeBackground (FRAME_X_WINDOW (f
), temp
);
516 #endif /* not HAVE_X11 */
519 if (FRAME_VISIBLE_P (f
))
525 x_set_mouse_color (f
, arg
, oldval
)
527 Lisp_Object arg
, oldval
;
529 Cursor cursor
, nontext_cursor
, mode_cursor
;
533 f
->display
.x
->mouse_pixel
= x_decode_color (arg
, BLACK_PIX_DEFAULT
);
534 mask_color
= f
->display
.x
->background_pixel
;
535 /* No invisible pointers. */
536 if (mask_color
== f
->display
.x
->mouse_pixel
537 && mask_color
== f
->display
.x
->background_pixel
)
538 f
->display
.x
->mouse_pixel
= f
->display
.x
->foreground_pixel
;
543 /* It's not okay to crash if the user selects a screwey cursor. */
546 if (!EQ (Qnil
, Vx_pointer_shape
))
548 CHECK_NUMBER (Vx_pointer_shape
, 0);
549 cursor
= XCreateFontCursor (x_current_display
, XINT (Vx_pointer_shape
));
552 cursor
= XCreateFontCursor (x_current_display
, XC_xterm
);
553 x_check_errors ("bad text pointer cursor: %s");
555 if (!EQ (Qnil
, Vx_nontext_pointer_shape
))
557 CHECK_NUMBER (Vx_nontext_pointer_shape
, 0);
558 nontext_cursor
= XCreateFontCursor (x_current_display
,
559 XINT (Vx_nontext_pointer_shape
));
562 nontext_cursor
= XCreateFontCursor (x_current_display
, XC_left_ptr
);
563 x_check_errors ("bad nontext pointer cursor: %s");
565 if (!EQ (Qnil
, Vx_mode_pointer_shape
))
567 CHECK_NUMBER (Vx_mode_pointer_shape
, 0);
568 mode_cursor
= XCreateFontCursor (x_current_display
,
569 XINT (Vx_mode_pointer_shape
));
572 mode_cursor
= XCreateFontCursor (x_current_display
, XC_xterm
);
574 /* Check and report errors with the above calls. */
575 x_check_errors ("can't set cursor shape: %s");
579 XColor fore_color
, back_color
;
581 fore_color
.pixel
= f
->display
.x
->mouse_pixel
;
582 back_color
.pixel
= mask_color
;
583 XQueryColor (x_current_display
,
584 DefaultColormap (x_current_display
,
585 DefaultScreen (x_current_display
)),
587 XQueryColor (x_current_display
,
588 DefaultColormap (x_current_display
,
589 DefaultScreen (x_current_display
)),
591 XRecolorCursor (x_current_display
, cursor
,
592 &fore_color
, &back_color
);
593 XRecolorCursor (x_current_display
, nontext_cursor
,
594 &fore_color
, &back_color
);
595 XRecolorCursor (x_current_display
, mode_cursor
,
596 &fore_color
, &back_color
);
599 cursor
= XCreateCursor (16, 16, MouseCursor
, MouseMask
,
601 f
->display
.x
->mouse_pixel
,
602 f
->display
.x
->background_pixel
,
606 if (FRAME_X_WINDOW (f
) != 0)
608 XDefineCursor (XDISPLAY
FRAME_X_WINDOW (f
), cursor
);
611 if (cursor
!= f
->display
.x
->text_cursor
&& f
->display
.x
->text_cursor
!= 0)
612 XFreeCursor (XDISPLAY f
->display
.x
->text_cursor
);
613 f
->display
.x
->text_cursor
= cursor
;
615 if (nontext_cursor
!= f
->display
.x
->nontext_cursor
616 && f
->display
.x
->nontext_cursor
!= 0)
617 XFreeCursor (XDISPLAY f
->display
.x
->nontext_cursor
);
618 f
->display
.x
->nontext_cursor
= nontext_cursor
;
620 if (mode_cursor
!= f
->display
.x
->modeline_cursor
621 && f
->display
.x
->modeline_cursor
!= 0)
622 XFreeCursor (XDISPLAY f
->display
.x
->modeline_cursor
);
623 f
->display
.x
->modeline_cursor
= mode_cursor
;
624 #endif /* HAVE_X11 */
631 x_set_cursor_color (f
, arg
, oldval
)
633 Lisp_Object arg
, oldval
;
635 unsigned long fore_pixel
;
637 if (!EQ (Vx_cursor_fore_pixel
, Qnil
))
638 fore_pixel
= x_decode_color (Vx_cursor_fore_pixel
, WHITE_PIX_DEFAULT
);
640 fore_pixel
= f
->display
.x
->background_pixel
;
641 f
->display
.x
->cursor_pixel
= x_decode_color (arg
, BLACK_PIX_DEFAULT
);
643 /* Make sure that the cursor color differs from the background color. */
644 if (f
->display
.x
->cursor_pixel
== f
->display
.x
->background_pixel
)
646 f
->display
.x
->cursor_pixel
== f
->display
.x
->mouse_pixel
;
647 if (f
->display
.x
->cursor_pixel
== fore_pixel
)
648 fore_pixel
= f
->display
.x
->background_pixel
;
651 if (FRAME_X_WINDOW (f
) != 0)
655 XSetBackground (x_current_display
, f
->display
.x
->cursor_gc
,
656 f
->display
.x
->cursor_pixel
);
657 XSetForeground (x_current_display
, f
->display
.x
->cursor_gc
,
660 #endif /* HAVE_X11 */
662 if (FRAME_VISIBLE_P (f
))
664 x_display_cursor (f
, 0);
665 x_display_cursor (f
, 1);
670 /* Set the border-color of frame F to value described by ARG.
671 ARG can be a string naming a color.
672 The border-color is used for the border that is drawn by the X server.
673 Note that this does not fully take effect if done before
674 F has an x-window; it must be redone when the window is created.
676 Note: this is done in two routines because of the way X10 works.
678 Note: under X11, this is normally the province of the window manager,
679 and so emacs' border colors may be overridden. */
682 x_set_border_color (f
, arg
, oldval
)
684 Lisp_Object arg
, oldval
;
689 CHECK_STRING (arg
, 0);
690 str
= XSTRING (arg
)->data
;
693 if (!strcmp (str
, "grey") || !strcmp (str
, "Grey")
694 || !strcmp (str
, "gray") || !strcmp (str
, "Gray"))
699 pix
= x_decode_color (arg
, BLACK_PIX_DEFAULT
);
701 x_set_border_pixel (f
, pix
);
704 /* Set the border-color of frame F to pixel value PIX.
705 Note that this does not fully take effect if done before
706 F has an x-window. */
708 x_set_border_pixel (f
, pix
)
712 f
->display
.x
->border_pixel
= pix
;
714 if (FRAME_X_WINDOW (f
) != 0 && f
->display
.x
->border_width
> 0)
721 XSetWindowBorder (x_current_display
, FRAME_X_WINDOW (f
),
725 temp
= XMakePixmap ((Bitmap
) XStoreBitmap (gray_width
, gray_height
,
727 BLACK_PIX_DEFAULT
, WHITE_PIX_DEFAULT
);
729 temp
= XMakeTile (pix
);
730 XChangeBorder (FRAME_X_WINDOW (f
), temp
);
731 XFreePixmap (XDISPLAY temp
);
732 #endif /* not HAVE_X11 */
735 if (FRAME_VISIBLE_P (f
))
741 x_set_cursor_type (f
, arg
, oldval
)
743 Lisp_Object arg
, oldval
;
746 FRAME_DESIRED_CURSOR (f
) = bar_cursor
;
747 else if (EQ (arg
, Qbox
))
748 FRAME_DESIRED_CURSOR (f
) = filled_box_cursor
;
751 ("the `cursor-type' frame parameter should be either `bar' or `box'");
753 /* Make sure the cursor gets redrawn. This is overkill, but how
754 often do people change cursor types? */
759 x_set_icon_type (f
, arg
, oldval
)
761 Lisp_Object arg
, oldval
;
766 if (EQ (oldval
, Qnil
) == EQ (arg
, Qnil
))
771 result
= x_text_icon (f
, 0);
773 result
= x_bitmap_icon (f
);
778 error ("No icon window available.");
781 /* If the window was unmapped (and its icon was mapped),
782 the new icon is not mapped, so map the window in its stead. */
783 if (FRAME_VISIBLE_P (f
))
784 XMapWindow (XDISPLAY
FRAME_X_WINDOW (f
));
791 x_set_font (f
, arg
, oldval
)
793 Lisp_Object arg
, oldval
;
798 CHECK_STRING (arg
, 1);
799 name
= XSTRING (arg
)->data
;
802 result
= x_new_font (f
, name
);
806 error ("Font \"%s\" is not defined", name
);
810 x_set_border_width (f
, arg
, oldval
)
812 Lisp_Object arg
, oldval
;
814 CHECK_NUMBER (arg
, 0);
816 if (XINT (arg
) == f
->display
.x
->border_width
)
819 if (FRAME_X_WINDOW (f
) != 0)
820 error ("Cannot change the border width of a window");
822 f
->display
.x
->border_width
= XINT (arg
);
826 x_set_internal_border_width (f
, arg
, oldval
)
828 Lisp_Object arg
, oldval
;
831 int old
= f
->display
.x
->internal_border_width
;
833 CHECK_NUMBER (arg
, 0);
834 f
->display
.x
->internal_border_width
= XINT (arg
);
835 if (f
->display
.x
->internal_border_width
< 0)
836 f
->display
.x
->internal_border_width
= 0;
838 if (f
->display
.x
->internal_border_width
== old
)
841 if (FRAME_X_WINDOW (f
) != 0)
844 x_set_window_size (f
, f
->width
, f
->height
);
846 x_set_resize_hint (f
);
850 SET_FRAME_GARBAGED (f
);
855 x_set_visibility (f
, value
, oldval
)
857 Lisp_Object value
, oldval
;
860 XSET (frame
, Lisp_Frame
, f
);
863 Fmake_frame_invisible (frame
);
864 else if (EQ (value
, Qicon
))
865 Ficonify_frame (frame
);
867 Fmake_frame_visible (frame
);
871 x_set_menu_bar_lines_1 (window
, n
)
875 for (; !NILP (window
); window
= XWINDOW (window
)->next
)
877 struct window
*w
= XWINDOW (window
);
881 if (!NILP (w
->vchild
))
882 x_set_menu_bar_lines_1 (w
->vchild
);
884 if (!NILP (w
->hchild
))
885 x_set_menu_bar_lines_1 (w
->hchild
);
890 x_set_menu_bar_lines (f
, value
, oldval
)
892 Lisp_Object value
, oldval
;
895 int olines
= FRAME_MENU_BAR_LINES (f
);
897 if (XTYPE (value
) == Lisp_Int
)
898 nlines
= XINT (value
);
902 FRAME_MENU_BAR_LINES (f
) = nlines
;
903 x_set_menu_bar_lines_1 (f
->root_window
, nlines
- olines
);
904 x_set_window_size (f
, FRAME_WIDTH (f
),
905 FRAME_HEIGHT (f
) + nlines
- olines
);
908 /* Change the name of frame F to ARG. If ARG is nil, set F's name to
911 If EXPLICIT is non-zero, that indicates that lisp code is setting the
912 name; if ARG is a string, set F's name to ARG and set
913 F->explicit_name; if ARG is Qnil, then clear F->explicit_name.
915 If EXPLICIT is zero, that indicates that Emacs redisplay code is
916 suggesting a new name, which lisp code should override; if
917 F->explicit_name is set, ignore the new name; otherwise, set it. */
920 x_set_name (f
, name
, explicit)
925 /* Make sure that requests from lisp code override requests from
926 Emacs redisplay code. */
929 /* If we're switching from explicit to implicit, we had better
930 update the mode lines and thereby update the title. */
931 if (f
->explicit_name
&& NILP (name
))
932 update_mode_lines
= 1;
934 f
->explicit_name
= ! NILP (name
);
936 else if (f
->explicit_name
)
939 /* If NAME is nil, set the name to the x_id_name. */
941 name
= build_string (x_id_name
);
943 CHECK_STRING (name
, 0);
945 /* Don't change the name if it's already NAME. */
946 if (! NILP (Fstring_equal (name
, f
->name
)))
949 if (FRAME_X_WINDOW (f
))
956 text
.value
= XSTRING (name
)->data
;
957 text
.encoding
= XA_STRING
;
959 text
.nitems
= XSTRING (name
)->size
;
960 XSetWMName (x_current_display
, FRAME_X_WINDOW (f
), &text
);
961 XSetWMIconName (x_current_display
, FRAME_X_WINDOW (f
), &text
);
964 XSetIconName (XDISPLAY
FRAME_X_WINDOW (f
),
965 XSTRING (name
)->data
);
966 XStoreName (XDISPLAY
FRAME_X_WINDOW (f
),
967 XSTRING (name
)->data
);
976 /* This function should be called when the user's lisp code has
977 specified a name for the frame; the name will override any set by the
980 x_explicitly_set_name (f
, arg
, oldval
)
982 Lisp_Object arg
, oldval
;
984 x_set_name (f
, arg
, 1);
987 /* This function should be called by Emacs redisplay code to set the
988 name; names set this way will never override names set by the user's
991 x_implicitly_set_name (f
, arg
, oldval
)
993 Lisp_Object arg
, oldval
;
995 x_set_name (f
, arg
, 0);
999 x_set_autoraise (f
, arg
, oldval
)
1001 Lisp_Object arg
, oldval
;
1003 f
->auto_raise
= !EQ (Qnil
, arg
);
1007 x_set_autolower (f
, arg
, oldval
)
1009 Lisp_Object arg
, oldval
;
1011 f
->auto_lower
= !EQ (Qnil
, arg
);
1015 x_set_vertical_scroll_bars (f
, arg
, oldval
)
1017 Lisp_Object arg
, oldval
;
1019 if (NILP (arg
) != ! FRAME_HAS_VERTICAL_SCROLL_BARS (f
))
1021 FRAME_HAS_VERTICAL_SCROLL_BARS (f
) = ! NILP (arg
);
1023 /* We set this parameter before creating the X window for the
1024 frame, so we can get the geometry right from the start.
1025 However, if the window hasn't been created yet, we shouldn't
1026 call x_set_window_size. */
1027 if (FRAME_X_WINDOW (f
))
1028 x_set_window_size (f
, FRAME_WIDTH (f
), FRAME_HEIGHT (f
));
1036 /* I believe this function is obsolete with respect to the new face display
1038 x_set_face (scr
, font
, background
, foreground
, stipple
)
1041 unsigned long background
, foreground
;
1044 XGCValues gc_values
;
1046 unsigned long gc_mask
;
1047 struct face
*new_face
;
1048 unsigned int width
= 16;
1049 unsigned int height
= 16;
1051 if (n_faces
== MAX_FACES_AND_GLYPHS
)
1054 /* Create the Graphics Context. */
1055 gc_values
.font
= font
->fid
;
1056 gc_values
.foreground
= foreground
;
1057 gc_values
.background
= background
;
1058 gc_values
.line_width
= 0;
1059 gc_mask
= GCLineWidth
| GCFont
| GCForeground
| GCBackground
;
1063 = XCreateBitmapFromData (x_current_display
, ROOT_WINDOW
,
1064 (char *) stipple
, width
, height
);
1065 gc_mask
|= GCStipple
;
1068 temp_gc
= XCreateGC (x_current_display
, FRAME_X_WINDOW (scr
),
1069 gc_mask
, &gc_values
);
1072 new_face
= (struct face
*) xmalloc (sizeof (struct face
));
1075 XFreeGC (x_current_display
, temp_gc
);
1079 new_face
->font
= font
;
1080 new_face
->foreground
= foreground
;
1081 new_face
->background
= background
;
1082 new_face
->face_gc
= temp_gc
;
1084 new_face
->stipple
= gc_values
.stipple
;
1086 x_face_table
[++n_faces
] = new_face
;
1091 x_set_glyph (scr
, glyph
)
1096 DEFUN ("x-set-face-font", Fx_set_face_font
, Sx_set_face_font
, 4, 2, 0,
1097 "Specify face table entry FACE-CODE to be the font named by FONT,\n\
1098 in colors FOREGROUND and BACKGROUND.")
1099 (face_code
, font_name
, foreground
, background
)
1100 Lisp_Object face_code
;
1101 Lisp_Object font_name
;
1102 Lisp_Object foreground
;
1103 Lisp_Object background
;
1105 register struct face
*fp
; /* Current face info. */
1106 register int fn
; /* Face number. */
1107 register FONT_TYPE
*f
; /* Font data structure. */
1108 unsigned char *newname
;
1111 XGCValues gc_values
;
1113 /* Need to do something about this. */
1114 Drawable drawable
= FRAME_X_WINDOW (selected_frame
);
1116 CHECK_NUMBER (face_code
, 1);
1117 CHECK_STRING (font_name
, 2);
1119 if (EQ (foreground
, Qnil
) || EQ (background
, Qnil
))
1121 fg
= selected_frame
->display
.x
->foreground_pixel
;
1122 bg
= selected_frame
->display
.x
->background_pixel
;
1126 CHECK_NUMBER (foreground
, 0);
1127 CHECK_NUMBER (background
, 1);
1129 fg
= x_decode_color (XINT (foreground
), BLACK_PIX_DEFAULT
);
1130 bg
= x_decode_color (XINT (background
), WHITE_PIX_DEFAULT
);
1133 fn
= XINT (face_code
);
1134 if ((fn
< 1) || (fn
> 255))
1135 error ("Invalid face code, %d", fn
);
1137 newname
= XSTRING (font_name
)->data
;
1139 f
= (*newname
== 0 ? 0 : XGetFont (newname
));
1142 error ("Font \"%s\" is not defined", newname
);
1144 fp
= x_face_table
[fn
];
1147 x_face_table
[fn
] = fp
= (struct face
*) xmalloc (sizeof (struct face
));
1148 bzero (fp
, sizeof (struct face
));
1149 fp
->face_type
= x_pixmap
;
1151 else if (FACE_IS_FONT (fn
))
1154 XFreeGC (FACE_FONT (fn
));
1157 else if (FACE_IS_IMAGE (fn
)) /* This should not happen... */
1160 XFreePixmap (x_current_display
, FACE_IMAGE (fn
));
1161 fp
->face_type
= x_font
;
1167 fp
->face_GLYPH
.font_desc
.font
= f
;
1168 gc_values
.font
= f
->fid
;
1169 gc_values
.foreground
= fg
;
1170 gc_values
.background
= bg
;
1171 fp
->face_GLYPH
.font_desc
.face_gc
= XCreateGC (x_current_display
,
1172 drawable
, GCFont
| GCForeground
1173 | GCBackground
, &gc_values
);
1174 fp
->face_GLYPH
.font_desc
.font_width
= FONT_WIDTH (f
);
1175 fp
->face_GLYPH
.font_desc
.font_height
= FONT_HEIGHT (f
);
1181 DEFUN ("x-set-face", Fx_set_face
, Sx_set_face
, 4, 4, 0,
1182 "Specify face table entry FACE-CODE to be the font named by FONT,\n\
1183 in colors FOREGROUND and BACKGROUND.")
1184 (face_code
, font_name
, foreground
, background
)
1185 Lisp_Object face_code
;
1186 Lisp_Object font_name
;
1187 Lisp_Object foreground
;
1188 Lisp_Object background
;
1190 register struct face
*fp
; /* Current face info. */
1191 register int fn
; /* Face number. */
1192 register FONT_TYPE
*f
; /* Font data structure. */
1193 unsigned char *newname
;
1195 CHECK_NUMBER (face_code
, 1);
1196 CHECK_STRING (font_name
, 2);
1198 fn
= XINT (face_code
);
1199 if ((fn
< 1) || (fn
> 255))
1200 error ("Invalid face code, %d", fn
);
1202 /* Ask the server to find the specified font. */
1203 newname
= XSTRING (font_name
)->data
;
1205 f
= (*newname
== 0 ? 0 : XGetFont (newname
));
1208 error ("Font \"%s\" is not defined", newname
);
1210 /* Get the face structure for face_code in the face table.
1211 Make sure it exists. */
1212 fp
= x_face_table
[fn
];
1215 x_face_table
[fn
] = fp
= (struct face
*) xmalloc (sizeof (struct face
));
1216 bzero (fp
, sizeof (struct face
));
1219 /* If this face code already exists, get rid of the old font. */
1220 if (fp
->font
!= 0 && fp
->font
!= f
)
1223 XLoseFont (fp
->font
);
1227 /* Store the specified information in FP. */
1228 fp
->fg
= x_decode_color (foreground
, BLACK_PIX_DEFAULT
);
1229 fp
->bg
= x_decode_color (background
, WHITE_PIX_DEFAULT
);
1237 /* This is excluded because there is no painless way
1238 to get or to remember the name of the font. */
1240 DEFUN ("x-get-face", Fx_get_face
, Sx_get_face
, 1, 1, 0,
1241 "Get data defining face code FACE. FACE is an integer.\n\
1242 The value is a list (FONT FG-COLOR BG-COLOR).")
1246 register struct face
*fp
; /* Current face info. */
1247 register int fn
; /* Face number. */
1249 CHECK_NUMBER (face
, 1);
1251 if ((fn
< 1) || (fn
> 255))
1252 error ("Invalid face code, %d", fn
);
1254 /* Make sure the face table exists and this face code is defined. */
1255 if (x_face_table
== 0 || x_face_table
[fn
] == 0)
1258 fp
= x_face_table
[fn
];
1260 return Fcons (build_string (fp
->name
),
1261 Fcons (make_number (fp
->fg
),
1262 Fcons (make_number (fp
->bg
), Qnil
)));
1266 /* Subroutines of creating an X frame. */
1269 extern char *x_get_string_resource ();
1270 extern XrmDatabase
x_load_resources ();
1272 DEFUN ("x-get-resource", Fx_get_resource
, Sx_get_resource
, 2, 4, 0,
1273 "Return the value of ATTRIBUTE, of class CLASS, from the X defaults database.\n\
1274 This uses `INSTANCE.ATTRIBUTE' as the key and `Emacs.CLASS' as the\n\
1275 class, where INSTANCE is the name under which Emacs was invoked.\n\
1277 The optional arguments COMPONENT and SUBCLASS add to the key and the\n\
1278 class, respectively. You must specify both of them or neither.\n\
1279 If you specify them, the key is `INSTANCE.COMPONENT.ATTRIBUTE'\n\
1280 and the class is `Emacs.CLASS.SUBCLASS'.")
1281 (attribute
, class, component
, subclass
)
1282 Lisp_Object attribute
, class, component
, subclass
;
1284 register char *value
;
1288 CHECK_STRING (attribute
, 0);
1289 CHECK_STRING (class, 0);
1291 if (!NILP (component
))
1292 CHECK_STRING (component
, 1);
1293 if (!NILP (subclass
))
1294 CHECK_STRING (subclass
, 2);
1295 if (NILP (component
) != NILP (subclass
))
1296 error ("x-get-resource: must specify both COMPONENT and SUBCLASS or neither");
1298 if (NILP (component
))
1300 /* Allocate space for the components, the dots which separate them,
1301 and the final '\0'. */
1302 name_key
= (char *) alloca (XSTRING (Vinvocation_name
)->size
1303 + XSTRING (attribute
)->size
1305 class_key
= (char *) alloca ((sizeof (EMACS_CLASS
) - 1)
1306 + XSTRING (class)->size
1309 sprintf (name_key
, "%s.%s",
1310 XSTRING (Vinvocation_name
)->data
,
1311 XSTRING (attribute
)->data
);
1312 sprintf (class_key
, "%s.%s",
1314 XSTRING (class)->data
);
1318 name_key
= (char *) alloca (XSTRING (Vinvocation_name
)->size
1319 + XSTRING (component
)->size
1320 + XSTRING (attribute
)->size
1323 class_key
= (char *) alloca ((sizeof (EMACS_CLASS
) - 1)
1324 + XSTRING (class)->size
1325 + XSTRING (subclass
)->size
1328 sprintf (name_key
, "%s.%s.%s",
1329 XSTRING (Vinvocation_name
)->data
,
1330 XSTRING (component
)->data
,
1331 XSTRING (attribute
)->data
);
1332 sprintf (class_key
, "%s.%s",
1334 XSTRING (class)->data
,
1335 XSTRING (subclass
)->data
);
1338 value
= x_get_string_resource (xrdb
, name_key
, class_key
);
1340 if (value
!= (char *) 0)
1341 return build_string (value
);
1348 DEFUN ("x-get-default", Fx_get_default
, Sx_get_default
, 1, 1, 0,
1349 "Get X default ATTRIBUTE from the system, or nil if no default.\n\
1350 Value is a string (when not nil) and ATTRIBUTE is also a string.\n\
1351 The defaults are specified in the file `~/.Xdefaults'.")
1355 register unsigned char *value
;
1357 CHECK_STRING (arg
, 1);
1359 value
= (unsigned char *) XGetDefault (XDISPLAY
1360 XSTRING (Vinvocation_name
)->data
,
1361 XSTRING (arg
)->data
);
1363 /* Try reversing last two args, in case this is the buggy version of X. */
1364 value
= (unsigned char *) XGetDefault (XDISPLAY
1365 XSTRING (arg
)->data
,
1366 XSTRING (Vinvocation_name
)->data
);
1368 return build_string (value
);
1373 #define Fx_get_resource(attribute, class, component, subclass) \
1374 Fx_get_default(attribute)
1378 /* Types we might convert a resource string into. */
1381 number
, boolean
, string
, symbol
,
1384 /* Return the value of parameter PARAM.
1386 First search ALIST, then Vdefault_frame_alist, then the X defaults
1387 database, using ATTRIBUTE as the attribute name and CLASS as its class.
1389 Convert the resource to the type specified by desired_type.
1391 If no default is specified, return Qunbound. If you call
1392 x_get_arg, make sure you deal with Qunbound in a reasonable way,
1393 and don't let it get stored in any lisp-visible variables! */
1396 x_get_arg (alist
, param
, attribute
, class, type
)
1397 Lisp_Object alist
, param
;
1400 enum resource_types type
;
1402 register Lisp_Object tem
;
1404 tem
= Fassq (param
, alist
);
1406 tem
= Fassq (param
, Vdefault_frame_alist
);
1412 tem
= Fx_get_resource (build_string (attribute
),
1413 build_string (class),
1422 return make_number (atoi (XSTRING (tem
)->data
));
1425 tem
= Fdowncase (tem
);
1426 if (!strcmp (XSTRING (tem
)->data
, "on")
1427 || !strcmp (XSTRING (tem
)->data
, "true"))
1436 /* As a special case, we map the values `true' and `on'
1437 to Qt, and `false' and `off' to Qnil. */
1439 Lisp_Object lower
= Fdowncase (tem
);
1440 if (!strcmp (XSTRING (tem
)->data
, "on")
1441 || !strcmp (XSTRING (tem
)->data
, "true"))
1443 else if (!strcmp (XSTRING (tem
)->data
, "off")
1444 || !strcmp (XSTRING (tem
)->data
, "false"))
1447 return Fintern (tem
, Qnil
);
1460 /* Record in frame F the specified or default value according to ALIST
1461 of the parameter named PARAM (a Lisp symbol).
1462 If no value is specified for PARAM, look for an X default for XPROP
1463 on the frame named NAME.
1464 If that is not found either, use the value DEFLT. */
1467 x_default_parameter (f
, alist
, prop
, deflt
, xprop
, xclass
, type
)
1474 enum resource_types type
;
1478 tem
= x_get_arg (alist
, prop
, xprop
, xclass
, type
);
1479 if (EQ (tem
, Qunbound
))
1481 x_set_frame_parameters (f
, Fcons (Fcons (prop
, tem
), Qnil
));
1485 DEFUN ("x-parse-geometry", Fx_parse_geometry
, Sx_parse_geometry
, 1, 1, 0,
1486 "Parse an X-style geometry string STRING.\n\
1487 Returns an alist of the form ((top . TOP), (left . LEFT) ... ).")
1492 unsigned int width
, height
;
1493 Lisp_Object values
[4];
1495 CHECK_STRING (string
, 0);
1497 geometry
= XParseGeometry ((char *) XSTRING (string
)->data
,
1498 &x
, &y
, &width
, &height
);
1500 switch (geometry
& 0xf) /* Mask out {X,Y}Negative */
1502 case (XValue
| YValue
):
1503 /* What's one pixel among friends?
1504 Perhaps fix this some day by returning symbol `extreme-top'... */
1505 if (x
== 0 && (geometry
& XNegative
))
1507 if (y
== 0 && (geometry
& YNegative
))
1509 values
[0] = Fcons (Qleft
, make_number (x
));
1510 values
[1] = Fcons (Qtop
, make_number (y
));
1511 return Flist (2, values
);
1514 case (WidthValue
| HeightValue
):
1515 values
[0] = Fcons (Qwidth
, make_number (width
));
1516 values
[1] = Fcons (Qheight
, make_number (height
));
1517 return Flist (2, values
);
1520 case (XValue
| YValue
| WidthValue
| HeightValue
):
1521 if (x
== 0 && (geometry
& XNegative
))
1523 if (y
== 0 && (geometry
& YNegative
))
1525 values
[0] = Fcons (Qwidth
, make_number (width
));
1526 values
[1] = Fcons (Qheight
, make_number (height
));
1527 values
[2] = Fcons (Qleft
, make_number (x
));
1528 values
[3] = Fcons (Qtop
, make_number (y
));
1529 return Flist (4, values
);
1536 error ("Must specify x and y value, and/or width and height");
1541 /* Calculate the desired size and position of this window,
1542 or set rubber-band prompting if none. */
1544 #define DEFAULT_ROWS 40
1545 #define DEFAULT_COLS 80
1548 x_figure_window_size (f
, parms
)
1552 register Lisp_Object tem0
, tem1
;
1553 int height
, width
, left
, top
;
1554 register int geometry
;
1555 long window_prompting
= 0;
1557 /* Default values if we fall through.
1558 Actually, if that happens we should get
1559 window manager prompting. */
1560 f
->width
= DEFAULT_COLS
;
1561 f
->height
= DEFAULT_ROWS
;
1562 f
->display
.x
->top_pos
= 1;
1563 f
->display
.x
->left_pos
= 1;
1565 tem0
= x_get_arg (parms
, Qheight
, 0, 0, number
);
1566 tem1
= x_get_arg (parms
, Qwidth
, 0, 0, number
);
1567 if (! EQ (tem0
, Qunbound
) && ! EQ (tem1
, Qunbound
))
1569 CHECK_NUMBER (tem0
, 0);
1570 CHECK_NUMBER (tem1
, 0);
1571 f
->height
= XINT (tem0
);
1572 f
->width
= XINT (tem1
);
1573 window_prompting
|= USSize
;
1575 else if (! EQ (tem0
, Qunbound
) || ! EQ (tem1
, Qunbound
))
1576 error ("Must specify *both* height and width");
1578 f
->display
.x
->vertical_scroll_bar_extra
=
1579 (FRAME_HAS_VERTICAL_SCROLL_BARS (f
)
1580 ? VERTICAL_SCROLL_BAR_PIXEL_WIDTH (f
)
1582 f
->display
.x
->pixel_width
= CHAR_TO_PIXEL_WIDTH (f
, f
->width
);
1583 f
->display
.x
->pixel_height
= CHAR_TO_PIXEL_HEIGHT (f
, f
->height
);
1585 tem0
= x_get_arg (parms
, Qtop
, 0, 0, number
);
1586 tem1
= x_get_arg (parms
, Qleft
, 0, 0, number
);
1587 if (! EQ (tem0
, Qunbound
) && ! EQ (tem1
, Qunbound
))
1589 CHECK_NUMBER (tem0
, 0);
1590 CHECK_NUMBER (tem1
, 0);
1591 f
->display
.x
->top_pos
= XINT (tem0
);
1592 f
->display
.x
->left_pos
= XINT (tem1
);
1593 x_calc_absolute_position (f
);
1594 window_prompting
|= USPosition
;
1596 else if (! EQ (tem0
, Qunbound
) || ! EQ (tem1
, Qunbound
))
1597 error ("Must specify *both* top and left corners");
1599 switch (window_prompting
)
1601 case USSize
| USPosition
:
1602 return window_prompting
;
1605 case USSize
: /* Got the size, need the position. */
1606 window_prompting
|= PPosition
;
1607 return window_prompting
;
1610 case USPosition
: /* Got the position, need the size. */
1611 window_prompting
|= PSize
;
1612 return window_prompting
;
1615 case 0: /* Got nothing, take both from geometry. */
1616 window_prompting
|= PPosition
| PSize
;
1617 return window_prompting
;
1621 /* Somehow a bit got set in window_prompting that we didn't
1631 XSetWindowAttributes attributes
;
1632 unsigned long attribute_mask
;
1633 XClassHint class_hints
;
1635 attributes
.background_pixel
= f
->display
.x
->background_pixel
;
1636 attributes
.border_pixel
= f
->display
.x
->border_pixel
;
1637 attributes
.bit_gravity
= StaticGravity
;
1638 attributes
.backing_store
= NotUseful
;
1639 attributes
.save_under
= True
;
1640 attributes
.event_mask
= STANDARD_EVENT_SET
;
1641 attribute_mask
= (CWBackPixel
| CWBorderPixel
| CWBitGravity
1643 | CWBackingStore
| CWSaveUnder
1649 = XCreateWindow (x_current_display
, ROOT_WINDOW
,
1650 f
->display
.x
->left_pos
,
1651 f
->display
.x
->top_pos
,
1652 PIXEL_WIDTH (f
), PIXEL_HEIGHT (f
),
1653 f
->display
.x
->border_width
,
1654 CopyFromParent
, /* depth */
1655 InputOutput
, /* class */
1656 screen_visual
, /* set in Fx_open_connection */
1657 attribute_mask
, &attributes
);
1659 class_hints
.res_name
= (char *) XSTRING (f
->name
)->data
;
1660 class_hints
.res_class
= EMACS_CLASS
;
1661 XSetClassHint (x_current_display
, FRAME_X_WINDOW (f
), &class_hints
);
1663 /* This indicates that we use the "Passive Input" input model.
1664 Unless we do this, we don't get the Focus{In,Out} events that we
1665 need to draw the cursor correctly. Accursed bureaucrats.
1666 XWhipsAndChains (x_current_display, IronMaiden, &TheRack); */
1668 f
->display
.x
->wm_hints
.input
= True
;
1669 f
->display
.x
->wm_hints
.flags
|= InputHint
;
1670 XSetWMHints (x_current_display
, FRAME_X_WINDOW (f
), &f
->display
.x
->wm_hints
);
1672 /* x_set_name normally ignores requests to set the name if the
1673 requested name is the same as the current name. This is the one
1674 place where that assumption isn't correct; f->name is set, but
1675 the X server hasn't been told. */
1677 Lisp_Object name
= f
->name
;
1678 int explicit = f
->explicit_name
;
1681 f
->explicit_name
= 0;
1682 x_set_name (f
, name
, explicit);
1685 XDefineCursor (XDISPLAY
FRAME_X_WINDOW (f
),
1686 f
->display
.x
->text_cursor
);
1689 if (FRAME_X_WINDOW (f
) == 0)
1690 error ("Unable to create window.");
1693 /* Handle the icon stuff for this window. Perhaps later we might
1694 want an x_set_icon_position which can be called interactively as
1702 Lisp_Object icon_x
, icon_y
;
1704 /* Set the position of the icon. Note that twm groups all
1705 icons in an icon window. */
1706 icon_x
= x_get_arg (parms
, Qicon_left
, 0, 0, number
);
1707 icon_y
= x_get_arg (parms
, Qicon_top
, 0, 0, number
);
1708 if (!EQ (icon_x
, Qunbound
) && !EQ (icon_y
, Qunbound
))
1710 CHECK_NUMBER (icon_x
, 0);
1711 CHECK_NUMBER (icon_y
, 0);
1713 else if (!EQ (icon_x
, Qunbound
) || !EQ (icon_y
, Qunbound
))
1714 error ("Both left and top icon corners of icon must be specified");
1718 if (! EQ (icon_x
, Qunbound
))
1719 x_wm_set_icon_position (f
, XINT (icon_x
), XINT (icon_y
));
1721 /* Start up iconic or window? */
1722 x_wm_set_window_state
1723 (f
, (EQ (x_get_arg (parms
, Qvisibility
, 0, 0, symbol
), Qicon
)
1730 /* Make the GC's needed for this window, setting the
1731 background, border and mouse colors; also create the
1732 mouse cursor and the gray border tile. */
1734 static char cursor_bits
[] =
1736 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
1737 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
1738 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
1739 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00
1746 XGCValues gc_values
;
1752 /* Create the GC's of this frame.
1753 Note that many default values are used. */
1756 gc_values
.font
= f
->display
.x
->font
->fid
;
1757 gc_values
.foreground
= f
->display
.x
->foreground_pixel
;
1758 gc_values
.background
= f
->display
.x
->background_pixel
;
1759 gc_values
.line_width
= 0; /* Means 1 using fast algorithm. */
1760 f
->display
.x
->normal_gc
= XCreateGC (x_current_display
,
1762 GCLineWidth
| GCFont
1763 | GCForeground
| GCBackground
,
1766 /* Reverse video style. */
1767 gc_values
.foreground
= f
->display
.x
->background_pixel
;
1768 gc_values
.background
= f
->display
.x
->foreground_pixel
;
1769 f
->display
.x
->reverse_gc
= XCreateGC (x_current_display
,
1771 GCFont
| GCForeground
| GCBackground
1775 /* Cursor has cursor-color background, background-color foreground. */
1776 gc_values
.foreground
= f
->display
.x
->background_pixel
;
1777 gc_values
.background
= f
->display
.x
->cursor_pixel
;
1778 gc_values
.fill_style
= FillOpaqueStippled
;
1780 = XCreateBitmapFromData (x_current_display
, ROOT_WINDOW
,
1781 cursor_bits
, 16, 16);
1782 f
->display
.x
->cursor_gc
1783 = XCreateGC (x_current_display
, FRAME_X_WINDOW (f
),
1784 (GCFont
| GCForeground
| GCBackground
1785 | GCFillStyle
| GCStipple
| GCLineWidth
),
1788 /* Create the gray border tile used when the pointer is not in
1789 the frame. Since this depends on the frame's pixel values,
1790 this must be done on a per-frame basis. */
1791 f
->display
.x
->border_tile
1792 = (XCreatePixmapFromBitmapData
1793 (x_current_display
, ROOT_WINDOW
,
1794 gray_bits
, gray_width
, gray_height
,
1795 f
->display
.x
->foreground_pixel
,
1796 f
->display
.x
->background_pixel
,
1797 DefaultDepth (x_current_display
, XDefaultScreen (x_current_display
))));
1799 init_frame_faces (f
);
1803 #endif /* HAVE_X11 */
1805 DEFUN ("x-create-frame", Fx_create_frame
, Sx_create_frame
,
1807 "Make a new X window, which is called a \"frame\" in Emacs terms.\n\
1808 Return an Emacs frame object representing the X window.\n\
1809 ALIST is an alist of frame parameters.\n\
1810 If the parameters specify that the frame should not have a minibuffer,\n\
1811 and do not specify a specific minibuffer window to use,\n\
1812 then `default-minibuffer-frame' must be a frame whose minibuffer can\n\
1813 be shared by the new frame.")
1819 Lisp_Object frame
, tem
;
1821 int minibuffer_only
= 0;
1822 long window_prompting
= 0;
1825 if (x_current_display
== 0)
1826 error ("X windows are not in use or not initialized");
1828 name
= x_get_arg (parms
, Qname
, "title", "Title", string
);
1829 if (XTYPE (name
) != Lisp_String
1830 && ! EQ (name
, Qunbound
)
1832 error ("x-create-frame: name parameter must be a string");
1834 tem
= x_get_arg (parms
, Qminibuffer
, 0, 0, symbol
);
1835 if (EQ (tem
, Qnone
) || NILP (tem
))
1836 f
= make_frame_without_minibuffer (Qnil
);
1837 else if (EQ (tem
, Qonly
))
1839 f
= make_minibuffer_frame ();
1840 minibuffer_only
= 1;
1842 else if (XTYPE (tem
) == Lisp_Window
)
1843 f
= make_frame_without_minibuffer (tem
);
1847 /* Note that X Windows does support scroll bars. */
1848 FRAME_CAN_HAVE_SCROLL_BARS (f
) = 1;
1850 /* Set the name; the functions to which we pass f expect the name to
1852 if (EQ (name
, Qunbound
) || NILP (name
))
1854 f
->name
= build_string (x_id_name
);
1855 f
->explicit_name
= 0;
1860 f
->explicit_name
= 1;
1863 XSET (frame
, Lisp_Frame
, f
);
1864 f
->output_method
= output_x_window
;
1865 f
->display
.x
= (struct x_display
*) xmalloc (sizeof (struct x_display
));
1866 bzero (f
->display
.x
, sizeof (struct x_display
));
1868 /* Note that the frame has no physical cursor right now. */
1869 f
->phys_cursor_x
= -1;
1871 /* Extract the window parameters from the supplied values
1872 that are needed to determine window geometry. */
1873 x_default_parameter (f
, parms
, Qfont
,
1875 /* If we use an XLFD name for this font, the lisp code
1876 knows how to find variants which are bold, italic,
1878 ("-*-fixed-*-*-*-*-*-120-*-*-c-*-iso8859-1"),
1879 "font", "Font", string
);
1880 x_default_parameter (f
, parms
, Qborder_width
, make_number (2),
1881 "borderwidth", "BorderWidth", number
);
1882 /* This defaults to 2 in order to match xterm. */
1883 x_default_parameter (f
, parms
, Qinternal_border_width
, make_number (2),
1884 "internalBorderWidth", "BorderWidth", number
);
1885 x_default_parameter (f
, parms
, Qvertical_scroll_bars
, Qt
,
1886 "verticalScrollBars", "ScrollBars", boolean
);
1888 /* Also do the stuff which must be set before the window exists. */
1889 x_default_parameter (f
, parms
, Qforeground_color
, build_string ("black"),
1890 "foreground", "Foreground", string
);
1891 x_default_parameter (f
, parms
, Qbackground_color
, build_string ("white"),
1892 "background", "Background", string
);
1893 x_default_parameter (f
, parms
, Qmouse_color
, build_string ("black"),
1894 "pointerColor", "Foreground", string
);
1895 x_default_parameter (f
, parms
, Qcursor_color
, build_string ("black"),
1896 "cursorColor", "Foreground", string
);
1897 x_default_parameter (f
, parms
, Qborder_color
, build_string ("black"),
1898 "borderColor", "BorderColor", string
);
1900 f
->display
.x
->parent_desc
= ROOT_WINDOW
;
1901 window_prompting
= x_figure_window_size (f
, parms
);
1907 /* We need to do this after creating the X window, so that the
1908 icon-creation functions can say whose icon they're describing. */
1909 x_default_parameter (f
, parms
, Qicon_type
, Qnil
,
1910 "iconType", "IconType", symbol
);
1912 x_default_parameter (f
, parms
, Qauto_raise
, Qnil
,
1913 "autoRaise", "AutoRaiseLower", boolean
);
1914 x_default_parameter (f
, parms
, Qauto_lower
, Qnil
,
1915 "autoLower", "AutoRaiseLower", boolean
);
1916 x_default_parameter (f
, parms
, Qcursor_type
, Qbox
,
1917 "cursorType", "CursorType", symbol
);
1919 /* Dimensions, especially f->height, must be done via change_frame_size.
1920 Change will not be effected unless different from the current
1924 f
->height
= f
->width
= 0;
1925 change_frame_size (f
, height
, width
, 1, 0);
1927 x_default_parameter (f
, parms
, Qmenu_bar_lines
, make_number (0),
1928 "menuBarLines", "MenuBarLines", number
);
1931 x_wm_set_size_hint (f
, window_prompting
);
1934 tem
= x_get_arg (parms
, Qunsplittable
, 0, 0, boolean
);
1935 f
->no_split
= minibuffer_only
|| EQ (tem
, Qt
);
1937 /* Make the window appear on the frame and enable display,
1938 unless the caller says not to. */
1940 Lisp_Object visibility
= x_get_arg (parms
, Qvisibility
, 0, 0, symbol
);
1942 if (EQ (visibility
, Qunbound
))
1945 if (EQ (visibility
, Qicon
))
1946 x_iconify_frame (f
);
1947 else if (! NILP (visibility
))
1948 x_make_frame_visible (f
);
1950 /* Must have been Qnil. */
1957 Lisp_Object frame
, tem
;
1959 int pixelwidth
, pixelheight
;
1964 int minibuffer_only
= 0;
1965 Lisp_Object vscroll
, hscroll
;
1967 if (x_current_display
== 0)
1968 error ("X windows are not in use or not initialized");
1970 name
= Fassq (Qname
, parms
);
1972 tem
= x_get_arg (parms
, Qminibuffer
, 0, 0, symbol
);
1973 if (EQ (tem
, Qnone
))
1974 f
= make_frame_without_minibuffer (Qnil
);
1975 else if (EQ (tem
, Qonly
))
1977 f
= make_minibuffer_frame ();
1978 minibuffer_only
= 1;
1980 else if (EQ (tem
, Qnil
) || EQ (tem
, Qunbound
))
1983 f
= make_frame_without_minibuffer (tem
);
1985 parent
= ROOT_WINDOW
;
1987 XSET (frame
, Lisp_Frame
, f
);
1988 f
->output_method
= output_x_window
;
1989 f
->display
.x
= (struct x_display
*) xmalloc (sizeof (struct x_display
));
1990 bzero (f
->display
.x
, sizeof (struct x_display
));
1992 /* Some temprorary default values for height and width. */
1995 f
->display
.x
->left_pos
= -1;
1996 f
->display
.x
->top_pos
= -1;
1998 /* Give the frame a default name (which may be overridden with PARMS). */
2000 strncpy (iconidentity
, ICONTAG
, MAXICID
);
2001 if (gethostname (&iconidentity
[sizeof (ICONTAG
) - 1],
2002 (MAXICID
- 1) - sizeof (ICONTAG
)))
2003 iconidentity
[sizeof (ICONTAG
) - 2] = '\0';
2004 f
->name
= build_string (iconidentity
);
2006 /* Extract some window parameters from the supplied values.
2007 These are the parameters that affect window geometry. */
2009 tem
= x_get_arg (parms
, Qfont
, "BodyFont", 0, string
);
2010 if (EQ (tem
, Qunbound
))
2011 tem
= build_string ("9x15");
2012 x_set_font (f
, tem
, Qnil
);
2013 x_default_parameter (f
, parms
, Qborder_color
,
2014 build_string ("black"), "Border", 0, string
);
2015 x_default_parameter (f
, parms
, Qbackground_color
,
2016 build_string ("white"), "Background", 0, string
);
2017 x_default_parameter (f
, parms
, Qforeground_color
,
2018 build_string ("black"), "Foreground", 0, string
);
2019 x_default_parameter (f
, parms
, Qmouse_color
,
2020 build_string ("black"), "Mouse", 0, string
);
2021 x_default_parameter (f
, parms
, Qcursor_color
,
2022 build_string ("black"), "Cursor", 0, string
);
2023 x_default_parameter (f
, parms
, Qborder_width
,
2024 make_number (2), "BorderWidth", 0, number
);
2025 x_default_parameter (f
, parms
, Qinternal_border_width
,
2026 make_number (4), "InternalBorderWidth", 0, number
);
2027 x_default_parameter (f
, parms
, Qauto_raise
,
2028 Qnil
, "AutoRaise", 0, boolean
);
2030 hscroll
= EQ (x_get_arg (parms
, Qhorizontal_scroll_bar
, 0, 0, boolean
), Qt
);
2031 vscroll
= EQ (x_get_arg (parms
, Qvertical_scroll_bar
, 0, 0, boolean
), Qt
);
2033 if (f
->display
.x
->internal_border_width
< 0)
2034 f
->display
.x
->internal_border_width
= 0;
2036 tem
= x_get_arg (parms
, Qwindow_id
, 0, 0, number
);
2037 if (!EQ (tem
, Qunbound
))
2039 WINDOWINFO_TYPE wininfo
;
2041 Window
*children
, root
;
2043 CHECK_NUMBER (tem
, 0);
2044 FRAME_X_WINDOW (f
) = (Window
) XINT (tem
);
2047 XGetWindowInfo (FRAME_X_WINDOW (f
), &wininfo
);
2048 XQueryTree (FRAME_X_WINDOW (f
), &parent
, &nchildren
, &children
);
2052 height
= PIXEL_TO_CHAR_HEIGHT (f
, wininfo
.height
);
2053 width
= PIXEL_TO_CHAR_WIDTH (f
, wininfo
.width
);
2054 f
->display
.x
->left_pos
= wininfo
.x
;
2055 f
->display
.x
->top_pos
= wininfo
.y
;
2056 FRAME_SET_VISIBILITY (f
, wininfo
.mapped
!= 0);
2057 f
->display
.x
->border_width
= wininfo
.bdrwidth
;
2058 f
->display
.x
->parent_desc
= parent
;
2062 tem
= x_get_arg (parms
, Qparent_id
, 0, 0, number
);
2063 if (!EQ (tem
, Qunbound
))
2065 CHECK_NUMBER (tem
, 0);
2066 parent
= (Window
) XINT (tem
);
2068 f
->display
.x
->parent_desc
= parent
;
2069 tem
= x_get_arg (parms
, Qheight
, 0, 0, number
);
2070 if (EQ (tem
, Qunbound
))
2072 tem
= x_get_arg (parms
, Qwidth
, 0, 0, number
);
2073 if (EQ (tem
, Qunbound
))
2075 tem
= x_get_arg (parms
, Qtop
, 0, 0, number
);
2076 if (EQ (tem
, Qunbound
))
2077 tem
= x_get_arg (parms
, Qleft
, 0, 0, number
);
2080 /* Now TEM is Qunbound if no edge or size was specified.
2081 In that case, we must do rubber-banding. */
2082 if (EQ (tem
, Qunbound
))
2084 tem
= x_get_arg (parms
, Qgeometry
, 0, 0, number
);
2086 &f
->display
.x
->left_pos
, &f
->display
.x
->top_pos
,
2088 (XTYPE (tem
) == Lisp_String
2089 ? (char *) XSTRING (tem
)->data
: ""),
2090 XSTRING (f
->name
)->data
,
2091 !NILP (hscroll
), !NILP (vscroll
));
2095 /* Here if at least one edge or size was specified.
2096 Demand that they all were specified, and use them. */
2097 tem
= x_get_arg (parms
, Qheight
, 0, 0, number
);
2098 if (EQ (tem
, Qunbound
))
2099 error ("Height not specified");
2100 CHECK_NUMBER (tem
, 0);
2101 height
= XINT (tem
);
2103 tem
= x_get_arg (parms
, Qwidth
, 0, 0, number
);
2104 if (EQ (tem
, Qunbound
))
2105 error ("Width not specified");
2106 CHECK_NUMBER (tem
, 0);
2109 tem
= x_get_arg (parms
, Qtop
, 0, 0, number
);
2110 if (EQ (tem
, Qunbound
))
2111 error ("Top position not specified");
2112 CHECK_NUMBER (tem
, 0);
2113 f
->display
.x
->left_pos
= XINT (tem
);
2115 tem
= x_get_arg (parms
, Qleft
, 0, 0, number
);
2116 if (EQ (tem
, Qunbound
))
2117 error ("Left position not specified");
2118 CHECK_NUMBER (tem
, 0);
2119 f
->display
.x
->top_pos
= XINT (tem
);
2122 pixelwidth
= CHAR_TO_PIXEL_WIDTH (f
, width
);
2123 pixelheight
= CHAR_TO_PIXEL_HEIGHT (f
, height
);
2127 = XCreateWindow (parent
,
2128 f
->display
.x
->left_pos
, /* Absolute horizontal offset */
2129 f
->display
.x
->top_pos
, /* Absolute Vertical offset */
2130 pixelwidth
, pixelheight
,
2131 f
->display
.x
->border_width
,
2132 BLACK_PIX_DEFAULT
, WHITE_PIX_DEFAULT
);
2134 if (FRAME_X_WINDOW (f
) == 0)
2135 error ("Unable to create window.");
2138 /* Install the now determined height and width
2139 in the windows and in phys_lines and desired_lines. */
2140 change_frame_size (f
, height
, width
, 1, 0);
2141 XSelectInput (FRAME_X_WINDOW (f
), KeyPressed
| ExposeWindow
2142 | ButtonPressed
| ButtonReleased
| ExposeRegion
| ExposeCopy
2143 | EnterWindow
| LeaveWindow
| UnmapWindow
);
2144 x_set_resize_hint (f
);
2146 /* Tell the server the window's default name. */
2147 XStoreName (XDISPLAY
FRAME_X_WINDOW (f
), XSTRING (f
->name
)->data
);
2149 /* Now override the defaults with all the rest of the specified
2151 tem
= x_get_arg (parms
, Qunsplittable
, 0, 0, boolean
);
2152 f
->no_split
= minibuffer_only
|| EQ (tem
, Qt
);
2154 /* Do not create an icon window if the caller says not to */
2155 if (!EQ (x_get_arg (parms
, Qsuppress_icon
, 0, 0, boolean
), Qt
)
2156 || f
->display
.x
->parent_desc
!= ROOT_WINDOW
)
2158 x_text_icon (f
, iconidentity
);
2159 x_default_parameter (f
, parms
, Qicon_type
, Qnil
,
2160 "BitmapIcon", 0, symbol
);
2163 /* Tell the X server the previously set values of the
2164 background, border and mouse colors; also create the mouse cursor. */
2166 temp
= XMakeTile (f
->display
.x
->background_pixel
);
2167 XChangeBackground (FRAME_X_WINDOW (f
), temp
);
2170 x_set_border_pixel (f
, f
->display
.x
->border_pixel
);
2172 x_set_mouse_color (f
, Qnil
, Qnil
);
2174 /* Now override the defaults with all the rest of the specified parms. */
2176 Fmodify_frame_parameters (frame
, parms
);
2178 /* Make the window appear on the frame and enable display. */
2180 Lisp_Object visibility
= x_get_arg (parms
, Qvisibility
, 0, 0, symbol
);
2182 if (EQ (visibility
, Qunbound
))
2185 if (! EQ (visibility
, Qicon
)
2186 && ! NILP (visibility
))
2187 x_make_window_visible (f
);
2190 SET_FRAME_GARBAGED (f
);
2196 DEFUN ("focus-frame", Ffocus_frame
, Sfocus_frame
, 1, 1, 0,
2197 "Set the focus on FRAME.")
2201 CHECK_LIVE_FRAME (frame
, 0);
2203 if (FRAME_X_P (XFRAME (frame
)))
2206 x_focus_on_frame (XFRAME (frame
));
2214 DEFUN ("unfocus-frame", Funfocus_frame
, Sunfocus_frame
, 0, 0, 0,
2215 "If a frame has been focused, release it.")
2221 x_unfocus_frame (x_focus_frame
);
2229 /* Computes an X-window size and position either from geometry GEO
2232 F is a frame. It specifies an X window which is used to
2233 determine which display to compute for. Its font, borders
2234 and colors control how the rectangle will be displayed.
2236 X and Y are where to store the positions chosen.
2237 WIDTH and HEIGHT are where to store the sizes chosen.
2239 GEO is the geometry that may specify some of the info.
2240 STR is a prompt to display.
2241 HSCROLL and VSCROLL say whether we have horiz and vert scroll bars. */
2244 x_rubber_band (f
, x
, y
, width
, height
, geo
, str
, hscroll
, vscroll
)
2246 int *x
, *y
, *width
, *height
;
2249 int hscroll
, vscroll
;
2255 int background_color
;
2261 background_color
= f
->display
.x
->background_pixel
;
2262 border_color
= f
->display
.x
->border_pixel
;
2264 frame
.bdrwidth
= f
->display
.x
->border_width
;
2265 frame
.border
= XMakeTile (border_color
);
2266 frame
.background
= XMakeTile (background_color
);
2267 tempwindow
= XCreateTerm (str
, "emacs", geo
, default_window
, &frame
, 10, 5,
2268 (2 * f
->display
.x
->internal_border_width
2269 + (vscroll
? VSCROLL_WIDTH
: 0)),
2270 (2 * f
->display
.x
->internal_border_width
2271 + (hscroll
? HSCROLL_HEIGHT
: 0)),
2272 width
, height
, f
->display
.x
->font
,
2273 FONT_WIDTH (f
->display
.x
->font
),
2274 FONT_HEIGHT (f
->display
.x
->font
));
2275 XFreePixmap (frame
.border
);
2276 XFreePixmap (frame
.background
);
2278 if (tempwindow
!= 0)
2280 XQueryWindow (tempwindow
, &wininfo
);
2281 XDestroyWindow (tempwindow
);
2286 /* Coordinates we got are relative to the root window.
2287 Convert them to coordinates relative to desired parent window
2288 by scanning from there up to the root. */
2289 tempwindow
= f
->display
.x
->parent_desc
;
2290 while (tempwindow
!= ROOT_WINDOW
)
2294 XQueryWindow (tempwindow
, &wininfo
);
2297 XQueryTree (tempwindow
, &tempwindow
, &nchildren
, &children
);
2302 return tempwindow
!= 0;
2304 #endif /* not HAVE_X11 */
2306 DEFUN ("x-color-defined-p", Fx_color_defined_p
, Sx_color_defined_p
, 1, 1, 0,
2307 "Return t if the current X display supports the color named COLOR.")
2313 CHECK_STRING (color
, 0);
2315 if (defined_color (XSTRING (color
)->data
, &foo
))
2321 DEFUN ("x-display-color-p", Fx_display_color_p
, Sx_display_color_p
, 0, 0, 0,
2322 "Return t if the X screen currently in use supports color.")
2325 if (x_screen_planes
<= 2)
2328 switch (screen_visual
->class)
2341 DEFUN ("x-display-pixel-width", Fx_display_pixel_width
, Sx_display_pixel_width
,
2343 "Returns the width in pixels of the display FRAME is on.")
2347 Display
*dpy
= x_current_display
;
2348 return make_number (DisplayWidth (dpy
, DefaultScreen (dpy
)));
2351 DEFUN ("x-display-pixel-height", Fx_display_pixel_height
,
2352 Sx_display_pixel_height
, 0, 1, 0,
2353 "Returns the height in pixels of the display FRAME is on.")
2357 Display
*dpy
= x_current_display
;
2358 return make_number (DisplayHeight (dpy
, DefaultScreen (dpy
)));
2361 DEFUN ("x-display-planes", Fx_display_planes
, Sx_display_planes
,
2363 "Returns the number of bitplanes of the display FRAME is on.")
2367 Display
*dpy
= x_current_display
;
2368 return make_number (DisplayPlanes (dpy
, DefaultScreen (dpy
)));
2371 DEFUN ("x-display-color-cells", Fx_display_color_cells
, Sx_display_color_cells
,
2373 "Returns the number of color cells of the display FRAME is on.")
2377 Display
*dpy
= x_current_display
;
2378 return make_number (DisplayCells (dpy
, DefaultScreen (dpy
)));
2381 DEFUN ("x-server-vendor", Fx_server_vendor
, Sx_server_vendor
, 0, 1, 0,
2382 "Returns the vendor ID string of the X server FRAME is on.")
2386 Display
*dpy
= x_current_display
;
2388 vendor
= ServerVendor (dpy
);
2389 if (! vendor
) vendor
= "";
2390 return build_string (vendor
);
2393 DEFUN ("x-server-version", Fx_server_version
, Sx_server_version
, 0, 1, 0,
2394 "Returns the version numbers of the X server in use.\n\
2395 The value is a list of three integers: the major and minor\n\
2396 version numbers of the X Protocol in use, and the vendor-specific release\n\
2397 number. See also the variable `x-server-vendor'.")
2401 Display
*dpy
= x_current_display
;
2402 return Fcons (make_number (ProtocolVersion (dpy
)),
2403 Fcons (make_number (ProtocolRevision (dpy
)),
2404 Fcons (make_number (VendorRelease (dpy
)), Qnil
)));
2407 DEFUN ("x-display-screens", Fx_display_screens
, Sx_display_screens
, 0, 1, 0,
2408 "Returns the number of screens on the X server FRAME is on.")
2412 return make_number (ScreenCount (x_current_display
));
2415 DEFUN ("x-display-mm-height", Fx_display_mm_height
, Sx_display_mm_height
, 0, 1, 0,
2416 "Returns the height in millimeters of the X screen FRAME is on.")
2420 return make_number (HeightMMOfScreen (x_screen
));
2423 DEFUN ("x-display-mm-width", Fx_display_mm_width
, Sx_display_mm_width
, 0, 1, 0,
2424 "Returns the width in millimeters of the X screen FRAME is on.")
2428 return make_number (WidthMMOfScreen (x_screen
));
2431 DEFUN ("x-display-backing-store", Fx_display_backing_store
,
2432 Sx_display_backing_store
, 0, 1, 0,
2433 "Returns an indication of whether the X screen FRAME is on does backing store.\n\
2434 The value may be `always', `when-mapped', or `not-useful'.")
2438 switch (DoesBackingStore (x_screen
))
2441 return intern ("always");
2444 return intern ("when-mapped");
2447 return intern ("not-useful");
2450 error ("Strange value for BackingStore parameter of screen");
2454 DEFUN ("x-display-visual-class", Fx_display_visual_class
,
2455 Sx_display_visual_class
, 0, 1, 0,
2456 "Returns the visual class of the display `screen' is on.\n\
2457 The value is one of the symbols `static-gray', `gray-scale',\n\
2458 `static-color', `pseudo-color', `true-color', or `direct-color'.")
2462 switch (screen_visual
->class)
2464 case StaticGray
: return (intern ("static-gray"));
2465 case GrayScale
: return (intern ("gray-scale"));
2466 case StaticColor
: return (intern ("static-color"));
2467 case PseudoColor
: return (intern ("pseudo-color"));
2468 case TrueColor
: return (intern ("true-color"));
2469 case DirectColor
: return (intern ("direct-color"));
2471 error ("Display has an unknown visual class");
2475 DEFUN ("x-display-save-under", Fx_display_save_under
,
2476 Sx_display_save_under
, 0, 1, 0,
2477 "Returns t if the X screen FRAME is on supports the save-under feature.")
2481 if (DoesSaveUnders (x_screen
) == True
)
2488 register struct frame
*f
;
2490 return PIXEL_WIDTH (f
);
2494 register struct frame
*f
;
2496 return PIXEL_HEIGHT (f
);
2500 register struct frame
*f
;
2502 return FONT_WIDTH (f
->display
.x
->font
);
2506 register struct frame
*f
;
2508 return FONT_HEIGHT (f
->display
.x
->font
);
2511 #if 0 /* These no longer seem like the right way to do things. */
2513 /* Draw a rectangle on the frame with left top corner including
2514 the character specified by LEFT_CHAR and TOP_CHAR. The rectangle is
2515 CHARS by LINES wide and long and is the color of the cursor. */
2518 x_rectangle (f
, gc
, left_char
, top_char
, chars
, lines
)
2519 register struct frame
*f
;
2521 register int top_char
, left_char
, chars
, lines
;
2525 int left
= (left_char
* FONT_WIDTH (f
->display
.x
->font
)
2526 + f
->display
.x
->internal_border_width
);
2527 int top
= (top_char
* FONT_HEIGHT (f
->display
.x
->font
)
2528 + f
->display
.x
->internal_border_width
);
2531 width
= FONT_WIDTH (f
->display
.x
->font
) / 2;
2533 width
= FONT_WIDTH (f
->display
.x
->font
) * chars
;
2535 height
= FONT_HEIGHT (f
->display
.x
->font
) / 2;
2537 height
= FONT_HEIGHT (f
->display
.x
->font
) * lines
;
2539 XDrawRectangle (x_current_display
, FRAME_X_WINDOW (f
),
2540 gc
, left
, top
, width
, height
);
2543 DEFUN ("x-draw-rectangle", Fx_draw_rectangle
, Sx_draw_rectangle
, 5, 5, 0,
2544 "Draw a rectangle on FRAME between coordinates specified by\n\
2545 numbers X0, Y0, X1, Y1 in the cursor pixel.")
2546 (frame
, X0
, Y0
, X1
, Y1
)
2547 register Lisp_Object frame
, X0
, X1
, Y0
, Y1
;
2549 register int x0
, y0
, x1
, y1
, top
, left
, n_chars
, n_lines
;
2551 CHECK_LIVE_FRAME (frame
, 0);
2552 CHECK_NUMBER (X0
, 0);
2553 CHECK_NUMBER (Y0
, 1);
2554 CHECK_NUMBER (X1
, 2);
2555 CHECK_NUMBER (Y1
, 3);
2565 n_lines
= y1
- y0
+ 1;
2570 n_lines
= y0
- y1
+ 1;
2576 n_chars
= x1
- x0
+ 1;
2581 n_chars
= x0
- x1
+ 1;
2585 x_rectangle (XFRAME (frame
), XFRAME (frame
)->display
.x
->cursor_gc
,
2586 left
, top
, n_chars
, n_lines
);
2592 DEFUN ("x-erase-rectangle", Fx_erase_rectangle
, Sx_erase_rectangle
, 5, 5, 0,
2593 "Draw a rectangle drawn on FRAME between coordinates\n\
2594 X0, Y0, X1, Y1 in the regular background-pixel.")
2595 (frame
, X0
, Y0
, X1
, Y1
)
2596 register Lisp_Object frame
, X0
, Y0
, X1
, Y1
;
2598 register int x0
, y0
, x1
, y1
, top
, left
, n_chars
, n_lines
;
2600 CHECK_FRAME (frame
, 0);
2601 CHECK_NUMBER (X0
, 0);
2602 CHECK_NUMBER (Y0
, 1);
2603 CHECK_NUMBER (X1
, 2);
2604 CHECK_NUMBER (Y1
, 3);
2614 n_lines
= y1
- y0
+ 1;
2619 n_lines
= y0
- y1
+ 1;
2625 n_chars
= x1
- x0
+ 1;
2630 n_chars
= x0
- x1
+ 1;
2634 x_rectangle (XFRAME (frame
), XFRAME (frame
)->display
.x
->reverse_gc
,
2635 left
, top
, n_chars
, n_lines
);
2641 /* Draw lines around the text region beginning at the character position
2642 TOP_X, TOP_Y and ending at BOTTOM_X and BOTTOM_Y. GC specifies the
2643 pixel and line characteristics. */
2645 #define line_len(line) (FRAME_CURRENT_GLYPHS (f)->used[(line)])
2648 outline_region (f
, gc
, top_x
, top_y
, bottom_x
, bottom_y
)
2649 register struct frame
*f
;
2651 int top_x
, top_y
, bottom_x
, bottom_y
;
2653 register int ibw
= f
->display
.x
->internal_border_width
;
2654 register int font_w
= FONT_WIDTH (f
->display
.x
->font
);
2655 register int font_h
= FONT_HEIGHT (f
->display
.x
->font
);
2657 int x
= line_len (y
);
2658 XPoint
*pixel_points
= (XPoint
*)
2659 alloca (((bottom_y
- top_y
+ 2) * 4) * sizeof (XPoint
));
2660 register XPoint
*this_point
= pixel_points
;
2662 /* Do the horizontal top line/lines */
2665 this_point
->x
= ibw
;
2666 this_point
->y
= ibw
+ (font_h
* top_y
);
2669 this_point
->x
= ibw
+ (font_w
/ 2); /* Half-size for newline chars. */
2671 this_point
->x
= ibw
+ (font_w
* x
);
2672 this_point
->y
= (this_point
- 1)->y
;
2676 this_point
->x
= ibw
;
2677 this_point
->y
= ibw
+ (font_h
* (top_y
+ 1));
2679 this_point
->x
= ibw
+ (font_w
* top_x
);
2680 this_point
->y
= (this_point
- 1)->y
;
2682 this_point
->x
= (this_point
- 1)->x
;
2683 this_point
->y
= ibw
+ (font_h
* top_y
);
2685 this_point
->x
= ibw
+ (font_w
* x
);
2686 this_point
->y
= (this_point
- 1)->y
;
2689 /* Now do the right side. */
2690 while (y
< bottom_y
)
2691 { /* Right vertical edge */
2693 this_point
->x
= (this_point
- 1)->x
;
2694 this_point
->y
= ibw
+ (font_h
* (y
+ 1));
2697 y
++; /* Horizontal connection to next line */
2700 this_point
->x
= ibw
+ (font_w
/ 2);
2702 this_point
->x
= ibw
+ (font_w
* x
);
2704 this_point
->y
= (this_point
- 1)->y
;
2707 /* Now do the bottom and connect to the top left point. */
2708 this_point
->x
= ibw
+ (font_w
* (bottom_x
+ 1));
2711 this_point
->x
= (this_point
- 1)->x
;
2712 this_point
->y
= ibw
+ (font_h
* (bottom_y
+ 1));
2714 this_point
->x
= ibw
;
2715 this_point
->y
= (this_point
- 1)->y
;
2717 this_point
->x
= pixel_points
->x
;
2718 this_point
->y
= pixel_points
->y
;
2720 XDrawLines (x_current_display
, FRAME_X_WINDOW (f
),
2722 (this_point
- pixel_points
+ 1), CoordModeOrigin
);
2725 DEFUN ("x-contour-region", Fx_contour_region
, Sx_contour_region
, 1, 1, 0,
2726 "Highlight the region between point and the character under the mouse\n\
2729 register Lisp_Object event
;
2731 register int x0
, y0
, x1
, y1
;
2732 register struct frame
*f
= selected_frame
;
2733 register int p1
, p2
;
2735 CHECK_CONS (event
, 0);
2738 x0
= XINT (Fcar (Fcar (event
)));
2739 y0
= XINT (Fcar (Fcdr (Fcar (event
))));
2741 /* If the mouse is past the end of the line, don't that area. */
2742 /* ReWrite this... */
2747 if (y1
> y0
) /* point below mouse */
2748 outline_region (f
, f
->display
.x
->cursor_gc
,
2750 else if (y1
< y0
) /* point above mouse */
2751 outline_region (f
, f
->display
.x
->cursor_gc
,
2753 else /* same line: draw horizontal rectangle */
2756 x_rectangle (f
, f
->display
.x
->cursor_gc
,
2757 x0
, y0
, (x1
- x0
+ 1), 1);
2759 x_rectangle (f
, f
->display
.x
->cursor_gc
,
2760 x1
, y1
, (x0
- x1
+ 1), 1);
2763 XFlush (x_current_display
);
2769 DEFUN ("x-uncontour-region", Fx_uncontour_region
, Sx_uncontour_region
, 1, 1, 0,
2770 "Erase any highlighting of the region between point and the character\n\
2771 at X, Y on the selected frame.")
2773 register Lisp_Object event
;
2775 register int x0
, y0
, x1
, y1
;
2776 register struct frame
*f
= selected_frame
;
2779 x0
= XINT (Fcar (Fcar (event
)));
2780 y0
= XINT (Fcar (Fcdr (Fcar (event
))));
2784 if (y1
> y0
) /* point below mouse */
2785 outline_region (f
, f
->display
.x
->reverse_gc
,
2787 else if (y1
< y0
) /* point above mouse */
2788 outline_region (f
, f
->display
.x
->reverse_gc
,
2790 else /* same line: draw horizontal rectangle */
2793 x_rectangle (f
, f
->display
.x
->reverse_gc
,
2794 x0
, y0
, (x1
- x0
+ 1), 1);
2796 x_rectangle (f
, f
->display
.x
->reverse_gc
,
2797 x1
, y1
, (x0
- x1
+ 1), 1);
2805 int contour_begin_x
, contour_begin_y
;
2806 int contour_end_x
, contour_end_y
;
2807 int contour_npoints
;
2809 /* Clip the top part of the contour lines down (and including) line Y_POS.
2810 If X_POS is in the middle (rather than at the end) of the line, drop
2811 down a line at that character. */
2814 clip_contour_top (y_pos
, x_pos
)
2816 register XPoint
*begin
= contour_lines
[y_pos
].top_left
;
2817 register XPoint
*end
;
2818 register int npoints
;
2819 register struct display_line
*line
= selected_frame
->phys_lines
[y_pos
+ 1];
2821 if (x_pos
>= line
->len
- 1) /* Draw one, straight horizontal line. */
2823 end
= contour_lines
[y_pos
].top_right
;
2824 npoints
= (end
- begin
+ 1);
2825 XDrawLines (x_current_display
, contour_window
,
2826 contour_erase_gc
, begin_erase
, npoints
, CoordModeOrigin
);
2828 bcopy (end
, begin
+ 1, contour_last_point
- end
+ 1);
2829 contour_last_point
-= (npoints
- 2);
2830 XDrawLines (x_current_display
, contour_window
,
2831 contour_erase_gc
, begin
, 2, CoordModeOrigin
);
2832 XFlush (x_current_display
);
2834 /* Now, update contour_lines structure. */
2839 register XPoint
*p
= begin
+ 1;
2840 end
= contour_lines
[y_pos
].bottom_right
;
2841 npoints
= (end
- begin
+ 1);
2842 XDrawLines (x_current_display
, contour_window
,
2843 contour_erase_gc
, begin_erase
, npoints
, CoordModeOrigin
);
2846 p
->x
= ibw
+ (font_w
* (x_pos
+ 1));
2848 p
->y
= begin
->y
+ font_h
;
2850 bcopy (end
, begin
+ 3, contour_last_point
- end
+ 1);
2851 contour_last_point
-= (npoints
- 5);
2852 XDrawLines (x_current_display
, contour_window
,
2853 contour_erase_gc
, begin
, 4, CoordModeOrigin
);
2854 XFlush (x_current_display
);
2856 /* Now, update contour_lines structure. */
2860 /* Erase the top horzontal lines of the contour, and then extend
2861 the contour upwards. */
2864 extend_contour_top (line
)
2869 clip_contour_bottom (x_pos
, y_pos
)
2875 extend_contour_bottom (x_pos
, y_pos
)
2879 DEFUN ("x-select-region", Fx_select_region
, Sx_select_region
, 1, 1, "e",
2884 register struct frame
*f
= selected_frame
;
2885 register int point_x
= f
->cursor_x
;
2886 register int point_y
= f
->cursor_y
;
2887 register int mouse_below_point
;
2888 register Lisp_Object obj
;
2889 register int x_contour_x
, x_contour_y
;
2891 x_contour_x
= x_mouse_x
;
2892 x_contour_y
= x_mouse_y
;
2893 if (x_contour_y
> point_y
|| (x_contour_y
== point_y
2894 && x_contour_x
> point_x
))
2896 mouse_below_point
= 1;
2897 outline_region (f
, f
->display
.x
->cursor_gc
, point_x
, point_y
,
2898 x_contour_x
, x_contour_y
);
2902 mouse_below_point
= 0;
2903 outline_region (f
, f
->display
.x
->cursor_gc
, x_contour_x
, x_contour_y
,
2909 obj
= read_char (-1, 0, 0, Qnil
, 0);
2910 if (XTYPE (obj
) != Lisp_Cons
)
2913 if (mouse_below_point
)
2915 if (x_mouse_y
<= point_y
) /* Flipped. */
2917 mouse_below_point
= 0;
2919 outline_region (f
, f
->display
.x
->reverse_gc
, point_x
, point_y
,
2920 x_contour_x
, x_contour_y
);
2921 outline_region (f
, f
->display
.x
->cursor_gc
, x_mouse_x
, x_mouse_y
,
2924 else if (x_mouse_y
< x_contour_y
) /* Bottom clipped. */
2926 clip_contour_bottom (x_mouse_y
);
2928 else if (x_mouse_y
> x_contour_y
) /* Bottom extended. */
2930 extend_bottom_contour (x_mouse_y
);
2933 x_contour_x
= x_mouse_x
;
2934 x_contour_y
= x_mouse_y
;
2936 else /* mouse above or same line as point */
2938 if (x_mouse_y
>= point_y
) /* Flipped. */
2940 mouse_below_point
= 1;
2942 outline_region (f
, f
->display
.x
->reverse_gc
,
2943 x_contour_x
, x_contour_y
, point_x
, point_y
);
2944 outline_region (f
, f
->display
.x
->cursor_gc
, point_x
, point_y
,
2945 x_mouse_x
, x_mouse_y
);
2947 else if (x_mouse_y
> x_contour_y
) /* Top clipped. */
2949 clip_contour_top (x_mouse_y
);
2951 else if (x_mouse_y
< x_contour_y
) /* Top extended. */
2953 extend_contour_top (x_mouse_y
);
2958 unread_command_event
= obj
;
2959 if (mouse_below_point
)
2961 contour_begin_x
= point_x
;
2962 contour_begin_y
= point_y
;
2963 contour_end_x
= x_contour_x
;
2964 contour_end_y
= x_contour_y
;
2968 contour_begin_x
= x_contour_x
;
2969 contour_begin_y
= x_contour_y
;
2970 contour_end_x
= point_x
;
2971 contour_end_y
= point_y
;
2976 DEFUN ("x-horizontal-line", Fx_horizontal_line
, Sx_horizontal_line
, 1, 1, "e",
2981 register Lisp_Object obj
;
2982 struct frame
*f
= selected_frame
;
2983 register struct window
*w
= XWINDOW (selected_window
);
2984 register GC line_gc
= f
->display
.x
->cursor_gc
;
2985 register GC erase_gc
= f
->display
.x
->reverse_gc
;
2987 char dash_list
[] = {6, 4, 6, 4};
2989 XGCValues gc_values
;
2991 register int previous_y
;
2992 register int line
= (x_mouse_y
+ 1) * FONT_HEIGHT (f
->display
.x
->font
)
2993 + f
->display
.x
->internal_border_width
;
2994 register int left
= f
->display
.x
->internal_border_width
2996 * FONT_WIDTH (f
->display
.x
->font
));
2997 register int right
= left
+ (w
->width
2998 * FONT_WIDTH (f
->display
.x
->font
))
2999 - f
->display
.x
->internal_border_width
;
3003 gc_values
.foreground
= f
->display
.x
->cursor_pixel
;
3004 gc_values
.background
= f
->display
.x
->background_pixel
;
3005 gc_values
.line_width
= 1;
3006 gc_values
.line_style
= LineOnOffDash
;
3007 gc_values
.cap_style
= CapRound
;
3008 gc_values
.join_style
= JoinRound
;
3010 line_gc
= XCreateGC (x_current_display
, FRAME_X_WINDOW (f
),
3011 GCLineStyle
| GCJoinStyle
| GCCapStyle
3012 | GCLineWidth
| GCForeground
| GCBackground
,
3014 XSetDashes (x_current_display
, line_gc
, 0, dash_list
, dashes
);
3015 gc_values
.foreground
= f
->display
.x
->background_pixel
;
3016 gc_values
.background
= f
->display
.x
->foreground_pixel
;
3017 erase_gc
= XCreateGC (x_current_display
, FRAME_X_WINDOW (f
),
3018 GCLineStyle
| GCJoinStyle
| GCCapStyle
3019 | GCLineWidth
| GCForeground
| GCBackground
,
3021 XSetDashes (x_current_display
, erase_gc
, 0, dash_list
, dashes
);
3027 if (x_mouse_y
>= XINT (w
->top
)
3028 && x_mouse_y
< XINT (w
->top
) + XINT (w
->height
) - 1)
3030 previous_y
= x_mouse_y
;
3031 line
= (x_mouse_y
+ 1) * FONT_HEIGHT (f
->display
.x
->font
)
3032 + f
->display
.x
->internal_border_width
;
3033 XDrawLine (x_current_display
, FRAME_X_WINDOW (f
),
3034 line_gc
, left
, line
, right
, line
);
3041 obj
= read_char (-1, 0, 0, Qnil
, 0);
3042 if ((XTYPE (obj
) != Lisp_Cons
)
3043 || (! EQ (Fcar (Fcdr (Fcdr (obj
))),
3044 Qvertical_scroll_bar
))
3048 XDrawLine (x_current_display
, FRAME_X_WINDOW (f
),
3049 erase_gc
, left
, line
, right
, line
);
3051 unread_command_event
= obj
;
3053 XFreeGC (x_current_display
, line_gc
);
3054 XFreeGC (x_current_display
, erase_gc
);
3059 while (x_mouse_y
== previous_y
);
3062 XDrawLine (x_current_display
, FRAME_X_WINDOW (f
),
3063 erase_gc
, left
, line
, right
, line
);
3069 /* Offset in buffer of character under the pointer, or 0. */
3070 int mouse_buffer_offset
;
3073 /* These keep track of the rectangle following the pointer. */
3074 int mouse_track_top
, mouse_track_left
, mouse_track_width
;
3076 DEFUN ("x-track-pointer", Fx_track_pointer
, Sx_track_pointer
, 0, 0, 0,
3077 "Track the pointer.")
3080 static Cursor current_pointer_shape
;
3081 FRAME_PTR f
= x_mouse_frame
;
3084 if (EQ (Vmouse_frame_part
, Qtext_part
)
3085 && (current_pointer_shape
!= f
->display
.x
->nontext_cursor
))
3090 current_pointer_shape
= f
->display
.x
->nontext_cursor
;
3091 XDefineCursor (x_current_display
,
3093 current_pointer_shape
);
3095 buf
= XBUFFER (XWINDOW (Vmouse_window
)->buffer
);
3096 c
= *(BUF_CHAR_ADDRESS (buf
, mouse_buffer_offset
));
3098 else if (EQ (Vmouse_frame_part
, Qmodeline_part
)
3099 && (current_pointer_shape
!= f
->display
.x
->modeline_cursor
))
3101 current_pointer_shape
= f
->display
.x
->modeline_cursor
;
3102 XDefineCursor (x_current_display
,
3104 current_pointer_shape
);
3113 DEFUN ("x-track-pointer", Fx_track_pointer
, Sx_track_pointer
, 1, 1, "e",
3114 "Draw rectangle around character under mouse pointer, if there is one.")
3118 struct window
*w
= XWINDOW (Vmouse_window
);
3119 struct frame
*f
= XFRAME (WINDOW_FRAME (w
));
3120 struct buffer
*b
= XBUFFER (w
->buffer
);
3123 if (! EQ (Vmouse_window
, selected_window
))
3126 if (EQ (event
, Qnil
))
3130 x_read_mouse_position (selected_frame
, &x
, &y
);
3134 mouse_track_width
= 0;
3135 mouse_track_left
= mouse_track_top
= -1;
3139 if ((x_mouse_x
!= mouse_track_left
3140 && (x_mouse_x
< mouse_track_left
3141 || x_mouse_x
> (mouse_track_left
+ mouse_track_width
)))
3142 || x_mouse_y
!= mouse_track_top
)
3144 int hp
= 0; /* Horizontal position */
3145 int len
= FRAME_CURRENT_GLYPHS (f
)->used
[x_mouse_y
];
3146 int p
= FRAME_CURRENT_GLYPHS (f
)->bufp
[x_mouse_y
];
3147 int tab_width
= XINT (b
->tab_width
);
3148 int ctl_arrow_p
= !NILP (b
->ctl_arrow
);
3150 int mode_line_vpos
= XFASTINT (w
->height
) + XFASTINT (w
->top
) - 1;
3151 int in_mode_line
= 0;
3153 if (! FRAME_CURRENT_GLYPHS (f
)->enable
[x_mouse_y
])
3156 /* Erase previous rectangle. */
3157 if (mouse_track_width
)
3159 x_rectangle (f
, f
->display
.x
->reverse_gc
,
3160 mouse_track_left
, mouse_track_top
,
3161 mouse_track_width
, 1);
3163 if ((mouse_track_left
== f
->phys_cursor_x
3164 || mouse_track_left
== f
->phys_cursor_x
- 1)
3165 && mouse_track_top
== f
->phys_cursor_y
)
3167 x_display_cursor (f
, 1);
3171 mouse_track_left
= x_mouse_x
;
3172 mouse_track_top
= x_mouse_y
;
3173 mouse_track_width
= 0;
3175 if (mouse_track_left
> len
) /* Past the end of line. */
3178 if (mouse_track_top
== mode_line_vpos
)
3184 if (tab_width
<= 0 || tab_width
> 20) tab_width
= 8;
3188 if (len
== f
->width
&& hp
== len
- 1 && c
!= '\n')
3194 mouse_track_width
= tab_width
- (hp
% tab_width
);
3196 hp
+= mouse_track_width
;
3199 mouse_track_left
= hp
- mouse_track_width
;
3205 mouse_track_width
= -1;
3209 if (ctl_arrow_p
&& (c
< 040 || c
== 0177))
3214 mouse_track_width
= 2;
3219 mouse_track_left
= hp
- mouse_track_width
;
3225 mouse_track_width
= 1;
3232 while (hp
<= x_mouse_x
);
3235 if (mouse_track_width
) /* Over text; use text pointer shape. */
3237 XDefineCursor (x_current_display
,
3239 f
->display
.x
->text_cursor
);
3240 x_rectangle (f
, f
->display
.x
->cursor_gc
,
3241 mouse_track_left
, mouse_track_top
,
3242 mouse_track_width
, 1);
3244 else if (in_mode_line
)
3245 XDefineCursor (x_current_display
,
3247 f
->display
.x
->modeline_cursor
);
3249 XDefineCursor (x_current_display
,
3251 f
->display
.x
->nontext_cursor
);
3254 XFlush (x_current_display
);
3257 obj
= read_char (-1, 0, 0, Qnil
, 0);
3260 while (XTYPE (obj
) == Lisp_Cons
/* Mouse event */
3261 && EQ (Fcar (Fcdr (Fcdr (obj
))), Qnil
) /* Not scroll bar */
3262 && EQ (Vmouse_depressed
, Qnil
) /* Only motion events */
3263 && EQ (Vmouse_window
, selected_window
) /* In this window */
3266 unread_command_event
= obj
;
3268 if (mouse_track_width
)
3270 x_rectangle (f
, f
->display
.x
->reverse_gc
,
3271 mouse_track_left
, mouse_track_top
,
3272 mouse_track_width
, 1);
3273 mouse_track_width
= 0;
3274 if ((mouse_track_left
== f
->phys_cursor_x
3275 || mouse_track_left
- 1 == f
->phys_cursor_x
)
3276 && mouse_track_top
== f
->phys_cursor_y
)
3278 x_display_cursor (f
, 1);
3281 XDefineCursor (x_current_display
,
3283 f
->display
.x
->nontext_cursor
);
3284 XFlush (x_current_display
);
3294 /* Draw a pixmap specified by IMAGE_DATA of dimensions WIDTH and HEIGHT
3295 on the frame F at position X, Y. */
3297 x_draw_pixmap (f
, x
, y
, image_data
, width
, height
)
3299 int x
, y
, width
, height
;
3304 image
= XCreateBitmapFromData (x_current_display
,
3305 FRAME_X_WINDOW (f
), image_data
,
3307 XCopyPlane (x_current_display
, image
, FRAME_X_WINDOW (f
),
3308 f
->display
.x
->normal_gc
, 0, 0, width
, height
, x
, y
);
3313 DEFUN ("x-store-cut-buffer", Fx_store_cut_buffer
, Sx_store_cut_buffer
,
3314 1, 1, "sStore text in cut buffer: ",
3315 "Store contents of STRING into the cut buffer of the X window system.")
3317 register Lisp_Object string
;
3321 CHECK_STRING (string
, 1);
3322 if (! FRAME_X_P (selected_frame
))
3323 error ("Selected frame does not understand X protocol.");
3326 XStoreBytes ((char *) XSTRING (string
)->data
, XSTRING (string
)->size
);
3332 DEFUN ("x-get-cut-buffer", Fx_get_cut_buffer
, Sx_get_cut_buffer
, 0, 0, 0,
3333 "Return contents of cut buffer of the X window system, as a string.")
3337 register Lisp_Object string
;
3342 d
= XFetchBytes (&len
);
3343 string
= make_string (d
, len
);
3351 DEFUN ("x-rebind-key", Fx_rebind_key
, Sx_rebind_key
, 3, 3, 0,
3352 "Rebind X keysym KEYSYM, with MODIFIERS, to generate NEWSTRING.\n\
3353 KEYSYM is a string which conforms to the X keysym definitions found\n\
3354 in X11/keysymdef.h, sans the initial XK_. MODIFIERS is nil or a\n\
3355 list of strings specifying modifier keys such as Control_L, which must\n\
3356 also be depressed for NEWSTRING to appear.")
3357 (x_keysym
, modifiers
, newstring
)
3358 register Lisp_Object x_keysym
;
3359 register Lisp_Object modifiers
;
3360 register Lisp_Object newstring
;
3363 register KeySym keysym
;
3364 KeySym modifier_list
[16];
3366 CHECK_STRING (x_keysym
, 1);
3367 CHECK_STRING (newstring
, 3);
3369 keysym
= XStringToKeysym ((char *) XSTRING (x_keysym
)->data
);
3370 if (keysym
== NoSymbol
)
3371 error ("Keysym does not exist");
3373 if (NILP (modifiers
))
3374 XRebindKeysym (x_current_display
, keysym
, modifier_list
, 0,
3375 XSTRING (newstring
)->data
, XSTRING (newstring
)->size
);
3378 register Lisp_Object rest
, mod
;
3381 for (rest
= modifiers
; !NILP (rest
); rest
= Fcdr (rest
))
3384 error ("Can't have more than 16 modifiers");
3387 CHECK_STRING (mod
, 3);
3388 modifier_list
[i
] = XStringToKeysym ((char *) XSTRING (mod
)->data
);
3389 if (modifier_list
[i
] == NoSymbol
3390 || !IsModifierKey (modifier_list
[i
]))
3391 error ("Element is not a modifier keysym");
3395 XRebindKeysym (x_current_display
, keysym
, modifier_list
, i
,
3396 XSTRING (newstring
)->data
, XSTRING (newstring
)->size
);
3402 DEFUN ("x-rebind-keys", Fx_rebind_keys
, Sx_rebind_keys
, 2, 2, 0,
3403 "Rebind KEYCODE to list of strings STRINGS.\n\
3404 STRINGS should be a list of 16 elements, one for each shift combination.\n\
3405 nil as element means don't change.\n\
3406 See the documentation of `x-rebind-key' for more information.")
3408 register Lisp_Object keycode
;
3409 register Lisp_Object strings
;
3411 register Lisp_Object item
;
3412 register unsigned char *rawstring
;
3413 KeySym rawkey
, modifier
[1];
3415 register unsigned i
;
3417 CHECK_NUMBER (keycode
, 1);
3418 CHECK_CONS (strings
, 2);
3419 rawkey
= (KeySym
) ((unsigned) (XINT (keycode
))) & 255;
3420 for (i
= 0; i
<= 15; strings
= Fcdr (strings
), i
++)
3422 item
= Fcar (strings
);
3425 CHECK_STRING (item
, 2);
3426 strsize
= XSTRING (item
)->size
;
3427 rawstring
= (unsigned char *) xmalloc (strsize
);
3428 bcopy (XSTRING (item
)->data
, rawstring
, strsize
);
3429 modifier
[1] = 1 << i
;
3430 XRebindKeysym (x_current_display
, rawkey
, modifier
, 1,
3431 rawstring
, strsize
);
3437 DEFUN ("x-rebind-key", Fx_rebind_key
, Sx_rebind_key
, 3, 3, 0,
3438 "Rebind KEYCODE, with shift bits SHIFT-MASK, to new string NEWSTRING.\n\
3439 KEYCODE and SHIFT-MASK should be numbers representing the X keyboard code\n\
3440 and shift mask respectively. NEWSTRING is an arbitrary string of keystrokes.\n\
3441 If SHIFT-MASK is nil, then KEYCODE's key will be bound to NEWSTRING for\n\
3442 all shift combinations.\n\
3443 Shift Lock 1 Shift 2\n\
3446 For values of KEYCODE, see /usr/lib/Xkeymap.txt (remember that the codes\n\
3447 in that file are in octal!)\n\
3449 NOTE: due to an X bug, this function will not take effect unless one has\n\
3450 a `~/.Xkeymap' file. (See the documentation for the `keycomp' program.)\n\
3451 This problem will be fixed in X version 11.")
3453 (keycode
, shift_mask
, newstring
)
3454 register Lisp_Object keycode
;
3455 register Lisp_Object shift_mask
;
3456 register Lisp_Object newstring
;
3459 int keysym
, rawshift
;
3462 CHECK_NUMBER (keycode
, 1);
3463 if (!NILP (shift_mask
))
3464 CHECK_NUMBER (shift_mask
, 2);
3465 CHECK_STRING (newstring
, 3);
3466 strsize
= XSTRING (newstring
)->size
;
3467 rawstring
= (char *) xmalloc (strsize
);
3468 bcopy (XSTRING (newstring
)->data
, rawstring
, strsize
);
3470 keysym
= ((unsigned) (XINT (keycode
))) & 255;
3472 if (NILP (shift_mask
))
3474 for (i
= 0; i
<= 15; i
++)
3475 XRebindCode (keysym
, i
<<11, rawstring
, strsize
);
3479 rawshift
= (((unsigned) (XINT (shift_mask
))) & 15) << 11;
3480 XRebindCode (keysym
, rawshift
, rawstring
, strsize
);
3485 DEFUN ("x-rebind-keys", Fx_rebind_keys
, Sx_rebind_keys
, 2, 2, 0,
3486 "Rebind KEYCODE to list of strings STRINGS.\n\
3487 STRINGS should be a list of 16 elements, one for each shift combination.\n\
3488 nil as element means don't change.\n\
3489 See the documentation of `x-rebind-key' for more information.")
3491 register Lisp_Object keycode
;
3492 register Lisp_Object strings
;
3494 register Lisp_Object item
;
3495 register char *rawstring
;
3496 KeySym rawkey
, modifier
[1];
3498 register unsigned i
;
3500 CHECK_NUMBER (keycode
, 1);
3501 CHECK_CONS (strings
, 2);
3502 rawkey
= (KeySym
) ((unsigned) (XINT (keycode
))) & 255;
3503 for (i
= 0; i
<= 15; strings
= Fcdr (strings
), i
++)
3505 item
= Fcar (strings
);
3508 CHECK_STRING (item
, 2);
3509 strsize
= XSTRING (item
)->size
;
3510 rawstring
= (char *) xmalloc (strsize
);
3511 bcopy (XSTRING (item
)->data
, rawstring
, strsize
);
3512 XRebindCode (rawkey
, i
<< 11, rawstring
, strsize
);
3517 #endif /* not HAVE_X11 */
3521 select_visual (screen
, depth
)
3523 unsigned int *depth
;
3526 XVisualInfo
*vinfo
, vinfo_template
;
3529 v
= DefaultVisualOfScreen (screen
);
3532 vinfo_template
.visualid
= XVisualIDFromVisual (v
);
3534 vinfo_template
.visualid
= v
->visualid
;
3537 vinfo
= XGetVisualInfo (x_current_display
, VisualIDMask
, &vinfo_template
,
3540 fatal ("Can't get proper X visual info");
3542 if ((1 << vinfo
->depth
) == vinfo
->colormap_size
)
3543 *depth
= vinfo
->depth
;
3547 int n
= vinfo
->colormap_size
- 1;
3556 XFree ((char *) vinfo
);
3559 #endif /* HAVE_X11 */
3561 DEFUN ("x-open-connection", Fx_open_connection
, Sx_open_connection
,
3562 1, 2, 0, "Open a connection to an X server.\n\
3563 DISPLAY is the name of the display to connect to. Optional second\n\
3564 arg XRM_STRING is a string of resources in xrdb format.")
3565 (display
, xrm_string
)
3566 Lisp_Object display
, xrm_string
;
3568 unsigned int n_planes
;
3569 unsigned char *xrm_option
;
3571 CHECK_STRING (display
, 0);
3572 if (x_current_display
!= 0)
3573 error ("X server connection is already initialized");
3575 /* This is what opens the connection and sets x_current_display.
3576 This also initializes many symbols, such as those used for input. */
3577 x_term_init (XSTRING (display
)->data
);
3580 XFASTINT (Vwindow_system_version
) = 11;
3582 if (!EQ (xrm_string
, Qnil
))
3584 CHECK_STRING (xrm_string
, 1);
3585 xrm_option
= (unsigned char *) XSTRING (xrm_string
);
3588 xrm_option
= (unsigned char *) 0;
3589 xrdb
= x_load_resources (x_current_display
, xrm_option
, EMACS_CLASS
);
3591 XrmSetDatabase (x_current_display
, xrdb
);
3593 x_current_display
->db
= xrdb
;
3596 x_screen
= DefaultScreenOfDisplay (x_current_display
);
3598 screen_visual
= select_visual (x_screen
, &n_planes
);
3599 x_screen_planes
= n_planes
;
3600 x_screen_height
= HeightOfScreen (x_screen
);
3601 x_screen_width
= WidthOfScreen (x_screen
);
3603 /* X Atoms used by emacs. */
3604 Xatoms_of_xselect ();
3606 Xatom_wm_protocols
= XInternAtom (x_current_display
, "WM_PROTOCOLS",
3608 Xatom_wm_take_focus
= XInternAtom (x_current_display
, "WM_TAKE_FOCUS",
3610 Xatom_wm_save_yourself
= XInternAtom (x_current_display
, "WM_SAVE_YOURSELF",
3612 Xatom_wm_delete_window
= XInternAtom (x_current_display
, "WM_DELETE_WINDOW",
3614 Xatom_wm_change_state
= XInternAtom (x_current_display
, "WM_CHANGE_STATE",
3616 Xatom_wm_configure_denied
= XInternAtom (x_current_display
,
3617 "WM_CONFIGURE_DENIED", False
);
3618 Xatom_wm_window_moved
= XInternAtom (x_current_display
, "WM_MOVED",
3621 #else /* not HAVE_X11 */
3622 XFASTINT (Vwindow_system_version
) = 10;
3623 #endif /* not HAVE_X11 */
3627 DEFUN ("x-close-current-connection", Fx_close_current_connection
,
3628 Sx_close_current_connection
,
3629 0, 0, 0, "Close the connection to the current X server.")
3633 /* This is ONLY used when killing emacs; For switching displays
3634 we'll have to take care of setting CloseDownMode elsewhere. */
3636 if (x_current_display
)
3639 XSetCloseDownMode (x_current_display
, DestroyAll
);
3640 XCloseDisplay (x_current_display
);
3643 fatal ("No current X display connection to close\n");
3648 DEFUN ("x-synchronize", Fx_synchronize
, Sx_synchronize
,
3649 1, 1, 0, "If ON is non-nil, report X errors as soon as the erring request is made.\n\
3650 If ON is nil, allow buffering of requests.\n\
3651 Turning on synchronization prohibits the Xlib routines from buffering\n\
3652 requests and seriously degrades performance, but makes debugging much\n\
3657 XSynchronize (x_current_display
, !EQ (on
, Qnil
));
3665 /* This is zero if not using X windows. */
3666 x_current_display
= 0;
3668 /* The section below is built by the lisp expression at the top of the file,
3669 just above where these variables are declared. */
3670 /*&&& init symbols here &&&*/
3671 Qauto_raise
= intern ("auto-raise");
3672 staticpro (&Qauto_raise
);
3673 Qauto_lower
= intern ("auto-lower");
3674 staticpro (&Qauto_lower
);
3675 Qbackground_color
= intern ("background-color");
3676 staticpro (&Qbackground_color
);
3677 Qbar
= intern ("bar");
3679 Qborder_color
= intern ("border-color");
3680 staticpro (&Qborder_color
);
3681 Qborder_width
= intern ("border-width");
3682 staticpro (&Qborder_width
);
3683 Qbox
= intern ("box");
3685 Qcursor_color
= intern ("cursor-color");
3686 staticpro (&Qcursor_color
);
3687 Qcursor_type
= intern ("cursor-type");
3688 staticpro (&Qcursor_type
);
3689 Qfont
= intern ("font");
3691 Qforeground_color
= intern ("foreground-color");
3692 staticpro (&Qforeground_color
);
3693 Qgeometry
= intern ("geometry");
3694 staticpro (&Qgeometry
);
3695 Qicon
= intern ("icon");
3697 Qicon_left
= intern ("icon-left");
3698 staticpro (&Qicon_left
);
3699 Qicon_top
= intern ("icon-top");
3700 staticpro (&Qicon_top
);
3701 Qicon_type
= intern ("icon-type");
3702 staticpro (&Qicon_type
);
3703 Qinternal_border_width
= intern ("internal-border-width");
3704 staticpro (&Qinternal_border_width
);
3705 Qleft
= intern ("left");
3707 Qmouse_color
= intern ("mouse-color");
3708 staticpro (&Qmouse_color
);
3709 Qnone
= intern ("none");
3711 Qparent_id
= intern ("parent-id");
3712 staticpro (&Qparent_id
);
3713 Qsuppress_icon
= intern ("suppress-icon");
3714 staticpro (&Qsuppress_icon
);
3715 Qtop
= intern ("top");
3717 Qundefined_color
= intern ("undefined-color");
3718 staticpro (&Qundefined_color
);
3719 Qvertical_scroll_bars
= intern ("vertical-scroll-bars");
3720 staticpro (&Qvertical_scroll_bars
);
3721 Qvisibility
= intern ("visibility");
3722 staticpro (&Qvisibility
);
3723 Qwindow_id
= intern ("window-id");
3724 staticpro (&Qwindow_id
);
3725 Qx_frame_parameter
= intern ("x-frame-parameter");
3726 staticpro (&Qx_frame_parameter
);
3727 /* This is the end of symbol initialization. */
3729 Fput (Qundefined_color
, Qerror_conditions
,
3730 Fcons (Qundefined_color
, Fcons (Qerror
, Qnil
)));
3731 Fput (Qundefined_color
, Qerror_message
,
3732 build_string ("Undefined color"));
3734 init_x_parm_symbols ();
3736 DEFVAR_INT ("mouse-buffer-offset", &mouse_buffer_offset
,
3737 "The buffer offset of the character under the pointer.");
3738 mouse_buffer_offset
= 0;
3740 DEFVAR_INT ("x-pointer-shape", &Vx_pointer_shape
,
3741 "The shape of the pointer when over text.");
3742 Vx_pointer_shape
= Qnil
;
3744 DEFVAR_INT ("x-nontext-pointer-shape", &Vx_nontext_pointer_shape
,
3745 "The shape of the pointer when not over text.");
3746 Vx_nontext_pointer_shape
= Qnil
;
3748 DEFVAR_INT ("x-mode-pointer-shape", &Vx_mode_pointer_shape
,
3749 "The shape of the pointer when over the mode line.");
3750 Vx_mode_pointer_shape
= Qnil
;
3752 DEFVAR_LISP ("x-cursor-fore-pixel", &Vx_cursor_fore_pixel
,
3753 "A string indicating the foreground color of the cursor box.");
3754 Vx_cursor_fore_pixel
= Qnil
;
3756 DEFVAR_LISP ("mouse-grabbed", &Vmouse_depressed
,
3757 "Non-nil if a mouse button is currently depressed.");
3758 Vmouse_depressed
= Qnil
;
3760 DEFVAR_LISP ("x-no-window-manager", &Vx_no_window_manager
,
3761 "t if no X window manager is in use.");
3764 defsubr (&Sx_get_resource
);
3766 defsubr (&Sx_draw_rectangle
);
3767 defsubr (&Sx_erase_rectangle
);
3768 defsubr (&Sx_contour_region
);
3769 defsubr (&Sx_uncontour_region
);
3771 defsubr (&Sx_display_color_p
);
3772 defsubr (&Sx_color_defined_p
);
3773 defsubr (&Sx_server_vendor
);
3774 defsubr (&Sx_server_version
);
3775 defsubr (&Sx_display_pixel_width
);
3776 defsubr (&Sx_display_pixel_height
);
3777 defsubr (&Sx_display_mm_width
);
3778 defsubr (&Sx_display_mm_height
);
3779 defsubr (&Sx_display_screens
);
3780 defsubr (&Sx_display_planes
);
3781 defsubr (&Sx_display_color_cells
);
3782 defsubr (&Sx_display_visual_class
);
3783 defsubr (&Sx_display_backing_store
);
3784 defsubr (&Sx_display_save_under
);
3786 defsubr (&Sx_track_pointer
);
3787 defsubr (&Sx_grab_pointer
);
3788 defsubr (&Sx_ungrab_pointer
);
3791 defsubr (&Sx_get_default
);
3792 defsubr (&Sx_store_cut_buffer
);
3793 defsubr (&Sx_get_cut_buffer
);
3794 defsubr (&Sx_set_face
);
3796 defsubr (&Sx_parse_geometry
);
3797 defsubr (&Sx_create_frame
);
3798 defsubr (&Sfocus_frame
);
3799 defsubr (&Sunfocus_frame
);
3801 defsubr (&Sx_horizontal_line
);
3803 defsubr (&Sx_rebind_key
);
3804 defsubr (&Sx_rebind_keys
);
3805 defsubr (&Sx_open_connection
);
3806 defsubr (&Sx_close_current_connection
);
3807 defsubr (&Sx_synchronize
);
3810 #endif /* HAVE_X_WINDOWS */