(menu-bar-help-menu): Binding for view-emacs-FAQ.
[emacs.git] / src / xfns.c
blob7a5e4ff9d717ae353f05f655a035f79f3ee10459
1 /* Functions for the X window system.
2 Copyright (C) 1989, 1992, 1993, 1994 Free Software Foundation.
4 This file is part of GNU Emacs.
6 GNU Emacs is free software; you can redistribute it and/or modify
7 it under the terms of the GNU General Public License as published by
8 the Free Software Foundation; either version 2, or (at your option)
9 any later version.
11 GNU Emacs is distributed in the hope that it will be useful,
12 but WITHOUT ANY WARRANTY; without even the implied warranty of
13 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14 GNU General Public License for more details.
16 You should have received a copy of the GNU General Public License
17 along with GNU Emacs; see the file COPYING. If not, write to
18 the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. */
20 /* Completely rewritten by Richard Stallman. */
22 /* Rewritten for X11 by Joseph Arceneaux */
24 #include <signal.h>
25 #include <config.h>
27 /* This makes the fields of a Display accessible, in Xlib header files. */
28 #define XLIB_ILLEGAL_ACCESS
30 #include "lisp.h"
31 #include "xterm.h"
32 #include "frame.h"
33 #include "window.h"
34 #include "buffer.h"
35 #include "dispextern.h"
36 #include "keyboard.h"
37 #include "blockinput.h"
38 #include "paths.h"
40 #ifdef HAVE_X_WINDOWS
41 extern void abort ();
43 #ifndef VMS
44 #if 1 /* Used to be #ifdef EMACS_BITMAP_FILES, but this should always work. */
45 #include "bitmaps/gray.xbm"
46 #else
47 #include <X11/bitmaps/gray>
48 #endif
49 #else
50 #include "[.bitmaps]gray.xbm"
51 #endif
53 #ifdef USE_X_TOOLKIT
54 #include <X11/Shell.h>
56 #include <X11/Xaw/Paned.h>
57 #include <X11/Xaw/Label.h>
59 #ifdef USG
60 #undef USG /* ####KLUDGE for Solaris 2.2 and up */
61 #include <X11/Xos.h>
62 #define USG
63 #else
64 #include <X11/Xos.h>
65 #endif
67 #include "widget.h"
69 #include "../lwlib/lwlib.h"
71 /* Do the EDITRES protocol if running X11R5 */
72 #if (XtSpecificationRelease >= 5)
73 #define HACK_EDITRES
74 extern void _XEditResCheckMessages ();
75 #endif /* R5 + Athena */
77 /* Unique id counter for widgets created by the Lucid Widget
78 Library. */
79 extern LWLIB_ID widget_id_tick;
81 /* This is part of a kludge--see lwlib/xlwmenu.c. */
82 XFontStruct *xlwmenu_default_font;
84 extern void free_frame_menubar ();
85 #endif /* USE_X_TOOLKIT */
87 #define min(a,b) ((a) < (b) ? (a) : (b))
88 #define max(a,b) ((a) > (b) ? (a) : (b))
90 #ifdef HAVE_X11R4
91 #define MAXREQUEST(dpy) (XMaxRequestSize (dpy))
92 #else
93 #define MAXREQUEST(dpy) ((dpy)->max_request_size)
94 #endif
96 /* The name we're using in resource queries. */
97 Lisp_Object Vx_resource_name;
99 /* The background and shape of the mouse pointer, and shape when not
100 over text or in the modeline. */
101 Lisp_Object Vx_pointer_shape, Vx_nontext_pointer_shape, Vx_mode_pointer_shape;
102 /* The shape when over mouse-sensitive text. */
103 Lisp_Object Vx_sensitive_text_pointer_shape;
105 /* Color of chars displayed in cursor box. */
106 Lisp_Object Vx_cursor_fore_pixel;
108 /* Nonzero if using X. */
109 static int x_in_use;
111 /* Non nil if no window manager is in use. */
112 Lisp_Object Vx_no_window_manager;
114 /* Search path for bitmap files. */
115 Lisp_Object Vx_bitmap_file_path;
117 /* Evaluate this expression to rebuild the section of syms_of_xfns
118 that initializes and staticpros the symbols declared below. Note
119 that Emacs 18 has a bug that keeps C-x C-e from being able to
120 evaluate this expression.
122 (progn
123 ;; Accumulate a list of the symbols we want to initialize from the
124 ;; declarations at the top of the file.
125 (goto-char (point-min))
126 (search-forward "/\*&&& symbols declared here &&&*\/\n")
127 (let (symbol-list)
128 (while (looking-at "Lisp_Object \\(Q[a-z_]+\\)")
129 (setq symbol-list
130 (cons (buffer-substring (match-beginning 1) (match-end 1))
131 symbol-list))
132 (forward-line 1))
133 (setq symbol-list (nreverse symbol-list))
134 ;; Delete the section of syms_of_... where we initialize the symbols.
135 (search-forward "\n /\*&&& init symbols here &&&*\/\n")
136 (let ((start (point)))
137 (while (looking-at "^ Q")
138 (forward-line 2))
139 (kill-region start (point)))
140 ;; Write a new symbol initialization section.
141 (while symbol-list
142 (insert (format " %s = intern (\"" (car symbol-list)))
143 (let ((start (point)))
144 (insert (substring (car symbol-list) 1))
145 (subst-char-in-region start (point) ?_ ?-))
146 (insert (format "\");\n staticpro (&%s);\n" (car symbol-list)))
147 (setq symbol-list (cdr symbol-list)))))
151 /*&&& symbols declared here &&&*/
152 Lisp_Object Qauto_raise;
153 Lisp_Object Qauto_lower;
154 Lisp_Object Qbackground_color;
155 Lisp_Object Qbar;
156 Lisp_Object Qborder_color;
157 Lisp_Object Qborder_width;
158 Lisp_Object Qbox;
159 Lisp_Object Qcursor_color;
160 Lisp_Object Qcursor_type;
161 Lisp_Object Qfont;
162 Lisp_Object Qforeground_color;
163 Lisp_Object Qgeometry;
164 Lisp_Object Qicon_left;
165 Lisp_Object Qicon_top;
166 Lisp_Object Qicon_type;
167 Lisp_Object Qinternal_border_width;
168 Lisp_Object Qleft;
169 Lisp_Object Qmouse_color;
170 Lisp_Object Qnone;
171 Lisp_Object Qparent_id;
172 Lisp_Object Qscroll_bar_width;
173 Lisp_Object Qsuppress_icon;
174 Lisp_Object Qtop;
175 Lisp_Object Qundefined_color;
176 Lisp_Object Qvertical_scroll_bars;
177 Lisp_Object Qvisibility;
178 Lisp_Object Qwindow_id;
179 Lisp_Object Qx_frame_parameter;
180 Lisp_Object Qx_resource_name;
181 Lisp_Object Quser_position;
182 Lisp_Object Quser_size;
183 Lisp_Object Qdisplay;
185 /* The below are defined in frame.c. */
186 extern Lisp_Object Qheight, Qminibuffer, Qname, Qonly, Qwidth;
187 extern Lisp_Object Qunsplittable, Qmenu_bar_lines;
189 extern Lisp_Object Vwindow_system_version;
192 /* Error if we are not connected to X. */
193 void
194 check_x ()
196 if (! x_in_use)
197 error ("X windows are not in use or not initialized");
200 /* Nonzero if using X for display. */
203 using_x_p ()
205 return x_in_use;
208 /* Extract a frame as a FRAME_PTR, defaulting to the selected frame
209 and checking validity for X. */
211 FRAME_PTR
212 check_x_frame (frame)
213 Lisp_Object frame;
215 FRAME_PTR f;
217 if (NILP (frame))
218 f = selected_frame;
219 else
221 CHECK_LIVE_FRAME (frame, 0);
222 f = XFRAME (frame);
224 if (! FRAME_X_P (f))
225 error ("non-X frame used");
226 return f;
229 /* Let the user specify an X display with a frame.
230 nil stands for the selected frame--or, if that is not an X frame,
231 the first X display on the list. */
233 static struct x_display_info *
234 check_x_display_info (frame)
235 Lisp_Object frame;
237 if (NILP (frame))
239 if (FRAME_X_P (selected_frame))
240 return FRAME_X_DISPLAY_INFO (selected_frame);
241 else if (x_display_list != 0)
242 return x_display_list;
243 else
244 error ("X windows are not in use or not initialized");
246 else if (STRINGP (frame))
247 return x_display_info_for_name (frame);
248 else
250 FRAME_PTR f;
252 CHECK_LIVE_FRAME (frame, 0);
253 f = XFRAME (frame);
254 if (! FRAME_X_P (f))
255 error ("non-X frame used");
256 return FRAME_X_DISPLAY_INFO (f);
260 /* Return the Emacs frame-object corresponding to an X window.
261 It could be the frame's main window or an icon window. */
263 /* This function can be called during GC, so use GC_xxx type test macros. */
265 struct frame *
266 x_window_to_frame (wdesc)
267 int wdesc;
269 Lisp_Object tail, frame;
270 struct frame *f;
272 for (tail = Vframe_list; GC_CONSP (tail); tail = XCONS (tail)->cdr)
274 frame = XCONS (tail)->car;
275 if (!GC_FRAMEP (frame))
276 continue;
277 f = XFRAME (frame);
278 #ifdef USE_X_TOOLKIT
279 if (f->display.nothing == 1)
280 return 0;
281 if ((f->display.x->edit_widget
282 && XtWindow (f->display.x->edit_widget) == wdesc)
283 || f->display.x->icon_desc == wdesc)
284 return f;
285 #else /* not USE_X_TOOLKIT */
286 if (FRAME_X_WINDOW (f) == wdesc
287 || f->display.x->icon_desc == wdesc)
288 return f;
289 #endif /* not USE_X_TOOLKIT */
291 return 0;
294 #ifdef USE_X_TOOLKIT
295 /* Like x_window_to_frame but also compares the window with the widget's
296 windows. */
298 struct frame *
299 x_any_window_to_frame (wdesc)
300 int wdesc;
302 Lisp_Object tail, frame;
303 struct frame *f;
304 struct x_display *x;
306 for (tail = Vframe_list; GC_CONSP (tail); tail = XCONS (tail)->cdr)
308 frame = XCONS (tail)->car;
309 if (!GC_FRAMEP (frame))
310 continue;
311 f = XFRAME (frame);
312 if (f->display.nothing == 1)
313 return 0;
314 x = f->display.x;
315 /* This frame matches if the window is any of its widgets. */
316 if (wdesc == XtWindow (x->widget)
317 || wdesc == XtWindow (x->column_widget)
318 || wdesc == XtWindow (x->edit_widget))
319 return f;
320 /* Match if the window is this frame's menubar. */
321 if (lw_window_is_in_menubar (wdesc, x->menubar_widget))
322 return f;
324 return 0;
327 /* Return the frame whose principal (outermost) window is WDESC.
328 If WDESC is some other (smaller) window, we return 0. */
330 struct frame *
331 x_top_window_to_frame (wdesc)
332 int wdesc;
334 Lisp_Object tail, frame;
335 struct frame *f;
336 struct x_display *x;
338 for (tail = Vframe_list; GC_CONSP (tail); tail = XCONS (tail)->cdr)
340 frame = XCONS (tail)->car;
341 if (!GC_FRAMEP (frame))
342 continue;
343 f = XFRAME (frame);
344 if (f->display.nothing == 1)
345 return 0;
346 x = f->display.x;
347 /* This frame matches if the window is its topmost widget. */
348 if (wdesc == XtWindow (x->widget))
349 return f;
350 /* Match if the window is this frame's menubar. */
351 if (x->menubar_widget
352 && wdesc == XtWindow (x->menubar_widget))
353 return f;
355 return 0;
357 #endif /* USE_X_TOOLKIT */
361 /* Code to deal with bitmaps. Bitmaps are referenced by their bitmap
362 id, which is just an int that this section returns. Bitmaps are
363 reference counted so they can be shared among frames.
365 Bitmap indices are guaranteed to be > 0, so a negative number can
366 be used to indicate no bitmap.
368 If you use x_create_bitmap_from_data, then you must keep track of
369 the bitmaps yourself. That is, creating a bitmap from the same
370 data more than once will not be caught. */
373 /* Functions to access the contents of a bitmap, given an id. */
376 x_bitmap_height (f, id)
377 FRAME_PTR f;
378 int id;
380 return FRAME_X_DISPLAY_INFO (f)->bitmaps[id - 1].height;
384 x_bitmap_width (f, id)
385 FRAME_PTR f;
386 int id;
388 return FRAME_X_DISPLAY_INFO (f)->bitmaps[id - 1].width;
392 x_bitmap_pixmap (f, id)
393 FRAME_PTR f;
394 int id;
396 return FRAME_X_DISPLAY_INFO (f)->bitmaps[id - 1].pixmap;
400 /* Allocate a new bitmap record. Returns index of new record. */
402 static int
403 x_allocate_bitmap_record (f)
404 FRAME_PTR f;
406 struct x_display_info *dpyinfo = FRAME_X_DISPLAY_INFO (f);
407 int i;
409 if (dpyinfo->bitmaps == NULL)
411 dpyinfo->bitmaps_size = 10;
412 dpyinfo->bitmaps
413 = (struct x_bitmap_record *) xmalloc (dpyinfo->bitmaps_size * sizeof (struct x_bitmap_record));
414 dpyinfo->bitmaps_last = 1;
415 return 1;
418 if (dpyinfo->bitmaps_last < dpyinfo->bitmaps_size)
419 return ++dpyinfo->bitmaps_last;
421 for (i = 0; i < dpyinfo->bitmaps_size; ++i)
422 if (dpyinfo->bitmaps[i].refcount == 0)
423 return i + 1;
425 dpyinfo->bitmaps_size *= 2;
426 dpyinfo->bitmaps
427 = (struct x_bitmap_record *) xrealloc (dpyinfo->bitmaps,
428 dpyinfo->bitmaps_size * sizeof (struct x_bitmap_record));
429 return ++dpyinfo->bitmaps_last;
432 /* Add one reference to the reference count of the bitmap with id ID. */
434 void
435 x_reference_bitmap (f, id)
436 FRAME_PTR f;
437 int id;
439 ++FRAME_X_DISPLAY_INFO (f)->bitmaps[id - 1].refcount;
442 /* Create a bitmap for frame F from a HEIGHT x WIDTH array of bits at BITS. */
445 x_create_bitmap_from_data (f, bits, width, height)
446 struct frame *f;
447 char *bits;
448 unsigned int width, height;
450 struct x_display_info *dpyinfo = FRAME_X_DISPLAY_INFO (f);
451 Pixmap bitmap;
452 int id;
454 bitmap = XCreateBitmapFromData (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
455 bits, width, height);
457 if (! bitmap)
458 return -1;
460 id = x_allocate_bitmap_record (f);
461 dpyinfo->bitmaps[id - 1].pixmap = bitmap;
462 dpyinfo->bitmaps[id - 1].file = NULL;
463 dpyinfo->bitmaps[id - 1].refcount = 1;
464 dpyinfo->bitmaps[id - 1].depth = 1;
465 dpyinfo->bitmaps[id - 1].height = height;
466 dpyinfo->bitmaps[id - 1].width = width;
468 return id;
471 /* Create bitmap from file FILE for frame F. */
474 x_create_bitmap_from_file (f, file)
475 struct frame *f;
476 Lisp_Object file;
478 struct x_display_info *dpyinfo = FRAME_X_DISPLAY_INFO (f);
479 unsigned int width, height;
480 Pixmap bitmap;
481 int xhot, yhot, result, id;
482 Lisp_Object found;
483 int fd;
484 char *filename;
486 /* Look for an existing bitmap with the same name. */
487 for (id = 0; id < dpyinfo->bitmaps_last; ++id)
489 if (dpyinfo->bitmaps[id].refcount
490 && dpyinfo->bitmaps[id].file
491 && !strcmp (dpyinfo->bitmaps[id].file, (char *) XSTRING (file)->data))
493 ++dpyinfo->bitmaps[id].refcount;
494 return id + 1;
498 /* Search bitmap-file-path for the file, if appropriate. */
499 fd = openp (Vx_bitmap_file_path, file, "", &found, 0);
500 if (fd < 0)
501 return -1;
502 close (fd);
504 filename = (char *) XSTRING (found)->data;
506 result = XReadBitmapFile (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
507 filename, &width, &height, &bitmap, &xhot, &yhot);
508 if (result != BitmapSuccess)
509 return -1;
511 id = x_allocate_bitmap_record (f);
512 dpyinfo->bitmaps[id - 1].pixmap = bitmap;
513 dpyinfo->bitmaps[id - 1].refcount = 1;
514 dpyinfo->bitmaps[id - 1].file = (char *) xmalloc (XSTRING (file)->size + 1);
515 dpyinfo->bitmaps[id - 1].depth = 1;
516 dpyinfo->bitmaps[id - 1].height = height;
517 dpyinfo->bitmaps[id - 1].width = width;
518 strcpy (dpyinfo->bitmaps[id - 1].file, XSTRING (file)->data);
520 return id;
523 /* Remove reference to bitmap with id number ID. */
526 x_destroy_bitmap (f, id)
527 FRAME_PTR f;
528 int id;
530 struct x_display_info *dpyinfo = FRAME_X_DISPLAY_INFO (f);
532 if (id > 0)
534 --dpyinfo->bitmaps[id - 1].refcount;
535 if (dpyinfo->bitmaps[id - 1].refcount == 0)
537 XFreePixmap (FRAME_X_DISPLAY (f), dpyinfo->bitmaps[id - 1].pixmap);
538 if (dpyinfo->bitmaps[id - 1].file)
540 free (dpyinfo->bitmaps[id - 1].file);
541 dpyinfo->bitmaps[id - 1].file = NULL;
547 /* Free all the bitmaps for the display specified by DPYINFO. */
549 static void
550 x_destroy_all_bitmaps (dpyinfo)
551 struct x_display_info *dpyinfo;
553 int i;
554 for (i = 0; i < dpyinfo->bitmaps_last; i++)
555 if (dpyinfo->bitmaps[i].refcount > 0)
557 XFreePixmap (dpyinfo->display, dpyinfo->bitmaps[i].pixmap);
558 if (dpyinfo->bitmaps[i].file)
559 free (dpyinfo->bitmaps[i].file);
561 dpyinfo->bitmaps_last = 0;
564 /* Connect the frame-parameter names for X frames
565 to the ways of passing the parameter values to the window system.
567 The name of a parameter, as a Lisp symbol,
568 has an `x-frame-parameter' property which is an integer in Lisp
569 but can be interpreted as an `enum x_frame_parm' in C. */
571 enum x_frame_parm
573 X_PARM_FOREGROUND_COLOR,
574 X_PARM_BACKGROUND_COLOR,
575 X_PARM_MOUSE_COLOR,
576 X_PARM_CURSOR_COLOR,
577 X_PARM_BORDER_COLOR,
578 X_PARM_ICON_TYPE,
579 X_PARM_FONT,
580 X_PARM_BORDER_WIDTH,
581 X_PARM_INTERNAL_BORDER_WIDTH,
582 X_PARM_NAME,
583 X_PARM_AUTORAISE,
584 X_PARM_AUTOLOWER,
585 X_PARM_VERT_SCROLL_BAR,
586 X_PARM_VISIBILITY,
587 X_PARM_MENU_BAR_LINES
591 struct x_frame_parm_table
593 char *name;
594 void (*setter)( /* struct frame *frame, Lisp_Object val, oldval */ );
597 void x_set_foreground_color ();
598 void x_set_background_color ();
599 void x_set_mouse_color ();
600 void x_set_cursor_color ();
601 void x_set_border_color ();
602 void x_set_cursor_type ();
603 void x_set_icon_type ();
604 void x_set_font ();
605 void x_set_border_width ();
606 void x_set_internal_border_width ();
607 void x_explicitly_set_name ();
608 void x_set_autoraise ();
609 void x_set_autolower ();
610 void x_set_vertical_scroll_bars ();
611 void x_set_visibility ();
612 void x_set_menu_bar_lines ();
613 void x_set_scroll_bar_width ();
614 void x_set_unsplittable ();
616 static struct x_frame_parm_table x_frame_parms[] =
618 "foreground-color", x_set_foreground_color,
619 "background-color", x_set_background_color,
620 "mouse-color", x_set_mouse_color,
621 "cursor-color", x_set_cursor_color,
622 "border-color", x_set_border_color,
623 "cursor-type", x_set_cursor_type,
624 "icon-type", x_set_icon_type,
625 "font", x_set_font,
626 "border-width", x_set_border_width,
627 "internal-border-width", x_set_internal_border_width,
628 "name", x_explicitly_set_name,
629 "auto-raise", x_set_autoraise,
630 "auto-lower", x_set_autolower,
631 "vertical-scroll-bars", x_set_vertical_scroll_bars,
632 "visibility", x_set_visibility,
633 "menu-bar-lines", x_set_menu_bar_lines,
634 "scroll-bar-width", x_set_scroll_bar_width,
635 "unsplittable", x_set_unsplittable,
638 /* Attach the `x-frame-parameter' properties to
639 the Lisp symbol names of parameters relevant to X. */
641 init_x_parm_symbols ()
643 int i;
645 for (i = 0; i < sizeof (x_frame_parms) / sizeof (x_frame_parms[0]); i++)
646 Fput (intern (x_frame_parms[i].name), Qx_frame_parameter,
647 make_number (i));
650 /* Change the parameters of FRAME as specified by ALIST.
651 If a parameter is not specially recognized, do nothing;
652 otherwise call the `x_set_...' function for that parameter. */
654 void
655 x_set_frame_parameters (f, alist)
656 FRAME_PTR f;
657 Lisp_Object alist;
659 Lisp_Object tail;
661 /* If both of these parameters are present, it's more efficient to
662 set them both at once. So we wait until we've looked at the
663 entire list before we set them. */
664 Lisp_Object width, height;
666 /* Same here. */
667 Lisp_Object left, top;
669 /* Same with these. */
670 Lisp_Object icon_left, icon_top;
672 /* Record in these vectors all the parms specified. */
673 Lisp_Object *parms;
674 Lisp_Object *values;
675 int i;
676 int left_no_change = 0, top_no_change = 0;
677 int icon_left_no_change = 0, icon_top_no_change = 0;
679 i = 0;
680 for (tail = alist; CONSP (tail); tail = Fcdr (tail))
681 i++;
683 parms = (Lisp_Object *) alloca (i * sizeof (Lisp_Object));
684 values = (Lisp_Object *) alloca (i * sizeof (Lisp_Object));
686 /* Extract parm names and values into those vectors. */
688 i = 0;
689 for (tail = alist; CONSP (tail); tail = Fcdr (tail))
691 Lisp_Object elt, prop, val;
693 elt = Fcar (tail);
694 parms[i] = Fcar (elt);
695 values[i] = Fcdr (elt);
696 i++;
699 width = height = top = left = Qunbound;
700 icon_left = icon_top = Qunbound;
702 /* Now process them in reverse of specified order. */
703 for (i--; i >= 0; i--)
705 Lisp_Object prop, val;
707 prop = parms[i];
708 val = values[i];
710 if (EQ (prop, Qwidth))
711 width = val;
712 else if (EQ (prop, Qheight))
713 height = val;
714 else if (EQ (prop, Qtop))
715 top = val;
716 else if (EQ (prop, Qleft))
717 left = val;
718 else if (EQ (prop, Qicon_top))
719 icon_top = val;
720 else if (EQ (prop, Qicon_left))
721 icon_left = val;
722 else
724 register Lisp_Object param_index, old_value;
726 param_index = Fget (prop, Qx_frame_parameter);
727 old_value = get_frame_param (f, prop);
728 store_frame_param (f, prop, val);
729 if (NATNUMP (param_index)
730 && (XFASTINT (param_index)
731 < sizeof (x_frame_parms)/sizeof (x_frame_parms[0])))
732 (*x_frame_parms[XINT (param_index)].setter)(f, val, old_value);
736 /* Don't die if just one of these was set. */
737 if (EQ (left, Qunbound))
739 left_no_change = 1;
740 if (f->display.x->left_pos < 0)
741 left = Fcons (Qplus, Fcons (make_number (f->display.x->left_pos), Qnil));
742 else
743 XSETINT (left, f->display.x->left_pos);
745 if (EQ (top, Qunbound))
747 top_no_change = 1;
748 if (f->display.x->top_pos < 0)
749 top = Fcons (Qplus, Fcons (make_number (f->display.x->top_pos), Qnil));
750 else
751 XSETINT (top, f->display.x->top_pos);
754 /* If one of the icon positions was not set, preserve or default it. */
755 if (EQ (icon_left, Qunbound) || ! INTEGERP (icon_left))
757 icon_left_no_change = 1;
758 icon_left = Fcdr (Fassq (Qicon_left, f->param_alist));
759 if (NILP (icon_left))
760 XSETINT (icon_left, 0);
762 if (EQ (icon_top, Qunbound) || ! INTEGERP (icon_top))
764 icon_top_no_change = 1;
765 icon_top = Fcdr (Fassq (Qicon_top, f->param_alist));
766 if (NILP (icon_top))
767 XSETINT (icon_top, 0);
770 /* Don't die if just one of these was set. */
771 if (EQ (width, Qunbound))
772 XSETINT (width, FRAME_WIDTH (f));
773 if (EQ (height, Qunbound))
774 XSETINT (height, FRAME_HEIGHT (f));
776 /* Don't set these parameters these unless they've been explicitly
777 specified. The window might be mapped or resized while we're in
778 this function, and we don't want to override that unless the lisp
779 code has asked for it.
781 Don't set these parameters unless they actually differ from the
782 window's current parameters; the window may not actually exist
783 yet. */
785 Lisp_Object frame;
787 check_frame_size (f, &height, &width);
789 XSETFRAME (frame, f);
791 if ((NUMBERP (width) && XINT (width) != FRAME_WIDTH (f))
792 || (NUMBERP (height) && XINT (height) != FRAME_HEIGHT (f)))
793 Fset_frame_size (frame, width, height);
795 if ((!NILP (left) || !NILP (top))
796 && ! (left_no_change && top_no_change)
797 && ! (NUMBERP (left) && XINT (left) == f->display.x->left_pos
798 && NUMBERP (top) && XINT (top) == f->display.x->top_pos))
800 int leftpos = 0;
801 int toppos = 0;
803 /* Record the signs. */
804 f->display.x->size_hint_flags &= ~ (XNegative | YNegative);
805 if (EQ (left, Qminus))
806 f->display.x->size_hint_flags |= XNegative;
807 else if (INTEGERP (left))
809 leftpos = XINT (left);
810 if (leftpos < 0)
811 f->display.x->size_hint_flags |= XNegative;
813 else if (CONSP (left) && EQ (XCONS (left)->car, Qminus)
814 && CONSP (XCONS (left)->cdr)
815 && INTEGERP (XCONS (XCONS (left)->cdr)->car))
817 leftpos = - XINT (XCONS (XCONS (left)->cdr)->car);
818 f->display.x->size_hint_flags |= XNegative;
820 else if (CONSP (left) && EQ (XCONS (left)->car, Qplus)
821 && CONSP (XCONS (left)->cdr)
822 && INTEGERP (XCONS (XCONS (left)->cdr)->car))
824 leftpos = XINT (XCONS (XCONS (left)->cdr)->car);
827 if (EQ (top, Qminus))
828 f->display.x->size_hint_flags |= YNegative;
829 else if (INTEGERP (top))
831 toppos = XINT (top);
832 if (toppos < 0)
833 f->display.x->size_hint_flags |= YNegative;
835 else if (CONSP (top) && EQ (XCONS (top)->car, Qminus)
836 && CONSP (XCONS (top)->cdr)
837 && INTEGERP (XCONS (XCONS (top)->cdr)->car))
839 toppos = - XINT (XCONS (XCONS (top)->cdr)->car);
840 f->display.x->size_hint_flags |= YNegative;
842 else if (CONSP (top) && EQ (XCONS (top)->car, Qplus)
843 && CONSP (XCONS (top)->cdr)
844 && INTEGERP (XCONS (XCONS (top)->cdr)->car))
846 toppos = XINT (XCONS (XCONS (top)->cdr)->car);
850 /* Store the numeric value of the position. */
851 f->display.x->top_pos = toppos;
852 f->display.x->left_pos = leftpos;
854 f->display.x->win_gravity = NorthWestGravity;
856 /* Actually set that position, and convert to absolute. */
857 x_set_offset (f, leftpos, toppos, 0);
860 if ((!NILP (icon_left) || !NILP (icon_top))
861 && ! (icon_left_no_change && icon_top_no_change))
862 x_wm_set_icon_position (f, XINT (icon_left), XINT (icon_top));
866 /* Store the screen positions of frame F into XPTR and YPTR.
867 These are the positions of the containing window manager window,
868 not Emacs's own window. */
870 void
871 x_real_positions (f, xptr, yptr)
872 FRAME_PTR f;
873 int *xptr, *yptr;
875 int win_x, win_y;
876 Window child;
878 /* This is pretty gross, but seems to be the easiest way out of
879 the problem that arises when restarting window-managers. */
881 #ifdef USE_X_TOOLKIT
882 Window outer = XtWindow (f->display.x->widget);
883 #else
884 Window outer = f->display.x->window_desc;
885 #endif
886 Window tmp_root_window;
887 Window *tmp_children;
888 int tmp_nchildren;
890 x_catch_errors (FRAME_X_DISPLAY (f));
891 while (1)
893 XQueryTree (FRAME_X_DISPLAY (f), outer, &tmp_root_window,
894 &f->display.x->parent_desc,
895 &tmp_children, &tmp_nchildren);
896 xfree (tmp_children);
898 win_x = win_y = 0;
900 /* Find the position of the outside upper-left corner of
901 the inner window, with respect to the outer window. */
902 if (f->display.x->parent_desc != FRAME_X_DISPLAY_INFO (f)->root_window)
904 XTranslateCoordinates (FRAME_X_DISPLAY (f),
906 /* From-window, to-window. */
907 #ifdef USE_X_TOOLKIT
908 XtWindow (f->display.x->widget),
909 #else
910 f->display.x->window_desc,
911 #endif
912 f->display.x->parent_desc,
914 /* From-position, to-position. */
915 0, 0, &win_x, &win_y,
917 /* Child of win. */
918 &child);
920 win_x += f->display.x->border_width;
921 win_y += f->display.x->border_width;
924 /* It is possible for the window returned by the XQueryNotify
925 to become invalid by the time we call XTranslateCoordinates.
926 That can happen when you restart some window managers.
927 If so, we get an error in XTranslateCoordinates.
928 Detect that and try the whole thing over. */
929 if (! x_had_errors_p (FRAME_X_DISPLAY (f)))
930 break;
933 x_uncatch_errors (FRAME_X_DISPLAY (f));
935 *xptr = f->display.x->left_pos - win_x;
936 *yptr = f->display.x->top_pos - win_y;
939 /* Insert a description of internally-recorded parameters of frame X
940 into the parameter alist *ALISTPTR that is to be given to the user.
941 Only parameters that are specific to the X window system
942 and whose values are not correctly recorded in the frame's
943 param_alist need to be considered here. */
945 x_report_frame_params (f, alistptr)
946 struct frame *f;
947 Lisp_Object *alistptr;
949 char buf[16];
951 store_in_alist (alistptr, Qleft, make_number (f->display.x->left_pos));
952 store_in_alist (alistptr, Qtop, make_number (f->display.x->top_pos));
953 store_in_alist (alistptr, Qborder_width,
954 make_number (f->display.x->border_width));
955 store_in_alist (alistptr, Qinternal_border_width,
956 make_number (f->display.x->internal_border_width));
957 sprintf (buf, "%ld", (long) FRAME_X_WINDOW (f));
958 store_in_alist (alistptr, Qwindow_id,
959 build_string (buf));
960 FRAME_SAMPLE_VISIBILITY (f);
961 store_in_alist (alistptr, Qvisibility,
962 (FRAME_VISIBLE_P (f) ? Qt
963 : FRAME_ICONIFIED_P (f) ? Qicon : Qnil));
967 /* Decide if color named COLOR is valid for the display associated with
968 the selected frame; if so, return the rgb values in COLOR_DEF.
969 If ALLOC is nonzero, allocate a new colormap cell. */
972 defined_color (f, color, color_def, alloc)
973 FRAME_PTR f;
974 char *color;
975 XColor *color_def;
976 int alloc;
978 register int status;
979 Colormap screen_colormap;
980 Display *display = FRAME_X_DISPLAY (f);
982 BLOCK_INPUT;
983 screen_colormap = DefaultColormap (display, XDefaultScreen (display));
985 status = XParseColor (display, screen_colormap, color, color_def);
986 if (status && alloc)
988 status = XAllocColor (display, screen_colormap, color_def);
989 if (!status)
991 /* If we got to this point, the colormap is full, so we're
992 going to try and get the next closest color.
993 The algorithm used is a least-squares matching, which is
994 what X uses for closest color matching with StaticColor visuals. */
996 XColor *cells;
997 int no_cells;
998 int nearest;
999 long nearest_delta, trial_delta;
1000 int x;
1002 no_cells = XDisplayCells (display, XDefaultScreen (display));
1003 cells = (XColor *) alloca (sizeof (XColor) * no_cells);
1005 for (x = 0; x < no_cells; x++)
1006 cells[x].pixel = x;
1008 XQueryColors (display, screen_colormap, cells, no_cells);
1009 nearest = 0;
1010 /* I'm assuming CSE so I'm not going to condense this. */
1011 nearest_delta = ((((color_def->red >> 8) - (cells[0].red >> 8))
1012 * ((color_def->red >> 8) - (cells[0].red >> 8)))
1014 (((color_def->green >> 8) - (cells[0].green >> 8))
1015 * ((color_def->green >> 8) - (cells[0].green >> 8)))
1017 (((color_def->blue >> 8) - (cells[0].blue >> 8))
1018 * ((color_def->blue >> 8) - (cells[0].blue >> 8))));
1019 for (x = 1; x < no_cells; x++)
1021 trial_delta = ((((color_def->red >> 8) - (cells[x].red >> 8))
1022 * ((color_def->red >> 8) - (cells[x].red >> 8)))
1024 (((color_def->green >> 8) - (cells[x].green >> 8))
1025 * ((color_def->green >> 8) - (cells[x].green >> 8))) +
1027 (((color_def->blue >> 8) - (cells[x].blue >> 8))
1028 * ((color_def->blue >> 8) - (cells[x].blue >> 8))));
1029 if (trial_delta < nearest_delta)
1031 nearest = x;
1032 nearest_delta = trial_delta;
1035 color_def->red = cells[nearest].red;
1036 color_def->green = cells[nearest].green;
1037 color_def->blue = cells[nearest].blue;
1038 status = XAllocColor (display, screen_colormap, color_def);
1041 UNBLOCK_INPUT;
1043 if (status)
1044 return 1;
1045 else
1046 return 0;
1049 /* Given a string ARG naming a color, compute a pixel value from it
1050 suitable for screen F.
1051 If F is not a color screen, return DEF (default) regardless of what
1052 ARG says. */
1055 x_decode_color (f, arg, def)
1056 FRAME_PTR f;
1057 Lisp_Object arg;
1058 int def;
1060 XColor cdef;
1062 CHECK_STRING (arg, 0);
1064 if (strcmp (XSTRING (arg)->data, "black") == 0)
1065 return BLACK_PIX_DEFAULT (f);
1066 else if (strcmp (XSTRING (arg)->data, "white") == 0)
1067 return WHITE_PIX_DEFAULT (f);
1069 if (FRAME_X_DISPLAY_INFO (f)->n_planes == 1)
1070 return def;
1072 /* Ignore the return value of defined_color so that
1073 we use a color close to the one requested
1074 if we can't get the exact request. */
1075 defined_color (f, XSTRING (arg)->data, &cdef, 1);
1076 return cdef.pixel;
1079 /* Functions called only from `x_set_frame_param'
1080 to set individual parameters.
1082 If FRAME_X_WINDOW (f) is 0,
1083 the frame is being created and its X-window does not exist yet.
1084 In that case, just record the parameter's new value
1085 in the standard place; do not attempt to change the window. */
1087 void
1088 x_set_foreground_color (f, arg, oldval)
1089 struct frame *f;
1090 Lisp_Object arg, oldval;
1092 f->display.x->foreground_pixel
1093 = x_decode_color (f, arg, BLACK_PIX_DEFAULT (f));
1094 if (FRAME_X_WINDOW (f) != 0)
1096 BLOCK_INPUT;
1097 XSetForeground (FRAME_X_DISPLAY (f), f->display.x->normal_gc,
1098 f->display.x->foreground_pixel);
1099 XSetBackground (FRAME_X_DISPLAY (f), f->display.x->reverse_gc,
1100 f->display.x->foreground_pixel);
1101 UNBLOCK_INPUT;
1102 recompute_basic_faces (f);
1103 if (FRAME_VISIBLE_P (f))
1104 redraw_frame (f);
1108 void
1109 x_set_background_color (f, arg, oldval)
1110 struct frame *f;
1111 Lisp_Object arg, oldval;
1113 Pixmap temp;
1114 int mask;
1116 f->display.x->background_pixel
1117 = x_decode_color (f, arg, WHITE_PIX_DEFAULT (f));
1119 if (FRAME_X_WINDOW (f) != 0)
1121 BLOCK_INPUT;
1122 /* The main frame area. */
1123 XSetBackground (FRAME_X_DISPLAY (f), f->display.x->normal_gc,
1124 f->display.x->background_pixel);
1125 XSetForeground (FRAME_X_DISPLAY (f), f->display.x->reverse_gc,
1126 f->display.x->background_pixel);
1127 XSetForeground (FRAME_X_DISPLAY (f), f->display.x->cursor_gc,
1128 f->display.x->background_pixel);
1129 XSetWindowBackground (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
1130 f->display.x->background_pixel);
1132 Lisp_Object bar;
1133 for (bar = FRAME_SCROLL_BARS (f); !NILP (bar);
1134 bar = XSCROLL_BAR (bar)->next)
1135 XSetWindowBackground (FRAME_X_DISPLAY (f),
1136 SCROLL_BAR_X_WINDOW (XSCROLL_BAR (bar)),
1137 f->display.x->background_pixel);
1139 UNBLOCK_INPUT;
1141 recompute_basic_faces (f);
1143 if (FRAME_VISIBLE_P (f))
1144 redraw_frame (f);
1148 void
1149 x_set_mouse_color (f, arg, oldval)
1150 struct frame *f;
1151 Lisp_Object arg, oldval;
1153 Cursor cursor, nontext_cursor, mode_cursor, cross_cursor;
1154 int mask_color;
1156 if (!EQ (Qnil, arg))
1157 f->display.x->mouse_pixel
1158 = x_decode_color (f, arg, BLACK_PIX_DEFAULT (f));
1159 mask_color = f->display.x->background_pixel;
1160 /* No invisible pointers. */
1161 if (mask_color == f->display.x->mouse_pixel
1162 && mask_color == f->display.x->background_pixel)
1163 f->display.x->mouse_pixel = f->display.x->foreground_pixel;
1165 BLOCK_INPUT;
1167 /* It's not okay to crash if the user selects a screwy cursor. */
1168 x_catch_errors (FRAME_X_DISPLAY (f));
1170 if (!EQ (Qnil, Vx_pointer_shape))
1172 CHECK_NUMBER (Vx_pointer_shape, 0);
1173 cursor = XCreateFontCursor (FRAME_X_DISPLAY (f), XINT (Vx_pointer_shape));
1175 else
1176 cursor = XCreateFontCursor (FRAME_X_DISPLAY (f), XC_xterm);
1177 x_check_errors (FRAME_X_DISPLAY (f), "bad text pointer cursor: %s");
1179 if (!EQ (Qnil, Vx_nontext_pointer_shape))
1181 CHECK_NUMBER (Vx_nontext_pointer_shape, 0);
1182 nontext_cursor = XCreateFontCursor (FRAME_X_DISPLAY (f),
1183 XINT (Vx_nontext_pointer_shape));
1185 else
1186 nontext_cursor = XCreateFontCursor (FRAME_X_DISPLAY (f), XC_left_ptr);
1187 x_check_errors (FRAME_X_DISPLAY (f), "bad nontext pointer cursor: %s");
1189 if (!EQ (Qnil, Vx_mode_pointer_shape))
1191 CHECK_NUMBER (Vx_mode_pointer_shape, 0);
1192 mode_cursor = XCreateFontCursor (FRAME_X_DISPLAY (f),
1193 XINT (Vx_mode_pointer_shape));
1195 else
1196 mode_cursor = XCreateFontCursor (FRAME_X_DISPLAY (f), XC_xterm);
1197 x_check_errors (FRAME_X_DISPLAY (f), "bad modeline pointer cursor: %s");
1199 if (!EQ (Qnil, Vx_sensitive_text_pointer_shape))
1201 CHECK_NUMBER (Vx_sensitive_text_pointer_shape, 0);
1202 cross_cursor
1203 = XCreateFontCursor (FRAME_X_DISPLAY (f),
1204 XINT (Vx_sensitive_text_pointer_shape));
1206 else
1207 cross_cursor = XCreateFontCursor (FRAME_X_DISPLAY (f), XC_crosshair);
1209 /* Check and report errors with the above calls. */
1210 x_check_errors (FRAME_X_DISPLAY (f), "can't set cursor shape: %s");
1211 x_uncatch_errors (FRAME_X_DISPLAY (f));
1214 XColor fore_color, back_color;
1216 fore_color.pixel = f->display.x->mouse_pixel;
1217 back_color.pixel = mask_color;
1218 XQueryColor (FRAME_X_DISPLAY (f),
1219 DefaultColormap (FRAME_X_DISPLAY (f),
1220 DefaultScreen (FRAME_X_DISPLAY (f))),
1221 &fore_color);
1222 XQueryColor (FRAME_X_DISPLAY (f),
1223 DefaultColormap (FRAME_X_DISPLAY (f),
1224 DefaultScreen (FRAME_X_DISPLAY (f))),
1225 &back_color);
1226 XRecolorCursor (FRAME_X_DISPLAY (f), cursor,
1227 &fore_color, &back_color);
1228 XRecolorCursor (FRAME_X_DISPLAY (f), nontext_cursor,
1229 &fore_color, &back_color);
1230 XRecolorCursor (FRAME_X_DISPLAY (f), mode_cursor,
1231 &fore_color, &back_color);
1232 XRecolorCursor (FRAME_X_DISPLAY (f), cross_cursor,
1233 &fore_color, &back_color);
1236 if (FRAME_X_WINDOW (f) != 0)
1238 XDefineCursor (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f), cursor);
1241 if (cursor != f->display.x->text_cursor && f->display.x->text_cursor != 0)
1242 XFreeCursor (FRAME_X_DISPLAY (f), f->display.x->text_cursor);
1243 f->display.x->text_cursor = cursor;
1245 if (nontext_cursor != f->display.x->nontext_cursor
1246 && f->display.x->nontext_cursor != 0)
1247 XFreeCursor (FRAME_X_DISPLAY (f), f->display.x->nontext_cursor);
1248 f->display.x->nontext_cursor = nontext_cursor;
1250 if (mode_cursor != f->display.x->modeline_cursor
1251 && f->display.x->modeline_cursor != 0)
1252 XFreeCursor (FRAME_X_DISPLAY (f), f->display.x->modeline_cursor);
1253 f->display.x->modeline_cursor = mode_cursor;
1254 if (cross_cursor != f->display.x->cross_cursor
1255 && f->display.x->cross_cursor != 0)
1256 XFreeCursor (FRAME_X_DISPLAY (f), f->display.x->cross_cursor);
1257 f->display.x->cross_cursor = cross_cursor;
1259 XFlush (FRAME_X_DISPLAY (f));
1260 UNBLOCK_INPUT;
1263 void
1264 x_set_cursor_color (f, arg, oldval)
1265 struct frame *f;
1266 Lisp_Object arg, oldval;
1268 unsigned long fore_pixel;
1270 if (!EQ (Vx_cursor_fore_pixel, Qnil))
1271 fore_pixel = x_decode_color (f, Vx_cursor_fore_pixel,
1272 WHITE_PIX_DEFAULT (f));
1273 else
1274 fore_pixel = f->display.x->background_pixel;
1275 f->display.x->cursor_pixel = x_decode_color (f, arg, BLACK_PIX_DEFAULT (f));
1277 /* Make sure that the cursor color differs from the background color. */
1278 if (f->display.x->cursor_pixel == f->display.x->background_pixel)
1280 f->display.x->cursor_pixel = f->display.x->mouse_pixel;
1281 if (f->display.x->cursor_pixel == fore_pixel)
1282 fore_pixel = f->display.x->background_pixel;
1284 f->display.x->cursor_foreground_pixel = fore_pixel;
1286 if (FRAME_X_WINDOW (f) != 0)
1288 BLOCK_INPUT;
1289 XSetBackground (FRAME_X_DISPLAY (f), f->display.x->cursor_gc,
1290 f->display.x->cursor_pixel);
1291 XSetForeground (FRAME_X_DISPLAY (f), f->display.x->cursor_gc,
1292 fore_pixel);
1293 UNBLOCK_INPUT;
1295 if (FRAME_VISIBLE_P (f))
1297 x_display_cursor (f, 0);
1298 x_display_cursor (f, 1);
1303 /* Set the border-color of frame F to value described by ARG.
1304 ARG can be a string naming a color.
1305 The border-color is used for the border that is drawn by the X server.
1306 Note that this does not fully take effect if done before
1307 F has an x-window; it must be redone when the window is created.
1309 Note: this is done in two routines because of the way X10 works.
1311 Note: under X11, this is normally the province of the window manager,
1312 and so emacs' border colors may be overridden. */
1314 void
1315 x_set_border_color (f, arg, oldval)
1316 struct frame *f;
1317 Lisp_Object arg, oldval;
1319 unsigned char *str;
1320 int pix;
1322 CHECK_STRING (arg, 0);
1323 str = XSTRING (arg)->data;
1325 pix = x_decode_color (f, arg, BLACK_PIX_DEFAULT (f));
1327 x_set_border_pixel (f, pix);
1330 /* Set the border-color of frame F to pixel value PIX.
1331 Note that this does not fully take effect if done before
1332 F has an x-window. */
1334 x_set_border_pixel (f, pix)
1335 struct frame *f;
1336 int pix;
1338 f->display.x->border_pixel = pix;
1340 if (FRAME_X_WINDOW (f) != 0 && f->display.x->border_width > 0)
1342 Pixmap temp;
1343 int mask;
1345 BLOCK_INPUT;
1346 XSetWindowBorder (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
1347 pix);
1348 UNBLOCK_INPUT;
1350 if (FRAME_VISIBLE_P (f))
1351 redraw_frame (f);
1355 void
1356 x_set_cursor_type (f, arg, oldval)
1357 FRAME_PTR f;
1358 Lisp_Object arg, oldval;
1360 if (EQ (arg, Qbar))
1362 FRAME_DESIRED_CURSOR (f) = bar_cursor;
1363 f->display.x->cursor_width = 2;
1365 else if (CONSP (arg) && EQ (XCONS (arg)->car, Qbar)
1366 && INTEGERP (XCONS (arg)->cdr))
1368 FRAME_DESIRED_CURSOR (f) = bar_cursor;
1369 f->display.x->cursor_width = XINT (XCONS (arg)->cdr);
1371 else
1372 /* Treat anything unknown as "box cursor".
1373 It was bad to signal an error; people have trouble fixing
1374 .Xdefaults with Emacs, when it has something bad in it. */
1375 FRAME_DESIRED_CURSOR (f) = filled_box_cursor;
1377 /* Make sure the cursor gets redrawn. This is overkill, but how
1378 often do people change cursor types? */
1379 update_mode_lines++;
1382 void
1383 x_set_icon_type (f, arg, oldval)
1384 struct frame *f;
1385 Lisp_Object arg, oldval;
1387 Lisp_Object tem;
1388 int result;
1390 if (STRINGP (arg))
1392 if (STRINGP (oldval) && EQ (Fstring_equal (oldval, arg), Qt))
1393 return;
1395 else if (!STRINGP (oldval) && EQ (oldval, Qnil) == EQ (arg, Qnil))
1396 return;
1398 BLOCK_INPUT;
1399 if (NILP (arg))
1400 result = x_text_icon (f, 0);
1401 else
1402 result = x_bitmap_icon (f, arg);
1404 if (result)
1406 UNBLOCK_INPUT;
1407 error ("No icon window available");
1410 /* If the window was unmapped (and its icon was mapped),
1411 the new icon is not mapped, so map the window in its stead. */
1412 if (FRAME_VISIBLE_P (f))
1414 #ifdef USE_X_TOOLKIT
1415 XtPopup (f->display.x->widget, XtGrabNone);
1416 #endif
1417 XMapWindow (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f));
1420 XFlush (FRAME_X_DISPLAY (f));
1421 UNBLOCK_INPUT;
1424 /* Return non-nil if frame F wants a bitmap icon. */
1426 Lisp_Object
1427 x_icon_type (f)
1428 FRAME_PTR f;
1430 Lisp_Object tem;
1432 tem = assq_no_quit (Qicon_type, f->param_alist);
1433 if (CONSP (tem))
1434 return XCONS (tem)->cdr;
1435 else
1436 return Qnil;
1439 extern Lisp_Object x_new_font ();
1441 void
1442 x_set_font (f, arg, oldval)
1443 struct frame *f;
1444 Lisp_Object arg, oldval;
1446 Lisp_Object result;
1448 CHECK_STRING (arg, 1);
1450 BLOCK_INPUT;
1451 result = x_new_font (f, XSTRING (arg)->data);
1452 UNBLOCK_INPUT;
1454 if (EQ (result, Qnil))
1455 error ("Font \"%s\" is not defined", XSTRING (arg)->data);
1456 else if (EQ (result, Qt))
1457 error ("the characters of the given font have varying widths");
1458 else if (STRINGP (result))
1460 recompute_basic_faces (f);
1461 store_frame_param (f, Qfont, result);
1463 else
1464 abort ();
1467 void
1468 x_set_border_width (f, arg, oldval)
1469 struct frame *f;
1470 Lisp_Object arg, oldval;
1472 CHECK_NUMBER (arg, 0);
1474 if (XINT (arg) == f->display.x->border_width)
1475 return;
1477 if (FRAME_X_WINDOW (f) != 0)
1478 error ("Cannot change the border width of a window");
1480 f->display.x->border_width = XINT (arg);
1483 void
1484 x_set_internal_border_width (f, arg, oldval)
1485 struct frame *f;
1486 Lisp_Object arg, oldval;
1488 int mask;
1489 int old = f->display.x->internal_border_width;
1491 CHECK_NUMBER (arg, 0);
1492 f->display.x->internal_border_width = XINT (arg);
1493 if (f->display.x->internal_border_width < 0)
1494 f->display.x->internal_border_width = 0;
1496 if (f->display.x->internal_border_width == old)
1497 return;
1499 if (FRAME_X_WINDOW (f) != 0)
1501 BLOCK_INPUT;
1502 x_set_window_size (f, 0, f->width, f->height);
1503 #if 0
1504 x_set_resize_hint (f);
1505 #endif
1506 XFlush (FRAME_X_DISPLAY (f));
1507 UNBLOCK_INPUT;
1508 SET_FRAME_GARBAGED (f);
1512 void
1513 x_set_visibility (f, value, oldval)
1514 struct frame *f;
1515 Lisp_Object value, oldval;
1517 Lisp_Object frame;
1518 XSETFRAME (frame, f);
1520 if (NILP (value))
1521 Fmake_frame_invisible (frame, Qt);
1522 else if (EQ (value, Qicon))
1523 Ficonify_frame (frame);
1524 else
1525 Fmake_frame_visible (frame);
1528 static void
1529 x_set_menu_bar_lines_1 (window, n)
1530 Lisp_Object window;
1531 int n;
1533 struct window *w = XWINDOW (window);
1535 XSETFASTINT (w->top, XFASTINT (w->top) + n);
1536 XSETFASTINT (w->height, XFASTINT (w->height) - n);
1538 /* Handle just the top child in a vertical split. */
1539 if (!NILP (w->vchild))
1540 x_set_menu_bar_lines_1 (w->vchild, n);
1542 /* Adjust all children in a horizontal split. */
1543 for (window = w->hchild; !NILP (window); window = w->next)
1545 w = XWINDOW (window);
1546 x_set_menu_bar_lines_1 (window, n);
1550 void
1551 x_set_menu_bar_lines (f, value, oldval)
1552 struct frame *f;
1553 Lisp_Object value, oldval;
1555 int nlines;
1556 int olines = FRAME_MENU_BAR_LINES (f);
1558 /* Right now, menu bars don't work properly in minibuf-only frames;
1559 most of the commands try to apply themselves to the minibuffer
1560 frame itslef, and get an error because you can't switch buffers
1561 in or split the minibuffer window. */
1562 if (FRAME_MINIBUF_ONLY_P (f))
1563 return;
1565 if (INTEGERP (value))
1566 nlines = XINT (value);
1567 else
1568 nlines = 0;
1570 #ifdef USE_X_TOOLKIT
1571 FRAME_MENU_BAR_LINES (f) = 0;
1572 if (nlines)
1573 FRAME_EXTERNAL_MENU_BAR (f) = 1;
1574 else
1576 if (FRAME_EXTERNAL_MENU_BAR (f) == 1)
1577 free_frame_menubar (f);
1578 FRAME_EXTERNAL_MENU_BAR (f) = 0;
1579 f->display.x->menubar_widget = 0;
1581 #else /* not USE_X_TOOLKIT */
1582 FRAME_MENU_BAR_LINES (f) = nlines;
1583 x_set_menu_bar_lines_1 (f->root_window, nlines - olines);
1584 #endif /* not USE_X_TOOLKIT */
1587 /* Change the name of frame F to NAME. If NAME is nil, set F's name to
1588 x_id_name.
1590 If EXPLICIT is non-zero, that indicates that lisp code is setting the
1591 name; if NAME is a string, set F's name to NAME and set
1592 F->explicit_name; if NAME is Qnil, then clear F->explicit_name.
1594 If EXPLICIT is zero, that indicates that Emacs redisplay code is
1595 suggesting a new name, which lisp code should override; if
1596 F->explicit_name is set, ignore the new name; otherwise, set it. */
1598 void
1599 x_set_name (f, name, explicit)
1600 struct frame *f;
1601 Lisp_Object name;
1602 int explicit;
1604 /* Make sure that requests from lisp code override requests from
1605 Emacs redisplay code. */
1606 if (explicit)
1608 /* If we're switching from explicit to implicit, we had better
1609 update the mode lines and thereby update the title. */
1610 if (f->explicit_name && NILP (name))
1611 update_mode_lines = 1;
1613 f->explicit_name = ! NILP (name);
1615 else if (f->explicit_name)
1616 return;
1618 /* If NAME is nil, set the name to the x_id_name. */
1619 if (NILP (name))
1621 /* Check for no change needed in this very common case
1622 before we do any consing. */
1623 if (!strcmp (FRAME_X_DISPLAY_INFO (f)->x_id_name,
1624 XSTRING (f->name)->data))
1625 return;
1626 name = build_string (FRAME_X_DISPLAY_INFO (f)->x_id_name);
1628 else
1629 CHECK_STRING (name, 0);
1631 /* Don't change the name if it's already NAME. */
1632 if (! NILP (Fstring_equal (name, f->name)))
1633 return;
1635 if (FRAME_X_WINDOW (f))
1637 BLOCK_INPUT;
1638 #ifdef HAVE_X11R4
1640 XTextProperty text;
1641 text.value = XSTRING (name)->data;
1642 text.encoding = XA_STRING;
1643 text.format = 8;
1644 text.nitems = XSTRING (name)->size;
1645 #ifdef USE_X_TOOLKIT
1646 XSetWMName (FRAME_X_DISPLAY (f),
1647 XtWindow (f->display.x->widget), &text);
1648 XSetWMIconName (FRAME_X_DISPLAY (f), XtWindow (f->display.x->widget),
1649 &text);
1650 #else /* not USE_X_TOOLKIT */
1651 XSetWMName (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f), &text);
1652 XSetWMIconName (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f), &text);
1653 #endif /* not USE_X_TOOLKIT */
1655 #else /* not HAVE_X11R4 */
1656 XSetIconName (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
1657 XSTRING (name)->data);
1658 XStoreName (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
1659 XSTRING (name)->data);
1660 #endif /* not HAVE_X11R4 */
1661 UNBLOCK_INPUT;
1664 f->name = name;
1667 /* This function should be called when the user's lisp code has
1668 specified a name for the frame; the name will override any set by the
1669 redisplay code. */
1670 void
1671 x_explicitly_set_name (f, arg, oldval)
1672 FRAME_PTR f;
1673 Lisp_Object arg, oldval;
1675 x_set_name (f, arg, 1);
1678 /* This function should be called by Emacs redisplay code to set the
1679 name; names set this way will never override names set by the user's
1680 lisp code. */
1681 void
1682 x_implicitly_set_name (f, arg, oldval)
1683 FRAME_PTR f;
1684 Lisp_Object arg, oldval;
1686 x_set_name (f, arg, 0);
1689 void
1690 x_set_autoraise (f, arg, oldval)
1691 struct frame *f;
1692 Lisp_Object arg, oldval;
1694 f->auto_raise = !EQ (Qnil, arg);
1697 void
1698 x_set_autolower (f, arg, oldval)
1699 struct frame *f;
1700 Lisp_Object arg, oldval;
1702 f->auto_lower = !EQ (Qnil, arg);
1705 void
1706 x_set_unsplittable (f, arg, oldval)
1707 struct frame *f;
1708 Lisp_Object arg, oldval;
1710 f->no_split = !NILP (arg);
1713 void
1714 x_set_vertical_scroll_bars (f, arg, oldval)
1715 struct frame *f;
1716 Lisp_Object arg, oldval;
1718 if (NILP (arg) != ! FRAME_HAS_VERTICAL_SCROLL_BARS (f))
1720 FRAME_HAS_VERTICAL_SCROLL_BARS (f) = ! NILP (arg);
1722 /* We set this parameter before creating the X window for the
1723 frame, so we can get the geometry right from the start.
1724 However, if the window hasn't been created yet, we shouldn't
1725 call x_set_window_size. */
1726 if (FRAME_X_WINDOW (f))
1727 x_set_window_size (f, 0, FRAME_WIDTH (f), FRAME_HEIGHT (f));
1731 void
1732 x_set_scroll_bar_width (f, arg, oldval)
1733 struct frame *f;
1734 Lisp_Object arg, oldval;
1736 if (NILP (arg))
1738 FRAME_SCROLL_BAR_PIXEL_WIDTH (f) = 0;
1739 FRAME_SCROLL_BAR_COLS (f) = 2;
1741 else if (INTEGERP (arg) && XINT (arg) > 0
1742 && XFASTINT (arg) != FRAME_SCROLL_BAR_PIXEL_WIDTH (f))
1744 int wid = FONT_WIDTH (f->display.x->font);
1745 FRAME_SCROLL_BAR_PIXEL_WIDTH (f) = XFASTINT (arg);
1746 FRAME_SCROLL_BAR_COLS (f) = (XFASTINT (arg) + wid-1) / wid;
1747 if (FRAME_X_WINDOW (f))
1748 x_set_window_size (f, 0, FRAME_WIDTH (f), FRAME_HEIGHT (f));
1752 /* Subroutines of creating an X frame. */
1754 /* Make sure that Vx_resource_name is set to a reasonable value. */
1755 static void
1756 validate_x_resource_name ()
1758 if (STRINGP (Vx_resource_name))
1760 int len = XSTRING (Vx_resource_name)->size;
1761 unsigned char *p = XSTRING (Vx_resource_name)->data;
1762 int i;
1764 /* Allow only letters, digits, - and _,
1765 because those are all that X allows. */
1766 for (i = 0; i < len; i++)
1768 int c = p[i];
1769 if (! ((c >= 'a' && c <= 'z')
1770 || (c >= 'A' && c <= 'Z')
1771 || (c >= '0' && c <= '9')
1772 || c == '-' || c == '_'))
1773 goto fail;
1776 else
1777 fail:
1778 Vx_resource_name = make_string ("emacs", 5);
1782 extern char *x_get_string_resource ();
1784 DEFUN ("x-get-resource", Fx_get_resource, Sx_get_resource, 2, 4, 0,
1785 "Return the value of ATTRIBUTE, of class CLASS, from the X defaults database.\n\
1786 This uses `INSTANCE.ATTRIBUTE' as the key and `Emacs.CLASS' as the\n\
1787 class, where INSTANCE is the name under which Emacs was invoked, or\n\
1788 the name specified by the `-name' or `-rn' command-line arguments.\n\
1790 The optional arguments COMPONENT and SUBCLASS add to the key and the\n\
1791 class, respectively. You must specify both of them or neither.\n\
1792 If you specify them, the key is `INSTANCE.COMPONENT.ATTRIBUTE'\n\
1793 and the class is `Emacs.CLASS.SUBCLASS'.")
1794 (attribute, class, component, subclass)
1795 Lisp_Object attribute, class, component, subclass;
1797 register char *value;
1798 char *name_key;
1799 char *class_key;
1800 Lisp_Object resname;
1802 check_x ();
1804 CHECK_STRING (attribute, 0);
1805 CHECK_STRING (class, 0);
1807 if (!NILP (component))
1808 CHECK_STRING (component, 1);
1809 if (!NILP (subclass))
1810 CHECK_STRING (subclass, 2);
1811 if (NILP (component) != NILP (subclass))
1812 error ("x-get-resource: must specify both COMPONENT and SUBCLASS or neither");
1814 validate_x_resource_name ();
1815 resname = Vx_resource_name;
1817 if (NILP (component))
1819 /* Allocate space for the components, the dots which separate them,
1820 and the final '\0'. */
1821 name_key = (char *) alloca (XSTRING (resname)->size
1822 + XSTRING (attribute)->size
1823 + 2);
1824 class_key = (char *) alloca ((sizeof (EMACS_CLASS) - 1)
1825 + XSTRING (class)->size
1826 + 2);
1828 sprintf (name_key, "%s.%s",
1829 XSTRING (resname)->data,
1830 XSTRING (attribute)->data);
1831 sprintf (class_key, "%s.%s",
1832 EMACS_CLASS,
1833 XSTRING (class)->data);
1835 else
1837 name_key = (char *) alloca (XSTRING (resname)->size
1838 + XSTRING (component)->size
1839 + XSTRING (attribute)->size
1840 + 3);
1842 class_key = (char *) alloca ((sizeof (EMACS_CLASS) - 1)
1843 + XSTRING (class)->size
1844 + XSTRING (subclass)->size
1845 + 3);
1847 sprintf (name_key, "%s.%s.%s",
1848 XSTRING (resname)->data,
1849 XSTRING (component)->data,
1850 XSTRING (attribute)->data);
1851 sprintf (class_key, "%s.%s.%s",
1852 EMACS_CLASS,
1853 XSTRING (class)->data,
1854 XSTRING (subclass)->data);
1857 value = x_get_string_resource (check_x_display_info (Qnil)->xrdb,
1858 name_key, class_key);
1860 if (value != (char *) 0)
1861 return build_string (value);
1862 else
1863 return Qnil;
1866 /* Used when C code wants a resource value. */
1868 char *
1869 x_get_resource_string (attribute, class)
1870 char *attribute, *class;
1872 register char *value;
1873 char *name_key;
1874 char *class_key;
1876 /* Allocate space for the components, the dots which separate them,
1877 and the final '\0'. */
1878 name_key = (char *) alloca (XSTRING (Vinvocation_name)->size
1879 + strlen (attribute) + 2);
1880 class_key = (char *) alloca ((sizeof (EMACS_CLASS) - 1)
1881 + strlen (class) + 2);
1883 sprintf (name_key, "%s.%s",
1884 XSTRING (Vinvocation_name)->data,
1885 attribute);
1886 sprintf (class_key, "%s.%s", EMACS_CLASS, class);
1888 return x_get_string_resource (FRAME_X_DISPLAY_INFO (selected_frame)->xrdb,
1889 name_key, class_key);
1892 /* Types we might convert a resource string into. */
1893 enum resource_types
1895 number, boolean, string, symbol
1898 /* Return the value of parameter PARAM.
1900 First search ALIST, then Vdefault_frame_alist, then the X defaults
1901 database, using ATTRIBUTE as the attribute name and CLASS as its class.
1903 Convert the resource to the type specified by desired_type.
1905 If no default is specified, return Qunbound. If you call
1906 x_get_arg, make sure you deal with Qunbound in a reasonable way,
1907 and don't let it get stored in any Lisp-visible variables! */
1909 static Lisp_Object
1910 x_get_arg (alist, param, attribute, class, type)
1911 Lisp_Object alist, param;
1912 char *attribute;
1913 char *class;
1914 enum resource_types type;
1916 register Lisp_Object tem;
1918 tem = Fassq (param, alist);
1919 if (EQ (tem, Qnil))
1920 tem = Fassq (param, Vdefault_frame_alist);
1921 if (EQ (tem, Qnil))
1924 if (attribute)
1926 tem = Fx_get_resource (build_string (attribute),
1927 build_string (class),
1928 Qnil, Qnil);
1930 if (NILP (tem))
1931 return Qunbound;
1933 switch (type)
1935 case number:
1936 return make_number (atoi (XSTRING (tem)->data));
1938 case boolean:
1939 tem = Fdowncase (tem);
1940 if (!strcmp (XSTRING (tem)->data, "on")
1941 || !strcmp (XSTRING (tem)->data, "true"))
1942 return Qt;
1943 else
1944 return Qnil;
1946 case string:
1947 return tem;
1949 case symbol:
1950 /* As a special case, we map the values `true' and `on'
1951 to Qt, and `false' and `off' to Qnil. */
1953 Lisp_Object lower;
1954 lower = Fdowncase (tem);
1955 if (!strcmp (XSTRING (lower)->data, "on")
1956 || !strcmp (XSTRING (lower)->data, "true"))
1957 return Qt;
1958 else if (!strcmp (XSTRING (lower)->data, "off")
1959 || !strcmp (XSTRING (lower)->data, "false"))
1960 return Qnil;
1961 else
1962 return Fintern (tem, Qnil);
1965 default:
1966 abort ();
1969 else
1970 return Qunbound;
1972 return Fcdr (tem);
1975 /* Record in frame F the specified or default value according to ALIST
1976 of the parameter named PARAM (a Lisp symbol).
1977 If no value is specified for PARAM, look for an X default for XPROP
1978 on the frame named NAME.
1979 If that is not found either, use the value DEFLT. */
1981 static Lisp_Object
1982 x_default_parameter (f, alist, prop, deflt, xprop, xclass, type)
1983 struct frame *f;
1984 Lisp_Object alist;
1985 Lisp_Object prop;
1986 Lisp_Object deflt;
1987 char *xprop;
1988 char *xclass;
1989 enum resource_types type;
1991 Lisp_Object tem;
1993 tem = x_get_arg (alist, prop, xprop, xclass, type);
1994 if (EQ (tem, Qunbound))
1995 tem = deflt;
1996 x_set_frame_parameters (f, Fcons (Fcons (prop, tem), Qnil));
1997 return tem;
2000 DEFUN ("x-parse-geometry", Fx_parse_geometry, Sx_parse_geometry, 1, 1, 0,
2001 "Parse an X-style geometry string STRING.\n\
2002 Returns an alist of the form ((top . TOP), (left . LEFT) ... ).\n\
2003 The properties returned may include `top', `left', `height', and `width'.\n\
2004 The value of `left' or `top' may be an integer,\n\
2005 or a list (+ N) meaning N pixels relative to top/left corner,\n\
2006 or a list (- N) meaning -N pixels relative to bottom/right corner.")
2007 (string)
2008 Lisp_Object string;
2010 int geometry, x, y;
2011 unsigned int width, height;
2012 Lisp_Object result;
2014 CHECK_STRING (string, 0);
2016 geometry = XParseGeometry ((char *) XSTRING (string)->data,
2017 &x, &y, &width, &height);
2019 #if 0
2020 if (!!(geometry & XValue) != !!(geometry & YValue))
2021 error ("Must specify both x and y position, or neither");
2022 #endif
2024 result = Qnil;
2025 if (geometry & XValue)
2027 Lisp_Object element;
2029 if (x >= 0 && (geometry & XNegative))
2030 element = Fcons (Qleft, Fcons (Qminus, Fcons (make_number (-x), Qnil)));
2031 else if (x < 0 && ! (geometry & XNegative))
2032 element = Fcons (Qleft, Fcons (Qplus, Fcons (make_number (x), Qnil)));
2033 else
2034 element = Fcons (Qleft, make_number (x));
2035 result = Fcons (element, result);
2038 if (geometry & YValue)
2040 Lisp_Object element;
2042 if (y >= 0 && (geometry & YNegative))
2043 element = Fcons (Qtop, Fcons (Qminus, Fcons (make_number (-y), Qnil)));
2044 else if (y < 0 && ! (geometry & YNegative))
2045 element = Fcons (Qtop, Fcons (Qplus, Fcons (make_number (y), Qnil)));
2046 else
2047 element = Fcons (Qtop, make_number (y));
2048 result = Fcons (element, result);
2051 if (geometry & WidthValue)
2052 result = Fcons (Fcons (Qwidth, make_number (width)), result);
2053 if (geometry & HeightValue)
2054 result = Fcons (Fcons (Qheight, make_number (height)), result);
2056 return result;
2059 /* Calculate the desired size and position of this window,
2060 and return the flags saying which aspects were specified.
2062 This function does not make the coordinates positive. */
2064 #define DEFAULT_ROWS 40
2065 #define DEFAULT_COLS 80
2067 static int
2068 x_figure_window_size (f, parms)
2069 struct frame *f;
2070 Lisp_Object parms;
2072 register Lisp_Object tem0, tem1, tem2;
2073 int height, width, left, top;
2074 register int geometry;
2075 long window_prompting = 0;
2077 /* Default values if we fall through.
2078 Actually, if that happens we should get
2079 window manager prompting. */
2080 f->width = DEFAULT_COLS;
2081 f->height = DEFAULT_ROWS;
2082 /* Window managers expect that if program-specified
2083 positions are not (0,0), they're intentional, not defaults. */
2084 f->display.x->top_pos = 0;
2085 f->display.x->left_pos = 0;
2087 tem0 = x_get_arg (parms, Qheight, 0, 0, number);
2088 tem1 = x_get_arg (parms, Qwidth, 0, 0, number);
2089 tem2 = x_get_arg (parms, Quser_size, 0, 0, number);
2090 if (! EQ (tem0, Qunbound) || ! EQ (tem1, Qunbound))
2092 if (!EQ (tem0, Qunbound))
2094 CHECK_NUMBER (tem0, 0);
2095 f->height = XINT (tem0);
2097 if (!EQ (tem1, Qunbound))
2099 CHECK_NUMBER (tem1, 0);
2100 f->width = XINT (tem1);
2102 if (!NILP (tem2) && !EQ (tem2, Qunbound))
2103 window_prompting |= USSize;
2104 else
2105 window_prompting |= PSize;
2108 f->display.x->vertical_scroll_bar_extra
2109 = (!FRAME_HAS_VERTICAL_SCROLL_BARS (f)
2111 : FRAME_SCROLL_BAR_PIXEL_WIDTH (f) > 0
2112 ? FRAME_SCROLL_BAR_PIXEL_WIDTH (f)
2113 : (FRAME_SCROLL_BAR_COLS (f) * FONT_WIDTH (f->display.x->font)));
2114 f->display.x->pixel_width = CHAR_TO_PIXEL_WIDTH (f, f->width);
2115 f->display.x->pixel_height = CHAR_TO_PIXEL_HEIGHT (f, f->height);
2117 tem0 = x_get_arg (parms, Qtop, 0, 0, number);
2118 tem1 = x_get_arg (parms, Qleft, 0, 0, number);
2119 tem2 = x_get_arg (parms, Quser_position, 0, 0, number);
2120 if (! EQ (tem0, Qunbound) || ! EQ (tem1, Qunbound))
2122 if (EQ (tem0, Qminus))
2124 f->display.x->top_pos = 0;
2125 window_prompting |= YNegative;
2127 else if (CONSP (tem0) && EQ (XCONS (tem0)->car, Qminus)
2128 && CONSP (XCONS (tem0)->cdr)
2129 && INTEGERP (XCONS (XCONS (tem0)->cdr)->car))
2131 f->display.x->top_pos = - XINT (XCONS (XCONS (tem0)->cdr)->car);
2132 window_prompting |= YNegative;
2134 else if (CONSP (tem0) && EQ (XCONS (tem0)->car, Qplus)
2135 && CONSP (XCONS (tem0)->cdr)
2136 && INTEGERP (XCONS (XCONS (tem0)->cdr)->car))
2138 f->display.x->top_pos = XINT (XCONS (XCONS (tem0)->cdr)->car);
2140 else if (EQ (tem0, Qunbound))
2141 f->display.x->top_pos = 0;
2142 else
2144 CHECK_NUMBER (tem0, 0);
2145 f->display.x->top_pos = XINT (tem0);
2146 if (f->display.x->top_pos < 0)
2147 window_prompting |= YNegative;
2150 if (EQ (tem1, Qminus))
2152 f->display.x->left_pos = 0;
2153 window_prompting |= XNegative;
2155 else if (CONSP (tem1) && EQ (XCONS (tem1)->car, Qminus)
2156 && CONSP (XCONS (tem1)->cdr)
2157 && INTEGERP (XCONS (XCONS (tem1)->cdr)->car))
2159 f->display.x->left_pos = - XINT (XCONS (XCONS (tem1)->cdr)->car);
2160 window_prompting |= XNegative;
2162 else if (CONSP (tem1) && EQ (XCONS (tem1)->car, Qplus)
2163 && CONSP (XCONS (tem1)->cdr)
2164 && INTEGERP (XCONS (XCONS (tem1)->cdr)->car))
2166 f->display.x->left_pos = XINT (XCONS (XCONS (tem1)->cdr)->car);
2168 else if (EQ (tem1, Qunbound))
2169 f->display.x->left_pos = 0;
2170 else
2172 CHECK_NUMBER (tem1, 0);
2173 f->display.x->left_pos = XINT (tem1);
2174 if (f->display.x->left_pos < 0)
2175 window_prompting |= XNegative;
2178 if (!NILP (tem2) && ! EQ (tem2, Qunbound))
2179 window_prompting |= USPosition;
2180 else
2181 window_prompting |= PPosition;
2184 return window_prompting;
2187 #if !defined (HAVE_X11R4) && !defined (HAVE_XSETWMPROTOCOLS)
2189 Status
2190 XSetWMProtocols (dpy, w, protocols, count)
2191 Display *dpy;
2192 Window w;
2193 Atom *protocols;
2194 int count;
2196 Atom prop;
2197 prop = XInternAtom (dpy, "WM_PROTOCOLS", False);
2198 if (prop == None) return False;
2199 XChangeProperty (dpy, w, prop, XA_ATOM, 32, PropModeReplace,
2200 (unsigned char *) protocols, count);
2201 return True;
2203 #endif /* not HAVE_X11R4 && not HAVE_XSETWMPROTOCOLS */
2205 #ifdef USE_X_TOOLKIT
2207 /* If the WM_PROTOCOLS property does not already contain WM_TAKE_FOCUS,
2208 WM_DELETE_WINDOW, and WM_SAVE_YOURSELF, then add them. (They may
2209 already be present because of the toolkit (Motif adds some of them,
2210 for example, but Xt doesn't). */
2212 static void
2213 hack_wm_protocols (f, widget)
2214 FRAME_PTR f;
2215 Widget widget;
2217 Display *dpy = XtDisplay (widget);
2218 Window w = XtWindow (widget);
2219 int need_delete = 1;
2220 int need_focus = 1;
2221 int need_save = 1;
2223 BLOCK_INPUT;
2225 Atom type, *atoms = 0;
2226 int format = 0;
2227 unsigned long nitems = 0;
2228 unsigned long bytes_after;
2230 if (Success == XGetWindowProperty (dpy, w,
2231 FRAME_X_DISPLAY_INFO (f)->Xatom_wm_protocols,
2232 0, 100, False, XA_ATOM,
2233 &type, &format, &nitems, &bytes_after,
2234 (unsigned char **) &atoms)
2235 && format == 32 && type == XA_ATOM)
2236 while (nitems > 0)
2238 nitems--;
2239 if (atoms[nitems] == FRAME_X_DISPLAY_INFO (f)->Xatom_wm_delete_window)
2240 need_delete = 0;
2241 else if (atoms[nitems] == FRAME_X_DISPLAY_INFO (f)->Xatom_wm_take_focus)
2242 need_focus = 0;
2243 else if (atoms[nitems] == FRAME_X_DISPLAY_INFO (f)->Xatom_wm_save_yourself)
2244 need_save = 0;
2246 if (atoms) XFree ((char *) atoms);
2249 Atom props [10];
2250 int count = 0;
2251 if (need_delete)
2252 props[count++] = FRAME_X_DISPLAY_INFO (f)->Xatom_wm_delete_window;
2253 if (need_focus)
2254 props[count++] = FRAME_X_DISPLAY_INFO (f)->Xatom_wm_take_focus;
2255 if (need_save)
2256 props[count++] = FRAME_X_DISPLAY_INFO (f)->Xatom_wm_save_yourself;
2257 if (count)
2258 XChangeProperty (dpy, w, FRAME_X_DISPLAY_INFO (f)->Xatom_wm_protocols,
2259 XA_ATOM, 32, PropModeAppend,
2260 (unsigned char *) props, count);
2262 UNBLOCK_INPUT;
2264 #endif
2266 #ifdef USE_X_TOOLKIT
2268 /* Create and set up the X widget for frame F. */
2270 static void
2271 x_window (f, window_prompting, minibuffer_only)
2272 struct frame *f;
2273 long window_prompting;
2274 int minibuffer_only;
2276 XClassHint class_hints;
2277 XSetWindowAttributes attributes;
2278 unsigned long attribute_mask;
2280 Widget shell_widget;
2281 Widget pane_widget;
2282 Widget frame_widget;
2283 char* name;
2284 Arg al [25];
2285 int ac;
2287 BLOCK_INPUT;
2289 if (STRINGP (f->name))
2290 name = (char*) XSTRING (f->name)->data;
2291 else
2292 name = "emacs";
2294 ac = 0;
2295 XtSetArg (al[ac], XtNallowShellResize, 1); ac++;
2296 XtSetArg (al[ac], XtNinput, 1); ac++;
2297 shell_widget = XtAppCreateShell (name, EMACS_CLASS,
2298 topLevelShellWidgetClass,
2299 FRAME_X_DISPLAY (f), al, ac);
2301 f->display.x->widget = shell_widget;
2302 /* maybe_set_screen_title_format (shell_widget); */
2304 pane_widget = lw_create_widget ("main", "pane", widget_id_tick++,
2305 (widget_value *) NULL,
2306 shell_widget, False,
2307 (lw_callback) NULL,
2308 (lw_callback) NULL,
2309 (lw_callback) NULL);
2311 f->display.x->column_widget = pane_widget;
2313 if (!minibuffer_only && FRAME_EXTERNAL_MENU_BAR (f))
2314 initialize_frame_menubar (f);
2316 /* mappedWhenManaged to false tells to the paned window to not map/unmap
2317 the emacs screen when changing menubar. This reduces flickering. */
2319 ac = 0;
2320 XtSetArg (al[ac], XtNmappedWhenManaged, 0); ac++;
2321 XtSetArg (al[ac], XtNshowGrip, 0); ac++;
2322 XtSetArg (al[ac], XtNallowResize, 1); ac++;
2323 XtSetArg (al[ac], XtNresizeToPreferred, 1); ac++;
2324 XtSetArg (al[ac], XtNemacsFrame, f); ac++;
2325 frame_widget = XtCreateWidget (name,
2326 emacsFrameClass,
2327 pane_widget, al, ac);
2328 lw_set_main_areas (pane_widget, f->display.x->menubar_widget, frame_widget);
2330 f->display.x->edit_widget = frame_widget;
2332 if (f->display.x->menubar_widget)
2333 XtManageChild (f->display.x->menubar_widget);
2334 XtManageChild (frame_widget);
2336 /* Do some needed geometry management. */
2338 int len;
2339 char *tem, shell_position[32];
2340 Arg al[2];
2341 int ac = 0;
2342 int menubar_size
2343 = (f->display.x->menubar_widget
2344 ? (f->display.x->menubar_widget->core.height
2345 + f->display.x->menubar_widget->core.border_width)
2346 : 0);
2348 if (FRAME_EXTERNAL_MENU_BAR (f))
2350 Dimension ibw = 0;
2351 XtVaGetValues (pane_widget, XtNinternalBorderWidth, &ibw, NULL);
2352 menubar_size += ibw;
2355 if (window_prompting & USPosition)
2357 int left = f->display.x->left_pos;
2358 int xneg = window_prompting & XNegative;
2359 int top = f->display.x->top_pos;
2360 int yneg = window_prompting & YNegative;
2361 if (xneg)
2362 left = -left;
2363 if (yneg)
2364 top = -top;
2365 sprintf (shell_position, "=%dx%d%c%d%c%d", PIXEL_WIDTH (f),
2366 PIXEL_HEIGHT (f) + menubar_size,
2367 (xneg ? '-' : '+'), left,
2368 (yneg ? '-' : '+'), top);
2370 else
2371 sprintf (shell_position, "=%dx%d", PIXEL_WIDTH (f),
2372 PIXEL_HEIGHT (f) + menubar_size);
2373 len = strlen (shell_position) + 1;
2374 tem = (char *) xmalloc (len);
2375 strncpy (tem, shell_position, len);
2376 XtSetArg (al[ac], XtNgeometry, tem); ac++;
2377 XtSetValues (shell_widget, al, ac);
2380 x_calc_absolute_position (f);
2382 XtManageChild (pane_widget);
2383 XtRealizeWidget (shell_widget);
2385 FRAME_X_WINDOW (f) = XtWindow (frame_widget);
2387 validate_x_resource_name ();
2388 class_hints.res_name = (char *) XSTRING (Vx_resource_name)->data;
2389 class_hints.res_class = EMACS_CLASS;
2390 XSetClassHint (FRAME_X_DISPLAY (f), XtWindow (shell_widget), &class_hints);
2392 f->display.x->wm_hints.input = True;
2393 f->display.x->wm_hints.flags |= InputHint;
2394 XSetWMHints (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
2395 &f->display.x->wm_hints);
2397 hack_wm_protocols (f, shell_widget);
2399 #ifdef HACK_EDITRES
2400 XtAddEventHandler (shell_widget, 0, True, _XEditResCheckMessages, 0);
2401 #endif
2403 /* Do a stupid property change to force the server to generate a
2404 propertyNotify event so that the event_stream server timestamp will
2405 be initialized to something relevant to the time we created the window.
2407 XChangeProperty (XtDisplay (frame_widget), XtWindow (frame_widget),
2408 FRAME_X_DISPLAY_INFO (f)->Xatom_wm_protocols,
2409 XA_ATOM, 32, PropModeAppend,
2410 (unsigned char*) NULL, 0);
2412 /* Make all the standard events reach the Emacs frame. */
2413 attributes.event_mask = STANDARD_EVENT_SET;
2414 attribute_mask = CWEventMask;
2415 XChangeWindowAttributes (XtDisplay (shell_widget), XtWindow (shell_widget),
2416 attribute_mask, &attributes);
2418 XtMapWidget (frame_widget);
2420 /* x_set_name normally ignores requests to set the name if the
2421 requested name is the same as the current name. This is the one
2422 place where that assumption isn't correct; f->name is set, but
2423 the X server hasn't been told. */
2425 Lisp_Object name;
2426 int explicit = f->explicit_name;
2428 f->explicit_name = 0;
2429 name = f->name;
2430 f->name = Qnil;
2431 x_set_name (f, name, explicit);
2434 XDefineCursor (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
2435 f->display.x->text_cursor);
2437 UNBLOCK_INPUT;
2439 if (FRAME_X_WINDOW (f) == 0)
2440 error ("Unable to create window");
2443 #else /* not USE_X_TOOLKIT */
2445 /* Create and set up the X window for frame F. */
2447 x_window (f)
2448 struct frame *f;
2451 XClassHint class_hints;
2452 XSetWindowAttributes attributes;
2453 unsigned long attribute_mask;
2455 attributes.background_pixel = f->display.x->background_pixel;
2456 attributes.border_pixel = f->display.x->border_pixel;
2457 attributes.bit_gravity = StaticGravity;
2458 attributes.backing_store = NotUseful;
2459 attributes.save_under = True;
2460 attributes.event_mask = STANDARD_EVENT_SET;
2461 attribute_mask = (CWBackPixel | CWBorderPixel | CWBitGravity
2462 #if 0
2463 | CWBackingStore | CWSaveUnder
2464 #endif
2465 | CWEventMask);
2467 BLOCK_INPUT;
2468 FRAME_X_WINDOW (f)
2469 = XCreateWindow (FRAME_X_DISPLAY (f),
2470 f->display.x->parent_desc,
2471 f->display.x->left_pos,
2472 f->display.x->top_pos,
2473 PIXEL_WIDTH (f), PIXEL_HEIGHT (f),
2474 f->display.x->border_width,
2475 CopyFromParent, /* depth */
2476 InputOutput, /* class */
2477 FRAME_X_DISPLAY_INFO (f)->visual,
2478 attribute_mask, &attributes);
2480 validate_x_resource_name ();
2481 class_hints.res_name = (char *) XSTRING (Vx_resource_name)->data;
2482 class_hints.res_class = EMACS_CLASS;
2483 XSetClassHint (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f), &class_hints);
2485 /* This indicates that we use the "Passive Input" input model.
2486 Unless we do this, we don't get the Focus{In,Out} events that we
2487 need to draw the cursor correctly. Accursed bureaucrats.
2488 XWhipsAndChains (FRAME_X_DISPLAY (f), IronMaiden, &TheRack); */
2490 f->display.x->wm_hints.input = True;
2491 f->display.x->wm_hints.flags |= InputHint;
2492 XSetWMHints (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
2493 &f->display.x->wm_hints);
2495 /* Request "save yourself" and "delete window" commands from wm. */
2497 Atom protocols[2];
2498 protocols[0] = FRAME_X_DISPLAY_INFO (f)->Xatom_wm_delete_window;
2499 protocols[1] = FRAME_X_DISPLAY_INFO (f)->Xatom_wm_save_yourself;
2500 XSetWMProtocols (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f), protocols, 2);
2503 /* x_set_name normally ignores requests to set the name if the
2504 requested name is the same as the current name. This is the one
2505 place where that assumption isn't correct; f->name is set, but
2506 the X server hasn't been told. */
2508 Lisp_Object name;
2509 int explicit = f->explicit_name;
2511 f->explicit_name = 0;
2512 name = f->name;
2513 f->name = Qnil;
2514 x_set_name (f, name, explicit);
2517 XDefineCursor (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
2518 f->display.x->text_cursor);
2520 UNBLOCK_INPUT;
2522 if (FRAME_X_WINDOW (f) == 0)
2523 error ("Unable to create window");
2526 #endif /* not USE_X_TOOLKIT */
2528 /* Handle the icon stuff for this window. Perhaps later we might
2529 want an x_set_icon_position which can be called interactively as
2530 well. */
2532 static void
2533 x_icon (f, parms)
2534 struct frame *f;
2535 Lisp_Object parms;
2537 Lisp_Object icon_x, icon_y;
2539 /* Set the position of the icon. Note that twm groups all
2540 icons in an icon window. */
2541 icon_x = x_get_arg (parms, Qicon_left, 0, 0, number);
2542 icon_y = x_get_arg (parms, Qicon_top, 0, 0, number);
2543 if (!EQ (icon_x, Qunbound) && !EQ (icon_y, Qunbound))
2545 CHECK_NUMBER (icon_x, 0);
2546 CHECK_NUMBER (icon_y, 0);
2548 else if (!EQ (icon_x, Qunbound) || !EQ (icon_y, Qunbound))
2549 error ("Both left and top icon corners of icon must be specified");
2551 BLOCK_INPUT;
2553 if (! EQ (icon_x, Qunbound))
2554 x_wm_set_icon_position (f, XINT (icon_x), XINT (icon_y));
2556 /* Start up iconic or window? */
2557 x_wm_set_window_state
2558 (f, (EQ (x_get_arg (parms, Qvisibility, 0, 0, symbol), Qicon)
2559 ? IconicState
2560 : NormalState));
2562 UNBLOCK_INPUT;
2565 /* Make the GC's needed for this window, setting the
2566 background, border and mouse colors; also create the
2567 mouse cursor and the gray border tile. */
2569 static char cursor_bits[] =
2571 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
2572 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
2573 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
2574 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00
2577 static void
2578 x_make_gc (f)
2579 struct frame *f;
2581 XGCValues gc_values;
2582 GC temp_gc;
2583 XImage tileimage;
2585 BLOCK_INPUT;
2587 /* Create the GC's of this frame.
2588 Note that many default values are used. */
2590 /* Normal video */
2591 gc_values.font = f->display.x->font->fid;
2592 gc_values.foreground = f->display.x->foreground_pixel;
2593 gc_values.background = f->display.x->background_pixel;
2594 gc_values.line_width = 0; /* Means 1 using fast algorithm. */
2595 f->display.x->normal_gc = XCreateGC (FRAME_X_DISPLAY (f),
2596 FRAME_X_WINDOW (f),
2597 GCLineWidth | GCFont
2598 | GCForeground | GCBackground,
2599 &gc_values);
2601 /* Reverse video style. */
2602 gc_values.foreground = f->display.x->background_pixel;
2603 gc_values.background = f->display.x->foreground_pixel;
2604 f->display.x->reverse_gc = XCreateGC (FRAME_X_DISPLAY (f),
2605 FRAME_X_WINDOW (f),
2606 GCFont | GCForeground | GCBackground
2607 | GCLineWidth,
2608 &gc_values);
2610 /* Cursor has cursor-color background, background-color foreground. */
2611 gc_values.foreground = f->display.x->background_pixel;
2612 gc_values.background = f->display.x->cursor_pixel;
2613 gc_values.fill_style = FillOpaqueStippled;
2614 gc_values.stipple
2615 = XCreateBitmapFromData (FRAME_X_DISPLAY (f),
2616 FRAME_X_DISPLAY_INFO (f)->root_window,
2617 cursor_bits, 16, 16);
2618 f->display.x->cursor_gc
2619 = XCreateGC (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
2620 (GCFont | GCForeground | GCBackground
2621 | GCFillStyle | GCStipple | GCLineWidth),
2622 &gc_values);
2624 /* Create the gray border tile used when the pointer is not in
2625 the frame. Since this depends on the frame's pixel values,
2626 this must be done on a per-frame basis. */
2627 f->display.x->border_tile
2628 = (XCreatePixmapFromBitmapData
2629 (FRAME_X_DISPLAY (f), FRAME_X_DISPLAY_INFO (f)->root_window,
2630 gray_bits, gray_width, gray_height,
2631 f->display.x->foreground_pixel,
2632 f->display.x->background_pixel,
2633 DefaultDepth (FRAME_X_DISPLAY (f),
2634 XScreenNumberOfScreen (FRAME_X_SCREEN (f)))));
2636 UNBLOCK_INPUT;
2639 DEFUN ("x-create-frame", Fx_create_frame, Sx_create_frame,
2640 1, 1, 0,
2641 "Make a new X window, which is called a \"frame\" in Emacs terms.\n\
2642 Returns an Emacs frame object.\n\
2643 ALIST is an alist of frame parameters.\n\
2644 If the parameters specify that the frame should not have a minibuffer,\n\
2645 and do not specify a specific minibuffer window to use,\n\
2646 then `default-minibuffer-frame' must be a frame whose minibuffer can\n\
2647 be shared by the new frame.\n\
2649 This function is an internal primitive--use `make-frame' instead.")
2650 (parms)
2651 Lisp_Object parms;
2653 struct frame *f;
2654 Lisp_Object frame, tem;
2655 Lisp_Object name;
2656 int minibuffer_only = 0;
2657 long window_prompting = 0;
2658 int width, height;
2659 int count = specpdl_ptr - specpdl;
2660 struct gcpro gcpro1;
2661 Lisp_Object display;
2662 struct x_display_info *dpyinfo;
2663 Lisp_Object parent;
2665 check_x ();
2667 display = x_get_arg (parms, Qdisplay, 0, 0, 0);
2668 if (EQ (display, Qunbound))
2669 display = Qnil;
2670 dpyinfo = check_x_display_info (display);
2672 name = x_get_arg (parms, Qname, "title", "Title", string);
2673 if (!STRINGP (name)
2674 && ! EQ (name, Qunbound)
2675 && ! NILP (name))
2676 error ("Invalid frame name--not a string or nil");
2678 /* See if parent window is specified. */
2679 parent = x_get_arg (parms, Qparent_id, NULL, NULL, number);
2680 if (EQ (parent, Qunbound))
2681 parent = Qnil;
2682 if (! NILP (parent))
2683 CHECK_NUMBER (parent, 0);
2685 tem = x_get_arg (parms, Qminibuffer, 0, 0, symbol);
2686 if (EQ (tem, Qnone) || NILP (tem))
2687 f = make_frame_without_minibuffer (Qnil);
2688 else if (EQ (tem, Qonly))
2690 f = make_minibuffer_frame ();
2691 minibuffer_only = 1;
2693 else if (WINDOWP (tem))
2694 f = make_frame_without_minibuffer (tem);
2695 else
2696 f = make_frame (1);
2698 /* Note that X Windows does support scroll bars. */
2699 FRAME_CAN_HAVE_SCROLL_BARS (f) = 1;
2701 XSETFRAME (frame, f);
2702 GCPRO1 (frame);
2704 f->output_method = output_x_window;
2705 f->display.x = (struct x_display *) xmalloc (sizeof (struct x_display));
2706 bzero (f->display.x, sizeof (struct x_display));
2707 f->display.x->icon_bitmap = -1;
2709 FRAME_X_DISPLAY_INFO (f) = dpyinfo;
2711 /* Specify the parent under which to make this X window. */
2713 if (!NILP (parent))
2715 f->display.x->parent_desc = parent;
2716 f->display.x->explicit_parent = 1;
2718 else
2720 f->display.x->parent_desc = FRAME_X_DISPLAY_INFO (f)->root_window;
2721 f->display.x->explicit_parent = 0;
2724 /* Note that the frame has no physical cursor right now. */
2725 f->phys_cursor_x = -1;
2727 /* Set the name; the functions to which we pass f expect the name to
2728 be set. */
2729 if (EQ (name, Qunbound) || NILP (name))
2731 f->name = build_string (dpyinfo->x_id_name);
2732 f->explicit_name = 0;
2734 else
2736 f->name = name;
2737 f->explicit_name = 1;
2738 /* use the frame's title when getting resources for this frame. */
2739 specbind (Qx_resource_name, name);
2742 /* Extract the window parameters from the supplied values
2743 that are needed to determine window geometry. */
2745 Lisp_Object font;
2747 font = x_get_arg (parms, Qfont, "font", "Font", string);
2748 BLOCK_INPUT;
2749 /* First, try whatever font the caller has specified. */
2750 if (STRINGP (font))
2751 font = x_new_font (f, XSTRING (font)->data);
2752 /* Try out a font which we hope has bold and italic variations. */
2753 if (!STRINGP (font))
2754 font = x_new_font (f, "-misc-fixed-medium-r-normal-*-*-140-*-*-c-*-iso8859-1");
2755 if (! STRINGP (font))
2756 font = x_new_font (f, "-*-*-medium-r-normal-*-*-140-*-*-c-*-iso8859-1");
2757 if (! STRINGP (font))
2758 /* This was formerly the first thing tried, but it finds too many fonts
2759 and takes too long. */
2760 font = x_new_font (f, "-*-*-medium-r-*-*-*-*-*-*-c-*-iso8859-1");
2761 /* If those didn't work, look for something which will at least work. */
2762 if (! STRINGP (font))
2763 font = x_new_font (f, "-*-fixed-*-*-*-*-*-140-*-*-c-*-iso8859-1");
2764 UNBLOCK_INPUT;
2765 if (! STRINGP (font))
2766 font = build_string ("fixed");
2768 x_default_parameter (f, parms, Qfont, font,
2769 "font", "Font", string);
2772 #ifdef USE_X_TOOLKIT
2773 /* Prevent lwlib/xlwmenu.c from crashing because of a bug
2774 whereby it fails to get any font. */
2775 xlwmenu_default_font = f->display.x->font;
2776 #endif
2778 x_default_parameter (f, parms, Qborder_width, make_number (2),
2779 "borderwidth", "BorderWidth", number);
2780 /* This defaults to 2 in order to match xterm. We recognize either
2781 internalBorderWidth or internalBorder (which is what xterm calls
2782 it). */
2783 if (NILP (Fassq (Qinternal_border_width, parms)))
2785 Lisp_Object value;
2787 value = x_get_arg (parms, Qinternal_border_width,
2788 "internalBorder", "BorderWidth", number);
2789 if (! EQ (value, Qunbound))
2790 parms = Fcons (Fcons (Qinternal_border_width, value),
2791 parms);
2793 x_default_parameter (f, parms, Qinternal_border_width, make_number (2),
2794 "internalBorderWidth", "BorderWidth", number);
2795 x_default_parameter (f, parms, Qvertical_scroll_bars, Qt,
2796 "verticalScrollBars", "ScrollBars", boolean);
2798 /* Also do the stuff which must be set before the window exists. */
2799 x_default_parameter (f, parms, Qforeground_color, build_string ("black"),
2800 "foreground", "Foreground", string);
2801 x_default_parameter (f, parms, Qbackground_color, build_string ("white"),
2802 "background", "Background", string);
2803 x_default_parameter (f, parms, Qmouse_color, build_string ("black"),
2804 "pointerColor", "Foreground", string);
2805 x_default_parameter (f, parms, Qcursor_color, build_string ("black"),
2806 "cursorColor", "Foreground", string);
2807 x_default_parameter (f, parms, Qborder_color, build_string ("black"),
2808 "borderColor", "BorderColor", string);
2810 x_default_parameter (f, parms, Qmenu_bar_lines, make_number (1),
2811 "menuBar", "MenuBar", number);
2812 x_default_parameter (f, parms, Qscroll_bar_width, Qnil,
2813 "scrollBarWidth", "ScrollBarWidth", number);
2815 f->display.x->parent_desc = FRAME_X_DISPLAY_INFO (f)->root_window;
2816 window_prompting = x_figure_window_size (f, parms);
2818 if (window_prompting & XNegative)
2820 if (window_prompting & YNegative)
2821 f->display.x->win_gravity = SouthEastGravity;
2822 else
2823 f->display.x->win_gravity = NorthEastGravity;
2825 else
2827 if (window_prompting & YNegative)
2828 f->display.x->win_gravity = SouthWestGravity;
2829 else
2830 f->display.x->win_gravity = NorthWestGravity;
2833 f->display.x->size_hint_flags = window_prompting;
2835 #ifdef USE_X_TOOLKIT
2836 x_window (f, window_prompting, minibuffer_only);
2837 #else
2838 x_window (f);
2839 #endif
2840 x_icon (f, parms);
2841 x_make_gc (f);
2842 init_frame_faces (f);
2844 /* We need to do this after creating the X window, so that the
2845 icon-creation functions can say whose icon they're describing. */
2846 x_default_parameter (f, parms, Qicon_type, Qnil,
2847 "bitmapIcon", "BitmapIcon", symbol);
2849 x_default_parameter (f, parms, Qauto_raise, Qnil,
2850 "autoRaise", "AutoRaiseLower", boolean);
2851 x_default_parameter (f, parms, Qauto_lower, Qnil,
2852 "autoLower", "AutoRaiseLower", boolean);
2853 x_default_parameter (f, parms, Qcursor_type, Qbox,
2854 "cursorType", "CursorType", symbol);
2856 /* Dimensions, especially f->height, must be done via change_frame_size.
2857 Change will not be effected unless different from the current
2858 f->height. */
2859 width = f->width;
2860 height = f->height;
2861 f->height = f->width = 0;
2862 change_frame_size (f, height, width, 1, 0);
2864 /* With the toolkit, the geometry management is done in x_window. */
2865 #ifndef USE_X_TOOLKIT
2866 BLOCK_INPUT;
2867 x_wm_set_size_hint (f, window_prompting, 0);
2868 UNBLOCK_INPUT;
2869 #endif /* USE_X_TOOLKIT */
2871 tem = x_get_arg (parms, Qunsplittable, 0, 0, boolean);
2872 f->no_split = minibuffer_only || EQ (tem, Qt);
2874 UNGCPRO;
2876 /* It is now ok to make the frame official
2877 even if we get an error below.
2878 And the frame needs to be on Vframe_list
2879 or making it visible won't work. */
2880 Vframe_list = Fcons (frame, Vframe_list);
2882 /* Now that the frame is official, it counts as a reference to
2883 its display. */
2884 FRAME_X_DISPLAY_INFO (f)->reference_count++;
2886 /* Make the window appear on the frame and enable display,
2887 unless the caller says not to. However, with explicit parent,
2888 Emacs cannot control visibility, so don't try. */
2889 if (! f->display.x->explicit_parent)
2891 Lisp_Object visibility;
2893 visibility = x_get_arg (parms, Qvisibility, 0, 0, symbol);
2894 if (EQ (visibility, Qunbound))
2895 visibility = Qt;
2897 if (EQ (visibility, Qicon))
2898 x_iconify_frame (f);
2899 else if (! NILP (visibility))
2900 x_make_frame_visible (f);
2901 else
2902 /* Must have been Qnil. */
2906 return unbind_to (count, frame);
2909 Lisp_Object
2910 x_get_focus_frame ()
2912 Lisp_Object xfocus;
2913 if (! x_focus_frame)
2914 return Qnil;
2916 XSETFRAME (xfocus, x_focus_frame);
2917 return xfocus;
2920 DEFUN ("focus-frame", Ffocus_frame, Sfocus_frame, 1, 1, 0,
2921 "Set the focus on FRAME.")
2922 (frame)
2923 Lisp_Object frame;
2925 CHECK_LIVE_FRAME (frame, 0);
2927 if (FRAME_X_P (XFRAME (frame)))
2929 BLOCK_INPUT;
2930 x_focus_on_frame (XFRAME (frame));
2931 UNBLOCK_INPUT;
2932 return frame;
2935 return Qnil;
2938 DEFUN ("unfocus-frame", Funfocus_frame, Sunfocus_frame, 0, 0, 0,
2939 "If a frame has been focused, release it.")
2942 if (x_focus_frame)
2944 BLOCK_INPUT;
2945 x_unfocus_frame (x_focus_frame);
2946 UNBLOCK_INPUT;
2949 return Qnil;
2952 DEFUN ("x-list-fonts", Fx_list_fonts, Sx_list_fonts, 1, 3, 0,
2953 "Return a list of the names of available fonts matching PATTERN.\n\
2954 If optional arguments FACE and FRAME are specified, return only fonts\n\
2955 the same size as FACE on FRAME.\n\
2957 PATTERN is a string, perhaps with wildcard characters;\n\
2958 the * character matches any substring, and\n\
2959 the ? character matches any single character.\n\
2960 PATTERN is case-insensitive.\n\
2961 FACE is a face name--a symbol.\n\
2963 The return value is a list of strings, suitable as arguments to\n\
2964 set-face-font.\n\
2966 Fonts Emacs can't use (i.e. proportional fonts) may or may not be excluded\n\
2967 even if they match PATTERN and FACE.")
2968 (pattern, face, frame)
2969 Lisp_Object pattern, face, frame;
2971 int num_fonts;
2972 char **names;
2973 #ifndef BROKEN_XLISTFONTSWITHINFO
2974 XFontStruct *info;
2975 #endif
2976 XFontStruct *size_ref;
2977 Lisp_Object list;
2978 FRAME_PTR f;
2980 check_x ();
2981 CHECK_STRING (pattern, 0);
2982 if (!NILP (face))
2983 CHECK_SYMBOL (face, 1);
2985 f = check_x_frame (frame);
2987 /* Determine the width standard for comparison with the fonts we find. */
2989 if (NILP (face))
2990 size_ref = 0;
2991 else
2993 int face_id;
2995 /* Don't die if we get called with a terminal frame. */
2996 if (! FRAME_X_P (f))
2997 error ("non-X frame used in `x-list-fonts'");
2999 face_id = face_name_id_number (f, face);
3001 if (face_id < 0 || face_id >= FRAME_N_PARAM_FACES (f)
3002 || FRAME_PARAM_FACES (f) [face_id] == 0)
3003 size_ref = f->display.x->font;
3004 else
3006 size_ref = FRAME_PARAM_FACES (f) [face_id]->font;
3007 if (size_ref == (XFontStruct *) (~0))
3008 size_ref = f->display.x->font;
3012 /* See if we cached the result for this particular query. */
3013 list = Fassoc (pattern,
3014 XCONS (FRAME_X_DISPLAY_INFO (f)->name_list_element)->cdr);
3016 /* We have info in the cache for this PATTERN. */
3017 if (!NILP (list))
3019 Lisp_Object tem, newlist;
3021 /* We have info about this pattern. */
3022 list = XCONS (list)->cdr;
3024 if (size_ref == 0)
3025 return list;
3027 BLOCK_INPUT;
3029 /* Filter the cached info and return just the fonts that match FACE. */
3030 newlist = Qnil;
3031 for (tem = list; CONSP (tem); tem = XCONS (tem)->cdr)
3033 XFontStruct *thisinfo;
3035 thisinfo = XLoadQueryFont (FRAME_X_DISPLAY (f),
3036 XSTRING (XCONS (tem)->car)->data);
3038 if (thisinfo && same_size_fonts (thisinfo, size_ref))
3039 newlist = Fcons (XCONS (tem)->car, newlist);
3041 XFreeFont (FRAME_X_DISPLAY (f), thisinfo);
3044 UNBLOCK_INPUT;
3046 return newlist;
3049 BLOCK_INPUT;
3051 /* Solaris 2.3 has a bug in XListFontsWithInfo. */
3052 #ifndef BROKEN_XLISTFONTSWITHINFO
3053 if (size_ref)
3054 names = XListFontsWithInfo (FRAME_X_DISPLAY (f),
3055 XSTRING (pattern)->data,
3056 2000, /* maxnames */
3057 &num_fonts, /* count_return */
3058 &info); /* info_return */
3059 else
3060 #endif
3061 names = XListFonts (FRAME_X_DISPLAY (f),
3062 XSTRING (pattern)->data,
3063 2000, /* maxnames */
3064 &num_fonts); /* count_return */
3066 UNBLOCK_INPUT;
3068 list = Qnil;
3070 if (names)
3072 int i;
3073 Lisp_Object full_list;
3075 /* Make a list of all the fonts we got back.
3076 Store that in the font cache for the display. */
3077 full_list = Qnil;
3078 for (i = 0; i < num_fonts; i++)
3079 full_list = Fcons (build_string (names[i]), full_list);
3080 XCONS (FRAME_X_DISPLAY_INFO (f)->name_list_element)->cdr
3081 = Fcons (Fcons (pattern, full_list),
3082 XCONS (FRAME_X_DISPLAY_INFO (f)->name_list_element)->cdr);
3084 /* Make a list of the fonts that have the right width. */
3085 list = Qnil;
3086 for (i = 0; i < num_fonts; i++)
3088 int keeper;
3090 if (!size_ref)
3091 keeper = 1;
3092 else
3094 #ifdef BROKEN_XLISTFONTSWITHINFO
3095 XFontStruct *thisinfo;
3097 BLOCK_INPUT;
3098 thisinfo = XLoadQueryFont (FRAME_X_DISPLAY (f), names[i]);
3099 UNBLOCK_INPUT;
3101 keeper = thisinfo && same_size_fonts (thisinfo, size_ref);
3102 #else
3103 keeper = same_size_fonts (&info[i], size_ref);
3104 #endif
3106 if (keeper)
3107 list = Fcons (build_string (names[i]), list);
3109 list = Fnreverse (list);
3111 BLOCK_INPUT;
3112 #ifndef BROKEN_XLISTFONTSWITHINFO
3113 if (size_ref)
3114 XFreeFontInfo (names, info, num_fonts);
3115 else
3116 #endif
3117 XFreeFontNames (names);
3118 UNBLOCK_INPUT;
3121 return list;
3125 DEFUN ("x-color-defined-p", Fx_color_defined_p, Sx_color_defined_p, 1, 2, 0,
3126 "Return non-nil color COLOR is supported on frame FRAME.\n\
3127 If FRAME is omitted or nil, use the selected frame.")
3128 (color, frame)
3129 Lisp_Object color, frame;
3131 XColor foo;
3132 FRAME_PTR f = check_x_frame (frame);
3134 CHECK_STRING (color, 1);
3136 if (defined_color (f, XSTRING (color)->data, &foo, 0))
3137 return Qt;
3138 else
3139 return Qnil;
3142 DEFUN ("x-color-values", Fx_color_values, Sx_color_values, 1, 2, 0,
3143 "Return a description of the color named COLOR on frame FRAME.\n\
3144 The value is a list of integer RGB values--(RED GREEN BLUE).\n\
3145 These values appear to range from 0 to 65280 or 65535, depending\n\
3146 on the system; white is (65280 65280 65280) or (65535 65535 65535).\n\
3147 If FRAME is omitted or nil, use the selected frame.")
3148 (color, frame)
3149 Lisp_Object color, frame;
3151 XColor foo;
3152 FRAME_PTR f = check_x_frame (frame);
3154 CHECK_STRING (color, 1);
3156 if (defined_color (f, XSTRING (color)->data, &foo, 0))
3158 Lisp_Object rgb[3];
3160 rgb[0] = make_number (foo.red);
3161 rgb[1] = make_number (foo.green);
3162 rgb[2] = make_number (foo.blue);
3163 return Flist (3, rgb);
3165 else
3166 return Qnil;
3169 DEFUN ("x-display-color-p", Fx_display_color_p, Sx_display_color_p, 0, 1, 0,
3170 "Return t if the X display supports color.\n\
3171 The optional argument DISPLAY specifies which display to ask about.\n\
3172 DISPLAY should be either a frame or a display name (a string).\n\
3173 If omitted or nil, that stands for the selected frame's display.")
3174 (display)
3175 Lisp_Object display;
3177 struct x_display_info *dpyinfo = check_x_display_info (display);
3179 if (dpyinfo->n_planes <= 2)
3180 return Qnil;
3182 switch (dpyinfo->visual->class)
3184 case StaticColor:
3185 case PseudoColor:
3186 case TrueColor:
3187 case DirectColor:
3188 return Qt;
3190 default:
3191 return Qnil;
3195 DEFUN ("x-display-grayscale-p", Fx_display_grayscale_p, Sx_display_grayscale_p,
3196 0, 1, 0,
3197 "Return t if the X display supports shades of gray.\n\
3198 The optional argument DISPLAY specifies which display to ask about.\n\
3199 DISPLAY should be either a frame or a display name (a string).\n\
3200 If omitted or nil, that stands for the selected frame's display.")
3201 (display)
3202 Lisp_Object display;
3204 struct x_display_info *dpyinfo = check_x_display_info (display);
3206 if (dpyinfo->n_planes <= 2)
3207 return Qnil;
3209 return (dpyinfo->n_planes > 1
3210 && (dpyinfo->visual->class == StaticGray
3211 || dpyinfo->visual->class == GrayScale));
3214 DEFUN ("x-display-pixel-width", Fx_display_pixel_width, Sx_display_pixel_width,
3215 0, 1, 0,
3216 "Returns the width in pixels of the X display DISPLAY.\n\
3217 The optional argument DISPLAY specifies which display to ask about.\n\
3218 DISPLAY should be either a frame or a display name (a string).\n\
3219 If omitted or nil, that stands for the selected frame's display.")
3220 (display)
3221 Lisp_Object display;
3223 struct x_display_info *dpyinfo = check_x_display_info (display);
3225 return make_number (dpyinfo->width);
3228 DEFUN ("x-display-pixel-height", Fx_display_pixel_height,
3229 Sx_display_pixel_height, 0, 1, 0,
3230 "Returns the height in pixels of the X display DISPLAY.\n\
3231 The optional argument DISPLAY specifies which display to ask about.\n\
3232 DISPLAY should be either a frame or a display name (a string).\n\
3233 If omitted or nil, that stands for the selected frame's display.")
3234 (display)
3235 Lisp_Object display;
3237 struct x_display_info *dpyinfo = check_x_display_info (display);
3239 return make_number (dpyinfo->height);
3242 DEFUN ("x-display-planes", Fx_display_planes, Sx_display_planes,
3243 0, 1, 0,
3244 "Returns the number of bitplanes of the X display DISPLAY.\n\
3245 The optional argument DISPLAY specifies which display to ask about.\n\
3246 DISPLAY should be either a frame or a display name (a string).\n\
3247 If omitted or nil, that stands for the selected frame's display.")
3248 (display)
3249 Lisp_Object display;
3251 struct x_display_info *dpyinfo = check_x_display_info (display);
3253 return make_number (dpyinfo->n_planes);
3256 DEFUN ("x-display-color-cells", Fx_display_color_cells, Sx_display_color_cells,
3257 0, 1, 0,
3258 "Returns the number of color cells of the X display DISPLAY.\n\
3259 The optional argument DISPLAY specifies which display to ask about.\n\
3260 DISPLAY should be either a frame or a display name (a string).\n\
3261 If omitted or nil, that stands for the selected frame's display.")
3262 (display)
3263 Lisp_Object display;
3265 struct x_display_info *dpyinfo = check_x_display_info (display);
3267 return make_number (DisplayCells (dpyinfo->display,
3268 XScreenNumberOfScreen (dpyinfo->screen)));
3271 DEFUN ("x-server-max-request-size", Fx_server_max_request_size,
3272 Sx_server_max_request_size,
3273 0, 1, 0,
3274 "Returns the maximum request size of the X server of display DISPLAY.\n\
3275 The optional argument DISPLAY specifies which display to ask about.\n\
3276 DISPLAY should be either a frame or a display name (a string).\n\
3277 If omitted or nil, that stands for the selected frame's display.")
3278 (display)
3279 Lisp_Object display;
3281 struct x_display_info *dpyinfo = check_x_display_info (display);
3283 return make_number (MAXREQUEST (dpyinfo->display));
3286 DEFUN ("x-server-vendor", Fx_server_vendor, Sx_server_vendor, 0, 1, 0,
3287 "Returns the vendor ID string of the X server of display DISPLAY.\n\
3288 The optional argument DISPLAY specifies which display to ask about.\n\
3289 DISPLAY should be either a frame or a display name (a string).\n\
3290 If omitted or nil, that stands for the selected frame's display.")
3291 (display)
3292 Lisp_Object display;
3294 struct x_display_info *dpyinfo = check_x_display_info (display);
3295 char *vendor = ServerVendor (dpyinfo->display);
3297 if (! vendor) vendor = "";
3298 return build_string (vendor);
3301 DEFUN ("x-server-version", Fx_server_version, Sx_server_version, 0, 1, 0,
3302 "Returns the version numbers of the X server of display DISPLAY.\n\
3303 The value is a list of three integers: the major and minor\n\
3304 version numbers of the X Protocol in use, and the vendor-specific release\n\
3305 number. See also the function `x-server-vendor'.\n\n\
3306 The optional argument DISPLAY specifies which display to ask about.\n\
3307 DISPLAY should be either a frame or a display name (a string).\n\
3308 If omitted or nil, that stands for the selected frame's display.")
3309 (display)
3310 Lisp_Object display;
3312 struct x_display_info *dpyinfo = check_x_display_info (display);
3313 Display *dpy = dpyinfo->display;
3315 return Fcons (make_number (ProtocolVersion (dpy)),
3316 Fcons (make_number (ProtocolRevision (dpy)),
3317 Fcons (make_number (VendorRelease (dpy)), Qnil)));
3320 DEFUN ("x-display-screens", Fx_display_screens, Sx_display_screens, 0, 1, 0,
3321 "Returns the number of screens on the X server of display DISPLAY.\n\
3322 The optional argument DISPLAY specifies which display to ask about.\n\
3323 DISPLAY should be either a frame or a display name (a string).\n\
3324 If omitted or nil, that stands for the selected frame's display.")
3325 (display)
3326 Lisp_Object display;
3328 struct x_display_info *dpyinfo = check_x_display_info (display);
3330 return make_number (ScreenCount (dpyinfo->display));
3333 DEFUN ("x-display-mm-height", Fx_display_mm_height, Sx_display_mm_height, 0, 1, 0,
3334 "Returns the height in millimeters of the X display DISPLAY.\n\
3335 The optional argument DISPLAY specifies which display to ask about.\n\
3336 DISPLAY should be either a frame or a display name (a string).\n\
3337 If omitted or nil, that stands for the selected frame's display.")
3338 (display)
3339 Lisp_Object display;
3341 struct x_display_info *dpyinfo = check_x_display_info (display);
3343 return make_number (HeightMMOfScreen (dpyinfo->screen));
3346 DEFUN ("x-display-mm-width", Fx_display_mm_width, Sx_display_mm_width, 0, 1, 0,
3347 "Returns the width in millimeters of the X display DISPLAY.\n\
3348 The optional argument DISPLAY specifies which display to ask about.\n\
3349 DISPLAY should be either a frame or a display name (a string).\n\
3350 If omitted or nil, that stands for the selected frame's display.")
3351 (display)
3352 Lisp_Object display;
3354 struct x_display_info *dpyinfo = check_x_display_info (display);
3356 return make_number (WidthMMOfScreen (dpyinfo->screen));
3359 DEFUN ("x-display-backing-store", Fx_display_backing_store,
3360 Sx_display_backing_store, 0, 1, 0,
3361 "Returns an indication of whether X display DISPLAY does backing store.\n\
3362 The value may be `always', `when-mapped', or `not-useful'.\n\
3363 The optional argument DISPLAY specifies which display to ask about.\n\
3364 DISPLAY should be either a frame or a display name (a string).\n\
3365 If omitted or nil, that stands for the selected frame's display.")
3366 (display)
3367 Lisp_Object display;
3369 struct x_display_info *dpyinfo = check_x_display_info (display);
3371 switch (DoesBackingStore (dpyinfo->screen))
3373 case Always:
3374 return intern ("always");
3376 case WhenMapped:
3377 return intern ("when-mapped");
3379 case NotUseful:
3380 return intern ("not-useful");
3382 default:
3383 error ("Strange value for BackingStore parameter of screen");
3387 DEFUN ("x-display-visual-class", Fx_display_visual_class,
3388 Sx_display_visual_class, 0, 1, 0,
3389 "Returns the visual class of the X display DISPLAY.\n\
3390 The value is one of the symbols `static-gray', `gray-scale',\n\
3391 `static-color', `pseudo-color', `true-color', or `direct-color'.\n\n\
3392 The optional argument DISPLAY specifies which display to ask about.\n\
3393 DISPLAY should be either a frame or a display name (a string).\n\
3394 If omitted or nil, that stands for the selected frame's display.")
3395 (display)
3396 Lisp_Object display;
3398 struct x_display_info *dpyinfo = check_x_display_info (display);
3400 switch (dpyinfo->visual->class)
3402 case StaticGray: return (intern ("static-gray"));
3403 case GrayScale: return (intern ("gray-scale"));
3404 case StaticColor: return (intern ("static-color"));
3405 case PseudoColor: return (intern ("pseudo-color"));
3406 case TrueColor: return (intern ("true-color"));
3407 case DirectColor: return (intern ("direct-color"));
3408 default:
3409 error ("Display has an unknown visual class");
3413 DEFUN ("x-display-save-under", Fx_display_save_under,
3414 Sx_display_save_under, 0, 1, 0,
3415 "Returns t if the X display DISPLAY supports the save-under feature.\n\
3416 The optional argument DISPLAY specifies which display to ask about.\n\
3417 DISPLAY should be either a frame or a display name (a string).\n\
3418 If omitted or nil, that stands for the selected frame's display.")
3419 (display)
3420 Lisp_Object display;
3422 struct x_display_info *dpyinfo = check_x_display_info (display);
3424 if (DoesSaveUnders (dpyinfo->screen) == True)
3425 return Qt;
3426 else
3427 return Qnil;
3431 x_pixel_width (f)
3432 register struct frame *f;
3434 return PIXEL_WIDTH (f);
3438 x_pixel_height (f)
3439 register struct frame *f;
3441 return PIXEL_HEIGHT (f);
3445 x_char_width (f)
3446 register struct frame *f;
3448 return FONT_WIDTH (f->display.x->font);
3452 x_char_height (f)
3453 register struct frame *f;
3455 return f->display.x->line_height;
3459 x_screen_planes (frame)
3460 Lisp_Object frame;
3462 return FRAME_X_DISPLAY_INFO (XFRAME (frame))->n_planes;
3465 #if 0 /* These no longer seem like the right way to do things. */
3467 /* Draw a rectangle on the frame with left top corner including
3468 the character specified by LEFT_CHAR and TOP_CHAR. The rectangle is
3469 CHARS by LINES wide and long and is the color of the cursor. */
3471 void
3472 x_rectangle (f, gc, left_char, top_char, chars, lines)
3473 register struct frame *f;
3474 GC gc;
3475 register int top_char, left_char, chars, lines;
3477 int width;
3478 int height;
3479 int left = (left_char * FONT_WIDTH (f->display.x->font)
3480 + f->display.x->internal_border_width);
3481 int top = (top_char * f->display.x->line_height
3482 + f->display.x->internal_border_width);
3484 if (chars < 0)
3485 width = FONT_WIDTH (f->display.x->font) / 2;
3486 else
3487 width = FONT_WIDTH (f->display.x->font) * chars;
3488 if (lines < 0)
3489 height = f->display.x->line_height / 2;
3490 else
3491 height = f->display.x->line_height * lines;
3493 XDrawRectangle (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
3494 gc, left, top, width, height);
3497 DEFUN ("x-draw-rectangle", Fx_draw_rectangle, Sx_draw_rectangle, 5, 5, 0,
3498 "Draw a rectangle on FRAME between coordinates specified by\n\
3499 numbers X0, Y0, X1, Y1 in the cursor pixel.")
3500 (frame, X0, Y0, X1, Y1)
3501 register Lisp_Object frame, X0, X1, Y0, Y1;
3503 register int x0, y0, x1, y1, top, left, n_chars, n_lines;
3505 CHECK_LIVE_FRAME (frame, 0);
3506 CHECK_NUMBER (X0, 0);
3507 CHECK_NUMBER (Y0, 1);
3508 CHECK_NUMBER (X1, 2);
3509 CHECK_NUMBER (Y1, 3);
3511 x0 = XINT (X0);
3512 x1 = XINT (X1);
3513 y0 = XINT (Y0);
3514 y1 = XINT (Y1);
3516 if (y1 > y0)
3518 top = y0;
3519 n_lines = y1 - y0 + 1;
3521 else
3523 top = y1;
3524 n_lines = y0 - y1 + 1;
3527 if (x1 > x0)
3529 left = x0;
3530 n_chars = x1 - x0 + 1;
3532 else
3534 left = x1;
3535 n_chars = x0 - x1 + 1;
3538 BLOCK_INPUT;
3539 x_rectangle (XFRAME (frame), XFRAME (frame)->display.x->cursor_gc,
3540 left, top, n_chars, n_lines);
3541 UNBLOCK_INPUT;
3543 return Qt;
3546 DEFUN ("x-erase-rectangle", Fx_erase_rectangle, Sx_erase_rectangle, 5, 5, 0,
3547 "Draw a rectangle drawn on FRAME between coordinates\n\
3548 X0, Y0, X1, Y1 in the regular background-pixel.")
3549 (frame, X0, Y0, X1, Y1)
3550 register Lisp_Object frame, X0, Y0, X1, Y1;
3552 register int x0, y0, x1, y1, top, left, n_chars, n_lines;
3554 CHECK_LIVE_FRAME (frame, 0);
3555 CHECK_NUMBER (X0, 0);
3556 CHECK_NUMBER (Y0, 1);
3557 CHECK_NUMBER (X1, 2);
3558 CHECK_NUMBER (Y1, 3);
3560 x0 = XINT (X0);
3561 x1 = XINT (X1);
3562 y0 = XINT (Y0);
3563 y1 = XINT (Y1);
3565 if (y1 > y0)
3567 top = y0;
3568 n_lines = y1 - y0 + 1;
3570 else
3572 top = y1;
3573 n_lines = y0 - y1 + 1;
3576 if (x1 > x0)
3578 left = x0;
3579 n_chars = x1 - x0 + 1;
3581 else
3583 left = x1;
3584 n_chars = x0 - x1 + 1;
3587 BLOCK_INPUT;
3588 x_rectangle (XFRAME (frame), XFRAME (frame)->display.x->reverse_gc,
3589 left, top, n_chars, n_lines);
3590 UNBLOCK_INPUT;
3592 return Qt;
3595 /* Draw lines around the text region beginning at the character position
3596 TOP_X, TOP_Y and ending at BOTTOM_X and BOTTOM_Y. GC specifies the
3597 pixel and line characteristics. */
3599 #define line_len(line) (FRAME_CURRENT_GLYPHS (f)->used[(line)])
3601 static void
3602 outline_region (f, gc, top_x, top_y, bottom_x, bottom_y)
3603 register struct frame *f;
3604 GC gc;
3605 int top_x, top_y, bottom_x, bottom_y;
3607 register int ibw = f->display.x->internal_border_width;
3608 register int font_w = FONT_WIDTH (f->display.x->font);
3609 register int font_h = f->display.x->line_height;
3610 int y = top_y;
3611 int x = line_len (y);
3612 XPoint *pixel_points
3613 = (XPoint *) alloca (((bottom_y - top_y + 2) * 4) * sizeof (XPoint));
3614 register XPoint *this_point = pixel_points;
3616 /* Do the horizontal top line/lines */
3617 if (top_x == 0)
3619 this_point->x = ibw;
3620 this_point->y = ibw + (font_h * top_y);
3621 this_point++;
3622 if (x == 0)
3623 this_point->x = ibw + (font_w / 2); /* Half-size for newline chars. */
3624 else
3625 this_point->x = ibw + (font_w * x);
3626 this_point->y = (this_point - 1)->y;
3628 else
3630 this_point->x = ibw;
3631 this_point->y = ibw + (font_h * (top_y + 1));
3632 this_point++;
3633 this_point->x = ibw + (font_w * top_x);
3634 this_point->y = (this_point - 1)->y;
3635 this_point++;
3636 this_point->x = (this_point - 1)->x;
3637 this_point->y = ibw + (font_h * top_y);
3638 this_point++;
3639 this_point->x = ibw + (font_w * x);
3640 this_point->y = (this_point - 1)->y;
3643 /* Now do the right side. */
3644 while (y < bottom_y)
3645 { /* Right vertical edge */
3646 this_point++;
3647 this_point->x = (this_point - 1)->x;
3648 this_point->y = ibw + (font_h * (y + 1));
3649 this_point++;
3651 y++; /* Horizontal connection to next line */
3652 x = line_len (y);
3653 if (x == 0)
3654 this_point->x = ibw + (font_w / 2);
3655 else
3656 this_point->x = ibw + (font_w * x);
3658 this_point->y = (this_point - 1)->y;
3661 /* Now do the bottom and connect to the top left point. */
3662 this_point->x = ibw + (font_w * (bottom_x + 1));
3664 this_point++;
3665 this_point->x = (this_point - 1)->x;
3666 this_point->y = ibw + (font_h * (bottom_y + 1));
3667 this_point++;
3668 this_point->x = ibw;
3669 this_point->y = (this_point - 1)->y;
3670 this_point++;
3671 this_point->x = pixel_points->x;
3672 this_point->y = pixel_points->y;
3674 XDrawLines (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
3675 gc, pixel_points,
3676 (this_point - pixel_points + 1), CoordModeOrigin);
3679 DEFUN ("x-contour-region", Fx_contour_region, Sx_contour_region, 1, 1, 0,
3680 "Highlight the region between point and the character under the mouse\n\
3681 selected frame.")
3682 (event)
3683 register Lisp_Object event;
3685 register int x0, y0, x1, y1;
3686 register struct frame *f = selected_frame;
3687 register int p1, p2;
3689 CHECK_CONS (event, 0);
3691 BLOCK_INPUT;
3692 x0 = XINT (Fcar (Fcar (event)));
3693 y0 = XINT (Fcar (Fcdr (Fcar (event))));
3695 /* If the mouse is past the end of the line, don't that area. */
3696 /* ReWrite this... */
3698 x1 = f->cursor_x;
3699 y1 = f->cursor_y;
3701 if (y1 > y0) /* point below mouse */
3702 outline_region (f, f->display.x->cursor_gc,
3703 x0, y0, x1, y1);
3704 else if (y1 < y0) /* point above mouse */
3705 outline_region (f, f->display.x->cursor_gc,
3706 x1, y1, x0, y0);
3707 else /* same line: draw horizontal rectangle */
3709 if (x1 > x0)
3710 x_rectangle (f, f->display.x->cursor_gc,
3711 x0, y0, (x1 - x0 + 1), 1);
3712 else if (x1 < x0)
3713 x_rectangle (f, f->display.x->cursor_gc,
3714 x1, y1, (x0 - x1 + 1), 1);
3717 XFlush (FRAME_X_DISPLAY (f));
3718 UNBLOCK_INPUT;
3720 return Qnil;
3723 DEFUN ("x-uncontour-region", Fx_uncontour_region, Sx_uncontour_region, 1, 1, 0,
3724 "Erase any highlighting of the region between point and the character\n\
3725 at X, Y on the selected frame.")
3726 (event)
3727 register Lisp_Object event;
3729 register int x0, y0, x1, y1;
3730 register struct frame *f = selected_frame;
3732 BLOCK_INPUT;
3733 x0 = XINT (Fcar (Fcar (event)));
3734 y0 = XINT (Fcar (Fcdr (Fcar (event))));
3735 x1 = f->cursor_x;
3736 y1 = f->cursor_y;
3738 if (y1 > y0) /* point below mouse */
3739 outline_region (f, f->display.x->reverse_gc,
3740 x0, y0, x1, y1);
3741 else if (y1 < y0) /* point above mouse */
3742 outline_region (f, f->display.x->reverse_gc,
3743 x1, y1, x0, y0);
3744 else /* same line: draw horizontal rectangle */
3746 if (x1 > x0)
3747 x_rectangle (f, f->display.x->reverse_gc,
3748 x0, y0, (x1 - x0 + 1), 1);
3749 else if (x1 < x0)
3750 x_rectangle (f, f->display.x->reverse_gc,
3751 x1, y1, (x0 - x1 + 1), 1);
3753 UNBLOCK_INPUT;
3755 return Qnil;
3758 #if 0
3759 int contour_begin_x, contour_begin_y;
3760 int contour_end_x, contour_end_y;
3761 int contour_npoints;
3763 /* Clip the top part of the contour lines down (and including) line Y_POS.
3764 If X_POS is in the middle (rather than at the end) of the line, drop
3765 down a line at that character. */
3767 static void
3768 clip_contour_top (y_pos, x_pos)
3770 register XPoint *begin = contour_lines[y_pos].top_left;
3771 register XPoint *end;
3772 register int npoints;
3773 register struct display_line *line = selected_frame->phys_lines[y_pos + 1];
3775 if (x_pos >= line->len - 1) /* Draw one, straight horizontal line. */
3777 end = contour_lines[y_pos].top_right;
3778 npoints = (end - begin + 1);
3779 XDrawLines (x_current_display, contour_window,
3780 contour_erase_gc, begin_erase, npoints, CoordModeOrigin);
3782 bcopy (end, begin + 1, contour_last_point - end + 1);
3783 contour_last_point -= (npoints - 2);
3784 XDrawLines (x_current_display, contour_window,
3785 contour_erase_gc, begin, 2, CoordModeOrigin);
3786 XFlush (x_current_display);
3788 /* Now, update contour_lines structure. */
3790 /* ______. */
3791 else /* |________*/
3793 register XPoint *p = begin + 1;
3794 end = contour_lines[y_pos].bottom_right;
3795 npoints = (end - begin + 1);
3796 XDrawLines (x_current_display, contour_window,
3797 contour_erase_gc, begin_erase, npoints, CoordModeOrigin);
3799 p->y = begin->y;
3800 p->x = ibw + (font_w * (x_pos + 1));
3801 p++;
3802 p->y = begin->y + font_h;
3803 p->x = (p - 1)->x;
3804 bcopy (end, begin + 3, contour_last_point - end + 1);
3805 contour_last_point -= (npoints - 5);
3806 XDrawLines (x_current_display, contour_window,
3807 contour_erase_gc, begin, 4, CoordModeOrigin);
3808 XFlush (x_current_display);
3810 /* Now, update contour_lines structure. */
3814 /* Erase the top horizontal lines of the contour, and then extend
3815 the contour upwards. */
3817 static void
3818 extend_contour_top (line)
3822 static void
3823 clip_contour_bottom (x_pos, y_pos)
3824 int x_pos, y_pos;
3828 static void
3829 extend_contour_bottom (x_pos, y_pos)
3833 DEFUN ("x-select-region", Fx_select_region, Sx_select_region, 1, 1, "e",
3835 (event)
3836 Lisp_Object event;
3838 register struct frame *f = selected_frame;
3839 register int point_x = f->cursor_x;
3840 register int point_y = f->cursor_y;
3841 register int mouse_below_point;
3842 register Lisp_Object obj;
3843 register int x_contour_x, x_contour_y;
3845 x_contour_x = x_mouse_x;
3846 x_contour_y = x_mouse_y;
3847 if (x_contour_y > point_y || (x_contour_y == point_y
3848 && x_contour_x > point_x))
3850 mouse_below_point = 1;
3851 outline_region (f, f->display.x->cursor_gc, point_x, point_y,
3852 x_contour_x, x_contour_y);
3854 else
3856 mouse_below_point = 0;
3857 outline_region (f, f->display.x->cursor_gc, x_contour_x, x_contour_y,
3858 point_x, point_y);
3861 while (1)
3863 obj = read_char (-1, 0, 0, Qnil, 0);
3864 if (!CONSP (obj))
3865 break;
3867 if (mouse_below_point)
3869 if (x_mouse_y <= point_y) /* Flipped. */
3871 mouse_below_point = 0;
3873 outline_region (f, f->display.x->reverse_gc, point_x, point_y,
3874 x_contour_x, x_contour_y);
3875 outline_region (f, f->display.x->cursor_gc, x_mouse_x, x_mouse_y,
3876 point_x, point_y);
3878 else if (x_mouse_y < x_contour_y) /* Bottom clipped. */
3880 clip_contour_bottom (x_mouse_y);
3882 else if (x_mouse_y > x_contour_y) /* Bottom extended. */
3884 extend_bottom_contour (x_mouse_y);
3887 x_contour_x = x_mouse_x;
3888 x_contour_y = x_mouse_y;
3890 else /* mouse above or same line as point */
3892 if (x_mouse_y >= point_y) /* Flipped. */
3894 mouse_below_point = 1;
3896 outline_region (f, f->display.x->reverse_gc,
3897 x_contour_x, x_contour_y, point_x, point_y);
3898 outline_region (f, f->display.x->cursor_gc, point_x, point_y,
3899 x_mouse_x, x_mouse_y);
3901 else if (x_mouse_y > x_contour_y) /* Top clipped. */
3903 clip_contour_top (x_mouse_y);
3905 else if (x_mouse_y < x_contour_y) /* Top extended. */
3907 extend_contour_top (x_mouse_y);
3912 unread_command_event = obj;
3913 if (mouse_below_point)
3915 contour_begin_x = point_x;
3916 contour_begin_y = point_y;
3917 contour_end_x = x_contour_x;
3918 contour_end_y = x_contour_y;
3920 else
3922 contour_begin_x = x_contour_x;
3923 contour_begin_y = x_contour_y;
3924 contour_end_x = point_x;
3925 contour_end_y = point_y;
3928 #endif
3930 DEFUN ("x-horizontal-line", Fx_horizontal_line, Sx_horizontal_line, 1, 1, "e",
3932 (event)
3933 Lisp_Object event;
3935 register Lisp_Object obj;
3936 struct frame *f = selected_frame;
3937 register struct window *w = XWINDOW (selected_window);
3938 register GC line_gc = f->display.x->cursor_gc;
3939 register GC erase_gc = f->display.x->reverse_gc;
3940 #if 0
3941 char dash_list[] = {6, 4, 6, 4};
3942 int dashes = 4;
3943 XGCValues gc_values;
3944 #endif
3945 register int previous_y;
3946 register int line = (x_mouse_y + 1) * f->display.x->line_height
3947 + f->display.x->internal_border_width;
3948 register int left = f->display.x->internal_border_width
3949 + (w->left
3950 * FONT_WIDTH (f->display.x->font));
3951 register int right = left + (w->width
3952 * FONT_WIDTH (f->display.x->font))
3953 - f->display.x->internal_border_width;
3955 #if 0
3956 BLOCK_INPUT;
3957 gc_values.foreground = f->display.x->cursor_pixel;
3958 gc_values.background = f->display.x->background_pixel;
3959 gc_values.line_width = 1;
3960 gc_values.line_style = LineOnOffDash;
3961 gc_values.cap_style = CapRound;
3962 gc_values.join_style = JoinRound;
3964 line_gc = XCreateGC (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
3965 GCLineStyle | GCJoinStyle | GCCapStyle
3966 | GCLineWidth | GCForeground | GCBackground,
3967 &gc_values);
3968 XSetDashes (FRAME_X_DISPLAY (f), line_gc, 0, dash_list, dashes);
3969 gc_values.foreground = f->display.x->background_pixel;
3970 gc_values.background = f->display.x->foreground_pixel;
3971 erase_gc = XCreateGC (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
3972 GCLineStyle | GCJoinStyle | GCCapStyle
3973 | GCLineWidth | GCForeground | GCBackground,
3974 &gc_values);
3975 XSetDashes (FRAME_X_DISPLAY (f), erase_gc, 0, dash_list, dashes);
3976 #endif
3978 while (1)
3980 BLOCK_INPUT;
3981 if (x_mouse_y >= XINT (w->top)
3982 && x_mouse_y < XINT (w->top) + XINT (w->height) - 1)
3984 previous_y = x_mouse_y;
3985 line = (x_mouse_y + 1) * f->display.x->line_height
3986 + f->display.x->internal_border_width;
3987 XDrawLine (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
3988 line_gc, left, line, right, line);
3990 XFlush (FRAME_X_DISPLAY (f));
3991 UNBLOCK_INPUT;
3995 obj = read_char (-1, 0, 0, Qnil, 0);
3996 if (!CONSP (obj)
3997 || (! EQ (Fcar (Fcdr (Fcdr (obj))),
3998 Qvertical_scroll_bar))
3999 || x_mouse_grabbed)
4001 BLOCK_INPUT;
4002 XDrawLine (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
4003 erase_gc, left, line, right, line);
4004 UNBLOCK_INPUT;
4005 unread_command_event = obj;
4006 #if 0
4007 XFreeGC (FRAME_X_DISPLAY (f), line_gc);
4008 XFreeGC (FRAME_X_DISPLAY (f), erase_gc);
4009 #endif
4010 return Qnil;
4013 while (x_mouse_y == previous_y);
4015 BLOCK_INPUT;
4016 XDrawLine (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
4017 erase_gc, left, line, right, line);
4018 UNBLOCK_INPUT;
4021 #endif
4023 #if 0
4024 /* These keep track of the rectangle following the pointer. */
4025 int mouse_track_top, mouse_track_left, mouse_track_width;
4027 /* Offset in buffer of character under the pointer, or 0. */
4028 int mouse_buffer_offset;
4030 DEFUN ("x-track-pointer", Fx_track_pointer, Sx_track_pointer, 0, 0, 0,
4031 "Track the pointer.")
4034 static Cursor current_pointer_shape;
4035 FRAME_PTR f = x_mouse_frame;
4037 BLOCK_INPUT;
4038 if (EQ (Vmouse_frame_part, Qtext_part)
4039 && (current_pointer_shape != f->display.x->nontext_cursor))
4041 unsigned char c;
4042 struct buffer *buf;
4044 current_pointer_shape = f->display.x->nontext_cursor;
4045 XDefineCursor (FRAME_X_DISPLAY (f),
4046 FRAME_X_WINDOW (f),
4047 current_pointer_shape);
4049 buf = XBUFFER (XWINDOW (Vmouse_window)->buffer);
4050 c = *(BUF_CHAR_ADDRESS (buf, mouse_buffer_offset));
4052 else if (EQ (Vmouse_frame_part, Qmodeline_part)
4053 && (current_pointer_shape != f->display.x->modeline_cursor))
4055 current_pointer_shape = f->display.x->modeline_cursor;
4056 XDefineCursor (FRAME_X_DISPLAY (f),
4057 FRAME_X_WINDOW (f),
4058 current_pointer_shape);
4061 XFlush (FRAME_X_DISPLAY (f));
4062 UNBLOCK_INPUT;
4064 #endif
4066 #if 0
4067 DEFUN ("x-track-pointer", Fx_track_pointer, Sx_track_pointer, 1, 1, "e",
4068 "Draw rectangle around character under mouse pointer, if there is one.")
4069 (event)
4070 Lisp_Object event;
4072 struct window *w = XWINDOW (Vmouse_window);
4073 struct frame *f = XFRAME (WINDOW_FRAME (w));
4074 struct buffer *b = XBUFFER (w->buffer);
4075 Lisp_Object obj;
4077 if (! EQ (Vmouse_window, selected_window))
4078 return Qnil;
4080 if (EQ (event, Qnil))
4082 int x, y;
4084 x_read_mouse_position (selected_frame, &x, &y);
4087 BLOCK_INPUT;
4088 mouse_track_width = 0;
4089 mouse_track_left = mouse_track_top = -1;
4093 if ((x_mouse_x != mouse_track_left
4094 && (x_mouse_x < mouse_track_left
4095 || x_mouse_x > (mouse_track_left + mouse_track_width)))
4096 || x_mouse_y != mouse_track_top)
4098 int hp = 0; /* Horizontal position */
4099 int len = FRAME_CURRENT_GLYPHS (f)->used[x_mouse_y];
4100 int p = FRAME_CURRENT_GLYPHS (f)->bufp[x_mouse_y];
4101 int tab_width = XINT (b->tab_width);
4102 int ctl_arrow_p = !NILP (b->ctl_arrow);
4103 unsigned char c;
4104 int mode_line_vpos = XFASTINT (w->height) + XFASTINT (w->top) - 1;
4105 int in_mode_line = 0;
4107 if (! FRAME_CURRENT_GLYPHS (f)->enable[x_mouse_y])
4108 break;
4110 /* Erase previous rectangle. */
4111 if (mouse_track_width)
4113 x_rectangle (f, f->display.x->reverse_gc,
4114 mouse_track_left, mouse_track_top,
4115 mouse_track_width, 1);
4117 if ((mouse_track_left == f->phys_cursor_x
4118 || mouse_track_left == f->phys_cursor_x - 1)
4119 && mouse_track_top == f->phys_cursor_y)
4121 x_display_cursor (f, 1);
4125 mouse_track_left = x_mouse_x;
4126 mouse_track_top = x_mouse_y;
4127 mouse_track_width = 0;
4129 if (mouse_track_left > len) /* Past the end of line. */
4130 goto draw_or_not;
4132 if (mouse_track_top == mode_line_vpos)
4134 in_mode_line = 1;
4135 goto draw_or_not;
4138 if (tab_width <= 0 || tab_width > 20) tab_width = 8;
4141 c = FETCH_CHAR (p);
4142 if (len == f->width && hp == len - 1 && c != '\n')
4143 goto draw_or_not;
4145 switch (c)
4147 case '\t':
4148 mouse_track_width = tab_width - (hp % tab_width);
4149 p++;
4150 hp += mouse_track_width;
4151 if (hp > x_mouse_x)
4153 mouse_track_left = hp - mouse_track_width;
4154 goto draw_or_not;
4156 continue;
4158 case '\n':
4159 mouse_track_width = -1;
4160 goto draw_or_not;
4162 default:
4163 if (ctl_arrow_p && (c < 040 || c == 0177))
4165 if (p > ZV)
4166 goto draw_or_not;
4168 mouse_track_width = 2;
4169 p++;
4170 hp +=2;
4171 if (hp > x_mouse_x)
4173 mouse_track_left = hp - mouse_track_width;
4174 goto draw_or_not;
4177 else
4179 mouse_track_width = 1;
4180 p++;
4181 hp++;
4183 continue;
4186 while (hp <= x_mouse_x);
4188 draw_or_not:
4189 if (mouse_track_width) /* Over text; use text pointer shape. */
4191 XDefineCursor (FRAME_X_DISPLAY (f),
4192 FRAME_X_WINDOW (f),
4193 f->display.x->text_cursor);
4194 x_rectangle (f, f->display.x->cursor_gc,
4195 mouse_track_left, mouse_track_top,
4196 mouse_track_width, 1);
4198 else if (in_mode_line)
4199 XDefineCursor (FRAME_X_DISPLAY (f),
4200 FRAME_X_WINDOW (f),
4201 f->display.x->modeline_cursor);
4202 else
4203 XDefineCursor (FRAME_X_DISPLAY (f),
4204 FRAME_X_WINDOW (f),
4205 f->display.x->nontext_cursor);
4208 XFlush (FRAME_X_DISPLAY (f));
4209 UNBLOCK_INPUT;
4211 obj = read_char (-1, 0, 0, Qnil, 0);
4212 BLOCK_INPUT;
4214 while (CONSP (obj) /* Mouse event */
4215 && EQ (Fcar (Fcdr (Fcdr (obj))), Qnil) /* Not scroll bar */
4216 && EQ (Vmouse_depressed, Qnil) /* Only motion events */
4217 && EQ (Vmouse_window, selected_window) /* In this window */
4218 && x_mouse_frame);
4220 unread_command_event = obj;
4222 if (mouse_track_width)
4224 x_rectangle (f, f->display.x->reverse_gc,
4225 mouse_track_left, mouse_track_top,
4226 mouse_track_width, 1);
4227 mouse_track_width = 0;
4228 if ((mouse_track_left == f->phys_cursor_x
4229 || mouse_track_left - 1 == f->phys_cursor_x)
4230 && mouse_track_top == f->phys_cursor_y)
4232 x_display_cursor (f, 1);
4235 XDefineCursor (FRAME_X_DISPLAY (f),
4236 FRAME_X_WINDOW (f),
4237 f->display.x->nontext_cursor);
4238 XFlush (FRAME_X_DISPLAY (f));
4239 UNBLOCK_INPUT;
4241 return Qnil;
4243 #endif
4245 #if 0
4246 #include "glyphs.h"
4248 /* Draw a pixmap specified by IMAGE_DATA of dimensions WIDTH and HEIGHT
4249 on the frame F at position X, Y. */
4251 x_draw_pixmap (f, x, y, image_data, width, height)
4252 struct frame *f;
4253 int x, y, width, height;
4254 char *image_data;
4256 Pixmap image;
4258 image = XCreateBitmapFromData (FRAME_X_DISPLAY (f),
4259 FRAME_X_WINDOW (f), image_data,
4260 width, height);
4261 XCopyPlane (FRAME_X_DISPLAY (f), image, FRAME_X_WINDOW (f),
4262 f->display.x->normal_gc, 0, 0, width, height, x, y);
4264 #endif
4266 #if 0 /* I'm told these functions are superfluous
4267 given the ability to bind function keys. */
4269 #ifdef HAVE_X11
4270 DEFUN ("x-rebind-key", Fx_rebind_key, Sx_rebind_key, 3, 3, 0,
4271 "Rebind X keysym KEYSYM, with MODIFIERS, to generate NEWSTRING.\n\
4272 KEYSYM is a string which conforms to the X keysym definitions found\n\
4273 in X11/keysymdef.h, sans the initial XK_. MODIFIERS is nil or a\n\
4274 list of strings specifying modifier keys such as Control_L, which must\n\
4275 also be depressed for NEWSTRING to appear.")
4276 (x_keysym, modifiers, newstring)
4277 register Lisp_Object x_keysym;
4278 register Lisp_Object modifiers;
4279 register Lisp_Object newstring;
4281 char *rawstring;
4282 register KeySym keysym;
4283 KeySym modifier_list[16];
4285 check_x ();
4286 CHECK_STRING (x_keysym, 1);
4287 CHECK_STRING (newstring, 3);
4289 keysym = XStringToKeysym ((char *) XSTRING (x_keysym)->data);
4290 if (keysym == NoSymbol)
4291 error ("Keysym does not exist");
4293 if (NILP (modifiers))
4294 XRebindKeysym (x_current_display, keysym, modifier_list, 0,
4295 XSTRING (newstring)->data, XSTRING (newstring)->size);
4296 else
4298 register Lisp_Object rest, mod;
4299 register int i = 0;
4301 for (rest = modifiers; !NILP (rest); rest = Fcdr (rest))
4303 if (i == 16)
4304 error ("Can't have more than 16 modifiers");
4306 mod = Fcar (rest);
4307 CHECK_STRING (mod, 3);
4308 modifier_list[i] = XStringToKeysym ((char *) XSTRING (mod)->data);
4309 #ifndef HAVE_X11R5
4310 if (modifier_list[i] == NoSymbol
4311 || !(IsModifierKey (modifier_list[i])
4312 || ((unsigned)(modifier_list[i]) == XK_Mode_switch)
4313 || ((unsigned)(modifier_list[i]) == XK_Num_Lock)))
4314 #else
4315 if (modifier_list[i] == NoSymbol
4316 || !IsModifierKey (modifier_list[i]))
4317 #endif
4318 error ("Element is not a modifier keysym");
4319 i++;
4322 XRebindKeysym (x_current_display, keysym, modifier_list, i,
4323 XSTRING (newstring)->data, XSTRING (newstring)->size);
4326 return Qnil;
4329 DEFUN ("x-rebind-keys", Fx_rebind_keys, Sx_rebind_keys, 2, 2, 0,
4330 "Rebind KEYCODE to list of strings STRINGS.\n\
4331 STRINGS should be a list of 16 elements, one for each shift combination.\n\
4332 nil as element means don't change.\n\
4333 See the documentation of `x-rebind-key' for more information.")
4334 (keycode, strings)
4335 register Lisp_Object keycode;
4336 register Lisp_Object strings;
4338 register Lisp_Object item;
4339 register unsigned char *rawstring;
4340 KeySym rawkey, modifier[1];
4341 int strsize;
4342 register unsigned i;
4344 check_x ();
4345 CHECK_NUMBER (keycode, 1);
4346 CHECK_CONS (strings, 2);
4347 rawkey = (KeySym) ((unsigned) (XINT (keycode))) & 255;
4348 for (i = 0; i <= 15; strings = Fcdr (strings), i++)
4350 item = Fcar (strings);
4351 if (!NILP (item))
4353 CHECK_STRING (item, 2);
4354 strsize = XSTRING (item)->size;
4355 rawstring = (unsigned char *) xmalloc (strsize);
4356 bcopy (XSTRING (item)->data, rawstring, strsize);
4357 modifier[1] = 1 << i;
4358 XRebindKeysym (x_current_display, rawkey, modifier, 1,
4359 rawstring, strsize);
4362 return Qnil;
4364 #endif /* HAVE_X11 */
4365 #endif /* 0 */
4367 #ifndef HAVE_XSCREENNUMBEROFSCREEN
4369 XScreenNumberOfScreen (scr)
4370 register Screen *scr;
4372 register Display *dpy;
4373 register Screen *dpyscr;
4374 register int i;
4376 dpy = scr->display;
4377 dpyscr = dpy->screens;
4379 for (i = 0; i < dpy->nscreens; i++, dpyscr++)
4380 if (scr == dpyscr)
4381 return i;
4383 return -1;
4385 #endif /* not HAVE_XSCREENNUMBEROFSCREEN */
4387 Visual *
4388 select_visual (dpy, screen, depth)
4389 Display *dpy;
4390 Screen *screen;
4391 unsigned int *depth;
4393 Visual *v;
4394 XVisualInfo *vinfo, vinfo_template;
4395 int n_visuals;
4397 v = DefaultVisualOfScreen (screen);
4399 #ifdef HAVE_X11R4
4400 vinfo_template.visualid = XVisualIDFromVisual (v);
4401 #else
4402 vinfo_template.visualid = v->visualid;
4403 #endif
4405 vinfo_template.screen = XScreenNumberOfScreen (screen);
4407 vinfo = XGetVisualInfo (dpy,
4408 VisualIDMask | VisualScreenMask, &vinfo_template,
4409 &n_visuals);
4410 if (n_visuals != 1)
4411 fatal ("Can't get proper X visual info");
4413 if ((1 << vinfo->depth) == vinfo->colormap_size)
4414 *depth = vinfo->depth;
4415 else
4417 int i = 0;
4418 int n = vinfo->colormap_size - 1;
4419 while (n)
4421 n = n >> 1;
4422 i++;
4424 *depth = i;
4427 XFree ((char *) vinfo);
4428 return v;
4431 /* Return the X display structure for the display named NAME.
4432 Open a new connection if necessary. */
4434 struct x_display_info *
4435 x_display_info_for_name (name)
4436 Lisp_Object name;
4438 Lisp_Object names;
4439 struct x_display_info *dpyinfo;
4441 CHECK_STRING (name, 0);
4443 for (dpyinfo = x_display_list, names = x_display_name_list;
4444 dpyinfo;
4445 dpyinfo = dpyinfo->next, names = XCONS (names)->cdr)
4447 Lisp_Object tem;
4448 tem = Fstring_equal (XCONS (XCONS (names)->car)->car, name);
4449 if (!NILP (tem))
4450 return dpyinfo;
4453 validate_x_resource_name ();
4455 dpyinfo = x_term_init (name, (unsigned char *)0,
4456 XSTRING (Vx_resource_name)->data);
4458 if (dpyinfo == 0)
4459 error ("X server %s not responding", XSTRING (name)->data);
4461 x_in_use = 1;
4462 XSETFASTINT (Vwindow_system_version, 11);
4464 return dpyinfo;
4467 DEFUN ("x-open-connection", Fx_open_connection, Sx_open_connection,
4468 1, 3, 0, "Open a connection to an X server.\n\
4469 DISPLAY is the name of the display to connect to.\n\
4470 Optional second arg XRM-STRING is a string of resources in xrdb format.\n\
4471 If the optional third arg MUST-SUCCEED is non-nil,\n\
4472 terminate Emacs if we can't open the connection.")
4473 (display, xrm_string, must_succeed)
4474 Lisp_Object display, xrm_string, must_succeed;
4476 unsigned int n_planes;
4477 unsigned char *xrm_option;
4478 struct x_display_info *dpyinfo;
4480 CHECK_STRING (display, 0);
4481 if (! NILP (xrm_string))
4482 CHECK_STRING (xrm_string, 1);
4484 if (! NILP (xrm_string))
4485 xrm_option = (unsigned char *) XSTRING (xrm_string)->data;
4486 else
4487 xrm_option = (unsigned char *) 0;
4489 validate_x_resource_name ();
4491 /* This is what opens the connection and sets x_current_display.
4492 This also initializes many symbols, such as those used for input. */
4493 dpyinfo = x_term_init (display, xrm_option,
4494 XSTRING (Vx_resource_name)->data);
4496 if (dpyinfo == 0)
4498 if (!NILP (must_succeed))
4499 fatal ("X server %s not responding.\n\
4500 Check the DISPLAY environment variable or use \"-d\"\n",
4501 XSTRING (display)->data);
4502 else
4503 error ("X server %s not responding", XSTRING (display)->data);
4506 x_in_use = 1;
4508 XSETFASTINT (Vwindow_system_version, 11);
4509 return Qnil;
4512 DEFUN ("x-close-connection", Fx_close_connection,
4513 Sx_close_connection, 1, 1, 0,
4514 "Close the connection to DISPLAY's X server.\n\
4515 For DISPLAY, specify either a frame or a display name (a string).\n\
4516 If DISPLAY is nil, that stands for the selected frame's display.")
4517 (display)
4518 Lisp_Object display;
4520 struct x_display_info *dpyinfo = check_x_display_info (display);
4521 struct x_display_info *tail;
4522 int i;
4524 if (dpyinfo->reference_count > 0)
4525 error ("Display still has frames on it");
4527 BLOCK_INPUT;
4528 /* Free the fonts in the font table. */
4529 for (i = 0; i < dpyinfo->n_fonts; i++)
4531 if (dpyinfo->font_table[i].name)
4532 free (dpyinfo->font_table[i].name);
4533 /* Don't free the full_name string;
4534 it is always shared with something else. */
4535 XFreeFont (dpyinfo->display, dpyinfo->font_table[i].font);
4537 x_destroy_all_bitmaps (dpyinfo);
4538 XSetCloseDownMode (dpyinfo->display, DestroyAll);
4540 #ifdef USE_X_TOOLKIT
4541 XtCloseDisplay (dpyinfo->display);
4542 #else
4543 XCloseDisplay (dpyinfo->display);
4544 #endif
4546 x_delete_display (dpyinfo);
4547 UNBLOCK_INPUT;
4549 return Qnil;
4552 DEFUN ("x-display-list", Fx_display_list, Sx_display_list, 0, 0, 0,
4553 "Return the list of display names that Emacs has connections to.")
4556 Lisp_Object tail, result;
4558 result = Qnil;
4559 for (tail = x_display_name_list; ! NILP (tail); tail = XCONS (tail)->cdr)
4560 result = Fcons (XCONS (XCONS (tail)->car)->car, result);
4562 return result;
4565 DEFUN ("x-synchronize", Fx_synchronize, Sx_synchronize, 1, 2, 0,
4566 "If ON is non-nil, report X errors as soon as the erring request is made.\n\
4567 If ON is nil, allow buffering of requests.\n\
4568 Turning on synchronization prohibits the Xlib routines from buffering\n\
4569 requests and seriously degrades performance, but makes debugging much\n\
4570 easier.\n\
4571 The optional second argument DISPLAY specifies which display to act on.\n\
4572 DISPLAY should be either a frame or a display name (a string).\n\
4573 If DISPLAY is omitted or nil, that stands for the selected frame's display.")
4574 (on, display)
4575 Lisp_Object display, on;
4577 struct x_display_info *dpyinfo = check_x_display_info (display);
4579 XSynchronize (dpyinfo->display, !EQ (on, Qnil));
4581 return Qnil;
4584 /* Wait for responses to all X commands issued so far for frame F. */
4586 void
4587 x_sync (f)
4588 FRAME_PTR f;
4590 BLOCK_INPUT;
4591 XSync (FRAME_X_DISPLAY (f), False);
4592 UNBLOCK_INPUT;
4595 syms_of_xfns ()
4597 /* This is zero if not using X windows. */
4598 x_in_use = 0;
4600 /* The section below is built by the lisp expression at the top of the file,
4601 just above where these variables are declared. */
4602 /*&&& init symbols here &&&*/
4603 Qauto_raise = intern ("auto-raise");
4604 staticpro (&Qauto_raise);
4605 Qauto_lower = intern ("auto-lower");
4606 staticpro (&Qauto_lower);
4607 Qbackground_color = intern ("background-color");
4608 staticpro (&Qbackground_color);
4609 Qbar = intern ("bar");
4610 staticpro (&Qbar);
4611 Qborder_color = intern ("border-color");
4612 staticpro (&Qborder_color);
4613 Qborder_width = intern ("border-width");
4614 staticpro (&Qborder_width);
4615 Qbox = intern ("box");
4616 staticpro (&Qbox);
4617 Qcursor_color = intern ("cursor-color");
4618 staticpro (&Qcursor_color);
4619 Qcursor_type = intern ("cursor-type");
4620 staticpro (&Qcursor_type);
4621 Qfont = intern ("font");
4622 staticpro (&Qfont);
4623 Qforeground_color = intern ("foreground-color");
4624 staticpro (&Qforeground_color);
4625 Qgeometry = intern ("geometry");
4626 staticpro (&Qgeometry);
4627 Qicon_left = intern ("icon-left");
4628 staticpro (&Qicon_left);
4629 Qicon_top = intern ("icon-top");
4630 staticpro (&Qicon_top);
4631 Qicon_type = intern ("icon-type");
4632 staticpro (&Qicon_type);
4633 Qinternal_border_width = intern ("internal-border-width");
4634 staticpro (&Qinternal_border_width);
4635 Qleft = intern ("left");
4636 staticpro (&Qleft);
4637 Qmouse_color = intern ("mouse-color");
4638 staticpro (&Qmouse_color);
4639 Qnone = intern ("none");
4640 staticpro (&Qnone);
4641 Qparent_id = intern ("parent-id");
4642 staticpro (&Qparent_id);
4643 Qscroll_bar_width = intern ("scroll-bar-width");
4644 staticpro (&Qscroll_bar_width);
4645 Qsuppress_icon = intern ("suppress-icon");
4646 staticpro (&Qsuppress_icon);
4647 Qtop = intern ("top");
4648 staticpro (&Qtop);
4649 Qundefined_color = intern ("undefined-color");
4650 staticpro (&Qundefined_color);
4651 Qvertical_scroll_bars = intern ("vertical-scroll-bars");
4652 staticpro (&Qvertical_scroll_bars);
4653 Qvisibility = intern ("visibility");
4654 staticpro (&Qvisibility);
4655 Qwindow_id = intern ("window-id");
4656 staticpro (&Qwindow_id);
4657 Qx_frame_parameter = intern ("x-frame-parameter");
4658 staticpro (&Qx_frame_parameter);
4659 Qx_resource_name = intern ("x-resource-name");
4660 staticpro (&Qx_resource_name);
4661 Quser_position = intern ("user-position");
4662 staticpro (&Quser_position);
4663 Quser_size = intern ("user-size");
4664 staticpro (&Quser_size);
4665 Qdisplay = intern ("display");
4666 staticpro (&Qdisplay);
4667 /* This is the end of symbol initialization. */
4669 Fput (Qundefined_color, Qerror_conditions,
4670 Fcons (Qundefined_color, Fcons (Qerror, Qnil)));
4671 Fput (Qundefined_color, Qerror_message,
4672 build_string ("Undefined color"));
4674 init_x_parm_symbols ();
4676 DEFVAR_LISP ("x-bitmap-file-path", &Vx_bitmap_file_path,
4677 "List of directories to search for bitmap files for X.");
4678 Vx_bitmap_file_path = Fcons (build_string (PATH_BITMAPS), Qnil);
4680 DEFVAR_LISP ("x-pointer-shape", &Vx_pointer_shape,
4681 "The shape of the pointer when over text.\n\
4682 Changing the value does not affect existing frames\n\
4683 unless you set the mouse color.");
4684 Vx_pointer_shape = Qnil;
4686 DEFVAR_LISP ("x-resource-name", &Vx_resource_name,
4687 "The name Emacs uses to look up X resources; for internal use only.\n\
4688 `x-get-resource' uses this as the first component of the instance name\n\
4689 when requesting resource values.\n\
4690 Emacs initially sets `x-resource-name' to the name under which Emacs\n\
4691 was invoked, or to the value specified with the `-name' or `-rn'\n\
4692 switches, if present.");
4693 Vx_resource_name = Qnil;
4695 #if 0 /* This doesn't really do anything. */
4696 DEFVAR_INT ("x-nontext-pointer-shape", &Vx_nontext_pointer_shape,
4697 "The shape of the pointer when not over text.\n\
4698 This variable takes effect when you create a new frame\n\
4699 or when you set the mouse color.");
4700 #endif
4701 Vx_nontext_pointer_shape = Qnil;
4703 #if 0 /* This doesn't really do anything. */
4704 DEFVAR_INT ("x-mode-pointer-shape", &Vx_mode_pointer_shape,
4705 "The shape of the pointer when over the mode line.\n\
4706 This variable takes effect when you create a new frame\n\
4707 or when you set the mouse color.");
4708 #endif
4709 Vx_mode_pointer_shape = Qnil;
4711 DEFVAR_INT ("x-sensitive-text-pointer-shape",
4712 &Vx_sensitive_text_pointer_shape,
4713 "The shape of the pointer when over mouse-sensitive text.\n\
4714 This variable takes effect when you create a new frame\n\
4715 or when you set the mouse color.");
4716 Vx_sensitive_text_pointer_shape = Qnil;
4718 DEFVAR_LISP ("x-cursor-fore-pixel", &Vx_cursor_fore_pixel,
4719 "A string indicating the foreground color of the cursor box.");
4720 Vx_cursor_fore_pixel = Qnil;
4722 DEFVAR_LISP ("x-no-window-manager", &Vx_no_window_manager,
4723 "Non-nil if no X window manager is in use.");
4725 #ifdef USE_X_TOOLKIT
4726 Fprovide (intern ("x-toolkit"));
4727 #endif
4729 defsubr (&Sx_get_resource);
4730 #if 0
4731 defsubr (&Sx_draw_rectangle);
4732 defsubr (&Sx_erase_rectangle);
4733 defsubr (&Sx_contour_region);
4734 defsubr (&Sx_uncontour_region);
4735 #endif
4736 defsubr (&Sx_list_fonts);
4737 defsubr (&Sx_display_color_p);
4738 defsubr (&Sx_display_grayscale_p);
4739 defsubr (&Sx_color_defined_p);
4740 defsubr (&Sx_color_values);
4741 defsubr (&Sx_server_max_request_size);
4742 defsubr (&Sx_server_vendor);
4743 defsubr (&Sx_server_version);
4744 defsubr (&Sx_display_pixel_width);
4745 defsubr (&Sx_display_pixel_height);
4746 defsubr (&Sx_display_mm_width);
4747 defsubr (&Sx_display_mm_height);
4748 defsubr (&Sx_display_screens);
4749 defsubr (&Sx_display_planes);
4750 defsubr (&Sx_display_color_cells);
4751 defsubr (&Sx_display_visual_class);
4752 defsubr (&Sx_display_backing_store);
4753 defsubr (&Sx_display_save_under);
4754 #if 0
4755 defsubr (&Sx_rebind_key);
4756 defsubr (&Sx_rebind_keys);
4757 defsubr (&Sx_track_pointer);
4758 defsubr (&Sx_grab_pointer);
4759 defsubr (&Sx_ungrab_pointer);
4760 #endif
4761 defsubr (&Sx_parse_geometry);
4762 defsubr (&Sx_create_frame);
4763 defsubr (&Sfocus_frame);
4764 defsubr (&Sunfocus_frame);
4765 #if 0
4766 defsubr (&Sx_horizontal_line);
4767 #endif
4768 defsubr (&Sx_open_connection);
4769 defsubr (&Sx_close_connection);
4770 defsubr (&Sx_display_list);
4771 defsubr (&Sx_synchronize);
4774 #endif /* HAVE_X_WINDOWS */