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"
43 /* On some systems, the character-composition stuff is broken in X11R5. */
44 #if defined (HAVE_X11R5) && ! defined (HAVE_X11R6)
45 #ifdef X11R5_INHIBIT_I18N
51 #if 1 /* Used to be #ifdef EMACS_BITMAP_FILES, but this should always work. */
52 #include "bitmaps/gray.xbm"
54 #include <X11/bitmaps/gray>
57 #include "[.bitmaps]gray.xbm"
61 #include <X11/Shell.h>
64 #include <X11/Xaw/Paned.h>
65 #include <X11/Xaw/Label.h>
66 #endif /* USE_MOTIF */
69 #undef USG /* ####KLUDGE for Solaris 2.2 and up */
78 #include "../lwlib/lwlib.h"
80 /* Do the EDITRES protocol if running X11R5
81 Exception: HP-UX (at least version A.09.05) has X11R5 without EditRes */
82 #if (XtSpecificationRelease >= 5) && !defined(NO_EDITRES)
84 extern void _XEditResCheckMessages ();
85 #endif /* R5 + Athena */
87 /* Unique id counter for widgets created by the Lucid Widget
89 extern LWLIB_ID widget_id_tick
;
91 /* This is part of a kludge--see lwlib/xlwmenu.c. */
92 XFontStruct
*xlwmenu_default_font
;
94 extern void free_frame_menubar ();
95 #endif /* USE_X_TOOLKIT */
97 #define min(a,b) ((a) < (b) ? (a) : (b))
98 #define max(a,b) ((a) > (b) ? (a) : (b))
101 #define MAXREQUEST(dpy) (XMaxRequestSize (dpy))
103 #define MAXREQUEST(dpy) ((dpy)->max_request_size)
106 /* The name we're using in resource queries. */
107 Lisp_Object Vx_resource_name
;
109 /* The background and shape of the mouse pointer, and shape when not
110 over text or in the modeline. */
111 Lisp_Object Vx_pointer_shape
, Vx_nontext_pointer_shape
, Vx_mode_pointer_shape
;
112 /* The shape when over mouse-sensitive text. */
113 Lisp_Object Vx_sensitive_text_pointer_shape
;
115 /* Color of chars displayed in cursor box. */
116 Lisp_Object Vx_cursor_fore_pixel
;
118 /* Nonzero if using X. */
121 /* Non nil if no window manager is in use. */
122 Lisp_Object Vx_no_window_manager
;
124 /* Search path for bitmap files. */
125 Lisp_Object Vx_bitmap_file_path
;
127 /* Evaluate this expression to rebuild the section of syms_of_xfns
128 that initializes and staticpros the symbols declared below. Note
129 that Emacs 18 has a bug that keeps C-x C-e from being able to
130 evaluate this expression.
133 ;; Accumulate a list of the symbols we want to initialize from the
134 ;; declarations at the top of the file.
135 (goto-char (point-min))
136 (search-forward "/\*&&& symbols declared here &&&*\/\n")
138 (while (looking-at "Lisp_Object \\(Q[a-z_]+\\)")
140 (cons (buffer-substring (match-beginning 1) (match-end 1))
143 (setq symbol-list (nreverse symbol-list))
144 ;; Delete the section of syms_of_... where we initialize the symbols.
145 (search-forward "\n /\*&&& init symbols here &&&*\/\n")
146 (let ((start (point)))
147 (while (looking-at "^ Q")
149 (kill-region start (point)))
150 ;; Write a new symbol initialization section.
152 (insert (format " %s = intern (\"" (car symbol-list)))
153 (let ((start (point)))
154 (insert (substring (car symbol-list) 1))
155 (subst-char-in-region start (point) ?_ ?-))
156 (insert (format "\");\n staticpro (&%s);\n" (car symbol-list)))
157 (setq symbol-list (cdr symbol-list)))))
161 /*&&& symbols declared here &&&*/
162 Lisp_Object Qauto_raise
;
163 Lisp_Object Qauto_lower
;
164 Lisp_Object Qbackground_color
;
166 Lisp_Object Qborder_color
;
167 Lisp_Object Qborder_width
;
169 Lisp_Object Qcursor_color
;
170 Lisp_Object Qcursor_type
;
172 Lisp_Object Qforeground_color
;
173 Lisp_Object Qgeometry
;
174 Lisp_Object Qicon_left
;
175 Lisp_Object Qicon_top
;
176 Lisp_Object Qicon_type
;
177 Lisp_Object Qicon_name
;
178 Lisp_Object Qinternal_border_width
;
180 Lisp_Object Qmouse_color
;
182 Lisp_Object Qparent_id
;
183 Lisp_Object Qscroll_bar_width
;
184 Lisp_Object Qsuppress_icon
;
186 Lisp_Object Qundefined_color
;
187 Lisp_Object Qvertical_scroll_bars
;
188 Lisp_Object Qvisibility
;
189 Lisp_Object Qwindow_id
;
190 Lisp_Object Qx_frame_parameter
;
191 Lisp_Object Qx_resource_name
;
192 Lisp_Object Quser_position
;
193 Lisp_Object Quser_size
;
194 Lisp_Object Qdisplay
;
196 /* The below are defined in frame.c. */
197 extern Lisp_Object Qheight
, Qminibuffer
, Qname
, Qonly
, Qwidth
;
198 extern Lisp_Object Qunsplittable
, Qmenu_bar_lines
, Qbuffer_predicate
;
200 extern Lisp_Object Vwindow_system_version
;
203 /* Error if we are not connected to X. */
208 error ("X windows are not in use or not initialized");
211 /* Nonzero if we can use mouse menus.
212 You should not call this unless HAVE_MENUS is defined. */
220 /* Extract a frame as a FRAME_PTR, defaulting to the selected frame
221 and checking validity for X. */
224 check_x_frame (frame
)
233 CHECK_LIVE_FRAME (frame
, 0);
237 error ("Non-X frame used");
241 /* Let the user specify an X display with a frame.
242 nil stands for the selected frame--or, if that is not an X frame,
243 the first X display on the list. */
245 static struct x_display_info
*
246 check_x_display_info (frame
)
251 if (FRAME_X_P (selected_frame
))
252 return FRAME_X_DISPLAY_INFO (selected_frame
);
253 else if (x_display_list
!= 0)
254 return x_display_list
;
256 error ("X windows are not in use or not initialized");
258 else if (STRINGP (frame
))
259 return x_display_info_for_name (frame
);
264 CHECK_LIVE_FRAME (frame
, 0);
267 error ("Non-X frame used");
268 return FRAME_X_DISPLAY_INFO (f
);
272 /* Return the Emacs frame-object corresponding to an X window.
273 It could be the frame's main window or an icon window. */
275 /* This function can be called during GC, so use GC_xxx type test macros. */
278 x_window_to_frame (dpyinfo
, wdesc
)
279 struct x_display_info
*dpyinfo
;
282 Lisp_Object tail
, frame
;
285 for (tail
= Vframe_list
; GC_CONSP (tail
); tail
= XCONS (tail
)->cdr
)
287 frame
= XCONS (tail
)->car
;
288 if (!GC_FRAMEP (frame
))
291 if (f
->output_data
.nothing
== 1 || FRAME_X_DISPLAY_INFO (f
) != dpyinfo
)
294 if ((f
->output_data
.x
->edit_widget
295 && XtWindow (f
->output_data
.x
->edit_widget
) == wdesc
)
296 || f
->output_data
.x
->icon_desc
== wdesc
)
298 #else /* not USE_X_TOOLKIT */
299 if (FRAME_X_WINDOW (f
) == wdesc
300 || f
->output_data
.x
->icon_desc
== wdesc
)
302 #endif /* not USE_X_TOOLKIT */
308 /* Like x_window_to_frame but also compares the window with the widget's
312 x_any_window_to_frame (dpyinfo
, wdesc
)
313 struct x_display_info
*dpyinfo
;
316 Lisp_Object tail
, frame
;
320 for (tail
= Vframe_list
; GC_CONSP (tail
); tail
= XCONS (tail
)->cdr
)
322 frame
= XCONS (tail
)->car
;
323 if (!GC_FRAMEP (frame
))
326 if (f
->output_data
.nothing
== 1 || FRAME_X_DISPLAY_INFO (f
) != dpyinfo
)
328 x
= f
->output_data
.x
;
329 /* This frame matches if the window is any of its widgets. */
330 if (wdesc
== XtWindow (x
->widget
)
331 || wdesc
== XtWindow (x
->column_widget
)
332 || wdesc
== XtWindow (x
->edit_widget
))
334 /* Match if the window is this frame's menubar. */
335 if (lw_window_is_in_menubar (wdesc
, x
->menubar_widget
))
341 /* Likewise, but exclude the menu bar widget. */
344 x_non_menubar_window_to_frame (dpyinfo
, wdesc
)
345 struct x_display_info
*dpyinfo
;
348 Lisp_Object tail
, frame
;
352 for (tail
= Vframe_list
; GC_CONSP (tail
); tail
= XCONS (tail
)->cdr
)
354 frame
= XCONS (tail
)->car
;
355 if (!GC_FRAMEP (frame
))
358 if (f
->output_data
.nothing
== 1 || FRAME_X_DISPLAY_INFO (f
) != dpyinfo
)
360 x
= f
->output_data
.x
;
361 /* This frame matches if the window is any of its widgets. */
362 if (wdesc
== XtWindow (x
->widget
)
363 || wdesc
== XtWindow (x
->column_widget
)
364 || wdesc
== XtWindow (x
->edit_widget
))
370 /* Likewise, but consider only the menu bar widget. */
373 x_menubar_window_to_frame (dpyinfo
, wdesc
)
374 struct x_display_info
*dpyinfo
;
377 Lisp_Object tail
, frame
;
381 for (tail
= Vframe_list
; GC_CONSP (tail
); tail
= XCONS (tail
)->cdr
)
383 frame
= XCONS (tail
)->car
;
384 if (!GC_FRAMEP (frame
))
387 if (f
->output_data
.nothing
== 1 || FRAME_X_DISPLAY_INFO (f
) != dpyinfo
)
389 x
= f
->output_data
.x
;
390 /* Match if the window is this frame's menubar. */
391 if (lw_window_is_in_menubar (wdesc
, x
->menubar_widget
))
397 /* Return the frame whose principal (outermost) window is WDESC.
398 If WDESC is some other (smaller) window, we return 0. */
401 x_top_window_to_frame (dpyinfo
, wdesc
)
402 struct x_display_info
*dpyinfo
;
405 Lisp_Object tail
, frame
;
409 for (tail
= Vframe_list
; GC_CONSP (tail
); tail
= XCONS (tail
)->cdr
)
411 frame
= XCONS (tail
)->car
;
412 if (!GC_FRAMEP (frame
))
415 if (f
->output_data
.nothing
== 1 || FRAME_X_DISPLAY_INFO (f
) != dpyinfo
)
417 x
= f
->output_data
.x
;
418 /* This frame matches if the window is its topmost widget. */
419 if (wdesc
== XtWindow (x
->widget
))
421 #if 0 /* I don't know why it did this,
422 but it seems logically wrong,
423 and it causes trouble for MapNotify events. */
424 /* Match if the window is this frame's menubar. */
425 if (x
->menubar_widget
426 && wdesc
== XtWindow (x
->menubar_widget
))
432 #endif /* USE_X_TOOLKIT */
436 /* Code to deal with bitmaps. Bitmaps are referenced by their bitmap
437 id, which is just an int that this section returns. Bitmaps are
438 reference counted so they can be shared among frames.
440 Bitmap indices are guaranteed to be > 0, so a negative number can
441 be used to indicate no bitmap.
443 If you use x_create_bitmap_from_data, then you must keep track of
444 the bitmaps yourself. That is, creating a bitmap from the same
445 data more than once will not be caught. */
448 /* Functions to access the contents of a bitmap, given an id. */
451 x_bitmap_height (f
, id
)
455 return FRAME_X_DISPLAY_INFO (f
)->bitmaps
[id
- 1].height
;
459 x_bitmap_width (f
, id
)
463 return FRAME_X_DISPLAY_INFO (f
)->bitmaps
[id
- 1].width
;
467 x_bitmap_pixmap (f
, id
)
471 return FRAME_X_DISPLAY_INFO (f
)->bitmaps
[id
- 1].pixmap
;
475 /* Allocate a new bitmap record. Returns index of new record. */
478 x_allocate_bitmap_record (f
)
481 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
484 if (dpyinfo
->bitmaps
== NULL
)
486 dpyinfo
->bitmaps_size
= 10;
488 = (struct x_bitmap_record
*) xmalloc (dpyinfo
->bitmaps_size
* sizeof (struct x_bitmap_record
));
489 dpyinfo
->bitmaps_last
= 1;
493 if (dpyinfo
->bitmaps_last
< dpyinfo
->bitmaps_size
)
494 return ++dpyinfo
->bitmaps_last
;
496 for (i
= 0; i
< dpyinfo
->bitmaps_size
; ++i
)
497 if (dpyinfo
->bitmaps
[i
].refcount
== 0)
500 dpyinfo
->bitmaps_size
*= 2;
502 = (struct x_bitmap_record
*) xrealloc (dpyinfo
->bitmaps
,
503 dpyinfo
->bitmaps_size
* sizeof (struct x_bitmap_record
));
504 return ++dpyinfo
->bitmaps_last
;
507 /* Add one reference to the reference count of the bitmap with id ID. */
510 x_reference_bitmap (f
, id
)
514 ++FRAME_X_DISPLAY_INFO (f
)->bitmaps
[id
- 1].refcount
;
517 /* Create a bitmap for frame F from a HEIGHT x WIDTH array of bits at BITS. */
520 x_create_bitmap_from_data (f
, bits
, width
, height
)
523 unsigned int width
, height
;
525 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
529 bitmap
= XCreateBitmapFromData (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
530 bits
, width
, height
);
535 id
= x_allocate_bitmap_record (f
);
536 dpyinfo
->bitmaps
[id
- 1].pixmap
= bitmap
;
537 dpyinfo
->bitmaps
[id
- 1].file
= NULL
;
538 dpyinfo
->bitmaps
[id
- 1].refcount
= 1;
539 dpyinfo
->bitmaps
[id
- 1].depth
= 1;
540 dpyinfo
->bitmaps
[id
- 1].height
= height
;
541 dpyinfo
->bitmaps
[id
- 1].width
= width
;
546 /* Create bitmap from file FILE for frame F. */
549 x_create_bitmap_from_file (f
, file
)
553 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
554 unsigned int width
, height
;
556 int xhot
, yhot
, result
, id
;
561 /* Look for an existing bitmap with the same name. */
562 for (id
= 0; id
< dpyinfo
->bitmaps_last
; ++id
)
564 if (dpyinfo
->bitmaps
[id
].refcount
565 && dpyinfo
->bitmaps
[id
].file
566 && !strcmp (dpyinfo
->bitmaps
[id
].file
, (char *) XSTRING (file
)->data
))
568 ++dpyinfo
->bitmaps
[id
].refcount
;
573 /* Search bitmap-file-path for the file, if appropriate. */
574 fd
= openp (Vx_bitmap_file_path
, file
, "", &found
, 0);
579 filename
= (char *) XSTRING (found
)->data
;
581 result
= XReadBitmapFile (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
582 filename
, &width
, &height
, &bitmap
, &xhot
, &yhot
);
583 if (result
!= BitmapSuccess
)
586 id
= x_allocate_bitmap_record (f
);
587 dpyinfo
->bitmaps
[id
- 1].pixmap
= bitmap
;
588 dpyinfo
->bitmaps
[id
- 1].refcount
= 1;
589 dpyinfo
->bitmaps
[id
- 1].file
= (char *) xmalloc (XSTRING (file
)->size
+ 1);
590 dpyinfo
->bitmaps
[id
- 1].depth
= 1;
591 dpyinfo
->bitmaps
[id
- 1].height
= height
;
592 dpyinfo
->bitmaps
[id
- 1].width
= width
;
593 strcpy (dpyinfo
->bitmaps
[id
- 1].file
, XSTRING (file
)->data
);
598 /* Remove reference to bitmap with id number ID. */
601 x_destroy_bitmap (f
, id
)
605 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
609 --dpyinfo
->bitmaps
[id
- 1].refcount
;
610 if (dpyinfo
->bitmaps
[id
- 1].refcount
== 0)
613 XFreePixmap (FRAME_X_DISPLAY (f
), dpyinfo
->bitmaps
[id
- 1].pixmap
);
614 if (dpyinfo
->bitmaps
[id
- 1].file
)
616 free (dpyinfo
->bitmaps
[id
- 1].file
);
617 dpyinfo
->bitmaps
[id
- 1].file
= NULL
;
624 /* Free all the bitmaps for the display specified by DPYINFO. */
627 x_destroy_all_bitmaps (dpyinfo
)
628 struct x_display_info
*dpyinfo
;
631 for (i
= 0; i
< dpyinfo
->bitmaps_last
; i
++)
632 if (dpyinfo
->bitmaps
[i
].refcount
> 0)
634 XFreePixmap (dpyinfo
->display
, dpyinfo
->bitmaps
[i
].pixmap
);
635 if (dpyinfo
->bitmaps
[i
].file
)
636 free (dpyinfo
->bitmaps
[i
].file
);
638 dpyinfo
->bitmaps_last
= 0;
641 /* Connect the frame-parameter names for X frames
642 to the ways of passing the parameter values to the window system.
644 The name of a parameter, as a Lisp symbol,
645 has an `x-frame-parameter' property which is an integer in Lisp
646 but can be interpreted as an `enum x_frame_parm' in C. */
650 X_PARM_FOREGROUND_COLOR
,
651 X_PARM_BACKGROUND_COLOR
,
658 X_PARM_INTERNAL_BORDER_WIDTH
,
662 X_PARM_VERT_SCROLL_BAR
,
664 X_PARM_MENU_BAR_LINES
668 struct x_frame_parm_table
671 void (*setter
)( /* struct frame *frame, Lisp_Object val, oldval */ );
674 void x_set_foreground_color ();
675 void x_set_background_color ();
676 void x_set_mouse_color ();
677 void x_set_cursor_color ();
678 void x_set_border_color ();
679 void x_set_cursor_type ();
680 void x_set_icon_type ();
681 void x_set_icon_name ();
683 void x_set_border_width ();
684 void x_set_internal_border_width ();
685 void x_explicitly_set_name ();
686 void x_set_autoraise ();
687 void x_set_autolower ();
688 void x_set_vertical_scroll_bars ();
689 void x_set_visibility ();
690 void x_set_menu_bar_lines ();
691 void x_set_scroll_bar_width ();
692 void x_set_unsplittable ();
694 static struct x_frame_parm_table x_frame_parms
[] =
696 "foreground-color", x_set_foreground_color
,
697 "background-color", x_set_background_color
,
698 "mouse-color", x_set_mouse_color
,
699 "cursor-color", x_set_cursor_color
,
700 "border-color", x_set_border_color
,
701 "cursor-type", x_set_cursor_type
,
702 "icon-type", x_set_icon_type
,
703 "icon-name", x_set_icon_name
,
705 "border-width", x_set_border_width
,
706 "internal-border-width", x_set_internal_border_width
,
707 "name", x_explicitly_set_name
,
708 "auto-raise", x_set_autoraise
,
709 "auto-lower", x_set_autolower
,
710 "vertical-scroll-bars", x_set_vertical_scroll_bars
,
711 "visibility", x_set_visibility
,
712 "menu-bar-lines", x_set_menu_bar_lines
,
713 "scroll-bar-width", x_set_scroll_bar_width
,
714 "unsplittable", x_set_unsplittable
,
717 /* Attach the `x-frame-parameter' properties to
718 the Lisp symbol names of parameters relevant to X. */
720 init_x_parm_symbols ()
724 for (i
= 0; i
< sizeof (x_frame_parms
) / sizeof (x_frame_parms
[0]); i
++)
725 Fput (intern (x_frame_parms
[i
].name
), Qx_frame_parameter
,
729 /* Change the parameters of FRAME as specified by ALIST.
730 If a parameter is not specially recognized, do nothing;
731 otherwise call the `x_set_...' function for that parameter. */
734 x_set_frame_parameters (f
, alist
)
740 /* If both of these parameters are present, it's more efficient to
741 set them both at once. So we wait until we've looked at the
742 entire list before we set them. */
743 Lisp_Object width
, height
;
746 Lisp_Object left
, top
;
748 /* Same with these. */
749 Lisp_Object icon_left
, icon_top
;
751 /* Record in these vectors all the parms specified. */
755 int left_no_change
= 0, top_no_change
= 0;
756 int icon_left_no_change
= 0, icon_top_no_change
= 0;
759 for (tail
= alist
; CONSP (tail
); tail
= Fcdr (tail
))
762 parms
= (Lisp_Object
*) alloca (i
* sizeof (Lisp_Object
));
763 values
= (Lisp_Object
*) alloca (i
* sizeof (Lisp_Object
));
765 /* Extract parm names and values into those vectors. */
768 for (tail
= alist
; CONSP (tail
); tail
= Fcdr (tail
))
770 Lisp_Object elt
, prop
, val
;
773 parms
[i
] = Fcar (elt
);
774 values
[i
] = Fcdr (elt
);
778 width
= height
= top
= left
= Qunbound
;
779 icon_left
= icon_top
= Qunbound
;
781 /* Now process them in reverse of specified order. */
782 for (i
--; i
>= 0; i
--)
784 Lisp_Object prop
, val
;
789 if (EQ (prop
, Qwidth
))
791 else if (EQ (prop
, Qheight
))
793 else if (EQ (prop
, Qtop
))
795 else if (EQ (prop
, Qleft
))
797 else if (EQ (prop
, Qicon_top
))
799 else if (EQ (prop
, Qicon_left
))
803 register Lisp_Object param_index
, old_value
;
805 param_index
= Fget (prop
, Qx_frame_parameter
);
806 old_value
= get_frame_param (f
, prop
);
807 store_frame_param (f
, prop
, val
);
808 if (NATNUMP (param_index
)
809 && (XFASTINT (param_index
)
810 < sizeof (x_frame_parms
)/sizeof (x_frame_parms
[0])))
811 (*x_frame_parms
[XINT (param_index
)].setter
)(f
, val
, old_value
);
815 /* Don't die if just one of these was set. */
816 if (EQ (left
, Qunbound
))
819 if (f
->output_data
.x
->left_pos
< 0)
820 left
= Fcons (Qplus
, Fcons (make_number (f
->output_data
.x
->left_pos
), Qnil
));
822 XSETINT (left
, f
->output_data
.x
->left_pos
);
824 if (EQ (top
, Qunbound
))
827 if (f
->output_data
.x
->top_pos
< 0)
828 top
= Fcons (Qplus
, Fcons (make_number (f
->output_data
.x
->top_pos
), Qnil
));
830 XSETINT (top
, f
->output_data
.x
->top_pos
);
833 /* If one of the icon positions was not set, preserve or default it. */
834 if (EQ (icon_left
, Qunbound
) || ! INTEGERP (icon_left
))
836 icon_left_no_change
= 1;
837 icon_left
= Fcdr (Fassq (Qicon_left
, f
->param_alist
));
838 if (NILP (icon_left
))
839 XSETINT (icon_left
, 0);
841 if (EQ (icon_top
, Qunbound
) || ! INTEGERP (icon_top
))
843 icon_top_no_change
= 1;
844 icon_top
= Fcdr (Fassq (Qicon_top
, f
->param_alist
));
846 XSETINT (icon_top
, 0);
849 /* Don't die if just one of these was set. */
850 if (EQ (width
, Qunbound
))
851 XSETINT (width
, FRAME_WIDTH (f
));
852 if (EQ (height
, Qunbound
))
853 XSETINT (height
, FRAME_HEIGHT (f
));
855 /* Don't set these parameters unless they've been explicitly
856 specified. The window might be mapped or resized while we're in
857 this function, and we don't want to override that unless the lisp
858 code has asked for it.
860 Don't set these parameters unless they actually differ from the
861 window's current parameters; the window may not actually exist
866 check_frame_size (f
, &height
, &width
);
868 XSETFRAME (frame
, f
);
870 if ((NUMBERP (width
) && XINT (width
) != FRAME_WIDTH (f
))
871 || (NUMBERP (height
) && XINT (height
) != FRAME_HEIGHT (f
)))
872 Fset_frame_size (frame
, width
, height
);
874 if ((!NILP (left
) || !NILP (top
))
875 && ! (left_no_change
&& top_no_change
)
876 && ! (NUMBERP (left
) && XINT (left
) == f
->output_data
.x
->left_pos
877 && NUMBERP (top
) && XINT (top
) == f
->output_data
.x
->top_pos
))
882 /* Record the signs. */
883 f
->output_data
.x
->size_hint_flags
&= ~ (XNegative
| YNegative
);
884 if (EQ (left
, Qminus
))
885 f
->output_data
.x
->size_hint_flags
|= XNegative
;
886 else if (INTEGERP (left
))
888 leftpos
= XINT (left
);
890 f
->output_data
.x
->size_hint_flags
|= XNegative
;
892 else if (CONSP (left
) && EQ (XCONS (left
)->car
, Qminus
)
893 && CONSP (XCONS (left
)->cdr
)
894 && INTEGERP (XCONS (XCONS (left
)->cdr
)->car
))
896 leftpos
= - XINT (XCONS (XCONS (left
)->cdr
)->car
);
897 f
->output_data
.x
->size_hint_flags
|= XNegative
;
899 else if (CONSP (left
) && EQ (XCONS (left
)->car
, Qplus
)
900 && CONSP (XCONS (left
)->cdr
)
901 && INTEGERP (XCONS (XCONS (left
)->cdr
)->car
))
903 leftpos
= XINT (XCONS (XCONS (left
)->cdr
)->car
);
906 if (EQ (top
, Qminus
))
907 f
->output_data
.x
->size_hint_flags
|= YNegative
;
908 else if (INTEGERP (top
))
912 f
->output_data
.x
->size_hint_flags
|= YNegative
;
914 else if (CONSP (top
) && EQ (XCONS (top
)->car
, Qminus
)
915 && CONSP (XCONS (top
)->cdr
)
916 && INTEGERP (XCONS (XCONS (top
)->cdr
)->car
))
918 toppos
= - XINT (XCONS (XCONS (top
)->cdr
)->car
);
919 f
->output_data
.x
->size_hint_flags
|= YNegative
;
921 else if (CONSP (top
) && EQ (XCONS (top
)->car
, Qplus
)
922 && CONSP (XCONS (top
)->cdr
)
923 && INTEGERP (XCONS (XCONS (top
)->cdr
)->car
))
925 toppos
= XINT (XCONS (XCONS (top
)->cdr
)->car
);
929 /* Store the numeric value of the position. */
930 f
->output_data
.x
->top_pos
= toppos
;
931 f
->output_data
.x
->left_pos
= leftpos
;
933 f
->output_data
.x
->win_gravity
= NorthWestGravity
;
935 /* Actually set that position, and convert to absolute. */
936 x_set_offset (f
, leftpos
, toppos
, -1);
939 if ((!NILP (icon_left
) || !NILP (icon_top
))
940 && ! (icon_left_no_change
&& icon_top_no_change
))
941 x_wm_set_icon_position (f
, XINT (icon_left
), XINT (icon_top
));
945 /* Store the screen positions of frame F into XPTR and YPTR.
946 These are the positions of the containing window manager window,
947 not Emacs's own window. */
950 x_real_positions (f
, xptr
, yptr
)
957 /* This is pretty gross, but seems to be the easiest way out of
958 the problem that arises when restarting window-managers. */
961 Window outer
= XtWindow (f
->output_data
.x
->widget
);
963 Window outer
= f
->output_data
.x
->window_desc
;
965 Window tmp_root_window
;
966 Window
*tmp_children
;
971 x_catch_errors (FRAME_X_DISPLAY (f
));
973 XQueryTree (FRAME_X_DISPLAY (f
), outer
, &tmp_root_window
,
974 &f
->output_data
.x
->parent_desc
,
975 &tmp_children
, &tmp_nchildren
);
976 xfree (tmp_children
);
980 /* Find the position of the outside upper-left corner of
981 the inner window, with respect to the outer window. */
982 if (f
->output_data
.x
->parent_desc
!= FRAME_X_DISPLAY_INFO (f
)->root_window
)
984 XTranslateCoordinates (FRAME_X_DISPLAY (f
),
986 /* From-window, to-window. */
988 XtWindow (f
->output_data
.x
->widget
),
990 f
->output_data
.x
->window_desc
,
992 f
->output_data
.x
->parent_desc
,
994 /* From-position, to-position. */
995 0, 0, &win_x
, &win_y
,
1000 #if 0 /* The values seem to be right without this and wrong with. */
1001 win_x
+= f
->output_data
.x
->border_width
;
1002 win_y
+= f
->output_data
.x
->border_width
;
1006 /* It is possible for the window returned by the XQueryNotify
1007 to become invalid by the time we call XTranslateCoordinates.
1008 That can happen when you restart some window managers.
1009 If so, we get an error in XTranslateCoordinates.
1010 Detect that and try the whole thing over. */
1011 if (! x_had_errors_p (FRAME_X_DISPLAY (f
)))
1014 x_uncatch_errors (FRAME_X_DISPLAY (f
));
1017 x_uncatch_errors (FRAME_X_DISPLAY (f
));
1019 *xptr
= f
->output_data
.x
->left_pos
- win_x
;
1020 *yptr
= f
->output_data
.x
->top_pos
- win_y
;
1023 /* Insert a description of internally-recorded parameters of frame X
1024 into the parameter alist *ALISTPTR that is to be given to the user.
1025 Only parameters that are specific to the X window system
1026 and whose values are not correctly recorded in the frame's
1027 param_alist need to be considered here. */
1029 x_report_frame_params (f
, alistptr
)
1031 Lisp_Object
*alistptr
;
1036 /* Represent negative positions (off the top or left screen edge)
1037 in a way that Fmodify_frame_parameters will understand correctly. */
1038 XSETINT (tem
, f
->output_data
.x
->left_pos
);
1039 if (f
->output_data
.x
->left_pos
>= 0)
1040 store_in_alist (alistptr
, Qleft
, tem
);
1042 store_in_alist (alistptr
, Qleft
, Fcons (Qplus
, Fcons (tem
, Qnil
)));
1044 XSETINT (tem
, f
->output_data
.x
->top_pos
);
1045 if (f
->output_data
.x
->top_pos
>= 0)
1046 store_in_alist (alistptr
, Qtop
, tem
);
1048 store_in_alist (alistptr
, Qtop
, Fcons (Qplus
, Fcons (tem
, Qnil
)));
1050 store_in_alist (alistptr
, Qborder_width
,
1051 make_number (f
->output_data
.x
->border_width
));
1052 store_in_alist (alistptr
, Qinternal_border_width
,
1053 make_number (f
->output_data
.x
->internal_border_width
));
1054 sprintf (buf
, "%ld", (long) FRAME_X_WINDOW (f
));
1055 store_in_alist (alistptr
, Qwindow_id
,
1056 build_string (buf
));
1057 store_in_alist (alistptr
, Qicon_name
, f
->icon_name
);
1058 FRAME_SAMPLE_VISIBILITY (f
);
1059 store_in_alist (alistptr
, Qvisibility
,
1060 (FRAME_VISIBLE_P (f
) ? Qt
1061 : FRAME_ICONIFIED_P (f
) ? Qicon
: Qnil
));
1062 store_in_alist (alistptr
, Qdisplay
,
1063 XCONS (FRAME_X_DISPLAY_INFO (f
)->name_list_element
)->car
);
1067 /* Decide if color named COLOR is valid for the display associated with
1068 the selected frame; if so, return the rgb values in COLOR_DEF.
1069 If ALLOC is nonzero, allocate a new colormap cell. */
1072 defined_color (f
, color
, color_def
, alloc
)
1078 register int status
;
1079 Colormap screen_colormap
;
1080 Display
*display
= FRAME_X_DISPLAY (f
);
1083 screen_colormap
= DefaultColormap (display
, XDefaultScreen (display
));
1085 status
= XParseColor (display
, screen_colormap
, color
, color_def
);
1086 if (status
&& alloc
)
1088 status
= XAllocColor (display
, screen_colormap
, color_def
);
1091 /* If we got to this point, the colormap is full, so we're
1092 going to try and get the next closest color.
1093 The algorithm used is a least-squares matching, which is
1094 what X uses for closest color matching with StaticColor visuals. */
1099 long nearest_delta
, trial_delta
;
1102 no_cells
= XDisplayCells (display
, XDefaultScreen (display
));
1103 cells
= (XColor
*) alloca (sizeof (XColor
) * no_cells
);
1105 for (x
= 0; x
< no_cells
; x
++)
1108 XQueryColors (display
, screen_colormap
, cells
, no_cells
);
1110 /* I'm assuming CSE so I'm not going to condense this. */
1111 nearest_delta
= ((((color_def
->red
>> 8) - (cells
[0].red
>> 8))
1112 * ((color_def
->red
>> 8) - (cells
[0].red
>> 8)))
1114 (((color_def
->green
>> 8) - (cells
[0].green
>> 8))
1115 * ((color_def
->green
>> 8) - (cells
[0].green
>> 8)))
1117 (((color_def
->blue
>> 8) - (cells
[0].blue
>> 8))
1118 * ((color_def
->blue
>> 8) - (cells
[0].blue
>> 8))));
1119 for (x
= 1; x
< no_cells
; x
++)
1121 trial_delta
= ((((color_def
->red
>> 8) - (cells
[x
].red
>> 8))
1122 * ((color_def
->red
>> 8) - (cells
[x
].red
>> 8)))
1124 (((color_def
->green
>> 8) - (cells
[x
].green
>> 8))
1125 * ((color_def
->green
>> 8) - (cells
[x
].green
>> 8)))
1127 (((color_def
->blue
>> 8) - (cells
[x
].blue
>> 8))
1128 * ((color_def
->blue
>> 8) - (cells
[x
].blue
>> 8))));
1129 if (trial_delta
< nearest_delta
)
1132 nearest_delta
= trial_delta
;
1135 color_def
->red
= cells
[nearest
].red
;
1136 color_def
->green
= cells
[nearest
].green
;
1137 color_def
->blue
= cells
[nearest
].blue
;
1138 status
= XAllocColor (display
, screen_colormap
, color_def
);
1149 /* Given a string ARG naming a color, compute a pixel value from it
1150 suitable for screen F.
1151 If F is not a color screen, return DEF (default) regardless of what
1155 x_decode_color (f
, arg
, def
)
1162 CHECK_STRING (arg
, 0);
1164 if (strcmp (XSTRING (arg
)->data
, "black") == 0)
1165 return BLACK_PIX_DEFAULT (f
);
1166 else if (strcmp (XSTRING (arg
)->data
, "white") == 0)
1167 return WHITE_PIX_DEFAULT (f
);
1169 if (FRAME_X_DISPLAY_INFO (f
)->n_planes
== 1)
1172 /* defined_color is responsible for coping with failures
1173 by looking for a near-miss. */
1174 if (defined_color (f
, XSTRING (arg
)->data
, &cdef
, 1))
1177 Fsignal (Qerror
, Fcons (build_string ("undefined color"),
1178 Fcons (arg
, Qnil
)));
1181 /* Functions called only from `x_set_frame_param'
1182 to set individual parameters.
1184 If FRAME_X_WINDOW (f) is 0,
1185 the frame is being created and its X-window does not exist yet.
1186 In that case, just record the parameter's new value
1187 in the standard place; do not attempt to change the window. */
1190 x_set_foreground_color (f
, arg
, oldval
)
1192 Lisp_Object arg
, oldval
;
1194 f
->output_data
.x
->foreground_pixel
1195 = x_decode_color (f
, arg
, BLACK_PIX_DEFAULT (f
));
1196 if (FRAME_X_WINDOW (f
) != 0)
1199 XSetForeground (FRAME_X_DISPLAY (f
), f
->output_data
.x
->normal_gc
,
1200 f
->output_data
.x
->foreground_pixel
);
1201 XSetBackground (FRAME_X_DISPLAY (f
), f
->output_data
.x
->reverse_gc
,
1202 f
->output_data
.x
->foreground_pixel
);
1204 recompute_basic_faces (f
);
1205 if (FRAME_VISIBLE_P (f
))
1211 x_set_background_color (f
, arg
, oldval
)
1213 Lisp_Object arg
, oldval
;
1218 f
->output_data
.x
->background_pixel
1219 = x_decode_color (f
, arg
, WHITE_PIX_DEFAULT (f
));
1221 if (FRAME_X_WINDOW (f
) != 0)
1224 /* The main frame area. */
1225 XSetBackground (FRAME_X_DISPLAY (f
), f
->output_data
.x
->normal_gc
,
1226 f
->output_data
.x
->background_pixel
);
1227 XSetForeground (FRAME_X_DISPLAY (f
), f
->output_data
.x
->reverse_gc
,
1228 f
->output_data
.x
->background_pixel
);
1229 XSetForeground (FRAME_X_DISPLAY (f
), f
->output_data
.x
->cursor_gc
,
1230 f
->output_data
.x
->background_pixel
);
1231 XSetWindowBackground (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
1232 f
->output_data
.x
->background_pixel
);
1235 for (bar
= FRAME_SCROLL_BARS (f
); !NILP (bar
);
1236 bar
= XSCROLL_BAR (bar
)->next
)
1237 XSetWindowBackground (FRAME_X_DISPLAY (f
),
1238 SCROLL_BAR_X_WINDOW (XSCROLL_BAR (bar
)),
1239 f
->output_data
.x
->background_pixel
);
1243 recompute_basic_faces (f
);
1245 if (FRAME_VISIBLE_P (f
))
1251 x_set_mouse_color (f
, arg
, oldval
)
1253 Lisp_Object arg
, oldval
;
1255 Cursor cursor
, nontext_cursor
, mode_cursor
, cross_cursor
;
1258 if (!EQ (Qnil
, arg
))
1259 f
->output_data
.x
->mouse_pixel
1260 = x_decode_color (f
, arg
, BLACK_PIX_DEFAULT (f
));
1261 mask_color
= f
->output_data
.x
->background_pixel
;
1262 /* No invisible pointers. */
1263 if (mask_color
== f
->output_data
.x
->mouse_pixel
1264 && mask_color
== f
->output_data
.x
->background_pixel
)
1265 f
->output_data
.x
->mouse_pixel
= f
->output_data
.x
->foreground_pixel
;
1269 /* It's not okay to crash if the user selects a screwy cursor. */
1270 x_catch_errors (FRAME_X_DISPLAY (f
));
1272 if (!EQ (Qnil
, Vx_pointer_shape
))
1274 CHECK_NUMBER (Vx_pointer_shape
, 0);
1275 cursor
= XCreateFontCursor (FRAME_X_DISPLAY (f
), XINT (Vx_pointer_shape
));
1278 cursor
= XCreateFontCursor (FRAME_X_DISPLAY (f
), XC_xterm
);
1279 x_check_errors (FRAME_X_DISPLAY (f
), "bad text pointer cursor: %s");
1281 if (!EQ (Qnil
, Vx_nontext_pointer_shape
))
1283 CHECK_NUMBER (Vx_nontext_pointer_shape
, 0);
1284 nontext_cursor
= XCreateFontCursor (FRAME_X_DISPLAY (f
),
1285 XINT (Vx_nontext_pointer_shape
));
1288 nontext_cursor
= XCreateFontCursor (FRAME_X_DISPLAY (f
), XC_left_ptr
);
1289 x_check_errors (FRAME_X_DISPLAY (f
), "bad nontext pointer cursor: %s");
1291 if (!EQ (Qnil
, Vx_mode_pointer_shape
))
1293 CHECK_NUMBER (Vx_mode_pointer_shape
, 0);
1294 mode_cursor
= XCreateFontCursor (FRAME_X_DISPLAY (f
),
1295 XINT (Vx_mode_pointer_shape
));
1298 mode_cursor
= XCreateFontCursor (FRAME_X_DISPLAY (f
), XC_xterm
);
1299 x_check_errors (FRAME_X_DISPLAY (f
), "bad modeline pointer cursor: %s");
1301 if (!EQ (Qnil
, Vx_sensitive_text_pointer_shape
))
1303 CHECK_NUMBER (Vx_sensitive_text_pointer_shape
, 0);
1305 = XCreateFontCursor (FRAME_X_DISPLAY (f
),
1306 XINT (Vx_sensitive_text_pointer_shape
));
1309 cross_cursor
= XCreateFontCursor (FRAME_X_DISPLAY (f
), XC_crosshair
);
1311 /* Check and report errors with the above calls. */
1312 x_check_errors (FRAME_X_DISPLAY (f
), "can't set cursor shape: %s");
1313 x_uncatch_errors (FRAME_X_DISPLAY (f
));
1316 XColor fore_color
, back_color
;
1318 fore_color
.pixel
= f
->output_data
.x
->mouse_pixel
;
1319 back_color
.pixel
= mask_color
;
1320 XQueryColor (FRAME_X_DISPLAY (f
),
1321 DefaultColormap (FRAME_X_DISPLAY (f
),
1322 DefaultScreen (FRAME_X_DISPLAY (f
))),
1324 XQueryColor (FRAME_X_DISPLAY (f
),
1325 DefaultColormap (FRAME_X_DISPLAY (f
),
1326 DefaultScreen (FRAME_X_DISPLAY (f
))),
1328 XRecolorCursor (FRAME_X_DISPLAY (f
), cursor
,
1329 &fore_color
, &back_color
);
1330 XRecolorCursor (FRAME_X_DISPLAY (f
), nontext_cursor
,
1331 &fore_color
, &back_color
);
1332 XRecolorCursor (FRAME_X_DISPLAY (f
), mode_cursor
,
1333 &fore_color
, &back_color
);
1334 XRecolorCursor (FRAME_X_DISPLAY (f
), cross_cursor
,
1335 &fore_color
, &back_color
);
1338 if (FRAME_X_WINDOW (f
) != 0)
1340 XDefineCursor (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
), cursor
);
1343 if (cursor
!= f
->output_data
.x
->text_cursor
&& f
->output_data
.x
->text_cursor
!= 0)
1344 XFreeCursor (FRAME_X_DISPLAY (f
), f
->output_data
.x
->text_cursor
);
1345 f
->output_data
.x
->text_cursor
= cursor
;
1347 if (nontext_cursor
!= f
->output_data
.x
->nontext_cursor
1348 && f
->output_data
.x
->nontext_cursor
!= 0)
1349 XFreeCursor (FRAME_X_DISPLAY (f
), f
->output_data
.x
->nontext_cursor
);
1350 f
->output_data
.x
->nontext_cursor
= nontext_cursor
;
1352 if (mode_cursor
!= f
->output_data
.x
->modeline_cursor
1353 && f
->output_data
.x
->modeline_cursor
!= 0)
1354 XFreeCursor (FRAME_X_DISPLAY (f
), f
->output_data
.x
->modeline_cursor
);
1355 f
->output_data
.x
->modeline_cursor
= mode_cursor
;
1356 if (cross_cursor
!= f
->output_data
.x
->cross_cursor
1357 && f
->output_data
.x
->cross_cursor
!= 0)
1358 XFreeCursor (FRAME_X_DISPLAY (f
), f
->output_data
.x
->cross_cursor
);
1359 f
->output_data
.x
->cross_cursor
= cross_cursor
;
1361 XFlush (FRAME_X_DISPLAY (f
));
1366 x_set_cursor_color (f
, arg
, oldval
)
1368 Lisp_Object arg
, oldval
;
1370 unsigned long fore_pixel
;
1372 if (!EQ (Vx_cursor_fore_pixel
, Qnil
))
1373 fore_pixel
= x_decode_color (f
, Vx_cursor_fore_pixel
,
1374 WHITE_PIX_DEFAULT (f
));
1376 fore_pixel
= f
->output_data
.x
->background_pixel
;
1377 f
->output_data
.x
->cursor_pixel
= x_decode_color (f
, arg
, BLACK_PIX_DEFAULT (f
));
1379 /* Make sure that the cursor color differs from the background color. */
1380 if (f
->output_data
.x
->cursor_pixel
== f
->output_data
.x
->background_pixel
)
1382 f
->output_data
.x
->cursor_pixel
= f
->output_data
.x
->mouse_pixel
;
1383 if (f
->output_data
.x
->cursor_pixel
== fore_pixel
)
1384 fore_pixel
= f
->output_data
.x
->background_pixel
;
1386 f
->output_data
.x
->cursor_foreground_pixel
= fore_pixel
;
1388 if (FRAME_X_WINDOW (f
) != 0)
1391 XSetBackground (FRAME_X_DISPLAY (f
), f
->output_data
.x
->cursor_gc
,
1392 f
->output_data
.x
->cursor_pixel
);
1393 XSetForeground (FRAME_X_DISPLAY (f
), f
->output_data
.x
->cursor_gc
,
1397 if (FRAME_VISIBLE_P (f
))
1399 x_display_cursor (f
, 0);
1400 x_display_cursor (f
, 1);
1405 /* Set the border-color of frame F to value described by ARG.
1406 ARG can be a string naming a color.
1407 The border-color is used for the border that is drawn by the X server.
1408 Note that this does not fully take effect if done before
1409 F has an x-window; it must be redone when the window is created.
1411 Note: this is done in two routines because of the way X10 works.
1413 Note: under X11, this is normally the province of the window manager,
1414 and so emacs' border colors may be overridden. */
1417 x_set_border_color (f
, arg
, oldval
)
1419 Lisp_Object arg
, oldval
;
1424 CHECK_STRING (arg
, 0);
1425 str
= XSTRING (arg
)->data
;
1427 pix
= x_decode_color (f
, arg
, BLACK_PIX_DEFAULT (f
));
1429 x_set_border_pixel (f
, pix
);
1432 /* Set the border-color of frame F to pixel value PIX.
1433 Note that this does not fully take effect if done before
1434 F has an x-window. */
1436 x_set_border_pixel (f
, pix
)
1440 f
->output_data
.x
->border_pixel
= pix
;
1442 if (FRAME_X_WINDOW (f
) != 0 && f
->output_data
.x
->border_width
> 0)
1448 XSetWindowBorder (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
1449 (unsigned long)pix
);
1452 if (FRAME_VISIBLE_P (f
))
1458 x_set_cursor_type (f
, arg
, oldval
)
1460 Lisp_Object arg
, oldval
;
1464 FRAME_DESIRED_CURSOR (f
) = bar_cursor
;
1465 f
->output_data
.x
->cursor_width
= 2;
1467 else if (CONSP (arg
) && EQ (XCONS (arg
)->car
, Qbar
)
1468 && INTEGERP (XCONS (arg
)->cdr
))
1470 FRAME_DESIRED_CURSOR (f
) = bar_cursor
;
1471 f
->output_data
.x
->cursor_width
= XINT (XCONS (arg
)->cdr
);
1474 /* Treat anything unknown as "box cursor".
1475 It was bad to signal an error; people have trouble fixing
1476 .Xdefaults with Emacs, when it has something bad in it. */
1477 FRAME_DESIRED_CURSOR (f
) = filled_box_cursor
;
1479 /* Make sure the cursor gets redrawn. This is overkill, but how
1480 often do people change cursor types? */
1481 update_mode_lines
++;
1485 x_set_icon_type (f
, arg
, oldval
)
1487 Lisp_Object arg
, oldval
;
1494 if (STRINGP (oldval
) && EQ (Fstring_equal (oldval
, arg
), Qt
))
1497 else if (!STRINGP (oldval
) && EQ (oldval
, Qnil
) == EQ (arg
, Qnil
))
1502 result
= x_text_icon (f
,
1503 (char *) XSTRING ((!NILP (f
->icon_name
)
1507 result
= x_bitmap_icon (f
, arg
);
1512 error ("No icon window available");
1515 XFlush (FRAME_X_DISPLAY (f
));
1519 /* Return non-nil if frame F wants a bitmap icon. */
1527 tem
= assq_no_quit (Qicon_type
, f
->param_alist
);
1529 return XCONS (tem
)->cdr
;
1535 x_set_icon_name (f
, arg
, oldval
)
1537 Lisp_Object arg
, oldval
;
1544 if (STRINGP (oldval
) && EQ (Fstring_equal (oldval
, arg
), Qt
))
1547 else if (!STRINGP (oldval
) && EQ (oldval
, Qnil
) == EQ (arg
, Qnil
))
1552 if (f
->output_data
.x
->icon_bitmap
!= 0)
1557 result
= x_text_icon (f
,
1558 (char *) XSTRING ((!NILP (f
->icon_name
)
1565 error ("No icon window available");
1568 XFlush (FRAME_X_DISPLAY (f
));
1572 extern Lisp_Object
x_new_font ();
1575 x_set_font (f
, arg
, oldval
)
1577 Lisp_Object arg
, oldval
;
1581 CHECK_STRING (arg
, 1);
1584 result
= x_new_font (f
, XSTRING (arg
)->data
);
1587 if (EQ (result
, Qnil
))
1588 error ("Font `%s' is not defined", XSTRING (arg
)->data
);
1589 else if (EQ (result
, Qt
))
1590 error ("the characters of the given font have varying widths");
1591 else if (STRINGP (result
))
1593 recompute_basic_faces (f
);
1594 store_frame_param (f
, Qfont
, result
);
1601 x_set_border_width (f
, arg
, oldval
)
1603 Lisp_Object arg
, oldval
;
1605 CHECK_NUMBER (arg
, 0);
1607 if (XINT (arg
) == f
->output_data
.x
->border_width
)
1610 if (FRAME_X_WINDOW (f
) != 0)
1611 error ("Cannot change the border width of a window");
1613 f
->output_data
.x
->border_width
= XINT (arg
);
1617 x_set_internal_border_width (f
, arg
, oldval
)
1619 Lisp_Object arg
, oldval
;
1622 int old
= f
->output_data
.x
->internal_border_width
;
1624 CHECK_NUMBER (arg
, 0);
1625 f
->output_data
.x
->internal_border_width
= XINT (arg
);
1626 if (f
->output_data
.x
->internal_border_width
< 0)
1627 f
->output_data
.x
->internal_border_width
= 0;
1629 if (f
->output_data
.x
->internal_border_width
== old
)
1632 if (FRAME_X_WINDOW (f
) != 0)
1635 x_set_window_size (f
, 0, f
->width
, f
->height
);
1637 x_set_resize_hint (f
);
1639 XFlush (FRAME_X_DISPLAY (f
));
1641 SET_FRAME_GARBAGED (f
);
1646 x_set_visibility (f
, value
, oldval
)
1648 Lisp_Object value
, oldval
;
1651 XSETFRAME (frame
, f
);
1654 Fmake_frame_invisible (frame
, Qt
);
1655 else if (EQ (value
, Qicon
))
1656 Ficonify_frame (frame
);
1658 Fmake_frame_visible (frame
);
1662 x_set_menu_bar_lines_1 (window
, n
)
1666 struct window
*w
= XWINDOW (window
);
1668 XSETFASTINT (w
->top
, XFASTINT (w
->top
) + n
);
1669 XSETFASTINT (w
->height
, XFASTINT (w
->height
) - n
);
1671 /* Handle just the top child in a vertical split. */
1672 if (!NILP (w
->vchild
))
1673 x_set_menu_bar_lines_1 (w
->vchild
, n
);
1675 /* Adjust all children in a horizontal split. */
1676 for (window
= w
->hchild
; !NILP (window
); window
= w
->next
)
1678 w
= XWINDOW (window
);
1679 x_set_menu_bar_lines_1 (window
, n
);
1684 x_set_menu_bar_lines (f
, value
, oldval
)
1686 Lisp_Object value
, oldval
;
1689 int olines
= FRAME_MENU_BAR_LINES (f
);
1691 /* Right now, menu bars don't work properly in minibuf-only frames;
1692 most of the commands try to apply themselves to the minibuffer
1693 frame itslef, and get an error because you can't switch buffers
1694 in or split the minibuffer window. */
1695 if (FRAME_MINIBUF_ONLY_P (f
))
1698 if (INTEGERP (value
))
1699 nlines
= XINT (value
);
1703 #ifdef USE_X_TOOLKIT
1704 FRAME_MENU_BAR_LINES (f
) = 0;
1707 FRAME_EXTERNAL_MENU_BAR (f
) = 1;
1708 if (FRAME_X_P (f
) && f
->output_data
.x
->menubar_widget
== 0)
1709 /* Make sure next redisplay shows the menu bar. */
1710 XWINDOW (FRAME_SELECTED_WINDOW (f
))->update_mode_line
= Qt
;
1714 if (FRAME_EXTERNAL_MENU_BAR (f
) == 1)
1715 free_frame_menubar (f
);
1716 FRAME_EXTERNAL_MENU_BAR (f
) = 0;
1718 f
->output_data
.x
->menubar_widget
= 0;
1720 #else /* not USE_X_TOOLKIT */
1721 FRAME_MENU_BAR_LINES (f
) = nlines
;
1722 x_set_menu_bar_lines_1 (f
->root_window
, nlines
- olines
);
1723 #endif /* not USE_X_TOOLKIT */
1726 /* Change the name of frame F to NAME. If NAME is nil, set F's name to
1729 If EXPLICIT is non-zero, that indicates that lisp code is setting the
1730 name; if NAME is a string, set F's name to NAME and set
1731 F->explicit_name; if NAME is Qnil, then clear F->explicit_name.
1733 If EXPLICIT is zero, that indicates that Emacs redisplay code is
1734 suggesting a new name, which lisp code should override; if
1735 F->explicit_name is set, ignore the new name; otherwise, set it. */
1738 x_set_name (f
, name
, explicit)
1743 /* Make sure that requests from lisp code override requests from
1744 Emacs redisplay code. */
1747 /* If we're switching from explicit to implicit, we had better
1748 update the mode lines and thereby update the title. */
1749 if (f
->explicit_name
&& NILP (name
))
1750 update_mode_lines
= 1;
1752 f
->explicit_name
= ! NILP (name
);
1754 else if (f
->explicit_name
)
1757 /* If NAME is nil, set the name to the x_id_name. */
1760 /* Check for no change needed in this very common case
1761 before we do any consing. */
1762 if (!strcmp (FRAME_X_DISPLAY_INFO (f
)->x_id_name
,
1763 XSTRING (f
->name
)->data
))
1765 name
= build_string (FRAME_X_DISPLAY_INFO (f
)->x_id_name
);
1768 CHECK_STRING (name
, 0);
1770 /* Don't change the name if it's already NAME. */
1771 if (! NILP (Fstring_equal (name
, f
->name
)))
1774 if (FRAME_X_WINDOW (f
))
1779 XTextProperty text
, icon
;
1780 Lisp_Object icon_name
;
1782 text
.value
= XSTRING (name
)->data
;
1783 text
.encoding
= XA_STRING
;
1785 text
.nitems
= XSTRING (name
)->size
;
1787 icon_name
= (!NILP (f
->icon_name
) ? f
->icon_name
: name
);
1789 icon
.value
= XSTRING (icon_name
)->data
;
1790 icon
.encoding
= XA_STRING
;
1792 icon
.nitems
= XSTRING (icon_name
)->size
;
1793 #ifdef USE_X_TOOLKIT
1794 XSetWMName (FRAME_X_DISPLAY (f
),
1795 XtWindow (f
->output_data
.x
->widget
), &text
);
1796 XSetWMIconName (FRAME_X_DISPLAY (f
), XtWindow (f
->output_data
.x
->widget
),
1798 #else /* not USE_X_TOOLKIT */
1799 XSetWMName (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
), &text
);
1800 XSetWMIconName (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
), &icon
);
1801 #endif /* not USE_X_TOOLKIT */
1803 #else /* not HAVE_X11R4 */
1804 XSetIconName (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
1805 XSTRING (name
)->data
);
1806 XStoreName (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
1807 XSTRING (name
)->data
);
1808 #endif /* not HAVE_X11R4 */
1815 /* This function should be called when the user's lisp code has
1816 specified a name for the frame; the name will override any set by the
1819 x_explicitly_set_name (f
, arg
, oldval
)
1821 Lisp_Object arg
, oldval
;
1823 x_set_name (f
, arg
, 1);
1826 /* This function should be called by Emacs redisplay code to set the
1827 name; names set this way will never override names set by the user's
1830 x_implicitly_set_name (f
, arg
, oldval
)
1832 Lisp_Object arg
, oldval
;
1834 x_set_name (f
, arg
, 0);
1838 x_set_autoraise (f
, arg
, oldval
)
1840 Lisp_Object arg
, oldval
;
1842 f
->auto_raise
= !EQ (Qnil
, arg
);
1846 x_set_autolower (f
, arg
, oldval
)
1848 Lisp_Object arg
, oldval
;
1850 f
->auto_lower
= !EQ (Qnil
, arg
);
1854 x_set_unsplittable (f
, arg
, oldval
)
1856 Lisp_Object arg
, oldval
;
1858 f
->no_split
= !NILP (arg
);
1862 x_set_vertical_scroll_bars (f
, arg
, oldval
)
1864 Lisp_Object arg
, oldval
;
1866 if (NILP (arg
) != ! FRAME_HAS_VERTICAL_SCROLL_BARS (f
))
1868 FRAME_HAS_VERTICAL_SCROLL_BARS (f
) = ! NILP (arg
);
1870 /* We set this parameter before creating the X window for the
1871 frame, so we can get the geometry right from the start.
1872 However, if the window hasn't been created yet, we shouldn't
1873 call x_set_window_size. */
1874 if (FRAME_X_WINDOW (f
))
1875 x_set_window_size (f
, 0, FRAME_WIDTH (f
), FRAME_HEIGHT (f
));
1880 x_set_scroll_bar_width (f
, arg
, oldval
)
1882 Lisp_Object arg
, oldval
;
1886 FRAME_SCROLL_BAR_PIXEL_WIDTH (f
) = 0;
1887 FRAME_SCROLL_BAR_COLS (f
) = 2;
1889 else if (INTEGERP (arg
) && XINT (arg
) > 0
1890 && XFASTINT (arg
) != FRAME_SCROLL_BAR_PIXEL_WIDTH (f
))
1892 int wid
= FONT_WIDTH (f
->output_data
.x
->font
);
1893 FRAME_SCROLL_BAR_PIXEL_WIDTH (f
) = XFASTINT (arg
);
1894 FRAME_SCROLL_BAR_COLS (f
) = (XFASTINT (arg
) + wid
-1) / wid
;
1895 if (FRAME_X_WINDOW (f
))
1896 x_set_window_size (f
, 0, FRAME_WIDTH (f
), FRAME_HEIGHT (f
));
1900 /* Subroutines of creating an X frame. */
1902 /* Make sure that Vx_resource_name is set to a reasonable value.
1903 Fix it up, or set it to `emacs' if it is too hopeless. */
1906 validate_x_resource_name ()
1909 /* Number of valid characters in the resource name. */
1911 /* Number of invalid characters in the resource name. */
1916 if (STRINGP (Vx_resource_name
))
1918 unsigned char *p
= XSTRING (Vx_resource_name
)->data
;
1921 len
= XSTRING (Vx_resource_name
)->size
;
1923 /* Only letters, digits, - and _ are valid in resource names.
1924 Count the valid characters and count the invalid ones. */
1925 for (i
= 0; i
< len
; i
++)
1928 if (! ((c
>= 'a' && c
<= 'z')
1929 || (c
>= 'A' && c
<= 'Z')
1930 || (c
>= '0' && c
<= '9')
1931 || c
== '-' || c
== '_'))
1938 /* Not a string => completely invalid. */
1939 bad_count
= 5, good_count
= 0;
1941 /* If name is valid already, return. */
1945 /* If name is entirely invalid, or nearly so, use `emacs'. */
1947 || (good_count
== 1 && bad_count
> 0))
1949 Vx_resource_name
= build_string ("emacs");
1953 /* Name is partly valid. Copy it and replace the invalid characters
1954 with underscores. */
1956 Vx_resource_name
= new = Fcopy_sequence (Vx_resource_name
);
1958 for (i
= 0; i
< len
; i
++)
1960 int c
= XSTRING (new)->data
[i
];
1961 if (! ((c
>= 'a' && c
<= 'z')
1962 || (c
>= 'A' && c
<= 'Z')
1963 || (c
>= '0' && c
<= '9')
1964 || c
== '-' || c
== '_'))
1965 XSTRING (new)->data
[i
] = '_';
1970 extern char *x_get_string_resource ();
1972 DEFUN ("x-get-resource", Fx_get_resource
, Sx_get_resource
, 2, 4, 0,
1973 "Return the value of ATTRIBUTE, of class CLASS, from the X defaults database.\n\
1974 This uses `INSTANCE.ATTRIBUTE' as the key and `Emacs.CLASS' as the\n\
1975 class, where INSTANCE is the name under which Emacs was invoked, or\n\
1976 the name specified by the `-name' or `-rn' command-line arguments.\n\
1978 The optional arguments COMPONENT and SUBCLASS add to the key and the\n\
1979 class, respectively. You must specify both of them or neither.\n\
1980 If you specify them, the key is `INSTANCE.COMPONENT.ATTRIBUTE'\n\
1981 and the class is `Emacs.CLASS.SUBCLASS'.")
1982 (attribute
, class, component
, subclass
)
1983 Lisp_Object attribute
, class, component
, subclass
;
1985 register char *value
;
1991 CHECK_STRING (attribute
, 0);
1992 CHECK_STRING (class, 0);
1994 if (!NILP (component
))
1995 CHECK_STRING (component
, 1);
1996 if (!NILP (subclass
))
1997 CHECK_STRING (subclass
, 2);
1998 if (NILP (component
) != NILP (subclass
))
1999 error ("x-get-resource: must specify both COMPONENT and SUBCLASS or neither");
2001 validate_x_resource_name ();
2003 /* Allocate space for the components, the dots which separate them,
2004 and the final '\0'. Make them big enough for the worst case. */
2005 name_key
= (char *) alloca (XSTRING (Vx_resource_name
)->size
2006 + (STRINGP (component
)
2007 ? XSTRING (component
)->size
: 0)
2008 + XSTRING (attribute
)->size
2011 class_key
= (char *) alloca ((sizeof (EMACS_CLASS
) - 1)
2012 + XSTRING (class)->size
2013 + (STRINGP (subclass
)
2014 ? XSTRING (subclass
)->size
: 0)
2017 /* Start with emacs.FRAMENAME for the name (the specific one)
2018 and with `Emacs' for the class key (the general one). */
2019 strcpy (name_key
, XSTRING (Vx_resource_name
)->data
);
2020 strcpy (class_key
, EMACS_CLASS
);
2022 strcat (class_key
, ".");
2023 strcat (class_key
, XSTRING (class)->data
);
2025 if (!NILP (component
))
2027 strcat (class_key
, ".");
2028 strcat (class_key
, XSTRING (subclass
)->data
);
2030 strcat (name_key
, ".");
2031 strcat (name_key
, XSTRING (component
)->data
);
2034 strcat (name_key
, ".");
2035 strcat (name_key
, XSTRING (attribute
)->data
);
2037 value
= x_get_string_resource (check_x_display_info (Qnil
)->xrdb
,
2038 name_key
, class_key
);
2040 if (value
!= (char *) 0)
2041 return build_string (value
);
2046 /* Used when C code wants a resource value. */
2049 x_get_resource_string (attribute
, class)
2050 char *attribute
, *class;
2052 register char *value
;
2056 /* Allocate space for the components, the dots which separate them,
2057 and the final '\0'. */
2058 name_key
= (char *) alloca (XSTRING (Vinvocation_name
)->size
2059 + strlen (attribute
) + 2);
2060 class_key
= (char *) alloca ((sizeof (EMACS_CLASS
) - 1)
2061 + strlen (class) + 2);
2063 sprintf (name_key
, "%s.%s",
2064 XSTRING (Vinvocation_name
)->data
,
2066 sprintf (class_key
, "%s.%s", EMACS_CLASS
, class);
2068 return x_get_string_resource (FRAME_X_DISPLAY_INFO (selected_frame
)->xrdb
,
2069 name_key
, class_key
);
2072 /* Types we might convert a resource string into. */
2075 number
, boolean
, string
, symbol
2078 /* Return the value of parameter PARAM.
2080 First search ALIST, then Vdefault_frame_alist, then the X defaults
2081 database, using ATTRIBUTE as the attribute name and CLASS as its class.
2083 Convert the resource to the type specified by desired_type.
2085 If no default is specified, return Qunbound. If you call
2086 x_get_arg, make sure you deal with Qunbound in a reasonable way,
2087 and don't let it get stored in any Lisp-visible variables! */
2090 x_get_arg (alist
, param
, attribute
, class, type
)
2091 Lisp_Object alist
, param
;
2094 enum resource_types type
;
2096 register Lisp_Object tem
;
2098 tem
= Fassq (param
, alist
);
2100 tem
= Fassq (param
, Vdefault_frame_alist
);
2106 tem
= Fx_get_resource (build_string (attribute
),
2107 build_string (class),
2116 return make_number (atoi (XSTRING (tem
)->data
));
2119 tem
= Fdowncase (tem
);
2120 if (!strcmp (XSTRING (tem
)->data
, "on")
2121 || !strcmp (XSTRING (tem
)->data
, "true"))
2130 /* As a special case, we map the values `true' and `on'
2131 to Qt, and `false' and `off' to Qnil. */
2134 lower
= Fdowncase (tem
);
2135 if (!strcmp (XSTRING (lower
)->data
, "on")
2136 || !strcmp (XSTRING (lower
)->data
, "true"))
2138 else if (!strcmp (XSTRING (lower
)->data
, "off")
2139 || !strcmp (XSTRING (lower
)->data
, "false"))
2142 return Fintern (tem
, Qnil
);
2155 /* Record in frame F the specified or default value according to ALIST
2156 of the parameter named PARAM (a Lisp symbol).
2157 If no value is specified for PARAM, look for an X default for XPROP
2158 on the frame named NAME.
2159 If that is not found either, use the value DEFLT. */
2162 x_default_parameter (f
, alist
, prop
, deflt
, xprop
, xclass
, type
)
2169 enum resource_types type
;
2173 tem
= x_get_arg (alist
, prop
, xprop
, xclass
, type
);
2174 if (EQ (tem
, Qunbound
))
2176 x_set_frame_parameters (f
, Fcons (Fcons (prop
, tem
), Qnil
));
2180 DEFUN ("x-parse-geometry", Fx_parse_geometry
, Sx_parse_geometry
, 1, 1, 0,
2181 "Parse an X-style geometry string STRING.\n\
2182 Returns an alist of the form ((top . TOP), (left . LEFT) ... ).\n\
2183 The properties returned may include `top', `left', `height', and `width'.\n\
2184 The value of `left' or `top' may be an integer,\n\
2185 or a list (+ N) meaning N pixels relative to top/left corner,\n\
2186 or a list (- N) meaning -N pixels relative to bottom/right corner.")
2191 unsigned int width
, height
;
2194 CHECK_STRING (string
, 0);
2196 geometry
= XParseGeometry ((char *) XSTRING (string
)->data
,
2197 &x
, &y
, &width
, &height
);
2200 if (!!(geometry
& XValue
) != !!(geometry
& YValue
))
2201 error ("Must specify both x and y position, or neither");
2205 if (geometry
& XValue
)
2207 Lisp_Object element
;
2209 if (x
>= 0 && (geometry
& XNegative
))
2210 element
= Fcons (Qleft
, Fcons (Qminus
, Fcons (make_number (-x
), Qnil
)));
2211 else if (x
< 0 && ! (geometry
& XNegative
))
2212 element
= Fcons (Qleft
, Fcons (Qplus
, Fcons (make_number (x
), Qnil
)));
2214 element
= Fcons (Qleft
, make_number (x
));
2215 result
= Fcons (element
, result
);
2218 if (geometry
& YValue
)
2220 Lisp_Object element
;
2222 if (y
>= 0 && (geometry
& YNegative
))
2223 element
= Fcons (Qtop
, Fcons (Qminus
, Fcons (make_number (-y
), Qnil
)));
2224 else if (y
< 0 && ! (geometry
& YNegative
))
2225 element
= Fcons (Qtop
, Fcons (Qplus
, Fcons (make_number (y
), Qnil
)));
2227 element
= Fcons (Qtop
, make_number (y
));
2228 result
= Fcons (element
, result
);
2231 if (geometry
& WidthValue
)
2232 result
= Fcons (Fcons (Qwidth
, make_number (width
)), result
);
2233 if (geometry
& HeightValue
)
2234 result
= Fcons (Fcons (Qheight
, make_number (height
)), result
);
2239 /* Calculate the desired size and position of this window,
2240 and return the flags saying which aspects were specified.
2242 This function does not make the coordinates positive. */
2244 #define DEFAULT_ROWS 40
2245 #define DEFAULT_COLS 80
2248 x_figure_window_size (f
, parms
)
2252 register Lisp_Object tem0
, tem1
, tem2
;
2253 int height
, width
, left
, top
;
2254 register int geometry
;
2255 long window_prompting
= 0;
2257 /* Default values if we fall through.
2258 Actually, if that happens we should get
2259 window manager prompting. */
2260 f
->width
= DEFAULT_COLS
;
2261 f
->height
= DEFAULT_ROWS
;
2262 /* Window managers expect that if program-specified
2263 positions are not (0,0), they're intentional, not defaults. */
2264 f
->output_data
.x
->top_pos
= 0;
2265 f
->output_data
.x
->left_pos
= 0;
2267 tem0
= x_get_arg (parms
, Qheight
, 0, 0, number
);
2268 tem1
= x_get_arg (parms
, Qwidth
, 0, 0, number
);
2269 tem2
= x_get_arg (parms
, Quser_size
, 0, 0, number
);
2270 if (! EQ (tem0
, Qunbound
) || ! EQ (tem1
, Qunbound
))
2272 if (!EQ (tem0
, Qunbound
))
2274 CHECK_NUMBER (tem0
, 0);
2275 f
->height
= XINT (tem0
);
2277 if (!EQ (tem1
, Qunbound
))
2279 CHECK_NUMBER (tem1
, 0);
2280 f
->width
= XINT (tem1
);
2282 if (!NILP (tem2
) && !EQ (tem2
, Qunbound
))
2283 window_prompting
|= USSize
;
2285 window_prompting
|= PSize
;
2288 f
->output_data
.x
->vertical_scroll_bar_extra
2289 = (!FRAME_HAS_VERTICAL_SCROLL_BARS (f
)
2291 : FRAME_SCROLL_BAR_PIXEL_WIDTH (f
) > 0
2292 ? FRAME_SCROLL_BAR_PIXEL_WIDTH (f
)
2293 : (FRAME_SCROLL_BAR_COLS (f
) * FONT_WIDTH (f
->output_data
.x
->font
)));
2294 f
->output_data
.x
->pixel_width
= CHAR_TO_PIXEL_WIDTH (f
, f
->width
);
2295 f
->output_data
.x
->pixel_height
= CHAR_TO_PIXEL_HEIGHT (f
, f
->height
);
2297 tem0
= x_get_arg (parms
, Qtop
, 0, 0, number
);
2298 tem1
= x_get_arg (parms
, Qleft
, 0, 0, number
);
2299 tem2
= x_get_arg (parms
, Quser_position
, 0, 0, number
);
2300 if (! EQ (tem0
, Qunbound
) || ! EQ (tem1
, Qunbound
))
2302 if (EQ (tem0
, Qminus
))
2304 f
->output_data
.x
->top_pos
= 0;
2305 window_prompting
|= YNegative
;
2307 else if (CONSP (tem0
) && EQ (XCONS (tem0
)->car
, Qminus
)
2308 && CONSP (XCONS (tem0
)->cdr
)
2309 && INTEGERP (XCONS (XCONS (tem0
)->cdr
)->car
))
2311 f
->output_data
.x
->top_pos
= - XINT (XCONS (XCONS (tem0
)->cdr
)->car
);
2312 window_prompting
|= YNegative
;
2314 else if (CONSP (tem0
) && EQ (XCONS (tem0
)->car
, Qplus
)
2315 && CONSP (XCONS (tem0
)->cdr
)
2316 && INTEGERP (XCONS (XCONS (tem0
)->cdr
)->car
))
2318 f
->output_data
.x
->top_pos
= XINT (XCONS (XCONS (tem0
)->cdr
)->car
);
2320 else if (EQ (tem0
, Qunbound
))
2321 f
->output_data
.x
->top_pos
= 0;
2324 CHECK_NUMBER (tem0
, 0);
2325 f
->output_data
.x
->top_pos
= XINT (tem0
);
2326 if (f
->output_data
.x
->top_pos
< 0)
2327 window_prompting
|= YNegative
;
2330 if (EQ (tem1
, Qminus
))
2332 f
->output_data
.x
->left_pos
= 0;
2333 window_prompting
|= XNegative
;
2335 else if (CONSP (tem1
) && EQ (XCONS (tem1
)->car
, Qminus
)
2336 && CONSP (XCONS (tem1
)->cdr
)
2337 && INTEGERP (XCONS (XCONS (tem1
)->cdr
)->car
))
2339 f
->output_data
.x
->left_pos
= - XINT (XCONS (XCONS (tem1
)->cdr
)->car
);
2340 window_prompting
|= XNegative
;
2342 else if (CONSP (tem1
) && EQ (XCONS (tem1
)->car
, Qplus
)
2343 && CONSP (XCONS (tem1
)->cdr
)
2344 && INTEGERP (XCONS (XCONS (tem1
)->cdr
)->car
))
2346 f
->output_data
.x
->left_pos
= XINT (XCONS (XCONS (tem1
)->cdr
)->car
);
2348 else if (EQ (tem1
, Qunbound
))
2349 f
->output_data
.x
->left_pos
= 0;
2352 CHECK_NUMBER (tem1
, 0);
2353 f
->output_data
.x
->left_pos
= XINT (tem1
);
2354 if (f
->output_data
.x
->left_pos
< 0)
2355 window_prompting
|= XNegative
;
2358 if (!NILP (tem2
) && ! EQ (tem2
, Qunbound
))
2359 window_prompting
|= USPosition
;
2361 window_prompting
|= PPosition
;
2364 return window_prompting
;
2367 #if !defined (HAVE_X11R4) && !defined (HAVE_XSETWMPROTOCOLS)
2370 XSetWMProtocols (dpy
, w
, protocols
, count
)
2377 prop
= XInternAtom (dpy
, "WM_PROTOCOLS", False
);
2378 if (prop
== None
) return False
;
2379 XChangeProperty (dpy
, w
, prop
, XA_ATOM
, 32, PropModeReplace
,
2380 (unsigned char *) protocols
, count
);
2383 #endif /* not HAVE_X11R4 && not HAVE_XSETWMPROTOCOLS */
2385 #ifdef USE_X_TOOLKIT
2387 /* If the WM_PROTOCOLS property does not already contain WM_TAKE_FOCUS,
2388 WM_DELETE_WINDOW, and WM_SAVE_YOURSELF, then add them. (They may
2389 already be present because of the toolkit (Motif adds some of them,
2390 for example, but Xt doesn't). */
2393 hack_wm_protocols (f
, widget
)
2397 Display
*dpy
= XtDisplay (widget
);
2398 Window w
= XtWindow (widget
);
2399 int need_delete
= 1;
2405 Atom type
, *atoms
= 0;
2407 unsigned long nitems
= 0;
2408 unsigned long bytes_after
;
2410 if ((XGetWindowProperty (dpy
, w
,
2411 FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_protocols
,
2412 (long)0, (long)100, False
, XA_ATOM
,
2413 &type
, &format
, &nitems
, &bytes_after
,
2414 (unsigned char **) &atoms
)
2416 && format
== 32 && type
== XA_ATOM
)
2420 if (atoms
[nitems
] == FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_delete_window
)
2422 else if (atoms
[nitems
] == FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_take_focus
)
2424 else if (atoms
[nitems
] == FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_save_yourself
)
2427 if (atoms
) XFree ((char *) atoms
);
2433 props
[count
++] = FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_delete_window
;
2435 props
[count
++] = FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_take_focus
;
2437 props
[count
++] = FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_save_yourself
;
2439 XChangeProperty (dpy
, w
, FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_protocols
,
2440 XA_ATOM
, 32, PropModeAppend
,
2441 (unsigned char *) props
, count
);
2447 #ifdef USE_X_TOOLKIT
2449 /* Create and set up the X widget for frame F. */
2452 x_window (f
, window_prompting
, minibuffer_only
)
2454 long window_prompting
;
2455 int minibuffer_only
;
2457 XClassHint class_hints
;
2458 XSetWindowAttributes attributes
;
2459 unsigned long attribute_mask
;
2461 Widget shell_widget
;
2463 Widget frame_widget
;
2469 /* Use the resource name as the top-level widget name
2470 for looking up resources. Make a non-Lisp copy
2471 for the window manager, so GC relocation won't bother it.
2473 Elsewhere we specify the window name for the window manager. */
2476 char *str
= (char *) XSTRING (Vx_resource_name
)->data
;
2477 f
->namebuf
= (char *) xmalloc (strlen (str
) + 1);
2478 strcpy (f
->namebuf
, str
);
2482 XtSetArg (al
[ac
], XtNallowShellResize
, 1); ac
++;
2483 XtSetArg (al
[ac
], XtNinput
, 1); ac
++;
2484 XtSetArg (al
[ac
], XtNmappedWhenManaged
, 0); ac
++;
2485 XtSetArg (al
[ac
], XtNborderWidth
, f
->output_data
.x
->border_width
); ac
++;
2486 shell_widget
= XtAppCreateShell (f
->namebuf
, EMACS_CLASS
,
2487 applicationShellWidgetClass
,
2488 FRAME_X_DISPLAY (f
), al
, ac
);
2490 f
->output_data
.x
->widget
= shell_widget
;
2491 /* maybe_set_screen_title_format (shell_widget); */
2493 pane_widget
= lw_create_widget ("main", "pane", widget_id_tick
++,
2494 (widget_value
*) NULL
,
2495 shell_widget
, False
,
2498 (lw_callback
) NULL
);
2500 f
->output_data
.x
->column_widget
= pane_widget
;
2502 /* mappedWhenManaged to false tells to the paned window to not map/unmap
2503 the emacs screen when changing menubar. This reduces flickering. */
2506 XtSetArg (al
[ac
], XtNmappedWhenManaged
, 0); ac
++;
2507 XtSetArg (al
[ac
], XtNshowGrip
, 0); ac
++;
2508 XtSetArg (al
[ac
], XtNallowResize
, 1); ac
++;
2509 XtSetArg (al
[ac
], XtNresizeToPreferred
, 1); ac
++;
2510 XtSetArg (al
[ac
], XtNemacsFrame
, f
); ac
++;
2511 frame_widget
= XtCreateWidget (f
->namebuf
,
2513 pane_widget
, al
, ac
);
2515 f
->output_data
.x
->edit_widget
= frame_widget
;
2517 XtManageChild (frame_widget
);
2519 /* Do some needed geometry management. */
2522 char *tem
, shell_position
[32];
2525 int extra_borders
= 0;
2527 = (f
->output_data
.x
->menubar_widget
2528 ? (f
->output_data
.x
->menubar_widget
->core
.height
2529 + f
->output_data
.x
->menubar_widget
->core
.border_width
)
2531 extern char *lwlib_toolkit_type
;
2533 if (FRAME_EXTERNAL_MENU_BAR (f
))
2536 XtVaGetValues (pane_widget
, XtNinternalBorderWidth
, &ibw
, NULL
);
2537 menubar_size
+= ibw
;
2540 f
->output_data
.x
->menubar_height
= menubar_size
;
2542 /* Motif seems to need this amount added to the sizes
2543 specified for the shell widget. The Athena/Lucid widgets don't.
2544 Both conclusions reached experimentally. -- rms. */
2545 if (!strcmp (lwlib_toolkit_type
, "motif"))
2546 XtVaGetValues (f
->output_data
.x
->edit_widget
, XtNinternalBorderWidth
,
2547 &extra_borders
, NULL
);
2549 /* Convert our geometry parameters into a geometry string
2551 Note that we do not specify here whether the position
2552 is a user-specified or program-specified one.
2553 We pass that information later, in x_wm_set_size_hints. */
2555 int left
= f
->output_data
.x
->left_pos
;
2556 int xneg
= window_prompting
& XNegative
;
2557 int top
= f
->output_data
.x
->top_pos
;
2558 int yneg
= window_prompting
& YNegative
;
2564 if (window_prompting
& USPosition
)
2565 sprintf (shell_position
, "=%dx%d%c%d%c%d",
2566 PIXEL_WIDTH (f
) + extra_borders
,
2567 PIXEL_HEIGHT (f
) + menubar_size
+ extra_borders
,
2568 (xneg
? '-' : '+'), left
,
2569 (yneg
? '-' : '+'), top
);
2571 sprintf (shell_position
, "=%dx%d",
2572 PIXEL_WIDTH (f
) + extra_borders
,
2573 PIXEL_HEIGHT (f
) + menubar_size
+ extra_borders
);
2576 len
= strlen (shell_position
) + 1;
2577 tem
= (char *) xmalloc (len
);
2578 strncpy (tem
, shell_position
, len
);
2579 XtSetArg (al
[ac
], XtNgeometry
, tem
); ac
++;
2580 XtSetValues (shell_widget
, al
, ac
);
2583 XtManageChild (pane_widget
);
2584 XtRealizeWidget (shell_widget
);
2586 FRAME_X_WINDOW (f
) = XtWindow (frame_widget
);
2588 validate_x_resource_name ();
2590 class_hints
.res_name
= (char *) XSTRING (Vx_resource_name
)->data
;
2591 class_hints
.res_class
= EMACS_CLASS
;
2592 XSetClassHint (FRAME_X_DISPLAY (f
), XtWindow (shell_widget
), &class_hints
);
2599 xim
= XOpenIM (FRAME_X_DISPLAY (f
), NULL
, NULL
, NULL
);
2603 xic
= XCreateIC (xim
,
2604 XNInputStyle
, XIMPreeditNothing
| XIMStatusNothing
,
2605 XNClientWindow
, FRAME_X_WINDOW(f
),
2606 XNFocusWindow
, FRAME_X_WINDOW(f
),
2612 FRAME_XIC (f
) = xic
;
2616 f
->output_data
.x
->wm_hints
.input
= True
;
2617 f
->output_data
.x
->wm_hints
.flags
|= InputHint
;
2618 XSetWMHints (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
2619 &f
->output_data
.x
->wm_hints
);
2621 hack_wm_protocols (f
, shell_widget
);
2624 XtAddEventHandler (shell_widget
, 0, True
, _XEditResCheckMessages
, 0);
2627 /* Do a stupid property change to force the server to generate a
2628 propertyNotify event so that the event_stream server timestamp will
2629 be initialized to something relevant to the time we created the window.
2631 XChangeProperty (XtDisplay (frame_widget
), XtWindow (frame_widget
),
2632 FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_protocols
,
2633 XA_ATOM
, 32, PropModeAppend
,
2634 (unsigned char*) NULL
, 0);
2636 /* Make all the standard events reach the Emacs frame. */
2637 attributes
.event_mask
= STANDARD_EVENT_SET
;
2638 attribute_mask
= CWEventMask
;
2639 XChangeWindowAttributes (XtDisplay (shell_widget
), XtWindow (shell_widget
),
2640 attribute_mask
, &attributes
);
2642 XtMapWidget (frame_widget
);
2644 /* x_set_name normally ignores requests to set the name if the
2645 requested name is the same as the current name. This is the one
2646 place where that assumption isn't correct; f->name is set, but
2647 the X server hasn't been told. */
2650 int explicit = f
->explicit_name
;
2652 f
->explicit_name
= 0;
2655 x_set_name (f
, name
, explicit);
2658 XDefineCursor (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
2659 f
->output_data
.x
->text_cursor
);
2663 if (!minibuffer_only
&& FRAME_EXTERNAL_MENU_BAR (f
))
2664 initialize_frame_menubar (f
);
2665 lw_set_main_areas (pane_widget
, f
->output_data
.x
->menubar_widget
, frame_widget
);
2667 if (FRAME_X_WINDOW (f
) == 0)
2668 error ("Unable to create window");
2671 #else /* not USE_X_TOOLKIT */
2673 /* Create and set up the X window for frame F. */
2679 XClassHint class_hints
;
2680 XSetWindowAttributes attributes
;
2681 unsigned long attribute_mask
;
2683 attributes
.background_pixel
= f
->output_data
.x
->background_pixel
;
2684 attributes
.border_pixel
= f
->output_data
.x
->border_pixel
;
2685 attributes
.bit_gravity
= StaticGravity
;
2686 attributes
.backing_store
= NotUseful
;
2687 attributes
.save_under
= True
;
2688 attributes
.event_mask
= STANDARD_EVENT_SET
;
2689 attribute_mask
= (CWBackPixel
| CWBorderPixel
| CWBitGravity
2691 | CWBackingStore
| CWSaveUnder
2697 = XCreateWindow (FRAME_X_DISPLAY (f
),
2698 f
->output_data
.x
->parent_desc
,
2699 f
->output_data
.x
->left_pos
,
2700 f
->output_data
.x
->top_pos
,
2701 PIXEL_WIDTH (f
), PIXEL_HEIGHT (f
),
2702 f
->output_data
.x
->border_width
,
2703 CopyFromParent
, /* depth */
2704 InputOutput
, /* class */
2705 FRAME_X_DISPLAY_INFO (f
)->visual
,
2706 attribute_mask
, &attributes
);
2712 xim
= XOpenIM (FRAME_X_DISPLAY(f
), NULL
, NULL
, NULL
);
2716 xic
= XCreateIC (xim
,
2717 XNInputStyle
, XIMPreeditNothing
| XIMStatusNothing
,
2718 XNClientWindow
, FRAME_X_WINDOW(f
),
2719 XNFocusWindow
, FRAME_X_WINDOW(f
),
2726 FRAME_XIC (f
) = xic
;
2730 validate_x_resource_name ();
2732 class_hints
.res_name
= (char *) XSTRING (Vx_resource_name
)->data
;
2733 class_hints
.res_class
= EMACS_CLASS
;
2734 XSetClassHint (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
), &class_hints
);
2736 /* The menubar is part of the ordinary display;
2737 it does not count in addition to the height of the window. */
2738 f
->output_data
.x
->menubar_height
= 0;
2740 /* This indicates that we use the "Passive Input" input model.
2741 Unless we do this, we don't get the Focus{In,Out} events that we
2742 need to draw the cursor correctly. Accursed bureaucrats.
2743 XWhipsAndChains (FRAME_X_DISPLAY (f), IronMaiden, &TheRack); */
2745 f
->output_data
.x
->wm_hints
.input
= True
;
2746 f
->output_data
.x
->wm_hints
.flags
|= InputHint
;
2747 XSetWMHints (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
2748 &f
->output_data
.x
->wm_hints
);
2750 /* Request "save yourself" and "delete window" commands from wm. */
2753 protocols
[0] = FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_delete_window
;
2754 protocols
[1] = FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_save_yourself
;
2755 XSetWMProtocols (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
), protocols
, 2);
2758 /* x_set_name normally ignores requests to set the name if the
2759 requested name is the same as the current name. This is the one
2760 place where that assumption isn't correct; f->name is set, but
2761 the X server hasn't been told. */
2764 int explicit = f
->explicit_name
;
2766 f
->explicit_name
= 0;
2769 x_set_name (f
, name
, explicit);
2772 XDefineCursor (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
2773 f
->output_data
.x
->text_cursor
);
2777 if (FRAME_X_WINDOW (f
) == 0)
2778 error ("Unable to create window");
2781 #endif /* not USE_X_TOOLKIT */
2783 /* Handle the icon stuff for this window. Perhaps later we might
2784 want an x_set_icon_position which can be called interactively as
2792 Lisp_Object icon_x
, icon_y
;
2794 /* Set the position of the icon. Note that twm groups all
2795 icons in an icon window. */
2796 icon_x
= x_get_arg (parms
, Qicon_left
, 0, 0, number
);
2797 icon_y
= x_get_arg (parms
, Qicon_top
, 0, 0, number
);
2798 if (!EQ (icon_x
, Qunbound
) && !EQ (icon_y
, Qunbound
))
2800 CHECK_NUMBER (icon_x
, 0);
2801 CHECK_NUMBER (icon_y
, 0);
2803 else if (!EQ (icon_x
, Qunbound
) || !EQ (icon_y
, Qunbound
))
2804 error ("Both left and top icon corners of icon must be specified");
2808 if (! EQ (icon_x
, Qunbound
))
2809 x_wm_set_icon_position (f
, XINT (icon_x
), XINT (icon_y
));
2811 /* Start up iconic or window? */
2812 x_wm_set_window_state
2813 (f
, (EQ (x_get_arg (parms
, Qvisibility
, 0, 0, symbol
), Qicon
)
2817 x_text_icon (f
, (char *) XSTRING ((!NILP (f
->icon_name
)
2824 /* Make the GC's needed for this window, setting the
2825 background, border and mouse colors; also create the
2826 mouse cursor and the gray border tile. */
2828 static char cursor_bits
[] =
2830 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
2831 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
2832 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
2833 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00
2840 XGCValues gc_values
;
2846 /* Create the GC's of this frame.
2847 Note that many default values are used. */
2850 gc_values
.font
= f
->output_data
.x
->font
->fid
;
2851 gc_values
.foreground
= f
->output_data
.x
->foreground_pixel
;
2852 gc_values
.background
= f
->output_data
.x
->background_pixel
;
2853 gc_values
.line_width
= 0; /* Means 1 using fast algorithm. */
2854 f
->output_data
.x
->normal_gc
= XCreateGC (FRAME_X_DISPLAY (f
),
2856 GCLineWidth
| GCFont
2857 | GCForeground
| GCBackground
,
2860 /* Reverse video style. */
2861 gc_values
.foreground
= f
->output_data
.x
->background_pixel
;
2862 gc_values
.background
= f
->output_data
.x
->foreground_pixel
;
2863 f
->output_data
.x
->reverse_gc
= XCreateGC (FRAME_X_DISPLAY (f
),
2865 GCFont
| GCForeground
| GCBackground
2869 /* Cursor has cursor-color background, background-color foreground. */
2870 gc_values
.foreground
= f
->output_data
.x
->background_pixel
;
2871 gc_values
.background
= f
->output_data
.x
->cursor_pixel
;
2872 gc_values
.fill_style
= FillOpaqueStippled
;
2874 = XCreateBitmapFromData (FRAME_X_DISPLAY (f
),
2875 FRAME_X_DISPLAY_INFO (f
)->root_window
,
2876 cursor_bits
, 16, 16);
2877 f
->output_data
.x
->cursor_gc
2878 = XCreateGC (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
2879 (GCFont
| GCForeground
| GCBackground
2880 | GCFillStyle
| GCStipple
| GCLineWidth
),
2883 /* Create the gray border tile used when the pointer is not in
2884 the frame. Since this depends on the frame's pixel values,
2885 this must be done on a per-frame basis. */
2886 f
->output_data
.x
->border_tile
2887 = (XCreatePixmapFromBitmapData
2888 (FRAME_X_DISPLAY (f
), FRAME_X_DISPLAY_INFO (f
)->root_window
,
2889 gray_bits
, gray_width
, gray_height
,
2890 f
->output_data
.x
->foreground_pixel
,
2891 f
->output_data
.x
->background_pixel
,
2892 DefaultDepth (FRAME_X_DISPLAY (f
),
2893 XScreenNumberOfScreen (FRAME_X_SCREEN (f
)))));
2898 DEFUN ("x-create-frame", Fx_create_frame
, Sx_create_frame
,
2900 "Make a new X window, which is called a \"frame\" in Emacs terms.\n\
2901 Returns an Emacs frame object.\n\
2902 ALIST is an alist of frame parameters.\n\
2903 If the parameters specify that the frame should not have a minibuffer,\n\
2904 and do not specify a specific minibuffer window to use,\n\
2905 then `default-minibuffer-frame' must be a frame whose minibuffer can\n\
2906 be shared by the new frame.\n\
2908 This function is an internal primitive--use `make-frame' instead.")
2913 Lisp_Object frame
, tem
;
2915 int minibuffer_only
= 0;
2916 long window_prompting
= 0;
2918 int count
= specpdl_ptr
- specpdl
;
2919 struct gcpro gcpro1
;
2920 Lisp_Object display
;
2921 struct x_display_info
*dpyinfo
;
2927 /* Use this general default value to start with
2928 until we know if this frame has a specified name. */
2929 Vx_resource_name
= Vinvocation_name
;
2931 display
= x_get_arg (parms
, Qdisplay
, 0, 0, string
);
2932 if (EQ (display
, Qunbound
))
2934 dpyinfo
= check_x_display_info (display
);
2936 kb
= dpyinfo
->kboard
;
2938 kb
= &the_only_kboard
;
2941 name
= x_get_arg (parms
, Qname
, "title", "Title", string
);
2943 && ! EQ (name
, Qunbound
)
2945 error ("Invalid frame name--not a string or nil");
2948 Vx_resource_name
= name
;
2950 /* See if parent window is specified. */
2951 parent
= x_get_arg (parms
, Qparent_id
, NULL
, NULL
, number
);
2952 if (EQ (parent
, Qunbound
))
2954 if (! NILP (parent
))
2955 CHECK_NUMBER (parent
, 0);
2957 tem
= x_get_arg (parms
, Qminibuffer
, 0, 0, symbol
);
2958 if (EQ (tem
, Qnone
) || NILP (tem
))
2959 f
= make_frame_without_minibuffer (Qnil
, kb
, display
);
2960 else if (EQ (tem
, Qonly
))
2962 f
= make_minibuffer_frame ();
2963 minibuffer_only
= 1;
2965 else if (WINDOWP (tem
))
2966 f
= make_frame_without_minibuffer (tem
, kb
, display
);
2970 /* Note that X Windows does support scroll bars. */
2971 FRAME_CAN_HAVE_SCROLL_BARS (f
) = 1;
2973 XSETFRAME (frame
, f
);
2976 f
->output_method
= output_x_window
;
2977 f
->output_data
.x
= (struct x_output
*) xmalloc (sizeof (struct x_output
));
2978 bzero (f
->output_data
.x
, sizeof (struct x_output
));
2979 f
->output_data
.x
->icon_bitmap
= -1;
2982 = x_get_arg (parms
, Qicon_name
, "iconName", "Title", string
);
2983 if (! STRINGP (f
->icon_name
))
2984 f
->icon_name
= Qnil
;
2986 FRAME_X_DISPLAY_INFO (f
) = dpyinfo
;
2988 FRAME_KBOARD (f
) = kb
;
2991 /* Specify the parent under which to make this X window. */
2995 f
->output_data
.x
->parent_desc
= parent
;
2996 f
->output_data
.x
->explicit_parent
= 1;
3000 f
->output_data
.x
->parent_desc
= FRAME_X_DISPLAY_INFO (f
)->root_window
;
3001 f
->output_data
.x
->explicit_parent
= 0;
3004 /* Note that the frame has no physical cursor right now. */
3005 f
->phys_cursor_x
= -1;
3007 /* Set the name; the functions to which we pass f expect the name to
3009 if (EQ (name
, Qunbound
) || NILP (name
))
3011 f
->name
= build_string (dpyinfo
->x_id_name
);
3012 f
->explicit_name
= 0;
3017 f
->explicit_name
= 1;
3018 /* use the frame's title when getting resources for this frame. */
3019 specbind (Qx_resource_name
, name
);
3022 /* Extract the window parameters from the supplied values
3023 that are needed to determine window geometry. */
3027 font
= x_get_arg (parms
, Qfont
, "font", "Font", string
);
3029 /* First, try whatever font the caller has specified. */
3031 font
= x_new_font (f
, XSTRING (font
)->data
);
3032 /* Try out a font which we hope has bold and italic variations. */
3033 if (!STRINGP (font
))
3034 font
= x_new_font (f
, "-misc-fixed-medium-r-normal-*-*-140-*-*-c-*-iso8859-1");
3035 if (! STRINGP (font
))
3036 font
= x_new_font (f
, "-*-*-medium-r-normal-*-*-140-*-*-c-*-iso8859-1");
3037 if (! STRINGP (font
))
3038 /* This was formerly the first thing tried, but it finds too many fonts
3039 and takes too long. */
3040 font
= x_new_font (f
, "-*-*-medium-r-*-*-*-*-*-*-c-*-iso8859-1");
3041 /* If those didn't work, look for something which will at least work. */
3042 if (! STRINGP (font
))
3043 font
= x_new_font (f
, "-*-fixed-*-*-*-*-*-140-*-*-c-*-iso8859-1");
3045 if (! STRINGP (font
))
3046 font
= build_string ("fixed");
3048 x_default_parameter (f
, parms
, Qfont
, font
,
3049 "font", "Font", string
);
3052 #ifdef USE_X_TOOLKIT
3053 /* Prevent lwlib/xlwmenu.c from crashing because of a bug
3054 whereby it fails to get any font. */
3055 xlwmenu_default_font
= f
->output_data
.x
->font
;
3058 x_default_parameter (f
, parms
, Qborder_width
, make_number (2),
3059 "borderwidth", "BorderWidth", number
);
3060 /* This defaults to 2 in order to match xterm. We recognize either
3061 internalBorderWidth or internalBorder (which is what xterm calls
3063 if (NILP (Fassq (Qinternal_border_width
, parms
)))
3067 value
= x_get_arg (parms
, Qinternal_border_width
,
3068 "internalBorder", "BorderWidth", number
);
3069 if (! EQ (value
, Qunbound
))
3070 parms
= Fcons (Fcons (Qinternal_border_width
, value
),
3073 x_default_parameter (f
, parms
, Qinternal_border_width
, make_number (2),
3074 "internalBorderWidth", "BorderWidth", number
);
3075 x_default_parameter (f
, parms
, Qvertical_scroll_bars
, Qt
,
3076 "verticalScrollBars", "ScrollBars", boolean
);
3078 /* Also do the stuff which must be set before the window exists. */
3079 x_default_parameter (f
, parms
, Qforeground_color
, build_string ("black"),
3080 "foreground", "Foreground", string
);
3081 x_default_parameter (f
, parms
, Qbackground_color
, build_string ("white"),
3082 "background", "Background", string
);
3083 x_default_parameter (f
, parms
, Qmouse_color
, build_string ("black"),
3084 "pointerColor", "Foreground", string
);
3085 x_default_parameter (f
, parms
, Qcursor_color
, build_string ("black"),
3086 "cursorColor", "Foreground", string
);
3087 x_default_parameter (f
, parms
, Qborder_color
, build_string ("black"),
3088 "borderColor", "BorderColor", string
);
3090 x_default_parameter (f
, parms
, Qmenu_bar_lines
, make_number (1),
3091 "menuBar", "MenuBar", number
);
3092 x_default_parameter (f
, parms
, Qscroll_bar_width
, Qnil
,
3093 "scrollBarWidth", "ScrollBarWidth", number
);
3094 x_default_parameter (f
, parms
, Qbuffer_predicate
, Qnil
,
3095 "bufferPredicate", "BufferPredicate", symbol
);
3097 f
->output_data
.x
->parent_desc
= FRAME_X_DISPLAY_INFO (f
)->root_window
;
3098 window_prompting
= x_figure_window_size (f
, parms
);
3100 if (window_prompting
& XNegative
)
3102 if (window_prompting
& YNegative
)
3103 f
->output_data
.x
->win_gravity
= SouthEastGravity
;
3105 f
->output_data
.x
->win_gravity
= NorthEastGravity
;
3109 if (window_prompting
& YNegative
)
3110 f
->output_data
.x
->win_gravity
= SouthWestGravity
;
3112 f
->output_data
.x
->win_gravity
= NorthWestGravity
;
3115 f
->output_data
.x
->size_hint_flags
= window_prompting
;
3117 #ifdef USE_X_TOOLKIT
3118 x_window (f
, window_prompting
, minibuffer_only
);
3124 init_frame_faces (f
);
3126 /* We need to do this after creating the X window, so that the
3127 icon-creation functions can say whose icon they're describing. */
3128 x_default_parameter (f
, parms
, Qicon_type
, Qnil
,
3129 "bitmapIcon", "BitmapIcon", symbol
);
3131 x_default_parameter (f
, parms
, Qauto_raise
, Qnil
,
3132 "autoRaise", "AutoRaiseLower", boolean
);
3133 x_default_parameter (f
, parms
, Qauto_lower
, Qnil
,
3134 "autoLower", "AutoRaiseLower", boolean
);
3135 x_default_parameter (f
, parms
, Qcursor_type
, Qbox
,
3136 "cursorType", "CursorType", symbol
);
3138 /* Dimensions, especially f->height, must be done via change_frame_size.
3139 Change will not be effected unless different from the current
3143 f
->height
= f
->width
= 0;
3144 change_frame_size (f
, height
, width
, 1, 0);
3146 /* Tell the server what size and position, etc, we want,
3147 and how badly we want them. */
3149 x_wm_set_size_hint (f
, window_prompting
, 0);
3152 tem
= x_get_arg (parms
, Qunsplittable
, 0, 0, boolean
);
3153 f
->no_split
= minibuffer_only
|| EQ (tem
, Qt
);
3157 /* It is now ok to make the frame official
3158 even if we get an error below.
3159 And the frame needs to be on Vframe_list
3160 or making it visible won't work. */
3161 Vframe_list
= Fcons (frame
, Vframe_list
);
3163 /* Now that the frame is official, it counts as a reference to
3165 FRAME_X_DISPLAY_INFO (f
)->reference_count
++;
3167 /* Make the window appear on the frame and enable display,
3168 unless the caller says not to. However, with explicit parent,
3169 Emacs cannot control visibility, so don't try. */
3170 if (! f
->output_data
.x
->explicit_parent
)
3172 Lisp_Object visibility
;
3174 visibility
= x_get_arg (parms
, Qvisibility
, 0, 0, symbol
);
3175 if (EQ (visibility
, Qunbound
))
3178 if (EQ (visibility
, Qicon
))
3179 x_iconify_frame (f
);
3180 else if (! NILP (visibility
))
3181 x_make_frame_visible (f
);
3183 /* Must have been Qnil. */
3187 return unbind_to (count
, frame
);
3190 /* FRAME is used only to get a handle on the X display. We don't pass the
3191 display info directly because we're called from frame.c, which doesn't
3192 know about that structure. */
3194 x_get_focus_frame (frame
)
3195 struct frame
*frame
;
3197 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (frame
);
3199 if (! dpyinfo
->x_focus_frame
)
3202 XSETFRAME (xfocus
, dpyinfo
->x_focus_frame
);
3206 DEFUN ("focus-frame", Ffocus_frame
, Sfocus_frame
, 1, 1, 0,
3207 "This function is obsolete, and does nothing.")
3214 DEFUN ("unfocus-frame", Funfocus_frame
, Sunfocus_frame
, 0, 0, 0,
3215 "This function is obsolete, and does nothing.")
3221 DEFUN ("x-list-fonts", Fx_list_fonts
, Sx_list_fonts
, 1, 3, 0,
3222 "Return a list of the names of available fonts matching PATTERN.\n\
3223 If optional arguments FACE and FRAME are specified, return only fonts\n\
3224 the same size as FACE on FRAME.\n\
3226 PATTERN is a string, perhaps with wildcard characters;\n\
3227 the * character matches any substring, and\n\
3228 the ? character matches any single character.\n\
3229 PATTERN is case-insensitive.\n\
3230 FACE is a face name--a symbol.\n\
3232 The return value is a list of strings, suitable as arguments to\n\
3235 Fonts Emacs can't use (i.e. proportional fonts) may or may not be excluded\n\
3236 even if they match PATTERN and FACE.")
3237 (pattern
, face
, frame
)
3238 Lisp_Object pattern
, face
, frame
;
3242 #ifndef BROKEN_XLISTFONTSWITHINFO
3245 XFontStruct
*size_ref
;
3250 CHECK_STRING (pattern
, 0);
3252 CHECK_SYMBOL (face
, 1);
3254 f
= check_x_frame (frame
);
3256 /* Determine the width standard for comparison with the fonts we find. */
3264 /* Don't die if we get called with a terminal frame. */
3265 if (! FRAME_X_P (f
))
3266 error ("Non-X frame used in `x-list-fonts'");
3268 face_id
= face_name_id_number (f
, face
);
3270 if (face_id
< 0 || face_id
>= FRAME_N_PARAM_FACES (f
)
3271 || FRAME_PARAM_FACES (f
) [face_id
] == 0)
3272 size_ref
= f
->output_data
.x
->font
;
3275 size_ref
= FRAME_PARAM_FACES (f
) [face_id
]->font
;
3276 if (size_ref
== (XFontStruct
*) (~0))
3277 size_ref
= f
->output_data
.x
->font
;
3281 /* See if we cached the result for this particular query. */
3282 list
= Fassoc (pattern
,
3283 XCONS (FRAME_X_DISPLAY_INFO (f
)->name_list_element
)->cdr
);
3285 /* We have info in the cache for this PATTERN. */
3288 Lisp_Object tem
, newlist
;
3290 /* We have info about this pattern. */
3291 list
= XCONS (list
)->cdr
;
3298 /* Filter the cached info and return just the fonts that match FACE. */
3300 for (tem
= list
; CONSP (tem
); tem
= XCONS (tem
)->cdr
)
3302 XFontStruct
*thisinfo
;
3304 thisinfo
= XLoadQueryFont (FRAME_X_DISPLAY (f
),
3305 XSTRING (XCONS (tem
)->car
)->data
);
3307 if (thisinfo
&& same_size_fonts (thisinfo
, size_ref
))
3308 newlist
= Fcons (XCONS (tem
)->car
, newlist
);
3311 XFreeFont (FRAME_X_DISPLAY (f
), thisinfo
);
3321 /* Solaris 2.3 has a bug in XListFontsWithInfo. */
3322 #ifndef BROKEN_XLISTFONTSWITHINFO
3324 names
= XListFontsWithInfo (FRAME_X_DISPLAY (f
),
3325 XSTRING (pattern
)->data
,
3326 2000, /* maxnames */
3327 &num_fonts
, /* count_return */
3328 &info
); /* info_return */
3331 names
= XListFonts (FRAME_X_DISPLAY (f
),
3332 XSTRING (pattern
)->data
,
3333 2000, /* maxnames */
3334 &num_fonts
); /* count_return */
3343 Lisp_Object full_list
;
3345 /* Make a list of all the fonts we got back.
3346 Store that in the font cache for the display. */
3348 for (i
= 0; i
< num_fonts
; i
++)
3349 full_list
= Fcons (build_string (names
[i
]), full_list
);
3350 XCONS (FRAME_X_DISPLAY_INFO (f
)->name_list_element
)->cdr
3351 = Fcons (Fcons (pattern
, full_list
),
3352 XCONS (FRAME_X_DISPLAY_INFO (f
)->name_list_element
)->cdr
);
3354 /* Make a list of the fonts that have the right width. */
3356 for (i
= 0; i
< num_fonts
; i
++)
3364 #ifdef BROKEN_XLISTFONTSWITHINFO
3365 XFontStruct
*thisinfo
;
3368 thisinfo
= XLoadQueryFont (FRAME_X_DISPLAY (f
), names
[i
]);
3371 keeper
= thisinfo
&& same_size_fonts (thisinfo
, size_ref
);
3373 keeper
= same_size_fonts (&info
[i
], size_ref
);
3377 list
= Fcons (build_string (names
[i
]), list
);
3379 list
= Fnreverse (list
);
3382 #ifndef BROKEN_XLISTFONTSWITHINFO
3384 XFreeFontInfo (names
, info
, num_fonts
);
3387 XFreeFontNames (names
);
3395 DEFUN ("x-color-defined-p", Fx_color_defined_p
, Sx_color_defined_p
, 1, 2, 0,
3396 "Return non-nil if color COLOR is supported on frame FRAME.\n\
3397 If FRAME is omitted or nil, use the selected frame.")
3399 Lisp_Object color
, frame
;
3402 FRAME_PTR f
= check_x_frame (frame
);
3404 CHECK_STRING (color
, 1);
3406 if (defined_color (f
, XSTRING (color
)->data
, &foo
, 0))
3412 DEFUN ("x-color-values", Fx_color_values
, Sx_color_values
, 1, 2, 0,
3413 "Return a description of the color named COLOR on frame FRAME.\n\
3414 The value is a list of integer RGB values--(RED GREEN BLUE).\n\
3415 These values appear to range from 0 to 65280 or 65535, depending\n\
3416 on the system; white is (65280 65280 65280) or (65535 65535 65535).\n\
3417 If FRAME is omitted or nil, use the selected frame.")
3419 Lisp_Object color
, frame
;
3422 FRAME_PTR f
= check_x_frame (frame
);
3424 CHECK_STRING (color
, 1);
3426 if (defined_color (f
, XSTRING (color
)->data
, &foo
, 0))
3430 rgb
[0] = make_number (foo
.red
);
3431 rgb
[1] = make_number (foo
.green
);
3432 rgb
[2] = make_number (foo
.blue
);
3433 return Flist (3, rgb
);
3439 DEFUN ("x-display-color-p", Fx_display_color_p
, Sx_display_color_p
, 0, 1, 0,
3440 "Return t if the X display supports color.\n\
3441 The optional argument DISPLAY specifies which display to ask about.\n\
3442 DISPLAY should be either a frame or a display name (a string).\n\
3443 If omitted or nil, that stands for the selected frame's display.")
3445 Lisp_Object display
;
3447 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
3449 if (dpyinfo
->n_planes
<= 2)
3452 switch (dpyinfo
->visual
->class)
3465 DEFUN ("x-display-grayscale-p", Fx_display_grayscale_p
, Sx_display_grayscale_p
,
3467 "Return t if the X display supports shades of gray.\n\
3468 Note that color displays do support shades of gray.\n\
3469 The optional argument DISPLAY specifies which display to ask about.\n\
3470 DISPLAY should be either a frame or a display name (a string).\n\
3471 If omitted or nil, that stands for the selected frame's display.")
3473 Lisp_Object display
;
3475 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
3477 if (dpyinfo
->n_planes
<= 1)
3480 switch (dpyinfo
->visual
->class)
3495 DEFUN ("x-display-pixel-width", Fx_display_pixel_width
, Sx_display_pixel_width
,
3497 "Returns the width in pixels of the X display DISPLAY.\n\
3498 The optional argument DISPLAY specifies which display to ask about.\n\
3499 DISPLAY should be either a frame or a display name (a string).\n\
3500 If omitted or nil, that stands for the selected frame's display.")
3502 Lisp_Object display
;
3504 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
3506 return make_number (dpyinfo
->width
);
3509 DEFUN ("x-display-pixel-height", Fx_display_pixel_height
,
3510 Sx_display_pixel_height
, 0, 1, 0,
3511 "Returns the height in pixels of the X display DISPLAY.\n\
3512 The optional argument DISPLAY specifies which display to ask about.\n\
3513 DISPLAY should be either a frame or a display name (a string).\n\
3514 If omitted or nil, that stands for the selected frame's display.")
3516 Lisp_Object display
;
3518 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
3520 return make_number (dpyinfo
->height
);
3523 DEFUN ("x-display-planes", Fx_display_planes
, Sx_display_planes
,
3525 "Returns the number of bitplanes of the X display DISPLAY.\n\
3526 The optional argument DISPLAY specifies which display to ask about.\n\
3527 DISPLAY should be either a frame or a display name (a string).\n\
3528 If omitted or nil, that stands for the selected frame's display.")
3530 Lisp_Object display
;
3532 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
3534 return make_number (dpyinfo
->n_planes
);
3537 DEFUN ("x-display-color-cells", Fx_display_color_cells
, Sx_display_color_cells
,
3539 "Returns the number of color cells of the X display DISPLAY.\n\
3540 The optional argument DISPLAY specifies which display to ask about.\n\
3541 DISPLAY should be either a frame or a display name (a string).\n\
3542 If omitted or nil, that stands for the selected frame's display.")
3544 Lisp_Object display
;
3546 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
3548 return make_number (DisplayCells (dpyinfo
->display
,
3549 XScreenNumberOfScreen (dpyinfo
->screen
)));
3552 DEFUN ("x-server-max-request-size", Fx_server_max_request_size
,
3553 Sx_server_max_request_size
,
3555 "Returns the maximum request size of the X server of display DISPLAY.\n\
3556 The optional argument DISPLAY specifies which display to ask about.\n\
3557 DISPLAY should be either a frame or a display name (a string).\n\
3558 If omitted or nil, that stands for the selected frame's display.")
3560 Lisp_Object display
;
3562 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
3564 return make_number (MAXREQUEST (dpyinfo
->display
));
3567 DEFUN ("x-server-vendor", Fx_server_vendor
, Sx_server_vendor
, 0, 1, 0,
3568 "Returns the vendor ID string of the X server of display DISPLAY.\n\
3569 The optional argument DISPLAY specifies which display to ask about.\n\
3570 DISPLAY should be either a frame or a display name (a string).\n\
3571 If omitted or nil, that stands for the selected frame's display.")
3573 Lisp_Object display
;
3575 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
3576 char *vendor
= ServerVendor (dpyinfo
->display
);
3578 if (! vendor
) vendor
= "";
3579 return build_string (vendor
);
3582 DEFUN ("x-server-version", Fx_server_version
, Sx_server_version
, 0, 1, 0,
3583 "Returns the version numbers of the X server of display DISPLAY.\n\
3584 The value is a list of three integers: the major and minor\n\
3585 version numbers of the X Protocol in use, and the vendor-specific release\n\
3586 number. See also the function `x-server-vendor'.\n\n\
3587 The optional argument DISPLAY specifies which display to ask about.\n\
3588 DISPLAY should be either a frame or a display name (a string).\n\
3589 If omitted or nil, that stands for the selected frame's display.")
3591 Lisp_Object display
;
3593 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
3594 Display
*dpy
= dpyinfo
->display
;
3596 return Fcons (make_number (ProtocolVersion (dpy
)),
3597 Fcons (make_number (ProtocolRevision (dpy
)),
3598 Fcons (make_number (VendorRelease (dpy
)), Qnil
)));
3601 DEFUN ("x-display-screens", Fx_display_screens
, Sx_display_screens
, 0, 1, 0,
3602 "Returns the number of screens on the X server of display DISPLAY.\n\
3603 The optional argument DISPLAY specifies which display to ask about.\n\
3604 DISPLAY should be either a frame or a display name (a string).\n\
3605 If omitted or nil, that stands for the selected frame's display.")
3607 Lisp_Object display
;
3609 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
3611 return make_number (ScreenCount (dpyinfo
->display
));
3614 DEFUN ("x-display-mm-height", Fx_display_mm_height
, Sx_display_mm_height
, 0, 1, 0,
3615 "Returns the height in millimeters of the X display DISPLAY.\n\
3616 The optional argument DISPLAY specifies which display to ask about.\n\
3617 DISPLAY should be either a frame or a display name (a string).\n\
3618 If omitted or nil, that stands for the selected frame's display.")
3620 Lisp_Object display
;
3622 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
3624 return make_number (HeightMMOfScreen (dpyinfo
->screen
));
3627 DEFUN ("x-display-mm-width", Fx_display_mm_width
, Sx_display_mm_width
, 0, 1, 0,
3628 "Returns the width in millimeters of the X display DISPLAY.\n\
3629 The optional argument DISPLAY specifies which display to ask about.\n\
3630 DISPLAY should be either a frame or a display name (a string).\n\
3631 If omitted or nil, that stands for the selected frame's display.")
3633 Lisp_Object display
;
3635 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
3637 return make_number (WidthMMOfScreen (dpyinfo
->screen
));
3640 DEFUN ("x-display-backing-store", Fx_display_backing_store
,
3641 Sx_display_backing_store
, 0, 1, 0,
3642 "Returns an indication of whether X display DISPLAY does backing store.\n\
3643 The value may be `always', `when-mapped', or `not-useful'.\n\
3644 The optional argument DISPLAY specifies which display to ask about.\n\
3645 DISPLAY should be either a frame or a display name (a string).\n\
3646 If omitted or nil, that stands for the selected frame's display.")
3648 Lisp_Object display
;
3650 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
3652 switch (DoesBackingStore (dpyinfo
->screen
))
3655 return intern ("always");
3658 return intern ("when-mapped");
3661 return intern ("not-useful");
3664 error ("Strange value for BackingStore parameter of screen");
3668 DEFUN ("x-display-visual-class", Fx_display_visual_class
,
3669 Sx_display_visual_class
, 0, 1, 0,
3670 "Returns the visual class of the X display DISPLAY.\n\
3671 The value is one of the symbols `static-gray', `gray-scale',\n\
3672 `static-color', `pseudo-color', `true-color', or `direct-color'.\n\n\
3673 The optional argument DISPLAY specifies which display to ask about.\n\
3674 DISPLAY should be either a frame or a display name (a string).\n\
3675 If omitted or nil, that stands for the selected frame's display.")
3677 Lisp_Object display
;
3679 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
3681 switch (dpyinfo
->visual
->class)
3683 case StaticGray
: return (intern ("static-gray"));
3684 case GrayScale
: return (intern ("gray-scale"));
3685 case StaticColor
: return (intern ("static-color"));
3686 case PseudoColor
: return (intern ("pseudo-color"));
3687 case TrueColor
: return (intern ("true-color"));
3688 case DirectColor
: return (intern ("direct-color"));
3690 error ("Display has an unknown visual class");
3694 DEFUN ("x-display-save-under", Fx_display_save_under
,
3695 Sx_display_save_under
, 0, 1, 0,
3696 "Returns t if the X display DISPLAY supports the save-under feature.\n\
3697 The optional argument DISPLAY specifies which display to ask about.\n\
3698 DISPLAY should be either a frame or a display name (a string).\n\
3699 If omitted or nil, that stands for the selected frame's display.")
3701 Lisp_Object display
;
3703 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
3705 if (DoesSaveUnders (dpyinfo
->screen
) == True
)
3713 register struct frame
*f
;
3715 return PIXEL_WIDTH (f
);
3720 register struct frame
*f
;
3722 return PIXEL_HEIGHT (f
);
3727 register struct frame
*f
;
3729 return FONT_WIDTH (f
->output_data
.x
->font
);
3734 register struct frame
*f
;
3736 return f
->output_data
.x
->line_height
;
3740 x_screen_planes (frame
)
3743 return FRAME_X_DISPLAY_INFO (XFRAME (frame
))->n_planes
;
3746 #if 0 /* These no longer seem like the right way to do things. */
3748 /* Draw a rectangle on the frame with left top corner including
3749 the character specified by LEFT_CHAR and TOP_CHAR. The rectangle is
3750 CHARS by LINES wide and long and is the color of the cursor. */
3753 x_rectangle (f
, gc
, left_char
, top_char
, chars
, lines
)
3754 register struct frame
*f
;
3756 register int top_char
, left_char
, chars
, lines
;
3760 int left
= (left_char
* FONT_WIDTH (f
->output_data
.x
->font
)
3761 + f
->output_data
.x
->internal_border_width
);
3762 int top
= (top_char
* f
->output_data
.x
->line_height
3763 + f
->output_data
.x
->internal_border_width
);
3766 width
= FONT_WIDTH (f
->output_data
.x
->font
) / 2;
3768 width
= FONT_WIDTH (f
->output_data
.x
->font
) * chars
;
3770 height
= f
->output_data
.x
->line_height
/ 2;
3772 height
= f
->output_data
.x
->line_height
* lines
;
3774 XDrawRectangle (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
3775 gc
, left
, top
, width
, height
);
3778 DEFUN ("x-draw-rectangle", Fx_draw_rectangle
, Sx_draw_rectangle
, 5, 5, 0,
3779 "Draw a rectangle on FRAME between coordinates specified by\n\
3780 numbers X0, Y0, X1, Y1 in the cursor pixel.")
3781 (frame
, X0
, Y0
, X1
, Y1
)
3782 register Lisp_Object frame
, X0
, X1
, Y0
, Y1
;
3784 register int x0
, y0
, x1
, y1
, top
, left
, n_chars
, n_lines
;
3786 CHECK_LIVE_FRAME (frame
, 0);
3787 CHECK_NUMBER (X0
, 0);
3788 CHECK_NUMBER (Y0
, 1);
3789 CHECK_NUMBER (X1
, 2);
3790 CHECK_NUMBER (Y1
, 3);
3800 n_lines
= y1
- y0
+ 1;
3805 n_lines
= y0
- y1
+ 1;
3811 n_chars
= x1
- x0
+ 1;
3816 n_chars
= x0
- x1
+ 1;
3820 x_rectangle (XFRAME (frame
), XFRAME (frame
)->output_data
.x
->cursor_gc
,
3821 left
, top
, n_chars
, n_lines
);
3827 DEFUN ("x-erase-rectangle", Fx_erase_rectangle
, Sx_erase_rectangle
, 5, 5, 0,
3828 "Draw a rectangle drawn on FRAME between coordinates\n\
3829 X0, Y0, X1, Y1 in the regular background-pixel.")
3830 (frame
, X0
, Y0
, X1
, Y1
)
3831 register Lisp_Object frame
, X0
, Y0
, X1
, Y1
;
3833 register int x0
, y0
, x1
, y1
, top
, left
, n_chars
, n_lines
;
3835 CHECK_LIVE_FRAME (frame
, 0);
3836 CHECK_NUMBER (X0
, 0);
3837 CHECK_NUMBER (Y0
, 1);
3838 CHECK_NUMBER (X1
, 2);
3839 CHECK_NUMBER (Y1
, 3);
3849 n_lines
= y1
- y0
+ 1;
3854 n_lines
= y0
- y1
+ 1;
3860 n_chars
= x1
- x0
+ 1;
3865 n_chars
= x0
- x1
+ 1;
3869 x_rectangle (XFRAME (frame
), XFRAME (frame
)->output_data
.x
->reverse_gc
,
3870 left
, top
, n_chars
, n_lines
);
3876 /* Draw lines around the text region beginning at the character position
3877 TOP_X, TOP_Y and ending at BOTTOM_X and BOTTOM_Y. GC specifies the
3878 pixel and line characteristics. */
3880 #define line_len(line) (FRAME_CURRENT_GLYPHS (f)->used[(line)])
3883 outline_region (f
, gc
, top_x
, top_y
, bottom_x
, bottom_y
)
3884 register struct frame
*f
;
3886 int top_x
, top_y
, bottom_x
, bottom_y
;
3888 register int ibw
= f
->output_data
.x
->internal_border_width
;
3889 register int font_w
= FONT_WIDTH (f
->output_data
.x
->font
);
3890 register int font_h
= f
->output_data
.x
->line_height
;
3892 int x
= line_len (y
);
3893 XPoint
*pixel_points
3894 = (XPoint
*) alloca (((bottom_y
- top_y
+ 2) * 4) * sizeof (XPoint
));
3895 register XPoint
*this_point
= pixel_points
;
3897 /* Do the horizontal top line/lines */
3900 this_point
->x
= ibw
;
3901 this_point
->y
= ibw
+ (font_h
* top_y
);
3904 this_point
->x
= ibw
+ (font_w
/ 2); /* Half-size for newline chars. */
3906 this_point
->x
= ibw
+ (font_w
* x
);
3907 this_point
->y
= (this_point
- 1)->y
;
3911 this_point
->x
= ibw
;
3912 this_point
->y
= ibw
+ (font_h
* (top_y
+ 1));
3914 this_point
->x
= ibw
+ (font_w
* top_x
);
3915 this_point
->y
= (this_point
- 1)->y
;
3917 this_point
->x
= (this_point
- 1)->x
;
3918 this_point
->y
= ibw
+ (font_h
* top_y
);
3920 this_point
->x
= ibw
+ (font_w
* x
);
3921 this_point
->y
= (this_point
- 1)->y
;
3924 /* Now do the right side. */
3925 while (y
< bottom_y
)
3926 { /* Right vertical edge */
3928 this_point
->x
= (this_point
- 1)->x
;
3929 this_point
->y
= ibw
+ (font_h
* (y
+ 1));
3932 y
++; /* Horizontal connection to next line */
3935 this_point
->x
= ibw
+ (font_w
/ 2);
3937 this_point
->x
= ibw
+ (font_w
* x
);
3939 this_point
->y
= (this_point
- 1)->y
;
3942 /* Now do the bottom and connect to the top left point. */
3943 this_point
->x
= ibw
+ (font_w
* (bottom_x
+ 1));
3946 this_point
->x
= (this_point
- 1)->x
;
3947 this_point
->y
= ibw
+ (font_h
* (bottom_y
+ 1));
3949 this_point
->x
= ibw
;
3950 this_point
->y
= (this_point
- 1)->y
;
3952 this_point
->x
= pixel_points
->x
;
3953 this_point
->y
= pixel_points
->y
;
3955 XDrawLines (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
3957 (this_point
- pixel_points
+ 1), CoordModeOrigin
);
3960 DEFUN ("x-contour-region", Fx_contour_region
, Sx_contour_region
, 1, 1, 0,
3961 "Highlight the region between point and the character under the mouse\n\
3964 register Lisp_Object event
;
3966 register int x0
, y0
, x1
, y1
;
3967 register struct frame
*f
= selected_frame
;
3968 register int p1
, p2
;
3970 CHECK_CONS (event
, 0);
3973 x0
= XINT (Fcar (Fcar (event
)));
3974 y0
= XINT (Fcar (Fcdr (Fcar (event
))));
3976 /* If the mouse is past the end of the line, don't that area. */
3977 /* ReWrite this... */
3982 if (y1
> y0
) /* point below mouse */
3983 outline_region (f
, f
->output_data
.x
->cursor_gc
,
3985 else if (y1
< y0
) /* point above mouse */
3986 outline_region (f
, f
->output_data
.x
->cursor_gc
,
3988 else /* same line: draw horizontal rectangle */
3991 x_rectangle (f
, f
->output_data
.x
->cursor_gc
,
3992 x0
, y0
, (x1
- x0
+ 1), 1);
3994 x_rectangle (f
, f
->output_data
.x
->cursor_gc
,
3995 x1
, y1
, (x0
- x1
+ 1), 1);
3998 XFlush (FRAME_X_DISPLAY (f
));
4004 DEFUN ("x-uncontour-region", Fx_uncontour_region
, Sx_uncontour_region
, 1, 1, 0,
4005 "Erase any highlighting of the region between point and the character\n\
4006 at X, Y on the selected frame.")
4008 register Lisp_Object event
;
4010 register int x0
, y0
, x1
, y1
;
4011 register struct frame
*f
= selected_frame
;
4014 x0
= XINT (Fcar (Fcar (event
)));
4015 y0
= XINT (Fcar (Fcdr (Fcar (event
))));
4019 if (y1
> y0
) /* point below mouse */
4020 outline_region (f
, f
->output_data
.x
->reverse_gc
,
4022 else if (y1
< y0
) /* point above mouse */
4023 outline_region (f
, f
->output_data
.x
->reverse_gc
,
4025 else /* same line: draw horizontal rectangle */
4028 x_rectangle (f
, f
->output_data
.x
->reverse_gc
,
4029 x0
, y0
, (x1
- x0
+ 1), 1);
4031 x_rectangle (f
, f
->output_data
.x
->reverse_gc
,
4032 x1
, y1
, (x0
- x1
+ 1), 1);
4040 int contour_begin_x
, contour_begin_y
;
4041 int contour_end_x
, contour_end_y
;
4042 int contour_npoints
;
4044 /* Clip the top part of the contour lines down (and including) line Y_POS.
4045 If X_POS is in the middle (rather than at the end) of the line, drop
4046 down a line at that character. */
4049 clip_contour_top (y_pos
, x_pos
)
4051 register XPoint
*begin
= contour_lines
[y_pos
].top_left
;
4052 register XPoint
*end
;
4053 register int npoints
;
4054 register struct display_line
*line
= selected_frame
->phys_lines
[y_pos
+ 1];
4056 if (x_pos
>= line
->len
- 1) /* Draw one, straight horizontal line. */
4058 end
= contour_lines
[y_pos
].top_right
;
4059 npoints
= (end
- begin
+ 1);
4060 XDrawLines (x_current_display
, contour_window
,
4061 contour_erase_gc
, begin_erase
, npoints
, CoordModeOrigin
);
4063 bcopy (end
, begin
+ 1, contour_last_point
- end
+ 1);
4064 contour_last_point
-= (npoints
- 2);
4065 XDrawLines (x_current_display
, contour_window
,
4066 contour_erase_gc
, begin
, 2, CoordModeOrigin
);
4067 XFlush (x_current_display
);
4069 /* Now, update contour_lines structure. */
4074 register XPoint
*p
= begin
+ 1;
4075 end
= contour_lines
[y_pos
].bottom_right
;
4076 npoints
= (end
- begin
+ 1);
4077 XDrawLines (x_current_display
, contour_window
,
4078 contour_erase_gc
, begin_erase
, npoints
, CoordModeOrigin
);
4081 p
->x
= ibw
+ (font_w
* (x_pos
+ 1));
4083 p
->y
= begin
->y
+ font_h
;
4085 bcopy (end
, begin
+ 3, contour_last_point
- end
+ 1);
4086 contour_last_point
-= (npoints
- 5);
4087 XDrawLines (x_current_display
, contour_window
,
4088 contour_erase_gc
, begin
, 4, CoordModeOrigin
);
4089 XFlush (x_current_display
);
4091 /* Now, update contour_lines structure. */
4095 /* Erase the top horizontal lines of the contour, and then extend
4096 the contour upwards. */
4099 extend_contour_top (line
)
4104 clip_contour_bottom (x_pos
, y_pos
)
4110 extend_contour_bottom (x_pos
, y_pos
)
4114 DEFUN ("x-select-region", Fx_select_region
, Sx_select_region
, 1, 1, "e",
4119 register struct frame
*f
= selected_frame
;
4120 register int point_x
= f
->cursor_x
;
4121 register int point_y
= f
->cursor_y
;
4122 register int mouse_below_point
;
4123 register Lisp_Object obj
;
4124 register int x_contour_x
, x_contour_y
;
4126 x_contour_x
= x_mouse_x
;
4127 x_contour_y
= x_mouse_y
;
4128 if (x_contour_y
> point_y
|| (x_contour_y
== point_y
4129 && x_contour_x
> point_x
))
4131 mouse_below_point
= 1;
4132 outline_region (f
, f
->output_data
.x
->cursor_gc
, point_x
, point_y
,
4133 x_contour_x
, x_contour_y
);
4137 mouse_below_point
= 0;
4138 outline_region (f
, f
->output_data
.x
->cursor_gc
, x_contour_x
, x_contour_y
,
4144 obj
= read_char (-1, 0, 0, Qnil
, 0);
4148 if (mouse_below_point
)
4150 if (x_mouse_y
<= point_y
) /* Flipped. */
4152 mouse_below_point
= 0;
4154 outline_region (f
, f
->output_data
.x
->reverse_gc
, point_x
, point_y
,
4155 x_contour_x
, x_contour_y
);
4156 outline_region (f
, f
->output_data
.x
->cursor_gc
, x_mouse_x
, x_mouse_y
,
4159 else if (x_mouse_y
< x_contour_y
) /* Bottom clipped. */
4161 clip_contour_bottom (x_mouse_y
);
4163 else if (x_mouse_y
> x_contour_y
) /* Bottom extended. */
4165 extend_bottom_contour (x_mouse_y
);
4168 x_contour_x
= x_mouse_x
;
4169 x_contour_y
= x_mouse_y
;
4171 else /* mouse above or same line as point */
4173 if (x_mouse_y
>= point_y
) /* Flipped. */
4175 mouse_below_point
= 1;
4177 outline_region (f
, f
->output_data
.x
->reverse_gc
,
4178 x_contour_x
, x_contour_y
, point_x
, point_y
);
4179 outline_region (f
, f
->output_data
.x
->cursor_gc
, point_x
, point_y
,
4180 x_mouse_x
, x_mouse_y
);
4182 else if (x_mouse_y
> x_contour_y
) /* Top clipped. */
4184 clip_contour_top (x_mouse_y
);
4186 else if (x_mouse_y
< x_contour_y
) /* Top extended. */
4188 extend_contour_top (x_mouse_y
);
4193 unread_command_event
= obj
;
4194 if (mouse_below_point
)
4196 contour_begin_x
= point_x
;
4197 contour_begin_y
= point_y
;
4198 contour_end_x
= x_contour_x
;
4199 contour_end_y
= x_contour_y
;
4203 contour_begin_x
= x_contour_x
;
4204 contour_begin_y
= x_contour_y
;
4205 contour_end_x
= point_x
;
4206 contour_end_y
= point_y
;
4211 DEFUN ("x-horizontal-line", Fx_horizontal_line
, Sx_horizontal_line
, 1, 1, "e",
4216 register Lisp_Object obj
;
4217 struct frame
*f
= selected_frame
;
4218 register struct window
*w
= XWINDOW (selected_window
);
4219 register GC line_gc
= f
->output_data
.x
->cursor_gc
;
4220 register GC erase_gc
= f
->output_data
.x
->reverse_gc
;
4222 char dash_list
[] = {6, 4, 6, 4};
4224 XGCValues gc_values
;
4226 register int previous_y
;
4227 register int line
= (x_mouse_y
+ 1) * f
->output_data
.x
->line_height
4228 + f
->output_data
.x
->internal_border_width
;
4229 register int left
= f
->output_data
.x
->internal_border_width
4231 * FONT_WIDTH (f
->output_data
.x
->font
));
4232 register int right
= left
+ (w
->width
4233 * FONT_WIDTH (f
->output_data
.x
->font
))
4234 - f
->output_data
.x
->internal_border_width
;
4238 gc_values
.foreground
= f
->output_data
.x
->cursor_pixel
;
4239 gc_values
.background
= f
->output_data
.x
->background_pixel
;
4240 gc_values
.line_width
= 1;
4241 gc_values
.line_style
= LineOnOffDash
;
4242 gc_values
.cap_style
= CapRound
;
4243 gc_values
.join_style
= JoinRound
;
4245 line_gc
= XCreateGC (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
4246 GCLineStyle
| GCJoinStyle
| GCCapStyle
4247 | GCLineWidth
| GCForeground
| GCBackground
,
4249 XSetDashes (FRAME_X_DISPLAY (f
), line_gc
, 0, dash_list
, dashes
);
4250 gc_values
.foreground
= f
->output_data
.x
->background_pixel
;
4251 gc_values
.background
= f
->output_data
.x
->foreground_pixel
;
4252 erase_gc
= XCreateGC (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
4253 GCLineStyle
| GCJoinStyle
| GCCapStyle
4254 | GCLineWidth
| GCForeground
| GCBackground
,
4256 XSetDashes (FRAME_X_DISPLAY (f
), erase_gc
, 0, dash_list
, dashes
);
4263 if (x_mouse_y
>= XINT (w
->top
)
4264 && x_mouse_y
< XINT (w
->top
) + XINT (w
->height
) - 1)
4266 previous_y
= x_mouse_y
;
4267 line
= (x_mouse_y
+ 1) * f
->output_data
.x
->line_height
4268 + f
->output_data
.x
->internal_border_width
;
4269 XDrawLine (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
4270 line_gc
, left
, line
, right
, line
);
4272 XFlush (FRAME_X_DISPLAY (f
));
4277 obj
= read_char (-1, 0, 0, Qnil
, 0);
4279 || (! EQ (Fcar (Fcdr (Fcdr (obj
))),
4280 Qvertical_scroll_bar
))
4284 XDrawLine (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
4285 erase_gc
, left
, line
, right
, line
);
4286 unread_command_event
= obj
;
4288 XFreeGC (FRAME_X_DISPLAY (f
), line_gc
);
4289 XFreeGC (FRAME_X_DISPLAY (f
), erase_gc
);
4295 while (x_mouse_y
== previous_y
);
4298 XDrawLine (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
4299 erase_gc
, left
, line
, right
, line
);
4306 /* These keep track of the rectangle following the pointer. */
4307 int mouse_track_top
, mouse_track_left
, mouse_track_width
;
4309 /* Offset in buffer of character under the pointer, or 0. */
4310 int mouse_buffer_offset
;
4312 DEFUN ("x-track-pointer", Fx_track_pointer
, Sx_track_pointer
, 0, 0, 0,
4313 "Track the pointer.")
4316 static Cursor current_pointer_shape
;
4317 FRAME_PTR f
= x_mouse_frame
;
4320 if (EQ (Vmouse_frame_part
, Qtext_part
)
4321 && (current_pointer_shape
!= f
->output_data
.x
->nontext_cursor
))
4326 current_pointer_shape
= f
->output_data
.x
->nontext_cursor
;
4327 XDefineCursor (FRAME_X_DISPLAY (f
),
4329 current_pointer_shape
);
4331 buf
= XBUFFER (XWINDOW (Vmouse_window
)->buffer
);
4332 c
= *(BUF_CHAR_ADDRESS (buf
, mouse_buffer_offset
));
4334 else if (EQ (Vmouse_frame_part
, Qmodeline_part
)
4335 && (current_pointer_shape
!= f
->output_data
.x
->modeline_cursor
))
4337 current_pointer_shape
= f
->output_data
.x
->modeline_cursor
;
4338 XDefineCursor (FRAME_X_DISPLAY (f
),
4340 current_pointer_shape
);
4343 XFlush (FRAME_X_DISPLAY (f
));
4349 DEFUN ("x-track-pointer", Fx_track_pointer
, Sx_track_pointer
, 1, 1, "e",
4350 "Draw rectangle around character under mouse pointer, if there is one.")
4354 struct window
*w
= XWINDOW (Vmouse_window
);
4355 struct frame
*f
= XFRAME (WINDOW_FRAME (w
));
4356 struct buffer
*b
= XBUFFER (w
->buffer
);
4359 if (! EQ (Vmouse_window
, selected_window
))
4362 if (EQ (event
, Qnil
))
4366 x_read_mouse_position (selected_frame
, &x
, &y
);
4370 mouse_track_width
= 0;
4371 mouse_track_left
= mouse_track_top
= -1;
4375 if ((x_mouse_x
!= mouse_track_left
4376 && (x_mouse_x
< mouse_track_left
4377 || x_mouse_x
> (mouse_track_left
+ mouse_track_width
)))
4378 || x_mouse_y
!= mouse_track_top
)
4380 int hp
= 0; /* Horizontal position */
4381 int len
= FRAME_CURRENT_GLYPHS (f
)->used
[x_mouse_y
];
4382 int p
= FRAME_CURRENT_GLYPHS (f
)->bufp
[x_mouse_y
];
4383 int tab_width
= XINT (b
->tab_width
);
4384 int ctl_arrow_p
= !NILP (b
->ctl_arrow
);
4386 int mode_line_vpos
= XFASTINT (w
->height
) + XFASTINT (w
->top
) - 1;
4387 int in_mode_line
= 0;
4389 if (! FRAME_CURRENT_GLYPHS (f
)->enable
[x_mouse_y
])
4392 /* Erase previous rectangle. */
4393 if (mouse_track_width
)
4395 x_rectangle (f
, f
->output_data
.x
->reverse_gc
,
4396 mouse_track_left
, mouse_track_top
,
4397 mouse_track_width
, 1);
4399 if ((mouse_track_left
== f
->phys_cursor_x
4400 || mouse_track_left
== f
->phys_cursor_x
- 1)
4401 && mouse_track_top
== f
->phys_cursor_y
)
4403 x_display_cursor (f
, 1);
4407 mouse_track_left
= x_mouse_x
;
4408 mouse_track_top
= x_mouse_y
;
4409 mouse_track_width
= 0;
4411 if (mouse_track_left
> len
) /* Past the end of line. */
4414 if (mouse_track_top
== mode_line_vpos
)
4420 if (tab_width
<= 0 || tab_width
> 20) tab_width
= 8;
4424 if (len
== f
->width
&& hp
== len
- 1 && c
!= '\n')
4430 mouse_track_width
= tab_width
- (hp
% tab_width
);
4432 hp
+= mouse_track_width
;
4435 mouse_track_left
= hp
- mouse_track_width
;
4441 mouse_track_width
= -1;
4445 if (ctl_arrow_p
&& (c
< 040 || c
== 0177))
4450 mouse_track_width
= 2;
4455 mouse_track_left
= hp
- mouse_track_width
;
4461 mouse_track_width
= 1;
4468 while (hp
<= x_mouse_x
);
4471 if (mouse_track_width
) /* Over text; use text pointer shape. */
4473 XDefineCursor (FRAME_X_DISPLAY (f
),
4475 f
->output_data
.x
->text_cursor
);
4476 x_rectangle (f
, f
->output_data
.x
->cursor_gc
,
4477 mouse_track_left
, mouse_track_top
,
4478 mouse_track_width
, 1);
4480 else if (in_mode_line
)
4481 XDefineCursor (FRAME_X_DISPLAY (f
),
4483 f
->output_data
.x
->modeline_cursor
);
4485 XDefineCursor (FRAME_X_DISPLAY (f
),
4487 f
->output_data
.x
->nontext_cursor
);
4490 XFlush (FRAME_X_DISPLAY (f
));
4493 obj
= read_char (-1, 0, 0, Qnil
, 0);
4496 while (CONSP (obj
) /* Mouse event */
4497 && EQ (Fcar (Fcdr (Fcdr (obj
))), Qnil
) /* Not scroll bar */
4498 && EQ (Vmouse_depressed
, Qnil
) /* Only motion events */
4499 && EQ (Vmouse_window
, selected_window
) /* In this window */
4502 unread_command_event
= obj
;
4504 if (mouse_track_width
)
4506 x_rectangle (f
, f
->output_data
.x
->reverse_gc
,
4507 mouse_track_left
, mouse_track_top
,
4508 mouse_track_width
, 1);
4509 mouse_track_width
= 0;
4510 if ((mouse_track_left
== f
->phys_cursor_x
4511 || mouse_track_left
- 1 == f
->phys_cursor_x
)
4512 && mouse_track_top
== f
->phys_cursor_y
)
4514 x_display_cursor (f
, 1);
4517 XDefineCursor (FRAME_X_DISPLAY (f
),
4519 f
->output_data
.x
->nontext_cursor
);
4520 XFlush (FRAME_X_DISPLAY (f
));
4530 /* Draw a pixmap specified by IMAGE_DATA of dimensions WIDTH and HEIGHT
4531 on the frame F at position X, Y. */
4533 x_draw_pixmap (f
, x
, y
, image_data
, width
, height
)
4535 int x
, y
, width
, height
;
4540 image
= XCreateBitmapFromData (FRAME_X_DISPLAY (f
),
4541 FRAME_X_WINDOW (f
), image_data
,
4543 XCopyPlane (FRAME_X_DISPLAY (f
), image
, FRAME_X_WINDOW (f
),
4544 f
->output_data
.x
->normal_gc
, 0, 0, width
, height
, x
, y
);
4548 #if 0 /* I'm told these functions are superfluous
4549 given the ability to bind function keys. */
4552 DEFUN ("x-rebind-key", Fx_rebind_key
, Sx_rebind_key
, 3, 3, 0,
4553 "Rebind X keysym KEYSYM, with MODIFIERS, to generate NEWSTRING.\n\
4554 KEYSYM is a string which conforms to the X keysym definitions found\n\
4555 in X11/keysymdef.h, sans the initial XK_. MODIFIERS is nil or a\n\
4556 list of strings specifying modifier keys such as Control_L, which must\n\
4557 also be depressed for NEWSTRING to appear.")
4558 (x_keysym
, modifiers
, newstring
)
4559 register Lisp_Object x_keysym
;
4560 register Lisp_Object modifiers
;
4561 register Lisp_Object newstring
;
4564 register KeySym keysym
;
4565 KeySym modifier_list
[16];
4568 CHECK_STRING (x_keysym
, 1);
4569 CHECK_STRING (newstring
, 3);
4571 keysym
= XStringToKeysym ((char *) XSTRING (x_keysym
)->data
);
4572 if (keysym
== NoSymbol
)
4573 error ("Keysym does not exist");
4575 if (NILP (modifiers
))
4576 XRebindKeysym (x_current_display
, keysym
, modifier_list
, 0,
4577 XSTRING (newstring
)->data
, XSTRING (newstring
)->size
);
4580 register Lisp_Object rest
, mod
;
4583 for (rest
= modifiers
; !NILP (rest
); rest
= Fcdr (rest
))
4586 error ("Can't have more than 16 modifiers");
4589 CHECK_STRING (mod
, 3);
4590 modifier_list
[i
] = XStringToKeysym ((char *) XSTRING (mod
)->data
);
4592 if (modifier_list
[i
] == NoSymbol
4593 || !(IsModifierKey (modifier_list
[i
])
4594 || ((unsigned)(modifier_list
[i
]) == XK_Mode_switch
)
4595 || ((unsigned)(modifier_list
[i
]) == XK_Num_Lock
)))
4597 if (modifier_list
[i
] == NoSymbol
4598 || !IsModifierKey (modifier_list
[i
]))
4600 error ("Element is not a modifier keysym");
4604 XRebindKeysym (x_current_display
, keysym
, modifier_list
, i
,
4605 XSTRING (newstring
)->data
, XSTRING (newstring
)->size
);
4611 DEFUN ("x-rebind-keys", Fx_rebind_keys
, Sx_rebind_keys
, 2, 2, 0,
4612 "Rebind KEYCODE to list of strings STRINGS.\n\
4613 STRINGS should be a list of 16 elements, one for each shift combination.\n\
4614 nil as element means don't change.\n\
4615 See the documentation of `x-rebind-key' for more information.")
4617 register Lisp_Object keycode
;
4618 register Lisp_Object strings
;
4620 register Lisp_Object item
;
4621 register unsigned char *rawstring
;
4622 KeySym rawkey
, modifier
[1];
4624 register unsigned i
;
4627 CHECK_NUMBER (keycode
, 1);
4628 CHECK_CONS (strings
, 2);
4629 rawkey
= (KeySym
) ((unsigned) (XINT (keycode
))) & 255;
4630 for (i
= 0; i
<= 15; strings
= Fcdr (strings
), i
++)
4632 item
= Fcar (strings
);
4635 CHECK_STRING (item
, 2);
4636 strsize
= XSTRING (item
)->size
;
4637 rawstring
= (unsigned char *) xmalloc (strsize
);
4638 bcopy (XSTRING (item
)->data
, rawstring
, strsize
);
4639 modifier
[1] = 1 << i
;
4640 XRebindKeysym (x_current_display
, rawkey
, modifier
, 1,
4641 rawstring
, strsize
);
4646 #endif /* HAVE_X11 */
4649 #ifndef HAVE_XSCREENNUMBEROFSCREEN
4651 XScreenNumberOfScreen (scr
)
4652 register Screen
*scr
;
4654 register Display
*dpy
;
4655 register Screen
*dpyscr
;
4659 dpyscr
= dpy
->screens
;
4661 for (i
= 0; i
< dpy
->nscreens
; i
++, dpyscr
++)
4667 #endif /* not HAVE_XSCREENNUMBEROFSCREEN */
4670 select_visual (dpy
, screen
, depth
)
4673 unsigned int *depth
;
4676 XVisualInfo
*vinfo
, vinfo_template
;
4679 v
= DefaultVisualOfScreen (screen
);
4682 vinfo_template
.visualid
= XVisualIDFromVisual (v
);
4684 vinfo_template
.visualid
= v
->visualid
;
4687 vinfo_template
.screen
= XScreenNumberOfScreen (screen
);
4689 vinfo
= XGetVisualInfo (dpy
,
4690 VisualIDMask
| VisualScreenMask
, &vinfo_template
,
4693 fatal ("Can't get proper X visual info");
4695 if ((1 << vinfo
->depth
) == vinfo
->colormap_size
)
4696 *depth
= vinfo
->depth
;
4700 int n
= vinfo
->colormap_size
- 1;
4709 XFree ((char *) vinfo
);
4713 /* Return the X display structure for the display named NAME.
4714 Open a new connection if necessary. */
4716 struct x_display_info
*
4717 x_display_info_for_name (name
)
4721 struct x_display_info
*dpyinfo
;
4723 CHECK_STRING (name
, 0);
4725 if (! EQ (Vwindow_system
, intern ("x")))
4726 error ("Not using X Windows");
4728 for (dpyinfo
= x_display_list
, names
= x_display_name_list
;
4730 dpyinfo
= dpyinfo
->next
, names
= XCONS (names
)->cdr
)
4733 tem
= Fstring_equal (XCONS (XCONS (names
)->car
)->car
, name
);
4738 /* Use this general default value to start with. */
4739 Vx_resource_name
= Vinvocation_name
;
4741 validate_x_resource_name ();
4743 dpyinfo
= x_term_init (name
, (unsigned char *)0,
4744 (char *) XSTRING (Vx_resource_name
)->data
);
4747 error ("Cannot connect to X server %s", XSTRING (name
)->data
);
4750 XSETFASTINT (Vwindow_system_version
, 11);
4755 DEFUN ("x-open-connection", Fx_open_connection
, Sx_open_connection
,
4756 1, 3, 0, "Open a connection to an X server.\n\
4757 DISPLAY is the name of the display to connect to.\n\
4758 Optional second arg XRM-STRING is a string of resources in xrdb format.\n\
4759 If the optional third arg MUST-SUCCEED is non-nil,\n\
4760 terminate Emacs if we can't open the connection.")
4761 (display
, xrm_string
, must_succeed
)
4762 Lisp_Object display
, xrm_string
, must_succeed
;
4764 unsigned int n_planes
;
4765 unsigned char *xrm_option
;
4766 struct x_display_info
*dpyinfo
;
4768 CHECK_STRING (display
, 0);
4769 if (! NILP (xrm_string
))
4770 CHECK_STRING (xrm_string
, 1);
4772 if (! EQ (Vwindow_system
, intern ("x")))
4773 error ("Not using X Windows");
4775 if (! NILP (xrm_string
))
4776 xrm_option
= (unsigned char *) XSTRING (xrm_string
)->data
;
4778 xrm_option
= (unsigned char *) 0;
4780 /* Use this general default value to start with. */
4781 Vx_resource_name
= Vinvocation_name
;
4783 validate_x_resource_name ();
4785 /* This is what opens the connection and sets x_current_display.
4786 This also initializes many symbols, such as those used for input. */
4787 dpyinfo
= x_term_init (display
, xrm_option
,
4788 (char *) XSTRING (Vx_resource_name
)->data
);
4792 if (!NILP (must_succeed
))
4793 fatal ("Cannot connect to X server %s.\n\
4794 Check the DISPLAY environment variable or use `-d'.\n\
4795 Also use the `xhost' program to verify that it is set to permit\n\
4796 connections from your machine.\n",
4797 XSTRING (display
)->data
);
4799 error ("Cannot connect to X server %s", XSTRING (display
)->data
);
4804 XSETFASTINT (Vwindow_system_version
, 11);
4808 DEFUN ("x-close-connection", Fx_close_connection
,
4809 Sx_close_connection
, 1, 1, 0,
4810 "Close the connection to DISPLAY's X server.\n\
4811 For DISPLAY, specify either a frame or a display name (a string).\n\
4812 If DISPLAY is nil, that stands for the selected frame's display.")
4814 Lisp_Object display
;
4816 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4817 struct x_display_info
*tail
;
4820 if (dpyinfo
->reference_count
> 0)
4821 error ("Display still has frames on it");
4824 /* Free the fonts in the font table. */
4825 for (i
= 0; i
< dpyinfo
->n_fonts
; i
++)
4827 if (dpyinfo
->font_table
[i
].name
)
4828 free (dpyinfo
->font_table
[i
].name
);
4829 /* Don't free the full_name string;
4830 it is always shared with something else. */
4831 XFreeFont (dpyinfo
->display
, dpyinfo
->font_table
[i
].font
);
4833 x_destroy_all_bitmaps (dpyinfo
);
4834 XSetCloseDownMode (dpyinfo
->display
, DestroyAll
);
4836 #ifdef USE_X_TOOLKIT
4837 XtCloseDisplay (dpyinfo
->display
);
4839 XCloseDisplay (dpyinfo
->display
);
4842 x_delete_display (dpyinfo
);
4848 DEFUN ("x-display-list", Fx_display_list
, Sx_display_list
, 0, 0, 0,
4849 "Return the list of display names that Emacs has connections to.")
4852 Lisp_Object tail
, result
;
4855 for (tail
= x_display_name_list
; ! NILP (tail
); tail
= XCONS (tail
)->cdr
)
4856 result
= Fcons (XCONS (XCONS (tail
)->car
)->car
, result
);
4861 DEFUN ("x-synchronize", Fx_synchronize
, Sx_synchronize
, 1, 2, 0,
4862 "If ON is non-nil, report X errors as soon as the erring request is made.\n\
4863 If ON is nil, allow buffering of requests.\n\
4864 Turning on synchronization prohibits the Xlib routines from buffering\n\
4865 requests and seriously degrades performance, but makes debugging much\n\
4867 The optional second argument DISPLAY specifies which display to act on.\n\
4868 DISPLAY should be either a frame or a display name (a string).\n\
4869 If DISPLAY is omitted or nil, that stands for the selected frame's display.")
4871 Lisp_Object display
, on
;
4873 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4875 XSynchronize (dpyinfo
->display
, !EQ (on
, Qnil
));
4880 /* Wait for responses to all X commands issued so far for frame F. */
4887 XSync (FRAME_X_DISPLAY (f
), False
);
4893 /* This is zero if not using X windows. */
4896 /* The section below is built by the lisp expression at the top of the file,
4897 just above where these variables are declared. */
4898 /*&&& init symbols here &&&*/
4899 Qauto_raise
= intern ("auto-raise");
4900 staticpro (&Qauto_raise
);
4901 Qauto_lower
= intern ("auto-lower");
4902 staticpro (&Qauto_lower
);
4903 Qbackground_color
= intern ("background-color");
4904 staticpro (&Qbackground_color
);
4905 Qbar
= intern ("bar");
4907 Qborder_color
= intern ("border-color");
4908 staticpro (&Qborder_color
);
4909 Qborder_width
= intern ("border-width");
4910 staticpro (&Qborder_width
);
4911 Qbox
= intern ("box");
4913 Qcursor_color
= intern ("cursor-color");
4914 staticpro (&Qcursor_color
);
4915 Qcursor_type
= intern ("cursor-type");
4916 staticpro (&Qcursor_type
);
4917 Qfont
= intern ("font");
4919 Qforeground_color
= intern ("foreground-color");
4920 staticpro (&Qforeground_color
);
4921 Qgeometry
= intern ("geometry");
4922 staticpro (&Qgeometry
);
4923 Qicon_left
= intern ("icon-left");
4924 staticpro (&Qicon_left
);
4925 Qicon_top
= intern ("icon-top");
4926 staticpro (&Qicon_top
);
4927 Qicon_type
= intern ("icon-type");
4928 staticpro (&Qicon_type
);
4929 Qicon_name
= intern ("icon-name");
4930 staticpro (&Qicon_name
);
4931 Qinternal_border_width
= intern ("internal-border-width");
4932 staticpro (&Qinternal_border_width
);
4933 Qleft
= intern ("left");
4935 Qmouse_color
= intern ("mouse-color");
4936 staticpro (&Qmouse_color
);
4937 Qnone
= intern ("none");
4939 Qparent_id
= intern ("parent-id");
4940 staticpro (&Qparent_id
);
4941 Qscroll_bar_width
= intern ("scroll-bar-width");
4942 staticpro (&Qscroll_bar_width
);
4943 Qsuppress_icon
= intern ("suppress-icon");
4944 staticpro (&Qsuppress_icon
);
4945 Qtop
= intern ("top");
4947 Qundefined_color
= intern ("undefined-color");
4948 staticpro (&Qundefined_color
);
4949 Qvertical_scroll_bars
= intern ("vertical-scroll-bars");
4950 staticpro (&Qvertical_scroll_bars
);
4951 Qvisibility
= intern ("visibility");
4952 staticpro (&Qvisibility
);
4953 Qwindow_id
= intern ("window-id");
4954 staticpro (&Qwindow_id
);
4955 Qx_frame_parameter
= intern ("x-frame-parameter");
4956 staticpro (&Qx_frame_parameter
);
4957 Qx_resource_name
= intern ("x-resource-name");
4958 staticpro (&Qx_resource_name
);
4959 Quser_position
= intern ("user-position");
4960 staticpro (&Quser_position
);
4961 Quser_size
= intern ("user-size");
4962 staticpro (&Quser_size
);
4963 Qdisplay
= intern ("display");
4964 staticpro (&Qdisplay
);
4965 /* This is the end of symbol initialization. */
4967 Fput (Qundefined_color
, Qerror_conditions
,
4968 Fcons (Qundefined_color
, Fcons (Qerror
, Qnil
)));
4969 Fput (Qundefined_color
, Qerror_message
,
4970 build_string ("Undefined color"));
4972 init_x_parm_symbols ();
4974 DEFVAR_LISP ("x-bitmap-file-path", &Vx_bitmap_file_path
,
4975 "List of directories to search for bitmap files for X.");
4976 Vx_bitmap_file_path
= decode_env_path ((char *) 0, PATH_BITMAPS
);
4978 DEFVAR_LISP ("x-pointer-shape", &Vx_pointer_shape
,
4979 "The shape of the pointer when over text.\n\
4980 Changing the value does not affect existing frames\n\
4981 unless you set the mouse color.");
4982 Vx_pointer_shape
= Qnil
;
4984 DEFVAR_LISP ("x-resource-name", &Vx_resource_name
,
4985 "The name Emacs uses to look up X resources; for internal use only.\n\
4986 `x-get-resource' uses this as the first component of the instance name\n\
4987 when requesting resource values.\n\
4988 Emacs initially sets `x-resource-name' to the name under which Emacs\n\
4989 was invoked, or to the value specified with the `-name' or `-rn'\n\
4990 switches, if present.");
4991 Vx_resource_name
= Qnil
;
4993 #if 0 /* This doesn't really do anything. */
4994 DEFVAR_INT ("x-nontext-pointer-shape", &Vx_nontext_pointer_shape
,
4995 "The shape of the pointer when not over text.\n\
4996 This variable takes effect when you create a new frame\n\
4997 or when you set the mouse color.");
4999 Vx_nontext_pointer_shape
= Qnil
;
5001 #if 0 /* This doesn't really do anything. */
5002 DEFVAR_INT ("x-mode-pointer-shape", &Vx_mode_pointer_shape
,
5003 "The shape of the pointer when over the mode line.\n\
5004 This variable takes effect when you create a new frame\n\
5005 or when you set the mouse color.");
5007 Vx_mode_pointer_shape
= Qnil
;
5009 DEFVAR_INT ("x-sensitive-text-pointer-shape",
5010 &Vx_sensitive_text_pointer_shape
,
5011 "The shape of the pointer when over mouse-sensitive text.\n\
5012 This variable takes effect when you create a new frame\n\
5013 or when you set the mouse color.");
5014 Vx_sensitive_text_pointer_shape
= Qnil
;
5016 DEFVAR_LISP ("x-cursor-fore-pixel", &Vx_cursor_fore_pixel
,
5017 "A string indicating the foreground color of the cursor box.");
5018 Vx_cursor_fore_pixel
= Qnil
;
5020 DEFVAR_LISP ("x-no-window-manager", &Vx_no_window_manager
,
5021 "Non-nil if no X window manager is in use.\n\
5022 Emacs doesn't try to figure this out; this is always nil\n\
5023 unless you set it to something else.");
5024 /* We don't have any way to find this out, so set it to nil
5025 and maybe the user would like to set it to t. */
5026 Vx_no_window_manager
= Qnil
;
5028 #ifdef USE_X_TOOLKIT
5029 Fprovide (intern ("x-toolkit"));
5032 Fprovide (intern ("motif"));
5035 defsubr (&Sx_get_resource
);
5037 defsubr (&Sx_draw_rectangle
);
5038 defsubr (&Sx_erase_rectangle
);
5039 defsubr (&Sx_contour_region
);
5040 defsubr (&Sx_uncontour_region
);
5042 defsubr (&Sx_list_fonts
);
5043 defsubr (&Sx_display_color_p
);
5044 defsubr (&Sx_display_grayscale_p
);
5045 defsubr (&Sx_color_defined_p
);
5046 defsubr (&Sx_color_values
);
5047 defsubr (&Sx_server_max_request_size
);
5048 defsubr (&Sx_server_vendor
);
5049 defsubr (&Sx_server_version
);
5050 defsubr (&Sx_display_pixel_width
);
5051 defsubr (&Sx_display_pixel_height
);
5052 defsubr (&Sx_display_mm_width
);
5053 defsubr (&Sx_display_mm_height
);
5054 defsubr (&Sx_display_screens
);
5055 defsubr (&Sx_display_planes
);
5056 defsubr (&Sx_display_color_cells
);
5057 defsubr (&Sx_display_visual_class
);
5058 defsubr (&Sx_display_backing_store
);
5059 defsubr (&Sx_display_save_under
);
5061 defsubr (&Sx_rebind_key
);
5062 defsubr (&Sx_rebind_keys
);
5063 defsubr (&Sx_track_pointer
);
5064 defsubr (&Sx_grab_pointer
);
5065 defsubr (&Sx_ungrab_pointer
);
5067 defsubr (&Sx_parse_geometry
);
5068 defsubr (&Sx_create_frame
);
5069 defsubr (&Sfocus_frame
);
5070 defsubr (&Sunfocus_frame
);
5072 defsubr (&Sx_horizontal_line
);
5074 defsubr (&Sx_open_connection
);
5075 defsubr (&Sx_close_connection
);
5076 defsubr (&Sx_display_list
);
5077 defsubr (&Sx_synchronize
);
5080 #endif /* HAVE_X_WINDOWS */