(display_text_line): Handle the case of point being in
[emacs.git] / src / xfns.c
blob4d624b07097a8f51a8218b2631f234b83af16881
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 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 PARAM (a Lisp symbol).
2377 If no value is specified for PARAM, 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;
3235 f->icon_name
3236 = x_get_arg (dpyinfo, parms, Qicon_name, "iconName", "Title", string);
3237 if (! STRINGP (f->icon_name))
3238 f->icon_name = Qnil;
3240 FRAME_X_DISPLAY_INFO (f) = dpyinfo;
3241 #ifdef MULTI_KBOARD
3242 FRAME_KBOARD (f) = kb;
3243 #endif
3245 /* Specify the parent under which to make this X window. */
3247 if (!NILP (parent))
3249 f->output_data.x->parent_desc = (Window) XFASTINT (parent);
3250 f->output_data.x->explicit_parent = 1;
3252 else
3254 f->output_data.x->parent_desc = FRAME_X_DISPLAY_INFO (f)->root_window;
3255 f->output_data.x->explicit_parent = 0;
3258 /* Note that the frame has no physical cursor right now. */
3259 f->phys_cursor_x = -1;
3261 /* Set the name; the functions to which we pass f expect the name to
3262 be set. */
3263 if (EQ (name, Qunbound) || NILP (name))
3265 f->name = build_string (dpyinfo->x_id_name);
3266 f->explicit_name = 0;
3268 else
3270 f->name = name;
3271 f->explicit_name = 1;
3272 /* use the frame's title when getting resources for this frame. */
3273 specbind (Qx_resource_name, name);
3276 /* Create fontsets from `global_fontset_alist' before handling fonts. */
3277 for (tem = Vglobal_fontset_alist; CONSP (tem); tem = XCONS (tem)->cdr)
3278 fs_register_fontset (f, XCONS (tem)->car);
3280 /* Extract the window parameters from the supplied values
3281 that are needed to determine window geometry. */
3283 Lisp_Object font;
3285 if (! STRINGP (font))
3286 font = x_get_arg (dpyinfo, parms, Qfont, "font", "Font", string);
3287 BLOCK_INPUT;
3288 /* First, try whatever font the caller has specified. */
3289 if (STRINGP (font))
3291 tem = Fquery_fontset (font);
3292 if (STRINGP (tem))
3293 font = x_new_fontset (f, XSTRING (tem)->data);
3294 else
3295 font = x_new_font (f, XSTRING (font)->data);
3297 /* Try out a font which we hope has bold and italic variations. */
3298 if (!STRINGP (font))
3299 font = x_new_font (f, "-misc-fixed-medium-r-normal-*-*-140-*-*-c-*-iso8859-1");
3300 if (! STRINGP (font))
3301 font = x_new_font (f, "-*-*-medium-r-normal-*-*-140-*-*-c-*-iso8859-1");
3302 if (! STRINGP (font))
3303 /* This was formerly the first thing tried, but it finds too many fonts
3304 and takes too long. */
3305 font = x_new_font (f, "-*-*-medium-r-*-*-*-*-*-*-c-*-iso8859-1");
3306 /* If those didn't work, look for something which will at least work. */
3307 if (! STRINGP (font))
3308 font = x_new_font (f, "-*-fixed-*-*-*-*-*-140-*-*-c-*-iso8859-1");
3309 UNBLOCK_INPUT;
3310 if (! STRINGP (font))
3311 font = build_string ("fixed");
3313 x_default_parameter (f, parms, Qfont, font,
3314 "font", "Font", string);
3317 #ifdef USE_LUCID
3318 /* Prevent lwlib/xlwmenu.c from crashing because of a bug
3319 whereby it fails to get any font. */
3320 xlwmenu_default_font = f->output_data.x->font;
3321 #endif
3323 x_default_parameter (f, parms, Qborder_width, make_number (2),
3324 "borderwidth", "BorderWidth", number);
3325 /* This defaults to 2 in order to match xterm. We recognize either
3326 internalBorderWidth or internalBorder (which is what xterm calls
3327 it). */
3328 if (NILP (Fassq (Qinternal_border_width, parms)))
3330 Lisp_Object value;
3332 value = x_get_arg (dpyinfo, parms, Qinternal_border_width,
3333 "internalBorder", "internalBorder", number);
3334 if (! EQ (value, Qunbound))
3335 parms = Fcons (Fcons (Qinternal_border_width, value),
3336 parms);
3338 x_default_parameter (f, parms, Qinternal_border_width, make_number (1),
3339 "internalBorderWidth", "internalBorderWidth", number);
3340 x_default_parameter (f, parms, Qvertical_scroll_bars, Qleft,
3341 "verticalScrollBars", "ScrollBars", boolean);
3343 /* Also do the stuff which must be set before the window exists. */
3344 x_default_parameter (f, parms, Qforeground_color, build_string ("black"),
3345 "foreground", "Foreground", string);
3346 x_default_parameter (f, parms, Qbackground_color, build_string ("white"),
3347 "background", "Background", string);
3348 x_default_parameter (f, parms, Qmouse_color, build_string ("black"),
3349 "pointerColor", "Foreground", string);
3350 x_default_parameter (f, parms, Qcursor_color, build_string ("black"),
3351 "cursorColor", "Foreground", string);
3352 x_default_parameter (f, parms, Qborder_color, build_string ("black"),
3353 "borderColor", "BorderColor", string);
3355 x_default_parameter (f, parms, Qmenu_bar_lines, make_number (1),
3356 "menuBar", "MenuBar", number);
3357 x_default_parameter (f, parms, Qscroll_bar_width, Qnil,
3358 "scrollBarWidth", "ScrollBarWidth", number);
3359 x_default_parameter (f, parms, Qbuffer_predicate, Qnil,
3360 "bufferPredicate", "BufferPredicate", symbol);
3361 x_default_parameter (f, parms, Qtitle, Qnil,
3362 "title", "Title", string);
3364 f->output_data.x->parent_desc = FRAME_X_DISPLAY_INFO (f)->root_window;
3365 window_prompting = x_figure_window_size (f, parms);
3367 if (window_prompting & XNegative)
3369 if (window_prompting & YNegative)
3370 f->output_data.x->win_gravity = SouthEastGravity;
3371 else
3372 f->output_data.x->win_gravity = NorthEastGravity;
3374 else
3376 if (window_prompting & YNegative)
3377 f->output_data.x->win_gravity = SouthWestGravity;
3378 else
3379 f->output_data.x->win_gravity = NorthWestGravity;
3382 f->output_data.x->size_hint_flags = window_prompting;
3384 #ifdef USE_X_TOOLKIT
3385 x_window (f, window_prompting, minibuffer_only);
3386 #else
3387 x_window (f);
3388 #endif
3389 x_icon (f, parms);
3390 x_make_gc (f);
3391 init_frame_faces (f);
3393 /* We need to do this after creating the X window, so that the
3394 icon-creation functions can say whose icon they're describing. */
3395 x_default_parameter (f, parms, Qicon_type, Qnil,
3396 "bitmapIcon", "BitmapIcon", symbol);
3398 x_default_parameter (f, parms, Qauto_raise, Qnil,
3399 "autoRaise", "AutoRaiseLower", boolean);
3400 x_default_parameter (f, parms, Qauto_lower, Qnil,
3401 "autoLower", "AutoRaiseLower", boolean);
3402 x_default_parameter (f, parms, Qcursor_type, Qbox,
3403 "cursorType", "CursorType", symbol);
3405 /* Dimensions, especially f->height, must be done via change_frame_size.
3406 Change will not be effected unless different from the current
3407 f->height. */
3408 width = f->width;
3409 height = f->height;
3410 f->height = 0;
3411 SET_FRAME_WIDTH (f, 0);
3412 change_frame_size (f, height, width, 1, 0);
3414 /* Tell the server what size and position, etc, we want,
3415 and how badly we want them. */
3416 BLOCK_INPUT;
3417 x_wm_set_size_hint (f, window_prompting, 0);
3418 UNBLOCK_INPUT;
3420 tem = x_get_arg (dpyinfo, parms, Qunsplittable, 0, 0, boolean);
3421 f->no_split = minibuffer_only || EQ (tem, Qt);
3423 UNGCPRO;
3425 /* It is now ok to make the frame official
3426 even if we get an error below.
3427 And the frame needs to be on Vframe_list
3428 or making it visible won't work. */
3429 Vframe_list = Fcons (frame, Vframe_list);
3431 /* Now that the frame is official, it counts as a reference to
3432 its display. */
3433 FRAME_X_DISPLAY_INFO (f)->reference_count++;
3435 /* Make the window appear on the frame and enable display,
3436 unless the caller says not to. However, with explicit parent,
3437 Emacs cannot control visibility, so don't try. */
3438 if (! f->output_data.x->explicit_parent)
3440 Lisp_Object visibility;
3442 visibility = x_get_arg (dpyinfo, parms, Qvisibility, 0, 0, symbol);
3443 if (EQ (visibility, Qunbound))
3444 visibility = Qt;
3446 if (EQ (visibility, Qicon))
3447 x_iconify_frame (f);
3448 else if (! NILP (visibility))
3449 x_make_frame_visible (f);
3450 else
3451 /* Must have been Qnil. */
3455 return unbind_to (count, frame);
3458 /* FRAME is used only to get a handle on the X display. We don't pass the
3459 display info directly because we're called from frame.c, which doesn't
3460 know about that structure. */
3462 Lisp_Object
3463 x_get_focus_frame (frame)
3464 struct frame *frame;
3466 struct x_display_info *dpyinfo = FRAME_X_DISPLAY_INFO (frame);
3467 Lisp_Object xfocus;
3468 if (! dpyinfo->x_focus_frame)
3469 return Qnil;
3471 XSETFRAME (xfocus, dpyinfo->x_focus_frame);
3472 return xfocus;
3475 #if 1
3476 #include "x-list-font.c"
3477 #else
3478 DEFUN ("x-list-fonts", Fx_list_fonts, Sx_list_fonts, 1, 4, 0,
3479 "Return a list of the names of available fonts matching PATTERN.\n\
3480 If optional arguments FACE and FRAME are specified, return only fonts\n\
3481 the same size as FACE on FRAME.\n\
3483 PATTERN is a string, perhaps with wildcard characters;\n\
3484 the * character matches any substring, and\n\
3485 the ? character matches any single character.\n\
3486 PATTERN is case-insensitive.\n\
3487 FACE is a face name--a symbol.\n\
3489 The return value is a list of strings, suitable as arguments to\n\
3490 set-face-font.\n\
3492 Fonts Emacs can't use (i.e. proportional fonts) may or may not be excluded\n\
3493 even if they match PATTERN and FACE.\n\
3495 The optional fourth argument MAXIMUM sets a limit on how many\n\
3496 fonts to match. The first MAXIMUM fonts are reported.")
3497 (pattern, face, frame, maximum)
3498 Lisp_Object pattern, face, frame, maximum;
3500 int num_fonts;
3501 char **names;
3502 #ifndef BROKEN_XLISTFONTSWITHINFO
3503 XFontStruct *info;
3504 #endif
3505 XFontStruct *size_ref;
3506 Lisp_Object list;
3507 FRAME_PTR f;
3508 Lisp_Object key;
3509 int maxnames;
3510 int count;
3512 check_x ();
3513 CHECK_STRING (pattern, 0);
3514 if (!NILP (face))
3515 CHECK_SYMBOL (face, 1);
3517 if (NILP (maximum))
3518 maxnames = 2000;
3519 else
3521 CHECK_NATNUM (maximum, 0);
3522 maxnames = XINT (maximum);
3525 f = check_x_frame (frame);
3527 /* Determine the width standard for comparison with the fonts we find. */
3529 if (NILP (face))
3530 size_ref = 0;
3531 else
3533 int face_id;
3535 /* Don't die if we get called with a terminal frame. */
3536 if (! FRAME_X_P (f))
3537 error ("Non-X frame used in `x-list-fonts'");
3539 face_id = face_name_id_number (f, face);
3541 if (face_id < 0 || face_id >= FRAME_N_PARAM_FACES (f)
3542 || FRAME_PARAM_FACES (f) [face_id] == 0)
3543 size_ref = f->output_data.x->font;
3544 else
3546 size_ref = FRAME_PARAM_FACES (f) [face_id]->font;
3547 if (size_ref == (XFontStruct *) (~0))
3548 size_ref = f->output_data.x->font;
3552 /* See if we cached the result for this particular query. */
3553 key = Fcons (pattern, maximum);
3554 list = Fassoc (key,
3555 XCONS (FRAME_X_DISPLAY_INFO (f)->name_list_element)->cdr);
3557 /* We have info in the cache for this PATTERN. */
3558 if (!NILP (list))
3560 Lisp_Object tem, newlist;
3562 /* We have info about this pattern. */
3563 list = XCONS (list)->cdr;
3565 if (size_ref == 0)
3566 return list;
3568 BLOCK_INPUT;
3570 /* Filter the cached info and return just the fonts that match FACE. */
3571 newlist = Qnil;
3572 for (tem = list; CONSP (tem); tem = XCONS (tem)->cdr)
3574 XFontStruct *thisinfo;
3576 count = x_catch_errors (FRAME_X_DISPLAY (f));
3578 thisinfo = XLoadQueryFont (FRAME_X_DISPLAY (f),
3579 XSTRING (XCONS (tem)->car)->data);
3581 x_check_errors (FRAME_X_DISPLAY (f), "XLoadQueryFont failure: %s");
3582 x_uncatch_errors (FRAME_X_DISPLAY (f), count);
3584 if (thisinfo && same_size_fonts (thisinfo, size_ref))
3585 newlist = Fcons (XCONS (tem)->car, newlist);
3587 if (thisinfo != 0)
3588 XFreeFont (FRAME_X_DISPLAY (f), thisinfo);
3591 UNBLOCK_INPUT;
3593 return newlist;
3596 BLOCK_INPUT;
3598 count = x_catch_errors (FRAME_X_DISPLAY (f));
3600 /* Solaris 2.3 has a bug in XListFontsWithInfo. */
3601 #ifndef BROKEN_XLISTFONTSWITHINFO
3602 if (size_ref)
3603 names = XListFontsWithInfo (FRAME_X_DISPLAY (f),
3604 XSTRING (pattern)->data,
3605 maxnames,
3606 &num_fonts, /* count_return */
3607 &info); /* info_return */
3608 else
3609 #endif
3610 names = XListFonts (FRAME_X_DISPLAY (f),
3611 XSTRING (pattern)->data,
3612 maxnames,
3613 &num_fonts); /* count_return */
3615 x_check_errors (FRAME_X_DISPLAY (f), "XListFonts failure: %s");
3616 x_uncatch_errors (FRAME_X_DISPLAY (f), count);
3618 UNBLOCK_INPUT;
3620 list = Qnil;
3622 if (names)
3624 int i;
3625 Lisp_Object full_list;
3627 /* Make a list of all the fonts we got back.
3628 Store that in the font cache for the display. */
3629 full_list = Qnil;
3630 for (i = 0; i < num_fonts; i++)
3631 full_list = Fcons (build_string (names[i]), full_list);
3632 XCONS (FRAME_X_DISPLAY_INFO (f)->name_list_element)->cdr
3633 = Fcons (Fcons (key, full_list),
3634 XCONS (FRAME_X_DISPLAY_INFO (f)->name_list_element)->cdr);
3636 /* Make a list of the fonts that have the right width. */
3637 list = Qnil;
3638 for (i = 0; i < num_fonts; i++)
3640 int keeper;
3642 if (!size_ref)
3643 keeper = 1;
3644 else
3646 #ifdef BROKEN_XLISTFONTSWITHINFO
3647 XFontStruct *thisinfo;
3649 BLOCK_INPUT;
3651 count = x_catch_errors (FRAME_X_DISPLAY (f));
3652 thisinfo = XLoadQueryFont (FRAME_X_DISPLAY (f), names[i]);
3653 x_check_errors (FRAME_X_DISPLAY (f),
3654 "XLoadQueryFont failure: %s");
3655 x_uncatch_errors (FRAME_X_DISPLAY (f), count);
3657 UNBLOCK_INPUT;
3659 keeper = thisinfo && same_size_fonts (thisinfo, size_ref);
3660 BLOCK_INPUT;
3661 if (thisinfo && ! keeper)
3662 XFreeFont (FRAME_X_DISPLAY (f), thisinfo);
3663 else if (thisinfo)
3664 XFreeFontInfo (NULL, thisinfo, 1);
3665 UNBLOCK_INPUT;
3666 #else
3667 keeper = same_size_fonts (&info[i], size_ref);
3668 #endif
3670 if (keeper)
3671 list = Fcons (build_string (names[i]), list);
3673 list = Fnreverse (list);
3675 BLOCK_INPUT;
3676 #ifndef BROKEN_XLISTFONTSWITHINFO
3677 if (size_ref)
3678 XFreeFontInfo (names, info, num_fonts);
3679 else
3680 #endif
3681 XFreeFontNames (names);
3682 UNBLOCK_INPUT;
3685 return list;
3687 #endif
3690 DEFUN ("x-color-defined-p", Fx_color_defined_p, Sx_color_defined_p, 1, 2, 0,
3691 "Return non-nil if color COLOR is supported on frame FRAME.\n\
3692 If FRAME is omitted or nil, use the selected frame.")
3693 (color, frame)
3694 Lisp_Object color, frame;
3696 XColor foo;
3697 FRAME_PTR f = check_x_frame (frame);
3699 CHECK_STRING (color, 1);
3701 if (defined_color (f, XSTRING (color)->data, &foo, 0))
3702 return Qt;
3703 else
3704 return Qnil;
3707 DEFUN ("x-color-values", Fx_color_values, Sx_color_values, 1, 2, 0,
3708 "Return a description of the color named COLOR on frame FRAME.\n\
3709 The value is a list of integer RGB values--(RED GREEN BLUE).\n\
3710 These values appear to range from 0 to 65280 or 65535, depending\n\
3711 on the system; white is (65280 65280 65280) or (65535 65535 65535).\n\
3712 If FRAME is omitted or nil, use the selected frame.")
3713 (color, frame)
3714 Lisp_Object color, frame;
3716 XColor foo;
3717 FRAME_PTR f = check_x_frame (frame);
3719 CHECK_STRING (color, 1);
3721 if (defined_color (f, XSTRING (color)->data, &foo, 0))
3723 Lisp_Object rgb[3];
3725 rgb[0] = make_number (foo.red);
3726 rgb[1] = make_number (foo.green);
3727 rgb[2] = make_number (foo.blue);
3728 return Flist (3, rgb);
3730 else
3731 return Qnil;
3734 DEFUN ("x-display-color-p", Fx_display_color_p, Sx_display_color_p, 0, 1, 0,
3735 "Return t if the X display supports color.\n\
3736 The optional argument DISPLAY specifies which display to ask about.\n\
3737 DISPLAY should be either a frame or a display name (a string).\n\
3738 If omitted or nil, that stands for the selected frame's display.")
3739 (display)
3740 Lisp_Object display;
3742 struct x_display_info *dpyinfo = check_x_display_info (display);
3744 if (dpyinfo->n_planes <= 2)
3745 return Qnil;
3747 switch (dpyinfo->visual->class)
3749 case StaticColor:
3750 case PseudoColor:
3751 case TrueColor:
3752 case DirectColor:
3753 return Qt;
3755 default:
3756 return Qnil;
3760 DEFUN ("x-display-grayscale-p", Fx_display_grayscale_p, Sx_display_grayscale_p,
3761 0, 1, 0,
3762 "Return t if the X display supports shades of gray.\n\
3763 Note that color displays do support shades of gray.\n\
3764 The optional argument DISPLAY specifies which display to ask about.\n\
3765 DISPLAY should be either a frame or a display name (a string).\n\
3766 If omitted or nil, that stands for the selected frame's display.")
3767 (display)
3768 Lisp_Object display;
3770 struct x_display_info *dpyinfo = check_x_display_info (display);
3772 if (dpyinfo->n_planes <= 1)
3773 return Qnil;
3775 switch (dpyinfo->visual->class)
3777 case StaticColor:
3778 case PseudoColor:
3779 case TrueColor:
3780 case DirectColor:
3781 case StaticGray:
3782 case GrayScale:
3783 return Qt;
3785 default:
3786 return Qnil;
3790 DEFUN ("x-display-pixel-width", Fx_display_pixel_width, Sx_display_pixel_width,
3791 0, 1, 0,
3792 "Returns the width in pixels of the X display DISPLAY.\n\
3793 The optional argument DISPLAY specifies which display to ask about.\n\
3794 DISPLAY should be either a frame or a display name (a string).\n\
3795 If omitted or nil, that stands for the selected frame's display.")
3796 (display)
3797 Lisp_Object display;
3799 struct x_display_info *dpyinfo = check_x_display_info (display);
3801 return make_number (dpyinfo->width);
3804 DEFUN ("x-display-pixel-height", Fx_display_pixel_height,
3805 Sx_display_pixel_height, 0, 1, 0,
3806 "Returns the height in pixels of the X display DISPLAY.\n\
3807 The optional argument DISPLAY specifies which display to ask about.\n\
3808 DISPLAY should be either a frame or a display name (a string).\n\
3809 If omitted or nil, that stands for the selected frame's display.")
3810 (display)
3811 Lisp_Object display;
3813 struct x_display_info *dpyinfo = check_x_display_info (display);
3815 return make_number (dpyinfo->height);
3818 DEFUN ("x-display-planes", Fx_display_planes, Sx_display_planes,
3819 0, 1, 0,
3820 "Returns the number of bitplanes of the X display DISPLAY.\n\
3821 The optional argument DISPLAY specifies which display to ask about.\n\
3822 DISPLAY should be either a frame or a display name (a string).\n\
3823 If omitted or nil, that stands for the selected frame's display.")
3824 (display)
3825 Lisp_Object display;
3827 struct x_display_info *dpyinfo = check_x_display_info (display);
3829 return make_number (dpyinfo->n_planes);
3832 DEFUN ("x-display-color-cells", Fx_display_color_cells, Sx_display_color_cells,
3833 0, 1, 0,
3834 "Returns the number of color cells of the X display DISPLAY.\n\
3835 The optional argument DISPLAY specifies which display to ask about.\n\
3836 DISPLAY should be either a frame or a display name (a string).\n\
3837 If omitted or nil, that stands for the selected frame's display.")
3838 (display)
3839 Lisp_Object display;
3841 struct x_display_info *dpyinfo = check_x_display_info (display);
3843 return make_number (DisplayCells (dpyinfo->display,
3844 XScreenNumberOfScreen (dpyinfo->screen)));
3847 DEFUN ("x-server-max-request-size", Fx_server_max_request_size,
3848 Sx_server_max_request_size,
3849 0, 1, 0,
3850 "Returns the maximum request size of the X server of display DISPLAY.\n\
3851 The optional argument DISPLAY specifies which display to ask about.\n\
3852 DISPLAY should be either a frame or a display name (a string).\n\
3853 If omitted or nil, that stands for the selected frame's display.")
3854 (display)
3855 Lisp_Object display;
3857 struct x_display_info *dpyinfo = check_x_display_info (display);
3859 return make_number (MAXREQUEST (dpyinfo->display));
3862 DEFUN ("x-server-vendor", Fx_server_vendor, Sx_server_vendor, 0, 1, 0,
3863 "Returns the vendor ID string of the X server of display DISPLAY.\n\
3864 The optional argument DISPLAY specifies which display to ask about.\n\
3865 DISPLAY should be either a frame or a display name (a string).\n\
3866 If omitted or nil, that stands for the selected frame's display.")
3867 (display)
3868 Lisp_Object display;
3870 struct x_display_info *dpyinfo = check_x_display_info (display);
3871 char *vendor = ServerVendor (dpyinfo->display);
3873 if (! vendor) vendor = "";
3874 return build_string (vendor);
3877 DEFUN ("x-server-version", Fx_server_version, Sx_server_version, 0, 1, 0,
3878 "Returns the version numbers of the X server of display DISPLAY.\n\
3879 The value is a list of three integers: the major and minor\n\
3880 version numbers of the X Protocol in use, and the vendor-specific release\n\
3881 number. See also the function `x-server-vendor'.\n\n\
3882 The optional argument DISPLAY specifies which display to ask about.\n\
3883 DISPLAY should be either a frame or a display name (a string).\n\
3884 If omitted or nil, that stands for the selected frame's display.")
3885 (display)
3886 Lisp_Object display;
3888 struct x_display_info *dpyinfo = check_x_display_info (display);
3889 Display *dpy = dpyinfo->display;
3891 return Fcons (make_number (ProtocolVersion (dpy)),
3892 Fcons (make_number (ProtocolRevision (dpy)),
3893 Fcons (make_number (VendorRelease (dpy)), Qnil)));
3896 DEFUN ("x-display-screens", Fx_display_screens, Sx_display_screens, 0, 1, 0,
3897 "Returns the number of screens on the X server of display DISPLAY.\n\
3898 The optional argument DISPLAY specifies which display to ask about.\n\
3899 DISPLAY should be either a frame or a display name (a string).\n\
3900 If omitted or nil, that stands for the selected frame's display.")
3901 (display)
3902 Lisp_Object display;
3904 struct x_display_info *dpyinfo = check_x_display_info (display);
3906 return make_number (ScreenCount (dpyinfo->display));
3909 DEFUN ("x-display-mm-height", Fx_display_mm_height, Sx_display_mm_height, 0, 1, 0,
3910 "Returns the height in millimeters of the X display DISPLAY.\n\
3911 The optional argument DISPLAY specifies which display to ask about.\n\
3912 DISPLAY should be either a frame or a display name (a string).\n\
3913 If omitted or nil, that stands for the selected frame's display.")
3914 (display)
3915 Lisp_Object display;
3917 struct x_display_info *dpyinfo = check_x_display_info (display);
3919 return make_number (HeightMMOfScreen (dpyinfo->screen));
3922 DEFUN ("x-display-mm-width", Fx_display_mm_width, Sx_display_mm_width, 0, 1, 0,
3923 "Returns the width in millimeters of the X display DISPLAY.\n\
3924 The optional argument DISPLAY specifies which display to ask about.\n\
3925 DISPLAY should be either a frame or a display name (a string).\n\
3926 If omitted or nil, that stands for the selected frame's display.")
3927 (display)
3928 Lisp_Object display;
3930 struct x_display_info *dpyinfo = check_x_display_info (display);
3932 return make_number (WidthMMOfScreen (dpyinfo->screen));
3935 DEFUN ("x-display-backing-store", Fx_display_backing_store,
3936 Sx_display_backing_store, 0, 1, 0,
3937 "Returns an indication of whether X display DISPLAY does backing store.\n\
3938 The value may be `always', `when-mapped', or `not-useful'.\n\
3939 The optional argument DISPLAY specifies which display to ask about.\n\
3940 DISPLAY should be either a frame or a display name (a string).\n\
3941 If omitted or nil, that stands for the selected frame's display.")
3942 (display)
3943 Lisp_Object display;
3945 struct x_display_info *dpyinfo = check_x_display_info (display);
3947 switch (DoesBackingStore (dpyinfo->screen))
3949 case Always:
3950 return intern ("always");
3952 case WhenMapped:
3953 return intern ("when-mapped");
3955 case NotUseful:
3956 return intern ("not-useful");
3958 default:
3959 error ("Strange value for BackingStore parameter of screen");
3963 DEFUN ("x-display-visual-class", Fx_display_visual_class,
3964 Sx_display_visual_class, 0, 1, 0,
3965 "Returns the visual class of the X display DISPLAY.\n\
3966 The value is one of the symbols `static-gray', `gray-scale',\n\
3967 `static-color', `pseudo-color', `true-color', or `direct-color'.\n\n\
3968 The optional argument DISPLAY specifies which display to ask about.\n\
3969 DISPLAY should be either a frame or a display name (a string).\n\
3970 If omitted or nil, that stands for the selected frame's display.")
3971 (display)
3972 Lisp_Object display;
3974 struct x_display_info *dpyinfo = check_x_display_info (display);
3976 switch (dpyinfo->visual->class)
3978 case StaticGray: return (intern ("static-gray"));
3979 case GrayScale: return (intern ("gray-scale"));
3980 case StaticColor: return (intern ("static-color"));
3981 case PseudoColor: return (intern ("pseudo-color"));
3982 case TrueColor: return (intern ("true-color"));
3983 case DirectColor: return (intern ("direct-color"));
3984 default:
3985 error ("Display has an unknown visual class");
3989 DEFUN ("x-display-save-under", Fx_display_save_under,
3990 Sx_display_save_under, 0, 1, 0,
3991 "Returns t if the X display DISPLAY supports the save-under feature.\n\
3992 The optional argument DISPLAY specifies which display to ask about.\n\
3993 DISPLAY should be either a frame or a display name (a string).\n\
3994 If omitted or nil, that stands for the selected frame's display.")
3995 (display)
3996 Lisp_Object display;
3998 struct x_display_info *dpyinfo = check_x_display_info (display);
4000 if (DoesSaveUnders (dpyinfo->screen) == True)
4001 return Qt;
4002 else
4003 return Qnil;
4007 x_pixel_width (f)
4008 register struct frame *f;
4010 return PIXEL_WIDTH (f);
4014 x_pixel_height (f)
4015 register struct frame *f;
4017 return PIXEL_HEIGHT (f);
4021 x_char_width (f)
4022 register struct frame *f;
4024 return FONT_WIDTH (f->output_data.x->font);
4028 x_char_height (f)
4029 register struct frame *f;
4031 return f->output_data.x->line_height;
4035 x_screen_planes (frame)
4036 Lisp_Object frame;
4038 return FRAME_X_DISPLAY_INFO (XFRAME (frame))->n_planes;
4041 #if 0 /* These no longer seem like the right way to do things. */
4043 /* Draw a rectangle on the frame with left top corner including
4044 the character specified by LEFT_CHAR and TOP_CHAR. The rectangle is
4045 CHARS by LINES wide and long and is the color of the cursor. */
4047 void
4048 x_rectangle (f, gc, left_char, top_char, chars, lines)
4049 register struct frame *f;
4050 GC gc;
4051 register int top_char, left_char, chars, lines;
4053 int width;
4054 int height;
4055 int left = (left_char * FONT_WIDTH (f->output_data.x->font)
4056 + f->output_data.x->internal_border_width);
4057 int top = (top_char * f->output_data.x->line_height
4058 + f->output_data.x->internal_border_width);
4060 if (chars < 0)
4061 width = FONT_WIDTH (f->output_data.x->font) / 2;
4062 else
4063 width = FONT_WIDTH (f->output_data.x->font) * chars;
4064 if (lines < 0)
4065 height = f->output_data.x->line_height / 2;
4066 else
4067 height = f->output_data.x->line_height * lines;
4069 XDrawRectangle (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
4070 gc, left, top, width, height);
4073 DEFUN ("x-draw-rectangle", Fx_draw_rectangle, Sx_draw_rectangle, 5, 5, 0,
4074 "Draw a rectangle on FRAME between coordinates specified by\n\
4075 numbers X0, Y0, X1, Y1 in the cursor pixel.")
4076 (frame, X0, Y0, X1, Y1)
4077 register Lisp_Object frame, X0, X1, Y0, Y1;
4079 register int x0, y0, x1, y1, top, left, n_chars, n_lines;
4081 CHECK_LIVE_FRAME (frame, 0);
4082 CHECK_NUMBER (X0, 0);
4083 CHECK_NUMBER (Y0, 1);
4084 CHECK_NUMBER (X1, 2);
4085 CHECK_NUMBER (Y1, 3);
4087 x0 = XINT (X0);
4088 x1 = XINT (X1);
4089 y0 = XINT (Y0);
4090 y1 = XINT (Y1);
4092 if (y1 > y0)
4094 top = y0;
4095 n_lines = y1 - y0 + 1;
4097 else
4099 top = y1;
4100 n_lines = y0 - y1 + 1;
4103 if (x1 > x0)
4105 left = x0;
4106 n_chars = x1 - x0 + 1;
4108 else
4110 left = x1;
4111 n_chars = x0 - x1 + 1;
4114 BLOCK_INPUT;
4115 x_rectangle (XFRAME (frame), XFRAME (frame)->output_data.x->cursor_gc,
4116 left, top, n_chars, n_lines);
4117 UNBLOCK_INPUT;
4119 return Qt;
4122 DEFUN ("x-erase-rectangle", Fx_erase_rectangle, Sx_erase_rectangle, 5, 5, 0,
4123 "Draw a rectangle drawn on FRAME between coordinates\n\
4124 X0, Y0, X1, Y1 in the regular background-pixel.")
4125 (frame, X0, Y0, X1, Y1)
4126 register Lisp_Object frame, X0, Y0, X1, Y1;
4128 register int x0, y0, x1, y1, top, left, n_chars, n_lines;
4130 CHECK_LIVE_FRAME (frame, 0);
4131 CHECK_NUMBER (X0, 0);
4132 CHECK_NUMBER (Y0, 1);
4133 CHECK_NUMBER (X1, 2);
4134 CHECK_NUMBER (Y1, 3);
4136 x0 = XINT (X0);
4137 x1 = XINT (X1);
4138 y0 = XINT (Y0);
4139 y1 = XINT (Y1);
4141 if (y1 > y0)
4143 top = y0;
4144 n_lines = y1 - y0 + 1;
4146 else
4148 top = y1;
4149 n_lines = y0 - y1 + 1;
4152 if (x1 > x0)
4154 left = x0;
4155 n_chars = x1 - x0 + 1;
4157 else
4159 left = x1;
4160 n_chars = x0 - x1 + 1;
4163 BLOCK_INPUT;
4164 x_rectangle (XFRAME (frame), XFRAME (frame)->output_data.x->reverse_gc,
4165 left, top, n_chars, n_lines);
4166 UNBLOCK_INPUT;
4168 return Qt;
4171 /* Draw lines around the text region beginning at the character position
4172 TOP_X, TOP_Y and ending at BOTTOM_X and BOTTOM_Y. GC specifies the
4173 pixel and line characteristics. */
4175 #define line_len(line) (FRAME_CURRENT_GLYPHS (f)->used[(line)])
4177 static void
4178 outline_region (f, gc, top_x, top_y, bottom_x, bottom_y)
4179 register struct frame *f;
4180 GC gc;
4181 int top_x, top_y, bottom_x, bottom_y;
4183 register int ibw = f->output_data.x->internal_border_width;
4184 register int font_w = FONT_WIDTH (f->output_data.x->font);
4185 register int font_h = f->output_data.x->line_height;
4186 int y = top_y;
4187 int x = line_len (y);
4188 XPoint *pixel_points
4189 = (XPoint *) alloca (((bottom_y - top_y + 2) * 4) * sizeof (XPoint));
4190 register XPoint *this_point = pixel_points;
4192 /* Do the horizontal top line/lines */
4193 if (top_x == 0)
4195 this_point->x = ibw;
4196 this_point->y = ibw + (font_h * top_y);
4197 this_point++;
4198 if (x == 0)
4199 this_point->x = ibw + (font_w / 2); /* Half-size for newline chars. */
4200 else
4201 this_point->x = ibw + (font_w * x);
4202 this_point->y = (this_point - 1)->y;
4204 else
4206 this_point->x = ibw;
4207 this_point->y = ibw + (font_h * (top_y + 1));
4208 this_point++;
4209 this_point->x = ibw + (font_w * top_x);
4210 this_point->y = (this_point - 1)->y;
4211 this_point++;
4212 this_point->x = (this_point - 1)->x;
4213 this_point->y = ibw + (font_h * top_y);
4214 this_point++;
4215 this_point->x = ibw + (font_w * x);
4216 this_point->y = (this_point - 1)->y;
4219 /* Now do the right side. */
4220 while (y < bottom_y)
4221 { /* Right vertical edge */
4222 this_point++;
4223 this_point->x = (this_point - 1)->x;
4224 this_point->y = ibw + (font_h * (y + 1));
4225 this_point++;
4227 y++; /* Horizontal connection to next line */
4228 x = line_len (y);
4229 if (x == 0)
4230 this_point->x = ibw + (font_w / 2);
4231 else
4232 this_point->x = ibw + (font_w * x);
4234 this_point->y = (this_point - 1)->y;
4237 /* Now do the bottom and connect to the top left point. */
4238 this_point->x = ibw + (font_w * (bottom_x + 1));
4240 this_point++;
4241 this_point->x = (this_point - 1)->x;
4242 this_point->y = ibw + (font_h * (bottom_y + 1));
4243 this_point++;
4244 this_point->x = ibw;
4245 this_point->y = (this_point - 1)->y;
4246 this_point++;
4247 this_point->x = pixel_points->x;
4248 this_point->y = pixel_points->y;
4250 XDrawLines (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
4251 gc, pixel_points,
4252 (this_point - pixel_points + 1), CoordModeOrigin);
4255 DEFUN ("x-contour-region", Fx_contour_region, Sx_contour_region, 1, 1, 0,
4256 "Highlight the region between point and the character under the mouse\n\
4257 selected frame.")
4258 (event)
4259 register Lisp_Object event;
4261 register int x0, y0, x1, y1;
4262 register struct frame *f = selected_frame;
4263 register int p1, p2;
4265 CHECK_CONS (event, 0);
4267 BLOCK_INPUT;
4268 x0 = XINT (Fcar (Fcar (event)));
4269 y0 = XINT (Fcar (Fcdr (Fcar (event))));
4271 /* If the mouse is past the end of the line, don't that area. */
4272 /* ReWrite this... */
4274 x1 = f->cursor_x;
4275 y1 = f->cursor_y;
4277 if (y1 > y0) /* point below mouse */
4278 outline_region (f, f->output_data.x->cursor_gc,
4279 x0, y0, x1, y1);
4280 else if (y1 < y0) /* point above mouse */
4281 outline_region (f, f->output_data.x->cursor_gc,
4282 x1, y1, x0, y0);
4283 else /* same line: draw horizontal rectangle */
4285 if (x1 > x0)
4286 x_rectangle (f, f->output_data.x->cursor_gc,
4287 x0, y0, (x1 - x0 + 1), 1);
4288 else if (x1 < x0)
4289 x_rectangle (f, f->output_data.x->cursor_gc,
4290 x1, y1, (x0 - x1 + 1), 1);
4293 XFlush (FRAME_X_DISPLAY (f));
4294 UNBLOCK_INPUT;
4296 return Qnil;
4299 DEFUN ("x-uncontour-region", Fx_uncontour_region, Sx_uncontour_region, 1, 1, 0,
4300 "Erase any highlighting of the region between point and the character\n\
4301 at X, Y on the selected frame.")
4302 (event)
4303 register Lisp_Object event;
4305 register int x0, y0, x1, y1;
4306 register struct frame *f = selected_frame;
4308 BLOCK_INPUT;
4309 x0 = XINT (Fcar (Fcar (event)));
4310 y0 = XINT (Fcar (Fcdr (Fcar (event))));
4311 x1 = f->cursor_x;
4312 y1 = f->cursor_y;
4314 if (y1 > y0) /* point below mouse */
4315 outline_region (f, f->output_data.x->reverse_gc,
4316 x0, y0, x1, y1);
4317 else if (y1 < y0) /* point above mouse */
4318 outline_region (f, f->output_data.x->reverse_gc,
4319 x1, y1, x0, y0);
4320 else /* same line: draw horizontal rectangle */
4322 if (x1 > x0)
4323 x_rectangle (f, f->output_data.x->reverse_gc,
4324 x0, y0, (x1 - x0 + 1), 1);
4325 else if (x1 < x0)
4326 x_rectangle (f, f->output_data.x->reverse_gc,
4327 x1, y1, (x0 - x1 + 1), 1);
4329 UNBLOCK_INPUT;
4331 return Qnil;
4334 #if 0
4335 int contour_begin_x, contour_begin_y;
4336 int contour_end_x, contour_end_y;
4337 int contour_npoints;
4339 /* Clip the top part of the contour lines down (and including) line Y_POS.
4340 If X_POS is in the middle (rather than at the end) of the line, drop
4341 down a line at that character. */
4343 static void
4344 clip_contour_top (y_pos, x_pos)
4346 register XPoint *begin = contour_lines[y_pos].top_left;
4347 register XPoint *end;
4348 register int npoints;
4349 register struct display_line *line = selected_frame->phys_lines[y_pos + 1];
4351 if (x_pos >= line->len - 1) /* Draw one, straight horizontal line. */
4353 end = contour_lines[y_pos].top_right;
4354 npoints = (end - begin + 1);
4355 XDrawLines (x_current_display, contour_window,
4356 contour_erase_gc, begin_erase, npoints, CoordModeOrigin);
4358 bcopy (end, begin + 1, contour_last_point - end + 1);
4359 contour_last_point -= (npoints - 2);
4360 XDrawLines (x_current_display, contour_window,
4361 contour_erase_gc, begin, 2, CoordModeOrigin);
4362 XFlush (x_current_display);
4364 /* Now, update contour_lines structure. */
4366 /* ______. */
4367 else /* |________*/
4369 register XPoint *p = begin + 1;
4370 end = contour_lines[y_pos].bottom_right;
4371 npoints = (end - begin + 1);
4372 XDrawLines (x_current_display, contour_window,
4373 contour_erase_gc, begin_erase, npoints, CoordModeOrigin);
4375 p->y = begin->y;
4376 p->x = ibw + (font_w * (x_pos + 1));
4377 p++;
4378 p->y = begin->y + font_h;
4379 p->x = (p - 1)->x;
4380 bcopy (end, begin + 3, contour_last_point - end + 1);
4381 contour_last_point -= (npoints - 5);
4382 XDrawLines (x_current_display, contour_window,
4383 contour_erase_gc, begin, 4, CoordModeOrigin);
4384 XFlush (x_current_display);
4386 /* Now, update contour_lines structure. */
4390 /* Erase the top horizontal lines of the contour, and then extend
4391 the contour upwards. */
4393 static void
4394 extend_contour_top (line)
4398 static void
4399 clip_contour_bottom (x_pos, y_pos)
4400 int x_pos, y_pos;
4404 static void
4405 extend_contour_bottom (x_pos, y_pos)
4409 DEFUN ("x-select-region", Fx_select_region, Sx_select_region, 1, 1, "e",
4411 (event)
4412 Lisp_Object event;
4414 register struct frame *f = selected_frame;
4415 register int point_x = f->cursor_x;
4416 register int point_y = f->cursor_y;
4417 register int mouse_below_point;
4418 register Lisp_Object obj;
4419 register int x_contour_x, x_contour_y;
4421 x_contour_x = x_mouse_x;
4422 x_contour_y = x_mouse_y;
4423 if (x_contour_y > point_y || (x_contour_y == point_y
4424 && x_contour_x > point_x))
4426 mouse_below_point = 1;
4427 outline_region (f, f->output_data.x->cursor_gc, point_x, point_y,
4428 x_contour_x, x_contour_y);
4430 else
4432 mouse_below_point = 0;
4433 outline_region (f, f->output_data.x->cursor_gc, x_contour_x, x_contour_y,
4434 point_x, point_y);
4437 while (1)
4439 obj = read_char (-1, 0, 0, Qnil, 0);
4440 if (!CONSP (obj))
4441 break;
4443 if (mouse_below_point)
4445 if (x_mouse_y <= point_y) /* Flipped. */
4447 mouse_below_point = 0;
4449 outline_region (f, f->output_data.x->reverse_gc, point_x, point_y,
4450 x_contour_x, x_contour_y);
4451 outline_region (f, f->output_data.x->cursor_gc, x_mouse_x, x_mouse_y,
4452 point_x, point_y);
4454 else if (x_mouse_y < x_contour_y) /* Bottom clipped. */
4456 clip_contour_bottom (x_mouse_y);
4458 else if (x_mouse_y > x_contour_y) /* Bottom extended. */
4460 extend_bottom_contour (x_mouse_y);
4463 x_contour_x = x_mouse_x;
4464 x_contour_y = x_mouse_y;
4466 else /* mouse above or same line as point */
4468 if (x_mouse_y >= point_y) /* Flipped. */
4470 mouse_below_point = 1;
4472 outline_region (f, f->output_data.x->reverse_gc,
4473 x_contour_x, x_contour_y, point_x, point_y);
4474 outline_region (f, f->output_data.x->cursor_gc, point_x, point_y,
4475 x_mouse_x, x_mouse_y);
4477 else if (x_mouse_y > x_contour_y) /* Top clipped. */
4479 clip_contour_top (x_mouse_y);
4481 else if (x_mouse_y < x_contour_y) /* Top extended. */
4483 extend_contour_top (x_mouse_y);
4488 unread_command_event = obj;
4489 if (mouse_below_point)
4491 contour_begin_x = point_x;
4492 contour_begin_y = point_y;
4493 contour_end_x = x_contour_x;
4494 contour_end_y = x_contour_y;
4496 else
4498 contour_begin_x = x_contour_x;
4499 contour_begin_y = x_contour_y;
4500 contour_end_x = point_x;
4501 contour_end_y = point_y;
4504 #endif
4506 DEFUN ("x-horizontal-line", Fx_horizontal_line, Sx_horizontal_line, 1, 1, "e",
4508 (event)
4509 Lisp_Object event;
4511 register Lisp_Object obj;
4512 struct frame *f = selected_frame;
4513 register struct window *w = XWINDOW (selected_window);
4514 register GC line_gc = f->output_data.x->cursor_gc;
4515 register GC erase_gc = f->output_data.x->reverse_gc;
4516 #if 0
4517 char dash_list[] = {6, 4, 6, 4};
4518 int dashes = 4;
4519 XGCValues gc_values;
4520 #endif
4521 register int previous_y;
4522 register int line = (x_mouse_y + 1) * f->output_data.x->line_height
4523 + f->output_data.x->internal_border_width;
4524 register int left = f->output_data.x->internal_border_width
4525 + (WINDOW_LEFT_MARGIN (w)
4526 * FONT_WIDTH (f->output_data.x->font));
4527 register int right = left + (w->width
4528 * FONT_WIDTH (f->output_data.x->font))
4529 - f->output_data.x->internal_border_width;
4531 #if 0
4532 BLOCK_INPUT;
4533 gc_values.foreground = f->output_data.x->cursor_pixel;
4534 gc_values.background = f->output_data.x->background_pixel;
4535 gc_values.line_width = 1;
4536 gc_values.line_style = LineOnOffDash;
4537 gc_values.cap_style = CapRound;
4538 gc_values.join_style = JoinRound;
4540 line_gc = XCreateGC (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
4541 GCLineStyle | GCJoinStyle | GCCapStyle
4542 | GCLineWidth | GCForeground | GCBackground,
4543 &gc_values);
4544 XSetDashes (FRAME_X_DISPLAY (f), line_gc, 0, dash_list, dashes);
4545 gc_values.foreground = f->output_data.x->background_pixel;
4546 gc_values.background = f->output_data.x->foreground_pixel;
4547 erase_gc = XCreateGC (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
4548 GCLineStyle | GCJoinStyle | GCCapStyle
4549 | GCLineWidth | GCForeground | GCBackground,
4550 &gc_values);
4551 XSetDashes (FRAME_X_DISPLAY (f), erase_gc, 0, dash_list, dashes);
4552 UNBLOCK_INPUT;
4553 #endif
4555 while (1)
4557 BLOCK_INPUT;
4558 if (x_mouse_y >= XINT (w->top)
4559 && x_mouse_y < XINT (w->top) + XINT (w->height) - 1)
4561 previous_y = x_mouse_y;
4562 line = (x_mouse_y + 1) * f->output_data.x->line_height
4563 + f->output_data.x->internal_border_width;
4564 XDrawLine (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
4565 line_gc, left, line, right, line);
4567 XFlush (FRAME_X_DISPLAY (f));
4568 UNBLOCK_INPUT;
4572 obj = read_char (-1, 0, 0, Qnil, 0);
4573 if (!CONSP (obj)
4574 || (! EQ (Fcar (Fcdr (Fcdr (obj))),
4575 Qvertical_scroll_bar))
4576 || x_mouse_grabbed)
4578 BLOCK_INPUT;
4579 XDrawLine (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
4580 erase_gc, left, line, right, line);
4581 unread_command_event = obj;
4582 #if 0
4583 XFreeGC (FRAME_X_DISPLAY (f), line_gc);
4584 XFreeGC (FRAME_X_DISPLAY (f), erase_gc);
4585 #endif
4586 UNBLOCK_INPUT;
4587 return Qnil;
4590 while (x_mouse_y == previous_y);
4592 BLOCK_INPUT;
4593 XDrawLine (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
4594 erase_gc, left, line, right, line);
4595 UNBLOCK_INPUT;
4598 #endif
4600 #if 0
4601 /* These keep track of the rectangle following the pointer. */
4602 int mouse_track_top, mouse_track_left, mouse_track_width;
4604 /* Offset in buffer of character under the pointer, or 0. */
4605 int mouse_buffer_offset;
4607 DEFUN ("x-track-pointer", Fx_track_pointer, Sx_track_pointer, 0, 0, 0,
4608 "Track the pointer.")
4611 static Cursor current_pointer_shape;
4612 FRAME_PTR f = x_mouse_frame;
4614 BLOCK_INPUT;
4615 if (EQ (Vmouse_frame_part, Qtext_part)
4616 && (current_pointer_shape != f->output_data.x->nontext_cursor))
4618 unsigned char c;
4619 struct buffer *buf;
4621 current_pointer_shape = f->output_data.x->nontext_cursor;
4622 XDefineCursor (FRAME_X_DISPLAY (f),
4623 FRAME_X_WINDOW (f),
4624 current_pointer_shape);
4626 buf = XBUFFER (XWINDOW (Vmouse_window)->buffer);
4627 c = *(BUF_CHAR_ADDRESS (buf, mouse_buffer_offset));
4629 else if (EQ (Vmouse_frame_part, Qmodeline_part)
4630 && (current_pointer_shape != f->output_data.x->modeline_cursor))
4632 current_pointer_shape = f->output_data.x->modeline_cursor;
4633 XDefineCursor (FRAME_X_DISPLAY (f),
4634 FRAME_X_WINDOW (f),
4635 current_pointer_shape);
4638 XFlush (FRAME_X_DISPLAY (f));
4639 UNBLOCK_INPUT;
4641 #endif
4643 #if 0
4644 DEFUN ("x-track-pointer", Fx_track_pointer, Sx_track_pointer, 1, 1, "e",
4645 "Draw rectangle around character under mouse pointer, if there is one.")
4646 (event)
4647 Lisp_Object event;
4649 struct window *w = XWINDOW (Vmouse_window);
4650 struct frame *f = XFRAME (WINDOW_FRAME (w));
4651 struct buffer *b = XBUFFER (w->buffer);
4652 Lisp_Object obj;
4654 if (! EQ (Vmouse_window, selected_window))
4655 return Qnil;
4657 if (EQ (event, Qnil))
4659 int x, y;
4661 x_read_mouse_position (selected_frame, &x, &y);
4664 BLOCK_INPUT;
4665 mouse_track_width = 0;
4666 mouse_track_left = mouse_track_top = -1;
4670 if ((x_mouse_x != mouse_track_left
4671 && (x_mouse_x < mouse_track_left
4672 || x_mouse_x > (mouse_track_left + mouse_track_width)))
4673 || x_mouse_y != mouse_track_top)
4675 int hp = 0; /* Horizontal position */
4676 int len = FRAME_CURRENT_GLYPHS (f)->used[x_mouse_y];
4677 int p = FRAME_CURRENT_GLYPHS (f)->bufp[x_mouse_y];
4678 int tab_width = XINT (b->tab_width);
4679 int ctl_arrow_p = !NILP (b->ctl_arrow);
4680 unsigned char c;
4681 int mode_line_vpos = XFASTINT (w->height) + XFASTINT (w->top) - 1;
4682 int in_mode_line = 0;
4684 if (! FRAME_CURRENT_GLYPHS (f)->enable[x_mouse_y])
4685 break;
4687 /* Erase previous rectangle. */
4688 if (mouse_track_width)
4690 x_rectangle (f, f->output_data.x->reverse_gc,
4691 mouse_track_left, mouse_track_top,
4692 mouse_track_width, 1);
4694 if ((mouse_track_left == f->phys_cursor_x
4695 || mouse_track_left == f->phys_cursor_x - 1)
4696 && mouse_track_top == f->phys_cursor_y)
4698 x_display_cursor (f, 1);
4702 mouse_track_left = x_mouse_x;
4703 mouse_track_top = x_mouse_y;
4704 mouse_track_width = 0;
4706 if (mouse_track_left > len) /* Past the end of line. */
4707 goto draw_or_not;
4709 if (mouse_track_top == mode_line_vpos)
4711 in_mode_line = 1;
4712 goto draw_or_not;
4715 if (tab_width <= 0 || tab_width > 20) tab_width = 8;
4718 c = FETCH_BYTE (p);
4719 if (len == f->width && hp == len - 1 && c != '\n')
4720 goto draw_or_not;
4722 switch (c)
4724 case '\t':
4725 mouse_track_width = tab_width - (hp % tab_width);
4726 p++;
4727 hp += mouse_track_width;
4728 if (hp > x_mouse_x)
4730 mouse_track_left = hp - mouse_track_width;
4731 goto draw_or_not;
4733 continue;
4735 case '\n':
4736 mouse_track_width = -1;
4737 goto draw_or_not;
4739 default:
4740 if (ctl_arrow_p && (c < 040 || c == 0177))
4742 if (p > ZV)
4743 goto draw_or_not;
4745 mouse_track_width = 2;
4746 p++;
4747 hp +=2;
4748 if (hp > x_mouse_x)
4750 mouse_track_left = hp - mouse_track_width;
4751 goto draw_or_not;
4754 else
4756 mouse_track_width = 1;
4757 p++;
4758 hp++;
4760 continue;
4763 while (hp <= x_mouse_x);
4765 draw_or_not:
4766 if (mouse_track_width) /* Over text; use text pointer shape. */
4768 XDefineCursor (FRAME_X_DISPLAY (f),
4769 FRAME_X_WINDOW (f),
4770 f->output_data.x->text_cursor);
4771 x_rectangle (f, f->output_data.x->cursor_gc,
4772 mouse_track_left, mouse_track_top,
4773 mouse_track_width, 1);
4775 else if (in_mode_line)
4776 XDefineCursor (FRAME_X_DISPLAY (f),
4777 FRAME_X_WINDOW (f),
4778 f->output_data.x->modeline_cursor);
4779 else
4780 XDefineCursor (FRAME_X_DISPLAY (f),
4781 FRAME_X_WINDOW (f),
4782 f->output_data.x->nontext_cursor);
4785 XFlush (FRAME_X_DISPLAY (f));
4786 UNBLOCK_INPUT;
4788 obj = read_char (-1, 0, 0, Qnil, 0);
4789 BLOCK_INPUT;
4791 while (CONSP (obj) /* Mouse event */
4792 && EQ (Fcar (Fcdr (Fcdr (obj))), Qnil) /* Not scroll bar */
4793 && EQ (Vmouse_depressed, Qnil) /* Only motion events */
4794 && EQ (Vmouse_window, selected_window) /* In this window */
4795 && x_mouse_frame);
4797 unread_command_event = obj;
4799 if (mouse_track_width)
4801 x_rectangle (f, f->output_data.x->reverse_gc,
4802 mouse_track_left, mouse_track_top,
4803 mouse_track_width, 1);
4804 mouse_track_width = 0;
4805 if ((mouse_track_left == f->phys_cursor_x
4806 || mouse_track_left - 1 == f->phys_cursor_x)
4807 && mouse_track_top == f->phys_cursor_y)
4809 x_display_cursor (f, 1);
4812 XDefineCursor (FRAME_X_DISPLAY (f),
4813 FRAME_X_WINDOW (f),
4814 f->output_data.x->nontext_cursor);
4815 XFlush (FRAME_X_DISPLAY (f));
4816 UNBLOCK_INPUT;
4818 return Qnil;
4820 #endif
4822 #if 0
4823 #include "glyphs.h"
4825 /* Draw a pixmap specified by IMAGE_DATA of dimensions WIDTH and HEIGHT
4826 on the frame F at position X, Y. */
4828 x_draw_pixmap (f, x, y, image_data, width, height)
4829 struct frame *f;
4830 int x, y, width, height;
4831 char *image_data;
4833 Pixmap image;
4835 image = XCreateBitmapFromData (FRAME_X_DISPLAY (f),
4836 FRAME_X_WINDOW (f), image_data,
4837 width, height);
4838 XCopyPlane (FRAME_X_DISPLAY (f), image, FRAME_X_WINDOW (f),
4839 f->output_data.x->normal_gc, 0, 0, width, height, x, y);
4841 #endif
4843 #if 0 /* I'm told these functions are superfluous
4844 given the ability to bind function keys. */
4846 #ifdef HAVE_X11
4847 DEFUN ("x-rebind-key", Fx_rebind_key, Sx_rebind_key, 3, 3, 0,
4848 "Rebind X keysym KEYSYM, with MODIFIERS, to generate NEWSTRING.\n\
4849 KEYSYM is a string which conforms to the X keysym definitions found\n\
4850 in X11/keysymdef.h, sans the initial XK_. MODIFIERS is nil or a\n\
4851 list of strings specifying modifier keys such as Control_L, which must\n\
4852 also be depressed for NEWSTRING to appear.")
4853 (x_keysym, modifiers, newstring)
4854 register Lisp_Object x_keysym;
4855 register Lisp_Object modifiers;
4856 register Lisp_Object newstring;
4858 char *rawstring;
4859 register KeySym keysym;
4860 KeySym modifier_list[16];
4862 check_x ();
4863 CHECK_STRING (x_keysym, 1);
4864 CHECK_STRING (newstring, 3);
4866 keysym = XStringToKeysym ((char *) XSTRING (x_keysym)->data);
4867 if (keysym == NoSymbol)
4868 error ("Keysym does not exist");
4870 if (NILP (modifiers))
4871 XRebindKeysym (x_current_display, keysym, modifier_list, 0,
4872 XSTRING (newstring)->data, XSTRING (newstring)->size);
4873 else
4875 register Lisp_Object rest, mod;
4876 register int i = 0;
4878 for (rest = modifiers; !NILP (rest); rest = Fcdr (rest))
4880 if (i == 16)
4881 error ("Can't have more than 16 modifiers");
4883 mod = Fcar (rest);
4884 CHECK_STRING (mod, 3);
4885 modifier_list[i] = XStringToKeysym ((char *) XSTRING (mod)->data);
4886 #ifndef HAVE_X11R5
4887 if (modifier_list[i] == NoSymbol
4888 || !(IsModifierKey (modifier_list[i])
4889 || ((unsigned)(modifier_list[i]) == XK_Mode_switch)
4890 || ((unsigned)(modifier_list[i]) == XK_Num_Lock)))
4891 #else
4892 if (modifier_list[i] == NoSymbol
4893 || !IsModifierKey (modifier_list[i]))
4894 #endif
4895 error ("Element is not a modifier keysym");
4896 i++;
4899 XRebindKeysym (x_current_display, keysym, modifier_list, i,
4900 XSTRING (newstring)->data, XSTRING (newstring)->size);
4903 return Qnil;
4906 DEFUN ("x-rebind-keys", Fx_rebind_keys, Sx_rebind_keys, 2, 2, 0,
4907 "Rebind KEYCODE to list of strings STRINGS.\n\
4908 STRINGS should be a list of 16 elements, one for each shift combination.\n\
4909 nil as element means don't change.\n\
4910 See the documentation of `x-rebind-key' for more information.")
4911 (keycode, strings)
4912 register Lisp_Object keycode;
4913 register Lisp_Object strings;
4915 register Lisp_Object item;
4916 register unsigned char *rawstring;
4917 KeySym rawkey, modifier[1];
4918 int strsize;
4919 register unsigned i;
4921 check_x ();
4922 CHECK_NUMBER (keycode, 1);
4923 CHECK_CONS (strings, 2);
4924 rawkey = (KeySym) ((unsigned) (XINT (keycode))) & 255;
4925 for (i = 0; i <= 15; strings = Fcdr (strings), i++)
4927 item = Fcar (strings);
4928 if (!NILP (item))
4930 CHECK_STRING (item, 2);
4931 strsize = XSTRING (item)->size;
4932 rawstring = (unsigned char *) xmalloc (strsize);
4933 bcopy (XSTRING (item)->data, rawstring, strsize);
4934 modifier[1] = 1 << i;
4935 XRebindKeysym (x_current_display, rawkey, modifier, 1,
4936 rawstring, strsize);
4939 return Qnil;
4941 #endif /* HAVE_X11 */
4942 #endif /* 0 */
4944 #ifndef HAVE_XSCREENNUMBEROFSCREEN
4946 XScreenNumberOfScreen (scr)
4947 register Screen *scr;
4949 register Display *dpy;
4950 register Screen *dpyscr;
4951 register int i;
4953 dpy = scr->display;
4954 dpyscr = dpy->screens;
4956 for (i = 0; i < dpy->nscreens; i++, dpyscr++)
4957 if (scr == dpyscr)
4958 return i;
4960 return -1;
4962 #endif /* not HAVE_XSCREENNUMBEROFSCREEN */
4964 Visual *
4965 select_visual (dpy, screen, depth)
4966 Display *dpy;
4967 Screen *screen;
4968 unsigned int *depth;
4970 Visual *v;
4971 XVisualInfo *vinfo, vinfo_template;
4972 int n_visuals;
4974 v = DefaultVisualOfScreen (screen);
4976 #ifdef HAVE_X11R4
4977 vinfo_template.visualid = XVisualIDFromVisual (v);
4978 #else
4979 vinfo_template.visualid = v->visualid;
4980 #endif
4982 vinfo_template.screen = XScreenNumberOfScreen (screen);
4984 vinfo = XGetVisualInfo (dpy,
4985 VisualIDMask | VisualScreenMask, &vinfo_template,
4986 &n_visuals);
4987 if (n_visuals != 1)
4988 fatal ("Can't get proper X visual info");
4990 if ((1 << vinfo->depth) == vinfo->colormap_size)
4991 *depth = vinfo->depth;
4992 else
4994 int i = 0;
4995 int n = vinfo->colormap_size - 1;
4996 while (n)
4998 n = n >> 1;
4999 i++;
5001 *depth = i;
5004 XFree ((char *) vinfo);
5005 return v;
5008 /* Return the X display structure for the display named NAME.
5009 Open a new connection if necessary. */
5011 struct x_display_info *
5012 x_display_info_for_name (name)
5013 Lisp_Object name;
5015 Lisp_Object names;
5016 struct x_display_info *dpyinfo;
5018 CHECK_STRING (name, 0);
5020 if (! EQ (Vwindow_system, intern ("x")))
5021 error ("Not using X Windows");
5023 for (dpyinfo = x_display_list, names = x_display_name_list;
5024 dpyinfo;
5025 dpyinfo = dpyinfo->next, names = XCONS (names)->cdr)
5027 Lisp_Object tem;
5028 tem = Fstring_equal (XCONS (XCONS (names)->car)->car, name);
5029 if (!NILP (tem))
5030 return dpyinfo;
5033 /* Use this general default value to start with. */
5034 Vx_resource_name = Vinvocation_name;
5036 validate_x_resource_name ();
5038 dpyinfo = x_term_init (name, (unsigned char *)0,
5039 (char *) XSTRING (Vx_resource_name)->data);
5041 if (dpyinfo == 0)
5042 error ("Cannot connect to X server %s", XSTRING (name)->data);
5044 x_in_use = 1;
5045 XSETFASTINT (Vwindow_system_version, 11);
5047 return dpyinfo;
5050 DEFUN ("x-open-connection", Fx_open_connection, Sx_open_connection,
5051 1, 3, 0, "Open a connection to an X server.\n\
5052 DISPLAY is the name of the display to connect to.\n\
5053 Optional second arg XRM-STRING is a string of resources in xrdb format.\n\
5054 If the optional third arg MUST-SUCCEED is non-nil,\n\
5055 terminate Emacs if we can't open the connection.")
5056 (display, xrm_string, must_succeed)
5057 Lisp_Object display, xrm_string, must_succeed;
5059 unsigned int n_planes;
5060 unsigned char *xrm_option;
5061 struct x_display_info *dpyinfo;
5063 CHECK_STRING (display, 0);
5064 if (! NILP (xrm_string))
5065 CHECK_STRING (xrm_string, 1);
5067 if (! EQ (Vwindow_system, intern ("x")))
5068 error ("Not using X Windows");
5070 if (! NILP (xrm_string))
5071 xrm_option = (unsigned char *) XSTRING (xrm_string)->data;
5072 else
5073 xrm_option = (unsigned char *) 0;
5075 validate_x_resource_name ();
5077 /* This is what opens the connection and sets x_current_display.
5078 This also initializes many symbols, such as those used for input. */
5079 dpyinfo = x_term_init (display, xrm_option,
5080 (char *) XSTRING (Vx_resource_name)->data);
5082 if (dpyinfo == 0)
5084 if (!NILP (must_succeed))
5085 fatal ("Cannot connect to X server %s.\n\
5086 Check the DISPLAY environment variable or use `-d'.\n\
5087 Also use the `xhost' program to verify that it is set to permit\n\
5088 connections from your machine.\n",
5089 XSTRING (display)->data);
5090 else
5091 error ("Cannot connect to X server %s", XSTRING (display)->data);
5094 x_in_use = 1;
5096 XSETFASTINT (Vwindow_system_version, 11);
5097 return Qnil;
5100 DEFUN ("x-close-connection", Fx_close_connection,
5101 Sx_close_connection, 1, 1, 0,
5102 "Close the connection to DISPLAY's X server.\n\
5103 For DISPLAY, specify either a frame or a display name (a string).\n\
5104 If DISPLAY is nil, that stands for the selected frame's display.")
5105 (display)
5106 Lisp_Object display;
5108 struct x_display_info *dpyinfo = check_x_display_info (display);
5109 struct x_display_info *tail;
5110 int i;
5112 if (dpyinfo->reference_count > 0)
5113 error ("Display still has frames on it");
5115 BLOCK_INPUT;
5116 /* Free the fonts in the font table. */
5117 for (i = 0; i < dpyinfo->n_fonts; i++)
5119 if (dpyinfo->font_table[i].name)
5120 free (dpyinfo->font_table[i].name);
5121 /* Don't free the full_name string;
5122 it is always shared with something else. */
5123 XFreeFont (dpyinfo->display, dpyinfo->font_table[i].font);
5125 x_destroy_all_bitmaps (dpyinfo);
5126 XSetCloseDownMode (dpyinfo->display, DestroyAll);
5128 #ifdef USE_X_TOOLKIT
5129 XtCloseDisplay (dpyinfo->display);
5130 #else
5131 XCloseDisplay (dpyinfo->display);
5132 #endif
5134 x_delete_display (dpyinfo);
5135 UNBLOCK_INPUT;
5137 return Qnil;
5140 DEFUN ("x-display-list", Fx_display_list, Sx_display_list, 0, 0, 0,
5141 "Return the list of display names that Emacs has connections to.")
5144 Lisp_Object tail, result;
5146 result = Qnil;
5147 for (tail = x_display_name_list; ! NILP (tail); tail = XCONS (tail)->cdr)
5148 result = Fcons (XCONS (XCONS (tail)->car)->car, result);
5150 return result;
5153 DEFUN ("x-synchronize", Fx_synchronize, Sx_synchronize, 1, 2, 0,
5154 "If ON is non-nil, report X errors as soon as the erring request is made.\n\
5155 If ON is nil, allow buffering of requests.\n\
5156 Turning on synchronization prohibits the Xlib routines from buffering\n\
5157 requests and seriously degrades performance, but makes debugging much\n\
5158 easier.\n\
5159 The optional second argument DISPLAY specifies which display to act on.\n\
5160 DISPLAY should be either a frame or a display name (a string).\n\
5161 If DISPLAY is omitted or nil, that stands for the selected frame's display.")
5162 (on, display)
5163 Lisp_Object display, on;
5165 struct x_display_info *dpyinfo = check_x_display_info (display);
5167 XSynchronize (dpyinfo->display, !EQ (on, Qnil));
5169 return Qnil;
5172 /* Wait for responses to all X commands issued so far for frame F. */
5174 void
5175 x_sync (f)
5176 FRAME_PTR f;
5178 BLOCK_INPUT;
5179 XSync (FRAME_X_DISPLAY (f), False);
5180 UNBLOCK_INPUT;
5183 syms_of_xfns ()
5185 /* This is zero if not using X windows. */
5186 x_in_use = 0;
5188 /* The section below is built by the lisp expression at the top of the file,
5189 just above where these variables are declared. */
5190 /*&&& init symbols here &&&*/
5191 Qauto_raise = intern ("auto-raise");
5192 staticpro (&Qauto_raise);
5193 Qauto_lower = intern ("auto-lower");
5194 staticpro (&Qauto_lower);
5195 Qbackground_color = intern ("background-color");
5196 staticpro (&Qbackground_color);
5197 Qbar = intern ("bar");
5198 staticpro (&Qbar);
5199 Qborder_color = intern ("border-color");
5200 staticpro (&Qborder_color);
5201 Qborder_width = intern ("border-width");
5202 staticpro (&Qborder_width);
5203 Qbox = intern ("box");
5204 staticpro (&Qbox);
5205 Qcursor_color = intern ("cursor-color");
5206 staticpro (&Qcursor_color);
5207 Qcursor_type = intern ("cursor-type");
5208 staticpro (&Qcursor_type);
5209 Qforeground_color = intern ("foreground-color");
5210 staticpro (&Qforeground_color);
5211 Qgeometry = intern ("geometry");
5212 staticpro (&Qgeometry);
5213 Qicon_left = intern ("icon-left");
5214 staticpro (&Qicon_left);
5215 Qicon_top = intern ("icon-top");
5216 staticpro (&Qicon_top);
5217 Qicon_type = intern ("icon-type");
5218 staticpro (&Qicon_type);
5219 Qicon_name = intern ("icon-name");
5220 staticpro (&Qicon_name);
5221 Qinternal_border_width = intern ("internal-border-width");
5222 staticpro (&Qinternal_border_width);
5223 Qleft = intern ("left");
5224 staticpro (&Qleft);
5225 Qright = intern ("right");
5226 staticpro (&Qright);
5227 Qmouse_color = intern ("mouse-color");
5228 staticpro (&Qmouse_color);
5229 Qnone = intern ("none");
5230 staticpro (&Qnone);
5231 Qparent_id = intern ("parent-id");
5232 staticpro (&Qparent_id);
5233 Qscroll_bar_width = intern ("scroll-bar-width");
5234 staticpro (&Qscroll_bar_width);
5235 Qsuppress_icon = intern ("suppress-icon");
5236 staticpro (&Qsuppress_icon);
5237 Qtop = intern ("top");
5238 staticpro (&Qtop);
5239 Qundefined_color = intern ("undefined-color");
5240 staticpro (&Qundefined_color);
5241 Qvertical_scroll_bars = intern ("vertical-scroll-bars");
5242 staticpro (&Qvertical_scroll_bars);
5243 Qvisibility = intern ("visibility");
5244 staticpro (&Qvisibility);
5245 Qwindow_id = intern ("window-id");
5246 staticpro (&Qwindow_id);
5247 Qx_frame_parameter = intern ("x-frame-parameter");
5248 staticpro (&Qx_frame_parameter);
5249 Qx_resource_name = intern ("x-resource-name");
5250 staticpro (&Qx_resource_name);
5251 Quser_position = intern ("user-position");
5252 staticpro (&Quser_position);
5253 Quser_size = intern ("user-size");
5254 staticpro (&Quser_size);
5255 Qdisplay = intern ("display");
5256 staticpro (&Qdisplay);
5257 /* This is the end of symbol initialization. */
5259 Qface_set_after_frame_default = intern ("face-set-after-frame-default");
5260 staticpro (&Qface_set_after_frame_default);
5262 Fput (Qundefined_color, Qerror_conditions,
5263 Fcons (Qundefined_color, Fcons (Qerror, Qnil)));
5264 Fput (Qundefined_color, Qerror_message,
5265 build_string ("Undefined color"));
5267 init_x_parm_symbols ();
5269 DEFVAR_LISP ("x-bitmap-file-path", &Vx_bitmap_file_path,
5270 "List of directories to search for bitmap files for X.");
5271 Vx_bitmap_file_path = decode_env_path ((char *) 0, PATH_BITMAPS);
5273 DEFVAR_LISP ("x-pointer-shape", &Vx_pointer_shape,
5274 "The shape of the pointer when over text.\n\
5275 Changing the value does not affect existing frames\n\
5276 unless you set the mouse color.");
5277 Vx_pointer_shape = Qnil;
5279 DEFVAR_LISP ("x-resource-name", &Vx_resource_name,
5280 "The name Emacs uses to look up X resources.\n\
5281 `x-get-resource' uses this as the first component of the instance name\n\
5282 when requesting resource values.\n\
5283 Emacs initially sets `x-resource-name' to the name under which Emacs\n\
5284 was invoked, or to the value specified with the `-name' or `-rn'\n\
5285 switches, if present.\n\
5287 It may be useful to bind this variable locally around a call\n\
5288 to `x-get-resource'. See also the variable `x-resource-class'.");
5289 Vx_resource_name = Qnil;
5291 DEFVAR_LISP ("x-resource-class", &Vx_resource_class,
5292 "The class Emacs uses to look up X resources.\n\
5293 `x-get-resource' uses this as the first component of the instance class\n\
5294 when requesting resource values.\n\
5295 Emacs initially sets `x-resource-class' to \"Emacs\".\n\
5297 Setting this variable permanently is not a reasonable thing to do,\n\
5298 but binding this variable locally around a call to `x-get-resource'\n\
5299 is a reasonabvle practice. See also the variable `x-resource-name'.");
5300 Vx_resource_class = build_string (EMACS_CLASS);
5302 #if 0 /* This doesn't really do anything. */
5303 DEFVAR_LISP ("x-nontext-pointer-shape", &Vx_nontext_pointer_shape,
5304 "The shape of the pointer when not over text.\n\
5305 This variable takes effect when you create a new frame\n\
5306 or when you set the mouse color.");
5307 #endif
5308 Vx_nontext_pointer_shape = Qnil;
5310 #if 0 /* This doesn't really do anything. */
5311 DEFVAR_LISP ("x-mode-pointer-shape", &Vx_mode_pointer_shape,
5312 "The shape of the pointer when over the mode line.\n\
5313 This variable takes effect when you create a new frame\n\
5314 or when you set the mouse color.");
5315 #endif
5316 Vx_mode_pointer_shape = Qnil;
5318 DEFVAR_LISP ("x-sensitive-text-pointer-shape",
5319 &Vx_sensitive_text_pointer_shape,
5320 "The shape of the pointer when over mouse-sensitive text.\n\
5321 This variable takes effect when you create a new frame\n\
5322 or when you set the mouse color.");
5323 Vx_sensitive_text_pointer_shape = Qnil;
5325 DEFVAR_LISP ("x-cursor-fore-pixel", &Vx_cursor_fore_pixel,
5326 "A string indicating the foreground color of the cursor box.");
5327 Vx_cursor_fore_pixel = Qnil;
5329 DEFVAR_LISP ("x-no-window-manager", &Vx_no_window_manager,
5330 "Non-nil if no X window manager is in use.\n\
5331 Emacs doesn't try to figure this out; this is always nil\n\
5332 unless you set it to something else.");
5333 /* We don't have any way to find this out, so set it to nil
5334 and maybe the user would like to set it to t. */
5335 Vx_no_window_manager = Qnil;
5337 DEFVAR_LISP ("x-pixel-size-width-font-regexp",
5338 &Vx_pixel_size_width_font_regexp,
5339 "Regexp matching a font name whose width is the same as `PIXEL_SIZE'.\n\
5341 Since Emacs gets width of a font matching with this regexp from\n\
5342 PIXEL_SIZE field of the name, font finding mechanism gets faster for\n\
5343 such a font. This is especially effective for such large fonts as\n\
5344 Chinese, Japanese, and Korean.");
5345 Vx_pixel_size_width_font_regexp = Qnil;
5347 #ifdef USE_X_TOOLKIT
5348 Fprovide (intern ("x-toolkit"));
5349 #endif
5350 #ifdef USE_MOTIF
5351 Fprovide (intern ("motif"));
5352 #endif
5354 defsubr (&Sx_get_resource);
5355 #if 0
5356 defsubr (&Sx_draw_rectangle);
5357 defsubr (&Sx_erase_rectangle);
5358 defsubr (&Sx_contour_region);
5359 defsubr (&Sx_uncontour_region);
5360 #endif
5361 defsubr (&Sx_list_fonts);
5362 defsubr (&Sx_display_color_p);
5363 defsubr (&Sx_display_grayscale_p);
5364 defsubr (&Sx_color_defined_p);
5365 defsubr (&Sx_color_values);
5366 defsubr (&Sx_server_max_request_size);
5367 defsubr (&Sx_server_vendor);
5368 defsubr (&Sx_server_version);
5369 defsubr (&Sx_display_pixel_width);
5370 defsubr (&Sx_display_pixel_height);
5371 defsubr (&Sx_display_mm_width);
5372 defsubr (&Sx_display_mm_height);
5373 defsubr (&Sx_display_screens);
5374 defsubr (&Sx_display_planes);
5375 defsubr (&Sx_display_color_cells);
5376 defsubr (&Sx_display_visual_class);
5377 defsubr (&Sx_display_backing_store);
5378 defsubr (&Sx_display_save_under);
5379 #if 0
5380 defsubr (&Sx_rebind_key);
5381 defsubr (&Sx_rebind_keys);
5382 defsubr (&Sx_track_pointer);
5383 defsubr (&Sx_grab_pointer);
5384 defsubr (&Sx_ungrab_pointer);
5385 #endif
5386 defsubr (&Sx_parse_geometry);
5387 defsubr (&Sx_create_frame);
5388 #if 0
5389 defsubr (&Sx_horizontal_line);
5390 #endif
5391 defsubr (&Sx_open_connection);
5392 defsubr (&Sx_close_connection);
5393 defsubr (&Sx_display_list);
5394 defsubr (&Sx_synchronize);
5396 /* Setting callback functions for fontset handler. */
5397 get_font_info_func = x_get_font_info;
5398 list_fonts_func = x_list_fonts;
5399 load_font_func = x_load_font;
5400 query_font_func = x_query_font;
5401 set_frame_fontset_func = x_set_font;
5402 check_window_system_func = check_x;
5405 #endif /* HAVE_X_WINDOWS */