Conditionalize the changes below on not __linux__.
[emacs.git] / src / xfns.c
bloba8bf946c596d371b2936039c12254fcf054a2d4e
1 /* Functions for the X window system.
2 Copyright (C) 1989, 1992, 1993, 1994, 1995, 1996 Free Software Foundation.
4 This file is part of GNU Emacs.
6 GNU Emacs is free software; you can redistribute it and/or modify
7 it under the terms of the GNU General Public License as published by
8 the Free Software Foundation; either version 2, or (at your option)
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, Inc., 59 Temple Place - Suite 330,
19 Boston, MA 02111-1307, USA. */
21 /* Completely rewritten by Richard Stallman. */
23 /* Rewritten for X11 by Joseph Arceneaux */
25 #include <signal.h>
26 #include <config.h>
28 /* This makes the fields of a Display accessible, in Xlib header files. */
29 #define XLIB_ILLEGAL_ACCESS
31 #include "lisp.h"
32 #include "xterm.h"
33 #include "frame.h"
34 #include "window.h"
35 #include "buffer.h"
36 #include "dispextern.h"
37 #include "keyboard.h"
38 #include "blockinput.h"
39 #include <paths.h>
41 #ifdef HAVE_X_WINDOWS
42 extern void abort ();
44 /* On some systems, the character-composition stuff is broken in X11R5. */
45 #if defined (HAVE_X11R5) && ! defined (HAVE_X11R6)
46 #ifdef X11R5_INHIBIT_I18N
47 #define X_I18N_INHIBITED
48 #endif
49 #endif
51 #ifndef VMS
52 #if 1 /* Used to be #ifdef EMACS_BITMAP_FILES, but this should always work. */
53 #include "bitmaps/gray.xbm"
54 #else
55 #include <X11/bitmaps/gray>
56 #endif
57 #else
58 #include "[.bitmaps]gray.xbm"
59 #endif
61 #ifdef USE_X_TOOLKIT
62 #include <X11/Shell.h>
64 #ifndef USE_MOTIF
65 #include <X11/Xaw/Paned.h>
66 #include <X11/Xaw/Label.h>
67 #endif /* USE_MOTIF */
69 #ifdef USG
70 #undef USG /* ####KLUDGE for Solaris 2.2 and up */
71 #include <X11/Xos.h>
72 #define USG
73 #else
74 #include <X11/Xos.h>
75 #endif
77 #include "widget.h"
79 #include "../lwlib/lwlib.h"
81 /* Do the EDITRES protocol if running X11R5
82 Exception: HP-UX (at least version A.09.05) has X11R5 without EditRes */
83 #if (XtSpecificationRelease >= 5) && !defined(NO_EDITRES)
84 #define HACK_EDITRES
85 extern void _XEditResCheckMessages ();
86 #endif /* R5 + Athena */
88 /* Unique id counter for widgets created by the Lucid Widget
89 Library. */
90 extern LWLIB_ID widget_id_tick;
92 #ifdef USE_LUCID
93 /* This is part of a kludge--see lwlib/xlwmenu.c. */
94 extern XFontStruct *xlwmenu_default_font;
95 #endif
97 extern void free_frame_menubar ();
98 #endif /* USE_X_TOOLKIT */
100 #define min(a,b) ((a) < (b) ? (a) : (b))
101 #define max(a,b) ((a) > (b) ? (a) : (b))
103 #ifdef HAVE_X11R4
104 #define MAXREQUEST(dpy) (XMaxRequestSize (dpy))
105 #else
106 #define MAXREQUEST(dpy) ((dpy)->max_request_size)
107 #endif
109 /* The name we're using in resource queries. */
110 Lisp_Object Vx_resource_name;
112 /* The background and shape of the mouse pointer, and shape when not
113 over text or in the modeline. */
114 Lisp_Object Vx_pointer_shape, Vx_nontext_pointer_shape, Vx_mode_pointer_shape;
115 /* The shape when over mouse-sensitive text. */
116 Lisp_Object Vx_sensitive_text_pointer_shape;
118 /* Color of chars displayed in cursor box. */
119 Lisp_Object Vx_cursor_fore_pixel;
121 /* Nonzero if using X. */
122 static int x_in_use;
124 /* Non nil if no window manager is in use. */
125 Lisp_Object Vx_no_window_manager;
127 /* Search path for bitmap files. */
128 Lisp_Object Vx_bitmap_file_path;
130 /* Evaluate this expression to rebuild the section of syms_of_xfns
131 that initializes and staticpros the symbols declared below. Note
132 that Emacs 18 has a bug that keeps C-x C-e from being able to
133 evaluate this expression.
135 (progn
136 ;; Accumulate a list of the symbols we want to initialize from the
137 ;; declarations at the top of the file.
138 (goto-char (point-min))
139 (search-forward "/\*&&& symbols declared here &&&*\/\n")
140 (let (symbol-list)
141 (while (looking-at "Lisp_Object \\(Q[a-z_]+\\)")
142 (setq symbol-list
143 (cons (buffer-substring (match-beginning 1) (match-end 1))
144 symbol-list))
145 (forward-line 1))
146 (setq symbol-list (nreverse symbol-list))
147 ;; Delete the section of syms_of_... where we initialize the symbols.
148 (search-forward "\n /\*&&& init symbols here &&&*\/\n")
149 (let ((start (point)))
150 (while (looking-at "^ Q")
151 (forward-line 2))
152 (kill-region start (point)))
153 ;; Write a new symbol initialization section.
154 (while symbol-list
155 (insert (format " %s = intern (\"" (car symbol-list)))
156 (let ((start (point)))
157 (insert (substring (car symbol-list) 1))
158 (subst-char-in-region start (point) ?_ ?-))
159 (insert (format "\");\n staticpro (&%s);\n" (car symbol-list)))
160 (setq symbol-list (cdr symbol-list)))))
164 /*&&& symbols declared here &&&*/
165 Lisp_Object Qauto_raise;
166 Lisp_Object Qauto_lower;
167 Lisp_Object Qbackground_color;
168 Lisp_Object Qbar;
169 Lisp_Object Qborder_color;
170 Lisp_Object Qborder_width;
171 Lisp_Object Qbox;
172 Lisp_Object Qcursor_color;
173 Lisp_Object Qcursor_type;
174 Lisp_Object Qforeground_color;
175 Lisp_Object Qgeometry;
176 Lisp_Object Qicon_left;
177 Lisp_Object Qicon_top;
178 Lisp_Object Qicon_type;
179 Lisp_Object Qicon_name;
180 Lisp_Object Qinternal_border_width;
181 Lisp_Object Qleft;
182 Lisp_Object Qmouse_color;
183 Lisp_Object Qnone;
184 Lisp_Object Qparent_id;
185 Lisp_Object Qscroll_bar_width;
186 Lisp_Object Qsuppress_icon;
187 Lisp_Object Qtop;
188 Lisp_Object Qundefined_color;
189 Lisp_Object Qvertical_scroll_bars;
190 Lisp_Object Qvisibility;
191 Lisp_Object Qwindow_id;
192 Lisp_Object Qx_frame_parameter;
193 Lisp_Object Qx_resource_name;
194 Lisp_Object Quser_position;
195 Lisp_Object Quser_size;
196 Lisp_Object Qdisplay;
198 /* The below are defined in frame.c. */
199 extern Lisp_Object Qheight, Qminibuffer, Qname, Qonly, Qwidth;
200 extern Lisp_Object Qunsplittable, Qmenu_bar_lines, Qbuffer_predicate, Qtitle;
202 extern Lisp_Object Vwindow_system_version;
205 /* Error if we are not connected to X. */
206 void
207 check_x ()
209 if (! x_in_use)
210 error ("X windows are not in use or not initialized");
213 /* Nonzero if we can use mouse menus.
214 You should not call this unless HAVE_MENUS is defined. */
217 have_menus_p ()
219 return x_in_use;
222 /* Extract a frame as a FRAME_PTR, defaulting to the selected frame
223 and checking validity for X. */
225 FRAME_PTR
226 check_x_frame (frame)
227 Lisp_Object frame;
229 FRAME_PTR f;
231 if (NILP (frame))
232 f = selected_frame;
233 else
235 CHECK_LIVE_FRAME (frame, 0);
236 f = XFRAME (frame);
238 if (! FRAME_X_P (f))
239 error ("Non-X frame used");
240 return f;
243 /* Let the user specify an X display with a frame.
244 nil stands for the selected frame--or, if that is not an X frame,
245 the first X display on the list. */
247 static struct x_display_info *
248 check_x_display_info (frame)
249 Lisp_Object frame;
251 if (NILP (frame))
253 if (FRAME_X_P (selected_frame))
254 return FRAME_X_DISPLAY_INFO (selected_frame);
255 else if (x_display_list != 0)
256 return x_display_list;
257 else
258 error ("X windows are not in use or not initialized");
260 else if (STRINGP (frame))
261 return x_display_info_for_name (frame);
262 else
264 FRAME_PTR f;
266 CHECK_LIVE_FRAME (frame, 0);
267 f = XFRAME (frame);
268 if (! FRAME_X_P (f))
269 error ("Non-X frame used");
270 return FRAME_X_DISPLAY_INFO (f);
274 /* Return the Emacs frame-object corresponding to an X window.
275 It could be the frame's main window or an icon window. */
277 /* This function can be called during GC, so use GC_xxx type test macros. */
279 struct frame *
280 x_window_to_frame (dpyinfo, wdesc)
281 struct x_display_info *dpyinfo;
282 int wdesc;
284 Lisp_Object tail, frame;
285 struct frame *f;
287 for (tail = Vframe_list; GC_CONSP (tail); tail = XCONS (tail)->cdr)
289 frame = XCONS (tail)->car;
290 if (!GC_FRAMEP (frame))
291 continue;
292 f = XFRAME (frame);
293 if (f->output_data.nothing == 1 || FRAME_X_DISPLAY_INFO (f) != dpyinfo)
294 continue;
295 #ifdef USE_X_TOOLKIT
296 if ((f->output_data.x->edit_widget
297 && XtWindow (f->output_data.x->edit_widget) == wdesc)
298 || f->output_data.x->icon_desc == wdesc)
299 return f;
300 #else /* not USE_X_TOOLKIT */
301 if (FRAME_X_WINDOW (f) == wdesc
302 || f->output_data.x->icon_desc == wdesc)
303 return f;
304 #endif /* not USE_X_TOOLKIT */
306 return 0;
309 #ifdef USE_X_TOOLKIT
310 /* Like x_window_to_frame but also compares the window with the widget's
311 windows. */
313 struct frame *
314 x_any_window_to_frame (dpyinfo, wdesc)
315 struct x_display_info *dpyinfo;
316 int wdesc;
318 Lisp_Object tail, frame;
319 struct frame *f;
320 struct x_output *x;
322 for (tail = Vframe_list; GC_CONSP (tail); tail = XCONS (tail)->cdr)
324 frame = XCONS (tail)->car;
325 if (!GC_FRAMEP (frame))
326 continue;
327 f = XFRAME (frame);
328 if (f->output_data.nothing == 1 || FRAME_X_DISPLAY_INFO (f) != dpyinfo)
329 continue;
330 x = f->output_data.x;
331 /* This frame matches if the window is any of its widgets. */
332 if (wdesc == XtWindow (x->widget)
333 || wdesc == XtWindow (x->column_widget)
334 || wdesc == XtWindow (x->edit_widget))
335 return f;
336 /* Match if the window is this frame's menubar. */
337 if (lw_window_is_in_menubar (wdesc, x->menubar_widget))
338 return f;
340 return 0;
343 /* Likewise, but exclude the menu bar widget. */
345 struct frame *
346 x_non_menubar_window_to_frame (dpyinfo, wdesc)
347 struct x_display_info *dpyinfo;
348 int wdesc;
350 Lisp_Object tail, frame;
351 struct frame *f;
352 struct x_output *x;
354 for (tail = Vframe_list; GC_CONSP (tail); tail = XCONS (tail)->cdr)
356 frame = XCONS (tail)->car;
357 if (!GC_FRAMEP (frame))
358 continue;
359 f = XFRAME (frame);
360 if (f->output_data.nothing == 1 || FRAME_X_DISPLAY_INFO (f) != dpyinfo)
361 continue;
362 x = f->output_data.x;
363 /* This frame matches if the window is any of its widgets. */
364 if (wdesc == XtWindow (x->widget)
365 || wdesc == XtWindow (x->column_widget)
366 || wdesc == XtWindow (x->edit_widget))
367 return f;
369 return 0;
372 /* Likewise, but consider only the menu bar widget. */
374 struct frame *
375 x_menubar_window_to_frame (dpyinfo, wdesc)
376 struct x_display_info *dpyinfo;
377 int wdesc;
379 Lisp_Object tail, frame;
380 struct frame *f;
381 struct x_output *x;
383 for (tail = Vframe_list; GC_CONSP (tail); tail = XCONS (tail)->cdr)
385 frame = XCONS (tail)->car;
386 if (!GC_FRAMEP (frame))
387 continue;
388 f = XFRAME (frame);
389 if (f->output_data.nothing == 1 || FRAME_X_DISPLAY_INFO (f) != dpyinfo)
390 continue;
391 x = f->output_data.x;
392 /* Match if the window is this frame's menubar. */
393 if (lw_window_is_in_menubar (wdesc, x->menubar_widget))
394 return f;
396 return 0;
399 /* Return the frame whose principal (outermost) window is WDESC.
400 If WDESC is some other (smaller) window, we return 0. */
402 struct frame *
403 x_top_window_to_frame (dpyinfo, wdesc)
404 struct x_display_info *dpyinfo;
405 int wdesc;
407 Lisp_Object tail, frame;
408 struct frame *f;
409 struct x_output *x;
411 for (tail = Vframe_list; GC_CONSP (tail); tail = XCONS (tail)->cdr)
413 frame = XCONS (tail)->car;
414 if (!GC_FRAMEP (frame))
415 continue;
416 f = XFRAME (frame);
417 if (f->output_data.nothing == 1 || FRAME_X_DISPLAY_INFO (f) != dpyinfo)
418 continue;
419 x = f->output_data.x;
420 /* This frame matches if the window is its topmost widget. */
421 if (wdesc == XtWindow (x->widget))
422 return f;
423 #if 0 /* I don't know why it did this,
424 but it seems logically wrong,
425 and it causes trouble for MapNotify events. */
426 /* Match if the window is this frame's menubar. */
427 if (x->menubar_widget
428 && wdesc == XtWindow (x->menubar_widget))
429 return f;
430 #endif
432 return 0;
434 #endif /* USE_X_TOOLKIT */
438 /* Code to deal with bitmaps. Bitmaps are referenced by their bitmap
439 id, which is just an int that this section returns. Bitmaps are
440 reference counted so they can be shared among frames.
442 Bitmap indices are guaranteed to be > 0, so a negative number can
443 be used to indicate no bitmap.
445 If you use x_create_bitmap_from_data, then you must keep track of
446 the bitmaps yourself. That is, creating a bitmap from the same
447 data more than once will not be caught. */
450 /* Functions to access the contents of a bitmap, given an id. */
453 x_bitmap_height (f, id)
454 FRAME_PTR f;
455 int id;
457 return FRAME_X_DISPLAY_INFO (f)->bitmaps[id - 1].height;
461 x_bitmap_width (f, id)
462 FRAME_PTR f;
463 int id;
465 return FRAME_X_DISPLAY_INFO (f)->bitmaps[id - 1].width;
469 x_bitmap_pixmap (f, id)
470 FRAME_PTR f;
471 int id;
473 return FRAME_X_DISPLAY_INFO (f)->bitmaps[id - 1].pixmap;
477 /* Allocate a new bitmap record. Returns index of new record. */
479 static int
480 x_allocate_bitmap_record (f)
481 FRAME_PTR f;
483 struct x_display_info *dpyinfo = FRAME_X_DISPLAY_INFO (f);
484 int i;
486 if (dpyinfo->bitmaps == NULL)
488 dpyinfo->bitmaps_size = 10;
489 dpyinfo->bitmaps
490 = (struct x_bitmap_record *) xmalloc (dpyinfo->bitmaps_size * sizeof (struct x_bitmap_record));
491 dpyinfo->bitmaps_last = 1;
492 return 1;
495 if (dpyinfo->bitmaps_last < dpyinfo->bitmaps_size)
496 return ++dpyinfo->bitmaps_last;
498 for (i = 0; i < dpyinfo->bitmaps_size; ++i)
499 if (dpyinfo->bitmaps[i].refcount == 0)
500 return i + 1;
502 dpyinfo->bitmaps_size *= 2;
503 dpyinfo->bitmaps
504 = (struct x_bitmap_record *) xrealloc (dpyinfo->bitmaps,
505 dpyinfo->bitmaps_size * sizeof (struct x_bitmap_record));
506 return ++dpyinfo->bitmaps_last;
509 /* Add one reference to the reference count of the bitmap with id ID. */
511 void
512 x_reference_bitmap (f, id)
513 FRAME_PTR f;
514 int id;
516 ++FRAME_X_DISPLAY_INFO (f)->bitmaps[id - 1].refcount;
519 /* Create a bitmap for frame F from a HEIGHT x WIDTH array of bits at BITS. */
522 x_create_bitmap_from_data (f, bits, width, height)
523 struct frame *f;
524 char *bits;
525 unsigned int width, height;
527 struct x_display_info *dpyinfo = FRAME_X_DISPLAY_INFO (f);
528 Pixmap bitmap;
529 int id;
531 bitmap = XCreateBitmapFromData (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
532 bits, width, height);
534 if (! bitmap)
535 return -1;
537 id = x_allocate_bitmap_record (f);
538 dpyinfo->bitmaps[id - 1].pixmap = bitmap;
539 dpyinfo->bitmaps[id - 1].file = NULL;
540 dpyinfo->bitmaps[id - 1].refcount = 1;
541 dpyinfo->bitmaps[id - 1].depth = 1;
542 dpyinfo->bitmaps[id - 1].height = height;
543 dpyinfo->bitmaps[id - 1].width = width;
545 return id;
548 /* Create bitmap from file FILE for frame F. */
551 x_create_bitmap_from_file (f, file)
552 struct frame *f;
553 Lisp_Object file;
555 struct x_display_info *dpyinfo = FRAME_X_DISPLAY_INFO (f);
556 unsigned int width, height;
557 Pixmap bitmap;
558 int xhot, yhot, result, id;
559 Lisp_Object found;
560 int fd;
561 char *filename;
563 /* Look for an existing bitmap with the same name. */
564 for (id = 0; id < dpyinfo->bitmaps_last; ++id)
566 if (dpyinfo->bitmaps[id].refcount
567 && dpyinfo->bitmaps[id].file
568 && !strcmp (dpyinfo->bitmaps[id].file, (char *) XSTRING (file)->data))
570 ++dpyinfo->bitmaps[id].refcount;
571 return id + 1;
575 /* Search bitmap-file-path for the file, if appropriate. */
576 fd = openp (Vx_bitmap_file_path, file, "", &found, 0);
577 if (fd < 0)
578 return -1;
579 close (fd);
581 filename = (char *) XSTRING (found)->data;
583 result = XReadBitmapFile (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
584 filename, &width, &height, &bitmap, &xhot, &yhot);
585 if (result != BitmapSuccess)
586 return -1;
588 id = x_allocate_bitmap_record (f);
589 dpyinfo->bitmaps[id - 1].pixmap = bitmap;
590 dpyinfo->bitmaps[id - 1].refcount = 1;
591 dpyinfo->bitmaps[id - 1].file = (char *) xmalloc (XSTRING (file)->size + 1);
592 dpyinfo->bitmaps[id - 1].depth = 1;
593 dpyinfo->bitmaps[id - 1].height = height;
594 dpyinfo->bitmaps[id - 1].width = width;
595 strcpy (dpyinfo->bitmaps[id - 1].file, XSTRING (file)->data);
597 return id;
600 /* Remove reference to bitmap with id number ID. */
603 x_destroy_bitmap (f, id)
604 FRAME_PTR f;
605 int id;
607 struct x_display_info *dpyinfo = FRAME_X_DISPLAY_INFO (f);
609 if (id > 0)
611 --dpyinfo->bitmaps[id - 1].refcount;
612 if (dpyinfo->bitmaps[id - 1].refcount == 0)
614 BLOCK_INPUT;
615 XFreePixmap (FRAME_X_DISPLAY (f), dpyinfo->bitmaps[id - 1].pixmap);
616 if (dpyinfo->bitmaps[id - 1].file)
618 free (dpyinfo->bitmaps[id - 1].file);
619 dpyinfo->bitmaps[id - 1].file = NULL;
621 UNBLOCK_INPUT;
626 /* Free all the bitmaps for the display specified by DPYINFO. */
628 static void
629 x_destroy_all_bitmaps (dpyinfo)
630 struct x_display_info *dpyinfo;
632 int i;
633 for (i = 0; i < dpyinfo->bitmaps_last; i++)
634 if (dpyinfo->bitmaps[i].refcount > 0)
636 XFreePixmap (dpyinfo->display, dpyinfo->bitmaps[i].pixmap);
637 if (dpyinfo->bitmaps[i].file)
638 free (dpyinfo->bitmaps[i].file);
640 dpyinfo->bitmaps_last = 0;
643 /* Connect the frame-parameter names for X frames
644 to the ways of passing the parameter values to the window system.
646 The name of a parameter, as a Lisp symbol,
647 has an `x-frame-parameter' property which is an integer in Lisp
648 that is an index in this table. */
650 struct x_frame_parm_table
652 char *name;
653 void (*setter)( /* struct frame *frame, Lisp_Object val, oldval */ );
656 void x_set_foreground_color ();
657 void x_set_background_color ();
658 void x_set_mouse_color ();
659 void x_set_cursor_color ();
660 void x_set_border_color ();
661 void x_set_cursor_type ();
662 void x_set_icon_type ();
663 void x_set_icon_name ();
664 void x_set_font ();
665 void x_set_border_width ();
666 void x_set_internal_border_width ();
667 void x_explicitly_set_name ();
668 void x_set_autoraise ();
669 void x_set_autolower ();
670 void x_set_vertical_scroll_bars ();
671 void x_set_visibility ();
672 void x_set_menu_bar_lines ();
673 void x_set_scroll_bar_width ();
674 void x_set_title ();
675 void x_set_unsplittable ();
677 static struct x_frame_parm_table x_frame_parms[] =
679 "auto-raise", x_set_autoraise,
680 "auto-lower", x_set_autolower,
681 "background-color", x_set_background_color,
682 "border-color", x_set_border_color,
683 "border-width", x_set_border_width,
684 "cursor-color", x_set_cursor_color,
685 "cursor-type", x_set_cursor_type,
686 "font", x_set_font,
687 "foreground-color", x_set_foreground_color,
688 "icon-name", x_set_icon_name,
689 "icon-type", x_set_icon_type,
690 "internal-border-width", x_set_internal_border_width,
691 "menu-bar-lines", x_set_menu_bar_lines,
692 "mouse-color", x_set_mouse_color,
693 "name", x_explicitly_set_name,
694 "scroll-bar-width", x_set_scroll_bar_width,
695 "title", x_set_title,
696 "unsplittable", x_set_unsplittable,
697 "vertical-scroll-bars", x_set_vertical_scroll_bars,
698 "visibility", x_set_visibility,
701 /* Attach the `x-frame-parameter' properties to
702 the Lisp symbol names of parameters relevant to X. */
704 init_x_parm_symbols ()
706 int i;
708 for (i = 0; i < sizeof (x_frame_parms) / sizeof (x_frame_parms[0]); i++)
709 Fput (intern (x_frame_parms[i].name), Qx_frame_parameter,
710 make_number (i));
713 /* Change the parameters of FRAME as specified by ALIST.
714 If a parameter is not specially recognized, do nothing;
715 otherwise call the `x_set_...' function for that parameter. */
717 void
718 x_set_frame_parameters (f, alist)
719 FRAME_PTR f;
720 Lisp_Object alist;
722 Lisp_Object tail;
724 /* If both of these parameters are present, it's more efficient to
725 set them both at once. So we wait until we've looked at the
726 entire list before we set them. */
727 Lisp_Object width, height;
729 /* Same here. */
730 Lisp_Object left, top;
732 /* Same with these. */
733 Lisp_Object icon_left, icon_top;
735 /* Record in these vectors all the parms specified. */
736 Lisp_Object *parms;
737 Lisp_Object *values;
738 int i;
739 int left_no_change = 0, top_no_change = 0;
740 int icon_left_no_change = 0, icon_top_no_change = 0;
742 i = 0;
743 for (tail = alist; CONSP (tail); tail = Fcdr (tail))
744 i++;
746 parms = (Lisp_Object *) alloca (i * sizeof (Lisp_Object));
747 values = (Lisp_Object *) alloca (i * sizeof (Lisp_Object));
749 /* Extract parm names and values into those vectors. */
751 i = 0;
752 for (tail = alist; CONSP (tail); tail = Fcdr (tail))
754 Lisp_Object elt, prop, val;
756 elt = Fcar (tail);
757 parms[i] = Fcar (elt);
758 values[i] = Fcdr (elt);
759 i++;
762 width = height = top = left = Qunbound;
763 icon_left = icon_top = Qunbound;
765 /* Now process them in reverse of specified order. */
766 for (i--; i >= 0; i--)
768 Lisp_Object prop, val;
770 prop = parms[i];
771 val = values[i];
773 if (EQ (prop, Qwidth))
774 width = val;
775 else if (EQ (prop, Qheight))
776 height = val;
777 else if (EQ (prop, Qtop))
778 top = val;
779 else if (EQ (prop, Qleft))
780 left = val;
781 else if (EQ (prop, Qicon_top))
782 icon_top = val;
783 else if (EQ (prop, Qicon_left))
784 icon_left = val;
785 else
787 register Lisp_Object param_index, old_value;
789 param_index = Fget (prop, Qx_frame_parameter);
790 old_value = get_frame_param (f, prop);
791 store_frame_param (f, prop, val);
792 if (NATNUMP (param_index)
793 && (XFASTINT (param_index)
794 < sizeof (x_frame_parms)/sizeof (x_frame_parms[0])))
795 (*x_frame_parms[XINT (param_index)].setter)(f, val, old_value);
799 /* Don't die if just one of these was set. */
800 if (EQ (left, Qunbound))
802 left_no_change = 1;
803 if (f->output_data.x->left_pos < 0)
804 left = Fcons (Qplus, Fcons (make_number (f->output_data.x->left_pos), Qnil));
805 else
806 XSETINT (left, f->output_data.x->left_pos);
808 if (EQ (top, Qunbound))
810 top_no_change = 1;
811 if (f->output_data.x->top_pos < 0)
812 top = Fcons (Qplus, Fcons (make_number (f->output_data.x->top_pos), Qnil));
813 else
814 XSETINT (top, f->output_data.x->top_pos);
817 /* If one of the icon positions was not set, preserve or default it. */
818 if (EQ (icon_left, Qunbound) || ! INTEGERP (icon_left))
820 icon_left_no_change = 1;
821 icon_left = Fcdr (Fassq (Qicon_left, f->param_alist));
822 if (NILP (icon_left))
823 XSETINT (icon_left, 0);
825 if (EQ (icon_top, Qunbound) || ! INTEGERP (icon_top))
827 icon_top_no_change = 1;
828 icon_top = Fcdr (Fassq (Qicon_top, f->param_alist));
829 if (NILP (icon_top))
830 XSETINT (icon_top, 0);
833 /* Don't die if just one of these was set. */
834 if (EQ (width, Qunbound))
836 if (FRAME_NEW_WIDTH (f))
837 XSETINT (width, FRAME_NEW_WIDTH (f));
838 else
839 XSETINT (width, FRAME_WIDTH (f));
841 if (EQ (height, Qunbound))
843 if (FRAME_NEW_HEIGHT (f))
844 XSETINT (height, FRAME_NEW_HEIGHT (f));
845 else
846 XSETINT (height, FRAME_HEIGHT (f));
849 /* Don't set these parameters unless they've been explicitly
850 specified. The window might be mapped or resized while we're in
851 this function, and we don't want to override that unless the lisp
852 code has asked for it.
854 Don't set these parameters unless they actually differ from the
855 window's current parameters; the window may not actually exist
856 yet. */
858 Lisp_Object frame;
860 check_frame_size (f, &height, &width);
862 XSETFRAME (frame, f);
864 if ((NUMBERP (width) && XINT (width) != FRAME_WIDTH (f))
865 || (NUMBERP (height) && XINT (height) != FRAME_HEIGHT (f))
866 || FRAME_NEW_HEIGHT (f) || FRAME_NEW_WIDTH (f))
867 Fset_frame_size (frame, width, height);
869 if ((!NILP (left) || !NILP (top))
870 && ! (left_no_change && top_no_change)
871 && ! (NUMBERP (left) && XINT (left) == f->output_data.x->left_pos
872 && NUMBERP (top) && XINT (top) == f->output_data.x->top_pos))
874 int leftpos = 0;
875 int toppos = 0;
877 /* Record the signs. */
878 f->output_data.x->size_hint_flags &= ~ (XNegative | YNegative);
879 if (EQ (left, Qminus))
880 f->output_data.x->size_hint_flags |= XNegative;
881 else if (INTEGERP (left))
883 leftpos = XINT (left);
884 if (leftpos < 0)
885 f->output_data.x->size_hint_flags |= XNegative;
887 else if (CONSP (left) && EQ (XCONS (left)->car, Qminus)
888 && CONSP (XCONS (left)->cdr)
889 && INTEGERP (XCONS (XCONS (left)->cdr)->car))
891 leftpos = - XINT (XCONS (XCONS (left)->cdr)->car);
892 f->output_data.x->size_hint_flags |= XNegative;
894 else if (CONSP (left) && EQ (XCONS (left)->car, Qplus)
895 && CONSP (XCONS (left)->cdr)
896 && INTEGERP (XCONS (XCONS (left)->cdr)->car))
898 leftpos = XINT (XCONS (XCONS (left)->cdr)->car);
901 if (EQ (top, Qminus))
902 f->output_data.x->size_hint_flags |= YNegative;
903 else if (INTEGERP (top))
905 toppos = XINT (top);
906 if (toppos < 0)
907 f->output_data.x->size_hint_flags |= YNegative;
909 else if (CONSP (top) && EQ (XCONS (top)->car, Qminus)
910 && CONSP (XCONS (top)->cdr)
911 && INTEGERP (XCONS (XCONS (top)->cdr)->car))
913 toppos = - XINT (XCONS (XCONS (top)->cdr)->car);
914 f->output_data.x->size_hint_flags |= YNegative;
916 else if (CONSP (top) && EQ (XCONS (top)->car, Qplus)
917 && CONSP (XCONS (top)->cdr)
918 && INTEGERP (XCONS (XCONS (top)->cdr)->car))
920 toppos = XINT (XCONS (XCONS (top)->cdr)->car);
924 /* Store the numeric value of the position. */
925 f->output_data.x->top_pos = toppos;
926 f->output_data.x->left_pos = leftpos;
928 f->output_data.x->win_gravity = NorthWestGravity;
930 /* Actually set that position, and convert to absolute. */
931 x_set_offset (f, leftpos, toppos, -1);
934 if ((!NILP (icon_left) || !NILP (icon_top))
935 && ! (icon_left_no_change && icon_top_no_change))
936 x_wm_set_icon_position (f, XINT (icon_left), XINT (icon_top));
940 /* Store the screen positions of frame F into XPTR and YPTR.
941 These are the positions of the containing window manager window,
942 not Emacs's own window. */
944 void
945 x_real_positions (f, xptr, yptr)
946 FRAME_PTR f;
947 int *xptr, *yptr;
949 int win_x, win_y;
950 Window child;
952 /* This is pretty gross, but seems to be the easiest way out of
953 the problem that arises when restarting window-managers. */
955 #ifdef USE_X_TOOLKIT
956 Window outer = XtWindow (f->output_data.x->widget);
957 #else
958 Window outer = f->output_data.x->window_desc;
959 #endif
960 Window tmp_root_window;
961 Window *tmp_children;
962 int tmp_nchildren;
964 while (1)
966 x_catch_errors (FRAME_X_DISPLAY (f));
968 XQueryTree (FRAME_X_DISPLAY (f), outer, &tmp_root_window,
969 &f->output_data.x->parent_desc,
970 &tmp_children, &tmp_nchildren);
971 XFree ((char *) tmp_children);
973 win_x = win_y = 0;
975 /* Find the position of the outside upper-left corner of
976 the inner window, with respect to the outer window. */
977 if (f->output_data.x->parent_desc != FRAME_X_DISPLAY_INFO (f)->root_window)
979 XTranslateCoordinates (FRAME_X_DISPLAY (f),
981 /* From-window, to-window. */
982 #ifdef USE_X_TOOLKIT
983 XtWindow (f->output_data.x->widget),
984 #else
985 f->output_data.x->window_desc,
986 #endif
987 f->output_data.x->parent_desc,
989 /* From-position, to-position. */
990 0, 0, &win_x, &win_y,
992 /* Child of win. */
993 &child);
995 #if 0 /* The values seem to be right without this and wrong with. */
996 win_x += f->output_data.x->border_width;
997 win_y += f->output_data.x->border_width;
998 #endif
1001 /* It is possible for the window returned by the XQueryNotify
1002 to become invalid by the time we call XTranslateCoordinates.
1003 That can happen when you restart some window managers.
1004 If so, we get an error in XTranslateCoordinates.
1005 Detect that and try the whole thing over. */
1006 if (! x_had_errors_p (FRAME_X_DISPLAY (f)))
1008 x_uncatch_errors (FRAME_X_DISPLAY (f));
1009 break;
1012 x_uncatch_errors (FRAME_X_DISPLAY (f));
1015 *xptr = f->output_data.x->left_pos - win_x;
1016 *yptr = f->output_data.x->top_pos - win_y;
1019 /* Insert a description of internally-recorded parameters of frame X
1020 into the parameter alist *ALISTPTR that is to be given to the user.
1021 Only parameters that are specific to the X window system
1022 and whose values are not correctly recorded in the frame's
1023 param_alist need to be considered here. */
1025 x_report_frame_params (f, alistptr)
1026 struct frame *f;
1027 Lisp_Object *alistptr;
1029 char buf[16];
1030 Lisp_Object tem;
1032 /* Represent negative positions (off the top or left screen edge)
1033 in a way that Fmodify_frame_parameters will understand correctly. */
1034 XSETINT (tem, f->output_data.x->left_pos);
1035 if (f->output_data.x->left_pos >= 0)
1036 store_in_alist (alistptr, Qleft, tem);
1037 else
1038 store_in_alist (alistptr, Qleft, Fcons (Qplus, Fcons (tem, Qnil)));
1040 XSETINT (tem, f->output_data.x->top_pos);
1041 if (f->output_data.x->top_pos >= 0)
1042 store_in_alist (alistptr, Qtop, tem);
1043 else
1044 store_in_alist (alistptr, Qtop, Fcons (Qplus, Fcons (tem, Qnil)));
1046 store_in_alist (alistptr, Qborder_width,
1047 make_number (f->output_data.x->border_width));
1048 store_in_alist (alistptr, Qinternal_border_width,
1049 make_number (f->output_data.x->internal_border_width));
1050 sprintf (buf, "%ld", (long) FRAME_X_WINDOW (f));
1051 store_in_alist (alistptr, Qwindow_id,
1052 build_string (buf));
1053 store_in_alist (alistptr, Qicon_name, f->icon_name);
1054 FRAME_SAMPLE_VISIBILITY (f);
1055 store_in_alist (alistptr, Qvisibility,
1056 (FRAME_VISIBLE_P (f) ? Qt
1057 : FRAME_ICONIFIED_P (f) ? Qicon : Qnil));
1058 store_in_alist (alistptr, Qdisplay,
1059 XCONS (FRAME_X_DISPLAY_INFO (f)->name_list_element)->car);
1063 /* Decide if color named COLOR is valid for the display associated with
1064 the selected frame; if so, return the rgb values in COLOR_DEF.
1065 If ALLOC is nonzero, allocate a new colormap cell. */
1068 defined_color (f, color, color_def, alloc)
1069 FRAME_PTR f;
1070 char *color;
1071 XColor *color_def;
1072 int alloc;
1074 register int status;
1075 Colormap screen_colormap;
1076 Display *display = FRAME_X_DISPLAY (f);
1078 BLOCK_INPUT;
1079 screen_colormap = DefaultColormap (display, XDefaultScreen (display));
1081 status = XParseColor (display, screen_colormap, color, color_def);
1082 if (status && alloc)
1084 status = XAllocColor (display, screen_colormap, color_def);
1085 if (!status)
1087 /* If we got to this point, the colormap is full, so we're
1088 going to try and get the next closest color.
1089 The algorithm used is a least-squares matching, which is
1090 what X uses for closest color matching with StaticColor visuals. */
1092 XColor *cells;
1093 int no_cells;
1094 int nearest;
1095 long nearest_delta, trial_delta;
1096 int x;
1098 no_cells = XDisplayCells (display, XDefaultScreen (display));
1099 cells = (XColor *) alloca (sizeof (XColor) * no_cells);
1101 for (x = 0; x < no_cells; x++)
1102 cells[x].pixel = x;
1104 XQueryColors (display, screen_colormap, cells, no_cells);
1105 nearest = 0;
1106 /* I'm assuming CSE so I'm not going to condense this. */
1107 nearest_delta = ((((color_def->red >> 8) - (cells[0].red >> 8))
1108 * ((color_def->red >> 8) - (cells[0].red >> 8)))
1110 (((color_def->green >> 8) - (cells[0].green >> 8))
1111 * ((color_def->green >> 8) - (cells[0].green >> 8)))
1113 (((color_def->blue >> 8) - (cells[0].blue >> 8))
1114 * ((color_def->blue >> 8) - (cells[0].blue >> 8))));
1115 for (x = 1; x < no_cells; x++)
1117 trial_delta = ((((color_def->red >> 8) - (cells[x].red >> 8))
1118 * ((color_def->red >> 8) - (cells[x].red >> 8)))
1120 (((color_def->green >> 8) - (cells[x].green >> 8))
1121 * ((color_def->green >> 8) - (cells[x].green >> 8)))
1123 (((color_def->blue >> 8) - (cells[x].blue >> 8))
1124 * ((color_def->blue >> 8) - (cells[x].blue >> 8))));
1125 if (trial_delta < nearest_delta)
1127 XColor temp;
1128 temp.red = cells[x].red;
1129 temp.green = cells[x].green;
1130 temp.blue = cells[x].blue;
1131 status = XAllocColor (display, screen_colormap, &temp);
1132 if (status)
1134 nearest = x;
1135 nearest_delta = trial_delta;
1139 color_def->red = cells[nearest].red;
1140 color_def->green = cells[nearest].green;
1141 color_def->blue = cells[nearest].blue;
1142 status = XAllocColor (display, screen_colormap, color_def);
1145 UNBLOCK_INPUT;
1147 if (status)
1148 return 1;
1149 else
1150 return 0;
1153 /* Given a string ARG naming a color, compute a pixel value from it
1154 suitable for screen F.
1155 If F is not a color screen, return DEF (default) regardless of what
1156 ARG says. */
1159 x_decode_color (f, arg, def)
1160 FRAME_PTR f;
1161 Lisp_Object arg;
1162 int def;
1164 XColor cdef;
1166 CHECK_STRING (arg, 0);
1168 if (strcmp (XSTRING (arg)->data, "black") == 0)
1169 return BLACK_PIX_DEFAULT (f);
1170 else if (strcmp (XSTRING (arg)->data, "white") == 0)
1171 return WHITE_PIX_DEFAULT (f);
1173 if (FRAME_X_DISPLAY_INFO (f)->n_planes == 1)
1174 return def;
1176 /* defined_color is responsible for coping with failures
1177 by looking for a near-miss. */
1178 if (defined_color (f, XSTRING (arg)->data, &cdef, 1))
1179 return cdef.pixel;
1181 Fsignal (Qerror, Fcons (build_string ("undefined color"),
1182 Fcons (arg, Qnil)));
1185 /* Functions called only from `x_set_frame_param'
1186 to set individual parameters.
1188 If FRAME_X_WINDOW (f) is 0,
1189 the frame is being created and its X-window does not exist yet.
1190 In that case, just record the parameter's new value
1191 in the standard place; do not attempt to change the window. */
1193 void
1194 x_set_foreground_color (f, arg, oldval)
1195 struct frame *f;
1196 Lisp_Object arg, oldval;
1198 f->output_data.x->foreground_pixel
1199 = x_decode_color (f, arg, BLACK_PIX_DEFAULT (f));
1200 if (FRAME_X_WINDOW (f) != 0)
1202 BLOCK_INPUT;
1203 XSetForeground (FRAME_X_DISPLAY (f), f->output_data.x->normal_gc,
1204 f->output_data.x->foreground_pixel);
1205 XSetBackground (FRAME_X_DISPLAY (f), f->output_data.x->reverse_gc,
1206 f->output_data.x->foreground_pixel);
1207 UNBLOCK_INPUT;
1208 recompute_basic_faces (f);
1209 if (FRAME_VISIBLE_P (f))
1210 redraw_frame (f);
1214 void
1215 x_set_background_color (f, arg, oldval)
1216 struct frame *f;
1217 Lisp_Object arg, oldval;
1219 Pixmap temp;
1220 int mask;
1222 f->output_data.x->background_pixel
1223 = x_decode_color (f, arg, WHITE_PIX_DEFAULT (f));
1225 if (FRAME_X_WINDOW (f) != 0)
1227 BLOCK_INPUT;
1228 /* The main frame area. */
1229 XSetBackground (FRAME_X_DISPLAY (f), f->output_data.x->normal_gc,
1230 f->output_data.x->background_pixel);
1231 XSetForeground (FRAME_X_DISPLAY (f), f->output_data.x->reverse_gc,
1232 f->output_data.x->background_pixel);
1233 XSetForeground (FRAME_X_DISPLAY (f), f->output_data.x->cursor_gc,
1234 f->output_data.x->background_pixel);
1235 XSetWindowBackground (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
1236 f->output_data.x->background_pixel);
1238 Lisp_Object bar;
1239 for (bar = FRAME_SCROLL_BARS (f); !NILP (bar);
1240 bar = XSCROLL_BAR (bar)->next)
1241 XSetWindowBackground (FRAME_X_DISPLAY (f),
1242 SCROLL_BAR_X_WINDOW (XSCROLL_BAR (bar)),
1243 f->output_data.x->background_pixel);
1245 UNBLOCK_INPUT;
1247 recompute_basic_faces (f);
1249 if (FRAME_VISIBLE_P (f))
1250 redraw_frame (f);
1254 void
1255 x_set_mouse_color (f, arg, oldval)
1256 struct frame *f;
1257 Lisp_Object arg, oldval;
1259 Cursor cursor, nontext_cursor, mode_cursor, cross_cursor;
1260 int mask_color;
1262 if (!EQ (Qnil, arg))
1263 f->output_data.x->mouse_pixel
1264 = x_decode_color (f, arg, BLACK_PIX_DEFAULT (f));
1265 mask_color = f->output_data.x->background_pixel;
1266 /* No invisible pointers. */
1267 if (mask_color == f->output_data.x->mouse_pixel
1268 && mask_color == f->output_data.x->background_pixel)
1269 f->output_data.x->mouse_pixel = f->output_data.x->foreground_pixel;
1271 BLOCK_INPUT;
1273 /* It's not okay to crash if the user selects a screwy cursor. */
1274 x_catch_errors (FRAME_X_DISPLAY (f));
1276 if (!EQ (Qnil, Vx_pointer_shape))
1278 CHECK_NUMBER (Vx_pointer_shape, 0);
1279 cursor = XCreateFontCursor (FRAME_X_DISPLAY (f), XINT (Vx_pointer_shape));
1281 else
1282 cursor = XCreateFontCursor (FRAME_X_DISPLAY (f), XC_xterm);
1283 x_check_errors (FRAME_X_DISPLAY (f), "bad text pointer cursor: %s");
1285 if (!EQ (Qnil, Vx_nontext_pointer_shape))
1287 CHECK_NUMBER (Vx_nontext_pointer_shape, 0);
1288 nontext_cursor = XCreateFontCursor (FRAME_X_DISPLAY (f),
1289 XINT (Vx_nontext_pointer_shape));
1291 else
1292 nontext_cursor = XCreateFontCursor (FRAME_X_DISPLAY (f), XC_left_ptr);
1293 x_check_errors (FRAME_X_DISPLAY (f), "bad nontext pointer cursor: %s");
1295 if (!EQ (Qnil, Vx_mode_pointer_shape))
1297 CHECK_NUMBER (Vx_mode_pointer_shape, 0);
1298 mode_cursor = XCreateFontCursor (FRAME_X_DISPLAY (f),
1299 XINT (Vx_mode_pointer_shape));
1301 else
1302 mode_cursor = XCreateFontCursor (FRAME_X_DISPLAY (f), XC_xterm);
1303 x_check_errors (FRAME_X_DISPLAY (f), "bad modeline pointer cursor: %s");
1305 if (!EQ (Qnil, Vx_sensitive_text_pointer_shape))
1307 CHECK_NUMBER (Vx_sensitive_text_pointer_shape, 0);
1308 cross_cursor
1309 = XCreateFontCursor (FRAME_X_DISPLAY (f),
1310 XINT (Vx_sensitive_text_pointer_shape));
1312 else
1313 cross_cursor = XCreateFontCursor (FRAME_X_DISPLAY (f), XC_crosshair);
1315 /* Check and report errors with the above calls. */
1316 x_check_errors (FRAME_X_DISPLAY (f), "can't set cursor shape: %s");
1317 x_uncatch_errors (FRAME_X_DISPLAY (f));
1320 XColor fore_color, back_color;
1322 fore_color.pixel = f->output_data.x->mouse_pixel;
1323 back_color.pixel = mask_color;
1324 XQueryColor (FRAME_X_DISPLAY (f),
1325 DefaultColormap (FRAME_X_DISPLAY (f),
1326 DefaultScreen (FRAME_X_DISPLAY (f))),
1327 &fore_color);
1328 XQueryColor (FRAME_X_DISPLAY (f),
1329 DefaultColormap (FRAME_X_DISPLAY (f),
1330 DefaultScreen (FRAME_X_DISPLAY (f))),
1331 &back_color);
1332 XRecolorCursor (FRAME_X_DISPLAY (f), cursor,
1333 &fore_color, &back_color);
1334 XRecolorCursor (FRAME_X_DISPLAY (f), nontext_cursor,
1335 &fore_color, &back_color);
1336 XRecolorCursor (FRAME_X_DISPLAY (f), mode_cursor,
1337 &fore_color, &back_color);
1338 XRecolorCursor (FRAME_X_DISPLAY (f), cross_cursor,
1339 &fore_color, &back_color);
1342 if (FRAME_X_WINDOW (f) != 0)
1344 XDefineCursor (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f), cursor);
1347 if (cursor != f->output_data.x->text_cursor && f->output_data.x->text_cursor != 0)
1348 XFreeCursor (FRAME_X_DISPLAY (f), f->output_data.x->text_cursor);
1349 f->output_data.x->text_cursor = cursor;
1351 if (nontext_cursor != f->output_data.x->nontext_cursor
1352 && f->output_data.x->nontext_cursor != 0)
1353 XFreeCursor (FRAME_X_DISPLAY (f), f->output_data.x->nontext_cursor);
1354 f->output_data.x->nontext_cursor = nontext_cursor;
1356 if (mode_cursor != f->output_data.x->modeline_cursor
1357 && f->output_data.x->modeline_cursor != 0)
1358 XFreeCursor (FRAME_X_DISPLAY (f), f->output_data.x->modeline_cursor);
1359 f->output_data.x->modeline_cursor = mode_cursor;
1360 if (cross_cursor != f->output_data.x->cross_cursor
1361 && f->output_data.x->cross_cursor != 0)
1362 XFreeCursor (FRAME_X_DISPLAY (f), f->output_data.x->cross_cursor);
1363 f->output_data.x->cross_cursor = cross_cursor;
1365 XFlush (FRAME_X_DISPLAY (f));
1366 UNBLOCK_INPUT;
1369 void
1370 x_set_cursor_color (f, arg, oldval)
1371 struct frame *f;
1372 Lisp_Object arg, oldval;
1374 unsigned long fore_pixel;
1376 if (!EQ (Vx_cursor_fore_pixel, Qnil))
1377 fore_pixel = x_decode_color (f, Vx_cursor_fore_pixel,
1378 WHITE_PIX_DEFAULT (f));
1379 else
1380 fore_pixel = f->output_data.x->background_pixel;
1381 f->output_data.x->cursor_pixel = x_decode_color (f, arg, BLACK_PIX_DEFAULT (f));
1383 /* Make sure that the cursor color differs from the background color. */
1384 if (f->output_data.x->cursor_pixel == f->output_data.x->background_pixel)
1386 f->output_data.x->cursor_pixel = f->output_data.x->mouse_pixel;
1387 if (f->output_data.x->cursor_pixel == fore_pixel)
1388 fore_pixel = f->output_data.x->background_pixel;
1390 f->output_data.x->cursor_foreground_pixel = fore_pixel;
1392 if (FRAME_X_WINDOW (f) != 0)
1394 BLOCK_INPUT;
1395 XSetBackground (FRAME_X_DISPLAY (f), f->output_data.x->cursor_gc,
1396 f->output_data.x->cursor_pixel);
1397 XSetForeground (FRAME_X_DISPLAY (f), f->output_data.x->cursor_gc,
1398 fore_pixel);
1399 UNBLOCK_INPUT;
1401 if (FRAME_VISIBLE_P (f))
1403 x_display_cursor (f, 0);
1404 x_display_cursor (f, 1);
1409 /* Set the border-color of frame F to value described by ARG.
1410 ARG can be a string naming a color.
1411 The border-color is used for the border that is drawn by the X server.
1412 Note that this does not fully take effect if done before
1413 F has an x-window; it must be redone when the window is created.
1415 Note: this is done in two routines because of the way X10 works.
1417 Note: under X11, this is normally the province of the window manager,
1418 and so emacs' border colors may be overridden. */
1420 void
1421 x_set_border_color (f, arg, oldval)
1422 struct frame *f;
1423 Lisp_Object arg, oldval;
1425 unsigned char *str;
1426 int pix;
1428 CHECK_STRING (arg, 0);
1429 str = XSTRING (arg)->data;
1431 pix = x_decode_color (f, arg, BLACK_PIX_DEFAULT (f));
1433 x_set_border_pixel (f, pix);
1436 /* Set the border-color of frame F to pixel value PIX.
1437 Note that this does not fully take effect if done before
1438 F has an x-window. */
1440 x_set_border_pixel (f, pix)
1441 struct frame *f;
1442 int pix;
1444 f->output_data.x->border_pixel = pix;
1446 if (FRAME_X_WINDOW (f) != 0 && f->output_data.x->border_width > 0)
1448 Pixmap temp;
1449 int mask;
1451 BLOCK_INPUT;
1452 XSetWindowBorder (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
1453 (unsigned long)pix);
1454 UNBLOCK_INPUT;
1456 if (FRAME_VISIBLE_P (f))
1457 redraw_frame (f);
1461 void
1462 x_set_cursor_type (f, arg, oldval)
1463 FRAME_PTR f;
1464 Lisp_Object arg, oldval;
1466 if (EQ (arg, Qbar))
1468 FRAME_DESIRED_CURSOR (f) = bar_cursor;
1469 f->output_data.x->cursor_width = 2;
1471 else if (CONSP (arg) && EQ (XCONS (arg)->car, Qbar)
1472 && INTEGERP (XCONS (arg)->cdr))
1474 FRAME_DESIRED_CURSOR (f) = bar_cursor;
1475 f->output_data.x->cursor_width = XINT (XCONS (arg)->cdr);
1477 else
1478 /* Treat anything unknown as "box cursor".
1479 It was bad to signal an error; people have trouble fixing
1480 .Xdefaults with Emacs, when it has something bad in it. */
1481 FRAME_DESIRED_CURSOR (f) = filled_box_cursor;
1483 /* Make sure the cursor gets redrawn. This is overkill, but how
1484 often do people change cursor types? */
1485 update_mode_lines++;
1488 void
1489 x_set_icon_type (f, arg, oldval)
1490 struct frame *f;
1491 Lisp_Object arg, oldval;
1493 Lisp_Object tem;
1494 int result;
1496 if (STRINGP (arg))
1498 if (STRINGP (oldval) && EQ (Fstring_equal (oldval, arg), Qt))
1499 return;
1501 else if (!STRINGP (oldval) && EQ (oldval, Qnil) == EQ (arg, Qnil))
1502 return;
1504 BLOCK_INPUT;
1505 if (NILP (arg))
1506 result = x_text_icon (f,
1507 (char *) XSTRING ((!NILP (f->icon_name)
1508 ? f->icon_name
1509 : f->name))->data);
1510 else
1511 result = x_bitmap_icon (f, arg);
1513 if (result)
1515 UNBLOCK_INPUT;
1516 error ("No icon window available");
1519 XFlush (FRAME_X_DISPLAY (f));
1520 UNBLOCK_INPUT;
1523 /* Return non-nil if frame F wants a bitmap icon. */
1525 Lisp_Object
1526 x_icon_type (f)
1527 FRAME_PTR f;
1529 Lisp_Object tem;
1531 tem = assq_no_quit (Qicon_type, f->param_alist);
1532 if (CONSP (tem))
1533 return XCONS (tem)->cdr;
1534 else
1535 return Qnil;
1538 void
1539 x_set_icon_name (f, arg, oldval)
1540 struct frame *f;
1541 Lisp_Object arg, oldval;
1543 Lisp_Object tem;
1544 int result;
1546 if (STRINGP (arg))
1548 if (STRINGP (oldval) && EQ (Fstring_equal (oldval, arg), Qt))
1549 return;
1551 else if (!STRINGP (oldval) && EQ (oldval, Qnil) == EQ (arg, Qnil))
1552 return;
1554 f->icon_name = arg;
1556 if (f->output_data.x->icon_bitmap != 0)
1557 return;
1559 BLOCK_INPUT;
1561 result = x_text_icon (f,
1562 (char *) XSTRING ((!NILP (f->icon_name)
1563 ? f->icon_name
1564 : !NILP (f->title)
1565 ? f->title
1566 : f->name))->data);
1568 if (result)
1570 UNBLOCK_INPUT;
1571 error ("No icon window available");
1574 XFlush (FRAME_X_DISPLAY (f));
1575 UNBLOCK_INPUT;
1578 extern Lisp_Object x_new_font ();
1580 void
1581 x_set_font (f, arg, oldval)
1582 struct frame *f;
1583 Lisp_Object arg, oldval;
1585 Lisp_Object result;
1587 CHECK_STRING (arg, 1);
1589 BLOCK_INPUT;
1590 result = x_new_font (f, XSTRING (arg)->data);
1591 UNBLOCK_INPUT;
1593 if (EQ (result, Qnil))
1594 error ("Font `%s' is not defined", XSTRING (arg)->data);
1595 else if (EQ (result, Qt))
1596 error ("the characters of the given font have varying widths");
1597 else if (STRINGP (result))
1599 recompute_basic_faces (f);
1600 store_frame_param (f, Qfont, result);
1602 else
1603 abort ();
1606 void
1607 x_set_border_width (f, arg, oldval)
1608 struct frame *f;
1609 Lisp_Object arg, oldval;
1611 CHECK_NUMBER (arg, 0);
1613 if (XINT (arg) == f->output_data.x->border_width)
1614 return;
1616 if (FRAME_X_WINDOW (f) != 0)
1617 error ("Cannot change the border width of a window");
1619 f->output_data.x->border_width = XINT (arg);
1622 void
1623 x_set_internal_border_width (f, arg, oldval)
1624 struct frame *f;
1625 Lisp_Object arg, oldval;
1627 int mask;
1628 int old = f->output_data.x->internal_border_width;
1630 CHECK_NUMBER (arg, 0);
1631 f->output_data.x->internal_border_width = XINT (arg);
1632 if (f->output_data.x->internal_border_width < 0)
1633 f->output_data.x->internal_border_width = 0;
1635 if (f->output_data.x->internal_border_width == old)
1636 return;
1638 if (FRAME_X_WINDOW (f) != 0)
1640 BLOCK_INPUT;
1641 x_set_window_size (f, 0, f->width, f->height);
1642 #if 0
1643 x_set_resize_hint (f);
1644 #endif
1645 XFlush (FRAME_X_DISPLAY (f));
1646 UNBLOCK_INPUT;
1647 SET_FRAME_GARBAGED (f);
1651 void
1652 x_set_visibility (f, value, oldval)
1653 struct frame *f;
1654 Lisp_Object value, oldval;
1656 Lisp_Object frame;
1657 XSETFRAME (frame, f);
1659 if (NILP (value))
1660 Fmake_frame_invisible (frame, Qt);
1661 else if (EQ (value, Qicon))
1662 Ficonify_frame (frame);
1663 else
1664 Fmake_frame_visible (frame);
1667 static void
1668 x_set_menu_bar_lines_1 (window, n)
1669 Lisp_Object window;
1670 int n;
1672 struct window *w = XWINDOW (window);
1674 XSETFASTINT (w->top, XFASTINT (w->top) + n);
1675 XSETFASTINT (w->height, XFASTINT (w->height) - n);
1677 /* Handle just the top child in a vertical split. */
1678 if (!NILP (w->vchild))
1679 x_set_menu_bar_lines_1 (w->vchild, n);
1681 /* Adjust all children in a horizontal split. */
1682 for (window = w->hchild; !NILP (window); window = w->next)
1684 w = XWINDOW (window);
1685 x_set_menu_bar_lines_1 (window, n);
1689 void
1690 x_set_menu_bar_lines (f, value, oldval)
1691 struct frame *f;
1692 Lisp_Object value, oldval;
1694 int nlines;
1695 int olines = FRAME_MENU_BAR_LINES (f);
1697 /* Right now, menu bars don't work properly in minibuf-only frames;
1698 most of the commands try to apply themselves to the minibuffer
1699 frame itslef, and get an error because you can't switch buffers
1700 in or split the minibuffer window. */
1701 if (FRAME_MINIBUF_ONLY_P (f))
1702 return;
1704 if (INTEGERP (value))
1705 nlines = XINT (value);
1706 else
1707 nlines = 0;
1709 #ifdef USE_X_TOOLKIT
1710 FRAME_MENU_BAR_LINES (f) = 0;
1711 if (nlines)
1713 FRAME_EXTERNAL_MENU_BAR (f) = 1;
1714 if (FRAME_X_P (f) && f->output_data.x->menubar_widget == 0)
1715 /* Make sure next redisplay shows the menu bar. */
1716 XWINDOW (FRAME_SELECTED_WINDOW (f))->update_mode_line = Qt;
1718 else
1720 if (FRAME_EXTERNAL_MENU_BAR (f) == 1)
1721 free_frame_menubar (f);
1722 FRAME_EXTERNAL_MENU_BAR (f) = 0;
1723 if (FRAME_X_P (f))
1724 f->output_data.x->menubar_widget = 0;
1726 #else /* not USE_X_TOOLKIT */
1727 FRAME_MENU_BAR_LINES (f) = nlines;
1728 x_set_menu_bar_lines_1 (f->root_window, nlines - olines);
1729 #endif /* not USE_X_TOOLKIT */
1732 /* Change the name of frame F to NAME. If NAME is nil, set F's name to
1733 x_id_name.
1735 If EXPLICIT is non-zero, that indicates that lisp code is setting the
1736 name; if NAME is a string, set F's name to NAME and set
1737 F->explicit_name; if NAME is Qnil, then clear F->explicit_name.
1739 If EXPLICIT is zero, that indicates that Emacs redisplay code is
1740 suggesting a new name, which lisp code should override; if
1741 F->explicit_name is set, ignore the new name; otherwise, set it. */
1743 void
1744 x_set_name (f, name, explicit)
1745 struct frame *f;
1746 Lisp_Object name;
1747 int explicit;
1749 /* Make sure that requests from lisp code override requests from
1750 Emacs redisplay code. */
1751 if (explicit)
1753 /* If we're switching from explicit to implicit, we had better
1754 update the mode lines and thereby update the title. */
1755 if (f->explicit_name && NILP (name))
1756 update_mode_lines = 1;
1758 f->explicit_name = ! NILP (name);
1760 else if (f->explicit_name)
1761 return;
1763 /* If NAME is nil, set the name to the x_id_name. */
1764 if (NILP (name))
1766 /* Check for no change needed in this very common case
1767 before we do any consing. */
1768 if (!strcmp (FRAME_X_DISPLAY_INFO (f)->x_id_name,
1769 XSTRING (f->name)->data))
1770 return;
1771 name = build_string (FRAME_X_DISPLAY_INFO (f)->x_id_name);
1773 else
1774 CHECK_STRING (name, 0);
1776 /* Don't change the name if it's already NAME. */
1777 if (! NILP (Fstring_equal (name, f->name)))
1778 return;
1780 f->name = name;
1782 /* For setting the frame title, the title parameter should override
1783 the name parameter. */
1784 if (! NILP (f->title))
1785 name = f->title;
1787 if (FRAME_X_WINDOW (f))
1789 BLOCK_INPUT;
1790 #ifdef HAVE_X11R4
1792 XTextProperty text, icon;
1793 Lisp_Object icon_name;
1795 text.value = XSTRING (name)->data;
1796 text.encoding = XA_STRING;
1797 text.format = 8;
1798 text.nitems = XSTRING (name)->size;
1800 icon_name = (!NILP (f->icon_name) ? f->icon_name : name);
1802 icon.value = XSTRING (icon_name)->data;
1803 icon.encoding = XA_STRING;
1804 icon.format = 8;
1805 icon.nitems = XSTRING (icon_name)->size;
1806 #ifdef USE_X_TOOLKIT
1807 XSetWMName (FRAME_X_DISPLAY (f),
1808 XtWindow (f->output_data.x->widget), &text);
1809 XSetWMIconName (FRAME_X_DISPLAY (f), XtWindow (f->output_data.x->widget),
1810 &icon);
1811 #else /* not USE_X_TOOLKIT */
1812 XSetWMName (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f), &text);
1813 XSetWMIconName (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f), &icon);
1814 #endif /* not USE_X_TOOLKIT */
1816 #else /* not HAVE_X11R4 */
1817 XSetIconName (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
1818 XSTRING (name)->data);
1819 XStoreName (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
1820 XSTRING (name)->data);
1821 #endif /* not HAVE_X11R4 */
1822 UNBLOCK_INPUT;
1826 /* This function should be called when the user's lisp code has
1827 specified a name for the frame; the name will override any set by the
1828 redisplay code. */
1829 void
1830 x_explicitly_set_name (f, arg, oldval)
1831 FRAME_PTR f;
1832 Lisp_Object arg, oldval;
1834 x_set_name (f, arg, 1);
1837 /* This function should be called by Emacs redisplay code to set the
1838 name; names set this way will never override names set by the user's
1839 lisp code. */
1840 void
1841 x_implicitly_set_name (f, arg, oldval)
1842 FRAME_PTR f;
1843 Lisp_Object arg, oldval;
1845 x_set_name (f, arg, 0);
1848 /* Change the title of frame F to NAME.
1849 If NAME is nil, use the frame name as the title.
1851 If EXPLICIT is non-zero, that indicates that lisp code is setting the
1852 name; if NAME is a string, set F's name to NAME and set
1853 F->explicit_name; if NAME is Qnil, then clear F->explicit_name.
1855 If EXPLICIT is zero, that indicates that Emacs redisplay code is
1856 suggesting a new name, which lisp code should override; if
1857 F->explicit_name is set, ignore the new name; otherwise, set it. */
1859 void
1860 x_set_title (f, name)
1861 struct frame *f;
1862 Lisp_Object name;
1864 /* Don't change the title if it's already NAME. */
1865 if (EQ (name, f->title))
1866 return;
1868 update_mode_lines = 1;
1870 f->title = name;
1872 if (NILP (name))
1873 name = f->name;
1875 if (FRAME_X_WINDOW (f))
1877 BLOCK_INPUT;
1878 #ifdef HAVE_X11R4
1880 XTextProperty text, icon;
1881 Lisp_Object icon_name;
1883 text.value = XSTRING (name)->data;
1884 text.encoding = XA_STRING;
1885 text.format = 8;
1886 text.nitems = XSTRING (name)->size;
1888 icon_name = (!NILP (f->icon_name) ? f->icon_name : name);
1890 icon.value = XSTRING (icon_name)->data;
1891 icon.encoding = XA_STRING;
1892 icon.format = 8;
1893 icon.nitems = XSTRING (icon_name)->size;
1894 #ifdef USE_X_TOOLKIT
1895 XSetWMName (FRAME_X_DISPLAY (f),
1896 XtWindow (f->output_data.x->widget), &text);
1897 XSetWMIconName (FRAME_X_DISPLAY (f), XtWindow (f->output_data.x->widget),
1898 &icon);
1899 #else /* not USE_X_TOOLKIT */
1900 XSetWMName (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f), &text);
1901 XSetWMIconName (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f), &icon);
1902 #endif /* not USE_X_TOOLKIT */
1904 #else /* not HAVE_X11R4 */
1905 XSetIconName (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
1906 XSTRING (name)->data);
1907 XStoreName (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
1908 XSTRING (name)->data);
1909 #endif /* not HAVE_X11R4 */
1910 UNBLOCK_INPUT;
1914 void
1915 x_set_autoraise (f, arg, oldval)
1916 struct frame *f;
1917 Lisp_Object arg, oldval;
1919 f->auto_raise = !EQ (Qnil, arg);
1922 void
1923 x_set_autolower (f, arg, oldval)
1924 struct frame *f;
1925 Lisp_Object arg, oldval;
1927 f->auto_lower = !EQ (Qnil, arg);
1930 void
1931 x_set_unsplittable (f, arg, oldval)
1932 struct frame *f;
1933 Lisp_Object arg, oldval;
1935 f->no_split = !NILP (arg);
1938 void
1939 x_set_vertical_scroll_bars (f, arg, oldval)
1940 struct frame *f;
1941 Lisp_Object arg, oldval;
1943 if (NILP (arg) != ! FRAME_HAS_VERTICAL_SCROLL_BARS (f))
1945 FRAME_HAS_VERTICAL_SCROLL_BARS (f) = ! NILP (arg);
1947 /* We set this parameter before creating the X window for the
1948 frame, so we can get the geometry right from the start.
1949 However, if the window hasn't been created yet, we shouldn't
1950 call x_set_window_size. */
1951 if (FRAME_X_WINDOW (f))
1952 x_set_window_size (f, 0, FRAME_WIDTH (f), FRAME_HEIGHT (f));
1956 void
1957 x_set_scroll_bar_width (f, arg, oldval)
1958 struct frame *f;
1959 Lisp_Object arg, oldval;
1961 if (NILP (arg))
1963 FRAME_SCROLL_BAR_PIXEL_WIDTH (f) = 0;
1964 FRAME_SCROLL_BAR_COLS (f) = 2;
1965 if (FRAME_X_WINDOW (f))
1966 x_set_window_size (f, 0, FRAME_WIDTH (f), FRAME_HEIGHT (f));
1968 else if (INTEGERP (arg) && XINT (arg) > 0
1969 && XFASTINT (arg) != FRAME_SCROLL_BAR_PIXEL_WIDTH (f))
1971 int wid = FONT_WIDTH (f->output_data.x->font);
1972 FRAME_SCROLL_BAR_PIXEL_WIDTH (f) = XFASTINT (arg);
1973 FRAME_SCROLL_BAR_COLS (f) = (XFASTINT (arg) + wid-1) / wid;
1974 if (FRAME_X_WINDOW (f))
1975 x_set_window_size (f, 0, FRAME_WIDTH (f), FRAME_HEIGHT (f));
1979 /* Subroutines of creating an X frame. */
1981 /* Make sure that Vx_resource_name is set to a reasonable value.
1982 Fix it up, or set it to `emacs' if it is too hopeless. */
1984 static void
1985 validate_x_resource_name ()
1987 int len;
1988 /* Number of valid characters in the resource name. */
1989 int good_count = 0;
1990 /* Number of invalid characters in the resource name. */
1991 int bad_count = 0;
1992 Lisp_Object new;
1993 int i;
1995 if (STRINGP (Vx_resource_name))
1997 unsigned char *p = XSTRING (Vx_resource_name)->data;
1998 int i;
2000 len = XSTRING (Vx_resource_name)->size;
2002 /* Only letters, digits, - and _ are valid in resource names.
2003 Count the valid characters and count the invalid ones. */
2004 for (i = 0; i < len; i++)
2006 int c = p[i];
2007 if (! ((c >= 'a' && c <= 'z')
2008 || (c >= 'A' && c <= 'Z')
2009 || (c >= '0' && c <= '9')
2010 || c == '-' || c == '_'))
2011 bad_count++;
2012 else
2013 good_count++;
2016 else
2017 /* Not a string => completely invalid. */
2018 bad_count = 5, good_count = 0;
2020 /* If name is valid already, return. */
2021 if (bad_count == 0)
2022 return;
2024 /* If name is entirely invalid, or nearly so, use `emacs'. */
2025 if (good_count == 0
2026 || (good_count == 1 && bad_count > 0))
2028 Vx_resource_name = build_string ("emacs");
2029 return;
2032 /* Name is partly valid. Copy it and replace the invalid characters
2033 with underscores. */
2035 Vx_resource_name = new = Fcopy_sequence (Vx_resource_name);
2037 for (i = 0; i < len; i++)
2039 int c = XSTRING (new)->data[i];
2040 if (! ((c >= 'a' && c <= 'z')
2041 || (c >= 'A' && c <= 'Z')
2042 || (c >= '0' && c <= '9')
2043 || c == '-' || c == '_'))
2044 XSTRING (new)->data[i] = '_';
2049 extern char *x_get_string_resource ();
2051 DEFUN ("x-get-resource", Fx_get_resource, Sx_get_resource, 2, 4, 0,
2052 "Return the value of ATTRIBUTE, of class CLASS, from the X defaults database.\n\
2053 This uses `INSTANCE.ATTRIBUTE' as the key and `Emacs.CLASS' as the\n\
2054 class, where INSTANCE is the name under which Emacs was invoked, or\n\
2055 the name specified by the `-name' or `-rn' command-line arguments.\n\
2057 The optional arguments COMPONENT and SUBCLASS add to the key and the\n\
2058 class, respectively. You must specify both of them or neither.\n\
2059 If you specify them, the key is `INSTANCE.COMPONENT.ATTRIBUTE'\n\
2060 and the class is `Emacs.CLASS.SUBCLASS'.")
2061 (attribute, class, component, subclass)
2062 Lisp_Object attribute, class, component, subclass;
2064 register char *value;
2065 char *name_key;
2066 char *class_key;
2068 check_x ();
2070 CHECK_STRING (attribute, 0);
2071 CHECK_STRING (class, 0);
2073 if (!NILP (component))
2074 CHECK_STRING (component, 1);
2075 if (!NILP (subclass))
2076 CHECK_STRING (subclass, 2);
2077 if (NILP (component) != NILP (subclass))
2078 error ("x-get-resource: must specify both COMPONENT and SUBCLASS or neither");
2080 validate_x_resource_name ();
2082 /* Allocate space for the components, the dots which separate them,
2083 and the final '\0'. Make them big enough for the worst case. */
2084 name_key = (char *) alloca (XSTRING (Vx_resource_name)->size
2085 + (STRINGP (component)
2086 ? XSTRING (component)->size : 0)
2087 + XSTRING (attribute)->size
2088 + 3);
2090 class_key = (char *) alloca ((sizeof (EMACS_CLASS) - 1)
2091 + XSTRING (class)->size
2092 + (STRINGP (subclass)
2093 ? XSTRING (subclass)->size : 0)
2094 + 3);
2096 /* Start with emacs.FRAMENAME for the name (the specific one)
2097 and with `Emacs' for the class key (the general one). */
2098 strcpy (name_key, XSTRING (Vx_resource_name)->data);
2099 strcpy (class_key, EMACS_CLASS);
2101 strcat (class_key, ".");
2102 strcat (class_key, XSTRING (class)->data);
2104 if (!NILP (component))
2106 strcat (class_key, ".");
2107 strcat (class_key, XSTRING (subclass)->data);
2109 strcat (name_key, ".");
2110 strcat (name_key, XSTRING (component)->data);
2113 strcat (name_key, ".");
2114 strcat (name_key, XSTRING (attribute)->data);
2116 value = x_get_string_resource (check_x_display_info (Qnil)->xrdb,
2117 name_key, class_key);
2119 if (value != (char *) 0)
2120 return build_string (value);
2121 else
2122 return Qnil;
2125 /* Used when C code wants a resource value. */
2127 char *
2128 x_get_resource_string (attribute, class)
2129 char *attribute, *class;
2131 register char *value;
2132 char *name_key;
2133 char *class_key;
2135 /* Allocate space for the components, the dots which separate them,
2136 and the final '\0'. */
2137 name_key = (char *) alloca (XSTRING (Vinvocation_name)->size
2138 + strlen (attribute) + 2);
2139 class_key = (char *) alloca ((sizeof (EMACS_CLASS) - 1)
2140 + strlen (class) + 2);
2142 sprintf (name_key, "%s.%s",
2143 XSTRING (Vinvocation_name)->data,
2144 attribute);
2145 sprintf (class_key, "%s.%s", EMACS_CLASS, class);
2147 return x_get_string_resource (FRAME_X_DISPLAY_INFO (selected_frame)->xrdb,
2148 name_key, class_key);
2151 /* Types we might convert a resource string into. */
2152 enum resource_types
2154 number, boolean, string, symbol
2157 /* Return the value of parameter PARAM.
2159 First search ALIST, then Vdefault_frame_alist, then the X defaults
2160 database, using ATTRIBUTE as the attribute name and CLASS as its class.
2162 Convert the resource to the type specified by desired_type.
2164 If no default is specified, return Qunbound. If you call
2165 x_get_arg, make sure you deal with Qunbound in a reasonable way,
2166 and don't let it get stored in any Lisp-visible variables! */
2168 static Lisp_Object
2169 x_get_arg (alist, param, attribute, class, type)
2170 Lisp_Object alist, param;
2171 char *attribute;
2172 char *class;
2173 enum resource_types type;
2175 register Lisp_Object tem;
2177 tem = Fassq (param, alist);
2178 if (EQ (tem, Qnil))
2179 tem = Fassq (param, Vdefault_frame_alist);
2180 if (EQ (tem, Qnil))
2183 if (attribute)
2185 tem = Fx_get_resource (build_string (attribute),
2186 build_string (class),
2187 Qnil, Qnil);
2189 if (NILP (tem))
2190 return Qunbound;
2192 switch (type)
2194 case number:
2195 return make_number (atoi (XSTRING (tem)->data));
2197 case boolean:
2198 tem = Fdowncase (tem);
2199 if (!strcmp (XSTRING (tem)->data, "on")
2200 || !strcmp (XSTRING (tem)->data, "true"))
2201 return Qt;
2202 else
2203 return Qnil;
2205 case string:
2206 return tem;
2208 case symbol:
2209 /* As a special case, we map the values `true' and `on'
2210 to Qt, and `false' and `off' to Qnil. */
2212 Lisp_Object lower;
2213 lower = Fdowncase (tem);
2214 if (!strcmp (XSTRING (lower)->data, "on")
2215 || !strcmp (XSTRING (lower)->data, "true"))
2216 return Qt;
2217 else if (!strcmp (XSTRING (lower)->data, "off")
2218 || !strcmp (XSTRING (lower)->data, "false"))
2219 return Qnil;
2220 else
2221 return Fintern (tem, Qnil);
2224 default:
2225 abort ();
2228 else
2229 return Qunbound;
2231 return Fcdr (tem);
2234 /* Record in frame F the specified or default value according to ALIST
2235 of the parameter named PARAM (a Lisp symbol).
2236 If no value is specified for PARAM, look for an X default for XPROP
2237 on the frame named NAME.
2238 If that is not found either, use the value DEFLT. */
2240 static Lisp_Object
2241 x_default_parameter (f, alist, prop, deflt, xprop, xclass, type)
2242 struct frame *f;
2243 Lisp_Object alist;
2244 Lisp_Object prop;
2245 Lisp_Object deflt;
2246 char *xprop;
2247 char *xclass;
2248 enum resource_types type;
2250 Lisp_Object tem;
2252 tem = x_get_arg (alist, prop, xprop, xclass, type);
2253 if (EQ (tem, Qunbound))
2254 tem = deflt;
2255 x_set_frame_parameters (f, Fcons (Fcons (prop, tem), Qnil));
2256 return tem;
2259 DEFUN ("x-parse-geometry", Fx_parse_geometry, Sx_parse_geometry, 1, 1, 0,
2260 "Parse an X-style geometry string STRING.\n\
2261 Returns an alist of the form ((top . TOP), (left . LEFT) ... ).\n\
2262 The properties returned may include `top', `left', `height', and `width'.\n\
2263 The value of `left' or `top' may be an integer,\n\
2264 or a list (+ N) meaning N pixels relative to top/left corner,\n\
2265 or a list (- N) meaning -N pixels relative to bottom/right corner.")
2266 (string)
2267 Lisp_Object string;
2269 int geometry, x, y;
2270 unsigned int width, height;
2271 Lisp_Object result;
2273 CHECK_STRING (string, 0);
2275 geometry = XParseGeometry ((char *) XSTRING (string)->data,
2276 &x, &y, &width, &height);
2278 #if 0
2279 if (!!(geometry & XValue) != !!(geometry & YValue))
2280 error ("Must specify both x and y position, or neither");
2281 #endif
2283 result = Qnil;
2284 if (geometry & XValue)
2286 Lisp_Object element;
2288 if (x >= 0 && (geometry & XNegative))
2289 element = Fcons (Qleft, Fcons (Qminus, Fcons (make_number (-x), Qnil)));
2290 else if (x < 0 && ! (geometry & XNegative))
2291 element = Fcons (Qleft, Fcons (Qplus, Fcons (make_number (x), Qnil)));
2292 else
2293 element = Fcons (Qleft, make_number (x));
2294 result = Fcons (element, result);
2297 if (geometry & YValue)
2299 Lisp_Object element;
2301 if (y >= 0 && (geometry & YNegative))
2302 element = Fcons (Qtop, Fcons (Qminus, Fcons (make_number (-y), Qnil)));
2303 else if (y < 0 && ! (geometry & YNegative))
2304 element = Fcons (Qtop, Fcons (Qplus, Fcons (make_number (y), Qnil)));
2305 else
2306 element = Fcons (Qtop, make_number (y));
2307 result = Fcons (element, result);
2310 if (geometry & WidthValue)
2311 result = Fcons (Fcons (Qwidth, make_number (width)), result);
2312 if (geometry & HeightValue)
2313 result = Fcons (Fcons (Qheight, make_number (height)), result);
2315 return result;
2318 /* Calculate the desired size and position of this window,
2319 and return the flags saying which aspects were specified.
2321 This function does not make the coordinates positive. */
2323 #define DEFAULT_ROWS 40
2324 #define DEFAULT_COLS 80
2326 static int
2327 x_figure_window_size (f, parms)
2328 struct frame *f;
2329 Lisp_Object parms;
2331 register Lisp_Object tem0, tem1, tem2;
2332 int height, width, left, top;
2333 register int geometry;
2334 long window_prompting = 0;
2336 /* Default values if we fall through.
2337 Actually, if that happens we should get
2338 window manager prompting. */
2339 f->width = DEFAULT_COLS;
2340 f->height = DEFAULT_ROWS;
2341 /* Window managers expect that if program-specified
2342 positions are not (0,0), they're intentional, not defaults. */
2343 f->output_data.x->top_pos = 0;
2344 f->output_data.x->left_pos = 0;
2346 tem0 = x_get_arg (parms, Qheight, 0, 0, number);
2347 tem1 = x_get_arg (parms, Qwidth, 0, 0, number);
2348 tem2 = x_get_arg (parms, Quser_size, 0, 0, number);
2349 if (! EQ (tem0, Qunbound) || ! EQ (tem1, Qunbound))
2351 if (!EQ (tem0, Qunbound))
2353 CHECK_NUMBER (tem0, 0);
2354 f->height = XINT (tem0);
2356 if (!EQ (tem1, Qunbound))
2358 CHECK_NUMBER (tem1, 0);
2359 f->width = XINT (tem1);
2361 if (!NILP (tem2) && !EQ (tem2, Qunbound))
2362 window_prompting |= USSize;
2363 else
2364 window_prompting |= PSize;
2367 f->output_data.x->vertical_scroll_bar_extra
2368 = (!FRAME_HAS_VERTICAL_SCROLL_BARS (f)
2370 : FRAME_SCROLL_BAR_PIXEL_WIDTH (f) > 0
2371 ? FRAME_SCROLL_BAR_PIXEL_WIDTH (f)
2372 : (FRAME_SCROLL_BAR_COLS (f) * FONT_WIDTH (f->output_data.x->font)));
2373 f->output_data.x->pixel_width = CHAR_TO_PIXEL_WIDTH (f, f->width);
2374 f->output_data.x->pixel_height = CHAR_TO_PIXEL_HEIGHT (f, f->height);
2376 tem0 = x_get_arg (parms, Qtop, 0, 0, number);
2377 tem1 = x_get_arg (parms, Qleft, 0, 0, number);
2378 tem2 = x_get_arg (parms, Quser_position, 0, 0, number);
2379 if (! EQ (tem0, Qunbound) || ! EQ (tem1, Qunbound))
2381 if (EQ (tem0, Qminus))
2383 f->output_data.x->top_pos = 0;
2384 window_prompting |= YNegative;
2386 else if (CONSP (tem0) && EQ (XCONS (tem0)->car, Qminus)
2387 && CONSP (XCONS (tem0)->cdr)
2388 && INTEGERP (XCONS (XCONS (tem0)->cdr)->car))
2390 f->output_data.x->top_pos = - XINT (XCONS (XCONS (tem0)->cdr)->car);
2391 window_prompting |= YNegative;
2393 else if (CONSP (tem0) && EQ (XCONS (tem0)->car, Qplus)
2394 && CONSP (XCONS (tem0)->cdr)
2395 && INTEGERP (XCONS (XCONS (tem0)->cdr)->car))
2397 f->output_data.x->top_pos = XINT (XCONS (XCONS (tem0)->cdr)->car);
2399 else if (EQ (tem0, Qunbound))
2400 f->output_data.x->top_pos = 0;
2401 else
2403 CHECK_NUMBER (tem0, 0);
2404 f->output_data.x->top_pos = XINT (tem0);
2405 if (f->output_data.x->top_pos < 0)
2406 window_prompting |= YNegative;
2409 if (EQ (tem1, Qminus))
2411 f->output_data.x->left_pos = 0;
2412 window_prompting |= XNegative;
2414 else if (CONSP (tem1) && EQ (XCONS (tem1)->car, Qminus)
2415 && CONSP (XCONS (tem1)->cdr)
2416 && INTEGERP (XCONS (XCONS (tem1)->cdr)->car))
2418 f->output_data.x->left_pos = - XINT (XCONS (XCONS (tem1)->cdr)->car);
2419 window_prompting |= XNegative;
2421 else if (CONSP (tem1) && EQ (XCONS (tem1)->car, Qplus)
2422 && CONSP (XCONS (tem1)->cdr)
2423 && INTEGERP (XCONS (XCONS (tem1)->cdr)->car))
2425 f->output_data.x->left_pos = XINT (XCONS (XCONS (tem1)->cdr)->car);
2427 else if (EQ (tem1, Qunbound))
2428 f->output_data.x->left_pos = 0;
2429 else
2431 CHECK_NUMBER (tem1, 0);
2432 f->output_data.x->left_pos = XINT (tem1);
2433 if (f->output_data.x->left_pos < 0)
2434 window_prompting |= XNegative;
2437 if (!NILP (tem2) && ! EQ (tem2, Qunbound))
2438 window_prompting |= USPosition;
2439 else
2440 window_prompting |= PPosition;
2443 return window_prompting;
2446 #if !defined (HAVE_X11R4) && !defined (HAVE_XSETWMPROTOCOLS)
2448 Status
2449 XSetWMProtocols (dpy, w, protocols, count)
2450 Display *dpy;
2451 Window w;
2452 Atom *protocols;
2453 int count;
2455 Atom prop;
2456 prop = XInternAtom (dpy, "WM_PROTOCOLS", False);
2457 if (prop == None) return False;
2458 XChangeProperty (dpy, w, prop, XA_ATOM, 32, PropModeReplace,
2459 (unsigned char *) protocols, count);
2460 return True;
2462 #endif /* not HAVE_X11R4 && not HAVE_XSETWMPROTOCOLS */
2464 #ifdef USE_X_TOOLKIT
2466 /* If the WM_PROTOCOLS property does not already contain WM_TAKE_FOCUS,
2467 WM_DELETE_WINDOW, and WM_SAVE_YOURSELF, then add them. (They may
2468 already be present because of the toolkit (Motif adds some of them,
2469 for example, but Xt doesn't). */
2471 static void
2472 hack_wm_protocols (f, widget)
2473 FRAME_PTR f;
2474 Widget widget;
2476 Display *dpy = XtDisplay (widget);
2477 Window w = XtWindow (widget);
2478 int need_delete = 1;
2479 int need_focus = 1;
2480 int need_save = 1;
2482 BLOCK_INPUT;
2484 Atom type, *atoms = 0;
2485 int format = 0;
2486 unsigned long nitems = 0;
2487 unsigned long bytes_after;
2489 if ((XGetWindowProperty (dpy, w,
2490 FRAME_X_DISPLAY_INFO (f)->Xatom_wm_protocols,
2491 (long)0, (long)100, False, XA_ATOM,
2492 &type, &format, &nitems, &bytes_after,
2493 (unsigned char **) &atoms)
2494 == Success)
2495 && format == 32 && type == XA_ATOM)
2496 while (nitems > 0)
2498 nitems--;
2499 if (atoms[nitems] == FRAME_X_DISPLAY_INFO (f)->Xatom_wm_delete_window)
2500 need_delete = 0;
2501 else if (atoms[nitems] == FRAME_X_DISPLAY_INFO (f)->Xatom_wm_take_focus)
2502 need_focus = 0;
2503 else if (atoms[nitems] == FRAME_X_DISPLAY_INFO (f)->Xatom_wm_save_yourself)
2504 need_save = 0;
2506 if (atoms) XFree ((char *) atoms);
2509 Atom props [10];
2510 int count = 0;
2511 if (need_delete)
2512 props[count++] = FRAME_X_DISPLAY_INFO (f)->Xatom_wm_delete_window;
2513 if (need_focus)
2514 props[count++] = FRAME_X_DISPLAY_INFO (f)->Xatom_wm_take_focus;
2515 if (need_save)
2516 props[count++] = FRAME_X_DISPLAY_INFO (f)->Xatom_wm_save_yourself;
2517 if (count)
2518 XChangeProperty (dpy, w, FRAME_X_DISPLAY_INFO (f)->Xatom_wm_protocols,
2519 XA_ATOM, 32, PropModeAppend,
2520 (unsigned char *) props, count);
2522 UNBLOCK_INPUT;
2524 #endif
2526 #ifdef USE_X_TOOLKIT
2528 /* Create and set up the X widget for frame F. */
2530 static void
2531 x_window (f, window_prompting, minibuffer_only)
2532 struct frame *f;
2533 long window_prompting;
2534 int minibuffer_only;
2536 XClassHint class_hints;
2537 XSetWindowAttributes attributes;
2538 unsigned long attribute_mask;
2540 Widget shell_widget;
2541 Widget pane_widget;
2542 Widget frame_widget;
2543 Arg al [25];
2544 int ac;
2546 BLOCK_INPUT;
2548 /* Use the resource name as the top-level widget name
2549 for looking up resources. Make a non-Lisp copy
2550 for the window manager, so GC relocation won't bother it.
2552 Elsewhere we specify the window name for the window manager. */
2555 char *str = (char *) XSTRING (Vx_resource_name)->data;
2556 f->namebuf = (char *) xmalloc (strlen (str) + 1);
2557 strcpy (f->namebuf, str);
2560 ac = 0;
2561 XtSetArg (al[ac], XtNallowShellResize, 1); ac++;
2562 XtSetArg (al[ac], XtNinput, 1); ac++;
2563 XtSetArg (al[ac], XtNmappedWhenManaged, 0); ac++;
2564 XtSetArg (al[ac], XtNborderWidth, f->output_data.x->border_width); ac++;
2565 shell_widget = XtAppCreateShell (f->namebuf, EMACS_CLASS,
2566 applicationShellWidgetClass,
2567 FRAME_X_DISPLAY (f), al, ac);
2569 f->output_data.x->widget = shell_widget;
2570 /* maybe_set_screen_title_format (shell_widget); */
2572 pane_widget = lw_create_widget ("main", "pane", widget_id_tick++,
2573 (widget_value *) NULL,
2574 shell_widget, False,
2575 (lw_callback) NULL,
2576 (lw_callback) NULL,
2577 (lw_callback) NULL);
2579 f->output_data.x->column_widget = pane_widget;
2581 /* mappedWhenManaged to false tells to the paned window to not map/unmap
2582 the emacs screen when changing menubar. This reduces flickering. */
2584 ac = 0;
2585 XtSetArg (al[ac], XtNmappedWhenManaged, 0); ac++;
2586 XtSetArg (al[ac], XtNshowGrip, 0); ac++;
2587 XtSetArg (al[ac], XtNallowResize, 1); ac++;
2588 XtSetArg (al[ac], XtNresizeToPreferred, 1); ac++;
2589 XtSetArg (al[ac], XtNemacsFrame, f); ac++;
2590 frame_widget = XtCreateWidget (f->namebuf,
2591 emacsFrameClass,
2592 pane_widget, al, ac);
2594 f->output_data.x->edit_widget = frame_widget;
2596 XtManageChild (frame_widget);
2598 /* Do some needed geometry management. */
2600 int len;
2601 char *tem, shell_position[32];
2602 Arg al[2];
2603 int ac = 0;
2604 int extra_borders = 0;
2605 int menubar_size
2606 = (f->output_data.x->menubar_widget
2607 ? (f->output_data.x->menubar_widget->core.height
2608 + f->output_data.x->menubar_widget->core.border_width)
2609 : 0);
2610 extern char *lwlib_toolkit_type;
2612 if (FRAME_EXTERNAL_MENU_BAR (f))
2614 Dimension ibw = 0;
2615 XtVaGetValues (pane_widget, XtNinternalBorderWidth, &ibw, NULL);
2616 menubar_size += ibw;
2619 f->output_data.x->menubar_height = menubar_size;
2621 /* Motif seems to need this amount added to the sizes
2622 specified for the shell widget. The Athena/Lucid widgets don't.
2623 Both conclusions reached experimentally. -- rms. */
2624 if (!strcmp (lwlib_toolkit_type, "motif"))
2625 XtVaGetValues (f->output_data.x->edit_widget, XtNinternalBorderWidth,
2626 &extra_borders, NULL);
2628 /* Convert our geometry parameters into a geometry string
2629 and specify it.
2630 Note that we do not specify here whether the position
2631 is a user-specified or program-specified one.
2632 We pass that information later, in x_wm_set_size_hints. */
2634 int left = f->output_data.x->left_pos;
2635 int xneg = window_prompting & XNegative;
2636 int top = f->output_data.x->top_pos;
2637 int yneg = window_prompting & YNegative;
2638 if (xneg)
2639 left = -left;
2640 if (yneg)
2641 top = -top;
2643 if (window_prompting & USPosition)
2644 sprintf (shell_position, "=%dx%d%c%d%c%d",
2645 PIXEL_WIDTH (f) + extra_borders,
2646 PIXEL_HEIGHT (f) + menubar_size + extra_borders,
2647 (xneg ? '-' : '+'), left,
2648 (yneg ? '-' : '+'), top);
2649 else
2650 sprintf (shell_position, "=%dx%d",
2651 PIXEL_WIDTH (f) + extra_borders,
2652 PIXEL_HEIGHT (f) + menubar_size + extra_borders);
2655 len = strlen (shell_position) + 1;
2656 tem = (char *) xmalloc (len);
2657 strncpy (tem, shell_position, len);
2658 XtSetArg (al[ac], XtNgeometry, tem); ac++;
2659 XtSetValues (shell_widget, al, ac);
2662 XtManageChild (pane_widget);
2663 XtRealizeWidget (shell_widget);
2665 FRAME_X_WINDOW (f) = XtWindow (frame_widget);
2667 validate_x_resource_name ();
2669 class_hints.res_name = (char *) XSTRING (Vx_resource_name)->data;
2670 class_hints.res_class = EMACS_CLASS;
2671 XSetClassHint (FRAME_X_DISPLAY (f), XtWindow (shell_widget), &class_hints);
2673 #ifdef HAVE_X_I18N
2674 #ifndef X_I18N_INHIBITED
2676 XIM xim;
2677 XIC xic = NULL;
2679 xim = XOpenIM (FRAME_X_DISPLAY (f), NULL, NULL, NULL);
2681 if (xim)
2683 xic = XCreateIC (xim,
2684 XNInputStyle, XIMPreeditNothing | XIMStatusNothing,
2685 XNClientWindow, FRAME_X_WINDOW(f),
2686 XNFocusWindow, FRAME_X_WINDOW(f),
2687 NULL);
2689 if (xic == 0)
2691 XCloseIM (xim);
2692 xim = NULL;
2695 FRAME_XIM (f) = xim;
2696 FRAME_XIC (f) = xic;
2698 #else /* X_I18N_INHIBITED */
2699 FRAME_XIM (f) = 0;
2700 FRAME_XIC (f) = 0;
2701 #endif /* X_I18N_INHIBITED */
2702 #endif /* HAVE_X_I18N */
2704 f->output_data.x->wm_hints.input = True;
2705 f->output_data.x->wm_hints.flags |= InputHint;
2706 XSetWMHints (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
2707 &f->output_data.x->wm_hints);
2709 hack_wm_protocols (f, shell_widget);
2711 #ifdef HACK_EDITRES
2712 XtAddEventHandler (shell_widget, 0, True, _XEditResCheckMessages, 0);
2713 #endif
2715 /* Do a stupid property change to force the server to generate a
2716 propertyNotify event so that the event_stream server timestamp will
2717 be initialized to something relevant to the time we created the window.
2719 XChangeProperty (XtDisplay (frame_widget), XtWindow (frame_widget),
2720 FRAME_X_DISPLAY_INFO (f)->Xatom_wm_protocols,
2721 XA_ATOM, 32, PropModeAppend,
2722 (unsigned char*) NULL, 0);
2724 /* Make all the standard events reach the Emacs frame. */
2725 attributes.event_mask = STANDARD_EVENT_SET;
2726 attribute_mask = CWEventMask;
2727 XChangeWindowAttributes (XtDisplay (shell_widget), XtWindow (shell_widget),
2728 attribute_mask, &attributes);
2730 XtMapWidget (frame_widget);
2732 /* x_set_name normally ignores requests to set the name if the
2733 requested name is the same as the current name. This is the one
2734 place where that assumption isn't correct; f->name is set, but
2735 the X server hasn't been told. */
2737 Lisp_Object name;
2738 int explicit = f->explicit_name;
2740 f->explicit_name = 0;
2741 name = f->name;
2742 f->name = Qnil;
2743 x_set_name (f, name, explicit);
2746 XDefineCursor (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
2747 f->output_data.x->text_cursor);
2749 UNBLOCK_INPUT;
2751 if (!minibuffer_only && FRAME_EXTERNAL_MENU_BAR (f))
2752 initialize_frame_menubar (f);
2753 lw_set_main_areas (pane_widget, f->output_data.x->menubar_widget, frame_widget);
2755 if (FRAME_X_WINDOW (f) == 0)
2756 error ("Unable to create window");
2759 #else /* not USE_X_TOOLKIT */
2761 /* Create and set up the X window for frame F. */
2763 x_window (f)
2764 struct frame *f;
2767 XClassHint class_hints;
2768 XSetWindowAttributes attributes;
2769 unsigned long attribute_mask;
2771 attributes.background_pixel = f->output_data.x->background_pixel;
2772 attributes.border_pixel = f->output_data.x->border_pixel;
2773 attributes.bit_gravity = StaticGravity;
2774 attributes.backing_store = NotUseful;
2775 attributes.save_under = True;
2776 attributes.event_mask = STANDARD_EVENT_SET;
2777 attribute_mask = (CWBackPixel | CWBorderPixel | CWBitGravity
2778 #if 0
2779 | CWBackingStore | CWSaveUnder
2780 #endif
2781 | CWEventMask);
2783 BLOCK_INPUT;
2784 FRAME_X_WINDOW (f)
2785 = XCreateWindow (FRAME_X_DISPLAY (f),
2786 f->output_data.x->parent_desc,
2787 f->output_data.x->left_pos,
2788 f->output_data.x->top_pos,
2789 PIXEL_WIDTH (f), PIXEL_HEIGHT (f),
2790 f->output_data.x->border_width,
2791 CopyFromParent, /* depth */
2792 InputOutput, /* class */
2793 FRAME_X_DISPLAY_INFO (f)->visual,
2794 attribute_mask, &attributes);
2795 #ifdef HAVE_X_I18N
2796 #ifndef X_I18N_INHIBITED
2798 XIM xim;
2799 XIC xic = NULL;
2801 xim = XOpenIM (FRAME_X_DISPLAY(f), NULL, NULL, NULL);
2803 if (xim)
2805 xic = XCreateIC (xim,
2806 XNInputStyle, XIMPreeditNothing | XIMStatusNothing,
2807 XNClientWindow, FRAME_X_WINDOW(f),
2808 XNFocusWindow, FRAME_X_WINDOW(f),
2809 NULL);
2811 if (!xic)
2813 XCloseIM (xim);
2814 xim = NULL;
2818 FRAME_XIM (f) = xim;
2819 FRAME_XIC (f) = xic;
2821 #else /* X_I18N_INHIBITED */
2822 FRAME_XIM (f) = 0;
2823 FRAME_XIC (f) = 0;
2824 #endif /* X_I18N_INHIBITED */
2825 #endif /* HAVE_X_I18N */
2827 validate_x_resource_name ();
2829 class_hints.res_name = (char *) XSTRING (Vx_resource_name)->data;
2830 class_hints.res_class = EMACS_CLASS;
2831 XSetClassHint (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f), &class_hints);
2833 /* The menubar is part of the ordinary display;
2834 it does not count in addition to the height of the window. */
2835 f->output_data.x->menubar_height = 0;
2837 /* This indicates that we use the "Passive Input" input model.
2838 Unless we do this, we don't get the Focus{In,Out} events that we
2839 need to draw the cursor correctly. Accursed bureaucrats.
2840 XWhipsAndChains (FRAME_X_DISPLAY (f), IronMaiden, &TheRack); */
2842 f->output_data.x->wm_hints.input = True;
2843 f->output_data.x->wm_hints.flags |= InputHint;
2844 XSetWMHints (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
2845 &f->output_data.x->wm_hints);
2846 f->output_data.x->wm_hints.icon_pixmap = None;
2848 /* Request "save yourself" and "delete window" commands from wm. */
2850 Atom protocols[2];
2851 protocols[0] = FRAME_X_DISPLAY_INFO (f)->Xatom_wm_delete_window;
2852 protocols[1] = FRAME_X_DISPLAY_INFO (f)->Xatom_wm_save_yourself;
2853 XSetWMProtocols (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f), protocols, 2);
2856 /* x_set_name normally ignores requests to set the name if the
2857 requested name is the same as the current name. This is the one
2858 place where that assumption isn't correct; f->name is set, but
2859 the X server hasn't been told. */
2861 Lisp_Object name;
2862 int explicit = f->explicit_name;
2864 f->explicit_name = 0;
2865 name = f->name;
2866 f->name = Qnil;
2867 x_set_name (f, name, explicit);
2870 XDefineCursor (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
2871 f->output_data.x->text_cursor);
2873 UNBLOCK_INPUT;
2875 if (FRAME_X_WINDOW (f) == 0)
2876 error ("Unable to create window");
2879 #endif /* not USE_X_TOOLKIT */
2881 /* Handle the icon stuff for this window. Perhaps later we might
2882 want an x_set_icon_position which can be called interactively as
2883 well. */
2885 static void
2886 x_icon (f, parms)
2887 struct frame *f;
2888 Lisp_Object parms;
2890 Lisp_Object icon_x, icon_y;
2892 /* Set the position of the icon. Note that twm groups all
2893 icons in an icon window. */
2894 icon_x = x_get_arg (parms, Qicon_left, 0, 0, number);
2895 icon_y = x_get_arg (parms, Qicon_top, 0, 0, number);
2896 if (!EQ (icon_x, Qunbound) && !EQ (icon_y, Qunbound))
2898 CHECK_NUMBER (icon_x, 0);
2899 CHECK_NUMBER (icon_y, 0);
2901 else if (!EQ (icon_x, Qunbound) || !EQ (icon_y, Qunbound))
2902 error ("Both left and top icon corners of icon must be specified");
2904 BLOCK_INPUT;
2906 if (! EQ (icon_x, Qunbound))
2907 x_wm_set_icon_position (f, XINT (icon_x), XINT (icon_y));
2909 /* Start up iconic or window? */
2910 x_wm_set_window_state
2911 (f, (EQ (x_get_arg (parms, Qvisibility, 0, 0, symbol), Qicon)
2912 ? IconicState
2913 : NormalState));
2915 x_text_icon (f, (char *) XSTRING ((!NILP (f->icon_name)
2916 ? f->icon_name
2917 : f->name))->data);
2919 UNBLOCK_INPUT;
2922 /* Make the GC's needed for this window, setting the
2923 background, border and mouse colors; also create the
2924 mouse cursor and the gray border tile. */
2926 static char cursor_bits[] =
2928 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
2929 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
2930 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
2931 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00
2934 static void
2935 x_make_gc (f)
2936 struct frame *f;
2938 XGCValues gc_values;
2939 GC temp_gc;
2940 XImage tileimage;
2942 BLOCK_INPUT;
2944 /* Create the GC's of this frame.
2945 Note that many default values are used. */
2947 /* Normal video */
2948 gc_values.font = f->output_data.x->font->fid;
2949 gc_values.foreground = f->output_data.x->foreground_pixel;
2950 gc_values.background = f->output_data.x->background_pixel;
2951 gc_values.line_width = 0; /* Means 1 using fast algorithm. */
2952 f->output_data.x->normal_gc = XCreateGC (FRAME_X_DISPLAY (f),
2953 FRAME_X_WINDOW (f),
2954 GCLineWidth | GCFont
2955 | GCForeground | GCBackground,
2956 &gc_values);
2958 /* Reverse video style. */
2959 gc_values.foreground = f->output_data.x->background_pixel;
2960 gc_values.background = f->output_data.x->foreground_pixel;
2961 f->output_data.x->reverse_gc = XCreateGC (FRAME_X_DISPLAY (f),
2962 FRAME_X_WINDOW (f),
2963 GCFont | GCForeground | GCBackground
2964 | GCLineWidth,
2965 &gc_values);
2967 /* Cursor has cursor-color background, background-color foreground. */
2968 gc_values.foreground = f->output_data.x->background_pixel;
2969 gc_values.background = f->output_data.x->cursor_pixel;
2970 gc_values.fill_style = FillOpaqueStippled;
2971 gc_values.stipple
2972 = XCreateBitmapFromData (FRAME_X_DISPLAY (f),
2973 FRAME_X_DISPLAY_INFO (f)->root_window,
2974 cursor_bits, 16, 16);
2975 f->output_data.x->cursor_gc
2976 = XCreateGC (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
2977 (GCFont | GCForeground | GCBackground
2978 | GCFillStyle | GCStipple | GCLineWidth),
2979 &gc_values);
2981 /* Create the gray border tile used when the pointer is not in
2982 the frame. Since this depends on the frame's pixel values,
2983 this must be done on a per-frame basis. */
2984 f->output_data.x->border_tile
2985 = (XCreatePixmapFromBitmapData
2986 (FRAME_X_DISPLAY (f), FRAME_X_DISPLAY_INFO (f)->root_window,
2987 gray_bits, gray_width, gray_height,
2988 f->output_data.x->foreground_pixel,
2989 f->output_data.x->background_pixel,
2990 DefaultDepth (FRAME_X_DISPLAY (f),
2991 XScreenNumberOfScreen (FRAME_X_SCREEN (f)))));
2993 UNBLOCK_INPUT;
2996 DEFUN ("x-create-frame", Fx_create_frame, Sx_create_frame,
2997 1, 1, 0,
2998 "Make a new X window, which is called a \"frame\" in Emacs terms.\n\
2999 Returns an Emacs frame object.\n\
3000 ALIST is an alist of frame parameters.\n\
3001 If the parameters specify that the frame should not have a minibuffer,\n\
3002 and do not specify a specific minibuffer window to use,\n\
3003 then `default-minibuffer-frame' must be a frame whose minibuffer can\n\
3004 be shared by the new frame.\n\
3006 This function is an internal primitive--use `make-frame' instead.")
3007 (parms)
3008 Lisp_Object parms;
3010 struct frame *f;
3011 Lisp_Object frame, tem;
3012 Lisp_Object name;
3013 int minibuffer_only = 0;
3014 long window_prompting = 0;
3015 int width, height;
3016 int count = specpdl_ptr - specpdl;
3017 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
3018 Lisp_Object display;
3019 struct x_display_info *dpyinfo;
3020 Lisp_Object parent;
3021 struct kboard *kb;
3023 check_x ();
3025 /* Use this general default value to start with
3026 until we know if this frame has a specified name. */
3027 Vx_resource_name = Vinvocation_name;
3029 display = x_get_arg (parms, Qdisplay, 0, 0, string);
3030 if (EQ (display, Qunbound))
3031 display = Qnil;
3032 dpyinfo = check_x_display_info (display);
3033 #ifdef MULTI_KBOARD
3034 kb = dpyinfo->kboard;
3035 #else
3036 kb = &the_only_kboard;
3037 #endif
3039 name = x_get_arg (parms, Qname, "name", "Name", string);
3040 if (!STRINGP (name)
3041 && ! EQ (name, Qunbound)
3042 && ! NILP (name))
3043 error ("Invalid frame name--not a string or nil");
3045 if (STRINGP (name))
3046 Vx_resource_name = name;
3048 /* See if parent window is specified. */
3049 parent = x_get_arg (parms, Qparent_id, NULL, NULL, number);
3050 if (EQ (parent, Qunbound))
3051 parent = Qnil;
3052 if (! NILP (parent))
3053 CHECK_NUMBER (parent, 0);
3055 /* make_frame_without_minibuffer can run Lisp code and garbage collect. */
3056 /* No need to protect DISPLAY because that's not used after passing
3057 it to make_frame_without_minibuffer. */
3058 frame = Qnil;
3059 GCPRO4 (parms, parent, name, frame);
3060 tem = x_get_arg (parms, Qminibuffer, 0, 0, symbol);
3061 if (EQ (tem, Qnone) || NILP (tem))
3062 f = make_frame_without_minibuffer (Qnil, kb, display);
3063 else if (EQ (tem, Qonly))
3065 f = make_minibuffer_frame ();
3066 minibuffer_only = 1;
3068 else if (WINDOWP (tem))
3069 f = make_frame_without_minibuffer (tem, kb, display);
3070 else
3071 f = make_frame (1);
3073 XSETFRAME (frame, f);
3075 /* Note that X Windows does support scroll bars. */
3076 FRAME_CAN_HAVE_SCROLL_BARS (f) = 1;
3078 f->output_method = output_x_window;
3079 f->output_data.x = (struct x_output *) xmalloc (sizeof (struct x_output));
3080 bzero (f->output_data.x, sizeof (struct x_output));
3081 f->output_data.x->icon_bitmap = -1;
3083 f->icon_name
3084 = x_get_arg (parms, Qicon_name, "iconName", "Title", string);
3085 if (! STRINGP (f->icon_name))
3086 f->icon_name = Qnil;
3088 FRAME_X_DISPLAY_INFO (f) = dpyinfo;
3089 #ifdef MULTI_KBOARD
3090 FRAME_KBOARD (f) = kb;
3091 #endif
3093 /* Specify the parent under which to make this X window. */
3095 if (!NILP (parent))
3097 f->output_data.x->parent_desc = parent;
3098 f->output_data.x->explicit_parent = 1;
3100 else
3102 f->output_data.x->parent_desc = FRAME_X_DISPLAY_INFO (f)->root_window;
3103 f->output_data.x->explicit_parent = 0;
3106 /* Note that the frame has no physical cursor right now. */
3107 f->phys_cursor_x = -1;
3109 /* Set the name; the functions to which we pass f expect the name to
3110 be set. */
3111 if (EQ (name, Qunbound) || NILP (name))
3113 f->name = build_string (dpyinfo->x_id_name);
3114 f->explicit_name = 0;
3116 else
3118 f->name = name;
3119 f->explicit_name = 1;
3120 /* use the frame's title when getting resources for this frame. */
3121 specbind (Qx_resource_name, name);
3124 /* Extract the window parameters from the supplied values
3125 that are needed to determine window geometry. */
3127 Lisp_Object font;
3129 font = x_get_arg (parms, Qfont, "font", "Font", string);
3130 BLOCK_INPUT;
3131 /* First, try whatever font the caller has specified. */
3132 if (STRINGP (font))
3133 font = x_new_font (f, XSTRING (font)->data);
3134 /* Try out a font which we hope has bold and italic variations. */
3135 if (!STRINGP (font))
3136 font = x_new_font (f, "-misc-fixed-medium-r-normal-*-*-140-*-*-c-*-iso8859-1");
3137 if (! STRINGP (font))
3138 font = x_new_font (f, "-*-*-medium-r-normal-*-*-140-*-*-c-*-iso8859-1");
3139 if (! STRINGP (font))
3140 /* This was formerly the first thing tried, but it finds too many fonts
3141 and takes too long. */
3142 font = x_new_font (f, "-*-*-medium-r-*-*-*-*-*-*-c-*-iso8859-1");
3143 /* If those didn't work, look for something which will at least work. */
3144 if (! STRINGP (font))
3145 font = x_new_font (f, "-*-fixed-*-*-*-*-*-140-*-*-c-*-iso8859-1");
3146 UNBLOCK_INPUT;
3147 if (! STRINGP (font))
3148 font = build_string ("fixed");
3150 x_default_parameter (f, parms, Qfont, font,
3151 "font", "Font", string);
3154 #ifdef USE_LUCID
3155 /* Prevent lwlib/xlwmenu.c from crashing because of a bug
3156 whereby it fails to get any font. */
3157 xlwmenu_default_font = f->output_data.x->font;
3158 #endif
3160 x_default_parameter (f, parms, Qborder_width, make_number (2),
3161 "borderwidth", "BorderWidth", number);
3162 /* This defaults to 2 in order to match xterm. We recognize either
3163 internalBorderWidth or internalBorder (which is what xterm calls
3164 it). */
3165 if (NILP (Fassq (Qinternal_border_width, parms)))
3167 Lisp_Object value;
3169 value = x_get_arg (parms, Qinternal_border_width,
3170 "internalBorder", "BorderWidth", number);
3171 if (! EQ (value, Qunbound))
3172 parms = Fcons (Fcons (Qinternal_border_width, value),
3173 parms);
3175 x_default_parameter (f, parms, Qinternal_border_width, make_number (2),
3176 "internalBorderWidth", "BorderWidth", number);
3177 x_default_parameter (f, parms, Qvertical_scroll_bars, Qt,
3178 "verticalScrollBars", "ScrollBars", boolean);
3180 /* Also do the stuff which must be set before the window exists. */
3181 x_default_parameter (f, parms, Qforeground_color, build_string ("black"),
3182 "foreground", "Foreground", string);
3183 x_default_parameter (f, parms, Qbackground_color, build_string ("white"),
3184 "background", "Background", string);
3185 x_default_parameter (f, parms, Qmouse_color, build_string ("black"),
3186 "pointerColor", "Foreground", string);
3187 x_default_parameter (f, parms, Qcursor_color, build_string ("black"),
3188 "cursorColor", "Foreground", string);
3189 x_default_parameter (f, parms, Qborder_color, build_string ("black"),
3190 "borderColor", "BorderColor", string);
3192 x_default_parameter (f, parms, Qmenu_bar_lines, make_number (1),
3193 "menuBar", "MenuBar", number);
3194 x_default_parameter (f, parms, Qscroll_bar_width, Qnil,
3195 "scrollBarWidth", "ScrollBarWidth", number);
3196 x_default_parameter (f, parms, Qbuffer_predicate, Qnil,
3197 "bufferPredicate", "BufferPredicate", symbol);
3198 x_default_parameter (f, parms, Qtitle, Qnil,
3199 "title", "Title", string);
3201 f->output_data.x->parent_desc = FRAME_X_DISPLAY_INFO (f)->root_window;
3202 window_prompting = x_figure_window_size (f, parms);
3204 if (window_prompting & XNegative)
3206 if (window_prompting & YNegative)
3207 f->output_data.x->win_gravity = SouthEastGravity;
3208 else
3209 f->output_data.x->win_gravity = NorthEastGravity;
3211 else
3213 if (window_prompting & YNegative)
3214 f->output_data.x->win_gravity = SouthWestGravity;
3215 else
3216 f->output_data.x->win_gravity = NorthWestGravity;
3219 f->output_data.x->size_hint_flags = window_prompting;
3221 #ifdef USE_X_TOOLKIT
3222 x_window (f, window_prompting, minibuffer_only);
3223 #else
3224 x_window (f);
3225 #endif
3226 x_icon (f, parms);
3227 x_make_gc (f);
3228 init_frame_faces (f);
3230 /* We need to do this after creating the X window, so that the
3231 icon-creation functions can say whose icon they're describing. */
3232 x_default_parameter (f, parms, Qicon_type, Qnil,
3233 "bitmapIcon", "BitmapIcon", symbol);
3235 x_default_parameter (f, parms, Qauto_raise, Qnil,
3236 "autoRaise", "AutoRaiseLower", boolean);
3237 x_default_parameter (f, parms, Qauto_lower, Qnil,
3238 "autoLower", "AutoRaiseLower", boolean);
3239 x_default_parameter (f, parms, Qcursor_type, Qbox,
3240 "cursorType", "CursorType", symbol);
3242 /* Dimensions, especially f->height, must be done via change_frame_size.
3243 Change will not be effected unless different from the current
3244 f->height. */
3245 width = f->width;
3246 height = f->height;
3247 f->height = f->width = 0;
3248 change_frame_size (f, height, width, 1, 0);
3250 /* Tell the server what size and position, etc, we want,
3251 and how badly we want them. */
3252 BLOCK_INPUT;
3253 x_wm_set_size_hint (f, window_prompting, 0);
3254 UNBLOCK_INPUT;
3256 tem = x_get_arg (parms, Qunsplittable, 0, 0, boolean);
3257 f->no_split = minibuffer_only || EQ (tem, Qt);
3259 UNGCPRO;
3261 /* It is now ok to make the frame official
3262 even if we get an error below.
3263 And the frame needs to be on Vframe_list
3264 or making it visible won't work. */
3265 Vframe_list = Fcons (frame, Vframe_list);
3267 /* Now that the frame is official, it counts as a reference to
3268 its display. */
3269 FRAME_X_DISPLAY_INFO (f)->reference_count++;
3271 /* Make the window appear on the frame and enable display,
3272 unless the caller says not to. However, with explicit parent,
3273 Emacs cannot control visibility, so don't try. */
3274 if (! f->output_data.x->explicit_parent)
3276 Lisp_Object visibility;
3278 visibility = x_get_arg (parms, Qvisibility, 0, 0, symbol);
3279 if (EQ (visibility, Qunbound))
3280 visibility = Qt;
3282 if (EQ (visibility, Qicon))
3283 x_iconify_frame (f);
3284 else if (! NILP (visibility))
3285 x_make_frame_visible (f);
3286 else
3287 /* Must have been Qnil. */
3291 return unbind_to (count, frame);
3294 /* FRAME is used only to get a handle on the X display. We don't pass the
3295 display info directly because we're called from frame.c, which doesn't
3296 know about that structure. */
3297 Lisp_Object
3298 x_get_focus_frame (frame)
3299 struct frame *frame;
3301 struct x_display_info *dpyinfo = FRAME_X_DISPLAY_INFO (frame);
3302 Lisp_Object xfocus;
3303 if (! dpyinfo->x_focus_frame)
3304 return Qnil;
3306 XSETFRAME (xfocus, dpyinfo->x_focus_frame);
3307 return xfocus;
3310 DEFUN ("focus-frame", Ffocus_frame, Sfocus_frame, 1, 1, 0,
3311 "This function is obsolete, and does nothing.")
3312 (frame)
3313 Lisp_Object frame;
3315 return Qnil;
3318 DEFUN ("unfocus-frame", Funfocus_frame, Sunfocus_frame, 0, 0, 0,
3319 "This function is obsolete, and does nothing.")
3322 return Qnil;
3325 DEFUN ("x-list-fonts", Fx_list_fonts, Sx_list_fonts, 1, 3, 0,
3326 "Return a list of the names of available fonts matching PATTERN.\n\
3327 If optional arguments FACE and FRAME are specified, return only fonts\n\
3328 the same size as FACE on FRAME.\n\
3330 PATTERN is a string, perhaps with wildcard characters;\n\
3331 the * character matches any substring, and\n\
3332 the ? character matches any single character.\n\
3333 PATTERN is case-insensitive.\n\
3334 FACE is a face name--a symbol.\n\
3336 The return value is a list of strings, suitable as arguments to\n\
3337 set-face-font.\n\
3339 Fonts Emacs can't use (i.e. proportional fonts) may or may not be excluded\n\
3340 even if they match PATTERN and FACE.")
3341 (pattern, face, frame)
3342 Lisp_Object pattern, face, frame;
3344 int num_fonts;
3345 char **names;
3346 #ifndef BROKEN_XLISTFONTSWITHINFO
3347 XFontStruct *info;
3348 #endif
3349 XFontStruct *size_ref;
3350 Lisp_Object list;
3351 FRAME_PTR f;
3353 check_x ();
3354 CHECK_STRING (pattern, 0);
3355 if (!NILP (face))
3356 CHECK_SYMBOL (face, 1);
3358 f = check_x_frame (frame);
3360 /* Determine the width standard for comparison with the fonts we find. */
3362 if (NILP (face))
3363 size_ref = 0;
3364 else
3366 int face_id;
3368 /* Don't die if we get called with a terminal frame. */
3369 if (! FRAME_X_P (f))
3370 error ("Non-X frame used in `x-list-fonts'");
3372 face_id = face_name_id_number (f, face);
3374 if (face_id < 0 || face_id >= FRAME_N_PARAM_FACES (f)
3375 || FRAME_PARAM_FACES (f) [face_id] == 0)
3376 size_ref = f->output_data.x->font;
3377 else
3379 size_ref = FRAME_PARAM_FACES (f) [face_id]->font;
3380 if (size_ref == (XFontStruct *) (~0))
3381 size_ref = f->output_data.x->font;
3385 /* See if we cached the result for this particular query. */
3386 list = Fassoc (pattern,
3387 XCONS (FRAME_X_DISPLAY_INFO (f)->name_list_element)->cdr);
3389 /* We have info in the cache for this PATTERN. */
3390 if (!NILP (list))
3392 Lisp_Object tem, newlist;
3394 /* We have info about this pattern. */
3395 list = XCONS (list)->cdr;
3397 if (size_ref == 0)
3398 return list;
3400 BLOCK_INPUT;
3402 /* Filter the cached info and return just the fonts that match FACE. */
3403 newlist = Qnil;
3404 for (tem = list; CONSP (tem); tem = XCONS (tem)->cdr)
3406 XFontStruct *thisinfo;
3408 x_catch_errors (FRAME_X_DISPLAY (f));
3410 thisinfo = XLoadQueryFont (FRAME_X_DISPLAY (f),
3411 XSTRING (XCONS (tem)->car)->data);
3413 x_check_errors (FRAME_X_DISPLAY (f), "XLoadQueryFont failure: %s");
3414 x_uncatch_errors (FRAME_X_DISPLAY (f));
3416 if (thisinfo && same_size_fonts (thisinfo, size_ref))
3417 newlist = Fcons (XCONS (tem)->car, newlist);
3419 if (thisinfo != 0)
3420 XFreeFont (FRAME_X_DISPLAY (f), thisinfo);
3423 UNBLOCK_INPUT;
3425 return newlist;
3428 BLOCK_INPUT;
3430 x_catch_errors (FRAME_X_DISPLAY (f));
3432 /* Solaris 2.3 has a bug in XListFontsWithInfo. */
3433 #ifndef BROKEN_XLISTFONTSWITHINFO
3434 if (size_ref)
3435 names = XListFontsWithInfo (FRAME_X_DISPLAY (f),
3436 XSTRING (pattern)->data,
3437 2000, /* maxnames */
3438 &num_fonts, /* count_return */
3439 &info); /* info_return */
3440 else
3441 #endif
3442 names = XListFonts (FRAME_X_DISPLAY (f),
3443 XSTRING (pattern)->data,
3444 2000, /* maxnames */
3445 &num_fonts); /* count_return */
3447 x_check_errors (FRAME_X_DISPLAY (f), "XListFonts failure: %s");
3448 x_uncatch_errors (FRAME_X_DISPLAY (f));
3450 UNBLOCK_INPUT;
3452 list = Qnil;
3454 if (names)
3456 int i;
3457 Lisp_Object full_list;
3459 /* Make a list of all the fonts we got back.
3460 Store that in the font cache for the display. */
3461 full_list = Qnil;
3462 for (i = 0; i < num_fonts; i++)
3463 full_list = Fcons (build_string (names[i]), full_list);
3464 XCONS (FRAME_X_DISPLAY_INFO (f)->name_list_element)->cdr
3465 = Fcons (Fcons (pattern, full_list),
3466 XCONS (FRAME_X_DISPLAY_INFO (f)->name_list_element)->cdr);
3468 /* Make a list of the fonts that have the right width. */
3469 list = Qnil;
3470 for (i = 0; i < num_fonts; i++)
3472 int keeper;
3474 if (!size_ref)
3475 keeper = 1;
3476 else
3478 #ifdef BROKEN_XLISTFONTSWITHINFO
3479 XFontStruct *thisinfo;
3481 BLOCK_INPUT;
3483 x_catch_errors (FRAME_X_DISPLAY (f));
3484 thisinfo = XLoadQueryFont (FRAME_X_DISPLAY (f), names[i]);
3485 x_check_errors (FRAME_X_DISPLAY (f),
3486 "XLoadQueryFont failure: %s");
3487 x_uncatch_errors (FRAME_X_DISPLAY (f));
3489 UNBLOCK_INPUT;
3491 keeper = thisinfo && same_size_fonts (thisinfo, size_ref);
3492 BLOCK_INPUT;
3493 if (thisinfo && ! keeper)
3494 XFreeFont (FRAME_X_DISPLAY (f), thisinfo);
3495 else if (thisinfo)
3496 XFreeFontInfo (NULL, thisinfo, 1);
3497 UNBLOCK_INPUT;
3498 #else
3499 keeper = same_size_fonts (&info[i], size_ref);
3500 #endif
3502 if (keeper)
3503 list = Fcons (build_string (names[i]), list);
3505 list = Fnreverse (list);
3507 BLOCK_INPUT;
3508 #ifndef BROKEN_XLISTFONTSWITHINFO
3509 if (size_ref)
3510 XFreeFontInfo (names, info, num_fonts);
3511 else
3512 #endif
3513 XFreeFontNames (names);
3514 UNBLOCK_INPUT;
3517 return list;
3521 DEFUN ("x-color-defined-p", Fx_color_defined_p, Sx_color_defined_p, 1, 2, 0,
3522 "Return non-nil if color COLOR is supported on frame FRAME.\n\
3523 If FRAME is omitted or nil, use the selected frame.")
3524 (color, frame)
3525 Lisp_Object color, frame;
3527 XColor foo;
3528 FRAME_PTR f = check_x_frame (frame);
3530 CHECK_STRING (color, 1);
3532 if (defined_color (f, XSTRING (color)->data, &foo, 0))
3533 return Qt;
3534 else
3535 return Qnil;
3538 DEFUN ("x-color-values", Fx_color_values, Sx_color_values, 1, 2, 0,
3539 "Return a description of the color named COLOR on frame FRAME.\n\
3540 The value is a list of integer RGB values--(RED GREEN BLUE).\n\
3541 These values appear to range from 0 to 65280 or 65535, depending\n\
3542 on the system; white is (65280 65280 65280) or (65535 65535 65535).\n\
3543 If FRAME is omitted or nil, use the selected frame.")
3544 (color, frame)
3545 Lisp_Object color, frame;
3547 XColor foo;
3548 FRAME_PTR f = check_x_frame (frame);
3550 CHECK_STRING (color, 1);
3552 if (defined_color (f, XSTRING (color)->data, &foo, 0))
3554 Lisp_Object rgb[3];
3556 rgb[0] = make_number (foo.red);
3557 rgb[1] = make_number (foo.green);
3558 rgb[2] = make_number (foo.blue);
3559 return Flist (3, rgb);
3561 else
3562 return Qnil;
3565 DEFUN ("x-display-color-p", Fx_display_color_p, Sx_display_color_p, 0, 1, 0,
3566 "Return t if the X display supports color.\n\
3567 The optional argument DISPLAY specifies which display to ask about.\n\
3568 DISPLAY should be either a frame or a display name (a string).\n\
3569 If omitted or nil, that stands for the selected frame's display.")
3570 (display)
3571 Lisp_Object display;
3573 struct x_display_info *dpyinfo = check_x_display_info (display);
3575 if (dpyinfo->n_planes <= 2)
3576 return Qnil;
3578 switch (dpyinfo->visual->class)
3580 case StaticColor:
3581 case PseudoColor:
3582 case TrueColor:
3583 case DirectColor:
3584 return Qt;
3586 default:
3587 return Qnil;
3591 DEFUN ("x-display-grayscale-p", Fx_display_grayscale_p, Sx_display_grayscale_p,
3592 0, 1, 0,
3593 "Return t if the X display supports shades of gray.\n\
3594 Note that color displays do support shades of gray.\n\
3595 The optional argument DISPLAY specifies which display to ask about.\n\
3596 DISPLAY should be either a frame or a display name (a string).\n\
3597 If omitted or nil, that stands for the selected frame's display.")
3598 (display)
3599 Lisp_Object display;
3601 struct x_display_info *dpyinfo = check_x_display_info (display);
3603 if (dpyinfo->n_planes <= 1)
3604 return Qnil;
3606 switch (dpyinfo->visual->class)
3608 case StaticColor:
3609 case PseudoColor:
3610 case TrueColor:
3611 case DirectColor:
3612 case StaticGray:
3613 case GrayScale:
3614 return Qt;
3616 default:
3617 return Qnil;
3621 DEFUN ("x-display-pixel-width", Fx_display_pixel_width, Sx_display_pixel_width,
3622 0, 1, 0,
3623 "Returns the width in pixels of the X display DISPLAY.\n\
3624 The optional argument DISPLAY specifies which display to ask about.\n\
3625 DISPLAY should be either a frame or a display name (a string).\n\
3626 If omitted or nil, that stands for the selected frame's display.")
3627 (display)
3628 Lisp_Object display;
3630 struct x_display_info *dpyinfo = check_x_display_info (display);
3632 return make_number (dpyinfo->width);
3635 DEFUN ("x-display-pixel-height", Fx_display_pixel_height,
3636 Sx_display_pixel_height, 0, 1, 0,
3637 "Returns the height in pixels of the X display DISPLAY.\n\
3638 The optional argument DISPLAY specifies which display to ask about.\n\
3639 DISPLAY should be either a frame or a display name (a string).\n\
3640 If omitted or nil, that stands for the selected frame's display.")
3641 (display)
3642 Lisp_Object display;
3644 struct x_display_info *dpyinfo = check_x_display_info (display);
3646 return make_number (dpyinfo->height);
3649 DEFUN ("x-display-planes", Fx_display_planes, Sx_display_planes,
3650 0, 1, 0,
3651 "Returns the number of bitplanes of the X display DISPLAY.\n\
3652 The optional argument DISPLAY specifies which display to ask about.\n\
3653 DISPLAY should be either a frame or a display name (a string).\n\
3654 If omitted or nil, that stands for the selected frame's display.")
3655 (display)
3656 Lisp_Object display;
3658 struct x_display_info *dpyinfo = check_x_display_info (display);
3660 return make_number (dpyinfo->n_planes);
3663 DEFUN ("x-display-color-cells", Fx_display_color_cells, Sx_display_color_cells,
3664 0, 1, 0,
3665 "Returns the number of color cells of the X display DISPLAY.\n\
3666 The optional argument DISPLAY specifies which display to ask about.\n\
3667 DISPLAY should be either a frame or a display name (a string).\n\
3668 If omitted or nil, that stands for the selected frame's display.")
3669 (display)
3670 Lisp_Object display;
3672 struct x_display_info *dpyinfo = check_x_display_info (display);
3674 return make_number (DisplayCells (dpyinfo->display,
3675 XScreenNumberOfScreen (dpyinfo->screen)));
3678 DEFUN ("x-server-max-request-size", Fx_server_max_request_size,
3679 Sx_server_max_request_size,
3680 0, 1, 0,
3681 "Returns the maximum request size of the X server of display DISPLAY.\n\
3682 The optional argument DISPLAY specifies which display to ask about.\n\
3683 DISPLAY should be either a frame or a display name (a string).\n\
3684 If omitted or nil, that stands for the selected frame's display.")
3685 (display)
3686 Lisp_Object display;
3688 struct x_display_info *dpyinfo = check_x_display_info (display);
3690 return make_number (MAXREQUEST (dpyinfo->display));
3693 DEFUN ("x-server-vendor", Fx_server_vendor, Sx_server_vendor, 0, 1, 0,
3694 "Returns the vendor ID string of the X server of display DISPLAY.\n\
3695 The optional argument DISPLAY specifies which display to ask about.\n\
3696 DISPLAY should be either a frame or a display name (a string).\n\
3697 If omitted or nil, that stands for the selected frame's display.")
3698 (display)
3699 Lisp_Object display;
3701 struct x_display_info *dpyinfo = check_x_display_info (display);
3702 char *vendor = ServerVendor (dpyinfo->display);
3704 if (! vendor) vendor = "";
3705 return build_string (vendor);
3708 DEFUN ("x-server-version", Fx_server_version, Sx_server_version, 0, 1, 0,
3709 "Returns the version numbers of the X server of display DISPLAY.\n\
3710 The value is a list of three integers: the major and minor\n\
3711 version numbers of the X Protocol in use, and the vendor-specific release\n\
3712 number. See also the function `x-server-vendor'.\n\n\
3713 The optional argument DISPLAY specifies which display to ask about.\n\
3714 DISPLAY should be either a frame or a display name (a string).\n\
3715 If omitted or nil, that stands for the selected frame's display.")
3716 (display)
3717 Lisp_Object display;
3719 struct x_display_info *dpyinfo = check_x_display_info (display);
3720 Display *dpy = dpyinfo->display;
3722 return Fcons (make_number (ProtocolVersion (dpy)),
3723 Fcons (make_number (ProtocolRevision (dpy)),
3724 Fcons (make_number (VendorRelease (dpy)), Qnil)));
3727 DEFUN ("x-display-screens", Fx_display_screens, Sx_display_screens, 0, 1, 0,
3728 "Returns the number of screens on the X server of display DISPLAY.\n\
3729 The optional argument DISPLAY specifies which display to ask about.\n\
3730 DISPLAY should be either a frame or a display name (a string).\n\
3731 If omitted or nil, that stands for the selected frame's display.")
3732 (display)
3733 Lisp_Object display;
3735 struct x_display_info *dpyinfo = check_x_display_info (display);
3737 return make_number (ScreenCount (dpyinfo->display));
3740 DEFUN ("x-display-mm-height", Fx_display_mm_height, Sx_display_mm_height, 0, 1, 0,
3741 "Returns the height in millimeters of the X display DISPLAY.\n\
3742 The optional argument DISPLAY specifies which display to ask about.\n\
3743 DISPLAY should be either a frame or a display name (a string).\n\
3744 If omitted or nil, that stands for the selected frame's display.")
3745 (display)
3746 Lisp_Object display;
3748 struct x_display_info *dpyinfo = check_x_display_info (display);
3750 return make_number (HeightMMOfScreen (dpyinfo->screen));
3753 DEFUN ("x-display-mm-width", Fx_display_mm_width, Sx_display_mm_width, 0, 1, 0,
3754 "Returns the width in millimeters of the X display DISPLAY.\n\
3755 The optional argument DISPLAY specifies which display to ask about.\n\
3756 DISPLAY should be either a frame or a display name (a string).\n\
3757 If omitted or nil, that stands for the selected frame's display.")
3758 (display)
3759 Lisp_Object display;
3761 struct x_display_info *dpyinfo = check_x_display_info (display);
3763 return make_number (WidthMMOfScreen (dpyinfo->screen));
3766 DEFUN ("x-display-backing-store", Fx_display_backing_store,
3767 Sx_display_backing_store, 0, 1, 0,
3768 "Returns an indication of whether X display DISPLAY does backing store.\n\
3769 The value may be `always', `when-mapped', or `not-useful'.\n\
3770 The optional argument DISPLAY specifies which display to ask about.\n\
3771 DISPLAY should be either a frame or a display name (a string).\n\
3772 If omitted or nil, that stands for the selected frame's display.")
3773 (display)
3774 Lisp_Object display;
3776 struct x_display_info *dpyinfo = check_x_display_info (display);
3778 switch (DoesBackingStore (dpyinfo->screen))
3780 case Always:
3781 return intern ("always");
3783 case WhenMapped:
3784 return intern ("when-mapped");
3786 case NotUseful:
3787 return intern ("not-useful");
3789 default:
3790 error ("Strange value for BackingStore parameter of screen");
3794 DEFUN ("x-display-visual-class", Fx_display_visual_class,
3795 Sx_display_visual_class, 0, 1, 0,
3796 "Returns the visual class of the X display DISPLAY.\n\
3797 The value is one of the symbols `static-gray', `gray-scale',\n\
3798 `static-color', `pseudo-color', `true-color', or `direct-color'.\n\n\
3799 The optional argument DISPLAY specifies which display to ask about.\n\
3800 DISPLAY should be either a frame or a display name (a string).\n\
3801 If omitted or nil, that stands for the selected frame's display.")
3802 (display)
3803 Lisp_Object display;
3805 struct x_display_info *dpyinfo = check_x_display_info (display);
3807 switch (dpyinfo->visual->class)
3809 case StaticGray: return (intern ("static-gray"));
3810 case GrayScale: return (intern ("gray-scale"));
3811 case StaticColor: return (intern ("static-color"));
3812 case PseudoColor: return (intern ("pseudo-color"));
3813 case TrueColor: return (intern ("true-color"));
3814 case DirectColor: return (intern ("direct-color"));
3815 default:
3816 error ("Display has an unknown visual class");
3820 DEFUN ("x-display-save-under", Fx_display_save_under,
3821 Sx_display_save_under, 0, 1, 0,
3822 "Returns t if the X display DISPLAY supports the save-under feature.\n\
3823 The optional argument DISPLAY specifies which display to ask about.\n\
3824 DISPLAY should be either a frame or a display name (a string).\n\
3825 If omitted or nil, that stands for the selected frame's display.")
3826 (display)
3827 Lisp_Object display;
3829 struct x_display_info *dpyinfo = check_x_display_info (display);
3831 if (DoesSaveUnders (dpyinfo->screen) == True)
3832 return Qt;
3833 else
3834 return Qnil;
3838 x_pixel_width (f)
3839 register struct frame *f;
3841 return PIXEL_WIDTH (f);
3845 x_pixel_height (f)
3846 register struct frame *f;
3848 return PIXEL_HEIGHT (f);
3852 x_char_width (f)
3853 register struct frame *f;
3855 return FONT_WIDTH (f->output_data.x->font);
3859 x_char_height (f)
3860 register struct frame *f;
3862 return f->output_data.x->line_height;
3866 x_screen_planes (frame)
3867 Lisp_Object frame;
3869 return FRAME_X_DISPLAY_INFO (XFRAME (frame))->n_planes;
3872 #if 0 /* These no longer seem like the right way to do things. */
3874 /* Draw a rectangle on the frame with left top corner including
3875 the character specified by LEFT_CHAR and TOP_CHAR. The rectangle is
3876 CHARS by LINES wide and long and is the color of the cursor. */
3878 void
3879 x_rectangle (f, gc, left_char, top_char, chars, lines)
3880 register struct frame *f;
3881 GC gc;
3882 register int top_char, left_char, chars, lines;
3884 int width;
3885 int height;
3886 int left = (left_char * FONT_WIDTH (f->output_data.x->font)
3887 + f->output_data.x->internal_border_width);
3888 int top = (top_char * f->output_data.x->line_height
3889 + f->output_data.x->internal_border_width);
3891 if (chars < 0)
3892 width = FONT_WIDTH (f->output_data.x->font) / 2;
3893 else
3894 width = FONT_WIDTH (f->output_data.x->font) * chars;
3895 if (lines < 0)
3896 height = f->output_data.x->line_height / 2;
3897 else
3898 height = f->output_data.x->line_height * lines;
3900 XDrawRectangle (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
3901 gc, left, top, width, height);
3904 DEFUN ("x-draw-rectangle", Fx_draw_rectangle, Sx_draw_rectangle, 5, 5, 0,
3905 "Draw a rectangle on FRAME between coordinates specified by\n\
3906 numbers X0, Y0, X1, Y1 in the cursor pixel.")
3907 (frame, X0, Y0, X1, Y1)
3908 register Lisp_Object frame, X0, X1, Y0, Y1;
3910 register int x0, y0, x1, y1, top, left, n_chars, n_lines;
3912 CHECK_LIVE_FRAME (frame, 0);
3913 CHECK_NUMBER (X0, 0);
3914 CHECK_NUMBER (Y0, 1);
3915 CHECK_NUMBER (X1, 2);
3916 CHECK_NUMBER (Y1, 3);
3918 x0 = XINT (X0);
3919 x1 = XINT (X1);
3920 y0 = XINT (Y0);
3921 y1 = XINT (Y1);
3923 if (y1 > y0)
3925 top = y0;
3926 n_lines = y1 - y0 + 1;
3928 else
3930 top = y1;
3931 n_lines = y0 - y1 + 1;
3934 if (x1 > x0)
3936 left = x0;
3937 n_chars = x1 - x0 + 1;
3939 else
3941 left = x1;
3942 n_chars = x0 - x1 + 1;
3945 BLOCK_INPUT;
3946 x_rectangle (XFRAME (frame), XFRAME (frame)->output_data.x->cursor_gc,
3947 left, top, n_chars, n_lines);
3948 UNBLOCK_INPUT;
3950 return Qt;
3953 DEFUN ("x-erase-rectangle", Fx_erase_rectangle, Sx_erase_rectangle, 5, 5, 0,
3954 "Draw a rectangle drawn on FRAME between coordinates\n\
3955 X0, Y0, X1, Y1 in the regular background-pixel.")
3956 (frame, X0, Y0, X1, Y1)
3957 register Lisp_Object frame, X0, Y0, X1, Y1;
3959 register int x0, y0, x1, y1, top, left, n_chars, n_lines;
3961 CHECK_LIVE_FRAME (frame, 0);
3962 CHECK_NUMBER (X0, 0);
3963 CHECK_NUMBER (Y0, 1);
3964 CHECK_NUMBER (X1, 2);
3965 CHECK_NUMBER (Y1, 3);
3967 x0 = XINT (X0);
3968 x1 = XINT (X1);
3969 y0 = XINT (Y0);
3970 y1 = XINT (Y1);
3972 if (y1 > y0)
3974 top = y0;
3975 n_lines = y1 - y0 + 1;
3977 else
3979 top = y1;
3980 n_lines = y0 - y1 + 1;
3983 if (x1 > x0)
3985 left = x0;
3986 n_chars = x1 - x0 + 1;
3988 else
3990 left = x1;
3991 n_chars = x0 - x1 + 1;
3994 BLOCK_INPUT;
3995 x_rectangle (XFRAME (frame), XFRAME (frame)->output_data.x->reverse_gc,
3996 left, top, n_chars, n_lines);
3997 UNBLOCK_INPUT;
3999 return Qt;
4002 /* Draw lines around the text region beginning at the character position
4003 TOP_X, TOP_Y and ending at BOTTOM_X and BOTTOM_Y. GC specifies the
4004 pixel and line characteristics. */
4006 #define line_len(line) (FRAME_CURRENT_GLYPHS (f)->used[(line)])
4008 static void
4009 outline_region (f, gc, top_x, top_y, bottom_x, bottom_y)
4010 register struct frame *f;
4011 GC gc;
4012 int top_x, top_y, bottom_x, bottom_y;
4014 register int ibw = f->output_data.x->internal_border_width;
4015 register int font_w = FONT_WIDTH (f->output_data.x->font);
4016 register int font_h = f->output_data.x->line_height;
4017 int y = top_y;
4018 int x = line_len (y);
4019 XPoint *pixel_points
4020 = (XPoint *) alloca (((bottom_y - top_y + 2) * 4) * sizeof (XPoint));
4021 register XPoint *this_point = pixel_points;
4023 /* Do the horizontal top line/lines */
4024 if (top_x == 0)
4026 this_point->x = ibw;
4027 this_point->y = ibw + (font_h * top_y);
4028 this_point++;
4029 if (x == 0)
4030 this_point->x = ibw + (font_w / 2); /* Half-size for newline chars. */
4031 else
4032 this_point->x = ibw + (font_w * x);
4033 this_point->y = (this_point - 1)->y;
4035 else
4037 this_point->x = ibw;
4038 this_point->y = ibw + (font_h * (top_y + 1));
4039 this_point++;
4040 this_point->x = ibw + (font_w * top_x);
4041 this_point->y = (this_point - 1)->y;
4042 this_point++;
4043 this_point->x = (this_point - 1)->x;
4044 this_point->y = ibw + (font_h * top_y);
4045 this_point++;
4046 this_point->x = ibw + (font_w * x);
4047 this_point->y = (this_point - 1)->y;
4050 /* Now do the right side. */
4051 while (y < bottom_y)
4052 { /* Right vertical edge */
4053 this_point++;
4054 this_point->x = (this_point - 1)->x;
4055 this_point->y = ibw + (font_h * (y + 1));
4056 this_point++;
4058 y++; /* Horizontal connection to next line */
4059 x = line_len (y);
4060 if (x == 0)
4061 this_point->x = ibw + (font_w / 2);
4062 else
4063 this_point->x = ibw + (font_w * x);
4065 this_point->y = (this_point - 1)->y;
4068 /* Now do the bottom and connect to the top left point. */
4069 this_point->x = ibw + (font_w * (bottom_x + 1));
4071 this_point++;
4072 this_point->x = (this_point - 1)->x;
4073 this_point->y = ibw + (font_h * (bottom_y + 1));
4074 this_point++;
4075 this_point->x = ibw;
4076 this_point->y = (this_point - 1)->y;
4077 this_point++;
4078 this_point->x = pixel_points->x;
4079 this_point->y = pixel_points->y;
4081 XDrawLines (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
4082 gc, pixel_points,
4083 (this_point - pixel_points + 1), CoordModeOrigin);
4086 DEFUN ("x-contour-region", Fx_contour_region, Sx_contour_region, 1, 1, 0,
4087 "Highlight the region between point and the character under the mouse\n\
4088 selected frame.")
4089 (event)
4090 register Lisp_Object event;
4092 register int x0, y0, x1, y1;
4093 register struct frame *f = selected_frame;
4094 register int p1, p2;
4096 CHECK_CONS (event, 0);
4098 BLOCK_INPUT;
4099 x0 = XINT (Fcar (Fcar (event)));
4100 y0 = XINT (Fcar (Fcdr (Fcar (event))));
4102 /* If the mouse is past the end of the line, don't that area. */
4103 /* ReWrite this... */
4105 x1 = f->cursor_x;
4106 y1 = f->cursor_y;
4108 if (y1 > y0) /* point below mouse */
4109 outline_region (f, f->output_data.x->cursor_gc,
4110 x0, y0, x1, y1);
4111 else if (y1 < y0) /* point above mouse */
4112 outline_region (f, f->output_data.x->cursor_gc,
4113 x1, y1, x0, y0);
4114 else /* same line: draw horizontal rectangle */
4116 if (x1 > x0)
4117 x_rectangle (f, f->output_data.x->cursor_gc,
4118 x0, y0, (x1 - x0 + 1), 1);
4119 else if (x1 < x0)
4120 x_rectangle (f, f->output_data.x->cursor_gc,
4121 x1, y1, (x0 - x1 + 1), 1);
4124 XFlush (FRAME_X_DISPLAY (f));
4125 UNBLOCK_INPUT;
4127 return Qnil;
4130 DEFUN ("x-uncontour-region", Fx_uncontour_region, Sx_uncontour_region, 1, 1, 0,
4131 "Erase any highlighting of the region between point and the character\n\
4132 at X, Y on the selected frame.")
4133 (event)
4134 register Lisp_Object event;
4136 register int x0, y0, x1, y1;
4137 register struct frame *f = selected_frame;
4139 BLOCK_INPUT;
4140 x0 = XINT (Fcar (Fcar (event)));
4141 y0 = XINT (Fcar (Fcdr (Fcar (event))));
4142 x1 = f->cursor_x;
4143 y1 = f->cursor_y;
4145 if (y1 > y0) /* point below mouse */
4146 outline_region (f, f->output_data.x->reverse_gc,
4147 x0, y0, x1, y1);
4148 else if (y1 < y0) /* point above mouse */
4149 outline_region (f, f->output_data.x->reverse_gc,
4150 x1, y1, x0, y0);
4151 else /* same line: draw horizontal rectangle */
4153 if (x1 > x0)
4154 x_rectangle (f, f->output_data.x->reverse_gc,
4155 x0, y0, (x1 - x0 + 1), 1);
4156 else if (x1 < x0)
4157 x_rectangle (f, f->output_data.x->reverse_gc,
4158 x1, y1, (x0 - x1 + 1), 1);
4160 UNBLOCK_INPUT;
4162 return Qnil;
4165 #if 0
4166 int contour_begin_x, contour_begin_y;
4167 int contour_end_x, contour_end_y;
4168 int contour_npoints;
4170 /* Clip the top part of the contour lines down (and including) line Y_POS.
4171 If X_POS is in the middle (rather than at the end) of the line, drop
4172 down a line at that character. */
4174 static void
4175 clip_contour_top (y_pos, x_pos)
4177 register XPoint *begin = contour_lines[y_pos].top_left;
4178 register XPoint *end;
4179 register int npoints;
4180 register struct display_line *line = selected_frame->phys_lines[y_pos + 1];
4182 if (x_pos >= line->len - 1) /* Draw one, straight horizontal line. */
4184 end = contour_lines[y_pos].top_right;
4185 npoints = (end - begin + 1);
4186 XDrawLines (x_current_display, contour_window,
4187 contour_erase_gc, begin_erase, npoints, CoordModeOrigin);
4189 bcopy (end, begin + 1, contour_last_point - end + 1);
4190 contour_last_point -= (npoints - 2);
4191 XDrawLines (x_current_display, contour_window,
4192 contour_erase_gc, begin, 2, CoordModeOrigin);
4193 XFlush (x_current_display);
4195 /* Now, update contour_lines structure. */
4197 /* ______. */
4198 else /* |________*/
4200 register XPoint *p = begin + 1;
4201 end = contour_lines[y_pos].bottom_right;
4202 npoints = (end - begin + 1);
4203 XDrawLines (x_current_display, contour_window,
4204 contour_erase_gc, begin_erase, npoints, CoordModeOrigin);
4206 p->y = begin->y;
4207 p->x = ibw + (font_w * (x_pos + 1));
4208 p++;
4209 p->y = begin->y + font_h;
4210 p->x = (p - 1)->x;
4211 bcopy (end, begin + 3, contour_last_point - end + 1);
4212 contour_last_point -= (npoints - 5);
4213 XDrawLines (x_current_display, contour_window,
4214 contour_erase_gc, begin, 4, CoordModeOrigin);
4215 XFlush (x_current_display);
4217 /* Now, update contour_lines structure. */
4221 /* Erase the top horizontal lines of the contour, and then extend
4222 the contour upwards. */
4224 static void
4225 extend_contour_top (line)
4229 static void
4230 clip_contour_bottom (x_pos, y_pos)
4231 int x_pos, y_pos;
4235 static void
4236 extend_contour_bottom (x_pos, y_pos)
4240 DEFUN ("x-select-region", Fx_select_region, Sx_select_region, 1, 1, "e",
4242 (event)
4243 Lisp_Object event;
4245 register struct frame *f = selected_frame;
4246 register int point_x = f->cursor_x;
4247 register int point_y = f->cursor_y;
4248 register int mouse_below_point;
4249 register Lisp_Object obj;
4250 register int x_contour_x, x_contour_y;
4252 x_contour_x = x_mouse_x;
4253 x_contour_y = x_mouse_y;
4254 if (x_contour_y > point_y || (x_contour_y == point_y
4255 && x_contour_x > point_x))
4257 mouse_below_point = 1;
4258 outline_region (f, f->output_data.x->cursor_gc, point_x, point_y,
4259 x_contour_x, x_contour_y);
4261 else
4263 mouse_below_point = 0;
4264 outline_region (f, f->output_data.x->cursor_gc, x_contour_x, x_contour_y,
4265 point_x, point_y);
4268 while (1)
4270 obj = read_char (-1, 0, 0, Qnil, 0);
4271 if (!CONSP (obj))
4272 break;
4274 if (mouse_below_point)
4276 if (x_mouse_y <= point_y) /* Flipped. */
4278 mouse_below_point = 0;
4280 outline_region (f, f->output_data.x->reverse_gc, point_x, point_y,
4281 x_contour_x, x_contour_y);
4282 outline_region (f, f->output_data.x->cursor_gc, x_mouse_x, x_mouse_y,
4283 point_x, point_y);
4285 else if (x_mouse_y < x_contour_y) /* Bottom clipped. */
4287 clip_contour_bottom (x_mouse_y);
4289 else if (x_mouse_y > x_contour_y) /* Bottom extended. */
4291 extend_bottom_contour (x_mouse_y);
4294 x_contour_x = x_mouse_x;
4295 x_contour_y = x_mouse_y;
4297 else /* mouse above or same line as point */
4299 if (x_mouse_y >= point_y) /* Flipped. */
4301 mouse_below_point = 1;
4303 outline_region (f, f->output_data.x->reverse_gc,
4304 x_contour_x, x_contour_y, point_x, point_y);
4305 outline_region (f, f->output_data.x->cursor_gc, point_x, point_y,
4306 x_mouse_x, x_mouse_y);
4308 else if (x_mouse_y > x_contour_y) /* Top clipped. */
4310 clip_contour_top (x_mouse_y);
4312 else if (x_mouse_y < x_contour_y) /* Top extended. */
4314 extend_contour_top (x_mouse_y);
4319 unread_command_event = obj;
4320 if (mouse_below_point)
4322 contour_begin_x = point_x;
4323 contour_begin_y = point_y;
4324 contour_end_x = x_contour_x;
4325 contour_end_y = x_contour_y;
4327 else
4329 contour_begin_x = x_contour_x;
4330 contour_begin_y = x_contour_y;
4331 contour_end_x = point_x;
4332 contour_end_y = point_y;
4335 #endif
4337 DEFUN ("x-horizontal-line", Fx_horizontal_line, Sx_horizontal_line, 1, 1, "e",
4339 (event)
4340 Lisp_Object event;
4342 register Lisp_Object obj;
4343 struct frame *f = selected_frame;
4344 register struct window *w = XWINDOW (selected_window);
4345 register GC line_gc = f->output_data.x->cursor_gc;
4346 register GC erase_gc = f->output_data.x->reverse_gc;
4347 #if 0
4348 char dash_list[] = {6, 4, 6, 4};
4349 int dashes = 4;
4350 XGCValues gc_values;
4351 #endif
4352 register int previous_y;
4353 register int line = (x_mouse_y + 1) * f->output_data.x->line_height
4354 + f->output_data.x->internal_border_width;
4355 register int left = f->output_data.x->internal_border_width
4356 + (w->left
4357 * FONT_WIDTH (f->output_data.x->font));
4358 register int right = left + (w->width
4359 * FONT_WIDTH (f->output_data.x->font))
4360 - f->output_data.x->internal_border_width;
4362 #if 0
4363 BLOCK_INPUT;
4364 gc_values.foreground = f->output_data.x->cursor_pixel;
4365 gc_values.background = f->output_data.x->background_pixel;
4366 gc_values.line_width = 1;
4367 gc_values.line_style = LineOnOffDash;
4368 gc_values.cap_style = CapRound;
4369 gc_values.join_style = JoinRound;
4371 line_gc = XCreateGC (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
4372 GCLineStyle | GCJoinStyle | GCCapStyle
4373 | GCLineWidth | GCForeground | GCBackground,
4374 &gc_values);
4375 XSetDashes (FRAME_X_DISPLAY (f), line_gc, 0, dash_list, dashes);
4376 gc_values.foreground = f->output_data.x->background_pixel;
4377 gc_values.background = f->output_data.x->foreground_pixel;
4378 erase_gc = XCreateGC (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
4379 GCLineStyle | GCJoinStyle | GCCapStyle
4380 | GCLineWidth | GCForeground | GCBackground,
4381 &gc_values);
4382 XSetDashes (FRAME_X_DISPLAY (f), erase_gc, 0, dash_list, dashes);
4383 UNBLOCK_INPUT;
4384 #endif
4386 while (1)
4388 BLOCK_INPUT;
4389 if (x_mouse_y >= XINT (w->top)
4390 && x_mouse_y < XINT (w->top) + XINT (w->height) - 1)
4392 previous_y = x_mouse_y;
4393 line = (x_mouse_y + 1) * f->output_data.x->line_height
4394 + f->output_data.x->internal_border_width;
4395 XDrawLine (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
4396 line_gc, left, line, right, line);
4398 XFlush (FRAME_X_DISPLAY (f));
4399 UNBLOCK_INPUT;
4403 obj = read_char (-1, 0, 0, Qnil, 0);
4404 if (!CONSP (obj)
4405 || (! EQ (Fcar (Fcdr (Fcdr (obj))),
4406 Qvertical_scroll_bar))
4407 || x_mouse_grabbed)
4409 BLOCK_INPUT;
4410 XDrawLine (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
4411 erase_gc, left, line, right, line);
4412 unread_command_event = obj;
4413 #if 0
4414 XFreeGC (FRAME_X_DISPLAY (f), line_gc);
4415 XFreeGC (FRAME_X_DISPLAY (f), erase_gc);
4416 #endif
4417 UNBLOCK_INPUT;
4418 return Qnil;
4421 while (x_mouse_y == previous_y);
4423 BLOCK_INPUT;
4424 XDrawLine (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
4425 erase_gc, left, line, right, line);
4426 UNBLOCK_INPUT;
4429 #endif
4431 #if 0
4432 /* These keep track of the rectangle following the pointer. */
4433 int mouse_track_top, mouse_track_left, mouse_track_width;
4435 /* Offset in buffer of character under the pointer, or 0. */
4436 int mouse_buffer_offset;
4438 DEFUN ("x-track-pointer", Fx_track_pointer, Sx_track_pointer, 0, 0, 0,
4439 "Track the pointer.")
4442 static Cursor current_pointer_shape;
4443 FRAME_PTR f = x_mouse_frame;
4445 BLOCK_INPUT;
4446 if (EQ (Vmouse_frame_part, Qtext_part)
4447 && (current_pointer_shape != f->output_data.x->nontext_cursor))
4449 unsigned char c;
4450 struct buffer *buf;
4452 current_pointer_shape = f->output_data.x->nontext_cursor;
4453 XDefineCursor (FRAME_X_DISPLAY (f),
4454 FRAME_X_WINDOW (f),
4455 current_pointer_shape);
4457 buf = XBUFFER (XWINDOW (Vmouse_window)->buffer);
4458 c = *(BUF_CHAR_ADDRESS (buf, mouse_buffer_offset));
4460 else if (EQ (Vmouse_frame_part, Qmodeline_part)
4461 && (current_pointer_shape != f->output_data.x->modeline_cursor))
4463 current_pointer_shape = f->output_data.x->modeline_cursor;
4464 XDefineCursor (FRAME_X_DISPLAY (f),
4465 FRAME_X_WINDOW (f),
4466 current_pointer_shape);
4469 XFlush (FRAME_X_DISPLAY (f));
4470 UNBLOCK_INPUT;
4472 #endif
4474 #if 0
4475 DEFUN ("x-track-pointer", Fx_track_pointer, Sx_track_pointer, 1, 1, "e",
4476 "Draw rectangle around character under mouse pointer, if there is one.")
4477 (event)
4478 Lisp_Object event;
4480 struct window *w = XWINDOW (Vmouse_window);
4481 struct frame *f = XFRAME (WINDOW_FRAME (w));
4482 struct buffer *b = XBUFFER (w->buffer);
4483 Lisp_Object obj;
4485 if (! EQ (Vmouse_window, selected_window))
4486 return Qnil;
4488 if (EQ (event, Qnil))
4490 int x, y;
4492 x_read_mouse_position (selected_frame, &x, &y);
4495 BLOCK_INPUT;
4496 mouse_track_width = 0;
4497 mouse_track_left = mouse_track_top = -1;
4501 if ((x_mouse_x != mouse_track_left
4502 && (x_mouse_x < mouse_track_left
4503 || x_mouse_x > (mouse_track_left + mouse_track_width)))
4504 || x_mouse_y != mouse_track_top)
4506 int hp = 0; /* Horizontal position */
4507 int len = FRAME_CURRENT_GLYPHS (f)->used[x_mouse_y];
4508 int p = FRAME_CURRENT_GLYPHS (f)->bufp[x_mouse_y];
4509 int tab_width = XINT (b->tab_width);
4510 int ctl_arrow_p = !NILP (b->ctl_arrow);
4511 unsigned char c;
4512 int mode_line_vpos = XFASTINT (w->height) + XFASTINT (w->top) - 1;
4513 int in_mode_line = 0;
4515 if (! FRAME_CURRENT_GLYPHS (f)->enable[x_mouse_y])
4516 break;
4518 /* Erase previous rectangle. */
4519 if (mouse_track_width)
4521 x_rectangle (f, f->output_data.x->reverse_gc,
4522 mouse_track_left, mouse_track_top,
4523 mouse_track_width, 1);
4525 if ((mouse_track_left == f->phys_cursor_x
4526 || mouse_track_left == f->phys_cursor_x - 1)
4527 && mouse_track_top == f->phys_cursor_y)
4529 x_display_cursor (f, 1);
4533 mouse_track_left = x_mouse_x;
4534 mouse_track_top = x_mouse_y;
4535 mouse_track_width = 0;
4537 if (mouse_track_left > len) /* Past the end of line. */
4538 goto draw_or_not;
4540 if (mouse_track_top == mode_line_vpos)
4542 in_mode_line = 1;
4543 goto draw_or_not;
4546 if (tab_width <= 0 || tab_width > 20) tab_width = 8;
4549 c = FETCH_CHAR (p);
4550 if (len == f->width && hp == len - 1 && c != '\n')
4551 goto draw_or_not;
4553 switch (c)
4555 case '\t':
4556 mouse_track_width = tab_width - (hp % tab_width);
4557 p++;
4558 hp += mouse_track_width;
4559 if (hp > x_mouse_x)
4561 mouse_track_left = hp - mouse_track_width;
4562 goto draw_or_not;
4564 continue;
4566 case '\n':
4567 mouse_track_width = -1;
4568 goto draw_or_not;
4570 default:
4571 if (ctl_arrow_p && (c < 040 || c == 0177))
4573 if (p > ZV)
4574 goto draw_or_not;
4576 mouse_track_width = 2;
4577 p++;
4578 hp +=2;
4579 if (hp > x_mouse_x)
4581 mouse_track_left = hp - mouse_track_width;
4582 goto draw_or_not;
4585 else
4587 mouse_track_width = 1;
4588 p++;
4589 hp++;
4591 continue;
4594 while (hp <= x_mouse_x);
4596 draw_or_not:
4597 if (mouse_track_width) /* Over text; use text pointer shape. */
4599 XDefineCursor (FRAME_X_DISPLAY (f),
4600 FRAME_X_WINDOW (f),
4601 f->output_data.x->text_cursor);
4602 x_rectangle (f, f->output_data.x->cursor_gc,
4603 mouse_track_left, mouse_track_top,
4604 mouse_track_width, 1);
4606 else if (in_mode_line)
4607 XDefineCursor (FRAME_X_DISPLAY (f),
4608 FRAME_X_WINDOW (f),
4609 f->output_data.x->modeline_cursor);
4610 else
4611 XDefineCursor (FRAME_X_DISPLAY (f),
4612 FRAME_X_WINDOW (f),
4613 f->output_data.x->nontext_cursor);
4616 XFlush (FRAME_X_DISPLAY (f));
4617 UNBLOCK_INPUT;
4619 obj = read_char (-1, 0, 0, Qnil, 0);
4620 BLOCK_INPUT;
4622 while (CONSP (obj) /* Mouse event */
4623 && EQ (Fcar (Fcdr (Fcdr (obj))), Qnil) /* Not scroll bar */
4624 && EQ (Vmouse_depressed, Qnil) /* Only motion events */
4625 && EQ (Vmouse_window, selected_window) /* In this window */
4626 && x_mouse_frame);
4628 unread_command_event = obj;
4630 if (mouse_track_width)
4632 x_rectangle (f, f->output_data.x->reverse_gc,
4633 mouse_track_left, mouse_track_top,
4634 mouse_track_width, 1);
4635 mouse_track_width = 0;
4636 if ((mouse_track_left == f->phys_cursor_x
4637 || mouse_track_left - 1 == f->phys_cursor_x)
4638 && mouse_track_top == f->phys_cursor_y)
4640 x_display_cursor (f, 1);
4643 XDefineCursor (FRAME_X_DISPLAY (f),
4644 FRAME_X_WINDOW (f),
4645 f->output_data.x->nontext_cursor);
4646 XFlush (FRAME_X_DISPLAY (f));
4647 UNBLOCK_INPUT;
4649 return Qnil;
4651 #endif
4653 #if 0
4654 #include "glyphs.h"
4656 /* Draw a pixmap specified by IMAGE_DATA of dimensions WIDTH and HEIGHT
4657 on the frame F at position X, Y. */
4659 x_draw_pixmap (f, x, y, image_data, width, height)
4660 struct frame *f;
4661 int x, y, width, height;
4662 char *image_data;
4664 Pixmap image;
4666 image = XCreateBitmapFromData (FRAME_X_DISPLAY (f),
4667 FRAME_X_WINDOW (f), image_data,
4668 width, height);
4669 XCopyPlane (FRAME_X_DISPLAY (f), image, FRAME_X_WINDOW (f),
4670 f->output_data.x->normal_gc, 0, 0, width, height, x, y);
4672 #endif
4674 #if 0 /* I'm told these functions are superfluous
4675 given the ability to bind function keys. */
4677 #ifdef HAVE_X11
4678 DEFUN ("x-rebind-key", Fx_rebind_key, Sx_rebind_key, 3, 3, 0,
4679 "Rebind X keysym KEYSYM, with MODIFIERS, to generate NEWSTRING.\n\
4680 KEYSYM is a string which conforms to the X keysym definitions found\n\
4681 in X11/keysymdef.h, sans the initial XK_. MODIFIERS is nil or a\n\
4682 list of strings specifying modifier keys such as Control_L, which must\n\
4683 also be depressed for NEWSTRING to appear.")
4684 (x_keysym, modifiers, newstring)
4685 register Lisp_Object x_keysym;
4686 register Lisp_Object modifiers;
4687 register Lisp_Object newstring;
4689 char *rawstring;
4690 register KeySym keysym;
4691 KeySym modifier_list[16];
4693 check_x ();
4694 CHECK_STRING (x_keysym, 1);
4695 CHECK_STRING (newstring, 3);
4697 keysym = XStringToKeysym ((char *) XSTRING (x_keysym)->data);
4698 if (keysym == NoSymbol)
4699 error ("Keysym does not exist");
4701 if (NILP (modifiers))
4702 XRebindKeysym (x_current_display, keysym, modifier_list, 0,
4703 XSTRING (newstring)->data, XSTRING (newstring)->size);
4704 else
4706 register Lisp_Object rest, mod;
4707 register int i = 0;
4709 for (rest = modifiers; !NILP (rest); rest = Fcdr (rest))
4711 if (i == 16)
4712 error ("Can't have more than 16 modifiers");
4714 mod = Fcar (rest);
4715 CHECK_STRING (mod, 3);
4716 modifier_list[i] = XStringToKeysym ((char *) XSTRING (mod)->data);
4717 #ifndef HAVE_X11R5
4718 if (modifier_list[i] == NoSymbol
4719 || !(IsModifierKey (modifier_list[i])
4720 || ((unsigned)(modifier_list[i]) == XK_Mode_switch)
4721 || ((unsigned)(modifier_list[i]) == XK_Num_Lock)))
4722 #else
4723 if (modifier_list[i] == NoSymbol
4724 || !IsModifierKey (modifier_list[i]))
4725 #endif
4726 error ("Element is not a modifier keysym");
4727 i++;
4730 XRebindKeysym (x_current_display, keysym, modifier_list, i,
4731 XSTRING (newstring)->data, XSTRING (newstring)->size);
4734 return Qnil;
4737 DEFUN ("x-rebind-keys", Fx_rebind_keys, Sx_rebind_keys, 2, 2, 0,
4738 "Rebind KEYCODE to list of strings STRINGS.\n\
4739 STRINGS should be a list of 16 elements, one for each shift combination.\n\
4740 nil as element means don't change.\n\
4741 See the documentation of `x-rebind-key' for more information.")
4742 (keycode, strings)
4743 register Lisp_Object keycode;
4744 register Lisp_Object strings;
4746 register Lisp_Object item;
4747 register unsigned char *rawstring;
4748 KeySym rawkey, modifier[1];
4749 int strsize;
4750 register unsigned i;
4752 check_x ();
4753 CHECK_NUMBER (keycode, 1);
4754 CHECK_CONS (strings, 2);
4755 rawkey = (KeySym) ((unsigned) (XINT (keycode))) & 255;
4756 for (i = 0; i <= 15; strings = Fcdr (strings), i++)
4758 item = Fcar (strings);
4759 if (!NILP (item))
4761 CHECK_STRING (item, 2);
4762 strsize = XSTRING (item)->size;
4763 rawstring = (unsigned char *) xmalloc (strsize);
4764 bcopy (XSTRING (item)->data, rawstring, strsize);
4765 modifier[1] = 1 << i;
4766 XRebindKeysym (x_current_display, rawkey, modifier, 1,
4767 rawstring, strsize);
4770 return Qnil;
4772 #endif /* HAVE_X11 */
4773 #endif /* 0 */
4775 #ifndef HAVE_XSCREENNUMBEROFSCREEN
4777 XScreenNumberOfScreen (scr)
4778 register Screen *scr;
4780 register Display *dpy;
4781 register Screen *dpyscr;
4782 register int i;
4784 dpy = scr->display;
4785 dpyscr = dpy->screens;
4787 for (i = 0; i < dpy->nscreens; i++, dpyscr++)
4788 if (scr == dpyscr)
4789 return i;
4791 return -1;
4793 #endif /* not HAVE_XSCREENNUMBEROFSCREEN */
4795 Visual *
4796 select_visual (dpy, screen, depth)
4797 Display *dpy;
4798 Screen *screen;
4799 unsigned int *depth;
4801 Visual *v;
4802 XVisualInfo *vinfo, vinfo_template;
4803 int n_visuals;
4805 v = DefaultVisualOfScreen (screen);
4807 #ifdef HAVE_X11R4
4808 vinfo_template.visualid = XVisualIDFromVisual (v);
4809 #else
4810 vinfo_template.visualid = v->visualid;
4811 #endif
4813 vinfo_template.screen = XScreenNumberOfScreen (screen);
4815 vinfo = XGetVisualInfo (dpy,
4816 VisualIDMask | VisualScreenMask, &vinfo_template,
4817 &n_visuals);
4818 if (n_visuals != 1)
4819 fatal ("Can't get proper X visual info");
4821 if ((1 << vinfo->depth) == vinfo->colormap_size)
4822 *depth = vinfo->depth;
4823 else
4825 int i = 0;
4826 int n = vinfo->colormap_size - 1;
4827 while (n)
4829 n = n >> 1;
4830 i++;
4832 *depth = i;
4835 XFree ((char *) vinfo);
4836 return v;
4839 /* Return the X display structure for the display named NAME.
4840 Open a new connection if necessary. */
4842 struct x_display_info *
4843 x_display_info_for_name (name)
4844 Lisp_Object name;
4846 Lisp_Object names;
4847 struct x_display_info *dpyinfo;
4849 CHECK_STRING (name, 0);
4851 if (! EQ (Vwindow_system, intern ("x")))
4852 error ("Not using X Windows");
4854 for (dpyinfo = x_display_list, names = x_display_name_list;
4855 dpyinfo;
4856 dpyinfo = dpyinfo->next, names = XCONS (names)->cdr)
4858 Lisp_Object tem;
4859 tem = Fstring_equal (XCONS (XCONS (names)->car)->car, name);
4860 if (!NILP (tem))
4861 return dpyinfo;
4864 /* Use this general default value to start with. */
4865 Vx_resource_name = Vinvocation_name;
4867 validate_x_resource_name ();
4869 dpyinfo = x_term_init (name, (unsigned char *)0,
4870 (char *) XSTRING (Vx_resource_name)->data);
4872 if (dpyinfo == 0)
4873 error ("Cannot connect to X server %s", XSTRING (name)->data);
4875 x_in_use = 1;
4876 XSETFASTINT (Vwindow_system_version, 11);
4878 return dpyinfo;
4881 DEFUN ("x-open-connection", Fx_open_connection, Sx_open_connection,
4882 1, 3, 0, "Open a connection to an X server.\n\
4883 DISPLAY is the name of the display to connect to.\n\
4884 Optional second arg XRM-STRING is a string of resources in xrdb format.\n\
4885 If the optional third arg MUST-SUCCEED is non-nil,\n\
4886 terminate Emacs if we can't open the connection.")
4887 (display, xrm_string, must_succeed)
4888 Lisp_Object display, xrm_string, must_succeed;
4890 unsigned int n_planes;
4891 unsigned char *xrm_option;
4892 struct x_display_info *dpyinfo;
4894 CHECK_STRING (display, 0);
4895 if (! NILP (xrm_string))
4896 CHECK_STRING (xrm_string, 1);
4898 if (! EQ (Vwindow_system, intern ("x")))
4899 error ("Not using X Windows");
4901 if (! NILP (xrm_string))
4902 xrm_option = (unsigned char *) XSTRING (xrm_string)->data;
4903 else
4904 xrm_option = (unsigned char *) 0;
4906 validate_x_resource_name ();
4908 /* This is what opens the connection and sets x_current_display.
4909 This also initializes many symbols, such as those used for input. */
4910 dpyinfo = x_term_init (display, xrm_option,
4911 (char *) XSTRING (Vx_resource_name)->data);
4913 if (dpyinfo == 0)
4915 if (!NILP (must_succeed))
4916 fatal ("Cannot connect to X server %s.\n\
4917 Check the DISPLAY environment variable or use `-d'.\n\
4918 Also use the `xhost' program to verify that it is set to permit\n\
4919 connections from your machine.\n",
4920 XSTRING (display)->data);
4921 else
4922 error ("Cannot connect to X server %s", XSTRING (display)->data);
4925 x_in_use = 1;
4927 XSETFASTINT (Vwindow_system_version, 11);
4928 return Qnil;
4931 DEFUN ("x-close-connection", Fx_close_connection,
4932 Sx_close_connection, 1, 1, 0,
4933 "Close the connection to DISPLAY's X server.\n\
4934 For DISPLAY, specify either a frame or a display name (a string).\n\
4935 If DISPLAY is nil, that stands for the selected frame's display.")
4936 (display)
4937 Lisp_Object display;
4939 struct x_display_info *dpyinfo = check_x_display_info (display);
4940 struct x_display_info *tail;
4941 int i;
4943 if (dpyinfo->reference_count > 0)
4944 error ("Display still has frames on it");
4946 BLOCK_INPUT;
4947 /* Free the fonts in the font table. */
4948 for (i = 0; i < dpyinfo->n_fonts; i++)
4950 if (dpyinfo->font_table[i].name)
4951 free (dpyinfo->font_table[i].name);
4952 /* Don't free the full_name string;
4953 it is always shared with something else. */
4954 XFreeFont (dpyinfo->display, dpyinfo->font_table[i].font);
4956 x_destroy_all_bitmaps (dpyinfo);
4957 XSetCloseDownMode (dpyinfo->display, DestroyAll);
4959 #ifdef USE_X_TOOLKIT
4960 XtCloseDisplay (dpyinfo->display);
4961 #else
4962 XCloseDisplay (dpyinfo->display);
4963 #endif
4965 x_delete_display (dpyinfo);
4966 UNBLOCK_INPUT;
4968 return Qnil;
4971 DEFUN ("x-display-list", Fx_display_list, Sx_display_list, 0, 0, 0,
4972 "Return the list of display names that Emacs has connections to.")
4975 Lisp_Object tail, result;
4977 result = Qnil;
4978 for (tail = x_display_name_list; ! NILP (tail); tail = XCONS (tail)->cdr)
4979 result = Fcons (XCONS (XCONS (tail)->car)->car, result);
4981 return result;
4984 DEFUN ("x-synchronize", Fx_synchronize, Sx_synchronize, 1, 2, 0,
4985 "If ON is non-nil, report X errors as soon as the erring request is made.\n\
4986 If ON is nil, allow buffering of requests.\n\
4987 Turning on synchronization prohibits the Xlib routines from buffering\n\
4988 requests and seriously degrades performance, but makes debugging much\n\
4989 easier.\n\
4990 The optional second argument DISPLAY specifies which display to act on.\n\
4991 DISPLAY should be either a frame or a display name (a string).\n\
4992 If DISPLAY is omitted or nil, that stands for the selected frame's display.")
4993 (on, display)
4994 Lisp_Object display, on;
4996 struct x_display_info *dpyinfo = check_x_display_info (display);
4998 XSynchronize (dpyinfo->display, !EQ (on, Qnil));
5000 return Qnil;
5003 /* Wait for responses to all X commands issued so far for frame F. */
5005 void
5006 x_sync (f)
5007 FRAME_PTR f;
5009 BLOCK_INPUT;
5010 XSync (FRAME_X_DISPLAY (f), False);
5011 UNBLOCK_INPUT;
5014 syms_of_xfns ()
5016 /* This is zero if not using X windows. */
5017 x_in_use = 0;
5019 /* The section below is built by the lisp expression at the top of the file,
5020 just above where these variables are declared. */
5021 /*&&& init symbols here &&&*/
5022 Qauto_raise = intern ("auto-raise");
5023 staticpro (&Qauto_raise);
5024 Qauto_lower = intern ("auto-lower");
5025 staticpro (&Qauto_lower);
5026 Qbackground_color = intern ("background-color");
5027 staticpro (&Qbackground_color);
5028 Qbar = intern ("bar");
5029 staticpro (&Qbar);
5030 Qborder_color = intern ("border-color");
5031 staticpro (&Qborder_color);
5032 Qborder_width = intern ("border-width");
5033 staticpro (&Qborder_width);
5034 Qbox = intern ("box");
5035 staticpro (&Qbox);
5036 Qcursor_color = intern ("cursor-color");
5037 staticpro (&Qcursor_color);
5038 Qcursor_type = intern ("cursor-type");
5039 staticpro (&Qcursor_type);
5040 Qforeground_color = intern ("foreground-color");
5041 staticpro (&Qforeground_color);
5042 Qgeometry = intern ("geometry");
5043 staticpro (&Qgeometry);
5044 Qicon_left = intern ("icon-left");
5045 staticpro (&Qicon_left);
5046 Qicon_top = intern ("icon-top");
5047 staticpro (&Qicon_top);
5048 Qicon_type = intern ("icon-type");
5049 staticpro (&Qicon_type);
5050 Qicon_name = intern ("icon-name");
5051 staticpro (&Qicon_name);
5052 Qinternal_border_width = intern ("internal-border-width");
5053 staticpro (&Qinternal_border_width);
5054 Qleft = intern ("left");
5055 staticpro (&Qleft);
5056 Qmouse_color = intern ("mouse-color");
5057 staticpro (&Qmouse_color);
5058 Qnone = intern ("none");
5059 staticpro (&Qnone);
5060 Qparent_id = intern ("parent-id");
5061 staticpro (&Qparent_id);
5062 Qscroll_bar_width = intern ("scroll-bar-width");
5063 staticpro (&Qscroll_bar_width);
5064 Qsuppress_icon = intern ("suppress-icon");
5065 staticpro (&Qsuppress_icon);
5066 Qtop = intern ("top");
5067 staticpro (&Qtop);
5068 Qundefined_color = intern ("undefined-color");
5069 staticpro (&Qundefined_color);
5070 Qvertical_scroll_bars = intern ("vertical-scroll-bars");
5071 staticpro (&Qvertical_scroll_bars);
5072 Qvisibility = intern ("visibility");
5073 staticpro (&Qvisibility);
5074 Qwindow_id = intern ("window-id");
5075 staticpro (&Qwindow_id);
5076 Qx_frame_parameter = intern ("x-frame-parameter");
5077 staticpro (&Qx_frame_parameter);
5078 Qx_resource_name = intern ("x-resource-name");
5079 staticpro (&Qx_resource_name);
5080 Quser_position = intern ("user-position");
5081 staticpro (&Quser_position);
5082 Quser_size = intern ("user-size");
5083 staticpro (&Quser_size);
5084 Qdisplay = intern ("display");
5085 staticpro (&Qdisplay);
5086 /* This is the end of symbol initialization. */
5088 Fput (Qundefined_color, Qerror_conditions,
5089 Fcons (Qundefined_color, Fcons (Qerror, Qnil)));
5090 Fput (Qundefined_color, Qerror_message,
5091 build_string ("Undefined color"));
5093 init_x_parm_symbols ();
5095 DEFVAR_LISP ("x-bitmap-file-path", &Vx_bitmap_file_path,
5096 "List of directories to search for bitmap files for X.");
5097 Vx_bitmap_file_path = decode_env_path ((char *) 0, PATH_BITMAPS);
5099 DEFVAR_LISP ("x-pointer-shape", &Vx_pointer_shape,
5100 "The shape of the pointer when over text.\n\
5101 Changing the value does not affect existing frames\n\
5102 unless you set the mouse color.");
5103 Vx_pointer_shape = Qnil;
5105 DEFVAR_LISP ("x-resource-name", &Vx_resource_name,
5106 "The name Emacs uses to look up X resources; for internal use only.\n\
5107 `x-get-resource' uses this as the first component of the instance name\n\
5108 when requesting resource values.\n\
5109 Emacs initially sets `x-resource-name' to the name under which Emacs\n\
5110 was invoked, or to the value specified with the `-name' or `-rn'\n\
5111 switches, if present.");
5112 Vx_resource_name = Qnil;
5114 #if 0 /* This doesn't really do anything. */
5115 DEFVAR_INT ("x-nontext-pointer-shape", &Vx_nontext_pointer_shape,
5116 "The shape of the pointer when not over text.\n\
5117 This variable takes effect when you create a new frame\n\
5118 or when you set the mouse color.");
5119 #endif
5120 Vx_nontext_pointer_shape = Qnil;
5122 #if 0 /* This doesn't really do anything. */
5123 DEFVAR_INT ("x-mode-pointer-shape", &Vx_mode_pointer_shape,
5124 "The shape of the pointer when over the mode line.\n\
5125 This variable takes effect when you create a new frame\n\
5126 or when you set the mouse color.");
5127 #endif
5128 Vx_mode_pointer_shape = Qnil;
5130 DEFVAR_INT ("x-sensitive-text-pointer-shape",
5131 &Vx_sensitive_text_pointer_shape,
5132 "The shape of the pointer when over mouse-sensitive text.\n\
5133 This variable takes effect when you create a new frame\n\
5134 or when you set the mouse color.");
5135 Vx_sensitive_text_pointer_shape = Qnil;
5137 DEFVAR_LISP ("x-cursor-fore-pixel", &Vx_cursor_fore_pixel,
5138 "A string indicating the foreground color of the cursor box.");
5139 Vx_cursor_fore_pixel = Qnil;
5141 DEFVAR_LISP ("x-no-window-manager", &Vx_no_window_manager,
5142 "Non-nil if no X window manager is in use.\n\
5143 Emacs doesn't try to figure this out; this is always nil\n\
5144 unless you set it to something else.");
5145 /* We don't have any way to find this out, so set it to nil
5146 and maybe the user would like to set it to t. */
5147 Vx_no_window_manager = Qnil;
5149 #ifdef USE_X_TOOLKIT
5150 Fprovide (intern ("x-toolkit"));
5151 #endif
5152 #ifdef USE_MOTIF
5153 Fprovide (intern ("motif"));
5154 #endif
5156 defsubr (&Sx_get_resource);
5157 #if 0
5158 defsubr (&Sx_draw_rectangle);
5159 defsubr (&Sx_erase_rectangle);
5160 defsubr (&Sx_contour_region);
5161 defsubr (&Sx_uncontour_region);
5162 #endif
5163 defsubr (&Sx_list_fonts);
5164 defsubr (&Sx_display_color_p);
5165 defsubr (&Sx_display_grayscale_p);
5166 defsubr (&Sx_color_defined_p);
5167 defsubr (&Sx_color_values);
5168 defsubr (&Sx_server_max_request_size);
5169 defsubr (&Sx_server_vendor);
5170 defsubr (&Sx_server_version);
5171 defsubr (&Sx_display_pixel_width);
5172 defsubr (&Sx_display_pixel_height);
5173 defsubr (&Sx_display_mm_width);
5174 defsubr (&Sx_display_mm_height);
5175 defsubr (&Sx_display_screens);
5176 defsubr (&Sx_display_planes);
5177 defsubr (&Sx_display_color_cells);
5178 defsubr (&Sx_display_visual_class);
5179 defsubr (&Sx_display_backing_store);
5180 defsubr (&Sx_display_save_under);
5181 #if 0
5182 defsubr (&Sx_rebind_key);
5183 defsubr (&Sx_rebind_keys);
5184 defsubr (&Sx_track_pointer);
5185 defsubr (&Sx_grab_pointer);
5186 defsubr (&Sx_ungrab_pointer);
5187 #endif
5188 defsubr (&Sx_parse_geometry);
5189 defsubr (&Sx_create_frame);
5190 defsubr (&Sfocus_frame);
5191 defsubr (&Sunfocus_frame);
5192 #if 0
5193 defsubr (&Sx_horizontal_line);
5194 #endif
5195 defsubr (&Sx_open_connection);
5196 defsubr (&Sx_close_connection);
5197 defsubr (&Sx_display_list);
5198 defsubr (&Sx_synchronize);
5201 #endif /* HAVE_X_WINDOWS */