Don't require timer; use autoloaded functions from Emacs or XEmacs,
[emacs.git] / src / xfns.c
blobfa837e6a4c026df6d92305dc168d8f08a64f83b9
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>
40 #include "charset.h"
41 #include "fontset.h"
43 #ifdef HAVE_X_WINDOWS
44 extern void abort ();
46 /* On some systems, the character-composition stuff is broken in X11R5. */
47 #if defined (HAVE_X11R5) && ! defined (HAVE_X11R6)
48 #ifdef X11R5_INHIBIT_I18N
49 #define X_I18N_INHIBITED
50 #endif
51 #endif
53 #ifndef VMS
54 #if 1 /* Used to be #ifdef EMACS_BITMAP_FILES, but this should always work. */
55 #include "bitmaps/gray.xbm"
56 #else
57 #include <X11/bitmaps/gray>
58 #endif
59 #else
60 #include "[.bitmaps]gray.xbm"
61 #endif
63 #ifdef USE_X_TOOLKIT
64 #include <X11/Shell.h>
66 #ifndef USE_MOTIF
67 #include <X11/Xaw/Paned.h>
68 #include <X11/Xaw/Label.h>
69 #endif /* USE_MOTIF */
71 #ifdef USG
72 #undef USG /* ####KLUDGE for Solaris 2.2 and up */
73 #include <X11/Xos.h>
74 #define USG
75 #else
76 #include <X11/Xos.h>
77 #endif
79 #include "widget.h"
81 #include "../lwlib/lwlib.h"
83 /* Do the EDITRES protocol if running X11R5
84 Exception: HP-UX (at least version A.09.05) has X11R5 without EditRes */
85 #if (XtSpecificationRelease >= 5) && !defined(NO_EDITRES)
86 #define HACK_EDITRES
87 extern void _XEditResCheckMessages ();
88 #endif /* R5 + Athena */
90 /* Unique id counter for widgets created by the Lucid Widget
91 Library. */
92 extern LWLIB_ID widget_id_tick;
94 #ifdef USE_LUCID
95 /* This is part of a kludge--see lwlib/xlwmenu.c. */
96 extern XFontStruct *xlwmenu_default_font;
97 #endif
99 extern void free_frame_menubar ();
100 #endif /* USE_X_TOOLKIT */
102 #define min(a,b) ((a) < (b) ? (a) : (b))
103 #define max(a,b) ((a) > (b) ? (a) : (b))
105 #ifdef HAVE_X11R4
106 #define MAXREQUEST(dpy) (XMaxRequestSize (dpy))
107 #else
108 #define MAXREQUEST(dpy) ((dpy)->max_request_size)
109 #endif
111 /* The name we're using in resource queries. Most often "emacs". */
112 Lisp_Object Vx_resource_name;
114 /* The application class we're using in resource queries.
115 Normally "Emacs". */
116 Lisp_Object Vx_resource_class;
118 /* The background and shape of the mouse pointer, and shape when not
119 over text or in the modeline. */
120 Lisp_Object Vx_pointer_shape, Vx_nontext_pointer_shape, Vx_mode_pointer_shape;
121 /* The shape when over mouse-sensitive text. */
122 Lisp_Object Vx_sensitive_text_pointer_shape;
124 /* Color of chars displayed in cursor box. */
125 Lisp_Object Vx_cursor_fore_pixel;
127 /* Nonzero if using X. */
128 static int x_in_use;
130 /* Non nil if no window manager is in use. */
131 Lisp_Object Vx_no_window_manager;
133 /* Search path for bitmap files. */
134 Lisp_Object Vx_bitmap_file_path;
136 /* Regexp matching a font name whose width is the same as `PIXEL_SIZE'. */
137 Lisp_Object Vx_pixel_size_width_font_regexp;
139 /* Evaluate this expression to rebuild the section of syms_of_xfns
140 that initializes and staticpros the symbols declared below. Note
141 that Emacs 18 has a bug that keeps C-x C-e from being able to
142 evaluate this expression.
144 (progn
145 ;; Accumulate a list of the symbols we want to initialize from the
146 ;; declarations at the top of the file.
147 (goto-char (point-min))
148 (search-forward "/\*&&& symbols declared here &&&*\/\n")
149 (let (symbol-list)
150 (while (looking-at "Lisp_Object \\(Q[a-z_]+\\)")
151 (setq symbol-list
152 (cons (buffer-substring (match-beginning 1) (match-end 1))
153 symbol-list))
154 (forward-line 1))
155 (setq symbol-list (nreverse symbol-list))
156 ;; Delete the section of syms_of_... where we initialize the symbols.
157 (search-forward "\n /\*&&& init symbols here &&&*\/\n")
158 (let ((start (point)))
159 (while (looking-at "^ Q")
160 (forward-line 2))
161 (kill-region start (point)))
162 ;; Write a new symbol initialization section.
163 (while symbol-list
164 (insert (format " %s = intern (\"" (car symbol-list)))
165 (let ((start (point)))
166 (insert (substring (car symbol-list) 1))
167 (subst-char-in-region start (point) ?_ ?-))
168 (insert (format "\");\n staticpro (&%s);\n" (car symbol-list)))
169 (setq symbol-list (cdr symbol-list)))))
173 /*&&& symbols declared here &&&*/
174 Lisp_Object Qauto_raise;
175 Lisp_Object Qauto_lower;
176 Lisp_Object Qbackground_color;
177 Lisp_Object Qbar;
178 Lisp_Object Qborder_color;
179 Lisp_Object Qborder_width;
180 Lisp_Object Qbox;
181 Lisp_Object Qcursor_color;
182 Lisp_Object Qcursor_type;
183 Lisp_Object Qforeground_color;
184 Lisp_Object Qgeometry;
185 Lisp_Object Qicon_left;
186 Lisp_Object Qicon_top;
187 Lisp_Object Qicon_type;
188 Lisp_Object Qicon_name;
189 Lisp_Object Qinternal_border_width;
190 Lisp_Object Qleft;
191 Lisp_Object Qright;
192 Lisp_Object Qmouse_color;
193 Lisp_Object Qnone;
194 Lisp_Object Qparent_id;
195 Lisp_Object Qscroll_bar_width;
196 Lisp_Object Qsuppress_icon;
197 Lisp_Object Qtop;
198 Lisp_Object Qundefined_color;
199 Lisp_Object Qvertical_scroll_bars;
200 Lisp_Object Qvisibility;
201 Lisp_Object Qwindow_id;
202 Lisp_Object Qx_frame_parameter;
203 Lisp_Object Qx_resource_name;
204 Lisp_Object Quser_position;
205 Lisp_Object Quser_size;
206 Lisp_Object Qdisplay;
208 /* The below are defined in frame.c. */
209 extern Lisp_Object Qheight, Qminibuffer, Qname, Qonly, Qwidth;
210 extern Lisp_Object Qunsplittable, Qmenu_bar_lines, Qbuffer_predicate, Qtitle;
212 extern Lisp_Object Vwindow_system_version;
215 /* Error if we are not connected to X. */
216 void
217 check_x ()
219 if (! x_in_use)
220 error ("X windows are not in use or not initialized");
223 /* Nonzero if we can use mouse menus.
224 You should not call this unless HAVE_MENUS is defined. */
227 have_menus_p ()
229 return x_in_use;
232 /* Extract a frame as a FRAME_PTR, defaulting to the selected frame
233 and checking validity for X. */
235 FRAME_PTR
236 check_x_frame (frame)
237 Lisp_Object frame;
239 FRAME_PTR f;
241 if (NILP (frame))
242 f = selected_frame;
243 else
245 CHECK_LIVE_FRAME (frame, 0);
246 f = XFRAME (frame);
248 if (! FRAME_X_P (f))
249 error ("Non-X frame used");
250 return f;
253 /* Let the user specify an X display with a frame.
254 nil stands for the selected frame--or, if that is not an X frame,
255 the first X display on the list. */
257 static struct x_display_info *
258 check_x_display_info (frame)
259 Lisp_Object frame;
261 if (NILP (frame))
263 if (FRAME_X_P (selected_frame))
264 return FRAME_X_DISPLAY_INFO (selected_frame);
265 else if (x_display_list != 0)
266 return x_display_list;
267 else
268 error ("X windows are not in use or not initialized");
270 else if (STRINGP (frame))
271 return x_display_info_for_name (frame);
272 else
274 FRAME_PTR f;
276 CHECK_LIVE_FRAME (frame, 0);
277 f = XFRAME (frame);
278 if (! FRAME_X_P (f))
279 error ("Non-X frame used");
280 return FRAME_X_DISPLAY_INFO (f);
284 /* Return the Emacs frame-object corresponding to an X window.
285 It could be the frame's main window or an icon window. */
287 /* This function can be called during GC, so use GC_xxx type test macros. */
289 struct frame *
290 x_window_to_frame (dpyinfo, wdesc)
291 struct x_display_info *dpyinfo;
292 int wdesc;
294 Lisp_Object tail, frame;
295 struct frame *f;
297 for (tail = Vframe_list; GC_CONSP (tail); tail = XCONS (tail)->cdr)
299 frame = XCONS (tail)->car;
300 if (!GC_FRAMEP (frame))
301 continue;
302 f = XFRAME (frame);
303 if (f->output_data.nothing == 1 || FRAME_X_DISPLAY_INFO (f) != dpyinfo)
304 continue;
305 #ifdef USE_X_TOOLKIT
306 if ((f->output_data.x->edit_widget
307 && XtWindow (f->output_data.x->edit_widget) == wdesc)
308 || f->output_data.x->icon_desc == wdesc)
309 return f;
310 #else /* not USE_X_TOOLKIT */
311 if (FRAME_X_WINDOW (f) == wdesc
312 || f->output_data.x->icon_desc == wdesc)
313 return f;
314 #endif /* not USE_X_TOOLKIT */
316 return 0;
319 #ifdef USE_X_TOOLKIT
320 /* Like x_window_to_frame but also compares the window with the widget's
321 windows. */
323 struct frame *
324 x_any_window_to_frame (dpyinfo, wdesc)
325 struct x_display_info *dpyinfo;
326 int wdesc;
328 Lisp_Object tail, frame;
329 struct frame *f;
330 struct x_output *x;
332 for (tail = Vframe_list; GC_CONSP (tail); tail = XCONS (tail)->cdr)
334 frame = XCONS (tail)->car;
335 if (!GC_FRAMEP (frame))
336 continue;
337 f = XFRAME (frame);
338 if (f->output_data.nothing == 1 || FRAME_X_DISPLAY_INFO (f) != dpyinfo)
339 continue;
340 x = f->output_data.x;
341 /* This frame matches if the window is any of its widgets. */
342 if (wdesc == XtWindow (x->widget)
343 || wdesc == XtWindow (x->column_widget)
344 || wdesc == XtWindow (x->edit_widget))
345 return f;
346 /* Match if the window is this frame's menubar. */
347 if (lw_window_is_in_menubar (wdesc, x->menubar_widget))
348 return f;
350 return 0;
353 /* Likewise, but exclude the menu bar widget. */
355 struct frame *
356 x_non_menubar_window_to_frame (dpyinfo, wdesc)
357 struct x_display_info *dpyinfo;
358 int wdesc;
360 Lisp_Object tail, frame;
361 struct frame *f;
362 struct x_output *x;
364 for (tail = Vframe_list; GC_CONSP (tail); tail = XCONS (tail)->cdr)
366 frame = XCONS (tail)->car;
367 if (!GC_FRAMEP (frame))
368 continue;
369 f = XFRAME (frame);
370 if (f->output_data.nothing == 1 || FRAME_X_DISPLAY_INFO (f) != dpyinfo)
371 continue;
372 x = f->output_data.x;
373 /* This frame matches if the window is any of its widgets. */
374 if (wdesc == XtWindow (x->widget)
375 || wdesc == XtWindow (x->column_widget)
376 || wdesc == XtWindow (x->edit_widget))
377 return f;
379 return 0;
382 /* Likewise, but consider only the menu bar widget. */
384 struct frame *
385 x_menubar_window_to_frame (dpyinfo, wdesc)
386 struct x_display_info *dpyinfo;
387 int wdesc;
389 Lisp_Object tail, frame;
390 struct frame *f;
391 struct x_output *x;
393 for (tail = Vframe_list; GC_CONSP (tail); tail = XCONS (tail)->cdr)
395 frame = XCONS (tail)->car;
396 if (!GC_FRAMEP (frame))
397 continue;
398 f = XFRAME (frame);
399 if (f->output_data.nothing == 1 || FRAME_X_DISPLAY_INFO (f) != dpyinfo)
400 continue;
401 x = f->output_data.x;
402 /* Match if the window is this frame's menubar. */
403 if (lw_window_is_in_menubar (wdesc, x->menubar_widget))
404 return f;
406 return 0;
409 /* Return the frame whose principal (outermost) window is WDESC.
410 If WDESC is some other (smaller) window, we return 0. */
412 struct frame *
413 x_top_window_to_frame (dpyinfo, wdesc)
414 struct x_display_info *dpyinfo;
415 int wdesc;
417 Lisp_Object tail, frame;
418 struct frame *f;
419 struct x_output *x;
421 for (tail = Vframe_list; GC_CONSP (tail); tail = XCONS (tail)->cdr)
423 frame = XCONS (tail)->car;
424 if (!GC_FRAMEP (frame))
425 continue;
426 f = XFRAME (frame);
427 if (f->output_data.nothing == 1 || FRAME_X_DISPLAY_INFO (f) != dpyinfo)
428 continue;
429 x = f->output_data.x;
430 /* This frame matches if the window is its topmost widget. */
431 if (wdesc == XtWindow (x->widget))
432 return f;
433 #if 0 /* I don't know why it did this,
434 but it seems logically wrong,
435 and it causes trouble for MapNotify events. */
436 /* Match if the window is this frame's menubar. */
437 if (x->menubar_widget
438 && wdesc == XtWindow (x->menubar_widget))
439 return f;
440 #endif
442 return 0;
444 #endif /* USE_X_TOOLKIT */
448 /* Code to deal with bitmaps. Bitmaps are referenced by their bitmap
449 id, which is just an int that this section returns. Bitmaps are
450 reference counted so they can be shared among frames.
452 Bitmap indices are guaranteed to be > 0, so a negative number can
453 be used to indicate no bitmap.
455 If you use x_create_bitmap_from_data, then you must keep track of
456 the bitmaps yourself. That is, creating a bitmap from the same
457 data more than once will not be caught. */
460 /* Functions to access the contents of a bitmap, given an id. */
463 x_bitmap_height (f, id)
464 FRAME_PTR f;
465 int id;
467 return FRAME_X_DISPLAY_INFO (f)->bitmaps[id - 1].height;
471 x_bitmap_width (f, id)
472 FRAME_PTR f;
473 int id;
475 return FRAME_X_DISPLAY_INFO (f)->bitmaps[id - 1].width;
479 x_bitmap_pixmap (f, id)
480 FRAME_PTR f;
481 int id;
483 return FRAME_X_DISPLAY_INFO (f)->bitmaps[id - 1].pixmap;
487 /* Allocate a new bitmap record. Returns index of new record. */
489 static int
490 x_allocate_bitmap_record (f)
491 FRAME_PTR f;
493 struct x_display_info *dpyinfo = FRAME_X_DISPLAY_INFO (f);
494 int i;
496 if (dpyinfo->bitmaps == NULL)
498 dpyinfo->bitmaps_size = 10;
499 dpyinfo->bitmaps
500 = (struct x_bitmap_record *) xmalloc (dpyinfo->bitmaps_size * sizeof (struct x_bitmap_record));
501 dpyinfo->bitmaps_last = 1;
502 return 1;
505 if (dpyinfo->bitmaps_last < dpyinfo->bitmaps_size)
506 return ++dpyinfo->bitmaps_last;
508 for (i = 0; i < dpyinfo->bitmaps_size; ++i)
509 if (dpyinfo->bitmaps[i].refcount == 0)
510 return i + 1;
512 dpyinfo->bitmaps_size *= 2;
513 dpyinfo->bitmaps
514 = (struct x_bitmap_record *) xrealloc (dpyinfo->bitmaps,
515 dpyinfo->bitmaps_size * sizeof (struct x_bitmap_record));
516 return ++dpyinfo->bitmaps_last;
519 /* Add one reference to the reference count of the bitmap with id ID. */
521 void
522 x_reference_bitmap (f, id)
523 FRAME_PTR f;
524 int id;
526 ++FRAME_X_DISPLAY_INFO (f)->bitmaps[id - 1].refcount;
529 /* Create a bitmap for frame F from a HEIGHT x WIDTH array of bits at BITS. */
532 x_create_bitmap_from_data (f, bits, width, height)
533 struct frame *f;
534 char *bits;
535 unsigned int width, height;
537 struct x_display_info *dpyinfo = FRAME_X_DISPLAY_INFO (f);
538 Pixmap bitmap;
539 int id;
541 bitmap = XCreateBitmapFromData (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
542 bits, width, height);
544 if (! bitmap)
545 return -1;
547 id = x_allocate_bitmap_record (f);
548 dpyinfo->bitmaps[id - 1].pixmap = bitmap;
549 dpyinfo->bitmaps[id - 1].file = NULL;
550 dpyinfo->bitmaps[id - 1].refcount = 1;
551 dpyinfo->bitmaps[id - 1].depth = 1;
552 dpyinfo->bitmaps[id - 1].height = height;
553 dpyinfo->bitmaps[id - 1].width = width;
555 return id;
558 /* Create bitmap from file FILE for frame F. */
561 x_create_bitmap_from_file (f, file)
562 struct frame *f;
563 Lisp_Object file;
565 struct x_display_info *dpyinfo = FRAME_X_DISPLAY_INFO (f);
566 unsigned int width, height;
567 Pixmap bitmap;
568 int xhot, yhot, result, id;
569 Lisp_Object found;
570 int fd;
571 char *filename;
573 /* Look for an existing bitmap with the same name. */
574 for (id = 0; id < dpyinfo->bitmaps_last; ++id)
576 if (dpyinfo->bitmaps[id].refcount
577 && dpyinfo->bitmaps[id].file
578 && !strcmp (dpyinfo->bitmaps[id].file, (char *) XSTRING (file)->data))
580 ++dpyinfo->bitmaps[id].refcount;
581 return id + 1;
585 /* Search bitmap-file-path for the file, if appropriate. */
586 fd = openp (Vx_bitmap_file_path, file, "", &found, 0);
587 if (fd < 0)
588 return -1;
589 close (fd);
591 filename = (char *) XSTRING (found)->data;
593 result = XReadBitmapFile (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
594 filename, &width, &height, &bitmap, &xhot, &yhot);
595 if (result != BitmapSuccess)
596 return -1;
598 id = x_allocate_bitmap_record (f);
599 dpyinfo->bitmaps[id - 1].pixmap = bitmap;
600 dpyinfo->bitmaps[id - 1].refcount = 1;
601 dpyinfo->bitmaps[id - 1].file = (char *) xmalloc (XSTRING (file)->size + 1);
602 dpyinfo->bitmaps[id - 1].depth = 1;
603 dpyinfo->bitmaps[id - 1].height = height;
604 dpyinfo->bitmaps[id - 1].width = width;
605 strcpy (dpyinfo->bitmaps[id - 1].file, XSTRING (file)->data);
607 return id;
610 /* Remove reference to bitmap with id number ID. */
613 x_destroy_bitmap (f, id)
614 FRAME_PTR f;
615 int id;
617 struct x_display_info *dpyinfo = FRAME_X_DISPLAY_INFO (f);
619 if (id > 0)
621 --dpyinfo->bitmaps[id - 1].refcount;
622 if (dpyinfo->bitmaps[id - 1].refcount == 0)
624 BLOCK_INPUT;
625 XFreePixmap (FRAME_X_DISPLAY (f), dpyinfo->bitmaps[id - 1].pixmap);
626 if (dpyinfo->bitmaps[id - 1].file)
628 free (dpyinfo->bitmaps[id - 1].file);
629 dpyinfo->bitmaps[id - 1].file = NULL;
631 UNBLOCK_INPUT;
636 /* Free all the bitmaps for the display specified by DPYINFO. */
638 static void
639 x_destroy_all_bitmaps (dpyinfo)
640 struct x_display_info *dpyinfo;
642 int i;
643 for (i = 0; i < dpyinfo->bitmaps_last; i++)
644 if (dpyinfo->bitmaps[i].refcount > 0)
646 XFreePixmap (dpyinfo->display, dpyinfo->bitmaps[i].pixmap);
647 if (dpyinfo->bitmaps[i].file)
648 free (dpyinfo->bitmaps[i].file);
650 dpyinfo->bitmaps_last = 0;
653 /* Connect the frame-parameter names for X frames
654 to the ways of passing the parameter values to the window system.
656 The name of a parameter, as a Lisp symbol,
657 has an `x-frame-parameter' property which is an integer in Lisp
658 that is an index in this table. */
660 struct x_frame_parm_table
662 char *name;
663 void (*setter)( /* struct frame *frame, Lisp_Object val, oldval */ );
666 void x_set_foreground_color ();
667 void x_set_background_color ();
668 void x_set_mouse_color ();
669 void x_set_cursor_color ();
670 void x_set_border_color ();
671 void x_set_cursor_type ();
672 void x_set_icon_type ();
673 void x_set_icon_name ();
674 void x_set_font ();
675 void x_set_border_width ();
676 void x_set_internal_border_width ();
677 void x_explicitly_set_name ();
678 void x_set_autoraise ();
679 void x_set_autolower ();
680 void x_set_vertical_scroll_bars ();
681 void x_set_visibility ();
682 void x_set_menu_bar_lines ();
683 void x_set_scroll_bar_width ();
684 void x_set_title ();
685 void x_set_unsplittable ();
687 static struct x_frame_parm_table x_frame_parms[] =
689 "auto-raise", x_set_autoraise,
690 "auto-lower", x_set_autolower,
691 "background-color", x_set_background_color,
692 "border-color", x_set_border_color,
693 "border-width", x_set_border_width,
694 "cursor-color", x_set_cursor_color,
695 "cursor-type", x_set_cursor_type,
696 "font", x_set_font,
697 "foreground-color", x_set_foreground_color,
698 "icon-name", x_set_icon_name,
699 "icon-type", x_set_icon_type,
700 "internal-border-width", x_set_internal_border_width,
701 "menu-bar-lines", x_set_menu_bar_lines,
702 "mouse-color", x_set_mouse_color,
703 "name", x_explicitly_set_name,
704 "scroll-bar-width", x_set_scroll_bar_width,
705 "title", x_set_title,
706 "unsplittable", x_set_unsplittable,
707 "vertical-scroll-bars", x_set_vertical_scroll_bars,
708 "visibility", x_set_visibility,
711 /* Attach the `x-frame-parameter' properties to
712 the Lisp symbol names of parameters relevant to X. */
714 init_x_parm_symbols ()
716 int i;
718 for (i = 0; i < sizeof (x_frame_parms) / sizeof (x_frame_parms[0]); i++)
719 Fput (intern (x_frame_parms[i].name), Qx_frame_parameter,
720 make_number (i));
723 /* Change the parameters of FRAME as specified by ALIST.
724 If a parameter is not specially recognized, do nothing;
725 otherwise call the `x_set_...' function for that parameter. */
727 void
728 x_set_frame_parameters (f, alist)
729 FRAME_PTR f;
730 Lisp_Object alist;
732 Lisp_Object tail;
734 /* If both of these parameters are present, it's more efficient to
735 set them both at once. So we wait until we've looked at the
736 entire list before we set them. */
737 int width, height;
739 /* Same here. */
740 Lisp_Object left, top;
742 /* Same with these. */
743 Lisp_Object icon_left, icon_top;
745 /* Record in these vectors all the parms specified. */
746 Lisp_Object *parms;
747 Lisp_Object *values;
748 int i;
749 int left_no_change = 0, top_no_change = 0;
750 int icon_left_no_change = 0, icon_top_no_change = 0;
752 i = 0;
753 for (tail = alist; CONSP (tail); tail = Fcdr (tail))
754 i++;
756 parms = (Lisp_Object *) alloca (i * sizeof (Lisp_Object));
757 values = (Lisp_Object *) alloca (i * sizeof (Lisp_Object));
759 /* Extract parm names and values into those vectors. */
761 i = 0;
762 for (tail = alist; CONSP (tail); tail = Fcdr (tail))
764 Lisp_Object elt, prop, val;
766 elt = Fcar (tail);
767 parms[i] = Fcar (elt);
768 values[i] = Fcdr (elt);
769 i++;
772 top = left = Qunbound;
773 icon_left = icon_top = Qunbound;
775 /* Provide default values for HEIGHT and WIDTH. */
776 if (FRAME_NEW_WIDTH (f))
777 width = FRAME_NEW_WIDTH (f);
778 else
779 width = FRAME_WIDTH (f);
781 if (FRAME_NEW_HEIGHT (f))
782 height = FRAME_NEW_HEIGHT (f);
783 else
784 height = FRAME_HEIGHT (f);
786 /* Now process them in reverse of specified order. */
787 for (i--; i >= 0; i--)
789 Lisp_Object prop, val;
791 prop = parms[i];
792 val = values[i];
794 if (EQ (prop, Qwidth) && NUMBERP (val))
795 width = XFASTINT (val);
796 else if (EQ (prop, Qheight) && NUMBERP (val))
797 height = XFASTINT (val);
798 else if (EQ (prop, Qtop))
799 top = val;
800 else if (EQ (prop, Qleft))
801 left = val;
802 else if (EQ (prop, Qicon_top))
803 icon_top = val;
804 else if (EQ (prop, Qicon_left))
805 icon_left = val;
806 else
808 register Lisp_Object param_index, old_value;
810 param_index = Fget (prop, Qx_frame_parameter);
811 old_value = get_frame_param (f, prop);
812 store_frame_param (f, prop, val);
813 if (NATNUMP (param_index)
814 && (XFASTINT (param_index)
815 < sizeof (x_frame_parms)/sizeof (x_frame_parms[0])))
816 (*x_frame_parms[XINT (param_index)].setter)(f, val, old_value);
820 /* Don't die if just one of these was set. */
821 if (EQ (left, Qunbound))
823 left_no_change = 1;
824 if (f->output_data.x->left_pos < 0)
825 left = Fcons (Qplus, Fcons (make_number (f->output_data.x->left_pos), Qnil));
826 else
827 XSETINT (left, f->output_data.x->left_pos);
829 if (EQ (top, Qunbound))
831 top_no_change = 1;
832 if (f->output_data.x->top_pos < 0)
833 top = Fcons (Qplus, Fcons (make_number (f->output_data.x->top_pos), Qnil));
834 else
835 XSETINT (top, f->output_data.x->top_pos);
838 /* If one of the icon positions was not set, preserve or default it. */
839 if (EQ (icon_left, Qunbound) || ! INTEGERP (icon_left))
841 icon_left_no_change = 1;
842 icon_left = Fcdr (Fassq (Qicon_left, f->param_alist));
843 if (NILP (icon_left))
844 XSETINT (icon_left, 0);
846 if (EQ (icon_top, Qunbound) || ! INTEGERP (icon_top))
848 icon_top_no_change = 1;
849 icon_top = Fcdr (Fassq (Qicon_top, f->param_alist));
850 if (NILP (icon_top))
851 XSETINT (icon_top, 0);
854 /* Don't set these parameters unless they've been explicitly
855 specified. The window might be mapped or resized while we're in
856 this function, and we don't want to override that unless the lisp
857 code has asked for it.
859 Don't set these parameters unless they actually differ from the
860 window's current parameters; the window may not actually exist
861 yet. */
863 Lisp_Object frame;
865 check_frame_size (f, &height, &width);
867 XSETFRAME (frame, f);
869 if (width != FRAME_WIDTH (f)
870 || height != FRAME_HEIGHT (f)
871 || FRAME_NEW_HEIGHT (f) || FRAME_NEW_WIDTH (f))
872 Fset_frame_size (frame, make_number (width), make_number (height));
874 if ((!NILP (left) || !NILP (top))
875 && ! (left_no_change && top_no_change)
876 && ! (NUMBERP (left) && XINT (left) == f->output_data.x->left_pos
877 && NUMBERP (top) && XINT (top) == f->output_data.x->top_pos))
879 int leftpos = 0;
880 int toppos = 0;
882 /* Record the signs. */
883 f->output_data.x->size_hint_flags &= ~ (XNegative | YNegative);
884 if (EQ (left, Qminus))
885 f->output_data.x->size_hint_flags |= XNegative;
886 else if (INTEGERP (left))
888 leftpos = XINT (left);
889 if (leftpos < 0)
890 f->output_data.x->size_hint_flags |= XNegative;
892 else if (CONSP (left) && EQ (XCONS (left)->car, Qminus)
893 && CONSP (XCONS (left)->cdr)
894 && INTEGERP (XCONS (XCONS (left)->cdr)->car))
896 leftpos = - XINT (XCONS (XCONS (left)->cdr)->car);
897 f->output_data.x->size_hint_flags |= XNegative;
899 else if (CONSP (left) && EQ (XCONS (left)->car, Qplus)
900 && CONSP (XCONS (left)->cdr)
901 && INTEGERP (XCONS (XCONS (left)->cdr)->car))
903 leftpos = XINT (XCONS (XCONS (left)->cdr)->car);
906 if (EQ (top, Qminus))
907 f->output_data.x->size_hint_flags |= YNegative;
908 else if (INTEGERP (top))
910 toppos = XINT (top);
911 if (toppos < 0)
912 f->output_data.x->size_hint_flags |= YNegative;
914 else if (CONSP (top) && EQ (XCONS (top)->car, Qminus)
915 && CONSP (XCONS (top)->cdr)
916 && INTEGERP (XCONS (XCONS (top)->cdr)->car))
918 toppos = - XINT (XCONS (XCONS (top)->cdr)->car);
919 f->output_data.x->size_hint_flags |= YNegative;
921 else if (CONSP (top) && EQ (XCONS (top)->car, Qplus)
922 && CONSP (XCONS (top)->cdr)
923 && INTEGERP (XCONS (XCONS (top)->cdr)->car))
925 toppos = XINT (XCONS (XCONS (top)->cdr)->car);
929 /* Store the numeric value of the position. */
930 f->output_data.x->top_pos = toppos;
931 f->output_data.x->left_pos = leftpos;
933 f->output_data.x->win_gravity = NorthWestGravity;
935 /* Actually set that position, and convert to absolute. */
936 x_set_offset (f, leftpos, toppos, -1);
939 if ((!NILP (icon_left) || !NILP (icon_top))
940 && ! (icon_left_no_change && icon_top_no_change))
941 x_wm_set_icon_position (f, XINT (icon_left), XINT (icon_top));
945 /* Store the screen positions of frame F into XPTR and YPTR.
946 These are the positions of the containing window manager window,
947 not Emacs's own window. */
949 void
950 x_real_positions (f, xptr, yptr)
951 FRAME_PTR f;
952 int *xptr, *yptr;
954 int win_x, win_y;
955 Window child;
957 /* This is pretty gross, but seems to be the easiest way out of
958 the problem that arises when restarting window-managers. */
960 #ifdef USE_X_TOOLKIT
961 Window outer = XtWindow (f->output_data.x->widget);
962 #else
963 Window outer = f->output_data.x->window_desc;
964 #endif
965 Window tmp_root_window;
966 Window *tmp_children;
967 int tmp_nchildren;
969 while (1)
971 int count = x_catch_errors (FRAME_X_DISPLAY (f));
972 Window outer_window;
974 XQueryTree (FRAME_X_DISPLAY (f), outer, &tmp_root_window,
975 &f->output_data.x->parent_desc,
976 &tmp_children, &tmp_nchildren);
977 XFree ((char *) tmp_children);
979 win_x = win_y = 0;
981 /* Find the position of the outside upper-left corner of
982 the inner window, with respect to the outer window. */
983 if (f->output_data.x->parent_desc != FRAME_X_DISPLAY_INFO (f)->root_window)
984 outer_window = f->output_data.x->parent_desc;
985 else
986 outer_window = outer;
988 XTranslateCoordinates (FRAME_X_DISPLAY (f),
990 /* From-window, to-window. */
991 outer_window,
992 FRAME_X_DISPLAY_INFO (f)->root_window,
994 /* From-position, to-position. */
995 0, 0, &win_x, &win_y,
997 /* Child of win. */
998 &child);
1000 /* It is possible for the window returned by the XQueryNotify
1001 to become invalid by the time we call XTranslateCoordinates.
1002 That can happen when you restart some window managers.
1003 If so, we get an error in XTranslateCoordinates.
1004 Detect that and try the whole thing over. */
1005 if (! x_had_errors_p (FRAME_X_DISPLAY (f)))
1007 x_uncatch_errors (FRAME_X_DISPLAY (f), count);
1008 break;
1011 x_uncatch_errors (FRAME_X_DISPLAY (f), count);
1014 *xptr = win_x - f->output_data.x->border_width;
1015 *yptr = win_y - f->output_data.x->border_width;
1018 /* Insert a description of internally-recorded parameters of frame X
1019 into the parameter alist *ALISTPTR that is to be given to the user.
1020 Only parameters that are specific to the X window system
1021 and whose values are not correctly recorded in the frame's
1022 param_alist need to be considered here. */
1024 x_report_frame_params (f, alistptr)
1025 struct frame *f;
1026 Lisp_Object *alistptr;
1028 char buf[16];
1029 Lisp_Object tem;
1031 /* Represent negative positions (off the top or left screen edge)
1032 in a way that Fmodify_frame_parameters will understand correctly. */
1033 XSETINT (tem, f->output_data.x->left_pos);
1034 if (f->output_data.x->left_pos >= 0)
1035 store_in_alist (alistptr, Qleft, tem);
1036 else
1037 store_in_alist (alistptr, Qleft, Fcons (Qplus, Fcons (tem, Qnil)));
1039 XSETINT (tem, f->output_data.x->top_pos);
1040 if (f->output_data.x->top_pos >= 0)
1041 store_in_alist (alistptr, Qtop, tem);
1042 else
1043 store_in_alist (alistptr, Qtop, Fcons (Qplus, Fcons (tem, Qnil)));
1045 store_in_alist (alistptr, Qborder_width,
1046 make_number (f->output_data.x->border_width));
1047 store_in_alist (alistptr, Qinternal_border_width,
1048 make_number (f->output_data.x->internal_border_width));
1049 sprintf (buf, "%ld", (long) FRAME_X_WINDOW (f));
1050 store_in_alist (alistptr, Qwindow_id,
1051 build_string (buf));
1052 store_in_alist (alistptr, Qicon_name, f->icon_name);
1053 FRAME_SAMPLE_VISIBILITY (f);
1054 store_in_alist (alistptr, Qvisibility,
1055 (FRAME_VISIBLE_P (f) ? Qt
1056 : FRAME_ICONIFIED_P (f) ? Qicon : Qnil));
1057 store_in_alist (alistptr, Qdisplay,
1058 XCONS (FRAME_X_DISPLAY_INFO (f)->name_list_element)->car);
1060 store_in_alist (alistptr, Qparent_id,
1061 (f->output_data.x->parent_desc == FRAME_X_DISPLAY_INFO (f)->root_window
1062 ? Qnil : f->output_data.x->parent_desc));
1066 /* Decide if color named COLOR is valid for the display associated with
1067 the selected frame; if so, return the rgb values in COLOR_DEF.
1068 If ALLOC is nonzero, allocate a new colormap cell. */
1071 defined_color (f, color, color_def, alloc)
1072 FRAME_PTR f;
1073 char *color;
1074 XColor *color_def;
1075 int alloc;
1077 register int status;
1078 Colormap screen_colormap;
1079 Display *display = FRAME_X_DISPLAY (f);
1081 BLOCK_INPUT;
1082 screen_colormap = DefaultColormap (display, XDefaultScreen (display));
1084 status = XParseColor (display, screen_colormap, color, color_def);
1085 if (status && alloc)
1087 status = XAllocColor (display, screen_colormap, color_def);
1088 if (!status)
1090 /* If we got to this point, the colormap is full, so we're
1091 going to try and get the next closest color.
1092 The algorithm used is a least-squares matching, which is
1093 what X uses for closest color matching with StaticColor visuals. */
1095 XColor *cells;
1096 int no_cells;
1097 int nearest;
1098 long nearest_delta, trial_delta;
1099 int x;
1101 no_cells = XDisplayCells (display, XDefaultScreen (display));
1102 cells = (XColor *) alloca (sizeof (XColor) * no_cells);
1104 for (x = 0; x < no_cells; x++)
1105 cells[x].pixel = x;
1107 XQueryColors (display, screen_colormap, cells, no_cells);
1108 nearest = 0;
1109 /* I'm assuming CSE so I'm not going to condense this. */
1110 nearest_delta = ((((color_def->red >> 8) - (cells[0].red >> 8))
1111 * ((color_def->red >> 8) - (cells[0].red >> 8)))
1113 (((color_def->green >> 8) - (cells[0].green >> 8))
1114 * ((color_def->green >> 8) - (cells[0].green >> 8)))
1116 (((color_def->blue >> 8) - (cells[0].blue >> 8))
1117 * ((color_def->blue >> 8) - (cells[0].blue >> 8))));
1118 for (x = 1; x < no_cells; x++)
1120 trial_delta = ((((color_def->red >> 8) - (cells[x].red >> 8))
1121 * ((color_def->red >> 8) - (cells[x].red >> 8)))
1123 (((color_def->green >> 8) - (cells[x].green >> 8))
1124 * ((color_def->green >> 8) - (cells[x].green >> 8)))
1126 (((color_def->blue >> 8) - (cells[x].blue >> 8))
1127 * ((color_def->blue >> 8) - (cells[x].blue >> 8))));
1128 if (trial_delta < nearest_delta)
1130 XColor temp;
1131 temp.red = cells[x].red;
1132 temp.green = cells[x].green;
1133 temp.blue = cells[x].blue;
1134 status = XAllocColor (display, screen_colormap, &temp);
1135 if (status)
1137 nearest = x;
1138 nearest_delta = trial_delta;
1142 color_def->red = cells[nearest].red;
1143 color_def->green = cells[nearest].green;
1144 color_def->blue = cells[nearest].blue;
1145 status = XAllocColor (display, screen_colormap, color_def);
1148 UNBLOCK_INPUT;
1150 if (status)
1151 return 1;
1152 else
1153 return 0;
1156 /* Given a string ARG naming a color, compute a pixel value from it
1157 suitable for screen F.
1158 If F is not a color screen, return DEF (default) regardless of what
1159 ARG says. */
1162 x_decode_color (f, arg, def)
1163 FRAME_PTR f;
1164 Lisp_Object arg;
1165 int def;
1167 XColor cdef;
1169 CHECK_STRING (arg, 0);
1171 if (strcmp (XSTRING (arg)->data, "black") == 0)
1172 return BLACK_PIX_DEFAULT (f);
1173 else if (strcmp (XSTRING (arg)->data, "white") == 0)
1174 return WHITE_PIX_DEFAULT (f);
1176 if (FRAME_X_DISPLAY_INFO (f)->n_planes == 1)
1177 return def;
1179 /* defined_color is responsible for coping with failures
1180 by looking for a near-miss. */
1181 if (defined_color (f, XSTRING (arg)->data, &cdef, 1))
1182 return cdef.pixel;
1184 Fsignal (Qerror, Fcons (build_string ("undefined color"),
1185 Fcons (arg, Qnil)));
1188 /* Functions called only from `x_set_frame_param'
1189 to set individual parameters.
1191 If FRAME_X_WINDOW (f) is 0,
1192 the frame is being created and its X-window does not exist yet.
1193 In that case, just record the parameter's new value
1194 in the standard place; do not attempt to change the window. */
1196 void
1197 x_set_foreground_color (f, arg, oldval)
1198 struct frame *f;
1199 Lisp_Object arg, oldval;
1201 f->output_data.x->foreground_pixel
1202 = x_decode_color (f, arg, BLACK_PIX_DEFAULT (f));
1203 if (FRAME_X_WINDOW (f) != 0)
1205 BLOCK_INPUT;
1206 XSetForeground (FRAME_X_DISPLAY (f), f->output_data.x->normal_gc,
1207 f->output_data.x->foreground_pixel);
1208 XSetBackground (FRAME_X_DISPLAY (f), f->output_data.x->reverse_gc,
1209 f->output_data.x->foreground_pixel);
1210 UNBLOCK_INPUT;
1211 recompute_basic_faces (f);
1212 if (FRAME_VISIBLE_P (f))
1213 redraw_frame (f);
1217 void
1218 x_set_background_color (f, arg, oldval)
1219 struct frame *f;
1220 Lisp_Object arg, oldval;
1222 Pixmap temp;
1223 int mask;
1225 f->output_data.x->background_pixel
1226 = x_decode_color (f, arg, WHITE_PIX_DEFAULT (f));
1228 if (FRAME_X_WINDOW (f) != 0)
1230 BLOCK_INPUT;
1231 /* The main frame area. */
1232 XSetBackground (FRAME_X_DISPLAY (f), f->output_data.x->normal_gc,
1233 f->output_data.x->background_pixel);
1234 XSetForeground (FRAME_X_DISPLAY (f), f->output_data.x->reverse_gc,
1235 f->output_data.x->background_pixel);
1236 XSetForeground (FRAME_X_DISPLAY (f), f->output_data.x->cursor_gc,
1237 f->output_data.x->background_pixel);
1238 XSetWindowBackground (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
1239 f->output_data.x->background_pixel);
1241 Lisp_Object bar;
1242 for (bar = FRAME_SCROLL_BARS (f); !NILP (bar);
1243 bar = XSCROLL_BAR (bar)->next)
1244 XSetWindowBackground (FRAME_X_DISPLAY (f),
1245 SCROLL_BAR_X_WINDOW (XSCROLL_BAR (bar)),
1246 f->output_data.x->background_pixel);
1248 UNBLOCK_INPUT;
1250 recompute_basic_faces (f);
1252 if (FRAME_VISIBLE_P (f))
1253 redraw_frame (f);
1257 void
1258 x_set_mouse_color (f, arg, oldval)
1259 struct frame *f;
1260 Lisp_Object arg, oldval;
1262 Cursor cursor, nontext_cursor, mode_cursor, cross_cursor;
1263 int count;
1264 int mask_color;
1266 if (!EQ (Qnil, arg))
1267 f->output_data.x->mouse_pixel
1268 = x_decode_color (f, arg, BLACK_PIX_DEFAULT (f));
1269 mask_color = f->output_data.x->background_pixel;
1270 /* No invisible pointers. */
1271 if (mask_color == f->output_data.x->mouse_pixel
1272 && mask_color == f->output_data.x->background_pixel)
1273 f->output_data.x->mouse_pixel = f->output_data.x->foreground_pixel;
1275 BLOCK_INPUT;
1277 /* It's not okay to crash if the user selects a screwy cursor. */
1278 count = x_catch_errors (FRAME_X_DISPLAY (f));
1280 if (!EQ (Qnil, Vx_pointer_shape))
1282 CHECK_NUMBER (Vx_pointer_shape, 0);
1283 cursor = XCreateFontCursor (FRAME_X_DISPLAY (f), XINT (Vx_pointer_shape));
1285 else
1286 cursor = XCreateFontCursor (FRAME_X_DISPLAY (f), XC_xterm);
1287 x_check_errors (FRAME_X_DISPLAY (f), "bad text pointer cursor: %s");
1289 if (!EQ (Qnil, Vx_nontext_pointer_shape))
1291 CHECK_NUMBER (Vx_nontext_pointer_shape, 0);
1292 nontext_cursor = XCreateFontCursor (FRAME_X_DISPLAY (f),
1293 XINT (Vx_nontext_pointer_shape));
1295 else
1296 nontext_cursor = XCreateFontCursor (FRAME_X_DISPLAY (f), XC_left_ptr);
1297 x_check_errors (FRAME_X_DISPLAY (f), "bad nontext pointer cursor: %s");
1299 if (!EQ (Qnil, Vx_mode_pointer_shape))
1301 CHECK_NUMBER (Vx_mode_pointer_shape, 0);
1302 mode_cursor = XCreateFontCursor (FRAME_X_DISPLAY (f),
1303 XINT (Vx_mode_pointer_shape));
1305 else
1306 mode_cursor = XCreateFontCursor (FRAME_X_DISPLAY (f), XC_xterm);
1307 x_check_errors (FRAME_X_DISPLAY (f), "bad modeline pointer cursor: %s");
1309 if (!EQ (Qnil, Vx_sensitive_text_pointer_shape))
1311 CHECK_NUMBER (Vx_sensitive_text_pointer_shape, 0);
1312 cross_cursor
1313 = XCreateFontCursor (FRAME_X_DISPLAY (f),
1314 XINT (Vx_sensitive_text_pointer_shape));
1316 else
1317 cross_cursor = XCreateFontCursor (FRAME_X_DISPLAY (f), XC_crosshair);
1319 /* Check and report errors with the above calls. */
1320 x_check_errors (FRAME_X_DISPLAY (f), "can't set cursor shape: %s");
1321 x_uncatch_errors (FRAME_X_DISPLAY (f), count);
1324 XColor fore_color, back_color;
1326 fore_color.pixel = f->output_data.x->mouse_pixel;
1327 back_color.pixel = mask_color;
1328 XQueryColor (FRAME_X_DISPLAY (f),
1329 DefaultColormap (FRAME_X_DISPLAY (f),
1330 DefaultScreen (FRAME_X_DISPLAY (f))),
1331 &fore_color);
1332 XQueryColor (FRAME_X_DISPLAY (f),
1333 DefaultColormap (FRAME_X_DISPLAY (f),
1334 DefaultScreen (FRAME_X_DISPLAY (f))),
1335 &back_color);
1336 XRecolorCursor (FRAME_X_DISPLAY (f), cursor,
1337 &fore_color, &back_color);
1338 XRecolorCursor (FRAME_X_DISPLAY (f), nontext_cursor,
1339 &fore_color, &back_color);
1340 XRecolorCursor (FRAME_X_DISPLAY (f), mode_cursor,
1341 &fore_color, &back_color);
1342 XRecolorCursor (FRAME_X_DISPLAY (f), cross_cursor,
1343 &fore_color, &back_color);
1346 if (FRAME_X_WINDOW (f) != 0)
1348 XDefineCursor (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f), cursor);
1351 if (cursor != f->output_data.x->text_cursor && f->output_data.x->text_cursor != 0)
1352 XFreeCursor (FRAME_X_DISPLAY (f), f->output_data.x->text_cursor);
1353 f->output_data.x->text_cursor = cursor;
1355 if (nontext_cursor != f->output_data.x->nontext_cursor
1356 && f->output_data.x->nontext_cursor != 0)
1357 XFreeCursor (FRAME_X_DISPLAY (f), f->output_data.x->nontext_cursor);
1358 f->output_data.x->nontext_cursor = nontext_cursor;
1360 if (mode_cursor != f->output_data.x->modeline_cursor
1361 && f->output_data.x->modeline_cursor != 0)
1362 XFreeCursor (FRAME_X_DISPLAY (f), f->output_data.x->modeline_cursor);
1363 f->output_data.x->modeline_cursor = mode_cursor;
1364 if (cross_cursor != f->output_data.x->cross_cursor
1365 && f->output_data.x->cross_cursor != 0)
1366 XFreeCursor (FRAME_X_DISPLAY (f), f->output_data.x->cross_cursor);
1367 f->output_data.x->cross_cursor = cross_cursor;
1369 XFlush (FRAME_X_DISPLAY (f));
1370 UNBLOCK_INPUT;
1373 void
1374 x_set_cursor_color (f, arg, oldval)
1375 struct frame *f;
1376 Lisp_Object arg, oldval;
1378 unsigned long fore_pixel;
1380 if (!EQ (Vx_cursor_fore_pixel, Qnil))
1381 fore_pixel = x_decode_color (f, Vx_cursor_fore_pixel,
1382 WHITE_PIX_DEFAULT (f));
1383 else
1384 fore_pixel = f->output_data.x->background_pixel;
1385 f->output_data.x->cursor_pixel = x_decode_color (f, arg, BLACK_PIX_DEFAULT (f));
1387 /* Make sure that the cursor color differs from the background color. */
1388 if (f->output_data.x->cursor_pixel == f->output_data.x->background_pixel)
1390 f->output_data.x->cursor_pixel = f->output_data.x->mouse_pixel;
1391 if (f->output_data.x->cursor_pixel == fore_pixel)
1392 fore_pixel = f->output_data.x->background_pixel;
1394 f->output_data.x->cursor_foreground_pixel = fore_pixel;
1396 if (FRAME_X_WINDOW (f) != 0)
1398 BLOCK_INPUT;
1399 XSetBackground (FRAME_X_DISPLAY (f), f->output_data.x->cursor_gc,
1400 f->output_data.x->cursor_pixel);
1401 XSetForeground (FRAME_X_DISPLAY (f), f->output_data.x->cursor_gc,
1402 fore_pixel);
1403 UNBLOCK_INPUT;
1405 if (FRAME_VISIBLE_P (f))
1407 x_update_cursor (f, 0);
1408 x_update_cursor (f, 1);
1413 /* Set the border-color of frame F to value described by ARG.
1414 ARG can be a string naming a color.
1415 The border-color is used for the border that is drawn by the X server.
1416 Note that this does not fully take effect if done before
1417 F has an x-window; it must be redone when the window is created.
1419 Note: this is done in two routines because of the way X10 works.
1421 Note: under X11, this is normally the province of the window manager,
1422 and so emacs' border colors may be overridden. */
1424 void
1425 x_set_border_color (f, arg, oldval)
1426 struct frame *f;
1427 Lisp_Object arg, oldval;
1429 unsigned char *str;
1430 int pix;
1432 CHECK_STRING (arg, 0);
1433 str = XSTRING (arg)->data;
1435 pix = x_decode_color (f, arg, BLACK_PIX_DEFAULT (f));
1437 x_set_border_pixel (f, pix);
1440 /* Set the border-color of frame F to pixel value PIX.
1441 Note that this does not fully take effect if done before
1442 F has an x-window. */
1444 x_set_border_pixel (f, pix)
1445 struct frame *f;
1446 int pix;
1448 f->output_data.x->border_pixel = pix;
1450 if (FRAME_X_WINDOW (f) != 0 && f->output_data.x->border_width > 0)
1452 Pixmap temp;
1453 int mask;
1455 BLOCK_INPUT;
1456 XSetWindowBorder (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
1457 (unsigned long)pix);
1458 UNBLOCK_INPUT;
1460 if (FRAME_VISIBLE_P (f))
1461 redraw_frame (f);
1465 void
1466 x_set_cursor_type (f, arg, oldval)
1467 FRAME_PTR f;
1468 Lisp_Object arg, oldval;
1470 if (EQ (arg, Qbar))
1472 FRAME_DESIRED_CURSOR (f) = bar_cursor;
1473 f->output_data.x->cursor_width = 2;
1475 else if (CONSP (arg) && EQ (XCONS (arg)->car, Qbar)
1476 && INTEGERP (XCONS (arg)->cdr))
1478 FRAME_DESIRED_CURSOR (f) = bar_cursor;
1479 f->output_data.x->cursor_width = XINT (XCONS (arg)->cdr);
1481 else
1482 /* Treat anything unknown as "box cursor".
1483 It was bad to signal an error; people have trouble fixing
1484 .Xdefaults with Emacs, when it has something bad in it. */
1485 FRAME_DESIRED_CURSOR (f) = filled_box_cursor;
1487 /* Make sure the cursor gets redrawn. This is overkill, but how
1488 often do people change cursor types? */
1489 update_mode_lines++;
1492 void
1493 x_set_icon_type (f, arg, oldval)
1494 struct frame *f;
1495 Lisp_Object arg, oldval;
1497 Lisp_Object tem;
1498 int result;
1500 if (STRINGP (arg))
1502 if (STRINGP (oldval) && EQ (Fstring_equal (oldval, arg), Qt))
1503 return;
1505 else if (!STRINGP (oldval) && EQ (oldval, Qnil) == EQ (arg, Qnil))
1506 return;
1508 BLOCK_INPUT;
1509 if (NILP (arg))
1510 result = x_text_icon (f,
1511 (char *) XSTRING ((!NILP (f->icon_name)
1512 ? f->icon_name
1513 : f->name))->data);
1514 else
1515 result = x_bitmap_icon (f, arg);
1517 if (result)
1519 UNBLOCK_INPUT;
1520 error ("No icon window available");
1523 XFlush (FRAME_X_DISPLAY (f));
1524 UNBLOCK_INPUT;
1527 /* Return non-nil if frame F wants a bitmap icon. */
1529 Lisp_Object
1530 x_icon_type (f)
1531 FRAME_PTR f;
1533 Lisp_Object tem;
1535 tem = assq_no_quit (Qicon_type, f->param_alist);
1536 if (CONSP (tem))
1537 return XCONS (tem)->cdr;
1538 else
1539 return Qnil;
1542 void
1543 x_set_icon_name (f, arg, oldval)
1544 struct frame *f;
1545 Lisp_Object arg, oldval;
1547 Lisp_Object tem;
1548 int result;
1550 if (STRINGP (arg))
1552 if (STRINGP (oldval) && EQ (Fstring_equal (oldval, arg), Qt))
1553 return;
1555 else if (!STRINGP (oldval) && EQ (oldval, Qnil) == EQ (arg, Qnil))
1556 return;
1558 f->icon_name = arg;
1560 if (f->output_data.x->icon_bitmap != 0)
1561 return;
1563 BLOCK_INPUT;
1565 result = x_text_icon (f,
1566 (char *) XSTRING ((!NILP (f->icon_name)
1567 ? f->icon_name
1568 : !NILP (f->title)
1569 ? f->title
1570 : f->name))->data);
1572 if (result)
1574 UNBLOCK_INPUT;
1575 error ("No icon window available");
1578 XFlush (FRAME_X_DISPLAY (f));
1579 UNBLOCK_INPUT;
1582 extern Lisp_Object x_new_font ();
1584 void
1585 x_set_font (f, arg, oldval)
1586 struct frame *f;
1587 Lisp_Object arg, oldval;
1589 Lisp_Object result;
1590 Lisp_Object fontset_name;
1592 CHECK_STRING (arg, 1);
1594 fontset_name = Fquery_fontset (arg);
1596 BLOCK_INPUT;
1597 result = (STRINGP (fontset_name)
1598 ? x_new_fontset (f, XSTRING (fontset_name)->data)
1599 : x_new_font (f, XSTRING (arg)->data));
1600 UNBLOCK_INPUT;
1602 if (EQ (result, Qnil))
1603 error ("Font `%s' is not defined", XSTRING (arg)->data);
1604 else if (EQ (result, Qt))
1605 error ("the characters of the given font have varying widths");
1606 else if (STRINGP (result))
1608 recompute_basic_faces (f);
1609 store_frame_param (f, Qfont, result);
1611 else
1612 abort ();
1615 void
1616 x_set_border_width (f, arg, oldval)
1617 struct frame *f;
1618 Lisp_Object arg, oldval;
1620 CHECK_NUMBER (arg, 0);
1622 if (XINT (arg) == f->output_data.x->border_width)
1623 return;
1625 if (FRAME_X_WINDOW (f) != 0)
1626 error ("Cannot change the border width of a window");
1628 f->output_data.x->border_width = XINT (arg);
1631 void
1632 x_set_internal_border_width (f, arg, oldval)
1633 struct frame *f;
1634 Lisp_Object arg, oldval;
1636 int mask;
1637 int old = f->output_data.x->internal_border_width;
1639 CHECK_NUMBER (arg, 0);
1640 f->output_data.x->internal_border_width = XINT (arg);
1641 if (f->output_data.x->internal_border_width < 0)
1642 f->output_data.x->internal_border_width = 0;
1644 #ifdef USE_X_TOOLKIT
1645 if (f->output_data.x->edit_widget)
1646 widget_store_internal_border (f->output_data.x->edit_widget,
1647 f->output_data.x->internal_border_width);
1648 #endif
1650 if (f->output_data.x->internal_border_width == old)
1651 return;
1653 if (FRAME_X_WINDOW (f) != 0)
1655 BLOCK_INPUT;
1656 x_set_window_size (f, 0, f->width, f->height);
1657 #if 0
1658 x_set_resize_hint (f);
1659 #endif
1660 XFlush (FRAME_X_DISPLAY (f));
1661 UNBLOCK_INPUT;
1662 SET_FRAME_GARBAGED (f);
1666 void
1667 x_set_visibility (f, value, oldval)
1668 struct frame *f;
1669 Lisp_Object value, oldval;
1671 Lisp_Object frame;
1672 XSETFRAME (frame, f);
1674 if (NILP (value))
1675 Fmake_frame_invisible (frame, Qt);
1676 else if (EQ (value, Qicon))
1677 Ficonify_frame (frame);
1678 else
1679 Fmake_frame_visible (frame);
1682 static void
1683 x_set_menu_bar_lines_1 (window, n)
1684 Lisp_Object window;
1685 int n;
1687 struct window *w = XWINDOW (window);
1689 XSETFASTINT (w->top, XFASTINT (w->top) + n);
1690 XSETFASTINT (w->height, XFASTINT (w->height) - n);
1692 /* Handle just the top child in a vertical split. */
1693 if (!NILP (w->vchild))
1694 x_set_menu_bar_lines_1 (w->vchild, n);
1696 /* Adjust all children in a horizontal split. */
1697 for (window = w->hchild; !NILP (window); window = w->next)
1699 w = XWINDOW (window);
1700 x_set_menu_bar_lines_1 (window, n);
1704 void
1705 x_set_menu_bar_lines (f, value, oldval)
1706 struct frame *f;
1707 Lisp_Object value, oldval;
1709 int nlines;
1710 int olines = FRAME_MENU_BAR_LINES (f);
1712 /* Right now, menu bars don't work properly in minibuf-only frames;
1713 most of the commands try to apply themselves to the minibuffer
1714 frame itslef, and get an error because you can't switch buffers
1715 in or split the minibuffer window. */
1716 if (FRAME_MINIBUF_ONLY_P (f))
1717 return;
1719 if (INTEGERP (value))
1720 nlines = XINT (value);
1721 else
1722 nlines = 0;
1724 /* Make sure we redisplay all windows in this frame. */
1725 windows_or_buffers_changed++;
1727 #ifdef USE_X_TOOLKIT
1728 FRAME_MENU_BAR_LINES (f) = 0;
1729 if (nlines)
1731 FRAME_EXTERNAL_MENU_BAR (f) = 1;
1732 if (FRAME_X_P (f) && f->output_data.x->menubar_widget == 0)
1733 /* Make sure next redisplay shows the menu bar. */
1734 XWINDOW (FRAME_SELECTED_WINDOW (f))->update_mode_line = Qt;
1736 else
1738 if (FRAME_EXTERNAL_MENU_BAR (f) == 1)
1739 free_frame_menubar (f);
1740 FRAME_EXTERNAL_MENU_BAR (f) = 0;
1741 if (FRAME_X_P (f))
1742 f->output_data.x->menubar_widget = 0;
1744 #else /* not USE_X_TOOLKIT */
1745 FRAME_MENU_BAR_LINES (f) = nlines;
1746 x_set_menu_bar_lines_1 (f->root_window, nlines - olines);
1747 #endif /* not USE_X_TOOLKIT */
1750 /* Change the name of frame F to NAME. If NAME is nil, set F's name to
1751 x_id_name.
1753 If EXPLICIT is non-zero, that indicates that lisp code is setting the
1754 name; if NAME is a string, set F's name to NAME and set
1755 F->explicit_name; if NAME is Qnil, then clear F->explicit_name.
1757 If EXPLICIT is zero, that indicates that Emacs redisplay code is
1758 suggesting a new name, which lisp code should override; if
1759 F->explicit_name is set, ignore the new name; otherwise, set it. */
1761 void
1762 x_set_name (f, name, explicit)
1763 struct frame *f;
1764 Lisp_Object name;
1765 int explicit;
1767 /* Make sure that requests from lisp code override requests from
1768 Emacs redisplay code. */
1769 if (explicit)
1771 /* If we're switching from explicit to implicit, we had better
1772 update the mode lines and thereby update the title. */
1773 if (f->explicit_name && NILP (name))
1774 update_mode_lines = 1;
1776 f->explicit_name = ! NILP (name);
1778 else if (f->explicit_name)
1779 return;
1781 /* If NAME is nil, set the name to the x_id_name. */
1782 if (NILP (name))
1784 /* Check for no change needed in this very common case
1785 before we do any consing. */
1786 if (!strcmp (FRAME_X_DISPLAY_INFO (f)->x_id_name,
1787 XSTRING (f->name)->data))
1788 return;
1789 name = build_string (FRAME_X_DISPLAY_INFO (f)->x_id_name);
1791 else
1792 CHECK_STRING (name, 0);
1794 /* Don't change the name if it's already NAME. */
1795 if (! NILP (Fstring_equal (name, f->name)))
1796 return;
1798 f->name = name;
1800 /* For setting the frame title, the title parameter should override
1801 the name parameter. */
1802 if (! NILP (f->title))
1803 name = f->title;
1805 if (FRAME_X_WINDOW (f))
1807 BLOCK_INPUT;
1808 #ifdef HAVE_X11R4
1810 XTextProperty text, icon;
1811 Lisp_Object icon_name;
1813 text.value = XSTRING (name)->data;
1814 text.encoding = XA_STRING;
1815 text.format = 8;
1816 text.nitems = XSTRING (name)->size;
1818 icon_name = (!NILP (f->icon_name) ? f->icon_name : name);
1820 icon.value = XSTRING (icon_name)->data;
1821 icon.encoding = XA_STRING;
1822 icon.format = 8;
1823 icon.nitems = XSTRING (icon_name)->size;
1824 #ifdef USE_X_TOOLKIT
1825 XSetWMName (FRAME_X_DISPLAY (f),
1826 XtWindow (f->output_data.x->widget), &text);
1827 XSetWMIconName (FRAME_X_DISPLAY (f), XtWindow (f->output_data.x->widget),
1828 &icon);
1829 #else /* not USE_X_TOOLKIT */
1830 XSetWMName (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f), &text);
1831 XSetWMIconName (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f), &icon);
1832 #endif /* not USE_X_TOOLKIT */
1834 #else /* not HAVE_X11R4 */
1835 XSetIconName (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
1836 XSTRING (name)->data);
1837 XStoreName (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
1838 XSTRING (name)->data);
1839 #endif /* not HAVE_X11R4 */
1840 UNBLOCK_INPUT;
1844 /* This function should be called when the user's lisp code has
1845 specified a name for the frame; the name will override any set by the
1846 redisplay code. */
1847 void
1848 x_explicitly_set_name (f, arg, oldval)
1849 FRAME_PTR f;
1850 Lisp_Object arg, oldval;
1852 x_set_name (f, arg, 1);
1855 /* This function should be called by Emacs redisplay code to set the
1856 name; names set this way will never override names set by the user's
1857 lisp code. */
1858 void
1859 x_implicitly_set_name (f, arg, oldval)
1860 FRAME_PTR f;
1861 Lisp_Object arg, oldval;
1863 x_set_name (f, arg, 0);
1866 /* Change the title of frame F to NAME.
1867 If NAME is nil, use the frame name as the title.
1869 If EXPLICIT is non-zero, that indicates that lisp code is setting the
1870 name; if NAME is a string, set F's name to NAME and set
1871 F->explicit_name; if NAME is Qnil, then clear F->explicit_name.
1873 If EXPLICIT is zero, that indicates that Emacs redisplay code is
1874 suggesting a new name, which lisp code should override; if
1875 F->explicit_name is set, ignore the new name; otherwise, set it. */
1877 void
1878 x_set_title (f, name)
1879 struct frame *f;
1880 Lisp_Object name;
1882 /* Don't change the title if it's already NAME. */
1883 if (EQ (name, f->title))
1884 return;
1886 update_mode_lines = 1;
1888 f->title = name;
1890 if (NILP (name))
1891 name = f->name;
1892 else
1893 CHECK_STRING (name, 0);
1895 if (FRAME_X_WINDOW (f))
1897 BLOCK_INPUT;
1898 #ifdef HAVE_X11R4
1900 XTextProperty text, icon;
1901 Lisp_Object icon_name;
1903 text.value = XSTRING (name)->data;
1904 text.encoding = XA_STRING;
1905 text.format = 8;
1906 text.nitems = XSTRING (name)->size;
1908 icon_name = (!NILP (f->icon_name) ? f->icon_name : name);
1910 icon.value = XSTRING (icon_name)->data;
1911 icon.encoding = XA_STRING;
1912 icon.format = 8;
1913 icon.nitems = XSTRING (icon_name)->size;
1914 #ifdef USE_X_TOOLKIT
1915 XSetWMName (FRAME_X_DISPLAY (f),
1916 XtWindow (f->output_data.x->widget), &text);
1917 XSetWMIconName (FRAME_X_DISPLAY (f), XtWindow (f->output_data.x->widget),
1918 &icon);
1919 #else /* not USE_X_TOOLKIT */
1920 XSetWMName (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f), &text);
1921 XSetWMIconName (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f), &icon);
1922 #endif /* not USE_X_TOOLKIT */
1924 #else /* not HAVE_X11R4 */
1925 XSetIconName (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
1926 XSTRING (name)->data);
1927 XStoreName (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
1928 XSTRING (name)->data);
1929 #endif /* not HAVE_X11R4 */
1930 UNBLOCK_INPUT;
1934 void
1935 x_set_autoraise (f, arg, oldval)
1936 struct frame *f;
1937 Lisp_Object arg, oldval;
1939 f->auto_raise = !EQ (Qnil, arg);
1942 void
1943 x_set_autolower (f, arg, oldval)
1944 struct frame *f;
1945 Lisp_Object arg, oldval;
1947 f->auto_lower = !EQ (Qnil, arg);
1950 void
1951 x_set_unsplittable (f, arg, oldval)
1952 struct frame *f;
1953 Lisp_Object arg, oldval;
1955 f->no_split = !NILP (arg);
1958 void
1959 x_set_vertical_scroll_bars (f, arg, oldval)
1960 struct frame *f;
1961 Lisp_Object arg, oldval;
1963 if ((EQ (arg, Qleft) && FRAME_HAS_VERTICAL_SCROLL_BARS_ON_RIGHT (f))
1964 || (EQ (arg, Qright) && FRAME_HAS_VERTICAL_SCROLL_BARS_ON_LEFT (f))
1965 || (NILP (arg) && FRAME_HAS_VERTICAL_SCROLL_BARS (f))
1966 || (!NILP (arg) && ! FRAME_HAS_VERTICAL_SCROLL_BARS (f)))
1968 FRAME_VERTICAL_SCROLL_BAR_TYPE (f)
1969 = (NILP (arg)
1970 ? vertical_scroll_bar_none
1971 : EQ (Qright, arg)
1972 ? vertical_scroll_bar_right
1973 : vertical_scroll_bar_left);
1975 /* We set this parameter before creating the X window for the
1976 frame, so we can get the geometry right from the start.
1977 However, if the window hasn't been created yet, we shouldn't
1978 call x_set_window_size. */
1979 if (FRAME_X_WINDOW (f))
1980 x_set_window_size (f, 0, FRAME_WIDTH (f), FRAME_HEIGHT (f));
1984 void
1985 x_set_scroll_bar_width (f, arg, oldval)
1986 struct frame *f;
1987 Lisp_Object arg, oldval;
1989 if (NILP (arg))
1991 FRAME_SCROLL_BAR_PIXEL_WIDTH (f) = 0;
1992 FRAME_SCROLL_BAR_COLS (f) = 3;
1993 if (FRAME_X_WINDOW (f))
1994 x_set_window_size (f, 0, FRAME_WIDTH (f), FRAME_HEIGHT (f));
1996 else if (INTEGERP (arg) && XINT (arg) > 0
1997 && XFASTINT (arg) != FRAME_SCROLL_BAR_PIXEL_WIDTH (f))
1999 int wid = FONT_WIDTH (f->output_data.x->font);
2001 if (XFASTINT (arg) <= 2 * VERTICAL_SCROLL_BAR_WIDTH_TRIM)
2002 XSETINT (arg, 2 * VERTICAL_SCROLL_BAR_WIDTH_TRIM + 1);
2004 FRAME_SCROLL_BAR_PIXEL_WIDTH (f) = XFASTINT (arg);
2005 FRAME_SCROLL_BAR_COLS (f) = (XFASTINT (arg) + wid-1) / wid;
2006 if (FRAME_X_WINDOW (f))
2007 x_set_window_size (f, 0, FRAME_WIDTH (f), FRAME_HEIGHT (f));
2010 change_frame_size (f, 0, FRAME_WIDTH (f), 0, 0);
2011 FRAME_CURSOR_X (f) = FRAME_LEFT_SCROLL_BAR_WIDTH (f);
2014 /* Subroutines of creating an X frame. */
2016 /* Make sure that Vx_resource_name is set to a reasonable value.
2017 Fix it up, or set it to `emacs' if it is too hopeless. */
2019 static void
2020 validate_x_resource_name ()
2022 int len;
2023 /* Number of valid characters in the resource name. */
2024 int good_count = 0;
2025 /* Number of invalid characters in the resource name. */
2026 int bad_count = 0;
2027 Lisp_Object new;
2028 int i;
2030 if (!STRINGP (Vx_resource_class))
2031 Vx_resource_class = build_string (EMACS_CLASS);
2033 if (STRINGP (Vx_resource_name))
2035 unsigned char *p = XSTRING (Vx_resource_name)->data;
2036 int i;
2038 len = XSTRING (Vx_resource_name)->size;
2040 /* Only letters, digits, - and _ are valid in resource names.
2041 Count the valid characters and count the invalid ones. */
2042 for (i = 0; i < len; i++)
2044 int c = p[i];
2045 if (! ((c >= 'a' && c <= 'z')
2046 || (c >= 'A' && c <= 'Z')
2047 || (c >= '0' && c <= '9')
2048 || c == '-' || c == '_'))
2049 bad_count++;
2050 else
2051 good_count++;
2054 else
2055 /* Not a string => completely invalid. */
2056 bad_count = 5, good_count = 0;
2058 /* If name is valid already, return. */
2059 if (bad_count == 0)
2060 return;
2062 /* If name is entirely invalid, or nearly so, use `emacs'. */
2063 if (good_count == 0
2064 || (good_count == 1 && bad_count > 0))
2066 Vx_resource_name = build_string ("emacs");
2067 return;
2070 /* Name is partly valid. Copy it and replace the invalid characters
2071 with underscores. */
2073 Vx_resource_name = new = Fcopy_sequence (Vx_resource_name);
2075 for (i = 0; i < len; i++)
2077 int c = XSTRING (new)->data[i];
2078 if (! ((c >= 'a' && c <= 'z')
2079 || (c >= 'A' && c <= 'Z')
2080 || (c >= '0' && c <= '9')
2081 || c == '-' || c == '_'))
2082 XSTRING (new)->data[i] = '_';
2087 extern char *x_get_string_resource ();
2089 DEFUN ("x-get-resource", Fx_get_resource, Sx_get_resource, 2, 4, 0,
2090 "Return the value of ATTRIBUTE, of class CLASS, from the X defaults database.\n\
2091 This uses `INSTANCE.ATTRIBUTE' as the key and `Emacs.CLASS' as the\n\
2092 class, where INSTANCE is the name under which Emacs was invoked, or\n\
2093 the name specified by the `-name' or `-rn' command-line arguments.\n\
2095 The optional arguments COMPONENT and SUBCLASS add to the key and the\n\
2096 class, respectively. You must specify both of them or neither.\n\
2097 If you specify them, the key is `INSTANCE.COMPONENT.ATTRIBUTE'\n\
2098 and the class is `Emacs.CLASS.SUBCLASS'.")
2099 (attribute, class, component, subclass)
2100 Lisp_Object attribute, class, component, subclass;
2102 register char *value;
2103 char *name_key;
2104 char *class_key;
2106 check_x ();
2108 CHECK_STRING (attribute, 0);
2109 CHECK_STRING (class, 0);
2111 if (!NILP (component))
2112 CHECK_STRING (component, 1);
2113 if (!NILP (subclass))
2114 CHECK_STRING (subclass, 2);
2115 if (NILP (component) != NILP (subclass))
2116 error ("x-get-resource: must specify both COMPONENT and SUBCLASS or neither");
2118 validate_x_resource_name ();
2120 /* Allocate space for the components, the dots which separate them,
2121 and the final '\0'. Make them big enough for the worst case. */
2122 name_key = (char *) alloca (XSTRING (Vx_resource_name)->size
2123 + (STRINGP (component)
2124 ? XSTRING (component)->size : 0)
2125 + XSTRING (attribute)->size
2126 + 3);
2128 class_key = (char *) alloca (XSTRING (Vx_resource_class)->size
2129 + XSTRING (class)->size
2130 + (STRINGP (subclass)
2131 ? XSTRING (subclass)->size : 0)
2132 + 3);
2134 /* Start with emacs.FRAMENAME for the name (the specific one)
2135 and with `Emacs' for the class key (the general one). */
2136 strcpy (name_key, XSTRING (Vx_resource_name)->data);
2137 strcpy (class_key, XSTRING (Vx_resource_class)->data);
2139 strcat (class_key, ".");
2140 strcat (class_key, XSTRING (class)->data);
2142 if (!NILP (component))
2144 strcat (class_key, ".");
2145 strcat (class_key, XSTRING (subclass)->data);
2147 strcat (name_key, ".");
2148 strcat (name_key, XSTRING (component)->data);
2151 strcat (name_key, ".");
2152 strcat (name_key, XSTRING (attribute)->data);
2154 value = x_get_string_resource (check_x_display_info (Qnil)->xrdb,
2155 name_key, class_key);
2157 if (value != (char *) 0)
2158 return build_string (value);
2159 else
2160 return Qnil;
2163 /* Get an X resource, like Fx_get_resource, but for display DPYINFO. */
2165 static Lisp_Object
2166 display_x_get_resource (dpyinfo, attribute, class, component, subclass)
2167 struct x_display_info *dpyinfo;
2168 Lisp_Object attribute, class, component, subclass;
2170 register char *value;
2171 char *name_key;
2172 char *class_key;
2174 check_x ();
2176 CHECK_STRING (attribute, 0);
2177 CHECK_STRING (class, 0);
2179 if (!NILP (component))
2180 CHECK_STRING (component, 1);
2181 if (!NILP (subclass))
2182 CHECK_STRING (subclass, 2);
2183 if (NILP (component) != NILP (subclass))
2184 error ("x-get-resource: must specify both COMPONENT and SUBCLASS or neither");
2186 validate_x_resource_name ();
2188 /* Allocate space for the components, the dots which separate them,
2189 and the final '\0'. Make them big enough for the worst case. */
2190 name_key = (char *) alloca (XSTRING (Vx_resource_name)->size
2191 + (STRINGP (component)
2192 ? XSTRING (component)->size : 0)
2193 + XSTRING (attribute)->size
2194 + 3);
2196 class_key = (char *) alloca (XSTRING (Vx_resource_class)->size
2197 + XSTRING (class)->size
2198 + (STRINGP (subclass)
2199 ? XSTRING (subclass)->size : 0)
2200 + 3);
2202 /* Start with emacs.FRAMENAME for the name (the specific one)
2203 and with `Emacs' for the class key (the general one). */
2204 strcpy (name_key, XSTRING (Vx_resource_name)->data);
2205 strcpy (class_key, XSTRING (Vx_resource_class)->data);
2207 strcat (class_key, ".");
2208 strcat (class_key, XSTRING (class)->data);
2210 if (!NILP (component))
2212 strcat (class_key, ".");
2213 strcat (class_key, XSTRING (subclass)->data);
2215 strcat (name_key, ".");
2216 strcat (name_key, XSTRING (component)->data);
2219 strcat (name_key, ".");
2220 strcat (name_key, XSTRING (attribute)->data);
2222 value = x_get_string_resource (dpyinfo->xrdb, name_key, class_key);
2224 if (value != (char *) 0)
2225 return build_string (value);
2226 else
2227 return Qnil;
2230 /* Used when C code wants a resource value. */
2232 char *
2233 x_get_resource_string (attribute, class)
2234 char *attribute, *class;
2236 register char *value;
2237 char *name_key;
2238 char *class_key;
2240 /* Allocate space for the components, the dots which separate them,
2241 and the final '\0'. */
2242 name_key = (char *) alloca (XSTRING (Vinvocation_name)->size
2243 + strlen (attribute) + 2);
2244 class_key = (char *) alloca ((sizeof (EMACS_CLASS) - 1)
2245 + strlen (class) + 2);
2247 sprintf (name_key, "%s.%s",
2248 XSTRING (Vinvocation_name)->data,
2249 attribute);
2250 sprintf (class_key, "%s.%s", EMACS_CLASS, class);
2252 return x_get_string_resource (FRAME_X_DISPLAY_INFO (selected_frame)->xrdb,
2253 name_key, class_key);
2256 /* Types we might convert a resource string into. */
2257 enum resource_types
2259 number, boolean, string, symbol
2262 /* Return the value of parameter PARAM.
2264 First search ALIST, then Vdefault_frame_alist, then the X defaults
2265 database, using ATTRIBUTE as the attribute name and CLASS as its class.
2267 Convert the resource to the type specified by desired_type.
2269 If no default is specified, return Qunbound. If you call
2270 x_get_arg, make sure you deal with Qunbound in a reasonable way,
2271 and don't let it get stored in any Lisp-visible variables! */
2273 static Lisp_Object
2274 x_get_arg (dpyinfo, alist, param, attribute, class, type)
2275 struct x_display_info *dpyinfo;
2276 Lisp_Object alist, param;
2277 char *attribute;
2278 char *class;
2279 enum resource_types type;
2281 register Lisp_Object tem;
2283 tem = Fassq (param, alist);
2284 if (EQ (tem, Qnil))
2285 tem = Fassq (param, Vdefault_frame_alist);
2286 if (EQ (tem, Qnil))
2289 if (attribute)
2291 tem = display_x_get_resource (dpyinfo,
2292 build_string (attribute),
2293 build_string (class),
2294 Qnil, Qnil);
2296 if (NILP (tem))
2297 return Qunbound;
2299 switch (type)
2301 case number:
2302 return make_number (atoi (XSTRING (tem)->data));
2304 case boolean:
2305 tem = Fdowncase (tem);
2306 if (!strcmp (XSTRING (tem)->data, "on")
2307 || !strcmp (XSTRING (tem)->data, "true"))
2308 return Qt;
2309 else
2310 return Qnil;
2312 case string:
2313 return tem;
2315 case symbol:
2316 /* As a special case, we map the values `true' and `on'
2317 to Qt, and `false' and `off' to Qnil. */
2319 Lisp_Object lower;
2320 lower = Fdowncase (tem);
2321 if (!strcmp (XSTRING (lower)->data, "on")
2322 || !strcmp (XSTRING (lower)->data, "true"))
2323 return Qt;
2324 else if (!strcmp (XSTRING (lower)->data, "off")
2325 || !strcmp (XSTRING (lower)->data, "false"))
2326 return Qnil;
2327 else
2328 return Fintern (tem, Qnil);
2331 default:
2332 abort ();
2335 else
2336 return Qunbound;
2338 return Fcdr (tem);
2341 /* Like x_get_arg, but also record the value in f->param_alist. */
2343 static Lisp_Object
2344 x_get_and_record_arg (f, alist, param, attribute, class, type)
2345 struct frame *f;
2346 Lisp_Object alist, param;
2347 char *attribute;
2348 char *class;
2349 enum resource_types type;
2351 Lisp_Object value;
2353 value = x_get_arg (FRAME_X_DISPLAY_INFO (f), alist, param,
2354 attribute, class, type);
2355 if (! NILP (value))
2356 store_frame_param (f, param, value);
2358 return value;
2361 /* Record in frame F the specified or default value according to ALIST
2362 of the parameter named PARAM (a Lisp symbol).
2363 If no value is specified for PARAM, look for an X default for XPROP
2364 on the frame named NAME.
2365 If that is not found either, use the value DEFLT. */
2367 static Lisp_Object
2368 x_default_parameter (f, alist, prop, deflt, xprop, xclass, type)
2369 struct frame *f;
2370 Lisp_Object alist;
2371 Lisp_Object prop;
2372 Lisp_Object deflt;
2373 char *xprop;
2374 char *xclass;
2375 enum resource_types type;
2377 Lisp_Object tem;
2379 tem = x_get_arg (FRAME_X_DISPLAY_INFO (f), alist, prop, xprop, xclass, type);
2380 if (EQ (tem, Qunbound))
2381 tem = deflt;
2382 x_set_frame_parameters (f, Fcons (Fcons (prop, tem), Qnil));
2383 return tem;
2386 DEFUN ("x-parse-geometry", Fx_parse_geometry, Sx_parse_geometry, 1, 1, 0,
2387 "Parse an X-style geometry string STRING.\n\
2388 Returns an alist of the form ((top . TOP), (left . LEFT) ... ).\n\
2389 The properties returned may include `top', `left', `height', and `width'.\n\
2390 The value of `left' or `top' may be an integer,\n\
2391 or a list (+ N) meaning N pixels relative to top/left corner,\n\
2392 or a list (- N) meaning -N pixels relative to bottom/right corner.")
2393 (string)
2394 Lisp_Object string;
2396 int geometry, x, y;
2397 unsigned int width, height;
2398 Lisp_Object result;
2400 CHECK_STRING (string, 0);
2402 geometry = XParseGeometry ((char *) XSTRING (string)->data,
2403 &x, &y, &width, &height);
2405 #if 0
2406 if (!!(geometry & XValue) != !!(geometry & YValue))
2407 error ("Must specify both x and y position, or neither");
2408 #endif
2410 result = Qnil;
2411 if (geometry & XValue)
2413 Lisp_Object element;
2415 if (x >= 0 && (geometry & XNegative))
2416 element = Fcons (Qleft, Fcons (Qminus, Fcons (make_number (-x), Qnil)));
2417 else if (x < 0 && ! (geometry & XNegative))
2418 element = Fcons (Qleft, Fcons (Qplus, Fcons (make_number (x), Qnil)));
2419 else
2420 element = Fcons (Qleft, make_number (x));
2421 result = Fcons (element, result);
2424 if (geometry & YValue)
2426 Lisp_Object element;
2428 if (y >= 0 && (geometry & YNegative))
2429 element = Fcons (Qtop, Fcons (Qminus, Fcons (make_number (-y), Qnil)));
2430 else if (y < 0 && ! (geometry & YNegative))
2431 element = Fcons (Qtop, Fcons (Qplus, Fcons (make_number (y), Qnil)));
2432 else
2433 element = Fcons (Qtop, make_number (y));
2434 result = Fcons (element, result);
2437 if (geometry & WidthValue)
2438 result = Fcons (Fcons (Qwidth, make_number (width)), result);
2439 if (geometry & HeightValue)
2440 result = Fcons (Fcons (Qheight, make_number (height)), result);
2442 return result;
2445 /* Calculate the desired size and position of this window,
2446 and return the flags saying which aspects were specified.
2448 This function does not make the coordinates positive. */
2450 #define DEFAULT_ROWS 40
2451 #define DEFAULT_COLS 80
2453 static int
2454 x_figure_window_size (f, parms)
2455 struct frame *f;
2456 Lisp_Object parms;
2458 register Lisp_Object tem0, tem1, tem2;
2459 int height, width, left, top;
2460 register int geometry;
2461 long window_prompting = 0;
2462 struct x_display_info *dpyinfo = FRAME_X_DISPLAY_INFO (f);
2464 /* Default values if we fall through.
2465 Actually, if that happens we should get
2466 window manager prompting. */
2467 SET_FRAME_WIDTH (f, DEFAULT_COLS);
2468 f->height = DEFAULT_ROWS;
2469 /* Window managers expect that if program-specified
2470 positions are not (0,0), they're intentional, not defaults. */
2471 f->output_data.x->top_pos = 0;
2472 f->output_data.x->left_pos = 0;
2474 tem0 = x_get_arg (dpyinfo, parms, Qheight, 0, 0, number);
2475 tem1 = x_get_arg (dpyinfo, parms, Qwidth, 0, 0, number);
2476 tem2 = x_get_arg (dpyinfo, parms, Quser_size, 0, 0, number);
2477 if (! EQ (tem0, Qunbound) || ! EQ (tem1, Qunbound))
2479 if (!EQ (tem0, Qunbound))
2481 CHECK_NUMBER (tem0, 0);
2482 f->height = XINT (tem0);
2484 if (!EQ (tem1, Qunbound))
2486 CHECK_NUMBER (tem1, 0);
2487 SET_FRAME_WIDTH (f, XINT (tem1));
2489 if (!NILP (tem2) && !EQ (tem2, Qunbound))
2490 window_prompting |= USSize;
2491 else
2492 window_prompting |= PSize;
2495 f->output_data.x->vertical_scroll_bar_extra
2496 = (!FRAME_HAS_VERTICAL_SCROLL_BARS (f)
2498 : FRAME_SCROLL_BAR_PIXEL_WIDTH (f) > 0
2499 ? FRAME_SCROLL_BAR_PIXEL_WIDTH (f)
2500 : (FRAME_SCROLL_BAR_COLS (f) * FONT_WIDTH (f->output_data.x->font)));
2501 f->output_data.x->pixel_width = CHAR_TO_PIXEL_WIDTH (f, f->width);
2502 f->output_data.x->pixel_height = CHAR_TO_PIXEL_HEIGHT (f, f->height);
2504 tem0 = x_get_arg (dpyinfo, parms, Qtop, 0, 0, number);
2505 tem1 = x_get_arg (dpyinfo, parms, Qleft, 0, 0, number);
2506 tem2 = x_get_arg (dpyinfo, parms, Quser_position, 0, 0, number);
2507 if (! EQ (tem0, Qunbound) || ! EQ (tem1, Qunbound))
2509 if (EQ (tem0, Qminus))
2511 f->output_data.x->top_pos = 0;
2512 window_prompting |= YNegative;
2514 else if (CONSP (tem0) && EQ (XCONS (tem0)->car, Qminus)
2515 && CONSP (XCONS (tem0)->cdr)
2516 && INTEGERP (XCONS (XCONS (tem0)->cdr)->car))
2518 f->output_data.x->top_pos = - XINT (XCONS (XCONS (tem0)->cdr)->car);
2519 window_prompting |= YNegative;
2521 else if (CONSP (tem0) && EQ (XCONS (tem0)->car, Qplus)
2522 && CONSP (XCONS (tem0)->cdr)
2523 && INTEGERP (XCONS (XCONS (tem0)->cdr)->car))
2525 f->output_data.x->top_pos = XINT (XCONS (XCONS (tem0)->cdr)->car);
2527 else if (EQ (tem0, Qunbound))
2528 f->output_data.x->top_pos = 0;
2529 else
2531 CHECK_NUMBER (tem0, 0);
2532 f->output_data.x->top_pos = XINT (tem0);
2533 if (f->output_data.x->top_pos < 0)
2534 window_prompting |= YNegative;
2537 if (EQ (tem1, Qminus))
2539 f->output_data.x->left_pos = 0;
2540 window_prompting |= XNegative;
2542 else if (CONSP (tem1) && EQ (XCONS (tem1)->car, Qminus)
2543 && CONSP (XCONS (tem1)->cdr)
2544 && INTEGERP (XCONS (XCONS (tem1)->cdr)->car))
2546 f->output_data.x->left_pos = - XINT (XCONS (XCONS (tem1)->cdr)->car);
2547 window_prompting |= XNegative;
2549 else if (CONSP (tem1) && EQ (XCONS (tem1)->car, Qplus)
2550 && CONSP (XCONS (tem1)->cdr)
2551 && INTEGERP (XCONS (XCONS (tem1)->cdr)->car))
2553 f->output_data.x->left_pos = XINT (XCONS (XCONS (tem1)->cdr)->car);
2555 else if (EQ (tem1, Qunbound))
2556 f->output_data.x->left_pos = 0;
2557 else
2559 CHECK_NUMBER (tem1, 0);
2560 f->output_data.x->left_pos = XINT (tem1);
2561 if (f->output_data.x->left_pos < 0)
2562 window_prompting |= XNegative;
2565 if (!NILP (tem2) && ! EQ (tem2, Qunbound))
2566 window_prompting |= USPosition;
2567 else
2568 window_prompting |= PPosition;
2571 return window_prompting;
2574 #if !defined (HAVE_X11R4) && !defined (HAVE_XSETWMPROTOCOLS)
2576 Status
2577 XSetWMProtocols (dpy, w, protocols, count)
2578 Display *dpy;
2579 Window w;
2580 Atom *protocols;
2581 int count;
2583 Atom prop;
2584 prop = XInternAtom (dpy, "WM_PROTOCOLS", False);
2585 if (prop == None) return False;
2586 XChangeProperty (dpy, w, prop, XA_ATOM, 32, PropModeReplace,
2587 (unsigned char *) protocols, count);
2588 return True;
2590 #endif /* not HAVE_X11R4 && not HAVE_XSETWMPROTOCOLS */
2592 #ifdef USE_X_TOOLKIT
2594 /* If the WM_PROTOCOLS property does not already contain WM_TAKE_FOCUS,
2595 WM_DELETE_WINDOW, and WM_SAVE_YOURSELF, then add them. (They may
2596 already be present because of the toolkit (Motif adds some of them,
2597 for example, but Xt doesn't). */
2599 static void
2600 hack_wm_protocols (f, widget)
2601 FRAME_PTR f;
2602 Widget widget;
2604 Display *dpy = XtDisplay (widget);
2605 Window w = XtWindow (widget);
2606 int need_delete = 1;
2607 int need_focus = 1;
2608 int need_save = 1;
2610 BLOCK_INPUT;
2612 Atom type, *atoms = 0;
2613 int format = 0;
2614 unsigned long nitems = 0;
2615 unsigned long bytes_after;
2617 if ((XGetWindowProperty (dpy, w,
2618 FRAME_X_DISPLAY_INFO (f)->Xatom_wm_protocols,
2619 (long)0, (long)100, False, XA_ATOM,
2620 &type, &format, &nitems, &bytes_after,
2621 (unsigned char **) &atoms)
2622 == Success)
2623 && format == 32 && type == XA_ATOM)
2624 while (nitems > 0)
2626 nitems--;
2627 if (atoms[nitems] == FRAME_X_DISPLAY_INFO (f)->Xatom_wm_delete_window)
2628 need_delete = 0;
2629 else if (atoms[nitems] == FRAME_X_DISPLAY_INFO (f)->Xatom_wm_take_focus)
2630 need_focus = 0;
2631 else if (atoms[nitems] == FRAME_X_DISPLAY_INFO (f)->Xatom_wm_save_yourself)
2632 need_save = 0;
2634 if (atoms) XFree ((char *) atoms);
2637 Atom props [10];
2638 int count = 0;
2639 if (need_delete)
2640 props[count++] = FRAME_X_DISPLAY_INFO (f)->Xatom_wm_delete_window;
2641 if (need_focus)
2642 props[count++] = FRAME_X_DISPLAY_INFO (f)->Xatom_wm_take_focus;
2643 if (need_save)
2644 props[count++] = FRAME_X_DISPLAY_INFO (f)->Xatom_wm_save_yourself;
2645 if (count)
2646 XChangeProperty (dpy, w, FRAME_X_DISPLAY_INFO (f)->Xatom_wm_protocols,
2647 XA_ATOM, 32, PropModeAppend,
2648 (unsigned char *) props, count);
2650 UNBLOCK_INPUT;
2652 #endif
2654 #ifdef USE_X_TOOLKIT
2656 /* Create and set up the X widget for frame F. */
2658 static void
2659 x_window (f, window_prompting, minibuffer_only)
2660 struct frame *f;
2661 long window_prompting;
2662 int minibuffer_only;
2664 XClassHint class_hints;
2665 XSetWindowAttributes attributes;
2666 unsigned long attribute_mask;
2668 Widget shell_widget;
2669 Widget pane_widget;
2670 Widget frame_widget;
2671 Arg al [25];
2672 int ac;
2674 BLOCK_INPUT;
2676 /* Use the resource name as the top-level widget name
2677 for looking up resources. Make a non-Lisp copy
2678 for the window manager, so GC relocation won't bother it.
2680 Elsewhere we specify the window name for the window manager. */
2683 char *str = (char *) XSTRING (Vx_resource_name)->data;
2684 f->namebuf = (char *) xmalloc (strlen (str) + 1);
2685 strcpy (f->namebuf, str);
2688 ac = 0;
2689 XtSetArg (al[ac], XtNallowShellResize, 1); ac++;
2690 XtSetArg (al[ac], XtNinput, 1); ac++;
2691 XtSetArg (al[ac], XtNmappedWhenManaged, 0); ac++;
2692 XtSetArg (al[ac], XtNborderWidth, f->output_data.x->border_width); ac++;
2693 shell_widget = XtAppCreateShell (f->namebuf, EMACS_CLASS,
2694 applicationShellWidgetClass,
2695 FRAME_X_DISPLAY (f), al, ac);
2697 f->output_data.x->widget = shell_widget;
2698 /* maybe_set_screen_title_format (shell_widget); */
2700 pane_widget = lw_create_widget ("main", "pane", widget_id_tick++,
2701 (widget_value *) NULL,
2702 shell_widget, False,
2703 (lw_callback) NULL,
2704 (lw_callback) NULL,
2705 (lw_callback) NULL);
2707 f->output_data.x->column_widget = pane_widget;
2709 /* mappedWhenManaged to false tells to the paned window to not map/unmap
2710 the emacs screen when changing menubar. This reduces flickering. */
2712 ac = 0;
2713 XtSetArg (al[ac], XtNmappedWhenManaged, 0); ac++;
2714 XtSetArg (al[ac], XtNshowGrip, 0); ac++;
2715 XtSetArg (al[ac], XtNallowResize, 1); ac++;
2716 XtSetArg (al[ac], XtNresizeToPreferred, 1); ac++;
2717 XtSetArg (al[ac], XtNemacsFrame, f); ac++;
2718 frame_widget = XtCreateWidget (f->namebuf,
2719 emacsFrameClass,
2720 pane_widget, al, ac);
2722 f->output_data.x->edit_widget = frame_widget;
2724 XtManageChild (frame_widget);
2726 /* Do some needed geometry management. */
2728 int len;
2729 char *tem, shell_position[32];
2730 Arg al[2];
2731 int ac = 0;
2732 int extra_borders = 0;
2733 int menubar_size
2734 = (f->output_data.x->menubar_widget
2735 ? (f->output_data.x->menubar_widget->core.height
2736 + f->output_data.x->menubar_widget->core.border_width)
2737 : 0);
2738 extern char *lwlib_toolkit_type;
2740 #if 0 /* Experimentally, we now get the right results
2741 for -geometry -0-0 without this. 24 Aug 96, rms. */
2742 if (FRAME_EXTERNAL_MENU_BAR (f))
2744 Dimension ibw = 0;
2745 XtVaGetValues (pane_widget, XtNinternalBorderWidth, &ibw, NULL);
2746 menubar_size += ibw;
2748 #endif
2750 f->output_data.x->menubar_height = menubar_size;
2752 #ifndef USE_LUCID
2753 /* Motif seems to need this amount added to the sizes
2754 specified for the shell widget. The Athena/Lucid widgets don't.
2755 Both conclusions reached experimentally. -- rms. */
2756 XtVaGetValues (f->output_data.x->edit_widget, XtNinternalBorderWidth,
2757 &extra_borders, NULL);
2758 extra_borders *= 2;
2759 #endif
2761 /* Convert our geometry parameters into a geometry string
2762 and specify it.
2763 Note that we do not specify here whether the position
2764 is a user-specified or program-specified one.
2765 We pass that information later, in x_wm_set_size_hints. */
2767 int left = f->output_data.x->left_pos;
2768 int xneg = window_prompting & XNegative;
2769 int top = f->output_data.x->top_pos;
2770 int yneg = window_prompting & YNegative;
2771 if (xneg)
2772 left = -left;
2773 if (yneg)
2774 top = -top;
2776 if (window_prompting & USPosition)
2777 sprintf (shell_position, "=%dx%d%c%d%c%d",
2778 PIXEL_WIDTH (f) + extra_borders,
2779 PIXEL_HEIGHT (f) + menubar_size + extra_borders,
2780 (xneg ? '-' : '+'), left,
2781 (yneg ? '-' : '+'), top);
2782 else
2783 sprintf (shell_position, "=%dx%d",
2784 PIXEL_WIDTH (f) + extra_borders,
2785 PIXEL_HEIGHT (f) + menubar_size + extra_borders);
2788 len = strlen (shell_position) + 1;
2789 /* We don't free this because we don't know whether
2790 it is safe to free it while the frame exists.
2791 It isn't worth the trouble of arranging to free it
2792 when the frame is deleted. */
2793 tem = (char *) xmalloc (len);
2794 strncpy (tem, shell_position, len);
2795 XtSetArg (al[ac], XtNgeometry, tem); ac++;
2796 XtSetValues (shell_widget, al, ac);
2799 XtManageChild (pane_widget);
2800 XtRealizeWidget (shell_widget);
2802 FRAME_X_WINDOW (f) = XtWindow (frame_widget);
2804 validate_x_resource_name ();
2806 class_hints.res_name = (char *) XSTRING (Vx_resource_name)->data;
2807 class_hints.res_class = (char *) XSTRING (Vx_resource_class)->data;
2808 XSetClassHint (FRAME_X_DISPLAY (f), XtWindow (shell_widget), &class_hints);
2810 #ifdef HAVE_X_I18N
2811 #ifndef X_I18N_INHIBITED
2813 XIM xim;
2814 XIC xic = NULL;
2816 xim = XOpenIM (FRAME_X_DISPLAY (f), NULL, NULL, NULL);
2818 if (xim)
2820 xic = XCreateIC (xim,
2821 XNInputStyle, XIMPreeditNothing | XIMStatusNothing,
2822 XNClientWindow, FRAME_X_WINDOW(f),
2823 XNFocusWindow, FRAME_X_WINDOW(f),
2824 NULL);
2826 if (xic == 0)
2828 XCloseIM (xim);
2829 xim = NULL;
2832 FRAME_XIM (f) = xim;
2833 FRAME_XIC (f) = xic;
2835 #else /* X_I18N_INHIBITED */
2836 FRAME_XIM (f) = 0;
2837 FRAME_XIC (f) = 0;
2838 #endif /* X_I18N_INHIBITED */
2839 #endif /* HAVE_X_I18N */
2841 f->output_data.x->wm_hints.input = True;
2842 f->output_data.x->wm_hints.flags |= InputHint;
2843 XSetWMHints (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
2844 &f->output_data.x->wm_hints);
2846 hack_wm_protocols (f, shell_widget);
2848 #ifdef HACK_EDITRES
2849 XtAddEventHandler (shell_widget, 0, True, _XEditResCheckMessages, 0);
2850 #endif
2852 /* Do a stupid property change to force the server to generate a
2853 propertyNotify event so that the event_stream server timestamp will
2854 be initialized to something relevant to the time we created the window.
2856 XChangeProperty (XtDisplay (frame_widget), XtWindow (frame_widget),
2857 FRAME_X_DISPLAY_INFO (f)->Xatom_wm_protocols,
2858 XA_ATOM, 32, PropModeAppend,
2859 (unsigned char*) NULL, 0);
2861 /* Make all the standard events reach the Emacs frame. */
2862 attributes.event_mask = STANDARD_EVENT_SET;
2863 attribute_mask = CWEventMask;
2864 XChangeWindowAttributes (XtDisplay (shell_widget), XtWindow (shell_widget),
2865 attribute_mask, &attributes);
2867 XtMapWidget (frame_widget);
2869 /* x_set_name normally ignores requests to set the name if the
2870 requested name is the same as the current name. This is the one
2871 place where that assumption isn't correct; f->name is set, but
2872 the X server hasn't been told. */
2874 Lisp_Object name;
2875 int explicit = f->explicit_name;
2877 f->explicit_name = 0;
2878 name = f->name;
2879 f->name = Qnil;
2880 x_set_name (f, name, explicit);
2883 XDefineCursor (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
2884 f->output_data.x->text_cursor);
2886 UNBLOCK_INPUT;
2888 if (!minibuffer_only && FRAME_EXTERNAL_MENU_BAR (f))
2889 initialize_frame_menubar (f);
2890 lw_set_main_areas (pane_widget, f->output_data.x->menubar_widget, frame_widget);
2892 if (FRAME_X_WINDOW (f) == 0)
2893 error ("Unable to create window");
2896 #else /* not USE_X_TOOLKIT */
2898 /* Create and set up the X window for frame F. */
2900 x_window (f)
2901 struct frame *f;
2904 XClassHint class_hints;
2905 XSetWindowAttributes attributes;
2906 unsigned long attribute_mask;
2908 attributes.background_pixel = f->output_data.x->background_pixel;
2909 attributes.border_pixel = f->output_data.x->border_pixel;
2910 attributes.bit_gravity = StaticGravity;
2911 attributes.backing_store = NotUseful;
2912 attributes.save_under = True;
2913 attributes.event_mask = STANDARD_EVENT_SET;
2914 attribute_mask = (CWBackPixel | CWBorderPixel | CWBitGravity
2915 #if 0
2916 | CWBackingStore | CWSaveUnder
2917 #endif
2918 | CWEventMask);
2920 BLOCK_INPUT;
2921 FRAME_X_WINDOW (f)
2922 = XCreateWindow (FRAME_X_DISPLAY (f),
2923 f->output_data.x->parent_desc,
2924 f->output_data.x->left_pos,
2925 f->output_data.x->top_pos,
2926 PIXEL_WIDTH (f), PIXEL_HEIGHT (f),
2927 f->output_data.x->border_width,
2928 CopyFromParent, /* depth */
2929 InputOutput, /* class */
2930 FRAME_X_DISPLAY_INFO (f)->visual,
2931 attribute_mask, &attributes);
2932 #ifdef HAVE_X_I18N
2933 #ifndef X_I18N_INHIBITED
2935 XIM xim;
2936 XIC xic = NULL;
2938 xim = XOpenIM (FRAME_X_DISPLAY(f), NULL, NULL, NULL);
2940 if (xim)
2942 xic = XCreateIC (xim,
2943 XNInputStyle, XIMPreeditNothing | XIMStatusNothing,
2944 XNClientWindow, FRAME_X_WINDOW(f),
2945 XNFocusWindow, FRAME_X_WINDOW(f),
2946 NULL);
2948 if (!xic)
2950 XCloseIM (xim);
2951 xim = NULL;
2955 FRAME_XIM (f) = xim;
2956 FRAME_XIC (f) = xic;
2958 #else /* X_I18N_INHIBITED */
2959 FRAME_XIM (f) = 0;
2960 FRAME_XIC (f) = 0;
2961 #endif /* X_I18N_INHIBITED */
2962 #endif /* HAVE_X_I18N */
2964 validate_x_resource_name ();
2966 class_hints.res_name = (char *) XSTRING (Vx_resource_name)->data;
2967 class_hints.res_class = (char *) XSTRING (Vx_resource_class)->data;
2968 XSetClassHint (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f), &class_hints);
2970 /* The menubar is part of the ordinary display;
2971 it does not count in addition to the height of the window. */
2972 f->output_data.x->menubar_height = 0;
2974 /* This indicates that we use the "Passive Input" input model.
2975 Unless we do this, we don't get the Focus{In,Out} events that we
2976 need to draw the cursor correctly. Accursed bureaucrats.
2977 XWhipsAndChains (FRAME_X_DISPLAY (f), IronMaiden, &TheRack); */
2979 f->output_data.x->wm_hints.input = True;
2980 f->output_data.x->wm_hints.flags |= InputHint;
2981 XSetWMHints (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
2982 &f->output_data.x->wm_hints);
2983 f->output_data.x->wm_hints.icon_pixmap = None;
2985 /* Request "save yourself" and "delete window" commands from wm. */
2987 Atom protocols[2];
2988 protocols[0] = FRAME_X_DISPLAY_INFO (f)->Xatom_wm_delete_window;
2989 protocols[1] = FRAME_X_DISPLAY_INFO (f)->Xatom_wm_save_yourself;
2990 XSetWMProtocols (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f), protocols, 2);
2993 /* x_set_name normally ignores requests to set the name if the
2994 requested name is the same as the current name. This is the one
2995 place where that assumption isn't correct; f->name is set, but
2996 the X server hasn't been told. */
2998 Lisp_Object name;
2999 int explicit = f->explicit_name;
3001 f->explicit_name = 0;
3002 name = f->name;
3003 f->name = Qnil;
3004 x_set_name (f, name, explicit);
3007 XDefineCursor (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
3008 f->output_data.x->text_cursor);
3010 UNBLOCK_INPUT;
3012 if (FRAME_X_WINDOW (f) == 0)
3013 error ("Unable to create window");
3016 #endif /* not USE_X_TOOLKIT */
3018 /* Handle the icon stuff for this window. Perhaps later we might
3019 want an x_set_icon_position which can be called interactively as
3020 well. */
3022 static void
3023 x_icon (f, parms)
3024 struct frame *f;
3025 Lisp_Object parms;
3027 Lisp_Object icon_x, icon_y;
3028 struct x_display_info *dpyinfo = FRAME_X_DISPLAY_INFO (f);
3030 /* Set the position of the icon. Note that twm groups all
3031 icons in an icon window. */
3032 icon_x = x_get_and_record_arg (f, parms, Qicon_left, 0, 0, number);
3033 icon_y = x_get_and_record_arg (f, parms, Qicon_top, 0, 0, number);
3034 if (!EQ (icon_x, Qunbound) && !EQ (icon_y, Qunbound))
3036 CHECK_NUMBER (icon_x, 0);
3037 CHECK_NUMBER (icon_y, 0);
3039 else if (!EQ (icon_x, Qunbound) || !EQ (icon_y, Qunbound))
3040 error ("Both left and top icon corners of icon must be specified");
3042 BLOCK_INPUT;
3044 if (! EQ (icon_x, Qunbound))
3045 x_wm_set_icon_position (f, XINT (icon_x), XINT (icon_y));
3047 /* Start up iconic or window? */
3048 x_wm_set_window_state
3049 (f, (EQ (x_get_arg (dpyinfo, parms, Qvisibility, 0, 0, symbol), Qicon)
3050 ? IconicState
3051 : NormalState));
3053 x_text_icon (f, (char *) XSTRING ((!NILP (f->icon_name)
3054 ? f->icon_name
3055 : f->name))->data);
3057 UNBLOCK_INPUT;
3060 /* Make the GC's needed for this window, setting the
3061 background, border and mouse colors; also create the
3062 mouse cursor and the gray border tile. */
3064 static char cursor_bits[] =
3066 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
3067 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
3068 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
3069 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00
3072 static void
3073 x_make_gc (f)
3074 struct frame *f;
3076 XGCValues gc_values;
3077 GC temp_gc;
3078 XImage tileimage;
3080 BLOCK_INPUT;
3082 /* Create the GC's of this frame.
3083 Note that many default values are used. */
3085 /* Normal video */
3086 gc_values.font = f->output_data.x->font->fid;
3087 gc_values.foreground = f->output_data.x->foreground_pixel;
3088 gc_values.background = f->output_data.x->background_pixel;
3089 gc_values.line_width = 0; /* Means 1 using fast algorithm. */
3090 f->output_data.x->normal_gc = XCreateGC (FRAME_X_DISPLAY (f),
3091 FRAME_X_WINDOW (f),
3092 GCLineWidth | GCFont
3093 | GCForeground | GCBackground,
3094 &gc_values);
3096 /* Reverse video style. */
3097 gc_values.foreground = f->output_data.x->background_pixel;
3098 gc_values.background = f->output_data.x->foreground_pixel;
3099 f->output_data.x->reverse_gc = XCreateGC (FRAME_X_DISPLAY (f),
3100 FRAME_X_WINDOW (f),
3101 GCFont | GCForeground | GCBackground
3102 | GCLineWidth,
3103 &gc_values);
3105 /* Cursor has cursor-color background, background-color foreground. */
3106 gc_values.foreground = f->output_data.x->background_pixel;
3107 gc_values.background = f->output_data.x->cursor_pixel;
3108 gc_values.fill_style = FillOpaqueStippled;
3109 gc_values.stipple
3110 = XCreateBitmapFromData (FRAME_X_DISPLAY (f),
3111 FRAME_X_DISPLAY_INFO (f)->root_window,
3112 cursor_bits, 16, 16);
3113 f->output_data.x->cursor_gc
3114 = XCreateGC (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
3115 (GCFont | GCForeground | GCBackground
3116 | GCFillStyle | GCStipple | GCLineWidth),
3117 &gc_values);
3119 /* Create the gray border tile used when the pointer is not in
3120 the frame. Since this depends on the frame's pixel values,
3121 this must be done on a per-frame basis. */
3122 f->output_data.x->border_tile
3123 = (XCreatePixmapFromBitmapData
3124 (FRAME_X_DISPLAY (f), FRAME_X_DISPLAY_INFO (f)->root_window,
3125 gray_bits, gray_width, gray_height,
3126 f->output_data.x->foreground_pixel,
3127 f->output_data.x->background_pixel,
3128 DefaultDepth (FRAME_X_DISPLAY (f),
3129 XScreenNumberOfScreen (FRAME_X_SCREEN (f)))));
3131 UNBLOCK_INPUT;
3134 DEFUN ("x-create-frame", Fx_create_frame, Sx_create_frame,
3135 1, 1, 0,
3136 "Make a new X window, which is called a \"frame\" in Emacs terms.\n\
3137 Returns an Emacs frame object.\n\
3138 ALIST is an alist of frame parameters.\n\
3139 If the parameters specify that the frame should not have a minibuffer,\n\
3140 and do not specify a specific minibuffer window to use,\n\
3141 then `default-minibuffer-frame' must be a frame whose minibuffer can\n\
3142 be shared by the new frame.\n\
3144 This function is an internal primitive--use `make-frame' instead.")
3145 (parms)
3146 Lisp_Object parms;
3148 struct frame *f;
3149 Lisp_Object frame, tem;
3150 Lisp_Object name;
3151 int minibuffer_only = 0;
3152 long window_prompting = 0;
3153 int width, height;
3154 int count = specpdl_ptr - specpdl;
3155 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
3156 Lisp_Object display;
3157 struct x_display_info *dpyinfo;
3158 Lisp_Object parent;
3159 struct kboard *kb;
3161 check_x ();
3163 /* Use this general default value to start with
3164 until we know if this frame has a specified name. */
3165 Vx_resource_name = Vinvocation_name;
3167 display = x_get_arg (dpyinfo, parms, Qdisplay, 0, 0, string);
3168 if (EQ (display, Qunbound))
3169 display = Qnil;
3170 dpyinfo = check_x_display_info (display);
3171 #ifdef MULTI_KBOARD
3172 kb = dpyinfo->kboard;
3173 #else
3174 kb = &the_only_kboard;
3175 #endif
3177 name = x_get_arg (dpyinfo, parms, Qname, "name", "Name", string);
3178 if (!STRINGP (name)
3179 && ! EQ (name, Qunbound)
3180 && ! NILP (name))
3181 error ("Invalid frame name--not a string or nil");
3183 if (STRINGP (name))
3184 Vx_resource_name = name;
3186 /* See if parent window is specified. */
3187 parent = x_get_arg (dpyinfo, parms, Qparent_id, NULL, NULL, number);
3188 if (EQ (parent, Qunbound))
3189 parent = Qnil;
3190 if (! NILP (parent))
3191 CHECK_NUMBER (parent, 0);
3193 /* make_frame_without_minibuffer can run Lisp code and garbage collect. */
3194 /* No need to protect DISPLAY because that's not used after passing
3195 it to make_frame_without_minibuffer. */
3196 frame = Qnil;
3197 GCPRO4 (parms, parent, name, frame);
3198 tem = x_get_arg (dpyinfo, parms, Qminibuffer, "minibuffer", "Minibuffer", symbol);
3199 if (EQ (tem, Qnone) || NILP (tem))
3200 f = make_frame_without_minibuffer (Qnil, kb, display);
3201 else if (EQ (tem, Qonly))
3203 f = make_minibuffer_frame ();
3204 minibuffer_only = 1;
3206 else if (WINDOWP (tem))
3207 f = make_frame_without_minibuffer (tem, kb, display);
3208 else
3209 f = make_frame (1);
3211 XSETFRAME (frame, f);
3213 /* Note that X Windows does support scroll bars. */
3214 FRAME_CAN_HAVE_SCROLL_BARS (f) = 1;
3216 f->output_method = output_x_window;
3217 f->output_data.x = (struct x_output *) xmalloc (sizeof (struct x_output));
3218 bzero (f->output_data.x, sizeof (struct x_output));
3219 f->output_data.x->icon_bitmap = -1;
3221 f->icon_name
3222 = x_get_arg (dpyinfo, parms, Qicon_name, "iconName", "Title", string);
3223 if (! STRINGP (f->icon_name))
3224 f->icon_name = Qnil;
3226 FRAME_X_DISPLAY_INFO (f) = dpyinfo;
3227 #ifdef MULTI_KBOARD
3228 FRAME_KBOARD (f) = kb;
3229 #endif
3231 /* Specify the parent under which to make this X window. */
3233 if (!NILP (parent))
3235 f->output_data.x->parent_desc = (Window) XINT (parent);
3236 f->output_data.x->explicit_parent = 1;
3238 else
3240 f->output_data.x->parent_desc = FRAME_X_DISPLAY_INFO (f)->root_window;
3241 f->output_data.x->explicit_parent = 0;
3244 /* Note that the frame has no physical cursor right now. */
3245 f->phys_cursor_x = -1;
3247 /* Set the name; the functions to which we pass f expect the name to
3248 be set. */
3249 if (EQ (name, Qunbound) || NILP (name))
3251 f->name = build_string (dpyinfo->x_id_name);
3252 f->explicit_name = 0;
3254 else
3256 f->name = name;
3257 f->explicit_name = 1;
3258 /* use the frame's title when getting resources for this frame. */
3259 specbind (Qx_resource_name, name);
3262 /* Create fontsets from `global_fontset_alist' before handling fonts. */
3263 for (tem = Vglobal_fontset_alist; CONSP (tem); tem = XCONS (tem)->cdr)
3264 fs_register_fontset (f, XCONS (tem)->car);
3266 /* Extract the window parameters from the supplied values
3267 that are needed to determine window geometry. */
3269 Lisp_Object font;
3271 if (! STRINGP (font))
3272 font = x_get_arg (dpyinfo, parms, Qfont, "font", "Font", string);
3273 BLOCK_INPUT;
3274 /* First, try whatever font the caller has specified. */
3275 if (STRINGP (font))
3277 tem = Fquery_fontset (font);
3278 if (STRINGP (tem))
3279 font = x_new_fontset (f, XSTRING (tem)->data);
3280 else
3281 font = x_new_font (f, XSTRING (font)->data);
3283 /* Try out a font which we hope has bold and italic variations. */
3284 if (!STRINGP (font))
3285 font = x_new_font (f, "-misc-fixed-medium-r-normal-*-*-140-*-*-c-*-iso8859-1");
3286 if (! STRINGP (font))
3287 font = x_new_font (f, "-*-*-medium-r-normal-*-*-140-*-*-c-*-iso8859-1");
3288 if (! STRINGP (font))
3289 /* This was formerly the first thing tried, but it finds too many fonts
3290 and takes too long. */
3291 font = x_new_font (f, "-*-*-medium-r-*-*-*-*-*-*-c-*-iso8859-1");
3292 /* If those didn't work, look for something which will at least work. */
3293 if (! STRINGP (font))
3294 font = x_new_font (f, "-*-fixed-*-*-*-*-*-140-*-*-c-*-iso8859-1");
3295 UNBLOCK_INPUT;
3296 if (! STRINGP (font))
3297 font = build_string ("fixed");
3299 x_default_parameter (f, parms, Qfont, font,
3300 "font", "Font", string);
3303 #ifdef USE_LUCID
3304 /* Prevent lwlib/xlwmenu.c from crashing because of a bug
3305 whereby it fails to get any font. */
3306 xlwmenu_default_font = f->output_data.x->font;
3307 #endif
3309 x_default_parameter (f, parms, Qborder_width, make_number (2),
3310 "borderwidth", "BorderWidth", number);
3311 /* This defaults to 2 in order to match xterm. We recognize either
3312 internalBorderWidth or internalBorder (which is what xterm calls
3313 it). */
3314 if (NILP (Fassq (Qinternal_border_width, parms)))
3316 Lisp_Object value;
3318 value = x_get_arg (dpyinfo, parms, Qinternal_border_width,
3319 "internalBorder", "internalBorder", number);
3320 if (! EQ (value, Qunbound))
3321 parms = Fcons (Fcons (Qinternal_border_width, value),
3322 parms);
3324 x_default_parameter (f, parms, Qinternal_border_width, make_number (1),
3325 "internalBorderWidth", "internalBorderWidth", number);
3326 x_default_parameter (f, parms, Qvertical_scroll_bars, Qleft,
3327 "verticalScrollBars", "ScrollBars", boolean);
3329 /* Also do the stuff which must be set before the window exists. */
3330 x_default_parameter (f, parms, Qforeground_color, build_string ("black"),
3331 "foreground", "Foreground", string);
3332 x_default_parameter (f, parms, Qbackground_color, build_string ("white"),
3333 "background", "Background", string);
3334 x_default_parameter (f, parms, Qmouse_color, build_string ("black"),
3335 "pointerColor", "Foreground", string);
3336 x_default_parameter (f, parms, Qcursor_color, build_string ("black"),
3337 "cursorColor", "Foreground", string);
3338 x_default_parameter (f, parms, Qborder_color, build_string ("black"),
3339 "borderColor", "BorderColor", string);
3341 x_default_parameter (f, parms, Qmenu_bar_lines, make_number (1),
3342 "menuBar", "MenuBar", number);
3343 x_default_parameter (f, parms, Qscroll_bar_width, Qnil,
3344 "scrollBarWidth", "ScrollBarWidth", number);
3345 x_default_parameter (f, parms, Qbuffer_predicate, Qnil,
3346 "bufferPredicate", "BufferPredicate", symbol);
3347 x_default_parameter (f, parms, Qtitle, Qnil,
3348 "title", "Title", string);
3350 f->output_data.x->parent_desc = FRAME_X_DISPLAY_INFO (f)->root_window;
3351 window_prompting = x_figure_window_size (f, parms);
3353 if (window_prompting & XNegative)
3355 if (window_prompting & YNegative)
3356 f->output_data.x->win_gravity = SouthEastGravity;
3357 else
3358 f->output_data.x->win_gravity = NorthEastGravity;
3360 else
3362 if (window_prompting & YNegative)
3363 f->output_data.x->win_gravity = SouthWestGravity;
3364 else
3365 f->output_data.x->win_gravity = NorthWestGravity;
3368 f->output_data.x->size_hint_flags = window_prompting;
3370 #ifdef USE_X_TOOLKIT
3371 x_window (f, window_prompting, minibuffer_only);
3372 #else
3373 x_window (f);
3374 #endif
3375 x_icon (f, parms);
3376 x_make_gc (f);
3377 init_frame_faces (f);
3379 /* We need to do this after creating the X window, so that the
3380 icon-creation functions can say whose icon they're describing. */
3381 x_default_parameter (f, parms, Qicon_type, Qnil,
3382 "bitmapIcon", "BitmapIcon", symbol);
3384 x_default_parameter (f, parms, Qauto_raise, Qnil,
3385 "autoRaise", "AutoRaiseLower", boolean);
3386 x_default_parameter (f, parms, Qauto_lower, Qnil,
3387 "autoLower", "AutoRaiseLower", boolean);
3388 x_default_parameter (f, parms, Qcursor_type, Qbox,
3389 "cursorType", "CursorType", symbol);
3391 /* Dimensions, especially f->height, must be done via change_frame_size.
3392 Change will not be effected unless different from the current
3393 f->height. */
3394 width = f->width;
3395 height = f->height;
3396 f->height = 0;
3397 SET_FRAME_WIDTH (f, 0);
3398 change_frame_size (f, height, width, 1, 0);
3400 /* Tell the server what size and position, etc, we want,
3401 and how badly we want them. */
3402 BLOCK_INPUT;
3403 x_wm_set_size_hint (f, window_prompting, 0);
3404 UNBLOCK_INPUT;
3406 tem = x_get_arg (dpyinfo, parms, Qunsplittable, 0, 0, boolean);
3407 f->no_split = minibuffer_only || EQ (tem, Qt);
3409 UNGCPRO;
3411 /* It is now ok to make the frame official
3412 even if we get an error below.
3413 And the frame needs to be on Vframe_list
3414 or making it visible won't work. */
3415 Vframe_list = Fcons (frame, Vframe_list);
3417 /* Now that the frame is official, it counts as a reference to
3418 its display. */
3419 FRAME_X_DISPLAY_INFO (f)->reference_count++;
3421 /* Make the window appear on the frame and enable display,
3422 unless the caller says not to. However, with explicit parent,
3423 Emacs cannot control visibility, so don't try. */
3424 if (! f->output_data.x->explicit_parent)
3426 Lisp_Object visibility;
3428 visibility = x_get_arg (dpyinfo, parms, Qvisibility, 0, 0, symbol);
3429 if (EQ (visibility, Qunbound))
3430 visibility = Qt;
3432 if (EQ (visibility, Qicon))
3433 x_iconify_frame (f);
3434 else if (! NILP (visibility))
3435 x_make_frame_visible (f);
3436 else
3437 /* Must have been Qnil. */
3441 return unbind_to (count, frame);
3444 /* FRAME is used only to get a handle on the X display. We don't pass the
3445 display info directly because we're called from frame.c, which doesn't
3446 know about that structure. */
3448 Lisp_Object
3449 x_get_focus_frame (frame)
3450 struct frame *frame;
3452 struct x_display_info *dpyinfo = FRAME_X_DISPLAY_INFO (frame);
3453 Lisp_Object xfocus;
3454 if (! dpyinfo->x_focus_frame)
3455 return Qnil;
3457 XSETFRAME (xfocus, dpyinfo->x_focus_frame);
3458 return xfocus;
3461 #if 1
3462 #include "x-list-font.c"
3463 #else
3464 DEFUN ("x-list-fonts", Fx_list_fonts, Sx_list_fonts, 1, 4, 0,
3465 "Return a list of the names of available fonts matching PATTERN.\n\
3466 If optional arguments FACE and FRAME are specified, return only fonts\n\
3467 the same size as FACE on FRAME.\n\
3469 PATTERN is a string, perhaps with wildcard characters;\n\
3470 the * character matches any substring, and\n\
3471 the ? character matches any single character.\n\
3472 PATTERN is case-insensitive.\n\
3473 FACE is a face name--a symbol.\n\
3475 The return value is a list of strings, suitable as arguments to\n\
3476 set-face-font.\n\
3478 Fonts Emacs can't use (i.e. proportional fonts) may or may not be excluded\n\
3479 even if they match PATTERN and FACE.\n\
3481 The optional fourth argument MAXIMUM sets a limit on how many\n\
3482 fonts to match. The first MAXIMUM fonts are reported.")
3483 (pattern, face, frame, maximum)
3484 Lisp_Object pattern, face, frame, maximum;
3486 int num_fonts;
3487 char **names;
3488 #ifndef BROKEN_XLISTFONTSWITHINFO
3489 XFontStruct *info;
3490 #endif
3491 XFontStruct *size_ref;
3492 Lisp_Object list;
3493 FRAME_PTR f;
3494 Lisp_Object key;
3495 int maxnames;
3496 int count;
3498 check_x ();
3499 CHECK_STRING (pattern, 0);
3500 if (!NILP (face))
3501 CHECK_SYMBOL (face, 1);
3503 if (NILP (maximum))
3504 maxnames = 2000;
3505 else
3507 CHECK_NATNUM (maximum, 0);
3508 maxnames = XINT (maximum);
3511 f = check_x_frame (frame);
3513 /* Determine the width standard for comparison with the fonts we find. */
3515 if (NILP (face))
3516 size_ref = 0;
3517 else
3519 int face_id;
3521 /* Don't die if we get called with a terminal frame. */
3522 if (! FRAME_X_P (f))
3523 error ("Non-X frame used in `x-list-fonts'");
3525 face_id = face_name_id_number (f, face);
3527 if (face_id < 0 || face_id >= FRAME_N_PARAM_FACES (f)
3528 || FRAME_PARAM_FACES (f) [face_id] == 0)
3529 size_ref = f->output_data.x->font;
3530 else
3532 size_ref = FRAME_PARAM_FACES (f) [face_id]->font;
3533 if (size_ref == (XFontStruct *) (~0))
3534 size_ref = f->output_data.x->font;
3538 /* See if we cached the result for this particular query. */
3539 key = Fcons (pattern, maximum);
3540 list = Fassoc (key,
3541 XCONS (FRAME_X_DISPLAY_INFO (f)->name_list_element)->cdr);
3543 /* We have info in the cache for this PATTERN. */
3544 if (!NILP (list))
3546 Lisp_Object tem, newlist;
3548 /* We have info about this pattern. */
3549 list = XCONS (list)->cdr;
3551 if (size_ref == 0)
3552 return list;
3554 BLOCK_INPUT;
3556 /* Filter the cached info and return just the fonts that match FACE. */
3557 newlist = Qnil;
3558 for (tem = list; CONSP (tem); tem = XCONS (tem)->cdr)
3560 XFontStruct *thisinfo;
3562 count = x_catch_errors (FRAME_X_DISPLAY (f));
3564 thisinfo = XLoadQueryFont (FRAME_X_DISPLAY (f),
3565 XSTRING (XCONS (tem)->car)->data);
3567 x_check_errors (FRAME_X_DISPLAY (f), "XLoadQueryFont failure: %s");
3568 x_uncatch_errors (FRAME_X_DISPLAY (f), count);
3570 if (thisinfo && same_size_fonts (thisinfo, size_ref))
3571 newlist = Fcons (XCONS (tem)->car, newlist);
3573 if (thisinfo != 0)
3574 XFreeFont (FRAME_X_DISPLAY (f), thisinfo);
3577 UNBLOCK_INPUT;
3579 return newlist;
3582 BLOCK_INPUT;
3584 count = x_catch_errors (FRAME_X_DISPLAY (f));
3586 /* Solaris 2.3 has a bug in XListFontsWithInfo. */
3587 #ifndef BROKEN_XLISTFONTSWITHINFO
3588 if (size_ref)
3589 names = XListFontsWithInfo (FRAME_X_DISPLAY (f),
3590 XSTRING (pattern)->data,
3591 maxnames,
3592 &num_fonts, /* count_return */
3593 &info); /* info_return */
3594 else
3595 #endif
3596 names = XListFonts (FRAME_X_DISPLAY (f),
3597 XSTRING (pattern)->data,
3598 maxnames,
3599 &num_fonts); /* count_return */
3601 x_check_errors (FRAME_X_DISPLAY (f), "XListFonts failure: %s");
3602 x_uncatch_errors (FRAME_X_DISPLAY (f), count);
3604 UNBLOCK_INPUT;
3606 list = Qnil;
3608 if (names)
3610 int i;
3611 Lisp_Object full_list;
3613 /* Make a list of all the fonts we got back.
3614 Store that in the font cache for the display. */
3615 full_list = Qnil;
3616 for (i = 0; i < num_fonts; i++)
3617 full_list = Fcons (build_string (names[i]), full_list);
3618 XCONS (FRAME_X_DISPLAY_INFO (f)->name_list_element)->cdr
3619 = Fcons (Fcons (key, full_list),
3620 XCONS (FRAME_X_DISPLAY_INFO (f)->name_list_element)->cdr);
3622 /* Make a list of the fonts that have the right width. */
3623 list = Qnil;
3624 for (i = 0; i < num_fonts; i++)
3626 int keeper;
3628 if (!size_ref)
3629 keeper = 1;
3630 else
3632 #ifdef BROKEN_XLISTFONTSWITHINFO
3633 XFontStruct *thisinfo;
3635 BLOCK_INPUT;
3637 count = x_catch_errors (FRAME_X_DISPLAY (f));
3638 thisinfo = XLoadQueryFont (FRAME_X_DISPLAY (f), names[i]);
3639 x_check_errors (FRAME_X_DISPLAY (f),
3640 "XLoadQueryFont failure: %s");
3641 x_uncatch_errors (FRAME_X_DISPLAY (f), count);
3643 UNBLOCK_INPUT;
3645 keeper = thisinfo && same_size_fonts (thisinfo, size_ref);
3646 BLOCK_INPUT;
3647 if (thisinfo && ! keeper)
3648 XFreeFont (FRAME_X_DISPLAY (f), thisinfo);
3649 else if (thisinfo)
3650 XFreeFontInfo (NULL, thisinfo, 1);
3651 UNBLOCK_INPUT;
3652 #else
3653 keeper = same_size_fonts (&info[i], size_ref);
3654 #endif
3656 if (keeper)
3657 list = Fcons (build_string (names[i]), list);
3659 list = Fnreverse (list);
3661 BLOCK_INPUT;
3662 #ifndef BROKEN_XLISTFONTSWITHINFO
3663 if (size_ref)
3664 XFreeFontInfo (names, info, num_fonts);
3665 else
3666 #endif
3667 XFreeFontNames (names);
3668 UNBLOCK_INPUT;
3671 return list;
3673 #endif
3676 DEFUN ("x-color-defined-p", Fx_color_defined_p, Sx_color_defined_p, 1, 2, 0,
3677 "Return non-nil if color COLOR is supported on frame FRAME.\n\
3678 If FRAME is omitted or nil, use the selected frame.")
3679 (color, frame)
3680 Lisp_Object color, frame;
3682 XColor foo;
3683 FRAME_PTR f = check_x_frame (frame);
3685 CHECK_STRING (color, 1);
3687 if (defined_color (f, XSTRING (color)->data, &foo, 0))
3688 return Qt;
3689 else
3690 return Qnil;
3693 DEFUN ("x-color-values", Fx_color_values, Sx_color_values, 1, 2, 0,
3694 "Return a description of the color named COLOR on frame FRAME.\n\
3695 The value is a list of integer RGB values--(RED GREEN BLUE).\n\
3696 These values appear to range from 0 to 65280 or 65535, depending\n\
3697 on the system; white is (65280 65280 65280) or (65535 65535 65535).\n\
3698 If FRAME is omitted or nil, use the selected frame.")
3699 (color, frame)
3700 Lisp_Object color, frame;
3702 XColor foo;
3703 FRAME_PTR f = check_x_frame (frame);
3705 CHECK_STRING (color, 1);
3707 if (defined_color (f, XSTRING (color)->data, &foo, 0))
3709 Lisp_Object rgb[3];
3711 rgb[0] = make_number (foo.red);
3712 rgb[1] = make_number (foo.green);
3713 rgb[2] = make_number (foo.blue);
3714 return Flist (3, rgb);
3716 else
3717 return Qnil;
3720 DEFUN ("x-display-color-p", Fx_display_color_p, Sx_display_color_p, 0, 1, 0,
3721 "Return t if the X display supports color.\n\
3722 The optional argument DISPLAY specifies which display to ask about.\n\
3723 DISPLAY should be either a frame or a display name (a string).\n\
3724 If omitted or nil, that stands for the selected frame's display.")
3725 (display)
3726 Lisp_Object display;
3728 struct x_display_info *dpyinfo = check_x_display_info (display);
3730 if (dpyinfo->n_planes <= 2)
3731 return Qnil;
3733 switch (dpyinfo->visual->class)
3735 case StaticColor:
3736 case PseudoColor:
3737 case TrueColor:
3738 case DirectColor:
3739 return Qt;
3741 default:
3742 return Qnil;
3746 DEFUN ("x-display-grayscale-p", Fx_display_grayscale_p, Sx_display_grayscale_p,
3747 0, 1, 0,
3748 "Return t if the X display supports shades of gray.\n\
3749 Note that color displays do support shades of gray.\n\
3750 The optional argument DISPLAY specifies which display to ask about.\n\
3751 DISPLAY should be either a frame or a display name (a string).\n\
3752 If omitted or nil, that stands for the selected frame's display.")
3753 (display)
3754 Lisp_Object display;
3756 struct x_display_info *dpyinfo = check_x_display_info (display);
3758 if (dpyinfo->n_planes <= 1)
3759 return Qnil;
3761 switch (dpyinfo->visual->class)
3763 case StaticColor:
3764 case PseudoColor:
3765 case TrueColor:
3766 case DirectColor:
3767 case StaticGray:
3768 case GrayScale:
3769 return Qt;
3771 default:
3772 return Qnil;
3776 DEFUN ("x-display-pixel-width", Fx_display_pixel_width, Sx_display_pixel_width,
3777 0, 1, 0,
3778 "Returns the width in pixels of the X display DISPLAY.\n\
3779 The optional argument DISPLAY specifies which display to ask about.\n\
3780 DISPLAY should be either a frame or a display name (a string).\n\
3781 If omitted or nil, that stands for the selected frame's display.")
3782 (display)
3783 Lisp_Object display;
3785 struct x_display_info *dpyinfo = check_x_display_info (display);
3787 return make_number (dpyinfo->width);
3790 DEFUN ("x-display-pixel-height", Fx_display_pixel_height,
3791 Sx_display_pixel_height, 0, 1, 0,
3792 "Returns the height in pixels of the X display DISPLAY.\n\
3793 The optional argument DISPLAY specifies which display to ask about.\n\
3794 DISPLAY should be either a frame or a display name (a string).\n\
3795 If omitted or nil, that stands for the selected frame's display.")
3796 (display)
3797 Lisp_Object display;
3799 struct x_display_info *dpyinfo = check_x_display_info (display);
3801 return make_number (dpyinfo->height);
3804 DEFUN ("x-display-planes", Fx_display_planes, Sx_display_planes,
3805 0, 1, 0,
3806 "Returns the number of bitplanes of the X display DISPLAY.\n\
3807 The optional argument DISPLAY specifies which display to ask about.\n\
3808 DISPLAY should be either a frame or a display name (a string).\n\
3809 If omitted or nil, that stands for the selected frame's display.")
3810 (display)
3811 Lisp_Object display;
3813 struct x_display_info *dpyinfo = check_x_display_info (display);
3815 return make_number (dpyinfo->n_planes);
3818 DEFUN ("x-display-color-cells", Fx_display_color_cells, Sx_display_color_cells,
3819 0, 1, 0,
3820 "Returns the number of color cells of the X display DISPLAY.\n\
3821 The optional argument DISPLAY specifies which display to ask about.\n\
3822 DISPLAY should be either a frame or a display name (a string).\n\
3823 If omitted or nil, that stands for the selected frame's display.")
3824 (display)
3825 Lisp_Object display;
3827 struct x_display_info *dpyinfo = check_x_display_info (display);
3829 return make_number (DisplayCells (dpyinfo->display,
3830 XScreenNumberOfScreen (dpyinfo->screen)));
3833 DEFUN ("x-server-max-request-size", Fx_server_max_request_size,
3834 Sx_server_max_request_size,
3835 0, 1, 0,
3836 "Returns the maximum request size of the X server of display DISPLAY.\n\
3837 The optional argument DISPLAY specifies which display to ask about.\n\
3838 DISPLAY should be either a frame or a display name (a string).\n\
3839 If omitted or nil, that stands for the selected frame's display.")
3840 (display)
3841 Lisp_Object display;
3843 struct x_display_info *dpyinfo = check_x_display_info (display);
3845 return make_number (MAXREQUEST (dpyinfo->display));
3848 DEFUN ("x-server-vendor", Fx_server_vendor, Sx_server_vendor, 0, 1, 0,
3849 "Returns the vendor ID string of the X server of display DISPLAY.\n\
3850 The optional argument DISPLAY specifies which display to ask about.\n\
3851 DISPLAY should be either a frame or a display name (a string).\n\
3852 If omitted or nil, that stands for the selected frame's display.")
3853 (display)
3854 Lisp_Object display;
3856 struct x_display_info *dpyinfo = check_x_display_info (display);
3857 char *vendor = ServerVendor (dpyinfo->display);
3859 if (! vendor) vendor = "";
3860 return build_string (vendor);
3863 DEFUN ("x-server-version", Fx_server_version, Sx_server_version, 0, 1, 0,
3864 "Returns the version numbers of the X server of display DISPLAY.\n\
3865 The value is a list of three integers: the major and minor\n\
3866 version numbers of the X Protocol in use, and the vendor-specific release\n\
3867 number. See also the function `x-server-vendor'.\n\n\
3868 The optional argument DISPLAY specifies which display to ask about.\n\
3869 DISPLAY should be either a frame or a display name (a string).\n\
3870 If omitted or nil, that stands for the selected frame's display.")
3871 (display)
3872 Lisp_Object display;
3874 struct x_display_info *dpyinfo = check_x_display_info (display);
3875 Display *dpy = dpyinfo->display;
3877 return Fcons (make_number (ProtocolVersion (dpy)),
3878 Fcons (make_number (ProtocolRevision (dpy)),
3879 Fcons (make_number (VendorRelease (dpy)), Qnil)));
3882 DEFUN ("x-display-screens", Fx_display_screens, Sx_display_screens, 0, 1, 0,
3883 "Returns the number of screens on the X server of display DISPLAY.\n\
3884 The optional argument DISPLAY specifies which display to ask about.\n\
3885 DISPLAY should be either a frame or a display name (a string).\n\
3886 If omitted or nil, that stands for the selected frame's display.")
3887 (display)
3888 Lisp_Object display;
3890 struct x_display_info *dpyinfo = check_x_display_info (display);
3892 return make_number (ScreenCount (dpyinfo->display));
3895 DEFUN ("x-display-mm-height", Fx_display_mm_height, Sx_display_mm_height, 0, 1, 0,
3896 "Returns the height in millimeters of the X display DISPLAY.\n\
3897 The optional argument DISPLAY specifies which display to ask about.\n\
3898 DISPLAY should be either a frame or a display name (a string).\n\
3899 If omitted or nil, that stands for the selected frame's display.")
3900 (display)
3901 Lisp_Object display;
3903 struct x_display_info *dpyinfo = check_x_display_info (display);
3905 return make_number (HeightMMOfScreen (dpyinfo->screen));
3908 DEFUN ("x-display-mm-width", Fx_display_mm_width, Sx_display_mm_width, 0, 1, 0,
3909 "Returns the width in millimeters of the X display DISPLAY.\n\
3910 The optional argument DISPLAY specifies which display to ask about.\n\
3911 DISPLAY should be either a frame or a display name (a string).\n\
3912 If omitted or nil, that stands for the selected frame's display.")
3913 (display)
3914 Lisp_Object display;
3916 struct x_display_info *dpyinfo = check_x_display_info (display);
3918 return make_number (WidthMMOfScreen (dpyinfo->screen));
3921 DEFUN ("x-display-backing-store", Fx_display_backing_store,
3922 Sx_display_backing_store, 0, 1, 0,
3923 "Returns an indication of whether X display DISPLAY does backing store.\n\
3924 The value may be `always', `when-mapped', or `not-useful'.\n\
3925 The optional argument DISPLAY specifies which display to ask about.\n\
3926 DISPLAY should be either a frame or a display name (a string).\n\
3927 If omitted or nil, that stands for the selected frame's display.")
3928 (display)
3929 Lisp_Object display;
3931 struct x_display_info *dpyinfo = check_x_display_info (display);
3933 switch (DoesBackingStore (dpyinfo->screen))
3935 case Always:
3936 return intern ("always");
3938 case WhenMapped:
3939 return intern ("when-mapped");
3941 case NotUseful:
3942 return intern ("not-useful");
3944 default:
3945 error ("Strange value for BackingStore parameter of screen");
3949 DEFUN ("x-display-visual-class", Fx_display_visual_class,
3950 Sx_display_visual_class, 0, 1, 0,
3951 "Returns the visual class of the X display DISPLAY.\n\
3952 The value is one of the symbols `static-gray', `gray-scale',\n\
3953 `static-color', `pseudo-color', `true-color', or `direct-color'.\n\n\
3954 The optional argument DISPLAY specifies which display to ask about.\n\
3955 DISPLAY should be either a frame or a display name (a string).\n\
3956 If omitted or nil, that stands for the selected frame's display.")
3957 (display)
3958 Lisp_Object display;
3960 struct x_display_info *dpyinfo = check_x_display_info (display);
3962 switch (dpyinfo->visual->class)
3964 case StaticGray: return (intern ("static-gray"));
3965 case GrayScale: return (intern ("gray-scale"));
3966 case StaticColor: return (intern ("static-color"));
3967 case PseudoColor: return (intern ("pseudo-color"));
3968 case TrueColor: return (intern ("true-color"));
3969 case DirectColor: return (intern ("direct-color"));
3970 default:
3971 error ("Display has an unknown visual class");
3975 DEFUN ("x-display-save-under", Fx_display_save_under,
3976 Sx_display_save_under, 0, 1, 0,
3977 "Returns t if the X display DISPLAY supports the save-under feature.\n\
3978 The optional argument DISPLAY specifies which display to ask about.\n\
3979 DISPLAY should be either a frame or a display name (a string).\n\
3980 If omitted or nil, that stands for the selected frame's display.")
3981 (display)
3982 Lisp_Object display;
3984 struct x_display_info *dpyinfo = check_x_display_info (display);
3986 if (DoesSaveUnders (dpyinfo->screen) == True)
3987 return Qt;
3988 else
3989 return Qnil;
3993 x_pixel_width (f)
3994 register struct frame *f;
3996 return PIXEL_WIDTH (f);
4000 x_pixel_height (f)
4001 register struct frame *f;
4003 return PIXEL_HEIGHT (f);
4007 x_char_width (f)
4008 register struct frame *f;
4010 return FONT_WIDTH (f->output_data.x->font);
4014 x_char_height (f)
4015 register struct frame *f;
4017 return f->output_data.x->line_height;
4021 x_screen_planes (frame)
4022 Lisp_Object frame;
4024 return FRAME_X_DISPLAY_INFO (XFRAME (frame))->n_planes;
4027 #if 0 /* These no longer seem like the right way to do things. */
4029 /* Draw a rectangle on the frame with left top corner including
4030 the character specified by LEFT_CHAR and TOP_CHAR. The rectangle is
4031 CHARS by LINES wide and long and is the color of the cursor. */
4033 void
4034 x_rectangle (f, gc, left_char, top_char, chars, lines)
4035 register struct frame *f;
4036 GC gc;
4037 register int top_char, left_char, chars, lines;
4039 int width;
4040 int height;
4041 int left = (left_char * FONT_WIDTH (f->output_data.x->font)
4042 + f->output_data.x->internal_border_width);
4043 int top = (top_char * f->output_data.x->line_height
4044 + f->output_data.x->internal_border_width);
4046 if (chars < 0)
4047 width = FONT_WIDTH (f->output_data.x->font) / 2;
4048 else
4049 width = FONT_WIDTH (f->output_data.x->font) * chars;
4050 if (lines < 0)
4051 height = f->output_data.x->line_height / 2;
4052 else
4053 height = f->output_data.x->line_height * lines;
4055 XDrawRectangle (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
4056 gc, left, top, width, height);
4059 DEFUN ("x-draw-rectangle", Fx_draw_rectangle, Sx_draw_rectangle, 5, 5, 0,
4060 "Draw a rectangle on FRAME between coordinates specified by\n\
4061 numbers X0, Y0, X1, Y1 in the cursor pixel.")
4062 (frame, X0, Y0, X1, Y1)
4063 register Lisp_Object frame, X0, X1, Y0, Y1;
4065 register int x0, y0, x1, y1, top, left, n_chars, n_lines;
4067 CHECK_LIVE_FRAME (frame, 0);
4068 CHECK_NUMBER (X0, 0);
4069 CHECK_NUMBER (Y0, 1);
4070 CHECK_NUMBER (X1, 2);
4071 CHECK_NUMBER (Y1, 3);
4073 x0 = XINT (X0);
4074 x1 = XINT (X1);
4075 y0 = XINT (Y0);
4076 y1 = XINT (Y1);
4078 if (y1 > y0)
4080 top = y0;
4081 n_lines = y1 - y0 + 1;
4083 else
4085 top = y1;
4086 n_lines = y0 - y1 + 1;
4089 if (x1 > x0)
4091 left = x0;
4092 n_chars = x1 - x0 + 1;
4094 else
4096 left = x1;
4097 n_chars = x0 - x1 + 1;
4100 BLOCK_INPUT;
4101 x_rectangle (XFRAME (frame), XFRAME (frame)->output_data.x->cursor_gc,
4102 left, top, n_chars, n_lines);
4103 UNBLOCK_INPUT;
4105 return Qt;
4108 DEFUN ("x-erase-rectangle", Fx_erase_rectangle, Sx_erase_rectangle, 5, 5, 0,
4109 "Draw a rectangle drawn on FRAME between coordinates\n\
4110 X0, Y0, X1, Y1 in the regular background-pixel.")
4111 (frame, X0, Y0, X1, Y1)
4112 register Lisp_Object frame, X0, Y0, X1, Y1;
4114 register int x0, y0, x1, y1, top, left, n_chars, n_lines;
4116 CHECK_LIVE_FRAME (frame, 0);
4117 CHECK_NUMBER (X0, 0);
4118 CHECK_NUMBER (Y0, 1);
4119 CHECK_NUMBER (X1, 2);
4120 CHECK_NUMBER (Y1, 3);
4122 x0 = XINT (X0);
4123 x1 = XINT (X1);
4124 y0 = XINT (Y0);
4125 y1 = XINT (Y1);
4127 if (y1 > y0)
4129 top = y0;
4130 n_lines = y1 - y0 + 1;
4132 else
4134 top = y1;
4135 n_lines = y0 - y1 + 1;
4138 if (x1 > x0)
4140 left = x0;
4141 n_chars = x1 - x0 + 1;
4143 else
4145 left = x1;
4146 n_chars = x0 - x1 + 1;
4149 BLOCK_INPUT;
4150 x_rectangle (XFRAME (frame), XFRAME (frame)->output_data.x->reverse_gc,
4151 left, top, n_chars, n_lines);
4152 UNBLOCK_INPUT;
4154 return Qt;
4157 /* Draw lines around the text region beginning at the character position
4158 TOP_X, TOP_Y and ending at BOTTOM_X and BOTTOM_Y. GC specifies the
4159 pixel and line characteristics. */
4161 #define line_len(line) (FRAME_CURRENT_GLYPHS (f)->used[(line)])
4163 static void
4164 outline_region (f, gc, top_x, top_y, bottom_x, bottom_y)
4165 register struct frame *f;
4166 GC gc;
4167 int top_x, top_y, bottom_x, bottom_y;
4169 register int ibw = f->output_data.x->internal_border_width;
4170 register int font_w = FONT_WIDTH (f->output_data.x->font);
4171 register int font_h = f->output_data.x->line_height;
4172 int y = top_y;
4173 int x = line_len (y);
4174 XPoint *pixel_points
4175 = (XPoint *) alloca (((bottom_y - top_y + 2) * 4) * sizeof (XPoint));
4176 register XPoint *this_point = pixel_points;
4178 /* Do the horizontal top line/lines */
4179 if (top_x == 0)
4181 this_point->x = ibw;
4182 this_point->y = ibw + (font_h * top_y);
4183 this_point++;
4184 if (x == 0)
4185 this_point->x = ibw + (font_w / 2); /* Half-size for newline chars. */
4186 else
4187 this_point->x = ibw + (font_w * x);
4188 this_point->y = (this_point - 1)->y;
4190 else
4192 this_point->x = ibw;
4193 this_point->y = ibw + (font_h * (top_y + 1));
4194 this_point++;
4195 this_point->x = ibw + (font_w * top_x);
4196 this_point->y = (this_point - 1)->y;
4197 this_point++;
4198 this_point->x = (this_point - 1)->x;
4199 this_point->y = ibw + (font_h * top_y);
4200 this_point++;
4201 this_point->x = ibw + (font_w * x);
4202 this_point->y = (this_point - 1)->y;
4205 /* Now do the right side. */
4206 while (y < bottom_y)
4207 { /* Right vertical edge */
4208 this_point++;
4209 this_point->x = (this_point - 1)->x;
4210 this_point->y = ibw + (font_h * (y + 1));
4211 this_point++;
4213 y++; /* Horizontal connection to next line */
4214 x = line_len (y);
4215 if (x == 0)
4216 this_point->x = ibw + (font_w / 2);
4217 else
4218 this_point->x = ibw + (font_w * x);
4220 this_point->y = (this_point - 1)->y;
4223 /* Now do the bottom and connect to the top left point. */
4224 this_point->x = ibw + (font_w * (bottom_x + 1));
4226 this_point++;
4227 this_point->x = (this_point - 1)->x;
4228 this_point->y = ibw + (font_h * (bottom_y + 1));
4229 this_point++;
4230 this_point->x = ibw;
4231 this_point->y = (this_point - 1)->y;
4232 this_point++;
4233 this_point->x = pixel_points->x;
4234 this_point->y = pixel_points->y;
4236 XDrawLines (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
4237 gc, pixel_points,
4238 (this_point - pixel_points + 1), CoordModeOrigin);
4241 DEFUN ("x-contour-region", Fx_contour_region, Sx_contour_region, 1, 1, 0,
4242 "Highlight the region between point and the character under the mouse\n\
4243 selected frame.")
4244 (event)
4245 register Lisp_Object event;
4247 register int x0, y0, x1, y1;
4248 register struct frame *f = selected_frame;
4249 register int p1, p2;
4251 CHECK_CONS (event, 0);
4253 BLOCK_INPUT;
4254 x0 = XINT (Fcar (Fcar (event)));
4255 y0 = XINT (Fcar (Fcdr (Fcar (event))));
4257 /* If the mouse is past the end of the line, don't that area. */
4258 /* ReWrite this... */
4260 x1 = f->cursor_x;
4261 y1 = f->cursor_y;
4263 if (y1 > y0) /* point below mouse */
4264 outline_region (f, f->output_data.x->cursor_gc,
4265 x0, y0, x1, y1);
4266 else if (y1 < y0) /* point above mouse */
4267 outline_region (f, f->output_data.x->cursor_gc,
4268 x1, y1, x0, y0);
4269 else /* same line: draw horizontal rectangle */
4271 if (x1 > x0)
4272 x_rectangle (f, f->output_data.x->cursor_gc,
4273 x0, y0, (x1 - x0 + 1), 1);
4274 else if (x1 < x0)
4275 x_rectangle (f, f->output_data.x->cursor_gc,
4276 x1, y1, (x0 - x1 + 1), 1);
4279 XFlush (FRAME_X_DISPLAY (f));
4280 UNBLOCK_INPUT;
4282 return Qnil;
4285 DEFUN ("x-uncontour-region", Fx_uncontour_region, Sx_uncontour_region, 1, 1, 0,
4286 "Erase any highlighting of the region between point and the character\n\
4287 at X, Y on the selected frame.")
4288 (event)
4289 register Lisp_Object event;
4291 register int x0, y0, x1, y1;
4292 register struct frame *f = selected_frame;
4294 BLOCK_INPUT;
4295 x0 = XINT (Fcar (Fcar (event)));
4296 y0 = XINT (Fcar (Fcdr (Fcar (event))));
4297 x1 = f->cursor_x;
4298 y1 = f->cursor_y;
4300 if (y1 > y0) /* point below mouse */
4301 outline_region (f, f->output_data.x->reverse_gc,
4302 x0, y0, x1, y1);
4303 else if (y1 < y0) /* point above mouse */
4304 outline_region (f, f->output_data.x->reverse_gc,
4305 x1, y1, x0, y0);
4306 else /* same line: draw horizontal rectangle */
4308 if (x1 > x0)
4309 x_rectangle (f, f->output_data.x->reverse_gc,
4310 x0, y0, (x1 - x0 + 1), 1);
4311 else if (x1 < x0)
4312 x_rectangle (f, f->output_data.x->reverse_gc,
4313 x1, y1, (x0 - x1 + 1), 1);
4315 UNBLOCK_INPUT;
4317 return Qnil;
4320 #if 0
4321 int contour_begin_x, contour_begin_y;
4322 int contour_end_x, contour_end_y;
4323 int contour_npoints;
4325 /* Clip the top part of the contour lines down (and including) line Y_POS.
4326 If X_POS is in the middle (rather than at the end) of the line, drop
4327 down a line at that character. */
4329 static void
4330 clip_contour_top (y_pos, x_pos)
4332 register XPoint *begin = contour_lines[y_pos].top_left;
4333 register XPoint *end;
4334 register int npoints;
4335 register struct display_line *line = selected_frame->phys_lines[y_pos + 1];
4337 if (x_pos >= line->len - 1) /* Draw one, straight horizontal line. */
4339 end = contour_lines[y_pos].top_right;
4340 npoints = (end - begin + 1);
4341 XDrawLines (x_current_display, contour_window,
4342 contour_erase_gc, begin_erase, npoints, CoordModeOrigin);
4344 bcopy (end, begin + 1, contour_last_point - end + 1);
4345 contour_last_point -= (npoints - 2);
4346 XDrawLines (x_current_display, contour_window,
4347 contour_erase_gc, begin, 2, CoordModeOrigin);
4348 XFlush (x_current_display);
4350 /* Now, update contour_lines structure. */
4352 /* ______. */
4353 else /* |________*/
4355 register XPoint *p = begin + 1;
4356 end = contour_lines[y_pos].bottom_right;
4357 npoints = (end - begin + 1);
4358 XDrawLines (x_current_display, contour_window,
4359 contour_erase_gc, begin_erase, npoints, CoordModeOrigin);
4361 p->y = begin->y;
4362 p->x = ibw + (font_w * (x_pos + 1));
4363 p++;
4364 p->y = begin->y + font_h;
4365 p->x = (p - 1)->x;
4366 bcopy (end, begin + 3, contour_last_point - end + 1);
4367 contour_last_point -= (npoints - 5);
4368 XDrawLines (x_current_display, contour_window,
4369 contour_erase_gc, begin, 4, CoordModeOrigin);
4370 XFlush (x_current_display);
4372 /* Now, update contour_lines structure. */
4376 /* Erase the top horizontal lines of the contour, and then extend
4377 the contour upwards. */
4379 static void
4380 extend_contour_top (line)
4384 static void
4385 clip_contour_bottom (x_pos, y_pos)
4386 int x_pos, y_pos;
4390 static void
4391 extend_contour_bottom (x_pos, y_pos)
4395 DEFUN ("x-select-region", Fx_select_region, Sx_select_region, 1, 1, "e",
4397 (event)
4398 Lisp_Object event;
4400 register struct frame *f = selected_frame;
4401 register int point_x = f->cursor_x;
4402 register int point_y = f->cursor_y;
4403 register int mouse_below_point;
4404 register Lisp_Object obj;
4405 register int x_contour_x, x_contour_y;
4407 x_contour_x = x_mouse_x;
4408 x_contour_y = x_mouse_y;
4409 if (x_contour_y > point_y || (x_contour_y == point_y
4410 && x_contour_x > point_x))
4412 mouse_below_point = 1;
4413 outline_region (f, f->output_data.x->cursor_gc, point_x, point_y,
4414 x_contour_x, x_contour_y);
4416 else
4418 mouse_below_point = 0;
4419 outline_region (f, f->output_data.x->cursor_gc, x_contour_x, x_contour_y,
4420 point_x, point_y);
4423 while (1)
4425 obj = read_char (-1, 0, 0, Qnil, 0);
4426 if (!CONSP (obj))
4427 break;
4429 if (mouse_below_point)
4431 if (x_mouse_y <= point_y) /* Flipped. */
4433 mouse_below_point = 0;
4435 outline_region (f, f->output_data.x->reverse_gc, point_x, point_y,
4436 x_contour_x, x_contour_y);
4437 outline_region (f, f->output_data.x->cursor_gc, x_mouse_x, x_mouse_y,
4438 point_x, point_y);
4440 else if (x_mouse_y < x_contour_y) /* Bottom clipped. */
4442 clip_contour_bottom (x_mouse_y);
4444 else if (x_mouse_y > x_contour_y) /* Bottom extended. */
4446 extend_bottom_contour (x_mouse_y);
4449 x_contour_x = x_mouse_x;
4450 x_contour_y = x_mouse_y;
4452 else /* mouse above or same line as point */
4454 if (x_mouse_y >= point_y) /* Flipped. */
4456 mouse_below_point = 1;
4458 outline_region (f, f->output_data.x->reverse_gc,
4459 x_contour_x, x_contour_y, point_x, point_y);
4460 outline_region (f, f->output_data.x->cursor_gc, point_x, point_y,
4461 x_mouse_x, x_mouse_y);
4463 else if (x_mouse_y > x_contour_y) /* Top clipped. */
4465 clip_contour_top (x_mouse_y);
4467 else if (x_mouse_y < x_contour_y) /* Top extended. */
4469 extend_contour_top (x_mouse_y);
4474 unread_command_event = obj;
4475 if (mouse_below_point)
4477 contour_begin_x = point_x;
4478 contour_begin_y = point_y;
4479 contour_end_x = x_contour_x;
4480 contour_end_y = x_contour_y;
4482 else
4484 contour_begin_x = x_contour_x;
4485 contour_begin_y = x_contour_y;
4486 contour_end_x = point_x;
4487 contour_end_y = point_y;
4490 #endif
4492 DEFUN ("x-horizontal-line", Fx_horizontal_line, Sx_horizontal_line, 1, 1, "e",
4494 (event)
4495 Lisp_Object event;
4497 register Lisp_Object obj;
4498 struct frame *f = selected_frame;
4499 register struct window *w = XWINDOW (selected_window);
4500 register GC line_gc = f->output_data.x->cursor_gc;
4501 register GC erase_gc = f->output_data.x->reverse_gc;
4502 #if 0
4503 char dash_list[] = {6, 4, 6, 4};
4504 int dashes = 4;
4505 XGCValues gc_values;
4506 #endif
4507 register int previous_y;
4508 register int line = (x_mouse_y + 1) * f->output_data.x->line_height
4509 + f->output_data.x->internal_border_width;
4510 register int left = f->output_data.x->internal_border_width
4511 + (WINDOW_LEFT_MARGIN (w)
4512 * FONT_WIDTH (f->output_data.x->font));
4513 register int right = left + (w->width
4514 * FONT_WIDTH (f->output_data.x->font))
4515 - f->output_data.x->internal_border_width;
4517 #if 0
4518 BLOCK_INPUT;
4519 gc_values.foreground = f->output_data.x->cursor_pixel;
4520 gc_values.background = f->output_data.x->background_pixel;
4521 gc_values.line_width = 1;
4522 gc_values.line_style = LineOnOffDash;
4523 gc_values.cap_style = CapRound;
4524 gc_values.join_style = JoinRound;
4526 line_gc = XCreateGC (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
4527 GCLineStyle | GCJoinStyle | GCCapStyle
4528 | GCLineWidth | GCForeground | GCBackground,
4529 &gc_values);
4530 XSetDashes (FRAME_X_DISPLAY (f), line_gc, 0, dash_list, dashes);
4531 gc_values.foreground = f->output_data.x->background_pixel;
4532 gc_values.background = f->output_data.x->foreground_pixel;
4533 erase_gc = XCreateGC (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
4534 GCLineStyle | GCJoinStyle | GCCapStyle
4535 | GCLineWidth | GCForeground | GCBackground,
4536 &gc_values);
4537 XSetDashes (FRAME_X_DISPLAY (f), erase_gc, 0, dash_list, dashes);
4538 UNBLOCK_INPUT;
4539 #endif
4541 while (1)
4543 BLOCK_INPUT;
4544 if (x_mouse_y >= XINT (w->top)
4545 && x_mouse_y < XINT (w->top) + XINT (w->height) - 1)
4547 previous_y = x_mouse_y;
4548 line = (x_mouse_y + 1) * f->output_data.x->line_height
4549 + f->output_data.x->internal_border_width;
4550 XDrawLine (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
4551 line_gc, left, line, right, line);
4553 XFlush (FRAME_X_DISPLAY (f));
4554 UNBLOCK_INPUT;
4558 obj = read_char (-1, 0, 0, Qnil, 0);
4559 if (!CONSP (obj)
4560 || (! EQ (Fcar (Fcdr (Fcdr (obj))),
4561 Qvertical_scroll_bar))
4562 || x_mouse_grabbed)
4564 BLOCK_INPUT;
4565 XDrawLine (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
4566 erase_gc, left, line, right, line);
4567 unread_command_event = obj;
4568 #if 0
4569 XFreeGC (FRAME_X_DISPLAY (f), line_gc);
4570 XFreeGC (FRAME_X_DISPLAY (f), erase_gc);
4571 #endif
4572 UNBLOCK_INPUT;
4573 return Qnil;
4576 while (x_mouse_y == previous_y);
4578 BLOCK_INPUT;
4579 XDrawLine (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
4580 erase_gc, left, line, right, line);
4581 UNBLOCK_INPUT;
4584 #endif
4586 #if 0
4587 /* These keep track of the rectangle following the pointer. */
4588 int mouse_track_top, mouse_track_left, mouse_track_width;
4590 /* Offset in buffer of character under the pointer, or 0. */
4591 int mouse_buffer_offset;
4593 DEFUN ("x-track-pointer", Fx_track_pointer, Sx_track_pointer, 0, 0, 0,
4594 "Track the pointer.")
4597 static Cursor current_pointer_shape;
4598 FRAME_PTR f = x_mouse_frame;
4600 BLOCK_INPUT;
4601 if (EQ (Vmouse_frame_part, Qtext_part)
4602 && (current_pointer_shape != f->output_data.x->nontext_cursor))
4604 unsigned char c;
4605 struct buffer *buf;
4607 current_pointer_shape = f->output_data.x->nontext_cursor;
4608 XDefineCursor (FRAME_X_DISPLAY (f),
4609 FRAME_X_WINDOW (f),
4610 current_pointer_shape);
4612 buf = XBUFFER (XWINDOW (Vmouse_window)->buffer);
4613 c = *(BUF_CHAR_ADDRESS (buf, mouse_buffer_offset));
4615 else if (EQ (Vmouse_frame_part, Qmodeline_part)
4616 && (current_pointer_shape != f->output_data.x->modeline_cursor))
4618 current_pointer_shape = f->output_data.x->modeline_cursor;
4619 XDefineCursor (FRAME_X_DISPLAY (f),
4620 FRAME_X_WINDOW (f),
4621 current_pointer_shape);
4624 XFlush (FRAME_X_DISPLAY (f));
4625 UNBLOCK_INPUT;
4627 #endif
4629 #if 0
4630 DEFUN ("x-track-pointer", Fx_track_pointer, Sx_track_pointer, 1, 1, "e",
4631 "Draw rectangle around character under mouse pointer, if there is one.")
4632 (event)
4633 Lisp_Object event;
4635 struct window *w = XWINDOW (Vmouse_window);
4636 struct frame *f = XFRAME (WINDOW_FRAME (w));
4637 struct buffer *b = XBUFFER (w->buffer);
4638 Lisp_Object obj;
4640 if (! EQ (Vmouse_window, selected_window))
4641 return Qnil;
4643 if (EQ (event, Qnil))
4645 int x, y;
4647 x_read_mouse_position (selected_frame, &x, &y);
4650 BLOCK_INPUT;
4651 mouse_track_width = 0;
4652 mouse_track_left = mouse_track_top = -1;
4656 if ((x_mouse_x != mouse_track_left
4657 && (x_mouse_x < mouse_track_left
4658 || x_mouse_x > (mouse_track_left + mouse_track_width)))
4659 || x_mouse_y != mouse_track_top)
4661 int hp = 0; /* Horizontal position */
4662 int len = FRAME_CURRENT_GLYPHS (f)->used[x_mouse_y];
4663 int p = FRAME_CURRENT_GLYPHS (f)->bufp[x_mouse_y];
4664 int tab_width = XINT (b->tab_width);
4665 int ctl_arrow_p = !NILP (b->ctl_arrow);
4666 unsigned char c;
4667 int mode_line_vpos = XFASTINT (w->height) + XFASTINT (w->top) - 1;
4668 int in_mode_line = 0;
4670 if (! FRAME_CURRENT_GLYPHS (f)->enable[x_mouse_y])
4671 break;
4673 /* Erase previous rectangle. */
4674 if (mouse_track_width)
4676 x_rectangle (f, f->output_data.x->reverse_gc,
4677 mouse_track_left, mouse_track_top,
4678 mouse_track_width, 1);
4680 if ((mouse_track_left == f->phys_cursor_x
4681 || mouse_track_left == f->phys_cursor_x - 1)
4682 && mouse_track_top == f->phys_cursor_y)
4684 x_display_cursor (f, 1);
4688 mouse_track_left = x_mouse_x;
4689 mouse_track_top = x_mouse_y;
4690 mouse_track_width = 0;
4692 if (mouse_track_left > len) /* Past the end of line. */
4693 goto draw_or_not;
4695 if (mouse_track_top == mode_line_vpos)
4697 in_mode_line = 1;
4698 goto draw_or_not;
4701 if (tab_width <= 0 || tab_width > 20) tab_width = 8;
4704 c = FETCH_BYTE (p);
4705 if (len == f->width && hp == len - 1 && c != '\n')
4706 goto draw_or_not;
4708 switch (c)
4710 case '\t':
4711 mouse_track_width = tab_width - (hp % tab_width);
4712 p++;
4713 hp += mouse_track_width;
4714 if (hp > x_mouse_x)
4716 mouse_track_left = hp - mouse_track_width;
4717 goto draw_or_not;
4719 continue;
4721 case '\n':
4722 mouse_track_width = -1;
4723 goto draw_or_not;
4725 default:
4726 if (ctl_arrow_p && (c < 040 || c == 0177))
4728 if (p > ZV)
4729 goto draw_or_not;
4731 mouse_track_width = 2;
4732 p++;
4733 hp +=2;
4734 if (hp > x_mouse_x)
4736 mouse_track_left = hp - mouse_track_width;
4737 goto draw_or_not;
4740 else
4742 mouse_track_width = 1;
4743 p++;
4744 hp++;
4746 continue;
4749 while (hp <= x_mouse_x);
4751 draw_or_not:
4752 if (mouse_track_width) /* Over text; use text pointer shape. */
4754 XDefineCursor (FRAME_X_DISPLAY (f),
4755 FRAME_X_WINDOW (f),
4756 f->output_data.x->text_cursor);
4757 x_rectangle (f, f->output_data.x->cursor_gc,
4758 mouse_track_left, mouse_track_top,
4759 mouse_track_width, 1);
4761 else if (in_mode_line)
4762 XDefineCursor (FRAME_X_DISPLAY (f),
4763 FRAME_X_WINDOW (f),
4764 f->output_data.x->modeline_cursor);
4765 else
4766 XDefineCursor (FRAME_X_DISPLAY (f),
4767 FRAME_X_WINDOW (f),
4768 f->output_data.x->nontext_cursor);
4771 XFlush (FRAME_X_DISPLAY (f));
4772 UNBLOCK_INPUT;
4774 obj = read_char (-1, 0, 0, Qnil, 0);
4775 BLOCK_INPUT;
4777 while (CONSP (obj) /* Mouse event */
4778 && EQ (Fcar (Fcdr (Fcdr (obj))), Qnil) /* Not scroll bar */
4779 && EQ (Vmouse_depressed, Qnil) /* Only motion events */
4780 && EQ (Vmouse_window, selected_window) /* In this window */
4781 && x_mouse_frame);
4783 unread_command_event = obj;
4785 if (mouse_track_width)
4787 x_rectangle (f, f->output_data.x->reverse_gc,
4788 mouse_track_left, mouse_track_top,
4789 mouse_track_width, 1);
4790 mouse_track_width = 0;
4791 if ((mouse_track_left == f->phys_cursor_x
4792 || mouse_track_left - 1 == f->phys_cursor_x)
4793 && mouse_track_top == f->phys_cursor_y)
4795 x_display_cursor (f, 1);
4798 XDefineCursor (FRAME_X_DISPLAY (f),
4799 FRAME_X_WINDOW (f),
4800 f->output_data.x->nontext_cursor);
4801 XFlush (FRAME_X_DISPLAY (f));
4802 UNBLOCK_INPUT;
4804 return Qnil;
4806 #endif
4808 #if 0
4809 #include "glyphs.h"
4811 /* Draw a pixmap specified by IMAGE_DATA of dimensions WIDTH and HEIGHT
4812 on the frame F at position X, Y. */
4814 x_draw_pixmap (f, x, y, image_data, width, height)
4815 struct frame *f;
4816 int x, y, width, height;
4817 char *image_data;
4819 Pixmap image;
4821 image = XCreateBitmapFromData (FRAME_X_DISPLAY (f),
4822 FRAME_X_WINDOW (f), image_data,
4823 width, height);
4824 XCopyPlane (FRAME_X_DISPLAY (f), image, FRAME_X_WINDOW (f),
4825 f->output_data.x->normal_gc, 0, 0, width, height, x, y);
4827 #endif
4829 #if 0 /* I'm told these functions are superfluous
4830 given the ability to bind function keys. */
4832 #ifdef HAVE_X11
4833 DEFUN ("x-rebind-key", Fx_rebind_key, Sx_rebind_key, 3, 3, 0,
4834 "Rebind X keysym KEYSYM, with MODIFIERS, to generate NEWSTRING.\n\
4835 KEYSYM is a string which conforms to the X keysym definitions found\n\
4836 in X11/keysymdef.h, sans the initial XK_. MODIFIERS is nil or a\n\
4837 list of strings specifying modifier keys such as Control_L, which must\n\
4838 also be depressed for NEWSTRING to appear.")
4839 (x_keysym, modifiers, newstring)
4840 register Lisp_Object x_keysym;
4841 register Lisp_Object modifiers;
4842 register Lisp_Object newstring;
4844 char *rawstring;
4845 register KeySym keysym;
4846 KeySym modifier_list[16];
4848 check_x ();
4849 CHECK_STRING (x_keysym, 1);
4850 CHECK_STRING (newstring, 3);
4852 keysym = XStringToKeysym ((char *) XSTRING (x_keysym)->data);
4853 if (keysym == NoSymbol)
4854 error ("Keysym does not exist");
4856 if (NILP (modifiers))
4857 XRebindKeysym (x_current_display, keysym, modifier_list, 0,
4858 XSTRING (newstring)->data, XSTRING (newstring)->size);
4859 else
4861 register Lisp_Object rest, mod;
4862 register int i = 0;
4864 for (rest = modifiers; !NILP (rest); rest = Fcdr (rest))
4866 if (i == 16)
4867 error ("Can't have more than 16 modifiers");
4869 mod = Fcar (rest);
4870 CHECK_STRING (mod, 3);
4871 modifier_list[i] = XStringToKeysym ((char *) XSTRING (mod)->data);
4872 #ifndef HAVE_X11R5
4873 if (modifier_list[i] == NoSymbol
4874 || !(IsModifierKey (modifier_list[i])
4875 || ((unsigned)(modifier_list[i]) == XK_Mode_switch)
4876 || ((unsigned)(modifier_list[i]) == XK_Num_Lock)))
4877 #else
4878 if (modifier_list[i] == NoSymbol
4879 || !IsModifierKey (modifier_list[i]))
4880 #endif
4881 error ("Element is not a modifier keysym");
4882 i++;
4885 XRebindKeysym (x_current_display, keysym, modifier_list, i,
4886 XSTRING (newstring)->data, XSTRING (newstring)->size);
4889 return Qnil;
4892 DEFUN ("x-rebind-keys", Fx_rebind_keys, Sx_rebind_keys, 2, 2, 0,
4893 "Rebind KEYCODE to list of strings STRINGS.\n\
4894 STRINGS should be a list of 16 elements, one for each shift combination.\n\
4895 nil as element means don't change.\n\
4896 See the documentation of `x-rebind-key' for more information.")
4897 (keycode, strings)
4898 register Lisp_Object keycode;
4899 register Lisp_Object strings;
4901 register Lisp_Object item;
4902 register unsigned char *rawstring;
4903 KeySym rawkey, modifier[1];
4904 int strsize;
4905 register unsigned i;
4907 check_x ();
4908 CHECK_NUMBER (keycode, 1);
4909 CHECK_CONS (strings, 2);
4910 rawkey = (KeySym) ((unsigned) (XINT (keycode))) & 255;
4911 for (i = 0; i <= 15; strings = Fcdr (strings), i++)
4913 item = Fcar (strings);
4914 if (!NILP (item))
4916 CHECK_STRING (item, 2);
4917 strsize = XSTRING (item)->size;
4918 rawstring = (unsigned char *) xmalloc (strsize);
4919 bcopy (XSTRING (item)->data, rawstring, strsize);
4920 modifier[1] = 1 << i;
4921 XRebindKeysym (x_current_display, rawkey, modifier, 1,
4922 rawstring, strsize);
4925 return Qnil;
4927 #endif /* HAVE_X11 */
4928 #endif /* 0 */
4930 #ifndef HAVE_XSCREENNUMBEROFSCREEN
4932 XScreenNumberOfScreen (scr)
4933 register Screen *scr;
4935 register Display *dpy;
4936 register Screen *dpyscr;
4937 register int i;
4939 dpy = scr->display;
4940 dpyscr = dpy->screens;
4942 for (i = 0; i < dpy->nscreens; i++, dpyscr++)
4943 if (scr == dpyscr)
4944 return i;
4946 return -1;
4948 #endif /* not HAVE_XSCREENNUMBEROFSCREEN */
4950 Visual *
4951 select_visual (dpy, screen, depth)
4952 Display *dpy;
4953 Screen *screen;
4954 unsigned int *depth;
4956 Visual *v;
4957 XVisualInfo *vinfo, vinfo_template;
4958 int n_visuals;
4960 v = DefaultVisualOfScreen (screen);
4962 #ifdef HAVE_X11R4
4963 vinfo_template.visualid = XVisualIDFromVisual (v);
4964 #else
4965 vinfo_template.visualid = v->visualid;
4966 #endif
4968 vinfo_template.screen = XScreenNumberOfScreen (screen);
4970 vinfo = XGetVisualInfo (dpy,
4971 VisualIDMask | VisualScreenMask, &vinfo_template,
4972 &n_visuals);
4973 if (n_visuals != 1)
4974 fatal ("Can't get proper X visual info");
4976 if ((1 << vinfo->depth) == vinfo->colormap_size)
4977 *depth = vinfo->depth;
4978 else
4980 int i = 0;
4981 int n = vinfo->colormap_size - 1;
4982 while (n)
4984 n = n >> 1;
4985 i++;
4987 *depth = i;
4990 XFree ((char *) vinfo);
4991 return v;
4994 /* Return the X display structure for the display named NAME.
4995 Open a new connection if necessary. */
4997 struct x_display_info *
4998 x_display_info_for_name (name)
4999 Lisp_Object name;
5001 Lisp_Object names;
5002 struct x_display_info *dpyinfo;
5004 CHECK_STRING (name, 0);
5006 if (! EQ (Vwindow_system, intern ("x")))
5007 error ("Not using X Windows");
5009 for (dpyinfo = x_display_list, names = x_display_name_list;
5010 dpyinfo;
5011 dpyinfo = dpyinfo->next, names = XCONS (names)->cdr)
5013 Lisp_Object tem;
5014 tem = Fstring_equal (XCONS (XCONS (names)->car)->car, name);
5015 if (!NILP (tem))
5016 return dpyinfo;
5019 /* Use this general default value to start with. */
5020 Vx_resource_name = Vinvocation_name;
5022 validate_x_resource_name ();
5024 dpyinfo = x_term_init (name, (unsigned char *)0,
5025 (char *) XSTRING (Vx_resource_name)->data);
5027 if (dpyinfo == 0)
5028 error ("Cannot connect to X server %s", XSTRING (name)->data);
5030 x_in_use = 1;
5031 XSETFASTINT (Vwindow_system_version, 11);
5033 return dpyinfo;
5036 DEFUN ("x-open-connection", Fx_open_connection, Sx_open_connection,
5037 1, 3, 0, "Open a connection to an X server.\n\
5038 DISPLAY is the name of the display to connect to.\n\
5039 Optional second arg XRM-STRING is a string of resources in xrdb format.\n\
5040 If the optional third arg MUST-SUCCEED is non-nil,\n\
5041 terminate Emacs if we can't open the connection.")
5042 (display, xrm_string, must_succeed)
5043 Lisp_Object display, xrm_string, must_succeed;
5045 unsigned int n_planes;
5046 unsigned char *xrm_option;
5047 struct x_display_info *dpyinfo;
5049 CHECK_STRING (display, 0);
5050 if (! NILP (xrm_string))
5051 CHECK_STRING (xrm_string, 1);
5053 if (! EQ (Vwindow_system, intern ("x")))
5054 error ("Not using X Windows");
5056 if (! NILP (xrm_string))
5057 xrm_option = (unsigned char *) XSTRING (xrm_string)->data;
5058 else
5059 xrm_option = (unsigned char *) 0;
5061 validate_x_resource_name ();
5063 /* This is what opens the connection and sets x_current_display.
5064 This also initializes many symbols, such as those used for input. */
5065 dpyinfo = x_term_init (display, xrm_option,
5066 (char *) XSTRING (Vx_resource_name)->data);
5068 if (dpyinfo == 0)
5070 if (!NILP (must_succeed))
5071 fatal ("Cannot connect to X server %s.\n\
5072 Check the DISPLAY environment variable or use `-d'.\n\
5073 Also use the `xhost' program to verify that it is set to permit\n\
5074 connections from your machine.\n",
5075 XSTRING (display)->data);
5076 else
5077 error ("Cannot connect to X server %s", XSTRING (display)->data);
5080 x_in_use = 1;
5082 XSETFASTINT (Vwindow_system_version, 11);
5083 return Qnil;
5086 DEFUN ("x-close-connection", Fx_close_connection,
5087 Sx_close_connection, 1, 1, 0,
5088 "Close the connection to DISPLAY's X server.\n\
5089 For DISPLAY, specify either a frame or a display name (a string).\n\
5090 If DISPLAY is nil, that stands for the selected frame's display.")
5091 (display)
5092 Lisp_Object display;
5094 struct x_display_info *dpyinfo = check_x_display_info (display);
5095 struct x_display_info *tail;
5096 int i;
5098 if (dpyinfo->reference_count > 0)
5099 error ("Display still has frames on it");
5101 BLOCK_INPUT;
5102 /* Free the fonts in the font table. */
5103 for (i = 0; i < dpyinfo->n_fonts; i++)
5105 if (dpyinfo->font_table[i].name)
5106 free (dpyinfo->font_table[i].name);
5107 /* Don't free the full_name string;
5108 it is always shared with something else. */
5109 XFreeFont (dpyinfo->display, dpyinfo->font_table[i].font);
5111 x_destroy_all_bitmaps (dpyinfo);
5112 XSetCloseDownMode (dpyinfo->display, DestroyAll);
5114 #ifdef USE_X_TOOLKIT
5115 XtCloseDisplay (dpyinfo->display);
5116 #else
5117 XCloseDisplay (dpyinfo->display);
5118 #endif
5120 x_delete_display (dpyinfo);
5121 UNBLOCK_INPUT;
5123 return Qnil;
5126 DEFUN ("x-display-list", Fx_display_list, Sx_display_list, 0, 0, 0,
5127 "Return the list of display names that Emacs has connections to.")
5130 Lisp_Object tail, result;
5132 result = Qnil;
5133 for (tail = x_display_name_list; ! NILP (tail); tail = XCONS (tail)->cdr)
5134 result = Fcons (XCONS (XCONS (tail)->car)->car, result);
5136 return result;
5139 DEFUN ("x-synchronize", Fx_synchronize, Sx_synchronize, 1, 2, 0,
5140 "If ON is non-nil, report X errors as soon as the erring request is made.\n\
5141 If ON is nil, allow buffering of requests.\n\
5142 Turning on synchronization prohibits the Xlib routines from buffering\n\
5143 requests and seriously degrades performance, but makes debugging much\n\
5144 easier.\n\
5145 The optional second argument DISPLAY specifies which display to act on.\n\
5146 DISPLAY should be either a frame or a display name (a string).\n\
5147 If DISPLAY is omitted or nil, that stands for the selected frame's display.")
5148 (on, display)
5149 Lisp_Object display, on;
5151 struct x_display_info *dpyinfo = check_x_display_info (display);
5153 XSynchronize (dpyinfo->display, !EQ (on, Qnil));
5155 return Qnil;
5158 /* Wait for responses to all X commands issued so far for frame F. */
5160 void
5161 x_sync (f)
5162 FRAME_PTR f;
5164 BLOCK_INPUT;
5165 XSync (FRAME_X_DISPLAY (f), False);
5166 UNBLOCK_INPUT;
5169 syms_of_xfns ()
5171 /* This is zero if not using X windows. */
5172 x_in_use = 0;
5174 /* The section below is built by the lisp expression at the top of the file,
5175 just above where these variables are declared. */
5176 /*&&& init symbols here &&&*/
5177 Qauto_raise = intern ("auto-raise");
5178 staticpro (&Qauto_raise);
5179 Qauto_lower = intern ("auto-lower");
5180 staticpro (&Qauto_lower);
5181 Qbackground_color = intern ("background-color");
5182 staticpro (&Qbackground_color);
5183 Qbar = intern ("bar");
5184 staticpro (&Qbar);
5185 Qborder_color = intern ("border-color");
5186 staticpro (&Qborder_color);
5187 Qborder_width = intern ("border-width");
5188 staticpro (&Qborder_width);
5189 Qbox = intern ("box");
5190 staticpro (&Qbox);
5191 Qcursor_color = intern ("cursor-color");
5192 staticpro (&Qcursor_color);
5193 Qcursor_type = intern ("cursor-type");
5194 staticpro (&Qcursor_type);
5195 Qforeground_color = intern ("foreground-color");
5196 staticpro (&Qforeground_color);
5197 Qgeometry = intern ("geometry");
5198 staticpro (&Qgeometry);
5199 Qicon_left = intern ("icon-left");
5200 staticpro (&Qicon_left);
5201 Qicon_top = intern ("icon-top");
5202 staticpro (&Qicon_top);
5203 Qicon_type = intern ("icon-type");
5204 staticpro (&Qicon_type);
5205 Qicon_name = intern ("icon-name");
5206 staticpro (&Qicon_name);
5207 Qinternal_border_width = intern ("internal-border-width");
5208 staticpro (&Qinternal_border_width);
5209 Qleft = intern ("left");
5210 staticpro (&Qleft);
5211 Qright = intern ("right");
5212 staticpro (&Qright);
5213 Qmouse_color = intern ("mouse-color");
5214 staticpro (&Qmouse_color);
5215 Qnone = intern ("none");
5216 staticpro (&Qnone);
5217 Qparent_id = intern ("parent-id");
5218 staticpro (&Qparent_id);
5219 Qscroll_bar_width = intern ("scroll-bar-width");
5220 staticpro (&Qscroll_bar_width);
5221 Qsuppress_icon = intern ("suppress-icon");
5222 staticpro (&Qsuppress_icon);
5223 Qtop = intern ("top");
5224 staticpro (&Qtop);
5225 Qundefined_color = intern ("undefined-color");
5226 staticpro (&Qundefined_color);
5227 Qvertical_scroll_bars = intern ("vertical-scroll-bars");
5228 staticpro (&Qvertical_scroll_bars);
5229 Qvisibility = intern ("visibility");
5230 staticpro (&Qvisibility);
5231 Qwindow_id = intern ("window-id");
5232 staticpro (&Qwindow_id);
5233 Qx_frame_parameter = intern ("x-frame-parameter");
5234 staticpro (&Qx_frame_parameter);
5235 Qx_resource_name = intern ("x-resource-name");
5236 staticpro (&Qx_resource_name);
5237 Quser_position = intern ("user-position");
5238 staticpro (&Quser_position);
5239 Quser_size = intern ("user-size");
5240 staticpro (&Quser_size);
5241 Qdisplay = intern ("display");
5242 staticpro (&Qdisplay);
5243 /* This is the end of symbol initialization. */
5245 Fput (Qundefined_color, Qerror_conditions,
5246 Fcons (Qundefined_color, Fcons (Qerror, Qnil)));
5247 Fput (Qundefined_color, Qerror_message,
5248 build_string ("Undefined color"));
5250 init_x_parm_symbols ();
5252 DEFVAR_LISP ("x-bitmap-file-path", &Vx_bitmap_file_path,
5253 "List of directories to search for bitmap files for X.");
5254 Vx_bitmap_file_path = decode_env_path ((char *) 0, PATH_BITMAPS);
5256 DEFVAR_LISP ("x-pointer-shape", &Vx_pointer_shape,
5257 "The shape of the pointer when over text.\n\
5258 Changing the value does not affect existing frames\n\
5259 unless you set the mouse color.");
5260 Vx_pointer_shape = Qnil;
5262 DEFVAR_LISP ("x-resource-name", &Vx_resource_name,
5263 "The name Emacs uses to look up X resources.\n\
5264 `x-get-resource' uses this as the first component of the instance name\n\
5265 when requesting resource values.\n\
5266 Emacs initially sets `x-resource-name' to the name under which Emacs\n\
5267 was invoked, or to the value specified with the `-name' or `-rn'\n\
5268 switches, if present.\n\
5270 It may be useful to bind this variable locally around a call\n\
5271 to `x-get-resource'. See also the variable `x-resource-class'.");
5272 Vx_resource_name = Qnil;
5274 DEFVAR_LISP ("x-resource-class", &Vx_resource_class,
5275 "The class Emacs uses to look up X resources.\n\
5276 `x-get-resource' uses this as the first component of the instance class\n\
5277 when requesting resource values.\n\
5278 Emacs initially sets `x-resource-class' to \"Emacs\".\n\
5280 Setting this variable permanently is not a reasonable thing to do,\n\
5281 but binding this variable locally around a call to `x-get-resource'\n\
5282 is a reasonabvle practice. See also the variable `x-resource-name'.");
5283 Vx_resource_class = build_string (EMACS_CLASS);
5285 #if 0 /* This doesn't really do anything. */
5286 DEFVAR_LISP ("x-nontext-pointer-shape", &Vx_nontext_pointer_shape,
5287 "The shape of the pointer when not over text.\n\
5288 This variable takes effect when you create a new frame\n\
5289 or when you set the mouse color.");
5290 #endif
5291 Vx_nontext_pointer_shape = Qnil;
5293 #if 0 /* This doesn't really do anything. */
5294 DEFVAR_LISP ("x-mode-pointer-shape", &Vx_mode_pointer_shape,
5295 "The shape of the pointer when over the mode line.\n\
5296 This variable takes effect when you create a new frame\n\
5297 or when you set the mouse color.");
5298 #endif
5299 Vx_mode_pointer_shape = Qnil;
5301 DEFVAR_LISP ("x-sensitive-text-pointer-shape",
5302 &Vx_sensitive_text_pointer_shape,
5303 "The shape of the pointer when over mouse-sensitive text.\n\
5304 This variable takes effect when you create a new frame\n\
5305 or when you set the mouse color.");
5306 Vx_sensitive_text_pointer_shape = Qnil;
5308 DEFVAR_LISP ("x-cursor-fore-pixel", &Vx_cursor_fore_pixel,
5309 "A string indicating the foreground color of the cursor box.");
5310 Vx_cursor_fore_pixel = Qnil;
5312 DEFVAR_LISP ("x-no-window-manager", &Vx_no_window_manager,
5313 "Non-nil if no X window manager is in use.\n\
5314 Emacs doesn't try to figure this out; this is always nil\n\
5315 unless you set it to something else.");
5316 /* We don't have any way to find this out, so set it to nil
5317 and maybe the user would like to set it to t. */
5318 Vx_no_window_manager = Qnil;
5320 DEFVAR_LISP ("x-pixel-size-width-font-regexp",
5321 &Vx_pixel_size_width_font_regexp,
5322 "Regexp matching a font name whose width is the same as `PIXEL_SIZE'.\n\
5324 Since Emacs gets width of a font matching with this regexp from\n\
5325 PIXEL_SIZE field of the name, font finding mechanism gets faster for\n\
5326 such a font. This is especially effective for such large fonts as\n\
5327 Chinese, Japanese, and Korean.");
5328 Vx_pixel_size_width_font_regexp = Qnil;
5330 #ifdef USE_X_TOOLKIT
5331 Fprovide (intern ("x-toolkit"));
5332 #endif
5333 #ifdef USE_MOTIF
5334 Fprovide (intern ("motif"));
5335 #endif
5337 defsubr (&Sx_get_resource);
5338 #if 0
5339 defsubr (&Sx_draw_rectangle);
5340 defsubr (&Sx_erase_rectangle);
5341 defsubr (&Sx_contour_region);
5342 defsubr (&Sx_uncontour_region);
5343 #endif
5344 defsubr (&Sx_list_fonts);
5345 defsubr (&Sx_display_color_p);
5346 defsubr (&Sx_display_grayscale_p);
5347 defsubr (&Sx_color_defined_p);
5348 defsubr (&Sx_color_values);
5349 defsubr (&Sx_server_max_request_size);
5350 defsubr (&Sx_server_vendor);
5351 defsubr (&Sx_server_version);
5352 defsubr (&Sx_display_pixel_width);
5353 defsubr (&Sx_display_pixel_height);
5354 defsubr (&Sx_display_mm_width);
5355 defsubr (&Sx_display_mm_height);
5356 defsubr (&Sx_display_screens);
5357 defsubr (&Sx_display_planes);
5358 defsubr (&Sx_display_color_cells);
5359 defsubr (&Sx_display_visual_class);
5360 defsubr (&Sx_display_backing_store);
5361 defsubr (&Sx_display_save_under);
5362 #if 0
5363 defsubr (&Sx_rebind_key);
5364 defsubr (&Sx_rebind_keys);
5365 defsubr (&Sx_track_pointer);
5366 defsubr (&Sx_grab_pointer);
5367 defsubr (&Sx_ungrab_pointer);
5368 #endif
5369 defsubr (&Sx_parse_geometry);
5370 defsubr (&Sx_create_frame);
5371 #if 0
5372 defsubr (&Sx_horizontal_line);
5373 #endif
5374 defsubr (&Sx_open_connection);
5375 defsubr (&Sx_close_connection);
5376 defsubr (&Sx_display_list);
5377 defsubr (&Sx_synchronize);
5379 /* Setting callback functions for fontset handler. */
5380 get_font_info_func = x_get_font_info;
5381 list_fonts_func = x_list_fonts;
5382 load_font_func = x_load_font;
5383 query_font_func = x_query_font;
5384 set_frame_fontset_func = x_set_font;
5385 check_window_system_func = check_x;
5388 #endif /* HAVE_X_WINDOWS */