1 /* Functions for the X window system.
2 Copyright (C) 1989, 1992, 1993, 1994, 1995, 1996 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
47 #define X_I18N_INHIBITED
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 extern 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
;
172 Lisp_Object Qforeground_color
;
173 Lisp_Object Qgeometry
;
174 Lisp_Object Qicon_left
;
175 Lisp_Object Qicon_top
;
176 Lisp_Object Qicon_type
;
177 Lisp_Object Qicon_name
;
178 Lisp_Object Qinternal_border_width
;
180 Lisp_Object Qmouse_color
;
182 Lisp_Object Qparent_id
;
183 Lisp_Object Qscroll_bar_width
;
184 Lisp_Object Qsuppress_icon
;
186 Lisp_Object Qundefined_color
;
187 Lisp_Object Qvertical_scroll_bars
;
188 Lisp_Object Qvisibility
;
189 Lisp_Object Qwindow_id
;
190 Lisp_Object Qx_frame_parameter
;
191 Lisp_Object Qx_resource_name
;
192 Lisp_Object Quser_position
;
193 Lisp_Object Quser_size
;
194 Lisp_Object Qdisplay
;
196 /* The below are defined in frame.c. */
197 extern Lisp_Object Qheight
, Qminibuffer
, Qname
, Qonly
, Qwidth
;
198 extern Lisp_Object Qunsplittable
, Qmenu_bar_lines
, Qbuffer_predicate
, Qtitle
;
200 extern Lisp_Object Vwindow_system_version
;
203 /* Error if we are not connected to X. */
208 error ("X windows are not in use or not initialized");
211 /* Nonzero if we can use mouse menus.
212 You should not call this unless HAVE_MENUS is defined. */
220 /* Extract a frame as a FRAME_PTR, defaulting to the selected frame
221 and checking validity for X. */
224 check_x_frame (frame
)
233 CHECK_LIVE_FRAME (frame
, 0);
237 error ("Non-X frame used");
241 /* Let the user specify an X display with a frame.
242 nil stands for the selected frame--or, if that is not an X frame,
243 the first X display on the list. */
245 static struct x_display_info
*
246 check_x_display_info (frame
)
251 if (FRAME_X_P (selected_frame
))
252 return FRAME_X_DISPLAY_INFO (selected_frame
);
253 else if (x_display_list
!= 0)
254 return x_display_list
;
256 error ("X windows are not in use or not initialized");
258 else if (STRINGP (frame
))
259 return x_display_info_for_name (frame
);
264 CHECK_LIVE_FRAME (frame
, 0);
267 error ("Non-X frame used");
268 return FRAME_X_DISPLAY_INFO (f
);
272 /* Return the Emacs frame-object corresponding to an X window.
273 It could be the frame's main window or an icon window. */
275 /* This function can be called during GC, so use GC_xxx type test macros. */
278 x_window_to_frame (dpyinfo
, wdesc
)
279 struct x_display_info
*dpyinfo
;
282 Lisp_Object tail
, frame
;
285 for (tail
= Vframe_list
; GC_CONSP (tail
); tail
= XCONS (tail
)->cdr
)
287 frame
= XCONS (tail
)->car
;
288 if (!GC_FRAMEP (frame
))
291 if (f
->output_data
.nothing
== 1 || FRAME_X_DISPLAY_INFO (f
) != dpyinfo
)
294 if ((f
->output_data
.x
->edit_widget
295 && XtWindow (f
->output_data
.x
->edit_widget
) == wdesc
)
296 || f
->output_data
.x
->icon_desc
== wdesc
)
298 #else /* not USE_X_TOOLKIT */
299 if (FRAME_X_WINDOW (f
) == wdesc
300 || f
->output_data
.x
->icon_desc
== wdesc
)
302 #endif /* not USE_X_TOOLKIT */
308 /* Like x_window_to_frame but also compares the window with the widget's
312 x_any_window_to_frame (dpyinfo
, wdesc
)
313 struct x_display_info
*dpyinfo
;
316 Lisp_Object tail
, frame
;
320 for (tail
= Vframe_list
; GC_CONSP (tail
); tail
= XCONS (tail
)->cdr
)
322 frame
= XCONS (tail
)->car
;
323 if (!GC_FRAMEP (frame
))
326 if (f
->output_data
.nothing
== 1 || FRAME_X_DISPLAY_INFO (f
) != dpyinfo
)
328 x
= f
->output_data
.x
;
329 /* This frame matches if the window is any of its widgets. */
330 if (wdesc
== XtWindow (x
->widget
)
331 || wdesc
== XtWindow (x
->column_widget
)
332 || wdesc
== XtWindow (x
->edit_widget
))
334 /* Match if the window is this frame's menubar. */
335 if (lw_window_is_in_menubar (wdesc
, x
->menubar_widget
))
341 /* Likewise, but exclude the menu bar widget. */
344 x_non_menubar_window_to_frame (dpyinfo
, wdesc
)
345 struct x_display_info
*dpyinfo
;
348 Lisp_Object tail
, frame
;
352 for (tail
= Vframe_list
; GC_CONSP (tail
); tail
= XCONS (tail
)->cdr
)
354 frame
= XCONS (tail
)->car
;
355 if (!GC_FRAMEP (frame
))
358 if (f
->output_data
.nothing
== 1 || FRAME_X_DISPLAY_INFO (f
) != dpyinfo
)
360 x
= f
->output_data
.x
;
361 /* This frame matches if the window is any of its widgets. */
362 if (wdesc
== XtWindow (x
->widget
)
363 || wdesc
== XtWindow (x
->column_widget
)
364 || wdesc
== XtWindow (x
->edit_widget
))
370 /* Likewise, but consider only the menu bar widget. */
373 x_menubar_window_to_frame (dpyinfo
, wdesc
)
374 struct x_display_info
*dpyinfo
;
377 Lisp_Object tail
, frame
;
381 for (tail
= Vframe_list
; GC_CONSP (tail
); tail
= XCONS (tail
)->cdr
)
383 frame
= XCONS (tail
)->car
;
384 if (!GC_FRAMEP (frame
))
387 if (f
->output_data
.nothing
== 1 || FRAME_X_DISPLAY_INFO (f
) != dpyinfo
)
389 x
= f
->output_data
.x
;
390 /* Match if the window is this frame's menubar. */
391 if (lw_window_is_in_menubar (wdesc
, x
->menubar_widget
))
397 /* Return the frame whose principal (outermost) window is WDESC.
398 If WDESC is some other (smaller) window, we return 0. */
401 x_top_window_to_frame (dpyinfo
, wdesc
)
402 struct x_display_info
*dpyinfo
;
405 Lisp_Object tail
, frame
;
409 for (tail
= Vframe_list
; GC_CONSP (tail
); tail
= XCONS (tail
)->cdr
)
411 frame
= XCONS (tail
)->car
;
412 if (!GC_FRAMEP (frame
))
415 if (f
->output_data
.nothing
== 1 || FRAME_X_DISPLAY_INFO (f
) != dpyinfo
)
417 x
= f
->output_data
.x
;
418 /* This frame matches if the window is its topmost widget. */
419 if (wdesc
== XtWindow (x
->widget
))
421 #if 0 /* I don't know why it did this,
422 but it seems logically wrong,
423 and it causes trouble for MapNotify events. */
424 /* Match if the window is this frame's menubar. */
425 if (x
->menubar_widget
426 && wdesc
== XtWindow (x
->menubar_widget
))
432 #endif /* USE_X_TOOLKIT */
436 /* Code to deal with bitmaps. Bitmaps are referenced by their bitmap
437 id, which is just an int that this section returns. Bitmaps are
438 reference counted so they can be shared among frames.
440 Bitmap indices are guaranteed to be > 0, so a negative number can
441 be used to indicate no bitmap.
443 If you use x_create_bitmap_from_data, then you must keep track of
444 the bitmaps yourself. That is, creating a bitmap from the same
445 data more than once will not be caught. */
448 /* Functions to access the contents of a bitmap, given an id. */
451 x_bitmap_height (f
, id
)
455 return FRAME_X_DISPLAY_INFO (f
)->bitmaps
[id
- 1].height
;
459 x_bitmap_width (f
, id
)
463 return FRAME_X_DISPLAY_INFO (f
)->bitmaps
[id
- 1].width
;
467 x_bitmap_pixmap (f
, id
)
471 return FRAME_X_DISPLAY_INFO (f
)->bitmaps
[id
- 1].pixmap
;
475 /* Allocate a new bitmap record. Returns index of new record. */
478 x_allocate_bitmap_record (f
)
481 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
484 if (dpyinfo
->bitmaps
== NULL
)
486 dpyinfo
->bitmaps_size
= 10;
488 = (struct x_bitmap_record
*) xmalloc (dpyinfo
->bitmaps_size
* sizeof (struct x_bitmap_record
));
489 dpyinfo
->bitmaps_last
= 1;
493 if (dpyinfo
->bitmaps_last
< dpyinfo
->bitmaps_size
)
494 return ++dpyinfo
->bitmaps_last
;
496 for (i
= 0; i
< dpyinfo
->bitmaps_size
; ++i
)
497 if (dpyinfo
->bitmaps
[i
].refcount
== 0)
500 dpyinfo
->bitmaps_size
*= 2;
502 = (struct x_bitmap_record
*) xrealloc (dpyinfo
->bitmaps
,
503 dpyinfo
->bitmaps_size
* sizeof (struct x_bitmap_record
));
504 return ++dpyinfo
->bitmaps_last
;
507 /* Add one reference to the reference count of the bitmap with id ID. */
510 x_reference_bitmap (f
, id
)
514 ++FRAME_X_DISPLAY_INFO (f
)->bitmaps
[id
- 1].refcount
;
517 /* Create a bitmap for frame F from a HEIGHT x WIDTH array of bits at BITS. */
520 x_create_bitmap_from_data (f
, bits
, width
, height
)
523 unsigned int width
, height
;
525 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
529 bitmap
= XCreateBitmapFromData (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
530 bits
, width
, height
);
535 id
= x_allocate_bitmap_record (f
);
536 dpyinfo
->bitmaps
[id
- 1].pixmap
= bitmap
;
537 dpyinfo
->bitmaps
[id
- 1].file
= NULL
;
538 dpyinfo
->bitmaps
[id
- 1].refcount
= 1;
539 dpyinfo
->bitmaps
[id
- 1].depth
= 1;
540 dpyinfo
->bitmaps
[id
- 1].height
= height
;
541 dpyinfo
->bitmaps
[id
- 1].width
= width
;
546 /* Create bitmap from file FILE for frame F. */
549 x_create_bitmap_from_file (f
, file
)
553 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
554 unsigned int width
, height
;
556 int xhot
, yhot
, result
, id
;
561 /* Look for an existing bitmap with the same name. */
562 for (id
= 0; id
< dpyinfo
->bitmaps_last
; ++id
)
564 if (dpyinfo
->bitmaps
[id
].refcount
565 && dpyinfo
->bitmaps
[id
].file
566 && !strcmp (dpyinfo
->bitmaps
[id
].file
, (char *) XSTRING (file
)->data
))
568 ++dpyinfo
->bitmaps
[id
].refcount
;
573 /* Search bitmap-file-path for the file, if appropriate. */
574 fd
= openp (Vx_bitmap_file_path
, file
, "", &found
, 0);
579 filename
= (char *) XSTRING (found
)->data
;
581 result
= XReadBitmapFile (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
582 filename
, &width
, &height
, &bitmap
, &xhot
, &yhot
);
583 if (result
!= BitmapSuccess
)
586 id
= x_allocate_bitmap_record (f
);
587 dpyinfo
->bitmaps
[id
- 1].pixmap
= bitmap
;
588 dpyinfo
->bitmaps
[id
- 1].refcount
= 1;
589 dpyinfo
->bitmaps
[id
- 1].file
= (char *) xmalloc (XSTRING (file
)->size
+ 1);
590 dpyinfo
->bitmaps
[id
- 1].depth
= 1;
591 dpyinfo
->bitmaps
[id
- 1].height
= height
;
592 dpyinfo
->bitmaps
[id
- 1].width
= width
;
593 strcpy (dpyinfo
->bitmaps
[id
- 1].file
, XSTRING (file
)->data
);
598 /* Remove reference to bitmap with id number ID. */
601 x_destroy_bitmap (f
, id
)
605 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
609 --dpyinfo
->bitmaps
[id
- 1].refcount
;
610 if (dpyinfo
->bitmaps
[id
- 1].refcount
== 0)
613 XFreePixmap (FRAME_X_DISPLAY (f
), dpyinfo
->bitmaps
[id
- 1].pixmap
);
614 if (dpyinfo
->bitmaps
[id
- 1].file
)
616 free (dpyinfo
->bitmaps
[id
- 1].file
);
617 dpyinfo
->bitmaps
[id
- 1].file
= NULL
;
624 /* Free all the bitmaps for the display specified by DPYINFO. */
627 x_destroy_all_bitmaps (dpyinfo
)
628 struct x_display_info
*dpyinfo
;
631 for (i
= 0; i
< dpyinfo
->bitmaps_last
; i
++)
632 if (dpyinfo
->bitmaps
[i
].refcount
> 0)
634 XFreePixmap (dpyinfo
->display
, dpyinfo
->bitmaps
[i
].pixmap
);
635 if (dpyinfo
->bitmaps
[i
].file
)
636 free (dpyinfo
->bitmaps
[i
].file
);
638 dpyinfo
->bitmaps_last
= 0;
641 /* Connect the frame-parameter names for X frames
642 to the ways of passing the parameter values to the window system.
644 The name of a parameter, as a Lisp symbol,
645 has an `x-frame-parameter' property which is an integer in Lisp
646 that is an index in this table. */
648 struct x_frame_parm_table
651 void (*setter
)( /* struct frame *frame, Lisp_Object val, oldval */ );
654 void x_set_foreground_color ();
655 void x_set_background_color ();
656 void x_set_mouse_color ();
657 void x_set_cursor_color ();
658 void x_set_border_color ();
659 void x_set_cursor_type ();
660 void x_set_icon_type ();
661 void x_set_icon_name ();
663 void x_set_border_width ();
664 void x_set_internal_border_width ();
665 void x_explicitly_set_name ();
666 void x_set_autoraise ();
667 void x_set_autolower ();
668 void x_set_vertical_scroll_bars ();
669 void x_set_visibility ();
670 void x_set_menu_bar_lines ();
671 void x_set_scroll_bar_width ();
673 void x_set_unsplittable ();
675 static struct x_frame_parm_table x_frame_parms
[] =
677 "auto-raise", x_set_autoraise
,
678 "auto-lower", x_set_autolower
,
679 "background-color", x_set_background_color
,
680 "border-color", x_set_border_color
,
681 "border-width", x_set_border_width
,
682 "cursor-color", x_set_cursor_color
,
683 "cursor-type", x_set_cursor_type
,
685 "foreground-color", x_set_foreground_color
,
686 "icon-name", x_set_icon_name
,
687 "icon-type", x_set_icon_type
,
688 "internal-border-width", x_set_internal_border_width
,
689 "menu-bar-lines", x_set_menu_bar_lines
,
690 "mouse-color", x_set_mouse_color
,
691 "name", x_explicitly_set_name
,
692 "scroll-bar-width", x_set_scroll_bar_width
,
693 "title", x_set_title
,
694 "unsplittable", x_set_unsplittable
,
695 "vertical-scroll-bars", x_set_vertical_scroll_bars
,
696 "visibility", x_set_visibility
,
699 /* Attach the `x-frame-parameter' properties to
700 the Lisp symbol names of parameters relevant to X. */
702 init_x_parm_symbols ()
706 for (i
= 0; i
< sizeof (x_frame_parms
) / sizeof (x_frame_parms
[0]); i
++)
707 Fput (intern (x_frame_parms
[i
].name
), Qx_frame_parameter
,
711 /* Change the parameters of FRAME as specified by ALIST.
712 If a parameter is not specially recognized, do nothing;
713 otherwise call the `x_set_...' function for that parameter. */
716 x_set_frame_parameters (f
, alist
)
722 /* If both of these parameters are present, it's more efficient to
723 set them both at once. So we wait until we've looked at the
724 entire list before we set them. */
725 Lisp_Object width
, height
;
728 Lisp_Object left
, top
;
730 /* Same with these. */
731 Lisp_Object icon_left
, icon_top
;
733 /* Record in these vectors all the parms specified. */
737 int left_no_change
= 0, top_no_change
= 0;
738 int icon_left_no_change
= 0, icon_top_no_change
= 0;
741 for (tail
= alist
; CONSP (tail
); tail
= Fcdr (tail
))
744 parms
= (Lisp_Object
*) alloca (i
* sizeof (Lisp_Object
));
745 values
= (Lisp_Object
*) alloca (i
* sizeof (Lisp_Object
));
747 /* Extract parm names and values into those vectors. */
750 for (tail
= alist
; CONSP (tail
); tail
= Fcdr (tail
))
752 Lisp_Object elt
, prop
, val
;
755 parms
[i
] = Fcar (elt
);
756 values
[i
] = Fcdr (elt
);
760 width
= height
= top
= left
= Qunbound
;
761 icon_left
= icon_top
= Qunbound
;
763 /* Now process them in reverse of specified order. */
764 for (i
--; i
>= 0; i
--)
766 Lisp_Object prop
, val
;
771 if (EQ (prop
, Qwidth
))
773 else if (EQ (prop
, Qheight
))
775 else if (EQ (prop
, Qtop
))
777 else if (EQ (prop
, Qleft
))
779 else if (EQ (prop
, Qicon_top
))
781 else if (EQ (prop
, Qicon_left
))
785 register Lisp_Object param_index
, old_value
;
787 param_index
= Fget (prop
, Qx_frame_parameter
);
788 old_value
= get_frame_param (f
, prop
);
789 store_frame_param (f
, prop
, val
);
790 if (NATNUMP (param_index
)
791 && (XFASTINT (param_index
)
792 < sizeof (x_frame_parms
)/sizeof (x_frame_parms
[0])))
793 (*x_frame_parms
[XINT (param_index
)].setter
)(f
, val
, old_value
);
797 /* Don't die if just one of these was set. */
798 if (EQ (left
, Qunbound
))
801 if (f
->output_data
.x
->left_pos
< 0)
802 left
= Fcons (Qplus
, Fcons (make_number (f
->output_data
.x
->left_pos
), Qnil
));
804 XSETINT (left
, f
->output_data
.x
->left_pos
);
806 if (EQ (top
, Qunbound
))
809 if (f
->output_data
.x
->top_pos
< 0)
810 top
= Fcons (Qplus
, Fcons (make_number (f
->output_data
.x
->top_pos
), Qnil
));
812 XSETINT (top
, f
->output_data
.x
->top_pos
);
815 /* If one of the icon positions was not set, preserve or default it. */
816 if (EQ (icon_left
, Qunbound
) || ! INTEGERP (icon_left
))
818 icon_left_no_change
= 1;
819 icon_left
= Fcdr (Fassq (Qicon_left
, f
->param_alist
));
820 if (NILP (icon_left
))
821 XSETINT (icon_left
, 0);
823 if (EQ (icon_top
, Qunbound
) || ! INTEGERP (icon_top
))
825 icon_top_no_change
= 1;
826 icon_top
= Fcdr (Fassq (Qicon_top
, f
->param_alist
));
828 XSETINT (icon_top
, 0);
831 /* Don't die if just one of these was set. */
832 if (EQ (width
, Qunbound
))
834 if (FRAME_NEW_WIDTH (f
))
835 XSETINT (width
, FRAME_NEW_WIDTH (f
));
837 XSETINT (width
, FRAME_WIDTH (f
));
839 if (EQ (height
, Qunbound
))
841 if (FRAME_NEW_HEIGHT (f
))
842 XSETINT (height
, FRAME_NEW_HEIGHT (f
));
844 XSETINT (height
, FRAME_HEIGHT (f
));
847 /* Don't set these parameters unless they've been explicitly
848 specified. The window might be mapped or resized while we're in
849 this function, and we don't want to override that unless the lisp
850 code has asked for it.
852 Don't set these parameters unless they actually differ from the
853 window's current parameters; the window may not actually exist
858 check_frame_size (f
, &height
, &width
);
860 XSETFRAME (frame
, f
);
862 if ((NUMBERP (width
) && XINT (width
) != FRAME_WIDTH (f
))
863 || (NUMBERP (height
) && XINT (height
) != FRAME_HEIGHT (f
))
864 || FRAME_NEW_HEIGHT (f
) || FRAME_NEW_WIDTH (f
))
865 Fset_frame_size (frame
, width
, height
);
867 if ((!NILP (left
) || !NILP (top
))
868 && ! (left_no_change
&& top_no_change
)
869 && ! (NUMBERP (left
) && XINT (left
) == f
->output_data
.x
->left_pos
870 && NUMBERP (top
) && XINT (top
) == f
->output_data
.x
->top_pos
))
875 /* Record the signs. */
876 f
->output_data
.x
->size_hint_flags
&= ~ (XNegative
| YNegative
);
877 if (EQ (left
, Qminus
))
878 f
->output_data
.x
->size_hint_flags
|= XNegative
;
879 else if (INTEGERP (left
))
881 leftpos
= XINT (left
);
883 f
->output_data
.x
->size_hint_flags
|= XNegative
;
885 else if (CONSP (left
) && EQ (XCONS (left
)->car
, Qminus
)
886 && CONSP (XCONS (left
)->cdr
)
887 && INTEGERP (XCONS (XCONS (left
)->cdr
)->car
))
889 leftpos
= - XINT (XCONS (XCONS (left
)->cdr
)->car
);
890 f
->output_data
.x
->size_hint_flags
|= XNegative
;
892 else if (CONSP (left
) && EQ (XCONS (left
)->car
, Qplus
)
893 && CONSP (XCONS (left
)->cdr
)
894 && INTEGERP (XCONS (XCONS (left
)->cdr
)->car
))
896 leftpos
= XINT (XCONS (XCONS (left
)->cdr
)->car
);
899 if (EQ (top
, Qminus
))
900 f
->output_data
.x
->size_hint_flags
|= YNegative
;
901 else if (INTEGERP (top
))
905 f
->output_data
.x
->size_hint_flags
|= YNegative
;
907 else if (CONSP (top
) && EQ (XCONS (top
)->car
, Qminus
)
908 && CONSP (XCONS (top
)->cdr
)
909 && INTEGERP (XCONS (XCONS (top
)->cdr
)->car
))
911 toppos
= - XINT (XCONS (XCONS (top
)->cdr
)->car
);
912 f
->output_data
.x
->size_hint_flags
|= YNegative
;
914 else if (CONSP (top
) && EQ (XCONS (top
)->car
, Qplus
)
915 && CONSP (XCONS (top
)->cdr
)
916 && INTEGERP (XCONS (XCONS (top
)->cdr
)->car
))
918 toppos
= XINT (XCONS (XCONS (top
)->cdr
)->car
);
922 /* Store the numeric value of the position. */
923 f
->output_data
.x
->top_pos
= toppos
;
924 f
->output_data
.x
->left_pos
= leftpos
;
926 f
->output_data
.x
->win_gravity
= NorthWestGravity
;
928 /* Actually set that position, and convert to absolute. */
929 x_set_offset (f
, leftpos
, toppos
, -1);
932 if ((!NILP (icon_left
) || !NILP (icon_top
))
933 && ! (icon_left_no_change
&& icon_top_no_change
))
934 x_wm_set_icon_position (f
, XINT (icon_left
), XINT (icon_top
));
938 /* Store the screen positions of frame F into XPTR and YPTR.
939 These are the positions of the containing window manager window,
940 not Emacs's own window. */
943 x_real_positions (f
, xptr
, yptr
)
950 /* This is pretty gross, but seems to be the easiest way out of
951 the problem that arises when restarting window-managers. */
954 Window outer
= XtWindow (f
->output_data
.x
->widget
);
956 Window outer
= f
->output_data
.x
->window_desc
;
958 Window tmp_root_window
;
959 Window
*tmp_children
;
964 x_catch_errors (FRAME_X_DISPLAY (f
));
966 XQueryTree (FRAME_X_DISPLAY (f
), outer
, &tmp_root_window
,
967 &f
->output_data
.x
->parent_desc
,
968 &tmp_children
, &tmp_nchildren
);
969 XFree ((char *) tmp_children
);
973 /* Find the position of the outside upper-left corner of
974 the inner window, with respect to the outer window. */
975 if (f
->output_data
.x
->parent_desc
!= FRAME_X_DISPLAY_INFO (f
)->root_window
)
977 XTranslateCoordinates (FRAME_X_DISPLAY (f
),
979 /* From-window, to-window. */
981 XtWindow (f
->output_data
.x
->widget
),
983 f
->output_data
.x
->window_desc
,
985 f
->output_data
.x
->parent_desc
,
987 /* From-position, to-position. */
988 0, 0, &win_x
, &win_y
,
993 #if 0 /* The values seem to be right without this and wrong with. */
994 win_x
+= f
->output_data
.x
->border_width
;
995 win_y
+= f
->output_data
.x
->border_width
;
999 /* It is possible for the window returned by the XQueryNotify
1000 to become invalid by the time we call XTranslateCoordinates.
1001 That can happen when you restart some window managers.
1002 If so, we get an error in XTranslateCoordinates.
1003 Detect that and try the whole thing over. */
1004 if (! x_had_errors_p (FRAME_X_DISPLAY (f
)))
1006 x_uncatch_errors (FRAME_X_DISPLAY (f
));
1010 x_uncatch_errors (FRAME_X_DISPLAY (f
));
1013 *xptr
= f
->output_data
.x
->left_pos
- win_x
;
1014 *yptr
= f
->output_data
.x
->top_pos
- win_y
;
1017 /* Insert a description of internally-recorded parameters of frame X
1018 into the parameter alist *ALISTPTR that is to be given to the user.
1019 Only parameters that are specific to the X window system
1020 and whose values are not correctly recorded in the frame's
1021 param_alist need to be considered here. */
1023 x_report_frame_params (f
, alistptr
)
1025 Lisp_Object
*alistptr
;
1030 /* Represent negative positions (off the top or left screen edge)
1031 in a way that Fmodify_frame_parameters will understand correctly. */
1032 XSETINT (tem
, f
->output_data
.x
->left_pos
);
1033 if (f
->output_data
.x
->left_pos
>= 0)
1034 store_in_alist (alistptr
, Qleft
, tem
);
1036 store_in_alist (alistptr
, Qleft
, Fcons (Qplus
, Fcons (tem
, Qnil
)));
1038 XSETINT (tem
, f
->output_data
.x
->top_pos
);
1039 if (f
->output_data
.x
->top_pos
>= 0)
1040 store_in_alist (alistptr
, Qtop
, tem
);
1042 store_in_alist (alistptr
, Qtop
, Fcons (Qplus
, Fcons (tem
, Qnil
)));
1044 store_in_alist (alistptr
, Qborder_width
,
1045 make_number (f
->output_data
.x
->border_width
));
1046 store_in_alist (alistptr
, Qinternal_border_width
,
1047 make_number (f
->output_data
.x
->internal_border_width
));
1048 sprintf (buf
, "%ld", (long) FRAME_X_WINDOW (f
));
1049 store_in_alist (alistptr
, Qwindow_id
,
1050 build_string (buf
));
1051 store_in_alist (alistptr
, Qicon_name
, f
->icon_name
);
1052 FRAME_SAMPLE_VISIBILITY (f
);
1053 store_in_alist (alistptr
, Qvisibility
,
1054 (FRAME_VISIBLE_P (f
) ? Qt
1055 : FRAME_ICONIFIED_P (f
) ? Qicon
: Qnil
));
1056 store_in_alist (alistptr
, Qdisplay
,
1057 XCONS (FRAME_X_DISPLAY_INFO (f
)->name_list_element
)->car
);
1061 /* Decide if color named COLOR is valid for the display associated with
1062 the selected frame; if so, return the rgb values in COLOR_DEF.
1063 If ALLOC is nonzero, allocate a new colormap cell. */
1066 defined_color (f
, color
, color_def
, alloc
)
1072 register int status
;
1073 Colormap screen_colormap
;
1074 Display
*display
= FRAME_X_DISPLAY (f
);
1077 screen_colormap
= DefaultColormap (display
, XDefaultScreen (display
));
1079 status
= XParseColor (display
, screen_colormap
, color
, color_def
);
1080 if (status
&& alloc
)
1082 status
= XAllocColor (display
, screen_colormap
, color_def
);
1085 /* If we got to this point, the colormap is full, so we're
1086 going to try and get the next closest color.
1087 The algorithm used is a least-squares matching, which is
1088 what X uses for closest color matching with StaticColor visuals. */
1093 long nearest_delta
, trial_delta
;
1096 no_cells
= XDisplayCells (display
, XDefaultScreen (display
));
1097 cells
= (XColor
*) alloca (sizeof (XColor
) * no_cells
);
1099 for (x
= 0; x
< no_cells
; x
++)
1102 XQueryColors (display
, screen_colormap
, cells
, no_cells
);
1104 /* I'm assuming CSE so I'm not going to condense this. */
1105 nearest_delta
= ((((color_def
->red
>> 8) - (cells
[0].red
>> 8))
1106 * ((color_def
->red
>> 8) - (cells
[0].red
>> 8)))
1108 (((color_def
->green
>> 8) - (cells
[0].green
>> 8))
1109 * ((color_def
->green
>> 8) - (cells
[0].green
>> 8)))
1111 (((color_def
->blue
>> 8) - (cells
[0].blue
>> 8))
1112 * ((color_def
->blue
>> 8) - (cells
[0].blue
>> 8))));
1113 for (x
= 1; x
< no_cells
; x
++)
1115 trial_delta
= ((((color_def
->red
>> 8) - (cells
[x
].red
>> 8))
1116 * ((color_def
->red
>> 8) - (cells
[x
].red
>> 8)))
1118 (((color_def
->green
>> 8) - (cells
[x
].green
>> 8))
1119 * ((color_def
->green
>> 8) - (cells
[x
].green
>> 8)))
1121 (((color_def
->blue
>> 8) - (cells
[x
].blue
>> 8))
1122 * ((color_def
->blue
>> 8) - (cells
[x
].blue
>> 8))));
1123 if (trial_delta
< nearest_delta
)
1126 temp
.red
= cells
[x
].red
;
1127 temp
.green
= cells
[x
].green
;
1128 temp
.blue
= cells
[x
].blue
;
1129 status
= XAllocColor (display
, screen_colormap
, &temp
);
1133 nearest_delta
= trial_delta
;
1137 color_def
->red
= cells
[nearest
].red
;
1138 color_def
->green
= cells
[nearest
].green
;
1139 color_def
->blue
= cells
[nearest
].blue
;
1140 status
= XAllocColor (display
, screen_colormap
, color_def
);
1151 /* Given a string ARG naming a color, compute a pixel value from it
1152 suitable for screen F.
1153 If F is not a color screen, return DEF (default) regardless of what
1157 x_decode_color (f
, arg
, def
)
1164 CHECK_STRING (arg
, 0);
1166 if (strcmp (XSTRING (arg
)->data
, "black") == 0)
1167 return BLACK_PIX_DEFAULT (f
);
1168 else if (strcmp (XSTRING (arg
)->data
, "white") == 0)
1169 return WHITE_PIX_DEFAULT (f
);
1171 if (FRAME_X_DISPLAY_INFO (f
)->n_planes
== 1)
1174 /* defined_color is responsible for coping with failures
1175 by looking for a near-miss. */
1176 if (defined_color (f
, XSTRING (arg
)->data
, &cdef
, 1))
1179 Fsignal (Qerror
, Fcons (build_string ("undefined color"),
1180 Fcons (arg
, Qnil
)));
1183 /* Functions called only from `x_set_frame_param'
1184 to set individual parameters.
1186 If FRAME_X_WINDOW (f) is 0,
1187 the frame is being created and its X-window does not exist yet.
1188 In that case, just record the parameter's new value
1189 in the standard place; do not attempt to change the window. */
1192 x_set_foreground_color (f
, arg
, oldval
)
1194 Lisp_Object arg
, oldval
;
1196 f
->output_data
.x
->foreground_pixel
1197 = x_decode_color (f
, arg
, BLACK_PIX_DEFAULT (f
));
1198 if (FRAME_X_WINDOW (f
) != 0)
1201 XSetForeground (FRAME_X_DISPLAY (f
), f
->output_data
.x
->normal_gc
,
1202 f
->output_data
.x
->foreground_pixel
);
1203 XSetBackground (FRAME_X_DISPLAY (f
), f
->output_data
.x
->reverse_gc
,
1204 f
->output_data
.x
->foreground_pixel
);
1206 recompute_basic_faces (f
);
1207 if (FRAME_VISIBLE_P (f
))
1213 x_set_background_color (f
, arg
, oldval
)
1215 Lisp_Object arg
, oldval
;
1220 f
->output_data
.x
->background_pixel
1221 = x_decode_color (f
, arg
, WHITE_PIX_DEFAULT (f
));
1223 if (FRAME_X_WINDOW (f
) != 0)
1226 /* The main frame area. */
1227 XSetBackground (FRAME_X_DISPLAY (f
), f
->output_data
.x
->normal_gc
,
1228 f
->output_data
.x
->background_pixel
);
1229 XSetForeground (FRAME_X_DISPLAY (f
), f
->output_data
.x
->reverse_gc
,
1230 f
->output_data
.x
->background_pixel
);
1231 XSetForeground (FRAME_X_DISPLAY (f
), f
->output_data
.x
->cursor_gc
,
1232 f
->output_data
.x
->background_pixel
);
1233 XSetWindowBackground (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
1234 f
->output_data
.x
->background_pixel
);
1237 for (bar
= FRAME_SCROLL_BARS (f
); !NILP (bar
);
1238 bar
= XSCROLL_BAR (bar
)->next
)
1239 XSetWindowBackground (FRAME_X_DISPLAY (f
),
1240 SCROLL_BAR_X_WINDOW (XSCROLL_BAR (bar
)),
1241 f
->output_data
.x
->background_pixel
);
1245 recompute_basic_faces (f
);
1247 if (FRAME_VISIBLE_P (f
))
1253 x_set_mouse_color (f
, arg
, oldval
)
1255 Lisp_Object arg
, oldval
;
1257 Cursor cursor
, nontext_cursor
, mode_cursor
, cross_cursor
;
1260 if (!EQ (Qnil
, arg
))
1261 f
->output_data
.x
->mouse_pixel
1262 = x_decode_color (f
, arg
, BLACK_PIX_DEFAULT (f
));
1263 mask_color
= f
->output_data
.x
->background_pixel
;
1264 /* No invisible pointers. */
1265 if (mask_color
== f
->output_data
.x
->mouse_pixel
1266 && mask_color
== f
->output_data
.x
->background_pixel
)
1267 f
->output_data
.x
->mouse_pixel
= f
->output_data
.x
->foreground_pixel
;
1271 /* It's not okay to crash if the user selects a screwy cursor. */
1272 x_catch_errors (FRAME_X_DISPLAY (f
));
1274 if (!EQ (Qnil
, Vx_pointer_shape
))
1276 CHECK_NUMBER (Vx_pointer_shape
, 0);
1277 cursor
= XCreateFontCursor (FRAME_X_DISPLAY (f
), XINT (Vx_pointer_shape
));
1280 cursor
= XCreateFontCursor (FRAME_X_DISPLAY (f
), XC_xterm
);
1281 x_check_errors (FRAME_X_DISPLAY (f
), "bad text pointer cursor: %s");
1283 if (!EQ (Qnil
, Vx_nontext_pointer_shape
))
1285 CHECK_NUMBER (Vx_nontext_pointer_shape
, 0);
1286 nontext_cursor
= XCreateFontCursor (FRAME_X_DISPLAY (f
),
1287 XINT (Vx_nontext_pointer_shape
));
1290 nontext_cursor
= XCreateFontCursor (FRAME_X_DISPLAY (f
), XC_left_ptr
);
1291 x_check_errors (FRAME_X_DISPLAY (f
), "bad nontext pointer cursor: %s");
1293 if (!EQ (Qnil
, Vx_mode_pointer_shape
))
1295 CHECK_NUMBER (Vx_mode_pointer_shape
, 0);
1296 mode_cursor
= XCreateFontCursor (FRAME_X_DISPLAY (f
),
1297 XINT (Vx_mode_pointer_shape
));
1300 mode_cursor
= XCreateFontCursor (FRAME_X_DISPLAY (f
), XC_xterm
);
1301 x_check_errors (FRAME_X_DISPLAY (f
), "bad modeline pointer cursor: %s");
1303 if (!EQ (Qnil
, Vx_sensitive_text_pointer_shape
))
1305 CHECK_NUMBER (Vx_sensitive_text_pointer_shape
, 0);
1307 = XCreateFontCursor (FRAME_X_DISPLAY (f
),
1308 XINT (Vx_sensitive_text_pointer_shape
));
1311 cross_cursor
= XCreateFontCursor (FRAME_X_DISPLAY (f
), XC_crosshair
);
1313 /* Check and report errors with the above calls. */
1314 x_check_errors (FRAME_X_DISPLAY (f
), "can't set cursor shape: %s");
1315 x_uncatch_errors (FRAME_X_DISPLAY (f
));
1318 XColor fore_color
, back_color
;
1320 fore_color
.pixel
= f
->output_data
.x
->mouse_pixel
;
1321 back_color
.pixel
= mask_color
;
1322 XQueryColor (FRAME_X_DISPLAY (f
),
1323 DefaultColormap (FRAME_X_DISPLAY (f
),
1324 DefaultScreen (FRAME_X_DISPLAY (f
))),
1326 XQueryColor (FRAME_X_DISPLAY (f
),
1327 DefaultColormap (FRAME_X_DISPLAY (f
),
1328 DefaultScreen (FRAME_X_DISPLAY (f
))),
1330 XRecolorCursor (FRAME_X_DISPLAY (f
), cursor
,
1331 &fore_color
, &back_color
);
1332 XRecolorCursor (FRAME_X_DISPLAY (f
), nontext_cursor
,
1333 &fore_color
, &back_color
);
1334 XRecolorCursor (FRAME_X_DISPLAY (f
), mode_cursor
,
1335 &fore_color
, &back_color
);
1336 XRecolorCursor (FRAME_X_DISPLAY (f
), cross_cursor
,
1337 &fore_color
, &back_color
);
1340 if (FRAME_X_WINDOW (f
) != 0)
1342 XDefineCursor (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
), cursor
);
1345 if (cursor
!= f
->output_data
.x
->text_cursor
&& f
->output_data
.x
->text_cursor
!= 0)
1346 XFreeCursor (FRAME_X_DISPLAY (f
), f
->output_data
.x
->text_cursor
);
1347 f
->output_data
.x
->text_cursor
= cursor
;
1349 if (nontext_cursor
!= f
->output_data
.x
->nontext_cursor
1350 && f
->output_data
.x
->nontext_cursor
!= 0)
1351 XFreeCursor (FRAME_X_DISPLAY (f
), f
->output_data
.x
->nontext_cursor
);
1352 f
->output_data
.x
->nontext_cursor
= nontext_cursor
;
1354 if (mode_cursor
!= f
->output_data
.x
->modeline_cursor
1355 && f
->output_data
.x
->modeline_cursor
!= 0)
1356 XFreeCursor (FRAME_X_DISPLAY (f
), f
->output_data
.x
->modeline_cursor
);
1357 f
->output_data
.x
->modeline_cursor
= mode_cursor
;
1358 if (cross_cursor
!= f
->output_data
.x
->cross_cursor
1359 && f
->output_data
.x
->cross_cursor
!= 0)
1360 XFreeCursor (FRAME_X_DISPLAY (f
), f
->output_data
.x
->cross_cursor
);
1361 f
->output_data
.x
->cross_cursor
= cross_cursor
;
1363 XFlush (FRAME_X_DISPLAY (f
));
1368 x_set_cursor_color (f
, arg
, oldval
)
1370 Lisp_Object arg
, oldval
;
1372 unsigned long fore_pixel
;
1374 if (!EQ (Vx_cursor_fore_pixel
, Qnil
))
1375 fore_pixel
= x_decode_color (f
, Vx_cursor_fore_pixel
,
1376 WHITE_PIX_DEFAULT (f
));
1378 fore_pixel
= f
->output_data
.x
->background_pixel
;
1379 f
->output_data
.x
->cursor_pixel
= x_decode_color (f
, arg
, BLACK_PIX_DEFAULT (f
));
1381 /* Make sure that the cursor color differs from the background color. */
1382 if (f
->output_data
.x
->cursor_pixel
== f
->output_data
.x
->background_pixel
)
1384 f
->output_data
.x
->cursor_pixel
= f
->output_data
.x
->mouse_pixel
;
1385 if (f
->output_data
.x
->cursor_pixel
== fore_pixel
)
1386 fore_pixel
= f
->output_data
.x
->background_pixel
;
1388 f
->output_data
.x
->cursor_foreground_pixel
= fore_pixel
;
1390 if (FRAME_X_WINDOW (f
) != 0)
1393 XSetBackground (FRAME_X_DISPLAY (f
), f
->output_data
.x
->cursor_gc
,
1394 f
->output_data
.x
->cursor_pixel
);
1395 XSetForeground (FRAME_X_DISPLAY (f
), f
->output_data
.x
->cursor_gc
,
1399 if (FRAME_VISIBLE_P (f
))
1401 x_display_cursor (f
, 0);
1402 x_display_cursor (f
, 1);
1407 /* Set the border-color of frame F to value described by ARG.
1408 ARG can be a string naming a color.
1409 The border-color is used for the border that is drawn by the X server.
1410 Note that this does not fully take effect if done before
1411 F has an x-window; it must be redone when the window is created.
1413 Note: this is done in two routines because of the way X10 works.
1415 Note: under X11, this is normally the province of the window manager,
1416 and so emacs' border colors may be overridden. */
1419 x_set_border_color (f
, arg
, oldval
)
1421 Lisp_Object arg
, oldval
;
1426 CHECK_STRING (arg
, 0);
1427 str
= XSTRING (arg
)->data
;
1429 pix
= x_decode_color (f
, arg
, BLACK_PIX_DEFAULT (f
));
1431 x_set_border_pixel (f
, pix
);
1434 /* Set the border-color of frame F to pixel value PIX.
1435 Note that this does not fully take effect if done before
1436 F has an x-window. */
1438 x_set_border_pixel (f
, pix
)
1442 f
->output_data
.x
->border_pixel
= pix
;
1444 if (FRAME_X_WINDOW (f
) != 0 && f
->output_data
.x
->border_width
> 0)
1450 XSetWindowBorder (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
1451 (unsigned long)pix
);
1454 if (FRAME_VISIBLE_P (f
))
1460 x_set_cursor_type (f
, arg
, oldval
)
1462 Lisp_Object arg
, oldval
;
1466 FRAME_DESIRED_CURSOR (f
) = bar_cursor
;
1467 f
->output_data
.x
->cursor_width
= 2;
1469 else if (CONSP (arg
) && EQ (XCONS (arg
)->car
, Qbar
)
1470 && INTEGERP (XCONS (arg
)->cdr
))
1472 FRAME_DESIRED_CURSOR (f
) = bar_cursor
;
1473 f
->output_data
.x
->cursor_width
= XINT (XCONS (arg
)->cdr
);
1476 /* Treat anything unknown as "box cursor".
1477 It was bad to signal an error; people have trouble fixing
1478 .Xdefaults with Emacs, when it has something bad in it. */
1479 FRAME_DESIRED_CURSOR (f
) = filled_box_cursor
;
1481 /* Make sure the cursor gets redrawn. This is overkill, but how
1482 often do people change cursor types? */
1483 update_mode_lines
++;
1487 x_set_icon_type (f
, arg
, oldval
)
1489 Lisp_Object arg
, oldval
;
1496 if (STRINGP (oldval
) && EQ (Fstring_equal (oldval
, arg
), Qt
))
1499 else if (!STRINGP (oldval
) && EQ (oldval
, Qnil
) == EQ (arg
, Qnil
))
1504 result
= x_text_icon (f
,
1505 (char *) XSTRING ((!NILP (f
->icon_name
)
1509 result
= x_bitmap_icon (f
, arg
);
1514 error ("No icon window available");
1517 XFlush (FRAME_X_DISPLAY (f
));
1521 /* Return non-nil if frame F wants a bitmap icon. */
1529 tem
= assq_no_quit (Qicon_type
, f
->param_alist
);
1531 return XCONS (tem
)->cdr
;
1537 x_set_icon_name (f
, arg
, oldval
)
1539 Lisp_Object arg
, oldval
;
1546 if (STRINGP (oldval
) && EQ (Fstring_equal (oldval
, arg
), Qt
))
1549 else if (!STRINGP (oldval
) && EQ (oldval
, Qnil
) == EQ (arg
, Qnil
))
1554 if (f
->output_data
.x
->icon_bitmap
!= 0)
1559 result
= x_text_icon (f
,
1560 (char *) XSTRING ((!NILP (f
->icon_name
)
1569 error ("No icon window available");
1572 XFlush (FRAME_X_DISPLAY (f
));
1576 extern Lisp_Object
x_new_font ();
1579 x_set_font (f
, arg
, oldval
)
1581 Lisp_Object arg
, oldval
;
1585 CHECK_STRING (arg
, 1);
1588 result
= x_new_font (f
, XSTRING (arg
)->data
);
1591 if (EQ (result
, Qnil
))
1592 error ("Font `%s' is not defined", XSTRING (arg
)->data
);
1593 else if (EQ (result
, Qt
))
1594 error ("the characters of the given font have varying widths");
1595 else if (STRINGP (result
))
1597 recompute_basic_faces (f
);
1598 store_frame_param (f
, Qfont
, result
);
1605 x_set_border_width (f
, arg
, oldval
)
1607 Lisp_Object arg
, oldval
;
1609 CHECK_NUMBER (arg
, 0);
1611 if (XINT (arg
) == f
->output_data
.x
->border_width
)
1614 if (FRAME_X_WINDOW (f
) != 0)
1615 error ("Cannot change the border width of a window");
1617 f
->output_data
.x
->border_width
= XINT (arg
);
1621 x_set_internal_border_width (f
, arg
, oldval
)
1623 Lisp_Object arg
, oldval
;
1626 int old
= f
->output_data
.x
->internal_border_width
;
1628 CHECK_NUMBER (arg
, 0);
1629 f
->output_data
.x
->internal_border_width
= XINT (arg
);
1630 if (f
->output_data
.x
->internal_border_width
< 0)
1631 f
->output_data
.x
->internal_border_width
= 0;
1633 if (f
->output_data
.x
->internal_border_width
== old
)
1636 if (FRAME_X_WINDOW (f
) != 0)
1639 x_set_window_size (f
, 0, f
->width
, f
->height
);
1641 x_set_resize_hint (f
);
1643 XFlush (FRAME_X_DISPLAY (f
));
1645 SET_FRAME_GARBAGED (f
);
1650 x_set_visibility (f
, value
, oldval
)
1652 Lisp_Object value
, oldval
;
1655 XSETFRAME (frame
, f
);
1658 Fmake_frame_invisible (frame
, Qt
);
1659 else if (EQ (value
, Qicon
))
1660 Ficonify_frame (frame
);
1662 Fmake_frame_visible (frame
);
1666 x_set_menu_bar_lines_1 (window
, n
)
1670 struct window
*w
= XWINDOW (window
);
1672 XSETFASTINT (w
->top
, XFASTINT (w
->top
) + n
);
1673 XSETFASTINT (w
->height
, XFASTINT (w
->height
) - n
);
1675 /* Handle just the top child in a vertical split. */
1676 if (!NILP (w
->vchild
))
1677 x_set_menu_bar_lines_1 (w
->vchild
, n
);
1679 /* Adjust all children in a horizontal split. */
1680 for (window
= w
->hchild
; !NILP (window
); window
= w
->next
)
1682 w
= XWINDOW (window
);
1683 x_set_menu_bar_lines_1 (window
, n
);
1688 x_set_menu_bar_lines (f
, value
, oldval
)
1690 Lisp_Object value
, oldval
;
1693 int olines
= FRAME_MENU_BAR_LINES (f
);
1695 /* Right now, menu bars don't work properly in minibuf-only frames;
1696 most of the commands try to apply themselves to the minibuffer
1697 frame itslef, and get an error because you can't switch buffers
1698 in or split the minibuffer window. */
1699 if (FRAME_MINIBUF_ONLY_P (f
))
1702 if (INTEGERP (value
))
1703 nlines
= XINT (value
);
1707 #ifdef USE_X_TOOLKIT
1708 FRAME_MENU_BAR_LINES (f
) = 0;
1711 FRAME_EXTERNAL_MENU_BAR (f
) = 1;
1712 if (FRAME_X_P (f
) && f
->output_data
.x
->menubar_widget
== 0)
1713 /* Make sure next redisplay shows the menu bar. */
1714 XWINDOW (FRAME_SELECTED_WINDOW (f
))->update_mode_line
= Qt
;
1718 if (FRAME_EXTERNAL_MENU_BAR (f
) == 1)
1719 free_frame_menubar (f
);
1720 FRAME_EXTERNAL_MENU_BAR (f
) = 0;
1722 f
->output_data
.x
->menubar_widget
= 0;
1724 #else /* not USE_X_TOOLKIT */
1725 FRAME_MENU_BAR_LINES (f
) = nlines
;
1726 x_set_menu_bar_lines_1 (f
->root_window
, nlines
- olines
);
1727 #endif /* not USE_X_TOOLKIT */
1730 /* Change the name of frame F to NAME. If NAME is nil, set F's name to
1733 If EXPLICIT is non-zero, that indicates that lisp code is setting the
1734 name; if NAME is a string, set F's name to NAME and set
1735 F->explicit_name; if NAME is Qnil, then clear F->explicit_name.
1737 If EXPLICIT is zero, that indicates that Emacs redisplay code is
1738 suggesting a new name, which lisp code should override; if
1739 F->explicit_name is set, ignore the new name; otherwise, set it. */
1742 x_set_name (f
, name
, explicit)
1747 /* Make sure that requests from lisp code override requests from
1748 Emacs redisplay code. */
1751 /* If we're switching from explicit to implicit, we had better
1752 update the mode lines and thereby update the title. */
1753 if (f
->explicit_name
&& NILP (name
))
1754 update_mode_lines
= 1;
1756 f
->explicit_name
= ! NILP (name
);
1758 else if (f
->explicit_name
)
1761 /* If NAME is nil, set the name to the x_id_name. */
1764 /* Check for no change needed in this very common case
1765 before we do any consing. */
1766 if (!strcmp (FRAME_X_DISPLAY_INFO (f
)->x_id_name
,
1767 XSTRING (f
->name
)->data
))
1769 name
= build_string (FRAME_X_DISPLAY_INFO (f
)->x_id_name
);
1772 CHECK_STRING (name
, 0);
1774 /* Don't change the name if it's already NAME. */
1775 if (! NILP (Fstring_equal (name
, f
->name
)))
1780 /* For setting the frame title, the title parameter should override
1781 the name parameter. */
1782 if (! NILP (f
->title
))
1785 if (FRAME_X_WINDOW (f
))
1790 XTextProperty text
, icon
;
1791 Lisp_Object icon_name
;
1793 text
.value
= XSTRING (name
)->data
;
1794 text
.encoding
= XA_STRING
;
1796 text
.nitems
= XSTRING (name
)->size
;
1798 icon_name
= (!NILP (f
->icon_name
) ? f
->icon_name
: name
);
1800 icon
.value
= XSTRING (icon_name
)->data
;
1801 icon
.encoding
= XA_STRING
;
1803 icon
.nitems
= XSTRING (icon_name
)->size
;
1804 #ifdef USE_X_TOOLKIT
1805 XSetWMName (FRAME_X_DISPLAY (f
),
1806 XtWindow (f
->output_data
.x
->widget
), &text
);
1807 XSetWMIconName (FRAME_X_DISPLAY (f
), XtWindow (f
->output_data
.x
->widget
),
1809 #else /* not USE_X_TOOLKIT */
1810 XSetWMName (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
), &text
);
1811 XSetWMIconName (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
), &icon
);
1812 #endif /* not USE_X_TOOLKIT */
1814 #else /* not HAVE_X11R4 */
1815 XSetIconName (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
1816 XSTRING (name
)->data
);
1817 XStoreName (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
1818 XSTRING (name
)->data
);
1819 #endif /* not HAVE_X11R4 */
1824 /* This function should be called when the user's lisp code has
1825 specified a name for the frame; the name will override any set by the
1828 x_explicitly_set_name (f
, arg
, oldval
)
1830 Lisp_Object arg
, oldval
;
1832 x_set_name (f
, arg
, 1);
1835 /* This function should be called by Emacs redisplay code to set the
1836 name; names set this way will never override names set by the user's
1839 x_implicitly_set_name (f
, arg
, oldval
)
1841 Lisp_Object arg
, oldval
;
1843 x_set_name (f
, arg
, 0);
1846 /* Change the title of frame F to NAME.
1847 If NAME is nil, use the frame name as the title.
1849 If EXPLICIT is non-zero, that indicates that lisp code is setting the
1850 name; if NAME is a string, set F's name to NAME and set
1851 F->explicit_name; if NAME is Qnil, then clear F->explicit_name.
1853 If EXPLICIT is zero, that indicates that Emacs redisplay code is
1854 suggesting a new name, which lisp code should override; if
1855 F->explicit_name is set, ignore the new name; otherwise, set it. */
1858 x_set_title (f
, name
)
1862 /* Don't change the title if it's already NAME. */
1863 if (EQ (name
, f
->title
))
1866 update_mode_lines
= 1;
1873 if (FRAME_X_WINDOW (f
))
1878 XTextProperty text
, icon
;
1879 Lisp_Object icon_name
;
1881 text
.value
= XSTRING (name
)->data
;
1882 text
.encoding
= XA_STRING
;
1884 text
.nitems
= XSTRING (name
)->size
;
1886 icon_name
= (!NILP (f
->icon_name
) ? f
->icon_name
: name
);
1888 icon
.value
= XSTRING (icon_name
)->data
;
1889 icon
.encoding
= XA_STRING
;
1891 icon
.nitems
= XSTRING (icon_name
)->size
;
1892 #ifdef USE_X_TOOLKIT
1893 XSetWMName (FRAME_X_DISPLAY (f
),
1894 XtWindow (f
->output_data
.x
->widget
), &text
);
1895 XSetWMIconName (FRAME_X_DISPLAY (f
), XtWindow (f
->output_data
.x
->widget
),
1897 #else /* not USE_X_TOOLKIT */
1898 XSetWMName (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
), &text
);
1899 XSetWMIconName (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
), &icon
);
1900 #endif /* not USE_X_TOOLKIT */
1902 #else /* not HAVE_X11R4 */
1903 XSetIconName (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
1904 XSTRING (name
)->data
);
1905 XStoreName (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
1906 XSTRING (name
)->data
);
1907 #endif /* not HAVE_X11R4 */
1913 x_set_autoraise (f
, arg
, oldval
)
1915 Lisp_Object arg
, oldval
;
1917 f
->auto_raise
= !EQ (Qnil
, arg
);
1921 x_set_autolower (f
, arg
, oldval
)
1923 Lisp_Object arg
, oldval
;
1925 f
->auto_lower
= !EQ (Qnil
, arg
);
1929 x_set_unsplittable (f
, arg
, oldval
)
1931 Lisp_Object arg
, oldval
;
1933 f
->no_split
= !NILP (arg
);
1937 x_set_vertical_scroll_bars (f
, arg
, oldval
)
1939 Lisp_Object arg
, oldval
;
1941 if (NILP (arg
) != ! FRAME_HAS_VERTICAL_SCROLL_BARS (f
))
1943 FRAME_HAS_VERTICAL_SCROLL_BARS (f
) = ! NILP (arg
);
1945 /* We set this parameter before creating the X window for the
1946 frame, so we can get the geometry right from the start.
1947 However, if the window hasn't been created yet, we shouldn't
1948 call x_set_window_size. */
1949 if (FRAME_X_WINDOW (f
))
1950 x_set_window_size (f
, 0, FRAME_WIDTH (f
), FRAME_HEIGHT (f
));
1955 x_set_scroll_bar_width (f
, arg
, oldval
)
1957 Lisp_Object arg
, oldval
;
1961 FRAME_SCROLL_BAR_PIXEL_WIDTH (f
) = 0;
1962 FRAME_SCROLL_BAR_COLS (f
) = 2;
1964 else if (INTEGERP (arg
) && XINT (arg
) > 0
1965 && XFASTINT (arg
) != FRAME_SCROLL_BAR_PIXEL_WIDTH (f
))
1967 int wid
= FONT_WIDTH (f
->output_data
.x
->font
);
1968 FRAME_SCROLL_BAR_PIXEL_WIDTH (f
) = XFASTINT (arg
);
1969 FRAME_SCROLL_BAR_COLS (f
) = (XFASTINT (arg
) + wid
-1) / wid
;
1970 if (FRAME_X_WINDOW (f
))
1971 x_set_window_size (f
, 0, FRAME_WIDTH (f
), FRAME_HEIGHT (f
));
1975 /* Subroutines of creating an X frame. */
1977 /* Make sure that Vx_resource_name is set to a reasonable value.
1978 Fix it up, or set it to `emacs' if it is too hopeless. */
1981 validate_x_resource_name ()
1984 /* Number of valid characters in the resource name. */
1986 /* Number of invalid characters in the resource name. */
1991 if (STRINGP (Vx_resource_name
))
1993 unsigned char *p
= XSTRING (Vx_resource_name
)->data
;
1996 len
= XSTRING (Vx_resource_name
)->size
;
1998 /* Only letters, digits, - and _ are valid in resource names.
1999 Count the valid characters and count the invalid ones. */
2000 for (i
= 0; i
< len
; i
++)
2003 if (! ((c
>= 'a' && c
<= 'z')
2004 || (c
>= 'A' && c
<= 'Z')
2005 || (c
>= '0' && c
<= '9')
2006 || c
== '-' || c
== '_'))
2013 /* Not a string => completely invalid. */
2014 bad_count
= 5, good_count
= 0;
2016 /* If name is valid already, return. */
2020 /* If name is entirely invalid, or nearly so, use `emacs'. */
2022 || (good_count
== 1 && bad_count
> 0))
2024 Vx_resource_name
= build_string ("emacs");
2028 /* Name is partly valid. Copy it and replace the invalid characters
2029 with underscores. */
2031 Vx_resource_name
= new = Fcopy_sequence (Vx_resource_name
);
2033 for (i
= 0; i
< len
; i
++)
2035 int c
= XSTRING (new)->data
[i
];
2036 if (! ((c
>= 'a' && c
<= 'z')
2037 || (c
>= 'A' && c
<= 'Z')
2038 || (c
>= '0' && c
<= '9')
2039 || c
== '-' || c
== '_'))
2040 XSTRING (new)->data
[i
] = '_';
2045 extern char *x_get_string_resource ();
2047 DEFUN ("x-get-resource", Fx_get_resource
, Sx_get_resource
, 2, 4, 0,
2048 "Return the value of ATTRIBUTE, of class CLASS, from the X defaults database.\n\
2049 This uses `INSTANCE.ATTRIBUTE' as the key and `Emacs.CLASS' as the\n\
2050 class, where INSTANCE is the name under which Emacs was invoked, or\n\
2051 the name specified by the `-name' or `-rn' command-line arguments.\n\
2053 The optional arguments COMPONENT and SUBCLASS add to the key and the\n\
2054 class, respectively. You must specify both of them or neither.\n\
2055 If you specify them, the key is `INSTANCE.COMPONENT.ATTRIBUTE'\n\
2056 and the class is `Emacs.CLASS.SUBCLASS'.")
2057 (attribute
, class, component
, subclass
)
2058 Lisp_Object attribute
, class, component
, subclass
;
2060 register char *value
;
2066 CHECK_STRING (attribute
, 0);
2067 CHECK_STRING (class, 0);
2069 if (!NILP (component
))
2070 CHECK_STRING (component
, 1);
2071 if (!NILP (subclass
))
2072 CHECK_STRING (subclass
, 2);
2073 if (NILP (component
) != NILP (subclass
))
2074 error ("x-get-resource: must specify both COMPONENT and SUBCLASS or neither");
2076 validate_x_resource_name ();
2078 /* Allocate space for the components, the dots which separate them,
2079 and the final '\0'. Make them big enough for the worst case. */
2080 name_key
= (char *) alloca (XSTRING (Vx_resource_name
)->size
2081 + (STRINGP (component
)
2082 ? XSTRING (component
)->size
: 0)
2083 + XSTRING (attribute
)->size
2086 class_key
= (char *) alloca ((sizeof (EMACS_CLASS
) - 1)
2087 + XSTRING (class)->size
2088 + (STRINGP (subclass
)
2089 ? XSTRING (subclass
)->size
: 0)
2092 /* Start with emacs.FRAMENAME for the name (the specific one)
2093 and with `Emacs' for the class key (the general one). */
2094 strcpy (name_key
, XSTRING (Vx_resource_name
)->data
);
2095 strcpy (class_key
, EMACS_CLASS
);
2097 strcat (class_key
, ".");
2098 strcat (class_key
, XSTRING (class)->data
);
2100 if (!NILP (component
))
2102 strcat (class_key
, ".");
2103 strcat (class_key
, XSTRING (subclass
)->data
);
2105 strcat (name_key
, ".");
2106 strcat (name_key
, XSTRING (component
)->data
);
2109 strcat (name_key
, ".");
2110 strcat (name_key
, XSTRING (attribute
)->data
);
2112 value
= x_get_string_resource (check_x_display_info (Qnil
)->xrdb
,
2113 name_key
, class_key
);
2115 if (value
!= (char *) 0)
2116 return build_string (value
);
2121 /* Used when C code wants a resource value. */
2124 x_get_resource_string (attribute
, class)
2125 char *attribute
, *class;
2127 register char *value
;
2131 /* Allocate space for the components, the dots which separate them,
2132 and the final '\0'. */
2133 name_key
= (char *) alloca (XSTRING (Vinvocation_name
)->size
2134 + strlen (attribute
) + 2);
2135 class_key
= (char *) alloca ((sizeof (EMACS_CLASS
) - 1)
2136 + strlen (class) + 2);
2138 sprintf (name_key
, "%s.%s",
2139 XSTRING (Vinvocation_name
)->data
,
2141 sprintf (class_key
, "%s.%s", EMACS_CLASS
, class);
2143 return x_get_string_resource (FRAME_X_DISPLAY_INFO (selected_frame
)->xrdb
,
2144 name_key
, class_key
);
2147 /* Types we might convert a resource string into. */
2150 number
, boolean
, string
, symbol
2153 /* Return the value of parameter PARAM.
2155 First search ALIST, then Vdefault_frame_alist, then the X defaults
2156 database, using ATTRIBUTE as the attribute name and CLASS as its class.
2158 Convert the resource to the type specified by desired_type.
2160 If no default is specified, return Qunbound. If you call
2161 x_get_arg, make sure you deal with Qunbound in a reasonable way,
2162 and don't let it get stored in any Lisp-visible variables! */
2165 x_get_arg (alist
, param
, attribute
, class, type
)
2166 Lisp_Object alist
, param
;
2169 enum resource_types type
;
2171 register Lisp_Object tem
;
2173 tem
= Fassq (param
, alist
);
2175 tem
= Fassq (param
, Vdefault_frame_alist
);
2181 tem
= Fx_get_resource (build_string (attribute
),
2182 build_string (class),
2191 return make_number (atoi (XSTRING (tem
)->data
));
2194 tem
= Fdowncase (tem
);
2195 if (!strcmp (XSTRING (tem
)->data
, "on")
2196 || !strcmp (XSTRING (tem
)->data
, "true"))
2205 /* As a special case, we map the values `true' and `on'
2206 to Qt, and `false' and `off' to Qnil. */
2209 lower
= Fdowncase (tem
);
2210 if (!strcmp (XSTRING (lower
)->data
, "on")
2211 || !strcmp (XSTRING (lower
)->data
, "true"))
2213 else if (!strcmp (XSTRING (lower
)->data
, "off")
2214 || !strcmp (XSTRING (lower
)->data
, "false"))
2217 return Fintern (tem
, Qnil
);
2230 /* Record in frame F the specified or default value according to ALIST
2231 of the parameter named PARAM (a Lisp symbol).
2232 If no value is specified for PARAM, look for an X default for XPROP
2233 on the frame named NAME.
2234 If that is not found either, use the value DEFLT. */
2237 x_default_parameter (f
, alist
, prop
, deflt
, xprop
, xclass
, type
)
2244 enum resource_types type
;
2248 tem
= x_get_arg (alist
, prop
, xprop
, xclass
, type
);
2249 if (EQ (tem
, Qunbound
))
2251 x_set_frame_parameters (f
, Fcons (Fcons (prop
, tem
), Qnil
));
2255 DEFUN ("x-parse-geometry", Fx_parse_geometry
, Sx_parse_geometry
, 1, 1, 0,
2256 "Parse an X-style geometry string STRING.\n\
2257 Returns an alist of the form ((top . TOP), (left . LEFT) ... ).\n\
2258 The properties returned may include `top', `left', `height', and `width'.\n\
2259 The value of `left' or `top' may be an integer,\n\
2260 or a list (+ N) meaning N pixels relative to top/left corner,\n\
2261 or a list (- N) meaning -N pixels relative to bottom/right corner.")
2266 unsigned int width
, height
;
2269 CHECK_STRING (string
, 0);
2271 geometry
= XParseGeometry ((char *) XSTRING (string
)->data
,
2272 &x
, &y
, &width
, &height
);
2275 if (!!(geometry
& XValue
) != !!(geometry
& YValue
))
2276 error ("Must specify both x and y position, or neither");
2280 if (geometry
& XValue
)
2282 Lisp_Object element
;
2284 if (x
>= 0 && (geometry
& XNegative
))
2285 element
= Fcons (Qleft
, Fcons (Qminus
, Fcons (make_number (-x
), Qnil
)));
2286 else if (x
< 0 && ! (geometry
& XNegative
))
2287 element
= Fcons (Qleft
, Fcons (Qplus
, Fcons (make_number (x
), Qnil
)));
2289 element
= Fcons (Qleft
, make_number (x
));
2290 result
= Fcons (element
, result
);
2293 if (geometry
& YValue
)
2295 Lisp_Object element
;
2297 if (y
>= 0 && (geometry
& YNegative
))
2298 element
= Fcons (Qtop
, Fcons (Qminus
, Fcons (make_number (-y
), Qnil
)));
2299 else if (y
< 0 && ! (geometry
& YNegative
))
2300 element
= Fcons (Qtop
, Fcons (Qplus
, Fcons (make_number (y
), Qnil
)));
2302 element
= Fcons (Qtop
, make_number (y
));
2303 result
= Fcons (element
, result
);
2306 if (geometry
& WidthValue
)
2307 result
= Fcons (Fcons (Qwidth
, make_number (width
)), result
);
2308 if (geometry
& HeightValue
)
2309 result
= Fcons (Fcons (Qheight
, make_number (height
)), result
);
2314 /* Calculate the desired size and position of this window,
2315 and return the flags saying which aspects were specified.
2317 This function does not make the coordinates positive. */
2319 #define DEFAULT_ROWS 40
2320 #define DEFAULT_COLS 80
2323 x_figure_window_size (f
, parms
)
2327 register Lisp_Object tem0
, tem1
, tem2
;
2328 int height
, width
, left
, top
;
2329 register int geometry
;
2330 long window_prompting
= 0;
2332 /* Default values if we fall through.
2333 Actually, if that happens we should get
2334 window manager prompting. */
2335 f
->width
= DEFAULT_COLS
;
2336 f
->height
= DEFAULT_ROWS
;
2337 /* Window managers expect that if program-specified
2338 positions are not (0,0), they're intentional, not defaults. */
2339 f
->output_data
.x
->top_pos
= 0;
2340 f
->output_data
.x
->left_pos
= 0;
2342 tem0
= x_get_arg (parms
, Qheight
, 0, 0, number
);
2343 tem1
= x_get_arg (parms
, Qwidth
, 0, 0, number
);
2344 tem2
= x_get_arg (parms
, Quser_size
, 0, 0, number
);
2345 if (! EQ (tem0
, Qunbound
) || ! EQ (tem1
, Qunbound
))
2347 if (!EQ (tem0
, Qunbound
))
2349 CHECK_NUMBER (tem0
, 0);
2350 f
->height
= XINT (tem0
);
2352 if (!EQ (tem1
, Qunbound
))
2354 CHECK_NUMBER (tem1
, 0);
2355 f
->width
= XINT (tem1
);
2357 if (!NILP (tem2
) && !EQ (tem2
, Qunbound
))
2358 window_prompting
|= USSize
;
2360 window_prompting
|= PSize
;
2363 f
->output_data
.x
->vertical_scroll_bar_extra
2364 = (!FRAME_HAS_VERTICAL_SCROLL_BARS (f
)
2366 : FRAME_SCROLL_BAR_PIXEL_WIDTH (f
) > 0
2367 ? FRAME_SCROLL_BAR_PIXEL_WIDTH (f
)
2368 : (FRAME_SCROLL_BAR_COLS (f
) * FONT_WIDTH (f
->output_data
.x
->font
)));
2369 f
->output_data
.x
->pixel_width
= CHAR_TO_PIXEL_WIDTH (f
, f
->width
);
2370 f
->output_data
.x
->pixel_height
= CHAR_TO_PIXEL_HEIGHT (f
, f
->height
);
2372 tem0
= x_get_arg (parms
, Qtop
, 0, 0, number
);
2373 tem1
= x_get_arg (parms
, Qleft
, 0, 0, number
);
2374 tem2
= x_get_arg (parms
, Quser_position
, 0, 0, number
);
2375 if (! EQ (tem0
, Qunbound
) || ! EQ (tem1
, Qunbound
))
2377 if (EQ (tem0
, Qminus
))
2379 f
->output_data
.x
->top_pos
= 0;
2380 window_prompting
|= YNegative
;
2382 else if (CONSP (tem0
) && EQ (XCONS (tem0
)->car
, Qminus
)
2383 && CONSP (XCONS (tem0
)->cdr
)
2384 && INTEGERP (XCONS (XCONS (tem0
)->cdr
)->car
))
2386 f
->output_data
.x
->top_pos
= - XINT (XCONS (XCONS (tem0
)->cdr
)->car
);
2387 window_prompting
|= YNegative
;
2389 else if (CONSP (tem0
) && EQ (XCONS (tem0
)->car
, Qplus
)
2390 && CONSP (XCONS (tem0
)->cdr
)
2391 && INTEGERP (XCONS (XCONS (tem0
)->cdr
)->car
))
2393 f
->output_data
.x
->top_pos
= XINT (XCONS (XCONS (tem0
)->cdr
)->car
);
2395 else if (EQ (tem0
, Qunbound
))
2396 f
->output_data
.x
->top_pos
= 0;
2399 CHECK_NUMBER (tem0
, 0);
2400 f
->output_data
.x
->top_pos
= XINT (tem0
);
2401 if (f
->output_data
.x
->top_pos
< 0)
2402 window_prompting
|= YNegative
;
2405 if (EQ (tem1
, Qminus
))
2407 f
->output_data
.x
->left_pos
= 0;
2408 window_prompting
|= XNegative
;
2410 else if (CONSP (tem1
) && EQ (XCONS (tem1
)->car
, Qminus
)
2411 && CONSP (XCONS (tem1
)->cdr
)
2412 && INTEGERP (XCONS (XCONS (tem1
)->cdr
)->car
))
2414 f
->output_data
.x
->left_pos
= - XINT (XCONS (XCONS (tem1
)->cdr
)->car
);
2415 window_prompting
|= XNegative
;
2417 else if (CONSP (tem1
) && EQ (XCONS (tem1
)->car
, Qplus
)
2418 && CONSP (XCONS (tem1
)->cdr
)
2419 && INTEGERP (XCONS (XCONS (tem1
)->cdr
)->car
))
2421 f
->output_data
.x
->left_pos
= XINT (XCONS (XCONS (tem1
)->cdr
)->car
);
2423 else if (EQ (tem1
, Qunbound
))
2424 f
->output_data
.x
->left_pos
= 0;
2427 CHECK_NUMBER (tem1
, 0);
2428 f
->output_data
.x
->left_pos
= XINT (tem1
);
2429 if (f
->output_data
.x
->left_pos
< 0)
2430 window_prompting
|= XNegative
;
2433 if (!NILP (tem2
) && ! EQ (tem2
, Qunbound
))
2434 window_prompting
|= USPosition
;
2436 window_prompting
|= PPosition
;
2439 return window_prompting
;
2442 #if !defined (HAVE_X11R4) && !defined (HAVE_XSETWMPROTOCOLS)
2445 XSetWMProtocols (dpy
, w
, protocols
, count
)
2452 prop
= XInternAtom (dpy
, "WM_PROTOCOLS", False
);
2453 if (prop
== None
) return False
;
2454 XChangeProperty (dpy
, w
, prop
, XA_ATOM
, 32, PropModeReplace
,
2455 (unsigned char *) protocols
, count
);
2458 #endif /* not HAVE_X11R4 && not HAVE_XSETWMPROTOCOLS */
2460 #ifdef USE_X_TOOLKIT
2462 /* If the WM_PROTOCOLS property does not already contain WM_TAKE_FOCUS,
2463 WM_DELETE_WINDOW, and WM_SAVE_YOURSELF, then add them. (They may
2464 already be present because of the toolkit (Motif adds some of them,
2465 for example, but Xt doesn't). */
2468 hack_wm_protocols (f
, widget
)
2472 Display
*dpy
= XtDisplay (widget
);
2473 Window w
= XtWindow (widget
);
2474 int need_delete
= 1;
2480 Atom type
, *atoms
= 0;
2482 unsigned long nitems
= 0;
2483 unsigned long bytes_after
;
2485 if ((XGetWindowProperty (dpy
, w
,
2486 FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_protocols
,
2487 (long)0, (long)100, False
, XA_ATOM
,
2488 &type
, &format
, &nitems
, &bytes_after
,
2489 (unsigned char **) &atoms
)
2491 && format
== 32 && type
== XA_ATOM
)
2495 if (atoms
[nitems
] == FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_delete_window
)
2497 else if (atoms
[nitems
] == FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_take_focus
)
2499 else if (atoms
[nitems
] == FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_save_yourself
)
2502 if (atoms
) XFree ((char *) atoms
);
2508 props
[count
++] = FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_delete_window
;
2510 props
[count
++] = FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_take_focus
;
2512 props
[count
++] = FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_save_yourself
;
2514 XChangeProperty (dpy
, w
, FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_protocols
,
2515 XA_ATOM
, 32, PropModeAppend
,
2516 (unsigned char *) props
, count
);
2522 #ifdef USE_X_TOOLKIT
2524 /* Create and set up the X widget for frame F. */
2527 x_window (f
, window_prompting
, minibuffer_only
)
2529 long window_prompting
;
2530 int minibuffer_only
;
2532 XClassHint class_hints
;
2533 XSetWindowAttributes attributes
;
2534 unsigned long attribute_mask
;
2536 Widget shell_widget
;
2538 Widget frame_widget
;
2544 /* Use the resource name as the top-level widget name
2545 for looking up resources. Make a non-Lisp copy
2546 for the window manager, so GC relocation won't bother it.
2548 Elsewhere we specify the window name for the window manager. */
2551 char *str
= (char *) XSTRING (Vx_resource_name
)->data
;
2552 f
->namebuf
= (char *) xmalloc (strlen (str
) + 1);
2553 strcpy (f
->namebuf
, str
);
2557 XtSetArg (al
[ac
], XtNallowShellResize
, 1); ac
++;
2558 XtSetArg (al
[ac
], XtNinput
, 1); ac
++;
2559 XtSetArg (al
[ac
], XtNmappedWhenManaged
, 0); ac
++;
2560 XtSetArg (al
[ac
], XtNborderWidth
, f
->output_data
.x
->border_width
); ac
++;
2561 shell_widget
= XtAppCreateShell (f
->namebuf
, EMACS_CLASS
,
2562 applicationShellWidgetClass
,
2563 FRAME_X_DISPLAY (f
), al
, ac
);
2565 f
->output_data
.x
->widget
= shell_widget
;
2566 /* maybe_set_screen_title_format (shell_widget); */
2568 pane_widget
= lw_create_widget ("main", "pane", widget_id_tick
++,
2569 (widget_value
*) NULL
,
2570 shell_widget
, False
,
2573 (lw_callback
) NULL
);
2575 f
->output_data
.x
->column_widget
= pane_widget
;
2577 /* mappedWhenManaged to false tells to the paned window to not map/unmap
2578 the emacs screen when changing menubar. This reduces flickering. */
2581 XtSetArg (al
[ac
], XtNmappedWhenManaged
, 0); ac
++;
2582 XtSetArg (al
[ac
], XtNshowGrip
, 0); ac
++;
2583 XtSetArg (al
[ac
], XtNallowResize
, 1); ac
++;
2584 XtSetArg (al
[ac
], XtNresizeToPreferred
, 1); ac
++;
2585 XtSetArg (al
[ac
], XtNemacsFrame
, f
); ac
++;
2586 frame_widget
= XtCreateWidget (f
->namebuf
,
2588 pane_widget
, al
, ac
);
2590 f
->output_data
.x
->edit_widget
= frame_widget
;
2592 XtManageChild (frame_widget
);
2594 /* Do some needed geometry management. */
2597 char *tem
, shell_position
[32];
2600 int extra_borders
= 0;
2602 = (f
->output_data
.x
->menubar_widget
2603 ? (f
->output_data
.x
->menubar_widget
->core
.height
2604 + f
->output_data
.x
->menubar_widget
->core
.border_width
)
2606 extern char *lwlib_toolkit_type
;
2608 if (FRAME_EXTERNAL_MENU_BAR (f
))
2611 XtVaGetValues (pane_widget
, XtNinternalBorderWidth
, &ibw
, NULL
);
2612 menubar_size
+= ibw
;
2615 f
->output_data
.x
->menubar_height
= menubar_size
;
2617 /* Motif seems to need this amount added to the sizes
2618 specified for the shell widget. The Athena/Lucid widgets don't.
2619 Both conclusions reached experimentally. -- rms. */
2620 if (!strcmp (lwlib_toolkit_type
, "motif"))
2621 XtVaGetValues (f
->output_data
.x
->edit_widget
, XtNinternalBorderWidth
,
2622 &extra_borders
, NULL
);
2624 /* Convert our geometry parameters into a geometry string
2626 Note that we do not specify here whether the position
2627 is a user-specified or program-specified one.
2628 We pass that information later, in x_wm_set_size_hints. */
2630 int left
= f
->output_data
.x
->left_pos
;
2631 int xneg
= window_prompting
& XNegative
;
2632 int top
= f
->output_data
.x
->top_pos
;
2633 int yneg
= window_prompting
& YNegative
;
2639 if (window_prompting
& USPosition
)
2640 sprintf (shell_position
, "=%dx%d%c%d%c%d",
2641 PIXEL_WIDTH (f
) + extra_borders
,
2642 PIXEL_HEIGHT (f
) + menubar_size
+ extra_borders
,
2643 (xneg
? '-' : '+'), left
,
2644 (yneg
? '-' : '+'), top
);
2646 sprintf (shell_position
, "=%dx%d",
2647 PIXEL_WIDTH (f
) + extra_borders
,
2648 PIXEL_HEIGHT (f
) + menubar_size
+ extra_borders
);
2651 len
= strlen (shell_position
) + 1;
2652 tem
= (char *) xmalloc (len
);
2653 strncpy (tem
, shell_position
, len
);
2654 XtSetArg (al
[ac
], XtNgeometry
, tem
); ac
++;
2655 XtSetValues (shell_widget
, al
, ac
);
2658 XtManageChild (pane_widget
);
2659 XtRealizeWidget (shell_widget
);
2661 FRAME_X_WINDOW (f
) = XtWindow (frame_widget
);
2663 validate_x_resource_name ();
2665 class_hints
.res_name
= (char *) XSTRING (Vx_resource_name
)->data
;
2666 class_hints
.res_class
= EMACS_CLASS
;
2667 XSetClassHint (FRAME_X_DISPLAY (f
), XtWindow (shell_widget
), &class_hints
);
2670 #ifndef X_I18N_INHIBITED
2675 xim
= XOpenIM (FRAME_X_DISPLAY (f
), NULL
, NULL
, NULL
);
2679 xic
= XCreateIC (xim
,
2680 XNInputStyle
, XIMPreeditNothing
| XIMStatusNothing
,
2681 XNClientWindow
, FRAME_X_WINDOW(f
),
2682 XNFocusWindow
, FRAME_X_WINDOW(f
),
2691 FRAME_XIM (f
) = xim
;
2692 FRAME_XIC (f
) = xic
;
2694 #else /* X_I18N_INHIBITED */
2697 #endif /* X_I18N_INHIBITED */
2698 #endif /* HAVE_X_I18N */
2700 f
->output_data
.x
->wm_hints
.input
= True
;
2701 f
->output_data
.x
->wm_hints
.flags
|= InputHint
;
2702 XSetWMHints (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
2703 &f
->output_data
.x
->wm_hints
);
2705 hack_wm_protocols (f
, shell_widget
);
2708 XtAddEventHandler (shell_widget
, 0, True
, _XEditResCheckMessages
, 0);
2711 /* Do a stupid property change to force the server to generate a
2712 propertyNotify event so that the event_stream server timestamp will
2713 be initialized to something relevant to the time we created the window.
2715 XChangeProperty (XtDisplay (frame_widget
), XtWindow (frame_widget
),
2716 FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_protocols
,
2717 XA_ATOM
, 32, PropModeAppend
,
2718 (unsigned char*) NULL
, 0);
2720 /* Make all the standard events reach the Emacs frame. */
2721 attributes
.event_mask
= STANDARD_EVENT_SET
;
2722 attribute_mask
= CWEventMask
;
2723 XChangeWindowAttributes (XtDisplay (shell_widget
), XtWindow (shell_widget
),
2724 attribute_mask
, &attributes
);
2726 XtMapWidget (frame_widget
);
2728 /* x_set_name normally ignores requests to set the name if the
2729 requested name is the same as the current name. This is the one
2730 place where that assumption isn't correct; f->name is set, but
2731 the X server hasn't been told. */
2734 int explicit = f
->explicit_name
;
2736 f
->explicit_name
= 0;
2739 x_set_name (f
, name
, explicit);
2742 XDefineCursor (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
2743 f
->output_data
.x
->text_cursor
);
2747 if (!minibuffer_only
&& FRAME_EXTERNAL_MENU_BAR (f
))
2748 initialize_frame_menubar (f
);
2749 lw_set_main_areas (pane_widget
, f
->output_data
.x
->menubar_widget
, frame_widget
);
2751 if (FRAME_X_WINDOW (f
) == 0)
2752 error ("Unable to create window");
2755 #else /* not USE_X_TOOLKIT */
2757 /* Create and set up the X window for frame F. */
2763 XClassHint class_hints
;
2764 XSetWindowAttributes attributes
;
2765 unsigned long attribute_mask
;
2767 attributes
.background_pixel
= f
->output_data
.x
->background_pixel
;
2768 attributes
.border_pixel
= f
->output_data
.x
->border_pixel
;
2769 attributes
.bit_gravity
= StaticGravity
;
2770 attributes
.backing_store
= NotUseful
;
2771 attributes
.save_under
= True
;
2772 attributes
.event_mask
= STANDARD_EVENT_SET
;
2773 attribute_mask
= (CWBackPixel
| CWBorderPixel
| CWBitGravity
2775 | CWBackingStore
| CWSaveUnder
2781 = XCreateWindow (FRAME_X_DISPLAY (f
),
2782 f
->output_data
.x
->parent_desc
,
2783 f
->output_data
.x
->left_pos
,
2784 f
->output_data
.x
->top_pos
,
2785 PIXEL_WIDTH (f
), PIXEL_HEIGHT (f
),
2786 f
->output_data
.x
->border_width
,
2787 CopyFromParent
, /* depth */
2788 InputOutput
, /* class */
2789 FRAME_X_DISPLAY_INFO (f
)->visual
,
2790 attribute_mask
, &attributes
);
2792 #ifndef X_I18N_INHIBITED
2797 xim
= XOpenIM (FRAME_X_DISPLAY(f
), NULL
, NULL
, NULL
);
2801 xic
= XCreateIC (xim
,
2802 XNInputStyle
, XIMPreeditNothing
| XIMStatusNothing
,
2803 XNClientWindow
, FRAME_X_WINDOW(f
),
2804 XNFocusWindow
, FRAME_X_WINDOW(f
),
2814 FRAME_XIM (f
) = xim
;
2815 FRAME_XIC (f
) = xic
;
2817 #else /* X_I18N_INHIBITED */
2820 #endif /* X_I18N_INHIBITED */
2821 #endif /* HAVE_X_I18N */
2823 validate_x_resource_name ();
2825 class_hints
.res_name
= (char *) XSTRING (Vx_resource_name
)->data
;
2826 class_hints
.res_class
= EMACS_CLASS
;
2827 XSetClassHint (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
), &class_hints
);
2829 /* The menubar is part of the ordinary display;
2830 it does not count in addition to the height of the window. */
2831 f
->output_data
.x
->menubar_height
= 0;
2833 /* This indicates that we use the "Passive Input" input model.
2834 Unless we do this, we don't get the Focus{In,Out} events that we
2835 need to draw the cursor correctly. Accursed bureaucrats.
2836 XWhipsAndChains (FRAME_X_DISPLAY (f), IronMaiden, &TheRack); */
2838 f
->output_data
.x
->wm_hints
.input
= True
;
2839 f
->output_data
.x
->wm_hints
.flags
|= InputHint
;
2840 XSetWMHints (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
2841 &f
->output_data
.x
->wm_hints
);
2842 f
->output_data
.x
->wm_hints
.icon_pixmap
= None
;
2844 /* Request "save yourself" and "delete window" commands from wm. */
2847 protocols
[0] = FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_delete_window
;
2848 protocols
[1] = FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_save_yourself
;
2849 XSetWMProtocols (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
), protocols
, 2);
2852 /* x_set_name normally ignores requests to set the name if the
2853 requested name is the same as the current name. This is the one
2854 place where that assumption isn't correct; f->name is set, but
2855 the X server hasn't been told. */
2858 int explicit = f
->explicit_name
;
2860 f
->explicit_name
= 0;
2863 x_set_name (f
, name
, explicit);
2866 XDefineCursor (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
2867 f
->output_data
.x
->text_cursor
);
2871 if (FRAME_X_WINDOW (f
) == 0)
2872 error ("Unable to create window");
2875 #endif /* not USE_X_TOOLKIT */
2877 /* Handle the icon stuff for this window. Perhaps later we might
2878 want an x_set_icon_position which can be called interactively as
2886 Lisp_Object icon_x
, icon_y
;
2888 /* Set the position of the icon. Note that twm groups all
2889 icons in an icon window. */
2890 icon_x
= x_get_arg (parms
, Qicon_left
, 0, 0, number
);
2891 icon_y
= x_get_arg (parms
, Qicon_top
, 0, 0, number
);
2892 if (!EQ (icon_x
, Qunbound
) && !EQ (icon_y
, Qunbound
))
2894 CHECK_NUMBER (icon_x
, 0);
2895 CHECK_NUMBER (icon_y
, 0);
2897 else if (!EQ (icon_x
, Qunbound
) || !EQ (icon_y
, Qunbound
))
2898 error ("Both left and top icon corners of icon must be specified");
2902 if (! EQ (icon_x
, Qunbound
))
2903 x_wm_set_icon_position (f
, XINT (icon_x
), XINT (icon_y
));
2905 /* Start up iconic or window? */
2906 x_wm_set_window_state
2907 (f
, (EQ (x_get_arg (parms
, Qvisibility
, 0, 0, symbol
), Qicon
)
2911 x_text_icon (f
, (char *) XSTRING ((!NILP (f
->icon_name
)
2918 /* Make the GC's needed for this window, setting the
2919 background, border and mouse colors; also create the
2920 mouse cursor and the gray border tile. */
2922 static char cursor_bits
[] =
2924 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
2925 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
2926 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
2927 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00
2934 XGCValues gc_values
;
2940 /* Create the GC's of this frame.
2941 Note that many default values are used. */
2944 gc_values
.font
= f
->output_data
.x
->font
->fid
;
2945 gc_values
.foreground
= f
->output_data
.x
->foreground_pixel
;
2946 gc_values
.background
= f
->output_data
.x
->background_pixel
;
2947 gc_values
.line_width
= 0; /* Means 1 using fast algorithm. */
2948 f
->output_data
.x
->normal_gc
= XCreateGC (FRAME_X_DISPLAY (f
),
2950 GCLineWidth
| GCFont
2951 | GCForeground
| GCBackground
,
2954 /* Reverse video style. */
2955 gc_values
.foreground
= f
->output_data
.x
->background_pixel
;
2956 gc_values
.background
= f
->output_data
.x
->foreground_pixel
;
2957 f
->output_data
.x
->reverse_gc
= XCreateGC (FRAME_X_DISPLAY (f
),
2959 GCFont
| GCForeground
| GCBackground
2963 /* Cursor has cursor-color background, background-color foreground. */
2964 gc_values
.foreground
= f
->output_data
.x
->background_pixel
;
2965 gc_values
.background
= f
->output_data
.x
->cursor_pixel
;
2966 gc_values
.fill_style
= FillOpaqueStippled
;
2968 = XCreateBitmapFromData (FRAME_X_DISPLAY (f
),
2969 FRAME_X_DISPLAY_INFO (f
)->root_window
,
2970 cursor_bits
, 16, 16);
2971 f
->output_data
.x
->cursor_gc
2972 = XCreateGC (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
2973 (GCFont
| GCForeground
| GCBackground
2974 | GCFillStyle
| GCStipple
| GCLineWidth
),
2977 /* Create the gray border tile used when the pointer is not in
2978 the frame. Since this depends on the frame's pixel values,
2979 this must be done on a per-frame basis. */
2980 f
->output_data
.x
->border_tile
2981 = (XCreatePixmapFromBitmapData
2982 (FRAME_X_DISPLAY (f
), FRAME_X_DISPLAY_INFO (f
)->root_window
,
2983 gray_bits
, gray_width
, gray_height
,
2984 f
->output_data
.x
->foreground_pixel
,
2985 f
->output_data
.x
->background_pixel
,
2986 DefaultDepth (FRAME_X_DISPLAY (f
),
2987 XScreenNumberOfScreen (FRAME_X_SCREEN (f
)))));
2992 DEFUN ("x-create-frame", Fx_create_frame
, Sx_create_frame
,
2994 "Make a new X window, which is called a \"frame\" in Emacs terms.\n\
2995 Returns an Emacs frame object.\n\
2996 ALIST is an alist of frame parameters.\n\
2997 If the parameters specify that the frame should not have a minibuffer,\n\
2998 and do not specify a specific minibuffer window to use,\n\
2999 then `default-minibuffer-frame' must be a frame whose minibuffer can\n\
3000 be shared by the new frame.\n\
3002 This function is an internal primitive--use `make-frame' instead.")
3007 Lisp_Object frame
, tem
;
3009 int minibuffer_only
= 0;
3010 long window_prompting
= 0;
3012 int count
= specpdl_ptr
- specpdl
;
3013 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
3014 Lisp_Object display
;
3015 struct x_display_info
*dpyinfo
;
3021 /* Use this general default value to start with
3022 until we know if this frame has a specified name. */
3023 Vx_resource_name
= Vinvocation_name
;
3025 display
= x_get_arg (parms
, Qdisplay
, 0, 0, string
);
3026 if (EQ (display
, Qunbound
))
3028 dpyinfo
= check_x_display_info (display
);
3030 kb
= dpyinfo
->kboard
;
3032 kb
= &the_only_kboard
;
3035 name
= x_get_arg (parms
, Qname
, "name", "Name", string
);
3037 && ! EQ (name
, Qunbound
)
3039 error ("Invalid frame name--not a string or nil");
3042 Vx_resource_name
= name
;
3044 /* See if parent window is specified. */
3045 parent
= x_get_arg (parms
, Qparent_id
, NULL
, NULL
, number
);
3046 if (EQ (parent
, Qunbound
))
3048 if (! NILP (parent
))
3049 CHECK_NUMBER (parent
, 0);
3051 /* make_frame_without_minibuffer can run Lisp code and garbage collect. */
3052 /* No need to protect DISPLAY because that's not used after passing
3053 it to make_frame_without_minibuffer. */
3055 GCPRO4 (parms
, parent
, name
, frame
);
3056 tem
= x_get_arg (parms
, Qminibuffer
, 0, 0, symbol
);
3057 if (EQ (tem
, Qnone
) || NILP (tem
))
3058 f
= make_frame_without_minibuffer (Qnil
, kb
, display
);
3059 else if (EQ (tem
, Qonly
))
3061 f
= make_minibuffer_frame ();
3062 minibuffer_only
= 1;
3064 else if (WINDOWP (tem
))
3065 f
= make_frame_without_minibuffer (tem
, kb
, display
);
3069 XSETFRAME (frame
, f
);
3071 /* Note that X Windows does support scroll bars. */
3072 FRAME_CAN_HAVE_SCROLL_BARS (f
) = 1;
3074 f
->output_method
= output_x_window
;
3075 f
->output_data
.x
= (struct x_output
*) xmalloc (sizeof (struct x_output
));
3076 bzero (f
->output_data
.x
, sizeof (struct x_output
));
3077 f
->output_data
.x
->icon_bitmap
= -1;
3080 = x_get_arg (parms
, Qicon_name
, "iconName", "Title", string
);
3081 if (! STRINGP (f
->icon_name
))
3082 f
->icon_name
= Qnil
;
3084 FRAME_X_DISPLAY_INFO (f
) = dpyinfo
;
3086 FRAME_KBOARD (f
) = kb
;
3089 /* Specify the parent under which to make this X window. */
3093 f
->output_data
.x
->parent_desc
= parent
;
3094 f
->output_data
.x
->explicit_parent
= 1;
3098 f
->output_data
.x
->parent_desc
= FRAME_X_DISPLAY_INFO (f
)->root_window
;
3099 f
->output_data
.x
->explicit_parent
= 0;
3102 /* Note that the frame has no physical cursor right now. */
3103 f
->phys_cursor_x
= -1;
3105 /* Set the name; the functions to which we pass f expect the name to
3107 if (EQ (name
, Qunbound
) || NILP (name
))
3109 f
->name
= build_string (dpyinfo
->x_id_name
);
3110 f
->explicit_name
= 0;
3115 f
->explicit_name
= 1;
3116 /* use the frame's title when getting resources for this frame. */
3117 specbind (Qx_resource_name
, name
);
3120 /* Extract the window parameters from the supplied values
3121 that are needed to determine window geometry. */
3125 font
= x_get_arg (parms
, Qfont
, "font", "Font", string
);
3127 /* First, try whatever font the caller has specified. */
3129 font
= x_new_font (f
, XSTRING (font
)->data
);
3130 /* Try out a font which we hope has bold and italic variations. */
3131 if (!STRINGP (font
))
3132 font
= x_new_font (f
, "-misc-fixed-medium-r-normal-*-*-140-*-*-c-*-iso8859-1");
3133 if (! STRINGP (font
))
3134 font
= x_new_font (f
, "-*-*-medium-r-normal-*-*-140-*-*-c-*-iso8859-1");
3135 if (! STRINGP (font
))
3136 /* This was formerly the first thing tried, but it finds too many fonts
3137 and takes too long. */
3138 font
= x_new_font (f
, "-*-*-medium-r-*-*-*-*-*-*-c-*-iso8859-1");
3139 /* If those didn't work, look for something which will at least work. */
3140 if (! STRINGP (font
))
3141 font
= x_new_font (f
, "-*-fixed-*-*-*-*-*-140-*-*-c-*-iso8859-1");
3143 if (! STRINGP (font
))
3144 font
= build_string ("fixed");
3146 x_default_parameter (f
, parms
, Qfont
, font
,
3147 "font", "Font", string
);
3150 #ifdef USE_X_TOOLKIT
3151 /* Prevent lwlib/xlwmenu.c from crashing because of a bug
3152 whereby it fails to get any font. */
3153 xlwmenu_default_font
= f
->output_data
.x
->font
;
3156 x_default_parameter (f
, parms
, Qborder_width
, make_number (2),
3157 "borderwidth", "BorderWidth", number
);
3158 /* This defaults to 2 in order to match xterm. We recognize either
3159 internalBorderWidth or internalBorder (which is what xterm calls
3161 if (NILP (Fassq (Qinternal_border_width
, parms
)))
3165 value
= x_get_arg (parms
, Qinternal_border_width
,
3166 "internalBorder", "BorderWidth", number
);
3167 if (! EQ (value
, Qunbound
))
3168 parms
= Fcons (Fcons (Qinternal_border_width
, value
),
3171 x_default_parameter (f
, parms
, Qinternal_border_width
, make_number (2),
3172 "internalBorderWidth", "BorderWidth", number
);
3173 x_default_parameter (f
, parms
, Qvertical_scroll_bars
, Qt
,
3174 "verticalScrollBars", "ScrollBars", boolean
);
3176 /* Also do the stuff which must be set before the window exists. */
3177 x_default_parameter (f
, parms
, Qforeground_color
, build_string ("black"),
3178 "foreground", "Foreground", string
);
3179 x_default_parameter (f
, parms
, Qbackground_color
, build_string ("white"),
3180 "background", "Background", string
);
3181 x_default_parameter (f
, parms
, Qmouse_color
, build_string ("black"),
3182 "pointerColor", "Foreground", string
);
3183 x_default_parameter (f
, parms
, Qcursor_color
, build_string ("black"),
3184 "cursorColor", "Foreground", string
);
3185 x_default_parameter (f
, parms
, Qborder_color
, build_string ("black"),
3186 "borderColor", "BorderColor", string
);
3188 x_default_parameter (f
, parms
, Qmenu_bar_lines
, make_number (1),
3189 "menuBar", "MenuBar", number
);
3190 x_default_parameter (f
, parms
, Qscroll_bar_width
, Qnil
,
3191 "scrollBarWidth", "ScrollBarWidth", number
);
3192 x_default_parameter (f
, parms
, Qbuffer_predicate
, Qnil
,
3193 "bufferPredicate", "BufferPredicate", symbol
);
3194 x_default_parameter (f
, parms
, Qtitle
, Qnil
,
3195 "title", "Title", string
);
3197 f
->output_data
.x
->parent_desc
= FRAME_X_DISPLAY_INFO (f
)->root_window
;
3198 window_prompting
= x_figure_window_size (f
, parms
);
3200 if (window_prompting
& XNegative
)
3202 if (window_prompting
& YNegative
)
3203 f
->output_data
.x
->win_gravity
= SouthEastGravity
;
3205 f
->output_data
.x
->win_gravity
= NorthEastGravity
;
3209 if (window_prompting
& YNegative
)
3210 f
->output_data
.x
->win_gravity
= SouthWestGravity
;
3212 f
->output_data
.x
->win_gravity
= NorthWestGravity
;
3215 f
->output_data
.x
->size_hint_flags
= window_prompting
;
3217 #ifdef USE_X_TOOLKIT
3218 x_window (f
, window_prompting
, minibuffer_only
);
3224 init_frame_faces (f
);
3226 /* We need to do this after creating the X window, so that the
3227 icon-creation functions can say whose icon they're describing. */
3228 x_default_parameter (f
, parms
, Qicon_type
, Qnil
,
3229 "bitmapIcon", "BitmapIcon", symbol
);
3231 x_default_parameter (f
, parms
, Qauto_raise
, Qnil
,
3232 "autoRaise", "AutoRaiseLower", boolean
);
3233 x_default_parameter (f
, parms
, Qauto_lower
, Qnil
,
3234 "autoLower", "AutoRaiseLower", boolean
);
3235 x_default_parameter (f
, parms
, Qcursor_type
, Qbox
,
3236 "cursorType", "CursorType", symbol
);
3238 /* Dimensions, especially f->height, must be done via change_frame_size.
3239 Change will not be effected unless different from the current
3243 f
->height
= f
->width
= 0;
3244 change_frame_size (f
, height
, width
, 1, 0);
3246 /* Tell the server what size and position, etc, we want,
3247 and how badly we want them. */
3249 x_wm_set_size_hint (f
, window_prompting
, 0);
3252 tem
= x_get_arg (parms
, Qunsplittable
, 0, 0, boolean
);
3253 f
->no_split
= minibuffer_only
|| EQ (tem
, Qt
);
3257 /* It is now ok to make the frame official
3258 even if we get an error below.
3259 And the frame needs to be on Vframe_list
3260 or making it visible won't work. */
3261 Vframe_list
= Fcons (frame
, Vframe_list
);
3263 /* Now that the frame is official, it counts as a reference to
3265 FRAME_X_DISPLAY_INFO (f
)->reference_count
++;
3267 /* Make the window appear on the frame and enable display,
3268 unless the caller says not to. However, with explicit parent,
3269 Emacs cannot control visibility, so don't try. */
3270 if (! f
->output_data
.x
->explicit_parent
)
3272 Lisp_Object visibility
;
3274 visibility
= x_get_arg (parms
, Qvisibility
, 0, 0, symbol
);
3275 if (EQ (visibility
, Qunbound
))
3278 if (EQ (visibility
, Qicon
))
3279 x_iconify_frame (f
);
3280 else if (! NILP (visibility
))
3281 x_make_frame_visible (f
);
3283 /* Must have been Qnil. */
3287 return unbind_to (count
, frame
);
3290 /* FRAME is used only to get a handle on the X display. We don't pass the
3291 display info directly because we're called from frame.c, which doesn't
3292 know about that structure. */
3294 x_get_focus_frame (frame
)
3295 struct frame
*frame
;
3297 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (frame
);
3299 if (! dpyinfo
->x_focus_frame
)
3302 XSETFRAME (xfocus
, dpyinfo
->x_focus_frame
);
3306 DEFUN ("focus-frame", Ffocus_frame
, Sfocus_frame
, 1, 1, 0,
3307 "This function is obsolete, and does nothing.")
3314 DEFUN ("unfocus-frame", Funfocus_frame
, Sunfocus_frame
, 0, 0, 0,
3315 "This function is obsolete, and does nothing.")
3321 DEFUN ("x-list-fonts", Fx_list_fonts
, Sx_list_fonts
, 1, 3, 0,
3322 "Return a list of the names of available fonts matching PATTERN.\n\
3323 If optional arguments FACE and FRAME are specified, return only fonts\n\
3324 the same size as FACE on FRAME.\n\
3326 PATTERN is a string, perhaps with wildcard characters;\n\
3327 the * character matches any substring, and\n\
3328 the ? character matches any single character.\n\
3329 PATTERN is case-insensitive.\n\
3330 FACE is a face name--a symbol.\n\
3332 The return value is a list of strings, suitable as arguments to\n\
3335 Fonts Emacs can't use (i.e. proportional fonts) may or may not be excluded\n\
3336 even if they match PATTERN and FACE.")
3337 (pattern
, face
, frame
)
3338 Lisp_Object pattern
, face
, frame
;
3342 #ifndef BROKEN_XLISTFONTSWITHINFO
3345 XFontStruct
*size_ref
;
3350 CHECK_STRING (pattern
, 0);
3352 CHECK_SYMBOL (face
, 1);
3354 f
= check_x_frame (frame
);
3356 /* Determine the width standard for comparison with the fonts we find. */
3364 /* Don't die if we get called with a terminal frame. */
3365 if (! FRAME_X_P (f
))
3366 error ("Non-X frame used in `x-list-fonts'");
3368 face_id
= face_name_id_number (f
, face
);
3370 if (face_id
< 0 || face_id
>= FRAME_N_PARAM_FACES (f
)
3371 || FRAME_PARAM_FACES (f
) [face_id
] == 0)
3372 size_ref
= f
->output_data
.x
->font
;
3375 size_ref
= FRAME_PARAM_FACES (f
) [face_id
]->font
;
3376 if (size_ref
== (XFontStruct
*) (~0))
3377 size_ref
= f
->output_data
.x
->font
;
3381 /* See if we cached the result for this particular query. */
3382 list
= Fassoc (pattern
,
3383 XCONS (FRAME_X_DISPLAY_INFO (f
)->name_list_element
)->cdr
);
3385 /* We have info in the cache for this PATTERN. */
3388 Lisp_Object tem
, newlist
;
3390 /* We have info about this pattern. */
3391 list
= XCONS (list
)->cdr
;
3398 /* Filter the cached info and return just the fonts that match FACE. */
3400 for (tem
= list
; CONSP (tem
); tem
= XCONS (tem
)->cdr
)
3402 XFontStruct
*thisinfo
;
3404 x_catch_errors (FRAME_X_DISPLAY (f
));
3406 thisinfo
= XLoadQueryFont (FRAME_X_DISPLAY (f
),
3407 XSTRING (XCONS (tem
)->car
)->data
);
3409 x_check_errors (FRAME_X_DISPLAY (f
), "XLoadQueryFont failure: %s");
3410 x_uncatch_errors (FRAME_X_DISPLAY (f
));
3412 if (thisinfo
&& same_size_fonts (thisinfo
, size_ref
))
3413 newlist
= Fcons (XCONS (tem
)->car
, newlist
);
3416 XFreeFont (FRAME_X_DISPLAY (f
), thisinfo
);
3426 x_catch_errors (FRAME_X_DISPLAY (f
));
3428 /* Solaris 2.3 has a bug in XListFontsWithInfo. */
3429 #ifndef BROKEN_XLISTFONTSWITHINFO
3431 names
= XListFontsWithInfo (FRAME_X_DISPLAY (f
),
3432 XSTRING (pattern
)->data
,
3433 2000, /* maxnames */
3434 &num_fonts
, /* count_return */
3435 &info
); /* info_return */
3438 names
= XListFonts (FRAME_X_DISPLAY (f
),
3439 XSTRING (pattern
)->data
,
3440 2000, /* maxnames */
3441 &num_fonts
); /* count_return */
3443 x_check_errors (FRAME_X_DISPLAY (f
), "XListFonts failure: %s");
3444 x_uncatch_errors (FRAME_X_DISPLAY (f
));
3453 Lisp_Object full_list
;
3455 /* Make a list of all the fonts we got back.
3456 Store that in the font cache for the display. */
3458 for (i
= 0; i
< num_fonts
; i
++)
3459 full_list
= Fcons (build_string (names
[i
]), full_list
);
3460 XCONS (FRAME_X_DISPLAY_INFO (f
)->name_list_element
)->cdr
3461 = Fcons (Fcons (pattern
, full_list
),
3462 XCONS (FRAME_X_DISPLAY_INFO (f
)->name_list_element
)->cdr
);
3464 /* Make a list of the fonts that have the right width. */
3466 for (i
= 0; i
< num_fonts
; i
++)
3474 #ifdef BROKEN_XLISTFONTSWITHINFO
3475 XFontStruct
*thisinfo
;
3479 x_catch_errors (FRAME_X_DISPLAY (f
));
3480 thisinfo
= XLoadQueryFont (FRAME_X_DISPLAY (f
), names
[i
]);
3481 x_check_errors (FRAME_X_DISPLAY (f
),
3482 "XLoadQueryFont failure: %s");
3483 x_uncatch_errors (FRAME_X_DISPLAY (f
));
3487 keeper
= thisinfo
&& same_size_fonts (thisinfo
, size_ref
);
3489 if (thisinfo
&& ! keeper
)
3490 XFreeFont (FRAME_X_DISPLAY (f
), thisinfo
);
3492 XFreeFontInfo (NULL
, thisinfo
, 1);
3495 keeper
= same_size_fonts (&info
[i
], size_ref
);
3499 list
= Fcons (build_string (names
[i
]), list
);
3501 list
= Fnreverse (list
);
3504 #ifndef BROKEN_XLISTFONTSWITHINFO
3506 XFreeFontInfo (names
, info
, num_fonts
);
3509 XFreeFontNames (names
);
3517 DEFUN ("x-color-defined-p", Fx_color_defined_p
, Sx_color_defined_p
, 1, 2, 0,
3518 "Return non-nil if color COLOR is supported on frame FRAME.\n\
3519 If FRAME is omitted or nil, use the selected frame.")
3521 Lisp_Object color
, frame
;
3524 FRAME_PTR f
= check_x_frame (frame
);
3526 CHECK_STRING (color
, 1);
3528 if (defined_color (f
, XSTRING (color
)->data
, &foo
, 0))
3534 DEFUN ("x-color-values", Fx_color_values
, Sx_color_values
, 1, 2, 0,
3535 "Return a description of the color named COLOR on frame FRAME.\n\
3536 The value is a list of integer RGB values--(RED GREEN BLUE).\n\
3537 These values appear to range from 0 to 65280 or 65535, depending\n\
3538 on the system; white is (65280 65280 65280) or (65535 65535 65535).\n\
3539 If FRAME is omitted or nil, use the selected frame.")
3541 Lisp_Object color
, frame
;
3544 FRAME_PTR f
= check_x_frame (frame
);
3546 CHECK_STRING (color
, 1);
3548 if (defined_color (f
, XSTRING (color
)->data
, &foo
, 0))
3552 rgb
[0] = make_number (foo
.red
);
3553 rgb
[1] = make_number (foo
.green
);
3554 rgb
[2] = make_number (foo
.blue
);
3555 return Flist (3, rgb
);
3561 DEFUN ("x-display-color-p", Fx_display_color_p
, Sx_display_color_p
, 0, 1, 0,
3562 "Return t if the X display supports color.\n\
3563 The optional argument DISPLAY specifies which display to ask about.\n\
3564 DISPLAY should be either a frame or a display name (a string).\n\
3565 If omitted or nil, that stands for the selected frame's display.")
3567 Lisp_Object display
;
3569 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
3571 if (dpyinfo
->n_planes
<= 2)
3574 switch (dpyinfo
->visual
->class)
3587 DEFUN ("x-display-grayscale-p", Fx_display_grayscale_p
, Sx_display_grayscale_p
,
3589 "Return t if the X display supports shades of gray.\n\
3590 Note that color displays do support shades of gray.\n\
3591 The optional argument DISPLAY specifies which display to ask about.\n\
3592 DISPLAY should be either a frame or a display name (a string).\n\
3593 If omitted or nil, that stands for the selected frame's display.")
3595 Lisp_Object display
;
3597 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
3599 if (dpyinfo
->n_planes
<= 1)
3602 switch (dpyinfo
->visual
->class)
3617 DEFUN ("x-display-pixel-width", Fx_display_pixel_width
, Sx_display_pixel_width
,
3619 "Returns the width in pixels of the X display DISPLAY.\n\
3620 The optional argument DISPLAY specifies which display to ask about.\n\
3621 DISPLAY should be either a frame or a display name (a string).\n\
3622 If omitted or nil, that stands for the selected frame's display.")
3624 Lisp_Object display
;
3626 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
3628 return make_number (dpyinfo
->width
);
3631 DEFUN ("x-display-pixel-height", Fx_display_pixel_height
,
3632 Sx_display_pixel_height
, 0, 1, 0,
3633 "Returns the height in pixels of the X display DISPLAY.\n\
3634 The optional argument DISPLAY specifies which display to ask about.\n\
3635 DISPLAY should be either a frame or a display name (a string).\n\
3636 If omitted or nil, that stands for the selected frame's display.")
3638 Lisp_Object display
;
3640 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
3642 return make_number (dpyinfo
->height
);
3645 DEFUN ("x-display-planes", Fx_display_planes
, Sx_display_planes
,
3647 "Returns the number of bitplanes of the X display DISPLAY.\n\
3648 The optional argument DISPLAY specifies which display to ask about.\n\
3649 DISPLAY should be either a frame or a display name (a string).\n\
3650 If omitted or nil, that stands for the selected frame's display.")
3652 Lisp_Object display
;
3654 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
3656 return make_number (dpyinfo
->n_planes
);
3659 DEFUN ("x-display-color-cells", Fx_display_color_cells
, Sx_display_color_cells
,
3661 "Returns the number of color cells of the X display DISPLAY.\n\
3662 The optional argument DISPLAY specifies which display to ask about.\n\
3663 DISPLAY should be either a frame or a display name (a string).\n\
3664 If omitted or nil, that stands for the selected frame's display.")
3666 Lisp_Object display
;
3668 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
3670 return make_number (DisplayCells (dpyinfo
->display
,
3671 XScreenNumberOfScreen (dpyinfo
->screen
)));
3674 DEFUN ("x-server-max-request-size", Fx_server_max_request_size
,
3675 Sx_server_max_request_size
,
3677 "Returns the maximum request size of the X server of display DISPLAY.\n\
3678 The optional argument DISPLAY specifies which display to ask about.\n\
3679 DISPLAY should be either a frame or a display name (a string).\n\
3680 If omitted or nil, that stands for the selected frame's display.")
3682 Lisp_Object display
;
3684 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
3686 return make_number (MAXREQUEST (dpyinfo
->display
));
3689 DEFUN ("x-server-vendor", Fx_server_vendor
, Sx_server_vendor
, 0, 1, 0,
3690 "Returns the vendor ID string of the X server of display DISPLAY.\n\
3691 The optional argument DISPLAY specifies which display to ask about.\n\
3692 DISPLAY should be either a frame or a display name (a string).\n\
3693 If omitted or nil, that stands for the selected frame's display.")
3695 Lisp_Object display
;
3697 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
3698 char *vendor
= ServerVendor (dpyinfo
->display
);
3700 if (! vendor
) vendor
= "";
3701 return build_string (vendor
);
3704 DEFUN ("x-server-version", Fx_server_version
, Sx_server_version
, 0, 1, 0,
3705 "Returns the version numbers of the X server of display DISPLAY.\n\
3706 The value is a list of three integers: the major and minor\n\
3707 version numbers of the X Protocol in use, and the vendor-specific release\n\
3708 number. See also the function `x-server-vendor'.\n\n\
3709 The optional argument DISPLAY specifies which display to ask about.\n\
3710 DISPLAY should be either a frame or a display name (a string).\n\
3711 If omitted or nil, that stands for the selected frame's display.")
3713 Lisp_Object display
;
3715 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
3716 Display
*dpy
= dpyinfo
->display
;
3718 return Fcons (make_number (ProtocolVersion (dpy
)),
3719 Fcons (make_number (ProtocolRevision (dpy
)),
3720 Fcons (make_number (VendorRelease (dpy
)), Qnil
)));
3723 DEFUN ("x-display-screens", Fx_display_screens
, Sx_display_screens
, 0, 1, 0,
3724 "Returns the number of screens on the X server of display DISPLAY.\n\
3725 The optional argument DISPLAY specifies which display to ask about.\n\
3726 DISPLAY should be either a frame or a display name (a string).\n\
3727 If omitted or nil, that stands for the selected frame's display.")
3729 Lisp_Object display
;
3731 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
3733 return make_number (ScreenCount (dpyinfo
->display
));
3736 DEFUN ("x-display-mm-height", Fx_display_mm_height
, Sx_display_mm_height
, 0, 1, 0,
3737 "Returns the height in millimeters of the X display DISPLAY.\n\
3738 The optional argument DISPLAY specifies which display to ask about.\n\
3739 DISPLAY should be either a frame or a display name (a string).\n\
3740 If omitted or nil, that stands for the selected frame's display.")
3742 Lisp_Object display
;
3744 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
3746 return make_number (HeightMMOfScreen (dpyinfo
->screen
));
3749 DEFUN ("x-display-mm-width", Fx_display_mm_width
, Sx_display_mm_width
, 0, 1, 0,
3750 "Returns the width in millimeters of the X display DISPLAY.\n\
3751 The optional argument DISPLAY specifies which display to ask about.\n\
3752 DISPLAY should be either a frame or a display name (a string).\n\
3753 If omitted or nil, that stands for the selected frame's display.")
3755 Lisp_Object display
;
3757 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
3759 return make_number (WidthMMOfScreen (dpyinfo
->screen
));
3762 DEFUN ("x-display-backing-store", Fx_display_backing_store
,
3763 Sx_display_backing_store
, 0, 1, 0,
3764 "Returns an indication of whether X display DISPLAY does backing store.\n\
3765 The value may be `always', `when-mapped', or `not-useful'.\n\
3766 The optional argument DISPLAY specifies which display to ask about.\n\
3767 DISPLAY should be either a frame or a display name (a string).\n\
3768 If omitted or nil, that stands for the selected frame's display.")
3770 Lisp_Object display
;
3772 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
3774 switch (DoesBackingStore (dpyinfo
->screen
))
3777 return intern ("always");
3780 return intern ("when-mapped");
3783 return intern ("not-useful");
3786 error ("Strange value for BackingStore parameter of screen");
3790 DEFUN ("x-display-visual-class", Fx_display_visual_class
,
3791 Sx_display_visual_class
, 0, 1, 0,
3792 "Returns the visual class of the X display DISPLAY.\n\
3793 The value is one of the symbols `static-gray', `gray-scale',\n\
3794 `static-color', `pseudo-color', `true-color', or `direct-color'.\n\n\
3795 The optional argument DISPLAY specifies which display to ask about.\n\
3796 DISPLAY should be either a frame or a display name (a string).\n\
3797 If omitted or nil, that stands for the selected frame's display.")
3799 Lisp_Object display
;
3801 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
3803 switch (dpyinfo
->visual
->class)
3805 case StaticGray
: return (intern ("static-gray"));
3806 case GrayScale
: return (intern ("gray-scale"));
3807 case StaticColor
: return (intern ("static-color"));
3808 case PseudoColor
: return (intern ("pseudo-color"));
3809 case TrueColor
: return (intern ("true-color"));
3810 case DirectColor
: return (intern ("direct-color"));
3812 error ("Display has an unknown visual class");
3816 DEFUN ("x-display-save-under", Fx_display_save_under
,
3817 Sx_display_save_under
, 0, 1, 0,
3818 "Returns t if the X display DISPLAY supports the save-under feature.\n\
3819 The optional argument DISPLAY specifies which display to ask about.\n\
3820 DISPLAY should be either a frame or a display name (a string).\n\
3821 If omitted or nil, that stands for the selected frame's display.")
3823 Lisp_Object display
;
3825 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
3827 if (DoesSaveUnders (dpyinfo
->screen
) == True
)
3835 register struct frame
*f
;
3837 return PIXEL_WIDTH (f
);
3842 register struct frame
*f
;
3844 return PIXEL_HEIGHT (f
);
3849 register struct frame
*f
;
3851 return FONT_WIDTH (f
->output_data
.x
->font
);
3856 register struct frame
*f
;
3858 return f
->output_data
.x
->line_height
;
3862 x_screen_planes (frame
)
3865 return FRAME_X_DISPLAY_INFO (XFRAME (frame
))->n_planes
;
3868 #if 0 /* These no longer seem like the right way to do things. */
3870 /* Draw a rectangle on the frame with left top corner including
3871 the character specified by LEFT_CHAR and TOP_CHAR. The rectangle is
3872 CHARS by LINES wide and long and is the color of the cursor. */
3875 x_rectangle (f
, gc
, left_char
, top_char
, chars
, lines
)
3876 register struct frame
*f
;
3878 register int top_char
, left_char
, chars
, lines
;
3882 int left
= (left_char
* FONT_WIDTH (f
->output_data
.x
->font
)
3883 + f
->output_data
.x
->internal_border_width
);
3884 int top
= (top_char
* f
->output_data
.x
->line_height
3885 + f
->output_data
.x
->internal_border_width
);
3888 width
= FONT_WIDTH (f
->output_data
.x
->font
) / 2;
3890 width
= FONT_WIDTH (f
->output_data
.x
->font
) * chars
;
3892 height
= f
->output_data
.x
->line_height
/ 2;
3894 height
= f
->output_data
.x
->line_height
* lines
;
3896 XDrawRectangle (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
3897 gc
, left
, top
, width
, height
);
3900 DEFUN ("x-draw-rectangle", Fx_draw_rectangle
, Sx_draw_rectangle
, 5, 5, 0,
3901 "Draw a rectangle on FRAME between coordinates specified by\n\
3902 numbers X0, Y0, X1, Y1 in the cursor pixel.")
3903 (frame
, X0
, Y0
, X1
, Y1
)
3904 register Lisp_Object frame
, X0
, X1
, Y0
, Y1
;
3906 register int x0
, y0
, x1
, y1
, top
, left
, n_chars
, n_lines
;
3908 CHECK_LIVE_FRAME (frame
, 0);
3909 CHECK_NUMBER (X0
, 0);
3910 CHECK_NUMBER (Y0
, 1);
3911 CHECK_NUMBER (X1
, 2);
3912 CHECK_NUMBER (Y1
, 3);
3922 n_lines
= y1
- y0
+ 1;
3927 n_lines
= y0
- y1
+ 1;
3933 n_chars
= x1
- x0
+ 1;
3938 n_chars
= x0
- x1
+ 1;
3942 x_rectangle (XFRAME (frame
), XFRAME (frame
)->output_data
.x
->cursor_gc
,
3943 left
, top
, n_chars
, n_lines
);
3949 DEFUN ("x-erase-rectangle", Fx_erase_rectangle
, Sx_erase_rectangle
, 5, 5, 0,
3950 "Draw a rectangle drawn on FRAME between coordinates\n\
3951 X0, Y0, X1, Y1 in the regular background-pixel.")
3952 (frame
, X0
, Y0
, X1
, Y1
)
3953 register Lisp_Object frame
, X0
, Y0
, X1
, Y1
;
3955 register int x0
, y0
, x1
, y1
, top
, left
, n_chars
, n_lines
;
3957 CHECK_LIVE_FRAME (frame
, 0);
3958 CHECK_NUMBER (X0
, 0);
3959 CHECK_NUMBER (Y0
, 1);
3960 CHECK_NUMBER (X1
, 2);
3961 CHECK_NUMBER (Y1
, 3);
3971 n_lines
= y1
- y0
+ 1;
3976 n_lines
= y0
- y1
+ 1;
3982 n_chars
= x1
- x0
+ 1;
3987 n_chars
= x0
- x1
+ 1;
3991 x_rectangle (XFRAME (frame
), XFRAME (frame
)->output_data
.x
->reverse_gc
,
3992 left
, top
, n_chars
, n_lines
);
3998 /* Draw lines around the text region beginning at the character position
3999 TOP_X, TOP_Y and ending at BOTTOM_X and BOTTOM_Y. GC specifies the
4000 pixel and line characteristics. */
4002 #define line_len(line) (FRAME_CURRENT_GLYPHS (f)->used[(line)])
4005 outline_region (f
, gc
, top_x
, top_y
, bottom_x
, bottom_y
)
4006 register struct frame
*f
;
4008 int top_x
, top_y
, bottom_x
, bottom_y
;
4010 register int ibw
= f
->output_data
.x
->internal_border_width
;
4011 register int font_w
= FONT_WIDTH (f
->output_data
.x
->font
);
4012 register int font_h
= f
->output_data
.x
->line_height
;
4014 int x
= line_len (y
);
4015 XPoint
*pixel_points
4016 = (XPoint
*) alloca (((bottom_y
- top_y
+ 2) * 4) * sizeof (XPoint
));
4017 register XPoint
*this_point
= pixel_points
;
4019 /* Do the horizontal top line/lines */
4022 this_point
->x
= ibw
;
4023 this_point
->y
= ibw
+ (font_h
* top_y
);
4026 this_point
->x
= ibw
+ (font_w
/ 2); /* Half-size for newline chars. */
4028 this_point
->x
= ibw
+ (font_w
* x
);
4029 this_point
->y
= (this_point
- 1)->y
;
4033 this_point
->x
= ibw
;
4034 this_point
->y
= ibw
+ (font_h
* (top_y
+ 1));
4036 this_point
->x
= ibw
+ (font_w
* top_x
);
4037 this_point
->y
= (this_point
- 1)->y
;
4039 this_point
->x
= (this_point
- 1)->x
;
4040 this_point
->y
= ibw
+ (font_h
* top_y
);
4042 this_point
->x
= ibw
+ (font_w
* x
);
4043 this_point
->y
= (this_point
- 1)->y
;
4046 /* Now do the right side. */
4047 while (y
< bottom_y
)
4048 { /* Right vertical edge */
4050 this_point
->x
= (this_point
- 1)->x
;
4051 this_point
->y
= ibw
+ (font_h
* (y
+ 1));
4054 y
++; /* Horizontal connection to next line */
4057 this_point
->x
= ibw
+ (font_w
/ 2);
4059 this_point
->x
= ibw
+ (font_w
* x
);
4061 this_point
->y
= (this_point
- 1)->y
;
4064 /* Now do the bottom and connect to the top left point. */
4065 this_point
->x
= ibw
+ (font_w
* (bottom_x
+ 1));
4068 this_point
->x
= (this_point
- 1)->x
;
4069 this_point
->y
= ibw
+ (font_h
* (bottom_y
+ 1));
4071 this_point
->x
= ibw
;
4072 this_point
->y
= (this_point
- 1)->y
;
4074 this_point
->x
= pixel_points
->x
;
4075 this_point
->y
= pixel_points
->y
;
4077 XDrawLines (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
4079 (this_point
- pixel_points
+ 1), CoordModeOrigin
);
4082 DEFUN ("x-contour-region", Fx_contour_region
, Sx_contour_region
, 1, 1, 0,
4083 "Highlight the region between point and the character under the mouse\n\
4086 register Lisp_Object event
;
4088 register int x0
, y0
, x1
, y1
;
4089 register struct frame
*f
= selected_frame
;
4090 register int p1
, p2
;
4092 CHECK_CONS (event
, 0);
4095 x0
= XINT (Fcar (Fcar (event
)));
4096 y0
= XINT (Fcar (Fcdr (Fcar (event
))));
4098 /* If the mouse is past the end of the line, don't that area. */
4099 /* ReWrite this... */
4104 if (y1
> y0
) /* point below mouse */
4105 outline_region (f
, f
->output_data
.x
->cursor_gc
,
4107 else if (y1
< y0
) /* point above mouse */
4108 outline_region (f
, f
->output_data
.x
->cursor_gc
,
4110 else /* same line: draw horizontal rectangle */
4113 x_rectangle (f
, f
->output_data
.x
->cursor_gc
,
4114 x0
, y0
, (x1
- x0
+ 1), 1);
4116 x_rectangle (f
, f
->output_data
.x
->cursor_gc
,
4117 x1
, y1
, (x0
- x1
+ 1), 1);
4120 XFlush (FRAME_X_DISPLAY (f
));
4126 DEFUN ("x-uncontour-region", Fx_uncontour_region
, Sx_uncontour_region
, 1, 1, 0,
4127 "Erase any highlighting of the region between point and the character\n\
4128 at X, Y on the selected frame.")
4130 register Lisp_Object event
;
4132 register int x0
, y0
, x1
, y1
;
4133 register struct frame
*f
= selected_frame
;
4136 x0
= XINT (Fcar (Fcar (event
)));
4137 y0
= XINT (Fcar (Fcdr (Fcar (event
))));
4141 if (y1
> y0
) /* point below mouse */
4142 outline_region (f
, f
->output_data
.x
->reverse_gc
,
4144 else if (y1
< y0
) /* point above mouse */
4145 outline_region (f
, f
->output_data
.x
->reverse_gc
,
4147 else /* same line: draw horizontal rectangle */
4150 x_rectangle (f
, f
->output_data
.x
->reverse_gc
,
4151 x0
, y0
, (x1
- x0
+ 1), 1);
4153 x_rectangle (f
, f
->output_data
.x
->reverse_gc
,
4154 x1
, y1
, (x0
- x1
+ 1), 1);
4162 int contour_begin_x
, contour_begin_y
;
4163 int contour_end_x
, contour_end_y
;
4164 int contour_npoints
;
4166 /* Clip the top part of the contour lines down (and including) line Y_POS.
4167 If X_POS is in the middle (rather than at the end) of the line, drop
4168 down a line at that character. */
4171 clip_contour_top (y_pos
, x_pos
)
4173 register XPoint
*begin
= contour_lines
[y_pos
].top_left
;
4174 register XPoint
*end
;
4175 register int npoints
;
4176 register struct display_line
*line
= selected_frame
->phys_lines
[y_pos
+ 1];
4178 if (x_pos
>= line
->len
- 1) /* Draw one, straight horizontal line. */
4180 end
= contour_lines
[y_pos
].top_right
;
4181 npoints
= (end
- begin
+ 1);
4182 XDrawLines (x_current_display
, contour_window
,
4183 contour_erase_gc
, begin_erase
, npoints
, CoordModeOrigin
);
4185 bcopy (end
, begin
+ 1, contour_last_point
- end
+ 1);
4186 contour_last_point
-= (npoints
- 2);
4187 XDrawLines (x_current_display
, contour_window
,
4188 contour_erase_gc
, begin
, 2, CoordModeOrigin
);
4189 XFlush (x_current_display
);
4191 /* Now, update contour_lines structure. */
4196 register XPoint
*p
= begin
+ 1;
4197 end
= contour_lines
[y_pos
].bottom_right
;
4198 npoints
= (end
- begin
+ 1);
4199 XDrawLines (x_current_display
, contour_window
,
4200 contour_erase_gc
, begin_erase
, npoints
, CoordModeOrigin
);
4203 p
->x
= ibw
+ (font_w
* (x_pos
+ 1));
4205 p
->y
= begin
->y
+ font_h
;
4207 bcopy (end
, begin
+ 3, contour_last_point
- end
+ 1);
4208 contour_last_point
-= (npoints
- 5);
4209 XDrawLines (x_current_display
, contour_window
,
4210 contour_erase_gc
, begin
, 4, CoordModeOrigin
);
4211 XFlush (x_current_display
);
4213 /* Now, update contour_lines structure. */
4217 /* Erase the top horizontal lines of the contour, and then extend
4218 the contour upwards. */
4221 extend_contour_top (line
)
4226 clip_contour_bottom (x_pos
, y_pos
)
4232 extend_contour_bottom (x_pos
, y_pos
)
4236 DEFUN ("x-select-region", Fx_select_region
, Sx_select_region
, 1, 1, "e",
4241 register struct frame
*f
= selected_frame
;
4242 register int point_x
= f
->cursor_x
;
4243 register int point_y
= f
->cursor_y
;
4244 register int mouse_below_point
;
4245 register Lisp_Object obj
;
4246 register int x_contour_x
, x_contour_y
;
4248 x_contour_x
= x_mouse_x
;
4249 x_contour_y
= x_mouse_y
;
4250 if (x_contour_y
> point_y
|| (x_contour_y
== point_y
4251 && x_contour_x
> point_x
))
4253 mouse_below_point
= 1;
4254 outline_region (f
, f
->output_data
.x
->cursor_gc
, point_x
, point_y
,
4255 x_contour_x
, x_contour_y
);
4259 mouse_below_point
= 0;
4260 outline_region (f
, f
->output_data
.x
->cursor_gc
, x_contour_x
, x_contour_y
,
4266 obj
= read_char (-1, 0, 0, Qnil
, 0);
4270 if (mouse_below_point
)
4272 if (x_mouse_y
<= point_y
) /* Flipped. */
4274 mouse_below_point
= 0;
4276 outline_region (f
, f
->output_data
.x
->reverse_gc
, point_x
, point_y
,
4277 x_contour_x
, x_contour_y
);
4278 outline_region (f
, f
->output_data
.x
->cursor_gc
, x_mouse_x
, x_mouse_y
,
4281 else if (x_mouse_y
< x_contour_y
) /* Bottom clipped. */
4283 clip_contour_bottom (x_mouse_y
);
4285 else if (x_mouse_y
> x_contour_y
) /* Bottom extended. */
4287 extend_bottom_contour (x_mouse_y
);
4290 x_contour_x
= x_mouse_x
;
4291 x_contour_y
= x_mouse_y
;
4293 else /* mouse above or same line as point */
4295 if (x_mouse_y
>= point_y
) /* Flipped. */
4297 mouse_below_point
= 1;
4299 outline_region (f
, f
->output_data
.x
->reverse_gc
,
4300 x_contour_x
, x_contour_y
, point_x
, point_y
);
4301 outline_region (f
, f
->output_data
.x
->cursor_gc
, point_x
, point_y
,
4302 x_mouse_x
, x_mouse_y
);
4304 else if (x_mouse_y
> x_contour_y
) /* Top clipped. */
4306 clip_contour_top (x_mouse_y
);
4308 else if (x_mouse_y
< x_contour_y
) /* Top extended. */
4310 extend_contour_top (x_mouse_y
);
4315 unread_command_event
= obj
;
4316 if (mouse_below_point
)
4318 contour_begin_x
= point_x
;
4319 contour_begin_y
= point_y
;
4320 contour_end_x
= x_contour_x
;
4321 contour_end_y
= x_contour_y
;
4325 contour_begin_x
= x_contour_x
;
4326 contour_begin_y
= x_contour_y
;
4327 contour_end_x
= point_x
;
4328 contour_end_y
= point_y
;
4333 DEFUN ("x-horizontal-line", Fx_horizontal_line
, Sx_horizontal_line
, 1, 1, "e",
4338 register Lisp_Object obj
;
4339 struct frame
*f
= selected_frame
;
4340 register struct window
*w
= XWINDOW (selected_window
);
4341 register GC line_gc
= f
->output_data
.x
->cursor_gc
;
4342 register GC erase_gc
= f
->output_data
.x
->reverse_gc
;
4344 char dash_list
[] = {6, 4, 6, 4};
4346 XGCValues gc_values
;
4348 register int previous_y
;
4349 register int line
= (x_mouse_y
+ 1) * f
->output_data
.x
->line_height
4350 + f
->output_data
.x
->internal_border_width
;
4351 register int left
= f
->output_data
.x
->internal_border_width
4353 * FONT_WIDTH (f
->output_data
.x
->font
));
4354 register int right
= left
+ (w
->width
4355 * FONT_WIDTH (f
->output_data
.x
->font
))
4356 - f
->output_data
.x
->internal_border_width
;
4360 gc_values
.foreground
= f
->output_data
.x
->cursor_pixel
;
4361 gc_values
.background
= f
->output_data
.x
->background_pixel
;
4362 gc_values
.line_width
= 1;
4363 gc_values
.line_style
= LineOnOffDash
;
4364 gc_values
.cap_style
= CapRound
;
4365 gc_values
.join_style
= JoinRound
;
4367 line_gc
= XCreateGC (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
4368 GCLineStyle
| GCJoinStyle
| GCCapStyle
4369 | GCLineWidth
| GCForeground
| GCBackground
,
4371 XSetDashes (FRAME_X_DISPLAY (f
), line_gc
, 0, dash_list
, dashes
);
4372 gc_values
.foreground
= f
->output_data
.x
->background_pixel
;
4373 gc_values
.background
= f
->output_data
.x
->foreground_pixel
;
4374 erase_gc
= XCreateGC (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
4375 GCLineStyle
| GCJoinStyle
| GCCapStyle
4376 | GCLineWidth
| GCForeground
| GCBackground
,
4378 XSetDashes (FRAME_X_DISPLAY (f
), erase_gc
, 0, dash_list
, dashes
);
4385 if (x_mouse_y
>= XINT (w
->top
)
4386 && x_mouse_y
< XINT (w
->top
) + XINT (w
->height
) - 1)
4388 previous_y
= x_mouse_y
;
4389 line
= (x_mouse_y
+ 1) * f
->output_data
.x
->line_height
4390 + f
->output_data
.x
->internal_border_width
;
4391 XDrawLine (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
4392 line_gc
, left
, line
, right
, line
);
4394 XFlush (FRAME_X_DISPLAY (f
));
4399 obj
= read_char (-1, 0, 0, Qnil
, 0);
4401 || (! EQ (Fcar (Fcdr (Fcdr (obj
))),
4402 Qvertical_scroll_bar
))
4406 XDrawLine (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
4407 erase_gc
, left
, line
, right
, line
);
4408 unread_command_event
= obj
;
4410 XFreeGC (FRAME_X_DISPLAY (f
), line_gc
);
4411 XFreeGC (FRAME_X_DISPLAY (f
), erase_gc
);
4417 while (x_mouse_y
== previous_y
);
4420 XDrawLine (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
4421 erase_gc
, left
, line
, right
, line
);
4428 /* These keep track of the rectangle following the pointer. */
4429 int mouse_track_top
, mouse_track_left
, mouse_track_width
;
4431 /* Offset in buffer of character under the pointer, or 0. */
4432 int mouse_buffer_offset
;
4434 DEFUN ("x-track-pointer", Fx_track_pointer
, Sx_track_pointer
, 0, 0, 0,
4435 "Track the pointer.")
4438 static Cursor current_pointer_shape
;
4439 FRAME_PTR f
= x_mouse_frame
;
4442 if (EQ (Vmouse_frame_part
, Qtext_part
)
4443 && (current_pointer_shape
!= f
->output_data
.x
->nontext_cursor
))
4448 current_pointer_shape
= f
->output_data
.x
->nontext_cursor
;
4449 XDefineCursor (FRAME_X_DISPLAY (f
),
4451 current_pointer_shape
);
4453 buf
= XBUFFER (XWINDOW (Vmouse_window
)->buffer
);
4454 c
= *(BUF_CHAR_ADDRESS (buf
, mouse_buffer_offset
));
4456 else if (EQ (Vmouse_frame_part
, Qmodeline_part
)
4457 && (current_pointer_shape
!= f
->output_data
.x
->modeline_cursor
))
4459 current_pointer_shape
= f
->output_data
.x
->modeline_cursor
;
4460 XDefineCursor (FRAME_X_DISPLAY (f
),
4462 current_pointer_shape
);
4465 XFlush (FRAME_X_DISPLAY (f
));
4471 DEFUN ("x-track-pointer", Fx_track_pointer
, Sx_track_pointer
, 1, 1, "e",
4472 "Draw rectangle around character under mouse pointer, if there is one.")
4476 struct window
*w
= XWINDOW (Vmouse_window
);
4477 struct frame
*f
= XFRAME (WINDOW_FRAME (w
));
4478 struct buffer
*b
= XBUFFER (w
->buffer
);
4481 if (! EQ (Vmouse_window
, selected_window
))
4484 if (EQ (event
, Qnil
))
4488 x_read_mouse_position (selected_frame
, &x
, &y
);
4492 mouse_track_width
= 0;
4493 mouse_track_left
= mouse_track_top
= -1;
4497 if ((x_mouse_x
!= mouse_track_left
4498 && (x_mouse_x
< mouse_track_left
4499 || x_mouse_x
> (mouse_track_left
+ mouse_track_width
)))
4500 || x_mouse_y
!= mouse_track_top
)
4502 int hp
= 0; /* Horizontal position */
4503 int len
= FRAME_CURRENT_GLYPHS (f
)->used
[x_mouse_y
];
4504 int p
= FRAME_CURRENT_GLYPHS (f
)->bufp
[x_mouse_y
];
4505 int tab_width
= XINT (b
->tab_width
);
4506 int ctl_arrow_p
= !NILP (b
->ctl_arrow
);
4508 int mode_line_vpos
= XFASTINT (w
->height
) + XFASTINT (w
->top
) - 1;
4509 int in_mode_line
= 0;
4511 if (! FRAME_CURRENT_GLYPHS (f
)->enable
[x_mouse_y
])
4514 /* Erase previous rectangle. */
4515 if (mouse_track_width
)
4517 x_rectangle (f
, f
->output_data
.x
->reverse_gc
,
4518 mouse_track_left
, mouse_track_top
,
4519 mouse_track_width
, 1);
4521 if ((mouse_track_left
== f
->phys_cursor_x
4522 || mouse_track_left
== f
->phys_cursor_x
- 1)
4523 && mouse_track_top
== f
->phys_cursor_y
)
4525 x_display_cursor (f
, 1);
4529 mouse_track_left
= x_mouse_x
;
4530 mouse_track_top
= x_mouse_y
;
4531 mouse_track_width
= 0;
4533 if (mouse_track_left
> len
) /* Past the end of line. */
4536 if (mouse_track_top
== mode_line_vpos
)
4542 if (tab_width
<= 0 || tab_width
> 20) tab_width
= 8;
4546 if (len
== f
->width
&& hp
== len
- 1 && c
!= '\n')
4552 mouse_track_width
= tab_width
- (hp
% tab_width
);
4554 hp
+= mouse_track_width
;
4557 mouse_track_left
= hp
- mouse_track_width
;
4563 mouse_track_width
= -1;
4567 if (ctl_arrow_p
&& (c
< 040 || c
== 0177))
4572 mouse_track_width
= 2;
4577 mouse_track_left
= hp
- mouse_track_width
;
4583 mouse_track_width
= 1;
4590 while (hp
<= x_mouse_x
);
4593 if (mouse_track_width
) /* Over text; use text pointer shape. */
4595 XDefineCursor (FRAME_X_DISPLAY (f
),
4597 f
->output_data
.x
->text_cursor
);
4598 x_rectangle (f
, f
->output_data
.x
->cursor_gc
,
4599 mouse_track_left
, mouse_track_top
,
4600 mouse_track_width
, 1);
4602 else if (in_mode_line
)
4603 XDefineCursor (FRAME_X_DISPLAY (f
),
4605 f
->output_data
.x
->modeline_cursor
);
4607 XDefineCursor (FRAME_X_DISPLAY (f
),
4609 f
->output_data
.x
->nontext_cursor
);
4612 XFlush (FRAME_X_DISPLAY (f
));
4615 obj
= read_char (-1, 0, 0, Qnil
, 0);
4618 while (CONSP (obj
) /* Mouse event */
4619 && EQ (Fcar (Fcdr (Fcdr (obj
))), Qnil
) /* Not scroll bar */
4620 && EQ (Vmouse_depressed
, Qnil
) /* Only motion events */
4621 && EQ (Vmouse_window
, selected_window
) /* In this window */
4624 unread_command_event
= obj
;
4626 if (mouse_track_width
)
4628 x_rectangle (f
, f
->output_data
.x
->reverse_gc
,
4629 mouse_track_left
, mouse_track_top
,
4630 mouse_track_width
, 1);
4631 mouse_track_width
= 0;
4632 if ((mouse_track_left
== f
->phys_cursor_x
4633 || mouse_track_left
- 1 == f
->phys_cursor_x
)
4634 && mouse_track_top
== f
->phys_cursor_y
)
4636 x_display_cursor (f
, 1);
4639 XDefineCursor (FRAME_X_DISPLAY (f
),
4641 f
->output_data
.x
->nontext_cursor
);
4642 XFlush (FRAME_X_DISPLAY (f
));
4652 /* Draw a pixmap specified by IMAGE_DATA of dimensions WIDTH and HEIGHT
4653 on the frame F at position X, Y. */
4655 x_draw_pixmap (f
, x
, y
, image_data
, width
, height
)
4657 int x
, y
, width
, height
;
4662 image
= XCreateBitmapFromData (FRAME_X_DISPLAY (f
),
4663 FRAME_X_WINDOW (f
), image_data
,
4665 XCopyPlane (FRAME_X_DISPLAY (f
), image
, FRAME_X_WINDOW (f
),
4666 f
->output_data
.x
->normal_gc
, 0, 0, width
, height
, x
, y
);
4670 #if 0 /* I'm told these functions are superfluous
4671 given the ability to bind function keys. */
4674 DEFUN ("x-rebind-key", Fx_rebind_key
, Sx_rebind_key
, 3, 3, 0,
4675 "Rebind X keysym KEYSYM, with MODIFIERS, to generate NEWSTRING.\n\
4676 KEYSYM is a string which conforms to the X keysym definitions found\n\
4677 in X11/keysymdef.h, sans the initial XK_. MODIFIERS is nil or a\n\
4678 list of strings specifying modifier keys such as Control_L, which must\n\
4679 also be depressed for NEWSTRING to appear.")
4680 (x_keysym
, modifiers
, newstring
)
4681 register Lisp_Object x_keysym
;
4682 register Lisp_Object modifiers
;
4683 register Lisp_Object newstring
;
4686 register KeySym keysym
;
4687 KeySym modifier_list
[16];
4690 CHECK_STRING (x_keysym
, 1);
4691 CHECK_STRING (newstring
, 3);
4693 keysym
= XStringToKeysym ((char *) XSTRING (x_keysym
)->data
);
4694 if (keysym
== NoSymbol
)
4695 error ("Keysym does not exist");
4697 if (NILP (modifiers
))
4698 XRebindKeysym (x_current_display
, keysym
, modifier_list
, 0,
4699 XSTRING (newstring
)->data
, XSTRING (newstring
)->size
);
4702 register Lisp_Object rest
, mod
;
4705 for (rest
= modifiers
; !NILP (rest
); rest
= Fcdr (rest
))
4708 error ("Can't have more than 16 modifiers");
4711 CHECK_STRING (mod
, 3);
4712 modifier_list
[i
] = XStringToKeysym ((char *) XSTRING (mod
)->data
);
4714 if (modifier_list
[i
] == NoSymbol
4715 || !(IsModifierKey (modifier_list
[i
])
4716 || ((unsigned)(modifier_list
[i
]) == XK_Mode_switch
)
4717 || ((unsigned)(modifier_list
[i
]) == XK_Num_Lock
)))
4719 if (modifier_list
[i
] == NoSymbol
4720 || !IsModifierKey (modifier_list
[i
]))
4722 error ("Element is not a modifier keysym");
4726 XRebindKeysym (x_current_display
, keysym
, modifier_list
, i
,
4727 XSTRING (newstring
)->data
, XSTRING (newstring
)->size
);
4733 DEFUN ("x-rebind-keys", Fx_rebind_keys
, Sx_rebind_keys
, 2, 2, 0,
4734 "Rebind KEYCODE to list of strings STRINGS.\n\
4735 STRINGS should be a list of 16 elements, one for each shift combination.\n\
4736 nil as element means don't change.\n\
4737 See the documentation of `x-rebind-key' for more information.")
4739 register Lisp_Object keycode
;
4740 register Lisp_Object strings
;
4742 register Lisp_Object item
;
4743 register unsigned char *rawstring
;
4744 KeySym rawkey
, modifier
[1];
4746 register unsigned i
;
4749 CHECK_NUMBER (keycode
, 1);
4750 CHECK_CONS (strings
, 2);
4751 rawkey
= (KeySym
) ((unsigned) (XINT (keycode
))) & 255;
4752 for (i
= 0; i
<= 15; strings
= Fcdr (strings
), i
++)
4754 item
= Fcar (strings
);
4757 CHECK_STRING (item
, 2);
4758 strsize
= XSTRING (item
)->size
;
4759 rawstring
= (unsigned char *) xmalloc (strsize
);
4760 bcopy (XSTRING (item
)->data
, rawstring
, strsize
);
4761 modifier
[1] = 1 << i
;
4762 XRebindKeysym (x_current_display
, rawkey
, modifier
, 1,
4763 rawstring
, strsize
);
4768 #endif /* HAVE_X11 */
4771 #ifndef HAVE_XSCREENNUMBEROFSCREEN
4773 XScreenNumberOfScreen (scr
)
4774 register Screen
*scr
;
4776 register Display
*dpy
;
4777 register Screen
*dpyscr
;
4781 dpyscr
= dpy
->screens
;
4783 for (i
= 0; i
< dpy
->nscreens
; i
++, dpyscr
++)
4789 #endif /* not HAVE_XSCREENNUMBEROFSCREEN */
4792 select_visual (dpy
, screen
, depth
)
4795 unsigned int *depth
;
4798 XVisualInfo
*vinfo
, vinfo_template
;
4801 v
= DefaultVisualOfScreen (screen
);
4804 vinfo_template
.visualid
= XVisualIDFromVisual (v
);
4806 vinfo_template
.visualid
= v
->visualid
;
4809 vinfo_template
.screen
= XScreenNumberOfScreen (screen
);
4811 vinfo
= XGetVisualInfo (dpy
,
4812 VisualIDMask
| VisualScreenMask
, &vinfo_template
,
4815 fatal ("Can't get proper X visual info");
4817 if ((1 << vinfo
->depth
) == vinfo
->colormap_size
)
4818 *depth
= vinfo
->depth
;
4822 int n
= vinfo
->colormap_size
- 1;
4831 XFree ((char *) vinfo
);
4835 /* Return the X display structure for the display named NAME.
4836 Open a new connection if necessary. */
4838 struct x_display_info
*
4839 x_display_info_for_name (name
)
4843 struct x_display_info
*dpyinfo
;
4845 CHECK_STRING (name
, 0);
4847 if (! EQ (Vwindow_system
, intern ("x")))
4848 error ("Not using X Windows");
4850 for (dpyinfo
= x_display_list
, names
= x_display_name_list
;
4852 dpyinfo
= dpyinfo
->next
, names
= XCONS (names
)->cdr
)
4855 tem
= Fstring_equal (XCONS (XCONS (names
)->car
)->car
, name
);
4860 /* Use this general default value to start with. */
4861 Vx_resource_name
= Vinvocation_name
;
4863 validate_x_resource_name ();
4865 dpyinfo
= x_term_init (name
, (unsigned char *)0,
4866 (char *) XSTRING (Vx_resource_name
)->data
);
4869 error ("Cannot connect to X server %s", XSTRING (name
)->data
);
4872 XSETFASTINT (Vwindow_system_version
, 11);
4877 DEFUN ("x-open-connection", Fx_open_connection
, Sx_open_connection
,
4878 1, 3, 0, "Open a connection to an X server.\n\
4879 DISPLAY is the name of the display to connect to.\n\
4880 Optional second arg XRM-STRING is a string of resources in xrdb format.\n\
4881 If the optional third arg MUST-SUCCEED is non-nil,\n\
4882 terminate Emacs if we can't open the connection.")
4883 (display
, xrm_string
, must_succeed
)
4884 Lisp_Object display
, xrm_string
, must_succeed
;
4886 unsigned int n_planes
;
4887 unsigned char *xrm_option
;
4888 struct x_display_info
*dpyinfo
;
4890 CHECK_STRING (display
, 0);
4891 if (! NILP (xrm_string
))
4892 CHECK_STRING (xrm_string
, 1);
4894 if (! EQ (Vwindow_system
, intern ("x")))
4895 error ("Not using X Windows");
4897 if (! NILP (xrm_string
))
4898 xrm_option
= (unsigned char *) XSTRING (xrm_string
)->data
;
4900 xrm_option
= (unsigned char *) 0;
4902 /* Use this general default value to start with. */
4903 Vx_resource_name
= Vinvocation_name
;
4905 validate_x_resource_name ();
4907 /* This is what opens the connection and sets x_current_display.
4908 This also initializes many symbols, such as those used for input. */
4909 dpyinfo
= x_term_init (display
, xrm_option
,
4910 (char *) XSTRING (Vx_resource_name
)->data
);
4914 if (!NILP (must_succeed
))
4915 fatal ("Cannot connect to X server %s.\n\
4916 Check the DISPLAY environment variable or use `-d'.\n\
4917 Also use the `xhost' program to verify that it is set to permit\n\
4918 connections from your machine.\n",
4919 XSTRING (display
)->data
);
4921 error ("Cannot connect to X server %s", XSTRING (display
)->data
);
4926 XSETFASTINT (Vwindow_system_version
, 11);
4930 DEFUN ("x-close-connection", Fx_close_connection
,
4931 Sx_close_connection
, 1, 1, 0,
4932 "Close the connection to DISPLAY's X server.\n\
4933 For DISPLAY, specify either a frame or a display name (a string).\n\
4934 If DISPLAY is nil, that stands for the selected frame's display.")
4936 Lisp_Object display
;
4938 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4939 struct x_display_info
*tail
;
4942 if (dpyinfo
->reference_count
> 0)
4943 error ("Display still has frames on it");
4946 /* Free the fonts in the font table. */
4947 for (i
= 0; i
< dpyinfo
->n_fonts
; i
++)
4949 if (dpyinfo
->font_table
[i
].name
)
4950 free (dpyinfo
->font_table
[i
].name
);
4951 /* Don't free the full_name string;
4952 it is always shared with something else. */
4953 XFreeFont (dpyinfo
->display
, dpyinfo
->font_table
[i
].font
);
4955 x_destroy_all_bitmaps (dpyinfo
);
4956 XSetCloseDownMode (dpyinfo
->display
, DestroyAll
);
4958 #ifdef USE_X_TOOLKIT
4959 XtCloseDisplay (dpyinfo
->display
);
4961 XCloseDisplay (dpyinfo
->display
);
4964 x_delete_display (dpyinfo
);
4970 DEFUN ("x-display-list", Fx_display_list
, Sx_display_list
, 0, 0, 0,
4971 "Return the list of display names that Emacs has connections to.")
4974 Lisp_Object tail
, result
;
4977 for (tail
= x_display_name_list
; ! NILP (tail
); tail
= XCONS (tail
)->cdr
)
4978 result
= Fcons (XCONS (XCONS (tail
)->car
)->car
, result
);
4983 DEFUN ("x-synchronize", Fx_synchronize
, Sx_synchronize
, 1, 2, 0,
4984 "If ON is non-nil, report X errors as soon as the erring request is made.\n\
4985 If ON is nil, allow buffering of requests.\n\
4986 Turning on synchronization prohibits the Xlib routines from buffering\n\
4987 requests and seriously degrades performance, but makes debugging much\n\
4989 The optional second argument DISPLAY specifies which display to act on.\n\
4990 DISPLAY should be either a frame or a display name (a string).\n\
4991 If DISPLAY is omitted or nil, that stands for the selected frame's display.")
4993 Lisp_Object display
, on
;
4995 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4997 XSynchronize (dpyinfo
->display
, !EQ (on
, Qnil
));
5002 /* Wait for responses to all X commands issued so far for frame F. */
5009 XSync (FRAME_X_DISPLAY (f
), False
);
5015 /* This is zero if not using X windows. */
5018 /* The section below is built by the lisp expression at the top of the file,
5019 just above where these variables are declared. */
5020 /*&&& init symbols here &&&*/
5021 Qauto_raise
= intern ("auto-raise");
5022 staticpro (&Qauto_raise
);
5023 Qauto_lower
= intern ("auto-lower");
5024 staticpro (&Qauto_lower
);
5025 Qbackground_color
= intern ("background-color");
5026 staticpro (&Qbackground_color
);
5027 Qbar
= intern ("bar");
5029 Qborder_color
= intern ("border-color");
5030 staticpro (&Qborder_color
);
5031 Qborder_width
= intern ("border-width");
5032 staticpro (&Qborder_width
);
5033 Qbox
= intern ("box");
5035 Qcursor_color
= intern ("cursor-color");
5036 staticpro (&Qcursor_color
);
5037 Qcursor_type
= intern ("cursor-type");
5038 staticpro (&Qcursor_type
);
5039 Qforeground_color
= intern ("foreground-color");
5040 staticpro (&Qforeground_color
);
5041 Qgeometry
= intern ("geometry");
5042 staticpro (&Qgeometry
);
5043 Qicon_left
= intern ("icon-left");
5044 staticpro (&Qicon_left
);
5045 Qicon_top
= intern ("icon-top");
5046 staticpro (&Qicon_top
);
5047 Qicon_type
= intern ("icon-type");
5048 staticpro (&Qicon_type
);
5049 Qicon_name
= intern ("icon-name");
5050 staticpro (&Qicon_name
);
5051 Qinternal_border_width
= intern ("internal-border-width");
5052 staticpro (&Qinternal_border_width
);
5053 Qleft
= intern ("left");
5055 Qmouse_color
= intern ("mouse-color");
5056 staticpro (&Qmouse_color
);
5057 Qnone
= intern ("none");
5059 Qparent_id
= intern ("parent-id");
5060 staticpro (&Qparent_id
);
5061 Qscroll_bar_width
= intern ("scroll-bar-width");
5062 staticpro (&Qscroll_bar_width
);
5063 Qsuppress_icon
= intern ("suppress-icon");
5064 staticpro (&Qsuppress_icon
);
5065 Qtop
= intern ("top");
5067 Qundefined_color
= intern ("undefined-color");
5068 staticpro (&Qundefined_color
);
5069 Qvertical_scroll_bars
= intern ("vertical-scroll-bars");
5070 staticpro (&Qvertical_scroll_bars
);
5071 Qvisibility
= intern ("visibility");
5072 staticpro (&Qvisibility
);
5073 Qwindow_id
= intern ("window-id");
5074 staticpro (&Qwindow_id
);
5075 Qx_frame_parameter
= intern ("x-frame-parameter");
5076 staticpro (&Qx_frame_parameter
);
5077 Qx_resource_name
= intern ("x-resource-name");
5078 staticpro (&Qx_resource_name
);
5079 Quser_position
= intern ("user-position");
5080 staticpro (&Quser_position
);
5081 Quser_size
= intern ("user-size");
5082 staticpro (&Quser_size
);
5083 Qdisplay
= intern ("display");
5084 staticpro (&Qdisplay
);
5085 /* This is the end of symbol initialization. */
5087 Fput (Qundefined_color
, Qerror_conditions
,
5088 Fcons (Qundefined_color
, Fcons (Qerror
, Qnil
)));
5089 Fput (Qundefined_color
, Qerror_message
,
5090 build_string ("Undefined color"));
5092 init_x_parm_symbols ();
5094 DEFVAR_LISP ("x-bitmap-file-path", &Vx_bitmap_file_path
,
5095 "List of directories to search for bitmap files for X.");
5096 Vx_bitmap_file_path
= decode_env_path ((char *) 0, PATH_BITMAPS
);
5098 DEFVAR_LISP ("x-pointer-shape", &Vx_pointer_shape
,
5099 "The shape of the pointer when over text.\n\
5100 Changing the value does not affect existing frames\n\
5101 unless you set the mouse color.");
5102 Vx_pointer_shape
= Qnil
;
5104 DEFVAR_LISP ("x-resource-name", &Vx_resource_name
,
5105 "The name Emacs uses to look up X resources; for internal use only.\n\
5106 `x-get-resource' uses this as the first component of the instance name\n\
5107 when requesting resource values.\n\
5108 Emacs initially sets `x-resource-name' to the name under which Emacs\n\
5109 was invoked, or to the value specified with the `-name' or `-rn'\n\
5110 switches, if present.");
5111 Vx_resource_name
= Qnil
;
5113 #if 0 /* This doesn't really do anything. */
5114 DEFVAR_INT ("x-nontext-pointer-shape", &Vx_nontext_pointer_shape
,
5115 "The shape of the pointer when not over text.\n\
5116 This variable takes effect when you create a new frame\n\
5117 or when you set the mouse color.");
5119 Vx_nontext_pointer_shape
= Qnil
;
5121 #if 0 /* This doesn't really do anything. */
5122 DEFVAR_INT ("x-mode-pointer-shape", &Vx_mode_pointer_shape
,
5123 "The shape of the pointer when over the mode line.\n\
5124 This variable takes effect when you create a new frame\n\
5125 or when you set the mouse color.");
5127 Vx_mode_pointer_shape
= Qnil
;
5129 DEFVAR_INT ("x-sensitive-text-pointer-shape",
5130 &Vx_sensitive_text_pointer_shape
,
5131 "The shape of the pointer when over mouse-sensitive text.\n\
5132 This variable takes effect when you create a new frame\n\
5133 or when you set the mouse color.");
5134 Vx_sensitive_text_pointer_shape
= Qnil
;
5136 DEFVAR_LISP ("x-cursor-fore-pixel", &Vx_cursor_fore_pixel
,
5137 "A string indicating the foreground color of the cursor box.");
5138 Vx_cursor_fore_pixel
= Qnil
;
5140 DEFVAR_LISP ("x-no-window-manager", &Vx_no_window_manager
,
5141 "Non-nil if no X window manager is in use.\n\
5142 Emacs doesn't try to figure this out; this is always nil\n\
5143 unless you set it to something else.");
5144 /* We don't have any way to find this out, so set it to nil
5145 and maybe the user would like to set it to t. */
5146 Vx_no_window_manager
= Qnil
;
5148 #ifdef USE_X_TOOLKIT
5149 Fprovide (intern ("x-toolkit"));
5152 Fprovide (intern ("motif"));
5155 defsubr (&Sx_get_resource
);
5157 defsubr (&Sx_draw_rectangle
);
5158 defsubr (&Sx_erase_rectangle
);
5159 defsubr (&Sx_contour_region
);
5160 defsubr (&Sx_uncontour_region
);
5162 defsubr (&Sx_list_fonts
);
5163 defsubr (&Sx_display_color_p
);
5164 defsubr (&Sx_display_grayscale_p
);
5165 defsubr (&Sx_color_defined_p
);
5166 defsubr (&Sx_color_values
);
5167 defsubr (&Sx_server_max_request_size
);
5168 defsubr (&Sx_server_vendor
);
5169 defsubr (&Sx_server_version
);
5170 defsubr (&Sx_display_pixel_width
);
5171 defsubr (&Sx_display_pixel_height
);
5172 defsubr (&Sx_display_mm_width
);
5173 defsubr (&Sx_display_mm_height
);
5174 defsubr (&Sx_display_screens
);
5175 defsubr (&Sx_display_planes
);
5176 defsubr (&Sx_display_color_cells
);
5177 defsubr (&Sx_display_visual_class
);
5178 defsubr (&Sx_display_backing_store
);
5179 defsubr (&Sx_display_save_under
);
5181 defsubr (&Sx_rebind_key
);
5182 defsubr (&Sx_rebind_keys
);
5183 defsubr (&Sx_track_pointer
);
5184 defsubr (&Sx_grab_pointer
);
5185 defsubr (&Sx_ungrab_pointer
);
5187 defsubr (&Sx_parse_geometry
);
5188 defsubr (&Sx_create_frame
);
5189 defsubr (&Sfocus_frame
);
5190 defsubr (&Sunfocus_frame
);
5192 defsubr (&Sx_horizontal_line
);
5194 defsubr (&Sx_open_connection
);
5195 defsubr (&Sx_close_connection
);
5196 defsubr (&Sx_display_list
);
5197 defsubr (&Sx_synchronize
);
5200 #endif /* HAVE_X_WINDOWS */