1 /* Functions for the X window system.
2 Copyright (C) 1989, 1992, 1993, 1994, 1995 Free Software Foundation.
4 This file is part of GNU Emacs.
6 GNU Emacs is free software; you can redistribute it and/or modify
7 it under the terms of the GNU General Public License as published by
8 the Free Software Foundation; either version 2, or (at your option)
11 GNU Emacs is distributed in the hope that it will be useful,
12 but WITHOUT ANY WARRANTY; without even the implied warranty of
13 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14 GNU General Public License for more details.
16 You should have received a copy of the GNU General Public License
17 along with GNU Emacs; see the file COPYING. If not, write to
18 the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. */
20 /* Completely rewritten by Richard Stallman. */
22 /* Rewritten for X11 by Joseph Arceneaux */
27 /* This makes the fields of a Display accessible, in Xlib header files. */
28 #define XLIB_ILLEGAL_ACCESS
35 #include "dispextern.h"
37 #include "blockinput.h"
44 #if 1 /* Used to be #ifdef EMACS_BITMAP_FILES, but this should always work. */
45 #include "bitmaps/gray.xbm"
47 #include <X11/bitmaps/gray>
50 #include "[.bitmaps]gray.xbm"
54 #include <X11/Shell.h>
57 #include <X11/Xaw/Paned.h>
58 #include <X11/Xaw/Label.h>
59 #endif /* USE_MOTIF */
62 #undef USG /* ####KLUDGE for Solaris 2.2 and up */
71 #include "../lwlib/lwlib.h"
73 /* Do the EDITRES protocol if running X11R5
74 Exception: HP-UX (at least version A.09.05) has X11R5 without EditRes */
75 #if (XtSpecificationRelease >= 5) && !defined(NO_EDITRES)
77 extern void _XEditResCheckMessages ();
78 #endif /* R5 + Athena */
80 /* Unique id counter for widgets created by the Lucid Widget
82 extern LWLIB_ID widget_id_tick
;
84 /* This is part of a kludge--see lwlib/xlwmenu.c. */
85 XFontStruct
*xlwmenu_default_font
;
87 extern void free_frame_menubar ();
88 #endif /* USE_X_TOOLKIT */
90 #define min(a,b) ((a) < (b) ? (a) : (b))
91 #define max(a,b) ((a) > (b) ? (a) : (b))
94 #define MAXREQUEST(dpy) (XMaxRequestSize (dpy))
96 #define MAXREQUEST(dpy) ((dpy)->max_request_size)
99 /* The name we're using in resource queries. */
100 Lisp_Object Vx_resource_name
;
102 /* The background and shape of the mouse pointer, and shape when not
103 over text or in the modeline. */
104 Lisp_Object Vx_pointer_shape
, Vx_nontext_pointer_shape
, Vx_mode_pointer_shape
;
105 /* The shape when over mouse-sensitive text. */
106 Lisp_Object Vx_sensitive_text_pointer_shape
;
108 /* Color of chars displayed in cursor box. */
109 Lisp_Object Vx_cursor_fore_pixel
;
111 /* Nonzero if using X. */
114 /* Non nil if no window manager is in use. */
115 Lisp_Object Vx_no_window_manager
;
117 /* Search path for bitmap files. */
118 Lisp_Object Vx_bitmap_file_path
;
120 /* Evaluate this expression to rebuild the section of syms_of_xfns
121 that initializes and staticpros the symbols declared below. Note
122 that Emacs 18 has a bug that keeps C-x C-e from being able to
123 evaluate this expression.
126 ;; Accumulate a list of the symbols we want to initialize from the
127 ;; declarations at the top of the file.
128 (goto-char (point-min))
129 (search-forward "/\*&&& symbols declared here &&&*\/\n")
131 (while (looking-at "Lisp_Object \\(Q[a-z_]+\\)")
133 (cons (buffer-substring (match-beginning 1) (match-end 1))
136 (setq symbol-list (nreverse symbol-list))
137 ;; Delete the section of syms_of_... where we initialize the symbols.
138 (search-forward "\n /\*&&& init symbols here &&&*\/\n")
139 (let ((start (point)))
140 (while (looking-at "^ Q")
142 (kill-region start (point)))
143 ;; Write a new symbol initialization section.
145 (insert (format " %s = intern (\"" (car symbol-list)))
146 (let ((start (point)))
147 (insert (substring (car symbol-list) 1))
148 (subst-char-in-region start (point) ?_ ?-))
149 (insert (format "\");\n staticpro (&%s);\n" (car symbol-list)))
150 (setq symbol-list (cdr symbol-list)))))
154 /*&&& symbols declared here &&&*/
155 Lisp_Object Qauto_raise
;
156 Lisp_Object Qauto_lower
;
157 Lisp_Object Qbackground_color
;
159 Lisp_Object Qborder_color
;
160 Lisp_Object Qborder_width
;
162 Lisp_Object Qcursor_color
;
163 Lisp_Object Qcursor_type
;
165 Lisp_Object Qforeground_color
;
166 Lisp_Object Qgeometry
;
167 Lisp_Object Qicon_left
;
168 Lisp_Object Qicon_top
;
169 Lisp_Object Qicon_type
;
170 Lisp_Object Qicon_name
;
171 Lisp_Object Qinternal_border_width
;
173 Lisp_Object Qmouse_color
;
175 Lisp_Object Qparent_id
;
176 Lisp_Object Qscroll_bar_width
;
177 Lisp_Object Qsuppress_icon
;
179 Lisp_Object Qundefined_color
;
180 Lisp_Object Qvertical_scroll_bars
;
181 Lisp_Object Qvisibility
;
182 Lisp_Object Qwindow_id
;
183 Lisp_Object Qx_frame_parameter
;
184 Lisp_Object Qx_resource_name
;
185 Lisp_Object Quser_position
;
186 Lisp_Object Quser_size
;
187 Lisp_Object Qdisplay
;
189 /* The below are defined in frame.c. */
190 extern Lisp_Object Qheight
, Qminibuffer
, Qname
, Qonly
, Qwidth
;
191 extern Lisp_Object Qunsplittable
, Qmenu_bar_lines
, Qbuffer_predicate
;
193 extern Lisp_Object Vwindow_system_version
;
196 /* Error if we are not connected to X. */
201 error ("X windows are not in use or not initialized");
204 /* Nonzero if using X for display. */
212 /* Extract a frame as a FRAME_PTR, defaulting to the selected frame
213 and checking validity for X. */
216 check_x_frame (frame
)
225 CHECK_LIVE_FRAME (frame
, 0);
229 error ("non-X frame used");
233 /* Let the user specify an X display with a frame.
234 nil stands for the selected frame--or, if that is not an X frame,
235 the first X display on the list. */
237 static struct x_display_info
*
238 check_x_display_info (frame
)
243 if (FRAME_X_P (selected_frame
))
244 return FRAME_X_DISPLAY_INFO (selected_frame
);
245 else if (x_display_list
!= 0)
246 return x_display_list
;
248 error ("X windows are not in use or not initialized");
250 else if (STRINGP (frame
))
251 return x_display_info_for_name (frame
);
256 CHECK_LIVE_FRAME (frame
, 0);
259 error ("non-X frame used");
260 return FRAME_X_DISPLAY_INFO (f
);
264 /* Return the Emacs frame-object corresponding to an X window.
265 It could be the frame's main window or an icon window. */
267 /* This function can be called during GC, so use GC_xxx type test macros. */
270 x_window_to_frame (dpyinfo
, wdesc
)
271 struct x_display_info
*dpyinfo
;
274 Lisp_Object tail
, frame
;
277 for (tail
= Vframe_list
; GC_CONSP (tail
); tail
= XCONS (tail
)->cdr
)
279 frame
= XCONS (tail
)->car
;
280 if (!GC_FRAMEP (frame
))
283 if (f
->output_data
.nothing
== 1 || FRAME_X_DISPLAY_INFO (f
) != dpyinfo
)
286 if ((f
->output_data
.x
->edit_widget
287 && XtWindow (f
->output_data
.x
->edit_widget
) == wdesc
)
288 || f
->output_data
.x
->icon_desc
== wdesc
)
290 #else /* not USE_X_TOOLKIT */
291 if (FRAME_X_WINDOW (f
) == wdesc
292 || f
->output_data
.x
->icon_desc
== wdesc
)
294 #endif /* not USE_X_TOOLKIT */
300 /* Like x_window_to_frame but also compares the window with the widget's
304 x_any_window_to_frame (dpyinfo
, wdesc
)
305 struct x_display_info
*dpyinfo
;
308 Lisp_Object tail
, frame
;
312 for (tail
= Vframe_list
; GC_CONSP (tail
); tail
= XCONS (tail
)->cdr
)
314 frame
= XCONS (tail
)->car
;
315 if (!GC_FRAMEP (frame
))
318 if (f
->output_data
.nothing
== 1 || FRAME_X_DISPLAY_INFO (f
) != dpyinfo
)
320 x
= f
->output_data
.x
;
321 /* This frame matches if the window is any of its widgets. */
322 if (wdesc
== XtWindow (x
->widget
)
323 || wdesc
== XtWindow (x
->column_widget
)
324 || wdesc
== XtWindow (x
->edit_widget
))
326 /* Match if the window is this frame's menubar. */
327 if (lw_window_is_in_menubar (wdesc
, x
->menubar_widget
))
333 /* Likewise, but exclude the menu bar widget. */
336 x_non_menubar_window_to_frame (dpyinfo
, wdesc
)
337 struct x_display_info
*dpyinfo
;
340 Lisp_Object tail
, frame
;
344 for (tail
= Vframe_list
; GC_CONSP (tail
); tail
= XCONS (tail
)->cdr
)
346 frame
= XCONS (tail
)->car
;
347 if (!GC_FRAMEP (frame
))
350 if (f
->output_data
.nothing
== 1 || FRAME_X_DISPLAY_INFO (f
) != dpyinfo
)
352 x
= f
->output_data
.x
;
353 /* This frame matches if the window is any of its widgets. */
354 if (wdesc
== XtWindow (x
->widget
)
355 || wdesc
== XtWindow (x
->column_widget
)
356 || wdesc
== XtWindow (x
->edit_widget
))
362 /* Likewise, but consider only the menu bar widget. */
365 x_menubar_window_to_frame (dpyinfo
, wdesc
)
366 struct x_display_info
*dpyinfo
;
369 Lisp_Object tail
, frame
;
373 for (tail
= Vframe_list
; GC_CONSP (tail
); tail
= XCONS (tail
)->cdr
)
375 frame
= XCONS (tail
)->car
;
376 if (!GC_FRAMEP (frame
))
379 if (f
->output_data
.nothing
== 1 || FRAME_X_DISPLAY_INFO (f
) != dpyinfo
)
381 x
= f
->output_data
.x
;
382 /* Match if the window is this frame's menubar. */
383 if (lw_window_is_in_menubar (wdesc
, x
->menubar_widget
))
389 /* Return the frame whose principal (outermost) window is WDESC.
390 If WDESC is some other (smaller) window, we return 0. */
393 x_top_window_to_frame (dpyinfo
, wdesc
)
394 struct x_display_info
*dpyinfo
;
397 Lisp_Object tail
, frame
;
401 for (tail
= Vframe_list
; GC_CONSP (tail
); tail
= XCONS (tail
)->cdr
)
403 frame
= XCONS (tail
)->car
;
404 if (!GC_FRAMEP (frame
))
407 if (f
->output_data
.nothing
== 1 || FRAME_X_DISPLAY_INFO (f
) != dpyinfo
)
409 x
= f
->output_data
.x
;
410 /* This frame matches if the window is its topmost widget. */
411 if (wdesc
== XtWindow (x
->widget
))
413 #if 0 /* I don't know why it did this,
414 but it seems logically wrong,
415 and it causes trouble for MapNotify events. */
416 /* Match if the window is this frame's menubar. */
417 if (x
->menubar_widget
418 && wdesc
== XtWindow (x
->menubar_widget
))
424 #endif /* USE_X_TOOLKIT */
428 /* Code to deal with bitmaps. Bitmaps are referenced by their bitmap
429 id, which is just an int that this section returns. Bitmaps are
430 reference counted so they can be shared among frames.
432 Bitmap indices are guaranteed to be > 0, so a negative number can
433 be used to indicate no bitmap.
435 If you use x_create_bitmap_from_data, then you must keep track of
436 the bitmaps yourself. That is, creating a bitmap from the same
437 data more than once will not be caught. */
440 /* Functions to access the contents of a bitmap, given an id. */
443 x_bitmap_height (f
, id
)
447 return FRAME_X_DISPLAY_INFO (f
)->bitmaps
[id
- 1].height
;
451 x_bitmap_width (f
, id
)
455 return FRAME_X_DISPLAY_INFO (f
)->bitmaps
[id
- 1].width
;
459 x_bitmap_pixmap (f
, id
)
463 return FRAME_X_DISPLAY_INFO (f
)->bitmaps
[id
- 1].pixmap
;
467 /* Allocate a new bitmap record. Returns index of new record. */
470 x_allocate_bitmap_record (f
)
473 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
476 if (dpyinfo
->bitmaps
== NULL
)
478 dpyinfo
->bitmaps_size
= 10;
480 = (struct x_bitmap_record
*) xmalloc (dpyinfo
->bitmaps_size
* sizeof (struct x_bitmap_record
));
481 dpyinfo
->bitmaps_last
= 1;
485 if (dpyinfo
->bitmaps_last
< dpyinfo
->bitmaps_size
)
486 return ++dpyinfo
->bitmaps_last
;
488 for (i
= 0; i
< dpyinfo
->bitmaps_size
; ++i
)
489 if (dpyinfo
->bitmaps
[i
].refcount
== 0)
492 dpyinfo
->bitmaps_size
*= 2;
494 = (struct x_bitmap_record
*) xrealloc (dpyinfo
->bitmaps
,
495 dpyinfo
->bitmaps_size
* sizeof (struct x_bitmap_record
));
496 return ++dpyinfo
->bitmaps_last
;
499 /* Add one reference to the reference count of the bitmap with id ID. */
502 x_reference_bitmap (f
, id
)
506 ++FRAME_X_DISPLAY_INFO (f
)->bitmaps
[id
- 1].refcount
;
509 /* Create a bitmap for frame F from a HEIGHT x WIDTH array of bits at BITS. */
512 x_create_bitmap_from_data (f
, bits
, width
, height
)
515 unsigned int width
, height
;
517 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
521 bitmap
= XCreateBitmapFromData (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
522 bits
, width
, height
);
527 id
= x_allocate_bitmap_record (f
);
528 dpyinfo
->bitmaps
[id
- 1].pixmap
= bitmap
;
529 dpyinfo
->bitmaps
[id
- 1].file
= NULL
;
530 dpyinfo
->bitmaps
[id
- 1].refcount
= 1;
531 dpyinfo
->bitmaps
[id
- 1].depth
= 1;
532 dpyinfo
->bitmaps
[id
- 1].height
= height
;
533 dpyinfo
->bitmaps
[id
- 1].width
= width
;
538 /* Create bitmap from file FILE for frame F. */
541 x_create_bitmap_from_file (f
, file
)
545 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
546 unsigned int width
, height
;
548 int xhot
, yhot
, result
, id
;
553 /* Look for an existing bitmap with the same name. */
554 for (id
= 0; id
< dpyinfo
->bitmaps_last
; ++id
)
556 if (dpyinfo
->bitmaps
[id
].refcount
557 && dpyinfo
->bitmaps
[id
].file
558 && !strcmp (dpyinfo
->bitmaps
[id
].file
, (char *) XSTRING (file
)->data
))
560 ++dpyinfo
->bitmaps
[id
].refcount
;
565 /* Search bitmap-file-path for the file, if appropriate. */
566 fd
= openp (Vx_bitmap_file_path
, file
, "", &found
, 0);
571 filename
= (char *) XSTRING (found
)->data
;
573 result
= XReadBitmapFile (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
574 filename
, &width
, &height
, &bitmap
, &xhot
, &yhot
);
575 if (result
!= BitmapSuccess
)
578 id
= x_allocate_bitmap_record (f
);
579 dpyinfo
->bitmaps
[id
- 1].pixmap
= bitmap
;
580 dpyinfo
->bitmaps
[id
- 1].refcount
= 1;
581 dpyinfo
->bitmaps
[id
- 1].file
= (char *) xmalloc (XSTRING (file
)->size
+ 1);
582 dpyinfo
->bitmaps
[id
- 1].depth
= 1;
583 dpyinfo
->bitmaps
[id
- 1].height
= height
;
584 dpyinfo
->bitmaps
[id
- 1].width
= width
;
585 strcpy (dpyinfo
->bitmaps
[id
- 1].file
, XSTRING (file
)->data
);
590 /* Remove reference to bitmap with id number ID. */
593 x_destroy_bitmap (f
, id
)
597 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
601 --dpyinfo
->bitmaps
[id
- 1].refcount
;
602 if (dpyinfo
->bitmaps
[id
- 1].refcount
== 0)
605 XFreePixmap (FRAME_X_DISPLAY (f
), dpyinfo
->bitmaps
[id
- 1].pixmap
);
606 if (dpyinfo
->bitmaps
[id
- 1].file
)
608 free (dpyinfo
->bitmaps
[id
- 1].file
);
609 dpyinfo
->bitmaps
[id
- 1].file
= NULL
;
616 /* Free all the bitmaps for the display specified by DPYINFO. */
619 x_destroy_all_bitmaps (dpyinfo
)
620 struct x_display_info
*dpyinfo
;
623 for (i
= 0; i
< dpyinfo
->bitmaps_last
; i
++)
624 if (dpyinfo
->bitmaps
[i
].refcount
> 0)
626 XFreePixmap (dpyinfo
->display
, dpyinfo
->bitmaps
[i
].pixmap
);
627 if (dpyinfo
->bitmaps
[i
].file
)
628 free (dpyinfo
->bitmaps
[i
].file
);
630 dpyinfo
->bitmaps_last
= 0;
633 /* Connect the frame-parameter names for X frames
634 to the ways of passing the parameter values to the window system.
636 The name of a parameter, as a Lisp symbol,
637 has an `x-frame-parameter' property which is an integer in Lisp
638 but can be interpreted as an `enum x_frame_parm' in C. */
642 X_PARM_FOREGROUND_COLOR
,
643 X_PARM_BACKGROUND_COLOR
,
650 X_PARM_INTERNAL_BORDER_WIDTH
,
654 X_PARM_VERT_SCROLL_BAR
,
656 X_PARM_MENU_BAR_LINES
660 struct x_frame_parm_table
663 void (*setter
)( /* struct frame *frame, Lisp_Object val, oldval */ );
666 void x_set_foreground_color ();
667 void x_set_background_color ();
668 void x_set_mouse_color ();
669 void x_set_cursor_color ();
670 void x_set_border_color ();
671 void x_set_cursor_type ();
672 void x_set_icon_type ();
673 void x_set_icon_name ();
675 void x_set_border_width ();
676 void x_set_internal_border_width ();
677 void x_explicitly_set_name ();
678 void x_set_autoraise ();
679 void x_set_autolower ();
680 void x_set_vertical_scroll_bars ();
681 void x_set_visibility ();
682 void x_set_menu_bar_lines ();
683 void x_set_scroll_bar_width ();
684 void x_set_unsplittable ();
686 static struct x_frame_parm_table x_frame_parms
[] =
688 "foreground-color", x_set_foreground_color
,
689 "background-color", x_set_background_color
,
690 "mouse-color", x_set_mouse_color
,
691 "cursor-color", x_set_cursor_color
,
692 "border-color", x_set_border_color
,
693 "cursor-type", x_set_cursor_type
,
694 "icon-type", x_set_icon_type
,
695 "icon-name", x_set_icon_name
,
697 "border-width", x_set_border_width
,
698 "internal-border-width", x_set_internal_border_width
,
699 "name", x_explicitly_set_name
,
700 "auto-raise", x_set_autoraise
,
701 "auto-lower", x_set_autolower
,
702 "vertical-scroll-bars", x_set_vertical_scroll_bars
,
703 "visibility", x_set_visibility
,
704 "menu-bar-lines", x_set_menu_bar_lines
,
705 "scroll-bar-width", x_set_scroll_bar_width
,
706 "unsplittable", x_set_unsplittable
,
709 /* Attach the `x-frame-parameter' properties to
710 the Lisp symbol names of parameters relevant to X. */
712 init_x_parm_symbols ()
716 for (i
= 0; i
< sizeof (x_frame_parms
) / sizeof (x_frame_parms
[0]); i
++)
717 Fput (intern (x_frame_parms
[i
].name
), Qx_frame_parameter
,
721 /* Change the parameters of FRAME as specified by ALIST.
722 If a parameter is not specially recognized, do nothing;
723 otherwise call the `x_set_...' function for that parameter. */
726 x_set_frame_parameters (f
, alist
)
732 /* If both of these parameters are present, it's more efficient to
733 set them both at once. So we wait until we've looked at the
734 entire list before we set them. */
735 Lisp_Object width
, height
;
738 Lisp_Object left
, top
;
740 /* Same with these. */
741 Lisp_Object icon_left
, icon_top
;
743 /* Record in these vectors all the parms specified. */
747 int left_no_change
= 0, top_no_change
= 0;
748 int icon_left_no_change
= 0, icon_top_no_change
= 0;
751 for (tail
= alist
; CONSP (tail
); tail
= Fcdr (tail
))
754 parms
= (Lisp_Object
*) alloca (i
* sizeof (Lisp_Object
));
755 values
= (Lisp_Object
*) alloca (i
* sizeof (Lisp_Object
));
757 /* Extract parm names and values into those vectors. */
760 for (tail
= alist
; CONSP (tail
); tail
= Fcdr (tail
))
762 Lisp_Object elt
, prop
, val
;
765 parms
[i
] = Fcar (elt
);
766 values
[i
] = Fcdr (elt
);
770 width
= height
= top
= left
= Qunbound
;
771 icon_left
= icon_top
= Qunbound
;
773 /* Now process them in reverse of specified order. */
774 for (i
--; i
>= 0; i
--)
776 Lisp_Object prop
, val
;
781 if (EQ (prop
, Qwidth
))
783 else if (EQ (prop
, Qheight
))
785 else if (EQ (prop
, Qtop
))
787 else if (EQ (prop
, Qleft
))
789 else if (EQ (prop
, Qicon_top
))
791 else if (EQ (prop
, Qicon_left
))
795 register Lisp_Object param_index
, old_value
;
797 param_index
= Fget (prop
, Qx_frame_parameter
);
798 old_value
= get_frame_param (f
, prop
);
799 store_frame_param (f
, prop
, val
);
800 if (NATNUMP (param_index
)
801 && (XFASTINT (param_index
)
802 < sizeof (x_frame_parms
)/sizeof (x_frame_parms
[0])))
803 (*x_frame_parms
[XINT (param_index
)].setter
)(f
, val
, old_value
);
807 /* Don't die if just one of these was set. */
808 if (EQ (left
, Qunbound
))
811 if (f
->output_data
.x
->left_pos
< 0)
812 left
= Fcons (Qplus
, Fcons (make_number (f
->output_data
.x
->left_pos
), Qnil
));
814 XSETINT (left
, f
->output_data
.x
->left_pos
);
816 if (EQ (top
, Qunbound
))
819 if (f
->output_data
.x
->top_pos
< 0)
820 top
= Fcons (Qplus
, Fcons (make_number (f
->output_data
.x
->top_pos
), Qnil
));
822 XSETINT (top
, f
->output_data
.x
->top_pos
);
825 /* If one of the icon positions was not set, preserve or default it. */
826 if (EQ (icon_left
, Qunbound
) || ! INTEGERP (icon_left
))
828 icon_left_no_change
= 1;
829 icon_left
= Fcdr (Fassq (Qicon_left
, f
->param_alist
));
830 if (NILP (icon_left
))
831 XSETINT (icon_left
, 0);
833 if (EQ (icon_top
, Qunbound
) || ! INTEGERP (icon_top
))
835 icon_top_no_change
= 1;
836 icon_top
= Fcdr (Fassq (Qicon_top
, f
->param_alist
));
838 XSETINT (icon_top
, 0);
841 /* Don't die if just one of these was set. */
842 if (EQ (width
, Qunbound
))
843 XSETINT (width
, FRAME_WIDTH (f
));
844 if (EQ (height
, Qunbound
))
845 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 Fset_frame_size (frame
, width
, height
);
866 if ((!NILP (left
) || !NILP (top
))
867 && ! (left_no_change
&& top_no_change
)
868 && ! (NUMBERP (left
) && XINT (left
) == f
->output_data
.x
->left_pos
869 && NUMBERP (top
) && XINT (top
) == f
->output_data
.x
->top_pos
))
874 /* Record the signs. */
875 f
->output_data
.x
->size_hint_flags
&= ~ (XNegative
| YNegative
);
876 if (EQ (left
, Qminus
))
877 f
->output_data
.x
->size_hint_flags
|= XNegative
;
878 else if (INTEGERP (left
))
880 leftpos
= XINT (left
);
882 f
->output_data
.x
->size_hint_flags
|= XNegative
;
884 else if (CONSP (left
) && EQ (XCONS (left
)->car
, Qminus
)
885 && CONSP (XCONS (left
)->cdr
)
886 && INTEGERP (XCONS (XCONS (left
)->cdr
)->car
))
888 leftpos
= - XINT (XCONS (XCONS (left
)->cdr
)->car
);
889 f
->output_data
.x
->size_hint_flags
|= XNegative
;
891 else if (CONSP (left
) && EQ (XCONS (left
)->car
, Qplus
)
892 && CONSP (XCONS (left
)->cdr
)
893 && INTEGERP (XCONS (XCONS (left
)->cdr
)->car
))
895 leftpos
= XINT (XCONS (XCONS (left
)->cdr
)->car
);
898 if (EQ (top
, Qminus
))
899 f
->output_data
.x
->size_hint_flags
|= YNegative
;
900 else if (INTEGERP (top
))
904 f
->output_data
.x
->size_hint_flags
|= YNegative
;
906 else if (CONSP (top
) && EQ (XCONS (top
)->car
, Qminus
)
907 && CONSP (XCONS (top
)->cdr
)
908 && INTEGERP (XCONS (XCONS (top
)->cdr
)->car
))
910 toppos
= - XINT (XCONS (XCONS (top
)->cdr
)->car
);
911 f
->output_data
.x
->size_hint_flags
|= YNegative
;
913 else if (CONSP (top
) && EQ (XCONS (top
)->car
, Qplus
)
914 && CONSP (XCONS (top
)->cdr
)
915 && INTEGERP (XCONS (XCONS (top
)->cdr
)->car
))
917 toppos
= XINT (XCONS (XCONS (top
)->cdr
)->car
);
921 /* Store the numeric value of the position. */
922 f
->output_data
.x
->top_pos
= toppos
;
923 f
->output_data
.x
->left_pos
= leftpos
;
925 f
->output_data
.x
->win_gravity
= NorthWestGravity
;
927 /* Actually set that position, and convert to absolute. */
928 x_set_offset (f
, leftpos
, toppos
, -1);
931 if ((!NILP (icon_left
) || !NILP (icon_top
))
932 && ! (icon_left_no_change
&& icon_top_no_change
))
933 x_wm_set_icon_position (f
, XINT (icon_left
), XINT (icon_top
));
937 /* Store the screen positions of frame F into XPTR and YPTR.
938 These are the positions of the containing window manager window,
939 not Emacs's own window. */
942 x_real_positions (f
, xptr
, yptr
)
949 /* This is pretty gross, but seems to be the easiest way out of
950 the problem that arises when restarting window-managers. */
953 Window outer
= XtWindow (f
->output_data
.x
->widget
);
955 Window outer
= f
->output_data
.x
->window_desc
;
957 Window tmp_root_window
;
958 Window
*tmp_children
;
963 x_catch_errors (FRAME_X_DISPLAY (f
));
965 XQueryTree (FRAME_X_DISPLAY (f
), outer
, &tmp_root_window
,
966 &f
->output_data
.x
->parent_desc
,
967 &tmp_children
, &tmp_nchildren
);
968 xfree (tmp_children
);
972 /* Find the position of the outside upper-left corner of
973 the inner window, with respect to the outer window. */
974 if (f
->output_data
.x
->parent_desc
!= FRAME_X_DISPLAY_INFO (f
)->root_window
)
976 XTranslateCoordinates (FRAME_X_DISPLAY (f
),
978 /* From-window, to-window. */
980 XtWindow (f
->output_data
.x
->widget
),
982 f
->output_data
.x
->window_desc
,
984 f
->output_data
.x
->parent_desc
,
986 /* From-position, to-position. */
987 0, 0, &win_x
, &win_y
,
992 #if 0 /* The values seem to be right without this and wrong with. */
993 win_x
+= f
->output_data
.x
->border_width
;
994 win_y
+= f
->output_data
.x
->border_width
;
998 /* It is possible for the window returned by the XQueryNotify
999 to become invalid by the time we call XTranslateCoordinates.
1000 That can happen when you restart some window managers.
1001 If so, we get an error in XTranslateCoordinates.
1002 Detect that and try the whole thing over. */
1003 if (! x_had_errors_p (FRAME_X_DISPLAY (f
)))
1006 x_uncatch_errors (FRAME_X_DISPLAY (f
));
1009 x_uncatch_errors (FRAME_X_DISPLAY (f
));
1011 *xptr
= f
->output_data
.x
->left_pos
- win_x
;
1012 *yptr
= f
->output_data
.x
->top_pos
- win_y
;
1015 /* Insert a description of internally-recorded parameters of frame X
1016 into the parameter alist *ALISTPTR that is to be given to the user.
1017 Only parameters that are specific to the X window system
1018 and whose values are not correctly recorded in the frame's
1019 param_alist need to be considered here. */
1021 x_report_frame_params (f
, alistptr
)
1023 Lisp_Object
*alistptr
;
1028 /* Represent negative positions (off the top or left screen edge)
1029 in a way that Fmodify_frame_parameters will understand correctly. */
1030 XSETINT (tem
, f
->output_data
.x
->left_pos
);
1031 if (f
->output_data
.x
->left_pos
>= 0)
1032 store_in_alist (alistptr
, Qleft
, tem
);
1034 store_in_alist (alistptr
, Qleft
, Fcons (Qplus
, Fcons (tem
, Qnil
)));
1036 XSETINT (tem
, f
->output_data
.x
->top_pos
);
1037 if (f
->output_data
.x
->top_pos
>= 0)
1038 store_in_alist (alistptr
, Qtop
, tem
);
1040 store_in_alist (alistptr
, Qtop
, Fcons (Qplus
, Fcons (tem
, Qnil
)));
1042 store_in_alist (alistptr
, Qborder_width
,
1043 make_number (f
->output_data
.x
->border_width
));
1044 store_in_alist (alistptr
, Qinternal_border_width
,
1045 make_number (f
->output_data
.x
->internal_border_width
));
1046 sprintf (buf
, "%ld", (long) FRAME_X_WINDOW (f
));
1047 store_in_alist (alistptr
, Qwindow_id
,
1048 build_string (buf
));
1049 store_in_alist (alistptr
, Qicon_name
, f
->icon_name
);
1050 FRAME_SAMPLE_VISIBILITY (f
);
1051 store_in_alist (alistptr
, Qvisibility
,
1052 (FRAME_VISIBLE_P (f
) ? Qt
1053 : FRAME_ICONIFIED_P (f
) ? Qicon
: Qnil
));
1054 store_in_alist (alistptr
, Qdisplay
,
1055 XCONS (FRAME_X_DISPLAY_INFO (f
)->name_list_element
)->car
);
1059 /* Decide if color named COLOR is valid for the display associated with
1060 the selected frame; if so, return the rgb values in COLOR_DEF.
1061 If ALLOC is nonzero, allocate a new colormap cell. */
1064 defined_color (f
, color
, color_def
, alloc
)
1070 register int status
;
1071 Colormap screen_colormap
;
1072 Display
*display
= FRAME_X_DISPLAY (f
);
1075 screen_colormap
= DefaultColormap (display
, XDefaultScreen (display
));
1077 status
= XParseColor (display
, screen_colormap
, color
, color_def
);
1078 if (status
&& alloc
)
1080 status
= XAllocColor (display
, screen_colormap
, color_def
);
1083 /* If we got to this point, the colormap is full, so we're
1084 going to try and get the next closest color.
1085 The algorithm used is a least-squares matching, which is
1086 what X uses for closest color matching with StaticColor visuals. */
1091 long nearest_delta
, trial_delta
;
1094 no_cells
= XDisplayCells (display
, XDefaultScreen (display
));
1095 cells
= (XColor
*) alloca (sizeof (XColor
) * no_cells
);
1097 for (x
= 0; x
< no_cells
; x
++)
1100 XQueryColors (display
, screen_colormap
, cells
, no_cells
);
1102 /* I'm assuming CSE so I'm not going to condense this. */
1103 nearest_delta
= ((((color_def
->red
>> 8) - (cells
[0].red
>> 8))
1104 * ((color_def
->red
>> 8) - (cells
[0].red
>> 8)))
1106 (((color_def
->green
>> 8) - (cells
[0].green
>> 8))
1107 * ((color_def
->green
>> 8) - (cells
[0].green
>> 8)))
1109 (((color_def
->blue
>> 8) - (cells
[0].blue
>> 8))
1110 * ((color_def
->blue
>> 8) - (cells
[0].blue
>> 8))));
1111 for (x
= 1; x
< no_cells
; x
++)
1113 trial_delta
= ((((color_def
->red
>> 8) - (cells
[x
].red
>> 8))
1114 * ((color_def
->red
>> 8) - (cells
[x
].red
>> 8)))
1116 (((color_def
->green
>> 8) - (cells
[x
].green
>> 8))
1117 * ((color_def
->green
>> 8) - (cells
[x
].green
>> 8)))
1119 (((color_def
->blue
>> 8) - (cells
[x
].blue
>> 8))
1120 * ((color_def
->blue
>> 8) - (cells
[x
].blue
>> 8))));
1121 if (trial_delta
< nearest_delta
)
1124 nearest_delta
= trial_delta
;
1127 color_def
->red
= cells
[nearest
].red
;
1128 color_def
->green
= cells
[nearest
].green
;
1129 color_def
->blue
= cells
[nearest
].blue
;
1130 status
= XAllocColor (display
, screen_colormap
, color_def
);
1141 /* Given a string ARG naming a color, compute a pixel value from it
1142 suitable for screen F.
1143 If F is not a color screen, return DEF (default) regardless of what
1147 x_decode_color (f
, arg
, def
)
1154 CHECK_STRING (arg
, 0);
1156 if (strcmp (XSTRING (arg
)->data
, "black") == 0)
1157 return BLACK_PIX_DEFAULT (f
);
1158 else if (strcmp (XSTRING (arg
)->data
, "white") == 0)
1159 return WHITE_PIX_DEFAULT (f
);
1161 if (FRAME_X_DISPLAY_INFO (f
)->n_planes
== 1)
1164 /* defined_color is responsible for coping with failures
1165 by looking for a near-miss. */
1166 if (defined_color (f
, XSTRING (arg
)->data
, &cdef
, 1))
1169 Fsignal (Qerror
, Fcons (build_string ("undefined color"),
1170 Fcons (arg
, Qnil
)));
1173 /* Functions called only from `x_set_frame_param'
1174 to set individual parameters.
1176 If FRAME_X_WINDOW (f) is 0,
1177 the frame is being created and its X-window does not exist yet.
1178 In that case, just record the parameter's new value
1179 in the standard place; do not attempt to change the window. */
1182 x_set_foreground_color (f
, arg
, oldval
)
1184 Lisp_Object arg
, oldval
;
1186 f
->output_data
.x
->foreground_pixel
1187 = x_decode_color (f
, arg
, BLACK_PIX_DEFAULT (f
));
1188 if (FRAME_X_WINDOW (f
) != 0)
1191 XSetForeground (FRAME_X_DISPLAY (f
), f
->output_data
.x
->normal_gc
,
1192 f
->output_data
.x
->foreground_pixel
);
1193 XSetBackground (FRAME_X_DISPLAY (f
), f
->output_data
.x
->reverse_gc
,
1194 f
->output_data
.x
->foreground_pixel
);
1196 recompute_basic_faces (f
);
1197 if (FRAME_VISIBLE_P (f
))
1203 x_set_background_color (f
, arg
, oldval
)
1205 Lisp_Object arg
, oldval
;
1210 f
->output_data
.x
->background_pixel
1211 = x_decode_color (f
, arg
, WHITE_PIX_DEFAULT (f
));
1213 if (FRAME_X_WINDOW (f
) != 0)
1216 /* The main frame area. */
1217 XSetBackground (FRAME_X_DISPLAY (f
), f
->output_data
.x
->normal_gc
,
1218 f
->output_data
.x
->background_pixel
);
1219 XSetForeground (FRAME_X_DISPLAY (f
), f
->output_data
.x
->reverse_gc
,
1220 f
->output_data
.x
->background_pixel
);
1221 XSetForeground (FRAME_X_DISPLAY (f
), f
->output_data
.x
->cursor_gc
,
1222 f
->output_data
.x
->background_pixel
);
1223 XSetWindowBackground (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
1224 f
->output_data
.x
->background_pixel
);
1227 for (bar
= FRAME_SCROLL_BARS (f
); !NILP (bar
);
1228 bar
= XSCROLL_BAR (bar
)->next
)
1229 XSetWindowBackground (FRAME_X_DISPLAY (f
),
1230 SCROLL_BAR_X_WINDOW (XSCROLL_BAR (bar
)),
1231 f
->output_data
.x
->background_pixel
);
1235 recompute_basic_faces (f
);
1237 if (FRAME_VISIBLE_P (f
))
1243 x_set_mouse_color (f
, arg
, oldval
)
1245 Lisp_Object arg
, oldval
;
1247 Cursor cursor
, nontext_cursor
, mode_cursor
, cross_cursor
;
1250 if (!EQ (Qnil
, arg
))
1251 f
->output_data
.x
->mouse_pixel
1252 = x_decode_color (f
, arg
, BLACK_PIX_DEFAULT (f
));
1253 mask_color
= f
->output_data
.x
->background_pixel
;
1254 /* No invisible pointers. */
1255 if (mask_color
== f
->output_data
.x
->mouse_pixel
1256 && mask_color
== f
->output_data
.x
->background_pixel
)
1257 f
->output_data
.x
->mouse_pixel
= f
->output_data
.x
->foreground_pixel
;
1261 /* It's not okay to crash if the user selects a screwy cursor. */
1262 x_catch_errors (FRAME_X_DISPLAY (f
));
1264 if (!EQ (Qnil
, Vx_pointer_shape
))
1266 CHECK_NUMBER (Vx_pointer_shape
, 0);
1267 cursor
= XCreateFontCursor (FRAME_X_DISPLAY (f
), XINT (Vx_pointer_shape
));
1270 cursor
= XCreateFontCursor (FRAME_X_DISPLAY (f
), XC_xterm
);
1271 x_check_errors (FRAME_X_DISPLAY (f
), "bad text pointer cursor: %s");
1273 if (!EQ (Qnil
, Vx_nontext_pointer_shape
))
1275 CHECK_NUMBER (Vx_nontext_pointer_shape
, 0);
1276 nontext_cursor
= XCreateFontCursor (FRAME_X_DISPLAY (f
),
1277 XINT (Vx_nontext_pointer_shape
));
1280 nontext_cursor
= XCreateFontCursor (FRAME_X_DISPLAY (f
), XC_left_ptr
);
1281 x_check_errors (FRAME_X_DISPLAY (f
), "bad nontext pointer cursor: %s");
1283 if (!EQ (Qnil
, Vx_mode_pointer_shape
))
1285 CHECK_NUMBER (Vx_mode_pointer_shape
, 0);
1286 mode_cursor
= XCreateFontCursor (FRAME_X_DISPLAY (f
),
1287 XINT (Vx_mode_pointer_shape
));
1290 mode_cursor
= XCreateFontCursor (FRAME_X_DISPLAY (f
), XC_xterm
);
1291 x_check_errors (FRAME_X_DISPLAY (f
), "bad modeline pointer cursor: %s");
1293 if (!EQ (Qnil
, Vx_sensitive_text_pointer_shape
))
1295 CHECK_NUMBER (Vx_sensitive_text_pointer_shape
, 0);
1297 = XCreateFontCursor (FRAME_X_DISPLAY (f
),
1298 XINT (Vx_sensitive_text_pointer_shape
));
1301 cross_cursor
= XCreateFontCursor (FRAME_X_DISPLAY (f
), XC_crosshair
);
1303 /* Check and report errors with the above calls. */
1304 x_check_errors (FRAME_X_DISPLAY (f
), "can't set cursor shape: %s");
1305 x_uncatch_errors (FRAME_X_DISPLAY (f
));
1308 XColor fore_color
, back_color
;
1310 fore_color
.pixel
= f
->output_data
.x
->mouse_pixel
;
1311 back_color
.pixel
= mask_color
;
1312 XQueryColor (FRAME_X_DISPLAY (f
),
1313 DefaultColormap (FRAME_X_DISPLAY (f
),
1314 DefaultScreen (FRAME_X_DISPLAY (f
))),
1316 XQueryColor (FRAME_X_DISPLAY (f
),
1317 DefaultColormap (FRAME_X_DISPLAY (f
),
1318 DefaultScreen (FRAME_X_DISPLAY (f
))),
1320 XRecolorCursor (FRAME_X_DISPLAY (f
), cursor
,
1321 &fore_color
, &back_color
);
1322 XRecolorCursor (FRAME_X_DISPLAY (f
), nontext_cursor
,
1323 &fore_color
, &back_color
);
1324 XRecolorCursor (FRAME_X_DISPLAY (f
), mode_cursor
,
1325 &fore_color
, &back_color
);
1326 XRecolorCursor (FRAME_X_DISPLAY (f
), cross_cursor
,
1327 &fore_color
, &back_color
);
1330 if (FRAME_X_WINDOW (f
) != 0)
1332 XDefineCursor (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
), cursor
);
1335 if (cursor
!= f
->output_data
.x
->text_cursor
&& f
->output_data
.x
->text_cursor
!= 0)
1336 XFreeCursor (FRAME_X_DISPLAY (f
), f
->output_data
.x
->text_cursor
);
1337 f
->output_data
.x
->text_cursor
= cursor
;
1339 if (nontext_cursor
!= f
->output_data
.x
->nontext_cursor
1340 && f
->output_data
.x
->nontext_cursor
!= 0)
1341 XFreeCursor (FRAME_X_DISPLAY (f
), f
->output_data
.x
->nontext_cursor
);
1342 f
->output_data
.x
->nontext_cursor
= nontext_cursor
;
1344 if (mode_cursor
!= f
->output_data
.x
->modeline_cursor
1345 && f
->output_data
.x
->modeline_cursor
!= 0)
1346 XFreeCursor (FRAME_X_DISPLAY (f
), f
->output_data
.x
->modeline_cursor
);
1347 f
->output_data
.x
->modeline_cursor
= mode_cursor
;
1348 if (cross_cursor
!= f
->output_data
.x
->cross_cursor
1349 && f
->output_data
.x
->cross_cursor
!= 0)
1350 XFreeCursor (FRAME_X_DISPLAY (f
), f
->output_data
.x
->cross_cursor
);
1351 f
->output_data
.x
->cross_cursor
= cross_cursor
;
1353 XFlush (FRAME_X_DISPLAY (f
));
1358 x_set_cursor_color (f
, arg
, oldval
)
1360 Lisp_Object arg
, oldval
;
1362 unsigned long fore_pixel
;
1364 if (!EQ (Vx_cursor_fore_pixel
, Qnil
))
1365 fore_pixel
= x_decode_color (f
, Vx_cursor_fore_pixel
,
1366 WHITE_PIX_DEFAULT (f
));
1368 fore_pixel
= f
->output_data
.x
->background_pixel
;
1369 f
->output_data
.x
->cursor_pixel
= x_decode_color (f
, arg
, BLACK_PIX_DEFAULT (f
));
1371 /* Make sure that the cursor color differs from the background color. */
1372 if (f
->output_data
.x
->cursor_pixel
== f
->output_data
.x
->background_pixel
)
1374 f
->output_data
.x
->cursor_pixel
= f
->output_data
.x
->mouse_pixel
;
1375 if (f
->output_data
.x
->cursor_pixel
== fore_pixel
)
1376 fore_pixel
= f
->output_data
.x
->background_pixel
;
1378 f
->output_data
.x
->cursor_foreground_pixel
= fore_pixel
;
1380 if (FRAME_X_WINDOW (f
) != 0)
1383 XSetBackground (FRAME_X_DISPLAY (f
), f
->output_data
.x
->cursor_gc
,
1384 f
->output_data
.x
->cursor_pixel
);
1385 XSetForeground (FRAME_X_DISPLAY (f
), f
->output_data
.x
->cursor_gc
,
1389 if (FRAME_VISIBLE_P (f
))
1391 x_display_cursor (f
, 0);
1392 x_display_cursor (f
, 1);
1397 /* Set the border-color of frame F to value described by ARG.
1398 ARG can be a string naming a color.
1399 The border-color is used for the border that is drawn by the X server.
1400 Note that this does not fully take effect if done before
1401 F has an x-window; it must be redone when the window is created.
1403 Note: this is done in two routines because of the way X10 works.
1405 Note: under X11, this is normally the province of the window manager,
1406 and so emacs' border colors may be overridden. */
1409 x_set_border_color (f
, arg
, oldval
)
1411 Lisp_Object arg
, oldval
;
1416 CHECK_STRING (arg
, 0);
1417 str
= XSTRING (arg
)->data
;
1419 pix
= x_decode_color (f
, arg
, BLACK_PIX_DEFAULT (f
));
1421 x_set_border_pixel (f
, pix
);
1424 /* Set the border-color of frame F to pixel value PIX.
1425 Note that this does not fully take effect if done before
1426 F has an x-window. */
1428 x_set_border_pixel (f
, pix
)
1432 f
->output_data
.x
->border_pixel
= pix
;
1434 if (FRAME_X_WINDOW (f
) != 0 && f
->output_data
.x
->border_width
> 0)
1440 XSetWindowBorder (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
1441 (unsigned long)pix
);
1444 if (FRAME_VISIBLE_P (f
))
1450 x_set_cursor_type (f
, arg
, oldval
)
1452 Lisp_Object arg
, oldval
;
1456 FRAME_DESIRED_CURSOR (f
) = bar_cursor
;
1457 f
->output_data
.x
->cursor_width
= 2;
1459 else if (CONSP (arg
) && EQ (XCONS (arg
)->car
, Qbar
)
1460 && INTEGERP (XCONS (arg
)->cdr
))
1462 FRAME_DESIRED_CURSOR (f
) = bar_cursor
;
1463 f
->output_data
.x
->cursor_width
= XINT (XCONS (arg
)->cdr
);
1466 /* Treat anything unknown as "box cursor".
1467 It was bad to signal an error; people have trouble fixing
1468 .Xdefaults with Emacs, when it has something bad in it. */
1469 FRAME_DESIRED_CURSOR (f
) = filled_box_cursor
;
1471 /* Make sure the cursor gets redrawn. This is overkill, but how
1472 often do people change cursor types? */
1473 update_mode_lines
++;
1477 x_set_icon_type (f
, arg
, oldval
)
1479 Lisp_Object arg
, oldval
;
1486 if (STRINGP (oldval
) && EQ (Fstring_equal (oldval
, arg
), Qt
))
1489 else if (!STRINGP (oldval
) && EQ (oldval
, Qnil
) == EQ (arg
, Qnil
))
1494 result
= x_text_icon (f
,
1495 (char *) XSTRING ((!NILP (f
->icon_name
)
1499 result
= x_bitmap_icon (f
, arg
);
1504 error ("No icon window available");
1507 XFlush (FRAME_X_DISPLAY (f
));
1511 /* Return non-nil if frame F wants a bitmap icon. */
1519 tem
= assq_no_quit (Qicon_type
, f
->param_alist
);
1521 return XCONS (tem
)->cdr
;
1527 x_set_icon_name (f
, arg
, oldval
)
1529 Lisp_Object arg
, oldval
;
1536 if (STRINGP (oldval
) && EQ (Fstring_equal (oldval
, arg
), Qt
))
1539 else if (!STRINGP (oldval
) && EQ (oldval
, Qnil
) == EQ (arg
, Qnil
))
1544 if (f
->output_data
.x
->icon_bitmap
!= 0)
1549 result
= x_text_icon (f
,
1550 (char *) XSTRING ((!NILP (f
->icon_name
)
1557 error ("No icon window available");
1560 XFlush (FRAME_X_DISPLAY (f
));
1564 extern Lisp_Object
x_new_font ();
1567 x_set_font (f
, arg
, oldval
)
1569 Lisp_Object arg
, oldval
;
1573 CHECK_STRING (arg
, 1);
1576 result
= x_new_font (f
, XSTRING (arg
)->data
);
1579 if (EQ (result
, Qnil
))
1580 error ("Font \"%s\" is not defined", XSTRING (arg
)->data
);
1581 else if (EQ (result
, Qt
))
1582 error ("the characters of the given font have varying widths");
1583 else if (STRINGP (result
))
1585 recompute_basic_faces (f
);
1586 store_frame_param (f
, Qfont
, result
);
1593 x_set_border_width (f
, arg
, oldval
)
1595 Lisp_Object arg
, oldval
;
1597 CHECK_NUMBER (arg
, 0);
1599 if (XINT (arg
) == f
->output_data
.x
->border_width
)
1602 if (FRAME_X_WINDOW (f
) != 0)
1603 error ("Cannot change the border width of a window");
1605 f
->output_data
.x
->border_width
= XINT (arg
);
1609 x_set_internal_border_width (f
, arg
, oldval
)
1611 Lisp_Object arg
, oldval
;
1614 int old
= f
->output_data
.x
->internal_border_width
;
1616 CHECK_NUMBER (arg
, 0);
1617 f
->output_data
.x
->internal_border_width
= XINT (arg
);
1618 if (f
->output_data
.x
->internal_border_width
< 0)
1619 f
->output_data
.x
->internal_border_width
= 0;
1621 if (f
->output_data
.x
->internal_border_width
== old
)
1624 if (FRAME_X_WINDOW (f
) != 0)
1627 x_set_window_size (f
, 0, f
->width
, f
->height
);
1629 x_set_resize_hint (f
);
1631 XFlush (FRAME_X_DISPLAY (f
));
1633 SET_FRAME_GARBAGED (f
);
1638 x_set_visibility (f
, value
, oldval
)
1640 Lisp_Object value
, oldval
;
1643 XSETFRAME (frame
, f
);
1646 Fmake_frame_invisible (frame
, Qt
);
1647 else if (EQ (value
, Qicon
))
1648 Ficonify_frame (frame
);
1650 Fmake_frame_visible (frame
);
1654 x_set_menu_bar_lines_1 (window
, n
)
1658 struct window
*w
= XWINDOW (window
);
1660 XSETFASTINT (w
->top
, XFASTINT (w
->top
) + n
);
1661 XSETFASTINT (w
->height
, XFASTINT (w
->height
) - n
);
1663 /* Handle just the top child in a vertical split. */
1664 if (!NILP (w
->vchild
))
1665 x_set_menu_bar_lines_1 (w
->vchild
, n
);
1667 /* Adjust all children in a horizontal split. */
1668 for (window
= w
->hchild
; !NILP (window
); window
= w
->next
)
1670 w
= XWINDOW (window
);
1671 x_set_menu_bar_lines_1 (window
, n
);
1676 x_set_menu_bar_lines (f
, value
, oldval
)
1678 Lisp_Object value
, oldval
;
1681 int olines
= FRAME_MENU_BAR_LINES (f
);
1683 /* Right now, menu bars don't work properly in minibuf-only frames;
1684 most of the commands try to apply themselves to the minibuffer
1685 frame itslef, and get an error because you can't switch buffers
1686 in or split the minibuffer window. */
1687 if (FRAME_MINIBUF_ONLY_P (f
))
1690 if (INTEGERP (value
))
1691 nlines
= XINT (value
);
1695 #ifdef USE_X_TOOLKIT
1696 FRAME_MENU_BAR_LINES (f
) = 0;
1699 FRAME_EXTERNAL_MENU_BAR (f
) = 1;
1700 if (f
->output_data
.x
->menubar_widget
== 0)
1701 /* Make sure next redisplay shows the menu bar. */
1702 XWINDOW (FRAME_SELECTED_WINDOW (f
))->update_mode_line
= Qt
;
1706 if (FRAME_EXTERNAL_MENU_BAR (f
) == 1)
1707 free_frame_menubar (f
);
1708 FRAME_EXTERNAL_MENU_BAR (f
) = 0;
1709 f
->output_data
.x
->menubar_widget
= 0;
1711 #else /* not USE_X_TOOLKIT */
1712 FRAME_MENU_BAR_LINES (f
) = nlines
;
1713 x_set_menu_bar_lines_1 (f
->root_window
, nlines
- olines
);
1714 #endif /* not USE_X_TOOLKIT */
1717 /* Change the name of frame F to NAME. If NAME is nil, set F's name to
1720 If EXPLICIT is non-zero, that indicates that lisp code is setting the
1721 name; if NAME is a string, set F's name to NAME and set
1722 F->explicit_name; if NAME is Qnil, then clear F->explicit_name.
1724 If EXPLICIT is zero, that indicates that Emacs redisplay code is
1725 suggesting a new name, which lisp code should override; if
1726 F->explicit_name is set, ignore the new name; otherwise, set it. */
1729 x_set_name (f
, name
, explicit)
1734 /* Make sure that requests from lisp code override requests from
1735 Emacs redisplay code. */
1738 /* If we're switching from explicit to implicit, we had better
1739 update the mode lines and thereby update the title. */
1740 if (f
->explicit_name
&& NILP (name
))
1741 update_mode_lines
= 1;
1743 f
->explicit_name
= ! NILP (name
);
1745 else if (f
->explicit_name
)
1748 /* If NAME is nil, set the name to the x_id_name. */
1751 /* Check for no change needed in this very common case
1752 before we do any consing. */
1753 if (!strcmp (FRAME_X_DISPLAY_INFO (f
)->x_id_name
,
1754 XSTRING (f
->name
)->data
))
1756 name
= build_string (FRAME_X_DISPLAY_INFO (f
)->x_id_name
);
1759 CHECK_STRING (name
, 0);
1761 /* Don't change the name if it's already NAME. */
1762 if (! NILP (Fstring_equal (name
, f
->name
)))
1765 if (FRAME_X_WINDOW (f
))
1770 XTextProperty text
, icon
;
1771 Lisp_Object icon_name
;
1773 text
.value
= XSTRING (name
)->data
;
1774 text
.encoding
= XA_STRING
;
1776 text
.nitems
= XSTRING (name
)->size
;
1778 icon_name
= (!NILP (f
->icon_name
) ? f
->icon_name
: name
);
1780 icon
.value
= XSTRING (icon_name
)->data
;
1781 icon
.encoding
= XA_STRING
;
1783 icon
.nitems
= XSTRING (icon_name
)->size
;
1784 #ifdef USE_X_TOOLKIT
1785 XSetWMName (FRAME_X_DISPLAY (f
),
1786 XtWindow (f
->output_data
.x
->widget
), &text
);
1787 XSetWMIconName (FRAME_X_DISPLAY (f
), XtWindow (f
->output_data
.x
->widget
),
1789 #else /* not USE_X_TOOLKIT */
1790 XSetWMName (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
), &text
);
1791 XSetWMIconName (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
), &icon
);
1792 #endif /* not USE_X_TOOLKIT */
1794 #else /* not HAVE_X11R4 */
1795 XSetIconName (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
1796 XSTRING (name
)->data
);
1797 XStoreName (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
1798 XSTRING (name
)->data
);
1799 #endif /* not HAVE_X11R4 */
1806 /* This function should be called when the user's lisp code has
1807 specified a name for the frame; the name will override any set by the
1810 x_explicitly_set_name (f
, arg
, oldval
)
1812 Lisp_Object arg
, oldval
;
1814 x_set_name (f
, arg
, 1);
1817 /* This function should be called by Emacs redisplay code to set the
1818 name; names set this way will never override names set by the user's
1821 x_implicitly_set_name (f
, arg
, oldval
)
1823 Lisp_Object arg
, oldval
;
1825 x_set_name (f
, arg
, 0);
1829 x_set_autoraise (f
, arg
, oldval
)
1831 Lisp_Object arg
, oldval
;
1833 f
->auto_raise
= !EQ (Qnil
, arg
);
1837 x_set_autolower (f
, arg
, oldval
)
1839 Lisp_Object arg
, oldval
;
1841 f
->auto_lower
= !EQ (Qnil
, arg
);
1845 x_set_unsplittable (f
, arg
, oldval
)
1847 Lisp_Object arg
, oldval
;
1849 f
->no_split
= !NILP (arg
);
1853 x_set_vertical_scroll_bars (f
, arg
, oldval
)
1855 Lisp_Object arg
, oldval
;
1857 if (NILP (arg
) != ! FRAME_HAS_VERTICAL_SCROLL_BARS (f
))
1859 FRAME_HAS_VERTICAL_SCROLL_BARS (f
) = ! NILP (arg
);
1861 /* We set this parameter before creating the X window for the
1862 frame, so we can get the geometry right from the start.
1863 However, if the window hasn't been created yet, we shouldn't
1864 call x_set_window_size. */
1865 if (FRAME_X_WINDOW (f
))
1866 x_set_window_size (f
, 0, FRAME_WIDTH (f
), FRAME_HEIGHT (f
));
1871 x_set_scroll_bar_width (f
, arg
, oldval
)
1873 Lisp_Object arg
, oldval
;
1877 FRAME_SCROLL_BAR_PIXEL_WIDTH (f
) = 0;
1878 FRAME_SCROLL_BAR_COLS (f
) = 2;
1880 else if (INTEGERP (arg
) && XINT (arg
) > 0
1881 && XFASTINT (arg
) != FRAME_SCROLL_BAR_PIXEL_WIDTH (f
))
1883 int wid
= FONT_WIDTH (f
->output_data
.x
->font
);
1884 FRAME_SCROLL_BAR_PIXEL_WIDTH (f
) = XFASTINT (arg
);
1885 FRAME_SCROLL_BAR_COLS (f
) = (XFASTINT (arg
) + wid
-1) / wid
;
1886 if (FRAME_X_WINDOW (f
))
1887 x_set_window_size (f
, 0, FRAME_WIDTH (f
), FRAME_HEIGHT (f
));
1891 /* Subroutines of creating an X frame. */
1893 /* Make sure that Vx_resource_name is set to a reasonable value.
1894 Fix it up, or set it to `emacs' if it is too hopeless. */
1897 validate_x_resource_name ()
1900 /* Number of valid characters in the resource name. */
1902 /* Number of invalid characters in the resource name. */
1907 if (STRINGP (Vx_resource_name
))
1909 unsigned char *p
= XSTRING (Vx_resource_name
)->data
;
1912 len
= XSTRING (Vx_resource_name
)->size
;
1914 /* Only letters, digits, - and _ are valid in resource names.
1915 Count the valid characters and count the invalid ones. */
1916 for (i
= 0; i
< len
; i
++)
1919 if (! ((c
>= 'a' && c
<= 'z')
1920 || (c
>= 'A' && c
<= 'Z')
1921 || (c
>= '0' && c
<= '9')
1922 || c
== '-' || c
== '_'))
1929 /* Not a string => completely invalid. */
1930 bad_count
= 5, good_count
= 0;
1932 /* If name is valid already, return. */
1936 /* If name is entirely invalid, or nearly so, use `emacs'. */
1938 || (good_count
== 1 && bad_count
> 0))
1940 Vx_resource_name
= build_string ("emacs");
1944 /* Name is partly valid. Copy it and replace the invalid characters
1945 with underscores. */
1947 Vx_resource_name
= new = Fcopy_sequence (Vx_resource_name
);
1949 for (i
= 0; i
< len
; i
++)
1951 int c
= XSTRING (new)->data
[i
];
1952 if (! ((c
>= 'a' && c
<= 'z')
1953 || (c
>= 'A' && c
<= 'Z')
1954 || (c
>= '0' && c
<= '9')
1955 || c
== '-' || c
== '_'))
1956 XSTRING (new)->data
[i
] = '_';
1961 extern char *x_get_string_resource ();
1963 DEFUN ("x-get-resource", Fx_get_resource
, Sx_get_resource
, 2, 4, 0,
1964 "Return the value of ATTRIBUTE, of class CLASS, from the X defaults database.\n\
1965 This uses `INSTANCE.ATTRIBUTE' as the key and `Emacs.CLASS' as the\n\
1966 class, where INSTANCE is the name under which Emacs was invoked, or\n\
1967 the name specified by the `-name' or `-rn' command-line arguments.\n\
1969 The optional arguments COMPONENT and SUBCLASS add to the key and the\n\
1970 class, respectively. You must specify both of them or neither.\n\
1971 If you specify them, the key is `INSTANCE.COMPONENT.ATTRIBUTE'\n\
1972 and the class is `Emacs.CLASS.SUBCLASS'.")
1973 (attribute
, class, component
, subclass
)
1974 Lisp_Object attribute
, class, component
, subclass
;
1976 register char *value
;
1982 CHECK_STRING (attribute
, 0);
1983 CHECK_STRING (class, 0);
1985 if (!NILP (component
))
1986 CHECK_STRING (component
, 1);
1987 if (!NILP (subclass
))
1988 CHECK_STRING (subclass
, 2);
1989 if (NILP (component
) != NILP (subclass
))
1990 error ("x-get-resource: must specify both COMPONENT and SUBCLASS or neither");
1992 validate_x_resource_name ();
1994 /* Allocate space for the components, the dots which separate them,
1995 and the final '\0'. Make them big enough for the worst case. */
1996 name_key
= (char *) alloca (XSTRING (Vx_resource_name
)->size
1997 + (STRINGP (component
)
1998 ? XSTRING (component
)->size
: 0)
1999 + XSTRING (attribute
)->size
2002 class_key
= (char *) alloca ((sizeof (EMACS_CLASS
) - 1)
2003 + XSTRING (class)->size
2004 + (STRINGP (subclass
)
2005 ? XSTRING (subclass
)->size
: 0)
2008 /* Start with emacs.FRAMENAME for the name (the specific one)
2009 and with `Emacs' for the class key (the general one). */
2010 strcpy (name_key
, XSTRING (Vx_resource_name
)->data
);
2011 strcpy (class_key
, EMACS_CLASS
);
2013 strcat (class_key
, ".");
2014 strcat (class_key
, XSTRING (class)->data
);
2016 if (!NILP (component
))
2018 strcat (class_key
, ".");
2019 strcat (class_key
, XSTRING (subclass
)->data
);
2021 strcat (name_key
, ".");
2022 strcat (name_key
, XSTRING (component
)->data
);
2025 strcat (name_key
, ".");
2026 strcat (name_key
, XSTRING (attribute
)->data
);
2028 value
= x_get_string_resource (check_x_display_info (Qnil
)->xrdb
,
2029 name_key
, class_key
);
2031 if (value
!= (char *) 0)
2032 return build_string (value
);
2037 /* Used when C code wants a resource value. */
2040 x_get_resource_string (attribute
, class)
2041 char *attribute
, *class;
2043 register char *value
;
2047 /* Allocate space for the components, the dots which separate them,
2048 and the final '\0'. */
2049 name_key
= (char *) alloca (XSTRING (Vinvocation_name
)->size
2050 + strlen (attribute
) + 2);
2051 class_key
= (char *) alloca ((sizeof (EMACS_CLASS
) - 1)
2052 + strlen (class) + 2);
2054 sprintf (name_key
, "%s.%s",
2055 XSTRING (Vinvocation_name
)->data
,
2057 sprintf (class_key
, "%s.%s", EMACS_CLASS
, class);
2059 return x_get_string_resource (FRAME_X_DISPLAY_INFO (selected_frame
)->xrdb
,
2060 name_key
, class_key
);
2063 /* Types we might convert a resource string into. */
2066 number
, boolean
, string
, symbol
2069 /* Return the value of parameter PARAM.
2071 First search ALIST, then Vdefault_frame_alist, then the X defaults
2072 database, using ATTRIBUTE as the attribute name and CLASS as its class.
2074 Convert the resource to the type specified by desired_type.
2076 If no default is specified, return Qunbound. If you call
2077 x_get_arg, make sure you deal with Qunbound in a reasonable way,
2078 and don't let it get stored in any Lisp-visible variables! */
2081 x_get_arg (alist
, param
, attribute
, class, type
)
2082 Lisp_Object alist
, param
;
2085 enum resource_types type
;
2087 register Lisp_Object tem
;
2089 tem
= Fassq (param
, alist
);
2091 tem
= Fassq (param
, Vdefault_frame_alist
);
2097 tem
= Fx_get_resource (build_string (attribute
),
2098 build_string (class),
2107 return make_number (atoi (XSTRING (tem
)->data
));
2110 tem
= Fdowncase (tem
);
2111 if (!strcmp (XSTRING (tem
)->data
, "on")
2112 || !strcmp (XSTRING (tem
)->data
, "true"))
2121 /* As a special case, we map the values `true' and `on'
2122 to Qt, and `false' and `off' to Qnil. */
2125 lower
= Fdowncase (tem
);
2126 if (!strcmp (XSTRING (lower
)->data
, "on")
2127 || !strcmp (XSTRING (lower
)->data
, "true"))
2129 else if (!strcmp (XSTRING (lower
)->data
, "off")
2130 || !strcmp (XSTRING (lower
)->data
, "false"))
2133 return Fintern (tem
, Qnil
);
2146 /* Record in frame F the specified or default value according to ALIST
2147 of the parameter named PARAM (a Lisp symbol).
2148 If no value is specified for PARAM, look for an X default for XPROP
2149 on the frame named NAME.
2150 If that is not found either, use the value DEFLT. */
2153 x_default_parameter (f
, alist
, prop
, deflt
, xprop
, xclass
, type
)
2160 enum resource_types type
;
2164 tem
= x_get_arg (alist
, prop
, xprop
, xclass
, type
);
2165 if (EQ (tem
, Qunbound
))
2167 x_set_frame_parameters (f
, Fcons (Fcons (prop
, tem
), Qnil
));
2171 DEFUN ("x-parse-geometry", Fx_parse_geometry
, Sx_parse_geometry
, 1, 1, 0,
2172 "Parse an X-style geometry string STRING.\n\
2173 Returns an alist of the form ((top . TOP), (left . LEFT) ... ).\n\
2174 The properties returned may include `top', `left', `height', and `width'.\n\
2175 The value of `left' or `top' may be an integer,\n\
2176 or a list (+ N) meaning N pixels relative to top/left corner,\n\
2177 or a list (- N) meaning -N pixels relative to bottom/right corner.")
2182 unsigned int width
, height
;
2185 CHECK_STRING (string
, 0);
2187 geometry
= XParseGeometry ((char *) XSTRING (string
)->data
,
2188 &x
, &y
, &width
, &height
);
2191 if (!!(geometry
& XValue
) != !!(geometry
& YValue
))
2192 error ("Must specify both x and y position, or neither");
2196 if (geometry
& XValue
)
2198 Lisp_Object element
;
2200 if (x
>= 0 && (geometry
& XNegative
))
2201 element
= Fcons (Qleft
, Fcons (Qminus
, Fcons (make_number (-x
), Qnil
)));
2202 else if (x
< 0 && ! (geometry
& XNegative
))
2203 element
= Fcons (Qleft
, Fcons (Qplus
, Fcons (make_number (x
), Qnil
)));
2205 element
= Fcons (Qleft
, make_number (x
));
2206 result
= Fcons (element
, result
);
2209 if (geometry
& YValue
)
2211 Lisp_Object element
;
2213 if (y
>= 0 && (geometry
& YNegative
))
2214 element
= Fcons (Qtop
, Fcons (Qminus
, Fcons (make_number (-y
), Qnil
)));
2215 else if (y
< 0 && ! (geometry
& YNegative
))
2216 element
= Fcons (Qtop
, Fcons (Qplus
, Fcons (make_number (y
), Qnil
)));
2218 element
= Fcons (Qtop
, make_number (y
));
2219 result
= Fcons (element
, result
);
2222 if (geometry
& WidthValue
)
2223 result
= Fcons (Fcons (Qwidth
, make_number (width
)), result
);
2224 if (geometry
& HeightValue
)
2225 result
= Fcons (Fcons (Qheight
, make_number (height
)), result
);
2230 /* Calculate the desired size and position of this window,
2231 and return the flags saying which aspects were specified.
2233 This function does not make the coordinates positive. */
2235 #define DEFAULT_ROWS 40
2236 #define DEFAULT_COLS 80
2239 x_figure_window_size (f
, parms
)
2243 register Lisp_Object tem0
, tem1
, tem2
;
2244 int height
, width
, left
, top
;
2245 register int geometry
;
2246 long window_prompting
= 0;
2248 /* Default values if we fall through.
2249 Actually, if that happens we should get
2250 window manager prompting. */
2251 f
->width
= DEFAULT_COLS
;
2252 f
->height
= DEFAULT_ROWS
;
2253 /* Window managers expect that if program-specified
2254 positions are not (0,0), they're intentional, not defaults. */
2255 f
->output_data
.x
->top_pos
= 0;
2256 f
->output_data
.x
->left_pos
= 0;
2258 tem0
= x_get_arg (parms
, Qheight
, 0, 0, number
);
2259 tem1
= x_get_arg (parms
, Qwidth
, 0, 0, number
);
2260 tem2
= x_get_arg (parms
, Quser_size
, 0, 0, number
);
2261 if (! EQ (tem0
, Qunbound
) || ! EQ (tem1
, Qunbound
))
2263 if (!EQ (tem0
, Qunbound
))
2265 CHECK_NUMBER (tem0
, 0);
2266 f
->height
= XINT (tem0
);
2268 if (!EQ (tem1
, Qunbound
))
2270 CHECK_NUMBER (tem1
, 0);
2271 f
->width
= XINT (tem1
);
2273 if (!NILP (tem2
) && !EQ (tem2
, Qunbound
))
2274 window_prompting
|= USSize
;
2276 window_prompting
|= PSize
;
2279 f
->output_data
.x
->vertical_scroll_bar_extra
2280 = (!FRAME_HAS_VERTICAL_SCROLL_BARS (f
)
2282 : FRAME_SCROLL_BAR_PIXEL_WIDTH (f
) > 0
2283 ? FRAME_SCROLL_BAR_PIXEL_WIDTH (f
)
2284 : (FRAME_SCROLL_BAR_COLS (f
) * FONT_WIDTH (f
->output_data
.x
->font
)));
2285 f
->output_data
.x
->pixel_width
= CHAR_TO_PIXEL_WIDTH (f
, f
->width
);
2286 f
->output_data
.x
->pixel_height
= CHAR_TO_PIXEL_HEIGHT (f
, f
->height
);
2288 tem0
= x_get_arg (parms
, Qtop
, 0, 0, number
);
2289 tem1
= x_get_arg (parms
, Qleft
, 0, 0, number
);
2290 tem2
= x_get_arg (parms
, Quser_position
, 0, 0, number
);
2291 if (! EQ (tem0
, Qunbound
) || ! EQ (tem1
, Qunbound
))
2293 if (EQ (tem0
, Qminus
))
2295 f
->output_data
.x
->top_pos
= 0;
2296 window_prompting
|= YNegative
;
2298 else if (CONSP (tem0
) && EQ (XCONS (tem0
)->car
, Qminus
)
2299 && CONSP (XCONS (tem0
)->cdr
)
2300 && INTEGERP (XCONS (XCONS (tem0
)->cdr
)->car
))
2302 f
->output_data
.x
->top_pos
= - XINT (XCONS (XCONS (tem0
)->cdr
)->car
);
2303 window_prompting
|= YNegative
;
2305 else if (CONSP (tem0
) && EQ (XCONS (tem0
)->car
, Qplus
)
2306 && CONSP (XCONS (tem0
)->cdr
)
2307 && INTEGERP (XCONS (XCONS (tem0
)->cdr
)->car
))
2309 f
->output_data
.x
->top_pos
= XINT (XCONS (XCONS (tem0
)->cdr
)->car
);
2311 else if (EQ (tem0
, Qunbound
))
2312 f
->output_data
.x
->top_pos
= 0;
2315 CHECK_NUMBER (tem0
, 0);
2316 f
->output_data
.x
->top_pos
= XINT (tem0
);
2317 if (f
->output_data
.x
->top_pos
< 0)
2318 window_prompting
|= YNegative
;
2321 if (EQ (tem1
, Qminus
))
2323 f
->output_data
.x
->left_pos
= 0;
2324 window_prompting
|= XNegative
;
2326 else if (CONSP (tem1
) && EQ (XCONS (tem1
)->car
, Qminus
)
2327 && CONSP (XCONS (tem1
)->cdr
)
2328 && INTEGERP (XCONS (XCONS (tem1
)->cdr
)->car
))
2330 f
->output_data
.x
->left_pos
= - XINT (XCONS (XCONS (tem1
)->cdr
)->car
);
2331 window_prompting
|= XNegative
;
2333 else if (CONSP (tem1
) && EQ (XCONS (tem1
)->car
, Qplus
)
2334 && CONSP (XCONS (tem1
)->cdr
)
2335 && INTEGERP (XCONS (XCONS (tem1
)->cdr
)->car
))
2337 f
->output_data
.x
->left_pos
= XINT (XCONS (XCONS (tem1
)->cdr
)->car
);
2339 else if (EQ (tem1
, Qunbound
))
2340 f
->output_data
.x
->left_pos
= 0;
2343 CHECK_NUMBER (tem1
, 0);
2344 f
->output_data
.x
->left_pos
= XINT (tem1
);
2345 if (f
->output_data
.x
->left_pos
< 0)
2346 window_prompting
|= XNegative
;
2349 if (!NILP (tem2
) && ! EQ (tem2
, Qunbound
))
2350 window_prompting
|= USPosition
;
2352 window_prompting
|= PPosition
;
2355 return window_prompting
;
2358 #if !defined (HAVE_X11R4) && !defined (HAVE_XSETWMPROTOCOLS)
2361 XSetWMProtocols (dpy
, w
, protocols
, count
)
2368 prop
= XInternAtom (dpy
, "WM_PROTOCOLS", False
);
2369 if (prop
== None
) return False
;
2370 XChangeProperty (dpy
, w
, prop
, XA_ATOM
, 32, PropModeReplace
,
2371 (unsigned char *) protocols
, count
);
2374 #endif /* not HAVE_X11R4 && not HAVE_XSETWMPROTOCOLS */
2376 #ifdef USE_X_TOOLKIT
2378 /* If the WM_PROTOCOLS property does not already contain WM_TAKE_FOCUS,
2379 WM_DELETE_WINDOW, and WM_SAVE_YOURSELF, then add them. (They may
2380 already be present because of the toolkit (Motif adds some of them,
2381 for example, but Xt doesn't). */
2384 hack_wm_protocols (f
, widget
)
2388 Display
*dpy
= XtDisplay (widget
);
2389 Window w
= XtWindow (widget
);
2390 int need_delete
= 1;
2396 Atom type
, *atoms
= 0;
2398 unsigned long nitems
= 0;
2399 unsigned long bytes_after
;
2401 if ((XGetWindowProperty (dpy
, w
,
2402 FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_protocols
,
2403 (long)0, (long)100, False
, XA_ATOM
,
2404 &type
, &format
, &nitems
, &bytes_after
,
2405 (unsigned char **) &atoms
)
2407 && format
== 32 && type
== XA_ATOM
)
2411 if (atoms
[nitems
] == FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_delete_window
)
2413 else if (atoms
[nitems
] == FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_take_focus
)
2415 else if (atoms
[nitems
] == FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_save_yourself
)
2418 if (atoms
) XFree ((char *) atoms
);
2424 props
[count
++] = FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_delete_window
;
2426 props
[count
++] = FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_take_focus
;
2428 props
[count
++] = FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_save_yourself
;
2430 XChangeProperty (dpy
, w
, FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_protocols
,
2431 XA_ATOM
, 32, PropModeAppend
,
2432 (unsigned char *) props
, count
);
2438 #ifdef USE_X_TOOLKIT
2440 /* Create and set up the X widget for frame F. */
2443 x_window (f
, window_prompting
, minibuffer_only
)
2445 long window_prompting
;
2446 int minibuffer_only
;
2448 XClassHint class_hints
;
2449 XSetWindowAttributes attributes
;
2450 unsigned long attribute_mask
;
2452 Widget shell_widget
;
2454 Widget frame_widget
;
2460 /* Use the resource name as the top-level widget name
2461 for looking up resources. Make a non-Lisp copy
2462 for the window manager, so GC relocation won't bother it.
2464 Elsewhere we specify the window name for the window manager. */
2467 char *str
= (char *) XSTRING (Vx_resource_name
)->data
;
2468 f
->namebuf
= (char *) xmalloc (strlen (str
) + 1);
2469 strcpy (f
->namebuf
, str
);
2473 XtSetArg (al
[ac
], XtNallowShellResize
, 1); ac
++;
2474 XtSetArg (al
[ac
], XtNinput
, 1); ac
++;
2475 XtSetArg (al
[ac
], XtNmappedWhenManaged
, 0); ac
++;
2476 XtSetArg (al
[ac
], XtNborderWidth
, f
->output_data
.x
->border_width
); ac
++;
2477 shell_widget
= XtAppCreateShell (f
->namebuf
, EMACS_CLASS
,
2478 applicationShellWidgetClass
,
2479 FRAME_X_DISPLAY (f
), al
, ac
);
2481 f
->output_data
.x
->widget
= shell_widget
;
2482 /* maybe_set_screen_title_format (shell_widget); */
2484 pane_widget
= lw_create_widget ("main", "pane", widget_id_tick
++,
2485 (widget_value
*) NULL
,
2486 shell_widget
, False
,
2489 (lw_callback
) NULL
);
2491 f
->output_data
.x
->column_widget
= pane_widget
;
2493 /* mappedWhenManaged to false tells to the paned window to not map/unmap
2494 the emacs screen when changing menubar. This reduces flickering. */
2497 XtSetArg (al
[ac
], XtNmappedWhenManaged
, 0); ac
++;
2498 XtSetArg (al
[ac
], XtNshowGrip
, 0); ac
++;
2499 XtSetArg (al
[ac
], XtNallowResize
, 1); ac
++;
2500 XtSetArg (al
[ac
], XtNresizeToPreferred
, 1); ac
++;
2501 XtSetArg (al
[ac
], XtNemacsFrame
, f
); ac
++;
2502 frame_widget
= XtCreateWidget (f
->namebuf
,
2504 pane_widget
, al
, ac
);
2506 f
->output_data
.x
->edit_widget
= frame_widget
;
2508 XtManageChild (frame_widget
);
2510 /* Do some needed geometry management. */
2513 char *tem
, shell_position
[32];
2516 int extra_borders
= 0;
2518 = (f
->output_data
.x
->menubar_widget
2519 ? (f
->output_data
.x
->menubar_widget
->core
.height
2520 + f
->output_data
.x
->menubar_widget
->core
.border_width
)
2522 extern char *lwlib_toolkit_type
;
2524 if (FRAME_EXTERNAL_MENU_BAR (f
))
2527 XtVaGetValues (pane_widget
, XtNinternalBorderWidth
, &ibw
, NULL
);
2528 menubar_size
+= ibw
;
2531 f
->output_data
.x
->menubar_height
= menubar_size
;
2533 /* Motif seems to need this amount added to the sizes
2534 specified for the shell widget. The Athena/Lucid widgets don't.
2535 Both conclusions reached experimentally. -- rms. */
2536 if (!strcmp (lwlib_toolkit_type
, "motif"))
2537 XtVaGetValues (f
->output_data
.x
->edit_widget
, XtNinternalBorderWidth
,
2538 &extra_borders
, NULL
);
2540 /* Convert our geometry parameters into a geometry string
2542 Note that we do not specify here whether the position
2543 is a user-specified or program-specified one.
2544 We pass that information later, in x_wm_set_size_hints. */
2546 int left
= f
->output_data
.x
->left_pos
;
2547 int xneg
= window_prompting
& XNegative
;
2548 int top
= f
->output_data
.x
->top_pos
;
2549 int yneg
= window_prompting
& YNegative
;
2555 if (window_prompting
& USPosition
)
2556 sprintf (shell_position
, "=%dx%d%c%d%c%d",
2557 PIXEL_WIDTH (f
) + extra_borders
,
2558 PIXEL_HEIGHT (f
) + menubar_size
+ extra_borders
,
2559 (xneg
? '-' : '+'), left
,
2560 (yneg
? '-' : '+'), top
);
2562 sprintf (shell_position
, "=%dx%d",
2563 PIXEL_WIDTH (f
) + extra_borders
,
2564 PIXEL_HEIGHT (f
) + menubar_size
+ extra_borders
);
2567 len
= strlen (shell_position
) + 1;
2568 tem
= (char *) xmalloc (len
);
2569 strncpy (tem
, shell_position
, len
);
2570 XtSetArg (al
[ac
], XtNgeometry
, tem
); ac
++;
2571 XtSetValues (shell_widget
, al
, ac
);
2574 XtManageChild (pane_widget
);
2575 XtRealizeWidget (shell_widget
);
2577 FRAME_X_WINDOW (f
) = XtWindow (frame_widget
);
2579 validate_x_resource_name ();
2581 class_hints
.res_name
= (char *) XSTRING (Vx_resource_name
)->data
;
2582 class_hints
.res_class
= EMACS_CLASS
;
2583 XSetClassHint (FRAME_X_DISPLAY (f
), XtWindow (shell_widget
), &class_hints
);
2590 xim
= XOpenIM (FRAME_X_DISPLAY (f
), NULL
, NULL
, NULL
);
2594 xic
= XCreateIC (xim
,
2595 XNInputStyle
, XIMPreeditNothing
| XIMStatusNothing
,
2596 XNClientWindow
, FRAME_X_WINDOW(f
),
2597 XNFocusWindow
, FRAME_X_WINDOW(f
),
2603 FRAME_XIC (f
) = xic
;
2607 f
->output_data
.x
->wm_hints
.input
= True
;
2608 f
->output_data
.x
->wm_hints
.flags
|= InputHint
;
2609 XSetWMHints (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
2610 &f
->output_data
.x
->wm_hints
);
2612 hack_wm_protocols (f
, shell_widget
);
2615 XtAddEventHandler (shell_widget
, 0, True
, _XEditResCheckMessages
, 0);
2618 /* Do a stupid property change to force the server to generate a
2619 propertyNotify event so that the event_stream server timestamp will
2620 be initialized to something relevant to the time we created the window.
2622 XChangeProperty (XtDisplay (frame_widget
), XtWindow (frame_widget
),
2623 FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_protocols
,
2624 XA_ATOM
, 32, PropModeAppend
,
2625 (unsigned char*) NULL
, 0);
2627 /* Make all the standard events reach the Emacs frame. */
2628 attributes
.event_mask
= STANDARD_EVENT_SET
;
2629 attribute_mask
= CWEventMask
;
2630 XChangeWindowAttributes (XtDisplay (shell_widget
), XtWindow (shell_widget
),
2631 attribute_mask
, &attributes
);
2633 XtMapWidget (frame_widget
);
2635 /* x_set_name normally ignores requests to set the name if the
2636 requested name is the same as the current name. This is the one
2637 place where that assumption isn't correct; f->name is set, but
2638 the X server hasn't been told. */
2641 int explicit = f
->explicit_name
;
2643 f
->explicit_name
= 0;
2646 x_set_name (f
, name
, explicit);
2649 XDefineCursor (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
2650 f
->output_data
.x
->text_cursor
);
2654 if (!minibuffer_only
&& FRAME_EXTERNAL_MENU_BAR (f
))
2655 initialize_frame_menubar (f
);
2656 lw_set_main_areas (pane_widget
, f
->output_data
.x
->menubar_widget
, frame_widget
);
2658 if (FRAME_X_WINDOW (f
) == 0)
2659 error ("Unable to create window");
2662 #else /* not USE_X_TOOLKIT */
2664 /* Create and set up the X window for frame F. */
2670 XClassHint class_hints
;
2671 XSetWindowAttributes attributes
;
2672 unsigned long attribute_mask
;
2674 attributes
.background_pixel
= f
->output_data
.x
->background_pixel
;
2675 attributes
.border_pixel
= f
->output_data
.x
->border_pixel
;
2676 attributes
.bit_gravity
= StaticGravity
;
2677 attributes
.backing_store
= NotUseful
;
2678 attributes
.save_under
= True
;
2679 attributes
.event_mask
= STANDARD_EVENT_SET
;
2680 attribute_mask
= (CWBackPixel
| CWBorderPixel
| CWBitGravity
2682 | CWBackingStore
| CWSaveUnder
2688 = XCreateWindow (FRAME_X_DISPLAY (f
),
2689 f
->output_data
.x
->parent_desc
,
2690 f
->output_data
.x
->left_pos
,
2691 f
->output_data
.x
->top_pos
,
2692 PIXEL_WIDTH (f
), PIXEL_HEIGHT (f
),
2693 f
->output_data
.x
->border_width
,
2694 CopyFromParent
, /* depth */
2695 InputOutput
, /* class */
2696 FRAME_X_DISPLAY_INFO (f
)->visual
,
2697 attribute_mask
, &attributes
);
2703 xim
= XOpenIM (FRAME_X_DISPLAY(f
), NULL
, NULL
, NULL
);
2707 xic
= XCreateIC (xim
,
2708 XNInputStyle
, XIMPreeditNothing
| XIMStatusNothing
,
2709 XNClientWindow
, FRAME_X_WINDOW(f
),
2710 XNFocusWindow
, FRAME_X_WINDOW(f
),
2717 FRAME_XIC (f
) = xic
;
2721 validate_x_resource_name ();
2723 class_hints
.res_name
= (char *) XSTRING (Vx_resource_name
)->data
;
2724 class_hints
.res_class
= EMACS_CLASS
;
2725 XSetClassHint (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
), &class_hints
);
2727 /* The menubar is part of the ordinary display;
2728 it does not count in addition to the height of the window. */
2729 f
->output_data
.x
->menubar_height
= 0;
2731 /* This indicates that we use the "Passive Input" input model.
2732 Unless we do this, we don't get the Focus{In,Out} events that we
2733 need to draw the cursor correctly. Accursed bureaucrats.
2734 XWhipsAndChains (FRAME_X_DISPLAY (f), IronMaiden, &TheRack); */
2736 f
->output_data
.x
->wm_hints
.input
= True
;
2737 f
->output_data
.x
->wm_hints
.flags
|= InputHint
;
2738 XSetWMHints (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
2739 &f
->output_data
.x
->wm_hints
);
2741 /* Request "save yourself" and "delete window" commands from wm. */
2744 protocols
[0] = FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_delete_window
;
2745 protocols
[1] = FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_save_yourself
;
2746 XSetWMProtocols (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
), protocols
, 2);
2749 /* x_set_name normally ignores requests to set the name if the
2750 requested name is the same as the current name. This is the one
2751 place where that assumption isn't correct; f->name is set, but
2752 the X server hasn't been told. */
2755 int explicit = f
->explicit_name
;
2757 f
->explicit_name
= 0;
2760 x_set_name (f
, name
, explicit);
2763 XDefineCursor (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
2764 f
->output_data
.x
->text_cursor
);
2768 if (FRAME_X_WINDOW (f
) == 0)
2769 error ("Unable to create window");
2772 #endif /* not USE_X_TOOLKIT */
2774 /* Handle the icon stuff for this window. Perhaps later we might
2775 want an x_set_icon_position which can be called interactively as
2783 Lisp_Object icon_x
, icon_y
;
2785 /* Set the position of the icon. Note that twm groups all
2786 icons in an icon window. */
2787 icon_x
= x_get_arg (parms
, Qicon_left
, 0, 0, number
);
2788 icon_y
= x_get_arg (parms
, Qicon_top
, 0, 0, number
);
2789 if (!EQ (icon_x
, Qunbound
) && !EQ (icon_y
, Qunbound
))
2791 CHECK_NUMBER (icon_x
, 0);
2792 CHECK_NUMBER (icon_y
, 0);
2794 else if (!EQ (icon_x
, Qunbound
) || !EQ (icon_y
, Qunbound
))
2795 error ("Both left and top icon corners of icon must be specified");
2799 if (! EQ (icon_x
, Qunbound
))
2800 x_wm_set_icon_position (f
, XINT (icon_x
), XINT (icon_y
));
2802 /* Start up iconic or window? */
2803 x_wm_set_window_state
2804 (f
, (EQ (x_get_arg (parms
, Qvisibility
, 0, 0, symbol
), Qicon
)
2808 x_text_icon (f
, (char *) XSTRING ((!NILP (f
->icon_name
)
2815 /* Make the GC's needed for this window, setting the
2816 background, border and mouse colors; also create the
2817 mouse cursor and the gray border tile. */
2819 static char cursor_bits
[] =
2821 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
2822 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
2823 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
2824 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00
2831 XGCValues gc_values
;
2837 /* Create the GC's of this frame.
2838 Note that many default values are used. */
2841 gc_values
.font
= f
->output_data
.x
->font
->fid
;
2842 gc_values
.foreground
= f
->output_data
.x
->foreground_pixel
;
2843 gc_values
.background
= f
->output_data
.x
->background_pixel
;
2844 gc_values
.line_width
= 0; /* Means 1 using fast algorithm. */
2845 f
->output_data
.x
->normal_gc
= XCreateGC (FRAME_X_DISPLAY (f
),
2847 GCLineWidth
| GCFont
2848 | GCForeground
| GCBackground
,
2851 /* Reverse video style. */
2852 gc_values
.foreground
= f
->output_data
.x
->background_pixel
;
2853 gc_values
.background
= f
->output_data
.x
->foreground_pixel
;
2854 f
->output_data
.x
->reverse_gc
= XCreateGC (FRAME_X_DISPLAY (f
),
2856 GCFont
| GCForeground
| GCBackground
2860 /* Cursor has cursor-color background, background-color foreground. */
2861 gc_values
.foreground
= f
->output_data
.x
->background_pixel
;
2862 gc_values
.background
= f
->output_data
.x
->cursor_pixel
;
2863 gc_values
.fill_style
= FillOpaqueStippled
;
2865 = XCreateBitmapFromData (FRAME_X_DISPLAY (f
),
2866 FRAME_X_DISPLAY_INFO (f
)->root_window
,
2867 cursor_bits
, 16, 16);
2868 f
->output_data
.x
->cursor_gc
2869 = XCreateGC (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
2870 (GCFont
| GCForeground
| GCBackground
2871 | GCFillStyle
| GCStipple
| GCLineWidth
),
2874 /* Create the gray border tile used when the pointer is not in
2875 the frame. Since this depends on the frame's pixel values,
2876 this must be done on a per-frame basis. */
2877 f
->output_data
.x
->border_tile
2878 = (XCreatePixmapFromBitmapData
2879 (FRAME_X_DISPLAY (f
), FRAME_X_DISPLAY_INFO (f
)->root_window
,
2880 gray_bits
, gray_width
, gray_height
,
2881 f
->output_data
.x
->foreground_pixel
,
2882 f
->output_data
.x
->background_pixel
,
2883 DefaultDepth (FRAME_X_DISPLAY (f
),
2884 XScreenNumberOfScreen (FRAME_X_SCREEN (f
)))));
2889 DEFUN ("x-create-frame", Fx_create_frame
, Sx_create_frame
,
2891 "Make a new X window, which is called a \"frame\" in Emacs terms.\n\
2892 Returns an Emacs frame object.\n\
2893 ALIST is an alist of frame parameters.\n\
2894 If the parameters specify that the frame should not have a minibuffer,\n\
2895 and do not specify a specific minibuffer window to use,\n\
2896 then `default-minibuffer-frame' must be a frame whose minibuffer can\n\
2897 be shared by the new frame.\n\
2899 This function is an internal primitive--use `make-frame' instead.")
2904 Lisp_Object frame
, tem
;
2906 int minibuffer_only
= 0;
2907 long window_prompting
= 0;
2909 int count
= specpdl_ptr
- specpdl
;
2910 struct gcpro gcpro1
;
2911 Lisp_Object display
;
2912 struct x_display_info
*dpyinfo
;
2918 /* Use this general default value to start with
2919 until we know if this frame has a specified name. */
2920 Vx_resource_name
= Vinvocation_name
;
2922 display
= x_get_arg (parms
, Qdisplay
, 0, 0, string
);
2923 if (EQ (display
, Qunbound
))
2925 dpyinfo
= check_x_display_info (display
);
2927 kb
= dpyinfo
->kboard
;
2929 kb
= &the_only_kboard
;
2932 name
= x_get_arg (parms
, Qname
, "title", "Title", string
);
2934 && ! EQ (name
, Qunbound
)
2936 error ("Invalid frame name--not a string or nil");
2939 Vx_resource_name
= name
;
2941 /* See if parent window is specified. */
2942 parent
= x_get_arg (parms
, Qparent_id
, NULL
, NULL
, number
);
2943 if (EQ (parent
, Qunbound
))
2945 if (! NILP (parent
))
2946 CHECK_NUMBER (parent
, 0);
2948 tem
= x_get_arg (parms
, Qminibuffer
, 0, 0, symbol
);
2949 if (EQ (tem
, Qnone
) || NILP (tem
))
2950 f
= make_frame_without_minibuffer (Qnil
, kb
, display
);
2951 else if (EQ (tem
, Qonly
))
2953 f
= make_minibuffer_frame ();
2954 minibuffer_only
= 1;
2956 else if (WINDOWP (tem
))
2957 f
= make_frame_without_minibuffer (tem
, kb
, display
);
2961 /* Note that X Windows does support scroll bars. */
2962 FRAME_CAN_HAVE_SCROLL_BARS (f
) = 1;
2964 XSETFRAME (frame
, f
);
2967 f
->output_method
= output_x_window
;
2968 f
->output_data
.x
= (struct x_output
*) xmalloc (sizeof (struct x_output
));
2969 bzero (f
->output_data
.x
, sizeof (struct x_output
));
2970 f
->output_data
.x
->icon_bitmap
= -1;
2973 = x_get_arg (parms
, Qicon_name
, "iconName", "Title", string
);
2974 if (! STRINGP (f
->icon_name
))
2975 f
->icon_name
= Qnil
;
2977 FRAME_X_DISPLAY_INFO (f
) = dpyinfo
;
2979 FRAME_KBOARD (f
) = kb
;
2982 /* Specify the parent under which to make this X window. */
2986 f
->output_data
.x
->parent_desc
= parent
;
2987 f
->output_data
.x
->explicit_parent
= 1;
2991 f
->output_data
.x
->parent_desc
= FRAME_X_DISPLAY_INFO (f
)->root_window
;
2992 f
->output_data
.x
->explicit_parent
= 0;
2995 /* Note that the frame has no physical cursor right now. */
2996 f
->phys_cursor_x
= -1;
2998 /* Set the name; the functions to which we pass f expect the name to
3000 if (EQ (name
, Qunbound
) || NILP (name
))
3002 f
->name
= build_string (dpyinfo
->x_id_name
);
3003 f
->explicit_name
= 0;
3008 f
->explicit_name
= 1;
3009 /* use the frame's title when getting resources for this frame. */
3010 specbind (Qx_resource_name
, name
);
3013 /* Extract the window parameters from the supplied values
3014 that are needed to determine window geometry. */
3018 font
= x_get_arg (parms
, Qfont
, "font", "Font", string
);
3020 /* First, try whatever font the caller has specified. */
3022 font
= x_new_font (f
, XSTRING (font
)->data
);
3023 /* Try out a font which we hope has bold and italic variations. */
3024 if (!STRINGP (font
))
3025 font
= x_new_font (f
, "-misc-fixed-medium-r-normal-*-*-140-*-*-c-*-iso8859-1");
3026 if (! STRINGP (font
))
3027 font
= x_new_font (f
, "-*-*-medium-r-normal-*-*-140-*-*-c-*-iso8859-1");
3028 if (! STRINGP (font
))
3029 /* This was formerly the first thing tried, but it finds too many fonts
3030 and takes too long. */
3031 font
= x_new_font (f
, "-*-*-medium-r-*-*-*-*-*-*-c-*-iso8859-1");
3032 /* If those didn't work, look for something which will at least work. */
3033 if (! STRINGP (font
))
3034 font
= x_new_font (f
, "-*-fixed-*-*-*-*-*-140-*-*-c-*-iso8859-1");
3036 if (! STRINGP (font
))
3037 font
= build_string ("fixed");
3039 x_default_parameter (f
, parms
, Qfont
, font
,
3040 "font", "Font", string
);
3043 #ifdef USE_X_TOOLKIT
3044 /* Prevent lwlib/xlwmenu.c from crashing because of a bug
3045 whereby it fails to get any font. */
3046 xlwmenu_default_font
= f
->output_data
.x
->font
;
3049 x_default_parameter (f
, parms
, Qborder_width
, make_number (2),
3050 "borderwidth", "BorderWidth", number
);
3051 /* This defaults to 2 in order to match xterm. We recognize either
3052 internalBorderWidth or internalBorder (which is what xterm calls
3054 if (NILP (Fassq (Qinternal_border_width
, parms
)))
3058 value
= x_get_arg (parms
, Qinternal_border_width
,
3059 "internalBorder", "BorderWidth", number
);
3060 if (! EQ (value
, Qunbound
))
3061 parms
= Fcons (Fcons (Qinternal_border_width
, value
),
3064 x_default_parameter (f
, parms
, Qinternal_border_width
, make_number (2),
3065 "internalBorderWidth", "BorderWidth", number
);
3066 x_default_parameter (f
, parms
, Qvertical_scroll_bars
, Qt
,
3067 "verticalScrollBars", "ScrollBars", boolean
);
3069 /* Also do the stuff which must be set before the window exists. */
3070 x_default_parameter (f
, parms
, Qforeground_color
, build_string ("black"),
3071 "foreground", "Foreground", string
);
3072 x_default_parameter (f
, parms
, Qbackground_color
, build_string ("white"),
3073 "background", "Background", string
);
3074 x_default_parameter (f
, parms
, Qmouse_color
, build_string ("black"),
3075 "pointerColor", "Foreground", string
);
3076 x_default_parameter (f
, parms
, Qcursor_color
, build_string ("black"),
3077 "cursorColor", "Foreground", string
);
3078 x_default_parameter (f
, parms
, Qborder_color
, build_string ("black"),
3079 "borderColor", "BorderColor", string
);
3081 x_default_parameter (f
, parms
, Qmenu_bar_lines
, make_number (1),
3082 "menuBar", "MenuBar", number
);
3083 x_default_parameter (f
, parms
, Qscroll_bar_width
, Qnil
,
3084 "scrollBarWidth", "ScrollBarWidth", number
);
3085 x_default_parameter (f
, parms
, Qbuffer_predicate
, Qnil
,
3086 "bufferPredicate", "BufferPredicate", symbol
);
3088 f
->output_data
.x
->parent_desc
= FRAME_X_DISPLAY_INFO (f
)->root_window
;
3089 window_prompting
= x_figure_window_size (f
, parms
);
3091 if (window_prompting
& XNegative
)
3093 if (window_prompting
& YNegative
)
3094 f
->output_data
.x
->win_gravity
= SouthEastGravity
;
3096 f
->output_data
.x
->win_gravity
= NorthEastGravity
;
3100 if (window_prompting
& YNegative
)
3101 f
->output_data
.x
->win_gravity
= SouthWestGravity
;
3103 f
->output_data
.x
->win_gravity
= NorthWestGravity
;
3106 f
->output_data
.x
->size_hint_flags
= window_prompting
;
3108 #ifdef USE_X_TOOLKIT
3109 x_window (f
, window_prompting
, minibuffer_only
);
3115 init_frame_faces (f
);
3117 /* We need to do this after creating the X window, so that the
3118 icon-creation functions can say whose icon they're describing. */
3119 x_default_parameter (f
, parms
, Qicon_type
, Qnil
,
3120 "bitmapIcon", "BitmapIcon", symbol
);
3122 x_default_parameter (f
, parms
, Qauto_raise
, Qnil
,
3123 "autoRaise", "AutoRaiseLower", boolean
);
3124 x_default_parameter (f
, parms
, Qauto_lower
, Qnil
,
3125 "autoLower", "AutoRaiseLower", boolean
);
3126 x_default_parameter (f
, parms
, Qcursor_type
, Qbox
,
3127 "cursorType", "CursorType", symbol
);
3129 /* Dimensions, especially f->height, must be done via change_frame_size.
3130 Change will not be effected unless different from the current
3134 f
->height
= f
->width
= 0;
3135 change_frame_size (f
, height
, width
, 1, 0);
3137 /* Tell the server what size and position, etc, we want,
3138 and how badly we want them. */
3140 x_wm_set_size_hint (f
, window_prompting
, 0);
3143 tem
= x_get_arg (parms
, Qunsplittable
, 0, 0, boolean
);
3144 f
->no_split
= minibuffer_only
|| EQ (tem
, Qt
);
3148 /* It is now ok to make the frame official
3149 even if we get an error below.
3150 And the frame needs to be on Vframe_list
3151 or making it visible won't work. */
3152 Vframe_list
= Fcons (frame
, Vframe_list
);
3154 /* Now that the frame is official, it counts as a reference to
3156 FRAME_X_DISPLAY_INFO (f
)->reference_count
++;
3158 /* Make the window appear on the frame and enable display,
3159 unless the caller says not to. However, with explicit parent,
3160 Emacs cannot control visibility, so don't try. */
3161 if (! f
->output_data
.x
->explicit_parent
)
3163 Lisp_Object visibility
;
3165 visibility
= x_get_arg (parms
, Qvisibility
, 0, 0, symbol
);
3166 if (EQ (visibility
, Qunbound
))
3169 if (EQ (visibility
, Qicon
))
3170 x_iconify_frame (f
);
3171 else if (! NILP (visibility
))
3172 x_make_frame_visible (f
);
3174 /* Must have been Qnil. */
3178 return unbind_to (count
, frame
);
3181 /* FRAME is used only to get a handle on the X display. We don't pass the
3182 display info directly because we're called from frame.c, which doesn't
3183 know about that structure. */
3185 x_get_focus_frame (frame
)
3186 struct frame
*frame
;
3188 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (frame
);
3190 if (! dpyinfo
->x_focus_frame
)
3193 XSETFRAME (xfocus
, dpyinfo
->x_focus_frame
);
3197 DEFUN ("focus-frame", Ffocus_frame
, Sfocus_frame
, 1, 1, 0,
3198 "This function is obsolete, and does nothing.")
3205 DEFUN ("unfocus-frame", Funfocus_frame
, Sunfocus_frame
, 0, 0, 0,
3206 "This function is obsolete, and does nothing.")
3212 DEFUN ("x-list-fonts", Fx_list_fonts
, Sx_list_fonts
, 1, 3, 0,
3213 "Return a list of the names of available fonts matching PATTERN.\n\
3214 If optional arguments FACE and FRAME are specified, return only fonts\n\
3215 the same size as FACE on FRAME.\n\
3217 PATTERN is a string, perhaps with wildcard characters;\n\
3218 the * character matches any substring, and\n\
3219 the ? character matches any single character.\n\
3220 PATTERN is case-insensitive.\n\
3221 FACE is a face name--a symbol.\n\
3223 The return value is a list of strings, suitable as arguments to\n\
3226 Fonts Emacs can't use (i.e. proportional fonts) may or may not be excluded\n\
3227 even if they match PATTERN and FACE.")
3228 (pattern
, face
, frame
)
3229 Lisp_Object pattern
, face
, frame
;
3233 #ifndef BROKEN_XLISTFONTSWITHINFO
3236 XFontStruct
*size_ref
;
3241 CHECK_STRING (pattern
, 0);
3243 CHECK_SYMBOL (face
, 1);
3245 f
= check_x_frame (frame
);
3247 /* Determine the width standard for comparison with the fonts we find. */
3255 /* Don't die if we get called with a terminal frame. */
3256 if (! FRAME_X_P (f
))
3257 error ("non-X frame used in `x-list-fonts'");
3259 face_id
= face_name_id_number (f
, face
);
3261 if (face_id
< 0 || face_id
>= FRAME_N_PARAM_FACES (f
)
3262 || FRAME_PARAM_FACES (f
) [face_id
] == 0)
3263 size_ref
= f
->output_data
.x
->font
;
3266 size_ref
= FRAME_PARAM_FACES (f
) [face_id
]->font
;
3267 if (size_ref
== (XFontStruct
*) (~0))
3268 size_ref
= f
->output_data
.x
->font
;
3272 /* See if we cached the result for this particular query. */
3273 list
= Fassoc (pattern
,
3274 XCONS (FRAME_X_DISPLAY_INFO (f
)->name_list_element
)->cdr
);
3276 /* We have info in the cache for this PATTERN. */
3279 Lisp_Object tem
, newlist
;
3281 /* We have info about this pattern. */
3282 list
= XCONS (list
)->cdr
;
3289 /* Filter the cached info and return just the fonts that match FACE. */
3291 for (tem
= list
; CONSP (tem
); tem
= XCONS (tem
)->cdr
)
3293 XFontStruct
*thisinfo
;
3295 thisinfo
= XLoadQueryFont (FRAME_X_DISPLAY (f
),
3296 XSTRING (XCONS (tem
)->car
)->data
);
3298 if (thisinfo
&& same_size_fonts (thisinfo
, size_ref
))
3299 newlist
= Fcons (XCONS (tem
)->car
, newlist
);
3302 XFreeFont (FRAME_X_DISPLAY (f
), thisinfo
);
3312 /* Solaris 2.3 has a bug in XListFontsWithInfo. */
3313 #ifndef BROKEN_XLISTFONTSWITHINFO
3315 names
= XListFontsWithInfo (FRAME_X_DISPLAY (f
),
3316 XSTRING (pattern
)->data
,
3317 2000, /* maxnames */
3318 &num_fonts
, /* count_return */
3319 &info
); /* info_return */
3322 names
= XListFonts (FRAME_X_DISPLAY (f
),
3323 XSTRING (pattern
)->data
,
3324 2000, /* maxnames */
3325 &num_fonts
); /* count_return */
3334 Lisp_Object full_list
;
3336 /* Make a list of all the fonts we got back.
3337 Store that in the font cache for the display. */
3339 for (i
= 0; i
< num_fonts
; i
++)
3340 full_list
= Fcons (build_string (names
[i
]), full_list
);
3341 XCONS (FRAME_X_DISPLAY_INFO (f
)->name_list_element
)->cdr
3342 = Fcons (Fcons (pattern
, full_list
),
3343 XCONS (FRAME_X_DISPLAY_INFO (f
)->name_list_element
)->cdr
);
3345 /* Make a list of the fonts that have the right width. */
3347 for (i
= 0; i
< num_fonts
; i
++)
3355 #ifdef BROKEN_XLISTFONTSWITHINFO
3356 XFontStruct
*thisinfo
;
3359 thisinfo
= XLoadQueryFont (FRAME_X_DISPLAY (f
), names
[i
]);
3362 keeper
= thisinfo
&& same_size_fonts (thisinfo
, size_ref
);
3364 keeper
= same_size_fonts (&info
[i
], size_ref
);
3368 list
= Fcons (build_string (names
[i
]), list
);
3370 list
= Fnreverse (list
);
3373 #ifndef BROKEN_XLISTFONTSWITHINFO
3375 XFreeFontInfo (names
, info
, num_fonts
);
3378 XFreeFontNames (names
);
3386 DEFUN ("x-color-defined-p", Fx_color_defined_p
, Sx_color_defined_p
, 1, 2, 0,
3387 "Return non-nil if color COLOR is supported on frame FRAME.\n\
3388 If FRAME is omitted or nil, use the selected frame.")
3390 Lisp_Object color
, frame
;
3393 FRAME_PTR f
= check_x_frame (frame
);
3395 CHECK_STRING (color
, 1);
3397 if (defined_color (f
, XSTRING (color
)->data
, &foo
, 0))
3403 DEFUN ("x-color-values", Fx_color_values
, Sx_color_values
, 1, 2, 0,
3404 "Return a description of the color named COLOR on frame FRAME.\n\
3405 The value is a list of integer RGB values--(RED GREEN BLUE).\n\
3406 These values appear to range from 0 to 65280 or 65535, depending\n\
3407 on the system; white is (65280 65280 65280) or (65535 65535 65535).\n\
3408 If FRAME is omitted or nil, use the selected frame.")
3410 Lisp_Object color
, frame
;
3413 FRAME_PTR f
= check_x_frame (frame
);
3415 CHECK_STRING (color
, 1);
3417 if (defined_color (f
, XSTRING (color
)->data
, &foo
, 0))
3421 rgb
[0] = make_number (foo
.red
);
3422 rgb
[1] = make_number (foo
.green
);
3423 rgb
[2] = make_number (foo
.blue
);
3424 return Flist (3, rgb
);
3430 DEFUN ("x-display-color-p", Fx_display_color_p
, Sx_display_color_p
, 0, 1, 0,
3431 "Return t if the X display supports color.\n\
3432 The optional argument DISPLAY specifies which display to ask about.\n\
3433 DISPLAY should be either a frame or a display name (a string).\n\
3434 If omitted or nil, that stands for the selected frame's display.")
3436 Lisp_Object display
;
3438 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
3440 if (dpyinfo
->n_planes
<= 2)
3443 switch (dpyinfo
->visual
->class)
3456 DEFUN ("x-display-grayscale-p", Fx_display_grayscale_p
, Sx_display_grayscale_p
,
3458 "Return t if the X display supports shades of gray.\n\
3459 Note that color displays do support shades of gray.\n\
3460 The optional argument DISPLAY specifies which display to ask about.\n\
3461 DISPLAY should be either a frame or a display name (a string).\n\
3462 If omitted or nil, that stands for the selected frame's display.")
3464 Lisp_Object display
;
3466 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
3468 if (dpyinfo
->n_planes
<= 1)
3471 switch (dpyinfo
->visual
->class)
3486 DEFUN ("x-display-pixel-width", Fx_display_pixel_width
, Sx_display_pixel_width
,
3488 "Returns the width in pixels of the X display DISPLAY.\n\
3489 The optional argument DISPLAY specifies which display to ask about.\n\
3490 DISPLAY should be either a frame or a display name (a string).\n\
3491 If omitted or nil, that stands for the selected frame's display.")
3493 Lisp_Object display
;
3495 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
3497 return make_number (dpyinfo
->width
);
3500 DEFUN ("x-display-pixel-height", Fx_display_pixel_height
,
3501 Sx_display_pixel_height
, 0, 1, 0,
3502 "Returns the height in pixels of the X display DISPLAY.\n\
3503 The optional argument DISPLAY specifies which display to ask about.\n\
3504 DISPLAY should be either a frame or a display name (a string).\n\
3505 If omitted or nil, that stands for the selected frame's display.")
3507 Lisp_Object display
;
3509 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
3511 return make_number (dpyinfo
->height
);
3514 DEFUN ("x-display-planes", Fx_display_planes
, Sx_display_planes
,
3516 "Returns the number of bitplanes of the X display DISPLAY.\n\
3517 The optional argument DISPLAY specifies which display to ask about.\n\
3518 DISPLAY should be either a frame or a display name (a string).\n\
3519 If omitted or nil, that stands for the selected frame's display.")
3521 Lisp_Object display
;
3523 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
3525 return make_number (dpyinfo
->n_planes
);
3528 DEFUN ("x-display-color-cells", Fx_display_color_cells
, Sx_display_color_cells
,
3530 "Returns the number of color cells of the X display DISPLAY.\n\
3531 The optional argument DISPLAY specifies which display to ask about.\n\
3532 DISPLAY should be either a frame or a display name (a string).\n\
3533 If omitted or nil, that stands for the selected frame's display.")
3535 Lisp_Object display
;
3537 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
3539 return make_number (DisplayCells (dpyinfo
->display
,
3540 XScreenNumberOfScreen (dpyinfo
->screen
)));
3543 DEFUN ("x-server-max-request-size", Fx_server_max_request_size
,
3544 Sx_server_max_request_size
,
3546 "Returns the maximum request size of the X server of display DISPLAY.\n\
3547 The optional argument DISPLAY specifies which display to ask about.\n\
3548 DISPLAY should be either a frame or a display name (a string).\n\
3549 If omitted or nil, that stands for the selected frame's display.")
3551 Lisp_Object display
;
3553 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
3555 return make_number (MAXREQUEST (dpyinfo
->display
));
3558 DEFUN ("x-server-vendor", Fx_server_vendor
, Sx_server_vendor
, 0, 1, 0,
3559 "Returns the vendor ID string of the X server of display DISPLAY.\n\
3560 The optional argument DISPLAY specifies which display to ask about.\n\
3561 DISPLAY should be either a frame or a display name (a string).\n\
3562 If omitted or nil, that stands for the selected frame's display.")
3564 Lisp_Object display
;
3566 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
3567 char *vendor
= ServerVendor (dpyinfo
->display
);
3569 if (! vendor
) vendor
= "";
3570 return build_string (vendor
);
3573 DEFUN ("x-server-version", Fx_server_version
, Sx_server_version
, 0, 1, 0,
3574 "Returns the version numbers of the X server of display DISPLAY.\n\
3575 The value is a list of three integers: the major and minor\n\
3576 version numbers of the X Protocol in use, and the vendor-specific release\n\
3577 number. See also the function `x-server-vendor'.\n\n\
3578 The optional argument DISPLAY specifies which display to ask about.\n\
3579 DISPLAY should be either a frame or a display name (a string).\n\
3580 If omitted or nil, that stands for the selected frame's display.")
3582 Lisp_Object display
;
3584 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
3585 Display
*dpy
= dpyinfo
->display
;
3587 return Fcons (make_number (ProtocolVersion (dpy
)),
3588 Fcons (make_number (ProtocolRevision (dpy
)),
3589 Fcons (make_number (VendorRelease (dpy
)), Qnil
)));
3592 DEFUN ("x-display-screens", Fx_display_screens
, Sx_display_screens
, 0, 1, 0,
3593 "Returns the number of screens on the X server of display DISPLAY.\n\
3594 The optional argument DISPLAY specifies which display to ask about.\n\
3595 DISPLAY should be either a frame or a display name (a string).\n\
3596 If omitted or nil, that stands for the selected frame's display.")
3598 Lisp_Object display
;
3600 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
3602 return make_number (ScreenCount (dpyinfo
->display
));
3605 DEFUN ("x-display-mm-height", Fx_display_mm_height
, Sx_display_mm_height
, 0, 1, 0,
3606 "Returns the height in millimeters of the X display DISPLAY.\n\
3607 The optional argument DISPLAY specifies which display to ask about.\n\
3608 DISPLAY should be either a frame or a display name (a string).\n\
3609 If omitted or nil, that stands for the selected frame's display.")
3611 Lisp_Object display
;
3613 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
3615 return make_number (HeightMMOfScreen (dpyinfo
->screen
));
3618 DEFUN ("x-display-mm-width", Fx_display_mm_width
, Sx_display_mm_width
, 0, 1, 0,
3619 "Returns the width in millimeters 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 (WidthMMOfScreen (dpyinfo
->screen
));
3631 DEFUN ("x-display-backing-store", Fx_display_backing_store
,
3632 Sx_display_backing_store
, 0, 1, 0,
3633 "Returns an indication of whether X display DISPLAY does backing store.\n\
3634 The value may be `always', `when-mapped', or `not-useful'.\n\
3635 The optional argument DISPLAY specifies which display to ask about.\n\
3636 DISPLAY should be either a frame or a display name (a string).\n\
3637 If omitted or nil, that stands for the selected frame's display.")
3639 Lisp_Object display
;
3641 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
3643 switch (DoesBackingStore (dpyinfo
->screen
))
3646 return intern ("always");
3649 return intern ("when-mapped");
3652 return intern ("not-useful");
3655 error ("Strange value for BackingStore parameter of screen");
3659 DEFUN ("x-display-visual-class", Fx_display_visual_class
,
3660 Sx_display_visual_class
, 0, 1, 0,
3661 "Returns the visual class of the X display DISPLAY.\n\
3662 The value is one of the symbols `static-gray', `gray-scale',\n\
3663 `static-color', `pseudo-color', `true-color', or `direct-color'.\n\n\
3664 The optional argument DISPLAY specifies which display to ask about.\n\
3665 DISPLAY should be either a frame or a display name (a string).\n\
3666 If omitted or nil, that stands for the selected frame's display.")
3668 Lisp_Object display
;
3670 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
3672 switch (dpyinfo
->visual
->class)
3674 case StaticGray
: return (intern ("static-gray"));
3675 case GrayScale
: return (intern ("gray-scale"));
3676 case StaticColor
: return (intern ("static-color"));
3677 case PseudoColor
: return (intern ("pseudo-color"));
3678 case TrueColor
: return (intern ("true-color"));
3679 case DirectColor
: return (intern ("direct-color"));
3681 error ("Display has an unknown visual class");
3685 DEFUN ("x-display-save-under", Fx_display_save_under
,
3686 Sx_display_save_under
, 0, 1, 0,
3687 "Returns t if the X display DISPLAY supports the save-under feature.\n\
3688 The optional argument DISPLAY specifies which display to ask about.\n\
3689 DISPLAY should be either a frame or a display name (a string).\n\
3690 If omitted or nil, that stands for the selected frame's display.")
3692 Lisp_Object display
;
3694 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
3696 if (DoesSaveUnders (dpyinfo
->screen
) == True
)
3704 register struct frame
*f
;
3706 return PIXEL_WIDTH (f
);
3711 register struct frame
*f
;
3713 return PIXEL_HEIGHT (f
);
3718 register struct frame
*f
;
3720 return FONT_WIDTH (f
->output_data
.x
->font
);
3725 register struct frame
*f
;
3727 return f
->output_data
.x
->line_height
;
3731 x_screen_planes (frame
)
3734 return FRAME_X_DISPLAY_INFO (XFRAME (frame
))->n_planes
;
3737 #if 0 /* These no longer seem like the right way to do things. */
3739 /* Draw a rectangle on the frame with left top corner including
3740 the character specified by LEFT_CHAR and TOP_CHAR. The rectangle is
3741 CHARS by LINES wide and long and is the color of the cursor. */
3744 x_rectangle (f
, gc
, left_char
, top_char
, chars
, lines
)
3745 register struct frame
*f
;
3747 register int top_char
, left_char
, chars
, lines
;
3751 int left
= (left_char
* FONT_WIDTH (f
->output_data
.x
->font
)
3752 + f
->output_data
.x
->internal_border_width
);
3753 int top
= (top_char
* f
->output_data
.x
->line_height
3754 + f
->output_data
.x
->internal_border_width
);
3757 width
= FONT_WIDTH (f
->output_data
.x
->font
) / 2;
3759 width
= FONT_WIDTH (f
->output_data
.x
->font
) * chars
;
3761 height
= f
->output_data
.x
->line_height
/ 2;
3763 height
= f
->output_data
.x
->line_height
* lines
;
3765 XDrawRectangle (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
3766 gc
, left
, top
, width
, height
);
3769 DEFUN ("x-draw-rectangle", Fx_draw_rectangle
, Sx_draw_rectangle
, 5, 5, 0,
3770 "Draw a rectangle on FRAME between coordinates specified by\n\
3771 numbers X0, Y0, X1, Y1 in the cursor pixel.")
3772 (frame
, X0
, Y0
, X1
, Y1
)
3773 register Lisp_Object frame
, X0
, X1
, Y0
, Y1
;
3775 register int x0
, y0
, x1
, y1
, top
, left
, n_chars
, n_lines
;
3777 CHECK_LIVE_FRAME (frame
, 0);
3778 CHECK_NUMBER (X0
, 0);
3779 CHECK_NUMBER (Y0
, 1);
3780 CHECK_NUMBER (X1
, 2);
3781 CHECK_NUMBER (Y1
, 3);
3791 n_lines
= y1
- y0
+ 1;
3796 n_lines
= y0
- y1
+ 1;
3802 n_chars
= x1
- x0
+ 1;
3807 n_chars
= x0
- x1
+ 1;
3811 x_rectangle (XFRAME (frame
), XFRAME (frame
)->output_data
.x
->cursor_gc
,
3812 left
, top
, n_chars
, n_lines
);
3818 DEFUN ("x-erase-rectangle", Fx_erase_rectangle
, Sx_erase_rectangle
, 5, 5, 0,
3819 "Draw a rectangle drawn on FRAME between coordinates\n\
3820 X0, Y0, X1, Y1 in the regular background-pixel.")
3821 (frame
, X0
, Y0
, X1
, Y1
)
3822 register Lisp_Object frame
, X0
, Y0
, X1
, Y1
;
3824 register int x0
, y0
, x1
, y1
, top
, left
, n_chars
, n_lines
;
3826 CHECK_LIVE_FRAME (frame
, 0);
3827 CHECK_NUMBER (X0
, 0);
3828 CHECK_NUMBER (Y0
, 1);
3829 CHECK_NUMBER (X1
, 2);
3830 CHECK_NUMBER (Y1
, 3);
3840 n_lines
= y1
- y0
+ 1;
3845 n_lines
= y0
- y1
+ 1;
3851 n_chars
= x1
- x0
+ 1;
3856 n_chars
= x0
- x1
+ 1;
3860 x_rectangle (XFRAME (frame
), XFRAME (frame
)->output_data
.x
->reverse_gc
,
3861 left
, top
, n_chars
, n_lines
);
3867 /* Draw lines around the text region beginning at the character position
3868 TOP_X, TOP_Y and ending at BOTTOM_X and BOTTOM_Y. GC specifies the
3869 pixel and line characteristics. */
3871 #define line_len(line) (FRAME_CURRENT_GLYPHS (f)->used[(line)])
3874 outline_region (f
, gc
, top_x
, top_y
, bottom_x
, bottom_y
)
3875 register struct frame
*f
;
3877 int top_x
, top_y
, bottom_x
, bottom_y
;
3879 register int ibw
= f
->output_data
.x
->internal_border_width
;
3880 register int font_w
= FONT_WIDTH (f
->output_data
.x
->font
);
3881 register int font_h
= f
->output_data
.x
->line_height
;
3883 int x
= line_len (y
);
3884 XPoint
*pixel_points
3885 = (XPoint
*) alloca (((bottom_y
- top_y
+ 2) * 4) * sizeof (XPoint
));
3886 register XPoint
*this_point
= pixel_points
;
3888 /* Do the horizontal top line/lines */
3891 this_point
->x
= ibw
;
3892 this_point
->y
= ibw
+ (font_h
* top_y
);
3895 this_point
->x
= ibw
+ (font_w
/ 2); /* Half-size for newline chars. */
3897 this_point
->x
= ibw
+ (font_w
* x
);
3898 this_point
->y
= (this_point
- 1)->y
;
3902 this_point
->x
= ibw
;
3903 this_point
->y
= ibw
+ (font_h
* (top_y
+ 1));
3905 this_point
->x
= ibw
+ (font_w
* top_x
);
3906 this_point
->y
= (this_point
- 1)->y
;
3908 this_point
->x
= (this_point
- 1)->x
;
3909 this_point
->y
= ibw
+ (font_h
* top_y
);
3911 this_point
->x
= ibw
+ (font_w
* x
);
3912 this_point
->y
= (this_point
- 1)->y
;
3915 /* Now do the right side. */
3916 while (y
< bottom_y
)
3917 { /* Right vertical edge */
3919 this_point
->x
= (this_point
- 1)->x
;
3920 this_point
->y
= ibw
+ (font_h
* (y
+ 1));
3923 y
++; /* Horizontal connection to next line */
3926 this_point
->x
= ibw
+ (font_w
/ 2);
3928 this_point
->x
= ibw
+ (font_w
* x
);
3930 this_point
->y
= (this_point
- 1)->y
;
3933 /* Now do the bottom and connect to the top left point. */
3934 this_point
->x
= ibw
+ (font_w
* (bottom_x
+ 1));
3937 this_point
->x
= (this_point
- 1)->x
;
3938 this_point
->y
= ibw
+ (font_h
* (bottom_y
+ 1));
3940 this_point
->x
= ibw
;
3941 this_point
->y
= (this_point
- 1)->y
;
3943 this_point
->x
= pixel_points
->x
;
3944 this_point
->y
= pixel_points
->y
;
3946 XDrawLines (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
3948 (this_point
- pixel_points
+ 1), CoordModeOrigin
);
3951 DEFUN ("x-contour-region", Fx_contour_region
, Sx_contour_region
, 1, 1, 0,
3952 "Highlight the region between point and the character under the mouse\n\
3955 register Lisp_Object event
;
3957 register int x0
, y0
, x1
, y1
;
3958 register struct frame
*f
= selected_frame
;
3959 register int p1
, p2
;
3961 CHECK_CONS (event
, 0);
3964 x0
= XINT (Fcar (Fcar (event
)));
3965 y0
= XINT (Fcar (Fcdr (Fcar (event
))));
3967 /* If the mouse is past the end of the line, don't that area. */
3968 /* ReWrite this... */
3973 if (y1
> y0
) /* point below mouse */
3974 outline_region (f
, f
->output_data
.x
->cursor_gc
,
3976 else if (y1
< y0
) /* point above mouse */
3977 outline_region (f
, f
->output_data
.x
->cursor_gc
,
3979 else /* same line: draw horizontal rectangle */
3982 x_rectangle (f
, f
->output_data
.x
->cursor_gc
,
3983 x0
, y0
, (x1
- x0
+ 1), 1);
3985 x_rectangle (f
, f
->output_data
.x
->cursor_gc
,
3986 x1
, y1
, (x0
- x1
+ 1), 1);
3989 XFlush (FRAME_X_DISPLAY (f
));
3995 DEFUN ("x-uncontour-region", Fx_uncontour_region
, Sx_uncontour_region
, 1, 1, 0,
3996 "Erase any highlighting of the region between point and the character\n\
3997 at X, Y on the selected frame.")
3999 register Lisp_Object event
;
4001 register int x0
, y0
, x1
, y1
;
4002 register struct frame
*f
= selected_frame
;
4005 x0
= XINT (Fcar (Fcar (event
)));
4006 y0
= XINT (Fcar (Fcdr (Fcar (event
))));
4010 if (y1
> y0
) /* point below mouse */
4011 outline_region (f
, f
->output_data
.x
->reverse_gc
,
4013 else if (y1
< y0
) /* point above mouse */
4014 outline_region (f
, f
->output_data
.x
->reverse_gc
,
4016 else /* same line: draw horizontal rectangle */
4019 x_rectangle (f
, f
->output_data
.x
->reverse_gc
,
4020 x0
, y0
, (x1
- x0
+ 1), 1);
4022 x_rectangle (f
, f
->output_data
.x
->reverse_gc
,
4023 x1
, y1
, (x0
- x1
+ 1), 1);
4031 int contour_begin_x
, contour_begin_y
;
4032 int contour_end_x
, contour_end_y
;
4033 int contour_npoints
;
4035 /* Clip the top part of the contour lines down (and including) line Y_POS.
4036 If X_POS is in the middle (rather than at the end) of the line, drop
4037 down a line at that character. */
4040 clip_contour_top (y_pos
, x_pos
)
4042 register XPoint
*begin
= contour_lines
[y_pos
].top_left
;
4043 register XPoint
*end
;
4044 register int npoints
;
4045 register struct display_line
*line
= selected_frame
->phys_lines
[y_pos
+ 1];
4047 if (x_pos
>= line
->len
- 1) /* Draw one, straight horizontal line. */
4049 end
= contour_lines
[y_pos
].top_right
;
4050 npoints
= (end
- begin
+ 1);
4051 XDrawLines (x_current_display
, contour_window
,
4052 contour_erase_gc
, begin_erase
, npoints
, CoordModeOrigin
);
4054 bcopy (end
, begin
+ 1, contour_last_point
- end
+ 1);
4055 contour_last_point
-= (npoints
- 2);
4056 XDrawLines (x_current_display
, contour_window
,
4057 contour_erase_gc
, begin
, 2, CoordModeOrigin
);
4058 XFlush (x_current_display
);
4060 /* Now, update contour_lines structure. */
4065 register XPoint
*p
= begin
+ 1;
4066 end
= contour_lines
[y_pos
].bottom_right
;
4067 npoints
= (end
- begin
+ 1);
4068 XDrawLines (x_current_display
, contour_window
,
4069 contour_erase_gc
, begin_erase
, npoints
, CoordModeOrigin
);
4072 p
->x
= ibw
+ (font_w
* (x_pos
+ 1));
4074 p
->y
= begin
->y
+ font_h
;
4076 bcopy (end
, begin
+ 3, contour_last_point
- end
+ 1);
4077 contour_last_point
-= (npoints
- 5);
4078 XDrawLines (x_current_display
, contour_window
,
4079 contour_erase_gc
, begin
, 4, CoordModeOrigin
);
4080 XFlush (x_current_display
);
4082 /* Now, update contour_lines structure. */
4086 /* Erase the top horizontal lines of the contour, and then extend
4087 the contour upwards. */
4090 extend_contour_top (line
)
4095 clip_contour_bottom (x_pos
, y_pos
)
4101 extend_contour_bottom (x_pos
, y_pos
)
4105 DEFUN ("x-select-region", Fx_select_region
, Sx_select_region
, 1, 1, "e",
4110 register struct frame
*f
= selected_frame
;
4111 register int point_x
= f
->cursor_x
;
4112 register int point_y
= f
->cursor_y
;
4113 register int mouse_below_point
;
4114 register Lisp_Object obj
;
4115 register int x_contour_x
, x_contour_y
;
4117 x_contour_x
= x_mouse_x
;
4118 x_contour_y
= x_mouse_y
;
4119 if (x_contour_y
> point_y
|| (x_contour_y
== point_y
4120 && x_contour_x
> point_x
))
4122 mouse_below_point
= 1;
4123 outline_region (f
, f
->output_data
.x
->cursor_gc
, point_x
, point_y
,
4124 x_contour_x
, x_contour_y
);
4128 mouse_below_point
= 0;
4129 outline_region (f
, f
->output_data
.x
->cursor_gc
, x_contour_x
, x_contour_y
,
4135 obj
= read_char (-1, 0, 0, Qnil
, 0);
4139 if (mouse_below_point
)
4141 if (x_mouse_y
<= point_y
) /* Flipped. */
4143 mouse_below_point
= 0;
4145 outline_region (f
, f
->output_data
.x
->reverse_gc
, point_x
, point_y
,
4146 x_contour_x
, x_contour_y
);
4147 outline_region (f
, f
->output_data
.x
->cursor_gc
, x_mouse_x
, x_mouse_y
,
4150 else if (x_mouse_y
< x_contour_y
) /* Bottom clipped. */
4152 clip_contour_bottom (x_mouse_y
);
4154 else if (x_mouse_y
> x_contour_y
) /* Bottom extended. */
4156 extend_bottom_contour (x_mouse_y
);
4159 x_contour_x
= x_mouse_x
;
4160 x_contour_y
= x_mouse_y
;
4162 else /* mouse above or same line as point */
4164 if (x_mouse_y
>= point_y
) /* Flipped. */
4166 mouse_below_point
= 1;
4168 outline_region (f
, f
->output_data
.x
->reverse_gc
,
4169 x_contour_x
, x_contour_y
, point_x
, point_y
);
4170 outline_region (f
, f
->output_data
.x
->cursor_gc
, point_x
, point_y
,
4171 x_mouse_x
, x_mouse_y
);
4173 else if (x_mouse_y
> x_contour_y
) /* Top clipped. */
4175 clip_contour_top (x_mouse_y
);
4177 else if (x_mouse_y
< x_contour_y
) /* Top extended. */
4179 extend_contour_top (x_mouse_y
);
4184 unread_command_event
= obj
;
4185 if (mouse_below_point
)
4187 contour_begin_x
= point_x
;
4188 contour_begin_y
= point_y
;
4189 contour_end_x
= x_contour_x
;
4190 contour_end_y
= x_contour_y
;
4194 contour_begin_x
= x_contour_x
;
4195 contour_begin_y
= x_contour_y
;
4196 contour_end_x
= point_x
;
4197 contour_end_y
= point_y
;
4202 DEFUN ("x-horizontal-line", Fx_horizontal_line
, Sx_horizontal_line
, 1, 1, "e",
4207 register Lisp_Object obj
;
4208 struct frame
*f
= selected_frame
;
4209 register struct window
*w
= XWINDOW (selected_window
);
4210 register GC line_gc
= f
->output_data
.x
->cursor_gc
;
4211 register GC erase_gc
= f
->output_data
.x
->reverse_gc
;
4213 char dash_list
[] = {6, 4, 6, 4};
4215 XGCValues gc_values
;
4217 register int previous_y
;
4218 register int line
= (x_mouse_y
+ 1) * f
->output_data
.x
->line_height
4219 + f
->output_data
.x
->internal_border_width
;
4220 register int left
= f
->output_data
.x
->internal_border_width
4222 * FONT_WIDTH (f
->output_data
.x
->font
));
4223 register int right
= left
+ (w
->width
4224 * FONT_WIDTH (f
->output_data
.x
->font
))
4225 - f
->output_data
.x
->internal_border_width
;
4229 gc_values
.foreground
= f
->output_data
.x
->cursor_pixel
;
4230 gc_values
.background
= f
->output_data
.x
->background_pixel
;
4231 gc_values
.line_width
= 1;
4232 gc_values
.line_style
= LineOnOffDash
;
4233 gc_values
.cap_style
= CapRound
;
4234 gc_values
.join_style
= JoinRound
;
4236 line_gc
= XCreateGC (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
4237 GCLineStyle
| GCJoinStyle
| GCCapStyle
4238 | GCLineWidth
| GCForeground
| GCBackground
,
4240 XSetDashes (FRAME_X_DISPLAY (f
), line_gc
, 0, dash_list
, dashes
);
4241 gc_values
.foreground
= f
->output_data
.x
->background_pixel
;
4242 gc_values
.background
= f
->output_data
.x
->foreground_pixel
;
4243 erase_gc
= XCreateGC (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
4244 GCLineStyle
| GCJoinStyle
| GCCapStyle
4245 | GCLineWidth
| GCForeground
| GCBackground
,
4247 XSetDashes (FRAME_X_DISPLAY (f
), erase_gc
, 0, dash_list
, dashes
);
4254 if (x_mouse_y
>= XINT (w
->top
)
4255 && x_mouse_y
< XINT (w
->top
) + XINT (w
->height
) - 1)
4257 previous_y
= x_mouse_y
;
4258 line
= (x_mouse_y
+ 1) * f
->output_data
.x
->line_height
4259 + f
->output_data
.x
->internal_border_width
;
4260 XDrawLine (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
4261 line_gc
, left
, line
, right
, line
);
4263 XFlush (FRAME_X_DISPLAY (f
));
4268 obj
= read_char (-1, 0, 0, Qnil
, 0);
4270 || (! EQ (Fcar (Fcdr (Fcdr (obj
))),
4271 Qvertical_scroll_bar
))
4275 XDrawLine (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
4276 erase_gc
, left
, line
, right
, line
);
4277 unread_command_event
= obj
;
4279 XFreeGC (FRAME_X_DISPLAY (f
), line_gc
);
4280 XFreeGC (FRAME_X_DISPLAY (f
), erase_gc
);
4286 while (x_mouse_y
== previous_y
);
4289 XDrawLine (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
4290 erase_gc
, left
, line
, right
, line
);
4297 /* These keep track of the rectangle following the pointer. */
4298 int mouse_track_top
, mouse_track_left
, mouse_track_width
;
4300 /* Offset in buffer of character under the pointer, or 0. */
4301 int mouse_buffer_offset
;
4303 DEFUN ("x-track-pointer", Fx_track_pointer
, Sx_track_pointer
, 0, 0, 0,
4304 "Track the pointer.")
4307 static Cursor current_pointer_shape
;
4308 FRAME_PTR f
= x_mouse_frame
;
4311 if (EQ (Vmouse_frame_part
, Qtext_part
)
4312 && (current_pointer_shape
!= f
->output_data
.x
->nontext_cursor
))
4317 current_pointer_shape
= f
->output_data
.x
->nontext_cursor
;
4318 XDefineCursor (FRAME_X_DISPLAY (f
),
4320 current_pointer_shape
);
4322 buf
= XBUFFER (XWINDOW (Vmouse_window
)->buffer
);
4323 c
= *(BUF_CHAR_ADDRESS (buf
, mouse_buffer_offset
));
4325 else if (EQ (Vmouse_frame_part
, Qmodeline_part
)
4326 && (current_pointer_shape
!= f
->output_data
.x
->modeline_cursor
))
4328 current_pointer_shape
= f
->output_data
.x
->modeline_cursor
;
4329 XDefineCursor (FRAME_X_DISPLAY (f
),
4331 current_pointer_shape
);
4334 XFlush (FRAME_X_DISPLAY (f
));
4340 DEFUN ("x-track-pointer", Fx_track_pointer
, Sx_track_pointer
, 1, 1, "e",
4341 "Draw rectangle around character under mouse pointer, if there is one.")
4345 struct window
*w
= XWINDOW (Vmouse_window
);
4346 struct frame
*f
= XFRAME (WINDOW_FRAME (w
));
4347 struct buffer
*b
= XBUFFER (w
->buffer
);
4350 if (! EQ (Vmouse_window
, selected_window
))
4353 if (EQ (event
, Qnil
))
4357 x_read_mouse_position (selected_frame
, &x
, &y
);
4361 mouse_track_width
= 0;
4362 mouse_track_left
= mouse_track_top
= -1;
4366 if ((x_mouse_x
!= mouse_track_left
4367 && (x_mouse_x
< mouse_track_left
4368 || x_mouse_x
> (mouse_track_left
+ mouse_track_width
)))
4369 || x_mouse_y
!= mouse_track_top
)
4371 int hp
= 0; /* Horizontal position */
4372 int len
= FRAME_CURRENT_GLYPHS (f
)->used
[x_mouse_y
];
4373 int p
= FRAME_CURRENT_GLYPHS (f
)->bufp
[x_mouse_y
];
4374 int tab_width
= XINT (b
->tab_width
);
4375 int ctl_arrow_p
= !NILP (b
->ctl_arrow
);
4377 int mode_line_vpos
= XFASTINT (w
->height
) + XFASTINT (w
->top
) - 1;
4378 int in_mode_line
= 0;
4380 if (! FRAME_CURRENT_GLYPHS (f
)->enable
[x_mouse_y
])
4383 /* Erase previous rectangle. */
4384 if (mouse_track_width
)
4386 x_rectangle (f
, f
->output_data
.x
->reverse_gc
,
4387 mouse_track_left
, mouse_track_top
,
4388 mouse_track_width
, 1);
4390 if ((mouse_track_left
== f
->phys_cursor_x
4391 || mouse_track_left
== f
->phys_cursor_x
- 1)
4392 && mouse_track_top
== f
->phys_cursor_y
)
4394 x_display_cursor (f
, 1);
4398 mouse_track_left
= x_mouse_x
;
4399 mouse_track_top
= x_mouse_y
;
4400 mouse_track_width
= 0;
4402 if (mouse_track_left
> len
) /* Past the end of line. */
4405 if (mouse_track_top
== mode_line_vpos
)
4411 if (tab_width
<= 0 || tab_width
> 20) tab_width
= 8;
4415 if (len
== f
->width
&& hp
== len
- 1 && c
!= '\n')
4421 mouse_track_width
= tab_width
- (hp
% tab_width
);
4423 hp
+= mouse_track_width
;
4426 mouse_track_left
= hp
- mouse_track_width
;
4432 mouse_track_width
= -1;
4436 if (ctl_arrow_p
&& (c
< 040 || c
== 0177))
4441 mouse_track_width
= 2;
4446 mouse_track_left
= hp
- mouse_track_width
;
4452 mouse_track_width
= 1;
4459 while (hp
<= x_mouse_x
);
4462 if (mouse_track_width
) /* Over text; use text pointer shape. */
4464 XDefineCursor (FRAME_X_DISPLAY (f
),
4466 f
->output_data
.x
->text_cursor
);
4467 x_rectangle (f
, f
->output_data
.x
->cursor_gc
,
4468 mouse_track_left
, mouse_track_top
,
4469 mouse_track_width
, 1);
4471 else if (in_mode_line
)
4472 XDefineCursor (FRAME_X_DISPLAY (f
),
4474 f
->output_data
.x
->modeline_cursor
);
4476 XDefineCursor (FRAME_X_DISPLAY (f
),
4478 f
->output_data
.x
->nontext_cursor
);
4481 XFlush (FRAME_X_DISPLAY (f
));
4484 obj
= read_char (-1, 0, 0, Qnil
, 0);
4487 while (CONSP (obj
) /* Mouse event */
4488 && EQ (Fcar (Fcdr (Fcdr (obj
))), Qnil
) /* Not scroll bar */
4489 && EQ (Vmouse_depressed
, Qnil
) /* Only motion events */
4490 && EQ (Vmouse_window
, selected_window
) /* In this window */
4493 unread_command_event
= obj
;
4495 if (mouse_track_width
)
4497 x_rectangle (f
, f
->output_data
.x
->reverse_gc
,
4498 mouse_track_left
, mouse_track_top
,
4499 mouse_track_width
, 1);
4500 mouse_track_width
= 0;
4501 if ((mouse_track_left
== f
->phys_cursor_x
4502 || mouse_track_left
- 1 == f
->phys_cursor_x
)
4503 && mouse_track_top
== f
->phys_cursor_y
)
4505 x_display_cursor (f
, 1);
4508 XDefineCursor (FRAME_X_DISPLAY (f
),
4510 f
->output_data
.x
->nontext_cursor
);
4511 XFlush (FRAME_X_DISPLAY (f
));
4521 /* Draw a pixmap specified by IMAGE_DATA of dimensions WIDTH and HEIGHT
4522 on the frame F at position X, Y. */
4524 x_draw_pixmap (f
, x
, y
, image_data
, width
, height
)
4526 int x
, y
, width
, height
;
4531 image
= XCreateBitmapFromData (FRAME_X_DISPLAY (f
),
4532 FRAME_X_WINDOW (f
), image_data
,
4534 XCopyPlane (FRAME_X_DISPLAY (f
), image
, FRAME_X_WINDOW (f
),
4535 f
->output_data
.x
->normal_gc
, 0, 0, width
, height
, x
, y
);
4539 #if 0 /* I'm told these functions are superfluous
4540 given the ability to bind function keys. */
4543 DEFUN ("x-rebind-key", Fx_rebind_key
, Sx_rebind_key
, 3, 3, 0,
4544 "Rebind X keysym KEYSYM, with MODIFIERS, to generate NEWSTRING.\n\
4545 KEYSYM is a string which conforms to the X keysym definitions found\n\
4546 in X11/keysymdef.h, sans the initial XK_. MODIFIERS is nil or a\n\
4547 list of strings specifying modifier keys such as Control_L, which must\n\
4548 also be depressed for NEWSTRING to appear.")
4549 (x_keysym
, modifiers
, newstring
)
4550 register Lisp_Object x_keysym
;
4551 register Lisp_Object modifiers
;
4552 register Lisp_Object newstring
;
4555 register KeySym keysym
;
4556 KeySym modifier_list
[16];
4559 CHECK_STRING (x_keysym
, 1);
4560 CHECK_STRING (newstring
, 3);
4562 keysym
= XStringToKeysym ((char *) XSTRING (x_keysym
)->data
);
4563 if (keysym
== NoSymbol
)
4564 error ("Keysym does not exist");
4566 if (NILP (modifiers
))
4567 XRebindKeysym (x_current_display
, keysym
, modifier_list
, 0,
4568 XSTRING (newstring
)->data
, XSTRING (newstring
)->size
);
4571 register Lisp_Object rest
, mod
;
4574 for (rest
= modifiers
; !NILP (rest
); rest
= Fcdr (rest
))
4577 error ("Can't have more than 16 modifiers");
4580 CHECK_STRING (mod
, 3);
4581 modifier_list
[i
] = XStringToKeysym ((char *) XSTRING (mod
)->data
);
4583 if (modifier_list
[i
] == NoSymbol
4584 || !(IsModifierKey (modifier_list
[i
])
4585 || ((unsigned)(modifier_list
[i
]) == XK_Mode_switch
)
4586 || ((unsigned)(modifier_list
[i
]) == XK_Num_Lock
)))
4588 if (modifier_list
[i
] == NoSymbol
4589 || !IsModifierKey (modifier_list
[i
]))
4591 error ("Element is not a modifier keysym");
4595 XRebindKeysym (x_current_display
, keysym
, modifier_list
, i
,
4596 XSTRING (newstring
)->data
, XSTRING (newstring
)->size
);
4602 DEFUN ("x-rebind-keys", Fx_rebind_keys
, Sx_rebind_keys
, 2, 2, 0,
4603 "Rebind KEYCODE to list of strings STRINGS.\n\
4604 STRINGS should be a list of 16 elements, one for each shift combination.\n\
4605 nil as element means don't change.\n\
4606 See the documentation of `x-rebind-key' for more information.")
4608 register Lisp_Object keycode
;
4609 register Lisp_Object strings
;
4611 register Lisp_Object item
;
4612 register unsigned char *rawstring
;
4613 KeySym rawkey
, modifier
[1];
4615 register unsigned i
;
4618 CHECK_NUMBER (keycode
, 1);
4619 CHECK_CONS (strings
, 2);
4620 rawkey
= (KeySym
) ((unsigned) (XINT (keycode
))) & 255;
4621 for (i
= 0; i
<= 15; strings
= Fcdr (strings
), i
++)
4623 item
= Fcar (strings
);
4626 CHECK_STRING (item
, 2);
4627 strsize
= XSTRING (item
)->size
;
4628 rawstring
= (unsigned char *) xmalloc (strsize
);
4629 bcopy (XSTRING (item
)->data
, rawstring
, strsize
);
4630 modifier
[1] = 1 << i
;
4631 XRebindKeysym (x_current_display
, rawkey
, modifier
, 1,
4632 rawstring
, strsize
);
4637 #endif /* HAVE_X11 */
4640 #ifndef HAVE_XSCREENNUMBEROFSCREEN
4642 XScreenNumberOfScreen (scr
)
4643 register Screen
*scr
;
4645 register Display
*dpy
;
4646 register Screen
*dpyscr
;
4650 dpyscr
= dpy
->screens
;
4652 for (i
= 0; i
< dpy
->nscreens
; i
++, dpyscr
++)
4658 #endif /* not HAVE_XSCREENNUMBEROFSCREEN */
4661 select_visual (dpy
, screen
, depth
)
4664 unsigned int *depth
;
4667 XVisualInfo
*vinfo
, vinfo_template
;
4670 v
= DefaultVisualOfScreen (screen
);
4673 vinfo_template
.visualid
= XVisualIDFromVisual (v
);
4675 vinfo_template
.visualid
= v
->visualid
;
4678 vinfo_template
.screen
= XScreenNumberOfScreen (screen
);
4680 vinfo
= XGetVisualInfo (dpy
,
4681 VisualIDMask
| VisualScreenMask
, &vinfo_template
,
4684 fatal ("Can't get proper X visual info");
4686 if ((1 << vinfo
->depth
) == vinfo
->colormap_size
)
4687 *depth
= vinfo
->depth
;
4691 int n
= vinfo
->colormap_size
- 1;
4700 XFree ((char *) vinfo
);
4704 /* Return the X display structure for the display named NAME.
4705 Open a new connection if necessary. */
4707 struct x_display_info
*
4708 x_display_info_for_name (name
)
4712 struct x_display_info
*dpyinfo
;
4714 CHECK_STRING (name
, 0);
4716 if (! EQ (Vwindow_system
, intern ("x")))
4717 error ("Not using X Windows");
4719 for (dpyinfo
= x_display_list
, names
= x_display_name_list
;
4721 dpyinfo
= dpyinfo
->next
, names
= XCONS (names
)->cdr
)
4724 tem
= Fstring_equal (XCONS (XCONS (names
)->car
)->car
, name
);
4729 /* Use this general default value to start with. */
4730 Vx_resource_name
= Vinvocation_name
;
4732 validate_x_resource_name ();
4734 dpyinfo
= x_term_init (name
, (unsigned char *)0,
4735 (char *) XSTRING (Vx_resource_name
)->data
);
4738 error ("Cannot connect to X server %s", XSTRING (name
)->data
);
4741 XSETFASTINT (Vwindow_system_version
, 11);
4746 DEFUN ("x-open-connection", Fx_open_connection
, Sx_open_connection
,
4747 1, 3, 0, "Open a connection to an X server.\n\
4748 DISPLAY is the name of the display to connect to.\n\
4749 Optional second arg XRM-STRING is a string of resources in xrdb format.\n\
4750 If the optional third arg MUST-SUCCEED is non-nil,\n\
4751 terminate Emacs if we can't open the connection.")
4752 (display
, xrm_string
, must_succeed
)
4753 Lisp_Object display
, xrm_string
, must_succeed
;
4755 unsigned int n_planes
;
4756 unsigned char *xrm_option
;
4757 struct x_display_info
*dpyinfo
;
4759 CHECK_STRING (display
, 0);
4760 if (! NILP (xrm_string
))
4761 CHECK_STRING (xrm_string
, 1);
4763 if (! EQ (Vwindow_system
, intern ("x")))
4764 error ("Not using X Windows");
4766 if (! NILP (xrm_string
))
4767 xrm_option
= (unsigned char *) XSTRING (xrm_string
)->data
;
4769 xrm_option
= (unsigned char *) 0;
4771 /* Use this general default value to start with. */
4772 Vx_resource_name
= Vinvocation_name
;
4774 validate_x_resource_name ();
4776 /* This is what opens the connection and sets x_current_display.
4777 This also initializes many symbols, such as those used for input. */
4778 dpyinfo
= x_term_init (display
, xrm_option
,
4779 (char *) XSTRING (Vx_resource_name
)->data
);
4783 if (!NILP (must_succeed
))
4784 fatal ("Cannot connect to X server %s.\n\
4785 Check the DISPLAY environment variable or use `-d'.\n\
4786 Also use the `xhost' program to verify that it is set to permit\n\
4787 connections from your machine.\n",
4788 XSTRING (display
)->data
);
4790 error ("Cannot connect to X server %s", XSTRING (display
)->data
);
4795 XSETFASTINT (Vwindow_system_version
, 11);
4799 DEFUN ("x-close-connection", Fx_close_connection
,
4800 Sx_close_connection
, 1, 1, 0,
4801 "Close the connection to DISPLAY's X server.\n\
4802 For DISPLAY, specify either a frame or a display name (a string).\n\
4803 If DISPLAY is nil, that stands for the selected frame's display.")
4805 Lisp_Object display
;
4807 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4808 struct x_display_info
*tail
;
4811 if (dpyinfo
->reference_count
> 0)
4812 error ("Display still has frames on it");
4815 /* Free the fonts in the font table. */
4816 for (i
= 0; i
< dpyinfo
->n_fonts
; i
++)
4818 if (dpyinfo
->font_table
[i
].name
)
4819 free (dpyinfo
->font_table
[i
].name
);
4820 /* Don't free the full_name string;
4821 it is always shared with something else. */
4822 XFreeFont (dpyinfo
->display
, dpyinfo
->font_table
[i
].font
);
4824 x_destroy_all_bitmaps (dpyinfo
);
4825 XSetCloseDownMode (dpyinfo
->display
, DestroyAll
);
4827 #ifdef USE_X_TOOLKIT
4828 XtCloseDisplay (dpyinfo
->display
);
4830 XCloseDisplay (dpyinfo
->display
);
4833 x_delete_display (dpyinfo
);
4839 DEFUN ("x-display-list", Fx_display_list
, Sx_display_list
, 0, 0, 0,
4840 "Return the list of display names that Emacs has connections to.")
4843 Lisp_Object tail
, result
;
4846 for (tail
= x_display_name_list
; ! NILP (tail
); tail
= XCONS (tail
)->cdr
)
4847 result
= Fcons (XCONS (XCONS (tail
)->car
)->car
, result
);
4852 DEFUN ("x-synchronize", Fx_synchronize
, Sx_synchronize
, 1, 2, 0,
4853 "If ON is non-nil, report X errors as soon as the erring request is made.\n\
4854 If ON is nil, allow buffering of requests.\n\
4855 Turning on synchronization prohibits the Xlib routines from buffering\n\
4856 requests and seriously degrades performance, but makes debugging much\n\
4858 The optional second argument DISPLAY specifies which display to act on.\n\
4859 DISPLAY should be either a frame or a display name (a string).\n\
4860 If DISPLAY is omitted or nil, that stands for the selected frame's display.")
4862 Lisp_Object display
, on
;
4864 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4866 XSynchronize (dpyinfo
->display
, !EQ (on
, Qnil
));
4871 /* Wait for responses to all X commands issued so far for frame F. */
4878 XSync (FRAME_X_DISPLAY (f
), False
);
4884 /* This is zero if not using X windows. */
4887 /* The section below is built by the lisp expression at the top of the file,
4888 just above where these variables are declared. */
4889 /*&&& init symbols here &&&*/
4890 Qauto_raise
= intern ("auto-raise");
4891 staticpro (&Qauto_raise
);
4892 Qauto_lower
= intern ("auto-lower");
4893 staticpro (&Qauto_lower
);
4894 Qbackground_color
= intern ("background-color");
4895 staticpro (&Qbackground_color
);
4896 Qbar
= intern ("bar");
4898 Qborder_color
= intern ("border-color");
4899 staticpro (&Qborder_color
);
4900 Qborder_width
= intern ("border-width");
4901 staticpro (&Qborder_width
);
4902 Qbox
= intern ("box");
4904 Qcursor_color
= intern ("cursor-color");
4905 staticpro (&Qcursor_color
);
4906 Qcursor_type
= intern ("cursor-type");
4907 staticpro (&Qcursor_type
);
4908 Qfont
= intern ("font");
4910 Qforeground_color
= intern ("foreground-color");
4911 staticpro (&Qforeground_color
);
4912 Qgeometry
= intern ("geometry");
4913 staticpro (&Qgeometry
);
4914 Qicon_left
= intern ("icon-left");
4915 staticpro (&Qicon_left
);
4916 Qicon_top
= intern ("icon-top");
4917 staticpro (&Qicon_top
);
4918 Qicon_type
= intern ("icon-type");
4919 staticpro (&Qicon_type
);
4920 Qicon_name
= intern ("icon-name");
4921 staticpro (&Qicon_name
);
4922 Qinternal_border_width
= intern ("internal-border-width");
4923 staticpro (&Qinternal_border_width
);
4924 Qleft
= intern ("left");
4926 Qmouse_color
= intern ("mouse-color");
4927 staticpro (&Qmouse_color
);
4928 Qnone
= intern ("none");
4930 Qparent_id
= intern ("parent-id");
4931 staticpro (&Qparent_id
);
4932 Qscroll_bar_width
= intern ("scroll-bar-width");
4933 staticpro (&Qscroll_bar_width
);
4934 Qsuppress_icon
= intern ("suppress-icon");
4935 staticpro (&Qsuppress_icon
);
4936 Qtop
= intern ("top");
4938 Qundefined_color
= intern ("undefined-color");
4939 staticpro (&Qundefined_color
);
4940 Qvertical_scroll_bars
= intern ("vertical-scroll-bars");
4941 staticpro (&Qvertical_scroll_bars
);
4942 Qvisibility
= intern ("visibility");
4943 staticpro (&Qvisibility
);
4944 Qwindow_id
= intern ("window-id");
4945 staticpro (&Qwindow_id
);
4946 Qx_frame_parameter
= intern ("x-frame-parameter");
4947 staticpro (&Qx_frame_parameter
);
4948 Qx_resource_name
= intern ("x-resource-name");
4949 staticpro (&Qx_resource_name
);
4950 Quser_position
= intern ("user-position");
4951 staticpro (&Quser_position
);
4952 Quser_size
= intern ("user-size");
4953 staticpro (&Quser_size
);
4954 Qdisplay
= intern ("display");
4955 staticpro (&Qdisplay
);
4956 /* This is the end of symbol initialization. */
4958 Fput (Qundefined_color
, Qerror_conditions
,
4959 Fcons (Qundefined_color
, Fcons (Qerror
, Qnil
)));
4960 Fput (Qundefined_color
, Qerror_message
,
4961 build_string ("Undefined color"));
4963 init_x_parm_symbols ();
4965 DEFVAR_LISP ("x-bitmap-file-path", &Vx_bitmap_file_path
,
4966 "List of directories to search for bitmap files for X.");
4967 Vx_bitmap_file_path
= decode_env_path ((char *) 0, PATH_BITMAPS
);
4969 DEFVAR_LISP ("x-pointer-shape", &Vx_pointer_shape
,
4970 "The shape of the pointer when over text.\n\
4971 Changing the value does not affect existing frames\n\
4972 unless you set the mouse color.");
4973 Vx_pointer_shape
= Qnil
;
4975 DEFVAR_LISP ("x-resource-name", &Vx_resource_name
,
4976 "The name Emacs uses to look up X resources; for internal use only.\n\
4977 `x-get-resource' uses this as the first component of the instance name\n\
4978 when requesting resource values.\n\
4979 Emacs initially sets `x-resource-name' to the name under which Emacs\n\
4980 was invoked, or to the value specified with the `-name' or `-rn'\n\
4981 switches, if present.");
4982 Vx_resource_name
= Qnil
;
4984 #if 0 /* This doesn't really do anything. */
4985 DEFVAR_INT ("x-nontext-pointer-shape", &Vx_nontext_pointer_shape
,
4986 "The shape of the pointer when not over text.\n\
4987 This variable takes effect when you create a new frame\n\
4988 or when you set the mouse color.");
4990 Vx_nontext_pointer_shape
= Qnil
;
4992 #if 0 /* This doesn't really do anything. */
4993 DEFVAR_INT ("x-mode-pointer-shape", &Vx_mode_pointer_shape
,
4994 "The shape of the pointer when over the mode line.\n\
4995 This variable takes effect when you create a new frame\n\
4996 or when you set the mouse color.");
4998 Vx_mode_pointer_shape
= Qnil
;
5000 DEFVAR_INT ("x-sensitive-text-pointer-shape",
5001 &Vx_sensitive_text_pointer_shape
,
5002 "The shape of the pointer when over mouse-sensitive text.\n\
5003 This variable takes effect when you create a new frame\n\
5004 or when you set the mouse color.");
5005 Vx_sensitive_text_pointer_shape
= Qnil
;
5007 DEFVAR_LISP ("x-cursor-fore-pixel", &Vx_cursor_fore_pixel
,
5008 "A string indicating the foreground color of the cursor box.");
5009 Vx_cursor_fore_pixel
= Qnil
;
5011 DEFVAR_LISP ("x-no-window-manager", &Vx_no_window_manager
,
5012 "Non-nil if no X window manager is in use.\n\
5013 Emacs doesn't try to figure this out; this is always nil\n\
5014 unless you set it to something else.");
5015 /* We don't have any way to find this out, so set it to nil
5016 and maybe the user would like to set it to t. */
5017 Vx_no_window_manager
= Qnil
;
5019 #ifdef USE_X_TOOLKIT
5020 Fprovide (intern ("x-toolkit"));
5023 Fprovide (intern ("motif"));
5026 defsubr (&Sx_get_resource
);
5028 defsubr (&Sx_draw_rectangle
);
5029 defsubr (&Sx_erase_rectangle
);
5030 defsubr (&Sx_contour_region
);
5031 defsubr (&Sx_uncontour_region
);
5033 defsubr (&Sx_list_fonts
);
5034 defsubr (&Sx_display_color_p
);
5035 defsubr (&Sx_display_grayscale_p
);
5036 defsubr (&Sx_color_defined_p
);
5037 defsubr (&Sx_color_values
);
5038 defsubr (&Sx_server_max_request_size
);
5039 defsubr (&Sx_server_vendor
);
5040 defsubr (&Sx_server_version
);
5041 defsubr (&Sx_display_pixel_width
);
5042 defsubr (&Sx_display_pixel_height
);
5043 defsubr (&Sx_display_mm_width
);
5044 defsubr (&Sx_display_mm_height
);
5045 defsubr (&Sx_display_screens
);
5046 defsubr (&Sx_display_planes
);
5047 defsubr (&Sx_display_color_cells
);
5048 defsubr (&Sx_display_visual_class
);
5049 defsubr (&Sx_display_backing_store
);
5050 defsubr (&Sx_display_save_under
);
5052 defsubr (&Sx_rebind_key
);
5053 defsubr (&Sx_rebind_keys
);
5054 defsubr (&Sx_track_pointer
);
5055 defsubr (&Sx_grab_pointer
);
5056 defsubr (&Sx_ungrab_pointer
);
5058 defsubr (&Sx_parse_geometry
);
5059 defsubr (&Sx_create_frame
);
5060 defsubr (&Sfocus_frame
);
5061 defsubr (&Sunfocus_frame
);
5063 defsubr (&Sx_horizontal_line
);
5065 defsubr (&Sx_open_connection
);
5066 defsubr (&Sx_close_connection
);
5067 defsubr (&Sx_display_list
);
5068 defsubr (&Sx_synchronize
);
5071 #endif /* HAVE_X_WINDOWS */