new version
[emacs.git] / src / xfns.c
blobcf187e5ff01a2f4b9100d46303a505d6dbe8275b
1 /* Functions for the X window system.
2 Copyright (C) 1989, 92, 93, 94, 95, 96, 1997 Free Software Foundation.
4 This file is part of GNU Emacs.
6 GNU Emacs is free software; you can redistribute it and/or modify
7 it under the terms of the GNU General Public License as published by
8 the Free Software Foundation; either version 2, or (at your option)
9 any later version.
11 GNU Emacs is distributed in the hope that it will be useful,
12 but WITHOUT ANY WARRANTY; without even the implied warranty of
13 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14 GNU General Public License for more details.
16 You should have received a copy of the GNU General Public License
17 along with GNU Emacs; see the file COPYING. If not, write to
18 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
19 Boston, MA 02111-1307, USA. */
21 /* Completely rewritten by Richard Stallman. */
23 /* Rewritten for X11 by Joseph Arceneaux */
25 #include <signal.h>
26 #include <config.h>
28 /* This makes the fields of a Display accessible, in Xlib header files. */
29 #define XLIB_ILLEGAL_ACCESS
31 #include "lisp.h"
32 #include "xterm.h"
33 #include "frame.h"
34 #include "window.h"
35 #include "buffer.h"
36 #include "dispextern.h"
37 #include "keyboard.h"
38 #include "blockinput.h"
39 #include <paths.h>
40 #include "charset.h"
41 #include "fontset.h"
43 #ifdef HAVE_X_WINDOWS
44 extern void abort ();
46 /* On some systems, the character-composition stuff is broken in X11R5. */
47 #if defined (HAVE_X11R5) && ! defined (HAVE_X11R6)
48 #ifdef X11R5_INHIBIT_I18N
49 #define X_I18N_INHIBITED
50 #endif
51 #endif
53 #ifndef VMS
54 #if 1 /* Used to be #ifdef EMACS_BITMAP_FILES, but this should always work. */
55 #include "bitmaps/gray.xbm"
56 #else
57 #include <X11/bitmaps/gray>
58 #endif
59 #else
60 #include "[.bitmaps]gray.xbm"
61 #endif
63 #ifdef USE_X_TOOLKIT
64 #include <X11/Shell.h>
66 #ifndef USE_MOTIF
67 #include <X11/Xaw/Paned.h>
68 #include <X11/Xaw/Label.h>
69 #endif /* USE_MOTIF */
71 #ifdef USG
72 #undef USG /* ####KLUDGE for Solaris 2.2 and up */
73 #include <X11/Xos.h>
74 #define USG
75 #else
76 #include <X11/Xos.h>
77 #endif
79 #include "widget.h"
81 #include "../lwlib/lwlib.h"
83 /* Do the EDITRES protocol if running X11R5
84 Exception: HP-UX (at least version A.09.05) has X11R5 without EditRes */
85 #if (XtSpecificationRelease >= 5) && !defined(NO_EDITRES)
86 #define HACK_EDITRES
87 extern void _XEditResCheckMessages ();
88 #endif /* R5 + Athena */
90 /* Unique id counter for widgets created by the Lucid Widget
91 Library. */
92 extern LWLIB_ID widget_id_tick;
94 #ifdef USE_LUCID
95 /* This is part of a kludge--see lwlib/xlwmenu.c. */
96 extern XFontStruct *xlwmenu_default_font;
97 #endif
99 extern void free_frame_menubar ();
100 #endif /* USE_X_TOOLKIT */
102 #define min(a,b) ((a) < (b) ? (a) : (b))
103 #define max(a,b) ((a) > (b) ? (a) : (b))
105 #ifdef HAVE_X11R4
106 #define MAXREQUEST(dpy) (XMaxRequestSize (dpy))
107 #else
108 #define MAXREQUEST(dpy) ((dpy)->max_request_size)
109 #endif
111 /* The name we're using in resource queries. Most often "emacs". */
112 Lisp_Object Vx_resource_name;
114 /* The application class we're using in resource queries.
115 Normally "Emacs". */
116 Lisp_Object Vx_resource_class;
118 /* The background and shape of the mouse pointer, and shape when not
119 over text or in the modeline. */
120 Lisp_Object Vx_pointer_shape, Vx_nontext_pointer_shape, Vx_mode_pointer_shape;
121 /* The shape when over mouse-sensitive text. */
122 Lisp_Object Vx_sensitive_text_pointer_shape;
124 /* Color of chars displayed in cursor box. */
125 Lisp_Object Vx_cursor_fore_pixel;
127 /* Nonzero if using X. */
128 static int x_in_use;
130 /* Non nil if no window manager is in use. */
131 Lisp_Object Vx_no_window_manager;
133 /* Search path for bitmap files. */
134 Lisp_Object Vx_bitmap_file_path;
136 /* Regexp matching a font name whose width is the same as `PIXEL_SIZE'. */
137 Lisp_Object Vx_pixel_size_width_font_regexp;
139 /* Evaluate this expression to rebuild the section of syms_of_xfns
140 that initializes and staticpros the symbols declared below. Note
141 that Emacs 18 has a bug that keeps C-x C-e from being able to
142 evaluate this expression.
144 (progn
145 ;; Accumulate a list of the symbols we want to initialize from the
146 ;; declarations at the top of the file.
147 (goto-char (point-min))
148 (search-forward "/\*&&& symbols declared here &&&*\/\n")
149 (let (symbol-list)
150 (while (looking-at "Lisp_Object \\(Q[a-z_]+\\)")
151 (setq symbol-list
152 (cons (buffer-substring (match-beginning 1) (match-end 1))
153 symbol-list))
154 (forward-line 1))
155 (setq symbol-list (nreverse symbol-list))
156 ;; Delete the section of syms_of_... where we initialize the symbols.
157 (search-forward "\n /\*&&& init symbols here &&&*\/\n")
158 (let ((start (point)))
159 (while (looking-at "^ Q")
160 (forward-line 2))
161 (kill-region start (point)))
162 ;; Write a new symbol initialization section.
163 (while symbol-list
164 (insert (format " %s = intern (\"" (car symbol-list)))
165 (let ((start (point)))
166 (insert (substring (car symbol-list) 1))
167 (subst-char-in-region start (point) ?_ ?-))
168 (insert (format "\");\n staticpro (&%s);\n" (car symbol-list)))
169 (setq symbol-list (cdr symbol-list)))))
173 /*&&& symbols declared here &&&*/
174 Lisp_Object Qauto_raise;
175 Lisp_Object Qauto_lower;
176 Lisp_Object Qbackground_color;
177 Lisp_Object Qbar;
178 Lisp_Object Qborder_color;
179 Lisp_Object Qborder_width;
180 Lisp_Object Qbox;
181 Lisp_Object Qcursor_color;
182 Lisp_Object Qcursor_type;
183 Lisp_Object Qforeground_color;
184 Lisp_Object Qgeometry;
185 Lisp_Object Qicon_left;
186 Lisp_Object Qicon_top;
187 Lisp_Object Qicon_type;
188 Lisp_Object Qicon_name;
189 Lisp_Object Qinternal_border_width;
190 Lisp_Object Qleft;
191 Lisp_Object Qright;
192 Lisp_Object Qmouse_color;
193 Lisp_Object Qnone;
194 Lisp_Object Qparent_id;
195 Lisp_Object Qscroll_bar_width;
196 Lisp_Object Qsuppress_icon;
197 Lisp_Object Qtop;
198 Lisp_Object Qundefined_color;
199 Lisp_Object Qvertical_scroll_bars;
200 Lisp_Object Qvisibility;
201 Lisp_Object Qwindow_id;
202 Lisp_Object Qx_frame_parameter;
203 Lisp_Object Qx_resource_name;
204 Lisp_Object Quser_position;
205 Lisp_Object Quser_size;
206 Lisp_Object Qdisplay;
208 /* The below are defined in frame.c. */
209 extern Lisp_Object Qheight, Qminibuffer, Qname, Qonly, Qwidth;
210 extern Lisp_Object Qunsplittable, Qmenu_bar_lines, Qbuffer_predicate, Qtitle;
212 extern Lisp_Object Vwindow_system_version;
214 Lisp_Object Qface_set_after_frame_default;
216 /* Error if we are not connected to X. */
217 void
218 check_x ()
220 if (! x_in_use)
221 error ("X windows are not in use or not initialized");
224 /* Nonzero if we can use mouse menus.
225 You should not call this unless HAVE_MENUS is defined. */
228 have_menus_p ()
230 return x_in_use;
233 /* Extract a frame as a FRAME_PTR, defaulting to the selected frame
234 and checking validity for X. */
236 FRAME_PTR
237 check_x_frame (frame)
238 Lisp_Object frame;
240 FRAME_PTR f;
242 if (NILP (frame))
243 f = selected_frame;
244 else
246 CHECK_LIVE_FRAME (frame, 0);
247 f = XFRAME (frame);
249 if (! FRAME_X_P (f))
250 error ("Non-X frame used");
251 return f;
254 /* Let the user specify an X display with a frame.
255 nil stands for the selected frame--or, if that is not an X frame,
256 the first X display on the list. */
258 static struct x_display_info *
259 check_x_display_info (frame)
260 Lisp_Object frame;
262 if (NILP (frame))
264 if (FRAME_X_P (selected_frame))
265 return FRAME_X_DISPLAY_INFO (selected_frame);
266 else if (x_display_list != 0)
267 return x_display_list;
268 else
269 error ("X windows are not in use or not initialized");
271 else if (STRINGP (frame))
272 return x_display_info_for_name (frame);
273 else
275 FRAME_PTR f;
277 CHECK_LIVE_FRAME (frame, 0);
278 f = XFRAME (frame);
279 if (! FRAME_X_P (f))
280 error ("Non-X frame used");
281 return FRAME_X_DISPLAY_INFO (f);
285 /* Return the Emacs frame-object corresponding to an X window.
286 It could be the frame's main window or an icon window. */
288 /* This function can be called during GC, so use GC_xxx type test macros. */
290 struct frame *
291 x_window_to_frame (dpyinfo, wdesc)
292 struct x_display_info *dpyinfo;
293 int wdesc;
295 Lisp_Object tail, frame;
296 struct frame *f;
298 for (tail = Vframe_list; GC_CONSP (tail); tail = XCONS (tail)->cdr)
300 frame = XCONS (tail)->car;
301 if (!GC_FRAMEP (frame))
302 continue;
303 f = XFRAME (frame);
304 if (f->output_data.nothing == 1 || FRAME_X_DISPLAY_INFO (f) != dpyinfo)
305 continue;
306 #ifdef USE_X_TOOLKIT
307 if ((f->output_data.x->edit_widget
308 && XtWindow (f->output_data.x->edit_widget) == wdesc)
309 || f->output_data.x->icon_desc == wdesc)
310 return f;
311 #else /* not USE_X_TOOLKIT */
312 if (FRAME_X_WINDOW (f) == wdesc
313 || f->output_data.x->icon_desc == wdesc)
314 return f;
315 #endif /* not USE_X_TOOLKIT */
317 return 0;
320 #ifdef USE_X_TOOLKIT
321 /* Like x_window_to_frame but also compares the window with the widget's
322 windows. */
324 struct frame *
325 x_any_window_to_frame (dpyinfo, wdesc)
326 struct x_display_info *dpyinfo;
327 int wdesc;
329 Lisp_Object tail, frame;
330 struct frame *f;
331 struct x_output *x;
333 for (tail = Vframe_list; GC_CONSP (tail); tail = XCONS (tail)->cdr)
335 frame = XCONS (tail)->car;
336 if (!GC_FRAMEP (frame))
337 continue;
338 f = XFRAME (frame);
339 if (f->output_data.nothing == 1 || FRAME_X_DISPLAY_INFO (f) != dpyinfo)
340 continue;
341 x = f->output_data.x;
342 /* This frame matches if the window is any of its widgets. */
343 if (wdesc == XtWindow (x->widget)
344 || wdesc == XtWindow (x->column_widget)
345 || wdesc == XtWindow (x->edit_widget))
346 return f;
347 /* Match if the window is this frame's menubar. */
348 if (lw_window_is_in_menubar (wdesc, x->menubar_widget))
349 return f;
351 return 0;
354 /* Likewise, but exclude the menu bar widget. */
356 struct frame *
357 x_non_menubar_window_to_frame (dpyinfo, wdesc)
358 struct x_display_info *dpyinfo;
359 int wdesc;
361 Lisp_Object tail, frame;
362 struct frame *f;
363 struct x_output *x;
365 for (tail = Vframe_list; GC_CONSP (tail); tail = XCONS (tail)->cdr)
367 frame = XCONS (tail)->car;
368 if (!GC_FRAMEP (frame))
369 continue;
370 f = XFRAME (frame);
371 if (f->output_data.nothing == 1 || FRAME_X_DISPLAY_INFO (f) != dpyinfo)
372 continue;
373 x = f->output_data.x;
374 /* This frame matches if the window is any of its widgets. */
375 if (wdesc == XtWindow (x->widget)
376 || wdesc == XtWindow (x->column_widget)
377 || wdesc == XtWindow (x->edit_widget))
378 return f;
380 return 0;
383 /* Likewise, but consider only the menu bar widget. */
385 struct frame *
386 x_menubar_window_to_frame (dpyinfo, wdesc)
387 struct x_display_info *dpyinfo;
388 int wdesc;
390 Lisp_Object tail, frame;
391 struct frame *f;
392 struct x_output *x;
394 for (tail = Vframe_list; GC_CONSP (tail); tail = XCONS (tail)->cdr)
396 frame = XCONS (tail)->car;
397 if (!GC_FRAMEP (frame))
398 continue;
399 f = XFRAME (frame);
400 if (f->output_data.nothing == 1 || FRAME_X_DISPLAY_INFO (f) != dpyinfo)
401 continue;
402 x = f->output_data.x;
403 /* Match if the window is this frame's menubar. */
404 if (lw_window_is_in_menubar (wdesc, x->menubar_widget))
405 return f;
407 return 0;
410 /* Return the frame whose principal (outermost) window is WDESC.
411 If WDESC is some other (smaller) window, we return 0. */
413 struct frame *
414 x_top_window_to_frame (dpyinfo, wdesc)
415 struct x_display_info *dpyinfo;
416 int wdesc;
418 Lisp_Object tail, frame;
419 struct frame *f;
420 struct x_output *x;
422 for (tail = Vframe_list; GC_CONSP (tail); tail = XCONS (tail)->cdr)
424 frame = XCONS (tail)->car;
425 if (!GC_FRAMEP (frame))
426 continue;
427 f = XFRAME (frame);
428 if (f->output_data.nothing == 1 || FRAME_X_DISPLAY_INFO (f) != dpyinfo)
429 continue;
430 x = f->output_data.x;
431 /* This frame matches if the window is its topmost widget. */
432 if (wdesc == XtWindow (x->widget))
433 return f;
434 #if 0 /* I don't know why it did this,
435 but it seems logically wrong,
436 and it causes trouble for MapNotify events. */
437 /* Match if the window is this frame's menubar. */
438 if (x->menubar_widget
439 && wdesc == XtWindow (x->menubar_widget))
440 return f;
441 #endif
443 return 0;
445 #endif /* USE_X_TOOLKIT */
449 /* Code to deal with bitmaps. Bitmaps are referenced by their bitmap
450 id, which is just an int that this section returns. Bitmaps are
451 reference counted so they can be shared among frames.
453 Bitmap indices are guaranteed to be > 0, so a negative number can
454 be used to indicate no bitmap.
456 If you use x_create_bitmap_from_data, then you must keep track of
457 the bitmaps yourself. That is, creating a bitmap from the same
458 data more than once will not be caught. */
461 /* Functions to access the contents of a bitmap, given an id. */
464 x_bitmap_height (f, id)
465 FRAME_PTR f;
466 int id;
468 return FRAME_X_DISPLAY_INFO (f)->bitmaps[id - 1].height;
472 x_bitmap_width (f, id)
473 FRAME_PTR f;
474 int id;
476 return FRAME_X_DISPLAY_INFO (f)->bitmaps[id - 1].width;
480 x_bitmap_pixmap (f, id)
481 FRAME_PTR f;
482 int id;
484 return FRAME_X_DISPLAY_INFO (f)->bitmaps[id - 1].pixmap;
488 /* Allocate a new bitmap record. Returns index of new record. */
490 static int
491 x_allocate_bitmap_record (f)
492 FRAME_PTR f;
494 struct x_display_info *dpyinfo = FRAME_X_DISPLAY_INFO (f);
495 int i;
497 if (dpyinfo->bitmaps == NULL)
499 dpyinfo->bitmaps_size = 10;
500 dpyinfo->bitmaps
501 = (struct x_bitmap_record *) xmalloc (dpyinfo->bitmaps_size * sizeof (struct x_bitmap_record));
502 dpyinfo->bitmaps_last = 1;
503 return 1;
506 if (dpyinfo->bitmaps_last < dpyinfo->bitmaps_size)
507 return ++dpyinfo->bitmaps_last;
509 for (i = 0; i < dpyinfo->bitmaps_size; ++i)
510 if (dpyinfo->bitmaps[i].refcount == 0)
511 return i + 1;
513 dpyinfo->bitmaps_size *= 2;
514 dpyinfo->bitmaps
515 = (struct x_bitmap_record *) xrealloc (dpyinfo->bitmaps,
516 dpyinfo->bitmaps_size * sizeof (struct x_bitmap_record));
517 return ++dpyinfo->bitmaps_last;
520 /* Add one reference to the reference count of the bitmap with id ID. */
522 void
523 x_reference_bitmap (f, id)
524 FRAME_PTR f;
525 int id;
527 ++FRAME_X_DISPLAY_INFO (f)->bitmaps[id - 1].refcount;
530 /* Create a bitmap for frame F from a HEIGHT x WIDTH array of bits at BITS. */
533 x_create_bitmap_from_data (f, bits, width, height)
534 struct frame *f;
535 char *bits;
536 unsigned int width, height;
538 struct x_display_info *dpyinfo = FRAME_X_DISPLAY_INFO (f);
539 Pixmap bitmap;
540 int id;
542 bitmap = XCreateBitmapFromData (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
543 bits, width, height);
545 if (! bitmap)
546 return -1;
548 id = x_allocate_bitmap_record (f);
549 dpyinfo->bitmaps[id - 1].pixmap = bitmap;
550 dpyinfo->bitmaps[id - 1].file = NULL;
551 dpyinfo->bitmaps[id - 1].refcount = 1;
552 dpyinfo->bitmaps[id - 1].depth = 1;
553 dpyinfo->bitmaps[id - 1].height = height;
554 dpyinfo->bitmaps[id - 1].width = width;
556 return id;
559 /* Create bitmap from file FILE for frame F. */
562 x_create_bitmap_from_file (f, file)
563 struct frame *f;
564 Lisp_Object file;
566 struct x_display_info *dpyinfo = FRAME_X_DISPLAY_INFO (f);
567 unsigned int width, height;
568 Pixmap bitmap;
569 int xhot, yhot, result, id;
570 Lisp_Object found;
571 int fd;
572 char *filename;
574 /* Look for an existing bitmap with the same name. */
575 for (id = 0; id < dpyinfo->bitmaps_last; ++id)
577 if (dpyinfo->bitmaps[id].refcount
578 && dpyinfo->bitmaps[id].file
579 && !strcmp (dpyinfo->bitmaps[id].file, (char *) XSTRING (file)->data))
581 ++dpyinfo->bitmaps[id].refcount;
582 return id + 1;
586 /* Search bitmap-file-path for the file, if appropriate. */
587 fd = openp (Vx_bitmap_file_path, file, "", &found, 0);
588 if (fd < 0)
589 return -1;
590 close (fd);
592 filename = (char *) XSTRING (found)->data;
594 result = XReadBitmapFile (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
595 filename, &width, &height, &bitmap, &xhot, &yhot);
596 if (result != BitmapSuccess)
597 return -1;
599 id = x_allocate_bitmap_record (f);
600 dpyinfo->bitmaps[id - 1].pixmap = bitmap;
601 dpyinfo->bitmaps[id - 1].refcount = 1;
602 dpyinfo->bitmaps[id - 1].file = (char *) xmalloc (XSTRING (file)->size + 1);
603 dpyinfo->bitmaps[id - 1].depth = 1;
604 dpyinfo->bitmaps[id - 1].height = height;
605 dpyinfo->bitmaps[id - 1].width = width;
606 strcpy (dpyinfo->bitmaps[id - 1].file, XSTRING (file)->data);
608 return id;
611 /* Remove reference to bitmap with id number ID. */
614 x_destroy_bitmap (f, id)
615 FRAME_PTR f;
616 int id;
618 struct x_display_info *dpyinfo = FRAME_X_DISPLAY_INFO (f);
620 if (id > 0)
622 --dpyinfo->bitmaps[id - 1].refcount;
623 if (dpyinfo->bitmaps[id - 1].refcount == 0)
625 BLOCK_INPUT;
626 XFreePixmap (FRAME_X_DISPLAY (f), dpyinfo->bitmaps[id - 1].pixmap);
627 if (dpyinfo->bitmaps[id - 1].file)
629 free (dpyinfo->bitmaps[id - 1].file);
630 dpyinfo->bitmaps[id - 1].file = NULL;
632 UNBLOCK_INPUT;
637 /* Free all the bitmaps for the display specified by DPYINFO. */
639 static void
640 x_destroy_all_bitmaps (dpyinfo)
641 struct x_display_info *dpyinfo;
643 int i;
644 for (i = 0; i < dpyinfo->bitmaps_last; i++)
645 if (dpyinfo->bitmaps[i].refcount > 0)
647 XFreePixmap (dpyinfo->display, dpyinfo->bitmaps[i].pixmap);
648 if (dpyinfo->bitmaps[i].file)
649 free (dpyinfo->bitmaps[i].file);
651 dpyinfo->bitmaps_last = 0;
654 /* Connect the frame-parameter names for X frames
655 to the ways of passing the parameter values to the window system.
657 The name of a parameter, as a Lisp symbol,
658 has an `x-frame-parameter' property which is an integer in Lisp
659 that is an index in this table. */
661 struct x_frame_parm_table
663 char *name;
664 void (*setter)( /* struct frame *frame, Lisp_Object val, oldval */ );
667 void x_set_foreground_color ();
668 void x_set_background_color ();
669 void x_set_mouse_color ();
670 void x_set_cursor_color ();
671 void x_set_border_color ();
672 void x_set_cursor_type ();
673 void x_set_icon_type ();
674 void x_set_icon_name ();
675 void x_set_font ();
676 void x_set_border_width ();
677 void x_set_internal_border_width ();
678 void x_explicitly_set_name ();
679 void x_set_autoraise ();
680 void x_set_autolower ();
681 void x_set_vertical_scroll_bars ();
682 void x_set_visibility ();
683 void x_set_menu_bar_lines ();
684 void x_set_scroll_bar_width ();
685 void x_set_title ();
686 void x_set_unsplittable ();
688 static struct x_frame_parm_table x_frame_parms[] =
690 "auto-raise", x_set_autoraise,
691 "auto-lower", x_set_autolower,
692 "background-color", x_set_background_color,
693 "border-color", x_set_border_color,
694 "border-width", x_set_border_width,
695 "cursor-color", x_set_cursor_color,
696 "cursor-type", x_set_cursor_type,
697 "font", x_set_font,
698 "foreground-color", x_set_foreground_color,
699 "icon-name", x_set_icon_name,
700 "icon-type", x_set_icon_type,
701 "internal-border-width", x_set_internal_border_width,
702 "menu-bar-lines", x_set_menu_bar_lines,
703 "mouse-color", x_set_mouse_color,
704 "name", x_explicitly_set_name,
705 "scroll-bar-width", x_set_scroll_bar_width,
706 "title", x_set_title,
707 "unsplittable", x_set_unsplittable,
708 "vertical-scroll-bars", x_set_vertical_scroll_bars,
709 "visibility", x_set_visibility,
712 /* Attach the `x-frame-parameter' properties to
713 the Lisp symbol names of parameters relevant to X. */
715 init_x_parm_symbols ()
717 int i;
719 for (i = 0; i < sizeof (x_frame_parms) / sizeof (x_frame_parms[0]); i++)
720 Fput (intern (x_frame_parms[i].name), Qx_frame_parameter,
721 make_number (i));
724 /* Change the parameters of frame F as specified by ALIST.
725 If a parameter is not specially recognized, do nothing;
726 otherwise call the `x_set_...' function for that parameter. */
728 void
729 x_set_frame_parameters (f, alist)
730 FRAME_PTR f;
731 Lisp_Object alist;
733 Lisp_Object tail;
735 /* If both of these parameters are present, it's more efficient to
736 set them both at once. So we wait until we've looked at the
737 entire list before we set them. */
738 int width, height;
740 /* Same here. */
741 Lisp_Object left, top;
743 /* Same with these. */
744 Lisp_Object icon_left, icon_top;
746 /* Record in these vectors all the parms specified. */
747 Lisp_Object *parms;
748 Lisp_Object *values;
749 int i;
750 int left_no_change = 0, top_no_change = 0;
751 int icon_left_no_change = 0, icon_top_no_change = 0;
753 i = 0;
754 for (tail = alist; CONSP (tail); tail = Fcdr (tail))
755 i++;
757 parms = (Lisp_Object *) alloca (i * sizeof (Lisp_Object));
758 values = (Lisp_Object *) alloca (i * sizeof (Lisp_Object));
760 /* Extract parm names and values into those vectors. */
762 i = 0;
763 for (tail = alist; CONSP (tail); tail = Fcdr (tail))
765 Lisp_Object elt, prop, val;
767 elt = Fcar (tail);
768 parms[i] = Fcar (elt);
769 values[i] = Fcdr (elt);
770 i++;
773 top = left = Qunbound;
774 icon_left = icon_top = Qunbound;
776 /* Provide default values for HEIGHT and WIDTH. */
777 if (FRAME_NEW_WIDTH (f))
778 width = FRAME_NEW_WIDTH (f);
779 else
780 width = FRAME_WIDTH (f);
782 if (FRAME_NEW_HEIGHT (f))
783 height = FRAME_NEW_HEIGHT (f);
784 else
785 height = FRAME_HEIGHT (f);
787 /* Now process them in reverse of specified order. */
788 for (i--; i >= 0; i--)
790 Lisp_Object prop, val;
792 prop = parms[i];
793 val = values[i];
795 if (EQ (prop, Qwidth) && NUMBERP (val))
796 width = XFASTINT (val);
797 else if (EQ (prop, Qheight) && NUMBERP (val))
798 height = XFASTINT (val);
799 else if (EQ (prop, Qtop))
800 top = val;
801 else if (EQ (prop, Qleft))
802 left = val;
803 else if (EQ (prop, Qicon_top))
804 icon_top = val;
805 else if (EQ (prop, Qicon_left))
806 icon_left = val;
807 else
809 register Lisp_Object param_index, old_value;
811 param_index = Fget (prop, Qx_frame_parameter);
812 old_value = get_frame_param (f, prop);
813 store_frame_param (f, prop, val);
814 if (NATNUMP (param_index)
815 && (XFASTINT (param_index)
816 < sizeof (x_frame_parms)/sizeof (x_frame_parms[0])))
817 (*x_frame_parms[XINT (param_index)].setter)(f, val, old_value);
821 /* Don't die if just one of these was set. */
822 if (EQ (left, Qunbound))
824 left_no_change = 1;
825 if (f->output_data.x->left_pos < 0)
826 left = Fcons (Qplus, Fcons (make_number (f->output_data.x->left_pos), Qnil));
827 else
828 XSETINT (left, f->output_data.x->left_pos);
830 if (EQ (top, Qunbound))
832 top_no_change = 1;
833 if (f->output_data.x->top_pos < 0)
834 top = Fcons (Qplus, Fcons (make_number (f->output_data.x->top_pos), Qnil));
835 else
836 XSETINT (top, f->output_data.x->top_pos);
839 /* If one of the icon positions was not set, preserve or default it. */
840 if (EQ (icon_left, Qunbound) || ! INTEGERP (icon_left))
842 icon_left_no_change = 1;
843 icon_left = Fcdr (Fassq (Qicon_left, f->param_alist));
844 if (NILP (icon_left))
845 XSETINT (icon_left, 0);
847 if (EQ (icon_top, Qunbound) || ! INTEGERP (icon_top))
849 icon_top_no_change = 1;
850 icon_top = Fcdr (Fassq (Qicon_top, f->param_alist));
851 if (NILP (icon_top))
852 XSETINT (icon_top, 0);
855 /* Don't set these parameters unless they've been explicitly
856 specified. The window might be mapped or resized while we're in
857 this function, and we don't want to override that unless the lisp
858 code has asked for it.
860 Don't set these parameters unless they actually differ from the
861 window's current parameters; the window may not actually exist
862 yet. */
864 Lisp_Object frame;
866 check_frame_size (f, &height, &width);
868 XSETFRAME (frame, f);
870 if (width != FRAME_WIDTH (f)
871 || height != FRAME_HEIGHT (f)
872 || FRAME_NEW_HEIGHT (f) || FRAME_NEW_WIDTH (f))
873 Fset_frame_size (frame, make_number (width), make_number (height));
875 if ((!NILP (left) || !NILP (top))
876 && ! (left_no_change && top_no_change)
877 && ! (NUMBERP (left) && XINT (left) == f->output_data.x->left_pos
878 && NUMBERP (top) && XINT (top) == f->output_data.x->top_pos))
880 int leftpos = 0;
881 int toppos = 0;
883 /* Record the signs. */
884 f->output_data.x->size_hint_flags &= ~ (XNegative | YNegative);
885 if (EQ (left, Qminus))
886 f->output_data.x->size_hint_flags |= XNegative;
887 else if (INTEGERP (left))
889 leftpos = XINT (left);
890 if (leftpos < 0)
891 f->output_data.x->size_hint_flags |= XNegative;
893 else if (CONSP (left) && EQ (XCONS (left)->car, Qminus)
894 && CONSP (XCONS (left)->cdr)
895 && INTEGERP (XCONS (XCONS (left)->cdr)->car))
897 leftpos = - XINT (XCONS (XCONS (left)->cdr)->car);
898 f->output_data.x->size_hint_flags |= XNegative;
900 else if (CONSP (left) && EQ (XCONS (left)->car, Qplus)
901 && CONSP (XCONS (left)->cdr)
902 && INTEGERP (XCONS (XCONS (left)->cdr)->car))
904 leftpos = XINT (XCONS (XCONS (left)->cdr)->car);
907 if (EQ (top, Qminus))
908 f->output_data.x->size_hint_flags |= YNegative;
909 else if (INTEGERP (top))
911 toppos = XINT (top);
912 if (toppos < 0)
913 f->output_data.x->size_hint_flags |= YNegative;
915 else if (CONSP (top) && EQ (XCONS (top)->car, Qminus)
916 && CONSP (XCONS (top)->cdr)
917 && INTEGERP (XCONS (XCONS (top)->cdr)->car))
919 toppos = - XINT (XCONS (XCONS (top)->cdr)->car);
920 f->output_data.x->size_hint_flags |= YNegative;
922 else if (CONSP (top) && EQ (XCONS (top)->car, Qplus)
923 && CONSP (XCONS (top)->cdr)
924 && INTEGERP (XCONS (XCONS (top)->cdr)->car))
926 toppos = XINT (XCONS (XCONS (top)->cdr)->car);
930 /* Store the numeric value of the position. */
931 f->output_data.x->top_pos = toppos;
932 f->output_data.x->left_pos = leftpos;
934 f->output_data.x->win_gravity = NorthWestGravity;
936 /* Actually set that position, and convert to absolute. */
937 x_set_offset (f, leftpos, toppos, -1);
940 if ((!NILP (icon_left) || !NILP (icon_top))
941 && ! (icon_left_no_change && icon_top_no_change))
942 x_wm_set_icon_position (f, XINT (icon_left), XINT (icon_top));
946 /* Store the screen positions of frame F into XPTR and YPTR.
947 These are the positions of the containing window manager window,
948 not Emacs's own window. */
950 void
951 x_real_positions (f, xptr, yptr)
952 FRAME_PTR f;
953 int *xptr, *yptr;
955 int win_x, win_y;
956 Window child;
958 /* This is pretty gross, but seems to be the easiest way out of
959 the problem that arises when restarting window-managers. */
961 #ifdef USE_X_TOOLKIT
962 Window outer = XtWindow (f->output_data.x->widget);
963 #else
964 Window outer = f->output_data.x->window_desc;
965 #endif
966 Window tmp_root_window;
967 Window *tmp_children;
968 int tmp_nchildren;
970 while (1)
972 int count = x_catch_errors (FRAME_X_DISPLAY (f));
973 Window outer_window;
975 XQueryTree (FRAME_X_DISPLAY (f), outer, &tmp_root_window,
976 &f->output_data.x->parent_desc,
977 &tmp_children, &tmp_nchildren);
978 XFree ((char *) tmp_children);
980 win_x = win_y = 0;
982 /* Find the position of the outside upper-left corner of
983 the inner window, with respect to the outer window. */
984 if (f->output_data.x->parent_desc != FRAME_X_DISPLAY_INFO (f)->root_window)
985 outer_window = f->output_data.x->parent_desc;
986 else
987 outer_window = outer;
989 XTranslateCoordinates (FRAME_X_DISPLAY (f),
991 /* From-window, to-window. */
992 outer_window,
993 FRAME_X_DISPLAY_INFO (f)->root_window,
995 /* From-position, to-position. */
996 0, 0, &win_x, &win_y,
998 /* Child of win. */
999 &child);
1001 /* It is possible for the window returned by the XQueryNotify
1002 to become invalid by the time we call XTranslateCoordinates.
1003 That can happen when you restart some window managers.
1004 If so, we get an error in XTranslateCoordinates.
1005 Detect that and try the whole thing over. */
1006 if (! x_had_errors_p (FRAME_X_DISPLAY (f)))
1008 x_uncatch_errors (FRAME_X_DISPLAY (f), count);
1009 break;
1012 x_uncatch_errors (FRAME_X_DISPLAY (f), count);
1015 *xptr = win_x - f->output_data.x->border_width;
1016 *yptr = win_y - f->output_data.x->border_width;
1019 /* Insert a description of internally-recorded parameters of frame X
1020 into the parameter alist *ALISTPTR that is to be given to the user.
1021 Only parameters that are specific to the X window system
1022 and whose values are not correctly recorded in the frame's
1023 param_alist need to be considered here. */
1025 x_report_frame_params (f, alistptr)
1026 struct frame *f;
1027 Lisp_Object *alistptr;
1029 char buf[16];
1030 Lisp_Object tem;
1032 /* Represent negative positions (off the top or left screen edge)
1033 in a way that Fmodify_frame_parameters will understand correctly. */
1034 XSETINT (tem, f->output_data.x->left_pos);
1035 if (f->output_data.x->left_pos >= 0)
1036 store_in_alist (alistptr, Qleft, tem);
1037 else
1038 store_in_alist (alistptr, Qleft, Fcons (Qplus, Fcons (tem, Qnil)));
1040 XSETINT (tem, f->output_data.x->top_pos);
1041 if (f->output_data.x->top_pos >= 0)
1042 store_in_alist (alistptr, Qtop, tem);
1043 else
1044 store_in_alist (alistptr, Qtop, Fcons (Qplus, Fcons (tem, Qnil)));
1046 store_in_alist (alistptr, Qborder_width,
1047 make_number (f->output_data.x->border_width));
1048 store_in_alist (alistptr, Qinternal_border_width,
1049 make_number (f->output_data.x->internal_border_width));
1050 sprintf (buf, "%ld", (long) FRAME_X_WINDOW (f));
1051 store_in_alist (alistptr, Qwindow_id,
1052 build_string (buf));
1053 store_in_alist (alistptr, Qicon_name, f->icon_name);
1054 FRAME_SAMPLE_VISIBILITY (f);
1055 store_in_alist (alistptr, Qvisibility,
1056 (FRAME_VISIBLE_P (f) ? Qt
1057 : FRAME_ICONIFIED_P (f) ? Qicon : Qnil));
1058 store_in_alist (alistptr, Qdisplay,
1059 XCONS (FRAME_X_DISPLAY_INFO (f)->name_list_element)->car);
1061 if (f->output_data.x->parent_desc == FRAME_X_DISPLAY_INFO (f)->root_window)
1062 tem = Qnil;
1063 else
1064 XSETFASTINT (tem, f->output_data.x->parent_desc);
1065 store_in_alist (alistptr, Qparent_id, tem);
1069 /* Decide if color named COLOR is valid for the display associated with
1070 the selected frame; if so, return the rgb values in COLOR_DEF.
1071 If ALLOC is nonzero, allocate a new colormap cell. */
1074 defined_color (f, color, color_def, alloc)
1075 FRAME_PTR f;
1076 char *color;
1077 XColor *color_def;
1078 int alloc;
1080 register int status;
1081 Colormap screen_colormap;
1082 Display *display = FRAME_X_DISPLAY (f);
1084 BLOCK_INPUT;
1085 screen_colormap = DefaultColormap (display, XDefaultScreen (display));
1087 status = XParseColor (display, screen_colormap, color, color_def);
1088 if (status && alloc)
1090 status = XAllocColor (display, screen_colormap, color_def);
1091 if (!status)
1093 /* If we got to this point, the colormap is full, so we're
1094 going to try and get the next closest color.
1095 The algorithm used is a least-squares matching, which is
1096 what X uses for closest color matching with StaticColor visuals. */
1098 XColor *cells;
1099 int no_cells;
1100 int nearest;
1101 long nearest_delta, trial_delta;
1102 int x;
1104 no_cells = XDisplayCells (display, XDefaultScreen (display));
1105 cells = (XColor *) alloca (sizeof (XColor) * no_cells);
1107 for (x = 0; x < no_cells; x++)
1108 cells[x].pixel = x;
1110 XQueryColors (display, screen_colormap, cells, no_cells);
1111 nearest = 0;
1112 /* I'm assuming CSE so I'm not going to condense this. */
1113 nearest_delta = ((((color_def->red >> 8) - (cells[0].red >> 8))
1114 * ((color_def->red >> 8) - (cells[0].red >> 8)))
1116 (((color_def->green >> 8) - (cells[0].green >> 8))
1117 * ((color_def->green >> 8) - (cells[0].green >> 8)))
1119 (((color_def->blue >> 8) - (cells[0].blue >> 8))
1120 * ((color_def->blue >> 8) - (cells[0].blue >> 8))));
1121 for (x = 1; x < no_cells; x++)
1123 trial_delta = ((((color_def->red >> 8) - (cells[x].red >> 8))
1124 * ((color_def->red >> 8) - (cells[x].red >> 8)))
1126 (((color_def->green >> 8) - (cells[x].green >> 8))
1127 * ((color_def->green >> 8) - (cells[x].green >> 8)))
1129 (((color_def->blue >> 8) - (cells[x].blue >> 8))
1130 * ((color_def->blue >> 8) - (cells[x].blue >> 8))));
1131 if (trial_delta < nearest_delta)
1133 XColor temp;
1134 temp.red = cells[x].red;
1135 temp.green = cells[x].green;
1136 temp.blue = cells[x].blue;
1137 status = XAllocColor (display, screen_colormap, &temp);
1138 if (status)
1140 nearest = x;
1141 nearest_delta = trial_delta;
1145 color_def->red = cells[nearest].red;
1146 color_def->green = cells[nearest].green;
1147 color_def->blue = cells[nearest].blue;
1148 status = XAllocColor (display, screen_colormap, color_def);
1151 UNBLOCK_INPUT;
1153 if (status)
1154 return 1;
1155 else
1156 return 0;
1159 /* Given a string ARG naming a color, compute a pixel value from it
1160 suitable for screen F.
1161 If F is not a color screen, return DEF (default) regardless of what
1162 ARG says. */
1165 x_decode_color (f, arg, def)
1166 FRAME_PTR f;
1167 Lisp_Object arg;
1168 int def;
1170 XColor cdef;
1172 CHECK_STRING (arg, 0);
1174 if (strcmp (XSTRING (arg)->data, "black") == 0)
1175 return BLACK_PIX_DEFAULT (f);
1176 else if (strcmp (XSTRING (arg)->data, "white") == 0)
1177 return WHITE_PIX_DEFAULT (f);
1179 if (FRAME_X_DISPLAY_INFO (f)->n_planes == 1)
1180 return def;
1182 /* defined_color is responsible for coping with failures
1183 by looking for a near-miss. */
1184 if (defined_color (f, XSTRING (arg)->data, &cdef, 1))
1185 return cdef.pixel;
1187 Fsignal (Qerror, Fcons (build_string ("undefined color"),
1188 Fcons (arg, Qnil)));
1191 /* Functions called only from `x_set_frame_param'
1192 to set individual parameters.
1194 If FRAME_X_WINDOW (f) is 0,
1195 the frame is being created and its X-window does not exist yet.
1196 In that case, just record the parameter's new value
1197 in the standard place; do not attempt to change the window. */
1199 void
1200 x_set_foreground_color (f, arg, oldval)
1201 struct frame *f;
1202 Lisp_Object arg, oldval;
1204 f->output_data.x->foreground_pixel
1205 = x_decode_color (f, arg, BLACK_PIX_DEFAULT (f));
1206 if (FRAME_X_WINDOW (f) != 0)
1208 BLOCK_INPUT;
1209 XSetForeground (FRAME_X_DISPLAY (f), f->output_data.x->normal_gc,
1210 f->output_data.x->foreground_pixel);
1211 XSetBackground (FRAME_X_DISPLAY (f), f->output_data.x->reverse_gc,
1212 f->output_data.x->foreground_pixel);
1213 UNBLOCK_INPUT;
1214 recompute_basic_faces (f);
1215 if (FRAME_VISIBLE_P (f))
1216 redraw_frame (f);
1220 void
1221 x_set_background_color (f, arg, oldval)
1222 struct frame *f;
1223 Lisp_Object arg, oldval;
1225 Pixmap temp;
1226 int mask;
1228 f->output_data.x->background_pixel
1229 = x_decode_color (f, arg, WHITE_PIX_DEFAULT (f));
1231 if (FRAME_X_WINDOW (f) != 0)
1233 BLOCK_INPUT;
1234 /* The main frame area. */
1235 XSetBackground (FRAME_X_DISPLAY (f), f->output_data.x->normal_gc,
1236 f->output_data.x->background_pixel);
1237 XSetForeground (FRAME_X_DISPLAY (f), f->output_data.x->reverse_gc,
1238 f->output_data.x->background_pixel);
1239 XSetForeground (FRAME_X_DISPLAY (f), f->output_data.x->cursor_gc,
1240 f->output_data.x->background_pixel);
1241 XSetWindowBackground (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
1242 f->output_data.x->background_pixel);
1244 Lisp_Object bar;
1245 for (bar = FRAME_SCROLL_BARS (f); !NILP (bar);
1246 bar = XSCROLL_BAR (bar)->next)
1247 XSetWindowBackground (FRAME_X_DISPLAY (f),
1248 SCROLL_BAR_X_WINDOW (XSCROLL_BAR (bar)),
1249 f->output_data.x->background_pixel);
1251 UNBLOCK_INPUT;
1253 recompute_basic_faces (f);
1255 if (FRAME_VISIBLE_P (f))
1256 redraw_frame (f);
1260 void
1261 x_set_mouse_color (f, arg, oldval)
1262 struct frame *f;
1263 Lisp_Object arg, oldval;
1265 Cursor cursor, nontext_cursor, mode_cursor, cross_cursor;
1266 int count;
1267 int mask_color;
1269 if (!EQ (Qnil, arg))
1270 f->output_data.x->mouse_pixel
1271 = x_decode_color (f, arg, BLACK_PIX_DEFAULT (f));
1272 mask_color = f->output_data.x->background_pixel;
1273 /* No invisible pointers. */
1274 if (mask_color == f->output_data.x->mouse_pixel
1275 && mask_color == f->output_data.x->background_pixel)
1276 f->output_data.x->mouse_pixel = f->output_data.x->foreground_pixel;
1278 BLOCK_INPUT;
1280 /* It's not okay to crash if the user selects a screwy cursor. */
1281 count = x_catch_errors (FRAME_X_DISPLAY (f));
1283 if (!EQ (Qnil, Vx_pointer_shape))
1285 CHECK_NUMBER (Vx_pointer_shape, 0);
1286 cursor = XCreateFontCursor (FRAME_X_DISPLAY (f), XINT (Vx_pointer_shape));
1288 else
1289 cursor = XCreateFontCursor (FRAME_X_DISPLAY (f), XC_xterm);
1290 x_check_errors (FRAME_X_DISPLAY (f), "bad text pointer cursor: %s");
1292 if (!EQ (Qnil, Vx_nontext_pointer_shape))
1294 CHECK_NUMBER (Vx_nontext_pointer_shape, 0);
1295 nontext_cursor = XCreateFontCursor (FRAME_X_DISPLAY (f),
1296 XINT (Vx_nontext_pointer_shape));
1298 else
1299 nontext_cursor = XCreateFontCursor (FRAME_X_DISPLAY (f), XC_left_ptr);
1300 x_check_errors (FRAME_X_DISPLAY (f), "bad nontext pointer cursor: %s");
1302 if (!EQ (Qnil, Vx_mode_pointer_shape))
1304 CHECK_NUMBER (Vx_mode_pointer_shape, 0);
1305 mode_cursor = XCreateFontCursor (FRAME_X_DISPLAY (f),
1306 XINT (Vx_mode_pointer_shape));
1308 else
1309 mode_cursor = XCreateFontCursor (FRAME_X_DISPLAY (f), XC_xterm);
1310 x_check_errors (FRAME_X_DISPLAY (f), "bad modeline pointer cursor: %s");
1312 if (!EQ (Qnil, Vx_sensitive_text_pointer_shape))
1314 CHECK_NUMBER (Vx_sensitive_text_pointer_shape, 0);
1315 cross_cursor
1316 = XCreateFontCursor (FRAME_X_DISPLAY (f),
1317 XINT (Vx_sensitive_text_pointer_shape));
1319 else
1320 cross_cursor = XCreateFontCursor (FRAME_X_DISPLAY (f), XC_crosshair);
1322 /* Check and report errors with the above calls. */
1323 x_check_errors (FRAME_X_DISPLAY (f), "can't set cursor shape: %s");
1324 x_uncatch_errors (FRAME_X_DISPLAY (f), count);
1327 XColor fore_color, back_color;
1329 fore_color.pixel = f->output_data.x->mouse_pixel;
1330 back_color.pixel = mask_color;
1331 XQueryColor (FRAME_X_DISPLAY (f),
1332 DefaultColormap (FRAME_X_DISPLAY (f),
1333 DefaultScreen (FRAME_X_DISPLAY (f))),
1334 &fore_color);
1335 XQueryColor (FRAME_X_DISPLAY (f),
1336 DefaultColormap (FRAME_X_DISPLAY (f),
1337 DefaultScreen (FRAME_X_DISPLAY (f))),
1338 &back_color);
1339 XRecolorCursor (FRAME_X_DISPLAY (f), cursor,
1340 &fore_color, &back_color);
1341 XRecolorCursor (FRAME_X_DISPLAY (f), nontext_cursor,
1342 &fore_color, &back_color);
1343 XRecolorCursor (FRAME_X_DISPLAY (f), mode_cursor,
1344 &fore_color, &back_color);
1345 XRecolorCursor (FRAME_X_DISPLAY (f), cross_cursor,
1346 &fore_color, &back_color);
1349 if (FRAME_X_WINDOW (f) != 0)
1351 XDefineCursor (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f), cursor);
1354 if (cursor != f->output_data.x->text_cursor && f->output_data.x->text_cursor != 0)
1355 XFreeCursor (FRAME_X_DISPLAY (f), f->output_data.x->text_cursor);
1356 f->output_data.x->text_cursor = cursor;
1358 if (nontext_cursor != f->output_data.x->nontext_cursor
1359 && f->output_data.x->nontext_cursor != 0)
1360 XFreeCursor (FRAME_X_DISPLAY (f), f->output_data.x->nontext_cursor);
1361 f->output_data.x->nontext_cursor = nontext_cursor;
1363 if (mode_cursor != f->output_data.x->modeline_cursor
1364 && f->output_data.x->modeline_cursor != 0)
1365 XFreeCursor (FRAME_X_DISPLAY (f), f->output_data.x->modeline_cursor);
1366 f->output_data.x->modeline_cursor = mode_cursor;
1367 if (cross_cursor != f->output_data.x->cross_cursor
1368 && f->output_data.x->cross_cursor != 0)
1369 XFreeCursor (FRAME_X_DISPLAY (f), f->output_data.x->cross_cursor);
1370 f->output_data.x->cross_cursor = cross_cursor;
1372 XFlush (FRAME_X_DISPLAY (f));
1373 UNBLOCK_INPUT;
1376 void
1377 x_set_cursor_color (f, arg, oldval)
1378 struct frame *f;
1379 Lisp_Object arg, oldval;
1381 unsigned long fore_pixel;
1383 if (!EQ (Vx_cursor_fore_pixel, Qnil))
1384 fore_pixel = x_decode_color (f, Vx_cursor_fore_pixel,
1385 WHITE_PIX_DEFAULT (f));
1386 else
1387 fore_pixel = f->output_data.x->background_pixel;
1388 f->output_data.x->cursor_pixel = x_decode_color (f, arg, BLACK_PIX_DEFAULT (f));
1390 /* Make sure that the cursor color differs from the background color. */
1391 if (f->output_data.x->cursor_pixel == f->output_data.x->background_pixel)
1393 f->output_data.x->cursor_pixel = f->output_data.x->mouse_pixel;
1394 if (f->output_data.x->cursor_pixel == fore_pixel)
1395 fore_pixel = f->output_data.x->background_pixel;
1397 f->output_data.x->cursor_foreground_pixel = fore_pixel;
1399 if (FRAME_X_WINDOW (f) != 0)
1401 BLOCK_INPUT;
1402 XSetBackground (FRAME_X_DISPLAY (f), f->output_data.x->cursor_gc,
1403 f->output_data.x->cursor_pixel);
1404 XSetForeground (FRAME_X_DISPLAY (f), f->output_data.x->cursor_gc,
1405 fore_pixel);
1406 UNBLOCK_INPUT;
1408 if (FRAME_VISIBLE_P (f))
1410 x_update_cursor (f, 0);
1411 x_update_cursor (f, 1);
1416 /* Set the border-color of frame F to value described by ARG.
1417 ARG can be a string naming a color.
1418 The border-color is used for the border that is drawn by the X server.
1419 Note that this does not fully take effect if done before
1420 F has an x-window; it must be redone when the window is created.
1422 Note: this is done in two routines because of the way X10 works.
1424 Note: under X11, this is normally the province of the window manager,
1425 and so emacs' border colors may be overridden. */
1427 void
1428 x_set_border_color (f, arg, oldval)
1429 struct frame *f;
1430 Lisp_Object arg, oldval;
1432 unsigned char *str;
1433 int pix;
1435 CHECK_STRING (arg, 0);
1436 str = XSTRING (arg)->data;
1438 pix = x_decode_color (f, arg, BLACK_PIX_DEFAULT (f));
1440 x_set_border_pixel (f, pix);
1443 /* Set the border-color of frame F to pixel value PIX.
1444 Note that this does not fully take effect if done before
1445 F has an x-window. */
1447 x_set_border_pixel (f, pix)
1448 struct frame *f;
1449 int pix;
1451 f->output_data.x->border_pixel = pix;
1453 if (FRAME_X_WINDOW (f) != 0 && f->output_data.x->border_width > 0)
1455 Pixmap temp;
1456 int mask;
1458 BLOCK_INPUT;
1459 XSetWindowBorder (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
1460 (unsigned long)pix);
1461 UNBLOCK_INPUT;
1463 if (FRAME_VISIBLE_P (f))
1464 redraw_frame (f);
1468 void
1469 x_set_cursor_type (f, arg, oldval)
1470 FRAME_PTR f;
1471 Lisp_Object arg, oldval;
1473 if (EQ (arg, Qbar))
1475 FRAME_DESIRED_CURSOR (f) = bar_cursor;
1476 f->output_data.x->cursor_width = 2;
1478 else if (CONSP (arg) && EQ (XCONS (arg)->car, Qbar)
1479 && INTEGERP (XCONS (arg)->cdr))
1481 FRAME_DESIRED_CURSOR (f) = bar_cursor;
1482 f->output_data.x->cursor_width = XINT (XCONS (arg)->cdr);
1484 else
1485 /* Treat anything unknown as "box cursor".
1486 It was bad to signal an error; people have trouble fixing
1487 .Xdefaults with Emacs, when it has something bad in it. */
1488 FRAME_DESIRED_CURSOR (f) = filled_box_cursor;
1490 /* Make sure the cursor gets redrawn. This is overkill, but how
1491 often do people change cursor types? */
1492 update_mode_lines++;
1495 void
1496 x_set_icon_type (f, arg, oldval)
1497 struct frame *f;
1498 Lisp_Object arg, oldval;
1500 Lisp_Object tem;
1501 int result;
1503 if (STRINGP (arg))
1505 if (STRINGP (oldval) && EQ (Fstring_equal (oldval, arg), Qt))
1506 return;
1508 else if (!STRINGP (oldval) && EQ (oldval, Qnil) == EQ (arg, Qnil))
1509 return;
1511 BLOCK_INPUT;
1512 if (NILP (arg))
1513 result = x_text_icon (f,
1514 (char *) XSTRING ((!NILP (f->icon_name)
1515 ? f->icon_name
1516 : f->name))->data);
1517 else
1518 result = x_bitmap_icon (f, arg);
1520 if (result)
1522 UNBLOCK_INPUT;
1523 error ("No icon window available");
1526 XFlush (FRAME_X_DISPLAY (f));
1527 UNBLOCK_INPUT;
1530 /* Return non-nil if frame F wants a bitmap icon. */
1532 Lisp_Object
1533 x_icon_type (f)
1534 FRAME_PTR f;
1536 Lisp_Object tem;
1538 tem = assq_no_quit (Qicon_type, f->param_alist);
1539 if (CONSP (tem))
1540 return XCONS (tem)->cdr;
1541 else
1542 return Qnil;
1545 void
1546 x_set_icon_name (f, arg, oldval)
1547 struct frame *f;
1548 Lisp_Object arg, oldval;
1550 Lisp_Object tem;
1551 int result;
1553 if (STRINGP (arg))
1555 if (STRINGP (oldval) && EQ (Fstring_equal (oldval, arg), Qt))
1556 return;
1558 else if (!STRINGP (oldval) && EQ (oldval, Qnil) == EQ (arg, Qnil))
1559 return;
1561 f->icon_name = arg;
1563 if (f->output_data.x->icon_bitmap != 0)
1564 return;
1566 BLOCK_INPUT;
1568 result = x_text_icon (f,
1569 (char *) XSTRING ((!NILP (f->icon_name)
1570 ? f->icon_name
1571 : !NILP (f->title)
1572 ? f->title
1573 : f->name))->data);
1575 if (result)
1577 UNBLOCK_INPUT;
1578 error ("No icon window available");
1581 XFlush (FRAME_X_DISPLAY (f));
1582 UNBLOCK_INPUT;
1585 extern Lisp_Object x_new_font ();
1586 extern Lisp_Object x_new_fontset ();
1587 extern Lisp_Object Fquery_fontset ();
1589 void
1590 x_set_font (f, arg, oldval)
1591 struct frame *f;
1592 Lisp_Object arg, oldval;
1594 Lisp_Object result;
1595 Lisp_Object fontset_name;
1596 Lisp_Object frame;
1598 CHECK_STRING (arg, 1);
1600 fontset_name = Fquery_fontset (arg);
1602 BLOCK_INPUT;
1603 result = (STRINGP (fontset_name)
1604 ? x_new_fontset (f, XSTRING (fontset_name)->data)
1605 : x_new_font (f, XSTRING (arg)->data));
1606 UNBLOCK_INPUT;
1608 if (EQ (result, Qnil))
1609 error ("Font `%s' is not defined", XSTRING (arg)->data);
1610 else if (EQ (result, Qt))
1611 error ("the characters of the given font have varying widths");
1612 else if (STRINGP (result))
1614 recompute_basic_faces (f);
1615 store_frame_param (f, Qfont, result);
1617 else
1618 abort ();
1620 XSETFRAME (frame, f);
1621 call1 (Qface_set_after_frame_default, frame);
1624 void
1625 x_set_border_width (f, arg, oldval)
1626 struct frame *f;
1627 Lisp_Object arg, oldval;
1629 CHECK_NUMBER (arg, 0);
1631 if (XINT (arg) == f->output_data.x->border_width)
1632 return;
1634 if (FRAME_X_WINDOW (f) != 0)
1635 error ("Cannot change the border width of a window");
1637 f->output_data.x->border_width = XINT (arg);
1640 void
1641 x_set_internal_border_width (f, arg, oldval)
1642 struct frame *f;
1643 Lisp_Object arg, oldval;
1645 int mask;
1646 int old = f->output_data.x->internal_border_width;
1648 CHECK_NUMBER (arg, 0);
1649 f->output_data.x->internal_border_width = XINT (arg);
1650 if (f->output_data.x->internal_border_width < 0)
1651 f->output_data.x->internal_border_width = 0;
1653 #ifdef USE_X_TOOLKIT
1654 if (f->output_data.x->edit_widget)
1655 widget_store_internal_border (f->output_data.x->edit_widget,
1656 f->output_data.x->internal_border_width);
1657 #endif
1659 if (f->output_data.x->internal_border_width == old)
1660 return;
1662 if (FRAME_X_WINDOW (f) != 0)
1664 BLOCK_INPUT;
1665 x_set_window_size (f, 0, f->width, f->height);
1666 #if 0
1667 x_set_resize_hint (f);
1668 #endif
1669 XFlush (FRAME_X_DISPLAY (f));
1670 UNBLOCK_INPUT;
1671 SET_FRAME_GARBAGED (f);
1675 void
1676 x_set_visibility (f, value, oldval)
1677 struct frame *f;
1678 Lisp_Object value, oldval;
1680 Lisp_Object frame;
1681 XSETFRAME (frame, f);
1683 if (NILP (value))
1684 Fmake_frame_invisible (frame, Qt);
1685 else if (EQ (value, Qicon))
1686 Ficonify_frame (frame);
1687 else
1688 Fmake_frame_visible (frame);
1691 static void
1692 x_set_menu_bar_lines_1 (window, n)
1693 Lisp_Object window;
1694 int n;
1696 struct window *w = XWINDOW (window);
1698 XSETFASTINT (w->top, XFASTINT (w->top) + n);
1699 XSETFASTINT (w->height, XFASTINT (w->height) - n);
1701 /* Handle just the top child in a vertical split. */
1702 if (!NILP (w->vchild))
1703 x_set_menu_bar_lines_1 (w->vchild, n);
1705 /* Adjust all children in a horizontal split. */
1706 for (window = w->hchild; !NILP (window); window = w->next)
1708 w = XWINDOW (window);
1709 x_set_menu_bar_lines_1 (window, n);
1713 void
1714 x_set_menu_bar_lines (f, value, oldval)
1715 struct frame *f;
1716 Lisp_Object value, oldval;
1718 int nlines;
1719 int olines = FRAME_MENU_BAR_LINES (f);
1721 /* Right now, menu bars don't work properly in minibuf-only frames;
1722 most of the commands try to apply themselves to the minibuffer
1723 frame itslef, and get an error because you can't switch buffers
1724 in or split the minibuffer window. */
1725 if (FRAME_MINIBUF_ONLY_P (f))
1726 return;
1728 if (INTEGERP (value))
1729 nlines = XINT (value);
1730 else
1731 nlines = 0;
1733 /* Make sure we redisplay all windows in this frame. */
1734 windows_or_buffers_changed++;
1736 #ifdef USE_X_TOOLKIT
1737 FRAME_MENU_BAR_LINES (f) = 0;
1738 if (nlines)
1740 FRAME_EXTERNAL_MENU_BAR (f) = 1;
1741 if (FRAME_X_P (f) && f->output_data.x->menubar_widget == 0)
1742 /* Make sure next redisplay shows the menu bar. */
1743 XWINDOW (FRAME_SELECTED_WINDOW (f))->update_mode_line = Qt;
1745 else
1747 if (FRAME_EXTERNAL_MENU_BAR (f) == 1)
1748 free_frame_menubar (f);
1749 FRAME_EXTERNAL_MENU_BAR (f) = 0;
1750 if (FRAME_X_P (f))
1751 f->output_data.x->menubar_widget = 0;
1753 #else /* not USE_X_TOOLKIT */
1754 FRAME_MENU_BAR_LINES (f) = nlines;
1755 x_set_menu_bar_lines_1 (f->root_window, nlines - olines);
1756 #endif /* not USE_X_TOOLKIT */
1759 /* Change the name of frame F to NAME. If NAME is nil, set F's name to
1760 x_id_name.
1762 If EXPLICIT is non-zero, that indicates that lisp code is setting the
1763 name; if NAME is a string, set F's name to NAME and set
1764 F->explicit_name; if NAME is Qnil, then clear F->explicit_name.
1766 If EXPLICIT is zero, that indicates that Emacs redisplay code is
1767 suggesting a new name, which lisp code should override; if
1768 F->explicit_name is set, ignore the new name; otherwise, set it. */
1770 void
1771 x_set_name (f, name, explicit)
1772 struct frame *f;
1773 Lisp_Object name;
1774 int explicit;
1776 /* Make sure that requests from lisp code override requests from
1777 Emacs redisplay code. */
1778 if (explicit)
1780 /* If we're switching from explicit to implicit, we had better
1781 update the mode lines and thereby update the title. */
1782 if (f->explicit_name && NILP (name))
1783 update_mode_lines = 1;
1785 f->explicit_name = ! NILP (name);
1787 else if (f->explicit_name)
1788 return;
1790 /* If NAME is nil, set the name to the x_id_name. */
1791 if (NILP (name))
1793 /* Check for no change needed in this very common case
1794 before we do any consing. */
1795 if (!strcmp (FRAME_X_DISPLAY_INFO (f)->x_id_name,
1796 XSTRING (f->name)->data))
1797 return;
1798 name = build_string (FRAME_X_DISPLAY_INFO (f)->x_id_name);
1800 else
1801 CHECK_STRING (name, 0);
1803 /* Don't change the name if it's already NAME. */
1804 if (! NILP (Fstring_equal (name, f->name)))
1805 return;
1807 f->name = name;
1809 /* For setting the frame title, the title parameter should override
1810 the name parameter. */
1811 if (! NILP (f->title))
1812 name = f->title;
1814 if (FRAME_X_WINDOW (f))
1816 BLOCK_INPUT;
1817 #ifdef HAVE_X11R4
1819 XTextProperty text, icon;
1820 Lisp_Object icon_name;
1822 text.value = XSTRING (name)->data;
1823 text.encoding = XA_STRING;
1824 text.format = 8;
1825 text.nitems = XSTRING (name)->size;
1827 icon_name = (!NILP (f->icon_name) ? f->icon_name : name);
1829 icon.value = XSTRING (icon_name)->data;
1830 icon.encoding = XA_STRING;
1831 icon.format = 8;
1832 icon.nitems = XSTRING (icon_name)->size;
1833 #ifdef USE_X_TOOLKIT
1834 XSetWMName (FRAME_X_DISPLAY (f),
1835 XtWindow (f->output_data.x->widget), &text);
1836 XSetWMIconName (FRAME_X_DISPLAY (f), XtWindow (f->output_data.x->widget),
1837 &icon);
1838 #else /* not USE_X_TOOLKIT */
1839 XSetWMName (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f), &text);
1840 XSetWMIconName (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f), &icon);
1841 #endif /* not USE_X_TOOLKIT */
1843 #else /* not HAVE_X11R4 */
1844 XSetIconName (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
1845 XSTRING (name)->data);
1846 XStoreName (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
1847 XSTRING (name)->data);
1848 #endif /* not HAVE_X11R4 */
1849 UNBLOCK_INPUT;
1853 /* This function should be called when the user's lisp code has
1854 specified a name for the frame; the name will override any set by the
1855 redisplay code. */
1856 void
1857 x_explicitly_set_name (f, arg, oldval)
1858 FRAME_PTR f;
1859 Lisp_Object arg, oldval;
1861 x_set_name (f, arg, 1);
1864 /* This function should be called by Emacs redisplay code to set the
1865 name; names set this way will never override names set by the user's
1866 lisp code. */
1867 void
1868 x_implicitly_set_name (f, arg, oldval)
1869 FRAME_PTR f;
1870 Lisp_Object arg, oldval;
1872 x_set_name (f, arg, 0);
1875 /* Change the title of frame F to NAME.
1876 If NAME is nil, use the frame name as the title.
1878 If EXPLICIT is non-zero, that indicates that lisp code is setting the
1879 name; if NAME is a string, set F's name to NAME and set
1880 F->explicit_name; if NAME is Qnil, then clear F->explicit_name.
1882 If EXPLICIT is zero, that indicates that Emacs redisplay code is
1883 suggesting a new name, which lisp code should override; if
1884 F->explicit_name is set, ignore the new name; otherwise, set it. */
1886 void
1887 x_set_title (f, name)
1888 struct frame *f;
1889 Lisp_Object name;
1891 /* Don't change the title if it's already NAME. */
1892 if (EQ (name, f->title))
1893 return;
1895 update_mode_lines = 1;
1897 f->title = name;
1899 if (NILP (name))
1900 name = f->name;
1901 else
1902 CHECK_STRING (name, 0);
1904 if (FRAME_X_WINDOW (f))
1906 BLOCK_INPUT;
1907 #ifdef HAVE_X11R4
1909 XTextProperty text, icon;
1910 Lisp_Object icon_name;
1912 text.value = XSTRING (name)->data;
1913 text.encoding = XA_STRING;
1914 text.format = 8;
1915 text.nitems = XSTRING (name)->size;
1917 icon_name = (!NILP (f->icon_name) ? f->icon_name : name);
1919 icon.value = XSTRING (icon_name)->data;
1920 icon.encoding = XA_STRING;
1921 icon.format = 8;
1922 icon.nitems = XSTRING (icon_name)->size;
1923 #ifdef USE_X_TOOLKIT
1924 XSetWMName (FRAME_X_DISPLAY (f),
1925 XtWindow (f->output_data.x->widget), &text);
1926 XSetWMIconName (FRAME_X_DISPLAY (f), XtWindow (f->output_data.x->widget),
1927 &icon);
1928 #else /* not USE_X_TOOLKIT */
1929 XSetWMName (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f), &text);
1930 XSetWMIconName (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f), &icon);
1931 #endif /* not USE_X_TOOLKIT */
1933 #else /* not HAVE_X11R4 */
1934 XSetIconName (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
1935 XSTRING (name)->data);
1936 XStoreName (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
1937 XSTRING (name)->data);
1938 #endif /* not HAVE_X11R4 */
1939 UNBLOCK_INPUT;
1943 void
1944 x_set_autoraise (f, arg, oldval)
1945 struct frame *f;
1946 Lisp_Object arg, oldval;
1948 f->auto_raise = !EQ (Qnil, arg);
1951 void
1952 x_set_autolower (f, arg, oldval)
1953 struct frame *f;
1954 Lisp_Object arg, oldval;
1956 f->auto_lower = !EQ (Qnil, arg);
1959 void
1960 x_set_unsplittable (f, arg, oldval)
1961 struct frame *f;
1962 Lisp_Object arg, oldval;
1964 f->no_split = !NILP (arg);
1967 void
1968 x_set_vertical_scroll_bars (f, arg, oldval)
1969 struct frame *f;
1970 Lisp_Object arg, oldval;
1972 if ((EQ (arg, Qleft) && FRAME_HAS_VERTICAL_SCROLL_BARS_ON_RIGHT (f))
1973 || (EQ (arg, Qright) && FRAME_HAS_VERTICAL_SCROLL_BARS_ON_LEFT (f))
1974 || (NILP (arg) && FRAME_HAS_VERTICAL_SCROLL_BARS (f))
1975 || (!NILP (arg) && ! FRAME_HAS_VERTICAL_SCROLL_BARS (f)))
1977 FRAME_VERTICAL_SCROLL_BAR_TYPE (f)
1978 = (NILP (arg)
1979 ? vertical_scroll_bar_none
1980 : EQ (Qright, arg)
1981 ? vertical_scroll_bar_right
1982 : vertical_scroll_bar_left);
1984 /* We set this parameter before creating the X window for the
1985 frame, so we can get the geometry right from the start.
1986 However, if the window hasn't been created yet, we shouldn't
1987 call x_set_window_size. */
1988 if (FRAME_X_WINDOW (f))
1989 x_set_window_size (f, 0, FRAME_WIDTH (f), FRAME_HEIGHT (f));
1993 void
1994 x_set_scroll_bar_width (f, arg, oldval)
1995 struct frame *f;
1996 Lisp_Object arg, oldval;
1998 int wid = FONT_WIDTH (f->output_data.x->font);
2000 if (NILP (arg))
2002 /* Make the actual width at least 14 pixels
2003 and a multiple of a character width. */
2004 FRAME_SCROLL_BAR_COLS (f) = (14 + wid - 1) / wid;
2005 /* Use all of that space (aside from required margins)
2006 for the scroll bar. */
2007 FRAME_SCROLL_BAR_PIXEL_WIDTH (f) = 0;
2009 if (FRAME_X_WINDOW (f))
2010 x_set_window_size (f, 0, FRAME_WIDTH (f), FRAME_HEIGHT (f));
2012 else if (INTEGERP (arg) && XINT (arg) > 0
2013 && XFASTINT (arg) != FRAME_SCROLL_BAR_PIXEL_WIDTH (f))
2015 if (XFASTINT (arg) <= 2 * VERTICAL_SCROLL_BAR_WIDTH_TRIM)
2016 XSETINT (arg, 2 * VERTICAL_SCROLL_BAR_WIDTH_TRIM + 1);
2018 FRAME_SCROLL_BAR_PIXEL_WIDTH (f) = XFASTINT (arg);
2019 FRAME_SCROLL_BAR_COLS (f) = (XFASTINT (arg) + wid-1) / wid;
2020 if (FRAME_X_WINDOW (f))
2021 x_set_window_size (f, 0, FRAME_WIDTH (f), FRAME_HEIGHT (f));
2024 change_frame_size (f, 0, FRAME_WIDTH (f), 0, 0);
2025 FRAME_CURSOR_X (f) = FRAME_LEFT_SCROLL_BAR_WIDTH (f);
2028 /* Subroutines of creating an X frame. */
2030 /* Make sure that Vx_resource_name is set to a reasonable value.
2031 Fix it up, or set it to `emacs' if it is too hopeless. */
2033 static void
2034 validate_x_resource_name ()
2036 int len;
2037 /* Number of valid characters in the resource name. */
2038 int good_count = 0;
2039 /* Number of invalid characters in the resource name. */
2040 int bad_count = 0;
2041 Lisp_Object new;
2042 int i;
2044 if (!STRINGP (Vx_resource_class))
2045 Vx_resource_class = build_string (EMACS_CLASS);
2047 if (STRINGP (Vx_resource_name))
2049 unsigned char *p = XSTRING (Vx_resource_name)->data;
2050 int i;
2052 len = XSTRING (Vx_resource_name)->size;
2054 /* Only letters, digits, - and _ are valid in resource names.
2055 Count the valid characters and count the invalid ones. */
2056 for (i = 0; i < len; i++)
2058 int c = p[i];
2059 if (! ((c >= 'a' && c <= 'z')
2060 || (c >= 'A' && c <= 'Z')
2061 || (c >= '0' && c <= '9')
2062 || c == '-' || c == '_'))
2063 bad_count++;
2064 else
2065 good_count++;
2068 else
2069 /* Not a string => completely invalid. */
2070 bad_count = 5, good_count = 0;
2072 /* If name is valid already, return. */
2073 if (bad_count == 0)
2074 return;
2076 /* If name is entirely invalid, or nearly so, use `emacs'. */
2077 if (good_count == 0
2078 || (good_count == 1 && bad_count > 0))
2080 Vx_resource_name = build_string ("emacs");
2081 return;
2084 /* Name is partly valid. Copy it and replace the invalid characters
2085 with underscores. */
2087 Vx_resource_name = new = Fcopy_sequence (Vx_resource_name);
2089 for (i = 0; i < len; i++)
2091 int c = XSTRING (new)->data[i];
2092 if (! ((c >= 'a' && c <= 'z')
2093 || (c >= 'A' && c <= 'Z')
2094 || (c >= '0' && c <= '9')
2095 || c == '-' || c == '_'))
2096 XSTRING (new)->data[i] = '_';
2101 extern char *x_get_string_resource ();
2103 DEFUN ("x-get-resource", Fx_get_resource, Sx_get_resource, 2, 4, 0,
2104 "Return the value of ATTRIBUTE, of class CLASS, from the X defaults database.\n\
2105 This uses `INSTANCE.ATTRIBUTE' as the key and `Emacs.CLASS' as the\n\
2106 class, where INSTANCE is the name under which Emacs was invoked, or\n\
2107 the name specified by the `-name' or `-rn' command-line arguments.\n\
2109 The optional arguments COMPONENT and SUBCLASS add to the key and the\n\
2110 class, respectively. You must specify both of them or neither.\n\
2111 If you specify them, the key is `INSTANCE.COMPONENT.ATTRIBUTE'\n\
2112 and the class is `Emacs.CLASS.SUBCLASS'.")
2113 (attribute, class, component, subclass)
2114 Lisp_Object attribute, class, component, subclass;
2116 register char *value;
2117 char *name_key;
2118 char *class_key;
2120 check_x ();
2122 CHECK_STRING (attribute, 0);
2123 CHECK_STRING (class, 0);
2125 if (!NILP (component))
2126 CHECK_STRING (component, 1);
2127 if (!NILP (subclass))
2128 CHECK_STRING (subclass, 2);
2129 if (NILP (component) != NILP (subclass))
2130 error ("x-get-resource: must specify both COMPONENT and SUBCLASS or neither");
2132 validate_x_resource_name ();
2134 /* Allocate space for the components, the dots which separate them,
2135 and the final '\0'. Make them big enough for the worst case. */
2136 name_key = (char *) alloca (XSTRING (Vx_resource_name)->size
2137 + (STRINGP (component)
2138 ? XSTRING (component)->size : 0)
2139 + XSTRING (attribute)->size
2140 + 3);
2142 class_key = (char *) alloca (XSTRING (Vx_resource_class)->size
2143 + XSTRING (class)->size
2144 + (STRINGP (subclass)
2145 ? XSTRING (subclass)->size : 0)
2146 + 3);
2148 /* Start with emacs.FRAMENAME for the name (the specific one)
2149 and with `Emacs' for the class key (the general one). */
2150 strcpy (name_key, XSTRING (Vx_resource_name)->data);
2151 strcpy (class_key, XSTRING (Vx_resource_class)->data);
2153 strcat (class_key, ".");
2154 strcat (class_key, XSTRING (class)->data);
2156 if (!NILP (component))
2158 strcat (class_key, ".");
2159 strcat (class_key, XSTRING (subclass)->data);
2161 strcat (name_key, ".");
2162 strcat (name_key, XSTRING (component)->data);
2165 strcat (name_key, ".");
2166 strcat (name_key, XSTRING (attribute)->data);
2168 value = x_get_string_resource (check_x_display_info (Qnil)->xrdb,
2169 name_key, class_key);
2171 if (value != (char *) 0)
2172 return build_string (value);
2173 else
2174 return Qnil;
2177 /* Get an X resource, like Fx_get_resource, but for display DPYINFO. */
2179 static Lisp_Object
2180 display_x_get_resource (dpyinfo, attribute, class, component, subclass)
2181 struct x_display_info *dpyinfo;
2182 Lisp_Object attribute, class, component, subclass;
2184 register char *value;
2185 char *name_key;
2186 char *class_key;
2188 check_x ();
2190 CHECK_STRING (attribute, 0);
2191 CHECK_STRING (class, 0);
2193 if (!NILP (component))
2194 CHECK_STRING (component, 1);
2195 if (!NILP (subclass))
2196 CHECK_STRING (subclass, 2);
2197 if (NILP (component) != NILP (subclass))
2198 error ("x-get-resource: must specify both COMPONENT and SUBCLASS or neither");
2200 validate_x_resource_name ();
2202 /* Allocate space for the components, the dots which separate them,
2203 and the final '\0'. Make them big enough for the worst case. */
2204 name_key = (char *) alloca (XSTRING (Vx_resource_name)->size
2205 + (STRINGP (component)
2206 ? XSTRING (component)->size : 0)
2207 + XSTRING (attribute)->size
2208 + 3);
2210 class_key = (char *) alloca (XSTRING (Vx_resource_class)->size
2211 + XSTRING (class)->size
2212 + (STRINGP (subclass)
2213 ? XSTRING (subclass)->size : 0)
2214 + 3);
2216 /* Start with emacs.FRAMENAME for the name (the specific one)
2217 and with `Emacs' for the class key (the general one). */
2218 strcpy (name_key, XSTRING (Vx_resource_name)->data);
2219 strcpy (class_key, XSTRING (Vx_resource_class)->data);
2221 strcat (class_key, ".");
2222 strcat (class_key, XSTRING (class)->data);
2224 if (!NILP (component))
2226 strcat (class_key, ".");
2227 strcat (class_key, XSTRING (subclass)->data);
2229 strcat (name_key, ".");
2230 strcat (name_key, XSTRING (component)->data);
2233 strcat (name_key, ".");
2234 strcat (name_key, XSTRING (attribute)->data);
2236 value = x_get_string_resource (dpyinfo->xrdb, name_key, class_key);
2238 if (value != (char *) 0)
2239 return build_string (value);
2240 else
2241 return Qnil;
2244 /* Used when C code wants a resource value. */
2246 char *
2247 x_get_resource_string (attribute, class)
2248 char *attribute, *class;
2250 register char *value;
2251 char *name_key;
2252 char *class_key;
2254 /* Allocate space for the components, the dots which separate them,
2255 and the final '\0'. */
2256 name_key = (char *) alloca (XSTRING (Vinvocation_name)->size
2257 + strlen (attribute) + 2);
2258 class_key = (char *) alloca ((sizeof (EMACS_CLASS) - 1)
2259 + strlen (class) + 2);
2261 sprintf (name_key, "%s.%s",
2262 XSTRING (Vinvocation_name)->data,
2263 attribute);
2264 sprintf (class_key, "%s.%s", EMACS_CLASS, class);
2266 return x_get_string_resource (FRAME_X_DISPLAY_INFO (selected_frame)->xrdb,
2267 name_key, class_key);
2270 /* Types we might convert a resource string into. */
2271 enum resource_types
2273 number, boolean, string, symbol
2276 /* Return the value of parameter PARAM.
2278 First search ALIST, then Vdefault_frame_alist, then the X defaults
2279 database, using ATTRIBUTE as the attribute name and CLASS as its class.
2281 Convert the resource to the type specified by desired_type.
2283 If no default is specified, return Qunbound. If you call
2284 x_get_arg, make sure you deal with Qunbound in a reasonable way,
2285 and don't let it get stored in any Lisp-visible variables! */
2287 static Lisp_Object
2288 x_get_arg (dpyinfo, alist, param, attribute, class, type)
2289 struct x_display_info *dpyinfo;
2290 Lisp_Object alist, param;
2291 char *attribute;
2292 char *class;
2293 enum resource_types type;
2295 register Lisp_Object tem;
2297 tem = Fassq (param, alist);
2298 if (EQ (tem, Qnil))
2299 tem = Fassq (param, Vdefault_frame_alist);
2300 if (EQ (tem, Qnil))
2303 if (attribute)
2305 tem = display_x_get_resource (dpyinfo,
2306 build_string (attribute),
2307 build_string (class),
2308 Qnil, Qnil);
2310 if (NILP (tem))
2311 return Qunbound;
2313 switch (type)
2315 case number:
2316 return make_number (atoi (XSTRING (tem)->data));
2318 case boolean:
2319 tem = Fdowncase (tem);
2320 if (!strcmp (XSTRING (tem)->data, "on")
2321 || !strcmp (XSTRING (tem)->data, "true"))
2322 return Qt;
2323 else
2324 return Qnil;
2326 case string:
2327 return tem;
2329 case symbol:
2330 /* As a special case, we map the values `true' and `on'
2331 to Qt, and `false' and `off' to Qnil. */
2333 Lisp_Object lower;
2334 lower = Fdowncase (tem);
2335 if (!strcmp (XSTRING (lower)->data, "on")
2336 || !strcmp (XSTRING (lower)->data, "true"))
2337 return Qt;
2338 else if (!strcmp (XSTRING (lower)->data, "off")
2339 || !strcmp (XSTRING (lower)->data, "false"))
2340 return Qnil;
2341 else
2342 return Fintern (tem, Qnil);
2345 default:
2346 abort ();
2349 else
2350 return Qunbound;
2352 return Fcdr (tem);
2355 /* Like x_get_arg, but also record the value in f->param_alist. */
2357 static Lisp_Object
2358 x_get_and_record_arg (f, alist, param, attribute, class, type)
2359 struct frame *f;
2360 Lisp_Object alist, param;
2361 char *attribute;
2362 char *class;
2363 enum resource_types type;
2365 Lisp_Object value;
2367 value = x_get_arg (FRAME_X_DISPLAY_INFO (f), alist, param,
2368 attribute, class, type);
2369 if (! NILP (value))
2370 store_frame_param (f, param, value);
2372 return value;
2375 /* Record in frame F the specified or default value according to ALIST
2376 of the parameter named PROP (a Lisp symbol).
2377 If no value is specified for PROP, look for an X default for XPROP
2378 on the frame named NAME.
2379 If that is not found either, use the value DEFLT. */
2381 static Lisp_Object
2382 x_default_parameter (f, alist, prop, deflt, xprop, xclass, type)
2383 struct frame *f;
2384 Lisp_Object alist;
2385 Lisp_Object prop;
2386 Lisp_Object deflt;
2387 char *xprop;
2388 char *xclass;
2389 enum resource_types type;
2391 Lisp_Object tem;
2393 tem = x_get_arg (FRAME_X_DISPLAY_INFO (f), alist, prop, xprop, xclass, type);
2394 if (EQ (tem, Qunbound))
2395 tem = deflt;
2396 x_set_frame_parameters (f, Fcons (Fcons (prop, tem), Qnil));
2397 return tem;
2400 DEFUN ("x-parse-geometry", Fx_parse_geometry, Sx_parse_geometry, 1, 1, 0,
2401 "Parse an X-style geometry string STRING.\n\
2402 Returns an alist of the form ((top . TOP), (left . LEFT) ... ).\n\
2403 The properties returned may include `top', `left', `height', and `width'.\n\
2404 The value of `left' or `top' may be an integer,\n\
2405 or a list (+ N) meaning N pixels relative to top/left corner,\n\
2406 or a list (- N) meaning -N pixels relative to bottom/right corner.")
2407 (string)
2408 Lisp_Object string;
2410 int geometry, x, y;
2411 unsigned int width, height;
2412 Lisp_Object result;
2414 CHECK_STRING (string, 0);
2416 geometry = XParseGeometry ((char *) XSTRING (string)->data,
2417 &x, &y, &width, &height);
2419 #if 0
2420 if (!!(geometry & XValue) != !!(geometry & YValue))
2421 error ("Must specify both x and y position, or neither");
2422 #endif
2424 result = Qnil;
2425 if (geometry & XValue)
2427 Lisp_Object element;
2429 if (x >= 0 && (geometry & XNegative))
2430 element = Fcons (Qleft, Fcons (Qminus, Fcons (make_number (-x), Qnil)));
2431 else if (x < 0 && ! (geometry & XNegative))
2432 element = Fcons (Qleft, Fcons (Qplus, Fcons (make_number (x), Qnil)));
2433 else
2434 element = Fcons (Qleft, make_number (x));
2435 result = Fcons (element, result);
2438 if (geometry & YValue)
2440 Lisp_Object element;
2442 if (y >= 0 && (geometry & YNegative))
2443 element = Fcons (Qtop, Fcons (Qminus, Fcons (make_number (-y), Qnil)));
2444 else if (y < 0 && ! (geometry & YNegative))
2445 element = Fcons (Qtop, Fcons (Qplus, Fcons (make_number (y), Qnil)));
2446 else
2447 element = Fcons (Qtop, make_number (y));
2448 result = Fcons (element, result);
2451 if (geometry & WidthValue)
2452 result = Fcons (Fcons (Qwidth, make_number (width)), result);
2453 if (geometry & HeightValue)
2454 result = Fcons (Fcons (Qheight, make_number (height)), result);
2456 return result;
2459 /* Calculate the desired size and position of this window,
2460 and return the flags saying which aspects were specified.
2462 This function does not make the coordinates positive. */
2464 #define DEFAULT_ROWS 40
2465 #define DEFAULT_COLS 80
2467 static int
2468 x_figure_window_size (f, parms)
2469 struct frame *f;
2470 Lisp_Object parms;
2472 register Lisp_Object tem0, tem1, tem2;
2473 int height, width, left, top;
2474 register int geometry;
2475 long window_prompting = 0;
2476 struct x_display_info *dpyinfo = FRAME_X_DISPLAY_INFO (f);
2478 /* Default values if we fall through.
2479 Actually, if that happens we should get
2480 window manager prompting. */
2481 SET_FRAME_WIDTH (f, DEFAULT_COLS);
2482 f->height = DEFAULT_ROWS;
2483 /* Window managers expect that if program-specified
2484 positions are not (0,0), they're intentional, not defaults. */
2485 f->output_data.x->top_pos = 0;
2486 f->output_data.x->left_pos = 0;
2488 tem0 = x_get_arg (dpyinfo, parms, Qheight, 0, 0, number);
2489 tem1 = x_get_arg (dpyinfo, parms, Qwidth, 0, 0, number);
2490 tem2 = x_get_arg (dpyinfo, parms, Quser_size, 0, 0, number);
2491 if (! EQ (tem0, Qunbound) || ! EQ (tem1, Qunbound))
2493 if (!EQ (tem0, Qunbound))
2495 CHECK_NUMBER (tem0, 0);
2496 f->height = XINT (tem0);
2498 if (!EQ (tem1, Qunbound))
2500 CHECK_NUMBER (tem1, 0);
2501 SET_FRAME_WIDTH (f, XINT (tem1));
2503 if (!NILP (tem2) && !EQ (tem2, Qunbound))
2504 window_prompting |= USSize;
2505 else
2506 window_prompting |= PSize;
2509 f->output_data.x->vertical_scroll_bar_extra
2510 = (!FRAME_HAS_VERTICAL_SCROLL_BARS (f)
2512 : FRAME_SCROLL_BAR_PIXEL_WIDTH (f) > 0
2513 ? FRAME_SCROLL_BAR_PIXEL_WIDTH (f)
2514 : (FRAME_SCROLL_BAR_COLS (f) * FONT_WIDTH (f->output_data.x->font)));
2515 f->output_data.x->pixel_width = CHAR_TO_PIXEL_WIDTH (f, f->width);
2516 f->output_data.x->pixel_height = CHAR_TO_PIXEL_HEIGHT (f, f->height);
2518 tem0 = x_get_arg (dpyinfo, parms, Qtop, 0, 0, number);
2519 tem1 = x_get_arg (dpyinfo, parms, Qleft, 0, 0, number);
2520 tem2 = x_get_arg (dpyinfo, parms, Quser_position, 0, 0, number);
2521 if (! EQ (tem0, Qunbound) || ! EQ (tem1, Qunbound))
2523 if (EQ (tem0, Qminus))
2525 f->output_data.x->top_pos = 0;
2526 window_prompting |= YNegative;
2528 else if (CONSP (tem0) && EQ (XCONS (tem0)->car, Qminus)
2529 && CONSP (XCONS (tem0)->cdr)
2530 && INTEGERP (XCONS (XCONS (tem0)->cdr)->car))
2532 f->output_data.x->top_pos = - XINT (XCONS (XCONS (tem0)->cdr)->car);
2533 window_prompting |= YNegative;
2535 else if (CONSP (tem0) && EQ (XCONS (tem0)->car, Qplus)
2536 && CONSP (XCONS (tem0)->cdr)
2537 && INTEGERP (XCONS (XCONS (tem0)->cdr)->car))
2539 f->output_data.x->top_pos = XINT (XCONS (XCONS (tem0)->cdr)->car);
2541 else if (EQ (tem0, Qunbound))
2542 f->output_data.x->top_pos = 0;
2543 else
2545 CHECK_NUMBER (tem0, 0);
2546 f->output_data.x->top_pos = XINT (tem0);
2547 if (f->output_data.x->top_pos < 0)
2548 window_prompting |= YNegative;
2551 if (EQ (tem1, Qminus))
2553 f->output_data.x->left_pos = 0;
2554 window_prompting |= XNegative;
2556 else if (CONSP (tem1) && EQ (XCONS (tem1)->car, Qminus)
2557 && CONSP (XCONS (tem1)->cdr)
2558 && INTEGERP (XCONS (XCONS (tem1)->cdr)->car))
2560 f->output_data.x->left_pos = - XINT (XCONS (XCONS (tem1)->cdr)->car);
2561 window_prompting |= XNegative;
2563 else if (CONSP (tem1) && EQ (XCONS (tem1)->car, Qplus)
2564 && CONSP (XCONS (tem1)->cdr)
2565 && INTEGERP (XCONS (XCONS (tem1)->cdr)->car))
2567 f->output_data.x->left_pos = XINT (XCONS (XCONS (tem1)->cdr)->car);
2569 else if (EQ (tem1, Qunbound))
2570 f->output_data.x->left_pos = 0;
2571 else
2573 CHECK_NUMBER (tem1, 0);
2574 f->output_data.x->left_pos = XINT (tem1);
2575 if (f->output_data.x->left_pos < 0)
2576 window_prompting |= XNegative;
2579 if (!NILP (tem2) && ! EQ (tem2, Qunbound))
2580 window_prompting |= USPosition;
2581 else
2582 window_prompting |= PPosition;
2585 return window_prompting;
2588 #if !defined (HAVE_X11R4) && !defined (HAVE_XSETWMPROTOCOLS)
2590 Status
2591 XSetWMProtocols (dpy, w, protocols, count)
2592 Display *dpy;
2593 Window w;
2594 Atom *protocols;
2595 int count;
2597 Atom prop;
2598 prop = XInternAtom (dpy, "WM_PROTOCOLS", False);
2599 if (prop == None) return False;
2600 XChangeProperty (dpy, w, prop, XA_ATOM, 32, PropModeReplace,
2601 (unsigned char *) protocols, count);
2602 return True;
2604 #endif /* not HAVE_X11R4 && not HAVE_XSETWMPROTOCOLS */
2606 #ifdef USE_X_TOOLKIT
2608 /* If the WM_PROTOCOLS property does not already contain WM_TAKE_FOCUS,
2609 WM_DELETE_WINDOW, and WM_SAVE_YOURSELF, then add them. (They may
2610 already be present because of the toolkit (Motif adds some of them,
2611 for example, but Xt doesn't). */
2613 static void
2614 hack_wm_protocols (f, widget)
2615 FRAME_PTR f;
2616 Widget widget;
2618 Display *dpy = XtDisplay (widget);
2619 Window w = XtWindow (widget);
2620 int need_delete = 1;
2621 int need_focus = 1;
2622 int need_save = 1;
2624 BLOCK_INPUT;
2626 Atom type, *atoms = 0;
2627 int format = 0;
2628 unsigned long nitems = 0;
2629 unsigned long bytes_after;
2631 if ((XGetWindowProperty (dpy, w,
2632 FRAME_X_DISPLAY_INFO (f)->Xatom_wm_protocols,
2633 (long)0, (long)100, False, XA_ATOM,
2634 &type, &format, &nitems, &bytes_after,
2635 (unsigned char **) &atoms)
2636 == Success)
2637 && format == 32 && type == XA_ATOM)
2638 while (nitems > 0)
2640 nitems--;
2641 if (atoms[nitems] == FRAME_X_DISPLAY_INFO (f)->Xatom_wm_delete_window)
2642 need_delete = 0;
2643 else if (atoms[nitems] == FRAME_X_DISPLAY_INFO (f)->Xatom_wm_take_focus)
2644 need_focus = 0;
2645 else if (atoms[nitems] == FRAME_X_DISPLAY_INFO (f)->Xatom_wm_save_yourself)
2646 need_save = 0;
2648 if (atoms) XFree ((char *) atoms);
2651 Atom props [10];
2652 int count = 0;
2653 if (need_delete)
2654 props[count++] = FRAME_X_DISPLAY_INFO (f)->Xatom_wm_delete_window;
2655 if (need_focus)
2656 props[count++] = FRAME_X_DISPLAY_INFO (f)->Xatom_wm_take_focus;
2657 if (need_save)
2658 props[count++] = FRAME_X_DISPLAY_INFO (f)->Xatom_wm_save_yourself;
2659 if (count)
2660 XChangeProperty (dpy, w, FRAME_X_DISPLAY_INFO (f)->Xatom_wm_protocols,
2661 XA_ATOM, 32, PropModeAppend,
2662 (unsigned char *) props, count);
2664 UNBLOCK_INPUT;
2666 #endif
2668 #ifdef USE_X_TOOLKIT
2670 /* Create and set up the X widget for frame F. */
2672 static void
2673 x_window (f, window_prompting, minibuffer_only)
2674 struct frame *f;
2675 long window_prompting;
2676 int minibuffer_only;
2678 XClassHint class_hints;
2679 XSetWindowAttributes attributes;
2680 unsigned long attribute_mask;
2682 Widget shell_widget;
2683 Widget pane_widget;
2684 Widget frame_widget;
2685 Arg al [25];
2686 int ac;
2688 BLOCK_INPUT;
2690 /* Use the resource name as the top-level widget name
2691 for looking up resources. Make a non-Lisp copy
2692 for the window manager, so GC relocation won't bother it.
2694 Elsewhere we specify the window name for the window manager. */
2697 char *str = (char *) XSTRING (Vx_resource_name)->data;
2698 f->namebuf = (char *) xmalloc (strlen (str) + 1);
2699 strcpy (f->namebuf, str);
2702 ac = 0;
2703 XtSetArg (al[ac], XtNallowShellResize, 1); ac++;
2704 XtSetArg (al[ac], XtNinput, 1); ac++;
2705 XtSetArg (al[ac], XtNmappedWhenManaged, 0); ac++;
2706 XtSetArg (al[ac], XtNborderWidth, f->output_data.x->border_width); ac++;
2707 shell_widget = XtAppCreateShell (f->namebuf, EMACS_CLASS,
2708 applicationShellWidgetClass,
2709 FRAME_X_DISPLAY (f), al, ac);
2711 f->output_data.x->widget = shell_widget;
2712 /* maybe_set_screen_title_format (shell_widget); */
2714 pane_widget = lw_create_widget ("main", "pane", widget_id_tick++,
2715 (widget_value *) NULL,
2716 shell_widget, False,
2717 (lw_callback) NULL,
2718 (lw_callback) NULL,
2719 (lw_callback) NULL);
2721 f->output_data.x->column_widget = pane_widget;
2723 /* mappedWhenManaged to false tells to the paned window to not map/unmap
2724 the emacs screen when changing menubar. This reduces flickering. */
2726 ac = 0;
2727 XtSetArg (al[ac], XtNmappedWhenManaged, 0); ac++;
2728 XtSetArg (al[ac], XtNshowGrip, 0); ac++;
2729 XtSetArg (al[ac], XtNallowResize, 1); ac++;
2730 XtSetArg (al[ac], XtNresizeToPreferred, 1); ac++;
2731 XtSetArg (al[ac], XtNemacsFrame, f); ac++;
2732 frame_widget = XtCreateWidget (f->namebuf,
2733 emacsFrameClass,
2734 pane_widget, al, ac);
2736 f->output_data.x->edit_widget = frame_widget;
2738 XtManageChild (frame_widget);
2740 /* Do some needed geometry management. */
2742 int len;
2743 char *tem, shell_position[32];
2744 Arg al[2];
2745 int ac = 0;
2746 int extra_borders = 0;
2747 int menubar_size
2748 = (f->output_data.x->menubar_widget
2749 ? (f->output_data.x->menubar_widget->core.height
2750 + f->output_data.x->menubar_widget->core.border_width)
2751 : 0);
2752 extern char *lwlib_toolkit_type;
2754 #if 0 /* Experimentally, we now get the right results
2755 for -geometry -0-0 without this. 24 Aug 96, rms. */
2756 if (FRAME_EXTERNAL_MENU_BAR (f))
2758 Dimension ibw = 0;
2759 XtVaGetValues (pane_widget, XtNinternalBorderWidth, &ibw, NULL);
2760 menubar_size += ibw;
2762 #endif
2764 f->output_data.x->menubar_height = menubar_size;
2766 #ifndef USE_LUCID
2767 /* Motif seems to need this amount added to the sizes
2768 specified for the shell widget. The Athena/Lucid widgets don't.
2769 Both conclusions reached experimentally. -- rms. */
2770 XtVaGetValues (f->output_data.x->edit_widget, XtNinternalBorderWidth,
2771 &extra_borders, NULL);
2772 extra_borders *= 2;
2773 #endif
2775 /* Convert our geometry parameters into a geometry string
2776 and specify it.
2777 Note that we do not specify here whether the position
2778 is a user-specified or program-specified one.
2779 We pass that information later, in x_wm_set_size_hints. */
2781 int left = f->output_data.x->left_pos;
2782 int xneg = window_prompting & XNegative;
2783 int top = f->output_data.x->top_pos;
2784 int yneg = window_prompting & YNegative;
2785 if (xneg)
2786 left = -left;
2787 if (yneg)
2788 top = -top;
2790 if (window_prompting & USPosition)
2791 sprintf (shell_position, "=%dx%d%c%d%c%d",
2792 PIXEL_WIDTH (f) + extra_borders,
2793 PIXEL_HEIGHT (f) + menubar_size + extra_borders,
2794 (xneg ? '-' : '+'), left,
2795 (yneg ? '-' : '+'), top);
2796 else
2797 sprintf (shell_position, "=%dx%d",
2798 PIXEL_WIDTH (f) + extra_borders,
2799 PIXEL_HEIGHT (f) + menubar_size + extra_borders);
2802 len = strlen (shell_position) + 1;
2803 /* We don't free this because we don't know whether
2804 it is safe to free it while the frame exists.
2805 It isn't worth the trouble of arranging to free it
2806 when the frame is deleted. */
2807 tem = (char *) xmalloc (len);
2808 strncpy (tem, shell_position, len);
2809 XtSetArg (al[ac], XtNgeometry, tem); ac++;
2810 XtSetValues (shell_widget, al, ac);
2813 XtManageChild (pane_widget);
2814 XtRealizeWidget (shell_widget);
2816 FRAME_X_WINDOW (f) = XtWindow (frame_widget);
2818 validate_x_resource_name ();
2820 class_hints.res_name = (char *) XSTRING (Vx_resource_name)->data;
2821 class_hints.res_class = (char *) XSTRING (Vx_resource_class)->data;
2822 XSetClassHint (FRAME_X_DISPLAY (f), XtWindow (shell_widget), &class_hints);
2824 #ifdef HAVE_X_I18N
2825 #ifndef X_I18N_INHIBITED
2827 XIM xim;
2828 XIC xic = NULL;
2830 xim = XOpenIM (FRAME_X_DISPLAY (f), NULL, NULL, NULL);
2832 if (xim)
2834 xic = XCreateIC (xim,
2835 XNInputStyle, XIMPreeditNothing | XIMStatusNothing,
2836 XNClientWindow, FRAME_X_WINDOW(f),
2837 XNFocusWindow, FRAME_X_WINDOW(f),
2838 NULL);
2840 if (xic == 0)
2842 XCloseIM (xim);
2843 xim = NULL;
2846 FRAME_XIM (f) = xim;
2847 FRAME_XIC (f) = xic;
2849 #else /* X_I18N_INHIBITED */
2850 FRAME_XIM (f) = 0;
2851 FRAME_XIC (f) = 0;
2852 #endif /* X_I18N_INHIBITED */
2853 #endif /* HAVE_X_I18N */
2855 f->output_data.x->wm_hints.input = True;
2856 f->output_data.x->wm_hints.flags |= InputHint;
2857 XSetWMHints (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
2858 &f->output_data.x->wm_hints);
2860 hack_wm_protocols (f, shell_widget);
2862 #ifdef HACK_EDITRES
2863 XtAddEventHandler (shell_widget, 0, True, _XEditResCheckMessages, 0);
2864 #endif
2866 /* Do a stupid property change to force the server to generate a
2867 propertyNotify event so that the event_stream server timestamp will
2868 be initialized to something relevant to the time we created the window.
2870 XChangeProperty (XtDisplay (frame_widget), XtWindow (frame_widget),
2871 FRAME_X_DISPLAY_INFO (f)->Xatom_wm_protocols,
2872 XA_ATOM, 32, PropModeAppend,
2873 (unsigned char*) NULL, 0);
2875 /* Make all the standard events reach the Emacs frame. */
2876 attributes.event_mask = STANDARD_EVENT_SET;
2877 attribute_mask = CWEventMask;
2878 XChangeWindowAttributes (XtDisplay (shell_widget), XtWindow (shell_widget),
2879 attribute_mask, &attributes);
2881 XtMapWidget (frame_widget);
2883 /* x_set_name normally ignores requests to set the name if the
2884 requested name is the same as the current name. This is the one
2885 place where that assumption isn't correct; f->name is set, but
2886 the X server hasn't been told. */
2888 Lisp_Object name;
2889 int explicit = f->explicit_name;
2891 f->explicit_name = 0;
2892 name = f->name;
2893 f->name = Qnil;
2894 x_set_name (f, name, explicit);
2897 XDefineCursor (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
2898 f->output_data.x->text_cursor);
2900 UNBLOCK_INPUT;
2902 if (!minibuffer_only && FRAME_EXTERNAL_MENU_BAR (f))
2903 initialize_frame_menubar (f);
2904 lw_set_main_areas (pane_widget, f->output_data.x->menubar_widget, frame_widget);
2906 if (FRAME_X_WINDOW (f) == 0)
2907 error ("Unable to create window");
2910 #else /* not USE_X_TOOLKIT */
2912 /* Create and set up the X window for frame F. */
2914 x_window (f)
2915 struct frame *f;
2918 XClassHint class_hints;
2919 XSetWindowAttributes attributes;
2920 unsigned long attribute_mask;
2922 attributes.background_pixel = f->output_data.x->background_pixel;
2923 attributes.border_pixel = f->output_data.x->border_pixel;
2924 attributes.bit_gravity = StaticGravity;
2925 attributes.backing_store = NotUseful;
2926 attributes.save_under = True;
2927 attributes.event_mask = STANDARD_EVENT_SET;
2928 attribute_mask = (CWBackPixel | CWBorderPixel | CWBitGravity
2929 #if 0
2930 | CWBackingStore | CWSaveUnder
2931 #endif
2932 | CWEventMask);
2934 BLOCK_INPUT;
2935 FRAME_X_WINDOW (f)
2936 = XCreateWindow (FRAME_X_DISPLAY (f),
2937 f->output_data.x->parent_desc,
2938 f->output_data.x->left_pos,
2939 f->output_data.x->top_pos,
2940 PIXEL_WIDTH (f), PIXEL_HEIGHT (f),
2941 f->output_data.x->border_width,
2942 CopyFromParent, /* depth */
2943 InputOutput, /* class */
2944 FRAME_X_DISPLAY_INFO (f)->visual,
2945 attribute_mask, &attributes);
2946 #ifdef HAVE_X_I18N
2947 #ifndef X_I18N_INHIBITED
2949 XIM xim;
2950 XIC xic = NULL;
2952 xim = XOpenIM (FRAME_X_DISPLAY(f), NULL, NULL, NULL);
2954 if (xim)
2956 xic = XCreateIC (xim,
2957 XNInputStyle, XIMPreeditNothing | XIMStatusNothing,
2958 XNClientWindow, FRAME_X_WINDOW(f),
2959 XNFocusWindow, FRAME_X_WINDOW(f),
2960 NULL);
2962 if (!xic)
2964 XCloseIM (xim);
2965 xim = NULL;
2969 FRAME_XIM (f) = xim;
2970 FRAME_XIC (f) = xic;
2972 #else /* X_I18N_INHIBITED */
2973 FRAME_XIM (f) = 0;
2974 FRAME_XIC (f) = 0;
2975 #endif /* X_I18N_INHIBITED */
2976 #endif /* HAVE_X_I18N */
2978 validate_x_resource_name ();
2980 class_hints.res_name = (char *) XSTRING (Vx_resource_name)->data;
2981 class_hints.res_class = (char *) XSTRING (Vx_resource_class)->data;
2982 XSetClassHint (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f), &class_hints);
2984 /* The menubar is part of the ordinary display;
2985 it does not count in addition to the height of the window. */
2986 f->output_data.x->menubar_height = 0;
2988 /* This indicates that we use the "Passive Input" input model.
2989 Unless we do this, we don't get the Focus{In,Out} events that we
2990 need to draw the cursor correctly. Accursed bureaucrats.
2991 XWhipsAndChains (FRAME_X_DISPLAY (f), IronMaiden, &TheRack); */
2993 f->output_data.x->wm_hints.input = True;
2994 f->output_data.x->wm_hints.flags |= InputHint;
2995 XSetWMHints (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
2996 &f->output_data.x->wm_hints);
2997 f->output_data.x->wm_hints.icon_pixmap = None;
2999 /* Request "save yourself" and "delete window" commands from wm. */
3001 Atom protocols[2];
3002 protocols[0] = FRAME_X_DISPLAY_INFO (f)->Xatom_wm_delete_window;
3003 protocols[1] = FRAME_X_DISPLAY_INFO (f)->Xatom_wm_save_yourself;
3004 XSetWMProtocols (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f), protocols, 2);
3007 /* x_set_name normally ignores requests to set the name if the
3008 requested name is the same as the current name. This is the one
3009 place where that assumption isn't correct; f->name is set, but
3010 the X server hasn't been told. */
3012 Lisp_Object name;
3013 int explicit = f->explicit_name;
3015 f->explicit_name = 0;
3016 name = f->name;
3017 f->name = Qnil;
3018 x_set_name (f, name, explicit);
3021 XDefineCursor (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
3022 f->output_data.x->text_cursor);
3024 UNBLOCK_INPUT;
3026 if (FRAME_X_WINDOW (f) == 0)
3027 error ("Unable to create window");
3030 #endif /* not USE_X_TOOLKIT */
3032 /* Handle the icon stuff for this window. Perhaps later we might
3033 want an x_set_icon_position which can be called interactively as
3034 well. */
3036 static void
3037 x_icon (f, parms)
3038 struct frame *f;
3039 Lisp_Object parms;
3041 Lisp_Object icon_x, icon_y;
3042 struct x_display_info *dpyinfo = FRAME_X_DISPLAY_INFO (f);
3044 /* Set the position of the icon. Note that twm groups all
3045 icons in an icon window. */
3046 icon_x = x_get_and_record_arg (f, parms, Qicon_left, 0, 0, number);
3047 icon_y = x_get_and_record_arg (f, parms, Qicon_top, 0, 0, number);
3048 if (!EQ (icon_x, Qunbound) && !EQ (icon_y, Qunbound))
3050 CHECK_NUMBER (icon_x, 0);
3051 CHECK_NUMBER (icon_y, 0);
3053 else if (!EQ (icon_x, Qunbound) || !EQ (icon_y, Qunbound))
3054 error ("Both left and top icon corners of icon must be specified");
3056 BLOCK_INPUT;
3058 if (! EQ (icon_x, Qunbound))
3059 x_wm_set_icon_position (f, XINT (icon_x), XINT (icon_y));
3061 /* Start up iconic or window? */
3062 x_wm_set_window_state
3063 (f, (EQ (x_get_arg (dpyinfo, parms, Qvisibility, 0, 0, symbol), Qicon)
3064 ? IconicState
3065 : NormalState));
3067 x_text_icon (f, (char *) XSTRING ((!NILP (f->icon_name)
3068 ? f->icon_name
3069 : f->name))->data);
3071 UNBLOCK_INPUT;
3074 /* Make the GC's needed for this window, setting the
3075 background, border and mouse colors; also create the
3076 mouse cursor and the gray border tile. */
3078 static char cursor_bits[] =
3080 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
3081 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
3082 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
3083 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00
3086 static void
3087 x_make_gc (f)
3088 struct frame *f;
3090 XGCValues gc_values;
3091 GC temp_gc;
3092 XImage tileimage;
3094 BLOCK_INPUT;
3096 /* Create the GC's of this frame.
3097 Note that many default values are used. */
3099 /* Normal video */
3100 gc_values.font = f->output_data.x->font->fid;
3101 gc_values.foreground = f->output_data.x->foreground_pixel;
3102 gc_values.background = f->output_data.x->background_pixel;
3103 gc_values.line_width = 0; /* Means 1 using fast algorithm. */
3104 f->output_data.x->normal_gc = XCreateGC (FRAME_X_DISPLAY (f),
3105 FRAME_X_WINDOW (f),
3106 GCLineWidth | GCFont
3107 | GCForeground | GCBackground,
3108 &gc_values);
3110 /* Reverse video style. */
3111 gc_values.foreground = f->output_data.x->background_pixel;
3112 gc_values.background = f->output_data.x->foreground_pixel;
3113 f->output_data.x->reverse_gc = XCreateGC (FRAME_X_DISPLAY (f),
3114 FRAME_X_WINDOW (f),
3115 GCFont | GCForeground | GCBackground
3116 | GCLineWidth,
3117 &gc_values);
3119 /* Cursor has cursor-color background, background-color foreground. */
3120 gc_values.foreground = f->output_data.x->background_pixel;
3121 gc_values.background = f->output_data.x->cursor_pixel;
3122 gc_values.fill_style = FillOpaqueStippled;
3123 gc_values.stipple
3124 = XCreateBitmapFromData (FRAME_X_DISPLAY (f),
3125 FRAME_X_DISPLAY_INFO (f)->root_window,
3126 cursor_bits, 16, 16);
3127 f->output_data.x->cursor_gc
3128 = XCreateGC (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
3129 (GCFont | GCForeground | GCBackground
3130 | GCFillStyle | GCStipple | GCLineWidth),
3131 &gc_values);
3133 /* Create the gray border tile used when the pointer is not in
3134 the frame. Since this depends on the frame's pixel values,
3135 this must be done on a per-frame basis. */
3136 f->output_data.x->border_tile
3137 = (XCreatePixmapFromBitmapData
3138 (FRAME_X_DISPLAY (f), FRAME_X_DISPLAY_INFO (f)->root_window,
3139 gray_bits, gray_width, gray_height,
3140 f->output_data.x->foreground_pixel,
3141 f->output_data.x->background_pixel,
3142 DefaultDepth (FRAME_X_DISPLAY (f),
3143 XScreenNumberOfScreen (FRAME_X_SCREEN (f)))));
3145 UNBLOCK_INPUT;
3148 DEFUN ("x-create-frame", Fx_create_frame, Sx_create_frame,
3149 1, 1, 0,
3150 "Make a new X window, which is called a \"frame\" in Emacs terms.\n\
3151 Returns an Emacs frame object.\n\
3152 ALIST is an alist of frame parameters.\n\
3153 If the parameters specify that the frame should not have a minibuffer,\n\
3154 and do not specify a specific minibuffer window to use,\n\
3155 then `default-minibuffer-frame' must be a frame whose minibuffer can\n\
3156 be shared by the new frame.\n\
3158 This function is an internal primitive--use `make-frame' instead.")
3159 (parms)
3160 Lisp_Object parms;
3162 struct frame *f;
3163 Lisp_Object frame, tem;
3164 Lisp_Object name;
3165 int minibuffer_only = 0;
3166 long window_prompting = 0;
3167 int width, height;
3168 int count = specpdl_ptr - specpdl;
3169 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
3170 Lisp_Object display;
3171 struct x_display_info *dpyinfo;
3172 Lisp_Object parent;
3173 struct kboard *kb;
3175 check_x ();
3177 /* Use this general default value to start with
3178 until we know if this frame has a specified name. */
3179 Vx_resource_name = Vinvocation_name;
3181 display = x_get_arg (dpyinfo, parms, Qdisplay, 0, 0, string);
3182 if (EQ (display, Qunbound))
3183 display = Qnil;
3184 dpyinfo = check_x_display_info (display);
3185 #ifdef MULTI_KBOARD
3186 kb = dpyinfo->kboard;
3187 #else
3188 kb = &the_only_kboard;
3189 #endif
3191 name = x_get_arg (dpyinfo, parms, Qname, "name", "Name", string);
3192 if (!STRINGP (name)
3193 && ! EQ (name, Qunbound)
3194 && ! NILP (name))
3195 error ("Invalid frame name--not a string or nil");
3197 if (STRINGP (name))
3198 Vx_resource_name = name;
3200 /* See if parent window is specified. */
3201 parent = x_get_arg (dpyinfo, parms, Qparent_id, NULL, NULL, number);
3202 if (EQ (parent, Qunbound))
3203 parent = Qnil;
3204 if (! NILP (parent))
3205 CHECK_NUMBER (parent, 0);
3207 /* make_frame_without_minibuffer can run Lisp code and garbage collect. */
3208 /* No need to protect DISPLAY because that's not used after passing
3209 it to make_frame_without_minibuffer. */
3210 frame = Qnil;
3211 GCPRO4 (parms, parent, name, frame);
3212 tem = x_get_arg (dpyinfo, parms, Qminibuffer, "minibuffer", "Minibuffer", symbol);
3213 if (EQ (tem, Qnone) || NILP (tem))
3214 f = make_frame_without_minibuffer (Qnil, kb, display);
3215 else if (EQ (tem, Qonly))
3217 f = make_minibuffer_frame ();
3218 minibuffer_only = 1;
3220 else if (WINDOWP (tem))
3221 f = make_frame_without_minibuffer (tem, kb, display);
3222 else
3223 f = make_frame (1);
3225 XSETFRAME (frame, f);
3227 /* Note that X Windows does support scroll bars. */
3228 FRAME_CAN_HAVE_SCROLL_BARS (f) = 1;
3230 f->output_method = output_x_window;
3231 f->output_data.x = (struct x_output *) xmalloc (sizeof (struct x_output));
3232 bzero (f->output_data.x, sizeof (struct x_output));
3233 f->output_data.x->icon_bitmap = -1;
3234 f->output_data.x->fontset = -1;
3236 f->icon_name
3237 = x_get_arg (dpyinfo, parms, Qicon_name, "iconName", "Title", string);
3238 if (! STRINGP (f->icon_name))
3239 f->icon_name = Qnil;
3241 FRAME_X_DISPLAY_INFO (f) = dpyinfo;
3242 #ifdef MULTI_KBOARD
3243 FRAME_KBOARD (f) = kb;
3244 #endif
3246 /* Specify the parent under which to make this X window. */
3248 if (!NILP (parent))
3250 f->output_data.x->parent_desc = (Window) XFASTINT (parent);
3251 f->output_data.x->explicit_parent = 1;
3253 else
3255 f->output_data.x->parent_desc = FRAME_X_DISPLAY_INFO (f)->root_window;
3256 f->output_data.x->explicit_parent = 0;
3259 /* Note that the frame has no physical cursor right now. */
3260 f->phys_cursor_x = -1;
3262 /* Set the name; the functions to which we pass f expect the name to
3263 be set. */
3264 if (EQ (name, Qunbound) || NILP (name))
3266 f->name = build_string (dpyinfo->x_id_name);
3267 f->explicit_name = 0;
3269 else
3271 f->name = name;
3272 f->explicit_name = 1;
3273 /* use the frame's title when getting resources for this frame. */
3274 specbind (Qx_resource_name, name);
3277 /* Create fontsets from `global_fontset_alist' before handling fonts. */
3278 for (tem = Vglobal_fontset_alist; CONSP (tem); tem = XCONS (tem)->cdr)
3279 fs_register_fontset (f, XCONS (tem)->car);
3281 /* Extract the window parameters from the supplied values
3282 that are needed to determine window geometry. */
3284 Lisp_Object font;
3286 font = x_get_arg (dpyinfo, parms, Qfont, "font", "Font", string);
3288 BLOCK_INPUT;
3289 /* First, try whatever font the caller has specified. */
3290 if (STRINGP (font))
3292 tem = Fquery_fontset (font);
3293 if (STRINGP (tem))
3294 font = x_new_fontset (f, XSTRING (tem)->data);
3295 else
3296 font = x_new_font (f, XSTRING (font)->data);
3298 /* Try out a font which we hope has bold and italic variations. */
3299 if (!STRINGP (font))
3300 font = x_new_font (f, "-misc-fixed-medium-r-normal-*-*-140-*-*-c-*-iso8859-1");
3301 if (! STRINGP (font))
3302 font = x_new_font (f, "-*-*-medium-r-normal-*-*-140-*-*-c-*-iso8859-1");
3303 if (! STRINGP (font))
3304 /* This was formerly the first thing tried, but it finds too many fonts
3305 and takes too long. */
3306 font = x_new_font (f, "-*-*-medium-r-*-*-*-*-*-*-c-*-iso8859-1");
3307 /* If those didn't work, look for something which will at least work. */
3308 if (! STRINGP (font))
3309 font = x_new_font (f, "-*-fixed-*-*-*-*-*-140-*-*-c-*-iso8859-1");
3310 UNBLOCK_INPUT;
3311 if (! STRINGP (font))
3312 font = build_string ("fixed");
3314 x_default_parameter (f, parms, Qfont, font,
3315 "font", "Font", string);
3318 #ifdef USE_LUCID
3319 /* Prevent lwlib/xlwmenu.c from crashing because of a bug
3320 whereby it fails to get any font. */
3321 xlwmenu_default_font = f->output_data.x->font;
3322 #endif
3324 x_default_parameter (f, parms, Qborder_width, make_number (2),
3325 "borderwidth", "BorderWidth", number);
3326 /* This defaults to 2 in order to match xterm. We recognize either
3327 internalBorderWidth or internalBorder (which is what xterm calls
3328 it). */
3329 if (NILP (Fassq (Qinternal_border_width, parms)))
3331 Lisp_Object value;
3333 value = x_get_arg (dpyinfo, parms, Qinternal_border_width,
3334 "internalBorder", "internalBorder", number);
3335 if (! EQ (value, Qunbound))
3336 parms = Fcons (Fcons (Qinternal_border_width, value),
3337 parms);
3339 x_default_parameter (f, parms, Qinternal_border_width, make_number (1),
3340 "internalBorderWidth", "internalBorderWidth", number);
3341 x_default_parameter (f, parms, Qvertical_scroll_bars, Qleft,
3342 "verticalScrollBars", "ScrollBars", symbol);
3344 /* Also do the stuff which must be set before the window exists. */
3345 x_default_parameter (f, parms, Qforeground_color, build_string ("black"),
3346 "foreground", "Foreground", string);
3347 x_default_parameter (f, parms, Qbackground_color, build_string ("white"),
3348 "background", "Background", string);
3349 x_default_parameter (f, parms, Qmouse_color, build_string ("black"),
3350 "pointerColor", "Foreground", string);
3351 x_default_parameter (f, parms, Qcursor_color, build_string ("black"),
3352 "cursorColor", "Foreground", string);
3353 x_default_parameter (f, parms, Qborder_color, build_string ("black"),
3354 "borderColor", "BorderColor", string);
3356 x_default_parameter (f, parms, Qmenu_bar_lines, make_number (1),
3357 "menuBar", "MenuBar", number);
3358 x_default_parameter (f, parms, Qscroll_bar_width, Qnil,
3359 "scrollBarWidth", "ScrollBarWidth", number);
3360 x_default_parameter (f, parms, Qbuffer_predicate, Qnil,
3361 "bufferPredicate", "BufferPredicate", symbol);
3362 x_default_parameter (f, parms, Qtitle, Qnil,
3363 "title", "Title", string);
3365 f->output_data.x->parent_desc = FRAME_X_DISPLAY_INFO (f)->root_window;
3366 window_prompting = x_figure_window_size (f, parms);
3368 if (window_prompting & XNegative)
3370 if (window_prompting & YNegative)
3371 f->output_data.x->win_gravity = SouthEastGravity;
3372 else
3373 f->output_data.x->win_gravity = NorthEastGravity;
3375 else
3377 if (window_prompting & YNegative)
3378 f->output_data.x->win_gravity = SouthWestGravity;
3379 else
3380 f->output_data.x->win_gravity = NorthWestGravity;
3383 f->output_data.x->size_hint_flags = window_prompting;
3385 #ifdef USE_X_TOOLKIT
3386 x_window (f, window_prompting, minibuffer_only);
3387 #else
3388 x_window (f);
3389 #endif
3390 x_icon (f, parms);
3391 x_make_gc (f);
3392 init_frame_faces (f);
3394 /* We need to do this after creating the X window, so that the
3395 icon-creation functions can say whose icon they're describing. */
3396 x_default_parameter (f, parms, Qicon_type, Qnil,
3397 "bitmapIcon", "BitmapIcon", symbol);
3399 x_default_parameter (f, parms, Qauto_raise, Qnil,
3400 "autoRaise", "AutoRaiseLower", boolean);
3401 x_default_parameter (f, parms, Qauto_lower, Qnil,
3402 "autoLower", "AutoRaiseLower", boolean);
3403 x_default_parameter (f, parms, Qcursor_type, Qbox,
3404 "cursorType", "CursorType", symbol);
3406 /* Dimensions, especially f->height, must be done via change_frame_size.
3407 Change will not be effected unless different from the current
3408 f->height. */
3409 width = f->width;
3410 height = f->height;
3411 f->height = 0;
3412 SET_FRAME_WIDTH (f, 0);
3413 change_frame_size (f, height, width, 1, 0);
3415 /* Tell the server what size and position, etc, we want,
3416 and how badly we want them. */
3417 BLOCK_INPUT;
3418 x_wm_set_size_hint (f, window_prompting, 0);
3419 UNBLOCK_INPUT;
3421 tem = x_get_arg (dpyinfo, parms, Qunsplittable, 0, 0, boolean);
3422 f->no_split = minibuffer_only || EQ (tem, Qt);
3424 UNGCPRO;
3426 /* It is now ok to make the frame official
3427 even if we get an error below.
3428 And the frame needs to be on Vframe_list
3429 or making it visible won't work. */
3430 Vframe_list = Fcons (frame, Vframe_list);
3432 /* Now that the frame is official, it counts as a reference to
3433 its display. */
3434 FRAME_X_DISPLAY_INFO (f)->reference_count++;
3436 /* Make the window appear on the frame and enable display,
3437 unless the caller says not to. However, with explicit parent,
3438 Emacs cannot control visibility, so don't try. */
3439 if (! f->output_data.x->explicit_parent)
3441 Lisp_Object visibility;
3443 visibility = x_get_arg (dpyinfo, parms, Qvisibility, 0, 0, symbol);
3444 if (EQ (visibility, Qunbound))
3445 visibility = Qt;
3447 if (EQ (visibility, Qicon))
3448 x_iconify_frame (f);
3449 else if (! NILP (visibility))
3450 x_make_frame_visible (f);
3451 else
3452 /* Must have been Qnil. */
3456 return unbind_to (count, frame);
3459 /* FRAME is used only to get a handle on the X display. We don't pass the
3460 display info directly because we're called from frame.c, which doesn't
3461 know about that structure. */
3463 Lisp_Object
3464 x_get_focus_frame (frame)
3465 struct frame *frame;
3467 struct x_display_info *dpyinfo = FRAME_X_DISPLAY_INFO (frame);
3468 Lisp_Object xfocus;
3469 if (! dpyinfo->x_focus_frame)
3470 return Qnil;
3472 XSETFRAME (xfocus, dpyinfo->x_focus_frame);
3473 return xfocus;
3476 #if 1
3477 #include "x-list-font.c"
3478 #else
3479 DEFUN ("x-list-fonts", Fx_list_fonts, Sx_list_fonts, 1, 4, 0,
3480 "Return a list of the names of available fonts matching PATTERN.\n\
3481 If optional arguments FACE and FRAME are specified, return only fonts\n\
3482 the same size as FACE on FRAME.\n\
3484 PATTERN is a string, perhaps with wildcard characters;\n\
3485 the * character matches any substring, and\n\
3486 the ? character matches any single character.\n\
3487 PATTERN is case-insensitive.\n\
3488 FACE is a face name--a symbol.\n\
3490 The return value is a list of strings, suitable as arguments to\n\
3491 set-face-font.\n\
3493 Fonts Emacs can't use (i.e. proportional fonts) may or may not be excluded\n\
3494 even if they match PATTERN and FACE.\n\
3496 The optional fourth argument MAXIMUM sets a limit on how many\n\
3497 fonts to match. The first MAXIMUM fonts are reported.")
3498 (pattern, face, frame, maximum)
3499 Lisp_Object pattern, face, frame, maximum;
3501 int num_fonts;
3502 char **names;
3503 #ifndef BROKEN_XLISTFONTSWITHINFO
3504 XFontStruct *info;
3505 #endif
3506 XFontStruct *size_ref;
3507 Lisp_Object list;
3508 FRAME_PTR f;
3509 Lisp_Object key;
3510 int maxnames;
3511 int count;
3513 check_x ();
3514 CHECK_STRING (pattern, 0);
3515 if (!NILP (face))
3516 CHECK_SYMBOL (face, 1);
3518 if (NILP (maximum))
3519 maxnames = 2000;
3520 else
3522 CHECK_NATNUM (maximum, 0);
3523 maxnames = XINT (maximum);
3526 f = check_x_frame (frame);
3528 /* Determine the width standard for comparison with the fonts we find. */
3530 if (NILP (face))
3531 size_ref = 0;
3532 else
3534 int face_id;
3536 /* Don't die if we get called with a terminal frame. */
3537 if (! FRAME_X_P (f))
3538 error ("Non-X frame used in `x-list-fonts'");
3540 face_id = face_name_id_number (f, face);
3542 if (face_id < 0 || face_id >= FRAME_N_PARAM_FACES (f)
3543 || FRAME_PARAM_FACES (f) [face_id] == 0)
3544 size_ref = f->output_data.x->font;
3545 else
3547 size_ref = FRAME_PARAM_FACES (f) [face_id]->font;
3548 if (size_ref == (XFontStruct *) (~0))
3549 size_ref = f->output_data.x->font;
3553 /* See if we cached the result for this particular query. */
3554 key = Fcons (pattern, maximum);
3555 list = Fassoc (key,
3556 XCONS (FRAME_X_DISPLAY_INFO (f)->name_list_element)->cdr);
3558 /* We have info in the cache for this PATTERN. */
3559 if (!NILP (list))
3561 Lisp_Object tem, newlist;
3563 /* We have info about this pattern. */
3564 list = XCONS (list)->cdr;
3566 if (size_ref == 0)
3567 return list;
3569 BLOCK_INPUT;
3571 /* Filter the cached info and return just the fonts that match FACE. */
3572 newlist = Qnil;
3573 for (tem = list; CONSP (tem); tem = XCONS (tem)->cdr)
3575 XFontStruct *thisinfo;
3577 count = x_catch_errors (FRAME_X_DISPLAY (f));
3579 thisinfo = XLoadQueryFont (FRAME_X_DISPLAY (f),
3580 XSTRING (XCONS (tem)->car)->data);
3582 x_check_errors (FRAME_X_DISPLAY (f), "XLoadQueryFont failure: %s");
3583 x_uncatch_errors (FRAME_X_DISPLAY (f), count);
3585 if (thisinfo && same_size_fonts (thisinfo, size_ref))
3586 newlist = Fcons (XCONS (tem)->car, newlist);
3588 if (thisinfo != 0)
3589 XFreeFont (FRAME_X_DISPLAY (f), thisinfo);
3592 UNBLOCK_INPUT;
3594 return newlist;
3597 BLOCK_INPUT;
3599 count = x_catch_errors (FRAME_X_DISPLAY (f));
3601 /* Solaris 2.3 has a bug in XListFontsWithInfo. */
3602 #ifndef BROKEN_XLISTFONTSWITHINFO
3603 if (size_ref)
3604 names = XListFontsWithInfo (FRAME_X_DISPLAY (f),
3605 XSTRING (pattern)->data,
3606 maxnames,
3607 &num_fonts, /* count_return */
3608 &info); /* info_return */
3609 else
3610 #endif
3611 names = XListFonts (FRAME_X_DISPLAY (f),
3612 XSTRING (pattern)->data,
3613 maxnames,
3614 &num_fonts); /* count_return */
3616 x_check_errors (FRAME_X_DISPLAY (f), "XListFonts failure: %s");
3617 x_uncatch_errors (FRAME_X_DISPLAY (f), count);
3619 UNBLOCK_INPUT;
3621 list = Qnil;
3623 if (names)
3625 int i;
3626 Lisp_Object full_list;
3628 /* Make a list of all the fonts we got back.
3629 Store that in the font cache for the display. */
3630 full_list = Qnil;
3631 for (i = 0; i < num_fonts; i++)
3632 full_list = Fcons (build_string (names[i]), full_list);
3633 XCONS (FRAME_X_DISPLAY_INFO (f)->name_list_element)->cdr
3634 = Fcons (Fcons (key, full_list),
3635 XCONS (FRAME_X_DISPLAY_INFO (f)->name_list_element)->cdr);
3637 /* Make a list of the fonts that have the right width. */
3638 list = Qnil;
3639 for (i = 0; i < num_fonts; i++)
3641 int keeper;
3643 if (!size_ref)
3644 keeper = 1;
3645 else
3647 #ifdef BROKEN_XLISTFONTSWITHINFO
3648 XFontStruct *thisinfo;
3650 BLOCK_INPUT;
3652 count = x_catch_errors (FRAME_X_DISPLAY (f));
3653 thisinfo = XLoadQueryFont (FRAME_X_DISPLAY (f), names[i]);
3654 x_check_errors (FRAME_X_DISPLAY (f),
3655 "XLoadQueryFont failure: %s");
3656 x_uncatch_errors (FRAME_X_DISPLAY (f), count);
3658 UNBLOCK_INPUT;
3660 keeper = thisinfo && same_size_fonts (thisinfo, size_ref);
3661 BLOCK_INPUT;
3662 if (thisinfo && ! keeper)
3663 XFreeFont (FRAME_X_DISPLAY (f), thisinfo);
3664 else if (thisinfo)
3665 XFreeFontInfo (NULL, thisinfo, 1);
3666 UNBLOCK_INPUT;
3667 #else
3668 keeper = same_size_fonts (&info[i], size_ref);
3669 #endif
3671 if (keeper)
3672 list = Fcons (build_string (names[i]), list);
3674 list = Fnreverse (list);
3676 BLOCK_INPUT;
3677 #ifndef BROKEN_XLISTFONTSWITHINFO
3678 if (size_ref)
3679 XFreeFontInfo (names, info, num_fonts);
3680 else
3681 #endif
3682 XFreeFontNames (names);
3683 UNBLOCK_INPUT;
3686 return list;
3688 #endif
3691 DEFUN ("x-color-defined-p", Fx_color_defined_p, Sx_color_defined_p, 1, 2, 0,
3692 "Return non-nil if color COLOR is supported on frame FRAME.\n\
3693 If FRAME is omitted or nil, use the selected frame.")
3694 (color, frame)
3695 Lisp_Object color, frame;
3697 XColor foo;
3698 FRAME_PTR f = check_x_frame (frame);
3700 CHECK_STRING (color, 1);
3702 if (defined_color (f, XSTRING (color)->data, &foo, 0))
3703 return Qt;
3704 else
3705 return Qnil;
3708 DEFUN ("x-color-values", Fx_color_values, Sx_color_values, 1, 2, 0,
3709 "Return a description of the color named COLOR on frame FRAME.\n\
3710 The value is a list of integer RGB values--(RED GREEN BLUE).\n\
3711 These values appear to range from 0 to 65280 or 65535, depending\n\
3712 on the system; white is (65280 65280 65280) or (65535 65535 65535).\n\
3713 If FRAME is omitted or nil, use the selected frame.")
3714 (color, frame)
3715 Lisp_Object color, frame;
3717 XColor foo;
3718 FRAME_PTR f = check_x_frame (frame);
3720 CHECK_STRING (color, 1);
3722 if (defined_color (f, XSTRING (color)->data, &foo, 0))
3724 Lisp_Object rgb[3];
3726 rgb[0] = make_number (foo.red);
3727 rgb[1] = make_number (foo.green);
3728 rgb[2] = make_number (foo.blue);
3729 return Flist (3, rgb);
3731 else
3732 return Qnil;
3735 DEFUN ("x-display-color-p", Fx_display_color_p, Sx_display_color_p, 0, 1, 0,
3736 "Return t if the X display supports color.\n\
3737 The optional argument DISPLAY specifies which display to ask about.\n\
3738 DISPLAY should be either a frame or a display name (a string).\n\
3739 If omitted or nil, that stands for the selected frame's display.")
3740 (display)
3741 Lisp_Object display;
3743 struct x_display_info *dpyinfo = check_x_display_info (display);
3745 if (dpyinfo->n_planes <= 2)
3746 return Qnil;
3748 switch (dpyinfo->visual->class)
3750 case StaticColor:
3751 case PseudoColor:
3752 case TrueColor:
3753 case DirectColor:
3754 return Qt;
3756 default:
3757 return Qnil;
3761 DEFUN ("x-display-grayscale-p", Fx_display_grayscale_p, Sx_display_grayscale_p,
3762 0, 1, 0,
3763 "Return t if the X display supports shades of gray.\n\
3764 Note that color displays do support shades of gray.\n\
3765 The optional argument DISPLAY specifies which display to ask about.\n\
3766 DISPLAY should be either a frame or a display name (a string).\n\
3767 If omitted or nil, that stands for the selected frame's display.")
3768 (display)
3769 Lisp_Object display;
3771 struct x_display_info *dpyinfo = check_x_display_info (display);
3773 if (dpyinfo->n_planes <= 1)
3774 return Qnil;
3776 switch (dpyinfo->visual->class)
3778 case StaticColor:
3779 case PseudoColor:
3780 case TrueColor:
3781 case DirectColor:
3782 case StaticGray:
3783 case GrayScale:
3784 return Qt;
3786 default:
3787 return Qnil;
3791 DEFUN ("x-display-pixel-width", Fx_display_pixel_width, Sx_display_pixel_width,
3792 0, 1, 0,
3793 "Returns the width in pixels of the X display DISPLAY.\n\
3794 The optional argument DISPLAY specifies which display to ask about.\n\
3795 DISPLAY should be either a frame or a display name (a string).\n\
3796 If omitted or nil, that stands for the selected frame's display.")
3797 (display)
3798 Lisp_Object display;
3800 struct x_display_info *dpyinfo = check_x_display_info (display);
3802 return make_number (dpyinfo->width);
3805 DEFUN ("x-display-pixel-height", Fx_display_pixel_height,
3806 Sx_display_pixel_height, 0, 1, 0,
3807 "Returns the height in pixels of the X display DISPLAY.\n\
3808 The optional argument DISPLAY specifies which display to ask about.\n\
3809 DISPLAY should be either a frame or a display name (a string).\n\
3810 If omitted or nil, that stands for the selected frame's display.")
3811 (display)
3812 Lisp_Object display;
3814 struct x_display_info *dpyinfo = check_x_display_info (display);
3816 return make_number (dpyinfo->height);
3819 DEFUN ("x-display-planes", Fx_display_planes, Sx_display_planes,
3820 0, 1, 0,
3821 "Returns the number of bitplanes of the X display DISPLAY.\n\
3822 The optional argument DISPLAY specifies which display to ask about.\n\
3823 DISPLAY should be either a frame or a display name (a string).\n\
3824 If omitted or nil, that stands for the selected frame's display.")
3825 (display)
3826 Lisp_Object display;
3828 struct x_display_info *dpyinfo = check_x_display_info (display);
3830 return make_number (dpyinfo->n_planes);
3833 DEFUN ("x-display-color-cells", Fx_display_color_cells, Sx_display_color_cells,
3834 0, 1, 0,
3835 "Returns the number of color cells of the X display DISPLAY.\n\
3836 The optional argument DISPLAY specifies which display to ask about.\n\
3837 DISPLAY should be either a frame or a display name (a string).\n\
3838 If omitted or nil, that stands for the selected frame's display.")
3839 (display)
3840 Lisp_Object display;
3842 struct x_display_info *dpyinfo = check_x_display_info (display);
3844 return make_number (DisplayCells (dpyinfo->display,
3845 XScreenNumberOfScreen (dpyinfo->screen)));
3848 DEFUN ("x-server-max-request-size", Fx_server_max_request_size,
3849 Sx_server_max_request_size,
3850 0, 1, 0,
3851 "Returns the maximum request size of the X server of display DISPLAY.\n\
3852 The optional argument DISPLAY specifies which display to ask about.\n\
3853 DISPLAY should be either a frame or a display name (a string).\n\
3854 If omitted or nil, that stands for the selected frame's display.")
3855 (display)
3856 Lisp_Object display;
3858 struct x_display_info *dpyinfo = check_x_display_info (display);
3860 return make_number (MAXREQUEST (dpyinfo->display));
3863 DEFUN ("x-server-vendor", Fx_server_vendor, Sx_server_vendor, 0, 1, 0,
3864 "Returns the vendor ID string of the X server of display DISPLAY.\n\
3865 The optional argument DISPLAY specifies which display to ask about.\n\
3866 DISPLAY should be either a frame or a display name (a string).\n\
3867 If omitted or nil, that stands for the selected frame's display.")
3868 (display)
3869 Lisp_Object display;
3871 struct x_display_info *dpyinfo = check_x_display_info (display);
3872 char *vendor = ServerVendor (dpyinfo->display);
3874 if (! vendor) vendor = "";
3875 return build_string (vendor);
3878 DEFUN ("x-server-version", Fx_server_version, Sx_server_version, 0, 1, 0,
3879 "Returns the version numbers of the X server of display DISPLAY.\n\
3880 The value is a list of three integers: the major and minor\n\
3881 version numbers of the X Protocol in use, and the vendor-specific release\n\
3882 number. See also the function `x-server-vendor'.\n\n\
3883 The optional argument DISPLAY specifies which display to ask about.\n\
3884 DISPLAY should be either a frame or a display name (a string).\n\
3885 If omitted or nil, that stands for the selected frame's display.")
3886 (display)
3887 Lisp_Object display;
3889 struct x_display_info *dpyinfo = check_x_display_info (display);
3890 Display *dpy = dpyinfo->display;
3892 return Fcons (make_number (ProtocolVersion (dpy)),
3893 Fcons (make_number (ProtocolRevision (dpy)),
3894 Fcons (make_number (VendorRelease (dpy)), Qnil)));
3897 DEFUN ("x-display-screens", Fx_display_screens, Sx_display_screens, 0, 1, 0,
3898 "Returns the number of screens on the X server of display DISPLAY.\n\
3899 The optional argument DISPLAY specifies which display to ask about.\n\
3900 DISPLAY should be either a frame or a display name (a string).\n\
3901 If omitted or nil, that stands for the selected frame's display.")
3902 (display)
3903 Lisp_Object display;
3905 struct x_display_info *dpyinfo = check_x_display_info (display);
3907 return make_number (ScreenCount (dpyinfo->display));
3910 DEFUN ("x-display-mm-height", Fx_display_mm_height, Sx_display_mm_height, 0, 1, 0,
3911 "Returns the height in millimeters of the X display DISPLAY.\n\
3912 The optional argument DISPLAY specifies which display to ask about.\n\
3913 DISPLAY should be either a frame or a display name (a string).\n\
3914 If omitted or nil, that stands for the selected frame's display.")
3915 (display)
3916 Lisp_Object display;
3918 struct x_display_info *dpyinfo = check_x_display_info (display);
3920 return make_number (HeightMMOfScreen (dpyinfo->screen));
3923 DEFUN ("x-display-mm-width", Fx_display_mm_width, Sx_display_mm_width, 0, 1, 0,
3924 "Returns the width in millimeters of the X display DISPLAY.\n\
3925 The optional argument DISPLAY specifies which display to ask about.\n\
3926 DISPLAY should be either a frame or a display name (a string).\n\
3927 If omitted or nil, that stands for the selected frame's display.")
3928 (display)
3929 Lisp_Object display;
3931 struct x_display_info *dpyinfo = check_x_display_info (display);
3933 return make_number (WidthMMOfScreen (dpyinfo->screen));
3936 DEFUN ("x-display-backing-store", Fx_display_backing_store,
3937 Sx_display_backing_store, 0, 1, 0,
3938 "Returns an indication of whether X display DISPLAY does backing store.\n\
3939 The value may be `always', `when-mapped', or `not-useful'.\n\
3940 The optional argument DISPLAY specifies which display to ask about.\n\
3941 DISPLAY should be either a frame or a display name (a string).\n\
3942 If omitted or nil, that stands for the selected frame's display.")
3943 (display)
3944 Lisp_Object display;
3946 struct x_display_info *dpyinfo = check_x_display_info (display);
3948 switch (DoesBackingStore (dpyinfo->screen))
3950 case Always:
3951 return intern ("always");
3953 case WhenMapped:
3954 return intern ("when-mapped");
3956 case NotUseful:
3957 return intern ("not-useful");
3959 default:
3960 error ("Strange value for BackingStore parameter of screen");
3964 DEFUN ("x-display-visual-class", Fx_display_visual_class,
3965 Sx_display_visual_class, 0, 1, 0,
3966 "Returns the visual class of the X display DISPLAY.\n\
3967 The value is one of the symbols `static-gray', `gray-scale',\n\
3968 `static-color', `pseudo-color', `true-color', or `direct-color'.\n\n\
3969 The optional argument DISPLAY specifies which display to ask about.\n\
3970 DISPLAY should be either a frame or a display name (a string).\n\
3971 If omitted or nil, that stands for the selected frame's display.")
3972 (display)
3973 Lisp_Object display;
3975 struct x_display_info *dpyinfo = check_x_display_info (display);
3977 switch (dpyinfo->visual->class)
3979 case StaticGray: return (intern ("static-gray"));
3980 case GrayScale: return (intern ("gray-scale"));
3981 case StaticColor: return (intern ("static-color"));
3982 case PseudoColor: return (intern ("pseudo-color"));
3983 case TrueColor: return (intern ("true-color"));
3984 case DirectColor: return (intern ("direct-color"));
3985 default:
3986 error ("Display has an unknown visual class");
3990 DEFUN ("x-display-save-under", Fx_display_save_under,
3991 Sx_display_save_under, 0, 1, 0,
3992 "Returns t if the X display DISPLAY supports the save-under feature.\n\
3993 The optional argument DISPLAY specifies which display to ask about.\n\
3994 DISPLAY should be either a frame or a display name (a string).\n\
3995 If omitted or nil, that stands for the selected frame's display.")
3996 (display)
3997 Lisp_Object display;
3999 struct x_display_info *dpyinfo = check_x_display_info (display);
4001 if (DoesSaveUnders (dpyinfo->screen) == True)
4002 return Qt;
4003 else
4004 return Qnil;
4008 x_pixel_width (f)
4009 register struct frame *f;
4011 return PIXEL_WIDTH (f);
4015 x_pixel_height (f)
4016 register struct frame *f;
4018 return PIXEL_HEIGHT (f);
4022 x_char_width (f)
4023 register struct frame *f;
4025 return FONT_WIDTH (f->output_data.x->font);
4029 x_char_height (f)
4030 register struct frame *f;
4032 return f->output_data.x->line_height;
4036 x_screen_planes (frame)
4037 Lisp_Object frame;
4039 return FRAME_X_DISPLAY_INFO (XFRAME (frame))->n_planes;
4042 #if 0 /* These no longer seem like the right way to do things. */
4044 /* Draw a rectangle on the frame with left top corner including
4045 the character specified by LEFT_CHAR and TOP_CHAR. The rectangle is
4046 CHARS by LINES wide and long and is the color of the cursor. */
4048 void
4049 x_rectangle (f, gc, left_char, top_char, chars, lines)
4050 register struct frame *f;
4051 GC gc;
4052 register int top_char, left_char, chars, lines;
4054 int width;
4055 int height;
4056 int left = (left_char * FONT_WIDTH (f->output_data.x->font)
4057 + f->output_data.x->internal_border_width);
4058 int top = (top_char * f->output_data.x->line_height
4059 + f->output_data.x->internal_border_width);
4061 if (chars < 0)
4062 width = FONT_WIDTH (f->output_data.x->font) / 2;
4063 else
4064 width = FONT_WIDTH (f->output_data.x->font) * chars;
4065 if (lines < 0)
4066 height = f->output_data.x->line_height / 2;
4067 else
4068 height = f->output_data.x->line_height * lines;
4070 XDrawRectangle (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
4071 gc, left, top, width, height);
4074 DEFUN ("x-draw-rectangle", Fx_draw_rectangle, Sx_draw_rectangle, 5, 5, 0,
4075 "Draw a rectangle on FRAME between coordinates specified by\n\
4076 numbers X0, Y0, X1, Y1 in the cursor pixel.")
4077 (frame, X0, Y0, X1, Y1)
4078 register Lisp_Object frame, X0, X1, Y0, Y1;
4080 register int x0, y0, x1, y1, top, left, n_chars, n_lines;
4082 CHECK_LIVE_FRAME (frame, 0);
4083 CHECK_NUMBER (X0, 0);
4084 CHECK_NUMBER (Y0, 1);
4085 CHECK_NUMBER (X1, 2);
4086 CHECK_NUMBER (Y1, 3);
4088 x0 = XINT (X0);
4089 x1 = XINT (X1);
4090 y0 = XINT (Y0);
4091 y1 = XINT (Y1);
4093 if (y1 > y0)
4095 top = y0;
4096 n_lines = y1 - y0 + 1;
4098 else
4100 top = y1;
4101 n_lines = y0 - y1 + 1;
4104 if (x1 > x0)
4106 left = x0;
4107 n_chars = x1 - x0 + 1;
4109 else
4111 left = x1;
4112 n_chars = x0 - x1 + 1;
4115 BLOCK_INPUT;
4116 x_rectangle (XFRAME (frame), XFRAME (frame)->output_data.x->cursor_gc,
4117 left, top, n_chars, n_lines);
4118 UNBLOCK_INPUT;
4120 return Qt;
4123 DEFUN ("x-erase-rectangle", Fx_erase_rectangle, Sx_erase_rectangle, 5, 5, 0,
4124 "Draw a rectangle drawn on FRAME between coordinates\n\
4125 X0, Y0, X1, Y1 in the regular background-pixel.")
4126 (frame, X0, Y0, X1, Y1)
4127 register Lisp_Object frame, X0, Y0, X1, Y1;
4129 register int x0, y0, x1, y1, top, left, n_chars, n_lines;
4131 CHECK_LIVE_FRAME (frame, 0);
4132 CHECK_NUMBER (X0, 0);
4133 CHECK_NUMBER (Y0, 1);
4134 CHECK_NUMBER (X1, 2);
4135 CHECK_NUMBER (Y1, 3);
4137 x0 = XINT (X0);
4138 x1 = XINT (X1);
4139 y0 = XINT (Y0);
4140 y1 = XINT (Y1);
4142 if (y1 > y0)
4144 top = y0;
4145 n_lines = y1 - y0 + 1;
4147 else
4149 top = y1;
4150 n_lines = y0 - y1 + 1;
4153 if (x1 > x0)
4155 left = x0;
4156 n_chars = x1 - x0 + 1;
4158 else
4160 left = x1;
4161 n_chars = x0 - x1 + 1;
4164 BLOCK_INPUT;
4165 x_rectangle (XFRAME (frame), XFRAME (frame)->output_data.x->reverse_gc,
4166 left, top, n_chars, n_lines);
4167 UNBLOCK_INPUT;
4169 return Qt;
4172 /* Draw lines around the text region beginning at the character position
4173 TOP_X, TOP_Y and ending at BOTTOM_X and BOTTOM_Y. GC specifies the
4174 pixel and line characteristics. */
4176 #define line_len(line) (FRAME_CURRENT_GLYPHS (f)->used[(line)])
4178 static void
4179 outline_region (f, gc, top_x, top_y, bottom_x, bottom_y)
4180 register struct frame *f;
4181 GC gc;
4182 int top_x, top_y, bottom_x, bottom_y;
4184 register int ibw = f->output_data.x->internal_border_width;
4185 register int font_w = FONT_WIDTH (f->output_data.x->font);
4186 register int font_h = f->output_data.x->line_height;
4187 int y = top_y;
4188 int x = line_len (y);
4189 XPoint *pixel_points
4190 = (XPoint *) alloca (((bottom_y - top_y + 2) * 4) * sizeof (XPoint));
4191 register XPoint *this_point = pixel_points;
4193 /* Do the horizontal top line/lines */
4194 if (top_x == 0)
4196 this_point->x = ibw;
4197 this_point->y = ibw + (font_h * top_y);
4198 this_point++;
4199 if (x == 0)
4200 this_point->x = ibw + (font_w / 2); /* Half-size for newline chars. */
4201 else
4202 this_point->x = ibw + (font_w * x);
4203 this_point->y = (this_point - 1)->y;
4205 else
4207 this_point->x = ibw;
4208 this_point->y = ibw + (font_h * (top_y + 1));
4209 this_point++;
4210 this_point->x = ibw + (font_w * top_x);
4211 this_point->y = (this_point - 1)->y;
4212 this_point++;
4213 this_point->x = (this_point - 1)->x;
4214 this_point->y = ibw + (font_h * top_y);
4215 this_point++;
4216 this_point->x = ibw + (font_w * x);
4217 this_point->y = (this_point - 1)->y;
4220 /* Now do the right side. */
4221 while (y < bottom_y)
4222 { /* Right vertical edge */
4223 this_point++;
4224 this_point->x = (this_point - 1)->x;
4225 this_point->y = ibw + (font_h * (y + 1));
4226 this_point++;
4228 y++; /* Horizontal connection to next line */
4229 x = line_len (y);
4230 if (x == 0)
4231 this_point->x = ibw + (font_w / 2);
4232 else
4233 this_point->x = ibw + (font_w * x);
4235 this_point->y = (this_point - 1)->y;
4238 /* Now do the bottom and connect to the top left point. */
4239 this_point->x = ibw + (font_w * (bottom_x + 1));
4241 this_point++;
4242 this_point->x = (this_point - 1)->x;
4243 this_point->y = ibw + (font_h * (bottom_y + 1));
4244 this_point++;
4245 this_point->x = ibw;
4246 this_point->y = (this_point - 1)->y;
4247 this_point++;
4248 this_point->x = pixel_points->x;
4249 this_point->y = pixel_points->y;
4251 XDrawLines (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
4252 gc, pixel_points,
4253 (this_point - pixel_points + 1), CoordModeOrigin);
4256 DEFUN ("x-contour-region", Fx_contour_region, Sx_contour_region, 1, 1, 0,
4257 "Highlight the region between point and the character under the mouse\n\
4258 selected frame.")
4259 (event)
4260 register Lisp_Object event;
4262 register int x0, y0, x1, y1;
4263 register struct frame *f = selected_frame;
4264 register int p1, p2;
4266 CHECK_CONS (event, 0);
4268 BLOCK_INPUT;
4269 x0 = XINT (Fcar (Fcar (event)));
4270 y0 = XINT (Fcar (Fcdr (Fcar (event))));
4272 /* If the mouse is past the end of the line, don't that area. */
4273 /* ReWrite this... */
4275 x1 = f->cursor_x;
4276 y1 = f->cursor_y;
4278 if (y1 > y0) /* point below mouse */
4279 outline_region (f, f->output_data.x->cursor_gc,
4280 x0, y0, x1, y1);
4281 else if (y1 < y0) /* point above mouse */
4282 outline_region (f, f->output_data.x->cursor_gc,
4283 x1, y1, x0, y0);
4284 else /* same line: draw horizontal rectangle */
4286 if (x1 > x0)
4287 x_rectangle (f, f->output_data.x->cursor_gc,
4288 x0, y0, (x1 - x0 + 1), 1);
4289 else if (x1 < x0)
4290 x_rectangle (f, f->output_data.x->cursor_gc,
4291 x1, y1, (x0 - x1 + 1), 1);
4294 XFlush (FRAME_X_DISPLAY (f));
4295 UNBLOCK_INPUT;
4297 return Qnil;
4300 DEFUN ("x-uncontour-region", Fx_uncontour_region, Sx_uncontour_region, 1, 1, 0,
4301 "Erase any highlighting of the region between point and the character\n\
4302 at X, Y on the selected frame.")
4303 (event)
4304 register Lisp_Object event;
4306 register int x0, y0, x1, y1;
4307 register struct frame *f = selected_frame;
4309 BLOCK_INPUT;
4310 x0 = XINT (Fcar (Fcar (event)));
4311 y0 = XINT (Fcar (Fcdr (Fcar (event))));
4312 x1 = f->cursor_x;
4313 y1 = f->cursor_y;
4315 if (y1 > y0) /* point below mouse */
4316 outline_region (f, f->output_data.x->reverse_gc,
4317 x0, y0, x1, y1);
4318 else if (y1 < y0) /* point above mouse */
4319 outline_region (f, f->output_data.x->reverse_gc,
4320 x1, y1, x0, y0);
4321 else /* same line: draw horizontal rectangle */
4323 if (x1 > x0)
4324 x_rectangle (f, f->output_data.x->reverse_gc,
4325 x0, y0, (x1 - x0 + 1), 1);
4326 else if (x1 < x0)
4327 x_rectangle (f, f->output_data.x->reverse_gc,
4328 x1, y1, (x0 - x1 + 1), 1);
4330 UNBLOCK_INPUT;
4332 return Qnil;
4335 #if 0
4336 int contour_begin_x, contour_begin_y;
4337 int contour_end_x, contour_end_y;
4338 int contour_npoints;
4340 /* Clip the top part of the contour lines down (and including) line Y_POS.
4341 If X_POS is in the middle (rather than at the end) of the line, drop
4342 down a line at that character. */
4344 static void
4345 clip_contour_top (y_pos, x_pos)
4347 register XPoint *begin = contour_lines[y_pos].top_left;
4348 register XPoint *end;
4349 register int npoints;
4350 register struct display_line *line = selected_frame->phys_lines[y_pos + 1];
4352 if (x_pos >= line->len - 1) /* Draw one, straight horizontal line. */
4354 end = contour_lines[y_pos].top_right;
4355 npoints = (end - begin + 1);
4356 XDrawLines (x_current_display, contour_window,
4357 contour_erase_gc, begin_erase, npoints, CoordModeOrigin);
4359 bcopy (end, begin + 1, contour_last_point - end + 1);
4360 contour_last_point -= (npoints - 2);
4361 XDrawLines (x_current_display, contour_window,
4362 contour_erase_gc, begin, 2, CoordModeOrigin);
4363 XFlush (x_current_display);
4365 /* Now, update contour_lines structure. */
4367 /* ______. */
4368 else /* |________*/
4370 register XPoint *p = begin + 1;
4371 end = contour_lines[y_pos].bottom_right;
4372 npoints = (end - begin + 1);
4373 XDrawLines (x_current_display, contour_window,
4374 contour_erase_gc, begin_erase, npoints, CoordModeOrigin);
4376 p->y = begin->y;
4377 p->x = ibw + (font_w * (x_pos + 1));
4378 p++;
4379 p->y = begin->y + font_h;
4380 p->x = (p - 1)->x;
4381 bcopy (end, begin + 3, contour_last_point - end + 1);
4382 contour_last_point -= (npoints - 5);
4383 XDrawLines (x_current_display, contour_window,
4384 contour_erase_gc, begin, 4, CoordModeOrigin);
4385 XFlush (x_current_display);
4387 /* Now, update contour_lines structure. */
4391 /* Erase the top horizontal lines of the contour, and then extend
4392 the contour upwards. */
4394 static void
4395 extend_contour_top (line)
4399 static void
4400 clip_contour_bottom (x_pos, y_pos)
4401 int x_pos, y_pos;
4405 static void
4406 extend_contour_bottom (x_pos, y_pos)
4410 DEFUN ("x-select-region", Fx_select_region, Sx_select_region, 1, 1, "e",
4412 (event)
4413 Lisp_Object event;
4415 register struct frame *f = selected_frame;
4416 register int point_x = f->cursor_x;
4417 register int point_y = f->cursor_y;
4418 register int mouse_below_point;
4419 register Lisp_Object obj;
4420 register int x_contour_x, x_contour_y;
4422 x_contour_x = x_mouse_x;
4423 x_contour_y = x_mouse_y;
4424 if (x_contour_y > point_y || (x_contour_y == point_y
4425 && x_contour_x > point_x))
4427 mouse_below_point = 1;
4428 outline_region (f, f->output_data.x->cursor_gc, point_x, point_y,
4429 x_contour_x, x_contour_y);
4431 else
4433 mouse_below_point = 0;
4434 outline_region (f, f->output_data.x->cursor_gc, x_contour_x, x_contour_y,
4435 point_x, point_y);
4438 while (1)
4440 obj = read_char (-1, 0, 0, Qnil, 0);
4441 if (!CONSP (obj))
4442 break;
4444 if (mouse_below_point)
4446 if (x_mouse_y <= point_y) /* Flipped. */
4448 mouse_below_point = 0;
4450 outline_region (f, f->output_data.x->reverse_gc, point_x, point_y,
4451 x_contour_x, x_contour_y);
4452 outline_region (f, f->output_data.x->cursor_gc, x_mouse_x, x_mouse_y,
4453 point_x, point_y);
4455 else if (x_mouse_y < x_contour_y) /* Bottom clipped. */
4457 clip_contour_bottom (x_mouse_y);
4459 else if (x_mouse_y > x_contour_y) /* Bottom extended. */
4461 extend_bottom_contour (x_mouse_y);
4464 x_contour_x = x_mouse_x;
4465 x_contour_y = x_mouse_y;
4467 else /* mouse above or same line as point */
4469 if (x_mouse_y >= point_y) /* Flipped. */
4471 mouse_below_point = 1;
4473 outline_region (f, f->output_data.x->reverse_gc,
4474 x_contour_x, x_contour_y, point_x, point_y);
4475 outline_region (f, f->output_data.x->cursor_gc, point_x, point_y,
4476 x_mouse_x, x_mouse_y);
4478 else if (x_mouse_y > x_contour_y) /* Top clipped. */
4480 clip_contour_top (x_mouse_y);
4482 else if (x_mouse_y < x_contour_y) /* Top extended. */
4484 extend_contour_top (x_mouse_y);
4489 unread_command_event = obj;
4490 if (mouse_below_point)
4492 contour_begin_x = point_x;
4493 contour_begin_y = point_y;
4494 contour_end_x = x_contour_x;
4495 contour_end_y = x_contour_y;
4497 else
4499 contour_begin_x = x_contour_x;
4500 contour_begin_y = x_contour_y;
4501 contour_end_x = point_x;
4502 contour_end_y = point_y;
4505 #endif
4507 DEFUN ("x-horizontal-line", Fx_horizontal_line, Sx_horizontal_line, 1, 1, "e",
4509 (event)
4510 Lisp_Object event;
4512 register Lisp_Object obj;
4513 struct frame *f = selected_frame;
4514 register struct window *w = XWINDOW (selected_window);
4515 register GC line_gc = f->output_data.x->cursor_gc;
4516 register GC erase_gc = f->output_data.x->reverse_gc;
4517 #if 0
4518 char dash_list[] = {6, 4, 6, 4};
4519 int dashes = 4;
4520 XGCValues gc_values;
4521 #endif
4522 register int previous_y;
4523 register int line = (x_mouse_y + 1) * f->output_data.x->line_height
4524 + f->output_data.x->internal_border_width;
4525 register int left = f->output_data.x->internal_border_width
4526 + (WINDOW_LEFT_MARGIN (w)
4527 * FONT_WIDTH (f->output_data.x->font));
4528 register int right = left + (w->width
4529 * FONT_WIDTH (f->output_data.x->font))
4530 - f->output_data.x->internal_border_width;
4532 #if 0
4533 BLOCK_INPUT;
4534 gc_values.foreground = f->output_data.x->cursor_pixel;
4535 gc_values.background = f->output_data.x->background_pixel;
4536 gc_values.line_width = 1;
4537 gc_values.line_style = LineOnOffDash;
4538 gc_values.cap_style = CapRound;
4539 gc_values.join_style = JoinRound;
4541 line_gc = XCreateGC (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
4542 GCLineStyle | GCJoinStyle | GCCapStyle
4543 | GCLineWidth | GCForeground | GCBackground,
4544 &gc_values);
4545 XSetDashes (FRAME_X_DISPLAY (f), line_gc, 0, dash_list, dashes);
4546 gc_values.foreground = f->output_data.x->background_pixel;
4547 gc_values.background = f->output_data.x->foreground_pixel;
4548 erase_gc = XCreateGC (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
4549 GCLineStyle | GCJoinStyle | GCCapStyle
4550 | GCLineWidth | GCForeground | GCBackground,
4551 &gc_values);
4552 XSetDashes (FRAME_X_DISPLAY (f), erase_gc, 0, dash_list, dashes);
4553 UNBLOCK_INPUT;
4554 #endif
4556 while (1)
4558 BLOCK_INPUT;
4559 if (x_mouse_y >= XINT (w->top)
4560 && x_mouse_y < XINT (w->top) + XINT (w->height) - 1)
4562 previous_y = x_mouse_y;
4563 line = (x_mouse_y + 1) * f->output_data.x->line_height
4564 + f->output_data.x->internal_border_width;
4565 XDrawLine (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
4566 line_gc, left, line, right, line);
4568 XFlush (FRAME_X_DISPLAY (f));
4569 UNBLOCK_INPUT;
4573 obj = read_char (-1, 0, 0, Qnil, 0);
4574 if (!CONSP (obj)
4575 || (! EQ (Fcar (Fcdr (Fcdr (obj))),
4576 Qvertical_scroll_bar))
4577 || x_mouse_grabbed)
4579 BLOCK_INPUT;
4580 XDrawLine (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
4581 erase_gc, left, line, right, line);
4582 unread_command_event = obj;
4583 #if 0
4584 XFreeGC (FRAME_X_DISPLAY (f), line_gc);
4585 XFreeGC (FRAME_X_DISPLAY (f), erase_gc);
4586 #endif
4587 UNBLOCK_INPUT;
4588 return Qnil;
4591 while (x_mouse_y == previous_y);
4593 BLOCK_INPUT;
4594 XDrawLine (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
4595 erase_gc, left, line, right, line);
4596 UNBLOCK_INPUT;
4599 #endif
4601 #if 0
4602 /* These keep track of the rectangle following the pointer. */
4603 int mouse_track_top, mouse_track_left, mouse_track_width;
4605 /* Offset in buffer of character under the pointer, or 0. */
4606 int mouse_buffer_offset;
4608 DEFUN ("x-track-pointer", Fx_track_pointer, Sx_track_pointer, 0, 0, 0,
4609 "Track the pointer.")
4612 static Cursor current_pointer_shape;
4613 FRAME_PTR f = x_mouse_frame;
4615 BLOCK_INPUT;
4616 if (EQ (Vmouse_frame_part, Qtext_part)
4617 && (current_pointer_shape != f->output_data.x->nontext_cursor))
4619 unsigned char c;
4620 struct buffer *buf;
4622 current_pointer_shape = f->output_data.x->nontext_cursor;
4623 XDefineCursor (FRAME_X_DISPLAY (f),
4624 FRAME_X_WINDOW (f),
4625 current_pointer_shape);
4627 buf = XBUFFER (XWINDOW (Vmouse_window)->buffer);
4628 c = *(BUF_CHAR_ADDRESS (buf, mouse_buffer_offset));
4630 else if (EQ (Vmouse_frame_part, Qmodeline_part)
4631 && (current_pointer_shape != f->output_data.x->modeline_cursor))
4633 current_pointer_shape = f->output_data.x->modeline_cursor;
4634 XDefineCursor (FRAME_X_DISPLAY (f),
4635 FRAME_X_WINDOW (f),
4636 current_pointer_shape);
4639 XFlush (FRAME_X_DISPLAY (f));
4640 UNBLOCK_INPUT;
4642 #endif
4644 #if 0
4645 DEFUN ("x-track-pointer", Fx_track_pointer, Sx_track_pointer, 1, 1, "e",
4646 "Draw rectangle around character under mouse pointer, if there is one.")
4647 (event)
4648 Lisp_Object event;
4650 struct window *w = XWINDOW (Vmouse_window);
4651 struct frame *f = XFRAME (WINDOW_FRAME (w));
4652 struct buffer *b = XBUFFER (w->buffer);
4653 Lisp_Object obj;
4655 if (! EQ (Vmouse_window, selected_window))
4656 return Qnil;
4658 if (EQ (event, Qnil))
4660 int x, y;
4662 x_read_mouse_position (selected_frame, &x, &y);
4665 BLOCK_INPUT;
4666 mouse_track_width = 0;
4667 mouse_track_left = mouse_track_top = -1;
4671 if ((x_mouse_x != mouse_track_left
4672 && (x_mouse_x < mouse_track_left
4673 || x_mouse_x > (mouse_track_left + mouse_track_width)))
4674 || x_mouse_y != mouse_track_top)
4676 int hp = 0; /* Horizontal position */
4677 int len = FRAME_CURRENT_GLYPHS (f)->used[x_mouse_y];
4678 int p = FRAME_CURRENT_GLYPHS (f)->bufp[x_mouse_y];
4679 int tab_width = XINT (b->tab_width);
4680 int ctl_arrow_p = !NILP (b->ctl_arrow);
4681 unsigned char c;
4682 int mode_line_vpos = XFASTINT (w->height) + XFASTINT (w->top) - 1;
4683 int in_mode_line = 0;
4685 if (! FRAME_CURRENT_GLYPHS (f)->enable[x_mouse_y])
4686 break;
4688 /* Erase previous rectangle. */
4689 if (mouse_track_width)
4691 x_rectangle (f, f->output_data.x->reverse_gc,
4692 mouse_track_left, mouse_track_top,
4693 mouse_track_width, 1);
4695 if ((mouse_track_left == f->phys_cursor_x
4696 || mouse_track_left == f->phys_cursor_x - 1)
4697 && mouse_track_top == f->phys_cursor_y)
4699 x_display_cursor (f, 1);
4703 mouse_track_left = x_mouse_x;
4704 mouse_track_top = x_mouse_y;
4705 mouse_track_width = 0;
4707 if (mouse_track_left > len) /* Past the end of line. */
4708 goto draw_or_not;
4710 if (mouse_track_top == mode_line_vpos)
4712 in_mode_line = 1;
4713 goto draw_or_not;
4716 if (tab_width <= 0 || tab_width > 20) tab_width = 8;
4719 c = FETCH_BYTE (p);
4720 if (len == f->width && hp == len - 1 && c != '\n')
4721 goto draw_or_not;
4723 switch (c)
4725 case '\t':
4726 mouse_track_width = tab_width - (hp % tab_width);
4727 p++;
4728 hp += mouse_track_width;
4729 if (hp > x_mouse_x)
4731 mouse_track_left = hp - mouse_track_width;
4732 goto draw_or_not;
4734 continue;
4736 case '\n':
4737 mouse_track_width = -1;
4738 goto draw_or_not;
4740 default:
4741 if (ctl_arrow_p && (c < 040 || c == 0177))
4743 if (p > ZV)
4744 goto draw_or_not;
4746 mouse_track_width = 2;
4747 p++;
4748 hp +=2;
4749 if (hp > x_mouse_x)
4751 mouse_track_left = hp - mouse_track_width;
4752 goto draw_or_not;
4755 else
4757 mouse_track_width = 1;
4758 p++;
4759 hp++;
4761 continue;
4764 while (hp <= x_mouse_x);
4766 draw_or_not:
4767 if (mouse_track_width) /* Over text; use text pointer shape. */
4769 XDefineCursor (FRAME_X_DISPLAY (f),
4770 FRAME_X_WINDOW (f),
4771 f->output_data.x->text_cursor);
4772 x_rectangle (f, f->output_data.x->cursor_gc,
4773 mouse_track_left, mouse_track_top,
4774 mouse_track_width, 1);
4776 else if (in_mode_line)
4777 XDefineCursor (FRAME_X_DISPLAY (f),
4778 FRAME_X_WINDOW (f),
4779 f->output_data.x->modeline_cursor);
4780 else
4781 XDefineCursor (FRAME_X_DISPLAY (f),
4782 FRAME_X_WINDOW (f),
4783 f->output_data.x->nontext_cursor);
4786 XFlush (FRAME_X_DISPLAY (f));
4787 UNBLOCK_INPUT;
4789 obj = read_char (-1, 0, 0, Qnil, 0);
4790 BLOCK_INPUT;
4792 while (CONSP (obj) /* Mouse event */
4793 && EQ (Fcar (Fcdr (Fcdr (obj))), Qnil) /* Not scroll bar */
4794 && EQ (Vmouse_depressed, Qnil) /* Only motion events */
4795 && EQ (Vmouse_window, selected_window) /* In this window */
4796 && x_mouse_frame);
4798 unread_command_event = obj;
4800 if (mouse_track_width)
4802 x_rectangle (f, f->output_data.x->reverse_gc,
4803 mouse_track_left, mouse_track_top,
4804 mouse_track_width, 1);
4805 mouse_track_width = 0;
4806 if ((mouse_track_left == f->phys_cursor_x
4807 || mouse_track_left - 1 == f->phys_cursor_x)
4808 && mouse_track_top == f->phys_cursor_y)
4810 x_display_cursor (f, 1);
4813 XDefineCursor (FRAME_X_DISPLAY (f),
4814 FRAME_X_WINDOW (f),
4815 f->output_data.x->nontext_cursor);
4816 XFlush (FRAME_X_DISPLAY (f));
4817 UNBLOCK_INPUT;
4819 return Qnil;
4821 #endif
4823 #if 0
4824 #include "glyphs.h"
4826 /* Draw a pixmap specified by IMAGE_DATA of dimensions WIDTH and HEIGHT
4827 on the frame F at position X, Y. */
4829 x_draw_pixmap (f, x, y, image_data, width, height)
4830 struct frame *f;
4831 int x, y, width, height;
4832 char *image_data;
4834 Pixmap image;
4836 image = XCreateBitmapFromData (FRAME_X_DISPLAY (f),
4837 FRAME_X_WINDOW (f), image_data,
4838 width, height);
4839 XCopyPlane (FRAME_X_DISPLAY (f), image, FRAME_X_WINDOW (f),
4840 f->output_data.x->normal_gc, 0, 0, width, height, x, y);
4842 #endif
4844 #if 0 /* I'm told these functions are superfluous
4845 given the ability to bind function keys. */
4847 #ifdef HAVE_X11
4848 DEFUN ("x-rebind-key", Fx_rebind_key, Sx_rebind_key, 3, 3, 0,
4849 "Rebind X keysym KEYSYM, with MODIFIERS, to generate NEWSTRING.\n\
4850 KEYSYM is a string which conforms to the X keysym definitions found\n\
4851 in X11/keysymdef.h, sans the initial XK_. MODIFIERS is nil or a\n\
4852 list of strings specifying modifier keys such as Control_L, which must\n\
4853 also be depressed for NEWSTRING to appear.")
4854 (x_keysym, modifiers, newstring)
4855 register Lisp_Object x_keysym;
4856 register Lisp_Object modifiers;
4857 register Lisp_Object newstring;
4859 char *rawstring;
4860 register KeySym keysym;
4861 KeySym modifier_list[16];
4863 check_x ();
4864 CHECK_STRING (x_keysym, 1);
4865 CHECK_STRING (newstring, 3);
4867 keysym = XStringToKeysym ((char *) XSTRING (x_keysym)->data);
4868 if (keysym == NoSymbol)
4869 error ("Keysym does not exist");
4871 if (NILP (modifiers))
4872 XRebindKeysym (x_current_display, keysym, modifier_list, 0,
4873 XSTRING (newstring)->data, XSTRING (newstring)->size);
4874 else
4876 register Lisp_Object rest, mod;
4877 register int i = 0;
4879 for (rest = modifiers; !NILP (rest); rest = Fcdr (rest))
4881 if (i == 16)
4882 error ("Can't have more than 16 modifiers");
4884 mod = Fcar (rest);
4885 CHECK_STRING (mod, 3);
4886 modifier_list[i] = XStringToKeysym ((char *) XSTRING (mod)->data);
4887 #ifndef HAVE_X11R5
4888 if (modifier_list[i] == NoSymbol
4889 || !(IsModifierKey (modifier_list[i])
4890 || ((unsigned)(modifier_list[i]) == XK_Mode_switch)
4891 || ((unsigned)(modifier_list[i]) == XK_Num_Lock)))
4892 #else
4893 if (modifier_list[i] == NoSymbol
4894 || !IsModifierKey (modifier_list[i]))
4895 #endif
4896 error ("Element is not a modifier keysym");
4897 i++;
4900 XRebindKeysym (x_current_display, keysym, modifier_list, i,
4901 XSTRING (newstring)->data, XSTRING (newstring)->size);
4904 return Qnil;
4907 DEFUN ("x-rebind-keys", Fx_rebind_keys, Sx_rebind_keys, 2, 2, 0,
4908 "Rebind KEYCODE to list of strings STRINGS.\n\
4909 STRINGS should be a list of 16 elements, one for each shift combination.\n\
4910 nil as element means don't change.\n\
4911 See the documentation of `x-rebind-key' for more information.")
4912 (keycode, strings)
4913 register Lisp_Object keycode;
4914 register Lisp_Object strings;
4916 register Lisp_Object item;
4917 register unsigned char *rawstring;
4918 KeySym rawkey, modifier[1];
4919 int strsize;
4920 register unsigned i;
4922 check_x ();
4923 CHECK_NUMBER (keycode, 1);
4924 CHECK_CONS (strings, 2);
4925 rawkey = (KeySym) ((unsigned) (XINT (keycode))) & 255;
4926 for (i = 0; i <= 15; strings = Fcdr (strings), i++)
4928 item = Fcar (strings);
4929 if (!NILP (item))
4931 CHECK_STRING (item, 2);
4932 strsize = XSTRING (item)->size;
4933 rawstring = (unsigned char *) xmalloc (strsize);
4934 bcopy (XSTRING (item)->data, rawstring, strsize);
4935 modifier[1] = 1 << i;
4936 XRebindKeysym (x_current_display, rawkey, modifier, 1,
4937 rawstring, strsize);
4940 return Qnil;
4942 #endif /* HAVE_X11 */
4943 #endif /* 0 */
4945 #ifndef HAVE_XSCREENNUMBEROFSCREEN
4947 XScreenNumberOfScreen (scr)
4948 register Screen *scr;
4950 register Display *dpy;
4951 register Screen *dpyscr;
4952 register int i;
4954 dpy = scr->display;
4955 dpyscr = dpy->screens;
4957 for (i = 0; i < dpy->nscreens; i++, dpyscr++)
4958 if (scr == dpyscr)
4959 return i;
4961 return -1;
4963 #endif /* not HAVE_XSCREENNUMBEROFSCREEN */
4965 Visual *
4966 select_visual (dpy, screen, depth)
4967 Display *dpy;
4968 Screen *screen;
4969 unsigned int *depth;
4971 Visual *v;
4972 XVisualInfo *vinfo, vinfo_template;
4973 int n_visuals;
4975 v = DefaultVisualOfScreen (screen);
4977 #ifdef HAVE_X11R4
4978 vinfo_template.visualid = XVisualIDFromVisual (v);
4979 #else
4980 vinfo_template.visualid = v->visualid;
4981 #endif
4983 vinfo_template.screen = XScreenNumberOfScreen (screen);
4985 vinfo = XGetVisualInfo (dpy,
4986 VisualIDMask | VisualScreenMask, &vinfo_template,
4987 &n_visuals);
4988 if (n_visuals != 1)
4989 fatal ("Can't get proper X visual info");
4991 if ((1 << vinfo->depth) == vinfo->colormap_size)
4992 *depth = vinfo->depth;
4993 else
4995 int i = 0;
4996 int n = vinfo->colormap_size - 1;
4997 while (n)
4999 n = n >> 1;
5000 i++;
5002 *depth = i;
5005 XFree ((char *) vinfo);
5006 return v;
5009 /* Return the X display structure for the display named NAME.
5010 Open a new connection if necessary. */
5012 struct x_display_info *
5013 x_display_info_for_name (name)
5014 Lisp_Object name;
5016 Lisp_Object names;
5017 struct x_display_info *dpyinfo;
5019 CHECK_STRING (name, 0);
5021 if (! EQ (Vwindow_system, intern ("x")))
5022 error ("Not using X Windows");
5024 for (dpyinfo = x_display_list, names = x_display_name_list;
5025 dpyinfo;
5026 dpyinfo = dpyinfo->next, names = XCONS (names)->cdr)
5028 Lisp_Object tem;
5029 tem = Fstring_equal (XCONS (XCONS (names)->car)->car, name);
5030 if (!NILP (tem))
5031 return dpyinfo;
5034 /* Use this general default value to start with. */
5035 Vx_resource_name = Vinvocation_name;
5037 validate_x_resource_name ();
5039 dpyinfo = x_term_init (name, (unsigned char *)0,
5040 (char *) XSTRING (Vx_resource_name)->data);
5042 if (dpyinfo == 0)
5043 error ("Cannot connect to X server %s", XSTRING (name)->data);
5045 x_in_use = 1;
5046 XSETFASTINT (Vwindow_system_version, 11);
5048 return dpyinfo;
5051 DEFUN ("x-open-connection", Fx_open_connection, Sx_open_connection,
5052 1, 3, 0, "Open a connection to an X server.\n\
5053 DISPLAY is the name of the display to connect to.\n\
5054 Optional second arg XRM-STRING is a string of resources in xrdb format.\n\
5055 If the optional third arg MUST-SUCCEED is non-nil,\n\
5056 terminate Emacs if we can't open the connection.")
5057 (display, xrm_string, must_succeed)
5058 Lisp_Object display, xrm_string, must_succeed;
5060 unsigned int n_planes;
5061 unsigned char *xrm_option;
5062 struct x_display_info *dpyinfo;
5064 CHECK_STRING (display, 0);
5065 if (! NILP (xrm_string))
5066 CHECK_STRING (xrm_string, 1);
5068 if (! EQ (Vwindow_system, intern ("x")))
5069 error ("Not using X Windows");
5071 if (! NILP (xrm_string))
5072 xrm_option = (unsigned char *) XSTRING (xrm_string)->data;
5073 else
5074 xrm_option = (unsigned char *) 0;
5076 validate_x_resource_name ();
5078 /* This is what opens the connection and sets x_current_display.
5079 This also initializes many symbols, such as those used for input. */
5080 dpyinfo = x_term_init (display, xrm_option,
5081 (char *) XSTRING (Vx_resource_name)->data);
5083 if (dpyinfo == 0)
5085 if (!NILP (must_succeed))
5086 fatal ("Cannot connect to X server %s.\n\
5087 Check the DISPLAY environment variable or use `-d'.\n\
5088 Also use the `xhost' program to verify that it is set to permit\n\
5089 connections from your machine.\n",
5090 XSTRING (display)->data);
5091 else
5092 error ("Cannot connect to X server %s", XSTRING (display)->data);
5095 x_in_use = 1;
5097 XSETFASTINT (Vwindow_system_version, 11);
5098 return Qnil;
5101 DEFUN ("x-close-connection", Fx_close_connection,
5102 Sx_close_connection, 1, 1, 0,
5103 "Close the connection to DISPLAY's X server.\n\
5104 For DISPLAY, specify either a frame or a display name (a string).\n\
5105 If DISPLAY is nil, that stands for the selected frame's display.")
5106 (display)
5107 Lisp_Object display;
5109 struct x_display_info *dpyinfo = check_x_display_info (display);
5110 struct x_display_info *tail;
5111 int i;
5113 if (dpyinfo->reference_count > 0)
5114 error ("Display still has frames on it");
5116 BLOCK_INPUT;
5117 /* Free the fonts in the font table. */
5118 for (i = 0; i < dpyinfo->n_fonts; i++)
5120 if (dpyinfo->font_table[i].name)
5121 free (dpyinfo->font_table[i].name);
5122 /* Don't free the full_name string;
5123 it is always shared with something else. */
5124 XFreeFont (dpyinfo->display, dpyinfo->font_table[i].font);
5126 x_destroy_all_bitmaps (dpyinfo);
5127 XSetCloseDownMode (dpyinfo->display, DestroyAll);
5129 #ifdef USE_X_TOOLKIT
5130 XtCloseDisplay (dpyinfo->display);
5131 #else
5132 XCloseDisplay (dpyinfo->display);
5133 #endif
5135 x_delete_display (dpyinfo);
5136 UNBLOCK_INPUT;
5138 return Qnil;
5141 DEFUN ("x-display-list", Fx_display_list, Sx_display_list, 0, 0, 0,
5142 "Return the list of display names that Emacs has connections to.")
5145 Lisp_Object tail, result;
5147 result = Qnil;
5148 for (tail = x_display_name_list; ! NILP (tail); tail = XCONS (tail)->cdr)
5149 result = Fcons (XCONS (XCONS (tail)->car)->car, result);
5151 return result;
5154 DEFUN ("x-synchronize", Fx_synchronize, Sx_synchronize, 1, 2, 0,
5155 "If ON is non-nil, report X errors as soon as the erring request is made.\n\
5156 If ON is nil, allow buffering of requests.\n\
5157 Turning on synchronization prohibits the Xlib routines from buffering\n\
5158 requests and seriously degrades performance, but makes debugging much\n\
5159 easier.\n\
5160 The optional second argument DISPLAY specifies which display to act on.\n\
5161 DISPLAY should be either a frame or a display name (a string).\n\
5162 If DISPLAY is omitted or nil, that stands for the selected frame's display.")
5163 (on, display)
5164 Lisp_Object display, on;
5166 struct x_display_info *dpyinfo = check_x_display_info (display);
5168 XSynchronize (dpyinfo->display, !EQ (on, Qnil));
5170 return Qnil;
5173 /* Wait for responses to all X commands issued so far for frame F. */
5175 void
5176 x_sync (f)
5177 FRAME_PTR f;
5179 BLOCK_INPUT;
5180 XSync (FRAME_X_DISPLAY (f), False);
5181 UNBLOCK_INPUT;
5184 syms_of_xfns ()
5186 /* This is zero if not using X windows. */
5187 x_in_use = 0;
5189 /* The section below is built by the lisp expression at the top of the file,
5190 just above where these variables are declared. */
5191 /*&&& init symbols here &&&*/
5192 Qauto_raise = intern ("auto-raise");
5193 staticpro (&Qauto_raise);
5194 Qauto_lower = intern ("auto-lower");
5195 staticpro (&Qauto_lower);
5196 Qbackground_color = intern ("background-color");
5197 staticpro (&Qbackground_color);
5198 Qbar = intern ("bar");
5199 staticpro (&Qbar);
5200 Qborder_color = intern ("border-color");
5201 staticpro (&Qborder_color);
5202 Qborder_width = intern ("border-width");
5203 staticpro (&Qborder_width);
5204 Qbox = intern ("box");
5205 staticpro (&Qbox);
5206 Qcursor_color = intern ("cursor-color");
5207 staticpro (&Qcursor_color);
5208 Qcursor_type = intern ("cursor-type");
5209 staticpro (&Qcursor_type);
5210 Qforeground_color = intern ("foreground-color");
5211 staticpro (&Qforeground_color);
5212 Qgeometry = intern ("geometry");
5213 staticpro (&Qgeometry);
5214 Qicon_left = intern ("icon-left");
5215 staticpro (&Qicon_left);
5216 Qicon_top = intern ("icon-top");
5217 staticpro (&Qicon_top);
5218 Qicon_type = intern ("icon-type");
5219 staticpro (&Qicon_type);
5220 Qicon_name = intern ("icon-name");
5221 staticpro (&Qicon_name);
5222 Qinternal_border_width = intern ("internal-border-width");
5223 staticpro (&Qinternal_border_width);
5224 Qleft = intern ("left");
5225 staticpro (&Qleft);
5226 Qright = intern ("right");
5227 staticpro (&Qright);
5228 Qmouse_color = intern ("mouse-color");
5229 staticpro (&Qmouse_color);
5230 Qnone = intern ("none");
5231 staticpro (&Qnone);
5232 Qparent_id = intern ("parent-id");
5233 staticpro (&Qparent_id);
5234 Qscroll_bar_width = intern ("scroll-bar-width");
5235 staticpro (&Qscroll_bar_width);
5236 Qsuppress_icon = intern ("suppress-icon");
5237 staticpro (&Qsuppress_icon);
5238 Qtop = intern ("top");
5239 staticpro (&Qtop);
5240 Qundefined_color = intern ("undefined-color");
5241 staticpro (&Qundefined_color);
5242 Qvertical_scroll_bars = intern ("vertical-scroll-bars");
5243 staticpro (&Qvertical_scroll_bars);
5244 Qvisibility = intern ("visibility");
5245 staticpro (&Qvisibility);
5246 Qwindow_id = intern ("window-id");
5247 staticpro (&Qwindow_id);
5248 Qx_frame_parameter = intern ("x-frame-parameter");
5249 staticpro (&Qx_frame_parameter);
5250 Qx_resource_name = intern ("x-resource-name");
5251 staticpro (&Qx_resource_name);
5252 Quser_position = intern ("user-position");
5253 staticpro (&Quser_position);
5254 Quser_size = intern ("user-size");
5255 staticpro (&Quser_size);
5256 Qdisplay = intern ("display");
5257 staticpro (&Qdisplay);
5258 /* This is the end of symbol initialization. */
5260 Qface_set_after_frame_default = intern ("face-set-after-frame-default");
5261 staticpro (&Qface_set_after_frame_default);
5263 Fput (Qundefined_color, Qerror_conditions,
5264 Fcons (Qundefined_color, Fcons (Qerror, Qnil)));
5265 Fput (Qundefined_color, Qerror_message,
5266 build_string ("Undefined color"));
5268 init_x_parm_symbols ();
5270 DEFVAR_LISP ("x-bitmap-file-path", &Vx_bitmap_file_path,
5271 "List of directories to search for bitmap files for X.");
5272 Vx_bitmap_file_path = decode_env_path ((char *) 0, PATH_BITMAPS);
5274 DEFVAR_LISP ("x-pointer-shape", &Vx_pointer_shape,
5275 "The shape of the pointer when over text.\n\
5276 Changing the value does not affect existing frames\n\
5277 unless you set the mouse color.");
5278 Vx_pointer_shape = Qnil;
5280 DEFVAR_LISP ("x-resource-name", &Vx_resource_name,
5281 "The name Emacs uses to look up X resources.\n\
5282 `x-get-resource' uses this as the first component of the instance name\n\
5283 when requesting resource values.\n\
5284 Emacs initially sets `x-resource-name' to the name under which Emacs\n\
5285 was invoked, or to the value specified with the `-name' or `-rn'\n\
5286 switches, if present.\n\
5288 It may be useful to bind this variable locally around a call\n\
5289 to `x-get-resource'. See also the variable `x-resource-class'.");
5290 Vx_resource_name = Qnil;
5292 DEFVAR_LISP ("x-resource-class", &Vx_resource_class,
5293 "The class Emacs uses to look up X resources.\n\
5294 `x-get-resource' uses this as the first component of the instance class\n\
5295 when requesting resource values.\n\
5296 Emacs initially sets `x-resource-class' to \"Emacs\".\n\
5298 Setting this variable permanently is not a reasonable thing to do,\n\
5299 but binding this variable locally around a call to `x-get-resource'\n\
5300 is a reasonabvle practice. See also the variable `x-resource-name'.");
5301 Vx_resource_class = build_string (EMACS_CLASS);
5303 #if 0 /* This doesn't really do anything. */
5304 DEFVAR_LISP ("x-nontext-pointer-shape", &Vx_nontext_pointer_shape,
5305 "The shape of the pointer when not over text.\n\
5306 This variable takes effect when you create a new frame\n\
5307 or when you set the mouse color.");
5308 #endif
5309 Vx_nontext_pointer_shape = Qnil;
5311 #if 0 /* This doesn't really do anything. */
5312 DEFVAR_LISP ("x-mode-pointer-shape", &Vx_mode_pointer_shape,
5313 "The shape of the pointer when over the mode line.\n\
5314 This variable takes effect when you create a new frame\n\
5315 or when you set the mouse color.");
5316 #endif
5317 Vx_mode_pointer_shape = Qnil;
5319 DEFVAR_LISP ("x-sensitive-text-pointer-shape",
5320 &Vx_sensitive_text_pointer_shape,
5321 "The shape of the pointer when over mouse-sensitive text.\n\
5322 This variable takes effect when you create a new frame\n\
5323 or when you set the mouse color.");
5324 Vx_sensitive_text_pointer_shape = Qnil;
5326 DEFVAR_LISP ("x-cursor-fore-pixel", &Vx_cursor_fore_pixel,
5327 "A string indicating the foreground color of the cursor box.");
5328 Vx_cursor_fore_pixel = Qnil;
5330 DEFVAR_LISP ("x-no-window-manager", &Vx_no_window_manager,
5331 "Non-nil if no X window manager is in use.\n\
5332 Emacs doesn't try to figure this out; this is always nil\n\
5333 unless you set it to something else.");
5334 /* We don't have any way to find this out, so set it to nil
5335 and maybe the user would like to set it to t. */
5336 Vx_no_window_manager = Qnil;
5338 DEFVAR_LISP ("x-pixel-size-width-font-regexp",
5339 &Vx_pixel_size_width_font_regexp,
5340 "Regexp matching a font name whose width is the same as `PIXEL_SIZE'.\n\
5342 Since Emacs gets width of a font matching with this regexp from\n\
5343 PIXEL_SIZE field of the name, font finding mechanism gets faster for\n\
5344 such a font. This is especially effective for such large fonts as\n\
5345 Chinese, Japanese, and Korean.");
5346 Vx_pixel_size_width_font_regexp = Qnil;
5348 #ifdef USE_X_TOOLKIT
5349 Fprovide (intern ("x-toolkit"));
5350 #endif
5351 #ifdef USE_MOTIF
5352 Fprovide (intern ("motif"));
5353 #endif
5355 defsubr (&Sx_get_resource);
5356 #if 0
5357 defsubr (&Sx_draw_rectangle);
5358 defsubr (&Sx_erase_rectangle);
5359 defsubr (&Sx_contour_region);
5360 defsubr (&Sx_uncontour_region);
5361 #endif
5362 defsubr (&Sx_list_fonts);
5363 defsubr (&Sx_display_color_p);
5364 defsubr (&Sx_display_grayscale_p);
5365 defsubr (&Sx_color_defined_p);
5366 defsubr (&Sx_color_values);
5367 defsubr (&Sx_server_max_request_size);
5368 defsubr (&Sx_server_vendor);
5369 defsubr (&Sx_server_version);
5370 defsubr (&Sx_display_pixel_width);
5371 defsubr (&Sx_display_pixel_height);
5372 defsubr (&Sx_display_mm_width);
5373 defsubr (&Sx_display_mm_height);
5374 defsubr (&Sx_display_screens);
5375 defsubr (&Sx_display_planes);
5376 defsubr (&Sx_display_color_cells);
5377 defsubr (&Sx_display_visual_class);
5378 defsubr (&Sx_display_backing_store);
5379 defsubr (&Sx_display_save_under);
5380 #if 0
5381 defsubr (&Sx_rebind_key);
5382 defsubr (&Sx_rebind_keys);
5383 defsubr (&Sx_track_pointer);
5384 defsubr (&Sx_grab_pointer);
5385 defsubr (&Sx_ungrab_pointer);
5386 #endif
5387 defsubr (&Sx_parse_geometry);
5388 defsubr (&Sx_create_frame);
5389 #if 0
5390 defsubr (&Sx_horizontal_line);
5391 #endif
5392 defsubr (&Sx_open_connection);
5393 defsubr (&Sx_close_connection);
5394 defsubr (&Sx_display_list);
5395 defsubr (&Sx_synchronize);
5397 /* Setting callback functions for fontset handler. */
5398 get_font_info_func = x_get_font_info;
5399 list_fonts_func = x_list_fonts;
5400 load_font_func = x_load_font;
5401 query_font_func = x_query_font;
5402 set_frame_fontset_func = x_set_font;
5403 check_window_system_func = check_x;
5406 #endif /* HAVE_X_WINDOWS */