(x_window): Don't add ibw to menubar_size.
[emacs.git] / src / xfns.c
blob524720f60a96a27e457774a46ee9f56f607151d8
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 0 /* Experimentally, we now get the right results
2613 for -geometry -0-0 without this. 24 Aug 96, rms. */
2614 if (FRAME_EXTERNAL_MENU_BAR (f))
2616 Dimension ibw = 0;
2617 XtVaGetValues (pane_widget, XtNinternalBorderWidth, &ibw, NULL);
2618 menubar_size += ibw;
2620 #endif
2622 f->output_data.x->menubar_height = menubar_size;
2624 /* Motif seems to need this amount added to the sizes
2625 specified for the shell widget. The Athena/Lucid widgets don't.
2626 Both conclusions reached experimentally. -- rms. */
2627 if (!strcmp (lwlib_toolkit_type, "motif"))
2628 XtVaGetValues (f->output_data.x->edit_widget, XtNinternalBorderWidth,
2629 &extra_borders, NULL);
2631 /* Convert our geometry parameters into a geometry string
2632 and specify it.
2633 Note that we do not specify here whether the position
2634 is a user-specified or program-specified one.
2635 We pass that information later, in x_wm_set_size_hints. */
2637 int left = f->output_data.x->left_pos;
2638 int xneg = window_prompting & XNegative;
2639 int top = f->output_data.x->top_pos;
2640 int yneg = window_prompting & YNegative;
2641 if (xneg)
2642 left = -left;
2643 if (yneg)
2644 top = -top;
2646 if (window_prompting & USPosition)
2647 sprintf (shell_position, "=%dx%d%c%d%c%d",
2648 PIXEL_WIDTH (f) + extra_borders,
2649 PIXEL_HEIGHT (f) + menubar_size + extra_borders,
2650 (xneg ? '-' : '+'), left,
2651 (yneg ? '-' : '+'), top);
2652 else
2653 sprintf (shell_position, "=%dx%d",
2654 PIXEL_WIDTH (f) + extra_borders,
2655 PIXEL_HEIGHT (f) + menubar_size + extra_borders);
2658 len = strlen (shell_position) + 1;
2659 tem = (char *) xmalloc (len);
2660 strncpy (tem, shell_position, len);
2661 XtSetArg (al[ac], XtNgeometry, tem); ac++;
2662 XtSetValues (shell_widget, al, ac);
2665 XtManageChild (pane_widget);
2666 XtRealizeWidget (shell_widget);
2668 FRAME_X_WINDOW (f) = XtWindow (frame_widget);
2670 validate_x_resource_name ();
2672 class_hints.res_name = (char *) XSTRING (Vx_resource_name)->data;
2673 class_hints.res_class = EMACS_CLASS;
2674 XSetClassHint (FRAME_X_DISPLAY (f), XtWindow (shell_widget), &class_hints);
2676 #ifdef HAVE_X_I18N
2677 #ifndef X_I18N_INHIBITED
2679 XIM xim;
2680 XIC xic = NULL;
2682 xim = XOpenIM (FRAME_X_DISPLAY (f), NULL, NULL, NULL);
2684 if (xim)
2686 xic = XCreateIC (xim,
2687 XNInputStyle, XIMPreeditNothing | XIMStatusNothing,
2688 XNClientWindow, FRAME_X_WINDOW(f),
2689 XNFocusWindow, FRAME_X_WINDOW(f),
2690 NULL);
2692 if (xic == 0)
2694 XCloseIM (xim);
2695 xim = NULL;
2698 FRAME_XIM (f) = xim;
2699 FRAME_XIC (f) = xic;
2701 #else /* X_I18N_INHIBITED */
2702 FRAME_XIM (f) = 0;
2703 FRAME_XIC (f) = 0;
2704 #endif /* X_I18N_INHIBITED */
2705 #endif /* HAVE_X_I18N */
2707 f->output_data.x->wm_hints.input = True;
2708 f->output_data.x->wm_hints.flags |= InputHint;
2709 XSetWMHints (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
2710 &f->output_data.x->wm_hints);
2712 hack_wm_protocols (f, shell_widget);
2714 #ifdef HACK_EDITRES
2715 XtAddEventHandler (shell_widget, 0, True, _XEditResCheckMessages, 0);
2716 #endif
2718 /* Do a stupid property change to force the server to generate a
2719 propertyNotify event so that the event_stream server timestamp will
2720 be initialized to something relevant to the time we created the window.
2722 XChangeProperty (XtDisplay (frame_widget), XtWindow (frame_widget),
2723 FRAME_X_DISPLAY_INFO (f)->Xatom_wm_protocols,
2724 XA_ATOM, 32, PropModeAppend,
2725 (unsigned char*) NULL, 0);
2727 /* Make all the standard events reach the Emacs frame. */
2728 attributes.event_mask = STANDARD_EVENT_SET;
2729 attribute_mask = CWEventMask;
2730 XChangeWindowAttributes (XtDisplay (shell_widget), XtWindow (shell_widget),
2731 attribute_mask, &attributes);
2733 XtMapWidget (frame_widget);
2735 /* x_set_name normally ignores requests to set the name if the
2736 requested name is the same as the current name. This is the one
2737 place where that assumption isn't correct; f->name is set, but
2738 the X server hasn't been told. */
2740 Lisp_Object name;
2741 int explicit = f->explicit_name;
2743 f->explicit_name = 0;
2744 name = f->name;
2745 f->name = Qnil;
2746 x_set_name (f, name, explicit);
2749 XDefineCursor (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
2750 f->output_data.x->text_cursor);
2752 UNBLOCK_INPUT;
2754 if (!minibuffer_only && FRAME_EXTERNAL_MENU_BAR (f))
2755 initialize_frame_menubar (f);
2756 lw_set_main_areas (pane_widget, f->output_data.x->menubar_widget, frame_widget);
2758 if (FRAME_X_WINDOW (f) == 0)
2759 error ("Unable to create window");
2762 #else /* not USE_X_TOOLKIT */
2764 /* Create and set up the X window for frame F. */
2766 x_window (f)
2767 struct frame *f;
2770 XClassHint class_hints;
2771 XSetWindowAttributes attributes;
2772 unsigned long attribute_mask;
2774 attributes.background_pixel = f->output_data.x->background_pixel;
2775 attributes.border_pixel = f->output_data.x->border_pixel;
2776 attributes.bit_gravity = StaticGravity;
2777 attributes.backing_store = NotUseful;
2778 attributes.save_under = True;
2779 attributes.event_mask = STANDARD_EVENT_SET;
2780 attribute_mask = (CWBackPixel | CWBorderPixel | CWBitGravity
2781 #if 0
2782 | CWBackingStore | CWSaveUnder
2783 #endif
2784 | CWEventMask);
2786 BLOCK_INPUT;
2787 FRAME_X_WINDOW (f)
2788 = XCreateWindow (FRAME_X_DISPLAY (f),
2789 f->output_data.x->parent_desc,
2790 f->output_data.x->left_pos,
2791 f->output_data.x->top_pos,
2792 PIXEL_WIDTH (f), PIXEL_HEIGHT (f),
2793 f->output_data.x->border_width,
2794 CopyFromParent, /* depth */
2795 InputOutput, /* class */
2796 FRAME_X_DISPLAY_INFO (f)->visual,
2797 attribute_mask, &attributes);
2798 #ifdef HAVE_X_I18N
2799 #ifndef X_I18N_INHIBITED
2801 XIM xim;
2802 XIC xic = NULL;
2804 xim = XOpenIM (FRAME_X_DISPLAY(f), NULL, NULL, NULL);
2806 if (xim)
2808 xic = XCreateIC (xim,
2809 XNInputStyle, XIMPreeditNothing | XIMStatusNothing,
2810 XNClientWindow, FRAME_X_WINDOW(f),
2811 XNFocusWindow, FRAME_X_WINDOW(f),
2812 NULL);
2814 if (!xic)
2816 XCloseIM (xim);
2817 xim = NULL;
2821 FRAME_XIM (f) = xim;
2822 FRAME_XIC (f) = xic;
2824 #else /* X_I18N_INHIBITED */
2825 FRAME_XIM (f) = 0;
2826 FRAME_XIC (f) = 0;
2827 #endif /* X_I18N_INHIBITED */
2828 #endif /* HAVE_X_I18N */
2830 validate_x_resource_name ();
2832 class_hints.res_name = (char *) XSTRING (Vx_resource_name)->data;
2833 class_hints.res_class = EMACS_CLASS;
2834 XSetClassHint (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f), &class_hints);
2836 /* The menubar is part of the ordinary display;
2837 it does not count in addition to the height of the window. */
2838 f->output_data.x->menubar_height = 0;
2840 /* This indicates that we use the "Passive Input" input model.
2841 Unless we do this, we don't get the Focus{In,Out} events that we
2842 need to draw the cursor correctly. Accursed bureaucrats.
2843 XWhipsAndChains (FRAME_X_DISPLAY (f), IronMaiden, &TheRack); */
2845 f->output_data.x->wm_hints.input = True;
2846 f->output_data.x->wm_hints.flags |= InputHint;
2847 XSetWMHints (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
2848 &f->output_data.x->wm_hints);
2849 f->output_data.x->wm_hints.icon_pixmap = None;
2851 /* Request "save yourself" and "delete window" commands from wm. */
2853 Atom protocols[2];
2854 protocols[0] = FRAME_X_DISPLAY_INFO (f)->Xatom_wm_delete_window;
2855 protocols[1] = FRAME_X_DISPLAY_INFO (f)->Xatom_wm_save_yourself;
2856 XSetWMProtocols (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f), protocols, 2);
2859 /* x_set_name normally ignores requests to set the name if the
2860 requested name is the same as the current name. This is the one
2861 place where that assumption isn't correct; f->name is set, but
2862 the X server hasn't been told. */
2864 Lisp_Object name;
2865 int explicit = f->explicit_name;
2867 f->explicit_name = 0;
2868 name = f->name;
2869 f->name = Qnil;
2870 x_set_name (f, name, explicit);
2873 XDefineCursor (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
2874 f->output_data.x->text_cursor);
2876 UNBLOCK_INPUT;
2878 if (FRAME_X_WINDOW (f) == 0)
2879 error ("Unable to create window");
2882 #endif /* not USE_X_TOOLKIT */
2884 /* Handle the icon stuff for this window. Perhaps later we might
2885 want an x_set_icon_position which can be called interactively as
2886 well. */
2888 static void
2889 x_icon (f, parms)
2890 struct frame *f;
2891 Lisp_Object parms;
2893 Lisp_Object icon_x, icon_y;
2895 /* Set the position of the icon. Note that twm groups all
2896 icons in an icon window. */
2897 icon_x = x_get_arg (parms, Qicon_left, 0, 0, number);
2898 icon_y = x_get_arg (parms, Qicon_top, 0, 0, number);
2899 if (!EQ (icon_x, Qunbound) && !EQ (icon_y, Qunbound))
2901 CHECK_NUMBER (icon_x, 0);
2902 CHECK_NUMBER (icon_y, 0);
2904 else if (!EQ (icon_x, Qunbound) || !EQ (icon_y, Qunbound))
2905 error ("Both left and top icon corners of icon must be specified");
2907 BLOCK_INPUT;
2909 if (! EQ (icon_x, Qunbound))
2910 x_wm_set_icon_position (f, XINT (icon_x), XINT (icon_y));
2912 /* Start up iconic or window? */
2913 x_wm_set_window_state
2914 (f, (EQ (x_get_arg (parms, Qvisibility, 0, 0, symbol), Qicon)
2915 ? IconicState
2916 : NormalState));
2918 x_text_icon (f, (char *) XSTRING ((!NILP (f->icon_name)
2919 ? f->icon_name
2920 : f->name))->data);
2922 UNBLOCK_INPUT;
2925 /* Make the GC's needed for this window, setting the
2926 background, border and mouse colors; also create the
2927 mouse cursor and the gray border tile. */
2929 static char cursor_bits[] =
2931 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
2932 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
2933 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
2934 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00
2937 static void
2938 x_make_gc (f)
2939 struct frame *f;
2941 XGCValues gc_values;
2942 GC temp_gc;
2943 XImage tileimage;
2945 BLOCK_INPUT;
2947 /* Create the GC's of this frame.
2948 Note that many default values are used. */
2950 /* Normal video */
2951 gc_values.font = f->output_data.x->font->fid;
2952 gc_values.foreground = f->output_data.x->foreground_pixel;
2953 gc_values.background = f->output_data.x->background_pixel;
2954 gc_values.line_width = 0; /* Means 1 using fast algorithm. */
2955 f->output_data.x->normal_gc = XCreateGC (FRAME_X_DISPLAY (f),
2956 FRAME_X_WINDOW (f),
2957 GCLineWidth | GCFont
2958 | GCForeground | GCBackground,
2959 &gc_values);
2961 /* Reverse video style. */
2962 gc_values.foreground = f->output_data.x->background_pixel;
2963 gc_values.background = f->output_data.x->foreground_pixel;
2964 f->output_data.x->reverse_gc = XCreateGC (FRAME_X_DISPLAY (f),
2965 FRAME_X_WINDOW (f),
2966 GCFont | GCForeground | GCBackground
2967 | GCLineWidth,
2968 &gc_values);
2970 /* Cursor has cursor-color background, background-color foreground. */
2971 gc_values.foreground = f->output_data.x->background_pixel;
2972 gc_values.background = f->output_data.x->cursor_pixel;
2973 gc_values.fill_style = FillOpaqueStippled;
2974 gc_values.stipple
2975 = XCreateBitmapFromData (FRAME_X_DISPLAY (f),
2976 FRAME_X_DISPLAY_INFO (f)->root_window,
2977 cursor_bits, 16, 16);
2978 f->output_data.x->cursor_gc
2979 = XCreateGC (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
2980 (GCFont | GCForeground | GCBackground
2981 | GCFillStyle | GCStipple | GCLineWidth),
2982 &gc_values);
2984 /* Create the gray border tile used when the pointer is not in
2985 the frame. Since this depends on the frame's pixel values,
2986 this must be done on a per-frame basis. */
2987 f->output_data.x->border_tile
2988 = (XCreatePixmapFromBitmapData
2989 (FRAME_X_DISPLAY (f), FRAME_X_DISPLAY_INFO (f)->root_window,
2990 gray_bits, gray_width, gray_height,
2991 f->output_data.x->foreground_pixel,
2992 f->output_data.x->background_pixel,
2993 DefaultDepth (FRAME_X_DISPLAY (f),
2994 XScreenNumberOfScreen (FRAME_X_SCREEN (f)))));
2996 UNBLOCK_INPUT;
2999 DEFUN ("x-create-frame", Fx_create_frame, Sx_create_frame,
3000 1, 1, 0,
3001 "Make a new X window, which is called a \"frame\" in Emacs terms.\n\
3002 Returns an Emacs frame object.\n\
3003 ALIST is an alist of frame parameters.\n\
3004 If the parameters specify that the frame should not have a minibuffer,\n\
3005 and do not specify a specific minibuffer window to use,\n\
3006 then `default-minibuffer-frame' must be a frame whose minibuffer can\n\
3007 be shared by the new frame.\n\
3009 This function is an internal primitive--use `make-frame' instead.")
3010 (parms)
3011 Lisp_Object parms;
3013 struct frame *f;
3014 Lisp_Object frame, tem;
3015 Lisp_Object name;
3016 int minibuffer_only = 0;
3017 long window_prompting = 0;
3018 int width, height;
3019 int count = specpdl_ptr - specpdl;
3020 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
3021 Lisp_Object display;
3022 struct x_display_info *dpyinfo;
3023 Lisp_Object parent;
3024 struct kboard *kb;
3026 check_x ();
3028 /* Use this general default value to start with
3029 until we know if this frame has a specified name. */
3030 Vx_resource_name = Vinvocation_name;
3032 display = x_get_arg (parms, Qdisplay, 0, 0, string);
3033 if (EQ (display, Qunbound))
3034 display = Qnil;
3035 dpyinfo = check_x_display_info (display);
3036 #ifdef MULTI_KBOARD
3037 kb = dpyinfo->kboard;
3038 #else
3039 kb = &the_only_kboard;
3040 #endif
3042 name = x_get_arg (parms, Qname, "name", "Name", string);
3043 if (!STRINGP (name)
3044 && ! EQ (name, Qunbound)
3045 && ! NILP (name))
3046 error ("Invalid frame name--not a string or nil");
3048 if (STRINGP (name))
3049 Vx_resource_name = name;
3051 /* See if parent window is specified. */
3052 parent = x_get_arg (parms, Qparent_id, NULL, NULL, number);
3053 if (EQ (parent, Qunbound))
3054 parent = Qnil;
3055 if (! NILP (parent))
3056 CHECK_NUMBER (parent, 0);
3058 /* make_frame_without_minibuffer can run Lisp code and garbage collect. */
3059 /* No need to protect DISPLAY because that's not used after passing
3060 it to make_frame_without_minibuffer. */
3061 frame = Qnil;
3062 GCPRO4 (parms, parent, name, frame);
3063 tem = x_get_arg (parms, Qminibuffer, 0, 0, symbol);
3064 if (EQ (tem, Qnone) || NILP (tem))
3065 f = make_frame_without_minibuffer (Qnil, kb, display);
3066 else if (EQ (tem, Qonly))
3068 f = make_minibuffer_frame ();
3069 minibuffer_only = 1;
3071 else if (WINDOWP (tem))
3072 f = make_frame_without_minibuffer (tem, kb, display);
3073 else
3074 f = make_frame (1);
3076 XSETFRAME (frame, f);
3078 /* Note that X Windows does support scroll bars. */
3079 FRAME_CAN_HAVE_SCROLL_BARS (f) = 1;
3081 f->output_method = output_x_window;
3082 f->output_data.x = (struct x_output *) xmalloc (sizeof (struct x_output));
3083 bzero (f->output_data.x, sizeof (struct x_output));
3084 f->output_data.x->icon_bitmap = -1;
3086 f->icon_name
3087 = x_get_arg (parms, Qicon_name, "iconName", "Title", string);
3088 if (! STRINGP (f->icon_name))
3089 f->icon_name = Qnil;
3091 FRAME_X_DISPLAY_INFO (f) = dpyinfo;
3092 #ifdef MULTI_KBOARD
3093 FRAME_KBOARD (f) = kb;
3094 #endif
3096 /* Specify the parent under which to make this X window. */
3098 if (!NILP (parent))
3100 f->output_data.x->parent_desc = parent;
3101 f->output_data.x->explicit_parent = 1;
3103 else
3105 f->output_data.x->parent_desc = FRAME_X_DISPLAY_INFO (f)->root_window;
3106 f->output_data.x->explicit_parent = 0;
3109 /* Note that the frame has no physical cursor right now. */
3110 f->phys_cursor_x = -1;
3112 /* Set the name; the functions to which we pass f expect the name to
3113 be set. */
3114 if (EQ (name, Qunbound) || NILP (name))
3116 f->name = build_string (dpyinfo->x_id_name);
3117 f->explicit_name = 0;
3119 else
3121 f->name = name;
3122 f->explicit_name = 1;
3123 /* use the frame's title when getting resources for this frame. */
3124 specbind (Qx_resource_name, name);
3127 /* Extract the window parameters from the supplied values
3128 that are needed to determine window geometry. */
3130 Lisp_Object font;
3132 font = x_get_arg (parms, Qfont, "font", "Font", string);
3133 BLOCK_INPUT;
3134 /* First, try whatever font the caller has specified. */
3135 if (STRINGP (font))
3136 font = x_new_font (f, XSTRING (font)->data);
3137 /* Try out a font which we hope has bold and italic variations. */
3138 if (!STRINGP (font))
3139 font = x_new_font (f, "-misc-fixed-medium-r-normal-*-*-140-*-*-c-*-iso8859-1");
3140 if (! STRINGP (font))
3141 font = x_new_font (f, "-*-*-medium-r-normal-*-*-140-*-*-c-*-iso8859-1");
3142 if (! STRINGP (font))
3143 /* This was formerly the first thing tried, but it finds too many fonts
3144 and takes too long. */
3145 font = x_new_font (f, "-*-*-medium-r-*-*-*-*-*-*-c-*-iso8859-1");
3146 /* If those didn't work, look for something which will at least work. */
3147 if (! STRINGP (font))
3148 font = x_new_font (f, "-*-fixed-*-*-*-*-*-140-*-*-c-*-iso8859-1");
3149 UNBLOCK_INPUT;
3150 if (! STRINGP (font))
3151 font = build_string ("fixed");
3153 x_default_parameter (f, parms, Qfont, font,
3154 "font", "Font", string);
3157 #ifdef USE_LUCID
3158 /* Prevent lwlib/xlwmenu.c from crashing because of a bug
3159 whereby it fails to get any font. */
3160 xlwmenu_default_font = f->output_data.x->font;
3161 #endif
3163 x_default_parameter (f, parms, Qborder_width, make_number (2),
3164 "borderwidth", "BorderWidth", number);
3165 /* This defaults to 2 in order to match xterm. We recognize either
3166 internalBorderWidth or internalBorder (which is what xterm calls
3167 it). */
3168 if (NILP (Fassq (Qinternal_border_width, parms)))
3170 Lisp_Object value;
3172 value = x_get_arg (parms, Qinternal_border_width,
3173 "internalBorder", "BorderWidth", number);
3174 if (! EQ (value, Qunbound))
3175 parms = Fcons (Fcons (Qinternal_border_width, value),
3176 parms);
3178 x_default_parameter (f, parms, Qinternal_border_width, make_number (2),
3179 "internalBorderWidth", "BorderWidth", number);
3180 x_default_parameter (f, parms, Qvertical_scroll_bars, Qt,
3181 "verticalScrollBars", "ScrollBars", boolean);
3183 /* Also do the stuff which must be set before the window exists. */
3184 x_default_parameter (f, parms, Qforeground_color, build_string ("black"),
3185 "foreground", "Foreground", string);
3186 x_default_parameter (f, parms, Qbackground_color, build_string ("white"),
3187 "background", "Background", string);
3188 x_default_parameter (f, parms, Qmouse_color, build_string ("black"),
3189 "pointerColor", "Foreground", string);
3190 x_default_parameter (f, parms, Qcursor_color, build_string ("black"),
3191 "cursorColor", "Foreground", string);
3192 x_default_parameter (f, parms, Qborder_color, build_string ("black"),
3193 "borderColor", "BorderColor", string);
3195 x_default_parameter (f, parms, Qmenu_bar_lines, make_number (1),
3196 "menuBar", "MenuBar", number);
3197 x_default_parameter (f, parms, Qscroll_bar_width, Qnil,
3198 "scrollBarWidth", "ScrollBarWidth", number);
3199 x_default_parameter (f, parms, Qbuffer_predicate, Qnil,
3200 "bufferPredicate", "BufferPredicate", symbol);
3201 x_default_parameter (f, parms, Qtitle, Qnil,
3202 "title", "Title", string);
3204 f->output_data.x->parent_desc = FRAME_X_DISPLAY_INFO (f)->root_window;
3205 window_prompting = x_figure_window_size (f, parms);
3207 if (window_prompting & XNegative)
3209 if (window_prompting & YNegative)
3210 f->output_data.x->win_gravity = SouthEastGravity;
3211 else
3212 f->output_data.x->win_gravity = NorthEastGravity;
3214 else
3216 if (window_prompting & YNegative)
3217 f->output_data.x->win_gravity = SouthWestGravity;
3218 else
3219 f->output_data.x->win_gravity = NorthWestGravity;
3222 f->output_data.x->size_hint_flags = window_prompting;
3224 #ifdef USE_X_TOOLKIT
3225 x_window (f, window_prompting, minibuffer_only);
3226 #else
3227 x_window (f);
3228 #endif
3229 x_icon (f, parms);
3230 x_make_gc (f);
3231 init_frame_faces (f);
3233 /* We need to do this after creating the X window, so that the
3234 icon-creation functions can say whose icon they're describing. */
3235 x_default_parameter (f, parms, Qicon_type, Qnil,
3236 "bitmapIcon", "BitmapIcon", symbol);
3238 x_default_parameter (f, parms, Qauto_raise, Qnil,
3239 "autoRaise", "AutoRaiseLower", boolean);
3240 x_default_parameter (f, parms, Qauto_lower, Qnil,
3241 "autoLower", "AutoRaiseLower", boolean);
3242 x_default_parameter (f, parms, Qcursor_type, Qbox,
3243 "cursorType", "CursorType", symbol);
3245 /* Dimensions, especially f->height, must be done via change_frame_size.
3246 Change will not be effected unless different from the current
3247 f->height. */
3248 width = f->width;
3249 height = f->height;
3250 f->height = f->width = 0;
3251 change_frame_size (f, height, width, 1, 0);
3253 /* Tell the server what size and position, etc, we want,
3254 and how badly we want them. */
3255 BLOCK_INPUT;
3256 x_wm_set_size_hint (f, window_prompting, 0);
3257 UNBLOCK_INPUT;
3259 tem = x_get_arg (parms, Qunsplittable, 0, 0, boolean);
3260 f->no_split = minibuffer_only || EQ (tem, Qt);
3262 UNGCPRO;
3264 /* It is now ok to make the frame official
3265 even if we get an error below.
3266 And the frame needs to be on Vframe_list
3267 or making it visible won't work. */
3268 Vframe_list = Fcons (frame, Vframe_list);
3270 /* Now that the frame is official, it counts as a reference to
3271 its display. */
3272 FRAME_X_DISPLAY_INFO (f)->reference_count++;
3274 /* Make the window appear on the frame and enable display,
3275 unless the caller says not to. However, with explicit parent,
3276 Emacs cannot control visibility, so don't try. */
3277 if (! f->output_data.x->explicit_parent)
3279 Lisp_Object visibility;
3281 visibility = x_get_arg (parms, Qvisibility, 0, 0, symbol);
3282 if (EQ (visibility, Qunbound))
3283 visibility = Qt;
3285 if (EQ (visibility, Qicon))
3286 x_iconify_frame (f);
3287 else if (! NILP (visibility))
3288 x_make_frame_visible (f);
3289 else
3290 /* Must have been Qnil. */
3294 return unbind_to (count, frame);
3297 /* FRAME is used only to get a handle on the X display. We don't pass the
3298 display info directly because we're called from frame.c, which doesn't
3299 know about that structure. */
3300 Lisp_Object
3301 x_get_focus_frame (frame)
3302 struct frame *frame;
3304 struct x_display_info *dpyinfo = FRAME_X_DISPLAY_INFO (frame);
3305 Lisp_Object xfocus;
3306 if (! dpyinfo->x_focus_frame)
3307 return Qnil;
3309 XSETFRAME (xfocus, dpyinfo->x_focus_frame);
3310 return xfocus;
3313 DEFUN ("focus-frame", Ffocus_frame, Sfocus_frame, 1, 1, 0,
3314 "This function is obsolete, and does nothing.")
3315 (frame)
3316 Lisp_Object frame;
3318 return Qnil;
3321 DEFUN ("unfocus-frame", Funfocus_frame, Sunfocus_frame, 0, 0, 0,
3322 "This function is obsolete, and does nothing.")
3325 return Qnil;
3328 DEFUN ("x-list-fonts", Fx_list_fonts, Sx_list_fonts, 1, 3, 0,
3329 "Return a list of the names of available fonts matching PATTERN.\n\
3330 If optional arguments FACE and FRAME are specified, return only fonts\n\
3331 the same size as FACE on FRAME.\n\
3333 PATTERN is a string, perhaps with wildcard characters;\n\
3334 the * character matches any substring, and\n\
3335 the ? character matches any single character.\n\
3336 PATTERN is case-insensitive.\n\
3337 FACE is a face name--a symbol.\n\
3339 The return value is a list of strings, suitable as arguments to\n\
3340 set-face-font.\n\
3342 Fonts Emacs can't use (i.e. proportional fonts) may or may not be excluded\n\
3343 even if they match PATTERN and FACE.")
3344 (pattern, face, frame)
3345 Lisp_Object pattern, face, frame;
3347 int num_fonts;
3348 char **names;
3349 #ifndef BROKEN_XLISTFONTSWITHINFO
3350 XFontStruct *info;
3351 #endif
3352 XFontStruct *size_ref;
3353 Lisp_Object list;
3354 FRAME_PTR f;
3356 check_x ();
3357 CHECK_STRING (pattern, 0);
3358 if (!NILP (face))
3359 CHECK_SYMBOL (face, 1);
3361 f = check_x_frame (frame);
3363 /* Determine the width standard for comparison with the fonts we find. */
3365 if (NILP (face))
3366 size_ref = 0;
3367 else
3369 int face_id;
3371 /* Don't die if we get called with a terminal frame. */
3372 if (! FRAME_X_P (f))
3373 error ("Non-X frame used in `x-list-fonts'");
3375 face_id = face_name_id_number (f, face);
3377 if (face_id < 0 || face_id >= FRAME_N_PARAM_FACES (f)
3378 || FRAME_PARAM_FACES (f) [face_id] == 0)
3379 size_ref = f->output_data.x->font;
3380 else
3382 size_ref = FRAME_PARAM_FACES (f) [face_id]->font;
3383 if (size_ref == (XFontStruct *) (~0))
3384 size_ref = f->output_data.x->font;
3388 /* See if we cached the result for this particular query. */
3389 list = Fassoc (pattern,
3390 XCONS (FRAME_X_DISPLAY_INFO (f)->name_list_element)->cdr);
3392 /* We have info in the cache for this PATTERN. */
3393 if (!NILP (list))
3395 Lisp_Object tem, newlist;
3397 /* We have info about this pattern. */
3398 list = XCONS (list)->cdr;
3400 if (size_ref == 0)
3401 return list;
3403 BLOCK_INPUT;
3405 /* Filter the cached info and return just the fonts that match FACE. */
3406 newlist = Qnil;
3407 for (tem = list; CONSP (tem); tem = XCONS (tem)->cdr)
3409 XFontStruct *thisinfo;
3411 x_catch_errors (FRAME_X_DISPLAY (f));
3413 thisinfo = XLoadQueryFont (FRAME_X_DISPLAY (f),
3414 XSTRING (XCONS (tem)->car)->data);
3416 x_check_errors (FRAME_X_DISPLAY (f), "XLoadQueryFont failure: %s");
3417 x_uncatch_errors (FRAME_X_DISPLAY (f));
3419 if (thisinfo && same_size_fonts (thisinfo, size_ref))
3420 newlist = Fcons (XCONS (tem)->car, newlist);
3422 if (thisinfo != 0)
3423 XFreeFont (FRAME_X_DISPLAY (f), thisinfo);
3426 UNBLOCK_INPUT;
3428 return newlist;
3431 BLOCK_INPUT;
3433 x_catch_errors (FRAME_X_DISPLAY (f));
3435 /* Solaris 2.3 has a bug in XListFontsWithInfo. */
3436 #ifndef BROKEN_XLISTFONTSWITHINFO
3437 if (size_ref)
3438 names = XListFontsWithInfo (FRAME_X_DISPLAY (f),
3439 XSTRING (pattern)->data,
3440 2000, /* maxnames */
3441 &num_fonts, /* count_return */
3442 &info); /* info_return */
3443 else
3444 #endif
3445 names = XListFonts (FRAME_X_DISPLAY (f),
3446 XSTRING (pattern)->data,
3447 2000, /* maxnames */
3448 &num_fonts); /* count_return */
3450 x_check_errors (FRAME_X_DISPLAY (f), "XListFonts failure: %s");
3451 x_uncatch_errors (FRAME_X_DISPLAY (f));
3453 UNBLOCK_INPUT;
3455 list = Qnil;
3457 if (names)
3459 int i;
3460 Lisp_Object full_list;
3462 /* Make a list of all the fonts we got back.
3463 Store that in the font cache for the display. */
3464 full_list = Qnil;
3465 for (i = 0; i < num_fonts; i++)
3466 full_list = Fcons (build_string (names[i]), full_list);
3467 XCONS (FRAME_X_DISPLAY_INFO (f)->name_list_element)->cdr
3468 = Fcons (Fcons (pattern, full_list),
3469 XCONS (FRAME_X_DISPLAY_INFO (f)->name_list_element)->cdr);
3471 /* Make a list of the fonts that have the right width. */
3472 list = Qnil;
3473 for (i = 0; i < num_fonts; i++)
3475 int keeper;
3477 if (!size_ref)
3478 keeper = 1;
3479 else
3481 #ifdef BROKEN_XLISTFONTSWITHINFO
3482 XFontStruct *thisinfo;
3484 BLOCK_INPUT;
3486 x_catch_errors (FRAME_X_DISPLAY (f));
3487 thisinfo = XLoadQueryFont (FRAME_X_DISPLAY (f), names[i]);
3488 x_check_errors (FRAME_X_DISPLAY (f),
3489 "XLoadQueryFont failure: %s");
3490 x_uncatch_errors (FRAME_X_DISPLAY (f));
3492 UNBLOCK_INPUT;
3494 keeper = thisinfo && same_size_fonts (thisinfo, size_ref);
3495 BLOCK_INPUT;
3496 if (thisinfo && ! keeper)
3497 XFreeFont (FRAME_X_DISPLAY (f), thisinfo);
3498 else if (thisinfo)
3499 XFreeFontInfo (NULL, thisinfo, 1);
3500 UNBLOCK_INPUT;
3501 #else
3502 keeper = same_size_fonts (&info[i], size_ref);
3503 #endif
3505 if (keeper)
3506 list = Fcons (build_string (names[i]), list);
3508 list = Fnreverse (list);
3510 BLOCK_INPUT;
3511 #ifndef BROKEN_XLISTFONTSWITHINFO
3512 if (size_ref)
3513 XFreeFontInfo (names, info, num_fonts);
3514 else
3515 #endif
3516 XFreeFontNames (names);
3517 UNBLOCK_INPUT;
3520 return list;
3524 DEFUN ("x-color-defined-p", Fx_color_defined_p, Sx_color_defined_p, 1, 2, 0,
3525 "Return non-nil if color COLOR is supported on frame FRAME.\n\
3526 If FRAME is omitted or nil, use the selected frame.")
3527 (color, frame)
3528 Lisp_Object color, frame;
3530 XColor foo;
3531 FRAME_PTR f = check_x_frame (frame);
3533 CHECK_STRING (color, 1);
3535 if (defined_color (f, XSTRING (color)->data, &foo, 0))
3536 return Qt;
3537 else
3538 return Qnil;
3541 DEFUN ("x-color-values", Fx_color_values, Sx_color_values, 1, 2, 0,
3542 "Return a description of the color named COLOR on frame FRAME.\n\
3543 The value is a list of integer RGB values--(RED GREEN BLUE).\n\
3544 These values appear to range from 0 to 65280 or 65535, depending\n\
3545 on the system; white is (65280 65280 65280) or (65535 65535 65535).\n\
3546 If FRAME is omitted or nil, use the selected frame.")
3547 (color, frame)
3548 Lisp_Object color, frame;
3550 XColor foo;
3551 FRAME_PTR f = check_x_frame (frame);
3553 CHECK_STRING (color, 1);
3555 if (defined_color (f, XSTRING (color)->data, &foo, 0))
3557 Lisp_Object rgb[3];
3559 rgb[0] = make_number (foo.red);
3560 rgb[1] = make_number (foo.green);
3561 rgb[2] = make_number (foo.blue);
3562 return Flist (3, rgb);
3564 else
3565 return Qnil;
3568 DEFUN ("x-display-color-p", Fx_display_color_p, Sx_display_color_p, 0, 1, 0,
3569 "Return t if the X display supports color.\n\
3570 The optional argument DISPLAY specifies which display to ask about.\n\
3571 DISPLAY should be either a frame or a display name (a string).\n\
3572 If omitted or nil, that stands for the selected frame's display.")
3573 (display)
3574 Lisp_Object display;
3576 struct x_display_info *dpyinfo = check_x_display_info (display);
3578 if (dpyinfo->n_planes <= 2)
3579 return Qnil;
3581 switch (dpyinfo->visual->class)
3583 case StaticColor:
3584 case PseudoColor:
3585 case TrueColor:
3586 case DirectColor:
3587 return Qt;
3589 default:
3590 return Qnil;
3594 DEFUN ("x-display-grayscale-p", Fx_display_grayscale_p, Sx_display_grayscale_p,
3595 0, 1, 0,
3596 "Return t if the X display supports shades of gray.\n\
3597 Note that color displays do support shades of gray.\n\
3598 The optional argument DISPLAY specifies which display to ask about.\n\
3599 DISPLAY should be either a frame or a display name (a string).\n\
3600 If omitted or nil, that stands for the selected frame's display.")
3601 (display)
3602 Lisp_Object display;
3604 struct x_display_info *dpyinfo = check_x_display_info (display);
3606 if (dpyinfo->n_planes <= 1)
3607 return Qnil;
3609 switch (dpyinfo->visual->class)
3611 case StaticColor:
3612 case PseudoColor:
3613 case TrueColor:
3614 case DirectColor:
3615 case StaticGray:
3616 case GrayScale:
3617 return Qt;
3619 default:
3620 return Qnil;
3624 DEFUN ("x-display-pixel-width", Fx_display_pixel_width, Sx_display_pixel_width,
3625 0, 1, 0,
3626 "Returns the width in pixels of the X display DISPLAY.\n\
3627 The optional argument DISPLAY specifies which display to ask about.\n\
3628 DISPLAY should be either a frame or a display name (a string).\n\
3629 If omitted or nil, that stands for the selected frame's display.")
3630 (display)
3631 Lisp_Object display;
3633 struct x_display_info *dpyinfo = check_x_display_info (display);
3635 return make_number (dpyinfo->width);
3638 DEFUN ("x-display-pixel-height", Fx_display_pixel_height,
3639 Sx_display_pixel_height, 0, 1, 0,
3640 "Returns the height in pixels of the X display DISPLAY.\n\
3641 The optional argument DISPLAY specifies which display to ask about.\n\
3642 DISPLAY should be either a frame or a display name (a string).\n\
3643 If omitted or nil, that stands for the selected frame's display.")
3644 (display)
3645 Lisp_Object display;
3647 struct x_display_info *dpyinfo = check_x_display_info (display);
3649 return make_number (dpyinfo->height);
3652 DEFUN ("x-display-planes", Fx_display_planes, Sx_display_planes,
3653 0, 1, 0,
3654 "Returns the number of bitplanes of the X display DISPLAY.\n\
3655 The optional argument DISPLAY specifies which display to ask about.\n\
3656 DISPLAY should be either a frame or a display name (a string).\n\
3657 If omitted or nil, that stands for the selected frame's display.")
3658 (display)
3659 Lisp_Object display;
3661 struct x_display_info *dpyinfo = check_x_display_info (display);
3663 return make_number (dpyinfo->n_planes);
3666 DEFUN ("x-display-color-cells", Fx_display_color_cells, Sx_display_color_cells,
3667 0, 1, 0,
3668 "Returns the number of color cells of the X display DISPLAY.\n\
3669 The optional argument DISPLAY specifies which display to ask about.\n\
3670 DISPLAY should be either a frame or a display name (a string).\n\
3671 If omitted or nil, that stands for the selected frame's display.")
3672 (display)
3673 Lisp_Object display;
3675 struct x_display_info *dpyinfo = check_x_display_info (display);
3677 return make_number (DisplayCells (dpyinfo->display,
3678 XScreenNumberOfScreen (dpyinfo->screen)));
3681 DEFUN ("x-server-max-request-size", Fx_server_max_request_size,
3682 Sx_server_max_request_size,
3683 0, 1, 0,
3684 "Returns the maximum request size of the X server of display DISPLAY.\n\
3685 The optional argument DISPLAY specifies which display to ask about.\n\
3686 DISPLAY should be either a frame or a display name (a string).\n\
3687 If omitted or nil, that stands for the selected frame's display.")
3688 (display)
3689 Lisp_Object display;
3691 struct x_display_info *dpyinfo = check_x_display_info (display);
3693 return make_number (MAXREQUEST (dpyinfo->display));
3696 DEFUN ("x-server-vendor", Fx_server_vendor, Sx_server_vendor, 0, 1, 0,
3697 "Returns the vendor ID string of the X server of display DISPLAY.\n\
3698 The optional argument DISPLAY specifies which display to ask about.\n\
3699 DISPLAY should be either a frame or a display name (a string).\n\
3700 If omitted or nil, that stands for the selected frame's display.")
3701 (display)
3702 Lisp_Object display;
3704 struct x_display_info *dpyinfo = check_x_display_info (display);
3705 char *vendor = ServerVendor (dpyinfo->display);
3707 if (! vendor) vendor = "";
3708 return build_string (vendor);
3711 DEFUN ("x-server-version", Fx_server_version, Sx_server_version, 0, 1, 0,
3712 "Returns the version numbers of the X server of display DISPLAY.\n\
3713 The value is a list of three integers: the major and minor\n\
3714 version numbers of the X Protocol in use, and the vendor-specific release\n\
3715 number. See also the function `x-server-vendor'.\n\n\
3716 The optional argument DISPLAY specifies which display to ask about.\n\
3717 DISPLAY should be either a frame or a display name (a string).\n\
3718 If omitted or nil, that stands for the selected frame's display.")
3719 (display)
3720 Lisp_Object display;
3722 struct x_display_info *dpyinfo = check_x_display_info (display);
3723 Display *dpy = dpyinfo->display;
3725 return Fcons (make_number (ProtocolVersion (dpy)),
3726 Fcons (make_number (ProtocolRevision (dpy)),
3727 Fcons (make_number (VendorRelease (dpy)), Qnil)));
3730 DEFUN ("x-display-screens", Fx_display_screens, Sx_display_screens, 0, 1, 0,
3731 "Returns the number of screens on the X server of display DISPLAY.\n\
3732 The optional argument DISPLAY specifies which display to ask about.\n\
3733 DISPLAY should be either a frame or a display name (a string).\n\
3734 If omitted or nil, that stands for the selected frame's display.")
3735 (display)
3736 Lisp_Object display;
3738 struct x_display_info *dpyinfo = check_x_display_info (display);
3740 return make_number (ScreenCount (dpyinfo->display));
3743 DEFUN ("x-display-mm-height", Fx_display_mm_height, Sx_display_mm_height, 0, 1, 0,
3744 "Returns the height in millimeters of the X display DISPLAY.\n\
3745 The optional argument DISPLAY specifies which display to ask about.\n\
3746 DISPLAY should be either a frame or a display name (a string).\n\
3747 If omitted or nil, that stands for the selected frame's display.")
3748 (display)
3749 Lisp_Object display;
3751 struct x_display_info *dpyinfo = check_x_display_info (display);
3753 return make_number (HeightMMOfScreen (dpyinfo->screen));
3756 DEFUN ("x-display-mm-width", Fx_display_mm_width, Sx_display_mm_width, 0, 1, 0,
3757 "Returns the width in millimeters of the X display DISPLAY.\n\
3758 The optional argument DISPLAY specifies which display to ask about.\n\
3759 DISPLAY should be either a frame or a display name (a string).\n\
3760 If omitted or nil, that stands for the selected frame's display.")
3761 (display)
3762 Lisp_Object display;
3764 struct x_display_info *dpyinfo = check_x_display_info (display);
3766 return make_number (WidthMMOfScreen (dpyinfo->screen));
3769 DEFUN ("x-display-backing-store", Fx_display_backing_store,
3770 Sx_display_backing_store, 0, 1, 0,
3771 "Returns an indication of whether X display DISPLAY does backing store.\n\
3772 The value may be `always', `when-mapped', or `not-useful'.\n\
3773 The optional argument DISPLAY specifies which display to ask about.\n\
3774 DISPLAY should be either a frame or a display name (a string).\n\
3775 If omitted or nil, that stands for the selected frame's display.")
3776 (display)
3777 Lisp_Object display;
3779 struct x_display_info *dpyinfo = check_x_display_info (display);
3781 switch (DoesBackingStore (dpyinfo->screen))
3783 case Always:
3784 return intern ("always");
3786 case WhenMapped:
3787 return intern ("when-mapped");
3789 case NotUseful:
3790 return intern ("not-useful");
3792 default:
3793 error ("Strange value for BackingStore parameter of screen");
3797 DEFUN ("x-display-visual-class", Fx_display_visual_class,
3798 Sx_display_visual_class, 0, 1, 0,
3799 "Returns the visual class of the X display DISPLAY.\n\
3800 The value is one of the symbols `static-gray', `gray-scale',\n\
3801 `static-color', `pseudo-color', `true-color', or `direct-color'.\n\n\
3802 The optional argument DISPLAY specifies which display to ask about.\n\
3803 DISPLAY should be either a frame or a display name (a string).\n\
3804 If omitted or nil, that stands for the selected frame's display.")
3805 (display)
3806 Lisp_Object display;
3808 struct x_display_info *dpyinfo = check_x_display_info (display);
3810 switch (dpyinfo->visual->class)
3812 case StaticGray: return (intern ("static-gray"));
3813 case GrayScale: return (intern ("gray-scale"));
3814 case StaticColor: return (intern ("static-color"));
3815 case PseudoColor: return (intern ("pseudo-color"));
3816 case TrueColor: return (intern ("true-color"));
3817 case DirectColor: return (intern ("direct-color"));
3818 default:
3819 error ("Display has an unknown visual class");
3823 DEFUN ("x-display-save-under", Fx_display_save_under,
3824 Sx_display_save_under, 0, 1, 0,
3825 "Returns t if the X display DISPLAY supports the save-under feature.\n\
3826 The optional argument DISPLAY specifies which display to ask about.\n\
3827 DISPLAY should be either a frame or a display name (a string).\n\
3828 If omitted or nil, that stands for the selected frame's display.")
3829 (display)
3830 Lisp_Object display;
3832 struct x_display_info *dpyinfo = check_x_display_info (display);
3834 if (DoesSaveUnders (dpyinfo->screen) == True)
3835 return Qt;
3836 else
3837 return Qnil;
3841 x_pixel_width (f)
3842 register struct frame *f;
3844 return PIXEL_WIDTH (f);
3848 x_pixel_height (f)
3849 register struct frame *f;
3851 return PIXEL_HEIGHT (f);
3855 x_char_width (f)
3856 register struct frame *f;
3858 return FONT_WIDTH (f->output_data.x->font);
3862 x_char_height (f)
3863 register struct frame *f;
3865 return f->output_data.x->line_height;
3869 x_screen_planes (frame)
3870 Lisp_Object frame;
3872 return FRAME_X_DISPLAY_INFO (XFRAME (frame))->n_planes;
3875 #if 0 /* These no longer seem like the right way to do things. */
3877 /* Draw a rectangle on the frame with left top corner including
3878 the character specified by LEFT_CHAR and TOP_CHAR. The rectangle is
3879 CHARS by LINES wide and long and is the color of the cursor. */
3881 void
3882 x_rectangle (f, gc, left_char, top_char, chars, lines)
3883 register struct frame *f;
3884 GC gc;
3885 register int top_char, left_char, chars, lines;
3887 int width;
3888 int height;
3889 int left = (left_char * FONT_WIDTH (f->output_data.x->font)
3890 + f->output_data.x->internal_border_width);
3891 int top = (top_char * f->output_data.x->line_height
3892 + f->output_data.x->internal_border_width);
3894 if (chars < 0)
3895 width = FONT_WIDTH (f->output_data.x->font) / 2;
3896 else
3897 width = FONT_WIDTH (f->output_data.x->font) * chars;
3898 if (lines < 0)
3899 height = f->output_data.x->line_height / 2;
3900 else
3901 height = f->output_data.x->line_height * lines;
3903 XDrawRectangle (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
3904 gc, left, top, width, height);
3907 DEFUN ("x-draw-rectangle", Fx_draw_rectangle, Sx_draw_rectangle, 5, 5, 0,
3908 "Draw a rectangle on FRAME between coordinates specified by\n\
3909 numbers X0, Y0, X1, Y1 in the cursor pixel.")
3910 (frame, X0, Y0, X1, Y1)
3911 register Lisp_Object frame, X0, X1, Y0, Y1;
3913 register int x0, y0, x1, y1, top, left, n_chars, n_lines;
3915 CHECK_LIVE_FRAME (frame, 0);
3916 CHECK_NUMBER (X0, 0);
3917 CHECK_NUMBER (Y0, 1);
3918 CHECK_NUMBER (X1, 2);
3919 CHECK_NUMBER (Y1, 3);
3921 x0 = XINT (X0);
3922 x1 = XINT (X1);
3923 y0 = XINT (Y0);
3924 y1 = XINT (Y1);
3926 if (y1 > y0)
3928 top = y0;
3929 n_lines = y1 - y0 + 1;
3931 else
3933 top = y1;
3934 n_lines = y0 - y1 + 1;
3937 if (x1 > x0)
3939 left = x0;
3940 n_chars = x1 - x0 + 1;
3942 else
3944 left = x1;
3945 n_chars = x0 - x1 + 1;
3948 BLOCK_INPUT;
3949 x_rectangle (XFRAME (frame), XFRAME (frame)->output_data.x->cursor_gc,
3950 left, top, n_chars, n_lines);
3951 UNBLOCK_INPUT;
3953 return Qt;
3956 DEFUN ("x-erase-rectangle", Fx_erase_rectangle, Sx_erase_rectangle, 5, 5, 0,
3957 "Draw a rectangle drawn on FRAME between coordinates\n\
3958 X0, Y0, X1, Y1 in the regular background-pixel.")
3959 (frame, X0, Y0, X1, Y1)
3960 register Lisp_Object frame, X0, Y0, X1, Y1;
3962 register int x0, y0, x1, y1, top, left, n_chars, n_lines;
3964 CHECK_LIVE_FRAME (frame, 0);
3965 CHECK_NUMBER (X0, 0);
3966 CHECK_NUMBER (Y0, 1);
3967 CHECK_NUMBER (X1, 2);
3968 CHECK_NUMBER (Y1, 3);
3970 x0 = XINT (X0);
3971 x1 = XINT (X1);
3972 y0 = XINT (Y0);
3973 y1 = XINT (Y1);
3975 if (y1 > y0)
3977 top = y0;
3978 n_lines = y1 - y0 + 1;
3980 else
3982 top = y1;
3983 n_lines = y0 - y1 + 1;
3986 if (x1 > x0)
3988 left = x0;
3989 n_chars = x1 - x0 + 1;
3991 else
3993 left = x1;
3994 n_chars = x0 - x1 + 1;
3997 BLOCK_INPUT;
3998 x_rectangle (XFRAME (frame), XFRAME (frame)->output_data.x->reverse_gc,
3999 left, top, n_chars, n_lines);
4000 UNBLOCK_INPUT;
4002 return Qt;
4005 /* Draw lines around the text region beginning at the character position
4006 TOP_X, TOP_Y and ending at BOTTOM_X and BOTTOM_Y. GC specifies the
4007 pixel and line characteristics. */
4009 #define line_len(line) (FRAME_CURRENT_GLYPHS (f)->used[(line)])
4011 static void
4012 outline_region (f, gc, top_x, top_y, bottom_x, bottom_y)
4013 register struct frame *f;
4014 GC gc;
4015 int top_x, top_y, bottom_x, bottom_y;
4017 register int ibw = f->output_data.x->internal_border_width;
4018 register int font_w = FONT_WIDTH (f->output_data.x->font);
4019 register int font_h = f->output_data.x->line_height;
4020 int y = top_y;
4021 int x = line_len (y);
4022 XPoint *pixel_points
4023 = (XPoint *) alloca (((bottom_y - top_y + 2) * 4) * sizeof (XPoint));
4024 register XPoint *this_point = pixel_points;
4026 /* Do the horizontal top line/lines */
4027 if (top_x == 0)
4029 this_point->x = ibw;
4030 this_point->y = ibw + (font_h * top_y);
4031 this_point++;
4032 if (x == 0)
4033 this_point->x = ibw + (font_w / 2); /* Half-size for newline chars. */
4034 else
4035 this_point->x = ibw + (font_w * x);
4036 this_point->y = (this_point - 1)->y;
4038 else
4040 this_point->x = ibw;
4041 this_point->y = ibw + (font_h * (top_y + 1));
4042 this_point++;
4043 this_point->x = ibw + (font_w * top_x);
4044 this_point->y = (this_point - 1)->y;
4045 this_point++;
4046 this_point->x = (this_point - 1)->x;
4047 this_point->y = ibw + (font_h * top_y);
4048 this_point++;
4049 this_point->x = ibw + (font_w * x);
4050 this_point->y = (this_point - 1)->y;
4053 /* Now do the right side. */
4054 while (y < bottom_y)
4055 { /* Right vertical edge */
4056 this_point++;
4057 this_point->x = (this_point - 1)->x;
4058 this_point->y = ibw + (font_h * (y + 1));
4059 this_point++;
4061 y++; /* Horizontal connection to next line */
4062 x = line_len (y);
4063 if (x == 0)
4064 this_point->x = ibw + (font_w / 2);
4065 else
4066 this_point->x = ibw + (font_w * x);
4068 this_point->y = (this_point - 1)->y;
4071 /* Now do the bottom and connect to the top left point. */
4072 this_point->x = ibw + (font_w * (bottom_x + 1));
4074 this_point++;
4075 this_point->x = (this_point - 1)->x;
4076 this_point->y = ibw + (font_h * (bottom_y + 1));
4077 this_point++;
4078 this_point->x = ibw;
4079 this_point->y = (this_point - 1)->y;
4080 this_point++;
4081 this_point->x = pixel_points->x;
4082 this_point->y = pixel_points->y;
4084 XDrawLines (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
4085 gc, pixel_points,
4086 (this_point - pixel_points + 1), CoordModeOrigin);
4089 DEFUN ("x-contour-region", Fx_contour_region, Sx_contour_region, 1, 1, 0,
4090 "Highlight the region between point and the character under the mouse\n\
4091 selected frame.")
4092 (event)
4093 register Lisp_Object event;
4095 register int x0, y0, x1, y1;
4096 register struct frame *f = selected_frame;
4097 register int p1, p2;
4099 CHECK_CONS (event, 0);
4101 BLOCK_INPUT;
4102 x0 = XINT (Fcar (Fcar (event)));
4103 y0 = XINT (Fcar (Fcdr (Fcar (event))));
4105 /* If the mouse is past the end of the line, don't that area. */
4106 /* ReWrite this... */
4108 x1 = f->cursor_x;
4109 y1 = f->cursor_y;
4111 if (y1 > y0) /* point below mouse */
4112 outline_region (f, f->output_data.x->cursor_gc,
4113 x0, y0, x1, y1);
4114 else if (y1 < y0) /* point above mouse */
4115 outline_region (f, f->output_data.x->cursor_gc,
4116 x1, y1, x0, y0);
4117 else /* same line: draw horizontal rectangle */
4119 if (x1 > x0)
4120 x_rectangle (f, f->output_data.x->cursor_gc,
4121 x0, y0, (x1 - x0 + 1), 1);
4122 else if (x1 < x0)
4123 x_rectangle (f, f->output_data.x->cursor_gc,
4124 x1, y1, (x0 - x1 + 1), 1);
4127 XFlush (FRAME_X_DISPLAY (f));
4128 UNBLOCK_INPUT;
4130 return Qnil;
4133 DEFUN ("x-uncontour-region", Fx_uncontour_region, Sx_uncontour_region, 1, 1, 0,
4134 "Erase any highlighting of the region between point and the character\n\
4135 at X, Y on the selected frame.")
4136 (event)
4137 register Lisp_Object event;
4139 register int x0, y0, x1, y1;
4140 register struct frame *f = selected_frame;
4142 BLOCK_INPUT;
4143 x0 = XINT (Fcar (Fcar (event)));
4144 y0 = XINT (Fcar (Fcdr (Fcar (event))));
4145 x1 = f->cursor_x;
4146 y1 = f->cursor_y;
4148 if (y1 > y0) /* point below mouse */
4149 outline_region (f, f->output_data.x->reverse_gc,
4150 x0, y0, x1, y1);
4151 else if (y1 < y0) /* point above mouse */
4152 outline_region (f, f->output_data.x->reverse_gc,
4153 x1, y1, x0, y0);
4154 else /* same line: draw horizontal rectangle */
4156 if (x1 > x0)
4157 x_rectangle (f, f->output_data.x->reverse_gc,
4158 x0, y0, (x1 - x0 + 1), 1);
4159 else if (x1 < x0)
4160 x_rectangle (f, f->output_data.x->reverse_gc,
4161 x1, y1, (x0 - x1 + 1), 1);
4163 UNBLOCK_INPUT;
4165 return Qnil;
4168 #if 0
4169 int contour_begin_x, contour_begin_y;
4170 int contour_end_x, contour_end_y;
4171 int contour_npoints;
4173 /* Clip the top part of the contour lines down (and including) line Y_POS.
4174 If X_POS is in the middle (rather than at the end) of the line, drop
4175 down a line at that character. */
4177 static void
4178 clip_contour_top (y_pos, x_pos)
4180 register XPoint *begin = contour_lines[y_pos].top_left;
4181 register XPoint *end;
4182 register int npoints;
4183 register struct display_line *line = selected_frame->phys_lines[y_pos + 1];
4185 if (x_pos >= line->len - 1) /* Draw one, straight horizontal line. */
4187 end = contour_lines[y_pos].top_right;
4188 npoints = (end - begin + 1);
4189 XDrawLines (x_current_display, contour_window,
4190 contour_erase_gc, begin_erase, npoints, CoordModeOrigin);
4192 bcopy (end, begin + 1, contour_last_point - end + 1);
4193 contour_last_point -= (npoints - 2);
4194 XDrawLines (x_current_display, contour_window,
4195 contour_erase_gc, begin, 2, CoordModeOrigin);
4196 XFlush (x_current_display);
4198 /* Now, update contour_lines structure. */
4200 /* ______. */
4201 else /* |________*/
4203 register XPoint *p = begin + 1;
4204 end = contour_lines[y_pos].bottom_right;
4205 npoints = (end - begin + 1);
4206 XDrawLines (x_current_display, contour_window,
4207 contour_erase_gc, begin_erase, npoints, CoordModeOrigin);
4209 p->y = begin->y;
4210 p->x = ibw + (font_w * (x_pos + 1));
4211 p++;
4212 p->y = begin->y + font_h;
4213 p->x = (p - 1)->x;
4214 bcopy (end, begin + 3, contour_last_point - end + 1);
4215 contour_last_point -= (npoints - 5);
4216 XDrawLines (x_current_display, contour_window,
4217 contour_erase_gc, begin, 4, CoordModeOrigin);
4218 XFlush (x_current_display);
4220 /* Now, update contour_lines structure. */
4224 /* Erase the top horizontal lines of the contour, and then extend
4225 the contour upwards. */
4227 static void
4228 extend_contour_top (line)
4232 static void
4233 clip_contour_bottom (x_pos, y_pos)
4234 int x_pos, y_pos;
4238 static void
4239 extend_contour_bottom (x_pos, y_pos)
4243 DEFUN ("x-select-region", Fx_select_region, Sx_select_region, 1, 1, "e",
4245 (event)
4246 Lisp_Object event;
4248 register struct frame *f = selected_frame;
4249 register int point_x = f->cursor_x;
4250 register int point_y = f->cursor_y;
4251 register int mouse_below_point;
4252 register Lisp_Object obj;
4253 register int x_contour_x, x_contour_y;
4255 x_contour_x = x_mouse_x;
4256 x_contour_y = x_mouse_y;
4257 if (x_contour_y > point_y || (x_contour_y == point_y
4258 && x_contour_x > point_x))
4260 mouse_below_point = 1;
4261 outline_region (f, f->output_data.x->cursor_gc, point_x, point_y,
4262 x_contour_x, x_contour_y);
4264 else
4266 mouse_below_point = 0;
4267 outline_region (f, f->output_data.x->cursor_gc, x_contour_x, x_contour_y,
4268 point_x, point_y);
4271 while (1)
4273 obj = read_char (-1, 0, 0, Qnil, 0);
4274 if (!CONSP (obj))
4275 break;
4277 if (mouse_below_point)
4279 if (x_mouse_y <= point_y) /* Flipped. */
4281 mouse_below_point = 0;
4283 outline_region (f, f->output_data.x->reverse_gc, point_x, point_y,
4284 x_contour_x, x_contour_y);
4285 outline_region (f, f->output_data.x->cursor_gc, x_mouse_x, x_mouse_y,
4286 point_x, point_y);
4288 else if (x_mouse_y < x_contour_y) /* Bottom clipped. */
4290 clip_contour_bottom (x_mouse_y);
4292 else if (x_mouse_y > x_contour_y) /* Bottom extended. */
4294 extend_bottom_contour (x_mouse_y);
4297 x_contour_x = x_mouse_x;
4298 x_contour_y = x_mouse_y;
4300 else /* mouse above or same line as point */
4302 if (x_mouse_y >= point_y) /* Flipped. */
4304 mouse_below_point = 1;
4306 outline_region (f, f->output_data.x->reverse_gc,
4307 x_contour_x, x_contour_y, point_x, point_y);
4308 outline_region (f, f->output_data.x->cursor_gc, point_x, point_y,
4309 x_mouse_x, x_mouse_y);
4311 else if (x_mouse_y > x_contour_y) /* Top clipped. */
4313 clip_contour_top (x_mouse_y);
4315 else if (x_mouse_y < x_contour_y) /* Top extended. */
4317 extend_contour_top (x_mouse_y);
4322 unread_command_event = obj;
4323 if (mouse_below_point)
4325 contour_begin_x = point_x;
4326 contour_begin_y = point_y;
4327 contour_end_x = x_contour_x;
4328 contour_end_y = x_contour_y;
4330 else
4332 contour_begin_x = x_contour_x;
4333 contour_begin_y = x_contour_y;
4334 contour_end_x = point_x;
4335 contour_end_y = point_y;
4338 #endif
4340 DEFUN ("x-horizontal-line", Fx_horizontal_line, Sx_horizontal_line, 1, 1, "e",
4342 (event)
4343 Lisp_Object event;
4345 register Lisp_Object obj;
4346 struct frame *f = selected_frame;
4347 register struct window *w = XWINDOW (selected_window);
4348 register GC line_gc = f->output_data.x->cursor_gc;
4349 register GC erase_gc = f->output_data.x->reverse_gc;
4350 #if 0
4351 char dash_list[] = {6, 4, 6, 4};
4352 int dashes = 4;
4353 XGCValues gc_values;
4354 #endif
4355 register int previous_y;
4356 register int line = (x_mouse_y + 1) * f->output_data.x->line_height
4357 + f->output_data.x->internal_border_width;
4358 register int left = f->output_data.x->internal_border_width
4359 + (w->left
4360 * FONT_WIDTH (f->output_data.x->font));
4361 register int right = left + (w->width
4362 * FONT_WIDTH (f->output_data.x->font))
4363 - f->output_data.x->internal_border_width;
4365 #if 0
4366 BLOCK_INPUT;
4367 gc_values.foreground = f->output_data.x->cursor_pixel;
4368 gc_values.background = f->output_data.x->background_pixel;
4369 gc_values.line_width = 1;
4370 gc_values.line_style = LineOnOffDash;
4371 gc_values.cap_style = CapRound;
4372 gc_values.join_style = JoinRound;
4374 line_gc = XCreateGC (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
4375 GCLineStyle | GCJoinStyle | GCCapStyle
4376 | GCLineWidth | GCForeground | GCBackground,
4377 &gc_values);
4378 XSetDashes (FRAME_X_DISPLAY (f), line_gc, 0, dash_list, dashes);
4379 gc_values.foreground = f->output_data.x->background_pixel;
4380 gc_values.background = f->output_data.x->foreground_pixel;
4381 erase_gc = XCreateGC (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
4382 GCLineStyle | GCJoinStyle | GCCapStyle
4383 | GCLineWidth | GCForeground | GCBackground,
4384 &gc_values);
4385 XSetDashes (FRAME_X_DISPLAY (f), erase_gc, 0, dash_list, dashes);
4386 UNBLOCK_INPUT;
4387 #endif
4389 while (1)
4391 BLOCK_INPUT;
4392 if (x_mouse_y >= XINT (w->top)
4393 && x_mouse_y < XINT (w->top) + XINT (w->height) - 1)
4395 previous_y = x_mouse_y;
4396 line = (x_mouse_y + 1) * f->output_data.x->line_height
4397 + f->output_data.x->internal_border_width;
4398 XDrawLine (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
4399 line_gc, left, line, right, line);
4401 XFlush (FRAME_X_DISPLAY (f));
4402 UNBLOCK_INPUT;
4406 obj = read_char (-1, 0, 0, Qnil, 0);
4407 if (!CONSP (obj)
4408 || (! EQ (Fcar (Fcdr (Fcdr (obj))),
4409 Qvertical_scroll_bar))
4410 || x_mouse_grabbed)
4412 BLOCK_INPUT;
4413 XDrawLine (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
4414 erase_gc, left, line, right, line);
4415 unread_command_event = obj;
4416 #if 0
4417 XFreeGC (FRAME_X_DISPLAY (f), line_gc);
4418 XFreeGC (FRAME_X_DISPLAY (f), erase_gc);
4419 #endif
4420 UNBLOCK_INPUT;
4421 return Qnil;
4424 while (x_mouse_y == previous_y);
4426 BLOCK_INPUT;
4427 XDrawLine (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
4428 erase_gc, left, line, right, line);
4429 UNBLOCK_INPUT;
4432 #endif
4434 #if 0
4435 /* These keep track of the rectangle following the pointer. */
4436 int mouse_track_top, mouse_track_left, mouse_track_width;
4438 /* Offset in buffer of character under the pointer, or 0. */
4439 int mouse_buffer_offset;
4441 DEFUN ("x-track-pointer", Fx_track_pointer, Sx_track_pointer, 0, 0, 0,
4442 "Track the pointer.")
4445 static Cursor current_pointer_shape;
4446 FRAME_PTR f = x_mouse_frame;
4448 BLOCK_INPUT;
4449 if (EQ (Vmouse_frame_part, Qtext_part)
4450 && (current_pointer_shape != f->output_data.x->nontext_cursor))
4452 unsigned char c;
4453 struct buffer *buf;
4455 current_pointer_shape = f->output_data.x->nontext_cursor;
4456 XDefineCursor (FRAME_X_DISPLAY (f),
4457 FRAME_X_WINDOW (f),
4458 current_pointer_shape);
4460 buf = XBUFFER (XWINDOW (Vmouse_window)->buffer);
4461 c = *(BUF_CHAR_ADDRESS (buf, mouse_buffer_offset));
4463 else if (EQ (Vmouse_frame_part, Qmodeline_part)
4464 && (current_pointer_shape != f->output_data.x->modeline_cursor))
4466 current_pointer_shape = f->output_data.x->modeline_cursor;
4467 XDefineCursor (FRAME_X_DISPLAY (f),
4468 FRAME_X_WINDOW (f),
4469 current_pointer_shape);
4472 XFlush (FRAME_X_DISPLAY (f));
4473 UNBLOCK_INPUT;
4475 #endif
4477 #if 0
4478 DEFUN ("x-track-pointer", Fx_track_pointer, Sx_track_pointer, 1, 1, "e",
4479 "Draw rectangle around character under mouse pointer, if there is one.")
4480 (event)
4481 Lisp_Object event;
4483 struct window *w = XWINDOW (Vmouse_window);
4484 struct frame *f = XFRAME (WINDOW_FRAME (w));
4485 struct buffer *b = XBUFFER (w->buffer);
4486 Lisp_Object obj;
4488 if (! EQ (Vmouse_window, selected_window))
4489 return Qnil;
4491 if (EQ (event, Qnil))
4493 int x, y;
4495 x_read_mouse_position (selected_frame, &x, &y);
4498 BLOCK_INPUT;
4499 mouse_track_width = 0;
4500 mouse_track_left = mouse_track_top = -1;
4504 if ((x_mouse_x != mouse_track_left
4505 && (x_mouse_x < mouse_track_left
4506 || x_mouse_x > (mouse_track_left + mouse_track_width)))
4507 || x_mouse_y != mouse_track_top)
4509 int hp = 0; /* Horizontal position */
4510 int len = FRAME_CURRENT_GLYPHS (f)->used[x_mouse_y];
4511 int p = FRAME_CURRENT_GLYPHS (f)->bufp[x_mouse_y];
4512 int tab_width = XINT (b->tab_width);
4513 int ctl_arrow_p = !NILP (b->ctl_arrow);
4514 unsigned char c;
4515 int mode_line_vpos = XFASTINT (w->height) + XFASTINT (w->top) - 1;
4516 int in_mode_line = 0;
4518 if (! FRAME_CURRENT_GLYPHS (f)->enable[x_mouse_y])
4519 break;
4521 /* Erase previous rectangle. */
4522 if (mouse_track_width)
4524 x_rectangle (f, f->output_data.x->reverse_gc,
4525 mouse_track_left, mouse_track_top,
4526 mouse_track_width, 1);
4528 if ((mouse_track_left == f->phys_cursor_x
4529 || mouse_track_left == f->phys_cursor_x - 1)
4530 && mouse_track_top == f->phys_cursor_y)
4532 x_display_cursor (f, 1);
4536 mouse_track_left = x_mouse_x;
4537 mouse_track_top = x_mouse_y;
4538 mouse_track_width = 0;
4540 if (mouse_track_left > len) /* Past the end of line. */
4541 goto draw_or_not;
4543 if (mouse_track_top == mode_line_vpos)
4545 in_mode_line = 1;
4546 goto draw_or_not;
4549 if (tab_width <= 0 || tab_width > 20) tab_width = 8;
4552 c = FETCH_CHAR (p);
4553 if (len == f->width && hp == len - 1 && c != '\n')
4554 goto draw_or_not;
4556 switch (c)
4558 case '\t':
4559 mouse_track_width = tab_width - (hp % tab_width);
4560 p++;
4561 hp += mouse_track_width;
4562 if (hp > x_mouse_x)
4564 mouse_track_left = hp - mouse_track_width;
4565 goto draw_or_not;
4567 continue;
4569 case '\n':
4570 mouse_track_width = -1;
4571 goto draw_or_not;
4573 default:
4574 if (ctl_arrow_p && (c < 040 || c == 0177))
4576 if (p > ZV)
4577 goto draw_or_not;
4579 mouse_track_width = 2;
4580 p++;
4581 hp +=2;
4582 if (hp > x_mouse_x)
4584 mouse_track_left = hp - mouse_track_width;
4585 goto draw_or_not;
4588 else
4590 mouse_track_width = 1;
4591 p++;
4592 hp++;
4594 continue;
4597 while (hp <= x_mouse_x);
4599 draw_or_not:
4600 if (mouse_track_width) /* Over text; use text pointer shape. */
4602 XDefineCursor (FRAME_X_DISPLAY (f),
4603 FRAME_X_WINDOW (f),
4604 f->output_data.x->text_cursor);
4605 x_rectangle (f, f->output_data.x->cursor_gc,
4606 mouse_track_left, mouse_track_top,
4607 mouse_track_width, 1);
4609 else if (in_mode_line)
4610 XDefineCursor (FRAME_X_DISPLAY (f),
4611 FRAME_X_WINDOW (f),
4612 f->output_data.x->modeline_cursor);
4613 else
4614 XDefineCursor (FRAME_X_DISPLAY (f),
4615 FRAME_X_WINDOW (f),
4616 f->output_data.x->nontext_cursor);
4619 XFlush (FRAME_X_DISPLAY (f));
4620 UNBLOCK_INPUT;
4622 obj = read_char (-1, 0, 0, Qnil, 0);
4623 BLOCK_INPUT;
4625 while (CONSP (obj) /* Mouse event */
4626 && EQ (Fcar (Fcdr (Fcdr (obj))), Qnil) /* Not scroll bar */
4627 && EQ (Vmouse_depressed, Qnil) /* Only motion events */
4628 && EQ (Vmouse_window, selected_window) /* In this window */
4629 && x_mouse_frame);
4631 unread_command_event = obj;
4633 if (mouse_track_width)
4635 x_rectangle (f, f->output_data.x->reverse_gc,
4636 mouse_track_left, mouse_track_top,
4637 mouse_track_width, 1);
4638 mouse_track_width = 0;
4639 if ((mouse_track_left == f->phys_cursor_x
4640 || mouse_track_left - 1 == f->phys_cursor_x)
4641 && mouse_track_top == f->phys_cursor_y)
4643 x_display_cursor (f, 1);
4646 XDefineCursor (FRAME_X_DISPLAY (f),
4647 FRAME_X_WINDOW (f),
4648 f->output_data.x->nontext_cursor);
4649 XFlush (FRAME_X_DISPLAY (f));
4650 UNBLOCK_INPUT;
4652 return Qnil;
4654 #endif
4656 #if 0
4657 #include "glyphs.h"
4659 /* Draw a pixmap specified by IMAGE_DATA of dimensions WIDTH and HEIGHT
4660 on the frame F at position X, Y. */
4662 x_draw_pixmap (f, x, y, image_data, width, height)
4663 struct frame *f;
4664 int x, y, width, height;
4665 char *image_data;
4667 Pixmap image;
4669 image = XCreateBitmapFromData (FRAME_X_DISPLAY (f),
4670 FRAME_X_WINDOW (f), image_data,
4671 width, height);
4672 XCopyPlane (FRAME_X_DISPLAY (f), image, FRAME_X_WINDOW (f),
4673 f->output_data.x->normal_gc, 0, 0, width, height, x, y);
4675 #endif
4677 #if 0 /* I'm told these functions are superfluous
4678 given the ability to bind function keys. */
4680 #ifdef HAVE_X11
4681 DEFUN ("x-rebind-key", Fx_rebind_key, Sx_rebind_key, 3, 3, 0,
4682 "Rebind X keysym KEYSYM, with MODIFIERS, to generate NEWSTRING.\n\
4683 KEYSYM is a string which conforms to the X keysym definitions found\n\
4684 in X11/keysymdef.h, sans the initial XK_. MODIFIERS is nil or a\n\
4685 list of strings specifying modifier keys such as Control_L, which must\n\
4686 also be depressed for NEWSTRING to appear.")
4687 (x_keysym, modifiers, newstring)
4688 register Lisp_Object x_keysym;
4689 register Lisp_Object modifiers;
4690 register Lisp_Object newstring;
4692 char *rawstring;
4693 register KeySym keysym;
4694 KeySym modifier_list[16];
4696 check_x ();
4697 CHECK_STRING (x_keysym, 1);
4698 CHECK_STRING (newstring, 3);
4700 keysym = XStringToKeysym ((char *) XSTRING (x_keysym)->data);
4701 if (keysym == NoSymbol)
4702 error ("Keysym does not exist");
4704 if (NILP (modifiers))
4705 XRebindKeysym (x_current_display, keysym, modifier_list, 0,
4706 XSTRING (newstring)->data, XSTRING (newstring)->size);
4707 else
4709 register Lisp_Object rest, mod;
4710 register int i = 0;
4712 for (rest = modifiers; !NILP (rest); rest = Fcdr (rest))
4714 if (i == 16)
4715 error ("Can't have more than 16 modifiers");
4717 mod = Fcar (rest);
4718 CHECK_STRING (mod, 3);
4719 modifier_list[i] = XStringToKeysym ((char *) XSTRING (mod)->data);
4720 #ifndef HAVE_X11R5
4721 if (modifier_list[i] == NoSymbol
4722 || !(IsModifierKey (modifier_list[i])
4723 || ((unsigned)(modifier_list[i]) == XK_Mode_switch)
4724 || ((unsigned)(modifier_list[i]) == XK_Num_Lock)))
4725 #else
4726 if (modifier_list[i] == NoSymbol
4727 || !IsModifierKey (modifier_list[i]))
4728 #endif
4729 error ("Element is not a modifier keysym");
4730 i++;
4733 XRebindKeysym (x_current_display, keysym, modifier_list, i,
4734 XSTRING (newstring)->data, XSTRING (newstring)->size);
4737 return Qnil;
4740 DEFUN ("x-rebind-keys", Fx_rebind_keys, Sx_rebind_keys, 2, 2, 0,
4741 "Rebind KEYCODE to list of strings STRINGS.\n\
4742 STRINGS should be a list of 16 elements, one for each shift combination.\n\
4743 nil as element means don't change.\n\
4744 See the documentation of `x-rebind-key' for more information.")
4745 (keycode, strings)
4746 register Lisp_Object keycode;
4747 register Lisp_Object strings;
4749 register Lisp_Object item;
4750 register unsigned char *rawstring;
4751 KeySym rawkey, modifier[1];
4752 int strsize;
4753 register unsigned i;
4755 check_x ();
4756 CHECK_NUMBER (keycode, 1);
4757 CHECK_CONS (strings, 2);
4758 rawkey = (KeySym) ((unsigned) (XINT (keycode))) & 255;
4759 for (i = 0; i <= 15; strings = Fcdr (strings), i++)
4761 item = Fcar (strings);
4762 if (!NILP (item))
4764 CHECK_STRING (item, 2);
4765 strsize = XSTRING (item)->size;
4766 rawstring = (unsigned char *) xmalloc (strsize);
4767 bcopy (XSTRING (item)->data, rawstring, strsize);
4768 modifier[1] = 1 << i;
4769 XRebindKeysym (x_current_display, rawkey, modifier, 1,
4770 rawstring, strsize);
4773 return Qnil;
4775 #endif /* HAVE_X11 */
4776 #endif /* 0 */
4778 #ifndef HAVE_XSCREENNUMBEROFSCREEN
4780 XScreenNumberOfScreen (scr)
4781 register Screen *scr;
4783 register Display *dpy;
4784 register Screen *dpyscr;
4785 register int i;
4787 dpy = scr->display;
4788 dpyscr = dpy->screens;
4790 for (i = 0; i < dpy->nscreens; i++, dpyscr++)
4791 if (scr == dpyscr)
4792 return i;
4794 return -1;
4796 #endif /* not HAVE_XSCREENNUMBEROFSCREEN */
4798 Visual *
4799 select_visual (dpy, screen, depth)
4800 Display *dpy;
4801 Screen *screen;
4802 unsigned int *depth;
4804 Visual *v;
4805 XVisualInfo *vinfo, vinfo_template;
4806 int n_visuals;
4808 v = DefaultVisualOfScreen (screen);
4810 #ifdef HAVE_X11R4
4811 vinfo_template.visualid = XVisualIDFromVisual (v);
4812 #else
4813 vinfo_template.visualid = v->visualid;
4814 #endif
4816 vinfo_template.screen = XScreenNumberOfScreen (screen);
4818 vinfo = XGetVisualInfo (dpy,
4819 VisualIDMask | VisualScreenMask, &vinfo_template,
4820 &n_visuals);
4821 if (n_visuals != 1)
4822 fatal ("Can't get proper X visual info");
4824 if ((1 << vinfo->depth) == vinfo->colormap_size)
4825 *depth = vinfo->depth;
4826 else
4828 int i = 0;
4829 int n = vinfo->colormap_size - 1;
4830 while (n)
4832 n = n >> 1;
4833 i++;
4835 *depth = i;
4838 XFree ((char *) vinfo);
4839 return v;
4842 /* Return the X display structure for the display named NAME.
4843 Open a new connection if necessary. */
4845 struct x_display_info *
4846 x_display_info_for_name (name)
4847 Lisp_Object name;
4849 Lisp_Object names;
4850 struct x_display_info *dpyinfo;
4852 CHECK_STRING (name, 0);
4854 if (! EQ (Vwindow_system, intern ("x")))
4855 error ("Not using X Windows");
4857 for (dpyinfo = x_display_list, names = x_display_name_list;
4858 dpyinfo;
4859 dpyinfo = dpyinfo->next, names = XCONS (names)->cdr)
4861 Lisp_Object tem;
4862 tem = Fstring_equal (XCONS (XCONS (names)->car)->car, name);
4863 if (!NILP (tem))
4864 return dpyinfo;
4867 /* Use this general default value to start with. */
4868 Vx_resource_name = Vinvocation_name;
4870 validate_x_resource_name ();
4872 dpyinfo = x_term_init (name, (unsigned char *)0,
4873 (char *) XSTRING (Vx_resource_name)->data);
4875 if (dpyinfo == 0)
4876 error ("Cannot connect to X server %s", XSTRING (name)->data);
4878 x_in_use = 1;
4879 XSETFASTINT (Vwindow_system_version, 11);
4881 return dpyinfo;
4884 DEFUN ("x-open-connection", Fx_open_connection, Sx_open_connection,
4885 1, 3, 0, "Open a connection to an X server.\n\
4886 DISPLAY is the name of the display to connect to.\n\
4887 Optional second arg XRM-STRING is a string of resources in xrdb format.\n\
4888 If the optional third arg MUST-SUCCEED is non-nil,\n\
4889 terminate Emacs if we can't open the connection.")
4890 (display, xrm_string, must_succeed)
4891 Lisp_Object display, xrm_string, must_succeed;
4893 unsigned int n_planes;
4894 unsigned char *xrm_option;
4895 struct x_display_info *dpyinfo;
4897 CHECK_STRING (display, 0);
4898 if (! NILP (xrm_string))
4899 CHECK_STRING (xrm_string, 1);
4901 if (! EQ (Vwindow_system, intern ("x")))
4902 error ("Not using X Windows");
4904 if (! NILP (xrm_string))
4905 xrm_option = (unsigned char *) XSTRING (xrm_string)->data;
4906 else
4907 xrm_option = (unsigned char *) 0;
4909 validate_x_resource_name ();
4911 /* This is what opens the connection and sets x_current_display.
4912 This also initializes many symbols, such as those used for input. */
4913 dpyinfo = x_term_init (display, xrm_option,
4914 (char *) XSTRING (Vx_resource_name)->data);
4916 if (dpyinfo == 0)
4918 if (!NILP (must_succeed))
4919 fatal ("Cannot connect to X server %s.\n\
4920 Check the DISPLAY environment variable or use `-d'.\n\
4921 Also use the `xhost' program to verify that it is set to permit\n\
4922 connections from your machine.\n",
4923 XSTRING (display)->data);
4924 else
4925 error ("Cannot connect to X server %s", XSTRING (display)->data);
4928 x_in_use = 1;
4930 XSETFASTINT (Vwindow_system_version, 11);
4931 return Qnil;
4934 DEFUN ("x-close-connection", Fx_close_connection,
4935 Sx_close_connection, 1, 1, 0,
4936 "Close the connection to DISPLAY's X server.\n\
4937 For DISPLAY, specify either a frame or a display name (a string).\n\
4938 If DISPLAY is nil, that stands for the selected frame's display.")
4939 (display)
4940 Lisp_Object display;
4942 struct x_display_info *dpyinfo = check_x_display_info (display);
4943 struct x_display_info *tail;
4944 int i;
4946 if (dpyinfo->reference_count > 0)
4947 error ("Display still has frames on it");
4949 BLOCK_INPUT;
4950 /* Free the fonts in the font table. */
4951 for (i = 0; i < dpyinfo->n_fonts; i++)
4953 if (dpyinfo->font_table[i].name)
4954 free (dpyinfo->font_table[i].name);
4955 /* Don't free the full_name string;
4956 it is always shared with something else. */
4957 XFreeFont (dpyinfo->display, dpyinfo->font_table[i].font);
4959 x_destroy_all_bitmaps (dpyinfo);
4960 XSetCloseDownMode (dpyinfo->display, DestroyAll);
4962 #ifdef USE_X_TOOLKIT
4963 XtCloseDisplay (dpyinfo->display);
4964 #else
4965 XCloseDisplay (dpyinfo->display);
4966 #endif
4968 x_delete_display (dpyinfo);
4969 UNBLOCK_INPUT;
4971 return Qnil;
4974 DEFUN ("x-display-list", Fx_display_list, Sx_display_list, 0, 0, 0,
4975 "Return the list of display names that Emacs has connections to.")
4978 Lisp_Object tail, result;
4980 result = Qnil;
4981 for (tail = x_display_name_list; ! NILP (tail); tail = XCONS (tail)->cdr)
4982 result = Fcons (XCONS (XCONS (tail)->car)->car, result);
4984 return result;
4987 DEFUN ("x-synchronize", Fx_synchronize, Sx_synchronize, 1, 2, 0,
4988 "If ON is non-nil, report X errors as soon as the erring request is made.\n\
4989 If ON is nil, allow buffering of requests.\n\
4990 Turning on synchronization prohibits the Xlib routines from buffering\n\
4991 requests and seriously degrades performance, but makes debugging much\n\
4992 easier.\n\
4993 The optional second argument DISPLAY specifies which display to act on.\n\
4994 DISPLAY should be either a frame or a display name (a string).\n\
4995 If DISPLAY is omitted or nil, that stands for the selected frame's display.")
4996 (on, display)
4997 Lisp_Object display, on;
4999 struct x_display_info *dpyinfo = check_x_display_info (display);
5001 XSynchronize (dpyinfo->display, !EQ (on, Qnil));
5003 return Qnil;
5006 /* Wait for responses to all X commands issued so far for frame F. */
5008 void
5009 x_sync (f)
5010 FRAME_PTR f;
5012 BLOCK_INPUT;
5013 XSync (FRAME_X_DISPLAY (f), False);
5014 UNBLOCK_INPUT;
5017 syms_of_xfns ()
5019 /* This is zero if not using X windows. */
5020 x_in_use = 0;
5022 /* The section below is built by the lisp expression at the top of the file,
5023 just above where these variables are declared. */
5024 /*&&& init symbols here &&&*/
5025 Qauto_raise = intern ("auto-raise");
5026 staticpro (&Qauto_raise);
5027 Qauto_lower = intern ("auto-lower");
5028 staticpro (&Qauto_lower);
5029 Qbackground_color = intern ("background-color");
5030 staticpro (&Qbackground_color);
5031 Qbar = intern ("bar");
5032 staticpro (&Qbar);
5033 Qborder_color = intern ("border-color");
5034 staticpro (&Qborder_color);
5035 Qborder_width = intern ("border-width");
5036 staticpro (&Qborder_width);
5037 Qbox = intern ("box");
5038 staticpro (&Qbox);
5039 Qcursor_color = intern ("cursor-color");
5040 staticpro (&Qcursor_color);
5041 Qcursor_type = intern ("cursor-type");
5042 staticpro (&Qcursor_type);
5043 Qforeground_color = intern ("foreground-color");
5044 staticpro (&Qforeground_color);
5045 Qgeometry = intern ("geometry");
5046 staticpro (&Qgeometry);
5047 Qicon_left = intern ("icon-left");
5048 staticpro (&Qicon_left);
5049 Qicon_top = intern ("icon-top");
5050 staticpro (&Qicon_top);
5051 Qicon_type = intern ("icon-type");
5052 staticpro (&Qicon_type);
5053 Qicon_name = intern ("icon-name");
5054 staticpro (&Qicon_name);
5055 Qinternal_border_width = intern ("internal-border-width");
5056 staticpro (&Qinternal_border_width);
5057 Qleft = intern ("left");
5058 staticpro (&Qleft);
5059 Qmouse_color = intern ("mouse-color");
5060 staticpro (&Qmouse_color);
5061 Qnone = intern ("none");
5062 staticpro (&Qnone);
5063 Qparent_id = intern ("parent-id");
5064 staticpro (&Qparent_id);
5065 Qscroll_bar_width = intern ("scroll-bar-width");
5066 staticpro (&Qscroll_bar_width);
5067 Qsuppress_icon = intern ("suppress-icon");
5068 staticpro (&Qsuppress_icon);
5069 Qtop = intern ("top");
5070 staticpro (&Qtop);
5071 Qundefined_color = intern ("undefined-color");
5072 staticpro (&Qundefined_color);
5073 Qvertical_scroll_bars = intern ("vertical-scroll-bars");
5074 staticpro (&Qvertical_scroll_bars);
5075 Qvisibility = intern ("visibility");
5076 staticpro (&Qvisibility);
5077 Qwindow_id = intern ("window-id");
5078 staticpro (&Qwindow_id);
5079 Qx_frame_parameter = intern ("x-frame-parameter");
5080 staticpro (&Qx_frame_parameter);
5081 Qx_resource_name = intern ("x-resource-name");
5082 staticpro (&Qx_resource_name);
5083 Quser_position = intern ("user-position");
5084 staticpro (&Quser_position);
5085 Quser_size = intern ("user-size");
5086 staticpro (&Quser_size);
5087 Qdisplay = intern ("display");
5088 staticpro (&Qdisplay);
5089 /* This is the end of symbol initialization. */
5091 Fput (Qundefined_color, Qerror_conditions,
5092 Fcons (Qundefined_color, Fcons (Qerror, Qnil)));
5093 Fput (Qundefined_color, Qerror_message,
5094 build_string ("Undefined color"));
5096 init_x_parm_symbols ();
5098 DEFVAR_LISP ("x-bitmap-file-path", &Vx_bitmap_file_path,
5099 "List of directories to search for bitmap files for X.");
5100 Vx_bitmap_file_path = decode_env_path ((char *) 0, PATH_BITMAPS);
5102 DEFVAR_LISP ("x-pointer-shape", &Vx_pointer_shape,
5103 "The shape of the pointer when over text.\n\
5104 Changing the value does not affect existing frames\n\
5105 unless you set the mouse color.");
5106 Vx_pointer_shape = Qnil;
5108 DEFVAR_LISP ("x-resource-name", &Vx_resource_name,
5109 "The name Emacs uses to look up X resources; for internal use only.\n\
5110 `x-get-resource' uses this as the first component of the instance name\n\
5111 when requesting resource values.\n\
5112 Emacs initially sets `x-resource-name' to the name under which Emacs\n\
5113 was invoked, or to the value specified with the `-name' or `-rn'\n\
5114 switches, if present.");
5115 Vx_resource_name = Qnil;
5117 #if 0 /* This doesn't really do anything. */
5118 DEFVAR_INT ("x-nontext-pointer-shape", &Vx_nontext_pointer_shape,
5119 "The shape of the pointer when not over text.\n\
5120 This variable takes effect when you create a new frame\n\
5121 or when you set the mouse color.");
5122 #endif
5123 Vx_nontext_pointer_shape = Qnil;
5125 #if 0 /* This doesn't really do anything. */
5126 DEFVAR_INT ("x-mode-pointer-shape", &Vx_mode_pointer_shape,
5127 "The shape of the pointer when over the mode line.\n\
5128 This variable takes effect when you create a new frame\n\
5129 or when you set the mouse color.");
5130 #endif
5131 Vx_mode_pointer_shape = Qnil;
5133 DEFVAR_INT ("x-sensitive-text-pointer-shape",
5134 &Vx_sensitive_text_pointer_shape,
5135 "The shape of the pointer when over mouse-sensitive text.\n\
5136 This variable takes effect when you create a new frame\n\
5137 or when you set the mouse color.");
5138 Vx_sensitive_text_pointer_shape = Qnil;
5140 DEFVAR_LISP ("x-cursor-fore-pixel", &Vx_cursor_fore_pixel,
5141 "A string indicating the foreground color of the cursor box.");
5142 Vx_cursor_fore_pixel = Qnil;
5144 DEFVAR_LISP ("x-no-window-manager", &Vx_no_window_manager,
5145 "Non-nil if no X window manager is in use.\n\
5146 Emacs doesn't try to figure this out; this is always nil\n\
5147 unless you set it to something else.");
5148 /* We don't have any way to find this out, so set it to nil
5149 and maybe the user would like to set it to t. */
5150 Vx_no_window_manager = Qnil;
5152 #ifdef USE_X_TOOLKIT
5153 Fprovide (intern ("x-toolkit"));
5154 #endif
5155 #ifdef USE_MOTIF
5156 Fprovide (intern ("motif"));
5157 #endif
5159 defsubr (&Sx_get_resource);
5160 #if 0
5161 defsubr (&Sx_draw_rectangle);
5162 defsubr (&Sx_erase_rectangle);
5163 defsubr (&Sx_contour_region);
5164 defsubr (&Sx_uncontour_region);
5165 #endif
5166 defsubr (&Sx_list_fonts);
5167 defsubr (&Sx_display_color_p);
5168 defsubr (&Sx_display_grayscale_p);
5169 defsubr (&Sx_color_defined_p);
5170 defsubr (&Sx_color_values);
5171 defsubr (&Sx_server_max_request_size);
5172 defsubr (&Sx_server_vendor);
5173 defsubr (&Sx_server_version);
5174 defsubr (&Sx_display_pixel_width);
5175 defsubr (&Sx_display_pixel_height);
5176 defsubr (&Sx_display_mm_width);
5177 defsubr (&Sx_display_mm_height);
5178 defsubr (&Sx_display_screens);
5179 defsubr (&Sx_display_planes);
5180 defsubr (&Sx_display_color_cells);
5181 defsubr (&Sx_display_visual_class);
5182 defsubr (&Sx_display_backing_store);
5183 defsubr (&Sx_display_save_under);
5184 #if 0
5185 defsubr (&Sx_rebind_key);
5186 defsubr (&Sx_rebind_keys);
5187 defsubr (&Sx_track_pointer);
5188 defsubr (&Sx_grab_pointer);
5189 defsubr (&Sx_ungrab_pointer);
5190 #endif
5191 defsubr (&Sx_parse_geometry);
5192 defsubr (&Sx_create_frame);
5193 defsubr (&Sfocus_frame);
5194 defsubr (&Sunfocus_frame);
5195 #if 0
5196 defsubr (&Sx_horizontal_line);
5197 #endif
5198 defsubr (&Sx_open_connection);
5199 defsubr (&Sx_close_connection);
5200 defsubr (&Sx_display_list);
5201 defsubr (&Sx_synchronize);
5204 #endif /* HAVE_X_WINDOWS */