(iso-transl-dead-key-alist): Fix syntax for ?^.
[emacs.git] / src / xfns.c
blobbade5b56765f5f5e7302e67e12f60e81fd8dbd1c
1 /* Functions for the X window system.
2 Copyright (C) 1989, 1992, 1993, 1994, 1995 Free Software Foundation.
4 This file is part of GNU Emacs.
6 GNU Emacs is free software; you can redistribute it and/or modify
7 it under the terms of the GNU General Public License as published by
8 the Free Software Foundation; either version 2, or (at your option)
9 any later version.
11 GNU Emacs is distributed in the hope that it will be useful,
12 but WITHOUT ANY WARRANTY; without even the implied warranty of
13 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14 GNU General Public License for more details.
16 You should have received a copy of the GNU General Public License
17 along with GNU Emacs; see the file COPYING. If not, write to
18 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
19 Boston, MA 02111-1307, USA. */
21 /* Completely rewritten by Richard Stallman. */
23 /* Rewritten for X11 by Joseph Arceneaux */
25 #include <signal.h>
26 #include <config.h>
28 /* This makes the fields of a Display accessible, in Xlib header files. */
29 #define XLIB_ILLEGAL_ACCESS
31 #include "lisp.h"
32 #include "xterm.h"
33 #include "frame.h"
34 #include "window.h"
35 #include "buffer.h"
36 #include "dispextern.h"
37 #include "keyboard.h"
38 #include "blockinput.h"
39 #include <paths.h>
41 #ifdef HAVE_X_WINDOWS
42 extern void abort ();
44 /* On some systems, the character-composition stuff is broken in X11R5. */
45 #if defined (HAVE_X11R5) && ! defined (HAVE_X11R6)
46 #ifdef X11R5_INHIBIT_I18N
47 #undef HAVE_X_I18N
48 #endif
49 #endif
51 #ifndef VMS
52 #if 1 /* Used to be #ifdef EMACS_BITMAP_FILES, but this should always work. */
53 #include "bitmaps/gray.xbm"
54 #else
55 #include <X11/bitmaps/gray>
56 #endif
57 #else
58 #include "[.bitmaps]gray.xbm"
59 #endif
61 #ifdef USE_X_TOOLKIT
62 #include <X11/Shell.h>
64 #ifndef USE_MOTIF
65 #include <X11/Xaw/Paned.h>
66 #include <X11/Xaw/Label.h>
67 #endif /* USE_MOTIF */
69 #ifdef USG
70 #undef USG /* ####KLUDGE for Solaris 2.2 and up */
71 #include <X11/Xos.h>
72 #define USG
73 #else
74 #include <X11/Xos.h>
75 #endif
77 #include "widget.h"
79 #include "../lwlib/lwlib.h"
81 /* Do the EDITRES protocol if running X11R5
82 Exception: HP-UX (at least version A.09.05) has X11R5 without EditRes */
83 #if (XtSpecificationRelease >= 5) && !defined(NO_EDITRES)
84 #define HACK_EDITRES
85 extern void _XEditResCheckMessages ();
86 #endif /* R5 + Athena */
88 /* Unique id counter for widgets created by the Lucid Widget
89 Library. */
90 extern LWLIB_ID widget_id_tick;
92 /* This is part of a kludge--see lwlib/xlwmenu.c. */
93 XFontStruct *xlwmenu_default_font;
95 extern void free_frame_menubar ();
96 #endif /* USE_X_TOOLKIT */
98 #define min(a,b) ((a) < (b) ? (a) : (b))
99 #define max(a,b) ((a) > (b) ? (a) : (b))
101 #ifdef HAVE_X11R4
102 #define MAXREQUEST(dpy) (XMaxRequestSize (dpy))
103 #else
104 #define MAXREQUEST(dpy) ((dpy)->max_request_size)
105 #endif
107 /* The name we're using in resource queries. */
108 Lisp_Object Vx_resource_name;
110 /* The background and shape of the mouse pointer, and shape when not
111 over text or in the modeline. */
112 Lisp_Object Vx_pointer_shape, Vx_nontext_pointer_shape, Vx_mode_pointer_shape;
113 /* The shape when over mouse-sensitive text. */
114 Lisp_Object Vx_sensitive_text_pointer_shape;
116 /* Color of chars displayed in cursor box. */
117 Lisp_Object Vx_cursor_fore_pixel;
119 /* Nonzero if using X. */
120 static int x_in_use;
122 /* Non nil if no window manager is in use. */
123 Lisp_Object Vx_no_window_manager;
125 /* Search path for bitmap files. */
126 Lisp_Object Vx_bitmap_file_path;
128 /* Evaluate this expression to rebuild the section of syms_of_xfns
129 that initializes and staticpros the symbols declared below. Note
130 that Emacs 18 has a bug that keeps C-x C-e from being able to
131 evaluate this expression.
133 (progn
134 ;; Accumulate a list of the symbols we want to initialize from the
135 ;; declarations at the top of the file.
136 (goto-char (point-min))
137 (search-forward "/\*&&& symbols declared here &&&*\/\n")
138 (let (symbol-list)
139 (while (looking-at "Lisp_Object \\(Q[a-z_]+\\)")
140 (setq symbol-list
141 (cons (buffer-substring (match-beginning 1) (match-end 1))
142 symbol-list))
143 (forward-line 1))
144 (setq symbol-list (nreverse symbol-list))
145 ;; Delete the section of syms_of_... where we initialize the symbols.
146 (search-forward "\n /\*&&& init symbols here &&&*\/\n")
147 (let ((start (point)))
148 (while (looking-at "^ Q")
149 (forward-line 2))
150 (kill-region start (point)))
151 ;; Write a new symbol initialization section.
152 (while symbol-list
153 (insert (format " %s = intern (\"" (car symbol-list)))
154 (let ((start (point)))
155 (insert (substring (car symbol-list) 1))
156 (subst-char-in-region start (point) ?_ ?-))
157 (insert (format "\");\n staticpro (&%s);\n" (car symbol-list)))
158 (setq symbol-list (cdr symbol-list)))))
162 /*&&& symbols declared here &&&*/
163 Lisp_Object Qauto_raise;
164 Lisp_Object Qauto_lower;
165 Lisp_Object Qbackground_color;
166 Lisp_Object Qbar;
167 Lisp_Object Qborder_color;
168 Lisp_Object Qborder_width;
169 Lisp_Object Qbox;
170 Lisp_Object Qcursor_color;
171 Lisp_Object Qcursor_type;
172 Lisp_Object Qfont;
173 Lisp_Object Qforeground_color;
174 Lisp_Object Qgeometry;
175 Lisp_Object Qicon_left;
176 Lisp_Object Qicon_top;
177 Lisp_Object Qicon_type;
178 Lisp_Object Qicon_name;
179 Lisp_Object Qinternal_border_width;
180 Lisp_Object Qleft;
181 Lisp_Object Qmouse_color;
182 Lisp_Object Qnone;
183 Lisp_Object Qparent_id;
184 Lisp_Object Qscroll_bar_width;
185 Lisp_Object Qsuppress_icon;
186 Lisp_Object Qtop;
187 Lisp_Object Qundefined_color;
188 Lisp_Object Qvertical_scroll_bars;
189 Lisp_Object Qvisibility;
190 Lisp_Object Qwindow_id;
191 Lisp_Object Qx_frame_parameter;
192 Lisp_Object Qx_resource_name;
193 Lisp_Object Quser_position;
194 Lisp_Object Quser_size;
195 Lisp_Object Qdisplay;
197 /* The below are defined in frame.c. */
198 extern Lisp_Object Qheight, Qminibuffer, Qname, Qonly, Qwidth;
199 extern Lisp_Object Qunsplittable, Qmenu_bar_lines, Qbuffer_predicate, Qtitle;
201 extern Lisp_Object Vwindow_system_version;
204 /* Error if we are not connected to X. */
205 void
206 check_x ()
208 if (! x_in_use)
209 error ("X windows are not in use or not initialized");
212 /* Nonzero if we can use mouse menus.
213 You should not call this unless HAVE_MENUS is defined. */
216 have_menus_p ()
218 return x_in_use;
221 /* Extract a frame as a FRAME_PTR, defaulting to the selected frame
222 and checking validity for X. */
224 FRAME_PTR
225 check_x_frame (frame)
226 Lisp_Object frame;
228 FRAME_PTR f;
230 if (NILP (frame))
231 f = selected_frame;
232 else
234 CHECK_LIVE_FRAME (frame, 0);
235 f = XFRAME (frame);
237 if (! FRAME_X_P (f))
238 error ("Non-X frame used");
239 return f;
242 /* Let the user specify an X display with a frame.
243 nil stands for the selected frame--or, if that is not an X frame,
244 the first X display on the list. */
246 static struct x_display_info *
247 check_x_display_info (frame)
248 Lisp_Object frame;
250 if (NILP (frame))
252 if (FRAME_X_P (selected_frame))
253 return FRAME_X_DISPLAY_INFO (selected_frame);
254 else if (x_display_list != 0)
255 return x_display_list;
256 else
257 error ("X windows are not in use or not initialized");
259 else if (STRINGP (frame))
260 return x_display_info_for_name (frame);
261 else
263 FRAME_PTR f;
265 CHECK_LIVE_FRAME (frame, 0);
266 f = XFRAME (frame);
267 if (! FRAME_X_P (f))
268 error ("Non-X frame used");
269 return FRAME_X_DISPLAY_INFO (f);
273 /* Return the Emacs frame-object corresponding to an X window.
274 It could be the frame's main window or an icon window. */
276 /* This function can be called during GC, so use GC_xxx type test macros. */
278 struct frame *
279 x_window_to_frame (dpyinfo, wdesc)
280 struct x_display_info *dpyinfo;
281 int wdesc;
283 Lisp_Object tail, frame;
284 struct frame *f;
286 for (tail = Vframe_list; GC_CONSP (tail); tail = XCONS (tail)->cdr)
288 frame = XCONS (tail)->car;
289 if (!GC_FRAMEP (frame))
290 continue;
291 f = XFRAME (frame);
292 if (f->output_data.nothing == 1 || FRAME_X_DISPLAY_INFO (f) != dpyinfo)
293 continue;
294 #ifdef USE_X_TOOLKIT
295 if ((f->output_data.x->edit_widget
296 && XtWindow (f->output_data.x->edit_widget) == wdesc)
297 || f->output_data.x->icon_desc == wdesc)
298 return f;
299 #else /* not USE_X_TOOLKIT */
300 if (FRAME_X_WINDOW (f) == wdesc
301 || f->output_data.x->icon_desc == wdesc)
302 return f;
303 #endif /* not USE_X_TOOLKIT */
305 return 0;
308 #ifdef USE_X_TOOLKIT
309 /* Like x_window_to_frame but also compares the window with the widget's
310 windows. */
312 struct frame *
313 x_any_window_to_frame (dpyinfo, wdesc)
314 struct x_display_info *dpyinfo;
315 int wdesc;
317 Lisp_Object tail, frame;
318 struct frame *f;
319 struct x_output *x;
321 for (tail = Vframe_list; GC_CONSP (tail); tail = XCONS (tail)->cdr)
323 frame = XCONS (tail)->car;
324 if (!GC_FRAMEP (frame))
325 continue;
326 f = XFRAME (frame);
327 if (f->output_data.nothing == 1 || FRAME_X_DISPLAY_INFO (f) != dpyinfo)
328 continue;
329 x = f->output_data.x;
330 /* This frame matches if the window is any of its widgets. */
331 if (wdesc == XtWindow (x->widget)
332 || wdesc == XtWindow (x->column_widget)
333 || wdesc == XtWindow (x->edit_widget))
334 return f;
335 /* Match if the window is this frame's menubar. */
336 if (lw_window_is_in_menubar (wdesc, x->menubar_widget))
337 return f;
339 return 0;
342 /* Likewise, but exclude the menu bar widget. */
344 struct frame *
345 x_non_menubar_window_to_frame (dpyinfo, wdesc)
346 struct x_display_info *dpyinfo;
347 int wdesc;
349 Lisp_Object tail, frame;
350 struct frame *f;
351 struct x_output *x;
353 for (tail = Vframe_list; GC_CONSP (tail); tail = XCONS (tail)->cdr)
355 frame = XCONS (tail)->car;
356 if (!GC_FRAMEP (frame))
357 continue;
358 f = XFRAME (frame);
359 if (f->output_data.nothing == 1 || FRAME_X_DISPLAY_INFO (f) != dpyinfo)
360 continue;
361 x = f->output_data.x;
362 /* This frame matches if the window is any of its widgets. */
363 if (wdesc == XtWindow (x->widget)
364 || wdesc == XtWindow (x->column_widget)
365 || wdesc == XtWindow (x->edit_widget))
366 return f;
368 return 0;
371 /* Likewise, but consider only the menu bar widget. */
373 struct frame *
374 x_menubar_window_to_frame (dpyinfo, wdesc)
375 struct x_display_info *dpyinfo;
376 int wdesc;
378 Lisp_Object tail, frame;
379 struct frame *f;
380 struct x_output *x;
382 for (tail = Vframe_list; GC_CONSP (tail); tail = XCONS (tail)->cdr)
384 frame = XCONS (tail)->car;
385 if (!GC_FRAMEP (frame))
386 continue;
387 f = XFRAME (frame);
388 if (f->output_data.nothing == 1 || FRAME_X_DISPLAY_INFO (f) != dpyinfo)
389 continue;
390 x = f->output_data.x;
391 /* Match if the window is this frame's menubar. */
392 if (lw_window_is_in_menubar (wdesc, x->menubar_widget))
393 return f;
395 return 0;
398 /* Return the frame whose principal (outermost) window is WDESC.
399 If WDESC is some other (smaller) window, we return 0. */
401 struct frame *
402 x_top_window_to_frame (dpyinfo, wdesc)
403 struct x_display_info *dpyinfo;
404 int wdesc;
406 Lisp_Object tail, frame;
407 struct frame *f;
408 struct x_output *x;
410 for (tail = Vframe_list; GC_CONSP (tail); tail = XCONS (tail)->cdr)
412 frame = XCONS (tail)->car;
413 if (!GC_FRAMEP (frame))
414 continue;
415 f = XFRAME (frame);
416 if (f->output_data.nothing == 1 || FRAME_X_DISPLAY_INFO (f) != dpyinfo)
417 continue;
418 x = f->output_data.x;
419 /* This frame matches if the window is its topmost widget. */
420 if (wdesc == XtWindow (x->widget))
421 return f;
422 #if 0 /* I don't know why it did this,
423 but it seems logically wrong,
424 and it causes trouble for MapNotify events. */
425 /* Match if the window is this frame's menubar. */
426 if (x->menubar_widget
427 && wdesc == XtWindow (x->menubar_widget))
428 return f;
429 #endif
431 return 0;
433 #endif /* USE_X_TOOLKIT */
437 /* Code to deal with bitmaps. Bitmaps are referenced by their bitmap
438 id, which is just an int that this section returns. Bitmaps are
439 reference counted so they can be shared among frames.
441 Bitmap indices are guaranteed to be > 0, so a negative number can
442 be used to indicate no bitmap.
444 If you use x_create_bitmap_from_data, then you must keep track of
445 the bitmaps yourself. That is, creating a bitmap from the same
446 data more than once will not be caught. */
449 /* Functions to access the contents of a bitmap, given an id. */
452 x_bitmap_height (f, id)
453 FRAME_PTR f;
454 int id;
456 return FRAME_X_DISPLAY_INFO (f)->bitmaps[id - 1].height;
460 x_bitmap_width (f, id)
461 FRAME_PTR f;
462 int id;
464 return FRAME_X_DISPLAY_INFO (f)->bitmaps[id - 1].width;
468 x_bitmap_pixmap (f, id)
469 FRAME_PTR f;
470 int id;
472 return FRAME_X_DISPLAY_INFO (f)->bitmaps[id - 1].pixmap;
476 /* Allocate a new bitmap record. Returns index of new record. */
478 static int
479 x_allocate_bitmap_record (f)
480 FRAME_PTR f;
482 struct x_display_info *dpyinfo = FRAME_X_DISPLAY_INFO (f);
483 int i;
485 if (dpyinfo->bitmaps == NULL)
487 dpyinfo->bitmaps_size = 10;
488 dpyinfo->bitmaps
489 = (struct x_bitmap_record *) xmalloc (dpyinfo->bitmaps_size * sizeof (struct x_bitmap_record));
490 dpyinfo->bitmaps_last = 1;
491 return 1;
494 if (dpyinfo->bitmaps_last < dpyinfo->bitmaps_size)
495 return ++dpyinfo->bitmaps_last;
497 for (i = 0; i < dpyinfo->bitmaps_size; ++i)
498 if (dpyinfo->bitmaps[i].refcount == 0)
499 return i + 1;
501 dpyinfo->bitmaps_size *= 2;
502 dpyinfo->bitmaps
503 = (struct x_bitmap_record *) xrealloc (dpyinfo->bitmaps,
504 dpyinfo->bitmaps_size * sizeof (struct x_bitmap_record));
505 return ++dpyinfo->bitmaps_last;
508 /* Add one reference to the reference count of the bitmap with id ID. */
510 void
511 x_reference_bitmap (f, id)
512 FRAME_PTR f;
513 int id;
515 ++FRAME_X_DISPLAY_INFO (f)->bitmaps[id - 1].refcount;
518 /* Create a bitmap for frame F from a HEIGHT x WIDTH array of bits at BITS. */
521 x_create_bitmap_from_data (f, bits, width, height)
522 struct frame *f;
523 char *bits;
524 unsigned int width, height;
526 struct x_display_info *dpyinfo = FRAME_X_DISPLAY_INFO (f);
527 Pixmap bitmap;
528 int id;
530 bitmap = XCreateBitmapFromData (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
531 bits, width, height);
533 if (! bitmap)
534 return -1;
536 id = x_allocate_bitmap_record (f);
537 dpyinfo->bitmaps[id - 1].pixmap = bitmap;
538 dpyinfo->bitmaps[id - 1].file = NULL;
539 dpyinfo->bitmaps[id - 1].refcount = 1;
540 dpyinfo->bitmaps[id - 1].depth = 1;
541 dpyinfo->bitmaps[id - 1].height = height;
542 dpyinfo->bitmaps[id - 1].width = width;
544 return id;
547 /* Create bitmap from file FILE for frame F. */
550 x_create_bitmap_from_file (f, file)
551 struct frame *f;
552 Lisp_Object file;
554 struct x_display_info *dpyinfo = FRAME_X_DISPLAY_INFO (f);
555 unsigned int width, height;
556 Pixmap bitmap;
557 int xhot, yhot, result, id;
558 Lisp_Object found;
559 int fd;
560 char *filename;
562 /* Look for an existing bitmap with the same name. */
563 for (id = 0; id < dpyinfo->bitmaps_last; ++id)
565 if (dpyinfo->bitmaps[id].refcount
566 && dpyinfo->bitmaps[id].file
567 && !strcmp (dpyinfo->bitmaps[id].file, (char *) XSTRING (file)->data))
569 ++dpyinfo->bitmaps[id].refcount;
570 return id + 1;
574 /* Search bitmap-file-path for the file, if appropriate. */
575 fd = openp (Vx_bitmap_file_path, file, "", &found, 0);
576 if (fd < 0)
577 return -1;
578 close (fd);
580 filename = (char *) XSTRING (found)->data;
582 result = XReadBitmapFile (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
583 filename, &width, &height, &bitmap, &xhot, &yhot);
584 if (result != BitmapSuccess)
585 return -1;
587 id = x_allocate_bitmap_record (f);
588 dpyinfo->bitmaps[id - 1].pixmap = bitmap;
589 dpyinfo->bitmaps[id - 1].refcount = 1;
590 dpyinfo->bitmaps[id - 1].file = (char *) xmalloc (XSTRING (file)->size + 1);
591 dpyinfo->bitmaps[id - 1].depth = 1;
592 dpyinfo->bitmaps[id - 1].height = height;
593 dpyinfo->bitmaps[id - 1].width = width;
594 strcpy (dpyinfo->bitmaps[id - 1].file, XSTRING (file)->data);
596 return id;
599 /* Remove reference to bitmap with id number ID. */
602 x_destroy_bitmap (f, id)
603 FRAME_PTR f;
604 int id;
606 struct x_display_info *dpyinfo = FRAME_X_DISPLAY_INFO (f);
608 if (id > 0)
610 --dpyinfo->bitmaps[id - 1].refcount;
611 if (dpyinfo->bitmaps[id - 1].refcount == 0)
613 BLOCK_INPUT;
614 XFreePixmap (FRAME_X_DISPLAY (f), dpyinfo->bitmaps[id - 1].pixmap);
615 if (dpyinfo->bitmaps[id - 1].file)
617 free (dpyinfo->bitmaps[id - 1].file);
618 dpyinfo->bitmaps[id - 1].file = NULL;
620 UNBLOCK_INPUT;
625 /* Free all the bitmaps for the display specified by DPYINFO. */
627 static void
628 x_destroy_all_bitmaps (dpyinfo)
629 struct x_display_info *dpyinfo;
631 int i;
632 for (i = 0; i < dpyinfo->bitmaps_last; i++)
633 if (dpyinfo->bitmaps[i].refcount > 0)
635 XFreePixmap (dpyinfo->display, dpyinfo->bitmaps[i].pixmap);
636 if (dpyinfo->bitmaps[i].file)
637 free (dpyinfo->bitmaps[i].file);
639 dpyinfo->bitmaps_last = 0;
642 /* Connect the frame-parameter names for X frames
643 to the ways of passing the parameter values to the window system.
645 The name of a parameter, as a Lisp symbol,
646 has an `x-frame-parameter' property which is an integer in Lisp
647 that is an index in this table. */
649 struct x_frame_parm_table
651 char *name;
652 void (*setter)( /* struct frame *frame, Lisp_Object val, oldval */ );
655 void x_set_foreground_color ();
656 void x_set_background_color ();
657 void x_set_mouse_color ();
658 void x_set_cursor_color ();
659 void x_set_border_color ();
660 void x_set_cursor_type ();
661 void x_set_icon_type ();
662 void x_set_icon_name ();
663 void x_set_font ();
664 void x_set_border_width ();
665 void x_set_internal_border_width ();
666 void x_explicitly_set_name ();
667 void x_set_autoraise ();
668 void x_set_autolower ();
669 void x_set_vertical_scroll_bars ();
670 void x_set_visibility ();
671 void x_set_menu_bar_lines ();
672 void x_set_scroll_bar_width ();
673 void x_set_title ();
674 void x_set_unsplittable ();
676 static struct x_frame_parm_table x_frame_parms[] =
678 "auto-raise", x_set_autoraise,
679 "auto-lower", x_set_autolower,
680 "background-color", x_set_background_color,
681 "border-color", x_set_border_color,
682 "border-width", x_set_border_width,
683 "cursor-color", x_set_cursor_color,
684 "cursor-type", x_set_cursor_type,
685 "font", x_set_font,
686 "foreground-color", x_set_foreground_color,
687 "icon-name", x_set_icon_name,
688 "icon-type", x_set_icon_type,
689 "internal-border-width", x_set_internal_border_width,
690 "menu-bar-lines", x_set_menu_bar_lines,
691 "mouse-color", x_set_mouse_color,
692 "name", x_explicitly_set_name,
693 "scroll-bar-width", x_set_scroll_bar_width,
694 "title", x_set_title,
695 "unsplittable", x_set_unsplittable,
696 "vertical-scroll-bars", x_set_vertical_scroll_bars,
697 "visibility", x_set_visibility,
700 /* Attach the `x-frame-parameter' properties to
701 the Lisp symbol names of parameters relevant to X. */
703 init_x_parm_symbols ()
705 int i;
707 for (i = 0; i < sizeof (x_frame_parms) / sizeof (x_frame_parms[0]); i++)
708 Fput (intern (x_frame_parms[i].name), Qx_frame_parameter,
709 make_number (i));
712 /* Change the parameters of FRAME as specified by ALIST.
713 If a parameter is not specially recognized, do nothing;
714 otherwise call the `x_set_...' function for that parameter. */
716 void
717 x_set_frame_parameters (f, alist)
718 FRAME_PTR f;
719 Lisp_Object alist;
721 Lisp_Object tail;
723 /* If both of these parameters are present, it's more efficient to
724 set them both at once. So we wait until we've looked at the
725 entire list before we set them. */
726 Lisp_Object width, height;
728 /* Same here. */
729 Lisp_Object left, top;
731 /* Same with these. */
732 Lisp_Object icon_left, icon_top;
734 /* Record in these vectors all the parms specified. */
735 Lisp_Object *parms;
736 Lisp_Object *values;
737 int i;
738 int left_no_change = 0, top_no_change = 0;
739 int icon_left_no_change = 0, icon_top_no_change = 0;
741 i = 0;
742 for (tail = alist; CONSP (tail); tail = Fcdr (tail))
743 i++;
745 parms = (Lisp_Object *) alloca (i * sizeof (Lisp_Object));
746 values = (Lisp_Object *) alloca (i * sizeof (Lisp_Object));
748 /* Extract parm names and values into those vectors. */
750 i = 0;
751 for (tail = alist; CONSP (tail); tail = Fcdr (tail))
753 Lisp_Object elt, prop, val;
755 elt = Fcar (tail);
756 parms[i] = Fcar (elt);
757 values[i] = Fcdr (elt);
758 i++;
761 width = height = top = left = Qunbound;
762 icon_left = icon_top = Qunbound;
764 /* Now process them in reverse of specified order. */
765 for (i--; i >= 0; i--)
767 Lisp_Object prop, val;
769 prop = parms[i];
770 val = values[i];
772 if (EQ (prop, Qwidth))
773 width = val;
774 else if (EQ (prop, Qheight))
775 height = val;
776 else if (EQ (prop, Qtop))
777 top = val;
778 else if (EQ (prop, Qleft))
779 left = val;
780 else if (EQ (prop, Qicon_top))
781 icon_top = val;
782 else if (EQ (prop, Qicon_left))
783 icon_left = val;
784 else
786 register Lisp_Object param_index, old_value;
788 param_index = Fget (prop, Qx_frame_parameter);
789 old_value = get_frame_param (f, prop);
790 store_frame_param (f, prop, val);
791 if (NATNUMP (param_index)
792 && (XFASTINT (param_index)
793 < sizeof (x_frame_parms)/sizeof (x_frame_parms[0])))
794 (*x_frame_parms[XINT (param_index)].setter)(f, val, old_value);
798 /* Don't die if just one of these was set. */
799 if (EQ (left, Qunbound))
801 left_no_change = 1;
802 if (f->output_data.x->left_pos < 0)
803 left = Fcons (Qplus, Fcons (make_number (f->output_data.x->left_pos), Qnil));
804 else
805 XSETINT (left, f->output_data.x->left_pos);
807 if (EQ (top, Qunbound))
809 top_no_change = 1;
810 if (f->output_data.x->top_pos < 0)
811 top = Fcons (Qplus, Fcons (make_number (f->output_data.x->top_pos), Qnil));
812 else
813 XSETINT (top, f->output_data.x->top_pos);
816 /* If one of the icon positions was not set, preserve or default it. */
817 if (EQ (icon_left, Qunbound) || ! INTEGERP (icon_left))
819 icon_left_no_change = 1;
820 icon_left = Fcdr (Fassq (Qicon_left, f->param_alist));
821 if (NILP (icon_left))
822 XSETINT (icon_left, 0);
824 if (EQ (icon_top, Qunbound) || ! INTEGERP (icon_top))
826 icon_top_no_change = 1;
827 icon_top = Fcdr (Fassq (Qicon_top, f->param_alist));
828 if (NILP (icon_top))
829 XSETINT (icon_top, 0);
832 /* Don't die if just one of these was set. */
833 if (EQ (width, Qunbound))
834 XSETINT (width, FRAME_WIDTH (f));
835 if (EQ (height, Qunbound))
836 XSETINT (height, FRAME_HEIGHT (f));
838 /* Don't set these parameters unless they've been explicitly
839 specified. The window might be mapped or resized while we're in
840 this function, and we don't want to override that unless the lisp
841 code has asked for it.
843 Don't set these parameters unless they actually differ from the
844 window's current parameters; the window may not actually exist
845 yet. */
847 Lisp_Object frame;
849 check_frame_size (f, &height, &width);
851 XSETFRAME (frame, f);
853 if ((NUMBERP (width) && XINT (width) != FRAME_WIDTH (f))
854 || (NUMBERP (height) && XINT (height) != FRAME_HEIGHT (f)))
855 Fset_frame_size (frame, width, height);
857 if ((!NILP (left) || !NILP (top))
858 && ! (left_no_change && top_no_change)
859 && ! (NUMBERP (left) && XINT (left) == f->output_data.x->left_pos
860 && NUMBERP (top) && XINT (top) == f->output_data.x->top_pos))
862 int leftpos = 0;
863 int toppos = 0;
865 /* Record the signs. */
866 f->output_data.x->size_hint_flags &= ~ (XNegative | YNegative);
867 if (EQ (left, Qminus))
868 f->output_data.x->size_hint_flags |= XNegative;
869 else if (INTEGERP (left))
871 leftpos = XINT (left);
872 if (leftpos < 0)
873 f->output_data.x->size_hint_flags |= XNegative;
875 else if (CONSP (left) && EQ (XCONS (left)->car, Qminus)
876 && CONSP (XCONS (left)->cdr)
877 && INTEGERP (XCONS (XCONS (left)->cdr)->car))
879 leftpos = - XINT (XCONS (XCONS (left)->cdr)->car);
880 f->output_data.x->size_hint_flags |= XNegative;
882 else if (CONSP (left) && EQ (XCONS (left)->car, Qplus)
883 && CONSP (XCONS (left)->cdr)
884 && INTEGERP (XCONS (XCONS (left)->cdr)->car))
886 leftpos = XINT (XCONS (XCONS (left)->cdr)->car);
889 if (EQ (top, Qminus))
890 f->output_data.x->size_hint_flags |= YNegative;
891 else if (INTEGERP (top))
893 toppos = XINT (top);
894 if (toppos < 0)
895 f->output_data.x->size_hint_flags |= YNegative;
897 else if (CONSP (top) && EQ (XCONS (top)->car, Qminus)
898 && CONSP (XCONS (top)->cdr)
899 && INTEGERP (XCONS (XCONS (top)->cdr)->car))
901 toppos = - XINT (XCONS (XCONS (top)->cdr)->car);
902 f->output_data.x->size_hint_flags |= YNegative;
904 else if (CONSP (top) && EQ (XCONS (top)->car, Qplus)
905 && CONSP (XCONS (top)->cdr)
906 && INTEGERP (XCONS (XCONS (top)->cdr)->car))
908 toppos = XINT (XCONS (XCONS (top)->cdr)->car);
912 /* Store the numeric value of the position. */
913 f->output_data.x->top_pos = toppos;
914 f->output_data.x->left_pos = leftpos;
916 f->output_data.x->win_gravity = NorthWestGravity;
918 /* Actually set that position, and convert to absolute. */
919 x_set_offset (f, leftpos, toppos, -1);
922 if ((!NILP (icon_left) || !NILP (icon_top))
923 && ! (icon_left_no_change && icon_top_no_change))
924 x_wm_set_icon_position (f, XINT (icon_left), XINT (icon_top));
928 /* Store the screen positions of frame F into XPTR and YPTR.
929 These are the positions of the containing window manager window,
930 not Emacs's own window. */
932 void
933 x_real_positions (f, xptr, yptr)
934 FRAME_PTR f;
935 int *xptr, *yptr;
937 int win_x, win_y;
938 Window child;
940 /* This is pretty gross, but seems to be the easiest way out of
941 the problem that arises when restarting window-managers. */
943 #ifdef USE_X_TOOLKIT
944 Window outer = XtWindow (f->output_data.x->widget);
945 #else
946 Window outer = f->output_data.x->window_desc;
947 #endif
948 Window tmp_root_window;
949 Window *tmp_children;
950 int tmp_nchildren;
952 while (1)
954 x_catch_errors (FRAME_X_DISPLAY (f));
956 XQueryTree (FRAME_X_DISPLAY (f), outer, &tmp_root_window,
957 &f->output_data.x->parent_desc,
958 &tmp_children, &tmp_nchildren);
959 XFree ((char *) tmp_children);
961 win_x = win_y = 0;
963 /* Find the position of the outside upper-left corner of
964 the inner window, with respect to the outer window. */
965 if (f->output_data.x->parent_desc != FRAME_X_DISPLAY_INFO (f)->root_window)
967 XTranslateCoordinates (FRAME_X_DISPLAY (f),
969 /* From-window, to-window. */
970 #ifdef USE_X_TOOLKIT
971 XtWindow (f->output_data.x->widget),
972 #else
973 f->output_data.x->window_desc,
974 #endif
975 f->output_data.x->parent_desc,
977 /* From-position, to-position. */
978 0, 0, &win_x, &win_y,
980 /* Child of win. */
981 &child);
983 #if 0 /* The values seem to be right without this and wrong with. */
984 win_x += f->output_data.x->border_width;
985 win_y += f->output_data.x->border_width;
986 #endif
989 /* It is possible for the window returned by the XQueryNotify
990 to become invalid by the time we call XTranslateCoordinates.
991 That can happen when you restart some window managers.
992 If so, we get an error in XTranslateCoordinates.
993 Detect that and try the whole thing over. */
994 if (! x_had_errors_p (FRAME_X_DISPLAY (f)))
995 break;
997 x_uncatch_errors (FRAME_X_DISPLAY (f));
1000 x_uncatch_errors (FRAME_X_DISPLAY (f));
1002 *xptr = f->output_data.x->left_pos - win_x;
1003 *yptr = f->output_data.x->top_pos - win_y;
1006 /* Insert a description of internally-recorded parameters of frame X
1007 into the parameter alist *ALISTPTR that is to be given to the user.
1008 Only parameters that are specific to the X window system
1009 and whose values are not correctly recorded in the frame's
1010 param_alist need to be considered here. */
1012 x_report_frame_params (f, alistptr)
1013 struct frame *f;
1014 Lisp_Object *alistptr;
1016 char buf[16];
1017 Lisp_Object tem;
1019 /* Represent negative positions (off the top or left screen edge)
1020 in a way that Fmodify_frame_parameters will understand correctly. */
1021 XSETINT (tem, f->output_data.x->left_pos);
1022 if (f->output_data.x->left_pos >= 0)
1023 store_in_alist (alistptr, Qleft, tem);
1024 else
1025 store_in_alist (alistptr, Qleft, Fcons (Qplus, Fcons (tem, Qnil)));
1027 XSETINT (tem, f->output_data.x->top_pos);
1028 if (f->output_data.x->top_pos >= 0)
1029 store_in_alist (alistptr, Qtop, tem);
1030 else
1031 store_in_alist (alistptr, Qtop, Fcons (Qplus, Fcons (tem, Qnil)));
1033 store_in_alist (alistptr, Qborder_width,
1034 make_number (f->output_data.x->border_width));
1035 store_in_alist (alistptr, Qinternal_border_width,
1036 make_number (f->output_data.x->internal_border_width));
1037 sprintf (buf, "%ld", (long) FRAME_X_WINDOW (f));
1038 store_in_alist (alistptr, Qwindow_id,
1039 build_string (buf));
1040 store_in_alist (alistptr, Qicon_name, f->icon_name);
1041 FRAME_SAMPLE_VISIBILITY (f);
1042 store_in_alist (alistptr, Qvisibility,
1043 (FRAME_VISIBLE_P (f) ? Qt
1044 : FRAME_ICONIFIED_P (f) ? Qicon : Qnil));
1045 store_in_alist (alistptr, Qdisplay,
1046 XCONS (FRAME_X_DISPLAY_INFO (f)->name_list_element)->car);
1050 /* Decide if color named COLOR is valid for the display associated with
1051 the selected frame; if so, return the rgb values in COLOR_DEF.
1052 If ALLOC is nonzero, allocate a new colormap cell. */
1055 defined_color (f, color, color_def, alloc)
1056 FRAME_PTR f;
1057 char *color;
1058 XColor *color_def;
1059 int alloc;
1061 register int status;
1062 Colormap screen_colormap;
1063 Display *display = FRAME_X_DISPLAY (f);
1065 BLOCK_INPUT;
1066 screen_colormap = DefaultColormap (display, XDefaultScreen (display));
1068 status = XParseColor (display, screen_colormap, color, color_def);
1069 if (status && alloc)
1071 status = XAllocColor (display, screen_colormap, color_def);
1072 if (!status)
1074 /* If we got to this point, the colormap is full, so we're
1075 going to try and get the next closest color.
1076 The algorithm used is a least-squares matching, which is
1077 what X uses for closest color matching with StaticColor visuals. */
1079 XColor *cells;
1080 int no_cells;
1081 int nearest;
1082 long nearest_delta, trial_delta;
1083 int x;
1085 no_cells = XDisplayCells (display, XDefaultScreen (display));
1086 cells = (XColor *) alloca (sizeof (XColor) * no_cells);
1088 for (x = 0; x < no_cells; x++)
1089 cells[x].pixel = x;
1091 XQueryColors (display, screen_colormap, cells, no_cells);
1092 nearest = 0;
1093 /* I'm assuming CSE so I'm not going to condense this. */
1094 nearest_delta = ((((color_def->red >> 8) - (cells[0].red >> 8))
1095 * ((color_def->red >> 8) - (cells[0].red >> 8)))
1097 (((color_def->green >> 8) - (cells[0].green >> 8))
1098 * ((color_def->green >> 8) - (cells[0].green >> 8)))
1100 (((color_def->blue >> 8) - (cells[0].blue >> 8))
1101 * ((color_def->blue >> 8) - (cells[0].blue >> 8))));
1102 for (x = 1; x < no_cells; x++)
1104 trial_delta = ((((color_def->red >> 8) - (cells[x].red >> 8))
1105 * ((color_def->red >> 8) - (cells[x].red >> 8)))
1107 (((color_def->green >> 8) - (cells[x].green >> 8))
1108 * ((color_def->green >> 8) - (cells[x].green >> 8)))
1110 (((color_def->blue >> 8) - (cells[x].blue >> 8))
1111 * ((color_def->blue >> 8) - (cells[x].blue >> 8))));
1112 if (trial_delta < nearest_delta)
1114 XColor temp;
1115 temp.red = cells[x].red;
1116 temp.green = cells[x].green;
1117 temp.blue = cells[x].blue;
1118 status = XAllocColor (display, screen_colormap, &temp);
1119 if (status)
1121 nearest = x;
1122 nearest_delta = trial_delta;
1126 color_def->red = cells[nearest].red;
1127 color_def->green = cells[nearest].green;
1128 color_def->blue = cells[nearest].blue;
1129 status = XAllocColor (display, screen_colormap, color_def);
1132 UNBLOCK_INPUT;
1134 if (status)
1135 return 1;
1136 else
1137 return 0;
1140 /* Given a string ARG naming a color, compute a pixel value from it
1141 suitable for screen F.
1142 If F is not a color screen, return DEF (default) regardless of what
1143 ARG says. */
1146 x_decode_color (f, arg, def)
1147 FRAME_PTR f;
1148 Lisp_Object arg;
1149 int def;
1151 XColor cdef;
1153 CHECK_STRING (arg, 0);
1155 if (strcmp (XSTRING (arg)->data, "black") == 0)
1156 return BLACK_PIX_DEFAULT (f);
1157 else if (strcmp (XSTRING (arg)->data, "white") == 0)
1158 return WHITE_PIX_DEFAULT (f);
1160 if (FRAME_X_DISPLAY_INFO (f)->n_planes == 1)
1161 return def;
1163 /* defined_color is responsible for coping with failures
1164 by looking for a near-miss. */
1165 if (defined_color (f, XSTRING (arg)->data, &cdef, 1))
1166 return cdef.pixel;
1168 Fsignal (Qerror, Fcons (build_string ("undefined color"),
1169 Fcons (arg, Qnil)));
1172 /* Functions called only from `x_set_frame_param'
1173 to set individual parameters.
1175 If FRAME_X_WINDOW (f) is 0,
1176 the frame is being created and its X-window does not exist yet.
1177 In that case, just record the parameter's new value
1178 in the standard place; do not attempt to change the window. */
1180 void
1181 x_set_foreground_color (f, arg, oldval)
1182 struct frame *f;
1183 Lisp_Object arg, oldval;
1185 f->output_data.x->foreground_pixel
1186 = x_decode_color (f, arg, BLACK_PIX_DEFAULT (f));
1187 if (FRAME_X_WINDOW (f) != 0)
1189 BLOCK_INPUT;
1190 XSetForeground (FRAME_X_DISPLAY (f), f->output_data.x->normal_gc,
1191 f->output_data.x->foreground_pixel);
1192 XSetBackground (FRAME_X_DISPLAY (f), f->output_data.x->reverse_gc,
1193 f->output_data.x->foreground_pixel);
1194 UNBLOCK_INPUT;
1195 recompute_basic_faces (f);
1196 if (FRAME_VISIBLE_P (f))
1197 redraw_frame (f);
1201 void
1202 x_set_background_color (f, arg, oldval)
1203 struct frame *f;
1204 Lisp_Object arg, oldval;
1206 Pixmap temp;
1207 int mask;
1209 f->output_data.x->background_pixel
1210 = x_decode_color (f, arg, WHITE_PIX_DEFAULT (f));
1212 if (FRAME_X_WINDOW (f) != 0)
1214 BLOCK_INPUT;
1215 /* The main frame area. */
1216 XSetBackground (FRAME_X_DISPLAY (f), f->output_data.x->normal_gc,
1217 f->output_data.x->background_pixel);
1218 XSetForeground (FRAME_X_DISPLAY (f), f->output_data.x->reverse_gc,
1219 f->output_data.x->background_pixel);
1220 XSetForeground (FRAME_X_DISPLAY (f), f->output_data.x->cursor_gc,
1221 f->output_data.x->background_pixel);
1222 XSetWindowBackground (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
1223 f->output_data.x->background_pixel);
1225 Lisp_Object bar;
1226 for (bar = FRAME_SCROLL_BARS (f); !NILP (bar);
1227 bar = XSCROLL_BAR (bar)->next)
1228 XSetWindowBackground (FRAME_X_DISPLAY (f),
1229 SCROLL_BAR_X_WINDOW (XSCROLL_BAR (bar)),
1230 f->output_data.x->background_pixel);
1232 UNBLOCK_INPUT;
1234 recompute_basic_faces (f);
1236 if (FRAME_VISIBLE_P (f))
1237 redraw_frame (f);
1241 void
1242 x_set_mouse_color (f, arg, oldval)
1243 struct frame *f;
1244 Lisp_Object arg, oldval;
1246 Cursor cursor, nontext_cursor, mode_cursor, cross_cursor;
1247 int mask_color;
1249 if (!EQ (Qnil, arg))
1250 f->output_data.x->mouse_pixel
1251 = x_decode_color (f, arg, BLACK_PIX_DEFAULT (f));
1252 mask_color = f->output_data.x->background_pixel;
1253 /* No invisible pointers. */
1254 if (mask_color == f->output_data.x->mouse_pixel
1255 && mask_color == f->output_data.x->background_pixel)
1256 f->output_data.x->mouse_pixel = f->output_data.x->foreground_pixel;
1258 BLOCK_INPUT;
1260 /* It's not okay to crash if the user selects a screwy cursor. */
1261 x_catch_errors (FRAME_X_DISPLAY (f));
1263 if (!EQ (Qnil, Vx_pointer_shape))
1265 CHECK_NUMBER (Vx_pointer_shape, 0);
1266 cursor = XCreateFontCursor (FRAME_X_DISPLAY (f), XINT (Vx_pointer_shape));
1268 else
1269 cursor = XCreateFontCursor (FRAME_X_DISPLAY (f), XC_xterm);
1270 x_check_errors (FRAME_X_DISPLAY (f), "bad text pointer cursor: %s");
1272 if (!EQ (Qnil, Vx_nontext_pointer_shape))
1274 CHECK_NUMBER (Vx_nontext_pointer_shape, 0);
1275 nontext_cursor = XCreateFontCursor (FRAME_X_DISPLAY (f),
1276 XINT (Vx_nontext_pointer_shape));
1278 else
1279 nontext_cursor = XCreateFontCursor (FRAME_X_DISPLAY (f), XC_left_ptr);
1280 x_check_errors (FRAME_X_DISPLAY (f), "bad nontext pointer cursor: %s");
1282 if (!EQ (Qnil, Vx_mode_pointer_shape))
1284 CHECK_NUMBER (Vx_mode_pointer_shape, 0);
1285 mode_cursor = XCreateFontCursor (FRAME_X_DISPLAY (f),
1286 XINT (Vx_mode_pointer_shape));
1288 else
1289 mode_cursor = XCreateFontCursor (FRAME_X_DISPLAY (f), XC_xterm);
1290 x_check_errors (FRAME_X_DISPLAY (f), "bad modeline pointer cursor: %s");
1292 if (!EQ (Qnil, Vx_sensitive_text_pointer_shape))
1294 CHECK_NUMBER (Vx_sensitive_text_pointer_shape, 0);
1295 cross_cursor
1296 = XCreateFontCursor (FRAME_X_DISPLAY (f),
1297 XINT (Vx_sensitive_text_pointer_shape));
1299 else
1300 cross_cursor = XCreateFontCursor (FRAME_X_DISPLAY (f), XC_crosshair);
1302 /* Check and report errors with the above calls. */
1303 x_check_errors (FRAME_X_DISPLAY (f), "can't set cursor shape: %s");
1304 x_uncatch_errors (FRAME_X_DISPLAY (f));
1307 XColor fore_color, back_color;
1309 fore_color.pixel = f->output_data.x->mouse_pixel;
1310 back_color.pixel = mask_color;
1311 XQueryColor (FRAME_X_DISPLAY (f),
1312 DefaultColormap (FRAME_X_DISPLAY (f),
1313 DefaultScreen (FRAME_X_DISPLAY (f))),
1314 &fore_color);
1315 XQueryColor (FRAME_X_DISPLAY (f),
1316 DefaultColormap (FRAME_X_DISPLAY (f),
1317 DefaultScreen (FRAME_X_DISPLAY (f))),
1318 &back_color);
1319 XRecolorCursor (FRAME_X_DISPLAY (f), cursor,
1320 &fore_color, &back_color);
1321 XRecolorCursor (FRAME_X_DISPLAY (f), nontext_cursor,
1322 &fore_color, &back_color);
1323 XRecolorCursor (FRAME_X_DISPLAY (f), mode_cursor,
1324 &fore_color, &back_color);
1325 XRecolorCursor (FRAME_X_DISPLAY (f), cross_cursor,
1326 &fore_color, &back_color);
1329 if (FRAME_X_WINDOW (f) != 0)
1331 XDefineCursor (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f), cursor);
1334 if (cursor != f->output_data.x->text_cursor && f->output_data.x->text_cursor != 0)
1335 XFreeCursor (FRAME_X_DISPLAY (f), f->output_data.x->text_cursor);
1336 f->output_data.x->text_cursor = cursor;
1338 if (nontext_cursor != f->output_data.x->nontext_cursor
1339 && f->output_data.x->nontext_cursor != 0)
1340 XFreeCursor (FRAME_X_DISPLAY (f), f->output_data.x->nontext_cursor);
1341 f->output_data.x->nontext_cursor = nontext_cursor;
1343 if (mode_cursor != f->output_data.x->modeline_cursor
1344 && f->output_data.x->modeline_cursor != 0)
1345 XFreeCursor (FRAME_X_DISPLAY (f), f->output_data.x->modeline_cursor);
1346 f->output_data.x->modeline_cursor = mode_cursor;
1347 if (cross_cursor != f->output_data.x->cross_cursor
1348 && f->output_data.x->cross_cursor != 0)
1349 XFreeCursor (FRAME_X_DISPLAY (f), f->output_data.x->cross_cursor);
1350 f->output_data.x->cross_cursor = cross_cursor;
1352 XFlush (FRAME_X_DISPLAY (f));
1353 UNBLOCK_INPUT;
1356 void
1357 x_set_cursor_color (f, arg, oldval)
1358 struct frame *f;
1359 Lisp_Object arg, oldval;
1361 unsigned long fore_pixel;
1363 if (!EQ (Vx_cursor_fore_pixel, Qnil))
1364 fore_pixel = x_decode_color (f, Vx_cursor_fore_pixel,
1365 WHITE_PIX_DEFAULT (f));
1366 else
1367 fore_pixel = f->output_data.x->background_pixel;
1368 f->output_data.x->cursor_pixel = x_decode_color (f, arg, BLACK_PIX_DEFAULT (f));
1370 /* Make sure that the cursor color differs from the background color. */
1371 if (f->output_data.x->cursor_pixel == f->output_data.x->background_pixel)
1373 f->output_data.x->cursor_pixel = f->output_data.x->mouse_pixel;
1374 if (f->output_data.x->cursor_pixel == fore_pixel)
1375 fore_pixel = f->output_data.x->background_pixel;
1377 f->output_data.x->cursor_foreground_pixel = fore_pixel;
1379 if (FRAME_X_WINDOW (f) != 0)
1381 BLOCK_INPUT;
1382 XSetBackground (FRAME_X_DISPLAY (f), f->output_data.x->cursor_gc,
1383 f->output_data.x->cursor_pixel);
1384 XSetForeground (FRAME_X_DISPLAY (f), f->output_data.x->cursor_gc,
1385 fore_pixel);
1386 UNBLOCK_INPUT;
1388 if (FRAME_VISIBLE_P (f))
1390 x_display_cursor (f, 0);
1391 x_display_cursor (f, 1);
1396 /* Set the border-color of frame F to value described by ARG.
1397 ARG can be a string naming a color.
1398 The border-color is used for the border that is drawn by the X server.
1399 Note that this does not fully take effect if done before
1400 F has an x-window; it must be redone when the window is created.
1402 Note: this is done in two routines because of the way X10 works.
1404 Note: under X11, this is normally the province of the window manager,
1405 and so emacs' border colors may be overridden. */
1407 void
1408 x_set_border_color (f, arg, oldval)
1409 struct frame *f;
1410 Lisp_Object arg, oldval;
1412 unsigned char *str;
1413 int pix;
1415 CHECK_STRING (arg, 0);
1416 str = XSTRING (arg)->data;
1418 pix = x_decode_color (f, arg, BLACK_PIX_DEFAULT (f));
1420 x_set_border_pixel (f, pix);
1423 /* Set the border-color of frame F to pixel value PIX.
1424 Note that this does not fully take effect if done before
1425 F has an x-window. */
1427 x_set_border_pixel (f, pix)
1428 struct frame *f;
1429 int pix;
1431 f->output_data.x->border_pixel = pix;
1433 if (FRAME_X_WINDOW (f) != 0 && f->output_data.x->border_width > 0)
1435 Pixmap temp;
1436 int mask;
1438 BLOCK_INPUT;
1439 XSetWindowBorder (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
1440 (unsigned long)pix);
1441 UNBLOCK_INPUT;
1443 if (FRAME_VISIBLE_P (f))
1444 redraw_frame (f);
1448 void
1449 x_set_cursor_type (f, arg, oldval)
1450 FRAME_PTR f;
1451 Lisp_Object arg, oldval;
1453 if (EQ (arg, Qbar))
1455 FRAME_DESIRED_CURSOR (f) = bar_cursor;
1456 f->output_data.x->cursor_width = 2;
1458 else if (CONSP (arg) && EQ (XCONS (arg)->car, Qbar)
1459 && INTEGERP (XCONS (arg)->cdr))
1461 FRAME_DESIRED_CURSOR (f) = bar_cursor;
1462 f->output_data.x->cursor_width = XINT (XCONS (arg)->cdr);
1464 else
1465 /* Treat anything unknown as "box cursor".
1466 It was bad to signal an error; people have trouble fixing
1467 .Xdefaults with Emacs, when it has something bad in it. */
1468 FRAME_DESIRED_CURSOR (f) = filled_box_cursor;
1470 /* Make sure the cursor gets redrawn. This is overkill, but how
1471 often do people change cursor types? */
1472 update_mode_lines++;
1475 void
1476 x_set_icon_type (f, arg, oldval)
1477 struct frame *f;
1478 Lisp_Object arg, oldval;
1480 Lisp_Object tem;
1481 int result;
1483 if (STRINGP (arg))
1485 if (STRINGP (oldval) && EQ (Fstring_equal (oldval, arg), Qt))
1486 return;
1488 else if (!STRINGP (oldval) && EQ (oldval, Qnil) == EQ (arg, Qnil))
1489 return;
1491 BLOCK_INPUT;
1492 if (NILP (arg))
1493 result = x_text_icon (f,
1494 (char *) XSTRING ((!NILP (f->icon_name)
1495 ? f->icon_name
1496 : f->name))->data);
1497 else
1498 result = x_bitmap_icon (f, arg);
1500 if (result)
1502 UNBLOCK_INPUT;
1503 error ("No icon window available");
1506 XFlush (FRAME_X_DISPLAY (f));
1507 UNBLOCK_INPUT;
1510 /* Return non-nil if frame F wants a bitmap icon. */
1512 Lisp_Object
1513 x_icon_type (f)
1514 FRAME_PTR f;
1516 Lisp_Object tem;
1518 tem = assq_no_quit (Qicon_type, f->param_alist);
1519 if (CONSP (tem))
1520 return XCONS (tem)->cdr;
1521 else
1522 return Qnil;
1525 void
1526 x_set_icon_name (f, arg, oldval)
1527 struct frame *f;
1528 Lisp_Object arg, oldval;
1530 Lisp_Object tem;
1531 int result;
1533 if (STRINGP (arg))
1535 if (STRINGP (oldval) && EQ (Fstring_equal (oldval, arg), Qt))
1536 return;
1538 else if (!STRINGP (oldval) && EQ (oldval, Qnil) == EQ (arg, Qnil))
1539 return;
1541 f->icon_name = arg;
1543 if (f->output_data.x->icon_bitmap != 0)
1544 return;
1546 BLOCK_INPUT;
1548 result = x_text_icon (f,
1549 (char *) XSTRING ((!NILP (f->icon_name)
1550 ? f->icon_name
1551 : !NILP (f->title)
1552 ? f->title
1553 : f->name))->data);
1555 if (result)
1557 UNBLOCK_INPUT;
1558 error ("No icon window available");
1561 XFlush (FRAME_X_DISPLAY (f));
1562 UNBLOCK_INPUT;
1565 extern Lisp_Object x_new_font ();
1567 void
1568 x_set_font (f, arg, oldval)
1569 struct frame *f;
1570 Lisp_Object arg, oldval;
1572 Lisp_Object result;
1574 CHECK_STRING (arg, 1);
1576 BLOCK_INPUT;
1577 result = x_new_font (f, XSTRING (arg)->data);
1578 UNBLOCK_INPUT;
1580 if (EQ (result, Qnil))
1581 error ("Font `%s' is not defined", XSTRING (arg)->data);
1582 else if (EQ (result, Qt))
1583 error ("the characters of the given font have varying widths");
1584 else if (STRINGP (result))
1586 recompute_basic_faces (f);
1587 store_frame_param (f, Qfont, result);
1589 else
1590 abort ();
1593 void
1594 x_set_border_width (f, arg, oldval)
1595 struct frame *f;
1596 Lisp_Object arg, oldval;
1598 CHECK_NUMBER (arg, 0);
1600 if (XINT (arg) == f->output_data.x->border_width)
1601 return;
1603 if (FRAME_X_WINDOW (f) != 0)
1604 error ("Cannot change the border width of a window");
1606 f->output_data.x->border_width = XINT (arg);
1609 void
1610 x_set_internal_border_width (f, arg, oldval)
1611 struct frame *f;
1612 Lisp_Object arg, oldval;
1614 int mask;
1615 int old = f->output_data.x->internal_border_width;
1617 CHECK_NUMBER (arg, 0);
1618 f->output_data.x->internal_border_width = XINT (arg);
1619 if (f->output_data.x->internal_border_width < 0)
1620 f->output_data.x->internal_border_width = 0;
1622 if (f->output_data.x->internal_border_width == old)
1623 return;
1625 if (FRAME_X_WINDOW (f) != 0)
1627 BLOCK_INPUT;
1628 x_set_window_size (f, 0, f->width, f->height);
1629 #if 0
1630 x_set_resize_hint (f);
1631 #endif
1632 XFlush (FRAME_X_DISPLAY (f));
1633 UNBLOCK_INPUT;
1634 SET_FRAME_GARBAGED (f);
1638 void
1639 x_set_visibility (f, value, oldval)
1640 struct frame *f;
1641 Lisp_Object value, oldval;
1643 Lisp_Object frame;
1644 XSETFRAME (frame, f);
1646 if (NILP (value))
1647 Fmake_frame_invisible (frame, Qt);
1648 else if (EQ (value, Qicon))
1649 Ficonify_frame (frame);
1650 else
1651 Fmake_frame_visible (frame);
1654 static void
1655 x_set_menu_bar_lines_1 (window, n)
1656 Lisp_Object window;
1657 int n;
1659 struct window *w = XWINDOW (window);
1661 XSETFASTINT (w->top, XFASTINT (w->top) + n);
1662 XSETFASTINT (w->height, XFASTINT (w->height) - n);
1664 /* Handle just the top child in a vertical split. */
1665 if (!NILP (w->vchild))
1666 x_set_menu_bar_lines_1 (w->vchild, n);
1668 /* Adjust all children in a horizontal split. */
1669 for (window = w->hchild; !NILP (window); window = w->next)
1671 w = XWINDOW (window);
1672 x_set_menu_bar_lines_1 (window, n);
1676 void
1677 x_set_menu_bar_lines (f, value, oldval)
1678 struct frame *f;
1679 Lisp_Object value, oldval;
1681 int nlines;
1682 int olines = FRAME_MENU_BAR_LINES (f);
1684 /* Right now, menu bars don't work properly in minibuf-only frames;
1685 most of the commands try to apply themselves to the minibuffer
1686 frame itslef, and get an error because you can't switch buffers
1687 in or split the minibuffer window. */
1688 if (FRAME_MINIBUF_ONLY_P (f))
1689 return;
1691 if (INTEGERP (value))
1692 nlines = XINT (value);
1693 else
1694 nlines = 0;
1696 #ifdef USE_X_TOOLKIT
1697 FRAME_MENU_BAR_LINES (f) = 0;
1698 if (nlines)
1700 FRAME_EXTERNAL_MENU_BAR (f) = 1;
1701 if (FRAME_X_P (f) && f->output_data.x->menubar_widget == 0)
1702 /* Make sure next redisplay shows the menu bar. */
1703 XWINDOW (FRAME_SELECTED_WINDOW (f))->update_mode_line = Qt;
1705 else
1707 if (FRAME_EXTERNAL_MENU_BAR (f) == 1)
1708 free_frame_menubar (f);
1709 FRAME_EXTERNAL_MENU_BAR (f) = 0;
1710 if (FRAME_X_P (f))
1711 f->output_data.x->menubar_widget = 0;
1713 #else /* not USE_X_TOOLKIT */
1714 FRAME_MENU_BAR_LINES (f) = nlines;
1715 x_set_menu_bar_lines_1 (f->root_window, nlines - olines);
1716 #endif /* not USE_X_TOOLKIT */
1719 /* Change the name of frame F to NAME. If NAME is nil, set F's name to
1720 x_id_name.
1722 If EXPLICIT is non-zero, that indicates that lisp code is setting the
1723 name; if NAME is a string, set F's name to NAME and set
1724 F->explicit_name; if NAME is Qnil, then clear F->explicit_name.
1726 If EXPLICIT is zero, that indicates that Emacs redisplay code is
1727 suggesting a new name, which lisp code should override; if
1728 F->explicit_name is set, ignore the new name; otherwise, set it. */
1730 void
1731 x_set_name (f, name, explicit)
1732 struct frame *f;
1733 Lisp_Object name;
1734 int explicit;
1736 /* Make sure that requests from lisp code override requests from
1737 Emacs redisplay code. */
1738 if (explicit)
1740 /* If we're switching from explicit to implicit, we had better
1741 update the mode lines and thereby update the title. */
1742 if (f->explicit_name && NILP (name))
1743 update_mode_lines = 1;
1745 f->explicit_name = ! NILP (name);
1747 else if (f->explicit_name)
1748 return;
1750 /* If NAME is nil, set the name to the x_id_name. */
1751 if (NILP (name))
1753 /* Check for no change needed in this very common case
1754 before we do any consing. */
1755 if (!strcmp (FRAME_X_DISPLAY_INFO (f)->x_id_name,
1756 XSTRING (f->name)->data))
1757 return;
1758 name = build_string (FRAME_X_DISPLAY_INFO (f)->x_id_name);
1760 else
1761 CHECK_STRING (name, 0);
1763 /* Don't change the name if it's already NAME. */
1764 if (! NILP (Fstring_equal (name, f->name)))
1765 return;
1767 f->name = name;
1769 /* For setting the frame title, the title parameter should override
1770 the name parameter. */
1771 if (! NILP (f->title))
1772 name = f->title;
1774 if (FRAME_X_WINDOW (f))
1776 BLOCK_INPUT;
1777 #ifdef HAVE_X11R4
1779 XTextProperty text, icon;
1780 Lisp_Object icon_name;
1782 text.value = XSTRING (name)->data;
1783 text.encoding = XA_STRING;
1784 text.format = 8;
1785 text.nitems = XSTRING (name)->size;
1787 icon_name = (!NILP (f->icon_name) ? f->icon_name : name);
1789 icon.value = XSTRING (icon_name)->data;
1790 icon.encoding = XA_STRING;
1791 icon.format = 8;
1792 icon.nitems = XSTRING (icon_name)->size;
1793 #ifdef USE_X_TOOLKIT
1794 XSetWMName (FRAME_X_DISPLAY (f),
1795 XtWindow (f->output_data.x->widget), &text);
1796 XSetWMIconName (FRAME_X_DISPLAY (f), XtWindow (f->output_data.x->widget),
1797 &icon);
1798 #else /* not USE_X_TOOLKIT */
1799 XSetWMName (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f), &text);
1800 XSetWMIconName (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f), &icon);
1801 #endif /* not USE_X_TOOLKIT */
1803 #else /* not HAVE_X11R4 */
1804 XSetIconName (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
1805 XSTRING (name)->data);
1806 XStoreName (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
1807 XSTRING (name)->data);
1808 #endif /* not HAVE_X11R4 */
1809 UNBLOCK_INPUT;
1813 /* This function should be called when the user's lisp code has
1814 specified a name for the frame; the name will override any set by the
1815 redisplay code. */
1816 void
1817 x_explicitly_set_name (f, arg, oldval)
1818 FRAME_PTR f;
1819 Lisp_Object arg, oldval;
1821 x_set_name (f, arg, 1);
1824 /* This function should be called by Emacs redisplay code to set the
1825 name; names set this way will never override names set by the user's
1826 lisp code. */
1827 void
1828 x_implicitly_set_name (f, arg, oldval)
1829 FRAME_PTR f;
1830 Lisp_Object arg, oldval;
1832 x_set_name (f, arg, 0);
1835 /* Change the title of frame F to NAME.
1836 If NAME is nil, use the frame name as the title.
1838 If EXPLICIT is non-zero, that indicates that lisp code is setting the
1839 name; if NAME is a string, set F's name to NAME and set
1840 F->explicit_name; if NAME is Qnil, then clear F->explicit_name.
1842 If EXPLICIT is zero, that indicates that Emacs redisplay code is
1843 suggesting a new name, which lisp code should override; if
1844 F->explicit_name is set, ignore the new name; otherwise, set it. */
1846 void
1847 x_set_title (f, name)
1848 struct frame *f;
1849 Lisp_Object name;
1851 /* Don't change the title if it's already NAME. */
1852 if (EQ (name, f->title))
1853 return;
1855 update_mode_lines = 1;
1857 f->title = name;
1859 if (NILP (name))
1860 name = f->name;
1862 if (FRAME_X_WINDOW (f))
1864 BLOCK_INPUT;
1865 #ifdef HAVE_X11R4
1867 XTextProperty text, icon;
1868 Lisp_Object icon_name;
1870 text.value = XSTRING (name)->data;
1871 text.encoding = XA_STRING;
1872 text.format = 8;
1873 text.nitems = XSTRING (name)->size;
1875 icon_name = (!NILP (f->icon_name) ? f->icon_name : name);
1877 icon.value = XSTRING (icon_name)->data;
1878 icon.encoding = XA_STRING;
1879 icon.format = 8;
1880 icon.nitems = XSTRING (icon_name)->size;
1881 #ifdef USE_X_TOOLKIT
1882 XSetWMName (FRAME_X_DISPLAY (f),
1883 XtWindow (f->output_data.x->widget), &text);
1884 XSetWMIconName (FRAME_X_DISPLAY (f), XtWindow (f->output_data.x->widget),
1885 &icon);
1886 #else /* not USE_X_TOOLKIT */
1887 XSetWMName (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f), &text);
1888 XSetWMIconName (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f), &icon);
1889 #endif /* not USE_X_TOOLKIT */
1891 #else /* not HAVE_X11R4 */
1892 XSetIconName (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
1893 XSTRING (name)->data);
1894 XStoreName (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
1895 XSTRING (name)->data);
1896 #endif /* not HAVE_X11R4 */
1897 UNBLOCK_INPUT;
1901 void
1902 x_set_autoraise (f, arg, oldval)
1903 struct frame *f;
1904 Lisp_Object arg, oldval;
1906 f->auto_raise = !EQ (Qnil, arg);
1909 void
1910 x_set_autolower (f, arg, oldval)
1911 struct frame *f;
1912 Lisp_Object arg, oldval;
1914 f->auto_lower = !EQ (Qnil, arg);
1917 void
1918 x_set_unsplittable (f, arg, oldval)
1919 struct frame *f;
1920 Lisp_Object arg, oldval;
1922 f->no_split = !NILP (arg);
1925 void
1926 x_set_vertical_scroll_bars (f, arg, oldval)
1927 struct frame *f;
1928 Lisp_Object arg, oldval;
1930 if (NILP (arg) != ! FRAME_HAS_VERTICAL_SCROLL_BARS (f))
1932 FRAME_HAS_VERTICAL_SCROLL_BARS (f) = ! NILP (arg);
1934 /* We set this parameter before creating the X window for the
1935 frame, so we can get the geometry right from the start.
1936 However, if the window hasn't been created yet, we shouldn't
1937 call x_set_window_size. */
1938 if (FRAME_X_WINDOW (f))
1939 x_set_window_size (f, 0, FRAME_WIDTH (f), FRAME_HEIGHT (f));
1943 void
1944 x_set_scroll_bar_width (f, arg, oldval)
1945 struct frame *f;
1946 Lisp_Object arg, oldval;
1948 if (NILP (arg))
1950 FRAME_SCROLL_BAR_PIXEL_WIDTH (f) = 0;
1951 FRAME_SCROLL_BAR_COLS (f) = 2;
1953 else if (INTEGERP (arg) && XINT (arg) > 0
1954 && XFASTINT (arg) != FRAME_SCROLL_BAR_PIXEL_WIDTH (f))
1956 int wid = FONT_WIDTH (f->output_data.x->font);
1957 FRAME_SCROLL_BAR_PIXEL_WIDTH (f) = XFASTINT (arg);
1958 FRAME_SCROLL_BAR_COLS (f) = (XFASTINT (arg) + wid-1) / wid;
1959 if (FRAME_X_WINDOW (f))
1960 x_set_window_size (f, 0, FRAME_WIDTH (f), FRAME_HEIGHT (f));
1964 /* Subroutines of creating an X frame. */
1966 /* Make sure that Vx_resource_name is set to a reasonable value.
1967 Fix it up, or set it to `emacs' if it is too hopeless. */
1969 static void
1970 validate_x_resource_name ()
1972 int len;
1973 /* Number of valid characters in the resource name. */
1974 int good_count = 0;
1975 /* Number of invalid characters in the resource name. */
1976 int bad_count = 0;
1977 Lisp_Object new;
1978 int i;
1980 if (STRINGP (Vx_resource_name))
1982 unsigned char *p = XSTRING (Vx_resource_name)->data;
1983 int i;
1985 len = XSTRING (Vx_resource_name)->size;
1987 /* Only letters, digits, - and _ are valid in resource names.
1988 Count the valid characters and count the invalid ones. */
1989 for (i = 0; i < len; i++)
1991 int c = p[i];
1992 if (! ((c >= 'a' && c <= 'z')
1993 || (c >= 'A' && c <= 'Z')
1994 || (c >= '0' && c <= '9')
1995 || c == '-' || c == '_'))
1996 bad_count++;
1997 else
1998 good_count++;
2001 else
2002 /* Not a string => completely invalid. */
2003 bad_count = 5, good_count = 0;
2005 /* If name is valid already, return. */
2006 if (bad_count == 0)
2007 return;
2009 /* If name is entirely invalid, or nearly so, use `emacs'. */
2010 if (good_count == 0
2011 || (good_count == 1 && bad_count > 0))
2013 Vx_resource_name = build_string ("emacs");
2014 return;
2017 /* Name is partly valid. Copy it and replace the invalid characters
2018 with underscores. */
2020 Vx_resource_name = new = Fcopy_sequence (Vx_resource_name);
2022 for (i = 0; i < len; i++)
2024 int c = XSTRING (new)->data[i];
2025 if (! ((c >= 'a' && c <= 'z')
2026 || (c >= 'A' && c <= 'Z')
2027 || (c >= '0' && c <= '9')
2028 || c == '-' || c == '_'))
2029 XSTRING (new)->data[i] = '_';
2034 extern char *x_get_string_resource ();
2036 DEFUN ("x-get-resource", Fx_get_resource, Sx_get_resource, 2, 4, 0,
2037 "Return the value of ATTRIBUTE, of class CLASS, from the X defaults database.\n\
2038 This uses `INSTANCE.ATTRIBUTE' as the key and `Emacs.CLASS' as the\n\
2039 class, where INSTANCE is the name under which Emacs was invoked, or\n\
2040 the name specified by the `-name' or `-rn' command-line arguments.\n\
2042 The optional arguments COMPONENT and SUBCLASS add to the key and the\n\
2043 class, respectively. You must specify both of them or neither.\n\
2044 If you specify them, the key is `INSTANCE.COMPONENT.ATTRIBUTE'\n\
2045 and the class is `Emacs.CLASS.SUBCLASS'.")
2046 (attribute, class, component, subclass)
2047 Lisp_Object attribute, class, component, subclass;
2049 register char *value;
2050 char *name_key;
2051 char *class_key;
2053 check_x ();
2055 CHECK_STRING (attribute, 0);
2056 CHECK_STRING (class, 0);
2058 if (!NILP (component))
2059 CHECK_STRING (component, 1);
2060 if (!NILP (subclass))
2061 CHECK_STRING (subclass, 2);
2062 if (NILP (component) != NILP (subclass))
2063 error ("x-get-resource: must specify both COMPONENT and SUBCLASS or neither");
2065 validate_x_resource_name ();
2067 /* Allocate space for the components, the dots which separate them,
2068 and the final '\0'. Make them big enough for the worst case. */
2069 name_key = (char *) alloca (XSTRING (Vx_resource_name)->size
2070 + (STRINGP (component)
2071 ? XSTRING (component)->size : 0)
2072 + XSTRING (attribute)->size
2073 + 3);
2075 class_key = (char *) alloca ((sizeof (EMACS_CLASS) - 1)
2076 + XSTRING (class)->size
2077 + (STRINGP (subclass)
2078 ? XSTRING (subclass)->size : 0)
2079 + 3);
2081 /* Start with emacs.FRAMENAME for the name (the specific one)
2082 and with `Emacs' for the class key (the general one). */
2083 strcpy (name_key, XSTRING (Vx_resource_name)->data);
2084 strcpy (class_key, EMACS_CLASS);
2086 strcat (class_key, ".");
2087 strcat (class_key, XSTRING (class)->data);
2089 if (!NILP (component))
2091 strcat (class_key, ".");
2092 strcat (class_key, XSTRING (subclass)->data);
2094 strcat (name_key, ".");
2095 strcat (name_key, XSTRING (component)->data);
2098 strcat (name_key, ".");
2099 strcat (name_key, XSTRING (attribute)->data);
2101 value = x_get_string_resource (check_x_display_info (Qnil)->xrdb,
2102 name_key, class_key);
2104 if (value != (char *) 0)
2105 return build_string (value);
2106 else
2107 return Qnil;
2110 /* Used when C code wants a resource value. */
2112 char *
2113 x_get_resource_string (attribute, class)
2114 char *attribute, *class;
2116 register char *value;
2117 char *name_key;
2118 char *class_key;
2120 /* Allocate space for the components, the dots which separate them,
2121 and the final '\0'. */
2122 name_key = (char *) alloca (XSTRING (Vinvocation_name)->size
2123 + strlen (attribute) + 2);
2124 class_key = (char *) alloca ((sizeof (EMACS_CLASS) - 1)
2125 + strlen (class) + 2);
2127 sprintf (name_key, "%s.%s",
2128 XSTRING (Vinvocation_name)->data,
2129 attribute);
2130 sprintf (class_key, "%s.%s", EMACS_CLASS, class);
2132 return x_get_string_resource (FRAME_X_DISPLAY_INFO (selected_frame)->xrdb,
2133 name_key, class_key);
2136 /* Types we might convert a resource string into. */
2137 enum resource_types
2139 number, boolean, string, symbol
2142 /* Return the value of parameter PARAM.
2144 First search ALIST, then Vdefault_frame_alist, then the X defaults
2145 database, using ATTRIBUTE as the attribute name and CLASS as its class.
2147 Convert the resource to the type specified by desired_type.
2149 If no default is specified, return Qunbound. If you call
2150 x_get_arg, make sure you deal with Qunbound in a reasonable way,
2151 and don't let it get stored in any Lisp-visible variables! */
2153 static Lisp_Object
2154 x_get_arg (alist, param, attribute, class, type)
2155 Lisp_Object alist, param;
2156 char *attribute;
2157 char *class;
2158 enum resource_types type;
2160 register Lisp_Object tem;
2162 tem = Fassq (param, alist);
2163 if (EQ (tem, Qnil))
2164 tem = Fassq (param, Vdefault_frame_alist);
2165 if (EQ (tem, Qnil))
2168 if (attribute)
2170 tem = Fx_get_resource (build_string (attribute),
2171 build_string (class),
2172 Qnil, Qnil);
2174 if (NILP (tem))
2175 return Qunbound;
2177 switch (type)
2179 case number:
2180 return make_number (atoi (XSTRING (tem)->data));
2182 case boolean:
2183 tem = Fdowncase (tem);
2184 if (!strcmp (XSTRING (tem)->data, "on")
2185 || !strcmp (XSTRING (tem)->data, "true"))
2186 return Qt;
2187 else
2188 return Qnil;
2190 case string:
2191 return tem;
2193 case symbol:
2194 /* As a special case, we map the values `true' and `on'
2195 to Qt, and `false' and `off' to Qnil. */
2197 Lisp_Object lower;
2198 lower = Fdowncase (tem);
2199 if (!strcmp (XSTRING (lower)->data, "on")
2200 || !strcmp (XSTRING (lower)->data, "true"))
2201 return Qt;
2202 else if (!strcmp (XSTRING (lower)->data, "off")
2203 || !strcmp (XSTRING (lower)->data, "false"))
2204 return Qnil;
2205 else
2206 return Fintern (tem, Qnil);
2209 default:
2210 abort ();
2213 else
2214 return Qunbound;
2216 return Fcdr (tem);
2219 /* Record in frame F the specified or default value according to ALIST
2220 of the parameter named PARAM (a Lisp symbol).
2221 If no value is specified for PARAM, look for an X default for XPROP
2222 on the frame named NAME.
2223 If that is not found either, use the value DEFLT. */
2225 static Lisp_Object
2226 x_default_parameter (f, alist, prop, deflt, xprop, xclass, type)
2227 struct frame *f;
2228 Lisp_Object alist;
2229 Lisp_Object prop;
2230 Lisp_Object deflt;
2231 char *xprop;
2232 char *xclass;
2233 enum resource_types type;
2235 Lisp_Object tem;
2237 tem = x_get_arg (alist, prop, xprop, xclass, type);
2238 if (EQ (tem, Qunbound))
2239 tem = deflt;
2240 x_set_frame_parameters (f, Fcons (Fcons (prop, tem), Qnil));
2241 return tem;
2244 DEFUN ("x-parse-geometry", Fx_parse_geometry, Sx_parse_geometry, 1, 1, 0,
2245 "Parse an X-style geometry string STRING.\n\
2246 Returns an alist of the form ((top . TOP), (left . LEFT) ... ).\n\
2247 The properties returned may include `top', `left', `height', and `width'.\n\
2248 The value of `left' or `top' may be an integer,\n\
2249 or a list (+ N) meaning N pixels relative to top/left corner,\n\
2250 or a list (- N) meaning -N pixels relative to bottom/right corner.")
2251 (string)
2252 Lisp_Object string;
2254 int geometry, x, y;
2255 unsigned int width, height;
2256 Lisp_Object result;
2258 CHECK_STRING (string, 0);
2260 geometry = XParseGeometry ((char *) XSTRING (string)->data,
2261 &x, &y, &width, &height);
2263 #if 0
2264 if (!!(geometry & XValue) != !!(geometry & YValue))
2265 error ("Must specify both x and y position, or neither");
2266 #endif
2268 result = Qnil;
2269 if (geometry & XValue)
2271 Lisp_Object element;
2273 if (x >= 0 && (geometry & XNegative))
2274 element = Fcons (Qleft, Fcons (Qminus, Fcons (make_number (-x), Qnil)));
2275 else if (x < 0 && ! (geometry & XNegative))
2276 element = Fcons (Qleft, Fcons (Qplus, Fcons (make_number (x), Qnil)));
2277 else
2278 element = Fcons (Qleft, make_number (x));
2279 result = Fcons (element, result);
2282 if (geometry & YValue)
2284 Lisp_Object element;
2286 if (y >= 0 && (geometry & YNegative))
2287 element = Fcons (Qtop, Fcons (Qminus, Fcons (make_number (-y), Qnil)));
2288 else if (y < 0 && ! (geometry & YNegative))
2289 element = Fcons (Qtop, Fcons (Qplus, Fcons (make_number (y), Qnil)));
2290 else
2291 element = Fcons (Qtop, make_number (y));
2292 result = Fcons (element, result);
2295 if (geometry & WidthValue)
2296 result = Fcons (Fcons (Qwidth, make_number (width)), result);
2297 if (geometry & HeightValue)
2298 result = Fcons (Fcons (Qheight, make_number (height)), result);
2300 return result;
2303 /* Calculate the desired size and position of this window,
2304 and return the flags saying which aspects were specified.
2306 This function does not make the coordinates positive. */
2308 #define DEFAULT_ROWS 40
2309 #define DEFAULT_COLS 80
2311 static int
2312 x_figure_window_size (f, parms)
2313 struct frame *f;
2314 Lisp_Object parms;
2316 register Lisp_Object tem0, tem1, tem2;
2317 int height, width, left, top;
2318 register int geometry;
2319 long window_prompting = 0;
2321 /* Default values if we fall through.
2322 Actually, if that happens we should get
2323 window manager prompting. */
2324 f->width = DEFAULT_COLS;
2325 f->height = DEFAULT_ROWS;
2326 /* Window managers expect that if program-specified
2327 positions are not (0,0), they're intentional, not defaults. */
2328 f->output_data.x->top_pos = 0;
2329 f->output_data.x->left_pos = 0;
2331 tem0 = x_get_arg (parms, Qheight, 0, 0, number);
2332 tem1 = x_get_arg (parms, Qwidth, 0, 0, number);
2333 tem2 = x_get_arg (parms, Quser_size, 0, 0, number);
2334 if (! EQ (tem0, Qunbound) || ! EQ (tem1, Qunbound))
2336 if (!EQ (tem0, Qunbound))
2338 CHECK_NUMBER (tem0, 0);
2339 f->height = XINT (tem0);
2341 if (!EQ (tem1, Qunbound))
2343 CHECK_NUMBER (tem1, 0);
2344 f->width = XINT (tem1);
2346 if (!NILP (tem2) && !EQ (tem2, Qunbound))
2347 window_prompting |= USSize;
2348 else
2349 window_prompting |= PSize;
2352 f->output_data.x->vertical_scroll_bar_extra
2353 = (!FRAME_HAS_VERTICAL_SCROLL_BARS (f)
2355 : FRAME_SCROLL_BAR_PIXEL_WIDTH (f) > 0
2356 ? FRAME_SCROLL_BAR_PIXEL_WIDTH (f)
2357 : (FRAME_SCROLL_BAR_COLS (f) * FONT_WIDTH (f->output_data.x->font)));
2358 f->output_data.x->pixel_width = CHAR_TO_PIXEL_WIDTH (f, f->width);
2359 f->output_data.x->pixel_height = CHAR_TO_PIXEL_HEIGHT (f, f->height);
2361 tem0 = x_get_arg (parms, Qtop, 0, 0, number);
2362 tem1 = x_get_arg (parms, Qleft, 0, 0, number);
2363 tem2 = x_get_arg (parms, Quser_position, 0, 0, number);
2364 if (! EQ (tem0, Qunbound) || ! EQ (tem1, Qunbound))
2366 if (EQ (tem0, Qminus))
2368 f->output_data.x->top_pos = 0;
2369 window_prompting |= YNegative;
2371 else if (CONSP (tem0) && EQ (XCONS (tem0)->car, Qminus)
2372 && CONSP (XCONS (tem0)->cdr)
2373 && INTEGERP (XCONS (XCONS (tem0)->cdr)->car))
2375 f->output_data.x->top_pos = - XINT (XCONS (XCONS (tem0)->cdr)->car);
2376 window_prompting |= YNegative;
2378 else if (CONSP (tem0) && EQ (XCONS (tem0)->car, Qplus)
2379 && CONSP (XCONS (tem0)->cdr)
2380 && INTEGERP (XCONS (XCONS (tem0)->cdr)->car))
2382 f->output_data.x->top_pos = XINT (XCONS (XCONS (tem0)->cdr)->car);
2384 else if (EQ (tem0, Qunbound))
2385 f->output_data.x->top_pos = 0;
2386 else
2388 CHECK_NUMBER (tem0, 0);
2389 f->output_data.x->top_pos = XINT (tem0);
2390 if (f->output_data.x->top_pos < 0)
2391 window_prompting |= YNegative;
2394 if (EQ (tem1, Qminus))
2396 f->output_data.x->left_pos = 0;
2397 window_prompting |= XNegative;
2399 else if (CONSP (tem1) && EQ (XCONS (tem1)->car, Qminus)
2400 && CONSP (XCONS (tem1)->cdr)
2401 && INTEGERP (XCONS (XCONS (tem1)->cdr)->car))
2403 f->output_data.x->left_pos = - XINT (XCONS (XCONS (tem1)->cdr)->car);
2404 window_prompting |= XNegative;
2406 else if (CONSP (tem1) && EQ (XCONS (tem1)->car, Qplus)
2407 && CONSP (XCONS (tem1)->cdr)
2408 && INTEGERP (XCONS (XCONS (tem1)->cdr)->car))
2410 f->output_data.x->left_pos = XINT (XCONS (XCONS (tem1)->cdr)->car);
2412 else if (EQ (tem1, Qunbound))
2413 f->output_data.x->left_pos = 0;
2414 else
2416 CHECK_NUMBER (tem1, 0);
2417 f->output_data.x->left_pos = XINT (tem1);
2418 if (f->output_data.x->left_pos < 0)
2419 window_prompting |= XNegative;
2422 if (!NILP (tem2) && ! EQ (tem2, Qunbound))
2423 window_prompting |= USPosition;
2424 else
2425 window_prompting |= PPosition;
2428 return window_prompting;
2431 #if !defined (HAVE_X11R4) && !defined (HAVE_XSETWMPROTOCOLS)
2433 Status
2434 XSetWMProtocols (dpy, w, protocols, count)
2435 Display *dpy;
2436 Window w;
2437 Atom *protocols;
2438 int count;
2440 Atom prop;
2441 prop = XInternAtom (dpy, "WM_PROTOCOLS", False);
2442 if (prop == None) return False;
2443 XChangeProperty (dpy, w, prop, XA_ATOM, 32, PropModeReplace,
2444 (unsigned char *) protocols, count);
2445 return True;
2447 #endif /* not HAVE_X11R4 && not HAVE_XSETWMPROTOCOLS */
2449 #ifdef USE_X_TOOLKIT
2451 /* If the WM_PROTOCOLS property does not already contain WM_TAKE_FOCUS,
2452 WM_DELETE_WINDOW, and WM_SAVE_YOURSELF, then add them. (They may
2453 already be present because of the toolkit (Motif adds some of them,
2454 for example, but Xt doesn't). */
2456 static void
2457 hack_wm_protocols (f, widget)
2458 FRAME_PTR f;
2459 Widget widget;
2461 Display *dpy = XtDisplay (widget);
2462 Window w = XtWindow (widget);
2463 int need_delete = 1;
2464 int need_focus = 1;
2465 int need_save = 1;
2467 BLOCK_INPUT;
2469 Atom type, *atoms = 0;
2470 int format = 0;
2471 unsigned long nitems = 0;
2472 unsigned long bytes_after;
2474 if ((XGetWindowProperty (dpy, w,
2475 FRAME_X_DISPLAY_INFO (f)->Xatom_wm_protocols,
2476 (long)0, (long)100, False, XA_ATOM,
2477 &type, &format, &nitems, &bytes_after,
2478 (unsigned char **) &atoms)
2479 == Success)
2480 && format == 32 && type == XA_ATOM)
2481 while (nitems > 0)
2483 nitems--;
2484 if (atoms[nitems] == FRAME_X_DISPLAY_INFO (f)->Xatom_wm_delete_window)
2485 need_delete = 0;
2486 else if (atoms[nitems] == FRAME_X_DISPLAY_INFO (f)->Xatom_wm_take_focus)
2487 need_focus = 0;
2488 else if (atoms[nitems] == FRAME_X_DISPLAY_INFO (f)->Xatom_wm_save_yourself)
2489 need_save = 0;
2491 if (atoms) XFree ((char *) atoms);
2494 Atom props [10];
2495 int count = 0;
2496 if (need_delete)
2497 props[count++] = FRAME_X_DISPLAY_INFO (f)->Xatom_wm_delete_window;
2498 if (need_focus)
2499 props[count++] = FRAME_X_DISPLAY_INFO (f)->Xatom_wm_take_focus;
2500 if (need_save)
2501 props[count++] = FRAME_X_DISPLAY_INFO (f)->Xatom_wm_save_yourself;
2502 if (count)
2503 XChangeProperty (dpy, w, FRAME_X_DISPLAY_INFO (f)->Xatom_wm_protocols,
2504 XA_ATOM, 32, PropModeAppend,
2505 (unsigned char *) props, count);
2507 UNBLOCK_INPUT;
2509 #endif
2511 #ifdef USE_X_TOOLKIT
2513 /* Create and set up the X widget for frame F. */
2515 static void
2516 x_window (f, window_prompting, minibuffer_only)
2517 struct frame *f;
2518 long window_prompting;
2519 int minibuffer_only;
2521 XClassHint class_hints;
2522 XSetWindowAttributes attributes;
2523 unsigned long attribute_mask;
2525 Widget shell_widget;
2526 Widget pane_widget;
2527 Widget frame_widget;
2528 Arg al [25];
2529 int ac;
2531 BLOCK_INPUT;
2533 /* Use the resource name as the top-level widget name
2534 for looking up resources. Make a non-Lisp copy
2535 for the window manager, so GC relocation won't bother it.
2537 Elsewhere we specify the window name for the window manager. */
2540 char *str = (char *) XSTRING (Vx_resource_name)->data;
2541 f->namebuf = (char *) xmalloc (strlen (str) + 1);
2542 strcpy (f->namebuf, str);
2545 ac = 0;
2546 XtSetArg (al[ac], XtNallowShellResize, 1); ac++;
2547 XtSetArg (al[ac], XtNinput, 1); ac++;
2548 XtSetArg (al[ac], XtNmappedWhenManaged, 0); ac++;
2549 XtSetArg (al[ac], XtNborderWidth, f->output_data.x->border_width); ac++;
2550 shell_widget = XtAppCreateShell (f->namebuf, EMACS_CLASS,
2551 applicationShellWidgetClass,
2552 FRAME_X_DISPLAY (f), al, ac);
2554 f->output_data.x->widget = shell_widget;
2555 /* maybe_set_screen_title_format (shell_widget); */
2557 pane_widget = lw_create_widget ("main", "pane", widget_id_tick++,
2558 (widget_value *) NULL,
2559 shell_widget, False,
2560 (lw_callback) NULL,
2561 (lw_callback) NULL,
2562 (lw_callback) NULL);
2564 f->output_data.x->column_widget = pane_widget;
2566 /* mappedWhenManaged to false tells to the paned window to not map/unmap
2567 the emacs screen when changing menubar. This reduces flickering. */
2569 ac = 0;
2570 XtSetArg (al[ac], XtNmappedWhenManaged, 0); ac++;
2571 XtSetArg (al[ac], XtNshowGrip, 0); ac++;
2572 XtSetArg (al[ac], XtNallowResize, 1); ac++;
2573 XtSetArg (al[ac], XtNresizeToPreferred, 1); ac++;
2574 XtSetArg (al[ac], XtNemacsFrame, f); ac++;
2575 frame_widget = XtCreateWidget (f->namebuf,
2576 emacsFrameClass,
2577 pane_widget, al, ac);
2579 f->output_data.x->edit_widget = frame_widget;
2581 XtManageChild (frame_widget);
2583 /* Do some needed geometry management. */
2585 int len;
2586 char *tem, shell_position[32];
2587 Arg al[2];
2588 int ac = 0;
2589 int extra_borders = 0;
2590 int menubar_size
2591 = (f->output_data.x->menubar_widget
2592 ? (f->output_data.x->menubar_widget->core.height
2593 + f->output_data.x->menubar_widget->core.border_width)
2594 : 0);
2595 extern char *lwlib_toolkit_type;
2597 if (FRAME_EXTERNAL_MENU_BAR (f))
2599 Dimension ibw = 0;
2600 XtVaGetValues (pane_widget, XtNinternalBorderWidth, &ibw, NULL);
2601 menubar_size += ibw;
2604 f->output_data.x->menubar_height = menubar_size;
2606 /* Motif seems to need this amount added to the sizes
2607 specified for the shell widget. The Athena/Lucid widgets don't.
2608 Both conclusions reached experimentally. -- rms. */
2609 if (!strcmp (lwlib_toolkit_type, "motif"))
2610 XtVaGetValues (f->output_data.x->edit_widget, XtNinternalBorderWidth,
2611 &extra_borders, NULL);
2613 /* Convert our geometry parameters into a geometry string
2614 and specify it.
2615 Note that we do not specify here whether the position
2616 is a user-specified or program-specified one.
2617 We pass that information later, in x_wm_set_size_hints. */
2619 int left = f->output_data.x->left_pos;
2620 int xneg = window_prompting & XNegative;
2621 int top = f->output_data.x->top_pos;
2622 int yneg = window_prompting & YNegative;
2623 if (xneg)
2624 left = -left;
2625 if (yneg)
2626 top = -top;
2628 if (window_prompting & USPosition)
2629 sprintf (shell_position, "=%dx%d%c%d%c%d",
2630 PIXEL_WIDTH (f) + extra_borders,
2631 PIXEL_HEIGHT (f) + menubar_size + extra_borders,
2632 (xneg ? '-' : '+'), left,
2633 (yneg ? '-' : '+'), top);
2634 else
2635 sprintf (shell_position, "=%dx%d",
2636 PIXEL_WIDTH (f) + extra_borders,
2637 PIXEL_HEIGHT (f) + menubar_size + extra_borders);
2640 len = strlen (shell_position) + 1;
2641 tem = (char *) xmalloc (len);
2642 strncpy (tem, shell_position, len);
2643 XtSetArg (al[ac], XtNgeometry, tem); ac++;
2644 XtSetValues (shell_widget, al, ac);
2647 XtManageChild (pane_widget);
2648 XtRealizeWidget (shell_widget);
2650 FRAME_X_WINDOW (f) = XtWindow (frame_widget);
2652 validate_x_resource_name ();
2654 class_hints.res_name = (char *) XSTRING (Vx_resource_name)->data;
2655 class_hints.res_class = EMACS_CLASS;
2656 XSetClassHint (FRAME_X_DISPLAY (f), XtWindow (shell_widget), &class_hints);
2658 #ifdef HAVE_X_I18N
2660 XIM xim;
2661 XIC xic = NULL;
2663 xim = XOpenIM (FRAME_X_DISPLAY (f), NULL, NULL, NULL);
2665 if (xim)
2667 xic = XCreateIC (xim,
2668 XNInputStyle, XIMPreeditNothing | XIMStatusNothing,
2669 XNClientWindow, FRAME_X_WINDOW(f),
2670 XNFocusWindow, FRAME_X_WINDOW(f),
2671 NULL);
2673 if (xic == 0)
2674 XCloseIM (xim);
2676 FRAME_XIC (f) = xic;
2678 #endif
2680 f->output_data.x->wm_hints.input = True;
2681 f->output_data.x->wm_hints.flags |= InputHint;
2682 XSetWMHints (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
2683 &f->output_data.x->wm_hints);
2685 hack_wm_protocols (f, shell_widget);
2687 #ifdef HACK_EDITRES
2688 XtAddEventHandler (shell_widget, 0, True, _XEditResCheckMessages, 0);
2689 #endif
2691 /* Do a stupid property change to force the server to generate a
2692 propertyNotify event so that the event_stream server timestamp will
2693 be initialized to something relevant to the time we created the window.
2695 XChangeProperty (XtDisplay (frame_widget), XtWindow (frame_widget),
2696 FRAME_X_DISPLAY_INFO (f)->Xatom_wm_protocols,
2697 XA_ATOM, 32, PropModeAppend,
2698 (unsigned char*) NULL, 0);
2700 /* Make all the standard events reach the Emacs frame. */
2701 attributes.event_mask = STANDARD_EVENT_SET;
2702 attribute_mask = CWEventMask;
2703 XChangeWindowAttributes (XtDisplay (shell_widget), XtWindow (shell_widget),
2704 attribute_mask, &attributes);
2706 XtMapWidget (frame_widget);
2708 /* x_set_name normally ignores requests to set the name if the
2709 requested name is the same as the current name. This is the one
2710 place where that assumption isn't correct; f->name is set, but
2711 the X server hasn't been told. */
2713 Lisp_Object name;
2714 int explicit = f->explicit_name;
2716 f->explicit_name = 0;
2717 name = f->name;
2718 f->name = Qnil;
2719 x_set_name (f, name, explicit);
2722 XDefineCursor (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
2723 f->output_data.x->text_cursor);
2725 UNBLOCK_INPUT;
2727 if (!minibuffer_only && FRAME_EXTERNAL_MENU_BAR (f))
2728 initialize_frame_menubar (f);
2729 lw_set_main_areas (pane_widget, f->output_data.x->menubar_widget, frame_widget);
2731 if (FRAME_X_WINDOW (f) == 0)
2732 error ("Unable to create window");
2735 #else /* not USE_X_TOOLKIT */
2737 /* Create and set up the X window for frame F. */
2739 x_window (f)
2740 struct frame *f;
2743 XClassHint class_hints;
2744 XSetWindowAttributes attributes;
2745 unsigned long attribute_mask;
2747 attributes.background_pixel = f->output_data.x->background_pixel;
2748 attributes.border_pixel = f->output_data.x->border_pixel;
2749 attributes.bit_gravity = StaticGravity;
2750 attributes.backing_store = NotUseful;
2751 attributes.save_under = True;
2752 attributes.event_mask = STANDARD_EVENT_SET;
2753 attribute_mask = (CWBackPixel | CWBorderPixel | CWBitGravity
2754 #if 0
2755 | CWBackingStore | CWSaveUnder
2756 #endif
2757 | CWEventMask);
2759 BLOCK_INPUT;
2760 FRAME_X_WINDOW (f)
2761 = XCreateWindow (FRAME_X_DISPLAY (f),
2762 f->output_data.x->parent_desc,
2763 f->output_data.x->left_pos,
2764 f->output_data.x->top_pos,
2765 PIXEL_WIDTH (f), PIXEL_HEIGHT (f),
2766 f->output_data.x->border_width,
2767 CopyFromParent, /* depth */
2768 InputOutput, /* class */
2769 FRAME_X_DISPLAY_INFO (f)->visual,
2770 attribute_mask, &attributes);
2771 #ifdef HAVE_X_I18N
2773 XIM xim;
2774 XIC xic = NULL;
2776 xim = XOpenIM (FRAME_X_DISPLAY(f), NULL, NULL, NULL);
2778 if (xim)
2780 xic = XCreateIC (xim,
2781 XNInputStyle, XIMPreeditNothing | XIMStatusNothing,
2782 XNClientWindow, FRAME_X_WINDOW(f),
2783 XNFocusWindow, FRAME_X_WINDOW(f),
2784 NULL);
2786 if (!xic)
2787 XCloseIM (xim);
2790 FRAME_XIC (f) = xic;
2792 #endif
2794 validate_x_resource_name ();
2796 class_hints.res_name = (char *) XSTRING (Vx_resource_name)->data;
2797 class_hints.res_class = EMACS_CLASS;
2798 XSetClassHint (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f), &class_hints);
2800 /* The menubar is part of the ordinary display;
2801 it does not count in addition to the height of the window. */
2802 f->output_data.x->menubar_height = 0;
2804 /* This indicates that we use the "Passive Input" input model.
2805 Unless we do this, we don't get the Focus{In,Out} events that we
2806 need to draw the cursor correctly. Accursed bureaucrats.
2807 XWhipsAndChains (FRAME_X_DISPLAY (f), IronMaiden, &TheRack); */
2809 f->output_data.x->wm_hints.input = True;
2810 f->output_data.x->wm_hints.flags |= InputHint;
2811 XSetWMHints (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
2812 &f->output_data.x->wm_hints);
2814 /* Request "save yourself" and "delete window" commands from wm. */
2816 Atom protocols[2];
2817 protocols[0] = FRAME_X_DISPLAY_INFO (f)->Xatom_wm_delete_window;
2818 protocols[1] = FRAME_X_DISPLAY_INFO (f)->Xatom_wm_save_yourself;
2819 XSetWMProtocols (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f), protocols, 2);
2822 /* x_set_name normally ignores requests to set the name if the
2823 requested name is the same as the current name. This is the one
2824 place where that assumption isn't correct; f->name is set, but
2825 the X server hasn't been told. */
2827 Lisp_Object name;
2828 int explicit = f->explicit_name;
2830 f->explicit_name = 0;
2831 name = f->name;
2832 f->name = Qnil;
2833 x_set_name (f, name, explicit);
2836 XDefineCursor (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
2837 f->output_data.x->text_cursor);
2839 UNBLOCK_INPUT;
2841 if (FRAME_X_WINDOW (f) == 0)
2842 error ("Unable to create window");
2845 #endif /* not USE_X_TOOLKIT */
2847 /* Handle the icon stuff for this window. Perhaps later we might
2848 want an x_set_icon_position which can be called interactively as
2849 well. */
2851 static void
2852 x_icon (f, parms)
2853 struct frame *f;
2854 Lisp_Object parms;
2856 Lisp_Object icon_x, icon_y;
2858 /* Set the position of the icon. Note that twm groups all
2859 icons in an icon window. */
2860 icon_x = x_get_arg (parms, Qicon_left, 0, 0, number);
2861 icon_y = x_get_arg (parms, Qicon_top, 0, 0, number);
2862 if (!EQ (icon_x, Qunbound) && !EQ (icon_y, Qunbound))
2864 CHECK_NUMBER (icon_x, 0);
2865 CHECK_NUMBER (icon_y, 0);
2867 else if (!EQ (icon_x, Qunbound) || !EQ (icon_y, Qunbound))
2868 error ("Both left and top icon corners of icon must be specified");
2870 BLOCK_INPUT;
2872 if (! EQ (icon_x, Qunbound))
2873 x_wm_set_icon_position (f, XINT (icon_x), XINT (icon_y));
2875 /* Start up iconic or window? */
2876 x_wm_set_window_state
2877 (f, (EQ (x_get_arg (parms, Qvisibility, 0, 0, symbol), Qicon)
2878 ? IconicState
2879 : NormalState));
2881 x_text_icon (f, (char *) XSTRING ((!NILP (f->icon_name)
2882 ? f->icon_name
2883 : f->name))->data);
2885 UNBLOCK_INPUT;
2888 /* Make the GC's needed for this window, setting the
2889 background, border and mouse colors; also create the
2890 mouse cursor and the gray border tile. */
2892 static char cursor_bits[] =
2894 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
2895 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
2896 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
2897 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00
2900 static void
2901 x_make_gc (f)
2902 struct frame *f;
2904 XGCValues gc_values;
2905 GC temp_gc;
2906 XImage tileimage;
2908 BLOCK_INPUT;
2910 /* Create the GC's of this frame.
2911 Note that many default values are used. */
2913 /* Normal video */
2914 gc_values.font = f->output_data.x->font->fid;
2915 gc_values.foreground = f->output_data.x->foreground_pixel;
2916 gc_values.background = f->output_data.x->background_pixel;
2917 gc_values.line_width = 0; /* Means 1 using fast algorithm. */
2918 f->output_data.x->normal_gc = XCreateGC (FRAME_X_DISPLAY (f),
2919 FRAME_X_WINDOW (f),
2920 GCLineWidth | GCFont
2921 | GCForeground | GCBackground,
2922 &gc_values);
2924 /* Reverse video style. */
2925 gc_values.foreground = f->output_data.x->background_pixel;
2926 gc_values.background = f->output_data.x->foreground_pixel;
2927 f->output_data.x->reverse_gc = XCreateGC (FRAME_X_DISPLAY (f),
2928 FRAME_X_WINDOW (f),
2929 GCFont | GCForeground | GCBackground
2930 | GCLineWidth,
2931 &gc_values);
2933 /* Cursor has cursor-color background, background-color foreground. */
2934 gc_values.foreground = f->output_data.x->background_pixel;
2935 gc_values.background = f->output_data.x->cursor_pixel;
2936 gc_values.fill_style = FillOpaqueStippled;
2937 gc_values.stipple
2938 = XCreateBitmapFromData (FRAME_X_DISPLAY (f),
2939 FRAME_X_DISPLAY_INFO (f)->root_window,
2940 cursor_bits, 16, 16);
2941 f->output_data.x->cursor_gc
2942 = XCreateGC (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
2943 (GCFont | GCForeground | GCBackground
2944 | GCFillStyle | GCStipple | GCLineWidth),
2945 &gc_values);
2947 /* Create the gray border tile used when the pointer is not in
2948 the frame. Since this depends on the frame's pixel values,
2949 this must be done on a per-frame basis. */
2950 f->output_data.x->border_tile
2951 = (XCreatePixmapFromBitmapData
2952 (FRAME_X_DISPLAY (f), FRAME_X_DISPLAY_INFO (f)->root_window,
2953 gray_bits, gray_width, gray_height,
2954 f->output_data.x->foreground_pixel,
2955 f->output_data.x->background_pixel,
2956 DefaultDepth (FRAME_X_DISPLAY (f),
2957 XScreenNumberOfScreen (FRAME_X_SCREEN (f)))));
2959 UNBLOCK_INPUT;
2962 DEFUN ("x-create-frame", Fx_create_frame, Sx_create_frame,
2963 1, 1, 0,
2964 "Make a new X window, which is called a \"frame\" in Emacs terms.\n\
2965 Returns an Emacs frame object.\n\
2966 ALIST is an alist of frame parameters.\n\
2967 If the parameters specify that the frame should not have a minibuffer,\n\
2968 and do not specify a specific minibuffer window to use,\n\
2969 then `default-minibuffer-frame' must be a frame whose minibuffer can\n\
2970 be shared by the new frame.\n\
2972 This function is an internal primitive--use `make-frame' instead.")
2973 (parms)
2974 Lisp_Object parms;
2976 struct frame *f;
2977 Lisp_Object frame, tem;
2978 Lisp_Object name;
2979 int minibuffer_only = 0;
2980 long window_prompting = 0;
2981 int width, height;
2982 int count = specpdl_ptr - specpdl;
2983 struct gcpro gcpro1;
2984 Lisp_Object display;
2985 struct x_display_info *dpyinfo;
2986 Lisp_Object parent;
2987 struct kboard *kb;
2989 check_x ();
2991 /* Use this general default value to start with
2992 until we know if this frame has a specified name. */
2993 Vx_resource_name = Vinvocation_name;
2995 display = x_get_arg (parms, Qdisplay, 0, 0, string);
2996 if (EQ (display, Qunbound))
2997 display = Qnil;
2998 dpyinfo = check_x_display_info (display);
2999 #ifdef MULTI_KBOARD
3000 kb = dpyinfo->kboard;
3001 #else
3002 kb = &the_only_kboard;
3003 #endif
3005 name = x_get_arg (parms, Qname, "name", "Name", string);
3006 if (!STRINGP (name)
3007 && ! EQ (name, Qunbound)
3008 && ! NILP (name))
3009 error ("Invalid frame name--not a string or nil");
3011 if (STRINGP (name))
3012 Vx_resource_name = name;
3014 /* See if parent window is specified. */
3015 parent = x_get_arg (parms, Qparent_id, NULL, NULL, number);
3016 if (EQ (parent, Qunbound))
3017 parent = Qnil;
3018 if (! NILP (parent))
3019 CHECK_NUMBER (parent, 0);
3021 tem = x_get_arg (parms, Qminibuffer, 0, 0, symbol);
3022 if (EQ (tem, Qnone) || NILP (tem))
3023 f = make_frame_without_minibuffer (Qnil, kb, display);
3024 else if (EQ (tem, Qonly))
3026 f = make_minibuffer_frame ();
3027 minibuffer_only = 1;
3029 else if (WINDOWP (tem))
3030 f = make_frame_without_minibuffer (tem, kb, display);
3031 else
3032 f = make_frame (1);
3034 /* Note that X Windows does support scroll bars. */
3035 FRAME_CAN_HAVE_SCROLL_BARS (f) = 1;
3037 XSETFRAME (frame, f);
3038 GCPRO1 (frame);
3040 f->output_method = output_x_window;
3041 f->output_data.x = (struct x_output *) xmalloc (sizeof (struct x_output));
3042 bzero (f->output_data.x, sizeof (struct x_output));
3043 f->output_data.x->icon_bitmap = -1;
3045 f->icon_name
3046 = x_get_arg (parms, Qicon_name, "iconName", "Title", string);
3047 if (! STRINGP (f->icon_name))
3048 f->icon_name = Qnil;
3050 FRAME_X_DISPLAY_INFO (f) = dpyinfo;
3051 #ifdef MULTI_KBOARD
3052 FRAME_KBOARD (f) = kb;
3053 #endif
3055 /* Specify the parent under which to make this X window. */
3057 if (!NILP (parent))
3059 f->output_data.x->parent_desc = parent;
3060 f->output_data.x->explicit_parent = 1;
3062 else
3064 f->output_data.x->parent_desc = FRAME_X_DISPLAY_INFO (f)->root_window;
3065 f->output_data.x->explicit_parent = 0;
3068 /* Note that the frame has no physical cursor right now. */
3069 f->phys_cursor_x = -1;
3071 /* Set the name; the functions to which we pass f expect the name to
3072 be set. */
3073 if (EQ (name, Qunbound) || NILP (name))
3075 f->name = build_string (dpyinfo->x_id_name);
3076 f->explicit_name = 0;
3078 else
3080 f->name = name;
3081 f->explicit_name = 1;
3082 /* use the frame's title when getting resources for this frame. */
3083 specbind (Qx_resource_name, name);
3086 /* Extract the window parameters from the supplied values
3087 that are needed to determine window geometry. */
3089 Lisp_Object font;
3091 font = x_get_arg (parms, Qfont, "font", "Font", string);
3092 BLOCK_INPUT;
3093 /* First, try whatever font the caller has specified. */
3094 if (STRINGP (font))
3095 font = x_new_font (f, XSTRING (font)->data);
3096 /* Try out a font which we hope has bold and italic variations. */
3097 if (!STRINGP (font))
3098 font = x_new_font (f, "-misc-fixed-medium-r-normal-*-*-140-*-*-c-*-iso8859-1");
3099 if (! STRINGP (font))
3100 font = x_new_font (f, "-*-*-medium-r-normal-*-*-140-*-*-c-*-iso8859-1");
3101 if (! STRINGP (font))
3102 /* This was formerly the first thing tried, but it finds too many fonts
3103 and takes too long. */
3104 font = x_new_font (f, "-*-*-medium-r-*-*-*-*-*-*-c-*-iso8859-1");
3105 /* If those didn't work, look for something which will at least work. */
3106 if (! STRINGP (font))
3107 font = x_new_font (f, "-*-fixed-*-*-*-*-*-140-*-*-c-*-iso8859-1");
3108 UNBLOCK_INPUT;
3109 if (! STRINGP (font))
3110 font = build_string ("fixed");
3112 x_default_parameter (f, parms, Qfont, font,
3113 "font", "Font", string);
3116 #ifdef USE_X_TOOLKIT
3117 /* Prevent lwlib/xlwmenu.c from crashing because of a bug
3118 whereby it fails to get any font. */
3119 xlwmenu_default_font = f->output_data.x->font;
3120 #endif
3122 x_default_parameter (f, parms, Qborder_width, make_number (2),
3123 "borderwidth", "BorderWidth", number);
3124 /* This defaults to 2 in order to match xterm. We recognize either
3125 internalBorderWidth or internalBorder (which is what xterm calls
3126 it). */
3127 if (NILP (Fassq (Qinternal_border_width, parms)))
3129 Lisp_Object value;
3131 value = x_get_arg (parms, Qinternal_border_width,
3132 "internalBorder", "BorderWidth", number);
3133 if (! EQ (value, Qunbound))
3134 parms = Fcons (Fcons (Qinternal_border_width, value),
3135 parms);
3137 x_default_parameter (f, parms, Qinternal_border_width, make_number (2),
3138 "internalBorderWidth", "BorderWidth", number);
3139 x_default_parameter (f, parms, Qvertical_scroll_bars, Qt,
3140 "verticalScrollBars", "ScrollBars", boolean);
3142 /* Also do the stuff which must be set before the window exists. */
3143 x_default_parameter (f, parms, Qforeground_color, build_string ("black"),
3144 "foreground", "Foreground", string);
3145 x_default_parameter (f, parms, Qbackground_color, build_string ("white"),
3146 "background", "Background", string);
3147 x_default_parameter (f, parms, Qmouse_color, build_string ("black"),
3148 "pointerColor", "Foreground", string);
3149 x_default_parameter (f, parms, Qcursor_color, build_string ("black"),
3150 "cursorColor", "Foreground", string);
3151 x_default_parameter (f, parms, Qborder_color, build_string ("black"),
3152 "borderColor", "BorderColor", string);
3154 x_default_parameter (f, parms, Qmenu_bar_lines, make_number (1),
3155 "menuBar", "MenuBar", number);
3156 x_default_parameter (f, parms, Qscroll_bar_width, Qnil,
3157 "scrollBarWidth", "ScrollBarWidth", number);
3158 x_default_parameter (f, parms, Qbuffer_predicate, Qnil,
3159 "bufferPredicate", "BufferPredicate", symbol);
3160 x_default_parameter (f, parms, Qtitle, Qnil,
3161 "title", "Title", string);
3163 f->output_data.x->parent_desc = FRAME_X_DISPLAY_INFO (f)->root_window;
3164 window_prompting = x_figure_window_size (f, parms);
3166 if (window_prompting & XNegative)
3168 if (window_prompting & YNegative)
3169 f->output_data.x->win_gravity = SouthEastGravity;
3170 else
3171 f->output_data.x->win_gravity = NorthEastGravity;
3173 else
3175 if (window_prompting & YNegative)
3176 f->output_data.x->win_gravity = SouthWestGravity;
3177 else
3178 f->output_data.x->win_gravity = NorthWestGravity;
3181 f->output_data.x->size_hint_flags = window_prompting;
3183 #ifdef USE_X_TOOLKIT
3184 x_window (f, window_prompting, minibuffer_only);
3185 #else
3186 x_window (f);
3187 #endif
3188 x_icon (f, parms);
3189 x_make_gc (f);
3190 init_frame_faces (f);
3192 /* We need to do this after creating the X window, so that the
3193 icon-creation functions can say whose icon they're describing. */
3194 x_default_parameter (f, parms, Qicon_type, Qnil,
3195 "bitmapIcon", "BitmapIcon", symbol);
3197 x_default_parameter (f, parms, Qauto_raise, Qnil,
3198 "autoRaise", "AutoRaiseLower", boolean);
3199 x_default_parameter (f, parms, Qauto_lower, Qnil,
3200 "autoLower", "AutoRaiseLower", boolean);
3201 x_default_parameter (f, parms, Qcursor_type, Qbox,
3202 "cursorType", "CursorType", symbol);
3204 /* Dimensions, especially f->height, must be done via change_frame_size.
3205 Change will not be effected unless different from the current
3206 f->height. */
3207 width = f->width;
3208 height = f->height;
3209 f->height = f->width = 0;
3210 change_frame_size (f, height, width, 1, 0);
3212 /* Tell the server what size and position, etc, we want,
3213 and how badly we want them. */
3214 BLOCK_INPUT;
3215 x_wm_set_size_hint (f, window_prompting, 0);
3216 UNBLOCK_INPUT;
3218 tem = x_get_arg (parms, Qunsplittable, 0, 0, boolean);
3219 f->no_split = minibuffer_only || EQ (tem, Qt);
3221 UNGCPRO;
3223 /* It is now ok to make the frame official
3224 even if we get an error below.
3225 And the frame needs to be on Vframe_list
3226 or making it visible won't work. */
3227 Vframe_list = Fcons (frame, Vframe_list);
3229 /* Now that the frame is official, it counts as a reference to
3230 its display. */
3231 FRAME_X_DISPLAY_INFO (f)->reference_count++;
3233 /* Make the window appear on the frame and enable display,
3234 unless the caller says not to. However, with explicit parent,
3235 Emacs cannot control visibility, so don't try. */
3236 if (! f->output_data.x->explicit_parent)
3238 Lisp_Object visibility;
3240 visibility = x_get_arg (parms, Qvisibility, 0, 0, symbol);
3241 if (EQ (visibility, Qunbound))
3242 visibility = Qt;
3244 if (EQ (visibility, Qicon))
3245 x_iconify_frame (f);
3246 else if (! NILP (visibility))
3247 x_make_frame_visible (f);
3248 else
3249 /* Must have been Qnil. */
3253 return unbind_to (count, frame);
3256 /* FRAME is used only to get a handle on the X display. We don't pass the
3257 display info directly because we're called from frame.c, which doesn't
3258 know about that structure. */
3259 Lisp_Object
3260 x_get_focus_frame (frame)
3261 struct frame *frame;
3263 struct x_display_info *dpyinfo = FRAME_X_DISPLAY_INFO (frame);
3264 Lisp_Object xfocus;
3265 if (! dpyinfo->x_focus_frame)
3266 return Qnil;
3268 XSETFRAME (xfocus, dpyinfo->x_focus_frame);
3269 return xfocus;
3272 DEFUN ("focus-frame", Ffocus_frame, Sfocus_frame, 1, 1, 0,
3273 "This function is obsolete, and does nothing.")
3274 (frame)
3275 Lisp_Object frame;
3277 return Qnil;
3280 DEFUN ("unfocus-frame", Funfocus_frame, Sunfocus_frame, 0, 0, 0,
3281 "This function is obsolete, and does nothing.")
3284 return Qnil;
3287 DEFUN ("x-list-fonts", Fx_list_fonts, Sx_list_fonts, 1, 3, 0,
3288 "Return a list of the names of available fonts matching PATTERN.\n\
3289 If optional arguments FACE and FRAME are specified, return only fonts\n\
3290 the same size as FACE on FRAME.\n\
3292 PATTERN is a string, perhaps with wildcard characters;\n\
3293 the * character matches any substring, and\n\
3294 the ? character matches any single character.\n\
3295 PATTERN is case-insensitive.\n\
3296 FACE is a face name--a symbol.\n\
3298 The return value is a list of strings, suitable as arguments to\n\
3299 set-face-font.\n\
3301 Fonts Emacs can't use (i.e. proportional fonts) may or may not be excluded\n\
3302 even if they match PATTERN and FACE.")
3303 (pattern, face, frame)
3304 Lisp_Object pattern, face, frame;
3306 int num_fonts;
3307 char **names;
3308 #ifndef BROKEN_XLISTFONTSWITHINFO
3309 XFontStruct *info;
3310 #endif
3311 XFontStruct *size_ref;
3312 Lisp_Object list;
3313 FRAME_PTR f;
3315 check_x ();
3316 CHECK_STRING (pattern, 0);
3317 if (!NILP (face))
3318 CHECK_SYMBOL (face, 1);
3320 f = check_x_frame (frame);
3322 /* Determine the width standard for comparison with the fonts we find. */
3324 if (NILP (face))
3325 size_ref = 0;
3326 else
3328 int face_id;
3330 /* Don't die if we get called with a terminal frame. */
3331 if (! FRAME_X_P (f))
3332 error ("Non-X frame used in `x-list-fonts'");
3334 face_id = face_name_id_number (f, face);
3336 if (face_id < 0 || face_id >= FRAME_N_PARAM_FACES (f)
3337 || FRAME_PARAM_FACES (f) [face_id] == 0)
3338 size_ref = f->output_data.x->font;
3339 else
3341 size_ref = FRAME_PARAM_FACES (f) [face_id]->font;
3342 if (size_ref == (XFontStruct *) (~0))
3343 size_ref = f->output_data.x->font;
3347 /* See if we cached the result for this particular query. */
3348 list = Fassoc (pattern,
3349 XCONS (FRAME_X_DISPLAY_INFO (f)->name_list_element)->cdr);
3351 /* We have info in the cache for this PATTERN. */
3352 if (!NILP (list))
3354 Lisp_Object tem, newlist;
3356 /* We have info about this pattern. */
3357 list = XCONS (list)->cdr;
3359 if (size_ref == 0)
3360 return list;
3362 BLOCK_INPUT;
3364 /* Filter the cached info and return just the fonts that match FACE. */
3365 newlist = Qnil;
3366 for (tem = list; CONSP (tem); tem = XCONS (tem)->cdr)
3368 XFontStruct *thisinfo;
3370 thisinfo = XLoadQueryFont (FRAME_X_DISPLAY (f),
3371 XSTRING (XCONS (tem)->car)->data);
3373 if (thisinfo && same_size_fonts (thisinfo, size_ref))
3374 newlist = Fcons (XCONS (tem)->car, newlist);
3376 if (thisinfo != 0)
3377 XFreeFont (FRAME_X_DISPLAY (f), thisinfo);
3380 UNBLOCK_INPUT;
3382 return newlist;
3385 BLOCK_INPUT;
3387 /* Solaris 2.3 has a bug in XListFontsWithInfo. */
3388 #ifndef BROKEN_XLISTFONTSWITHINFO
3389 if (size_ref)
3390 names = XListFontsWithInfo (FRAME_X_DISPLAY (f),
3391 XSTRING (pattern)->data,
3392 2000, /* maxnames */
3393 &num_fonts, /* count_return */
3394 &info); /* info_return */
3395 else
3396 #endif
3397 names = XListFonts (FRAME_X_DISPLAY (f),
3398 XSTRING (pattern)->data,
3399 2000, /* maxnames */
3400 &num_fonts); /* count_return */
3402 UNBLOCK_INPUT;
3404 list = Qnil;
3406 if (names)
3408 int i;
3409 Lisp_Object full_list;
3411 /* Make a list of all the fonts we got back.
3412 Store that in the font cache for the display. */
3413 full_list = Qnil;
3414 for (i = 0; i < num_fonts; i++)
3415 full_list = Fcons (build_string (names[i]), full_list);
3416 XCONS (FRAME_X_DISPLAY_INFO (f)->name_list_element)->cdr
3417 = Fcons (Fcons (pattern, full_list),
3418 XCONS (FRAME_X_DISPLAY_INFO (f)->name_list_element)->cdr);
3420 /* Make a list of the fonts that have the right width. */
3421 list = Qnil;
3422 for (i = 0; i < num_fonts; i++)
3424 int keeper;
3426 if (!size_ref)
3427 keeper = 1;
3428 else
3430 #ifdef BROKEN_XLISTFONTSWITHINFO
3431 XFontStruct *thisinfo;
3433 BLOCK_INPUT;
3434 thisinfo = XLoadQueryFont (FRAME_X_DISPLAY (f), names[i]);
3435 UNBLOCK_INPUT;
3437 keeper = thisinfo && same_size_fonts (thisinfo, size_ref);
3438 #else
3439 keeper = same_size_fonts (&info[i], size_ref);
3440 #endif
3442 if (keeper)
3443 list = Fcons (build_string (names[i]), list);
3445 list = Fnreverse (list);
3447 BLOCK_INPUT;
3448 #ifndef BROKEN_XLISTFONTSWITHINFO
3449 if (size_ref)
3450 XFreeFontInfo (names, info, num_fonts);
3451 else
3452 #endif
3453 XFreeFontNames (names);
3454 UNBLOCK_INPUT;
3457 return list;
3461 DEFUN ("x-color-defined-p", Fx_color_defined_p, Sx_color_defined_p, 1, 2, 0,
3462 "Return non-nil if color COLOR is supported on frame FRAME.\n\
3463 If FRAME is omitted or nil, use the selected frame.")
3464 (color, frame)
3465 Lisp_Object color, frame;
3467 XColor foo;
3468 FRAME_PTR f = check_x_frame (frame);
3470 CHECK_STRING (color, 1);
3472 if (defined_color (f, XSTRING (color)->data, &foo, 0))
3473 return Qt;
3474 else
3475 return Qnil;
3478 DEFUN ("x-color-values", Fx_color_values, Sx_color_values, 1, 2, 0,
3479 "Return a description of the color named COLOR on frame FRAME.\n\
3480 The value is a list of integer RGB values--(RED GREEN BLUE).\n\
3481 These values appear to range from 0 to 65280 or 65535, depending\n\
3482 on the system; white is (65280 65280 65280) or (65535 65535 65535).\n\
3483 If FRAME is omitted or nil, use the selected frame.")
3484 (color, frame)
3485 Lisp_Object color, frame;
3487 XColor foo;
3488 FRAME_PTR f = check_x_frame (frame);
3490 CHECK_STRING (color, 1);
3492 if (defined_color (f, XSTRING (color)->data, &foo, 0))
3494 Lisp_Object rgb[3];
3496 rgb[0] = make_number (foo.red);
3497 rgb[1] = make_number (foo.green);
3498 rgb[2] = make_number (foo.blue);
3499 return Flist (3, rgb);
3501 else
3502 return Qnil;
3505 DEFUN ("x-display-color-p", Fx_display_color_p, Sx_display_color_p, 0, 1, 0,
3506 "Return t if the X display supports color.\n\
3507 The optional argument DISPLAY specifies which display to ask about.\n\
3508 DISPLAY should be either a frame or a display name (a string).\n\
3509 If omitted or nil, that stands for the selected frame's display.")
3510 (display)
3511 Lisp_Object display;
3513 struct x_display_info *dpyinfo = check_x_display_info (display);
3515 if (dpyinfo->n_planes <= 2)
3516 return Qnil;
3518 switch (dpyinfo->visual->class)
3520 case StaticColor:
3521 case PseudoColor:
3522 case TrueColor:
3523 case DirectColor:
3524 return Qt;
3526 default:
3527 return Qnil;
3531 DEFUN ("x-display-grayscale-p", Fx_display_grayscale_p, Sx_display_grayscale_p,
3532 0, 1, 0,
3533 "Return t if the X display supports shades of gray.\n\
3534 Note that color displays do support shades of gray.\n\
3535 The optional argument DISPLAY specifies which display to ask about.\n\
3536 DISPLAY should be either a frame or a display name (a string).\n\
3537 If omitted or nil, that stands for the selected frame's display.")
3538 (display)
3539 Lisp_Object display;
3541 struct x_display_info *dpyinfo = check_x_display_info (display);
3543 if (dpyinfo->n_planes <= 1)
3544 return Qnil;
3546 switch (dpyinfo->visual->class)
3548 case StaticColor:
3549 case PseudoColor:
3550 case TrueColor:
3551 case DirectColor:
3552 case StaticGray:
3553 case GrayScale:
3554 return Qt;
3556 default:
3557 return Qnil;
3561 DEFUN ("x-display-pixel-width", Fx_display_pixel_width, Sx_display_pixel_width,
3562 0, 1, 0,
3563 "Returns the width in pixels of the X display DISPLAY.\n\
3564 The optional argument DISPLAY specifies which display to ask about.\n\
3565 DISPLAY should be either a frame or a display name (a string).\n\
3566 If omitted or nil, that stands for the selected frame's display.")
3567 (display)
3568 Lisp_Object display;
3570 struct x_display_info *dpyinfo = check_x_display_info (display);
3572 return make_number (dpyinfo->width);
3575 DEFUN ("x-display-pixel-height", Fx_display_pixel_height,
3576 Sx_display_pixel_height, 0, 1, 0,
3577 "Returns the height in pixels of the X display DISPLAY.\n\
3578 The optional argument DISPLAY specifies which display to ask about.\n\
3579 DISPLAY should be either a frame or a display name (a string).\n\
3580 If omitted or nil, that stands for the selected frame's display.")
3581 (display)
3582 Lisp_Object display;
3584 struct x_display_info *dpyinfo = check_x_display_info (display);
3586 return make_number (dpyinfo->height);
3589 DEFUN ("x-display-planes", Fx_display_planes, Sx_display_planes,
3590 0, 1, 0,
3591 "Returns the number of bitplanes of the X display DISPLAY.\n\
3592 The optional argument DISPLAY specifies which display to ask about.\n\
3593 DISPLAY should be either a frame or a display name (a string).\n\
3594 If omitted or nil, that stands for the selected frame's display.")
3595 (display)
3596 Lisp_Object display;
3598 struct x_display_info *dpyinfo = check_x_display_info (display);
3600 return make_number (dpyinfo->n_planes);
3603 DEFUN ("x-display-color-cells", Fx_display_color_cells, Sx_display_color_cells,
3604 0, 1, 0,
3605 "Returns the number of color cells of the X display DISPLAY.\n\
3606 The optional argument DISPLAY specifies which display to ask about.\n\
3607 DISPLAY should be either a frame or a display name (a string).\n\
3608 If omitted or nil, that stands for the selected frame's display.")
3609 (display)
3610 Lisp_Object display;
3612 struct x_display_info *dpyinfo = check_x_display_info (display);
3614 return make_number (DisplayCells (dpyinfo->display,
3615 XScreenNumberOfScreen (dpyinfo->screen)));
3618 DEFUN ("x-server-max-request-size", Fx_server_max_request_size,
3619 Sx_server_max_request_size,
3620 0, 1, 0,
3621 "Returns the maximum request size of the X server of display DISPLAY.\n\
3622 The optional argument DISPLAY specifies which display to ask about.\n\
3623 DISPLAY should be either a frame or a display name (a string).\n\
3624 If omitted or nil, that stands for the selected frame's display.")
3625 (display)
3626 Lisp_Object display;
3628 struct x_display_info *dpyinfo = check_x_display_info (display);
3630 return make_number (MAXREQUEST (dpyinfo->display));
3633 DEFUN ("x-server-vendor", Fx_server_vendor, Sx_server_vendor, 0, 1, 0,
3634 "Returns the vendor ID string of the X server of display DISPLAY.\n\
3635 The optional argument DISPLAY specifies which display to ask about.\n\
3636 DISPLAY should be either a frame or a display name (a string).\n\
3637 If omitted or nil, that stands for the selected frame's display.")
3638 (display)
3639 Lisp_Object display;
3641 struct x_display_info *dpyinfo = check_x_display_info (display);
3642 char *vendor = ServerVendor (dpyinfo->display);
3644 if (! vendor) vendor = "";
3645 return build_string (vendor);
3648 DEFUN ("x-server-version", Fx_server_version, Sx_server_version, 0, 1, 0,
3649 "Returns the version numbers of the X server of display DISPLAY.\n\
3650 The value is a list of three integers: the major and minor\n\
3651 version numbers of the X Protocol in use, and the vendor-specific release\n\
3652 number. See also the function `x-server-vendor'.\n\n\
3653 The optional argument DISPLAY specifies which display to ask about.\n\
3654 DISPLAY should be either a frame or a display name (a string).\n\
3655 If omitted or nil, that stands for the selected frame's display.")
3656 (display)
3657 Lisp_Object display;
3659 struct x_display_info *dpyinfo = check_x_display_info (display);
3660 Display *dpy = dpyinfo->display;
3662 return Fcons (make_number (ProtocolVersion (dpy)),
3663 Fcons (make_number (ProtocolRevision (dpy)),
3664 Fcons (make_number (VendorRelease (dpy)), Qnil)));
3667 DEFUN ("x-display-screens", Fx_display_screens, Sx_display_screens, 0, 1, 0,
3668 "Returns the number of screens on the X server of display DISPLAY.\n\
3669 The optional argument DISPLAY specifies which display to ask about.\n\
3670 DISPLAY should be either a frame or a display name (a string).\n\
3671 If omitted or nil, that stands for the selected frame's display.")
3672 (display)
3673 Lisp_Object display;
3675 struct x_display_info *dpyinfo = check_x_display_info (display);
3677 return make_number (ScreenCount (dpyinfo->display));
3680 DEFUN ("x-display-mm-height", Fx_display_mm_height, Sx_display_mm_height, 0, 1, 0,
3681 "Returns the height in millimeters of the X display DISPLAY.\n\
3682 The optional argument DISPLAY specifies which display to ask about.\n\
3683 DISPLAY should be either a frame or a display name (a string).\n\
3684 If omitted or nil, that stands for the selected frame's display.")
3685 (display)
3686 Lisp_Object display;
3688 struct x_display_info *dpyinfo = check_x_display_info (display);
3690 return make_number (HeightMMOfScreen (dpyinfo->screen));
3693 DEFUN ("x-display-mm-width", Fx_display_mm_width, Sx_display_mm_width, 0, 1, 0,
3694 "Returns the width in millimeters of the X display DISPLAY.\n\
3695 The optional argument DISPLAY specifies which display to ask about.\n\
3696 DISPLAY should be either a frame or a display name (a string).\n\
3697 If omitted or nil, that stands for the selected frame's display.")
3698 (display)
3699 Lisp_Object display;
3701 struct x_display_info *dpyinfo = check_x_display_info (display);
3703 return make_number (WidthMMOfScreen (dpyinfo->screen));
3706 DEFUN ("x-display-backing-store", Fx_display_backing_store,
3707 Sx_display_backing_store, 0, 1, 0,
3708 "Returns an indication of whether X display DISPLAY does backing store.\n\
3709 The value may be `always', `when-mapped', or `not-useful'.\n\
3710 The optional argument DISPLAY specifies which display to ask about.\n\
3711 DISPLAY should be either a frame or a display name (a string).\n\
3712 If omitted or nil, that stands for the selected frame's display.")
3713 (display)
3714 Lisp_Object display;
3716 struct x_display_info *dpyinfo = check_x_display_info (display);
3718 switch (DoesBackingStore (dpyinfo->screen))
3720 case Always:
3721 return intern ("always");
3723 case WhenMapped:
3724 return intern ("when-mapped");
3726 case NotUseful:
3727 return intern ("not-useful");
3729 default:
3730 error ("Strange value for BackingStore parameter of screen");
3734 DEFUN ("x-display-visual-class", Fx_display_visual_class,
3735 Sx_display_visual_class, 0, 1, 0,
3736 "Returns the visual class of the X display DISPLAY.\n\
3737 The value is one of the symbols `static-gray', `gray-scale',\n\
3738 `static-color', `pseudo-color', `true-color', or `direct-color'.\n\n\
3739 The optional argument DISPLAY specifies which display to ask about.\n\
3740 DISPLAY should be either a frame or a display name (a string).\n\
3741 If omitted or nil, that stands for the selected frame's display.")
3742 (display)
3743 Lisp_Object display;
3745 struct x_display_info *dpyinfo = check_x_display_info (display);
3747 switch (dpyinfo->visual->class)
3749 case StaticGray: return (intern ("static-gray"));
3750 case GrayScale: return (intern ("gray-scale"));
3751 case StaticColor: return (intern ("static-color"));
3752 case PseudoColor: return (intern ("pseudo-color"));
3753 case TrueColor: return (intern ("true-color"));
3754 case DirectColor: return (intern ("direct-color"));
3755 default:
3756 error ("Display has an unknown visual class");
3760 DEFUN ("x-display-save-under", Fx_display_save_under,
3761 Sx_display_save_under, 0, 1, 0,
3762 "Returns t if the X display DISPLAY supports the save-under feature.\n\
3763 The optional argument DISPLAY specifies which display to ask about.\n\
3764 DISPLAY should be either a frame or a display name (a string).\n\
3765 If omitted or nil, that stands for the selected frame's display.")
3766 (display)
3767 Lisp_Object display;
3769 struct x_display_info *dpyinfo = check_x_display_info (display);
3771 if (DoesSaveUnders (dpyinfo->screen) == True)
3772 return Qt;
3773 else
3774 return Qnil;
3778 x_pixel_width (f)
3779 register struct frame *f;
3781 return PIXEL_WIDTH (f);
3785 x_pixel_height (f)
3786 register struct frame *f;
3788 return PIXEL_HEIGHT (f);
3792 x_char_width (f)
3793 register struct frame *f;
3795 return FONT_WIDTH (f->output_data.x->font);
3799 x_char_height (f)
3800 register struct frame *f;
3802 return f->output_data.x->line_height;
3806 x_screen_planes (frame)
3807 Lisp_Object frame;
3809 return FRAME_X_DISPLAY_INFO (XFRAME (frame))->n_planes;
3812 #if 0 /* These no longer seem like the right way to do things. */
3814 /* Draw a rectangle on the frame with left top corner including
3815 the character specified by LEFT_CHAR and TOP_CHAR. The rectangle is
3816 CHARS by LINES wide and long and is the color of the cursor. */
3818 void
3819 x_rectangle (f, gc, left_char, top_char, chars, lines)
3820 register struct frame *f;
3821 GC gc;
3822 register int top_char, left_char, chars, lines;
3824 int width;
3825 int height;
3826 int left = (left_char * FONT_WIDTH (f->output_data.x->font)
3827 + f->output_data.x->internal_border_width);
3828 int top = (top_char * f->output_data.x->line_height
3829 + f->output_data.x->internal_border_width);
3831 if (chars < 0)
3832 width = FONT_WIDTH (f->output_data.x->font) / 2;
3833 else
3834 width = FONT_WIDTH (f->output_data.x->font) * chars;
3835 if (lines < 0)
3836 height = f->output_data.x->line_height / 2;
3837 else
3838 height = f->output_data.x->line_height * lines;
3840 XDrawRectangle (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
3841 gc, left, top, width, height);
3844 DEFUN ("x-draw-rectangle", Fx_draw_rectangle, Sx_draw_rectangle, 5, 5, 0,
3845 "Draw a rectangle on FRAME between coordinates specified by\n\
3846 numbers X0, Y0, X1, Y1 in the cursor pixel.")
3847 (frame, X0, Y0, X1, Y1)
3848 register Lisp_Object frame, X0, X1, Y0, Y1;
3850 register int x0, y0, x1, y1, top, left, n_chars, n_lines;
3852 CHECK_LIVE_FRAME (frame, 0);
3853 CHECK_NUMBER (X0, 0);
3854 CHECK_NUMBER (Y0, 1);
3855 CHECK_NUMBER (X1, 2);
3856 CHECK_NUMBER (Y1, 3);
3858 x0 = XINT (X0);
3859 x1 = XINT (X1);
3860 y0 = XINT (Y0);
3861 y1 = XINT (Y1);
3863 if (y1 > y0)
3865 top = y0;
3866 n_lines = y1 - y0 + 1;
3868 else
3870 top = y1;
3871 n_lines = y0 - y1 + 1;
3874 if (x1 > x0)
3876 left = x0;
3877 n_chars = x1 - x0 + 1;
3879 else
3881 left = x1;
3882 n_chars = x0 - x1 + 1;
3885 BLOCK_INPUT;
3886 x_rectangle (XFRAME (frame), XFRAME (frame)->output_data.x->cursor_gc,
3887 left, top, n_chars, n_lines);
3888 UNBLOCK_INPUT;
3890 return Qt;
3893 DEFUN ("x-erase-rectangle", Fx_erase_rectangle, Sx_erase_rectangle, 5, 5, 0,
3894 "Draw a rectangle drawn on FRAME between coordinates\n\
3895 X0, Y0, X1, Y1 in the regular background-pixel.")
3896 (frame, X0, Y0, X1, Y1)
3897 register Lisp_Object frame, X0, Y0, X1, Y1;
3899 register int x0, y0, x1, y1, top, left, n_chars, n_lines;
3901 CHECK_LIVE_FRAME (frame, 0);
3902 CHECK_NUMBER (X0, 0);
3903 CHECK_NUMBER (Y0, 1);
3904 CHECK_NUMBER (X1, 2);
3905 CHECK_NUMBER (Y1, 3);
3907 x0 = XINT (X0);
3908 x1 = XINT (X1);
3909 y0 = XINT (Y0);
3910 y1 = XINT (Y1);
3912 if (y1 > y0)
3914 top = y0;
3915 n_lines = y1 - y0 + 1;
3917 else
3919 top = y1;
3920 n_lines = y0 - y1 + 1;
3923 if (x1 > x0)
3925 left = x0;
3926 n_chars = x1 - x0 + 1;
3928 else
3930 left = x1;
3931 n_chars = x0 - x1 + 1;
3934 BLOCK_INPUT;
3935 x_rectangle (XFRAME (frame), XFRAME (frame)->output_data.x->reverse_gc,
3936 left, top, n_chars, n_lines);
3937 UNBLOCK_INPUT;
3939 return Qt;
3942 /* Draw lines around the text region beginning at the character position
3943 TOP_X, TOP_Y and ending at BOTTOM_X and BOTTOM_Y. GC specifies the
3944 pixel and line characteristics. */
3946 #define line_len(line) (FRAME_CURRENT_GLYPHS (f)->used[(line)])
3948 static void
3949 outline_region (f, gc, top_x, top_y, bottom_x, bottom_y)
3950 register struct frame *f;
3951 GC gc;
3952 int top_x, top_y, bottom_x, bottom_y;
3954 register int ibw = f->output_data.x->internal_border_width;
3955 register int font_w = FONT_WIDTH (f->output_data.x->font);
3956 register int font_h = f->output_data.x->line_height;
3957 int y = top_y;
3958 int x = line_len (y);
3959 XPoint *pixel_points
3960 = (XPoint *) alloca (((bottom_y - top_y + 2) * 4) * sizeof (XPoint));
3961 register XPoint *this_point = pixel_points;
3963 /* Do the horizontal top line/lines */
3964 if (top_x == 0)
3966 this_point->x = ibw;
3967 this_point->y = ibw + (font_h * top_y);
3968 this_point++;
3969 if (x == 0)
3970 this_point->x = ibw + (font_w / 2); /* Half-size for newline chars. */
3971 else
3972 this_point->x = ibw + (font_w * x);
3973 this_point->y = (this_point - 1)->y;
3975 else
3977 this_point->x = ibw;
3978 this_point->y = ibw + (font_h * (top_y + 1));
3979 this_point++;
3980 this_point->x = ibw + (font_w * top_x);
3981 this_point->y = (this_point - 1)->y;
3982 this_point++;
3983 this_point->x = (this_point - 1)->x;
3984 this_point->y = ibw + (font_h * top_y);
3985 this_point++;
3986 this_point->x = ibw + (font_w * x);
3987 this_point->y = (this_point - 1)->y;
3990 /* Now do the right side. */
3991 while (y < bottom_y)
3992 { /* Right vertical edge */
3993 this_point++;
3994 this_point->x = (this_point - 1)->x;
3995 this_point->y = ibw + (font_h * (y + 1));
3996 this_point++;
3998 y++; /* Horizontal connection to next line */
3999 x = line_len (y);
4000 if (x == 0)
4001 this_point->x = ibw + (font_w / 2);
4002 else
4003 this_point->x = ibw + (font_w * x);
4005 this_point->y = (this_point - 1)->y;
4008 /* Now do the bottom and connect to the top left point. */
4009 this_point->x = ibw + (font_w * (bottom_x + 1));
4011 this_point++;
4012 this_point->x = (this_point - 1)->x;
4013 this_point->y = ibw + (font_h * (bottom_y + 1));
4014 this_point++;
4015 this_point->x = ibw;
4016 this_point->y = (this_point - 1)->y;
4017 this_point++;
4018 this_point->x = pixel_points->x;
4019 this_point->y = pixel_points->y;
4021 XDrawLines (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
4022 gc, pixel_points,
4023 (this_point - pixel_points + 1), CoordModeOrigin);
4026 DEFUN ("x-contour-region", Fx_contour_region, Sx_contour_region, 1, 1, 0,
4027 "Highlight the region between point and the character under the mouse\n\
4028 selected frame.")
4029 (event)
4030 register Lisp_Object event;
4032 register int x0, y0, x1, y1;
4033 register struct frame *f = selected_frame;
4034 register int p1, p2;
4036 CHECK_CONS (event, 0);
4038 BLOCK_INPUT;
4039 x0 = XINT (Fcar (Fcar (event)));
4040 y0 = XINT (Fcar (Fcdr (Fcar (event))));
4042 /* If the mouse is past the end of the line, don't that area. */
4043 /* ReWrite this... */
4045 x1 = f->cursor_x;
4046 y1 = f->cursor_y;
4048 if (y1 > y0) /* point below mouse */
4049 outline_region (f, f->output_data.x->cursor_gc,
4050 x0, y0, x1, y1);
4051 else if (y1 < y0) /* point above mouse */
4052 outline_region (f, f->output_data.x->cursor_gc,
4053 x1, y1, x0, y0);
4054 else /* same line: draw horizontal rectangle */
4056 if (x1 > x0)
4057 x_rectangle (f, f->output_data.x->cursor_gc,
4058 x0, y0, (x1 - x0 + 1), 1);
4059 else if (x1 < x0)
4060 x_rectangle (f, f->output_data.x->cursor_gc,
4061 x1, y1, (x0 - x1 + 1), 1);
4064 XFlush (FRAME_X_DISPLAY (f));
4065 UNBLOCK_INPUT;
4067 return Qnil;
4070 DEFUN ("x-uncontour-region", Fx_uncontour_region, Sx_uncontour_region, 1, 1, 0,
4071 "Erase any highlighting of the region between point and the character\n\
4072 at X, Y on the selected frame.")
4073 (event)
4074 register Lisp_Object event;
4076 register int x0, y0, x1, y1;
4077 register struct frame *f = selected_frame;
4079 BLOCK_INPUT;
4080 x0 = XINT (Fcar (Fcar (event)));
4081 y0 = XINT (Fcar (Fcdr (Fcar (event))));
4082 x1 = f->cursor_x;
4083 y1 = f->cursor_y;
4085 if (y1 > y0) /* point below mouse */
4086 outline_region (f, f->output_data.x->reverse_gc,
4087 x0, y0, x1, y1);
4088 else if (y1 < y0) /* point above mouse */
4089 outline_region (f, f->output_data.x->reverse_gc,
4090 x1, y1, x0, y0);
4091 else /* same line: draw horizontal rectangle */
4093 if (x1 > x0)
4094 x_rectangle (f, f->output_data.x->reverse_gc,
4095 x0, y0, (x1 - x0 + 1), 1);
4096 else if (x1 < x0)
4097 x_rectangle (f, f->output_data.x->reverse_gc,
4098 x1, y1, (x0 - x1 + 1), 1);
4100 UNBLOCK_INPUT;
4102 return Qnil;
4105 #if 0
4106 int contour_begin_x, contour_begin_y;
4107 int contour_end_x, contour_end_y;
4108 int contour_npoints;
4110 /* Clip the top part of the contour lines down (and including) line Y_POS.
4111 If X_POS is in the middle (rather than at the end) of the line, drop
4112 down a line at that character. */
4114 static void
4115 clip_contour_top (y_pos, x_pos)
4117 register XPoint *begin = contour_lines[y_pos].top_left;
4118 register XPoint *end;
4119 register int npoints;
4120 register struct display_line *line = selected_frame->phys_lines[y_pos + 1];
4122 if (x_pos >= line->len - 1) /* Draw one, straight horizontal line. */
4124 end = contour_lines[y_pos].top_right;
4125 npoints = (end - begin + 1);
4126 XDrawLines (x_current_display, contour_window,
4127 contour_erase_gc, begin_erase, npoints, CoordModeOrigin);
4129 bcopy (end, begin + 1, contour_last_point - end + 1);
4130 contour_last_point -= (npoints - 2);
4131 XDrawLines (x_current_display, contour_window,
4132 contour_erase_gc, begin, 2, CoordModeOrigin);
4133 XFlush (x_current_display);
4135 /* Now, update contour_lines structure. */
4137 /* ______. */
4138 else /* |________*/
4140 register XPoint *p = begin + 1;
4141 end = contour_lines[y_pos].bottom_right;
4142 npoints = (end - begin + 1);
4143 XDrawLines (x_current_display, contour_window,
4144 contour_erase_gc, begin_erase, npoints, CoordModeOrigin);
4146 p->y = begin->y;
4147 p->x = ibw + (font_w * (x_pos + 1));
4148 p++;
4149 p->y = begin->y + font_h;
4150 p->x = (p - 1)->x;
4151 bcopy (end, begin + 3, contour_last_point - end + 1);
4152 contour_last_point -= (npoints - 5);
4153 XDrawLines (x_current_display, contour_window,
4154 contour_erase_gc, begin, 4, CoordModeOrigin);
4155 XFlush (x_current_display);
4157 /* Now, update contour_lines structure. */
4161 /* Erase the top horizontal lines of the contour, and then extend
4162 the contour upwards. */
4164 static void
4165 extend_contour_top (line)
4169 static void
4170 clip_contour_bottom (x_pos, y_pos)
4171 int x_pos, y_pos;
4175 static void
4176 extend_contour_bottom (x_pos, y_pos)
4180 DEFUN ("x-select-region", Fx_select_region, Sx_select_region, 1, 1, "e",
4182 (event)
4183 Lisp_Object event;
4185 register struct frame *f = selected_frame;
4186 register int point_x = f->cursor_x;
4187 register int point_y = f->cursor_y;
4188 register int mouse_below_point;
4189 register Lisp_Object obj;
4190 register int x_contour_x, x_contour_y;
4192 x_contour_x = x_mouse_x;
4193 x_contour_y = x_mouse_y;
4194 if (x_contour_y > point_y || (x_contour_y == point_y
4195 && x_contour_x > point_x))
4197 mouse_below_point = 1;
4198 outline_region (f, f->output_data.x->cursor_gc, point_x, point_y,
4199 x_contour_x, x_contour_y);
4201 else
4203 mouse_below_point = 0;
4204 outline_region (f, f->output_data.x->cursor_gc, x_contour_x, x_contour_y,
4205 point_x, point_y);
4208 while (1)
4210 obj = read_char (-1, 0, 0, Qnil, 0);
4211 if (!CONSP (obj))
4212 break;
4214 if (mouse_below_point)
4216 if (x_mouse_y <= point_y) /* Flipped. */
4218 mouse_below_point = 0;
4220 outline_region (f, f->output_data.x->reverse_gc, point_x, point_y,
4221 x_contour_x, x_contour_y);
4222 outline_region (f, f->output_data.x->cursor_gc, x_mouse_x, x_mouse_y,
4223 point_x, point_y);
4225 else if (x_mouse_y < x_contour_y) /* Bottom clipped. */
4227 clip_contour_bottom (x_mouse_y);
4229 else if (x_mouse_y > x_contour_y) /* Bottom extended. */
4231 extend_bottom_contour (x_mouse_y);
4234 x_contour_x = x_mouse_x;
4235 x_contour_y = x_mouse_y;
4237 else /* mouse above or same line as point */
4239 if (x_mouse_y >= point_y) /* Flipped. */
4241 mouse_below_point = 1;
4243 outline_region (f, f->output_data.x->reverse_gc,
4244 x_contour_x, x_contour_y, point_x, point_y);
4245 outline_region (f, f->output_data.x->cursor_gc, point_x, point_y,
4246 x_mouse_x, x_mouse_y);
4248 else if (x_mouse_y > x_contour_y) /* Top clipped. */
4250 clip_contour_top (x_mouse_y);
4252 else if (x_mouse_y < x_contour_y) /* Top extended. */
4254 extend_contour_top (x_mouse_y);
4259 unread_command_event = obj;
4260 if (mouse_below_point)
4262 contour_begin_x = point_x;
4263 contour_begin_y = point_y;
4264 contour_end_x = x_contour_x;
4265 contour_end_y = x_contour_y;
4267 else
4269 contour_begin_x = x_contour_x;
4270 contour_begin_y = x_contour_y;
4271 contour_end_x = point_x;
4272 contour_end_y = point_y;
4275 #endif
4277 DEFUN ("x-horizontal-line", Fx_horizontal_line, Sx_horizontal_line, 1, 1, "e",
4279 (event)
4280 Lisp_Object event;
4282 register Lisp_Object obj;
4283 struct frame *f = selected_frame;
4284 register struct window *w = XWINDOW (selected_window);
4285 register GC line_gc = f->output_data.x->cursor_gc;
4286 register GC erase_gc = f->output_data.x->reverse_gc;
4287 #if 0
4288 char dash_list[] = {6, 4, 6, 4};
4289 int dashes = 4;
4290 XGCValues gc_values;
4291 #endif
4292 register int previous_y;
4293 register int line = (x_mouse_y + 1) * f->output_data.x->line_height
4294 + f->output_data.x->internal_border_width;
4295 register int left = f->output_data.x->internal_border_width
4296 + (w->left
4297 * FONT_WIDTH (f->output_data.x->font));
4298 register int right = left + (w->width
4299 * FONT_WIDTH (f->output_data.x->font))
4300 - f->output_data.x->internal_border_width;
4302 #if 0
4303 BLOCK_INPUT;
4304 gc_values.foreground = f->output_data.x->cursor_pixel;
4305 gc_values.background = f->output_data.x->background_pixel;
4306 gc_values.line_width = 1;
4307 gc_values.line_style = LineOnOffDash;
4308 gc_values.cap_style = CapRound;
4309 gc_values.join_style = JoinRound;
4311 line_gc = XCreateGC (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
4312 GCLineStyle | GCJoinStyle | GCCapStyle
4313 | GCLineWidth | GCForeground | GCBackground,
4314 &gc_values);
4315 XSetDashes (FRAME_X_DISPLAY (f), line_gc, 0, dash_list, dashes);
4316 gc_values.foreground = f->output_data.x->background_pixel;
4317 gc_values.background = f->output_data.x->foreground_pixel;
4318 erase_gc = XCreateGC (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
4319 GCLineStyle | GCJoinStyle | GCCapStyle
4320 | GCLineWidth | GCForeground | GCBackground,
4321 &gc_values);
4322 XSetDashes (FRAME_X_DISPLAY (f), erase_gc, 0, dash_list, dashes);
4323 UNBLOCK_INPUT;
4324 #endif
4326 while (1)
4328 BLOCK_INPUT;
4329 if (x_mouse_y >= XINT (w->top)
4330 && x_mouse_y < XINT (w->top) + XINT (w->height) - 1)
4332 previous_y = x_mouse_y;
4333 line = (x_mouse_y + 1) * f->output_data.x->line_height
4334 + f->output_data.x->internal_border_width;
4335 XDrawLine (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
4336 line_gc, left, line, right, line);
4338 XFlush (FRAME_X_DISPLAY (f));
4339 UNBLOCK_INPUT;
4343 obj = read_char (-1, 0, 0, Qnil, 0);
4344 if (!CONSP (obj)
4345 || (! EQ (Fcar (Fcdr (Fcdr (obj))),
4346 Qvertical_scroll_bar))
4347 || x_mouse_grabbed)
4349 BLOCK_INPUT;
4350 XDrawLine (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
4351 erase_gc, left, line, right, line);
4352 unread_command_event = obj;
4353 #if 0
4354 XFreeGC (FRAME_X_DISPLAY (f), line_gc);
4355 XFreeGC (FRAME_X_DISPLAY (f), erase_gc);
4356 #endif
4357 UNBLOCK_INPUT;
4358 return Qnil;
4361 while (x_mouse_y == previous_y);
4363 BLOCK_INPUT;
4364 XDrawLine (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
4365 erase_gc, left, line, right, line);
4366 UNBLOCK_INPUT;
4369 #endif
4371 #if 0
4372 /* These keep track of the rectangle following the pointer. */
4373 int mouse_track_top, mouse_track_left, mouse_track_width;
4375 /* Offset in buffer of character under the pointer, or 0. */
4376 int mouse_buffer_offset;
4378 DEFUN ("x-track-pointer", Fx_track_pointer, Sx_track_pointer, 0, 0, 0,
4379 "Track the pointer.")
4382 static Cursor current_pointer_shape;
4383 FRAME_PTR f = x_mouse_frame;
4385 BLOCK_INPUT;
4386 if (EQ (Vmouse_frame_part, Qtext_part)
4387 && (current_pointer_shape != f->output_data.x->nontext_cursor))
4389 unsigned char c;
4390 struct buffer *buf;
4392 current_pointer_shape = f->output_data.x->nontext_cursor;
4393 XDefineCursor (FRAME_X_DISPLAY (f),
4394 FRAME_X_WINDOW (f),
4395 current_pointer_shape);
4397 buf = XBUFFER (XWINDOW (Vmouse_window)->buffer);
4398 c = *(BUF_CHAR_ADDRESS (buf, mouse_buffer_offset));
4400 else if (EQ (Vmouse_frame_part, Qmodeline_part)
4401 && (current_pointer_shape != f->output_data.x->modeline_cursor))
4403 current_pointer_shape = f->output_data.x->modeline_cursor;
4404 XDefineCursor (FRAME_X_DISPLAY (f),
4405 FRAME_X_WINDOW (f),
4406 current_pointer_shape);
4409 XFlush (FRAME_X_DISPLAY (f));
4410 UNBLOCK_INPUT;
4412 #endif
4414 #if 0
4415 DEFUN ("x-track-pointer", Fx_track_pointer, Sx_track_pointer, 1, 1, "e",
4416 "Draw rectangle around character under mouse pointer, if there is one.")
4417 (event)
4418 Lisp_Object event;
4420 struct window *w = XWINDOW (Vmouse_window);
4421 struct frame *f = XFRAME (WINDOW_FRAME (w));
4422 struct buffer *b = XBUFFER (w->buffer);
4423 Lisp_Object obj;
4425 if (! EQ (Vmouse_window, selected_window))
4426 return Qnil;
4428 if (EQ (event, Qnil))
4430 int x, y;
4432 x_read_mouse_position (selected_frame, &x, &y);
4435 BLOCK_INPUT;
4436 mouse_track_width = 0;
4437 mouse_track_left = mouse_track_top = -1;
4441 if ((x_mouse_x != mouse_track_left
4442 && (x_mouse_x < mouse_track_left
4443 || x_mouse_x > (mouse_track_left + mouse_track_width)))
4444 || x_mouse_y != mouse_track_top)
4446 int hp = 0; /* Horizontal position */
4447 int len = FRAME_CURRENT_GLYPHS (f)->used[x_mouse_y];
4448 int p = FRAME_CURRENT_GLYPHS (f)->bufp[x_mouse_y];
4449 int tab_width = XINT (b->tab_width);
4450 int ctl_arrow_p = !NILP (b->ctl_arrow);
4451 unsigned char c;
4452 int mode_line_vpos = XFASTINT (w->height) + XFASTINT (w->top) - 1;
4453 int in_mode_line = 0;
4455 if (! FRAME_CURRENT_GLYPHS (f)->enable[x_mouse_y])
4456 break;
4458 /* Erase previous rectangle. */
4459 if (mouse_track_width)
4461 x_rectangle (f, f->output_data.x->reverse_gc,
4462 mouse_track_left, mouse_track_top,
4463 mouse_track_width, 1);
4465 if ((mouse_track_left == f->phys_cursor_x
4466 || mouse_track_left == f->phys_cursor_x - 1)
4467 && mouse_track_top == f->phys_cursor_y)
4469 x_display_cursor (f, 1);
4473 mouse_track_left = x_mouse_x;
4474 mouse_track_top = x_mouse_y;
4475 mouse_track_width = 0;
4477 if (mouse_track_left > len) /* Past the end of line. */
4478 goto draw_or_not;
4480 if (mouse_track_top == mode_line_vpos)
4482 in_mode_line = 1;
4483 goto draw_or_not;
4486 if (tab_width <= 0 || tab_width > 20) tab_width = 8;
4489 c = FETCH_CHAR (p);
4490 if (len == f->width && hp == len - 1 && c != '\n')
4491 goto draw_or_not;
4493 switch (c)
4495 case '\t':
4496 mouse_track_width = tab_width - (hp % tab_width);
4497 p++;
4498 hp += mouse_track_width;
4499 if (hp > x_mouse_x)
4501 mouse_track_left = hp - mouse_track_width;
4502 goto draw_or_not;
4504 continue;
4506 case '\n':
4507 mouse_track_width = -1;
4508 goto draw_or_not;
4510 default:
4511 if (ctl_arrow_p && (c < 040 || c == 0177))
4513 if (p > ZV)
4514 goto draw_or_not;
4516 mouse_track_width = 2;
4517 p++;
4518 hp +=2;
4519 if (hp > x_mouse_x)
4521 mouse_track_left = hp - mouse_track_width;
4522 goto draw_or_not;
4525 else
4527 mouse_track_width = 1;
4528 p++;
4529 hp++;
4531 continue;
4534 while (hp <= x_mouse_x);
4536 draw_or_not:
4537 if (mouse_track_width) /* Over text; use text pointer shape. */
4539 XDefineCursor (FRAME_X_DISPLAY (f),
4540 FRAME_X_WINDOW (f),
4541 f->output_data.x->text_cursor);
4542 x_rectangle (f, f->output_data.x->cursor_gc,
4543 mouse_track_left, mouse_track_top,
4544 mouse_track_width, 1);
4546 else if (in_mode_line)
4547 XDefineCursor (FRAME_X_DISPLAY (f),
4548 FRAME_X_WINDOW (f),
4549 f->output_data.x->modeline_cursor);
4550 else
4551 XDefineCursor (FRAME_X_DISPLAY (f),
4552 FRAME_X_WINDOW (f),
4553 f->output_data.x->nontext_cursor);
4556 XFlush (FRAME_X_DISPLAY (f));
4557 UNBLOCK_INPUT;
4559 obj = read_char (-1, 0, 0, Qnil, 0);
4560 BLOCK_INPUT;
4562 while (CONSP (obj) /* Mouse event */
4563 && EQ (Fcar (Fcdr (Fcdr (obj))), Qnil) /* Not scroll bar */
4564 && EQ (Vmouse_depressed, Qnil) /* Only motion events */
4565 && EQ (Vmouse_window, selected_window) /* In this window */
4566 && x_mouse_frame);
4568 unread_command_event = obj;
4570 if (mouse_track_width)
4572 x_rectangle (f, f->output_data.x->reverse_gc,
4573 mouse_track_left, mouse_track_top,
4574 mouse_track_width, 1);
4575 mouse_track_width = 0;
4576 if ((mouse_track_left == f->phys_cursor_x
4577 || mouse_track_left - 1 == f->phys_cursor_x)
4578 && mouse_track_top == f->phys_cursor_y)
4580 x_display_cursor (f, 1);
4583 XDefineCursor (FRAME_X_DISPLAY (f),
4584 FRAME_X_WINDOW (f),
4585 f->output_data.x->nontext_cursor);
4586 XFlush (FRAME_X_DISPLAY (f));
4587 UNBLOCK_INPUT;
4589 return Qnil;
4591 #endif
4593 #if 0
4594 #include "glyphs.h"
4596 /* Draw a pixmap specified by IMAGE_DATA of dimensions WIDTH and HEIGHT
4597 on the frame F at position X, Y. */
4599 x_draw_pixmap (f, x, y, image_data, width, height)
4600 struct frame *f;
4601 int x, y, width, height;
4602 char *image_data;
4604 Pixmap image;
4606 image = XCreateBitmapFromData (FRAME_X_DISPLAY (f),
4607 FRAME_X_WINDOW (f), image_data,
4608 width, height);
4609 XCopyPlane (FRAME_X_DISPLAY (f), image, FRAME_X_WINDOW (f),
4610 f->output_data.x->normal_gc, 0, 0, width, height, x, y);
4612 #endif
4614 #if 0 /* I'm told these functions are superfluous
4615 given the ability to bind function keys. */
4617 #ifdef HAVE_X11
4618 DEFUN ("x-rebind-key", Fx_rebind_key, Sx_rebind_key, 3, 3, 0,
4619 "Rebind X keysym KEYSYM, with MODIFIERS, to generate NEWSTRING.\n\
4620 KEYSYM is a string which conforms to the X keysym definitions found\n\
4621 in X11/keysymdef.h, sans the initial XK_. MODIFIERS is nil or a\n\
4622 list of strings specifying modifier keys such as Control_L, which must\n\
4623 also be depressed for NEWSTRING to appear.")
4624 (x_keysym, modifiers, newstring)
4625 register Lisp_Object x_keysym;
4626 register Lisp_Object modifiers;
4627 register Lisp_Object newstring;
4629 char *rawstring;
4630 register KeySym keysym;
4631 KeySym modifier_list[16];
4633 check_x ();
4634 CHECK_STRING (x_keysym, 1);
4635 CHECK_STRING (newstring, 3);
4637 keysym = XStringToKeysym ((char *) XSTRING (x_keysym)->data);
4638 if (keysym == NoSymbol)
4639 error ("Keysym does not exist");
4641 if (NILP (modifiers))
4642 XRebindKeysym (x_current_display, keysym, modifier_list, 0,
4643 XSTRING (newstring)->data, XSTRING (newstring)->size);
4644 else
4646 register Lisp_Object rest, mod;
4647 register int i = 0;
4649 for (rest = modifiers; !NILP (rest); rest = Fcdr (rest))
4651 if (i == 16)
4652 error ("Can't have more than 16 modifiers");
4654 mod = Fcar (rest);
4655 CHECK_STRING (mod, 3);
4656 modifier_list[i] = XStringToKeysym ((char *) XSTRING (mod)->data);
4657 #ifndef HAVE_X11R5
4658 if (modifier_list[i] == NoSymbol
4659 || !(IsModifierKey (modifier_list[i])
4660 || ((unsigned)(modifier_list[i]) == XK_Mode_switch)
4661 || ((unsigned)(modifier_list[i]) == XK_Num_Lock)))
4662 #else
4663 if (modifier_list[i] == NoSymbol
4664 || !IsModifierKey (modifier_list[i]))
4665 #endif
4666 error ("Element is not a modifier keysym");
4667 i++;
4670 XRebindKeysym (x_current_display, keysym, modifier_list, i,
4671 XSTRING (newstring)->data, XSTRING (newstring)->size);
4674 return Qnil;
4677 DEFUN ("x-rebind-keys", Fx_rebind_keys, Sx_rebind_keys, 2, 2, 0,
4678 "Rebind KEYCODE to list of strings STRINGS.\n\
4679 STRINGS should be a list of 16 elements, one for each shift combination.\n\
4680 nil as element means don't change.\n\
4681 See the documentation of `x-rebind-key' for more information.")
4682 (keycode, strings)
4683 register Lisp_Object keycode;
4684 register Lisp_Object strings;
4686 register Lisp_Object item;
4687 register unsigned char *rawstring;
4688 KeySym rawkey, modifier[1];
4689 int strsize;
4690 register unsigned i;
4692 check_x ();
4693 CHECK_NUMBER (keycode, 1);
4694 CHECK_CONS (strings, 2);
4695 rawkey = (KeySym) ((unsigned) (XINT (keycode))) & 255;
4696 for (i = 0; i <= 15; strings = Fcdr (strings), i++)
4698 item = Fcar (strings);
4699 if (!NILP (item))
4701 CHECK_STRING (item, 2);
4702 strsize = XSTRING (item)->size;
4703 rawstring = (unsigned char *) xmalloc (strsize);
4704 bcopy (XSTRING (item)->data, rawstring, strsize);
4705 modifier[1] = 1 << i;
4706 XRebindKeysym (x_current_display, rawkey, modifier, 1,
4707 rawstring, strsize);
4710 return Qnil;
4712 #endif /* HAVE_X11 */
4713 #endif /* 0 */
4715 #ifndef HAVE_XSCREENNUMBEROFSCREEN
4717 XScreenNumberOfScreen (scr)
4718 register Screen *scr;
4720 register Display *dpy;
4721 register Screen *dpyscr;
4722 register int i;
4724 dpy = scr->display;
4725 dpyscr = dpy->screens;
4727 for (i = 0; i < dpy->nscreens; i++, dpyscr++)
4728 if (scr == dpyscr)
4729 return i;
4731 return -1;
4733 #endif /* not HAVE_XSCREENNUMBEROFSCREEN */
4735 Visual *
4736 select_visual (dpy, screen, depth)
4737 Display *dpy;
4738 Screen *screen;
4739 unsigned int *depth;
4741 Visual *v;
4742 XVisualInfo *vinfo, vinfo_template;
4743 int n_visuals;
4745 v = DefaultVisualOfScreen (screen);
4747 #ifdef HAVE_X11R4
4748 vinfo_template.visualid = XVisualIDFromVisual (v);
4749 #else
4750 vinfo_template.visualid = v->visualid;
4751 #endif
4753 vinfo_template.screen = XScreenNumberOfScreen (screen);
4755 vinfo = XGetVisualInfo (dpy,
4756 VisualIDMask | VisualScreenMask, &vinfo_template,
4757 &n_visuals);
4758 if (n_visuals != 1)
4759 fatal ("Can't get proper X visual info");
4761 if ((1 << vinfo->depth) == vinfo->colormap_size)
4762 *depth = vinfo->depth;
4763 else
4765 int i = 0;
4766 int n = vinfo->colormap_size - 1;
4767 while (n)
4769 n = n >> 1;
4770 i++;
4772 *depth = i;
4775 XFree ((char *) vinfo);
4776 return v;
4779 /* Return the X display structure for the display named NAME.
4780 Open a new connection if necessary. */
4782 struct x_display_info *
4783 x_display_info_for_name (name)
4784 Lisp_Object name;
4786 Lisp_Object names;
4787 struct x_display_info *dpyinfo;
4789 CHECK_STRING (name, 0);
4791 if (! EQ (Vwindow_system, intern ("x")))
4792 error ("Not using X Windows");
4794 for (dpyinfo = x_display_list, names = x_display_name_list;
4795 dpyinfo;
4796 dpyinfo = dpyinfo->next, names = XCONS (names)->cdr)
4798 Lisp_Object tem;
4799 tem = Fstring_equal (XCONS (XCONS (names)->car)->car, name);
4800 if (!NILP (tem))
4801 return dpyinfo;
4804 /* Use this general default value to start with. */
4805 Vx_resource_name = Vinvocation_name;
4807 validate_x_resource_name ();
4809 dpyinfo = x_term_init (name, (unsigned char *)0,
4810 (char *) XSTRING (Vx_resource_name)->data);
4812 if (dpyinfo == 0)
4813 error ("Cannot connect to X server %s", XSTRING (name)->data);
4815 x_in_use = 1;
4816 XSETFASTINT (Vwindow_system_version, 11);
4818 return dpyinfo;
4821 DEFUN ("x-open-connection", Fx_open_connection, Sx_open_connection,
4822 1, 3, 0, "Open a connection to an X server.\n\
4823 DISPLAY is the name of the display to connect to.\n\
4824 Optional second arg XRM-STRING is a string of resources in xrdb format.\n\
4825 If the optional third arg MUST-SUCCEED is non-nil,\n\
4826 terminate Emacs if we can't open the connection.")
4827 (display, xrm_string, must_succeed)
4828 Lisp_Object display, xrm_string, must_succeed;
4830 unsigned int n_planes;
4831 unsigned char *xrm_option;
4832 struct x_display_info *dpyinfo;
4834 CHECK_STRING (display, 0);
4835 if (! NILP (xrm_string))
4836 CHECK_STRING (xrm_string, 1);
4838 if (! EQ (Vwindow_system, intern ("x")))
4839 error ("Not using X Windows");
4841 if (! NILP (xrm_string))
4842 xrm_option = (unsigned char *) XSTRING (xrm_string)->data;
4843 else
4844 xrm_option = (unsigned char *) 0;
4846 /* Use this general default value to start with. */
4847 Vx_resource_name = Vinvocation_name;
4849 validate_x_resource_name ();
4851 /* This is what opens the connection and sets x_current_display.
4852 This also initializes many symbols, such as those used for input. */
4853 dpyinfo = x_term_init (display, xrm_option,
4854 (char *) XSTRING (Vx_resource_name)->data);
4856 if (dpyinfo == 0)
4858 if (!NILP (must_succeed))
4859 fatal ("Cannot connect to X server %s.\n\
4860 Check the DISPLAY environment variable or use `-d'.\n\
4861 Also use the `xhost' program to verify that it is set to permit\n\
4862 connections from your machine.\n",
4863 XSTRING (display)->data);
4864 else
4865 error ("Cannot connect to X server %s", XSTRING (display)->data);
4868 x_in_use = 1;
4870 XSETFASTINT (Vwindow_system_version, 11);
4871 return Qnil;
4874 DEFUN ("x-close-connection", Fx_close_connection,
4875 Sx_close_connection, 1, 1, 0,
4876 "Close the connection to DISPLAY's X server.\n\
4877 For DISPLAY, specify either a frame or a display name (a string).\n\
4878 If DISPLAY is nil, that stands for the selected frame's display.")
4879 (display)
4880 Lisp_Object display;
4882 struct x_display_info *dpyinfo = check_x_display_info (display);
4883 struct x_display_info *tail;
4884 int i;
4886 if (dpyinfo->reference_count > 0)
4887 error ("Display still has frames on it");
4889 BLOCK_INPUT;
4890 /* Free the fonts in the font table. */
4891 for (i = 0; i < dpyinfo->n_fonts; i++)
4893 if (dpyinfo->font_table[i].name)
4894 free (dpyinfo->font_table[i].name);
4895 /* Don't free the full_name string;
4896 it is always shared with something else. */
4897 XFreeFont (dpyinfo->display, dpyinfo->font_table[i].font);
4899 x_destroy_all_bitmaps (dpyinfo);
4900 XSetCloseDownMode (dpyinfo->display, DestroyAll);
4902 #ifdef USE_X_TOOLKIT
4903 XtCloseDisplay (dpyinfo->display);
4904 #else
4905 XCloseDisplay (dpyinfo->display);
4906 #endif
4908 x_delete_display (dpyinfo);
4909 UNBLOCK_INPUT;
4911 return Qnil;
4914 DEFUN ("x-display-list", Fx_display_list, Sx_display_list, 0, 0, 0,
4915 "Return the list of display names that Emacs has connections to.")
4918 Lisp_Object tail, result;
4920 result = Qnil;
4921 for (tail = x_display_name_list; ! NILP (tail); tail = XCONS (tail)->cdr)
4922 result = Fcons (XCONS (XCONS (tail)->car)->car, result);
4924 return result;
4927 DEFUN ("x-synchronize", Fx_synchronize, Sx_synchronize, 1, 2, 0,
4928 "If ON is non-nil, report X errors as soon as the erring request is made.\n\
4929 If ON is nil, allow buffering of requests.\n\
4930 Turning on synchronization prohibits the Xlib routines from buffering\n\
4931 requests and seriously degrades performance, but makes debugging much\n\
4932 easier.\n\
4933 The optional second argument DISPLAY specifies which display to act on.\n\
4934 DISPLAY should be either a frame or a display name (a string).\n\
4935 If DISPLAY is omitted or nil, that stands for the selected frame's display.")
4936 (on, display)
4937 Lisp_Object display, on;
4939 struct x_display_info *dpyinfo = check_x_display_info (display);
4941 XSynchronize (dpyinfo->display, !EQ (on, Qnil));
4943 return Qnil;
4946 /* Wait for responses to all X commands issued so far for frame F. */
4948 void
4949 x_sync (f)
4950 FRAME_PTR f;
4952 BLOCK_INPUT;
4953 XSync (FRAME_X_DISPLAY (f), False);
4954 UNBLOCK_INPUT;
4957 syms_of_xfns ()
4959 /* This is zero if not using X windows. */
4960 x_in_use = 0;
4962 /* The section below is built by the lisp expression at the top of the file,
4963 just above where these variables are declared. */
4964 /*&&& init symbols here &&&*/
4965 Qauto_raise = intern ("auto-raise");
4966 staticpro (&Qauto_raise);
4967 Qauto_lower = intern ("auto-lower");
4968 staticpro (&Qauto_lower);
4969 Qbackground_color = intern ("background-color");
4970 staticpro (&Qbackground_color);
4971 Qbar = intern ("bar");
4972 staticpro (&Qbar);
4973 Qborder_color = intern ("border-color");
4974 staticpro (&Qborder_color);
4975 Qborder_width = intern ("border-width");
4976 staticpro (&Qborder_width);
4977 Qbox = intern ("box");
4978 staticpro (&Qbox);
4979 Qcursor_color = intern ("cursor-color");
4980 staticpro (&Qcursor_color);
4981 Qcursor_type = intern ("cursor-type");
4982 staticpro (&Qcursor_type);
4983 Qfont = intern ("font");
4984 staticpro (&Qfont);
4985 Qforeground_color = intern ("foreground-color");
4986 staticpro (&Qforeground_color);
4987 Qgeometry = intern ("geometry");
4988 staticpro (&Qgeometry);
4989 Qicon_left = intern ("icon-left");
4990 staticpro (&Qicon_left);
4991 Qicon_top = intern ("icon-top");
4992 staticpro (&Qicon_top);
4993 Qicon_type = intern ("icon-type");
4994 staticpro (&Qicon_type);
4995 Qicon_name = intern ("icon-name");
4996 staticpro (&Qicon_name);
4997 Qinternal_border_width = intern ("internal-border-width");
4998 staticpro (&Qinternal_border_width);
4999 Qleft = intern ("left");
5000 staticpro (&Qleft);
5001 Qmouse_color = intern ("mouse-color");
5002 staticpro (&Qmouse_color);
5003 Qnone = intern ("none");
5004 staticpro (&Qnone);
5005 Qparent_id = intern ("parent-id");
5006 staticpro (&Qparent_id);
5007 Qscroll_bar_width = intern ("scroll-bar-width");
5008 staticpro (&Qscroll_bar_width);
5009 Qsuppress_icon = intern ("suppress-icon");
5010 staticpro (&Qsuppress_icon);
5011 Qtop = intern ("top");
5012 staticpro (&Qtop);
5013 Qundefined_color = intern ("undefined-color");
5014 staticpro (&Qundefined_color);
5015 Qvertical_scroll_bars = intern ("vertical-scroll-bars");
5016 staticpro (&Qvertical_scroll_bars);
5017 Qvisibility = intern ("visibility");
5018 staticpro (&Qvisibility);
5019 Qwindow_id = intern ("window-id");
5020 staticpro (&Qwindow_id);
5021 Qx_frame_parameter = intern ("x-frame-parameter");
5022 staticpro (&Qx_frame_parameter);
5023 Qx_resource_name = intern ("x-resource-name");
5024 staticpro (&Qx_resource_name);
5025 Quser_position = intern ("user-position");
5026 staticpro (&Quser_position);
5027 Quser_size = intern ("user-size");
5028 staticpro (&Quser_size);
5029 Qdisplay = intern ("display");
5030 staticpro (&Qdisplay);
5031 /* This is the end of symbol initialization. */
5033 Fput (Qundefined_color, Qerror_conditions,
5034 Fcons (Qundefined_color, Fcons (Qerror, Qnil)));
5035 Fput (Qundefined_color, Qerror_message,
5036 build_string ("Undefined color"));
5038 init_x_parm_symbols ();
5040 DEFVAR_LISP ("x-bitmap-file-path", &Vx_bitmap_file_path,
5041 "List of directories to search for bitmap files for X.");
5042 Vx_bitmap_file_path = decode_env_path ((char *) 0, PATH_BITMAPS);
5044 DEFVAR_LISP ("x-pointer-shape", &Vx_pointer_shape,
5045 "The shape of the pointer when over text.\n\
5046 Changing the value does not affect existing frames\n\
5047 unless you set the mouse color.");
5048 Vx_pointer_shape = Qnil;
5050 DEFVAR_LISP ("x-resource-name", &Vx_resource_name,
5051 "The name Emacs uses to look up X resources; for internal use only.\n\
5052 `x-get-resource' uses this as the first component of the instance name\n\
5053 when requesting resource values.\n\
5054 Emacs initially sets `x-resource-name' to the name under which Emacs\n\
5055 was invoked, or to the value specified with the `-name' or `-rn'\n\
5056 switches, if present.");
5057 Vx_resource_name = Qnil;
5059 #if 0 /* This doesn't really do anything. */
5060 DEFVAR_INT ("x-nontext-pointer-shape", &Vx_nontext_pointer_shape,
5061 "The shape of the pointer when not over text.\n\
5062 This variable takes effect when you create a new frame\n\
5063 or when you set the mouse color.");
5064 #endif
5065 Vx_nontext_pointer_shape = Qnil;
5067 #if 0 /* This doesn't really do anything. */
5068 DEFVAR_INT ("x-mode-pointer-shape", &Vx_mode_pointer_shape,
5069 "The shape of the pointer when over the mode line.\n\
5070 This variable takes effect when you create a new frame\n\
5071 or when you set the mouse color.");
5072 #endif
5073 Vx_mode_pointer_shape = Qnil;
5075 DEFVAR_INT ("x-sensitive-text-pointer-shape",
5076 &Vx_sensitive_text_pointer_shape,
5077 "The shape of the pointer when over mouse-sensitive text.\n\
5078 This variable takes effect when you create a new frame\n\
5079 or when you set the mouse color.");
5080 Vx_sensitive_text_pointer_shape = Qnil;
5082 DEFVAR_LISP ("x-cursor-fore-pixel", &Vx_cursor_fore_pixel,
5083 "A string indicating the foreground color of the cursor box.");
5084 Vx_cursor_fore_pixel = Qnil;
5086 DEFVAR_LISP ("x-no-window-manager", &Vx_no_window_manager,
5087 "Non-nil if no X window manager is in use.\n\
5088 Emacs doesn't try to figure this out; this is always nil\n\
5089 unless you set it to something else.");
5090 /* We don't have any way to find this out, so set it to nil
5091 and maybe the user would like to set it to t. */
5092 Vx_no_window_manager = Qnil;
5094 #ifdef USE_X_TOOLKIT
5095 Fprovide (intern ("x-toolkit"));
5096 #endif
5097 #ifdef USE_MOTIF
5098 Fprovide (intern ("motif"));
5099 #endif
5101 defsubr (&Sx_get_resource);
5102 #if 0
5103 defsubr (&Sx_draw_rectangle);
5104 defsubr (&Sx_erase_rectangle);
5105 defsubr (&Sx_contour_region);
5106 defsubr (&Sx_uncontour_region);
5107 #endif
5108 defsubr (&Sx_list_fonts);
5109 defsubr (&Sx_display_color_p);
5110 defsubr (&Sx_display_grayscale_p);
5111 defsubr (&Sx_color_defined_p);
5112 defsubr (&Sx_color_values);
5113 defsubr (&Sx_server_max_request_size);
5114 defsubr (&Sx_server_vendor);
5115 defsubr (&Sx_server_version);
5116 defsubr (&Sx_display_pixel_width);
5117 defsubr (&Sx_display_pixel_height);
5118 defsubr (&Sx_display_mm_width);
5119 defsubr (&Sx_display_mm_height);
5120 defsubr (&Sx_display_screens);
5121 defsubr (&Sx_display_planes);
5122 defsubr (&Sx_display_color_cells);
5123 defsubr (&Sx_display_visual_class);
5124 defsubr (&Sx_display_backing_store);
5125 defsubr (&Sx_display_save_under);
5126 #if 0
5127 defsubr (&Sx_rebind_key);
5128 defsubr (&Sx_rebind_keys);
5129 defsubr (&Sx_track_pointer);
5130 defsubr (&Sx_grab_pointer);
5131 defsubr (&Sx_ungrab_pointer);
5132 #endif
5133 defsubr (&Sx_parse_geometry);
5134 defsubr (&Sx_create_frame);
5135 defsubr (&Sfocus_frame);
5136 defsubr (&Sunfocus_frame);
5137 #if 0
5138 defsubr (&Sx_horizontal_line);
5139 #endif
5140 defsubr (&Sx_open_connection);
5141 defsubr (&Sx_close_connection);
5142 defsubr (&Sx_display_list);
5143 defsubr (&Sx_synchronize);
5146 #endif /* HAVE_X_WINDOWS */