(imenu--cleanup): Set alist to its default just once, at the beginning.
[emacs.git] / src / xfns.c
blobc62bdd4a090f56725f71b9d2e96a6850bae4def4
1 /* Functions for the X window system.
2 Copyright (C) 1989, 1992, 1993, 1994 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)
9 any later version.
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 */
24 #include <signal.h>
25 #include <config.h>
27 /* This makes the fields of a Display accessible, in Xlib header files. */
28 #define XLIB_ILLEGAL_ACCESS
30 #include "lisp.h"
31 #include "xterm.h"
32 #include "frame.h"
33 #include "window.h"
34 #include "buffer.h"
35 #include "dispextern.h"
36 #include "keyboard.h"
37 #include "blockinput.h"
38 #include "paths.h"
40 #ifdef HAVE_X_WINDOWS
41 extern void abort ();
43 #ifndef VMS
44 #if 1 /* Used to be #ifdef EMACS_BITMAP_FILES, but this should always work. */
45 #include "bitmaps/gray.xbm"
46 #else
47 #include <X11/bitmaps/gray>
48 #endif
49 #else
50 #include "[.bitmaps]gray.xbm"
51 #endif
53 #ifdef USE_X_TOOLKIT
54 #include <X11/Shell.h>
56 #include <X11/Xaw/Paned.h>
57 #include <X11/Xaw/Label.h>
59 #ifdef USG
60 #undef USG /* ####KLUDGE for Solaris 2.2 and up */
61 #include <X11/Xos.h>
62 #define USG
63 #else
64 #include <X11/Xos.h>
65 #endif
67 #include "widget.h"
69 #include "../lwlib/lwlib.h"
71 /* Do the EDITRES protocol if running X11R5 */
72 #if (XtSpecificationRelease >= 5)
73 #define HACK_EDITRES
74 extern void _XEditResCheckMessages ();
75 #endif /* R5 + Athena */
77 /* Unique id counter for widgets created by the Lucid Widget
78 Library. */
79 extern LWLIB_ID widget_id_tick;
81 /* This is part of a kludge--see lwlib/xlwmenu.c. */
82 XFontStruct *xlwmenu_default_font;
84 extern void free_frame_menubar ();
85 #endif /* USE_X_TOOLKIT */
87 #define min(a,b) ((a) < (b) ? (a) : (b))
88 #define max(a,b) ((a) > (b) ? (a) : (b))
90 #ifdef HAVE_X11R4
91 #define MAXREQUEST(dpy) (XMaxRequestSize (dpy))
92 #else
93 #define MAXREQUEST(dpy) ((dpy)->max_request_size)
94 #endif
96 /* The name we're using in resource queries. */
97 Lisp_Object Vx_resource_name;
99 /* The background and shape of the mouse pointer, and shape when not
100 over text or in the modeline. */
101 Lisp_Object Vx_pointer_shape, Vx_nontext_pointer_shape, Vx_mode_pointer_shape;
102 /* The shape when over mouse-sensitive text. */
103 Lisp_Object Vx_sensitive_text_pointer_shape;
105 /* Color of chars displayed in cursor box. */
106 Lisp_Object Vx_cursor_fore_pixel;
108 /* Nonzero if using X. */
109 static int x_in_use;
111 /* Non nil if no window manager is in use. */
112 Lisp_Object Vx_no_window_manager;
114 /* Search path for bitmap files. */
115 Lisp_Object Vx_bitmap_file_path;
117 /* Evaluate this expression to rebuild the section of syms_of_xfns
118 that initializes and staticpros the symbols declared below. Note
119 that Emacs 18 has a bug that keeps C-x C-e from being able to
120 evaluate this expression.
122 (progn
123 ;; Accumulate a list of the symbols we want to initialize from the
124 ;; declarations at the top of the file.
125 (goto-char (point-min))
126 (search-forward "/\*&&& symbols declared here &&&*\/\n")
127 (let (symbol-list)
128 (while (looking-at "Lisp_Object \\(Q[a-z_]+\\)")
129 (setq symbol-list
130 (cons (buffer-substring (match-beginning 1) (match-end 1))
131 symbol-list))
132 (forward-line 1))
133 (setq symbol-list (nreverse symbol-list))
134 ;; Delete the section of syms_of_... where we initialize the symbols.
135 (search-forward "\n /\*&&& init symbols here &&&*\/\n")
136 (let ((start (point)))
137 (while (looking-at "^ Q")
138 (forward-line 2))
139 (kill-region start (point)))
140 ;; Write a new symbol initialization section.
141 (while symbol-list
142 (insert (format " %s = intern (\"" (car symbol-list)))
143 (let ((start (point)))
144 (insert (substring (car symbol-list) 1))
145 (subst-char-in-region start (point) ?_ ?-))
146 (insert (format "\");\n staticpro (&%s);\n" (car symbol-list)))
147 (setq symbol-list (cdr symbol-list)))))
151 /*&&& symbols declared here &&&*/
152 Lisp_Object Qauto_raise;
153 Lisp_Object Qauto_lower;
154 Lisp_Object Qbackground_color;
155 Lisp_Object Qbar;
156 Lisp_Object Qborder_color;
157 Lisp_Object Qborder_width;
158 Lisp_Object Qbox;
159 Lisp_Object Qcursor_color;
160 Lisp_Object Qcursor_type;
161 Lisp_Object Qfont;
162 Lisp_Object Qforeground_color;
163 Lisp_Object Qgeometry;
164 Lisp_Object Qicon_left;
165 Lisp_Object Qicon_top;
166 Lisp_Object Qicon_type;
167 Lisp_Object Qinternal_border_width;
168 Lisp_Object Qleft;
169 Lisp_Object Qmouse_color;
170 Lisp_Object Qnone;
171 Lisp_Object Qparent_id;
172 Lisp_Object Qscroll_bar_width;
173 Lisp_Object Qsuppress_icon;
174 Lisp_Object Qtop;
175 Lisp_Object Qundefined_color;
176 Lisp_Object Qvertical_scroll_bars;
177 Lisp_Object Qvisibility;
178 Lisp_Object Qwindow_id;
179 Lisp_Object Qx_frame_parameter;
180 Lisp_Object Qx_resource_name;
181 Lisp_Object Quser_position;
182 Lisp_Object Quser_size;
183 Lisp_Object Qdisplay;
185 /* The below are defined in frame.c. */
186 extern Lisp_Object Qheight, Qminibuffer, Qname, Qonly, Qwidth;
187 extern Lisp_Object Qunsplittable, Qmenu_bar_lines;
189 extern Lisp_Object Vwindow_system_version;
192 /* Error if we are not connected to X. */
193 void
194 check_x ()
196 if (! x_in_use)
197 error ("X windows are not in use or not initialized");
200 /* Nonzero if using X for display. */
203 using_x_p ()
205 return x_in_use;
208 /* Extract a frame as a FRAME_PTR, defaulting to the selected frame
209 and checking validity for X. */
211 FRAME_PTR
212 check_x_frame (frame)
213 Lisp_Object frame;
215 FRAME_PTR f;
217 if (NILP (frame))
218 f = selected_frame;
219 else
221 CHECK_LIVE_FRAME (frame, 0);
222 f = XFRAME (frame);
224 if (! FRAME_X_P (f))
225 error ("non-X frame used");
226 return f;
229 /* Let the user specify an X display with a frame.
230 nil stands for the selected frame--or, if that is not an X frame,
231 the first X display on the list. */
233 static struct x_display_info *
234 check_x_display_info (frame)
235 Lisp_Object frame;
237 if (NILP (frame))
239 if (FRAME_X_P (selected_frame))
240 return FRAME_X_DISPLAY_INFO (selected_frame);
241 else if (x_display_list != 0)
242 return x_display_list;
243 else
244 error ("X windows are not in use or not initialized");
246 else if (STRINGP (frame))
247 return x_display_info_for_name (frame);
248 else
250 FRAME_PTR f;
252 CHECK_LIVE_FRAME (frame, 0);
253 f = XFRAME (frame);
254 if (! FRAME_X_P (f))
255 error ("non-X frame used");
256 return FRAME_X_DISPLAY_INFO (f);
260 /* Return the Emacs frame-object corresponding to an X window.
261 It could be the frame's main window or an icon window. */
263 /* This function can be called during GC, so use GC_xxx type test macros. */
265 struct frame *
266 x_window_to_frame (wdesc)
267 int wdesc;
269 Lisp_Object tail, frame;
270 struct frame *f;
272 for (tail = Vframe_list; GC_CONSP (tail); tail = XCONS (tail)->cdr)
274 frame = XCONS (tail)->car;
275 if (!GC_FRAMEP (frame))
276 continue;
277 f = XFRAME (frame);
278 #ifdef USE_X_TOOLKIT
279 if (f->display.nothing == 1)
280 return 0;
281 if ((f->display.x->edit_widget
282 && XtWindow (f->display.x->edit_widget) == wdesc)
283 || f->display.x->icon_desc == wdesc)
284 return f;
285 #else /* not USE_X_TOOLKIT */
286 if (FRAME_X_WINDOW (f) == wdesc
287 || f->display.x->icon_desc == wdesc)
288 return f;
289 #endif /* not USE_X_TOOLKIT */
291 return 0;
294 #ifdef USE_X_TOOLKIT
295 /* Like x_window_to_frame but also compares the window with the widget's
296 windows. */
298 struct frame *
299 x_any_window_to_frame (wdesc)
300 int wdesc;
302 Lisp_Object tail, frame;
303 struct frame *f;
304 struct x_display *x;
306 for (tail = Vframe_list; GC_CONSP (tail); tail = XCONS (tail)->cdr)
308 frame = XCONS (tail)->car;
309 if (!GC_FRAMEP (frame))
310 continue;
311 f = XFRAME (frame);
312 if (f->display.nothing == 1)
313 return 0;
314 x = f->display.x;
315 /* This frame matches if the window is any of its widgets. */
316 if (wdesc == XtWindow (x->widget)
317 || wdesc == XtWindow (x->column_widget)
318 || wdesc == XtWindow (x->edit_widget))
319 return f;
320 /* Match if the window is this frame's menubar. */
321 if (lw_window_is_in_menubar (wdesc, x->menubar_widget))
322 return f;
324 return 0;
327 /* Return the frame whose principal (outermost) window is WDESC.
328 If WDESC is some other (smaller) window, we return 0. */
330 struct frame *
331 x_top_window_to_frame (wdesc)
332 int wdesc;
334 Lisp_Object tail, frame;
335 struct frame *f;
336 struct x_display *x;
338 for (tail = Vframe_list; GC_CONSP (tail); tail = XCONS (tail)->cdr)
340 frame = XCONS (tail)->car;
341 if (!GC_FRAMEP (frame))
342 continue;
343 f = XFRAME (frame);
344 if (f->display.nothing == 1)
345 return 0;
346 x = f->display.x;
347 /* This frame matches if the window is its topmost widget. */
348 if (wdesc == XtWindow (x->widget))
349 return f;
350 /* Match if the window is this frame's menubar. */
351 if (x->menubar_widget
352 && wdesc == XtWindow (x->menubar_widget))
353 return f;
355 return 0;
357 #endif /* USE_X_TOOLKIT */
361 /* Code to deal with bitmaps. Bitmaps are referenced by their bitmap
362 id, which is just an int that this section returns. Bitmaps are
363 reference counted so they can be shared among frames.
365 Bitmap indices are guaranteed to be > 0, so a negative number can
366 be used to indicate no bitmap.
368 If you use x_create_bitmap_from_data, then you must keep track of
369 the bitmaps yourself. That is, creating a bitmap from the same
370 data more than once will not be caught. */
373 /* Functions to access the contents of a bitmap, given an id. */
376 x_bitmap_height (f, id)
377 FRAME_PTR f;
378 int id;
380 return FRAME_X_DISPLAY_INFO (f)->bitmaps[id - 1].height;
384 x_bitmap_width (f, id)
385 FRAME_PTR f;
386 int id;
388 return FRAME_X_DISPLAY_INFO (f)->bitmaps[id - 1].width;
392 x_bitmap_pixmap (f, id)
393 FRAME_PTR f;
394 int id;
396 return FRAME_X_DISPLAY_INFO (f)->bitmaps[id - 1].pixmap;
400 /* Allocate a new bitmap record. Returns index of new record. */
402 static int
403 x_allocate_bitmap_record (f)
404 FRAME_PTR f;
406 struct x_display_info *dpyinfo = FRAME_X_DISPLAY_INFO (f);
407 int i;
409 if (dpyinfo->bitmaps == NULL)
411 dpyinfo->bitmaps_size = 10;
412 dpyinfo->bitmaps
413 = (struct x_bitmap_record *) xmalloc (dpyinfo->bitmaps_size * sizeof (struct x_bitmap_record));
414 dpyinfo->bitmaps_last = 1;
415 return 1;
418 if (dpyinfo->bitmaps_last < dpyinfo->bitmaps_size)
419 return ++dpyinfo->bitmaps_last;
421 for (i = 0; i < dpyinfo->bitmaps_size; ++i)
422 if (dpyinfo->bitmaps[i].refcount == 0)
423 return i + 1;
425 dpyinfo->bitmaps_size *= 2;
426 dpyinfo->bitmaps
427 = (struct x_bitmap_record *) xrealloc (dpyinfo->bitmaps,
428 dpyinfo->bitmaps_size * sizeof (struct x_bitmap_record));
429 return ++dpyinfo->bitmaps_last;
432 /* Add one reference to the reference count of the bitmap with id ID. */
434 void
435 x_reference_bitmap (f, id)
436 FRAME_PTR f;
437 int id;
439 ++FRAME_X_DISPLAY_INFO (f)->bitmaps[id - 1].refcount;
442 /* Create a bitmap for frame F from a HEIGHT x WIDTH array of bits at BITS. */
445 x_create_bitmap_from_data (f, bits, width, height)
446 struct frame *f;
447 char *bits;
448 unsigned int width, height;
450 struct x_display_info *dpyinfo = FRAME_X_DISPLAY_INFO (f);
451 Pixmap bitmap;
452 int id;
454 bitmap = XCreateBitmapFromData (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
455 bits, width, height);
457 if (! bitmap)
458 return -1;
460 id = x_allocate_bitmap_record (f);
461 dpyinfo->bitmaps[id - 1].pixmap = bitmap;
462 dpyinfo->bitmaps[id - 1].file = NULL;
463 dpyinfo->bitmaps[id - 1].refcount = 1;
464 dpyinfo->bitmaps[id - 1].depth = 1;
465 dpyinfo->bitmaps[id - 1].height = height;
466 dpyinfo->bitmaps[id - 1].width = width;
468 return id;
471 /* Create bitmap from file FILE for frame F. */
474 x_create_bitmap_from_file (f, file)
475 struct frame *f;
476 Lisp_Object file;
478 struct x_display_info *dpyinfo = FRAME_X_DISPLAY_INFO (f);
479 unsigned int width, height;
480 Pixmap bitmap;
481 int xhot, yhot, result, id;
482 Lisp_Object found;
483 int fd;
484 char *filename;
486 /* Look for an existing bitmap with the same name. */
487 for (id = 0; id < dpyinfo->bitmaps_last; ++id)
489 if (dpyinfo->bitmaps[id].refcount
490 && dpyinfo->bitmaps[id].file
491 && !strcmp (dpyinfo->bitmaps[id].file, (char *) XSTRING (file)->data))
493 ++dpyinfo->bitmaps[id].refcount;
494 return id + 1;
498 /* Search bitmap-file-path for the file, if appropriate. */
499 fd = openp (Vx_bitmap_file_path, file, "", &found, 0);
500 if (fd < 0)
501 return -1;
502 close (fd);
504 filename = (char *) XSTRING (found)->data;
506 result = XReadBitmapFile (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
507 filename, &width, &height, &bitmap, &xhot, &yhot);
508 if (result != BitmapSuccess)
509 return -1;
511 id = x_allocate_bitmap_record (f);
512 dpyinfo->bitmaps[id - 1].pixmap = bitmap;
513 dpyinfo->bitmaps[id - 1].refcount = 1;
514 dpyinfo->bitmaps[id - 1].file = (char *) xmalloc (XSTRING (file)->size + 1);
515 dpyinfo->bitmaps[id - 1].depth = 1;
516 dpyinfo->bitmaps[id - 1].height = height;
517 dpyinfo->bitmaps[id - 1].width = width;
518 strcpy (dpyinfo->bitmaps[id - 1].file, XSTRING (file)->data);
520 return id;
523 /* Remove reference to bitmap with id number ID. */
526 x_destroy_bitmap (f, id)
527 FRAME_PTR f;
528 int id;
530 struct x_display_info *dpyinfo = FRAME_X_DISPLAY_INFO (f);
532 if (id > 0)
534 --dpyinfo->bitmaps[id - 1].refcount;
535 if (dpyinfo->bitmaps[id - 1].refcount == 0)
537 XFreePixmap (FRAME_X_DISPLAY (f), dpyinfo->bitmaps[id - 1].pixmap);
538 if (dpyinfo->bitmaps[id - 1].file)
540 free (dpyinfo->bitmaps[id - 1].file);
541 dpyinfo->bitmaps[id - 1].file = NULL;
547 /* Free all the bitmaps for the display specified by DPYINFO. */
549 static void
550 x_destroy_all_bitmaps (dpyinfo)
551 struct x_display_info *dpyinfo;
553 int i;
554 for (i = 0; i < dpyinfo->bitmaps_last; i++)
555 if (dpyinfo->bitmaps[i].refcount > 0)
557 XFreePixmap (dpyinfo->display, dpyinfo->bitmaps[i].pixmap);
558 if (dpyinfo->bitmaps[i].file)
559 free (dpyinfo->bitmaps[i].file);
561 dpyinfo->bitmaps_last = 0;
564 /* Connect the frame-parameter names for X frames
565 to the ways of passing the parameter values to the window system.
567 The name of a parameter, as a Lisp symbol,
568 has an `x-frame-parameter' property which is an integer in Lisp
569 but can be interpreted as an `enum x_frame_parm' in C. */
571 enum x_frame_parm
573 X_PARM_FOREGROUND_COLOR,
574 X_PARM_BACKGROUND_COLOR,
575 X_PARM_MOUSE_COLOR,
576 X_PARM_CURSOR_COLOR,
577 X_PARM_BORDER_COLOR,
578 X_PARM_ICON_TYPE,
579 X_PARM_FONT,
580 X_PARM_BORDER_WIDTH,
581 X_PARM_INTERNAL_BORDER_WIDTH,
582 X_PARM_NAME,
583 X_PARM_AUTORAISE,
584 X_PARM_AUTOLOWER,
585 X_PARM_VERT_SCROLL_BAR,
586 X_PARM_VISIBILITY,
587 X_PARM_MENU_BAR_LINES
591 struct x_frame_parm_table
593 char *name;
594 void (*setter)( /* struct frame *frame, Lisp_Object val, oldval */ );
597 void x_set_foreground_color ();
598 void x_set_background_color ();
599 void x_set_mouse_color ();
600 void x_set_cursor_color ();
601 void x_set_border_color ();
602 void x_set_cursor_type ();
603 void x_set_icon_type ();
604 void x_set_font ();
605 void x_set_border_width ();
606 void x_set_internal_border_width ();
607 void x_explicitly_set_name ();
608 void x_set_autoraise ();
609 void x_set_autolower ();
610 void x_set_vertical_scroll_bars ();
611 void x_set_visibility ();
612 void x_set_menu_bar_lines ();
613 void x_set_scroll_bar_width ();
614 void x_set_unsplittable ();
616 static struct x_frame_parm_table x_frame_parms[] =
618 "foreground-color", x_set_foreground_color,
619 "background-color", x_set_background_color,
620 "mouse-color", x_set_mouse_color,
621 "cursor-color", x_set_cursor_color,
622 "border-color", x_set_border_color,
623 "cursor-type", x_set_cursor_type,
624 "icon-type", x_set_icon_type,
625 "font", x_set_font,
626 "border-width", x_set_border_width,
627 "internal-border-width", x_set_internal_border_width,
628 "name", x_explicitly_set_name,
629 "auto-raise", x_set_autoraise,
630 "auto-lower", x_set_autolower,
631 "vertical-scroll-bars", x_set_vertical_scroll_bars,
632 "visibility", x_set_visibility,
633 "menu-bar-lines", x_set_menu_bar_lines,
634 "scroll-bar-width", x_set_scroll_bar_width,
635 "unsplittable", x_set_unsplittable,
638 /* Attach the `x-frame-parameter' properties to
639 the Lisp symbol names of parameters relevant to X. */
641 init_x_parm_symbols ()
643 int i;
645 for (i = 0; i < sizeof (x_frame_parms) / sizeof (x_frame_parms[0]); i++)
646 Fput (intern (x_frame_parms[i].name), Qx_frame_parameter,
647 make_number (i));
650 /* Change the parameters of FRAME as specified by ALIST.
651 If a parameter is not specially recognized, do nothing;
652 otherwise call the `x_set_...' function for that parameter. */
654 void
655 x_set_frame_parameters (f, alist)
656 FRAME_PTR f;
657 Lisp_Object alist;
659 Lisp_Object tail;
661 /* If both of these parameters are present, it's more efficient to
662 set them both at once. So we wait until we've looked at the
663 entire list before we set them. */
664 Lisp_Object width, height;
666 /* Same here. */
667 Lisp_Object left, top;
669 /* Same with these. */
670 Lisp_Object icon_left, icon_top;
672 /* Record in these vectors all the parms specified. */
673 Lisp_Object *parms;
674 Lisp_Object *values;
675 int i;
676 int left_no_change = 0, top_no_change = 0;
677 int icon_left_no_change = 0, icon_top_no_change = 0;
679 i = 0;
680 for (tail = alist; CONSP (tail); tail = Fcdr (tail))
681 i++;
683 parms = (Lisp_Object *) alloca (i * sizeof (Lisp_Object));
684 values = (Lisp_Object *) alloca (i * sizeof (Lisp_Object));
686 /* Extract parm names and values into those vectors. */
688 i = 0;
689 for (tail = alist; CONSP (tail); tail = Fcdr (tail))
691 Lisp_Object elt, prop, val;
693 elt = Fcar (tail);
694 parms[i] = Fcar (elt);
695 values[i] = Fcdr (elt);
696 i++;
699 width = height = top = left = Qunbound;
700 icon_left = icon_top = Qunbound;
702 /* Now process them in reverse of specified order. */
703 for (i--; i >= 0; i--)
705 Lisp_Object prop, val;
707 prop = parms[i];
708 val = values[i];
710 if (EQ (prop, Qwidth))
711 width = val;
712 else if (EQ (prop, Qheight))
713 height = val;
714 else if (EQ (prop, Qtop))
715 top = val;
716 else if (EQ (prop, Qleft))
717 left = val;
718 else if (EQ (prop, Qicon_top))
719 icon_top = val;
720 else if (EQ (prop, Qicon_left))
721 icon_left = val;
722 else
724 register Lisp_Object param_index, old_value;
726 param_index = Fget (prop, Qx_frame_parameter);
727 old_value = get_frame_param (f, prop);
728 store_frame_param (f, prop, val);
729 if (NATNUMP (param_index)
730 && (XFASTINT (param_index)
731 < sizeof (x_frame_parms)/sizeof (x_frame_parms[0])))
732 (*x_frame_parms[XINT (param_index)].setter)(f, val, old_value);
736 /* Don't die if just one of these was set. */
737 if (EQ (left, Qunbound))
739 left_no_change = 1;
740 if (f->display.x->left_pos < 0)
741 left = Fcons (Qplus, Fcons (make_number (f->display.x->left_pos), Qnil));
742 else
743 XSETINT (left, f->display.x->left_pos);
745 if (EQ (top, Qunbound))
747 top_no_change = 1;
748 if (f->display.x->top_pos < 0)
749 top = Fcons (Qplus, Fcons (make_number (f->display.x->top_pos), Qnil));
750 else
751 XSETINT (top, f->display.x->top_pos);
754 /* If one of the icon positions was not set, preserve or default it. */
755 if (EQ (icon_left, Qunbound) || ! INTEGERP (icon_left))
757 icon_left_no_change = 1;
758 icon_left = Fcdr (Fassq (Qicon_left, f->param_alist));
759 if (NILP (icon_left))
760 XSETINT (icon_left, 0);
762 if (EQ (icon_top, Qunbound) || ! INTEGERP (icon_top))
764 icon_top_no_change = 1;
765 icon_top = Fcdr (Fassq (Qicon_top, f->param_alist));
766 if (NILP (icon_top))
767 XSETINT (icon_top, 0);
770 /* Don't die if just one of these was set. */
771 if (EQ (width, Qunbound))
772 XSETINT (width, FRAME_WIDTH (f));
773 if (EQ (height, Qunbound))
774 XSETINT (height, FRAME_HEIGHT (f));
776 /* Don't set these parameters these unless they've been explicitly
777 specified. The window might be mapped or resized while we're in
778 this function, and we don't want to override that unless the lisp
779 code has asked for it.
781 Don't set these parameters unless they actually differ from the
782 window's current parameters; the window may not actually exist
783 yet. */
785 Lisp_Object frame;
787 check_frame_size (f, &height, &width);
789 XSETFRAME (frame, f);
791 if ((NUMBERP (width) && XINT (width) != FRAME_WIDTH (f))
792 || (NUMBERP (height) && XINT (height) != FRAME_HEIGHT (f)))
793 Fset_frame_size (frame, width, height);
795 if ((!NILP (left) || !NILP (top))
796 && ! (left_no_change && top_no_change)
797 && ! (NUMBERP (left) && XINT (left) == f->display.x->left_pos
798 && NUMBERP (top) && XINT (top) == f->display.x->top_pos))
800 int leftpos = 0;
801 int toppos = 0;
803 /* Record the signs. */
804 f->display.x->size_hint_flags &= ~ (XNegative | YNegative);
805 if (EQ (left, Qminus))
806 f->display.x->size_hint_flags |= XNegative;
807 else if (INTEGERP (left))
809 leftpos = XINT (left);
810 if (leftpos < 0)
811 f->display.x->size_hint_flags |= XNegative;
813 else if (CONSP (left) && EQ (XCONS (left)->car, Qminus)
814 && CONSP (XCONS (left)->cdr)
815 && INTEGERP (XCONS (XCONS (left)->cdr)->car))
817 leftpos = - XINT (XCONS (XCONS (left)->cdr)->car);
818 f->display.x->size_hint_flags |= XNegative;
820 else if (CONSP (left) && EQ (XCONS (left)->car, Qplus)
821 && CONSP (XCONS (left)->cdr)
822 && INTEGERP (XCONS (XCONS (left)->cdr)->car))
824 leftpos = XINT (XCONS (XCONS (left)->cdr)->car);
827 if (EQ (top, Qminus))
828 f->display.x->size_hint_flags |= YNegative;
829 else if (INTEGERP (top))
831 toppos = XINT (top);
832 if (toppos < 0)
833 f->display.x->size_hint_flags |= YNegative;
835 else if (CONSP (top) && EQ (XCONS (top)->car, Qminus)
836 && CONSP (XCONS (top)->cdr)
837 && INTEGERP (XCONS (XCONS (top)->cdr)->car))
839 toppos = - XINT (XCONS (XCONS (top)->cdr)->car);
840 f->display.x->size_hint_flags |= YNegative;
842 else if (CONSP (top) && EQ (XCONS (top)->car, Qplus)
843 && CONSP (XCONS (top)->cdr)
844 && INTEGERP (XCONS (XCONS (top)->cdr)->car))
846 toppos = XINT (XCONS (XCONS (top)->cdr)->car);
850 /* Store the numeric value of the position. */
851 f->display.x->top_pos = toppos;
852 f->display.x->left_pos = leftpos;
854 f->display.x->win_gravity = NorthWestGravity;
856 /* Actually set that position, and convert to absolute. */
857 x_set_offset (f, leftpos, toppos, 0);
860 if ((!NILP (icon_left) || !NILP (icon_top))
861 && ! (icon_left_no_change && icon_top_no_change))
862 x_wm_set_icon_position (f, XINT (icon_left), XINT (icon_top));
866 /* Store the screen positions of frame F into XPTR and YPTR.
867 These are the positions of the containing window manager window,
868 not Emacs's own window. */
870 void
871 x_real_positions (f, xptr, yptr)
872 FRAME_PTR f;
873 int *xptr, *yptr;
875 int win_x, win_y;
876 Window child;
878 /* This is pretty gross, but seems to be the easiest way out of
879 the problem that arises when restarting window-managers. */
881 #ifdef USE_X_TOOLKIT
882 Window outer = XtWindow (f->display.x->widget);
883 #else
884 Window outer = f->display.x->window_desc;
885 #endif
886 Window tmp_root_window;
887 Window *tmp_children;
888 int tmp_nchildren;
890 x_catch_errors (FRAME_X_DISPLAY (f));
891 while (1)
893 XQueryTree (FRAME_X_DISPLAY (f), outer, &tmp_root_window,
894 &f->display.x->parent_desc,
895 &tmp_children, &tmp_nchildren);
896 xfree (tmp_children);
898 win_x = win_y = 0;
900 /* Find the position of the outside upper-left corner of
901 the inner window, with respect to the outer window. */
902 if (f->display.x->parent_desc != FRAME_X_DISPLAY_INFO (f)->root_window)
904 XTranslateCoordinates (FRAME_X_DISPLAY (f),
906 /* From-window, to-window. */
907 #ifdef USE_X_TOOLKIT
908 XtWindow (f->display.x->widget),
909 #else
910 f->display.x->window_desc,
911 #endif
912 f->display.x->parent_desc,
914 /* From-position, to-position. */
915 0, 0, &win_x, &win_y,
917 /* Child of win. */
918 &child);
920 win_x += f->display.x->border_width;
921 win_y += f->display.x->border_width;
924 /* It is possible for the window returned by the XQueryNotify
925 to become invalid by the time we call XTranslateCoordinates.
926 That can happen when you restart some window managers.
927 If so, we get an error in XTranslateCoordinates.
928 Detect that and try the whole thing over. */
929 if (! x_had_errors_p (FRAME_X_DISPLAY (f)))
930 break;
933 x_uncatch_errors (FRAME_X_DISPLAY (f));
935 *xptr = f->display.x->left_pos - win_x;
936 *yptr = f->display.x->top_pos - win_y;
939 /* Insert a description of internally-recorded parameters of frame X
940 into the parameter alist *ALISTPTR that is to be given to the user.
941 Only parameters that are specific to the X window system
942 and whose values are not correctly recorded in the frame's
943 param_alist need to be considered here. */
945 x_report_frame_params (f, alistptr)
946 struct frame *f;
947 Lisp_Object *alistptr;
949 char buf[16];
951 store_in_alist (alistptr, Qleft, make_number (f->display.x->left_pos));
952 store_in_alist (alistptr, Qtop, make_number (f->display.x->top_pos));
953 store_in_alist (alistptr, Qborder_width,
954 make_number (f->display.x->border_width));
955 store_in_alist (alistptr, Qinternal_border_width,
956 make_number (f->display.x->internal_border_width));
957 sprintf (buf, "%ld", (long) FRAME_X_WINDOW (f));
958 store_in_alist (alistptr, Qwindow_id,
959 build_string (buf));
960 FRAME_SAMPLE_VISIBILITY (f);
961 store_in_alist (alistptr, Qvisibility,
962 (FRAME_VISIBLE_P (f) ? Qt
963 : FRAME_ICONIFIED_P (f) ? Qicon : Qnil));
966 /* Decide if color named COLOR is valid for the display associated with
967 the selected frame; if so, return the rgb values in COLOR_DEF.
968 If ALLOC is nonzero, allocate a new colormap cell. */
971 defined_color (f, color, color_def, alloc)
972 FRAME_PTR f;
973 char *color;
974 XColor *color_def;
975 int alloc;
977 register int foo;
978 Colormap screen_colormap;
980 BLOCK_INPUT;
981 screen_colormap
982 = DefaultColormap (FRAME_X_DISPLAY (f),
983 XDefaultScreen (FRAME_X_DISPLAY (f)));
985 foo = XParseColor (FRAME_X_DISPLAY (f), screen_colormap, color, color_def);
986 if (foo && alloc)
987 foo = XAllocColor (FRAME_X_DISPLAY (f), screen_colormap, color_def);
988 UNBLOCK_INPUT;
990 if (foo)
991 return 1;
992 else
993 return 0;
996 /* Given a string ARG naming a color, compute a pixel value from it
997 suitable for screen F.
998 If F is not a color screen, return DEF (default) regardless of what
999 ARG says. */
1002 x_decode_color (f, arg, def)
1003 FRAME_PTR f;
1004 Lisp_Object arg;
1005 int def;
1007 XColor cdef;
1009 CHECK_STRING (arg, 0);
1011 if (strcmp (XSTRING (arg)->data, "black") == 0)
1012 return BLACK_PIX_DEFAULT (f);
1013 else if (strcmp (XSTRING (arg)->data, "white") == 0)
1014 return WHITE_PIX_DEFAULT (f);
1016 if (FRAME_X_DISPLAY_INFO (f)->n_planes == 1)
1017 return def;
1019 /* Ignore the return value of defined_color so that
1020 we use a color close to the one requested
1021 if we can't get the exact request. */
1022 defined_color (f, XSTRING (arg)->data, &cdef, 1);
1023 return cdef.pixel;
1026 /* Functions called only from `x_set_frame_param'
1027 to set individual parameters.
1029 If FRAME_X_WINDOW (f) is 0,
1030 the frame is being created and its X-window does not exist yet.
1031 In that case, just record the parameter's new value
1032 in the standard place; do not attempt to change the window. */
1034 void
1035 x_set_foreground_color (f, arg, oldval)
1036 struct frame *f;
1037 Lisp_Object arg, oldval;
1039 f->display.x->foreground_pixel
1040 = x_decode_color (f, arg, BLACK_PIX_DEFAULT (f));
1041 if (FRAME_X_WINDOW (f) != 0)
1043 BLOCK_INPUT;
1044 XSetForeground (FRAME_X_DISPLAY (f), f->display.x->normal_gc,
1045 f->display.x->foreground_pixel);
1046 XSetBackground (FRAME_X_DISPLAY (f), f->display.x->reverse_gc,
1047 f->display.x->foreground_pixel);
1048 UNBLOCK_INPUT;
1049 recompute_basic_faces (f);
1050 if (FRAME_VISIBLE_P (f))
1051 redraw_frame (f);
1055 void
1056 x_set_background_color (f, arg, oldval)
1057 struct frame *f;
1058 Lisp_Object arg, oldval;
1060 Pixmap temp;
1061 int mask;
1063 f->display.x->background_pixel
1064 = x_decode_color (f, arg, WHITE_PIX_DEFAULT (f));
1066 if (FRAME_X_WINDOW (f) != 0)
1068 BLOCK_INPUT;
1069 /* The main frame area. */
1070 XSetBackground (FRAME_X_DISPLAY (f), f->display.x->normal_gc,
1071 f->display.x->background_pixel);
1072 XSetForeground (FRAME_X_DISPLAY (f), f->display.x->reverse_gc,
1073 f->display.x->background_pixel);
1074 XSetForeground (FRAME_X_DISPLAY (f), f->display.x->cursor_gc,
1075 f->display.x->background_pixel);
1076 XSetWindowBackground (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
1077 f->display.x->background_pixel);
1079 Lisp_Object bar;
1080 for (bar = FRAME_SCROLL_BARS (f); !NILP (bar);
1081 bar = XSCROLL_BAR (bar)->next)
1082 XSetWindowBackground (FRAME_X_DISPLAY (f),
1083 SCROLL_BAR_X_WINDOW (XSCROLL_BAR (bar)),
1084 f->display.x->background_pixel);
1086 UNBLOCK_INPUT;
1088 recompute_basic_faces (f);
1090 if (FRAME_VISIBLE_P (f))
1091 redraw_frame (f);
1095 void
1096 x_set_mouse_color (f, arg, oldval)
1097 struct frame *f;
1098 Lisp_Object arg, oldval;
1100 Cursor cursor, nontext_cursor, mode_cursor, cross_cursor;
1101 int mask_color;
1103 if (!EQ (Qnil, arg))
1104 f->display.x->mouse_pixel
1105 = x_decode_color (f, arg, BLACK_PIX_DEFAULT (f));
1106 mask_color = f->display.x->background_pixel;
1107 /* No invisible pointers. */
1108 if (mask_color == f->display.x->mouse_pixel
1109 && mask_color == f->display.x->background_pixel)
1110 f->display.x->mouse_pixel = f->display.x->foreground_pixel;
1112 BLOCK_INPUT;
1114 /* It's not okay to crash if the user selects a screwy cursor. */
1115 x_catch_errors (FRAME_X_DISPLAY (f));
1117 if (!EQ (Qnil, Vx_pointer_shape))
1119 CHECK_NUMBER (Vx_pointer_shape, 0);
1120 cursor = XCreateFontCursor (FRAME_X_DISPLAY (f), XINT (Vx_pointer_shape));
1122 else
1123 cursor = XCreateFontCursor (FRAME_X_DISPLAY (f), XC_xterm);
1124 x_check_errors (FRAME_X_DISPLAY (f), "bad text pointer cursor: %s");
1126 if (!EQ (Qnil, Vx_nontext_pointer_shape))
1128 CHECK_NUMBER (Vx_nontext_pointer_shape, 0);
1129 nontext_cursor = XCreateFontCursor (FRAME_X_DISPLAY (f),
1130 XINT (Vx_nontext_pointer_shape));
1132 else
1133 nontext_cursor = XCreateFontCursor (FRAME_X_DISPLAY (f), XC_left_ptr);
1134 x_check_errors (FRAME_X_DISPLAY (f), "bad nontext pointer cursor: %s");
1136 if (!EQ (Qnil, Vx_mode_pointer_shape))
1138 CHECK_NUMBER (Vx_mode_pointer_shape, 0);
1139 mode_cursor = XCreateFontCursor (FRAME_X_DISPLAY (f),
1140 XINT (Vx_mode_pointer_shape));
1142 else
1143 mode_cursor = XCreateFontCursor (FRAME_X_DISPLAY (f), XC_xterm);
1144 x_check_errors (FRAME_X_DISPLAY (f), "bad modeline pointer cursor: %s");
1146 if (!EQ (Qnil, Vx_sensitive_text_pointer_shape))
1148 CHECK_NUMBER (Vx_sensitive_text_pointer_shape, 0);
1149 cross_cursor
1150 = XCreateFontCursor (FRAME_X_DISPLAY (f),
1151 XINT (Vx_sensitive_text_pointer_shape));
1153 else
1154 cross_cursor = XCreateFontCursor (FRAME_X_DISPLAY (f), XC_crosshair);
1156 /* Check and report errors with the above calls. */
1157 x_check_errors (FRAME_X_DISPLAY (f), "can't set cursor shape: %s");
1158 x_uncatch_errors (FRAME_X_DISPLAY (f));
1161 XColor fore_color, back_color;
1163 fore_color.pixel = f->display.x->mouse_pixel;
1164 back_color.pixel = mask_color;
1165 XQueryColor (FRAME_X_DISPLAY (f),
1166 DefaultColormap (FRAME_X_DISPLAY (f),
1167 DefaultScreen (FRAME_X_DISPLAY (f))),
1168 &fore_color);
1169 XQueryColor (FRAME_X_DISPLAY (f),
1170 DefaultColormap (FRAME_X_DISPLAY (f),
1171 DefaultScreen (FRAME_X_DISPLAY (f))),
1172 &back_color);
1173 XRecolorCursor (FRAME_X_DISPLAY (f), cursor,
1174 &fore_color, &back_color);
1175 XRecolorCursor (FRAME_X_DISPLAY (f), nontext_cursor,
1176 &fore_color, &back_color);
1177 XRecolorCursor (FRAME_X_DISPLAY (f), mode_cursor,
1178 &fore_color, &back_color);
1179 XRecolorCursor (FRAME_X_DISPLAY (f), cross_cursor,
1180 &fore_color, &back_color);
1183 if (FRAME_X_WINDOW (f) != 0)
1185 XDefineCursor (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f), cursor);
1188 if (cursor != f->display.x->text_cursor && f->display.x->text_cursor != 0)
1189 XFreeCursor (FRAME_X_DISPLAY (f), f->display.x->text_cursor);
1190 f->display.x->text_cursor = cursor;
1192 if (nontext_cursor != f->display.x->nontext_cursor
1193 && f->display.x->nontext_cursor != 0)
1194 XFreeCursor (FRAME_X_DISPLAY (f), f->display.x->nontext_cursor);
1195 f->display.x->nontext_cursor = nontext_cursor;
1197 if (mode_cursor != f->display.x->modeline_cursor
1198 && f->display.x->modeline_cursor != 0)
1199 XFreeCursor (FRAME_X_DISPLAY (f), f->display.x->modeline_cursor);
1200 f->display.x->modeline_cursor = mode_cursor;
1201 if (cross_cursor != f->display.x->cross_cursor
1202 && f->display.x->cross_cursor != 0)
1203 XFreeCursor (FRAME_X_DISPLAY (f), f->display.x->cross_cursor);
1204 f->display.x->cross_cursor = cross_cursor;
1206 XFlush (FRAME_X_DISPLAY (f));
1207 UNBLOCK_INPUT;
1210 void
1211 x_set_cursor_color (f, arg, oldval)
1212 struct frame *f;
1213 Lisp_Object arg, oldval;
1215 unsigned long fore_pixel;
1217 if (!EQ (Vx_cursor_fore_pixel, Qnil))
1218 fore_pixel = x_decode_color (f, Vx_cursor_fore_pixel,
1219 WHITE_PIX_DEFAULT (f));
1220 else
1221 fore_pixel = f->display.x->background_pixel;
1222 f->display.x->cursor_pixel = x_decode_color (f, arg, BLACK_PIX_DEFAULT (f));
1224 /* Make sure that the cursor color differs from the background color. */
1225 if (f->display.x->cursor_pixel == f->display.x->background_pixel)
1227 f->display.x->cursor_pixel = f->display.x->mouse_pixel;
1228 if (f->display.x->cursor_pixel == fore_pixel)
1229 fore_pixel = f->display.x->background_pixel;
1231 f->display.x->cursor_foreground_pixel = fore_pixel;
1233 if (FRAME_X_WINDOW (f) != 0)
1235 BLOCK_INPUT;
1236 XSetBackground (FRAME_X_DISPLAY (f), f->display.x->cursor_gc,
1237 f->display.x->cursor_pixel);
1238 XSetForeground (FRAME_X_DISPLAY (f), f->display.x->cursor_gc,
1239 fore_pixel);
1240 UNBLOCK_INPUT;
1242 if (FRAME_VISIBLE_P (f))
1244 x_display_cursor (f, 0);
1245 x_display_cursor (f, 1);
1250 /* Set the border-color of frame F to value described by ARG.
1251 ARG can be a string naming a color.
1252 The border-color is used for the border that is drawn by the X server.
1253 Note that this does not fully take effect if done before
1254 F has an x-window; it must be redone when the window is created.
1256 Note: this is done in two routines because of the way X10 works.
1258 Note: under X11, this is normally the province of the window manager,
1259 and so emacs' border colors may be overridden. */
1261 void
1262 x_set_border_color (f, arg, oldval)
1263 struct frame *f;
1264 Lisp_Object arg, oldval;
1266 unsigned char *str;
1267 int pix;
1269 CHECK_STRING (arg, 0);
1270 str = XSTRING (arg)->data;
1272 pix = x_decode_color (f, arg, BLACK_PIX_DEFAULT (f));
1274 x_set_border_pixel (f, pix);
1277 /* Set the border-color of frame F to pixel value PIX.
1278 Note that this does not fully take effect if done before
1279 F has an x-window. */
1281 x_set_border_pixel (f, pix)
1282 struct frame *f;
1283 int pix;
1285 f->display.x->border_pixel = pix;
1287 if (FRAME_X_WINDOW (f) != 0 && f->display.x->border_width > 0)
1289 Pixmap temp;
1290 int mask;
1292 BLOCK_INPUT;
1293 XSetWindowBorder (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
1294 pix);
1295 UNBLOCK_INPUT;
1297 if (FRAME_VISIBLE_P (f))
1298 redraw_frame (f);
1302 void
1303 x_set_cursor_type (f, arg, oldval)
1304 FRAME_PTR f;
1305 Lisp_Object arg, oldval;
1307 if (EQ (arg, Qbar))
1309 FRAME_DESIRED_CURSOR (f) = bar_cursor;
1310 f->display.x->cursor_width = 2;
1312 else if (CONSP (arg) && EQ (XCONS (arg)->car, Qbar)
1313 && INTEGERP (XCONS (arg)->cdr))
1315 FRAME_DESIRED_CURSOR (f) = bar_cursor;
1316 f->display.x->cursor_width = XINT (XCONS (arg)->cdr);
1318 else
1319 /* Treat anything unknown as "box cursor".
1320 It was bad to signal an error; people have trouble fixing
1321 .Xdefaults with Emacs, when it has something bad in it. */
1322 FRAME_DESIRED_CURSOR (f) = filled_box_cursor;
1324 /* Make sure the cursor gets redrawn. This is overkill, but how
1325 often do people change cursor types? */
1326 update_mode_lines++;
1329 void
1330 x_set_icon_type (f, arg, oldval)
1331 struct frame *f;
1332 Lisp_Object arg, oldval;
1334 Lisp_Object tem;
1335 int result;
1337 if (STRINGP (arg))
1339 if (STRINGP (oldval) && EQ (Fstring_equal (oldval, arg), Qt))
1340 return;
1342 else if (!STRINGP (oldval) && EQ (oldval, Qnil) == EQ (arg, Qnil))
1343 return;
1345 BLOCK_INPUT;
1346 if (NILP (arg))
1347 result = x_text_icon (f, 0);
1348 else
1349 result = x_bitmap_icon (f, arg);
1351 if (result)
1353 UNBLOCK_INPUT;
1354 error ("No icon window available");
1357 /* If the window was unmapped (and its icon was mapped),
1358 the new icon is not mapped, so map the window in its stead. */
1359 if (FRAME_VISIBLE_P (f))
1361 #ifdef USE_X_TOOLKIT
1362 XtPopup (f->display.x->widget, XtGrabNone);
1363 #endif
1364 XMapWindow (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f));
1367 XFlush (FRAME_X_DISPLAY (f));
1368 UNBLOCK_INPUT;
1371 /* Return non-nil if frame F wants a bitmap icon. */
1373 Lisp_Object
1374 x_icon_type (f)
1375 FRAME_PTR f;
1377 Lisp_Object tem;
1379 tem = assq_no_quit (Qicon_type, f->param_alist);
1380 if (CONSP (tem))
1381 return XCONS (tem)->cdr;
1382 else
1383 return Qnil;
1386 extern Lisp_Object x_new_font ();
1388 void
1389 x_set_font (f, arg, oldval)
1390 struct frame *f;
1391 Lisp_Object arg, oldval;
1393 Lisp_Object result;
1395 CHECK_STRING (arg, 1);
1397 BLOCK_INPUT;
1398 result = x_new_font (f, XSTRING (arg)->data);
1399 UNBLOCK_INPUT;
1401 if (EQ (result, Qnil))
1402 error ("Font \"%s\" is not defined", XSTRING (arg)->data);
1403 else if (EQ (result, Qt))
1404 error ("the characters of the given font have varying widths");
1405 else if (STRINGP (result))
1407 recompute_basic_faces (f);
1408 store_frame_param (f, Qfont, result);
1410 else
1411 abort ();
1414 void
1415 x_set_border_width (f, arg, oldval)
1416 struct frame *f;
1417 Lisp_Object arg, oldval;
1419 CHECK_NUMBER (arg, 0);
1421 if (XINT (arg) == f->display.x->border_width)
1422 return;
1424 if (FRAME_X_WINDOW (f) != 0)
1425 error ("Cannot change the border width of a window");
1427 f->display.x->border_width = XINT (arg);
1430 void
1431 x_set_internal_border_width (f, arg, oldval)
1432 struct frame *f;
1433 Lisp_Object arg, oldval;
1435 int mask;
1436 int old = f->display.x->internal_border_width;
1438 CHECK_NUMBER (arg, 0);
1439 f->display.x->internal_border_width = XINT (arg);
1440 if (f->display.x->internal_border_width < 0)
1441 f->display.x->internal_border_width = 0;
1443 if (f->display.x->internal_border_width == old)
1444 return;
1446 if (FRAME_X_WINDOW (f) != 0)
1448 BLOCK_INPUT;
1449 x_set_window_size (f, 0, f->width, f->height);
1450 #if 0
1451 x_set_resize_hint (f);
1452 #endif
1453 XFlush (FRAME_X_DISPLAY (f));
1454 UNBLOCK_INPUT;
1455 SET_FRAME_GARBAGED (f);
1459 void
1460 x_set_visibility (f, value, oldval)
1461 struct frame *f;
1462 Lisp_Object value, oldval;
1464 Lisp_Object frame;
1465 XSETFRAME (frame, f);
1467 if (NILP (value))
1468 Fmake_frame_invisible (frame, Qt);
1469 else if (EQ (value, Qicon))
1470 Ficonify_frame (frame);
1471 else
1472 Fmake_frame_visible (frame);
1475 static void
1476 x_set_menu_bar_lines_1 (window, n)
1477 Lisp_Object window;
1478 int n;
1480 struct window *w = XWINDOW (window);
1482 XSETFASTINT (w->top, XFASTINT (w->top) + n);
1483 XSETFASTINT (w->height, XFASTINT (w->height) - n);
1485 /* Handle just the top child in a vertical split. */
1486 if (!NILP (w->vchild))
1487 x_set_menu_bar_lines_1 (w->vchild, n);
1489 /* Adjust all children in a horizontal split. */
1490 for (window = w->hchild; !NILP (window); window = w->next)
1492 w = XWINDOW (window);
1493 x_set_menu_bar_lines_1 (window, n);
1497 void
1498 x_set_menu_bar_lines (f, value, oldval)
1499 struct frame *f;
1500 Lisp_Object value, oldval;
1502 int nlines;
1503 int olines = FRAME_MENU_BAR_LINES (f);
1505 /* Right now, menu bars don't work properly in minibuf-only frames;
1506 most of the commands try to apply themselves to the minibuffer
1507 frame itslef, and get an error because you can't switch buffers
1508 in or split the minibuffer window. */
1509 if (FRAME_MINIBUF_ONLY_P (f))
1510 return;
1512 if (INTEGERP (value))
1513 nlines = XINT (value);
1514 else
1515 nlines = 0;
1517 #ifdef USE_X_TOOLKIT
1518 FRAME_MENU_BAR_LINES (f) = 0;
1519 if (nlines)
1520 FRAME_EXTERNAL_MENU_BAR (f) = 1;
1521 else
1523 if (FRAME_EXTERNAL_MENU_BAR (f) == 1)
1524 free_frame_menubar (f);
1525 FRAME_EXTERNAL_MENU_BAR (f) = 0;
1526 f->display.x->menubar_widget = 0;
1528 #else /* not USE_X_TOOLKIT */
1529 FRAME_MENU_BAR_LINES (f) = nlines;
1530 x_set_menu_bar_lines_1 (f->root_window, nlines - olines);
1531 #endif /* not USE_X_TOOLKIT */
1534 /* Change the name of frame F to NAME. If NAME is nil, set F's name to
1535 x_id_name.
1537 If EXPLICIT is non-zero, that indicates that lisp code is setting the
1538 name; if NAME is a string, set F's name to NAME and set
1539 F->explicit_name; if NAME is Qnil, then clear F->explicit_name.
1541 If EXPLICIT is zero, that indicates that Emacs redisplay code is
1542 suggesting a new name, which lisp code should override; if
1543 F->explicit_name is set, ignore the new name; otherwise, set it. */
1545 void
1546 x_set_name (f, name, explicit)
1547 struct frame *f;
1548 Lisp_Object name;
1549 int explicit;
1551 /* Make sure that requests from lisp code override requests from
1552 Emacs redisplay code. */
1553 if (explicit)
1555 /* If we're switching from explicit to implicit, we had better
1556 update the mode lines and thereby update the title. */
1557 if (f->explicit_name && NILP (name))
1558 update_mode_lines = 1;
1560 f->explicit_name = ! NILP (name);
1562 else if (f->explicit_name)
1563 return;
1565 /* If NAME is nil, set the name to the x_id_name. */
1566 if (NILP (name))
1568 /* Check for no change needed in this very common case
1569 before we do any consing. */
1570 if (!strcmp (FRAME_X_DISPLAY_INFO (f)->x_id_name,
1571 XSTRING (f->name)->data))
1572 return;
1573 name = build_string (FRAME_X_DISPLAY_INFO (f)->x_id_name);
1575 else
1576 CHECK_STRING (name, 0);
1578 /* Don't change the name if it's already NAME. */
1579 if (! NILP (Fstring_equal (name, f->name)))
1580 return;
1582 if (FRAME_X_WINDOW (f))
1584 BLOCK_INPUT;
1585 #ifdef HAVE_X11R4
1587 XTextProperty text;
1588 text.value = XSTRING (name)->data;
1589 text.encoding = XA_STRING;
1590 text.format = 8;
1591 text.nitems = XSTRING (name)->size;
1592 #ifdef USE_X_TOOLKIT
1593 XSetWMName (FRAME_X_DISPLAY (f),
1594 XtWindow (f->display.x->widget), &text);
1595 XSetWMIconName (FRAME_X_DISPLAY (f), XtWindow (f->display.x->widget),
1596 &text);
1597 #else /* not USE_X_TOOLKIT */
1598 XSetWMName (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f), &text);
1599 XSetWMIconName (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f), &text);
1600 #endif /* not USE_X_TOOLKIT */
1602 #else /* not HAVE_X11R4 */
1603 XSetIconName (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
1604 XSTRING (name)->data);
1605 XStoreName (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
1606 XSTRING (name)->data);
1607 #endif /* not HAVE_X11R4 */
1608 UNBLOCK_INPUT;
1611 f->name = name;
1614 /* This function should be called when the user's lisp code has
1615 specified a name for the frame; the name will override any set by the
1616 redisplay code. */
1617 void
1618 x_explicitly_set_name (f, arg, oldval)
1619 FRAME_PTR f;
1620 Lisp_Object arg, oldval;
1622 x_set_name (f, arg, 1);
1625 /* This function should be called by Emacs redisplay code to set the
1626 name; names set this way will never override names set by the user's
1627 lisp code. */
1628 void
1629 x_implicitly_set_name (f, arg, oldval)
1630 FRAME_PTR f;
1631 Lisp_Object arg, oldval;
1633 x_set_name (f, arg, 0);
1636 void
1637 x_set_autoraise (f, arg, oldval)
1638 struct frame *f;
1639 Lisp_Object arg, oldval;
1641 f->auto_raise = !EQ (Qnil, arg);
1644 void
1645 x_set_autolower (f, arg, oldval)
1646 struct frame *f;
1647 Lisp_Object arg, oldval;
1649 f->auto_lower = !EQ (Qnil, arg);
1652 void
1653 x_set_unsplittable (f, arg, oldval)
1654 struct frame *f;
1655 Lisp_Object arg, oldval;
1657 f->no_split = !NILP (arg);
1660 void
1661 x_set_vertical_scroll_bars (f, arg, oldval)
1662 struct frame *f;
1663 Lisp_Object arg, oldval;
1665 if (NILP (arg) != ! FRAME_HAS_VERTICAL_SCROLL_BARS (f))
1667 FRAME_HAS_VERTICAL_SCROLL_BARS (f) = ! NILP (arg);
1669 /* We set this parameter before creating the X window for the
1670 frame, so we can get the geometry right from the start.
1671 However, if the window hasn't been created yet, we shouldn't
1672 call x_set_window_size. */
1673 if (FRAME_X_WINDOW (f))
1674 x_set_window_size (f, 0, FRAME_WIDTH (f), FRAME_HEIGHT (f));
1678 void
1679 x_set_scroll_bar_width (f, arg, oldval)
1680 struct frame *f;
1681 Lisp_Object arg, oldval;
1683 if (NILP (arg))
1685 FRAME_SCROLL_BAR_PIXEL_WIDTH (f) = 0;
1686 FRAME_SCROLL_BAR_COLS (f) = 2;
1688 else if (INTEGERP (arg) && XINT (arg) > 0
1689 && XFASTINT (arg) != FRAME_SCROLL_BAR_PIXEL_WIDTH (f))
1691 int wid = FONT_WIDTH (f->display.x->font);
1692 FRAME_SCROLL_BAR_PIXEL_WIDTH (f) = XFASTINT (arg);
1693 FRAME_SCROLL_BAR_COLS (f) = (XFASTINT (arg) + wid-1) / wid;
1694 if (FRAME_X_WINDOW (f))
1695 x_set_window_size (f, 0, FRAME_WIDTH (f), FRAME_HEIGHT (f));
1699 /* Subroutines of creating an X frame. */
1701 /* Make sure that Vx_resource_name is set to a reasonable value. */
1702 static void
1703 validate_x_resource_name ()
1705 if (STRINGP (Vx_resource_name))
1707 int len = XSTRING (Vx_resource_name)->size;
1708 unsigned char *p = XSTRING (Vx_resource_name)->data;
1709 int i;
1711 /* Allow only letters, digits, - and _,
1712 because those are all that X allows. */
1713 for (i = 0; i < len; i++)
1715 int c = p[i];
1716 if (! ((c >= 'a' && c <= 'z')
1717 || (c >= 'A' && c <= 'Z')
1718 || (c >= '0' && c <= '9')
1719 || c == '-' || c == '_'))
1720 goto fail;
1723 else
1724 fail:
1725 Vx_resource_name = make_string ("emacs", 5);
1729 extern char *x_get_string_resource ();
1731 DEFUN ("x-get-resource", Fx_get_resource, Sx_get_resource, 2, 4, 0,
1732 "Return the value of ATTRIBUTE, of class CLASS, from the X defaults database.\n\
1733 This uses `INSTANCE.ATTRIBUTE' as the key and `Emacs.CLASS' as the\n\
1734 class, where INSTANCE is the name under which Emacs was invoked, or\n\
1735 the name specified by the `-name' or `-rn' command-line arguments.\n\
1737 The optional arguments COMPONENT and SUBCLASS add to the key and the\n\
1738 class, respectively. You must specify both of them or neither.\n\
1739 If you specify them, the key is `INSTANCE.COMPONENT.ATTRIBUTE'\n\
1740 and the class is `Emacs.CLASS.SUBCLASS'.")
1741 (attribute, class, component, subclass)
1742 Lisp_Object attribute, class, component, subclass;
1744 register char *value;
1745 char *name_key;
1746 char *class_key;
1747 Lisp_Object resname;
1749 check_x ();
1751 CHECK_STRING (attribute, 0);
1752 CHECK_STRING (class, 0);
1754 if (!NILP (component))
1755 CHECK_STRING (component, 1);
1756 if (!NILP (subclass))
1757 CHECK_STRING (subclass, 2);
1758 if (NILP (component) != NILP (subclass))
1759 error ("x-get-resource: must specify both COMPONENT and SUBCLASS or neither");
1761 validate_x_resource_name ();
1762 resname = Vx_resource_name;
1764 if (NILP (component))
1766 /* Allocate space for the components, the dots which separate them,
1767 and the final '\0'. */
1768 name_key = (char *) alloca (XSTRING (resname)->size
1769 + XSTRING (attribute)->size
1770 + 2);
1771 class_key = (char *) alloca ((sizeof (EMACS_CLASS) - 1)
1772 + XSTRING (class)->size
1773 + 2);
1775 sprintf (name_key, "%s.%s",
1776 XSTRING (resname)->data,
1777 XSTRING (attribute)->data);
1778 sprintf (class_key, "%s.%s",
1779 EMACS_CLASS,
1780 XSTRING (class)->data);
1782 else
1784 name_key = (char *) alloca (XSTRING (resname)->size
1785 + XSTRING (component)->size
1786 + XSTRING (attribute)->size
1787 + 3);
1789 class_key = (char *) alloca ((sizeof (EMACS_CLASS) - 1)
1790 + XSTRING (class)->size
1791 + XSTRING (subclass)->size
1792 + 3);
1794 sprintf (name_key, "%s.%s.%s",
1795 XSTRING (resname)->data,
1796 XSTRING (component)->data,
1797 XSTRING (attribute)->data);
1798 sprintf (class_key, "%s.%s.%s",
1799 EMACS_CLASS,
1800 XSTRING (class)->data,
1801 XSTRING (subclass)->data);
1804 value = x_get_string_resource (check_x_display_info (Qnil)->xrdb,
1805 name_key, class_key);
1807 if (value != (char *) 0)
1808 return build_string (value);
1809 else
1810 return Qnil;
1813 /* Used when C code wants a resource value. */
1815 char *
1816 x_get_resource_string (attribute, class)
1817 char *attribute, *class;
1819 register char *value;
1820 char *name_key;
1821 char *class_key;
1823 /* Allocate space for the components, the dots which separate them,
1824 and the final '\0'. */
1825 name_key = (char *) alloca (XSTRING (Vinvocation_name)->size
1826 + strlen (attribute) + 2);
1827 class_key = (char *) alloca ((sizeof (EMACS_CLASS) - 1)
1828 + strlen (class) + 2);
1830 sprintf (name_key, "%s.%s",
1831 XSTRING (Vinvocation_name)->data,
1832 attribute);
1833 sprintf (class_key, "%s.%s", EMACS_CLASS, class);
1835 return x_get_string_resource (FRAME_X_DISPLAY_INFO (selected_frame)->xrdb,
1836 name_key, class_key);
1839 /* Types we might convert a resource string into. */
1840 enum resource_types
1842 number, boolean, string, symbol
1845 /* Return the value of parameter PARAM.
1847 First search ALIST, then Vdefault_frame_alist, then the X defaults
1848 database, using ATTRIBUTE as the attribute name and CLASS as its class.
1850 Convert the resource to the type specified by desired_type.
1852 If no default is specified, return Qunbound. If you call
1853 x_get_arg, make sure you deal with Qunbound in a reasonable way,
1854 and don't let it get stored in any Lisp-visible variables! */
1856 static Lisp_Object
1857 x_get_arg (alist, param, attribute, class, type)
1858 Lisp_Object alist, param;
1859 char *attribute;
1860 char *class;
1861 enum resource_types type;
1863 register Lisp_Object tem;
1865 tem = Fassq (param, alist);
1866 if (EQ (tem, Qnil))
1867 tem = Fassq (param, Vdefault_frame_alist);
1868 if (EQ (tem, Qnil))
1871 if (attribute)
1873 tem = Fx_get_resource (build_string (attribute),
1874 build_string (class),
1875 Qnil, Qnil);
1877 if (NILP (tem))
1878 return Qunbound;
1880 switch (type)
1882 case number:
1883 return make_number (atoi (XSTRING (tem)->data));
1885 case boolean:
1886 tem = Fdowncase (tem);
1887 if (!strcmp (XSTRING (tem)->data, "on")
1888 || !strcmp (XSTRING (tem)->data, "true"))
1889 return Qt;
1890 else
1891 return Qnil;
1893 case string:
1894 return tem;
1896 case symbol:
1897 /* As a special case, we map the values `true' and `on'
1898 to Qt, and `false' and `off' to Qnil. */
1900 Lisp_Object lower;
1901 lower = Fdowncase (tem);
1902 if (!strcmp (XSTRING (lower)->data, "on")
1903 || !strcmp (XSTRING (lower)->data, "true"))
1904 return Qt;
1905 else if (!strcmp (XSTRING (lower)->data, "off")
1906 || !strcmp (XSTRING (lower)->data, "false"))
1907 return Qnil;
1908 else
1909 return Fintern (tem, Qnil);
1912 default:
1913 abort ();
1916 else
1917 return Qunbound;
1919 return Fcdr (tem);
1922 /* Record in frame F the specified or default value according to ALIST
1923 of the parameter named PARAM (a Lisp symbol).
1924 If no value is specified for PARAM, look for an X default for XPROP
1925 on the frame named NAME.
1926 If that is not found either, use the value DEFLT. */
1928 static Lisp_Object
1929 x_default_parameter (f, alist, prop, deflt, xprop, xclass, type)
1930 struct frame *f;
1931 Lisp_Object alist;
1932 Lisp_Object prop;
1933 Lisp_Object deflt;
1934 char *xprop;
1935 char *xclass;
1936 enum resource_types type;
1938 Lisp_Object tem;
1940 tem = x_get_arg (alist, prop, xprop, xclass, type);
1941 if (EQ (tem, Qunbound))
1942 tem = deflt;
1943 x_set_frame_parameters (f, Fcons (Fcons (prop, tem), Qnil));
1944 return tem;
1947 DEFUN ("x-parse-geometry", Fx_parse_geometry, Sx_parse_geometry, 1, 1, 0,
1948 "Parse an X-style geometry string STRING.\n\
1949 Returns an alist of the form ((top . TOP), (left . LEFT) ... ).\n\
1950 The properties returned may include `top', `left', `height', and `width'.\n\
1951 The value of `left' or `top' may be an integer,\n\
1952 or a list (+ N) meaning N pixels relative to top/left corner,\n\
1953 or a list (- N) meaning -N pixels relative to bottom/right corner.")
1954 (string)
1955 Lisp_Object string;
1957 int geometry, x, y;
1958 unsigned int width, height;
1959 Lisp_Object result;
1961 CHECK_STRING (string, 0);
1963 geometry = XParseGeometry ((char *) XSTRING (string)->data,
1964 &x, &y, &width, &height);
1966 #if 0
1967 if (!!(geometry & XValue) != !!(geometry & YValue))
1968 error ("Must specify both x and y position, or neither");
1969 #endif
1971 result = Qnil;
1972 if (geometry & XValue)
1974 Lisp_Object element;
1976 if (x >= 0 && (geometry & XNegative))
1977 element = Fcons (Qleft, Fcons (Qminus, Fcons (make_number (-x), Qnil)));
1978 else if (x < 0 && ! (geometry & XNegative))
1979 element = Fcons (Qleft, Fcons (Qplus, Fcons (make_number (x), Qnil)));
1980 else
1981 element = Fcons (Qleft, make_number (x));
1982 result = Fcons (element, result);
1985 if (geometry & YValue)
1987 Lisp_Object element;
1989 if (y >= 0 && (geometry & YNegative))
1990 element = Fcons (Qtop, Fcons (Qminus, Fcons (make_number (-y), Qnil)));
1991 else if (y < 0 && ! (geometry & YNegative))
1992 element = Fcons (Qtop, Fcons (Qplus, Fcons (make_number (y), Qnil)));
1993 else
1994 element = Fcons (Qtop, make_number (y));
1995 result = Fcons (element, result);
1998 if (geometry & WidthValue)
1999 result = Fcons (Fcons (Qwidth, make_number (width)), result);
2000 if (geometry & HeightValue)
2001 result = Fcons (Fcons (Qheight, make_number (height)), result);
2003 return result;
2006 /* Calculate the desired size and position of this window,
2007 and return the flags saying which aspects were specified.
2009 This function does not make the coordinates positive. */
2011 #define DEFAULT_ROWS 40
2012 #define DEFAULT_COLS 80
2014 static int
2015 x_figure_window_size (f, parms)
2016 struct frame *f;
2017 Lisp_Object parms;
2019 register Lisp_Object tem0, tem1, tem2;
2020 int height, width, left, top;
2021 register int geometry;
2022 long window_prompting = 0;
2024 /* Default values if we fall through.
2025 Actually, if that happens we should get
2026 window manager prompting. */
2027 f->width = DEFAULT_COLS;
2028 f->height = DEFAULT_ROWS;
2029 /* Window managers expect that if program-specified
2030 positions are not (0,0), they're intentional, not defaults. */
2031 f->display.x->top_pos = 0;
2032 f->display.x->left_pos = 0;
2034 tem0 = x_get_arg (parms, Qheight, 0, 0, number);
2035 tem1 = x_get_arg (parms, Qwidth, 0, 0, number);
2036 tem2 = x_get_arg (parms, Quser_size, 0, 0, number);
2037 if (! EQ (tem0, Qunbound) || ! EQ (tem1, Qunbound))
2039 if (!EQ (tem0, Qunbound))
2041 CHECK_NUMBER (tem0, 0);
2042 f->height = XINT (tem0);
2044 if (!EQ (tem1, Qunbound))
2046 CHECK_NUMBER (tem1, 0);
2047 f->width = XINT (tem1);
2049 if (!NILP (tem2) && !EQ (tem2, Qunbound))
2050 window_prompting |= USSize;
2051 else
2052 window_prompting |= PSize;
2055 f->display.x->vertical_scroll_bar_extra
2056 = (!FRAME_HAS_VERTICAL_SCROLL_BARS (f)
2058 : FRAME_SCROLL_BAR_PIXEL_WIDTH (f) > 0
2059 ? FRAME_SCROLL_BAR_PIXEL_WIDTH (f)
2060 : (FRAME_SCROLL_BAR_COLS (f) * FONT_WIDTH (f->display.x->font)));
2061 f->display.x->pixel_width = CHAR_TO_PIXEL_WIDTH (f, f->width);
2062 f->display.x->pixel_height = CHAR_TO_PIXEL_HEIGHT (f, f->height);
2064 tem0 = x_get_arg (parms, Qtop, 0, 0, number);
2065 tem1 = x_get_arg (parms, Qleft, 0, 0, number);
2066 tem2 = x_get_arg (parms, Quser_position, 0, 0, number);
2067 if (! EQ (tem0, Qunbound) || ! EQ (tem1, Qunbound))
2069 if (EQ (tem0, Qminus))
2071 f->display.x->top_pos = 0;
2072 window_prompting |= YNegative;
2074 else if (CONSP (tem0) && EQ (XCONS (tem0)->car, Qminus)
2075 && CONSP (XCONS (tem0)->cdr)
2076 && INTEGERP (XCONS (XCONS (tem0)->cdr)->car))
2078 f->display.x->top_pos = - XINT (XCONS (XCONS (tem0)->cdr)->car);
2079 window_prompting |= YNegative;
2081 else if (CONSP (tem0) && EQ (XCONS (tem0)->car, Qplus)
2082 && CONSP (XCONS (tem0)->cdr)
2083 && INTEGERP (XCONS (XCONS (tem0)->cdr)->car))
2085 f->display.x->top_pos = XINT (XCONS (XCONS (tem0)->cdr)->car);
2087 else if (EQ (tem0, Qunbound))
2088 f->display.x->top_pos = 0;
2089 else
2091 CHECK_NUMBER (tem0, 0);
2092 f->display.x->top_pos = XINT (tem0);
2093 if (f->display.x->top_pos < 0)
2094 window_prompting |= YNegative;
2097 if (EQ (tem1, Qminus))
2099 f->display.x->left_pos = 0;
2100 window_prompting |= XNegative;
2102 else if (CONSP (tem1) && EQ (XCONS (tem1)->car, Qminus)
2103 && CONSP (XCONS (tem1)->cdr)
2104 && INTEGERP (XCONS (XCONS (tem1)->cdr)->car))
2106 f->display.x->left_pos = - XINT (XCONS (XCONS (tem1)->cdr)->car);
2107 window_prompting |= XNegative;
2109 else if (CONSP (tem1) && EQ (XCONS (tem1)->car, Qplus)
2110 && CONSP (XCONS (tem1)->cdr)
2111 && INTEGERP (XCONS (XCONS (tem1)->cdr)->car))
2113 f->display.x->left_pos = XINT (XCONS (XCONS (tem1)->cdr)->car);
2115 else if (EQ (tem1, Qunbound))
2116 f->display.x->left_pos = 0;
2117 else
2119 CHECK_NUMBER (tem1, 0);
2120 f->display.x->left_pos = XINT (tem1);
2121 if (f->display.x->left_pos < 0)
2122 window_prompting |= XNegative;
2125 if (!NILP (tem2) && ! EQ (tem2, Qunbound))
2126 window_prompting |= USPosition;
2127 else
2128 window_prompting |= PPosition;
2131 return window_prompting;
2134 #if !defined (HAVE_X11R4) && !defined (HAVE_XSETWMPROTOCOLS)
2136 Status
2137 XSetWMProtocols (dpy, w, protocols, count)
2138 Display *dpy;
2139 Window w;
2140 Atom *protocols;
2141 int count;
2143 Atom prop;
2144 prop = XInternAtom (dpy, "WM_PROTOCOLS", False);
2145 if (prop == None) return False;
2146 XChangeProperty (dpy, w, prop, XA_ATOM, 32, PropModeReplace,
2147 (unsigned char *) protocols, count);
2148 return True;
2150 #endif /* not HAVE_X11R4 && not HAVE_XSETWMPROTOCOLS */
2152 #ifdef USE_X_TOOLKIT
2154 /* If the WM_PROTOCOLS property does not already contain WM_TAKE_FOCUS,
2155 WM_DELETE_WINDOW, and WM_SAVE_YOURSELF, then add them. (They may
2156 already be present because of the toolkit (Motif adds some of them,
2157 for example, but Xt doesn't). */
2159 static void
2160 hack_wm_protocols (f, widget)
2161 FRAME_PTR f;
2162 Widget widget;
2164 Display *dpy = XtDisplay (widget);
2165 Window w = XtWindow (widget);
2166 int need_delete = 1;
2167 int need_focus = 1;
2168 int need_save = 1;
2170 BLOCK_INPUT;
2172 Atom type, *atoms = 0;
2173 int format = 0;
2174 unsigned long nitems = 0;
2175 unsigned long bytes_after;
2177 if (Success == XGetWindowProperty (dpy, w,
2178 FRAME_X_DISPLAY_INFO (f)->Xatom_wm_protocols,
2179 0, 100, False, XA_ATOM,
2180 &type, &format, &nitems, &bytes_after,
2181 (unsigned char **) &atoms)
2182 && format == 32 && type == XA_ATOM)
2183 while (nitems > 0)
2185 nitems--;
2186 if (atoms[nitems] == FRAME_X_DISPLAY_INFO (f)->Xatom_wm_delete_window)
2187 need_delete = 0;
2188 else if (atoms[nitems] == FRAME_X_DISPLAY_INFO (f)->Xatom_wm_take_focus)
2189 need_focus = 0;
2190 else if (atoms[nitems] == FRAME_X_DISPLAY_INFO (f)->Xatom_wm_save_yourself)
2191 need_save = 0;
2193 if (atoms) XFree ((char *) atoms);
2196 Atom props [10];
2197 int count = 0;
2198 if (need_delete)
2199 props[count++] = FRAME_X_DISPLAY_INFO (f)->Xatom_wm_delete_window;
2200 if (need_focus)
2201 props[count++] = FRAME_X_DISPLAY_INFO (f)->Xatom_wm_take_focus;
2202 if (need_save)
2203 props[count++] = FRAME_X_DISPLAY_INFO (f)->Xatom_wm_save_yourself;
2204 if (count)
2205 XChangeProperty (dpy, w, FRAME_X_DISPLAY_INFO (f)->Xatom_wm_protocols,
2206 XA_ATOM, 32, PropModeAppend,
2207 (unsigned char *) props, count);
2209 UNBLOCK_INPUT;
2211 #endif
2213 #ifdef USE_X_TOOLKIT
2215 /* Create and set up the X widget for frame F. */
2217 static void
2218 x_window (f, window_prompting, minibuffer_only)
2219 struct frame *f;
2220 long window_prompting;
2221 int minibuffer_only;
2223 XClassHint class_hints;
2224 XSetWindowAttributes attributes;
2225 unsigned long attribute_mask;
2227 Widget shell_widget;
2228 Widget pane_widget;
2229 Widget frame_widget;
2230 char* name;
2231 Arg al [25];
2232 int ac;
2234 BLOCK_INPUT;
2236 if (STRINGP (f->name))
2237 name = (char*) XSTRING (f->name)->data;
2238 else
2239 name = "emacs";
2241 ac = 0;
2242 XtSetArg (al[ac], XtNallowShellResize, 1); ac++;
2243 XtSetArg (al[ac], XtNinput, 1); ac++;
2244 shell_widget = XtAppCreateShell (name, EMACS_CLASS,
2245 topLevelShellWidgetClass,
2246 FRAME_X_DISPLAY (f), al, ac);
2248 f->display.x->widget = shell_widget;
2249 /* maybe_set_screen_title_format (shell_widget); */
2251 pane_widget = lw_create_widget ("main", "pane", widget_id_tick++,
2252 (widget_value *) NULL,
2253 shell_widget, False,
2254 (lw_callback) NULL,
2255 (lw_callback) NULL,
2256 (lw_callback) NULL);
2258 f->display.x->column_widget = pane_widget;
2260 if (!minibuffer_only && FRAME_EXTERNAL_MENU_BAR (f))
2261 initialize_frame_menubar (f);
2263 /* mappedWhenManaged to false tells to the paned window to not map/unmap
2264 the emacs screen when changing menubar. This reduces flickering. */
2266 ac = 0;
2267 XtSetArg (al[ac], XtNmappedWhenManaged, 0); ac++;
2268 XtSetArg (al[ac], XtNshowGrip, 0); ac++;
2269 XtSetArg (al[ac], XtNallowResize, 1); ac++;
2270 XtSetArg (al[ac], XtNresizeToPreferred, 1); ac++;
2271 XtSetArg (al[ac], XtNemacsFrame, f); ac++;
2272 frame_widget = XtCreateWidget (name,
2273 emacsFrameClass,
2274 pane_widget, al, ac);
2275 lw_set_main_areas (pane_widget, f->display.x->menubar_widget, frame_widget);
2277 f->display.x->edit_widget = frame_widget;
2279 if (f->display.x->menubar_widget)
2280 XtManageChild (f->display.x->menubar_widget);
2281 XtManageChild (frame_widget);
2283 /* Do some needed geometry management. */
2285 int len;
2286 char *tem, shell_position[32];
2287 Arg al[2];
2288 int ac = 0;
2289 int menubar_size
2290 = (f->display.x->menubar_widget
2291 ? (f->display.x->menubar_widget->core.height
2292 + f->display.x->menubar_widget->core.border_width)
2293 : 0);
2295 if (FRAME_EXTERNAL_MENU_BAR (f))
2297 Dimension ibw = 0;
2298 XtVaGetValues (pane_widget, XtNinternalBorderWidth, &ibw, NULL);
2299 menubar_size += ibw;
2302 if (window_prompting & USPosition)
2304 int left = f->display.x->left_pos;
2305 int xneg = window_prompting & XNegative;
2306 int top = f->display.x->top_pos;
2307 int yneg = window_prompting & YNegative;
2308 if (xneg)
2309 left = -left;
2310 if (yneg)
2311 top = -top;
2312 sprintf (shell_position, "=%dx%d%c%d%c%d", PIXEL_WIDTH (f),
2313 PIXEL_HEIGHT (f) + menubar_size,
2314 (xneg ? '-' : '+'), left,
2315 (yneg ? '-' : '+'), top);
2317 else
2318 sprintf (shell_position, "=%dx%d", PIXEL_WIDTH (f),
2319 PIXEL_HEIGHT (f) + menubar_size);
2320 len = strlen (shell_position) + 1;
2321 tem = (char *) xmalloc (len);
2322 strncpy (tem, shell_position, len);
2323 XtSetArg (al[ac], XtNgeometry, tem); ac++;
2324 XtSetValues (shell_widget, al, ac);
2327 x_calc_absolute_position (f);
2329 XtManageChild (pane_widget);
2330 XtRealizeWidget (shell_widget);
2332 FRAME_X_WINDOW (f) = XtWindow (frame_widget);
2334 validate_x_resource_name ();
2335 class_hints.res_name = (char *) XSTRING (Vx_resource_name)->data;
2336 class_hints.res_class = EMACS_CLASS;
2337 XSetClassHint (FRAME_X_DISPLAY (f), XtWindow (shell_widget), &class_hints);
2339 f->display.x->wm_hints.input = True;
2340 f->display.x->wm_hints.flags |= InputHint;
2341 XSetWMHints (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
2342 &f->display.x->wm_hints);
2344 hack_wm_protocols (f, shell_widget);
2346 #ifdef HACK_EDITRES
2347 XtAddEventHandler (shell_widget, 0, True, _XEditResCheckMessages, 0);
2348 #endif
2350 /* Do a stupid property change to force the server to generate a
2351 propertyNotify event so that the event_stream server timestamp will
2352 be initialized to something relevant to the time we created the window.
2354 XChangeProperty (XtDisplay (frame_widget), XtWindow (frame_widget),
2355 FRAME_X_DISPLAY_INFO (f)->Xatom_wm_protocols,
2356 XA_ATOM, 32, PropModeAppend,
2357 (unsigned char*) NULL, 0);
2359 /* Make all the standard events reach the Emacs frame. */
2360 attributes.event_mask = STANDARD_EVENT_SET;
2361 attribute_mask = CWEventMask;
2362 XChangeWindowAttributes (XtDisplay (shell_widget), XtWindow (shell_widget),
2363 attribute_mask, &attributes);
2365 XtMapWidget (frame_widget);
2367 /* x_set_name normally ignores requests to set the name if the
2368 requested name is the same as the current name. This is the one
2369 place where that assumption isn't correct; f->name is set, but
2370 the X server hasn't been told. */
2372 Lisp_Object name;
2373 int explicit = f->explicit_name;
2375 f->explicit_name = 0;
2376 name = f->name;
2377 f->name = Qnil;
2378 x_set_name (f, name, explicit);
2381 XDefineCursor (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
2382 f->display.x->text_cursor);
2384 UNBLOCK_INPUT;
2386 if (FRAME_X_WINDOW (f) == 0)
2387 error ("Unable to create window");
2390 #else /* not USE_X_TOOLKIT */
2392 /* Create and set up the X window for frame F. */
2394 x_window (f)
2395 struct frame *f;
2398 XClassHint class_hints;
2399 XSetWindowAttributes attributes;
2400 unsigned long attribute_mask;
2402 attributes.background_pixel = f->display.x->background_pixel;
2403 attributes.border_pixel = f->display.x->border_pixel;
2404 attributes.bit_gravity = StaticGravity;
2405 attributes.backing_store = NotUseful;
2406 attributes.save_under = True;
2407 attributes.event_mask = STANDARD_EVENT_SET;
2408 attribute_mask = (CWBackPixel | CWBorderPixel | CWBitGravity
2409 #if 0
2410 | CWBackingStore | CWSaveUnder
2411 #endif
2412 | CWEventMask);
2414 BLOCK_INPUT;
2415 FRAME_X_WINDOW (f)
2416 = XCreateWindow (FRAME_X_DISPLAY (f),
2417 f->display.x->parent_desc,
2418 f->display.x->left_pos,
2419 f->display.x->top_pos,
2420 PIXEL_WIDTH (f), PIXEL_HEIGHT (f),
2421 f->display.x->border_width,
2422 CopyFromParent, /* depth */
2423 InputOutput, /* class */
2424 FRAME_X_DISPLAY_INFO (f)->visual,
2425 attribute_mask, &attributes);
2427 validate_x_resource_name ();
2428 class_hints.res_name = (char *) XSTRING (Vx_resource_name)->data;
2429 class_hints.res_class = EMACS_CLASS;
2430 XSetClassHint (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f), &class_hints);
2432 /* This indicates that we use the "Passive Input" input model.
2433 Unless we do this, we don't get the Focus{In,Out} events that we
2434 need to draw the cursor correctly. Accursed bureaucrats.
2435 XWhipsAndChains (FRAME_X_DISPLAY (f), IronMaiden, &TheRack); */
2437 f->display.x->wm_hints.input = True;
2438 f->display.x->wm_hints.flags |= InputHint;
2439 XSetWMHints (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
2440 &f->display.x->wm_hints);
2442 /* Request "save yourself" and "delete window" commands from wm. */
2444 Atom protocols[2];
2445 protocols[0] = FRAME_X_DISPLAY_INFO (f)->Xatom_wm_delete_window;
2446 protocols[1] = FRAME_X_DISPLAY_INFO (f)->Xatom_wm_save_yourself;
2447 XSetWMProtocols (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f), protocols, 2);
2450 /* x_set_name normally ignores requests to set the name if the
2451 requested name is the same as the current name. This is the one
2452 place where that assumption isn't correct; f->name is set, but
2453 the X server hasn't been told. */
2455 Lisp_Object name;
2456 int explicit = f->explicit_name;
2458 f->explicit_name = 0;
2459 name = f->name;
2460 f->name = Qnil;
2461 x_set_name (f, name, explicit);
2464 XDefineCursor (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
2465 f->display.x->text_cursor);
2467 UNBLOCK_INPUT;
2469 if (FRAME_X_WINDOW (f) == 0)
2470 error ("Unable to create window");
2473 #endif /* not USE_X_TOOLKIT */
2475 /* Handle the icon stuff for this window. Perhaps later we might
2476 want an x_set_icon_position which can be called interactively as
2477 well. */
2479 static void
2480 x_icon (f, parms)
2481 struct frame *f;
2482 Lisp_Object parms;
2484 Lisp_Object icon_x, icon_y;
2486 /* Set the position of the icon. Note that twm groups all
2487 icons in an icon window. */
2488 icon_x = x_get_arg (parms, Qicon_left, 0, 0, number);
2489 icon_y = x_get_arg (parms, Qicon_top, 0, 0, number);
2490 if (!EQ (icon_x, Qunbound) && !EQ (icon_y, Qunbound))
2492 CHECK_NUMBER (icon_x, 0);
2493 CHECK_NUMBER (icon_y, 0);
2495 else if (!EQ (icon_x, Qunbound) || !EQ (icon_y, Qunbound))
2496 error ("Both left and top icon corners of icon must be specified");
2498 BLOCK_INPUT;
2500 if (! EQ (icon_x, Qunbound))
2501 x_wm_set_icon_position (f, XINT (icon_x), XINT (icon_y));
2503 /* Start up iconic or window? */
2504 x_wm_set_window_state
2505 (f, (EQ (x_get_arg (parms, Qvisibility, 0, 0, symbol), Qicon)
2506 ? IconicState
2507 : NormalState));
2509 UNBLOCK_INPUT;
2512 /* Make the GC's needed for this window, setting the
2513 background, border and mouse colors; also create the
2514 mouse cursor and the gray border tile. */
2516 static char cursor_bits[] =
2518 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
2519 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
2520 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
2521 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00
2524 static void
2525 x_make_gc (f)
2526 struct frame *f;
2528 XGCValues gc_values;
2529 GC temp_gc;
2530 XImage tileimage;
2532 BLOCK_INPUT;
2534 /* Create the GC's of this frame.
2535 Note that many default values are used. */
2537 /* Normal video */
2538 gc_values.font = f->display.x->font->fid;
2539 gc_values.foreground = f->display.x->foreground_pixel;
2540 gc_values.background = f->display.x->background_pixel;
2541 gc_values.line_width = 0; /* Means 1 using fast algorithm. */
2542 f->display.x->normal_gc = XCreateGC (FRAME_X_DISPLAY (f),
2543 FRAME_X_WINDOW (f),
2544 GCLineWidth | GCFont
2545 | GCForeground | GCBackground,
2546 &gc_values);
2548 /* Reverse video style. */
2549 gc_values.foreground = f->display.x->background_pixel;
2550 gc_values.background = f->display.x->foreground_pixel;
2551 f->display.x->reverse_gc = XCreateGC (FRAME_X_DISPLAY (f),
2552 FRAME_X_WINDOW (f),
2553 GCFont | GCForeground | GCBackground
2554 | GCLineWidth,
2555 &gc_values);
2557 /* Cursor has cursor-color background, background-color foreground. */
2558 gc_values.foreground = f->display.x->background_pixel;
2559 gc_values.background = f->display.x->cursor_pixel;
2560 gc_values.fill_style = FillOpaqueStippled;
2561 gc_values.stipple
2562 = XCreateBitmapFromData (FRAME_X_DISPLAY (f),
2563 FRAME_X_DISPLAY_INFO (f)->root_window,
2564 cursor_bits, 16, 16);
2565 f->display.x->cursor_gc
2566 = XCreateGC (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
2567 (GCFont | GCForeground | GCBackground
2568 | GCFillStyle | GCStipple | GCLineWidth),
2569 &gc_values);
2571 /* Create the gray border tile used when the pointer is not in
2572 the frame. Since this depends on the frame's pixel values,
2573 this must be done on a per-frame basis. */
2574 f->display.x->border_tile
2575 = (XCreatePixmapFromBitmapData
2576 (FRAME_X_DISPLAY (f), FRAME_X_DISPLAY_INFO (f)->root_window,
2577 gray_bits, gray_width, gray_height,
2578 f->display.x->foreground_pixel,
2579 f->display.x->background_pixel,
2580 DefaultDepth (FRAME_X_DISPLAY (f),
2581 XScreenNumberOfScreen (FRAME_X_SCREEN (f)))));
2583 UNBLOCK_INPUT;
2586 DEFUN ("x-create-frame", Fx_create_frame, Sx_create_frame,
2587 1, 1, 0,
2588 "Make a new X window, which is called a \"frame\" in Emacs terms.\n\
2589 Returns an Emacs frame object.\n\
2590 ALIST is an alist of frame parameters.\n\
2591 If the parameters specify that the frame should not have a minibuffer,\n\
2592 and do not specify a specific minibuffer window to use,\n\
2593 then `default-minibuffer-frame' must be a frame whose minibuffer can\n\
2594 be shared by the new frame.\n\
2596 This function is an internal primitive--use `make-frame' instead.")
2597 (parms)
2598 Lisp_Object parms;
2600 struct frame *f;
2601 Lisp_Object frame, tem;
2602 Lisp_Object name;
2603 int minibuffer_only = 0;
2604 long window_prompting = 0;
2605 int width, height;
2606 int count = specpdl_ptr - specpdl;
2607 struct gcpro gcpro1;
2608 Lisp_Object display;
2609 struct x_display_info *dpyinfo;
2610 Lisp_Object parent;
2612 check_x ();
2614 display = x_get_arg (parms, Qdisplay, 0, 0, 0);
2615 if (EQ (display, Qunbound))
2616 display = Qnil;
2617 dpyinfo = check_x_display_info (display);
2619 name = x_get_arg (parms, Qname, "title", "Title", string);
2620 if (!STRINGP (name)
2621 && ! EQ (name, Qunbound)
2622 && ! NILP (name))
2623 error ("Invalid frame name--not a string or nil");
2625 /* See if parent window is specified. */
2626 parent = x_get_arg (parms, Qparent_id, NULL, NULL, number);
2627 if (EQ (parent, Qunbound))
2628 parent = Qnil;
2629 if (! NILP (parent))
2630 CHECK_NUMBER (parent, 0);
2632 tem = x_get_arg (parms, Qminibuffer, 0, 0, symbol);
2633 if (EQ (tem, Qnone) || NILP (tem))
2634 f = make_frame_without_minibuffer (Qnil);
2635 else if (EQ (tem, Qonly))
2637 f = make_minibuffer_frame ();
2638 minibuffer_only = 1;
2640 else if (WINDOWP (tem))
2641 f = make_frame_without_minibuffer (tem);
2642 else
2643 f = make_frame (1);
2645 /* Note that X Windows does support scroll bars. */
2646 FRAME_CAN_HAVE_SCROLL_BARS (f) = 1;
2648 XSETFRAME (frame, f);
2649 GCPRO1 (frame);
2651 f->output_method = output_x_window;
2652 f->display.x = (struct x_display *) xmalloc (sizeof (struct x_display));
2653 bzero (f->display.x, sizeof (struct x_display));
2654 f->display.x->icon_bitmap = -1;
2656 FRAME_X_DISPLAY_INFO (f) = dpyinfo;
2658 /* Specify the parent under which to make this X window. */
2660 if (!NILP (parent))
2662 f->display.x->parent_desc = parent;
2663 f->display.x->explicit_parent = 1;
2665 else
2667 f->display.x->parent_desc = FRAME_X_DISPLAY_INFO (f)->root_window;
2668 f->display.x->explicit_parent = 0;
2671 /* Note that the frame has no physical cursor right now. */
2672 f->phys_cursor_x = -1;
2674 /* Set the name; the functions to which we pass f expect the name to
2675 be set. */
2676 if (EQ (name, Qunbound) || NILP (name))
2678 f->name = build_string (dpyinfo->x_id_name);
2679 f->explicit_name = 0;
2681 else
2683 f->name = name;
2684 f->explicit_name = 1;
2685 /* use the frame's title when getting resources for this frame. */
2686 specbind (Qx_resource_name, name);
2689 /* Extract the window parameters from the supplied values
2690 that are needed to determine window geometry. */
2692 Lisp_Object font;
2694 font = x_get_arg (parms, Qfont, "font", "Font", string);
2695 BLOCK_INPUT;
2696 /* First, try whatever font the caller has specified. */
2697 if (STRINGP (font))
2698 font = x_new_font (f, XSTRING (font)->data);
2699 /* Try out a font which we hope has bold and italic variations. */
2700 if (!STRINGP (font))
2701 font = x_new_font (f, "-misc-fixed-medium-r-normal-*-*-140-*-*-c-*-iso8859-1");
2702 if (! STRINGP (font))
2703 font = x_new_font (f, "-*-*-medium-r-normal-*-*-140-*-*-c-*-iso8859-1");
2704 if (! STRINGP (font))
2705 /* This was formerly the first thing tried, but it finds too many fonts
2706 and takes too long. */
2707 font = x_new_font (f, "-*-*-medium-r-*-*-*-*-*-*-c-*-iso8859-1");
2708 /* If those didn't work, look for something which will at least work. */
2709 if (! STRINGP (font))
2710 font = x_new_font (f, "-*-fixed-*-*-*-*-*-140-*-*-c-*-iso8859-1");
2711 UNBLOCK_INPUT;
2712 if (! STRINGP (font))
2713 font = build_string ("fixed");
2715 x_default_parameter (f, parms, Qfont, font,
2716 "font", "Font", string);
2719 #ifdef USE_X_TOOLKIT
2720 /* Prevent lwlib/xlwmenu.c from crashing because of a bug
2721 whereby it fails to get any font. */
2722 xlwmenu_default_font = f->display.x->font;
2723 #endif
2725 x_default_parameter (f, parms, Qborder_width, make_number (2),
2726 "borderwidth", "BorderWidth", number);
2727 /* This defaults to 2 in order to match xterm. We recognize either
2728 internalBorderWidth or internalBorder (which is what xterm calls
2729 it). */
2730 if (NILP (Fassq (Qinternal_border_width, parms)))
2732 Lisp_Object value;
2734 value = x_get_arg (parms, Qinternal_border_width,
2735 "internalBorder", "BorderWidth", number);
2736 if (! EQ (value, Qunbound))
2737 parms = Fcons (Fcons (Qinternal_border_width, value),
2738 parms);
2740 x_default_parameter (f, parms, Qinternal_border_width, make_number (2),
2741 "internalBorderWidth", "BorderWidth", number);
2742 x_default_parameter (f, parms, Qvertical_scroll_bars, Qt,
2743 "verticalScrollBars", "ScrollBars", boolean);
2745 /* Also do the stuff which must be set before the window exists. */
2746 x_default_parameter (f, parms, Qforeground_color, build_string ("black"),
2747 "foreground", "Foreground", string);
2748 x_default_parameter (f, parms, Qbackground_color, build_string ("white"),
2749 "background", "Background", string);
2750 x_default_parameter (f, parms, Qmouse_color, build_string ("black"),
2751 "pointerColor", "Foreground", string);
2752 x_default_parameter (f, parms, Qcursor_color, build_string ("black"),
2753 "cursorColor", "Foreground", string);
2754 x_default_parameter (f, parms, Qborder_color, build_string ("black"),
2755 "borderColor", "BorderColor", string);
2757 x_default_parameter (f, parms, Qmenu_bar_lines, make_number (1),
2758 "menuBar", "MenuBar", number);
2759 x_default_parameter (f, parms, Qscroll_bar_width, Qnil,
2760 "scrollBarWidth", "ScrollBarWidth", number);
2762 f->display.x->parent_desc = FRAME_X_DISPLAY_INFO (f)->root_window;
2763 window_prompting = x_figure_window_size (f, parms);
2765 if (window_prompting & XNegative)
2767 if (window_prompting & YNegative)
2768 f->display.x->win_gravity = SouthEastGravity;
2769 else
2770 f->display.x->win_gravity = NorthEastGravity;
2772 else
2774 if (window_prompting & YNegative)
2775 f->display.x->win_gravity = SouthWestGravity;
2776 else
2777 f->display.x->win_gravity = NorthWestGravity;
2780 f->display.x->size_hint_flags = window_prompting;
2782 #ifdef USE_X_TOOLKIT
2783 x_window (f, window_prompting, minibuffer_only);
2784 #else
2785 x_window (f);
2786 #endif
2787 x_icon (f, parms);
2788 x_make_gc (f);
2789 init_frame_faces (f);
2791 /* We need to do this after creating the X window, so that the
2792 icon-creation functions can say whose icon they're describing. */
2793 x_default_parameter (f, parms, Qicon_type, Qnil,
2794 "bitmapIcon", "BitmapIcon", symbol);
2796 x_default_parameter (f, parms, Qauto_raise, Qnil,
2797 "autoRaise", "AutoRaiseLower", boolean);
2798 x_default_parameter (f, parms, Qauto_lower, Qnil,
2799 "autoLower", "AutoRaiseLower", boolean);
2800 x_default_parameter (f, parms, Qcursor_type, Qbox,
2801 "cursorType", "CursorType", symbol);
2803 /* Dimensions, especially f->height, must be done via change_frame_size.
2804 Change will not be effected unless different from the current
2805 f->height. */
2806 width = f->width;
2807 height = f->height;
2808 f->height = f->width = 0;
2809 change_frame_size (f, height, width, 1, 0);
2811 /* With the toolkit, the geometry management is done in x_window. */
2812 #ifndef USE_X_TOOLKIT
2813 BLOCK_INPUT;
2814 x_wm_set_size_hint (f, window_prompting, 0);
2815 UNBLOCK_INPUT;
2816 #endif /* USE_X_TOOLKIT */
2818 tem = x_get_arg (parms, Qunsplittable, 0, 0, boolean);
2819 f->no_split = minibuffer_only || EQ (tem, Qt);
2821 UNGCPRO;
2823 /* It is now ok to make the frame official
2824 even if we get an error below.
2825 And the frame needs to be on Vframe_list
2826 or making it visible won't work. */
2827 Vframe_list = Fcons (frame, Vframe_list);
2829 /* Now that the frame is official, it counts as a reference to
2830 its display. */
2831 FRAME_X_DISPLAY_INFO (f)->reference_count++;
2833 /* Make the window appear on the frame and enable display,
2834 unless the caller says not to. However, with explicit parent,
2835 Emacs cannot control visibility, so don't try. */
2836 if (! f->display.x->explicit_parent)
2838 Lisp_Object visibility;
2840 visibility = x_get_arg (parms, Qvisibility, 0, 0, symbol);
2841 if (EQ (visibility, Qunbound))
2842 visibility = Qt;
2844 if (EQ (visibility, Qicon))
2845 x_iconify_frame (f);
2846 else if (! NILP (visibility))
2847 x_make_frame_visible (f);
2848 else
2849 /* Must have been Qnil. */
2853 return unbind_to (count, frame);
2856 Lisp_Object
2857 x_get_focus_frame ()
2859 Lisp_Object xfocus;
2860 if (! x_focus_frame)
2861 return Qnil;
2863 XSETFRAME (xfocus, x_focus_frame);
2864 return xfocus;
2867 DEFUN ("focus-frame", Ffocus_frame, Sfocus_frame, 1, 1, 0,
2868 "Set the focus on FRAME.")
2869 (frame)
2870 Lisp_Object frame;
2872 CHECK_LIVE_FRAME (frame, 0);
2874 if (FRAME_X_P (XFRAME (frame)))
2876 BLOCK_INPUT;
2877 x_focus_on_frame (XFRAME (frame));
2878 UNBLOCK_INPUT;
2879 return frame;
2882 return Qnil;
2885 DEFUN ("unfocus-frame", Funfocus_frame, Sunfocus_frame, 0, 0, 0,
2886 "If a frame has been focused, release it.")
2889 if (x_focus_frame)
2891 BLOCK_INPUT;
2892 x_unfocus_frame (x_focus_frame);
2893 UNBLOCK_INPUT;
2896 return Qnil;
2899 DEFUN ("x-list-fonts", Fx_list_fonts, Sx_list_fonts, 1, 3, 0,
2900 "Return a list of the names of available fonts matching PATTERN.\n\
2901 If optional arguments FACE and FRAME are specified, return only fonts\n\
2902 the same size as FACE on FRAME.\n\
2904 PATTERN is a string, perhaps with wildcard characters;\n\
2905 the * character matches any substring, and\n\
2906 the ? character matches any single character.\n\
2907 PATTERN is case-insensitive.\n\
2908 FACE is a face name--a symbol.\n\
2910 The return value is a list of strings, suitable as arguments to\n\
2911 set-face-font.\n\
2913 Fonts Emacs can't use (i.e. proportional fonts) may or may not be excluded\n\
2914 even if they match PATTERN and FACE.")
2915 (pattern, face, frame)
2916 Lisp_Object pattern, face, frame;
2918 int num_fonts;
2919 char **names;
2920 #ifndef BROKEN_XLISTFONTSWITHINFO
2921 XFontStruct *info;
2922 #endif
2923 XFontStruct *size_ref;
2924 Lisp_Object list;
2925 FRAME_PTR f;
2927 check_x ();
2928 CHECK_STRING (pattern, 0);
2929 if (!NILP (face))
2930 CHECK_SYMBOL (face, 1);
2932 f = check_x_frame (frame);
2934 /* Determine the width standard for comparison with the fonts we find. */
2936 if (NILP (face))
2937 size_ref = 0;
2938 else
2940 int face_id;
2942 /* Don't die if we get called with a terminal frame. */
2943 if (! FRAME_X_P (f))
2944 error ("non-X frame used in `x-list-fonts'");
2946 face_id = face_name_id_number (f, face);
2948 if (face_id < 0 || face_id >= FRAME_N_PARAM_FACES (f)
2949 || FRAME_PARAM_FACES (f) [face_id] == 0)
2950 size_ref = f->display.x->font;
2951 else
2953 size_ref = FRAME_PARAM_FACES (f) [face_id]->font;
2954 if (size_ref == (XFontStruct *) (~0))
2955 size_ref = f->display.x->font;
2959 /* See if we cached the result for this particular query. */
2960 list = Fassoc (pattern,
2961 XCONS (FRAME_X_DISPLAY_INFO (f)->name_list_element)->cdr);
2963 /* We have info in the cache for this PATTERN. */
2964 if (!NILP (list))
2966 Lisp_Object tem, newlist;
2968 /* We have info about this pattern. */
2969 list = XCONS (list)->cdr;
2971 if (size_ref == 0)
2972 return list;
2974 BLOCK_INPUT;
2976 /* Filter the cached info and return just the fonts that match FACE. */
2977 newlist = Qnil;
2978 for (tem = list; CONSP (tem); tem = XCONS (tem)->cdr)
2980 XFontStruct *thisinfo;
2982 thisinfo = XLoadQueryFont (FRAME_X_DISPLAY (f),
2983 XSTRING (XCONS (tem)->car)->data);
2985 if (thisinfo && same_size_fonts (thisinfo, size_ref))
2986 newlist = Fcons (XCONS (tem)->car, newlist);
2988 XFreeFont (FRAME_X_DISPLAY (f), thisinfo);
2991 UNBLOCK_INPUT;
2993 return newlist;
2996 BLOCK_INPUT;
2998 /* Solaris 2.3 has a bug in XListFontsWithInfo. */
2999 #ifndef BROKEN_XLISTFONTSWITHINFO
3000 if (size_ref)
3001 names = XListFontsWithInfo (FRAME_X_DISPLAY (f),
3002 XSTRING (pattern)->data,
3003 2000, /* maxnames */
3004 &num_fonts, /* count_return */
3005 &info); /* info_return */
3006 else
3007 #endif
3008 names = XListFonts (FRAME_X_DISPLAY (f),
3009 XSTRING (pattern)->data,
3010 2000, /* maxnames */
3011 &num_fonts); /* count_return */
3013 UNBLOCK_INPUT;
3015 list = Qnil;
3017 if (names)
3019 int i;
3020 Lisp_Object full_list;
3022 /* Make a list of all the fonts we got back.
3023 Store that in the font cache for the display. */
3024 full_list = Qnil;
3025 for (i = 0; i < num_fonts; i++)
3026 full_list = Fcons (build_string (names[i]), full_list);
3027 XCONS (FRAME_X_DISPLAY_INFO (f)->name_list_element)->cdr
3028 = Fcons (Fcons (pattern, full_list),
3029 XCONS (FRAME_X_DISPLAY_INFO (f)->name_list_element)->cdr);
3031 /* Make a list of the fonts that have the right width. */
3032 list = Qnil;
3033 for (i = 0; i < num_fonts; i++)
3035 int keeper;
3037 if (!size_ref)
3038 keeper = 1;
3039 else
3041 #ifdef BROKEN_XLISTFONTSWITHINFO
3042 XFontStruct *thisinfo;
3044 BLOCK_INPUT;
3045 thisinfo = XLoadQueryFont (FRAME_X_DISPLAY (f), names[i]);
3046 UNBLOCK_INPUT;
3048 keeper = thisinfo && same_size_fonts (thisinfo, size_ref);
3049 #else
3050 keeper = same_size_fonts (&info[i], size_ref);
3051 #endif
3053 if (keeper)
3054 list = Fcons (build_string (names[i]), list);
3056 list = Fnreverse (list);
3058 BLOCK_INPUT;
3059 #ifndef BROKEN_XLISTFONTSWITHINFO
3060 if (size_ref)
3061 XFreeFontInfo (names, info, num_fonts);
3062 else
3063 #endif
3064 XFreeFontNames (names);
3065 UNBLOCK_INPUT;
3068 return list;
3072 DEFUN ("x-color-defined-p", Fx_color_defined_p, Sx_color_defined_p, 1, 2, 0,
3073 "Return non-nil color COLOR is supported on frame FRAME.\n\
3074 If FRAME is omitted or nil, use the selected frame.")
3075 (color, frame)
3076 Lisp_Object color, frame;
3078 XColor foo;
3079 FRAME_PTR f = check_x_frame (frame);
3081 CHECK_STRING (color, 1);
3083 if (defined_color (f, XSTRING (color)->data, &foo, 0))
3084 return Qt;
3085 else
3086 return Qnil;
3089 DEFUN ("x-color-values", Fx_color_values, Sx_color_values, 1, 2, 0,
3090 "Return a description of the color named COLOR on frame FRAME.\n\
3091 The value is a list of integer RGB values--(RED GREEN BLUE).\n\
3092 These values appear to range from 0 to 65280 or 65535, depending\n\
3093 on the system; white is (65280 65280 65280) or (65535 65535 65535).\n\
3094 If FRAME is omitted or nil, use the selected frame.")
3095 (color, frame)
3096 Lisp_Object color, frame;
3098 XColor foo;
3099 FRAME_PTR f = check_x_frame (frame);
3101 CHECK_STRING (color, 1);
3103 if (defined_color (f, XSTRING (color)->data, &foo, 0))
3105 Lisp_Object rgb[3];
3107 rgb[0] = make_number (foo.red);
3108 rgb[1] = make_number (foo.green);
3109 rgb[2] = make_number (foo.blue);
3110 return Flist (3, rgb);
3112 else
3113 return Qnil;
3116 DEFUN ("x-display-color-p", Fx_display_color_p, Sx_display_color_p, 0, 1, 0,
3117 "Return t if the X display supports color.\n\
3118 The optional argument DISPLAY specifies which display to ask about.\n\
3119 DISPLAY should be either a frame or a display name (a string).\n\
3120 If omitted or nil, that stands for the selected frame's display.")
3121 (display)
3122 Lisp_Object display;
3124 struct x_display_info *dpyinfo = check_x_display_info (display);
3126 if (dpyinfo->n_planes <= 2)
3127 return Qnil;
3129 switch (dpyinfo->visual->class)
3131 case StaticColor:
3132 case PseudoColor:
3133 case TrueColor:
3134 case DirectColor:
3135 return Qt;
3137 default:
3138 return Qnil;
3142 DEFUN ("x-display-grayscale-p", Fx_display_grayscale_p, Sx_display_grayscale_p,
3143 0, 1, 0,
3144 "Return t if the X display supports shades of gray.\n\
3145 The optional argument DISPLAY specifies which display to ask about.\n\
3146 DISPLAY should be either a frame or a display name (a string).\n\
3147 If omitted or nil, that stands for the selected frame's display.")
3148 (display)
3149 Lisp_Object display;
3151 struct x_display_info *dpyinfo = check_x_display_info (display);
3153 if (dpyinfo->n_planes <= 2)
3154 return Qnil;
3156 return (dpyinfo->n_planes > 1
3157 && (dpyinfo->visual->class == StaticGray
3158 || dpyinfo->visual->class == GrayScale));
3161 DEFUN ("x-display-pixel-width", Fx_display_pixel_width, Sx_display_pixel_width,
3162 0, 1, 0,
3163 "Returns the width in pixels of the X display DISPLAY.\n\
3164 The optional argument DISPLAY specifies which display to ask about.\n\
3165 DISPLAY should be either a frame or a display name (a string).\n\
3166 If omitted or nil, that stands for the selected frame's display.")
3167 (display)
3168 Lisp_Object display;
3170 struct x_display_info *dpyinfo = check_x_display_info (display);
3172 return make_number (dpyinfo->width);
3175 DEFUN ("x-display-pixel-height", Fx_display_pixel_height,
3176 Sx_display_pixel_height, 0, 1, 0,
3177 "Returns the height in pixels of the X display DISPLAY.\n\
3178 The optional argument DISPLAY specifies which display to ask about.\n\
3179 DISPLAY should be either a frame or a display name (a string).\n\
3180 If omitted or nil, that stands for the selected frame's display.")
3181 (display)
3182 Lisp_Object display;
3184 struct x_display_info *dpyinfo = check_x_display_info (display);
3186 return make_number (dpyinfo->height);
3189 DEFUN ("x-display-planes", Fx_display_planes, Sx_display_planes,
3190 0, 1, 0,
3191 "Returns the number of bitplanes of the X display DISPLAY.\n\
3192 The optional argument DISPLAY specifies which display to ask about.\n\
3193 DISPLAY should be either a frame or a display name (a string).\n\
3194 If omitted or nil, that stands for the selected frame's display.")
3195 (display)
3196 Lisp_Object display;
3198 struct x_display_info *dpyinfo = check_x_display_info (display);
3200 return make_number (dpyinfo->n_planes);
3203 DEFUN ("x-display-color-cells", Fx_display_color_cells, Sx_display_color_cells,
3204 0, 1, 0,
3205 "Returns the number of color cells of the X display DISPLAY.\n\
3206 The optional argument DISPLAY specifies which display to ask about.\n\
3207 DISPLAY should be either a frame or a display name (a string).\n\
3208 If omitted or nil, that stands for the selected frame's display.")
3209 (display)
3210 Lisp_Object display;
3212 struct x_display_info *dpyinfo = check_x_display_info (display);
3214 return make_number (DisplayCells (dpyinfo->display,
3215 XScreenNumberOfScreen (dpyinfo->screen)));
3218 DEFUN ("x-server-max-request-size", Fx_server_max_request_size,
3219 Sx_server_max_request_size,
3220 0, 1, 0,
3221 "Returns the maximum request size of the X server of display DISPLAY.\n\
3222 The optional argument DISPLAY specifies which display to ask about.\n\
3223 DISPLAY should be either a frame or a display name (a string).\n\
3224 If omitted or nil, that stands for the selected frame's display.")
3225 (display)
3226 Lisp_Object display;
3228 struct x_display_info *dpyinfo = check_x_display_info (display);
3230 return make_number (MAXREQUEST (dpyinfo->display));
3233 DEFUN ("x-server-vendor", Fx_server_vendor, Sx_server_vendor, 0, 1, 0,
3234 "Returns the vendor ID string of the X server of display DISPLAY.\n\
3235 The optional argument DISPLAY specifies which display to ask about.\n\
3236 DISPLAY should be either a frame or a display name (a string).\n\
3237 If omitted or nil, that stands for the selected frame's display.")
3238 (display)
3239 Lisp_Object display;
3241 struct x_display_info *dpyinfo = check_x_display_info (display);
3242 char *vendor = ServerVendor (dpyinfo->display);
3244 if (! vendor) vendor = "";
3245 return build_string (vendor);
3248 DEFUN ("x-server-version", Fx_server_version, Sx_server_version, 0, 1, 0,
3249 "Returns the version numbers of the X server of display DISPLAY.\n\
3250 The value is a list of three integers: the major and minor\n\
3251 version numbers of the X Protocol in use, and the vendor-specific release\n\
3252 number. See also the function `x-server-vendor'.\n\n\
3253 The optional argument DISPLAY specifies which display to ask about.\n\
3254 DISPLAY should be either a frame or a display name (a string).\n\
3255 If omitted or nil, that stands for the selected frame's display.")
3256 (display)
3257 Lisp_Object display;
3259 struct x_display_info *dpyinfo = check_x_display_info (display);
3260 Display *dpy = dpyinfo->display;
3262 return Fcons (make_number (ProtocolVersion (dpy)),
3263 Fcons (make_number (ProtocolRevision (dpy)),
3264 Fcons (make_number (VendorRelease (dpy)), Qnil)));
3267 DEFUN ("x-display-screens", Fx_display_screens, Sx_display_screens, 0, 1, 0,
3268 "Returns the number of screens on the X server of display DISPLAY.\n\
3269 The optional argument DISPLAY specifies which display to ask about.\n\
3270 DISPLAY should be either a frame or a display name (a string).\n\
3271 If omitted or nil, that stands for the selected frame's display.")
3272 (display)
3273 Lisp_Object display;
3275 struct x_display_info *dpyinfo = check_x_display_info (display);
3277 return make_number (ScreenCount (dpyinfo->display));
3280 DEFUN ("x-display-mm-height", Fx_display_mm_height, Sx_display_mm_height, 0, 1, 0,
3281 "Returns the height in millimeters of the X display DISPLAY.\n\
3282 The optional argument DISPLAY specifies which display to ask about.\n\
3283 DISPLAY should be either a frame or a display name (a string).\n\
3284 If omitted or nil, that stands for the selected frame's display.")
3285 (display)
3286 Lisp_Object display;
3288 struct x_display_info *dpyinfo = check_x_display_info (display);
3290 return make_number (HeightMMOfScreen (dpyinfo->screen));
3293 DEFUN ("x-display-mm-width", Fx_display_mm_width, Sx_display_mm_width, 0, 1, 0,
3294 "Returns the width in millimeters of the X display DISPLAY.\n\
3295 The optional argument DISPLAY specifies which display to ask about.\n\
3296 DISPLAY should be either a frame or a display name (a string).\n\
3297 If omitted or nil, that stands for the selected frame's display.")
3298 (display)
3299 Lisp_Object display;
3301 struct x_display_info *dpyinfo = check_x_display_info (display);
3303 return make_number (WidthMMOfScreen (dpyinfo->screen));
3306 DEFUN ("x-display-backing-store", Fx_display_backing_store,
3307 Sx_display_backing_store, 0, 1, 0,
3308 "Returns an indication of whether X display DISPLAY does backing store.\n\
3309 The value may be `always', `when-mapped', or `not-useful'.\n\
3310 The optional argument DISPLAY specifies which display to ask about.\n\
3311 DISPLAY should be either a frame or a display name (a string).\n\
3312 If omitted or nil, that stands for the selected frame's display.")
3313 (display)
3314 Lisp_Object display;
3316 struct x_display_info *dpyinfo = check_x_display_info (display);
3318 switch (DoesBackingStore (dpyinfo->screen))
3320 case Always:
3321 return intern ("always");
3323 case WhenMapped:
3324 return intern ("when-mapped");
3326 case NotUseful:
3327 return intern ("not-useful");
3329 default:
3330 error ("Strange value for BackingStore parameter of screen");
3334 DEFUN ("x-display-visual-class", Fx_display_visual_class,
3335 Sx_display_visual_class, 0, 1, 0,
3336 "Returns the visual class of the X display DISPLAY.\n\
3337 The value is one of the symbols `static-gray', `gray-scale',\n\
3338 `static-color', `pseudo-color', `true-color', or `direct-color'.\n\n\
3339 The optional argument DISPLAY specifies which display to ask about.\n\
3340 DISPLAY should be either a frame or a display name (a string).\n\
3341 If omitted or nil, that stands for the selected frame's display.")
3342 (display)
3343 Lisp_Object display;
3345 struct x_display_info *dpyinfo = check_x_display_info (display);
3347 switch (dpyinfo->visual->class)
3349 case StaticGray: return (intern ("static-gray"));
3350 case GrayScale: return (intern ("gray-scale"));
3351 case StaticColor: return (intern ("static-color"));
3352 case PseudoColor: return (intern ("pseudo-color"));
3353 case TrueColor: return (intern ("true-color"));
3354 case DirectColor: return (intern ("direct-color"));
3355 default:
3356 error ("Display has an unknown visual class");
3360 DEFUN ("x-display-save-under", Fx_display_save_under,
3361 Sx_display_save_under, 0, 1, 0,
3362 "Returns t if the X display DISPLAY supports the save-under feature.\n\
3363 The optional argument DISPLAY specifies which display to ask about.\n\
3364 DISPLAY should be either a frame or a display name (a string).\n\
3365 If omitted or nil, that stands for the selected frame's display.")
3366 (display)
3367 Lisp_Object display;
3369 struct x_display_info *dpyinfo = check_x_display_info (display);
3371 if (DoesSaveUnders (dpyinfo->screen) == True)
3372 return Qt;
3373 else
3374 return Qnil;
3378 x_pixel_width (f)
3379 register struct frame *f;
3381 return PIXEL_WIDTH (f);
3385 x_pixel_height (f)
3386 register struct frame *f;
3388 return PIXEL_HEIGHT (f);
3392 x_char_width (f)
3393 register struct frame *f;
3395 return FONT_WIDTH (f->display.x->font);
3399 x_char_height (f)
3400 register struct frame *f;
3402 return f->display.x->line_height;
3406 x_screen_planes (frame)
3407 Lisp_Object frame;
3409 return FRAME_X_DISPLAY_INFO (XFRAME (frame))->n_planes;
3412 #if 0 /* These no longer seem like the right way to do things. */
3414 /* Draw a rectangle on the frame with left top corner including
3415 the character specified by LEFT_CHAR and TOP_CHAR. The rectangle is
3416 CHARS by LINES wide and long and is the color of the cursor. */
3418 void
3419 x_rectangle (f, gc, left_char, top_char, chars, lines)
3420 register struct frame *f;
3421 GC gc;
3422 register int top_char, left_char, chars, lines;
3424 int width;
3425 int height;
3426 int left = (left_char * FONT_WIDTH (f->display.x->font)
3427 + f->display.x->internal_border_width);
3428 int top = (top_char * f->display.x->line_height
3429 + f->display.x->internal_border_width);
3431 if (chars < 0)
3432 width = FONT_WIDTH (f->display.x->font) / 2;
3433 else
3434 width = FONT_WIDTH (f->display.x->font) * chars;
3435 if (lines < 0)
3436 height = f->display.x->line_height / 2;
3437 else
3438 height = f->display.x->line_height * lines;
3440 XDrawRectangle (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
3441 gc, left, top, width, height);
3444 DEFUN ("x-draw-rectangle", Fx_draw_rectangle, Sx_draw_rectangle, 5, 5, 0,
3445 "Draw a rectangle on FRAME between coordinates specified by\n\
3446 numbers X0, Y0, X1, Y1 in the cursor pixel.")
3447 (frame, X0, Y0, X1, Y1)
3448 register Lisp_Object frame, X0, X1, Y0, Y1;
3450 register int x0, y0, x1, y1, top, left, n_chars, n_lines;
3452 CHECK_LIVE_FRAME (frame, 0);
3453 CHECK_NUMBER (X0, 0);
3454 CHECK_NUMBER (Y0, 1);
3455 CHECK_NUMBER (X1, 2);
3456 CHECK_NUMBER (Y1, 3);
3458 x0 = XINT (X0);
3459 x1 = XINT (X1);
3460 y0 = XINT (Y0);
3461 y1 = XINT (Y1);
3463 if (y1 > y0)
3465 top = y0;
3466 n_lines = y1 - y0 + 1;
3468 else
3470 top = y1;
3471 n_lines = y0 - y1 + 1;
3474 if (x1 > x0)
3476 left = x0;
3477 n_chars = x1 - x0 + 1;
3479 else
3481 left = x1;
3482 n_chars = x0 - x1 + 1;
3485 BLOCK_INPUT;
3486 x_rectangle (XFRAME (frame), XFRAME (frame)->display.x->cursor_gc,
3487 left, top, n_chars, n_lines);
3488 UNBLOCK_INPUT;
3490 return Qt;
3493 DEFUN ("x-erase-rectangle", Fx_erase_rectangle, Sx_erase_rectangle, 5, 5, 0,
3494 "Draw a rectangle drawn on FRAME between coordinates\n\
3495 X0, Y0, X1, Y1 in the regular background-pixel.")
3496 (frame, X0, Y0, X1, Y1)
3497 register Lisp_Object frame, X0, Y0, X1, Y1;
3499 register int x0, y0, x1, y1, top, left, n_chars, n_lines;
3501 CHECK_LIVE_FRAME (frame, 0);
3502 CHECK_NUMBER (X0, 0);
3503 CHECK_NUMBER (Y0, 1);
3504 CHECK_NUMBER (X1, 2);
3505 CHECK_NUMBER (Y1, 3);
3507 x0 = XINT (X0);
3508 x1 = XINT (X1);
3509 y0 = XINT (Y0);
3510 y1 = XINT (Y1);
3512 if (y1 > y0)
3514 top = y0;
3515 n_lines = y1 - y0 + 1;
3517 else
3519 top = y1;
3520 n_lines = y0 - y1 + 1;
3523 if (x1 > x0)
3525 left = x0;
3526 n_chars = x1 - x0 + 1;
3528 else
3530 left = x1;
3531 n_chars = x0 - x1 + 1;
3534 BLOCK_INPUT;
3535 x_rectangle (XFRAME (frame), XFRAME (frame)->display.x->reverse_gc,
3536 left, top, n_chars, n_lines);
3537 UNBLOCK_INPUT;
3539 return Qt;
3542 /* Draw lines around the text region beginning at the character position
3543 TOP_X, TOP_Y and ending at BOTTOM_X and BOTTOM_Y. GC specifies the
3544 pixel and line characteristics. */
3546 #define line_len(line) (FRAME_CURRENT_GLYPHS (f)->used[(line)])
3548 static void
3549 outline_region (f, gc, top_x, top_y, bottom_x, bottom_y)
3550 register struct frame *f;
3551 GC gc;
3552 int top_x, top_y, bottom_x, bottom_y;
3554 register int ibw = f->display.x->internal_border_width;
3555 register int font_w = FONT_WIDTH (f->display.x->font);
3556 register int font_h = f->display.x->line_height;
3557 int y = top_y;
3558 int x = line_len (y);
3559 XPoint *pixel_points
3560 = (XPoint *) alloca (((bottom_y - top_y + 2) * 4) * sizeof (XPoint));
3561 register XPoint *this_point = pixel_points;
3563 /* Do the horizontal top line/lines */
3564 if (top_x == 0)
3566 this_point->x = ibw;
3567 this_point->y = ibw + (font_h * top_y);
3568 this_point++;
3569 if (x == 0)
3570 this_point->x = ibw + (font_w / 2); /* Half-size for newline chars. */
3571 else
3572 this_point->x = ibw + (font_w * x);
3573 this_point->y = (this_point - 1)->y;
3575 else
3577 this_point->x = ibw;
3578 this_point->y = ibw + (font_h * (top_y + 1));
3579 this_point++;
3580 this_point->x = ibw + (font_w * top_x);
3581 this_point->y = (this_point - 1)->y;
3582 this_point++;
3583 this_point->x = (this_point - 1)->x;
3584 this_point->y = ibw + (font_h * top_y);
3585 this_point++;
3586 this_point->x = ibw + (font_w * x);
3587 this_point->y = (this_point - 1)->y;
3590 /* Now do the right side. */
3591 while (y < bottom_y)
3592 { /* Right vertical edge */
3593 this_point++;
3594 this_point->x = (this_point - 1)->x;
3595 this_point->y = ibw + (font_h * (y + 1));
3596 this_point++;
3598 y++; /* Horizontal connection to next line */
3599 x = line_len (y);
3600 if (x == 0)
3601 this_point->x = ibw + (font_w / 2);
3602 else
3603 this_point->x = ibw + (font_w * x);
3605 this_point->y = (this_point - 1)->y;
3608 /* Now do the bottom and connect to the top left point. */
3609 this_point->x = ibw + (font_w * (bottom_x + 1));
3611 this_point++;
3612 this_point->x = (this_point - 1)->x;
3613 this_point->y = ibw + (font_h * (bottom_y + 1));
3614 this_point++;
3615 this_point->x = ibw;
3616 this_point->y = (this_point - 1)->y;
3617 this_point++;
3618 this_point->x = pixel_points->x;
3619 this_point->y = pixel_points->y;
3621 XDrawLines (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
3622 gc, pixel_points,
3623 (this_point - pixel_points + 1), CoordModeOrigin);
3626 DEFUN ("x-contour-region", Fx_contour_region, Sx_contour_region, 1, 1, 0,
3627 "Highlight the region between point and the character under the mouse\n\
3628 selected frame.")
3629 (event)
3630 register Lisp_Object event;
3632 register int x0, y0, x1, y1;
3633 register struct frame *f = selected_frame;
3634 register int p1, p2;
3636 CHECK_CONS (event, 0);
3638 BLOCK_INPUT;
3639 x0 = XINT (Fcar (Fcar (event)));
3640 y0 = XINT (Fcar (Fcdr (Fcar (event))));
3642 /* If the mouse is past the end of the line, don't that area. */
3643 /* ReWrite this... */
3645 x1 = f->cursor_x;
3646 y1 = f->cursor_y;
3648 if (y1 > y0) /* point below mouse */
3649 outline_region (f, f->display.x->cursor_gc,
3650 x0, y0, x1, y1);
3651 else if (y1 < y0) /* point above mouse */
3652 outline_region (f, f->display.x->cursor_gc,
3653 x1, y1, x0, y0);
3654 else /* same line: draw horizontal rectangle */
3656 if (x1 > x0)
3657 x_rectangle (f, f->display.x->cursor_gc,
3658 x0, y0, (x1 - x0 + 1), 1);
3659 else if (x1 < x0)
3660 x_rectangle (f, f->display.x->cursor_gc,
3661 x1, y1, (x0 - x1 + 1), 1);
3664 XFlush (FRAME_X_DISPLAY (f));
3665 UNBLOCK_INPUT;
3667 return Qnil;
3670 DEFUN ("x-uncontour-region", Fx_uncontour_region, Sx_uncontour_region, 1, 1, 0,
3671 "Erase any highlighting of the region between point and the character\n\
3672 at X, Y on the selected frame.")
3673 (event)
3674 register Lisp_Object event;
3676 register int x0, y0, x1, y1;
3677 register struct frame *f = selected_frame;
3679 BLOCK_INPUT;
3680 x0 = XINT (Fcar (Fcar (event)));
3681 y0 = XINT (Fcar (Fcdr (Fcar (event))));
3682 x1 = f->cursor_x;
3683 y1 = f->cursor_y;
3685 if (y1 > y0) /* point below mouse */
3686 outline_region (f, f->display.x->reverse_gc,
3687 x0, y0, x1, y1);
3688 else if (y1 < y0) /* point above mouse */
3689 outline_region (f, f->display.x->reverse_gc,
3690 x1, y1, x0, y0);
3691 else /* same line: draw horizontal rectangle */
3693 if (x1 > x0)
3694 x_rectangle (f, f->display.x->reverse_gc,
3695 x0, y0, (x1 - x0 + 1), 1);
3696 else if (x1 < x0)
3697 x_rectangle (f, f->display.x->reverse_gc,
3698 x1, y1, (x0 - x1 + 1), 1);
3700 UNBLOCK_INPUT;
3702 return Qnil;
3705 #if 0
3706 int contour_begin_x, contour_begin_y;
3707 int contour_end_x, contour_end_y;
3708 int contour_npoints;
3710 /* Clip the top part of the contour lines down (and including) line Y_POS.
3711 If X_POS is in the middle (rather than at the end) of the line, drop
3712 down a line at that character. */
3714 static void
3715 clip_contour_top (y_pos, x_pos)
3717 register XPoint *begin = contour_lines[y_pos].top_left;
3718 register XPoint *end;
3719 register int npoints;
3720 register struct display_line *line = selected_frame->phys_lines[y_pos + 1];
3722 if (x_pos >= line->len - 1) /* Draw one, straight horizontal line. */
3724 end = contour_lines[y_pos].top_right;
3725 npoints = (end - begin + 1);
3726 XDrawLines (x_current_display, contour_window,
3727 contour_erase_gc, begin_erase, npoints, CoordModeOrigin);
3729 bcopy (end, begin + 1, contour_last_point - end + 1);
3730 contour_last_point -= (npoints - 2);
3731 XDrawLines (x_current_display, contour_window,
3732 contour_erase_gc, begin, 2, CoordModeOrigin);
3733 XFlush (x_current_display);
3735 /* Now, update contour_lines structure. */
3737 /* ______. */
3738 else /* |________*/
3740 register XPoint *p = begin + 1;
3741 end = contour_lines[y_pos].bottom_right;
3742 npoints = (end - begin + 1);
3743 XDrawLines (x_current_display, contour_window,
3744 contour_erase_gc, begin_erase, npoints, CoordModeOrigin);
3746 p->y = begin->y;
3747 p->x = ibw + (font_w * (x_pos + 1));
3748 p++;
3749 p->y = begin->y + font_h;
3750 p->x = (p - 1)->x;
3751 bcopy (end, begin + 3, contour_last_point - end + 1);
3752 contour_last_point -= (npoints - 5);
3753 XDrawLines (x_current_display, contour_window,
3754 contour_erase_gc, begin, 4, CoordModeOrigin);
3755 XFlush (x_current_display);
3757 /* Now, update contour_lines structure. */
3761 /* Erase the top horizontal lines of the contour, and then extend
3762 the contour upwards. */
3764 static void
3765 extend_contour_top (line)
3769 static void
3770 clip_contour_bottom (x_pos, y_pos)
3771 int x_pos, y_pos;
3775 static void
3776 extend_contour_bottom (x_pos, y_pos)
3780 DEFUN ("x-select-region", Fx_select_region, Sx_select_region, 1, 1, "e",
3782 (event)
3783 Lisp_Object event;
3785 register struct frame *f = selected_frame;
3786 register int point_x = f->cursor_x;
3787 register int point_y = f->cursor_y;
3788 register int mouse_below_point;
3789 register Lisp_Object obj;
3790 register int x_contour_x, x_contour_y;
3792 x_contour_x = x_mouse_x;
3793 x_contour_y = x_mouse_y;
3794 if (x_contour_y > point_y || (x_contour_y == point_y
3795 && x_contour_x > point_x))
3797 mouse_below_point = 1;
3798 outline_region (f, f->display.x->cursor_gc, point_x, point_y,
3799 x_contour_x, x_contour_y);
3801 else
3803 mouse_below_point = 0;
3804 outline_region (f, f->display.x->cursor_gc, x_contour_x, x_contour_y,
3805 point_x, point_y);
3808 while (1)
3810 obj = read_char (-1, 0, 0, Qnil, 0);
3811 if (!CONSP (obj))
3812 break;
3814 if (mouse_below_point)
3816 if (x_mouse_y <= point_y) /* Flipped. */
3818 mouse_below_point = 0;
3820 outline_region (f, f->display.x->reverse_gc, point_x, point_y,
3821 x_contour_x, x_contour_y);
3822 outline_region (f, f->display.x->cursor_gc, x_mouse_x, x_mouse_y,
3823 point_x, point_y);
3825 else if (x_mouse_y < x_contour_y) /* Bottom clipped. */
3827 clip_contour_bottom (x_mouse_y);
3829 else if (x_mouse_y > x_contour_y) /* Bottom extended. */
3831 extend_bottom_contour (x_mouse_y);
3834 x_contour_x = x_mouse_x;
3835 x_contour_y = x_mouse_y;
3837 else /* mouse above or same line as point */
3839 if (x_mouse_y >= point_y) /* Flipped. */
3841 mouse_below_point = 1;
3843 outline_region (f, f->display.x->reverse_gc,
3844 x_contour_x, x_contour_y, point_x, point_y);
3845 outline_region (f, f->display.x->cursor_gc, point_x, point_y,
3846 x_mouse_x, x_mouse_y);
3848 else if (x_mouse_y > x_contour_y) /* Top clipped. */
3850 clip_contour_top (x_mouse_y);
3852 else if (x_mouse_y < x_contour_y) /* Top extended. */
3854 extend_contour_top (x_mouse_y);
3859 unread_command_event = obj;
3860 if (mouse_below_point)
3862 contour_begin_x = point_x;
3863 contour_begin_y = point_y;
3864 contour_end_x = x_contour_x;
3865 contour_end_y = x_contour_y;
3867 else
3869 contour_begin_x = x_contour_x;
3870 contour_begin_y = x_contour_y;
3871 contour_end_x = point_x;
3872 contour_end_y = point_y;
3875 #endif
3877 DEFUN ("x-horizontal-line", Fx_horizontal_line, Sx_horizontal_line, 1, 1, "e",
3879 (event)
3880 Lisp_Object event;
3882 register Lisp_Object obj;
3883 struct frame *f = selected_frame;
3884 register struct window *w = XWINDOW (selected_window);
3885 register GC line_gc = f->display.x->cursor_gc;
3886 register GC erase_gc = f->display.x->reverse_gc;
3887 #if 0
3888 char dash_list[] = {6, 4, 6, 4};
3889 int dashes = 4;
3890 XGCValues gc_values;
3891 #endif
3892 register int previous_y;
3893 register int line = (x_mouse_y + 1) * f->display.x->line_height
3894 + f->display.x->internal_border_width;
3895 register int left = f->display.x->internal_border_width
3896 + (w->left
3897 * FONT_WIDTH (f->display.x->font));
3898 register int right = left + (w->width
3899 * FONT_WIDTH (f->display.x->font))
3900 - f->display.x->internal_border_width;
3902 #if 0
3903 BLOCK_INPUT;
3904 gc_values.foreground = f->display.x->cursor_pixel;
3905 gc_values.background = f->display.x->background_pixel;
3906 gc_values.line_width = 1;
3907 gc_values.line_style = LineOnOffDash;
3908 gc_values.cap_style = CapRound;
3909 gc_values.join_style = JoinRound;
3911 line_gc = XCreateGC (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
3912 GCLineStyle | GCJoinStyle | GCCapStyle
3913 | GCLineWidth | GCForeground | GCBackground,
3914 &gc_values);
3915 XSetDashes (FRAME_X_DISPLAY (f), line_gc, 0, dash_list, dashes);
3916 gc_values.foreground = f->display.x->background_pixel;
3917 gc_values.background = f->display.x->foreground_pixel;
3918 erase_gc = XCreateGC (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
3919 GCLineStyle | GCJoinStyle | GCCapStyle
3920 | GCLineWidth | GCForeground | GCBackground,
3921 &gc_values);
3922 XSetDashes (FRAME_X_DISPLAY (f), erase_gc, 0, dash_list, dashes);
3923 #endif
3925 while (1)
3927 BLOCK_INPUT;
3928 if (x_mouse_y >= XINT (w->top)
3929 && x_mouse_y < XINT (w->top) + XINT (w->height) - 1)
3931 previous_y = x_mouse_y;
3932 line = (x_mouse_y + 1) * f->display.x->line_height
3933 + f->display.x->internal_border_width;
3934 XDrawLine (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
3935 line_gc, left, line, right, line);
3937 XFlush (FRAME_X_DISPLAY (f));
3938 UNBLOCK_INPUT;
3942 obj = read_char (-1, 0, 0, Qnil, 0);
3943 if (!CONSP (obj)
3944 || (! EQ (Fcar (Fcdr (Fcdr (obj))),
3945 Qvertical_scroll_bar))
3946 || x_mouse_grabbed)
3948 BLOCK_INPUT;
3949 XDrawLine (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
3950 erase_gc, left, line, right, line);
3951 UNBLOCK_INPUT;
3952 unread_command_event = obj;
3953 #if 0
3954 XFreeGC (FRAME_X_DISPLAY (f), line_gc);
3955 XFreeGC (FRAME_X_DISPLAY (f), erase_gc);
3956 #endif
3957 return Qnil;
3960 while (x_mouse_y == previous_y);
3962 BLOCK_INPUT;
3963 XDrawLine (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
3964 erase_gc, left, line, right, line);
3965 UNBLOCK_INPUT;
3968 #endif
3970 #if 0
3971 /* These keep track of the rectangle following the pointer. */
3972 int mouse_track_top, mouse_track_left, mouse_track_width;
3974 /* Offset in buffer of character under the pointer, or 0. */
3975 int mouse_buffer_offset;
3977 DEFUN ("x-track-pointer", Fx_track_pointer, Sx_track_pointer, 0, 0, 0,
3978 "Track the pointer.")
3981 static Cursor current_pointer_shape;
3982 FRAME_PTR f = x_mouse_frame;
3984 BLOCK_INPUT;
3985 if (EQ (Vmouse_frame_part, Qtext_part)
3986 && (current_pointer_shape != f->display.x->nontext_cursor))
3988 unsigned char c;
3989 struct buffer *buf;
3991 current_pointer_shape = f->display.x->nontext_cursor;
3992 XDefineCursor (FRAME_X_DISPLAY (f),
3993 FRAME_X_WINDOW (f),
3994 current_pointer_shape);
3996 buf = XBUFFER (XWINDOW (Vmouse_window)->buffer);
3997 c = *(BUF_CHAR_ADDRESS (buf, mouse_buffer_offset));
3999 else if (EQ (Vmouse_frame_part, Qmodeline_part)
4000 && (current_pointer_shape != f->display.x->modeline_cursor))
4002 current_pointer_shape = f->display.x->modeline_cursor;
4003 XDefineCursor (FRAME_X_DISPLAY (f),
4004 FRAME_X_WINDOW (f),
4005 current_pointer_shape);
4008 XFlush (FRAME_X_DISPLAY (f));
4009 UNBLOCK_INPUT;
4011 #endif
4013 #if 0
4014 DEFUN ("x-track-pointer", Fx_track_pointer, Sx_track_pointer, 1, 1, "e",
4015 "Draw rectangle around character under mouse pointer, if there is one.")
4016 (event)
4017 Lisp_Object event;
4019 struct window *w = XWINDOW (Vmouse_window);
4020 struct frame *f = XFRAME (WINDOW_FRAME (w));
4021 struct buffer *b = XBUFFER (w->buffer);
4022 Lisp_Object obj;
4024 if (! EQ (Vmouse_window, selected_window))
4025 return Qnil;
4027 if (EQ (event, Qnil))
4029 int x, y;
4031 x_read_mouse_position (selected_frame, &x, &y);
4034 BLOCK_INPUT;
4035 mouse_track_width = 0;
4036 mouse_track_left = mouse_track_top = -1;
4040 if ((x_mouse_x != mouse_track_left
4041 && (x_mouse_x < mouse_track_left
4042 || x_mouse_x > (mouse_track_left + mouse_track_width)))
4043 || x_mouse_y != mouse_track_top)
4045 int hp = 0; /* Horizontal position */
4046 int len = FRAME_CURRENT_GLYPHS (f)->used[x_mouse_y];
4047 int p = FRAME_CURRENT_GLYPHS (f)->bufp[x_mouse_y];
4048 int tab_width = XINT (b->tab_width);
4049 int ctl_arrow_p = !NILP (b->ctl_arrow);
4050 unsigned char c;
4051 int mode_line_vpos = XFASTINT (w->height) + XFASTINT (w->top) - 1;
4052 int in_mode_line = 0;
4054 if (! FRAME_CURRENT_GLYPHS (f)->enable[x_mouse_y])
4055 break;
4057 /* Erase previous rectangle. */
4058 if (mouse_track_width)
4060 x_rectangle (f, f->display.x->reverse_gc,
4061 mouse_track_left, mouse_track_top,
4062 mouse_track_width, 1);
4064 if ((mouse_track_left == f->phys_cursor_x
4065 || mouse_track_left == f->phys_cursor_x - 1)
4066 && mouse_track_top == f->phys_cursor_y)
4068 x_display_cursor (f, 1);
4072 mouse_track_left = x_mouse_x;
4073 mouse_track_top = x_mouse_y;
4074 mouse_track_width = 0;
4076 if (mouse_track_left > len) /* Past the end of line. */
4077 goto draw_or_not;
4079 if (mouse_track_top == mode_line_vpos)
4081 in_mode_line = 1;
4082 goto draw_or_not;
4085 if (tab_width <= 0 || tab_width > 20) tab_width = 8;
4088 c = FETCH_CHAR (p);
4089 if (len == f->width && hp == len - 1 && c != '\n')
4090 goto draw_or_not;
4092 switch (c)
4094 case '\t':
4095 mouse_track_width = tab_width - (hp % tab_width);
4096 p++;
4097 hp += mouse_track_width;
4098 if (hp > x_mouse_x)
4100 mouse_track_left = hp - mouse_track_width;
4101 goto draw_or_not;
4103 continue;
4105 case '\n':
4106 mouse_track_width = -1;
4107 goto draw_or_not;
4109 default:
4110 if (ctl_arrow_p && (c < 040 || c == 0177))
4112 if (p > ZV)
4113 goto draw_or_not;
4115 mouse_track_width = 2;
4116 p++;
4117 hp +=2;
4118 if (hp > x_mouse_x)
4120 mouse_track_left = hp - mouse_track_width;
4121 goto draw_or_not;
4124 else
4126 mouse_track_width = 1;
4127 p++;
4128 hp++;
4130 continue;
4133 while (hp <= x_mouse_x);
4135 draw_or_not:
4136 if (mouse_track_width) /* Over text; use text pointer shape. */
4138 XDefineCursor (FRAME_X_DISPLAY (f),
4139 FRAME_X_WINDOW (f),
4140 f->display.x->text_cursor);
4141 x_rectangle (f, f->display.x->cursor_gc,
4142 mouse_track_left, mouse_track_top,
4143 mouse_track_width, 1);
4145 else if (in_mode_line)
4146 XDefineCursor (FRAME_X_DISPLAY (f),
4147 FRAME_X_WINDOW (f),
4148 f->display.x->modeline_cursor);
4149 else
4150 XDefineCursor (FRAME_X_DISPLAY (f),
4151 FRAME_X_WINDOW (f),
4152 f->display.x->nontext_cursor);
4155 XFlush (FRAME_X_DISPLAY (f));
4156 UNBLOCK_INPUT;
4158 obj = read_char (-1, 0, 0, Qnil, 0);
4159 BLOCK_INPUT;
4161 while (CONSP (obj) /* Mouse event */
4162 && EQ (Fcar (Fcdr (Fcdr (obj))), Qnil) /* Not scroll bar */
4163 && EQ (Vmouse_depressed, Qnil) /* Only motion events */
4164 && EQ (Vmouse_window, selected_window) /* In this window */
4165 && x_mouse_frame);
4167 unread_command_event = obj;
4169 if (mouse_track_width)
4171 x_rectangle (f, f->display.x->reverse_gc,
4172 mouse_track_left, mouse_track_top,
4173 mouse_track_width, 1);
4174 mouse_track_width = 0;
4175 if ((mouse_track_left == f->phys_cursor_x
4176 || mouse_track_left - 1 == f->phys_cursor_x)
4177 && mouse_track_top == f->phys_cursor_y)
4179 x_display_cursor (f, 1);
4182 XDefineCursor (FRAME_X_DISPLAY (f),
4183 FRAME_X_WINDOW (f),
4184 f->display.x->nontext_cursor);
4185 XFlush (FRAME_X_DISPLAY (f));
4186 UNBLOCK_INPUT;
4188 return Qnil;
4190 #endif
4192 #if 0
4193 #include "glyphs.h"
4195 /* Draw a pixmap specified by IMAGE_DATA of dimensions WIDTH and HEIGHT
4196 on the frame F at position X, Y. */
4198 x_draw_pixmap (f, x, y, image_data, width, height)
4199 struct frame *f;
4200 int x, y, width, height;
4201 char *image_data;
4203 Pixmap image;
4205 image = XCreateBitmapFromData (FRAME_X_DISPLAY (f),
4206 FRAME_X_WINDOW (f), image_data,
4207 width, height);
4208 XCopyPlane (FRAME_X_DISPLAY (f), image, FRAME_X_WINDOW (f),
4209 f->display.x->normal_gc, 0, 0, width, height, x, y);
4211 #endif
4213 #if 0 /* I'm told these functions are superfluous
4214 given the ability to bind function keys. */
4216 #ifdef HAVE_X11
4217 DEFUN ("x-rebind-key", Fx_rebind_key, Sx_rebind_key, 3, 3, 0,
4218 "Rebind X keysym KEYSYM, with MODIFIERS, to generate NEWSTRING.\n\
4219 KEYSYM is a string which conforms to the X keysym definitions found\n\
4220 in X11/keysymdef.h, sans the initial XK_. MODIFIERS is nil or a\n\
4221 list of strings specifying modifier keys such as Control_L, which must\n\
4222 also be depressed for NEWSTRING to appear.")
4223 (x_keysym, modifiers, newstring)
4224 register Lisp_Object x_keysym;
4225 register Lisp_Object modifiers;
4226 register Lisp_Object newstring;
4228 char *rawstring;
4229 register KeySym keysym;
4230 KeySym modifier_list[16];
4232 check_x ();
4233 CHECK_STRING (x_keysym, 1);
4234 CHECK_STRING (newstring, 3);
4236 keysym = XStringToKeysym ((char *) XSTRING (x_keysym)->data);
4237 if (keysym == NoSymbol)
4238 error ("Keysym does not exist");
4240 if (NILP (modifiers))
4241 XRebindKeysym (x_current_display, keysym, modifier_list, 0,
4242 XSTRING (newstring)->data, XSTRING (newstring)->size);
4243 else
4245 register Lisp_Object rest, mod;
4246 register int i = 0;
4248 for (rest = modifiers; !NILP (rest); rest = Fcdr (rest))
4250 if (i == 16)
4251 error ("Can't have more than 16 modifiers");
4253 mod = Fcar (rest);
4254 CHECK_STRING (mod, 3);
4255 modifier_list[i] = XStringToKeysym ((char *) XSTRING (mod)->data);
4256 #ifndef HAVE_X11R5
4257 if (modifier_list[i] == NoSymbol
4258 || !(IsModifierKey (modifier_list[i])
4259 || ((unsigned)(modifier_list[i]) == XK_Mode_switch)
4260 || ((unsigned)(modifier_list[i]) == XK_Num_Lock)))
4261 #else
4262 if (modifier_list[i] == NoSymbol
4263 || !IsModifierKey (modifier_list[i]))
4264 #endif
4265 error ("Element is not a modifier keysym");
4266 i++;
4269 XRebindKeysym (x_current_display, keysym, modifier_list, i,
4270 XSTRING (newstring)->data, XSTRING (newstring)->size);
4273 return Qnil;
4276 DEFUN ("x-rebind-keys", Fx_rebind_keys, Sx_rebind_keys, 2, 2, 0,
4277 "Rebind KEYCODE to list of strings STRINGS.\n\
4278 STRINGS should be a list of 16 elements, one for each shift combination.\n\
4279 nil as element means don't change.\n\
4280 See the documentation of `x-rebind-key' for more information.")
4281 (keycode, strings)
4282 register Lisp_Object keycode;
4283 register Lisp_Object strings;
4285 register Lisp_Object item;
4286 register unsigned char *rawstring;
4287 KeySym rawkey, modifier[1];
4288 int strsize;
4289 register unsigned i;
4291 check_x ();
4292 CHECK_NUMBER (keycode, 1);
4293 CHECK_CONS (strings, 2);
4294 rawkey = (KeySym) ((unsigned) (XINT (keycode))) & 255;
4295 for (i = 0; i <= 15; strings = Fcdr (strings), i++)
4297 item = Fcar (strings);
4298 if (!NILP (item))
4300 CHECK_STRING (item, 2);
4301 strsize = XSTRING (item)->size;
4302 rawstring = (unsigned char *) xmalloc (strsize);
4303 bcopy (XSTRING (item)->data, rawstring, strsize);
4304 modifier[1] = 1 << i;
4305 XRebindKeysym (x_current_display, rawkey, modifier, 1,
4306 rawstring, strsize);
4309 return Qnil;
4311 #endif /* HAVE_X11 */
4312 #endif /* 0 */
4314 #ifndef HAVE_XSCREENNUMBEROFSCREEN
4316 XScreenNumberOfScreen (scr)
4317 register Screen *scr;
4319 register Display *dpy;
4320 register Screen *dpyscr;
4321 register int i;
4323 dpy = scr->display;
4324 dpyscr = dpy->screens;
4326 for (i = 0; i < dpy->nscreens; i++, dpyscr++)
4327 if (scr == dpyscr)
4328 return i;
4330 return -1;
4332 #endif /* not HAVE_XSCREENNUMBEROFSCREEN */
4334 Visual *
4335 select_visual (dpy, screen, depth)
4336 Display *dpy;
4337 Screen *screen;
4338 unsigned int *depth;
4340 Visual *v;
4341 XVisualInfo *vinfo, vinfo_template;
4342 int n_visuals;
4344 v = DefaultVisualOfScreen (screen);
4346 #ifdef HAVE_X11R4
4347 vinfo_template.visualid = XVisualIDFromVisual (v);
4348 #else
4349 vinfo_template.visualid = v->visualid;
4350 #endif
4352 vinfo_template.screen = XScreenNumberOfScreen (screen);
4354 vinfo = XGetVisualInfo (dpy,
4355 VisualIDMask | VisualScreenMask, &vinfo_template,
4356 &n_visuals);
4357 if (n_visuals != 1)
4358 fatal ("Can't get proper X visual info");
4360 if ((1 << vinfo->depth) == vinfo->colormap_size)
4361 *depth = vinfo->depth;
4362 else
4364 int i = 0;
4365 int n = vinfo->colormap_size - 1;
4366 while (n)
4368 n = n >> 1;
4369 i++;
4371 *depth = i;
4374 XFree ((char *) vinfo);
4375 return v;
4378 /* Return the X display structure for the display named NAME.
4379 Open a new connection if necessary. */
4381 struct x_display_info *
4382 x_display_info_for_name (name)
4383 Lisp_Object name;
4385 Lisp_Object names;
4386 struct x_display_info *dpyinfo;
4388 CHECK_STRING (name, 0);
4390 for (dpyinfo = x_display_list, names = x_display_name_list;
4391 dpyinfo;
4392 dpyinfo = dpyinfo->next, names = XCONS (names)->cdr)
4394 Lisp_Object tem;
4395 tem = Fstring_equal (XCONS (XCONS (names)->car)->car, name);
4396 if (!NILP (tem))
4397 return dpyinfo;
4400 validate_x_resource_name ();
4402 dpyinfo = x_term_init (name, (unsigned char *)0,
4403 XSTRING (Vx_resource_name)->data);
4405 if (dpyinfo == 0)
4406 error ("X server %s not responding", XSTRING (name)->data);
4408 x_in_use = 1;
4409 XSETFASTINT (Vwindow_system_version, 11);
4411 return dpyinfo;
4414 DEFUN ("x-open-connection", Fx_open_connection, Sx_open_connection,
4415 1, 3, 0, "Open a connection to an X server.\n\
4416 DISPLAY is the name of the display to connect to.\n\
4417 Optional second arg XRM-STRING is a string of resources in xrdb format.\n\
4418 If the optional third arg MUST-SUCCEED is non-nil,\n\
4419 terminate Emacs if we can't open the connection.")
4420 (display, xrm_string, must_succeed)
4421 Lisp_Object display, xrm_string, must_succeed;
4423 unsigned int n_planes;
4424 unsigned char *xrm_option;
4425 struct x_display_info *dpyinfo;
4427 CHECK_STRING (display, 0);
4428 if (! NILP (xrm_string))
4429 CHECK_STRING (xrm_string, 1);
4431 if (! NILP (xrm_string))
4432 xrm_option = (unsigned char *) XSTRING (xrm_string)->data;
4433 else
4434 xrm_option = (unsigned char *) 0;
4436 validate_x_resource_name ();
4438 /* This is what opens the connection and sets x_current_display.
4439 This also initializes many symbols, such as those used for input. */
4440 dpyinfo = x_term_init (display, xrm_option,
4441 XSTRING (Vx_resource_name)->data);
4443 if (dpyinfo == 0)
4445 if (!NILP (must_succeed))
4446 fatal ("X server %s not responding.\n\
4447 Check the DISPLAY environment variable or use \"-d\"\n",
4448 XSTRING (display)->data);
4449 else
4450 error ("X server %s not responding", XSTRING (display)->data);
4453 x_in_use = 1;
4455 XSETFASTINT (Vwindow_system_version, 11);
4456 return Qnil;
4459 DEFUN ("x-close-connection", Fx_close_connection,
4460 Sx_close_connection, 1, 1, 0,
4461 "Close the connection to DISPLAY's X server.\n\
4462 For DISPLAY, specify either a frame or a display name (a string).\n\
4463 If DISPLAY is nil, that stands for the selected frame's display.")
4464 (display)
4465 Lisp_Object display;
4467 struct x_display_info *dpyinfo = check_x_display_info (display);
4468 struct x_display_info *tail;
4469 int i;
4471 if (dpyinfo->reference_count > 0)
4472 error ("Display still has frames on it");
4474 BLOCK_INPUT;
4475 /* Free the fonts in the font table. */
4476 for (i = 0; i < dpyinfo->n_fonts; i++)
4478 if (dpyinfo->font_table[i].name)
4479 free (dpyinfo->font_table[i].name);
4480 /* Don't free the full_name string;
4481 it is always shared with something else. */
4482 XFreeFont (dpyinfo->display, dpyinfo->font_table[i].font);
4484 x_destroy_all_bitmaps (dpyinfo);
4485 XSetCloseDownMode (dpyinfo->display, DestroyAll);
4487 #ifdef USE_X_TOOLKIT
4488 XtCloseDisplay (dpyinfo->display);
4489 #else
4490 XCloseDisplay (dpyinfo->display);
4491 #endif
4493 x_delete_display (dpyinfo);
4494 UNBLOCK_INPUT;
4496 return Qnil;
4499 DEFUN ("x-display-list", Fx_display_list, Sx_display_list, 0, 0, 0,
4500 "Return the list of display names that Emacs has connections to.")
4503 Lisp_Object tail, result;
4505 result = Qnil;
4506 for (tail = x_display_name_list; ! NILP (tail); tail = XCONS (tail)->cdr)
4507 result = Fcons (XCONS (XCONS (tail)->car)->car, result);
4509 return result;
4512 DEFUN ("x-synchronize", Fx_synchronize, Sx_synchronize, 1, 2, 0,
4513 "If ON is non-nil, report X errors as soon as the erring request is made.\n\
4514 If ON is nil, allow buffering of requests.\n\
4515 Turning on synchronization prohibits the Xlib routines from buffering\n\
4516 requests and seriously degrades performance, but makes debugging much\n\
4517 easier.\n\
4518 The optional second argument DISPLAY specifies which display to act on.\n\
4519 DISPLAY should be either a frame or a display name (a string).\n\
4520 If DISPLAY is omitted or nil, that stands for the selected frame's display.")
4521 (on, display)
4522 Lisp_Object display, on;
4524 struct x_display_info *dpyinfo = check_x_display_info (display);
4526 XSynchronize (dpyinfo->display, !EQ (on, Qnil));
4528 return Qnil;
4531 /* Wait for responses to all X commands issued so far for frame F. */
4533 void
4534 x_sync (f)
4535 FRAME_PTR f;
4537 BLOCK_INPUT;
4538 XSync (FRAME_X_DISPLAY (f), False);
4539 UNBLOCK_INPUT;
4542 syms_of_xfns ()
4544 /* This is zero if not using X windows. */
4545 x_in_use = 0;
4547 /* The section below is built by the lisp expression at the top of the file,
4548 just above where these variables are declared. */
4549 /*&&& init symbols here &&&*/
4550 Qauto_raise = intern ("auto-raise");
4551 staticpro (&Qauto_raise);
4552 Qauto_lower = intern ("auto-lower");
4553 staticpro (&Qauto_lower);
4554 Qbackground_color = intern ("background-color");
4555 staticpro (&Qbackground_color);
4556 Qbar = intern ("bar");
4557 staticpro (&Qbar);
4558 Qborder_color = intern ("border-color");
4559 staticpro (&Qborder_color);
4560 Qborder_width = intern ("border-width");
4561 staticpro (&Qborder_width);
4562 Qbox = intern ("box");
4563 staticpro (&Qbox);
4564 Qcursor_color = intern ("cursor-color");
4565 staticpro (&Qcursor_color);
4566 Qcursor_type = intern ("cursor-type");
4567 staticpro (&Qcursor_type);
4568 Qfont = intern ("font");
4569 staticpro (&Qfont);
4570 Qforeground_color = intern ("foreground-color");
4571 staticpro (&Qforeground_color);
4572 Qgeometry = intern ("geometry");
4573 staticpro (&Qgeometry);
4574 Qicon_left = intern ("icon-left");
4575 staticpro (&Qicon_left);
4576 Qicon_top = intern ("icon-top");
4577 staticpro (&Qicon_top);
4578 Qicon_type = intern ("icon-type");
4579 staticpro (&Qicon_type);
4580 Qinternal_border_width = intern ("internal-border-width");
4581 staticpro (&Qinternal_border_width);
4582 Qleft = intern ("left");
4583 staticpro (&Qleft);
4584 Qmouse_color = intern ("mouse-color");
4585 staticpro (&Qmouse_color);
4586 Qnone = intern ("none");
4587 staticpro (&Qnone);
4588 Qparent_id = intern ("parent-id");
4589 staticpro (&Qparent_id);
4590 Qscroll_bar_width = intern ("scroll-bar-width");
4591 staticpro (&Qscroll_bar_width);
4592 Qsuppress_icon = intern ("suppress-icon");
4593 staticpro (&Qsuppress_icon);
4594 Qtop = intern ("top");
4595 staticpro (&Qtop);
4596 Qundefined_color = intern ("undefined-color");
4597 staticpro (&Qundefined_color);
4598 Qvertical_scroll_bars = intern ("vertical-scroll-bars");
4599 staticpro (&Qvertical_scroll_bars);
4600 Qvisibility = intern ("visibility");
4601 staticpro (&Qvisibility);
4602 Qwindow_id = intern ("window-id");
4603 staticpro (&Qwindow_id);
4604 Qx_frame_parameter = intern ("x-frame-parameter");
4605 staticpro (&Qx_frame_parameter);
4606 Qx_resource_name = intern ("x-resource-name");
4607 staticpro (&Qx_resource_name);
4608 Quser_position = intern ("user-position");
4609 staticpro (&Quser_position);
4610 Quser_size = intern ("user-size");
4611 staticpro (&Quser_size);
4612 Qdisplay = intern ("display");
4613 staticpro (&Qdisplay);
4614 /* This is the end of symbol initialization. */
4616 Fput (Qundefined_color, Qerror_conditions,
4617 Fcons (Qundefined_color, Fcons (Qerror, Qnil)));
4618 Fput (Qundefined_color, Qerror_message,
4619 build_string ("Undefined color"));
4621 init_x_parm_symbols ();
4623 DEFVAR_LISP ("x-bitmap-file-path", &Vx_bitmap_file_path,
4624 "List of directories to search for bitmap files for X.");
4625 Vx_bitmap_file_path = Fcons (build_string (PATH_BITMAPS), Qnil);
4627 DEFVAR_LISP ("x-pointer-shape", &Vx_pointer_shape,
4628 "The shape of the pointer when over text.\n\
4629 Changing the value does not affect existing frames\n\
4630 unless you set the mouse color.");
4631 Vx_pointer_shape = Qnil;
4633 DEFVAR_LISP ("x-resource-name", &Vx_resource_name,
4634 "The name Emacs uses to look up X resources; for internal use only.\n\
4635 `x-get-resource' uses this as the first component of the instance name\n\
4636 when requesting resource values.\n\
4637 Emacs initially sets `x-resource-name' to the name under which Emacs\n\
4638 was invoked, or to the value specified with the `-name' or `-rn'\n\
4639 switches, if present.");
4640 Vx_resource_name = Qnil;
4642 #if 0 /* This doesn't really do anything. */
4643 DEFVAR_INT ("x-nontext-pointer-shape", &Vx_nontext_pointer_shape,
4644 "The shape of the pointer when not over text.\n\
4645 This variable takes effect when you create a new frame\n\
4646 or when you set the mouse color.");
4647 #endif
4648 Vx_nontext_pointer_shape = Qnil;
4650 #if 0 /* This doesn't really do anything. */
4651 DEFVAR_INT ("x-mode-pointer-shape", &Vx_mode_pointer_shape,
4652 "The shape of the pointer when over the mode line.\n\
4653 This variable takes effect when you create a new frame\n\
4654 or when you set the mouse color.");
4655 #endif
4656 Vx_mode_pointer_shape = Qnil;
4658 DEFVAR_INT ("x-sensitive-text-pointer-shape",
4659 &Vx_sensitive_text_pointer_shape,
4660 "The shape of the pointer when over mouse-sensitive text.\n\
4661 This variable takes effect when you create a new frame\n\
4662 or when you set the mouse color.");
4663 Vx_sensitive_text_pointer_shape = Qnil;
4665 DEFVAR_LISP ("x-cursor-fore-pixel", &Vx_cursor_fore_pixel,
4666 "A string indicating the foreground color of the cursor box.");
4667 Vx_cursor_fore_pixel = Qnil;
4669 DEFVAR_LISP ("x-no-window-manager", &Vx_no_window_manager,
4670 "Non-nil if no X window manager is in use.");
4672 #ifdef USE_X_TOOLKIT
4673 Fprovide (intern ("x-toolkit"));
4674 #endif
4676 defsubr (&Sx_get_resource);
4677 #if 0
4678 defsubr (&Sx_draw_rectangle);
4679 defsubr (&Sx_erase_rectangle);
4680 defsubr (&Sx_contour_region);
4681 defsubr (&Sx_uncontour_region);
4682 #endif
4683 defsubr (&Sx_list_fonts);
4684 defsubr (&Sx_display_color_p);
4685 defsubr (&Sx_display_grayscale_p);
4686 defsubr (&Sx_color_defined_p);
4687 defsubr (&Sx_color_values);
4688 defsubr (&Sx_server_max_request_size);
4689 defsubr (&Sx_server_vendor);
4690 defsubr (&Sx_server_version);
4691 defsubr (&Sx_display_pixel_width);
4692 defsubr (&Sx_display_pixel_height);
4693 defsubr (&Sx_display_mm_width);
4694 defsubr (&Sx_display_mm_height);
4695 defsubr (&Sx_display_screens);
4696 defsubr (&Sx_display_planes);
4697 defsubr (&Sx_display_color_cells);
4698 defsubr (&Sx_display_visual_class);
4699 defsubr (&Sx_display_backing_store);
4700 defsubr (&Sx_display_save_under);
4701 #if 0
4702 defsubr (&Sx_rebind_key);
4703 defsubr (&Sx_rebind_keys);
4704 defsubr (&Sx_track_pointer);
4705 defsubr (&Sx_grab_pointer);
4706 defsubr (&Sx_ungrab_pointer);
4707 #endif
4708 defsubr (&Sx_parse_geometry);
4709 defsubr (&Sx_create_frame);
4710 defsubr (&Sfocus_frame);
4711 defsubr (&Sunfocus_frame);
4712 #if 0
4713 defsubr (&Sx_horizontal_line);
4714 #endif
4715 defsubr (&Sx_open_connection);
4716 defsubr (&Sx_close_connection);
4717 defsubr (&Sx_display_list);
4718 defsubr (&Sx_synchronize);
4721 #endif /* HAVE_X_WINDOWS */