1 /* Functions for the X window system.
2 Copyright (C) 1989, 1992, 1993, 1994, 1995 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, Inc., 59 Temple Place - Suite 330,
19 Boston, MA 02111-1307, USA. */
21 /* Completely rewritten by Richard Stallman. */
23 /* Rewritten for X11 by Joseph Arceneaux */
28 /* This makes the fields of a Display accessible, in Xlib header files. */
29 #define XLIB_ILLEGAL_ACCESS
36 #include "dispextern.h"
38 #include "blockinput.h"
44 /* On some systems, the character-composition stuff is broken in X11R5. */
45 #if defined (HAVE_X11R5) && ! defined (HAVE_X11R6)
46 #ifdef X11R5_INHIBIT_I18N
52 #if 1 /* Used to be #ifdef EMACS_BITMAP_FILES, but this should always work. */
53 #include "bitmaps/gray.xbm"
55 #include <X11/bitmaps/gray>
58 #include "[.bitmaps]gray.xbm"
62 #include <X11/Shell.h>
65 #include <X11/Xaw/Paned.h>
66 #include <X11/Xaw/Label.h>
67 #endif /* USE_MOTIF */
70 #undef USG /* ####KLUDGE for Solaris 2.2 and up */
79 #include "../lwlib/lwlib.h"
81 /* Do the EDITRES protocol if running X11R5
82 Exception: HP-UX (at least version A.09.05) has X11R5 without EditRes */
83 #if (XtSpecificationRelease >= 5) && !defined(NO_EDITRES)
85 extern void _XEditResCheckMessages ();
86 #endif /* R5 + Athena */
88 /* Unique id counter for widgets created by the Lucid Widget
90 extern LWLIB_ID widget_id_tick
;
92 /* This is part of a kludge--see lwlib/xlwmenu.c. */
93 XFontStruct
*xlwmenu_default_font
;
95 extern void free_frame_menubar ();
96 #endif /* USE_X_TOOLKIT */
98 #define min(a,b) ((a) < (b) ? (a) : (b))
99 #define max(a,b) ((a) > (b) ? (a) : (b))
102 #define MAXREQUEST(dpy) (XMaxRequestSize (dpy))
104 #define MAXREQUEST(dpy) ((dpy)->max_request_size)
107 /* The name we're using in resource queries. */
108 Lisp_Object Vx_resource_name
;
110 /* The background and shape of the mouse pointer, and shape when not
111 over text or in the modeline. */
112 Lisp_Object Vx_pointer_shape
, Vx_nontext_pointer_shape
, Vx_mode_pointer_shape
;
113 /* The shape when over mouse-sensitive text. */
114 Lisp_Object Vx_sensitive_text_pointer_shape
;
116 /* Color of chars displayed in cursor box. */
117 Lisp_Object Vx_cursor_fore_pixel
;
119 /* Nonzero if using X. */
122 /* Non nil if no window manager is in use. */
123 Lisp_Object Vx_no_window_manager
;
125 /* Search path for bitmap files. */
126 Lisp_Object Vx_bitmap_file_path
;
128 /* Evaluate this expression to rebuild the section of syms_of_xfns
129 that initializes and staticpros the symbols declared below. Note
130 that Emacs 18 has a bug that keeps C-x C-e from being able to
131 evaluate this expression.
134 ;; Accumulate a list of the symbols we want to initialize from the
135 ;; declarations at the top of the file.
136 (goto-char (point-min))
137 (search-forward "/\*&&& symbols declared here &&&*\/\n")
139 (while (looking-at "Lisp_Object \\(Q[a-z_]+\\)")
141 (cons (buffer-substring (match-beginning 1) (match-end 1))
144 (setq symbol-list (nreverse symbol-list))
145 ;; Delete the section of syms_of_... where we initialize the symbols.
146 (search-forward "\n /\*&&& init symbols here &&&*\/\n")
147 (let ((start (point)))
148 (while (looking-at "^ Q")
150 (kill-region start (point)))
151 ;; Write a new symbol initialization section.
153 (insert (format " %s = intern (\"" (car symbol-list)))
154 (let ((start (point)))
155 (insert (substring (car symbol-list) 1))
156 (subst-char-in-region start (point) ?_ ?-))
157 (insert (format "\");\n staticpro (&%s);\n" (car symbol-list)))
158 (setq symbol-list (cdr symbol-list)))))
162 /*&&& symbols declared here &&&*/
163 Lisp_Object Qauto_raise
;
164 Lisp_Object Qauto_lower
;
165 Lisp_Object Qbackground_color
;
167 Lisp_Object Qborder_color
;
168 Lisp_Object Qborder_width
;
170 Lisp_Object Qcursor_color
;
171 Lisp_Object Qcursor_type
;
173 Lisp_Object Qforeground_color
;
174 Lisp_Object Qgeometry
;
175 Lisp_Object Qicon_left
;
176 Lisp_Object Qicon_top
;
177 Lisp_Object Qicon_type
;
178 Lisp_Object Qicon_name
;
179 Lisp_Object Qinternal_border_width
;
181 Lisp_Object Qmouse_color
;
183 Lisp_Object Qparent_id
;
184 Lisp_Object Qscroll_bar_width
;
185 Lisp_Object Qsuppress_icon
;
187 Lisp_Object Qundefined_color
;
188 Lisp_Object Qvertical_scroll_bars
;
189 Lisp_Object Qvisibility
;
190 Lisp_Object Qwindow_id
;
191 Lisp_Object Qx_frame_parameter
;
192 Lisp_Object Qx_resource_name
;
193 Lisp_Object Quser_position
;
194 Lisp_Object Quser_size
;
195 Lisp_Object Qdisplay
;
197 /* The below are defined in frame.c. */
198 extern Lisp_Object Qheight
, Qminibuffer
, Qname
, Qonly
, Qwidth
;
199 extern Lisp_Object Qunsplittable
, Qmenu_bar_lines
, Qbuffer_predicate
;
201 extern Lisp_Object Vwindow_system_version
;
204 /* Error if we are not connected to X. */
209 error ("X windows are not in use or not initialized");
212 /* Nonzero if we can use mouse menus.
213 You should not call this unless HAVE_MENUS is defined. */
221 /* Extract a frame as a FRAME_PTR, defaulting to the selected frame
222 and checking validity for X. */
225 check_x_frame (frame
)
234 CHECK_LIVE_FRAME (frame
, 0);
238 error ("Non-X frame used");
242 /* Let the user specify an X display with a frame.
243 nil stands for the selected frame--or, if that is not an X frame,
244 the first X display on the list. */
246 static struct x_display_info
*
247 check_x_display_info (frame
)
252 if (FRAME_X_P (selected_frame
))
253 return FRAME_X_DISPLAY_INFO (selected_frame
);
254 else if (x_display_list
!= 0)
255 return x_display_list
;
257 error ("X windows are not in use or not initialized");
259 else if (STRINGP (frame
))
260 return x_display_info_for_name (frame
);
265 CHECK_LIVE_FRAME (frame
, 0);
268 error ("Non-X frame used");
269 return FRAME_X_DISPLAY_INFO (f
);
273 /* Return the Emacs frame-object corresponding to an X window.
274 It could be the frame's main window or an icon window. */
276 /* This function can be called during GC, so use GC_xxx type test macros. */
279 x_window_to_frame (dpyinfo
, wdesc
)
280 struct x_display_info
*dpyinfo
;
283 Lisp_Object tail
, frame
;
286 for (tail
= Vframe_list
; GC_CONSP (tail
); tail
= XCONS (tail
)->cdr
)
288 frame
= XCONS (tail
)->car
;
289 if (!GC_FRAMEP (frame
))
292 if (f
->output_data
.nothing
== 1 || FRAME_X_DISPLAY_INFO (f
) != dpyinfo
)
295 if ((f
->output_data
.x
->edit_widget
296 && XtWindow (f
->output_data
.x
->edit_widget
) == wdesc
)
297 || f
->output_data
.x
->icon_desc
== wdesc
)
299 #else /* not USE_X_TOOLKIT */
300 if (FRAME_X_WINDOW (f
) == wdesc
301 || f
->output_data
.x
->icon_desc
== wdesc
)
303 #endif /* not USE_X_TOOLKIT */
309 /* Like x_window_to_frame but also compares the window with the widget's
313 x_any_window_to_frame (dpyinfo
, wdesc
)
314 struct x_display_info
*dpyinfo
;
317 Lisp_Object tail
, frame
;
321 for (tail
= Vframe_list
; GC_CONSP (tail
); tail
= XCONS (tail
)->cdr
)
323 frame
= XCONS (tail
)->car
;
324 if (!GC_FRAMEP (frame
))
327 if (f
->output_data
.nothing
== 1 || FRAME_X_DISPLAY_INFO (f
) != dpyinfo
)
329 x
= f
->output_data
.x
;
330 /* This frame matches if the window is any of its widgets. */
331 if (wdesc
== XtWindow (x
->widget
)
332 || wdesc
== XtWindow (x
->column_widget
)
333 || wdesc
== XtWindow (x
->edit_widget
))
335 /* Match if the window is this frame's menubar. */
336 if (lw_window_is_in_menubar (wdesc
, x
->menubar_widget
))
342 /* Likewise, but exclude the menu bar widget. */
345 x_non_menubar_window_to_frame (dpyinfo
, wdesc
)
346 struct x_display_info
*dpyinfo
;
349 Lisp_Object tail
, frame
;
353 for (tail
= Vframe_list
; GC_CONSP (tail
); tail
= XCONS (tail
)->cdr
)
355 frame
= XCONS (tail
)->car
;
356 if (!GC_FRAMEP (frame
))
359 if (f
->output_data
.nothing
== 1 || FRAME_X_DISPLAY_INFO (f
) != dpyinfo
)
361 x
= f
->output_data
.x
;
362 /* This frame matches if the window is any of its widgets. */
363 if (wdesc
== XtWindow (x
->widget
)
364 || wdesc
== XtWindow (x
->column_widget
)
365 || wdesc
== XtWindow (x
->edit_widget
))
371 /* Likewise, but consider only the menu bar widget. */
374 x_menubar_window_to_frame (dpyinfo
, wdesc
)
375 struct x_display_info
*dpyinfo
;
378 Lisp_Object tail
, frame
;
382 for (tail
= Vframe_list
; GC_CONSP (tail
); tail
= XCONS (tail
)->cdr
)
384 frame
= XCONS (tail
)->car
;
385 if (!GC_FRAMEP (frame
))
388 if (f
->output_data
.nothing
== 1 || FRAME_X_DISPLAY_INFO (f
) != dpyinfo
)
390 x
= f
->output_data
.x
;
391 /* Match if the window is this frame's menubar. */
392 if (lw_window_is_in_menubar (wdesc
, x
->menubar_widget
))
398 /* Return the frame whose principal (outermost) window is WDESC.
399 If WDESC is some other (smaller) window, we return 0. */
402 x_top_window_to_frame (dpyinfo
, wdesc
)
403 struct x_display_info
*dpyinfo
;
406 Lisp_Object tail
, frame
;
410 for (tail
= Vframe_list
; GC_CONSP (tail
); tail
= XCONS (tail
)->cdr
)
412 frame
= XCONS (tail
)->car
;
413 if (!GC_FRAMEP (frame
))
416 if (f
->output_data
.nothing
== 1 || FRAME_X_DISPLAY_INFO (f
) != dpyinfo
)
418 x
= f
->output_data
.x
;
419 /* This frame matches if the window is its topmost widget. */
420 if (wdesc
== XtWindow (x
->widget
))
422 #if 0 /* I don't know why it did this,
423 but it seems logically wrong,
424 and it causes trouble for MapNotify events. */
425 /* Match if the window is this frame's menubar. */
426 if (x
->menubar_widget
427 && wdesc
== XtWindow (x
->menubar_widget
))
433 #endif /* USE_X_TOOLKIT */
437 /* Code to deal with bitmaps. Bitmaps are referenced by their bitmap
438 id, which is just an int that this section returns. Bitmaps are
439 reference counted so they can be shared among frames.
441 Bitmap indices are guaranteed to be > 0, so a negative number can
442 be used to indicate no bitmap.
444 If you use x_create_bitmap_from_data, then you must keep track of
445 the bitmaps yourself. That is, creating a bitmap from the same
446 data more than once will not be caught. */
449 /* Functions to access the contents of a bitmap, given an id. */
452 x_bitmap_height (f
, id
)
456 return FRAME_X_DISPLAY_INFO (f
)->bitmaps
[id
- 1].height
;
460 x_bitmap_width (f
, id
)
464 return FRAME_X_DISPLAY_INFO (f
)->bitmaps
[id
- 1].width
;
468 x_bitmap_pixmap (f
, id
)
472 return FRAME_X_DISPLAY_INFO (f
)->bitmaps
[id
- 1].pixmap
;
476 /* Allocate a new bitmap record. Returns index of new record. */
479 x_allocate_bitmap_record (f
)
482 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
485 if (dpyinfo
->bitmaps
== NULL
)
487 dpyinfo
->bitmaps_size
= 10;
489 = (struct x_bitmap_record
*) xmalloc (dpyinfo
->bitmaps_size
* sizeof (struct x_bitmap_record
));
490 dpyinfo
->bitmaps_last
= 1;
494 if (dpyinfo
->bitmaps_last
< dpyinfo
->bitmaps_size
)
495 return ++dpyinfo
->bitmaps_last
;
497 for (i
= 0; i
< dpyinfo
->bitmaps_size
; ++i
)
498 if (dpyinfo
->bitmaps
[i
].refcount
== 0)
501 dpyinfo
->bitmaps_size
*= 2;
503 = (struct x_bitmap_record
*) xrealloc (dpyinfo
->bitmaps
,
504 dpyinfo
->bitmaps_size
* sizeof (struct x_bitmap_record
));
505 return ++dpyinfo
->bitmaps_last
;
508 /* Add one reference to the reference count of the bitmap with id ID. */
511 x_reference_bitmap (f
, id
)
515 ++FRAME_X_DISPLAY_INFO (f
)->bitmaps
[id
- 1].refcount
;
518 /* Create a bitmap for frame F from a HEIGHT x WIDTH array of bits at BITS. */
521 x_create_bitmap_from_data (f
, bits
, width
, height
)
524 unsigned int width
, height
;
526 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
530 bitmap
= XCreateBitmapFromData (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
531 bits
, width
, height
);
536 id
= x_allocate_bitmap_record (f
);
537 dpyinfo
->bitmaps
[id
- 1].pixmap
= bitmap
;
538 dpyinfo
->bitmaps
[id
- 1].file
= NULL
;
539 dpyinfo
->bitmaps
[id
- 1].refcount
= 1;
540 dpyinfo
->bitmaps
[id
- 1].depth
= 1;
541 dpyinfo
->bitmaps
[id
- 1].height
= height
;
542 dpyinfo
->bitmaps
[id
- 1].width
= width
;
547 /* Create bitmap from file FILE for frame F. */
550 x_create_bitmap_from_file (f
, file
)
554 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
555 unsigned int width
, height
;
557 int xhot
, yhot
, result
, id
;
562 /* Look for an existing bitmap with the same name. */
563 for (id
= 0; id
< dpyinfo
->bitmaps_last
; ++id
)
565 if (dpyinfo
->bitmaps
[id
].refcount
566 && dpyinfo
->bitmaps
[id
].file
567 && !strcmp (dpyinfo
->bitmaps
[id
].file
, (char *) XSTRING (file
)->data
))
569 ++dpyinfo
->bitmaps
[id
].refcount
;
574 /* Search bitmap-file-path for the file, if appropriate. */
575 fd
= openp (Vx_bitmap_file_path
, file
, "", &found
, 0);
580 filename
= (char *) XSTRING (found
)->data
;
582 result
= XReadBitmapFile (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
583 filename
, &width
, &height
, &bitmap
, &xhot
, &yhot
);
584 if (result
!= BitmapSuccess
)
587 id
= x_allocate_bitmap_record (f
);
588 dpyinfo
->bitmaps
[id
- 1].pixmap
= bitmap
;
589 dpyinfo
->bitmaps
[id
- 1].refcount
= 1;
590 dpyinfo
->bitmaps
[id
- 1].file
= (char *) xmalloc (XSTRING (file
)->size
+ 1);
591 dpyinfo
->bitmaps
[id
- 1].depth
= 1;
592 dpyinfo
->bitmaps
[id
- 1].height
= height
;
593 dpyinfo
->bitmaps
[id
- 1].width
= width
;
594 strcpy (dpyinfo
->bitmaps
[id
- 1].file
, XSTRING (file
)->data
);
599 /* Remove reference to bitmap with id number ID. */
602 x_destroy_bitmap (f
, id
)
606 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
610 --dpyinfo
->bitmaps
[id
- 1].refcount
;
611 if (dpyinfo
->bitmaps
[id
- 1].refcount
== 0)
614 XFreePixmap (FRAME_X_DISPLAY (f
), dpyinfo
->bitmaps
[id
- 1].pixmap
);
615 if (dpyinfo
->bitmaps
[id
- 1].file
)
617 free (dpyinfo
->bitmaps
[id
- 1].file
);
618 dpyinfo
->bitmaps
[id
- 1].file
= NULL
;
625 /* Free all the bitmaps for the display specified by DPYINFO. */
628 x_destroy_all_bitmaps (dpyinfo
)
629 struct x_display_info
*dpyinfo
;
632 for (i
= 0; i
< dpyinfo
->bitmaps_last
; i
++)
633 if (dpyinfo
->bitmaps
[i
].refcount
> 0)
635 XFreePixmap (dpyinfo
->display
, dpyinfo
->bitmaps
[i
].pixmap
);
636 if (dpyinfo
->bitmaps
[i
].file
)
637 free (dpyinfo
->bitmaps
[i
].file
);
639 dpyinfo
->bitmaps_last
= 0;
642 /* Connect the frame-parameter names for X frames
643 to the ways of passing the parameter values to the window system.
645 The name of a parameter, as a Lisp symbol,
646 has an `x-frame-parameter' property which is an integer in Lisp
647 but can be interpreted as an `enum x_frame_parm' in C. */
651 X_PARM_FOREGROUND_COLOR
,
652 X_PARM_BACKGROUND_COLOR
,
659 X_PARM_INTERNAL_BORDER_WIDTH
,
663 X_PARM_VERT_SCROLL_BAR
,
665 X_PARM_MENU_BAR_LINES
669 struct x_frame_parm_table
672 void (*setter
)( /* struct frame *frame, Lisp_Object val, oldval */ );
675 void x_set_foreground_color ();
676 void x_set_background_color ();
677 void x_set_mouse_color ();
678 void x_set_cursor_color ();
679 void x_set_border_color ();
680 void x_set_cursor_type ();
681 void x_set_icon_type ();
682 void x_set_icon_name ();
684 void x_set_border_width ();
685 void x_set_internal_border_width ();
686 void x_explicitly_set_name ();
687 void x_set_autoraise ();
688 void x_set_autolower ();
689 void x_set_vertical_scroll_bars ();
690 void x_set_visibility ();
691 void x_set_menu_bar_lines ();
692 void x_set_scroll_bar_width ();
693 void x_set_unsplittable ();
695 static struct x_frame_parm_table x_frame_parms
[] =
697 "foreground-color", x_set_foreground_color
,
698 "background-color", x_set_background_color
,
699 "mouse-color", x_set_mouse_color
,
700 "cursor-color", x_set_cursor_color
,
701 "border-color", x_set_border_color
,
702 "cursor-type", x_set_cursor_type
,
703 "icon-type", x_set_icon_type
,
704 "icon-name", x_set_icon_name
,
706 "border-width", x_set_border_width
,
707 "internal-border-width", x_set_internal_border_width
,
708 "name", x_explicitly_set_name
,
709 "auto-raise", x_set_autoraise
,
710 "auto-lower", x_set_autolower
,
711 "vertical-scroll-bars", x_set_vertical_scroll_bars
,
712 "visibility", x_set_visibility
,
713 "menu-bar-lines", x_set_menu_bar_lines
,
714 "scroll-bar-width", x_set_scroll_bar_width
,
715 "unsplittable", x_set_unsplittable
,
718 /* Attach the `x-frame-parameter' properties to
719 the Lisp symbol names of parameters relevant to X. */
721 init_x_parm_symbols ()
725 for (i
= 0; i
< sizeof (x_frame_parms
) / sizeof (x_frame_parms
[0]); i
++)
726 Fput (intern (x_frame_parms
[i
].name
), Qx_frame_parameter
,
730 /* Change the parameters of FRAME as specified by ALIST.
731 If a parameter is not specially recognized, do nothing;
732 otherwise call the `x_set_...' function for that parameter. */
735 x_set_frame_parameters (f
, alist
)
741 /* If both of these parameters are present, it's more efficient to
742 set them both at once. So we wait until we've looked at the
743 entire list before we set them. */
744 Lisp_Object width
, height
;
747 Lisp_Object left
, top
;
749 /* Same with these. */
750 Lisp_Object icon_left
, icon_top
;
752 /* Record in these vectors all the parms specified. */
756 int left_no_change
= 0, top_no_change
= 0;
757 int icon_left_no_change
= 0, icon_top_no_change
= 0;
760 for (tail
= alist
; CONSP (tail
); tail
= Fcdr (tail
))
763 parms
= (Lisp_Object
*) alloca (i
* sizeof (Lisp_Object
));
764 values
= (Lisp_Object
*) alloca (i
* sizeof (Lisp_Object
));
766 /* Extract parm names and values into those vectors. */
769 for (tail
= alist
; CONSP (tail
); tail
= Fcdr (tail
))
771 Lisp_Object elt
, prop
, val
;
774 parms
[i
] = Fcar (elt
);
775 values
[i
] = Fcdr (elt
);
779 width
= height
= top
= left
= Qunbound
;
780 icon_left
= icon_top
= Qunbound
;
782 /* Now process them in reverse of specified order. */
783 for (i
--; i
>= 0; i
--)
785 Lisp_Object prop
, val
;
790 if (EQ (prop
, Qwidth
))
792 else if (EQ (prop
, Qheight
))
794 else if (EQ (prop
, Qtop
))
796 else if (EQ (prop
, Qleft
))
798 else if (EQ (prop
, Qicon_top
))
800 else if (EQ (prop
, Qicon_left
))
804 register Lisp_Object param_index
, old_value
;
806 param_index
= Fget (prop
, Qx_frame_parameter
);
807 old_value
= get_frame_param (f
, prop
);
808 store_frame_param (f
, prop
, val
);
809 if (NATNUMP (param_index
)
810 && (XFASTINT (param_index
)
811 < sizeof (x_frame_parms
)/sizeof (x_frame_parms
[0])))
812 (*x_frame_parms
[XINT (param_index
)].setter
)(f
, val
, old_value
);
816 /* Don't die if just one of these was set. */
817 if (EQ (left
, Qunbound
))
820 if (f
->output_data
.x
->left_pos
< 0)
821 left
= Fcons (Qplus
, Fcons (make_number (f
->output_data
.x
->left_pos
), Qnil
));
823 XSETINT (left
, f
->output_data
.x
->left_pos
);
825 if (EQ (top
, Qunbound
))
828 if (f
->output_data
.x
->top_pos
< 0)
829 top
= Fcons (Qplus
, Fcons (make_number (f
->output_data
.x
->top_pos
), Qnil
));
831 XSETINT (top
, f
->output_data
.x
->top_pos
);
834 /* If one of the icon positions was not set, preserve or default it. */
835 if (EQ (icon_left
, Qunbound
) || ! INTEGERP (icon_left
))
837 icon_left_no_change
= 1;
838 icon_left
= Fcdr (Fassq (Qicon_left
, f
->param_alist
));
839 if (NILP (icon_left
))
840 XSETINT (icon_left
, 0);
842 if (EQ (icon_top
, Qunbound
) || ! INTEGERP (icon_top
))
844 icon_top_no_change
= 1;
845 icon_top
= Fcdr (Fassq (Qicon_top
, f
->param_alist
));
847 XSETINT (icon_top
, 0);
850 /* Don't die if just one of these was set. */
851 if (EQ (width
, Qunbound
))
852 XSETINT (width
, FRAME_WIDTH (f
));
853 if (EQ (height
, Qunbound
))
854 XSETINT (height
, FRAME_HEIGHT (f
));
856 /* Don't set these parameters unless they've been explicitly
857 specified. The window might be mapped or resized while we're in
858 this function, and we don't want to override that unless the lisp
859 code has asked for it.
861 Don't set these parameters unless they actually differ from the
862 window's current parameters; the window may not actually exist
867 check_frame_size (f
, &height
, &width
);
869 XSETFRAME (frame
, f
);
871 if ((NUMBERP (width
) && XINT (width
) != FRAME_WIDTH (f
))
872 || (NUMBERP (height
) && XINT (height
) != FRAME_HEIGHT (f
)))
873 Fset_frame_size (frame
, width
, height
);
875 if ((!NILP (left
) || !NILP (top
))
876 && ! (left_no_change
&& top_no_change
)
877 && ! (NUMBERP (left
) && XINT (left
) == f
->output_data
.x
->left_pos
878 && NUMBERP (top
) && XINT (top
) == f
->output_data
.x
->top_pos
))
883 /* Record the signs. */
884 f
->output_data
.x
->size_hint_flags
&= ~ (XNegative
| YNegative
);
885 if (EQ (left
, Qminus
))
886 f
->output_data
.x
->size_hint_flags
|= XNegative
;
887 else if (INTEGERP (left
))
889 leftpos
= XINT (left
);
891 f
->output_data
.x
->size_hint_flags
|= XNegative
;
893 else if (CONSP (left
) && EQ (XCONS (left
)->car
, Qminus
)
894 && CONSP (XCONS (left
)->cdr
)
895 && INTEGERP (XCONS (XCONS (left
)->cdr
)->car
))
897 leftpos
= - XINT (XCONS (XCONS (left
)->cdr
)->car
);
898 f
->output_data
.x
->size_hint_flags
|= XNegative
;
900 else if (CONSP (left
) && EQ (XCONS (left
)->car
, Qplus
)
901 && CONSP (XCONS (left
)->cdr
)
902 && INTEGERP (XCONS (XCONS (left
)->cdr
)->car
))
904 leftpos
= XINT (XCONS (XCONS (left
)->cdr
)->car
);
907 if (EQ (top
, Qminus
))
908 f
->output_data
.x
->size_hint_flags
|= YNegative
;
909 else if (INTEGERP (top
))
913 f
->output_data
.x
->size_hint_flags
|= YNegative
;
915 else if (CONSP (top
) && EQ (XCONS (top
)->car
, Qminus
)
916 && CONSP (XCONS (top
)->cdr
)
917 && INTEGERP (XCONS (XCONS (top
)->cdr
)->car
))
919 toppos
= - XINT (XCONS (XCONS (top
)->cdr
)->car
);
920 f
->output_data
.x
->size_hint_flags
|= YNegative
;
922 else if (CONSP (top
) && EQ (XCONS (top
)->car
, Qplus
)
923 && CONSP (XCONS (top
)->cdr
)
924 && INTEGERP (XCONS (XCONS (top
)->cdr
)->car
))
926 toppos
= XINT (XCONS (XCONS (top
)->cdr
)->car
);
930 /* Store the numeric value of the position. */
931 f
->output_data
.x
->top_pos
= toppos
;
932 f
->output_data
.x
->left_pos
= leftpos
;
934 f
->output_data
.x
->win_gravity
= NorthWestGravity
;
936 /* Actually set that position, and convert to absolute. */
937 x_set_offset (f
, leftpos
, toppos
, -1);
940 if ((!NILP (icon_left
) || !NILP (icon_top
))
941 && ! (icon_left_no_change
&& icon_top_no_change
))
942 x_wm_set_icon_position (f
, XINT (icon_left
), XINT (icon_top
));
946 /* Store the screen positions of frame F into XPTR and YPTR.
947 These are the positions of the containing window manager window,
948 not Emacs's own window. */
951 x_real_positions (f
, xptr
, yptr
)
958 /* This is pretty gross, but seems to be the easiest way out of
959 the problem that arises when restarting window-managers. */
962 Window outer
= XtWindow (f
->output_data
.x
->widget
);
964 Window outer
= f
->output_data
.x
->window_desc
;
966 Window tmp_root_window
;
967 Window
*tmp_children
;
972 x_catch_errors (FRAME_X_DISPLAY (f
));
974 XQueryTree (FRAME_X_DISPLAY (f
), outer
, &tmp_root_window
,
975 &f
->output_data
.x
->parent_desc
,
976 &tmp_children
, &tmp_nchildren
);
977 xfree (tmp_children
);
981 /* Find the position of the outside upper-left corner of
982 the inner window, with respect to the outer window. */
983 if (f
->output_data
.x
->parent_desc
!= FRAME_X_DISPLAY_INFO (f
)->root_window
)
985 XTranslateCoordinates (FRAME_X_DISPLAY (f
),
987 /* From-window, to-window. */
989 XtWindow (f
->output_data
.x
->widget
),
991 f
->output_data
.x
->window_desc
,
993 f
->output_data
.x
->parent_desc
,
995 /* From-position, to-position. */
996 0, 0, &win_x
, &win_y
,
1001 #if 0 /* The values seem to be right without this and wrong with. */
1002 win_x
+= f
->output_data
.x
->border_width
;
1003 win_y
+= f
->output_data
.x
->border_width
;
1007 /* It is possible for the window returned by the XQueryNotify
1008 to become invalid by the time we call XTranslateCoordinates.
1009 That can happen when you restart some window managers.
1010 If so, we get an error in XTranslateCoordinates.
1011 Detect that and try the whole thing over. */
1012 if (! x_had_errors_p (FRAME_X_DISPLAY (f
)))
1015 x_uncatch_errors (FRAME_X_DISPLAY (f
));
1018 x_uncatch_errors (FRAME_X_DISPLAY (f
));
1020 *xptr
= f
->output_data
.x
->left_pos
- win_x
;
1021 *yptr
= f
->output_data
.x
->top_pos
- win_y
;
1024 /* Insert a description of internally-recorded parameters of frame X
1025 into the parameter alist *ALISTPTR that is to be given to the user.
1026 Only parameters that are specific to the X window system
1027 and whose values are not correctly recorded in the frame's
1028 param_alist need to be considered here. */
1030 x_report_frame_params (f
, alistptr
)
1032 Lisp_Object
*alistptr
;
1037 /* Represent negative positions (off the top or left screen edge)
1038 in a way that Fmodify_frame_parameters will understand correctly. */
1039 XSETINT (tem
, f
->output_data
.x
->left_pos
);
1040 if (f
->output_data
.x
->left_pos
>= 0)
1041 store_in_alist (alistptr
, Qleft
, tem
);
1043 store_in_alist (alistptr
, Qleft
, Fcons (Qplus
, Fcons (tem
, Qnil
)));
1045 XSETINT (tem
, f
->output_data
.x
->top_pos
);
1046 if (f
->output_data
.x
->top_pos
>= 0)
1047 store_in_alist (alistptr
, Qtop
, tem
);
1049 store_in_alist (alistptr
, Qtop
, Fcons (Qplus
, Fcons (tem
, Qnil
)));
1051 store_in_alist (alistptr
, Qborder_width
,
1052 make_number (f
->output_data
.x
->border_width
));
1053 store_in_alist (alistptr
, Qinternal_border_width
,
1054 make_number (f
->output_data
.x
->internal_border_width
));
1055 sprintf (buf
, "%ld", (long) FRAME_X_WINDOW (f
));
1056 store_in_alist (alistptr
, Qwindow_id
,
1057 build_string (buf
));
1058 store_in_alist (alistptr
, Qicon_name
, f
->icon_name
);
1059 FRAME_SAMPLE_VISIBILITY (f
);
1060 store_in_alist (alistptr
, Qvisibility
,
1061 (FRAME_VISIBLE_P (f
) ? Qt
1062 : FRAME_ICONIFIED_P (f
) ? Qicon
: Qnil
));
1063 store_in_alist (alistptr
, Qdisplay
,
1064 XCONS (FRAME_X_DISPLAY_INFO (f
)->name_list_element
)->car
);
1068 /* Decide if color named COLOR is valid for the display associated with
1069 the selected frame; if so, return the rgb values in COLOR_DEF.
1070 If ALLOC is nonzero, allocate a new colormap cell. */
1073 defined_color (f
, color
, color_def
, alloc
)
1079 register int status
;
1080 Colormap screen_colormap
;
1081 Display
*display
= FRAME_X_DISPLAY (f
);
1084 screen_colormap
= DefaultColormap (display
, XDefaultScreen (display
));
1086 status
= XParseColor (display
, screen_colormap
, color
, color_def
);
1087 if (status
&& alloc
)
1089 status
= XAllocColor (display
, screen_colormap
, color_def
);
1092 /* If we got to this point, the colormap is full, so we're
1093 going to try and get the next closest color.
1094 The algorithm used is a least-squares matching, which is
1095 what X uses for closest color matching with StaticColor visuals. */
1100 long nearest_delta
, trial_delta
;
1103 no_cells
= XDisplayCells (display
, XDefaultScreen (display
));
1104 cells
= (XColor
*) alloca (sizeof (XColor
) * no_cells
);
1106 for (x
= 0; x
< no_cells
; x
++)
1109 XQueryColors (display
, screen_colormap
, cells
, no_cells
);
1111 /* I'm assuming CSE so I'm not going to condense this. */
1112 nearest_delta
= ((((color_def
->red
>> 8) - (cells
[0].red
>> 8))
1113 * ((color_def
->red
>> 8) - (cells
[0].red
>> 8)))
1115 (((color_def
->green
>> 8) - (cells
[0].green
>> 8))
1116 * ((color_def
->green
>> 8) - (cells
[0].green
>> 8)))
1118 (((color_def
->blue
>> 8) - (cells
[0].blue
>> 8))
1119 * ((color_def
->blue
>> 8) - (cells
[0].blue
>> 8))));
1120 for (x
= 1; x
< no_cells
; x
++)
1122 trial_delta
= ((((color_def
->red
>> 8) - (cells
[x
].red
>> 8))
1123 * ((color_def
->red
>> 8) - (cells
[x
].red
>> 8)))
1125 (((color_def
->green
>> 8) - (cells
[x
].green
>> 8))
1126 * ((color_def
->green
>> 8) - (cells
[x
].green
>> 8)))
1128 (((color_def
->blue
>> 8) - (cells
[x
].blue
>> 8))
1129 * ((color_def
->blue
>> 8) - (cells
[x
].blue
>> 8))));
1130 if (trial_delta
< nearest_delta
)
1133 nearest_delta
= trial_delta
;
1136 color_def
->red
= cells
[nearest
].red
;
1137 color_def
->green
= cells
[nearest
].green
;
1138 color_def
->blue
= cells
[nearest
].blue
;
1139 status
= XAllocColor (display
, screen_colormap
, color_def
);
1150 /* Given a string ARG naming a color, compute a pixel value from it
1151 suitable for screen F.
1152 If F is not a color screen, return DEF (default) regardless of what
1156 x_decode_color (f
, arg
, def
)
1163 CHECK_STRING (arg
, 0);
1165 if (strcmp (XSTRING (arg
)->data
, "black") == 0)
1166 return BLACK_PIX_DEFAULT (f
);
1167 else if (strcmp (XSTRING (arg
)->data
, "white") == 0)
1168 return WHITE_PIX_DEFAULT (f
);
1170 if (FRAME_X_DISPLAY_INFO (f
)->n_planes
== 1)
1173 /* defined_color is responsible for coping with failures
1174 by looking for a near-miss. */
1175 if (defined_color (f
, XSTRING (arg
)->data
, &cdef
, 1))
1178 Fsignal (Qerror
, Fcons (build_string ("undefined color"),
1179 Fcons (arg
, Qnil
)));
1182 /* Functions called only from `x_set_frame_param'
1183 to set individual parameters.
1185 If FRAME_X_WINDOW (f) is 0,
1186 the frame is being created and its X-window does not exist yet.
1187 In that case, just record the parameter's new value
1188 in the standard place; do not attempt to change the window. */
1191 x_set_foreground_color (f
, arg
, oldval
)
1193 Lisp_Object arg
, oldval
;
1195 f
->output_data
.x
->foreground_pixel
1196 = x_decode_color (f
, arg
, BLACK_PIX_DEFAULT (f
));
1197 if (FRAME_X_WINDOW (f
) != 0)
1200 XSetForeground (FRAME_X_DISPLAY (f
), f
->output_data
.x
->normal_gc
,
1201 f
->output_data
.x
->foreground_pixel
);
1202 XSetBackground (FRAME_X_DISPLAY (f
), f
->output_data
.x
->reverse_gc
,
1203 f
->output_data
.x
->foreground_pixel
);
1205 recompute_basic_faces (f
);
1206 if (FRAME_VISIBLE_P (f
))
1212 x_set_background_color (f
, arg
, oldval
)
1214 Lisp_Object arg
, oldval
;
1219 f
->output_data
.x
->background_pixel
1220 = x_decode_color (f
, arg
, WHITE_PIX_DEFAULT (f
));
1222 if (FRAME_X_WINDOW (f
) != 0)
1225 /* The main frame area. */
1226 XSetBackground (FRAME_X_DISPLAY (f
), f
->output_data
.x
->normal_gc
,
1227 f
->output_data
.x
->background_pixel
);
1228 XSetForeground (FRAME_X_DISPLAY (f
), f
->output_data
.x
->reverse_gc
,
1229 f
->output_data
.x
->background_pixel
);
1230 XSetForeground (FRAME_X_DISPLAY (f
), f
->output_data
.x
->cursor_gc
,
1231 f
->output_data
.x
->background_pixel
);
1232 XSetWindowBackground (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
1233 f
->output_data
.x
->background_pixel
);
1236 for (bar
= FRAME_SCROLL_BARS (f
); !NILP (bar
);
1237 bar
= XSCROLL_BAR (bar
)->next
)
1238 XSetWindowBackground (FRAME_X_DISPLAY (f
),
1239 SCROLL_BAR_X_WINDOW (XSCROLL_BAR (bar
)),
1240 f
->output_data
.x
->background_pixel
);
1244 recompute_basic_faces (f
);
1246 if (FRAME_VISIBLE_P (f
))
1252 x_set_mouse_color (f
, arg
, oldval
)
1254 Lisp_Object arg
, oldval
;
1256 Cursor cursor
, nontext_cursor
, mode_cursor
, cross_cursor
;
1259 if (!EQ (Qnil
, arg
))
1260 f
->output_data
.x
->mouse_pixel
1261 = x_decode_color (f
, arg
, BLACK_PIX_DEFAULT (f
));
1262 mask_color
= f
->output_data
.x
->background_pixel
;
1263 /* No invisible pointers. */
1264 if (mask_color
== f
->output_data
.x
->mouse_pixel
1265 && mask_color
== f
->output_data
.x
->background_pixel
)
1266 f
->output_data
.x
->mouse_pixel
= f
->output_data
.x
->foreground_pixel
;
1270 /* It's not okay to crash if the user selects a screwy cursor. */
1271 x_catch_errors (FRAME_X_DISPLAY (f
));
1273 if (!EQ (Qnil
, Vx_pointer_shape
))
1275 CHECK_NUMBER (Vx_pointer_shape
, 0);
1276 cursor
= XCreateFontCursor (FRAME_X_DISPLAY (f
), XINT (Vx_pointer_shape
));
1279 cursor
= XCreateFontCursor (FRAME_X_DISPLAY (f
), XC_xterm
);
1280 x_check_errors (FRAME_X_DISPLAY (f
), "bad text pointer cursor: %s");
1282 if (!EQ (Qnil
, Vx_nontext_pointer_shape
))
1284 CHECK_NUMBER (Vx_nontext_pointer_shape
, 0);
1285 nontext_cursor
= XCreateFontCursor (FRAME_X_DISPLAY (f
),
1286 XINT (Vx_nontext_pointer_shape
));
1289 nontext_cursor
= XCreateFontCursor (FRAME_X_DISPLAY (f
), XC_left_ptr
);
1290 x_check_errors (FRAME_X_DISPLAY (f
), "bad nontext pointer cursor: %s");
1292 if (!EQ (Qnil
, Vx_mode_pointer_shape
))
1294 CHECK_NUMBER (Vx_mode_pointer_shape
, 0);
1295 mode_cursor
= XCreateFontCursor (FRAME_X_DISPLAY (f
),
1296 XINT (Vx_mode_pointer_shape
));
1299 mode_cursor
= XCreateFontCursor (FRAME_X_DISPLAY (f
), XC_xterm
);
1300 x_check_errors (FRAME_X_DISPLAY (f
), "bad modeline pointer cursor: %s");
1302 if (!EQ (Qnil
, Vx_sensitive_text_pointer_shape
))
1304 CHECK_NUMBER (Vx_sensitive_text_pointer_shape
, 0);
1306 = XCreateFontCursor (FRAME_X_DISPLAY (f
),
1307 XINT (Vx_sensitive_text_pointer_shape
));
1310 cross_cursor
= XCreateFontCursor (FRAME_X_DISPLAY (f
), XC_crosshair
);
1312 /* Check and report errors with the above calls. */
1313 x_check_errors (FRAME_X_DISPLAY (f
), "can't set cursor shape: %s");
1314 x_uncatch_errors (FRAME_X_DISPLAY (f
));
1317 XColor fore_color
, back_color
;
1319 fore_color
.pixel
= f
->output_data
.x
->mouse_pixel
;
1320 back_color
.pixel
= mask_color
;
1321 XQueryColor (FRAME_X_DISPLAY (f
),
1322 DefaultColormap (FRAME_X_DISPLAY (f
),
1323 DefaultScreen (FRAME_X_DISPLAY (f
))),
1325 XQueryColor (FRAME_X_DISPLAY (f
),
1326 DefaultColormap (FRAME_X_DISPLAY (f
),
1327 DefaultScreen (FRAME_X_DISPLAY (f
))),
1329 XRecolorCursor (FRAME_X_DISPLAY (f
), cursor
,
1330 &fore_color
, &back_color
);
1331 XRecolorCursor (FRAME_X_DISPLAY (f
), nontext_cursor
,
1332 &fore_color
, &back_color
);
1333 XRecolorCursor (FRAME_X_DISPLAY (f
), mode_cursor
,
1334 &fore_color
, &back_color
);
1335 XRecolorCursor (FRAME_X_DISPLAY (f
), cross_cursor
,
1336 &fore_color
, &back_color
);
1339 if (FRAME_X_WINDOW (f
) != 0)
1341 XDefineCursor (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
), cursor
);
1344 if (cursor
!= f
->output_data
.x
->text_cursor
&& f
->output_data
.x
->text_cursor
!= 0)
1345 XFreeCursor (FRAME_X_DISPLAY (f
), f
->output_data
.x
->text_cursor
);
1346 f
->output_data
.x
->text_cursor
= cursor
;
1348 if (nontext_cursor
!= f
->output_data
.x
->nontext_cursor
1349 && f
->output_data
.x
->nontext_cursor
!= 0)
1350 XFreeCursor (FRAME_X_DISPLAY (f
), f
->output_data
.x
->nontext_cursor
);
1351 f
->output_data
.x
->nontext_cursor
= nontext_cursor
;
1353 if (mode_cursor
!= f
->output_data
.x
->modeline_cursor
1354 && f
->output_data
.x
->modeline_cursor
!= 0)
1355 XFreeCursor (FRAME_X_DISPLAY (f
), f
->output_data
.x
->modeline_cursor
);
1356 f
->output_data
.x
->modeline_cursor
= mode_cursor
;
1357 if (cross_cursor
!= f
->output_data
.x
->cross_cursor
1358 && f
->output_data
.x
->cross_cursor
!= 0)
1359 XFreeCursor (FRAME_X_DISPLAY (f
), f
->output_data
.x
->cross_cursor
);
1360 f
->output_data
.x
->cross_cursor
= cross_cursor
;
1362 XFlush (FRAME_X_DISPLAY (f
));
1367 x_set_cursor_color (f
, arg
, oldval
)
1369 Lisp_Object arg
, oldval
;
1371 unsigned long fore_pixel
;
1373 if (!EQ (Vx_cursor_fore_pixel
, Qnil
))
1374 fore_pixel
= x_decode_color (f
, Vx_cursor_fore_pixel
,
1375 WHITE_PIX_DEFAULT (f
));
1377 fore_pixel
= f
->output_data
.x
->background_pixel
;
1378 f
->output_data
.x
->cursor_pixel
= x_decode_color (f
, arg
, BLACK_PIX_DEFAULT (f
));
1380 /* Make sure that the cursor color differs from the background color. */
1381 if (f
->output_data
.x
->cursor_pixel
== f
->output_data
.x
->background_pixel
)
1383 f
->output_data
.x
->cursor_pixel
= f
->output_data
.x
->mouse_pixel
;
1384 if (f
->output_data
.x
->cursor_pixel
== fore_pixel
)
1385 fore_pixel
= f
->output_data
.x
->background_pixel
;
1387 f
->output_data
.x
->cursor_foreground_pixel
= fore_pixel
;
1389 if (FRAME_X_WINDOW (f
) != 0)
1392 XSetBackground (FRAME_X_DISPLAY (f
), f
->output_data
.x
->cursor_gc
,
1393 f
->output_data
.x
->cursor_pixel
);
1394 XSetForeground (FRAME_X_DISPLAY (f
), f
->output_data
.x
->cursor_gc
,
1398 if (FRAME_VISIBLE_P (f
))
1400 x_display_cursor (f
, 0);
1401 x_display_cursor (f
, 1);
1406 /* Set the border-color of frame F to value described by ARG.
1407 ARG can be a string naming a color.
1408 The border-color is used for the border that is drawn by the X server.
1409 Note that this does not fully take effect if done before
1410 F has an x-window; it must be redone when the window is created.
1412 Note: this is done in two routines because of the way X10 works.
1414 Note: under X11, this is normally the province of the window manager,
1415 and so emacs' border colors may be overridden. */
1418 x_set_border_color (f
, arg
, oldval
)
1420 Lisp_Object arg
, oldval
;
1425 CHECK_STRING (arg
, 0);
1426 str
= XSTRING (arg
)->data
;
1428 pix
= x_decode_color (f
, arg
, BLACK_PIX_DEFAULT (f
));
1430 x_set_border_pixel (f
, pix
);
1433 /* Set the border-color of frame F to pixel value PIX.
1434 Note that this does not fully take effect if done before
1435 F has an x-window. */
1437 x_set_border_pixel (f
, pix
)
1441 f
->output_data
.x
->border_pixel
= pix
;
1443 if (FRAME_X_WINDOW (f
) != 0 && f
->output_data
.x
->border_width
> 0)
1449 XSetWindowBorder (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
1450 (unsigned long)pix
);
1453 if (FRAME_VISIBLE_P (f
))
1459 x_set_cursor_type (f
, arg
, oldval
)
1461 Lisp_Object arg
, oldval
;
1465 FRAME_DESIRED_CURSOR (f
) = bar_cursor
;
1466 f
->output_data
.x
->cursor_width
= 2;
1468 else if (CONSP (arg
) && EQ (XCONS (arg
)->car
, Qbar
)
1469 && INTEGERP (XCONS (arg
)->cdr
))
1471 FRAME_DESIRED_CURSOR (f
) = bar_cursor
;
1472 f
->output_data
.x
->cursor_width
= XINT (XCONS (arg
)->cdr
);
1475 /* Treat anything unknown as "box cursor".
1476 It was bad to signal an error; people have trouble fixing
1477 .Xdefaults with Emacs, when it has something bad in it. */
1478 FRAME_DESIRED_CURSOR (f
) = filled_box_cursor
;
1480 /* Make sure the cursor gets redrawn. This is overkill, but how
1481 often do people change cursor types? */
1482 update_mode_lines
++;
1486 x_set_icon_type (f
, arg
, oldval
)
1488 Lisp_Object arg
, oldval
;
1495 if (STRINGP (oldval
) && EQ (Fstring_equal (oldval
, arg
), Qt
))
1498 else if (!STRINGP (oldval
) && EQ (oldval
, Qnil
) == EQ (arg
, Qnil
))
1503 result
= x_text_icon (f
,
1504 (char *) XSTRING ((!NILP (f
->icon_name
)
1508 result
= x_bitmap_icon (f
, arg
);
1513 error ("No icon window available");
1516 XFlush (FRAME_X_DISPLAY (f
));
1520 /* Return non-nil if frame F wants a bitmap icon. */
1528 tem
= assq_no_quit (Qicon_type
, f
->param_alist
);
1530 return XCONS (tem
)->cdr
;
1536 x_set_icon_name (f
, arg
, oldval
)
1538 Lisp_Object arg
, oldval
;
1545 if (STRINGP (oldval
) && EQ (Fstring_equal (oldval
, arg
), Qt
))
1548 else if (!STRINGP (oldval
) && EQ (oldval
, Qnil
) == EQ (arg
, Qnil
))
1553 if (f
->output_data
.x
->icon_bitmap
!= 0)
1558 result
= x_text_icon (f
,
1559 (char *) XSTRING ((!NILP (f
->icon_name
)
1566 error ("No icon window available");
1569 XFlush (FRAME_X_DISPLAY (f
));
1573 extern Lisp_Object
x_new_font ();
1576 x_set_font (f
, arg
, oldval
)
1578 Lisp_Object arg
, oldval
;
1582 CHECK_STRING (arg
, 1);
1585 result
= x_new_font (f
, XSTRING (arg
)->data
);
1588 if (EQ (result
, Qnil
))
1589 error ("Font `%s' is not defined", XSTRING (arg
)->data
);
1590 else if (EQ (result
, Qt
))
1591 error ("the characters of the given font have varying widths");
1592 else if (STRINGP (result
))
1594 recompute_basic_faces (f
);
1595 store_frame_param (f
, Qfont
, result
);
1602 x_set_border_width (f
, arg
, oldval
)
1604 Lisp_Object arg
, oldval
;
1606 CHECK_NUMBER (arg
, 0);
1608 if (XINT (arg
) == f
->output_data
.x
->border_width
)
1611 if (FRAME_X_WINDOW (f
) != 0)
1612 error ("Cannot change the border width of a window");
1614 f
->output_data
.x
->border_width
= XINT (arg
);
1618 x_set_internal_border_width (f
, arg
, oldval
)
1620 Lisp_Object arg
, oldval
;
1623 int old
= f
->output_data
.x
->internal_border_width
;
1625 CHECK_NUMBER (arg
, 0);
1626 f
->output_data
.x
->internal_border_width
= XINT (arg
);
1627 if (f
->output_data
.x
->internal_border_width
< 0)
1628 f
->output_data
.x
->internal_border_width
= 0;
1630 if (f
->output_data
.x
->internal_border_width
== old
)
1633 if (FRAME_X_WINDOW (f
) != 0)
1636 x_set_window_size (f
, 0, f
->width
, f
->height
);
1638 x_set_resize_hint (f
);
1640 XFlush (FRAME_X_DISPLAY (f
));
1642 SET_FRAME_GARBAGED (f
);
1647 x_set_visibility (f
, value
, oldval
)
1649 Lisp_Object value
, oldval
;
1652 XSETFRAME (frame
, f
);
1655 Fmake_frame_invisible (frame
, Qt
);
1656 else if (EQ (value
, Qicon
))
1657 Ficonify_frame (frame
);
1659 Fmake_frame_visible (frame
);
1663 x_set_menu_bar_lines_1 (window
, n
)
1667 struct window
*w
= XWINDOW (window
);
1669 XSETFASTINT (w
->top
, XFASTINT (w
->top
) + n
);
1670 XSETFASTINT (w
->height
, XFASTINT (w
->height
) - n
);
1672 /* Handle just the top child in a vertical split. */
1673 if (!NILP (w
->vchild
))
1674 x_set_menu_bar_lines_1 (w
->vchild
, n
);
1676 /* Adjust all children in a horizontal split. */
1677 for (window
= w
->hchild
; !NILP (window
); window
= w
->next
)
1679 w
= XWINDOW (window
);
1680 x_set_menu_bar_lines_1 (window
, n
);
1685 x_set_menu_bar_lines (f
, value
, oldval
)
1687 Lisp_Object value
, oldval
;
1690 int olines
= FRAME_MENU_BAR_LINES (f
);
1692 /* Right now, menu bars don't work properly in minibuf-only frames;
1693 most of the commands try to apply themselves to the minibuffer
1694 frame itslef, and get an error because you can't switch buffers
1695 in or split the minibuffer window. */
1696 if (FRAME_MINIBUF_ONLY_P (f
))
1699 if (INTEGERP (value
))
1700 nlines
= XINT (value
);
1704 #ifdef USE_X_TOOLKIT
1705 FRAME_MENU_BAR_LINES (f
) = 0;
1708 FRAME_EXTERNAL_MENU_BAR (f
) = 1;
1709 if (FRAME_X_P (f
) && f
->output_data
.x
->menubar_widget
== 0)
1710 /* Make sure next redisplay shows the menu bar. */
1711 XWINDOW (FRAME_SELECTED_WINDOW (f
))->update_mode_line
= Qt
;
1715 if (FRAME_EXTERNAL_MENU_BAR (f
) == 1)
1716 free_frame_menubar (f
);
1717 FRAME_EXTERNAL_MENU_BAR (f
) = 0;
1719 f
->output_data
.x
->menubar_widget
= 0;
1721 #else /* not USE_X_TOOLKIT */
1722 FRAME_MENU_BAR_LINES (f
) = nlines
;
1723 x_set_menu_bar_lines_1 (f
->root_window
, nlines
- olines
);
1724 #endif /* not USE_X_TOOLKIT */
1727 /* Change the name of frame F to NAME. If NAME is nil, set F's name to
1730 If EXPLICIT is non-zero, that indicates that lisp code is setting the
1731 name; if NAME is a string, set F's name to NAME and set
1732 F->explicit_name; if NAME is Qnil, then clear F->explicit_name.
1734 If EXPLICIT is zero, that indicates that Emacs redisplay code is
1735 suggesting a new name, which lisp code should override; if
1736 F->explicit_name is set, ignore the new name; otherwise, set it. */
1739 x_set_name (f
, name
, explicit)
1744 /* Make sure that requests from lisp code override requests from
1745 Emacs redisplay code. */
1748 /* If we're switching from explicit to implicit, we had better
1749 update the mode lines and thereby update the title. */
1750 if (f
->explicit_name
&& NILP (name
))
1751 update_mode_lines
= 1;
1753 f
->explicit_name
= ! NILP (name
);
1755 else if (f
->explicit_name
)
1758 /* If NAME is nil, set the name to the x_id_name. */
1761 /* Check for no change needed in this very common case
1762 before we do any consing. */
1763 if (!strcmp (FRAME_X_DISPLAY_INFO (f
)->x_id_name
,
1764 XSTRING (f
->name
)->data
))
1766 name
= build_string (FRAME_X_DISPLAY_INFO (f
)->x_id_name
);
1769 CHECK_STRING (name
, 0);
1771 /* Don't change the name if it's already NAME. */
1772 if (! NILP (Fstring_equal (name
, f
->name
)))
1775 if (FRAME_X_WINDOW (f
))
1780 XTextProperty text
, icon
;
1781 Lisp_Object icon_name
;
1783 text
.value
= XSTRING (name
)->data
;
1784 text
.encoding
= XA_STRING
;
1786 text
.nitems
= XSTRING (name
)->size
;
1788 icon_name
= (!NILP (f
->icon_name
) ? f
->icon_name
: name
);
1790 icon
.value
= XSTRING (icon_name
)->data
;
1791 icon
.encoding
= XA_STRING
;
1793 icon
.nitems
= XSTRING (icon_name
)->size
;
1794 #ifdef USE_X_TOOLKIT
1795 XSetWMName (FRAME_X_DISPLAY (f
),
1796 XtWindow (f
->output_data
.x
->widget
), &text
);
1797 XSetWMIconName (FRAME_X_DISPLAY (f
), XtWindow (f
->output_data
.x
->widget
),
1799 #else /* not USE_X_TOOLKIT */
1800 XSetWMName (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
), &text
);
1801 XSetWMIconName (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
), &icon
);
1802 #endif /* not USE_X_TOOLKIT */
1804 #else /* not HAVE_X11R4 */
1805 XSetIconName (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
1806 XSTRING (name
)->data
);
1807 XStoreName (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
1808 XSTRING (name
)->data
);
1809 #endif /* not HAVE_X11R4 */
1816 /* This function should be called when the user's lisp code has
1817 specified a name for the frame; the name will override any set by the
1820 x_explicitly_set_name (f
, arg
, oldval
)
1822 Lisp_Object arg
, oldval
;
1824 x_set_name (f
, arg
, 1);
1827 /* This function should be called by Emacs redisplay code to set the
1828 name; names set this way will never override names set by the user's
1831 x_implicitly_set_name (f
, arg
, oldval
)
1833 Lisp_Object arg
, oldval
;
1835 x_set_name (f
, arg
, 0);
1839 x_set_autoraise (f
, arg
, oldval
)
1841 Lisp_Object arg
, oldval
;
1843 f
->auto_raise
= !EQ (Qnil
, arg
);
1847 x_set_autolower (f
, arg
, oldval
)
1849 Lisp_Object arg
, oldval
;
1851 f
->auto_lower
= !EQ (Qnil
, arg
);
1855 x_set_unsplittable (f
, arg
, oldval
)
1857 Lisp_Object arg
, oldval
;
1859 f
->no_split
= !NILP (arg
);
1863 x_set_vertical_scroll_bars (f
, arg
, oldval
)
1865 Lisp_Object arg
, oldval
;
1867 if (NILP (arg
) != ! FRAME_HAS_VERTICAL_SCROLL_BARS (f
))
1869 FRAME_HAS_VERTICAL_SCROLL_BARS (f
) = ! NILP (arg
);
1871 /* We set this parameter before creating the X window for the
1872 frame, so we can get the geometry right from the start.
1873 However, if the window hasn't been created yet, we shouldn't
1874 call x_set_window_size. */
1875 if (FRAME_X_WINDOW (f
))
1876 x_set_window_size (f
, 0, FRAME_WIDTH (f
), FRAME_HEIGHT (f
));
1881 x_set_scroll_bar_width (f
, arg
, oldval
)
1883 Lisp_Object arg
, oldval
;
1887 FRAME_SCROLL_BAR_PIXEL_WIDTH (f
) = 0;
1888 FRAME_SCROLL_BAR_COLS (f
) = 2;
1890 else if (INTEGERP (arg
) && XINT (arg
) > 0
1891 && XFASTINT (arg
) != FRAME_SCROLL_BAR_PIXEL_WIDTH (f
))
1893 int wid
= FONT_WIDTH (f
->output_data
.x
->font
);
1894 FRAME_SCROLL_BAR_PIXEL_WIDTH (f
) = XFASTINT (arg
);
1895 FRAME_SCROLL_BAR_COLS (f
) = (XFASTINT (arg
) + wid
-1) / wid
;
1896 if (FRAME_X_WINDOW (f
))
1897 x_set_window_size (f
, 0, FRAME_WIDTH (f
), FRAME_HEIGHT (f
));
1901 /* Subroutines of creating an X frame. */
1903 /* Make sure that Vx_resource_name is set to a reasonable value.
1904 Fix it up, or set it to `emacs' if it is too hopeless. */
1907 validate_x_resource_name ()
1910 /* Number of valid characters in the resource name. */
1912 /* Number of invalid characters in the resource name. */
1917 if (STRINGP (Vx_resource_name
))
1919 unsigned char *p
= XSTRING (Vx_resource_name
)->data
;
1922 len
= XSTRING (Vx_resource_name
)->size
;
1924 /* Only letters, digits, - and _ are valid in resource names.
1925 Count the valid characters and count the invalid ones. */
1926 for (i
= 0; i
< len
; i
++)
1929 if (! ((c
>= 'a' && c
<= 'z')
1930 || (c
>= 'A' && c
<= 'Z')
1931 || (c
>= '0' && c
<= '9')
1932 || c
== '-' || c
== '_'))
1939 /* Not a string => completely invalid. */
1940 bad_count
= 5, good_count
= 0;
1942 /* If name is valid already, return. */
1946 /* If name is entirely invalid, or nearly so, use `emacs'. */
1948 || (good_count
== 1 && bad_count
> 0))
1950 Vx_resource_name
= build_string ("emacs");
1954 /* Name is partly valid. Copy it and replace the invalid characters
1955 with underscores. */
1957 Vx_resource_name
= new = Fcopy_sequence (Vx_resource_name
);
1959 for (i
= 0; i
< len
; i
++)
1961 int c
= XSTRING (new)->data
[i
];
1962 if (! ((c
>= 'a' && c
<= 'z')
1963 || (c
>= 'A' && c
<= 'Z')
1964 || (c
>= '0' && c
<= '9')
1965 || c
== '-' || c
== '_'))
1966 XSTRING (new)->data
[i
] = '_';
1971 extern char *x_get_string_resource ();
1973 DEFUN ("x-get-resource", Fx_get_resource
, Sx_get_resource
, 2, 4, 0,
1974 "Return the value of ATTRIBUTE, of class CLASS, from the X defaults database.\n\
1975 This uses `INSTANCE.ATTRIBUTE' as the key and `Emacs.CLASS' as the\n\
1976 class, where INSTANCE is the name under which Emacs was invoked, or\n\
1977 the name specified by the `-name' or `-rn' command-line arguments.\n\
1979 The optional arguments COMPONENT and SUBCLASS add to the key and the\n\
1980 class, respectively. You must specify both of them or neither.\n\
1981 If you specify them, the key is `INSTANCE.COMPONENT.ATTRIBUTE'\n\
1982 and the class is `Emacs.CLASS.SUBCLASS'.")
1983 (attribute
, class, component
, subclass
)
1984 Lisp_Object attribute
, class, component
, subclass
;
1986 register char *value
;
1992 CHECK_STRING (attribute
, 0);
1993 CHECK_STRING (class, 0);
1995 if (!NILP (component
))
1996 CHECK_STRING (component
, 1);
1997 if (!NILP (subclass
))
1998 CHECK_STRING (subclass
, 2);
1999 if (NILP (component
) != NILP (subclass
))
2000 error ("x-get-resource: must specify both COMPONENT and SUBCLASS or neither");
2002 validate_x_resource_name ();
2004 /* Allocate space for the components, the dots which separate them,
2005 and the final '\0'. Make them big enough for the worst case. */
2006 name_key
= (char *) alloca (XSTRING (Vx_resource_name
)->size
2007 + (STRINGP (component
)
2008 ? XSTRING (component
)->size
: 0)
2009 + XSTRING (attribute
)->size
2012 class_key
= (char *) alloca ((sizeof (EMACS_CLASS
) - 1)
2013 + XSTRING (class)->size
2014 + (STRINGP (subclass
)
2015 ? XSTRING (subclass
)->size
: 0)
2018 /* Start with emacs.FRAMENAME for the name (the specific one)
2019 and with `Emacs' for the class key (the general one). */
2020 strcpy (name_key
, XSTRING (Vx_resource_name
)->data
);
2021 strcpy (class_key
, EMACS_CLASS
);
2023 strcat (class_key
, ".");
2024 strcat (class_key
, XSTRING (class)->data
);
2026 if (!NILP (component
))
2028 strcat (class_key
, ".");
2029 strcat (class_key
, XSTRING (subclass
)->data
);
2031 strcat (name_key
, ".");
2032 strcat (name_key
, XSTRING (component
)->data
);
2035 strcat (name_key
, ".");
2036 strcat (name_key
, XSTRING (attribute
)->data
);
2038 value
= x_get_string_resource (check_x_display_info (Qnil
)->xrdb
,
2039 name_key
, class_key
);
2041 if (value
!= (char *) 0)
2042 return build_string (value
);
2047 /* Used when C code wants a resource value. */
2050 x_get_resource_string (attribute
, class)
2051 char *attribute
, *class;
2053 register char *value
;
2057 /* Allocate space for the components, the dots which separate them,
2058 and the final '\0'. */
2059 name_key
= (char *) alloca (XSTRING (Vinvocation_name
)->size
2060 + strlen (attribute
) + 2);
2061 class_key
= (char *) alloca ((sizeof (EMACS_CLASS
) - 1)
2062 + strlen (class) + 2);
2064 sprintf (name_key
, "%s.%s",
2065 XSTRING (Vinvocation_name
)->data
,
2067 sprintf (class_key
, "%s.%s", EMACS_CLASS
, class);
2069 return x_get_string_resource (FRAME_X_DISPLAY_INFO (selected_frame
)->xrdb
,
2070 name_key
, class_key
);
2073 /* Types we might convert a resource string into. */
2076 number
, boolean
, string
, symbol
2079 /* Return the value of parameter PARAM.
2081 First search ALIST, then Vdefault_frame_alist, then the X defaults
2082 database, using ATTRIBUTE as the attribute name and CLASS as its class.
2084 Convert the resource to the type specified by desired_type.
2086 If no default is specified, return Qunbound. If you call
2087 x_get_arg, make sure you deal with Qunbound in a reasonable way,
2088 and don't let it get stored in any Lisp-visible variables! */
2091 x_get_arg (alist
, param
, attribute
, class, type
)
2092 Lisp_Object alist
, param
;
2095 enum resource_types type
;
2097 register Lisp_Object tem
;
2099 tem
= Fassq (param
, alist
);
2101 tem
= Fassq (param
, Vdefault_frame_alist
);
2107 tem
= Fx_get_resource (build_string (attribute
),
2108 build_string (class),
2117 return make_number (atoi (XSTRING (tem
)->data
));
2120 tem
= Fdowncase (tem
);
2121 if (!strcmp (XSTRING (tem
)->data
, "on")
2122 || !strcmp (XSTRING (tem
)->data
, "true"))
2131 /* As a special case, we map the values `true' and `on'
2132 to Qt, and `false' and `off' to Qnil. */
2135 lower
= Fdowncase (tem
);
2136 if (!strcmp (XSTRING (lower
)->data
, "on")
2137 || !strcmp (XSTRING (lower
)->data
, "true"))
2139 else if (!strcmp (XSTRING (lower
)->data
, "off")
2140 || !strcmp (XSTRING (lower
)->data
, "false"))
2143 return Fintern (tem
, Qnil
);
2156 /* Record in frame F the specified or default value according to ALIST
2157 of the parameter named PARAM (a Lisp symbol).
2158 If no value is specified for PARAM, look for an X default for XPROP
2159 on the frame named NAME.
2160 If that is not found either, use the value DEFLT. */
2163 x_default_parameter (f
, alist
, prop
, deflt
, xprop
, xclass
, type
)
2170 enum resource_types type
;
2174 tem
= x_get_arg (alist
, prop
, xprop
, xclass
, type
);
2175 if (EQ (tem
, Qunbound
))
2177 x_set_frame_parameters (f
, Fcons (Fcons (prop
, tem
), Qnil
));
2181 DEFUN ("x-parse-geometry", Fx_parse_geometry
, Sx_parse_geometry
, 1, 1, 0,
2182 "Parse an X-style geometry string STRING.\n\
2183 Returns an alist of the form ((top . TOP), (left . LEFT) ... ).\n\
2184 The properties returned may include `top', `left', `height', and `width'.\n\
2185 The value of `left' or `top' may be an integer,\n\
2186 or a list (+ N) meaning N pixels relative to top/left corner,\n\
2187 or a list (- N) meaning -N pixels relative to bottom/right corner.")
2192 unsigned int width
, height
;
2195 CHECK_STRING (string
, 0);
2197 geometry
= XParseGeometry ((char *) XSTRING (string
)->data
,
2198 &x
, &y
, &width
, &height
);
2201 if (!!(geometry
& XValue
) != !!(geometry
& YValue
))
2202 error ("Must specify both x and y position, or neither");
2206 if (geometry
& XValue
)
2208 Lisp_Object element
;
2210 if (x
>= 0 && (geometry
& XNegative
))
2211 element
= Fcons (Qleft
, Fcons (Qminus
, Fcons (make_number (-x
), Qnil
)));
2212 else if (x
< 0 && ! (geometry
& XNegative
))
2213 element
= Fcons (Qleft
, Fcons (Qplus
, Fcons (make_number (x
), Qnil
)));
2215 element
= Fcons (Qleft
, make_number (x
));
2216 result
= Fcons (element
, result
);
2219 if (geometry
& YValue
)
2221 Lisp_Object element
;
2223 if (y
>= 0 && (geometry
& YNegative
))
2224 element
= Fcons (Qtop
, Fcons (Qminus
, Fcons (make_number (-y
), Qnil
)));
2225 else if (y
< 0 && ! (geometry
& YNegative
))
2226 element
= Fcons (Qtop
, Fcons (Qplus
, Fcons (make_number (y
), Qnil
)));
2228 element
= Fcons (Qtop
, make_number (y
));
2229 result
= Fcons (element
, result
);
2232 if (geometry
& WidthValue
)
2233 result
= Fcons (Fcons (Qwidth
, make_number (width
)), result
);
2234 if (geometry
& HeightValue
)
2235 result
= Fcons (Fcons (Qheight
, make_number (height
)), result
);
2240 /* Calculate the desired size and position of this window,
2241 and return the flags saying which aspects were specified.
2243 This function does not make the coordinates positive. */
2245 #define DEFAULT_ROWS 40
2246 #define DEFAULT_COLS 80
2249 x_figure_window_size (f
, parms
)
2253 register Lisp_Object tem0
, tem1
, tem2
;
2254 int height
, width
, left
, top
;
2255 register int geometry
;
2256 long window_prompting
= 0;
2258 /* Default values if we fall through.
2259 Actually, if that happens we should get
2260 window manager prompting. */
2261 f
->width
= DEFAULT_COLS
;
2262 f
->height
= DEFAULT_ROWS
;
2263 /* Window managers expect that if program-specified
2264 positions are not (0,0), they're intentional, not defaults. */
2265 f
->output_data
.x
->top_pos
= 0;
2266 f
->output_data
.x
->left_pos
= 0;
2268 tem0
= x_get_arg (parms
, Qheight
, 0, 0, number
);
2269 tem1
= x_get_arg (parms
, Qwidth
, 0, 0, number
);
2270 tem2
= x_get_arg (parms
, Quser_size
, 0, 0, number
);
2271 if (! EQ (tem0
, Qunbound
) || ! EQ (tem1
, Qunbound
))
2273 if (!EQ (tem0
, Qunbound
))
2275 CHECK_NUMBER (tem0
, 0);
2276 f
->height
= XINT (tem0
);
2278 if (!EQ (tem1
, Qunbound
))
2280 CHECK_NUMBER (tem1
, 0);
2281 f
->width
= XINT (tem1
);
2283 if (!NILP (tem2
) && !EQ (tem2
, Qunbound
))
2284 window_prompting
|= USSize
;
2286 window_prompting
|= PSize
;
2289 f
->output_data
.x
->vertical_scroll_bar_extra
2290 = (!FRAME_HAS_VERTICAL_SCROLL_BARS (f
)
2292 : FRAME_SCROLL_BAR_PIXEL_WIDTH (f
) > 0
2293 ? FRAME_SCROLL_BAR_PIXEL_WIDTH (f
)
2294 : (FRAME_SCROLL_BAR_COLS (f
) * FONT_WIDTH (f
->output_data
.x
->font
)));
2295 f
->output_data
.x
->pixel_width
= CHAR_TO_PIXEL_WIDTH (f
, f
->width
);
2296 f
->output_data
.x
->pixel_height
= CHAR_TO_PIXEL_HEIGHT (f
, f
->height
);
2298 tem0
= x_get_arg (parms
, Qtop
, 0, 0, number
);
2299 tem1
= x_get_arg (parms
, Qleft
, 0, 0, number
);
2300 tem2
= x_get_arg (parms
, Quser_position
, 0, 0, number
);
2301 if (! EQ (tem0
, Qunbound
) || ! EQ (tem1
, Qunbound
))
2303 if (EQ (tem0
, Qminus
))
2305 f
->output_data
.x
->top_pos
= 0;
2306 window_prompting
|= YNegative
;
2308 else if (CONSP (tem0
) && EQ (XCONS (tem0
)->car
, Qminus
)
2309 && CONSP (XCONS (tem0
)->cdr
)
2310 && INTEGERP (XCONS (XCONS (tem0
)->cdr
)->car
))
2312 f
->output_data
.x
->top_pos
= - XINT (XCONS (XCONS (tem0
)->cdr
)->car
);
2313 window_prompting
|= YNegative
;
2315 else if (CONSP (tem0
) && EQ (XCONS (tem0
)->car
, Qplus
)
2316 && CONSP (XCONS (tem0
)->cdr
)
2317 && INTEGERP (XCONS (XCONS (tem0
)->cdr
)->car
))
2319 f
->output_data
.x
->top_pos
= XINT (XCONS (XCONS (tem0
)->cdr
)->car
);
2321 else if (EQ (tem0
, Qunbound
))
2322 f
->output_data
.x
->top_pos
= 0;
2325 CHECK_NUMBER (tem0
, 0);
2326 f
->output_data
.x
->top_pos
= XINT (tem0
);
2327 if (f
->output_data
.x
->top_pos
< 0)
2328 window_prompting
|= YNegative
;
2331 if (EQ (tem1
, Qminus
))
2333 f
->output_data
.x
->left_pos
= 0;
2334 window_prompting
|= XNegative
;
2336 else if (CONSP (tem1
) && EQ (XCONS (tem1
)->car
, Qminus
)
2337 && CONSP (XCONS (tem1
)->cdr
)
2338 && INTEGERP (XCONS (XCONS (tem1
)->cdr
)->car
))
2340 f
->output_data
.x
->left_pos
= - XINT (XCONS (XCONS (tem1
)->cdr
)->car
);
2341 window_prompting
|= XNegative
;
2343 else if (CONSP (tem1
) && EQ (XCONS (tem1
)->car
, Qplus
)
2344 && CONSP (XCONS (tem1
)->cdr
)
2345 && INTEGERP (XCONS (XCONS (tem1
)->cdr
)->car
))
2347 f
->output_data
.x
->left_pos
= XINT (XCONS (XCONS (tem1
)->cdr
)->car
);
2349 else if (EQ (tem1
, Qunbound
))
2350 f
->output_data
.x
->left_pos
= 0;
2353 CHECK_NUMBER (tem1
, 0);
2354 f
->output_data
.x
->left_pos
= XINT (tem1
);
2355 if (f
->output_data
.x
->left_pos
< 0)
2356 window_prompting
|= XNegative
;
2359 if (!NILP (tem2
) && ! EQ (tem2
, Qunbound
))
2360 window_prompting
|= USPosition
;
2362 window_prompting
|= PPosition
;
2365 return window_prompting
;
2368 #if !defined (HAVE_X11R4) && !defined (HAVE_XSETWMPROTOCOLS)
2371 XSetWMProtocols (dpy
, w
, protocols
, count
)
2378 prop
= XInternAtom (dpy
, "WM_PROTOCOLS", False
);
2379 if (prop
== None
) return False
;
2380 XChangeProperty (dpy
, w
, prop
, XA_ATOM
, 32, PropModeReplace
,
2381 (unsigned char *) protocols
, count
);
2384 #endif /* not HAVE_X11R4 && not HAVE_XSETWMPROTOCOLS */
2386 #ifdef USE_X_TOOLKIT
2388 /* If the WM_PROTOCOLS property does not already contain WM_TAKE_FOCUS,
2389 WM_DELETE_WINDOW, and WM_SAVE_YOURSELF, then add them. (They may
2390 already be present because of the toolkit (Motif adds some of them,
2391 for example, but Xt doesn't). */
2394 hack_wm_protocols (f
, widget
)
2398 Display
*dpy
= XtDisplay (widget
);
2399 Window w
= XtWindow (widget
);
2400 int need_delete
= 1;
2406 Atom type
, *atoms
= 0;
2408 unsigned long nitems
= 0;
2409 unsigned long bytes_after
;
2411 if ((XGetWindowProperty (dpy
, w
,
2412 FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_protocols
,
2413 (long)0, (long)100, False
, XA_ATOM
,
2414 &type
, &format
, &nitems
, &bytes_after
,
2415 (unsigned char **) &atoms
)
2417 && format
== 32 && type
== XA_ATOM
)
2421 if (atoms
[nitems
] == FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_delete_window
)
2423 else if (atoms
[nitems
] == FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_take_focus
)
2425 else if (atoms
[nitems
] == FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_save_yourself
)
2428 if (atoms
) XFree ((char *) atoms
);
2434 props
[count
++] = FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_delete_window
;
2436 props
[count
++] = FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_take_focus
;
2438 props
[count
++] = FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_save_yourself
;
2440 XChangeProperty (dpy
, w
, FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_protocols
,
2441 XA_ATOM
, 32, PropModeAppend
,
2442 (unsigned char *) props
, count
);
2448 #ifdef USE_X_TOOLKIT
2450 /* Create and set up the X widget for frame F. */
2453 x_window (f
, window_prompting
, minibuffer_only
)
2455 long window_prompting
;
2456 int minibuffer_only
;
2458 XClassHint class_hints
;
2459 XSetWindowAttributes attributes
;
2460 unsigned long attribute_mask
;
2462 Widget shell_widget
;
2464 Widget frame_widget
;
2470 /* Use the resource name as the top-level widget name
2471 for looking up resources. Make a non-Lisp copy
2472 for the window manager, so GC relocation won't bother it.
2474 Elsewhere we specify the window name for the window manager. */
2477 char *str
= (char *) XSTRING (Vx_resource_name
)->data
;
2478 f
->namebuf
= (char *) xmalloc (strlen (str
) + 1);
2479 strcpy (f
->namebuf
, str
);
2483 XtSetArg (al
[ac
], XtNallowShellResize
, 1); ac
++;
2484 XtSetArg (al
[ac
], XtNinput
, 1); ac
++;
2485 XtSetArg (al
[ac
], XtNmappedWhenManaged
, 0); ac
++;
2486 XtSetArg (al
[ac
], XtNborderWidth
, f
->output_data
.x
->border_width
); ac
++;
2487 shell_widget
= XtAppCreateShell (f
->namebuf
, EMACS_CLASS
,
2488 applicationShellWidgetClass
,
2489 FRAME_X_DISPLAY (f
), al
, ac
);
2491 f
->output_data
.x
->widget
= shell_widget
;
2492 /* maybe_set_screen_title_format (shell_widget); */
2494 pane_widget
= lw_create_widget ("main", "pane", widget_id_tick
++,
2495 (widget_value
*) NULL
,
2496 shell_widget
, False
,
2499 (lw_callback
) NULL
);
2501 f
->output_data
.x
->column_widget
= pane_widget
;
2503 /* mappedWhenManaged to false tells to the paned window to not map/unmap
2504 the emacs screen when changing menubar. This reduces flickering. */
2507 XtSetArg (al
[ac
], XtNmappedWhenManaged
, 0); ac
++;
2508 XtSetArg (al
[ac
], XtNshowGrip
, 0); ac
++;
2509 XtSetArg (al
[ac
], XtNallowResize
, 1); ac
++;
2510 XtSetArg (al
[ac
], XtNresizeToPreferred
, 1); ac
++;
2511 XtSetArg (al
[ac
], XtNemacsFrame
, f
); ac
++;
2512 frame_widget
= XtCreateWidget (f
->namebuf
,
2514 pane_widget
, al
, ac
);
2516 f
->output_data
.x
->edit_widget
= frame_widget
;
2518 XtManageChild (frame_widget
);
2520 /* Do some needed geometry management. */
2523 char *tem
, shell_position
[32];
2526 int extra_borders
= 0;
2528 = (f
->output_data
.x
->menubar_widget
2529 ? (f
->output_data
.x
->menubar_widget
->core
.height
2530 + f
->output_data
.x
->menubar_widget
->core
.border_width
)
2532 extern char *lwlib_toolkit_type
;
2534 if (FRAME_EXTERNAL_MENU_BAR (f
))
2537 XtVaGetValues (pane_widget
, XtNinternalBorderWidth
, &ibw
, NULL
);
2538 menubar_size
+= ibw
;
2541 f
->output_data
.x
->menubar_height
= menubar_size
;
2543 /* Motif seems to need this amount added to the sizes
2544 specified for the shell widget. The Athena/Lucid widgets don't.
2545 Both conclusions reached experimentally. -- rms. */
2546 if (!strcmp (lwlib_toolkit_type
, "motif"))
2547 XtVaGetValues (f
->output_data
.x
->edit_widget
, XtNinternalBorderWidth
,
2548 &extra_borders
, NULL
);
2550 /* Convert our geometry parameters into a geometry string
2552 Note that we do not specify here whether the position
2553 is a user-specified or program-specified one.
2554 We pass that information later, in x_wm_set_size_hints. */
2556 int left
= f
->output_data
.x
->left_pos
;
2557 int xneg
= window_prompting
& XNegative
;
2558 int top
= f
->output_data
.x
->top_pos
;
2559 int yneg
= window_prompting
& YNegative
;
2565 if (window_prompting
& USPosition
)
2566 sprintf (shell_position
, "=%dx%d%c%d%c%d",
2567 PIXEL_WIDTH (f
) + extra_borders
,
2568 PIXEL_HEIGHT (f
) + menubar_size
+ extra_borders
,
2569 (xneg
? '-' : '+'), left
,
2570 (yneg
? '-' : '+'), top
);
2572 sprintf (shell_position
, "=%dx%d",
2573 PIXEL_WIDTH (f
) + extra_borders
,
2574 PIXEL_HEIGHT (f
) + menubar_size
+ extra_borders
);
2577 len
= strlen (shell_position
) + 1;
2578 tem
= (char *) xmalloc (len
);
2579 strncpy (tem
, shell_position
, len
);
2580 XtSetArg (al
[ac
], XtNgeometry
, tem
); ac
++;
2581 XtSetValues (shell_widget
, al
, ac
);
2584 XtManageChild (pane_widget
);
2585 XtRealizeWidget (shell_widget
);
2587 FRAME_X_WINDOW (f
) = XtWindow (frame_widget
);
2589 validate_x_resource_name ();
2591 class_hints
.res_name
= (char *) XSTRING (Vx_resource_name
)->data
;
2592 class_hints
.res_class
= EMACS_CLASS
;
2593 XSetClassHint (FRAME_X_DISPLAY (f
), XtWindow (shell_widget
), &class_hints
);
2600 xim
= XOpenIM (FRAME_X_DISPLAY (f
), NULL
, NULL
, NULL
);
2604 xic
= XCreateIC (xim
,
2605 XNInputStyle
, XIMPreeditNothing
| XIMStatusNothing
,
2606 XNClientWindow
, FRAME_X_WINDOW(f
),
2607 XNFocusWindow
, FRAME_X_WINDOW(f
),
2613 FRAME_XIC (f
) = xic
;
2617 f
->output_data
.x
->wm_hints
.input
= True
;
2618 f
->output_data
.x
->wm_hints
.flags
|= InputHint
;
2619 XSetWMHints (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
2620 &f
->output_data
.x
->wm_hints
);
2622 hack_wm_protocols (f
, shell_widget
);
2625 XtAddEventHandler (shell_widget
, 0, True
, _XEditResCheckMessages
, 0);
2628 /* Do a stupid property change to force the server to generate a
2629 propertyNotify event so that the event_stream server timestamp will
2630 be initialized to something relevant to the time we created the window.
2632 XChangeProperty (XtDisplay (frame_widget
), XtWindow (frame_widget
),
2633 FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_protocols
,
2634 XA_ATOM
, 32, PropModeAppend
,
2635 (unsigned char*) NULL
, 0);
2637 /* Make all the standard events reach the Emacs frame. */
2638 attributes
.event_mask
= STANDARD_EVENT_SET
;
2639 attribute_mask
= CWEventMask
;
2640 XChangeWindowAttributes (XtDisplay (shell_widget
), XtWindow (shell_widget
),
2641 attribute_mask
, &attributes
);
2643 XtMapWidget (frame_widget
);
2645 /* x_set_name normally ignores requests to set the name if the
2646 requested name is the same as the current name. This is the one
2647 place where that assumption isn't correct; f->name is set, but
2648 the X server hasn't been told. */
2651 int explicit = f
->explicit_name
;
2653 f
->explicit_name
= 0;
2656 x_set_name (f
, name
, explicit);
2659 XDefineCursor (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
2660 f
->output_data
.x
->text_cursor
);
2664 if (!minibuffer_only
&& FRAME_EXTERNAL_MENU_BAR (f
))
2665 initialize_frame_menubar (f
);
2666 lw_set_main_areas (pane_widget
, f
->output_data
.x
->menubar_widget
, frame_widget
);
2668 if (FRAME_X_WINDOW (f
) == 0)
2669 error ("Unable to create window");
2672 #else /* not USE_X_TOOLKIT */
2674 /* Create and set up the X window for frame F. */
2680 XClassHint class_hints
;
2681 XSetWindowAttributes attributes
;
2682 unsigned long attribute_mask
;
2684 attributes
.background_pixel
= f
->output_data
.x
->background_pixel
;
2685 attributes
.border_pixel
= f
->output_data
.x
->border_pixel
;
2686 attributes
.bit_gravity
= StaticGravity
;
2687 attributes
.backing_store
= NotUseful
;
2688 attributes
.save_under
= True
;
2689 attributes
.event_mask
= STANDARD_EVENT_SET
;
2690 attribute_mask
= (CWBackPixel
| CWBorderPixel
| CWBitGravity
2692 | CWBackingStore
| CWSaveUnder
2698 = XCreateWindow (FRAME_X_DISPLAY (f
),
2699 f
->output_data
.x
->parent_desc
,
2700 f
->output_data
.x
->left_pos
,
2701 f
->output_data
.x
->top_pos
,
2702 PIXEL_WIDTH (f
), PIXEL_HEIGHT (f
),
2703 f
->output_data
.x
->border_width
,
2704 CopyFromParent
, /* depth */
2705 InputOutput
, /* class */
2706 FRAME_X_DISPLAY_INFO (f
)->visual
,
2707 attribute_mask
, &attributes
);
2713 xim
= XOpenIM (FRAME_X_DISPLAY(f
), NULL
, NULL
, NULL
);
2717 xic
= XCreateIC (xim
,
2718 XNInputStyle
, XIMPreeditNothing
| XIMStatusNothing
,
2719 XNClientWindow
, FRAME_X_WINDOW(f
),
2720 XNFocusWindow
, FRAME_X_WINDOW(f
),
2727 FRAME_XIC (f
) = xic
;
2731 validate_x_resource_name ();
2733 class_hints
.res_name
= (char *) XSTRING (Vx_resource_name
)->data
;
2734 class_hints
.res_class
= EMACS_CLASS
;
2735 XSetClassHint (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
), &class_hints
);
2737 /* The menubar is part of the ordinary display;
2738 it does not count in addition to the height of the window. */
2739 f
->output_data
.x
->menubar_height
= 0;
2741 /* This indicates that we use the "Passive Input" input model.
2742 Unless we do this, we don't get the Focus{In,Out} events that we
2743 need to draw the cursor correctly. Accursed bureaucrats.
2744 XWhipsAndChains (FRAME_X_DISPLAY (f), IronMaiden, &TheRack); */
2746 f
->output_data
.x
->wm_hints
.input
= True
;
2747 f
->output_data
.x
->wm_hints
.flags
|= InputHint
;
2748 XSetWMHints (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
2749 &f
->output_data
.x
->wm_hints
);
2751 /* Request "save yourself" and "delete window" commands from wm. */
2754 protocols
[0] = FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_delete_window
;
2755 protocols
[1] = FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_save_yourself
;
2756 XSetWMProtocols (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
), protocols
, 2);
2759 /* x_set_name normally ignores requests to set the name if the
2760 requested name is the same as the current name. This is the one
2761 place where that assumption isn't correct; f->name is set, but
2762 the X server hasn't been told. */
2765 int explicit = f
->explicit_name
;
2767 f
->explicit_name
= 0;
2770 x_set_name (f
, name
, explicit);
2773 XDefineCursor (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
2774 f
->output_data
.x
->text_cursor
);
2778 if (FRAME_X_WINDOW (f
) == 0)
2779 error ("Unable to create window");
2782 #endif /* not USE_X_TOOLKIT */
2784 /* Handle the icon stuff for this window. Perhaps later we might
2785 want an x_set_icon_position which can be called interactively as
2793 Lisp_Object icon_x
, icon_y
;
2795 /* Set the position of the icon. Note that twm groups all
2796 icons in an icon window. */
2797 icon_x
= x_get_arg (parms
, Qicon_left
, 0, 0, number
);
2798 icon_y
= x_get_arg (parms
, Qicon_top
, 0, 0, number
);
2799 if (!EQ (icon_x
, Qunbound
) && !EQ (icon_y
, Qunbound
))
2801 CHECK_NUMBER (icon_x
, 0);
2802 CHECK_NUMBER (icon_y
, 0);
2804 else if (!EQ (icon_x
, Qunbound
) || !EQ (icon_y
, Qunbound
))
2805 error ("Both left and top icon corners of icon must be specified");
2809 if (! EQ (icon_x
, Qunbound
))
2810 x_wm_set_icon_position (f
, XINT (icon_x
), XINT (icon_y
));
2812 /* Start up iconic or window? */
2813 x_wm_set_window_state
2814 (f
, (EQ (x_get_arg (parms
, Qvisibility
, 0, 0, symbol
), Qicon
)
2818 x_text_icon (f
, (char *) XSTRING ((!NILP (f
->icon_name
)
2825 /* Make the GC's needed for this window, setting the
2826 background, border and mouse colors; also create the
2827 mouse cursor and the gray border tile. */
2829 static char cursor_bits
[] =
2831 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
2832 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
2833 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
2834 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00
2841 XGCValues gc_values
;
2847 /* Create the GC's of this frame.
2848 Note that many default values are used. */
2851 gc_values
.font
= f
->output_data
.x
->font
->fid
;
2852 gc_values
.foreground
= f
->output_data
.x
->foreground_pixel
;
2853 gc_values
.background
= f
->output_data
.x
->background_pixel
;
2854 gc_values
.line_width
= 0; /* Means 1 using fast algorithm. */
2855 f
->output_data
.x
->normal_gc
= XCreateGC (FRAME_X_DISPLAY (f
),
2857 GCLineWidth
| GCFont
2858 | GCForeground
| GCBackground
,
2861 /* Reverse video style. */
2862 gc_values
.foreground
= f
->output_data
.x
->background_pixel
;
2863 gc_values
.background
= f
->output_data
.x
->foreground_pixel
;
2864 f
->output_data
.x
->reverse_gc
= XCreateGC (FRAME_X_DISPLAY (f
),
2866 GCFont
| GCForeground
| GCBackground
2870 /* Cursor has cursor-color background, background-color foreground. */
2871 gc_values
.foreground
= f
->output_data
.x
->background_pixel
;
2872 gc_values
.background
= f
->output_data
.x
->cursor_pixel
;
2873 gc_values
.fill_style
= FillOpaqueStippled
;
2875 = XCreateBitmapFromData (FRAME_X_DISPLAY (f
),
2876 FRAME_X_DISPLAY_INFO (f
)->root_window
,
2877 cursor_bits
, 16, 16);
2878 f
->output_data
.x
->cursor_gc
2879 = XCreateGC (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
2880 (GCFont
| GCForeground
| GCBackground
2881 | GCFillStyle
| GCStipple
| GCLineWidth
),
2884 /* Create the gray border tile used when the pointer is not in
2885 the frame. Since this depends on the frame's pixel values,
2886 this must be done on a per-frame basis. */
2887 f
->output_data
.x
->border_tile
2888 = (XCreatePixmapFromBitmapData
2889 (FRAME_X_DISPLAY (f
), FRAME_X_DISPLAY_INFO (f
)->root_window
,
2890 gray_bits
, gray_width
, gray_height
,
2891 f
->output_data
.x
->foreground_pixel
,
2892 f
->output_data
.x
->background_pixel
,
2893 DefaultDepth (FRAME_X_DISPLAY (f
),
2894 XScreenNumberOfScreen (FRAME_X_SCREEN (f
)))));
2899 DEFUN ("x-create-frame", Fx_create_frame
, Sx_create_frame
,
2901 "Make a new X window, which is called a \"frame\" in Emacs terms.\n\
2902 Returns an Emacs frame object.\n\
2903 ALIST is an alist of frame parameters.\n\
2904 If the parameters specify that the frame should not have a minibuffer,\n\
2905 and do not specify a specific minibuffer window to use,\n\
2906 then `default-minibuffer-frame' must be a frame whose minibuffer can\n\
2907 be shared by the new frame.\n\
2909 This function is an internal primitive--use `make-frame' instead.")
2914 Lisp_Object frame
, tem
;
2916 int minibuffer_only
= 0;
2917 long window_prompting
= 0;
2919 int count
= specpdl_ptr
- specpdl
;
2920 struct gcpro gcpro1
;
2921 Lisp_Object display
;
2922 struct x_display_info
*dpyinfo
;
2928 /* Use this general default value to start with
2929 until we know if this frame has a specified name. */
2930 Vx_resource_name
= Vinvocation_name
;
2932 display
= x_get_arg (parms
, Qdisplay
, 0, 0, string
);
2933 if (EQ (display
, Qunbound
))
2935 dpyinfo
= check_x_display_info (display
);
2937 kb
= dpyinfo
->kboard
;
2939 kb
= &the_only_kboard
;
2942 name
= x_get_arg (parms
, Qname
, "title", "Title", string
);
2944 && ! EQ (name
, Qunbound
)
2946 error ("Invalid frame name--not a string or nil");
2949 Vx_resource_name
= name
;
2951 /* See if parent window is specified. */
2952 parent
= x_get_arg (parms
, Qparent_id
, NULL
, NULL
, number
);
2953 if (EQ (parent
, Qunbound
))
2955 if (! NILP (parent
))
2956 CHECK_NUMBER (parent
, 0);
2958 tem
= x_get_arg (parms
, Qminibuffer
, 0, 0, symbol
);
2959 if (EQ (tem
, Qnone
) || NILP (tem
))
2960 f
= make_frame_without_minibuffer (Qnil
, kb
, display
);
2961 else if (EQ (tem
, Qonly
))
2963 f
= make_minibuffer_frame ();
2964 minibuffer_only
= 1;
2966 else if (WINDOWP (tem
))
2967 f
= make_frame_without_minibuffer (tem
, kb
, display
);
2971 /* Note that X Windows does support scroll bars. */
2972 FRAME_CAN_HAVE_SCROLL_BARS (f
) = 1;
2974 XSETFRAME (frame
, f
);
2977 f
->output_method
= output_x_window
;
2978 f
->output_data
.x
= (struct x_output
*) xmalloc (sizeof (struct x_output
));
2979 bzero (f
->output_data
.x
, sizeof (struct x_output
));
2980 f
->output_data
.x
->icon_bitmap
= -1;
2983 = x_get_arg (parms
, Qicon_name
, "iconName", "Title", string
);
2984 if (! STRINGP (f
->icon_name
))
2985 f
->icon_name
= Qnil
;
2987 FRAME_X_DISPLAY_INFO (f
) = dpyinfo
;
2989 FRAME_KBOARD (f
) = kb
;
2992 /* Specify the parent under which to make this X window. */
2996 f
->output_data
.x
->parent_desc
= parent
;
2997 f
->output_data
.x
->explicit_parent
= 1;
3001 f
->output_data
.x
->parent_desc
= FRAME_X_DISPLAY_INFO (f
)->root_window
;
3002 f
->output_data
.x
->explicit_parent
= 0;
3005 /* Note that the frame has no physical cursor right now. */
3006 f
->phys_cursor_x
= -1;
3008 /* Set the name; the functions to which we pass f expect the name to
3010 if (EQ (name
, Qunbound
) || NILP (name
))
3012 f
->name
= build_string (dpyinfo
->x_id_name
);
3013 f
->explicit_name
= 0;
3018 f
->explicit_name
= 1;
3019 /* use the frame's title when getting resources for this frame. */
3020 specbind (Qx_resource_name
, name
);
3023 /* Extract the window parameters from the supplied values
3024 that are needed to determine window geometry. */
3028 font
= x_get_arg (parms
, Qfont
, "font", "Font", string
);
3030 /* First, try whatever font the caller has specified. */
3032 font
= x_new_font (f
, XSTRING (font
)->data
);
3033 /* Try out a font which we hope has bold and italic variations. */
3034 if (!STRINGP (font
))
3035 font
= x_new_font (f
, "-misc-fixed-medium-r-normal-*-*-140-*-*-c-*-iso8859-1");
3036 if (! STRINGP (font
))
3037 font
= x_new_font (f
, "-*-*-medium-r-normal-*-*-140-*-*-c-*-iso8859-1");
3038 if (! STRINGP (font
))
3039 /* This was formerly the first thing tried, but it finds too many fonts
3040 and takes too long. */
3041 font
= x_new_font (f
, "-*-*-medium-r-*-*-*-*-*-*-c-*-iso8859-1");
3042 /* If those didn't work, look for something which will at least work. */
3043 if (! STRINGP (font
))
3044 font
= x_new_font (f
, "-*-fixed-*-*-*-*-*-140-*-*-c-*-iso8859-1");
3046 if (! STRINGP (font
))
3047 font
= build_string ("fixed");
3049 x_default_parameter (f
, parms
, Qfont
, font
,
3050 "font", "Font", string
);
3053 #ifdef USE_X_TOOLKIT
3054 /* Prevent lwlib/xlwmenu.c from crashing because of a bug
3055 whereby it fails to get any font. */
3056 xlwmenu_default_font
= f
->output_data
.x
->font
;
3059 x_default_parameter (f
, parms
, Qborder_width
, make_number (2),
3060 "borderwidth", "BorderWidth", number
);
3061 /* This defaults to 2 in order to match xterm. We recognize either
3062 internalBorderWidth or internalBorder (which is what xterm calls
3064 if (NILP (Fassq (Qinternal_border_width
, parms
)))
3068 value
= x_get_arg (parms
, Qinternal_border_width
,
3069 "internalBorder", "BorderWidth", number
);
3070 if (! EQ (value
, Qunbound
))
3071 parms
= Fcons (Fcons (Qinternal_border_width
, value
),
3074 x_default_parameter (f
, parms
, Qinternal_border_width
, make_number (2),
3075 "internalBorderWidth", "BorderWidth", number
);
3076 x_default_parameter (f
, parms
, Qvertical_scroll_bars
, Qt
,
3077 "verticalScrollBars", "ScrollBars", boolean
);
3079 /* Also do the stuff which must be set before the window exists. */
3080 x_default_parameter (f
, parms
, Qforeground_color
, build_string ("black"),
3081 "foreground", "Foreground", string
);
3082 x_default_parameter (f
, parms
, Qbackground_color
, build_string ("white"),
3083 "background", "Background", string
);
3084 x_default_parameter (f
, parms
, Qmouse_color
, build_string ("black"),
3085 "pointerColor", "Foreground", string
);
3086 x_default_parameter (f
, parms
, Qcursor_color
, build_string ("black"),
3087 "cursorColor", "Foreground", string
);
3088 x_default_parameter (f
, parms
, Qborder_color
, build_string ("black"),
3089 "borderColor", "BorderColor", string
);
3091 x_default_parameter (f
, parms
, Qmenu_bar_lines
, make_number (1),
3092 "menuBar", "MenuBar", number
);
3093 x_default_parameter (f
, parms
, Qscroll_bar_width
, Qnil
,
3094 "scrollBarWidth", "ScrollBarWidth", number
);
3095 x_default_parameter (f
, parms
, Qbuffer_predicate
, Qnil
,
3096 "bufferPredicate", "BufferPredicate", symbol
);
3098 f
->output_data
.x
->parent_desc
= FRAME_X_DISPLAY_INFO (f
)->root_window
;
3099 window_prompting
= x_figure_window_size (f
, parms
);
3101 if (window_prompting
& XNegative
)
3103 if (window_prompting
& YNegative
)
3104 f
->output_data
.x
->win_gravity
= SouthEastGravity
;
3106 f
->output_data
.x
->win_gravity
= NorthEastGravity
;
3110 if (window_prompting
& YNegative
)
3111 f
->output_data
.x
->win_gravity
= SouthWestGravity
;
3113 f
->output_data
.x
->win_gravity
= NorthWestGravity
;
3116 f
->output_data
.x
->size_hint_flags
= window_prompting
;
3118 #ifdef USE_X_TOOLKIT
3119 x_window (f
, window_prompting
, minibuffer_only
);
3125 init_frame_faces (f
);
3127 /* We need to do this after creating the X window, so that the
3128 icon-creation functions can say whose icon they're describing. */
3129 x_default_parameter (f
, parms
, Qicon_type
, Qnil
,
3130 "bitmapIcon", "BitmapIcon", symbol
);
3132 x_default_parameter (f
, parms
, Qauto_raise
, Qnil
,
3133 "autoRaise", "AutoRaiseLower", boolean
);
3134 x_default_parameter (f
, parms
, Qauto_lower
, Qnil
,
3135 "autoLower", "AutoRaiseLower", boolean
);
3136 x_default_parameter (f
, parms
, Qcursor_type
, Qbox
,
3137 "cursorType", "CursorType", symbol
);
3139 /* Dimensions, especially f->height, must be done via change_frame_size.
3140 Change will not be effected unless different from the current
3144 f
->height
= f
->width
= 0;
3145 change_frame_size (f
, height
, width
, 1, 0);
3147 /* Tell the server what size and position, etc, we want,
3148 and how badly we want them. */
3150 x_wm_set_size_hint (f
, window_prompting
, 0);
3153 tem
= x_get_arg (parms
, Qunsplittable
, 0, 0, boolean
);
3154 f
->no_split
= minibuffer_only
|| EQ (tem
, Qt
);
3158 /* It is now ok to make the frame official
3159 even if we get an error below.
3160 And the frame needs to be on Vframe_list
3161 or making it visible won't work. */
3162 Vframe_list
= Fcons (frame
, Vframe_list
);
3164 /* Now that the frame is official, it counts as a reference to
3166 FRAME_X_DISPLAY_INFO (f
)->reference_count
++;
3168 /* Make the window appear on the frame and enable display,
3169 unless the caller says not to. However, with explicit parent,
3170 Emacs cannot control visibility, so don't try. */
3171 if (! f
->output_data
.x
->explicit_parent
)
3173 Lisp_Object visibility
;
3175 visibility
= x_get_arg (parms
, Qvisibility
, 0, 0, symbol
);
3176 if (EQ (visibility
, Qunbound
))
3179 if (EQ (visibility
, Qicon
))
3180 x_iconify_frame (f
);
3181 else if (! NILP (visibility
))
3182 x_make_frame_visible (f
);
3184 /* Must have been Qnil. */
3188 return unbind_to (count
, frame
);
3191 /* FRAME is used only to get a handle on the X display. We don't pass the
3192 display info directly because we're called from frame.c, which doesn't
3193 know about that structure. */
3195 x_get_focus_frame (frame
)
3196 struct frame
*frame
;
3198 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (frame
);
3200 if (! dpyinfo
->x_focus_frame
)
3203 XSETFRAME (xfocus
, dpyinfo
->x_focus_frame
);
3207 DEFUN ("focus-frame", Ffocus_frame
, Sfocus_frame
, 1, 1, 0,
3208 "This function is obsolete, and does nothing.")
3215 DEFUN ("unfocus-frame", Funfocus_frame
, Sunfocus_frame
, 0, 0, 0,
3216 "This function is obsolete, and does nothing.")
3222 DEFUN ("x-list-fonts", Fx_list_fonts
, Sx_list_fonts
, 1, 3, 0,
3223 "Return a list of the names of available fonts matching PATTERN.\n\
3224 If optional arguments FACE and FRAME are specified, return only fonts\n\
3225 the same size as FACE on FRAME.\n\
3227 PATTERN is a string, perhaps with wildcard characters;\n\
3228 the * character matches any substring, and\n\
3229 the ? character matches any single character.\n\
3230 PATTERN is case-insensitive.\n\
3231 FACE is a face name--a symbol.\n\
3233 The return value is a list of strings, suitable as arguments to\n\
3236 Fonts Emacs can't use (i.e. proportional fonts) may or may not be excluded\n\
3237 even if they match PATTERN and FACE.")
3238 (pattern
, face
, frame
)
3239 Lisp_Object pattern
, face
, frame
;
3243 #ifndef BROKEN_XLISTFONTSWITHINFO
3246 XFontStruct
*size_ref
;
3251 CHECK_STRING (pattern
, 0);
3253 CHECK_SYMBOL (face
, 1);
3255 f
= check_x_frame (frame
);
3257 /* Determine the width standard for comparison with the fonts we find. */
3265 /* Don't die if we get called with a terminal frame. */
3266 if (! FRAME_X_P (f
))
3267 error ("Non-X frame used in `x-list-fonts'");
3269 face_id
= face_name_id_number (f
, face
);
3271 if (face_id
< 0 || face_id
>= FRAME_N_PARAM_FACES (f
)
3272 || FRAME_PARAM_FACES (f
) [face_id
] == 0)
3273 size_ref
= f
->output_data
.x
->font
;
3276 size_ref
= FRAME_PARAM_FACES (f
) [face_id
]->font
;
3277 if (size_ref
== (XFontStruct
*) (~0))
3278 size_ref
= f
->output_data
.x
->font
;
3282 /* See if we cached the result for this particular query. */
3283 list
= Fassoc (pattern
,
3284 XCONS (FRAME_X_DISPLAY_INFO (f
)->name_list_element
)->cdr
);
3286 /* We have info in the cache for this PATTERN. */
3289 Lisp_Object tem
, newlist
;
3291 /* We have info about this pattern. */
3292 list
= XCONS (list
)->cdr
;
3299 /* Filter the cached info and return just the fonts that match FACE. */
3301 for (tem
= list
; CONSP (tem
); tem
= XCONS (tem
)->cdr
)
3303 XFontStruct
*thisinfo
;
3305 thisinfo
= XLoadQueryFont (FRAME_X_DISPLAY (f
),
3306 XSTRING (XCONS (tem
)->car
)->data
);
3308 if (thisinfo
&& same_size_fonts (thisinfo
, size_ref
))
3309 newlist
= Fcons (XCONS (tem
)->car
, newlist
);
3312 XFreeFont (FRAME_X_DISPLAY (f
), thisinfo
);
3322 /* Solaris 2.3 has a bug in XListFontsWithInfo. */
3323 #ifndef BROKEN_XLISTFONTSWITHINFO
3325 names
= XListFontsWithInfo (FRAME_X_DISPLAY (f
),
3326 XSTRING (pattern
)->data
,
3327 2000, /* maxnames */
3328 &num_fonts
, /* count_return */
3329 &info
); /* info_return */
3332 names
= XListFonts (FRAME_X_DISPLAY (f
),
3333 XSTRING (pattern
)->data
,
3334 2000, /* maxnames */
3335 &num_fonts
); /* count_return */
3344 Lisp_Object full_list
;
3346 /* Make a list of all the fonts we got back.
3347 Store that in the font cache for the display. */
3349 for (i
= 0; i
< num_fonts
; i
++)
3350 full_list
= Fcons (build_string (names
[i
]), full_list
);
3351 XCONS (FRAME_X_DISPLAY_INFO (f
)->name_list_element
)->cdr
3352 = Fcons (Fcons (pattern
, full_list
),
3353 XCONS (FRAME_X_DISPLAY_INFO (f
)->name_list_element
)->cdr
);
3355 /* Make a list of the fonts that have the right width. */
3357 for (i
= 0; i
< num_fonts
; i
++)
3365 #ifdef BROKEN_XLISTFONTSWITHINFO
3366 XFontStruct
*thisinfo
;
3369 thisinfo
= XLoadQueryFont (FRAME_X_DISPLAY (f
), names
[i
]);
3372 keeper
= thisinfo
&& same_size_fonts (thisinfo
, size_ref
);
3374 keeper
= same_size_fonts (&info
[i
], size_ref
);
3378 list
= Fcons (build_string (names
[i
]), list
);
3380 list
= Fnreverse (list
);
3383 #ifndef BROKEN_XLISTFONTSWITHINFO
3385 XFreeFontInfo (names
, info
, num_fonts
);
3388 XFreeFontNames (names
);
3396 DEFUN ("x-color-defined-p", Fx_color_defined_p
, Sx_color_defined_p
, 1, 2, 0,
3397 "Return non-nil if color COLOR is supported on frame FRAME.\n\
3398 If FRAME is omitted or nil, use the selected frame.")
3400 Lisp_Object color
, frame
;
3403 FRAME_PTR f
= check_x_frame (frame
);
3405 CHECK_STRING (color
, 1);
3407 if (defined_color (f
, XSTRING (color
)->data
, &foo
, 0))
3413 DEFUN ("x-color-values", Fx_color_values
, Sx_color_values
, 1, 2, 0,
3414 "Return a description of the color named COLOR on frame FRAME.\n\
3415 The value is a list of integer RGB values--(RED GREEN BLUE).\n\
3416 These values appear to range from 0 to 65280 or 65535, depending\n\
3417 on the system; white is (65280 65280 65280) or (65535 65535 65535).\n\
3418 If FRAME is omitted or nil, use the selected frame.")
3420 Lisp_Object color
, frame
;
3423 FRAME_PTR f
= check_x_frame (frame
);
3425 CHECK_STRING (color
, 1);
3427 if (defined_color (f
, XSTRING (color
)->data
, &foo
, 0))
3431 rgb
[0] = make_number (foo
.red
);
3432 rgb
[1] = make_number (foo
.green
);
3433 rgb
[2] = make_number (foo
.blue
);
3434 return Flist (3, rgb
);
3440 DEFUN ("x-display-color-p", Fx_display_color_p
, Sx_display_color_p
, 0, 1, 0,
3441 "Return t if the X display supports color.\n\
3442 The optional argument DISPLAY specifies which display to ask about.\n\
3443 DISPLAY should be either a frame or a display name (a string).\n\
3444 If omitted or nil, that stands for the selected frame's display.")
3446 Lisp_Object display
;
3448 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
3450 if (dpyinfo
->n_planes
<= 2)
3453 switch (dpyinfo
->visual
->class)
3466 DEFUN ("x-display-grayscale-p", Fx_display_grayscale_p
, Sx_display_grayscale_p
,
3468 "Return t if the X display supports shades of gray.\n\
3469 Note that color displays do support shades of gray.\n\
3470 The optional argument DISPLAY specifies which display to ask about.\n\
3471 DISPLAY should be either a frame or a display name (a string).\n\
3472 If omitted or nil, that stands for the selected frame's display.")
3474 Lisp_Object display
;
3476 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
3478 if (dpyinfo
->n_planes
<= 1)
3481 switch (dpyinfo
->visual
->class)
3496 DEFUN ("x-display-pixel-width", Fx_display_pixel_width
, Sx_display_pixel_width
,
3498 "Returns the width in pixels of the X display DISPLAY.\n\
3499 The optional argument DISPLAY specifies which display to ask about.\n\
3500 DISPLAY should be either a frame or a display name (a string).\n\
3501 If omitted or nil, that stands for the selected frame's display.")
3503 Lisp_Object display
;
3505 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
3507 return make_number (dpyinfo
->width
);
3510 DEFUN ("x-display-pixel-height", Fx_display_pixel_height
,
3511 Sx_display_pixel_height
, 0, 1, 0,
3512 "Returns the height in pixels of the X display DISPLAY.\n\
3513 The optional argument DISPLAY specifies which display to ask about.\n\
3514 DISPLAY should be either a frame or a display name (a string).\n\
3515 If omitted or nil, that stands for the selected frame's display.")
3517 Lisp_Object display
;
3519 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
3521 return make_number (dpyinfo
->height
);
3524 DEFUN ("x-display-planes", Fx_display_planes
, Sx_display_planes
,
3526 "Returns the number of bitplanes of the X display DISPLAY.\n\
3527 The optional argument DISPLAY specifies which display to ask about.\n\
3528 DISPLAY should be either a frame or a display name (a string).\n\
3529 If omitted or nil, that stands for the selected frame's display.")
3531 Lisp_Object display
;
3533 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
3535 return make_number (dpyinfo
->n_planes
);
3538 DEFUN ("x-display-color-cells", Fx_display_color_cells
, Sx_display_color_cells
,
3540 "Returns the number of color cells of the X display DISPLAY.\n\
3541 The optional argument DISPLAY specifies which display to ask about.\n\
3542 DISPLAY should be either a frame or a display name (a string).\n\
3543 If omitted or nil, that stands for the selected frame's display.")
3545 Lisp_Object display
;
3547 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
3549 return make_number (DisplayCells (dpyinfo
->display
,
3550 XScreenNumberOfScreen (dpyinfo
->screen
)));
3553 DEFUN ("x-server-max-request-size", Fx_server_max_request_size
,
3554 Sx_server_max_request_size
,
3556 "Returns the maximum request size of the X server of display DISPLAY.\n\
3557 The optional argument DISPLAY specifies which display to ask about.\n\
3558 DISPLAY should be either a frame or a display name (a string).\n\
3559 If omitted or nil, that stands for the selected frame's display.")
3561 Lisp_Object display
;
3563 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
3565 return make_number (MAXREQUEST (dpyinfo
->display
));
3568 DEFUN ("x-server-vendor", Fx_server_vendor
, Sx_server_vendor
, 0, 1, 0,
3569 "Returns the vendor ID string of the X server of display DISPLAY.\n\
3570 The optional argument DISPLAY specifies which display to ask about.\n\
3571 DISPLAY should be either a frame or a display name (a string).\n\
3572 If omitted or nil, that stands for the selected frame's display.")
3574 Lisp_Object display
;
3576 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
3577 char *vendor
= ServerVendor (dpyinfo
->display
);
3579 if (! vendor
) vendor
= "";
3580 return build_string (vendor
);
3583 DEFUN ("x-server-version", Fx_server_version
, Sx_server_version
, 0, 1, 0,
3584 "Returns the version numbers of the X server of display DISPLAY.\n\
3585 The value is a list of three integers: the major and minor\n\
3586 version numbers of the X Protocol in use, and the vendor-specific release\n\
3587 number. See also the function `x-server-vendor'.\n\n\
3588 The optional argument DISPLAY specifies which display to ask about.\n\
3589 DISPLAY should be either a frame or a display name (a string).\n\
3590 If omitted or nil, that stands for the selected frame's display.")
3592 Lisp_Object display
;
3594 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
3595 Display
*dpy
= dpyinfo
->display
;
3597 return Fcons (make_number (ProtocolVersion (dpy
)),
3598 Fcons (make_number (ProtocolRevision (dpy
)),
3599 Fcons (make_number (VendorRelease (dpy
)), Qnil
)));
3602 DEFUN ("x-display-screens", Fx_display_screens
, Sx_display_screens
, 0, 1, 0,
3603 "Returns the number of screens on the X server of display DISPLAY.\n\
3604 The optional argument DISPLAY specifies which display to ask about.\n\
3605 DISPLAY should be either a frame or a display name (a string).\n\
3606 If omitted or nil, that stands for the selected frame's display.")
3608 Lisp_Object display
;
3610 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
3612 return make_number (ScreenCount (dpyinfo
->display
));
3615 DEFUN ("x-display-mm-height", Fx_display_mm_height
, Sx_display_mm_height
, 0, 1, 0,
3616 "Returns the height in millimeters of the X display DISPLAY.\n\
3617 The optional argument DISPLAY specifies which display to ask about.\n\
3618 DISPLAY should be either a frame or a display name (a string).\n\
3619 If omitted or nil, that stands for the selected frame's display.")
3621 Lisp_Object display
;
3623 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
3625 return make_number (HeightMMOfScreen (dpyinfo
->screen
));
3628 DEFUN ("x-display-mm-width", Fx_display_mm_width
, Sx_display_mm_width
, 0, 1, 0,
3629 "Returns the width in millimeters of the X display DISPLAY.\n\
3630 The optional argument DISPLAY specifies which display to ask about.\n\
3631 DISPLAY should be either a frame or a display name (a string).\n\
3632 If omitted or nil, that stands for the selected frame's display.")
3634 Lisp_Object display
;
3636 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
3638 return make_number (WidthMMOfScreen (dpyinfo
->screen
));
3641 DEFUN ("x-display-backing-store", Fx_display_backing_store
,
3642 Sx_display_backing_store
, 0, 1, 0,
3643 "Returns an indication of whether X display DISPLAY does backing store.\n\
3644 The value may be `always', `when-mapped', or `not-useful'.\n\
3645 The optional argument DISPLAY specifies which display to ask about.\n\
3646 DISPLAY should be either a frame or a display name (a string).\n\
3647 If omitted or nil, that stands for the selected frame's display.")
3649 Lisp_Object display
;
3651 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
3653 switch (DoesBackingStore (dpyinfo
->screen
))
3656 return intern ("always");
3659 return intern ("when-mapped");
3662 return intern ("not-useful");
3665 error ("Strange value for BackingStore parameter of screen");
3669 DEFUN ("x-display-visual-class", Fx_display_visual_class
,
3670 Sx_display_visual_class
, 0, 1, 0,
3671 "Returns the visual class of the X display DISPLAY.\n\
3672 The value is one of the symbols `static-gray', `gray-scale',\n\
3673 `static-color', `pseudo-color', `true-color', or `direct-color'.\n\n\
3674 The optional argument DISPLAY specifies which display to ask about.\n\
3675 DISPLAY should be either a frame or a display name (a string).\n\
3676 If omitted or nil, that stands for the selected frame's display.")
3678 Lisp_Object display
;
3680 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
3682 switch (dpyinfo
->visual
->class)
3684 case StaticGray
: return (intern ("static-gray"));
3685 case GrayScale
: return (intern ("gray-scale"));
3686 case StaticColor
: return (intern ("static-color"));
3687 case PseudoColor
: return (intern ("pseudo-color"));
3688 case TrueColor
: return (intern ("true-color"));
3689 case DirectColor
: return (intern ("direct-color"));
3691 error ("Display has an unknown visual class");
3695 DEFUN ("x-display-save-under", Fx_display_save_under
,
3696 Sx_display_save_under
, 0, 1, 0,
3697 "Returns t if the X display DISPLAY supports the save-under feature.\n\
3698 The optional argument DISPLAY specifies which display to ask about.\n\
3699 DISPLAY should be either a frame or a display name (a string).\n\
3700 If omitted or nil, that stands for the selected frame's display.")
3702 Lisp_Object display
;
3704 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
3706 if (DoesSaveUnders (dpyinfo
->screen
) == True
)
3714 register struct frame
*f
;
3716 return PIXEL_WIDTH (f
);
3721 register struct frame
*f
;
3723 return PIXEL_HEIGHT (f
);
3728 register struct frame
*f
;
3730 return FONT_WIDTH (f
->output_data
.x
->font
);
3735 register struct frame
*f
;
3737 return f
->output_data
.x
->line_height
;
3741 x_screen_planes (frame
)
3744 return FRAME_X_DISPLAY_INFO (XFRAME (frame
))->n_planes
;
3747 #if 0 /* These no longer seem like the right way to do things. */
3749 /* Draw a rectangle on the frame with left top corner including
3750 the character specified by LEFT_CHAR and TOP_CHAR. The rectangle is
3751 CHARS by LINES wide and long and is the color of the cursor. */
3754 x_rectangle (f
, gc
, left_char
, top_char
, chars
, lines
)
3755 register struct frame
*f
;
3757 register int top_char
, left_char
, chars
, lines
;
3761 int left
= (left_char
* FONT_WIDTH (f
->output_data
.x
->font
)
3762 + f
->output_data
.x
->internal_border_width
);
3763 int top
= (top_char
* f
->output_data
.x
->line_height
3764 + f
->output_data
.x
->internal_border_width
);
3767 width
= FONT_WIDTH (f
->output_data
.x
->font
) / 2;
3769 width
= FONT_WIDTH (f
->output_data
.x
->font
) * chars
;
3771 height
= f
->output_data
.x
->line_height
/ 2;
3773 height
= f
->output_data
.x
->line_height
* lines
;
3775 XDrawRectangle (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
3776 gc
, left
, top
, width
, height
);
3779 DEFUN ("x-draw-rectangle", Fx_draw_rectangle
, Sx_draw_rectangle
, 5, 5, 0,
3780 "Draw a rectangle on FRAME between coordinates specified by\n\
3781 numbers X0, Y0, X1, Y1 in the cursor pixel.")
3782 (frame
, X0
, Y0
, X1
, Y1
)
3783 register Lisp_Object frame
, X0
, X1
, Y0
, Y1
;
3785 register int x0
, y0
, x1
, y1
, top
, left
, n_chars
, n_lines
;
3787 CHECK_LIVE_FRAME (frame
, 0);
3788 CHECK_NUMBER (X0
, 0);
3789 CHECK_NUMBER (Y0
, 1);
3790 CHECK_NUMBER (X1
, 2);
3791 CHECK_NUMBER (Y1
, 3);
3801 n_lines
= y1
- y0
+ 1;
3806 n_lines
= y0
- y1
+ 1;
3812 n_chars
= x1
- x0
+ 1;
3817 n_chars
= x0
- x1
+ 1;
3821 x_rectangle (XFRAME (frame
), XFRAME (frame
)->output_data
.x
->cursor_gc
,
3822 left
, top
, n_chars
, n_lines
);
3828 DEFUN ("x-erase-rectangle", Fx_erase_rectangle
, Sx_erase_rectangle
, 5, 5, 0,
3829 "Draw a rectangle drawn on FRAME between coordinates\n\
3830 X0, Y0, X1, Y1 in the regular background-pixel.")
3831 (frame
, X0
, Y0
, X1
, Y1
)
3832 register Lisp_Object frame
, X0
, Y0
, X1
, Y1
;
3834 register int x0
, y0
, x1
, y1
, top
, left
, n_chars
, n_lines
;
3836 CHECK_LIVE_FRAME (frame
, 0);
3837 CHECK_NUMBER (X0
, 0);
3838 CHECK_NUMBER (Y0
, 1);
3839 CHECK_NUMBER (X1
, 2);
3840 CHECK_NUMBER (Y1
, 3);
3850 n_lines
= y1
- y0
+ 1;
3855 n_lines
= y0
- y1
+ 1;
3861 n_chars
= x1
- x0
+ 1;
3866 n_chars
= x0
- x1
+ 1;
3870 x_rectangle (XFRAME (frame
), XFRAME (frame
)->output_data
.x
->reverse_gc
,
3871 left
, top
, n_chars
, n_lines
);
3877 /* Draw lines around the text region beginning at the character position
3878 TOP_X, TOP_Y and ending at BOTTOM_X and BOTTOM_Y. GC specifies the
3879 pixel and line characteristics. */
3881 #define line_len(line) (FRAME_CURRENT_GLYPHS (f)->used[(line)])
3884 outline_region (f
, gc
, top_x
, top_y
, bottom_x
, bottom_y
)
3885 register struct frame
*f
;
3887 int top_x
, top_y
, bottom_x
, bottom_y
;
3889 register int ibw
= f
->output_data
.x
->internal_border_width
;
3890 register int font_w
= FONT_WIDTH (f
->output_data
.x
->font
);
3891 register int font_h
= f
->output_data
.x
->line_height
;
3893 int x
= line_len (y
);
3894 XPoint
*pixel_points
3895 = (XPoint
*) alloca (((bottom_y
- top_y
+ 2) * 4) * sizeof (XPoint
));
3896 register XPoint
*this_point
= pixel_points
;
3898 /* Do the horizontal top line/lines */
3901 this_point
->x
= ibw
;
3902 this_point
->y
= ibw
+ (font_h
* top_y
);
3905 this_point
->x
= ibw
+ (font_w
/ 2); /* Half-size for newline chars. */
3907 this_point
->x
= ibw
+ (font_w
* x
);
3908 this_point
->y
= (this_point
- 1)->y
;
3912 this_point
->x
= ibw
;
3913 this_point
->y
= ibw
+ (font_h
* (top_y
+ 1));
3915 this_point
->x
= ibw
+ (font_w
* top_x
);
3916 this_point
->y
= (this_point
- 1)->y
;
3918 this_point
->x
= (this_point
- 1)->x
;
3919 this_point
->y
= ibw
+ (font_h
* top_y
);
3921 this_point
->x
= ibw
+ (font_w
* x
);
3922 this_point
->y
= (this_point
- 1)->y
;
3925 /* Now do the right side. */
3926 while (y
< bottom_y
)
3927 { /* Right vertical edge */
3929 this_point
->x
= (this_point
- 1)->x
;
3930 this_point
->y
= ibw
+ (font_h
* (y
+ 1));
3933 y
++; /* Horizontal connection to next line */
3936 this_point
->x
= ibw
+ (font_w
/ 2);
3938 this_point
->x
= ibw
+ (font_w
* x
);
3940 this_point
->y
= (this_point
- 1)->y
;
3943 /* Now do the bottom and connect to the top left point. */
3944 this_point
->x
= ibw
+ (font_w
* (bottom_x
+ 1));
3947 this_point
->x
= (this_point
- 1)->x
;
3948 this_point
->y
= ibw
+ (font_h
* (bottom_y
+ 1));
3950 this_point
->x
= ibw
;
3951 this_point
->y
= (this_point
- 1)->y
;
3953 this_point
->x
= pixel_points
->x
;
3954 this_point
->y
= pixel_points
->y
;
3956 XDrawLines (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
3958 (this_point
- pixel_points
+ 1), CoordModeOrigin
);
3961 DEFUN ("x-contour-region", Fx_contour_region
, Sx_contour_region
, 1, 1, 0,
3962 "Highlight the region between point and the character under the mouse\n\
3965 register Lisp_Object event
;
3967 register int x0
, y0
, x1
, y1
;
3968 register struct frame
*f
= selected_frame
;
3969 register int p1
, p2
;
3971 CHECK_CONS (event
, 0);
3974 x0
= XINT (Fcar (Fcar (event
)));
3975 y0
= XINT (Fcar (Fcdr (Fcar (event
))));
3977 /* If the mouse is past the end of the line, don't that area. */
3978 /* ReWrite this... */
3983 if (y1
> y0
) /* point below mouse */
3984 outline_region (f
, f
->output_data
.x
->cursor_gc
,
3986 else if (y1
< y0
) /* point above mouse */
3987 outline_region (f
, f
->output_data
.x
->cursor_gc
,
3989 else /* same line: draw horizontal rectangle */
3992 x_rectangle (f
, f
->output_data
.x
->cursor_gc
,
3993 x0
, y0
, (x1
- x0
+ 1), 1);
3995 x_rectangle (f
, f
->output_data
.x
->cursor_gc
,
3996 x1
, y1
, (x0
- x1
+ 1), 1);
3999 XFlush (FRAME_X_DISPLAY (f
));
4005 DEFUN ("x-uncontour-region", Fx_uncontour_region
, Sx_uncontour_region
, 1, 1, 0,
4006 "Erase any highlighting of the region between point and the character\n\
4007 at X, Y on the selected frame.")
4009 register Lisp_Object event
;
4011 register int x0
, y0
, x1
, y1
;
4012 register struct frame
*f
= selected_frame
;
4015 x0
= XINT (Fcar (Fcar (event
)));
4016 y0
= XINT (Fcar (Fcdr (Fcar (event
))));
4020 if (y1
> y0
) /* point below mouse */
4021 outline_region (f
, f
->output_data
.x
->reverse_gc
,
4023 else if (y1
< y0
) /* point above mouse */
4024 outline_region (f
, f
->output_data
.x
->reverse_gc
,
4026 else /* same line: draw horizontal rectangle */
4029 x_rectangle (f
, f
->output_data
.x
->reverse_gc
,
4030 x0
, y0
, (x1
- x0
+ 1), 1);
4032 x_rectangle (f
, f
->output_data
.x
->reverse_gc
,
4033 x1
, y1
, (x0
- x1
+ 1), 1);
4041 int contour_begin_x
, contour_begin_y
;
4042 int contour_end_x
, contour_end_y
;
4043 int contour_npoints
;
4045 /* Clip the top part of the contour lines down (and including) line Y_POS.
4046 If X_POS is in the middle (rather than at the end) of the line, drop
4047 down a line at that character. */
4050 clip_contour_top (y_pos
, x_pos
)
4052 register XPoint
*begin
= contour_lines
[y_pos
].top_left
;
4053 register XPoint
*end
;
4054 register int npoints
;
4055 register struct display_line
*line
= selected_frame
->phys_lines
[y_pos
+ 1];
4057 if (x_pos
>= line
->len
- 1) /* Draw one, straight horizontal line. */
4059 end
= contour_lines
[y_pos
].top_right
;
4060 npoints
= (end
- begin
+ 1);
4061 XDrawLines (x_current_display
, contour_window
,
4062 contour_erase_gc
, begin_erase
, npoints
, CoordModeOrigin
);
4064 bcopy (end
, begin
+ 1, contour_last_point
- end
+ 1);
4065 contour_last_point
-= (npoints
- 2);
4066 XDrawLines (x_current_display
, contour_window
,
4067 contour_erase_gc
, begin
, 2, CoordModeOrigin
);
4068 XFlush (x_current_display
);
4070 /* Now, update contour_lines structure. */
4075 register XPoint
*p
= begin
+ 1;
4076 end
= contour_lines
[y_pos
].bottom_right
;
4077 npoints
= (end
- begin
+ 1);
4078 XDrawLines (x_current_display
, contour_window
,
4079 contour_erase_gc
, begin_erase
, npoints
, CoordModeOrigin
);
4082 p
->x
= ibw
+ (font_w
* (x_pos
+ 1));
4084 p
->y
= begin
->y
+ font_h
;
4086 bcopy (end
, begin
+ 3, contour_last_point
- end
+ 1);
4087 contour_last_point
-= (npoints
- 5);
4088 XDrawLines (x_current_display
, contour_window
,
4089 contour_erase_gc
, begin
, 4, CoordModeOrigin
);
4090 XFlush (x_current_display
);
4092 /* Now, update contour_lines structure. */
4096 /* Erase the top horizontal lines of the contour, and then extend
4097 the contour upwards. */
4100 extend_contour_top (line
)
4105 clip_contour_bottom (x_pos
, y_pos
)
4111 extend_contour_bottom (x_pos
, y_pos
)
4115 DEFUN ("x-select-region", Fx_select_region
, Sx_select_region
, 1, 1, "e",
4120 register struct frame
*f
= selected_frame
;
4121 register int point_x
= f
->cursor_x
;
4122 register int point_y
= f
->cursor_y
;
4123 register int mouse_below_point
;
4124 register Lisp_Object obj
;
4125 register int x_contour_x
, x_contour_y
;
4127 x_contour_x
= x_mouse_x
;
4128 x_contour_y
= x_mouse_y
;
4129 if (x_contour_y
> point_y
|| (x_contour_y
== point_y
4130 && x_contour_x
> point_x
))
4132 mouse_below_point
= 1;
4133 outline_region (f
, f
->output_data
.x
->cursor_gc
, point_x
, point_y
,
4134 x_contour_x
, x_contour_y
);
4138 mouse_below_point
= 0;
4139 outline_region (f
, f
->output_data
.x
->cursor_gc
, x_contour_x
, x_contour_y
,
4145 obj
= read_char (-1, 0, 0, Qnil
, 0);
4149 if (mouse_below_point
)
4151 if (x_mouse_y
<= point_y
) /* Flipped. */
4153 mouse_below_point
= 0;
4155 outline_region (f
, f
->output_data
.x
->reverse_gc
, point_x
, point_y
,
4156 x_contour_x
, x_contour_y
);
4157 outline_region (f
, f
->output_data
.x
->cursor_gc
, x_mouse_x
, x_mouse_y
,
4160 else if (x_mouse_y
< x_contour_y
) /* Bottom clipped. */
4162 clip_contour_bottom (x_mouse_y
);
4164 else if (x_mouse_y
> x_contour_y
) /* Bottom extended. */
4166 extend_bottom_contour (x_mouse_y
);
4169 x_contour_x
= x_mouse_x
;
4170 x_contour_y
= x_mouse_y
;
4172 else /* mouse above or same line as point */
4174 if (x_mouse_y
>= point_y
) /* Flipped. */
4176 mouse_below_point
= 1;
4178 outline_region (f
, f
->output_data
.x
->reverse_gc
,
4179 x_contour_x
, x_contour_y
, point_x
, point_y
);
4180 outline_region (f
, f
->output_data
.x
->cursor_gc
, point_x
, point_y
,
4181 x_mouse_x
, x_mouse_y
);
4183 else if (x_mouse_y
> x_contour_y
) /* Top clipped. */
4185 clip_contour_top (x_mouse_y
);
4187 else if (x_mouse_y
< x_contour_y
) /* Top extended. */
4189 extend_contour_top (x_mouse_y
);
4194 unread_command_event
= obj
;
4195 if (mouse_below_point
)
4197 contour_begin_x
= point_x
;
4198 contour_begin_y
= point_y
;
4199 contour_end_x
= x_contour_x
;
4200 contour_end_y
= x_contour_y
;
4204 contour_begin_x
= x_contour_x
;
4205 contour_begin_y
= x_contour_y
;
4206 contour_end_x
= point_x
;
4207 contour_end_y
= point_y
;
4212 DEFUN ("x-horizontal-line", Fx_horizontal_line
, Sx_horizontal_line
, 1, 1, "e",
4217 register Lisp_Object obj
;
4218 struct frame
*f
= selected_frame
;
4219 register struct window
*w
= XWINDOW (selected_window
);
4220 register GC line_gc
= f
->output_data
.x
->cursor_gc
;
4221 register GC erase_gc
= f
->output_data
.x
->reverse_gc
;
4223 char dash_list
[] = {6, 4, 6, 4};
4225 XGCValues gc_values
;
4227 register int previous_y
;
4228 register int line
= (x_mouse_y
+ 1) * f
->output_data
.x
->line_height
4229 + f
->output_data
.x
->internal_border_width
;
4230 register int left
= f
->output_data
.x
->internal_border_width
4232 * FONT_WIDTH (f
->output_data
.x
->font
));
4233 register int right
= left
+ (w
->width
4234 * FONT_WIDTH (f
->output_data
.x
->font
))
4235 - f
->output_data
.x
->internal_border_width
;
4239 gc_values
.foreground
= f
->output_data
.x
->cursor_pixel
;
4240 gc_values
.background
= f
->output_data
.x
->background_pixel
;
4241 gc_values
.line_width
= 1;
4242 gc_values
.line_style
= LineOnOffDash
;
4243 gc_values
.cap_style
= CapRound
;
4244 gc_values
.join_style
= JoinRound
;
4246 line_gc
= XCreateGC (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
4247 GCLineStyle
| GCJoinStyle
| GCCapStyle
4248 | GCLineWidth
| GCForeground
| GCBackground
,
4250 XSetDashes (FRAME_X_DISPLAY (f
), line_gc
, 0, dash_list
, dashes
);
4251 gc_values
.foreground
= f
->output_data
.x
->background_pixel
;
4252 gc_values
.background
= f
->output_data
.x
->foreground_pixel
;
4253 erase_gc
= XCreateGC (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
4254 GCLineStyle
| GCJoinStyle
| GCCapStyle
4255 | GCLineWidth
| GCForeground
| GCBackground
,
4257 XSetDashes (FRAME_X_DISPLAY (f
), erase_gc
, 0, dash_list
, dashes
);
4264 if (x_mouse_y
>= XINT (w
->top
)
4265 && x_mouse_y
< XINT (w
->top
) + XINT (w
->height
) - 1)
4267 previous_y
= x_mouse_y
;
4268 line
= (x_mouse_y
+ 1) * f
->output_data
.x
->line_height
4269 + f
->output_data
.x
->internal_border_width
;
4270 XDrawLine (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
4271 line_gc
, left
, line
, right
, line
);
4273 XFlush (FRAME_X_DISPLAY (f
));
4278 obj
= read_char (-1, 0, 0, Qnil
, 0);
4280 || (! EQ (Fcar (Fcdr (Fcdr (obj
))),
4281 Qvertical_scroll_bar
))
4285 XDrawLine (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
4286 erase_gc
, left
, line
, right
, line
);
4287 unread_command_event
= obj
;
4289 XFreeGC (FRAME_X_DISPLAY (f
), line_gc
);
4290 XFreeGC (FRAME_X_DISPLAY (f
), erase_gc
);
4296 while (x_mouse_y
== previous_y
);
4299 XDrawLine (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
4300 erase_gc
, left
, line
, right
, line
);
4307 /* These keep track of the rectangle following the pointer. */
4308 int mouse_track_top
, mouse_track_left
, mouse_track_width
;
4310 /* Offset in buffer of character under the pointer, or 0. */
4311 int mouse_buffer_offset
;
4313 DEFUN ("x-track-pointer", Fx_track_pointer
, Sx_track_pointer
, 0, 0, 0,
4314 "Track the pointer.")
4317 static Cursor current_pointer_shape
;
4318 FRAME_PTR f
= x_mouse_frame
;
4321 if (EQ (Vmouse_frame_part
, Qtext_part
)
4322 && (current_pointer_shape
!= f
->output_data
.x
->nontext_cursor
))
4327 current_pointer_shape
= f
->output_data
.x
->nontext_cursor
;
4328 XDefineCursor (FRAME_X_DISPLAY (f
),
4330 current_pointer_shape
);
4332 buf
= XBUFFER (XWINDOW (Vmouse_window
)->buffer
);
4333 c
= *(BUF_CHAR_ADDRESS (buf
, mouse_buffer_offset
));
4335 else if (EQ (Vmouse_frame_part
, Qmodeline_part
)
4336 && (current_pointer_shape
!= f
->output_data
.x
->modeline_cursor
))
4338 current_pointer_shape
= f
->output_data
.x
->modeline_cursor
;
4339 XDefineCursor (FRAME_X_DISPLAY (f
),
4341 current_pointer_shape
);
4344 XFlush (FRAME_X_DISPLAY (f
));
4350 DEFUN ("x-track-pointer", Fx_track_pointer
, Sx_track_pointer
, 1, 1, "e",
4351 "Draw rectangle around character under mouse pointer, if there is one.")
4355 struct window
*w
= XWINDOW (Vmouse_window
);
4356 struct frame
*f
= XFRAME (WINDOW_FRAME (w
));
4357 struct buffer
*b
= XBUFFER (w
->buffer
);
4360 if (! EQ (Vmouse_window
, selected_window
))
4363 if (EQ (event
, Qnil
))
4367 x_read_mouse_position (selected_frame
, &x
, &y
);
4371 mouse_track_width
= 0;
4372 mouse_track_left
= mouse_track_top
= -1;
4376 if ((x_mouse_x
!= mouse_track_left
4377 && (x_mouse_x
< mouse_track_left
4378 || x_mouse_x
> (mouse_track_left
+ mouse_track_width
)))
4379 || x_mouse_y
!= mouse_track_top
)
4381 int hp
= 0; /* Horizontal position */
4382 int len
= FRAME_CURRENT_GLYPHS (f
)->used
[x_mouse_y
];
4383 int p
= FRAME_CURRENT_GLYPHS (f
)->bufp
[x_mouse_y
];
4384 int tab_width
= XINT (b
->tab_width
);
4385 int ctl_arrow_p
= !NILP (b
->ctl_arrow
);
4387 int mode_line_vpos
= XFASTINT (w
->height
) + XFASTINT (w
->top
) - 1;
4388 int in_mode_line
= 0;
4390 if (! FRAME_CURRENT_GLYPHS (f
)->enable
[x_mouse_y
])
4393 /* Erase previous rectangle. */
4394 if (mouse_track_width
)
4396 x_rectangle (f
, f
->output_data
.x
->reverse_gc
,
4397 mouse_track_left
, mouse_track_top
,
4398 mouse_track_width
, 1);
4400 if ((mouse_track_left
== f
->phys_cursor_x
4401 || mouse_track_left
== f
->phys_cursor_x
- 1)
4402 && mouse_track_top
== f
->phys_cursor_y
)
4404 x_display_cursor (f
, 1);
4408 mouse_track_left
= x_mouse_x
;
4409 mouse_track_top
= x_mouse_y
;
4410 mouse_track_width
= 0;
4412 if (mouse_track_left
> len
) /* Past the end of line. */
4415 if (mouse_track_top
== mode_line_vpos
)
4421 if (tab_width
<= 0 || tab_width
> 20) tab_width
= 8;
4425 if (len
== f
->width
&& hp
== len
- 1 && c
!= '\n')
4431 mouse_track_width
= tab_width
- (hp
% tab_width
);
4433 hp
+= mouse_track_width
;
4436 mouse_track_left
= hp
- mouse_track_width
;
4442 mouse_track_width
= -1;
4446 if (ctl_arrow_p
&& (c
< 040 || c
== 0177))
4451 mouse_track_width
= 2;
4456 mouse_track_left
= hp
- mouse_track_width
;
4462 mouse_track_width
= 1;
4469 while (hp
<= x_mouse_x
);
4472 if (mouse_track_width
) /* Over text; use text pointer shape. */
4474 XDefineCursor (FRAME_X_DISPLAY (f
),
4476 f
->output_data
.x
->text_cursor
);
4477 x_rectangle (f
, f
->output_data
.x
->cursor_gc
,
4478 mouse_track_left
, mouse_track_top
,
4479 mouse_track_width
, 1);
4481 else if (in_mode_line
)
4482 XDefineCursor (FRAME_X_DISPLAY (f
),
4484 f
->output_data
.x
->modeline_cursor
);
4486 XDefineCursor (FRAME_X_DISPLAY (f
),
4488 f
->output_data
.x
->nontext_cursor
);
4491 XFlush (FRAME_X_DISPLAY (f
));
4494 obj
= read_char (-1, 0, 0, Qnil
, 0);
4497 while (CONSP (obj
) /* Mouse event */
4498 && EQ (Fcar (Fcdr (Fcdr (obj
))), Qnil
) /* Not scroll bar */
4499 && EQ (Vmouse_depressed
, Qnil
) /* Only motion events */
4500 && EQ (Vmouse_window
, selected_window
) /* In this window */
4503 unread_command_event
= obj
;
4505 if (mouse_track_width
)
4507 x_rectangle (f
, f
->output_data
.x
->reverse_gc
,
4508 mouse_track_left
, mouse_track_top
,
4509 mouse_track_width
, 1);
4510 mouse_track_width
= 0;
4511 if ((mouse_track_left
== f
->phys_cursor_x
4512 || mouse_track_left
- 1 == f
->phys_cursor_x
)
4513 && mouse_track_top
== f
->phys_cursor_y
)
4515 x_display_cursor (f
, 1);
4518 XDefineCursor (FRAME_X_DISPLAY (f
),
4520 f
->output_data
.x
->nontext_cursor
);
4521 XFlush (FRAME_X_DISPLAY (f
));
4531 /* Draw a pixmap specified by IMAGE_DATA of dimensions WIDTH and HEIGHT
4532 on the frame F at position X, Y. */
4534 x_draw_pixmap (f
, x
, y
, image_data
, width
, height
)
4536 int x
, y
, width
, height
;
4541 image
= XCreateBitmapFromData (FRAME_X_DISPLAY (f
),
4542 FRAME_X_WINDOW (f
), image_data
,
4544 XCopyPlane (FRAME_X_DISPLAY (f
), image
, FRAME_X_WINDOW (f
),
4545 f
->output_data
.x
->normal_gc
, 0, 0, width
, height
, x
, y
);
4549 #if 0 /* I'm told these functions are superfluous
4550 given the ability to bind function keys. */
4553 DEFUN ("x-rebind-key", Fx_rebind_key
, Sx_rebind_key
, 3, 3, 0,
4554 "Rebind X keysym KEYSYM, with MODIFIERS, to generate NEWSTRING.\n\
4555 KEYSYM is a string which conforms to the X keysym definitions found\n\
4556 in X11/keysymdef.h, sans the initial XK_. MODIFIERS is nil or a\n\
4557 list of strings specifying modifier keys such as Control_L, which must\n\
4558 also be depressed for NEWSTRING to appear.")
4559 (x_keysym
, modifiers
, newstring
)
4560 register Lisp_Object x_keysym
;
4561 register Lisp_Object modifiers
;
4562 register Lisp_Object newstring
;
4565 register KeySym keysym
;
4566 KeySym modifier_list
[16];
4569 CHECK_STRING (x_keysym
, 1);
4570 CHECK_STRING (newstring
, 3);
4572 keysym
= XStringToKeysym ((char *) XSTRING (x_keysym
)->data
);
4573 if (keysym
== NoSymbol
)
4574 error ("Keysym does not exist");
4576 if (NILP (modifiers
))
4577 XRebindKeysym (x_current_display
, keysym
, modifier_list
, 0,
4578 XSTRING (newstring
)->data
, XSTRING (newstring
)->size
);
4581 register Lisp_Object rest
, mod
;
4584 for (rest
= modifiers
; !NILP (rest
); rest
= Fcdr (rest
))
4587 error ("Can't have more than 16 modifiers");
4590 CHECK_STRING (mod
, 3);
4591 modifier_list
[i
] = XStringToKeysym ((char *) XSTRING (mod
)->data
);
4593 if (modifier_list
[i
] == NoSymbol
4594 || !(IsModifierKey (modifier_list
[i
])
4595 || ((unsigned)(modifier_list
[i
]) == XK_Mode_switch
)
4596 || ((unsigned)(modifier_list
[i
]) == XK_Num_Lock
)))
4598 if (modifier_list
[i
] == NoSymbol
4599 || !IsModifierKey (modifier_list
[i
]))
4601 error ("Element is not a modifier keysym");
4605 XRebindKeysym (x_current_display
, keysym
, modifier_list
, i
,
4606 XSTRING (newstring
)->data
, XSTRING (newstring
)->size
);
4612 DEFUN ("x-rebind-keys", Fx_rebind_keys
, Sx_rebind_keys
, 2, 2, 0,
4613 "Rebind KEYCODE to list of strings STRINGS.\n\
4614 STRINGS should be a list of 16 elements, one for each shift combination.\n\
4615 nil as element means don't change.\n\
4616 See the documentation of `x-rebind-key' for more information.")
4618 register Lisp_Object keycode
;
4619 register Lisp_Object strings
;
4621 register Lisp_Object item
;
4622 register unsigned char *rawstring
;
4623 KeySym rawkey
, modifier
[1];
4625 register unsigned i
;
4628 CHECK_NUMBER (keycode
, 1);
4629 CHECK_CONS (strings
, 2);
4630 rawkey
= (KeySym
) ((unsigned) (XINT (keycode
))) & 255;
4631 for (i
= 0; i
<= 15; strings
= Fcdr (strings
), i
++)
4633 item
= Fcar (strings
);
4636 CHECK_STRING (item
, 2);
4637 strsize
= XSTRING (item
)->size
;
4638 rawstring
= (unsigned char *) xmalloc (strsize
);
4639 bcopy (XSTRING (item
)->data
, rawstring
, strsize
);
4640 modifier
[1] = 1 << i
;
4641 XRebindKeysym (x_current_display
, rawkey
, modifier
, 1,
4642 rawstring
, strsize
);
4647 #endif /* HAVE_X11 */
4650 #ifndef HAVE_XSCREENNUMBEROFSCREEN
4652 XScreenNumberOfScreen (scr
)
4653 register Screen
*scr
;
4655 register Display
*dpy
;
4656 register Screen
*dpyscr
;
4660 dpyscr
= dpy
->screens
;
4662 for (i
= 0; i
< dpy
->nscreens
; i
++, dpyscr
++)
4668 #endif /* not HAVE_XSCREENNUMBEROFSCREEN */
4671 select_visual (dpy
, screen
, depth
)
4674 unsigned int *depth
;
4677 XVisualInfo
*vinfo
, vinfo_template
;
4680 v
= DefaultVisualOfScreen (screen
);
4683 vinfo_template
.visualid
= XVisualIDFromVisual (v
);
4685 vinfo_template
.visualid
= v
->visualid
;
4688 vinfo_template
.screen
= XScreenNumberOfScreen (screen
);
4690 vinfo
= XGetVisualInfo (dpy
,
4691 VisualIDMask
| VisualScreenMask
, &vinfo_template
,
4694 fatal ("Can't get proper X visual info");
4696 if ((1 << vinfo
->depth
) == vinfo
->colormap_size
)
4697 *depth
= vinfo
->depth
;
4701 int n
= vinfo
->colormap_size
- 1;
4710 XFree ((char *) vinfo
);
4714 /* Return the X display structure for the display named NAME.
4715 Open a new connection if necessary. */
4717 struct x_display_info
*
4718 x_display_info_for_name (name
)
4722 struct x_display_info
*dpyinfo
;
4724 CHECK_STRING (name
, 0);
4726 if (! EQ (Vwindow_system
, intern ("x")))
4727 error ("Not using X Windows");
4729 for (dpyinfo
= x_display_list
, names
= x_display_name_list
;
4731 dpyinfo
= dpyinfo
->next
, names
= XCONS (names
)->cdr
)
4734 tem
= Fstring_equal (XCONS (XCONS (names
)->car
)->car
, name
);
4739 /* Use this general default value to start with. */
4740 Vx_resource_name
= Vinvocation_name
;
4742 validate_x_resource_name ();
4744 dpyinfo
= x_term_init (name
, (unsigned char *)0,
4745 (char *) XSTRING (Vx_resource_name
)->data
);
4748 error ("Cannot connect to X server %s", XSTRING (name
)->data
);
4751 XSETFASTINT (Vwindow_system_version
, 11);
4756 DEFUN ("x-open-connection", Fx_open_connection
, Sx_open_connection
,
4757 1, 3, 0, "Open a connection to an X server.\n\
4758 DISPLAY is the name of the display to connect to.\n\
4759 Optional second arg XRM-STRING is a string of resources in xrdb format.\n\
4760 If the optional third arg MUST-SUCCEED is non-nil,\n\
4761 terminate Emacs if we can't open the connection.")
4762 (display
, xrm_string
, must_succeed
)
4763 Lisp_Object display
, xrm_string
, must_succeed
;
4765 unsigned int n_planes
;
4766 unsigned char *xrm_option
;
4767 struct x_display_info
*dpyinfo
;
4769 CHECK_STRING (display
, 0);
4770 if (! NILP (xrm_string
))
4771 CHECK_STRING (xrm_string
, 1);
4773 if (! EQ (Vwindow_system
, intern ("x")))
4774 error ("Not using X Windows");
4776 if (! NILP (xrm_string
))
4777 xrm_option
= (unsigned char *) XSTRING (xrm_string
)->data
;
4779 xrm_option
= (unsigned char *) 0;
4781 /* Use this general default value to start with. */
4782 Vx_resource_name
= Vinvocation_name
;
4784 validate_x_resource_name ();
4786 /* This is what opens the connection and sets x_current_display.
4787 This also initializes many symbols, such as those used for input. */
4788 dpyinfo
= x_term_init (display
, xrm_option
,
4789 (char *) XSTRING (Vx_resource_name
)->data
);
4793 if (!NILP (must_succeed
))
4794 fatal ("Cannot connect to X server %s.\n\
4795 Check the DISPLAY environment variable or use `-d'.\n\
4796 Also use the `xhost' program to verify that it is set to permit\n\
4797 connections from your machine.\n",
4798 XSTRING (display
)->data
);
4800 error ("Cannot connect to X server %s", XSTRING (display
)->data
);
4805 XSETFASTINT (Vwindow_system_version
, 11);
4809 DEFUN ("x-close-connection", Fx_close_connection
,
4810 Sx_close_connection
, 1, 1, 0,
4811 "Close the connection to DISPLAY's X server.\n\
4812 For DISPLAY, specify either a frame or a display name (a string).\n\
4813 If DISPLAY is nil, that stands for the selected frame's display.")
4815 Lisp_Object display
;
4817 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4818 struct x_display_info
*tail
;
4821 if (dpyinfo
->reference_count
> 0)
4822 error ("Display still has frames on it");
4825 /* Free the fonts in the font table. */
4826 for (i
= 0; i
< dpyinfo
->n_fonts
; i
++)
4828 if (dpyinfo
->font_table
[i
].name
)
4829 free (dpyinfo
->font_table
[i
].name
);
4830 /* Don't free the full_name string;
4831 it is always shared with something else. */
4832 XFreeFont (dpyinfo
->display
, dpyinfo
->font_table
[i
].font
);
4834 x_destroy_all_bitmaps (dpyinfo
);
4835 XSetCloseDownMode (dpyinfo
->display
, DestroyAll
);
4837 #ifdef USE_X_TOOLKIT
4838 XtCloseDisplay (dpyinfo
->display
);
4840 XCloseDisplay (dpyinfo
->display
);
4843 x_delete_display (dpyinfo
);
4849 DEFUN ("x-display-list", Fx_display_list
, Sx_display_list
, 0, 0, 0,
4850 "Return the list of display names that Emacs has connections to.")
4853 Lisp_Object tail
, result
;
4856 for (tail
= x_display_name_list
; ! NILP (tail
); tail
= XCONS (tail
)->cdr
)
4857 result
= Fcons (XCONS (XCONS (tail
)->car
)->car
, result
);
4862 DEFUN ("x-synchronize", Fx_synchronize
, Sx_synchronize
, 1, 2, 0,
4863 "If ON is non-nil, report X errors as soon as the erring request is made.\n\
4864 If ON is nil, allow buffering of requests.\n\
4865 Turning on synchronization prohibits the Xlib routines from buffering\n\
4866 requests and seriously degrades performance, but makes debugging much\n\
4868 The optional second argument DISPLAY specifies which display to act on.\n\
4869 DISPLAY should be either a frame or a display name (a string).\n\
4870 If DISPLAY is omitted or nil, that stands for the selected frame's display.")
4872 Lisp_Object display
, on
;
4874 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4876 XSynchronize (dpyinfo
->display
, !EQ (on
, Qnil
));
4881 /* Wait for responses to all X commands issued so far for frame F. */
4888 XSync (FRAME_X_DISPLAY (f
), False
);
4894 /* This is zero if not using X windows. */
4897 /* The section below is built by the lisp expression at the top of the file,
4898 just above where these variables are declared. */
4899 /*&&& init symbols here &&&*/
4900 Qauto_raise
= intern ("auto-raise");
4901 staticpro (&Qauto_raise
);
4902 Qauto_lower
= intern ("auto-lower");
4903 staticpro (&Qauto_lower
);
4904 Qbackground_color
= intern ("background-color");
4905 staticpro (&Qbackground_color
);
4906 Qbar
= intern ("bar");
4908 Qborder_color
= intern ("border-color");
4909 staticpro (&Qborder_color
);
4910 Qborder_width
= intern ("border-width");
4911 staticpro (&Qborder_width
);
4912 Qbox
= intern ("box");
4914 Qcursor_color
= intern ("cursor-color");
4915 staticpro (&Qcursor_color
);
4916 Qcursor_type
= intern ("cursor-type");
4917 staticpro (&Qcursor_type
);
4918 Qfont
= intern ("font");
4920 Qforeground_color
= intern ("foreground-color");
4921 staticpro (&Qforeground_color
);
4922 Qgeometry
= intern ("geometry");
4923 staticpro (&Qgeometry
);
4924 Qicon_left
= intern ("icon-left");
4925 staticpro (&Qicon_left
);
4926 Qicon_top
= intern ("icon-top");
4927 staticpro (&Qicon_top
);
4928 Qicon_type
= intern ("icon-type");
4929 staticpro (&Qicon_type
);
4930 Qicon_name
= intern ("icon-name");
4931 staticpro (&Qicon_name
);
4932 Qinternal_border_width
= intern ("internal-border-width");
4933 staticpro (&Qinternal_border_width
);
4934 Qleft
= intern ("left");
4936 Qmouse_color
= intern ("mouse-color");
4937 staticpro (&Qmouse_color
);
4938 Qnone
= intern ("none");
4940 Qparent_id
= intern ("parent-id");
4941 staticpro (&Qparent_id
);
4942 Qscroll_bar_width
= intern ("scroll-bar-width");
4943 staticpro (&Qscroll_bar_width
);
4944 Qsuppress_icon
= intern ("suppress-icon");
4945 staticpro (&Qsuppress_icon
);
4946 Qtop
= intern ("top");
4948 Qundefined_color
= intern ("undefined-color");
4949 staticpro (&Qundefined_color
);
4950 Qvertical_scroll_bars
= intern ("vertical-scroll-bars");
4951 staticpro (&Qvertical_scroll_bars
);
4952 Qvisibility
= intern ("visibility");
4953 staticpro (&Qvisibility
);
4954 Qwindow_id
= intern ("window-id");
4955 staticpro (&Qwindow_id
);
4956 Qx_frame_parameter
= intern ("x-frame-parameter");
4957 staticpro (&Qx_frame_parameter
);
4958 Qx_resource_name
= intern ("x-resource-name");
4959 staticpro (&Qx_resource_name
);
4960 Quser_position
= intern ("user-position");
4961 staticpro (&Quser_position
);
4962 Quser_size
= intern ("user-size");
4963 staticpro (&Quser_size
);
4964 Qdisplay
= intern ("display");
4965 staticpro (&Qdisplay
);
4966 /* This is the end of symbol initialization. */
4968 Fput (Qundefined_color
, Qerror_conditions
,
4969 Fcons (Qundefined_color
, Fcons (Qerror
, Qnil
)));
4970 Fput (Qundefined_color
, Qerror_message
,
4971 build_string ("Undefined color"));
4973 init_x_parm_symbols ();
4975 DEFVAR_LISP ("x-bitmap-file-path", &Vx_bitmap_file_path
,
4976 "List of directories to search for bitmap files for X.");
4977 Vx_bitmap_file_path
= decode_env_path ((char *) 0, PATH_BITMAPS
);
4979 DEFVAR_LISP ("x-pointer-shape", &Vx_pointer_shape
,
4980 "The shape of the pointer when over text.\n\
4981 Changing the value does not affect existing frames\n\
4982 unless you set the mouse color.");
4983 Vx_pointer_shape
= Qnil
;
4985 DEFVAR_LISP ("x-resource-name", &Vx_resource_name
,
4986 "The name Emacs uses to look up X resources; for internal use only.\n\
4987 `x-get-resource' uses this as the first component of the instance name\n\
4988 when requesting resource values.\n\
4989 Emacs initially sets `x-resource-name' to the name under which Emacs\n\
4990 was invoked, or to the value specified with the `-name' or `-rn'\n\
4991 switches, if present.");
4992 Vx_resource_name
= Qnil
;
4994 #if 0 /* This doesn't really do anything. */
4995 DEFVAR_INT ("x-nontext-pointer-shape", &Vx_nontext_pointer_shape
,
4996 "The shape of the pointer when not over text.\n\
4997 This variable takes effect when you create a new frame\n\
4998 or when you set the mouse color.");
5000 Vx_nontext_pointer_shape
= Qnil
;
5002 #if 0 /* This doesn't really do anything. */
5003 DEFVAR_INT ("x-mode-pointer-shape", &Vx_mode_pointer_shape
,
5004 "The shape of the pointer when over the mode line.\n\
5005 This variable takes effect when you create a new frame\n\
5006 or when you set the mouse color.");
5008 Vx_mode_pointer_shape
= Qnil
;
5010 DEFVAR_INT ("x-sensitive-text-pointer-shape",
5011 &Vx_sensitive_text_pointer_shape
,
5012 "The shape of the pointer when over mouse-sensitive text.\n\
5013 This variable takes effect when you create a new frame\n\
5014 or when you set the mouse color.");
5015 Vx_sensitive_text_pointer_shape
= Qnil
;
5017 DEFVAR_LISP ("x-cursor-fore-pixel", &Vx_cursor_fore_pixel
,
5018 "A string indicating the foreground color of the cursor box.");
5019 Vx_cursor_fore_pixel
= Qnil
;
5021 DEFVAR_LISP ("x-no-window-manager", &Vx_no_window_manager
,
5022 "Non-nil if no X window manager is in use.\n\
5023 Emacs doesn't try to figure this out; this is always nil\n\
5024 unless you set it to something else.");
5025 /* We don't have any way to find this out, so set it to nil
5026 and maybe the user would like to set it to t. */
5027 Vx_no_window_manager
= Qnil
;
5029 #ifdef USE_X_TOOLKIT
5030 Fprovide (intern ("x-toolkit"));
5033 Fprovide (intern ("motif"));
5036 defsubr (&Sx_get_resource
);
5038 defsubr (&Sx_draw_rectangle
);
5039 defsubr (&Sx_erase_rectangle
);
5040 defsubr (&Sx_contour_region
);
5041 defsubr (&Sx_uncontour_region
);
5043 defsubr (&Sx_list_fonts
);
5044 defsubr (&Sx_display_color_p
);
5045 defsubr (&Sx_display_grayscale_p
);
5046 defsubr (&Sx_color_defined_p
);
5047 defsubr (&Sx_color_values
);
5048 defsubr (&Sx_server_max_request_size
);
5049 defsubr (&Sx_server_vendor
);
5050 defsubr (&Sx_server_version
);
5051 defsubr (&Sx_display_pixel_width
);
5052 defsubr (&Sx_display_pixel_height
);
5053 defsubr (&Sx_display_mm_width
);
5054 defsubr (&Sx_display_mm_height
);
5055 defsubr (&Sx_display_screens
);
5056 defsubr (&Sx_display_planes
);
5057 defsubr (&Sx_display_color_cells
);
5058 defsubr (&Sx_display_visual_class
);
5059 defsubr (&Sx_display_backing_store
);
5060 defsubr (&Sx_display_save_under
);
5062 defsubr (&Sx_rebind_key
);
5063 defsubr (&Sx_rebind_keys
);
5064 defsubr (&Sx_track_pointer
);
5065 defsubr (&Sx_grab_pointer
);
5066 defsubr (&Sx_ungrab_pointer
);
5068 defsubr (&Sx_parse_geometry
);
5069 defsubr (&Sx_create_frame
);
5070 defsubr (&Sfocus_frame
);
5071 defsubr (&Sunfocus_frame
);
5073 defsubr (&Sx_horizontal_line
);
5075 defsubr (&Sx_open_connection
);
5076 defsubr (&Sx_close_connection
);
5077 defsubr (&Sx_display_list
);
5078 defsubr (&Sx_synchronize
);
5081 #endif /* HAVE_X_WINDOWS */