(do-auto-fill): Check enable-kinsoku and enable-multibyte-characters.
[emacs.git] / src / xfns.c
blobed7f726889cd4a7c3dce9614352f4d8e67370e57
1 /* Functions for the X window system.
2 Copyright (C) 1989, 1992, 1993, 1994, 1995, 1996 Free Software Foundation.
4 This file is part of GNU Emacs.
6 GNU Emacs is free software; you can redistribute it and/or modify
7 it under the terms of the GNU General Public License as published by
8 the Free Software Foundation; either version 2, or (at your option)
9 any later version.
11 GNU Emacs is distributed in the hope that it will be useful,
12 but WITHOUT ANY WARRANTY; without even the implied warranty of
13 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14 GNU General Public License for more details.
16 You should have received a copy of the GNU General Public License
17 along with GNU Emacs; see the file COPYING. If not, write to
18 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
19 Boston, MA 02111-1307, USA. */
21 /* Completely rewritten by Richard Stallman. */
23 /* Rewritten for X11 by Joseph Arceneaux */
25 #include <signal.h>
26 #include <config.h>
28 /* This makes the fields of a Display accessible, in Xlib header files. */
29 #define XLIB_ILLEGAL_ACCESS
31 #include "lisp.h"
32 #include "xterm.h"
33 #include "frame.h"
34 #include "window.h"
35 #include "buffer.h"
36 #include "dispextern.h"
37 #include "keyboard.h"
38 #include "blockinput.h"
39 #include <paths.h>
40 #include "charset.h"
41 #include "fontset.h"
43 #ifdef HAVE_X_WINDOWS
44 extern void abort ();
46 /* On some systems, the character-composition stuff is broken in X11R5. */
47 #if defined (HAVE_X11R5) && ! defined (HAVE_X11R6)
48 #ifdef X11R5_INHIBIT_I18N
49 #define X_I18N_INHIBITED
50 #endif
51 #endif
53 #ifndef VMS
54 #if 1 /* Used to be #ifdef EMACS_BITMAP_FILES, but this should always work. */
55 #include "bitmaps/gray.xbm"
56 #else
57 #include <X11/bitmaps/gray>
58 #endif
59 #else
60 #include "[.bitmaps]gray.xbm"
61 #endif
63 #ifdef USE_X_TOOLKIT
64 #include <X11/Shell.h>
66 #ifndef USE_MOTIF
67 #include <X11/Xaw/Paned.h>
68 #include <X11/Xaw/Label.h>
69 #endif /* USE_MOTIF */
71 #ifdef USG
72 #undef USG /* ####KLUDGE for Solaris 2.2 and up */
73 #include <X11/Xos.h>
74 #define USG
75 #else
76 #include <X11/Xos.h>
77 #endif
79 #include "widget.h"
81 #include "../lwlib/lwlib.h"
83 /* Do the EDITRES protocol if running X11R5
84 Exception: HP-UX (at least version A.09.05) has X11R5 without EditRes */
85 #if (XtSpecificationRelease >= 5) && !defined(NO_EDITRES)
86 #define HACK_EDITRES
87 extern void _XEditResCheckMessages ();
88 #endif /* R5 + Athena */
90 /* Unique id counter for widgets created by the Lucid Widget
91 Library. */
92 extern LWLIB_ID widget_id_tick;
94 #ifdef USE_LUCID
95 /* This is part of a kludge--see lwlib/xlwmenu.c. */
96 extern XFontStruct *xlwmenu_default_font;
97 #endif
99 extern void free_frame_menubar ();
100 #endif /* USE_X_TOOLKIT */
102 #define min(a,b) ((a) < (b) ? (a) : (b))
103 #define max(a,b) ((a) > (b) ? (a) : (b))
105 #ifdef HAVE_X11R4
106 #define MAXREQUEST(dpy) (XMaxRequestSize (dpy))
107 #else
108 #define MAXREQUEST(dpy) ((dpy)->max_request_size)
109 #endif
111 /* The name we're using in resource queries. Most often "emacs". */
112 Lisp_Object Vx_resource_name;
114 /* The application class we're using in resource queries.
115 Normally "Emacs". */
116 Lisp_Object Vx_resource_class;
118 /* The background and shape of the mouse pointer, and shape when not
119 over text or in the modeline. */
120 Lisp_Object Vx_pointer_shape, Vx_nontext_pointer_shape, Vx_mode_pointer_shape;
121 /* The shape when over mouse-sensitive text. */
122 Lisp_Object Vx_sensitive_text_pointer_shape;
124 /* Color of chars displayed in cursor box. */
125 Lisp_Object Vx_cursor_fore_pixel;
127 /* Nonzero if using X. */
128 static int x_in_use;
130 /* Non nil if no window manager is in use. */
131 Lisp_Object Vx_no_window_manager;
133 /* Search path for bitmap files. */
134 Lisp_Object Vx_bitmap_file_path;
136 /* Regexp matching a font name whose width is the same as `PIXEL_SIZE'. */
137 Lisp_Object Vx_pixel_size_width_font_regexp;
139 /* Evaluate this expression to rebuild the section of syms_of_xfns
140 that initializes and staticpros the symbols declared below. Note
141 that Emacs 18 has a bug that keeps C-x C-e from being able to
142 evaluate this expression.
144 (progn
145 ;; Accumulate a list of the symbols we want to initialize from the
146 ;; declarations at the top of the file.
147 (goto-char (point-min))
148 (search-forward "/\*&&& symbols declared here &&&*\/\n")
149 (let (symbol-list)
150 (while (looking-at "Lisp_Object \\(Q[a-z_]+\\)")
151 (setq symbol-list
152 (cons (buffer-substring (match-beginning 1) (match-end 1))
153 symbol-list))
154 (forward-line 1))
155 (setq symbol-list (nreverse symbol-list))
156 ;; Delete the section of syms_of_... where we initialize the symbols.
157 (search-forward "\n /\*&&& init symbols here &&&*\/\n")
158 (let ((start (point)))
159 (while (looking-at "^ Q")
160 (forward-line 2))
161 (kill-region start (point)))
162 ;; Write a new symbol initialization section.
163 (while symbol-list
164 (insert (format " %s = intern (\"" (car symbol-list)))
165 (let ((start (point)))
166 (insert (substring (car symbol-list) 1))
167 (subst-char-in-region start (point) ?_ ?-))
168 (insert (format "\");\n staticpro (&%s);\n" (car symbol-list)))
169 (setq symbol-list (cdr symbol-list)))))
173 /*&&& symbols declared here &&&*/
174 Lisp_Object Qauto_raise;
175 Lisp_Object Qauto_lower;
176 Lisp_Object Qbackground_color;
177 Lisp_Object Qbar;
178 Lisp_Object Qborder_color;
179 Lisp_Object Qborder_width;
180 Lisp_Object Qbox;
181 Lisp_Object Qcursor_color;
182 Lisp_Object Qcursor_type;
183 Lisp_Object Qforeground_color;
184 Lisp_Object Qgeometry;
185 Lisp_Object Qicon_left;
186 Lisp_Object Qicon_top;
187 Lisp_Object Qicon_type;
188 Lisp_Object Qicon_name;
189 Lisp_Object Qinternal_border_width;
190 Lisp_Object Qleft;
191 Lisp_Object Qright;
192 Lisp_Object Qmouse_color;
193 Lisp_Object Qnone;
194 Lisp_Object Qparent_id;
195 Lisp_Object Qscroll_bar_width;
196 Lisp_Object Qsuppress_icon;
197 Lisp_Object Qtop;
198 Lisp_Object Qundefined_color;
199 Lisp_Object Qvertical_scroll_bars;
200 Lisp_Object Qvisibility;
201 Lisp_Object Qwindow_id;
202 Lisp_Object Qx_frame_parameter;
203 Lisp_Object Qx_resource_name;
204 Lisp_Object Quser_position;
205 Lisp_Object Quser_size;
206 Lisp_Object Qdisplay;
208 /* The below are defined in frame.c. */
209 extern Lisp_Object Qheight, Qminibuffer, Qname, Qonly, Qwidth;
210 extern Lisp_Object Qunsplittable, Qmenu_bar_lines, Qbuffer_predicate, Qtitle;
212 extern Lisp_Object Vwindow_system_version;
215 /* Error if we are not connected to X. */
216 void
217 check_x ()
219 if (! x_in_use)
220 error ("X windows are not in use or not initialized");
223 /* Nonzero if we can use mouse menus.
224 You should not call this unless HAVE_MENUS is defined. */
227 have_menus_p ()
229 return x_in_use;
232 /* Extract a frame as a FRAME_PTR, defaulting to the selected frame
233 and checking validity for X. */
235 FRAME_PTR
236 check_x_frame (frame)
237 Lisp_Object frame;
239 FRAME_PTR f;
241 if (NILP (frame))
242 f = selected_frame;
243 else
245 CHECK_LIVE_FRAME (frame, 0);
246 f = XFRAME (frame);
248 if (! FRAME_X_P (f))
249 error ("Non-X frame used");
250 return f;
253 /* Let the user specify an X display with a frame.
254 nil stands for the selected frame--or, if that is not an X frame,
255 the first X display on the list. */
257 static struct x_display_info *
258 check_x_display_info (frame)
259 Lisp_Object frame;
261 if (NILP (frame))
263 if (FRAME_X_P (selected_frame))
264 return FRAME_X_DISPLAY_INFO (selected_frame);
265 else if (x_display_list != 0)
266 return x_display_list;
267 else
268 error ("X windows are not in use or not initialized");
270 else if (STRINGP (frame))
271 return x_display_info_for_name (frame);
272 else
274 FRAME_PTR f;
276 CHECK_LIVE_FRAME (frame, 0);
277 f = XFRAME (frame);
278 if (! FRAME_X_P (f))
279 error ("Non-X frame used");
280 return FRAME_X_DISPLAY_INFO (f);
284 /* Return the Emacs frame-object corresponding to an X window.
285 It could be the frame's main window or an icon window. */
287 /* This function can be called during GC, so use GC_xxx type test macros. */
289 struct frame *
290 x_window_to_frame (dpyinfo, wdesc)
291 struct x_display_info *dpyinfo;
292 int wdesc;
294 Lisp_Object tail, frame;
295 struct frame *f;
297 for (tail = Vframe_list; GC_CONSP (tail); tail = XCONS (tail)->cdr)
299 frame = XCONS (tail)->car;
300 if (!GC_FRAMEP (frame))
301 continue;
302 f = XFRAME (frame);
303 if (f->output_data.nothing == 1 || FRAME_X_DISPLAY_INFO (f) != dpyinfo)
304 continue;
305 #ifdef USE_X_TOOLKIT
306 if ((f->output_data.x->edit_widget
307 && XtWindow (f->output_data.x->edit_widget) == wdesc)
308 || f->output_data.x->icon_desc == wdesc)
309 return f;
310 #else /* not USE_X_TOOLKIT */
311 if (FRAME_X_WINDOW (f) == wdesc
312 || f->output_data.x->icon_desc == wdesc)
313 return f;
314 #endif /* not USE_X_TOOLKIT */
316 return 0;
319 #ifdef USE_X_TOOLKIT
320 /* Like x_window_to_frame but also compares the window with the widget's
321 windows. */
323 struct frame *
324 x_any_window_to_frame (dpyinfo, wdesc)
325 struct x_display_info *dpyinfo;
326 int wdesc;
328 Lisp_Object tail, frame;
329 struct frame *f;
330 struct x_output *x;
332 for (tail = Vframe_list; GC_CONSP (tail); tail = XCONS (tail)->cdr)
334 frame = XCONS (tail)->car;
335 if (!GC_FRAMEP (frame))
336 continue;
337 f = XFRAME (frame);
338 if (f->output_data.nothing == 1 || FRAME_X_DISPLAY_INFO (f) != dpyinfo)
339 continue;
340 x = f->output_data.x;
341 /* This frame matches if the window is any of its widgets. */
342 if (wdesc == XtWindow (x->widget)
343 || wdesc == XtWindow (x->column_widget)
344 || wdesc == XtWindow (x->edit_widget))
345 return f;
346 /* Match if the window is this frame's menubar. */
347 if (lw_window_is_in_menubar (wdesc, x->menubar_widget))
348 return f;
350 return 0;
353 /* Likewise, but exclude the menu bar widget. */
355 struct frame *
356 x_non_menubar_window_to_frame (dpyinfo, wdesc)
357 struct x_display_info *dpyinfo;
358 int wdesc;
360 Lisp_Object tail, frame;
361 struct frame *f;
362 struct x_output *x;
364 for (tail = Vframe_list; GC_CONSP (tail); tail = XCONS (tail)->cdr)
366 frame = XCONS (tail)->car;
367 if (!GC_FRAMEP (frame))
368 continue;
369 f = XFRAME (frame);
370 if (f->output_data.nothing == 1 || FRAME_X_DISPLAY_INFO (f) != dpyinfo)
371 continue;
372 x = f->output_data.x;
373 /* This frame matches if the window is any of its widgets. */
374 if (wdesc == XtWindow (x->widget)
375 || wdesc == XtWindow (x->column_widget)
376 || wdesc == XtWindow (x->edit_widget))
377 return f;
379 return 0;
382 /* Likewise, but consider only the menu bar widget. */
384 struct frame *
385 x_menubar_window_to_frame (dpyinfo, wdesc)
386 struct x_display_info *dpyinfo;
387 int wdesc;
389 Lisp_Object tail, frame;
390 struct frame *f;
391 struct x_output *x;
393 for (tail = Vframe_list; GC_CONSP (tail); tail = XCONS (tail)->cdr)
395 frame = XCONS (tail)->car;
396 if (!GC_FRAMEP (frame))
397 continue;
398 f = XFRAME (frame);
399 if (f->output_data.nothing == 1 || FRAME_X_DISPLAY_INFO (f) != dpyinfo)
400 continue;
401 x = f->output_data.x;
402 /* Match if the window is this frame's menubar. */
403 if (lw_window_is_in_menubar (wdesc, x->menubar_widget))
404 return f;
406 return 0;
409 /* Return the frame whose principal (outermost) window is WDESC.
410 If WDESC is some other (smaller) window, we return 0. */
412 struct frame *
413 x_top_window_to_frame (dpyinfo, wdesc)
414 struct x_display_info *dpyinfo;
415 int wdesc;
417 Lisp_Object tail, frame;
418 struct frame *f;
419 struct x_output *x;
421 for (tail = Vframe_list; GC_CONSP (tail); tail = XCONS (tail)->cdr)
423 frame = XCONS (tail)->car;
424 if (!GC_FRAMEP (frame))
425 continue;
426 f = XFRAME (frame);
427 if (f->output_data.nothing == 1 || FRAME_X_DISPLAY_INFO (f) != dpyinfo)
428 continue;
429 x = f->output_data.x;
430 /* This frame matches if the window is its topmost widget. */
431 if (wdesc == XtWindow (x->widget))
432 return f;
433 #if 0 /* I don't know why it did this,
434 but it seems logically wrong,
435 and it causes trouble for MapNotify events. */
436 /* Match if the window is this frame's menubar. */
437 if (x->menubar_widget
438 && wdesc == XtWindow (x->menubar_widget))
439 return f;
440 #endif
442 return 0;
444 #endif /* USE_X_TOOLKIT */
448 /* Code to deal with bitmaps. Bitmaps are referenced by their bitmap
449 id, which is just an int that this section returns. Bitmaps are
450 reference counted so they can be shared among frames.
452 Bitmap indices are guaranteed to be > 0, so a negative number can
453 be used to indicate no bitmap.
455 If you use x_create_bitmap_from_data, then you must keep track of
456 the bitmaps yourself. That is, creating a bitmap from the same
457 data more than once will not be caught. */
460 /* Functions to access the contents of a bitmap, given an id. */
463 x_bitmap_height (f, id)
464 FRAME_PTR f;
465 int id;
467 return FRAME_X_DISPLAY_INFO (f)->bitmaps[id - 1].height;
471 x_bitmap_width (f, id)
472 FRAME_PTR f;
473 int id;
475 return FRAME_X_DISPLAY_INFO (f)->bitmaps[id - 1].width;
479 x_bitmap_pixmap (f, id)
480 FRAME_PTR f;
481 int id;
483 return FRAME_X_DISPLAY_INFO (f)->bitmaps[id - 1].pixmap;
487 /* Allocate a new bitmap record. Returns index of new record. */
489 static int
490 x_allocate_bitmap_record (f)
491 FRAME_PTR f;
493 struct x_display_info *dpyinfo = FRAME_X_DISPLAY_INFO (f);
494 int i;
496 if (dpyinfo->bitmaps == NULL)
498 dpyinfo->bitmaps_size = 10;
499 dpyinfo->bitmaps
500 = (struct x_bitmap_record *) xmalloc (dpyinfo->bitmaps_size * sizeof (struct x_bitmap_record));
501 dpyinfo->bitmaps_last = 1;
502 return 1;
505 if (dpyinfo->bitmaps_last < dpyinfo->bitmaps_size)
506 return ++dpyinfo->bitmaps_last;
508 for (i = 0; i < dpyinfo->bitmaps_size; ++i)
509 if (dpyinfo->bitmaps[i].refcount == 0)
510 return i + 1;
512 dpyinfo->bitmaps_size *= 2;
513 dpyinfo->bitmaps
514 = (struct x_bitmap_record *) xrealloc (dpyinfo->bitmaps,
515 dpyinfo->bitmaps_size * sizeof (struct x_bitmap_record));
516 return ++dpyinfo->bitmaps_last;
519 /* Add one reference to the reference count of the bitmap with id ID. */
521 void
522 x_reference_bitmap (f, id)
523 FRAME_PTR f;
524 int id;
526 ++FRAME_X_DISPLAY_INFO (f)->bitmaps[id - 1].refcount;
529 /* Create a bitmap for frame F from a HEIGHT x WIDTH array of bits at BITS. */
532 x_create_bitmap_from_data (f, bits, width, height)
533 struct frame *f;
534 char *bits;
535 unsigned int width, height;
537 struct x_display_info *dpyinfo = FRAME_X_DISPLAY_INFO (f);
538 Pixmap bitmap;
539 int id;
541 bitmap = XCreateBitmapFromData (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
542 bits, width, height);
544 if (! bitmap)
545 return -1;
547 id = x_allocate_bitmap_record (f);
548 dpyinfo->bitmaps[id - 1].pixmap = bitmap;
549 dpyinfo->bitmaps[id - 1].file = NULL;
550 dpyinfo->bitmaps[id - 1].refcount = 1;
551 dpyinfo->bitmaps[id - 1].depth = 1;
552 dpyinfo->bitmaps[id - 1].height = height;
553 dpyinfo->bitmaps[id - 1].width = width;
555 return id;
558 /* Create bitmap from file FILE for frame F. */
561 x_create_bitmap_from_file (f, file)
562 struct frame *f;
563 Lisp_Object file;
565 struct x_display_info *dpyinfo = FRAME_X_DISPLAY_INFO (f);
566 unsigned int width, height;
567 Pixmap bitmap;
568 int xhot, yhot, result, id;
569 Lisp_Object found;
570 int fd;
571 char *filename;
573 /* Look for an existing bitmap with the same name. */
574 for (id = 0; id < dpyinfo->bitmaps_last; ++id)
576 if (dpyinfo->bitmaps[id].refcount
577 && dpyinfo->bitmaps[id].file
578 && !strcmp (dpyinfo->bitmaps[id].file, (char *) XSTRING (file)->data))
580 ++dpyinfo->bitmaps[id].refcount;
581 return id + 1;
585 /* Search bitmap-file-path for the file, if appropriate. */
586 fd = openp (Vx_bitmap_file_path, file, "", &found, 0);
587 if (fd < 0)
588 return -1;
589 close (fd);
591 filename = (char *) XSTRING (found)->data;
593 result = XReadBitmapFile (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
594 filename, &width, &height, &bitmap, &xhot, &yhot);
595 if (result != BitmapSuccess)
596 return -1;
598 id = x_allocate_bitmap_record (f);
599 dpyinfo->bitmaps[id - 1].pixmap = bitmap;
600 dpyinfo->bitmaps[id - 1].refcount = 1;
601 dpyinfo->bitmaps[id - 1].file = (char *) xmalloc (XSTRING (file)->size + 1);
602 dpyinfo->bitmaps[id - 1].depth = 1;
603 dpyinfo->bitmaps[id - 1].height = height;
604 dpyinfo->bitmaps[id - 1].width = width;
605 strcpy (dpyinfo->bitmaps[id - 1].file, XSTRING (file)->data);
607 return id;
610 /* Remove reference to bitmap with id number ID. */
613 x_destroy_bitmap (f, id)
614 FRAME_PTR f;
615 int id;
617 struct x_display_info *dpyinfo = FRAME_X_DISPLAY_INFO (f);
619 if (id > 0)
621 --dpyinfo->bitmaps[id - 1].refcount;
622 if (dpyinfo->bitmaps[id - 1].refcount == 0)
624 BLOCK_INPUT;
625 XFreePixmap (FRAME_X_DISPLAY (f), dpyinfo->bitmaps[id - 1].pixmap);
626 if (dpyinfo->bitmaps[id - 1].file)
628 free (dpyinfo->bitmaps[id - 1].file);
629 dpyinfo->bitmaps[id - 1].file = NULL;
631 UNBLOCK_INPUT;
636 /* Free all the bitmaps for the display specified by DPYINFO. */
638 static void
639 x_destroy_all_bitmaps (dpyinfo)
640 struct x_display_info *dpyinfo;
642 int i;
643 for (i = 0; i < dpyinfo->bitmaps_last; i++)
644 if (dpyinfo->bitmaps[i].refcount > 0)
646 XFreePixmap (dpyinfo->display, dpyinfo->bitmaps[i].pixmap);
647 if (dpyinfo->bitmaps[i].file)
648 free (dpyinfo->bitmaps[i].file);
650 dpyinfo->bitmaps_last = 0;
653 /* Connect the frame-parameter names for X frames
654 to the ways of passing the parameter values to the window system.
656 The name of a parameter, as a Lisp symbol,
657 has an `x-frame-parameter' property which is an integer in Lisp
658 that is an index in this table. */
660 struct x_frame_parm_table
662 char *name;
663 void (*setter)( /* struct frame *frame, Lisp_Object val, oldval */ );
666 void x_set_foreground_color ();
667 void x_set_background_color ();
668 void x_set_mouse_color ();
669 void x_set_cursor_color ();
670 void x_set_border_color ();
671 void x_set_cursor_type ();
672 void x_set_icon_type ();
673 void x_set_icon_name ();
674 void x_set_font ();
675 void x_set_border_width ();
676 void x_set_internal_border_width ();
677 void x_explicitly_set_name ();
678 void x_set_autoraise ();
679 void x_set_autolower ();
680 void x_set_vertical_scroll_bars ();
681 void x_set_visibility ();
682 void x_set_menu_bar_lines ();
683 void x_set_scroll_bar_width ();
684 void x_set_title ();
685 void x_set_unsplittable ();
687 static struct x_frame_parm_table x_frame_parms[] =
689 "auto-raise", x_set_autoraise,
690 "auto-lower", x_set_autolower,
691 "background-color", x_set_background_color,
692 "border-color", x_set_border_color,
693 "border-width", x_set_border_width,
694 "cursor-color", x_set_cursor_color,
695 "cursor-type", x_set_cursor_type,
696 "font", x_set_font,
697 "foreground-color", x_set_foreground_color,
698 "icon-name", x_set_icon_name,
699 "icon-type", x_set_icon_type,
700 "internal-border-width", x_set_internal_border_width,
701 "menu-bar-lines", x_set_menu_bar_lines,
702 "mouse-color", x_set_mouse_color,
703 "name", x_explicitly_set_name,
704 "scroll-bar-width", x_set_scroll_bar_width,
705 "title", x_set_title,
706 "unsplittable", x_set_unsplittable,
707 "vertical-scroll-bars", x_set_vertical_scroll_bars,
708 "visibility", x_set_visibility,
711 /* Attach the `x-frame-parameter' properties to
712 the Lisp symbol names of parameters relevant to X. */
714 init_x_parm_symbols ()
716 int i;
718 for (i = 0; i < sizeof (x_frame_parms) / sizeof (x_frame_parms[0]); i++)
719 Fput (intern (x_frame_parms[i].name), Qx_frame_parameter,
720 make_number (i));
723 /* Change the parameters of FRAME as specified by ALIST.
724 If a parameter is not specially recognized, do nothing;
725 otherwise call the `x_set_...' function for that parameter. */
727 void
728 x_set_frame_parameters (f, alist)
729 FRAME_PTR f;
730 Lisp_Object alist;
732 Lisp_Object tail;
734 /* If both of these parameters are present, it's more efficient to
735 set them both at once. So we wait until we've looked at the
736 entire list before we set them. */
737 int width, height;
739 /* Same here. */
740 Lisp_Object left, top;
742 /* Same with these. */
743 Lisp_Object icon_left, icon_top;
745 /* Record in these vectors all the parms specified. */
746 Lisp_Object *parms;
747 Lisp_Object *values;
748 int i;
749 int left_no_change = 0, top_no_change = 0;
750 int icon_left_no_change = 0, icon_top_no_change = 0;
752 i = 0;
753 for (tail = alist; CONSP (tail); tail = Fcdr (tail))
754 i++;
756 parms = (Lisp_Object *) alloca (i * sizeof (Lisp_Object));
757 values = (Lisp_Object *) alloca (i * sizeof (Lisp_Object));
759 /* Extract parm names and values into those vectors. */
761 i = 0;
762 for (tail = alist; CONSP (tail); tail = Fcdr (tail))
764 Lisp_Object elt, prop, val;
766 elt = Fcar (tail);
767 parms[i] = Fcar (elt);
768 values[i] = Fcdr (elt);
769 i++;
772 top = left = Qunbound;
773 icon_left = icon_top = Qunbound;
775 /* Provide default values for HEIGHT and WIDTH. */
776 if (FRAME_NEW_WIDTH (f))
777 width = FRAME_NEW_WIDTH (f);
778 else
779 width = FRAME_WIDTH (f);
781 if (FRAME_NEW_HEIGHT (f))
782 height = FRAME_NEW_HEIGHT (f);
783 else
784 height = FRAME_HEIGHT (f);
786 /* Now process them in reverse of specified order. */
787 for (i--; i >= 0; i--)
789 Lisp_Object prop, val;
791 prop = parms[i];
792 val = values[i];
794 if (EQ (prop, Qwidth) && NUMBERP (val))
795 width = XFASTINT (val);
796 else if (EQ (prop, Qheight) && NUMBERP (val))
797 height = XFASTINT (val);
798 else if (EQ (prop, Qtop))
799 top = val;
800 else if (EQ (prop, Qleft))
801 left = val;
802 else if (EQ (prop, Qicon_top))
803 icon_top = val;
804 else if (EQ (prop, Qicon_left))
805 icon_left = val;
806 else
808 register Lisp_Object param_index, old_value;
810 param_index = Fget (prop, Qx_frame_parameter);
811 old_value = get_frame_param (f, prop);
812 store_frame_param (f, prop, val);
813 if (NATNUMP (param_index)
814 && (XFASTINT (param_index)
815 < sizeof (x_frame_parms)/sizeof (x_frame_parms[0])))
816 (*x_frame_parms[XINT (param_index)].setter)(f, val, old_value);
820 /* Don't die if just one of these was set. */
821 if (EQ (left, Qunbound))
823 left_no_change = 1;
824 if (f->output_data.x->left_pos < 0)
825 left = Fcons (Qplus, Fcons (make_number (f->output_data.x->left_pos), Qnil));
826 else
827 XSETINT (left, f->output_data.x->left_pos);
829 if (EQ (top, Qunbound))
831 top_no_change = 1;
832 if (f->output_data.x->top_pos < 0)
833 top = Fcons (Qplus, Fcons (make_number (f->output_data.x->top_pos), Qnil));
834 else
835 XSETINT (top, f->output_data.x->top_pos);
838 /* If one of the icon positions was not set, preserve or default it. */
839 if (EQ (icon_left, Qunbound) || ! INTEGERP (icon_left))
841 icon_left_no_change = 1;
842 icon_left = Fcdr (Fassq (Qicon_left, f->param_alist));
843 if (NILP (icon_left))
844 XSETINT (icon_left, 0);
846 if (EQ (icon_top, Qunbound) || ! INTEGERP (icon_top))
848 icon_top_no_change = 1;
849 icon_top = Fcdr (Fassq (Qicon_top, f->param_alist));
850 if (NILP (icon_top))
851 XSETINT (icon_top, 0);
854 /* Don't set these parameters unless they've been explicitly
855 specified. The window might be mapped or resized while we're in
856 this function, and we don't want to override that unless the lisp
857 code has asked for it.
859 Don't set these parameters unless they actually differ from the
860 window's current parameters; the window may not actually exist
861 yet. */
863 Lisp_Object frame;
865 check_frame_size (f, &height, &width);
867 XSETFRAME (frame, f);
869 if (width != FRAME_WIDTH (f)
870 || height != FRAME_HEIGHT (f)
871 || FRAME_NEW_HEIGHT (f) || FRAME_NEW_WIDTH (f))
872 Fset_frame_size (frame, make_number (width), make_number (height));
874 if ((!NILP (left) || !NILP (top))
875 && ! (left_no_change && top_no_change)
876 && ! (NUMBERP (left) && XINT (left) == f->output_data.x->left_pos
877 && NUMBERP (top) && XINT (top) == f->output_data.x->top_pos))
879 int leftpos = 0;
880 int toppos = 0;
882 /* Record the signs. */
883 f->output_data.x->size_hint_flags &= ~ (XNegative | YNegative);
884 if (EQ (left, Qminus))
885 f->output_data.x->size_hint_flags |= XNegative;
886 else if (INTEGERP (left))
888 leftpos = XINT (left);
889 if (leftpos < 0)
890 f->output_data.x->size_hint_flags |= XNegative;
892 else if (CONSP (left) && EQ (XCONS (left)->car, Qminus)
893 && CONSP (XCONS (left)->cdr)
894 && INTEGERP (XCONS (XCONS (left)->cdr)->car))
896 leftpos = - XINT (XCONS (XCONS (left)->cdr)->car);
897 f->output_data.x->size_hint_flags |= XNegative;
899 else if (CONSP (left) && EQ (XCONS (left)->car, Qplus)
900 && CONSP (XCONS (left)->cdr)
901 && INTEGERP (XCONS (XCONS (left)->cdr)->car))
903 leftpos = XINT (XCONS (XCONS (left)->cdr)->car);
906 if (EQ (top, Qminus))
907 f->output_data.x->size_hint_flags |= YNegative;
908 else if (INTEGERP (top))
910 toppos = XINT (top);
911 if (toppos < 0)
912 f->output_data.x->size_hint_flags |= YNegative;
914 else if (CONSP (top) && EQ (XCONS (top)->car, Qminus)
915 && CONSP (XCONS (top)->cdr)
916 && INTEGERP (XCONS (XCONS (top)->cdr)->car))
918 toppos = - XINT (XCONS (XCONS (top)->cdr)->car);
919 f->output_data.x->size_hint_flags |= YNegative;
921 else if (CONSP (top) && EQ (XCONS (top)->car, Qplus)
922 && CONSP (XCONS (top)->cdr)
923 && INTEGERP (XCONS (XCONS (top)->cdr)->car))
925 toppos = XINT (XCONS (XCONS (top)->cdr)->car);
929 /* Store the numeric value of the position. */
930 f->output_data.x->top_pos = toppos;
931 f->output_data.x->left_pos = leftpos;
933 f->output_data.x->win_gravity = NorthWestGravity;
935 /* Actually set that position, and convert to absolute. */
936 x_set_offset (f, leftpos, toppos, -1);
939 if ((!NILP (icon_left) || !NILP (icon_top))
940 && ! (icon_left_no_change && icon_top_no_change))
941 x_wm_set_icon_position (f, XINT (icon_left), XINT (icon_top));
945 /* Store the screen positions of frame F into XPTR and YPTR.
946 These are the positions of the containing window manager window,
947 not Emacs's own window. */
949 void
950 x_real_positions (f, xptr, yptr)
951 FRAME_PTR f;
952 int *xptr, *yptr;
954 int win_x, win_y;
955 Window child;
957 /* This is pretty gross, but seems to be the easiest way out of
958 the problem that arises when restarting window-managers. */
960 #ifdef USE_X_TOOLKIT
961 Window outer = XtWindow (f->output_data.x->widget);
962 #else
963 Window outer = f->output_data.x->window_desc;
964 #endif
965 Window tmp_root_window;
966 Window *tmp_children;
967 int tmp_nchildren;
969 while (1)
971 int count = x_catch_errors (FRAME_X_DISPLAY (f));
973 XQueryTree (FRAME_X_DISPLAY (f), outer, &tmp_root_window,
974 &f->output_data.x->parent_desc,
975 &tmp_children, &tmp_nchildren);
976 XFree ((char *) tmp_children);
978 win_x = win_y = 0;
980 /* Find the position of the outside upper-left corner of
981 the inner window, with respect to the outer window. */
982 if (f->output_data.x->parent_desc != FRAME_X_DISPLAY_INFO (f)->root_window)
984 XTranslateCoordinates (FRAME_X_DISPLAY (f),
986 /* From-window, to-window. */
987 #ifdef USE_X_TOOLKIT
988 XtWindow (f->output_data.x->widget),
989 #else
990 f->output_data.x->window_desc,
991 #endif
992 f->output_data.x->parent_desc,
994 /* From-position, to-position. */
995 0, 0, &win_x, &win_y,
997 /* Child of win. */
998 &child);
1000 #if 0 /* The values seem to be right without this and wrong with. */
1001 win_x += f->output_data.x->border_width;
1002 win_y += f->output_data.x->border_width;
1003 #endif
1006 /* It is possible for the window returned by the XQueryNotify
1007 to become invalid by the time we call XTranslateCoordinates.
1008 That can happen when you restart some window managers.
1009 If so, we get an error in XTranslateCoordinates.
1010 Detect that and try the whole thing over. */
1011 if (! x_had_errors_p (FRAME_X_DISPLAY (f)))
1013 x_uncatch_errors (FRAME_X_DISPLAY (f), count);
1014 break;
1017 x_uncatch_errors (FRAME_X_DISPLAY (f), count);
1020 *xptr = f->output_data.x->left_pos - win_x;
1021 *yptr = f->output_data.x->top_pos - win_y;
1024 /* Insert a description of internally-recorded parameters of frame X
1025 into the parameter alist *ALISTPTR that is to be given to the user.
1026 Only parameters that are specific to the X window system
1027 and whose values are not correctly recorded in the frame's
1028 param_alist need to be considered here. */
1030 x_report_frame_params (f, alistptr)
1031 struct frame *f;
1032 Lisp_Object *alistptr;
1034 char buf[16];
1035 Lisp_Object tem;
1037 /* Represent negative positions (off the top or left screen edge)
1038 in a way that Fmodify_frame_parameters will understand correctly. */
1039 XSETINT (tem, f->output_data.x->left_pos);
1040 if (f->output_data.x->left_pos >= 0)
1041 store_in_alist (alistptr, Qleft, tem);
1042 else
1043 store_in_alist (alistptr, Qleft, Fcons (Qplus, Fcons (tem, Qnil)));
1045 XSETINT (tem, f->output_data.x->top_pos);
1046 if (f->output_data.x->top_pos >= 0)
1047 store_in_alist (alistptr, Qtop, tem);
1048 else
1049 store_in_alist (alistptr, Qtop, Fcons (Qplus, Fcons (tem, Qnil)));
1051 store_in_alist (alistptr, Qborder_width,
1052 make_number (f->output_data.x->border_width));
1053 store_in_alist (alistptr, Qinternal_border_width,
1054 make_number (f->output_data.x->internal_border_width));
1055 sprintf (buf, "%ld", (long) FRAME_X_WINDOW (f));
1056 store_in_alist (alistptr, Qwindow_id,
1057 build_string (buf));
1058 store_in_alist (alistptr, Qicon_name, f->icon_name);
1059 FRAME_SAMPLE_VISIBILITY (f);
1060 store_in_alist (alistptr, Qvisibility,
1061 (FRAME_VISIBLE_P (f) ? Qt
1062 : FRAME_ICONIFIED_P (f) ? Qicon : Qnil));
1063 store_in_alist (alistptr, Qdisplay,
1064 XCONS (FRAME_X_DISPLAY_INFO (f)->name_list_element)->car);
1066 store_in_alist (alistptr, Qparent_id,
1067 (f->output_data.x->parent_desc == FRAME_X_DISPLAY_INFO (f)->root_window
1068 ? Qnil : f->output_data.x->parent_desc));
1072 /* Decide if color named COLOR is valid for the display associated with
1073 the selected frame; if so, return the rgb values in COLOR_DEF.
1074 If ALLOC is nonzero, allocate a new colormap cell. */
1077 defined_color (f, color, color_def, alloc)
1078 FRAME_PTR f;
1079 char *color;
1080 XColor *color_def;
1081 int alloc;
1083 register int status;
1084 Colormap screen_colormap;
1085 Display *display = FRAME_X_DISPLAY (f);
1087 BLOCK_INPUT;
1088 screen_colormap = DefaultColormap (display, XDefaultScreen (display));
1090 status = XParseColor (display, screen_colormap, color, color_def);
1091 if (status && alloc)
1093 status = XAllocColor (display, screen_colormap, color_def);
1094 if (!status)
1096 /* If we got to this point, the colormap is full, so we're
1097 going to try and get the next closest color.
1098 The algorithm used is a least-squares matching, which is
1099 what X uses for closest color matching with StaticColor visuals. */
1101 XColor *cells;
1102 int no_cells;
1103 int nearest;
1104 long nearest_delta, trial_delta;
1105 int x;
1107 no_cells = XDisplayCells (display, XDefaultScreen (display));
1108 cells = (XColor *) alloca (sizeof (XColor) * no_cells);
1110 for (x = 0; x < no_cells; x++)
1111 cells[x].pixel = x;
1113 XQueryColors (display, screen_colormap, cells, no_cells);
1114 nearest = 0;
1115 /* I'm assuming CSE so I'm not going to condense this. */
1116 nearest_delta = ((((color_def->red >> 8) - (cells[0].red >> 8))
1117 * ((color_def->red >> 8) - (cells[0].red >> 8)))
1119 (((color_def->green >> 8) - (cells[0].green >> 8))
1120 * ((color_def->green >> 8) - (cells[0].green >> 8)))
1122 (((color_def->blue >> 8) - (cells[0].blue >> 8))
1123 * ((color_def->blue >> 8) - (cells[0].blue >> 8))));
1124 for (x = 1; x < no_cells; x++)
1126 trial_delta = ((((color_def->red >> 8) - (cells[x].red >> 8))
1127 * ((color_def->red >> 8) - (cells[x].red >> 8)))
1129 (((color_def->green >> 8) - (cells[x].green >> 8))
1130 * ((color_def->green >> 8) - (cells[x].green >> 8)))
1132 (((color_def->blue >> 8) - (cells[x].blue >> 8))
1133 * ((color_def->blue >> 8) - (cells[x].blue >> 8))));
1134 if (trial_delta < nearest_delta)
1136 XColor temp;
1137 temp.red = cells[x].red;
1138 temp.green = cells[x].green;
1139 temp.blue = cells[x].blue;
1140 status = XAllocColor (display, screen_colormap, &temp);
1141 if (status)
1143 nearest = x;
1144 nearest_delta = trial_delta;
1148 color_def->red = cells[nearest].red;
1149 color_def->green = cells[nearest].green;
1150 color_def->blue = cells[nearest].blue;
1151 status = XAllocColor (display, screen_colormap, color_def);
1154 UNBLOCK_INPUT;
1156 if (status)
1157 return 1;
1158 else
1159 return 0;
1162 /* Given a string ARG naming a color, compute a pixel value from it
1163 suitable for screen F.
1164 If F is not a color screen, return DEF (default) regardless of what
1165 ARG says. */
1168 x_decode_color (f, arg, def)
1169 FRAME_PTR f;
1170 Lisp_Object arg;
1171 int def;
1173 XColor cdef;
1175 CHECK_STRING (arg, 0);
1177 if (strcmp (XSTRING (arg)->data, "black") == 0)
1178 return BLACK_PIX_DEFAULT (f);
1179 else if (strcmp (XSTRING (arg)->data, "white") == 0)
1180 return WHITE_PIX_DEFAULT (f);
1182 if (FRAME_X_DISPLAY_INFO (f)->n_planes == 1)
1183 return def;
1185 /* defined_color is responsible for coping with failures
1186 by looking for a near-miss. */
1187 if (defined_color (f, XSTRING (arg)->data, &cdef, 1))
1188 return cdef.pixel;
1190 Fsignal (Qerror, Fcons (build_string ("undefined color"),
1191 Fcons (arg, Qnil)));
1194 /* Functions called only from `x_set_frame_param'
1195 to set individual parameters.
1197 If FRAME_X_WINDOW (f) is 0,
1198 the frame is being created and its X-window does not exist yet.
1199 In that case, just record the parameter's new value
1200 in the standard place; do not attempt to change the window. */
1202 void
1203 x_set_foreground_color (f, arg, oldval)
1204 struct frame *f;
1205 Lisp_Object arg, oldval;
1207 f->output_data.x->foreground_pixel
1208 = x_decode_color (f, arg, BLACK_PIX_DEFAULT (f));
1209 if (FRAME_X_WINDOW (f) != 0)
1211 BLOCK_INPUT;
1212 XSetForeground (FRAME_X_DISPLAY (f), f->output_data.x->normal_gc,
1213 f->output_data.x->foreground_pixel);
1214 XSetBackground (FRAME_X_DISPLAY (f), f->output_data.x->reverse_gc,
1215 f->output_data.x->foreground_pixel);
1216 UNBLOCK_INPUT;
1217 recompute_basic_faces (f);
1218 if (FRAME_VISIBLE_P (f))
1219 redraw_frame (f);
1223 void
1224 x_set_background_color (f, arg, oldval)
1225 struct frame *f;
1226 Lisp_Object arg, oldval;
1228 Pixmap temp;
1229 int mask;
1231 f->output_data.x->background_pixel
1232 = x_decode_color (f, arg, WHITE_PIX_DEFAULT (f));
1234 if (FRAME_X_WINDOW (f) != 0)
1236 BLOCK_INPUT;
1237 /* The main frame area. */
1238 XSetBackground (FRAME_X_DISPLAY (f), f->output_data.x->normal_gc,
1239 f->output_data.x->background_pixel);
1240 XSetForeground (FRAME_X_DISPLAY (f), f->output_data.x->reverse_gc,
1241 f->output_data.x->background_pixel);
1242 XSetForeground (FRAME_X_DISPLAY (f), f->output_data.x->cursor_gc,
1243 f->output_data.x->background_pixel);
1244 XSetWindowBackground (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
1245 f->output_data.x->background_pixel);
1247 Lisp_Object bar;
1248 for (bar = FRAME_SCROLL_BARS (f); !NILP (bar);
1249 bar = XSCROLL_BAR (bar)->next)
1250 XSetWindowBackground (FRAME_X_DISPLAY (f),
1251 SCROLL_BAR_X_WINDOW (XSCROLL_BAR (bar)),
1252 f->output_data.x->background_pixel);
1254 UNBLOCK_INPUT;
1256 recompute_basic_faces (f);
1258 if (FRAME_VISIBLE_P (f))
1259 redraw_frame (f);
1263 void
1264 x_set_mouse_color (f, arg, oldval)
1265 struct frame *f;
1266 Lisp_Object arg, oldval;
1268 Cursor cursor, nontext_cursor, mode_cursor, cross_cursor;
1269 int count;
1270 int mask_color;
1272 if (!EQ (Qnil, arg))
1273 f->output_data.x->mouse_pixel
1274 = x_decode_color (f, arg, BLACK_PIX_DEFAULT (f));
1275 mask_color = f->output_data.x->background_pixel;
1276 /* No invisible pointers. */
1277 if (mask_color == f->output_data.x->mouse_pixel
1278 && mask_color == f->output_data.x->background_pixel)
1279 f->output_data.x->mouse_pixel = f->output_data.x->foreground_pixel;
1281 BLOCK_INPUT;
1283 /* It's not okay to crash if the user selects a screwy cursor. */
1284 count = x_catch_errors (FRAME_X_DISPLAY (f));
1286 if (!EQ (Qnil, Vx_pointer_shape))
1288 CHECK_NUMBER (Vx_pointer_shape, 0);
1289 cursor = XCreateFontCursor (FRAME_X_DISPLAY (f), XINT (Vx_pointer_shape));
1291 else
1292 cursor = XCreateFontCursor (FRAME_X_DISPLAY (f), XC_xterm);
1293 x_check_errors (FRAME_X_DISPLAY (f), "bad text pointer cursor: %s");
1295 if (!EQ (Qnil, Vx_nontext_pointer_shape))
1297 CHECK_NUMBER (Vx_nontext_pointer_shape, 0);
1298 nontext_cursor = XCreateFontCursor (FRAME_X_DISPLAY (f),
1299 XINT (Vx_nontext_pointer_shape));
1301 else
1302 nontext_cursor = XCreateFontCursor (FRAME_X_DISPLAY (f), XC_left_ptr);
1303 x_check_errors (FRAME_X_DISPLAY (f), "bad nontext pointer cursor: %s");
1305 if (!EQ (Qnil, Vx_mode_pointer_shape))
1307 CHECK_NUMBER (Vx_mode_pointer_shape, 0);
1308 mode_cursor = XCreateFontCursor (FRAME_X_DISPLAY (f),
1309 XINT (Vx_mode_pointer_shape));
1311 else
1312 mode_cursor = XCreateFontCursor (FRAME_X_DISPLAY (f), XC_xterm);
1313 x_check_errors (FRAME_X_DISPLAY (f), "bad modeline pointer cursor: %s");
1315 if (!EQ (Qnil, Vx_sensitive_text_pointer_shape))
1317 CHECK_NUMBER (Vx_sensitive_text_pointer_shape, 0);
1318 cross_cursor
1319 = XCreateFontCursor (FRAME_X_DISPLAY (f),
1320 XINT (Vx_sensitive_text_pointer_shape));
1322 else
1323 cross_cursor = XCreateFontCursor (FRAME_X_DISPLAY (f), XC_crosshair);
1325 /* Check and report errors with the above calls. */
1326 x_check_errors (FRAME_X_DISPLAY (f), "can't set cursor shape: %s");
1327 x_uncatch_errors (FRAME_X_DISPLAY (f), count);
1330 XColor fore_color, back_color;
1332 fore_color.pixel = f->output_data.x->mouse_pixel;
1333 back_color.pixel = mask_color;
1334 XQueryColor (FRAME_X_DISPLAY (f),
1335 DefaultColormap (FRAME_X_DISPLAY (f),
1336 DefaultScreen (FRAME_X_DISPLAY (f))),
1337 &fore_color);
1338 XQueryColor (FRAME_X_DISPLAY (f),
1339 DefaultColormap (FRAME_X_DISPLAY (f),
1340 DefaultScreen (FRAME_X_DISPLAY (f))),
1341 &back_color);
1342 XRecolorCursor (FRAME_X_DISPLAY (f), cursor,
1343 &fore_color, &back_color);
1344 XRecolorCursor (FRAME_X_DISPLAY (f), nontext_cursor,
1345 &fore_color, &back_color);
1346 XRecolorCursor (FRAME_X_DISPLAY (f), mode_cursor,
1347 &fore_color, &back_color);
1348 XRecolorCursor (FRAME_X_DISPLAY (f), cross_cursor,
1349 &fore_color, &back_color);
1352 if (FRAME_X_WINDOW (f) != 0)
1354 XDefineCursor (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f), cursor);
1357 if (cursor != f->output_data.x->text_cursor && f->output_data.x->text_cursor != 0)
1358 XFreeCursor (FRAME_X_DISPLAY (f), f->output_data.x->text_cursor);
1359 f->output_data.x->text_cursor = cursor;
1361 if (nontext_cursor != f->output_data.x->nontext_cursor
1362 && f->output_data.x->nontext_cursor != 0)
1363 XFreeCursor (FRAME_X_DISPLAY (f), f->output_data.x->nontext_cursor);
1364 f->output_data.x->nontext_cursor = nontext_cursor;
1366 if (mode_cursor != f->output_data.x->modeline_cursor
1367 && f->output_data.x->modeline_cursor != 0)
1368 XFreeCursor (FRAME_X_DISPLAY (f), f->output_data.x->modeline_cursor);
1369 f->output_data.x->modeline_cursor = mode_cursor;
1370 if (cross_cursor != f->output_data.x->cross_cursor
1371 && f->output_data.x->cross_cursor != 0)
1372 XFreeCursor (FRAME_X_DISPLAY (f), f->output_data.x->cross_cursor);
1373 f->output_data.x->cross_cursor = cross_cursor;
1375 XFlush (FRAME_X_DISPLAY (f));
1376 UNBLOCK_INPUT;
1379 void
1380 x_set_cursor_color (f, arg, oldval)
1381 struct frame *f;
1382 Lisp_Object arg, oldval;
1384 unsigned long fore_pixel;
1386 if (!EQ (Vx_cursor_fore_pixel, Qnil))
1387 fore_pixel = x_decode_color (f, Vx_cursor_fore_pixel,
1388 WHITE_PIX_DEFAULT (f));
1389 else
1390 fore_pixel = f->output_data.x->background_pixel;
1391 f->output_data.x->cursor_pixel = x_decode_color (f, arg, BLACK_PIX_DEFAULT (f));
1393 /* Make sure that the cursor color differs from the background color. */
1394 if (f->output_data.x->cursor_pixel == f->output_data.x->background_pixel)
1396 f->output_data.x->cursor_pixel = f->output_data.x->mouse_pixel;
1397 if (f->output_data.x->cursor_pixel == fore_pixel)
1398 fore_pixel = f->output_data.x->background_pixel;
1400 f->output_data.x->cursor_foreground_pixel = fore_pixel;
1402 if (FRAME_X_WINDOW (f) != 0)
1404 BLOCK_INPUT;
1405 XSetBackground (FRAME_X_DISPLAY (f), f->output_data.x->cursor_gc,
1406 f->output_data.x->cursor_pixel);
1407 XSetForeground (FRAME_X_DISPLAY (f), f->output_data.x->cursor_gc,
1408 fore_pixel);
1409 UNBLOCK_INPUT;
1411 if (FRAME_VISIBLE_P (f))
1413 x_update_cursor (f, 0);
1414 x_update_cursor (f, 1);
1419 /* Set the border-color of frame F to value described by ARG.
1420 ARG can be a string naming a color.
1421 The border-color is used for the border that is drawn by the X server.
1422 Note that this does not fully take effect if done before
1423 F has an x-window; it must be redone when the window is created.
1425 Note: this is done in two routines because of the way X10 works.
1427 Note: under X11, this is normally the province of the window manager,
1428 and so emacs' border colors may be overridden. */
1430 void
1431 x_set_border_color (f, arg, oldval)
1432 struct frame *f;
1433 Lisp_Object arg, oldval;
1435 unsigned char *str;
1436 int pix;
1438 CHECK_STRING (arg, 0);
1439 str = XSTRING (arg)->data;
1441 pix = x_decode_color (f, arg, BLACK_PIX_DEFAULT (f));
1443 x_set_border_pixel (f, pix);
1446 /* Set the border-color of frame F to pixel value PIX.
1447 Note that this does not fully take effect if done before
1448 F has an x-window. */
1450 x_set_border_pixel (f, pix)
1451 struct frame *f;
1452 int pix;
1454 f->output_data.x->border_pixel = pix;
1456 if (FRAME_X_WINDOW (f) != 0 && f->output_data.x->border_width > 0)
1458 Pixmap temp;
1459 int mask;
1461 BLOCK_INPUT;
1462 XSetWindowBorder (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
1463 (unsigned long)pix);
1464 UNBLOCK_INPUT;
1466 if (FRAME_VISIBLE_P (f))
1467 redraw_frame (f);
1471 void
1472 x_set_cursor_type (f, arg, oldval)
1473 FRAME_PTR f;
1474 Lisp_Object arg, oldval;
1476 if (EQ (arg, Qbar))
1478 FRAME_DESIRED_CURSOR (f) = bar_cursor;
1479 f->output_data.x->cursor_width = 2;
1481 else if (CONSP (arg) && EQ (XCONS (arg)->car, Qbar)
1482 && INTEGERP (XCONS (arg)->cdr))
1484 FRAME_DESIRED_CURSOR (f) = bar_cursor;
1485 f->output_data.x->cursor_width = XINT (XCONS (arg)->cdr);
1487 else
1488 /* Treat anything unknown as "box cursor".
1489 It was bad to signal an error; people have trouble fixing
1490 .Xdefaults with Emacs, when it has something bad in it. */
1491 FRAME_DESIRED_CURSOR (f) = filled_box_cursor;
1493 /* Make sure the cursor gets redrawn. This is overkill, but how
1494 often do people change cursor types? */
1495 update_mode_lines++;
1498 void
1499 x_set_icon_type (f, arg, oldval)
1500 struct frame *f;
1501 Lisp_Object arg, oldval;
1503 Lisp_Object tem;
1504 int result;
1506 if (STRINGP (arg))
1508 if (STRINGP (oldval) && EQ (Fstring_equal (oldval, arg), Qt))
1509 return;
1511 else if (!STRINGP (oldval) && EQ (oldval, Qnil) == EQ (arg, Qnil))
1512 return;
1514 BLOCK_INPUT;
1515 if (NILP (arg))
1516 result = x_text_icon (f,
1517 (char *) XSTRING ((!NILP (f->icon_name)
1518 ? f->icon_name
1519 : f->name))->data);
1520 else
1521 result = x_bitmap_icon (f, arg);
1523 if (result)
1525 UNBLOCK_INPUT;
1526 error ("No icon window available");
1529 XFlush (FRAME_X_DISPLAY (f));
1530 UNBLOCK_INPUT;
1533 /* Return non-nil if frame F wants a bitmap icon. */
1535 Lisp_Object
1536 x_icon_type (f)
1537 FRAME_PTR f;
1539 Lisp_Object tem;
1541 tem = assq_no_quit (Qicon_type, f->param_alist);
1542 if (CONSP (tem))
1543 return XCONS (tem)->cdr;
1544 else
1545 return Qnil;
1548 void
1549 x_set_icon_name (f, arg, oldval)
1550 struct frame *f;
1551 Lisp_Object arg, oldval;
1553 Lisp_Object tem;
1554 int result;
1556 if (STRINGP (arg))
1558 if (STRINGP (oldval) && EQ (Fstring_equal (oldval, arg), Qt))
1559 return;
1561 else if (!STRINGP (oldval) && EQ (oldval, Qnil) == EQ (arg, Qnil))
1562 return;
1564 f->icon_name = arg;
1566 if (f->output_data.x->icon_bitmap != 0)
1567 return;
1569 BLOCK_INPUT;
1571 result = x_text_icon (f,
1572 (char *) XSTRING ((!NILP (f->icon_name)
1573 ? f->icon_name
1574 : !NILP (f->title)
1575 ? f->title
1576 : f->name))->data);
1578 if (result)
1580 UNBLOCK_INPUT;
1581 error ("No icon window available");
1584 XFlush (FRAME_X_DISPLAY (f));
1585 UNBLOCK_INPUT;
1588 extern Lisp_Object x_new_font ();
1590 void
1591 x_set_font (f, arg, oldval)
1592 struct frame *f;
1593 Lisp_Object arg, oldval;
1595 Lisp_Object result;
1596 Lisp_Object fontset_name;
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 ();
1621 void
1622 x_set_border_width (f, arg, oldval)
1623 struct frame *f;
1624 Lisp_Object arg, oldval;
1626 CHECK_NUMBER (arg, 0);
1628 if (XINT (arg) == f->output_data.x->border_width)
1629 return;
1631 if (FRAME_X_WINDOW (f) != 0)
1632 error ("Cannot change the border width of a window");
1634 f->output_data.x->border_width = XINT (arg);
1637 void
1638 x_set_internal_border_width (f, arg, oldval)
1639 struct frame *f;
1640 Lisp_Object arg, oldval;
1642 int mask;
1643 int old = f->output_data.x->internal_border_width;
1645 CHECK_NUMBER (arg, 0);
1646 f->output_data.x->internal_border_width = XINT (arg);
1647 if (f->output_data.x->internal_border_width < 0)
1648 f->output_data.x->internal_border_width = 0;
1650 #ifdef USE_X_TOOLKIT
1651 if (f->output_data.x->edit_widget)
1652 widget_store_internal_border (f->output_data.x->edit_widget,
1653 f->output_data.x->internal_border_width);
1654 #endif
1656 if (f->output_data.x->internal_border_width == old)
1657 return;
1659 if (FRAME_X_WINDOW (f) != 0)
1661 BLOCK_INPUT;
1662 x_set_window_size (f, 0, f->width, f->height);
1663 #if 0
1664 x_set_resize_hint (f);
1665 #endif
1666 XFlush (FRAME_X_DISPLAY (f));
1667 UNBLOCK_INPUT;
1668 SET_FRAME_GARBAGED (f);
1672 void
1673 x_set_visibility (f, value, oldval)
1674 struct frame *f;
1675 Lisp_Object value, oldval;
1677 Lisp_Object frame;
1678 XSETFRAME (frame, f);
1680 if (NILP (value))
1681 Fmake_frame_invisible (frame, Qt);
1682 else if (EQ (value, Qicon))
1683 Ficonify_frame (frame);
1684 else
1685 Fmake_frame_visible (frame);
1688 static void
1689 x_set_menu_bar_lines_1 (window, n)
1690 Lisp_Object window;
1691 int n;
1693 struct window *w = XWINDOW (window);
1695 XSETFASTINT (w->top, XFASTINT (w->top) + n);
1696 XSETFASTINT (w->height, XFASTINT (w->height) - n);
1698 /* Handle just the top child in a vertical split. */
1699 if (!NILP (w->vchild))
1700 x_set_menu_bar_lines_1 (w->vchild, n);
1702 /* Adjust all children in a horizontal split. */
1703 for (window = w->hchild; !NILP (window); window = w->next)
1705 w = XWINDOW (window);
1706 x_set_menu_bar_lines_1 (window, n);
1710 void
1711 x_set_menu_bar_lines (f, value, oldval)
1712 struct frame *f;
1713 Lisp_Object value, oldval;
1715 int nlines;
1716 int olines = FRAME_MENU_BAR_LINES (f);
1718 /* Right now, menu bars don't work properly in minibuf-only frames;
1719 most of the commands try to apply themselves to the minibuffer
1720 frame itslef, and get an error because you can't switch buffers
1721 in or split the minibuffer window. */
1722 if (FRAME_MINIBUF_ONLY_P (f))
1723 return;
1725 if (INTEGERP (value))
1726 nlines = XINT (value);
1727 else
1728 nlines = 0;
1730 /* Make sure we redisplay all windows in this frame. */
1731 windows_or_buffers_changed++;
1733 #ifdef USE_X_TOOLKIT
1734 FRAME_MENU_BAR_LINES (f) = 0;
1735 if (nlines)
1737 FRAME_EXTERNAL_MENU_BAR (f) = 1;
1738 if (FRAME_X_P (f) && f->output_data.x->menubar_widget == 0)
1739 /* Make sure next redisplay shows the menu bar. */
1740 XWINDOW (FRAME_SELECTED_WINDOW (f))->update_mode_line = Qt;
1742 else
1744 if (FRAME_EXTERNAL_MENU_BAR (f) == 1)
1745 free_frame_menubar (f);
1746 FRAME_EXTERNAL_MENU_BAR (f) = 0;
1747 if (FRAME_X_P (f))
1748 f->output_data.x->menubar_widget = 0;
1750 #else /* not USE_X_TOOLKIT */
1751 FRAME_MENU_BAR_LINES (f) = nlines;
1752 x_set_menu_bar_lines_1 (f->root_window, nlines - olines);
1753 #endif /* not USE_X_TOOLKIT */
1756 /* Change the name of frame F to NAME. If NAME is nil, set F's name to
1757 x_id_name.
1759 If EXPLICIT is non-zero, that indicates that lisp code is setting the
1760 name; if NAME is a string, set F's name to NAME and set
1761 F->explicit_name; if NAME is Qnil, then clear F->explicit_name.
1763 If EXPLICIT is zero, that indicates that Emacs redisplay code is
1764 suggesting a new name, which lisp code should override; if
1765 F->explicit_name is set, ignore the new name; otherwise, set it. */
1767 void
1768 x_set_name (f, name, explicit)
1769 struct frame *f;
1770 Lisp_Object name;
1771 int explicit;
1773 /* Make sure that requests from lisp code override requests from
1774 Emacs redisplay code. */
1775 if (explicit)
1777 /* If we're switching from explicit to implicit, we had better
1778 update the mode lines and thereby update the title. */
1779 if (f->explicit_name && NILP (name))
1780 update_mode_lines = 1;
1782 f->explicit_name = ! NILP (name);
1784 else if (f->explicit_name)
1785 return;
1787 /* If NAME is nil, set the name to the x_id_name. */
1788 if (NILP (name))
1790 /* Check for no change needed in this very common case
1791 before we do any consing. */
1792 if (!strcmp (FRAME_X_DISPLAY_INFO (f)->x_id_name,
1793 XSTRING (f->name)->data))
1794 return;
1795 name = build_string (FRAME_X_DISPLAY_INFO (f)->x_id_name);
1797 else
1798 CHECK_STRING (name, 0);
1800 /* Don't change the name if it's already NAME. */
1801 if (! NILP (Fstring_equal (name, f->name)))
1802 return;
1804 f->name = name;
1806 /* For setting the frame title, the title parameter should override
1807 the name parameter. */
1808 if (! NILP (f->title))
1809 name = f->title;
1811 if (FRAME_X_WINDOW (f))
1813 BLOCK_INPUT;
1814 #ifdef HAVE_X11R4
1816 XTextProperty text, icon;
1817 Lisp_Object icon_name;
1819 text.value = XSTRING (name)->data;
1820 text.encoding = XA_STRING;
1821 text.format = 8;
1822 text.nitems = XSTRING (name)->size;
1824 icon_name = (!NILP (f->icon_name) ? f->icon_name : name);
1826 icon.value = XSTRING (icon_name)->data;
1827 icon.encoding = XA_STRING;
1828 icon.format = 8;
1829 icon.nitems = XSTRING (icon_name)->size;
1830 #ifdef USE_X_TOOLKIT
1831 XSetWMName (FRAME_X_DISPLAY (f),
1832 XtWindow (f->output_data.x->widget), &text);
1833 XSetWMIconName (FRAME_X_DISPLAY (f), XtWindow (f->output_data.x->widget),
1834 &icon);
1835 #else /* not USE_X_TOOLKIT */
1836 XSetWMName (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f), &text);
1837 XSetWMIconName (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f), &icon);
1838 #endif /* not USE_X_TOOLKIT */
1840 #else /* not HAVE_X11R4 */
1841 XSetIconName (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
1842 XSTRING (name)->data);
1843 XStoreName (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
1844 XSTRING (name)->data);
1845 #endif /* not HAVE_X11R4 */
1846 UNBLOCK_INPUT;
1850 /* This function should be called when the user's lisp code has
1851 specified a name for the frame; the name will override any set by the
1852 redisplay code. */
1853 void
1854 x_explicitly_set_name (f, arg, oldval)
1855 FRAME_PTR f;
1856 Lisp_Object arg, oldval;
1858 x_set_name (f, arg, 1);
1861 /* This function should be called by Emacs redisplay code to set the
1862 name; names set this way will never override names set by the user's
1863 lisp code. */
1864 void
1865 x_implicitly_set_name (f, arg, oldval)
1866 FRAME_PTR f;
1867 Lisp_Object arg, oldval;
1869 x_set_name (f, arg, 0);
1872 /* Change the title of frame F to NAME.
1873 If NAME is nil, use the frame name as the title.
1875 If EXPLICIT is non-zero, that indicates that lisp code is setting the
1876 name; if NAME is a string, set F's name to NAME and set
1877 F->explicit_name; if NAME is Qnil, then clear F->explicit_name.
1879 If EXPLICIT is zero, that indicates that Emacs redisplay code is
1880 suggesting a new name, which lisp code should override; if
1881 F->explicit_name is set, ignore the new name; otherwise, set it. */
1883 void
1884 x_set_title (f, name)
1885 struct frame *f;
1886 Lisp_Object name;
1888 /* Don't change the title if it's already NAME. */
1889 if (EQ (name, f->title))
1890 return;
1892 update_mode_lines = 1;
1894 f->title = name;
1896 if (NILP (name))
1897 name = f->name;
1898 else
1899 CHECK_STRING (name, 0);
1901 if (FRAME_X_WINDOW (f))
1903 BLOCK_INPUT;
1904 #ifdef HAVE_X11R4
1906 XTextProperty text, icon;
1907 Lisp_Object icon_name;
1909 text.value = XSTRING (name)->data;
1910 text.encoding = XA_STRING;
1911 text.format = 8;
1912 text.nitems = XSTRING (name)->size;
1914 icon_name = (!NILP (f->icon_name) ? f->icon_name : name);
1916 icon.value = XSTRING (icon_name)->data;
1917 icon.encoding = XA_STRING;
1918 icon.format = 8;
1919 icon.nitems = XSTRING (icon_name)->size;
1920 #ifdef USE_X_TOOLKIT
1921 XSetWMName (FRAME_X_DISPLAY (f),
1922 XtWindow (f->output_data.x->widget), &text);
1923 XSetWMIconName (FRAME_X_DISPLAY (f), XtWindow (f->output_data.x->widget),
1924 &icon);
1925 #else /* not USE_X_TOOLKIT */
1926 XSetWMName (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f), &text);
1927 XSetWMIconName (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f), &icon);
1928 #endif /* not USE_X_TOOLKIT */
1930 #else /* not HAVE_X11R4 */
1931 XSetIconName (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
1932 XSTRING (name)->data);
1933 XStoreName (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
1934 XSTRING (name)->data);
1935 #endif /* not HAVE_X11R4 */
1936 UNBLOCK_INPUT;
1940 void
1941 x_set_autoraise (f, arg, oldval)
1942 struct frame *f;
1943 Lisp_Object arg, oldval;
1945 f->auto_raise = !EQ (Qnil, arg);
1948 void
1949 x_set_autolower (f, arg, oldval)
1950 struct frame *f;
1951 Lisp_Object arg, oldval;
1953 f->auto_lower = !EQ (Qnil, arg);
1956 void
1957 x_set_unsplittable (f, arg, oldval)
1958 struct frame *f;
1959 Lisp_Object arg, oldval;
1961 f->no_split = !NILP (arg);
1964 void
1965 x_set_vertical_scroll_bars (f, arg, oldval)
1966 struct frame *f;
1967 Lisp_Object arg, oldval;
1969 if ((EQ (arg, Qleft) && FRAME_HAS_VERTICAL_SCROLL_BARS_ON_RIGHT (f))
1970 || (EQ (arg, Qright) && FRAME_HAS_VERTICAL_SCROLL_BARS_ON_LEFT (f))
1971 || (NILP (arg) && FRAME_HAS_VERTICAL_SCROLL_BARS (f))
1972 || (!NILP (arg) && ! FRAME_HAS_VERTICAL_SCROLL_BARS (f)))
1974 FRAME_VERTICAL_SCROLL_BAR_TYPE (f)
1975 = (NILP (arg)
1976 ? vertical_scroll_bar_none
1977 : EQ (Qright, arg)
1978 ? vertical_scroll_bar_right
1979 : vertical_scroll_bar_left);
1981 /* We set this parameter before creating the X window for the
1982 frame, so we can get the geometry right from the start.
1983 However, if the window hasn't been created yet, we shouldn't
1984 call x_set_window_size. */
1985 if (FRAME_X_WINDOW (f))
1986 x_set_window_size (f, 0, FRAME_WIDTH (f), FRAME_HEIGHT (f));
1990 void
1991 x_set_scroll_bar_width (f, arg, oldval)
1992 struct frame *f;
1993 Lisp_Object arg, oldval;
1995 if (NILP (arg))
1997 FRAME_SCROLL_BAR_PIXEL_WIDTH (f) = 0;
1998 FRAME_SCROLL_BAR_COLS (f) = 3;
1999 if (FRAME_X_WINDOW (f))
2000 x_set_window_size (f, 0, FRAME_WIDTH (f), FRAME_HEIGHT (f));
2002 else if (INTEGERP (arg) && XINT (arg) > 0
2003 && XFASTINT (arg) != FRAME_SCROLL_BAR_PIXEL_WIDTH (f))
2005 int wid = FONT_WIDTH (f->output_data.x->font);
2007 if (XFASTINT (arg) <= 2 * VERTICAL_SCROLL_BAR_WIDTH_TRIM)
2008 XSETINT (arg, 2 * VERTICAL_SCROLL_BAR_WIDTH_TRIM + 1);
2010 FRAME_SCROLL_BAR_PIXEL_WIDTH (f) = XFASTINT (arg);
2011 FRAME_SCROLL_BAR_COLS (f) = (XFASTINT (arg) + wid-1) / wid;
2012 if (FRAME_X_WINDOW (f))
2013 x_set_window_size (f, 0, FRAME_WIDTH (f), FRAME_HEIGHT (f));
2016 change_frame_size (f, 0, FRAME_WIDTH (f), 0, 0);
2017 FRAME_CURSOR_X (f) = FRAME_LEFT_SCROLL_BAR_WIDTH (f);
2020 /* Subroutines of creating an X frame. */
2022 /* Make sure that Vx_resource_name is set to a reasonable value.
2023 Fix it up, or set it to `emacs' if it is too hopeless. */
2025 static void
2026 validate_x_resource_name ()
2028 int len;
2029 /* Number of valid characters in the resource name. */
2030 int good_count = 0;
2031 /* Number of invalid characters in the resource name. */
2032 int bad_count = 0;
2033 Lisp_Object new;
2034 int i;
2036 if (!STRINGP (Vx_resource_class))
2037 Vx_resource_class = build_string (EMACS_CLASS);
2039 if (STRINGP (Vx_resource_name))
2041 unsigned char *p = XSTRING (Vx_resource_name)->data;
2042 int i;
2044 len = XSTRING (Vx_resource_name)->size;
2046 /* Only letters, digits, - and _ are valid in resource names.
2047 Count the valid characters and count the invalid ones. */
2048 for (i = 0; i < len; i++)
2050 int c = p[i];
2051 if (! ((c >= 'a' && c <= 'z')
2052 || (c >= 'A' && c <= 'Z')
2053 || (c >= '0' && c <= '9')
2054 || c == '-' || c == '_'))
2055 bad_count++;
2056 else
2057 good_count++;
2060 else
2061 /* Not a string => completely invalid. */
2062 bad_count = 5, good_count = 0;
2064 /* If name is valid already, return. */
2065 if (bad_count == 0)
2066 return;
2068 /* If name is entirely invalid, or nearly so, use `emacs'. */
2069 if (good_count == 0
2070 || (good_count == 1 && bad_count > 0))
2072 Vx_resource_name = build_string ("emacs");
2073 return;
2076 /* Name is partly valid. Copy it and replace the invalid characters
2077 with underscores. */
2079 Vx_resource_name = new = Fcopy_sequence (Vx_resource_name);
2081 for (i = 0; i < len; i++)
2083 int c = XSTRING (new)->data[i];
2084 if (! ((c >= 'a' && c <= 'z')
2085 || (c >= 'A' && c <= 'Z')
2086 || (c >= '0' && c <= '9')
2087 || c == '-' || c == '_'))
2088 XSTRING (new)->data[i] = '_';
2093 extern char *x_get_string_resource ();
2095 DEFUN ("x-get-resource", Fx_get_resource, Sx_get_resource, 2, 4, 0,
2096 "Return the value of ATTRIBUTE, of class CLASS, from the X defaults database.\n\
2097 This uses `INSTANCE.ATTRIBUTE' as the key and `Emacs.CLASS' as the\n\
2098 class, where INSTANCE is the name under which Emacs was invoked, or\n\
2099 the name specified by the `-name' or `-rn' command-line arguments.\n\
2101 The optional arguments COMPONENT and SUBCLASS add to the key and the\n\
2102 class, respectively. You must specify both of them or neither.\n\
2103 If you specify them, the key is `INSTANCE.COMPONENT.ATTRIBUTE'\n\
2104 and the class is `Emacs.CLASS.SUBCLASS'.")
2105 (attribute, class, component, subclass)
2106 Lisp_Object attribute, class, component, subclass;
2108 register char *value;
2109 char *name_key;
2110 char *class_key;
2112 check_x ();
2114 CHECK_STRING (attribute, 0);
2115 CHECK_STRING (class, 0);
2117 if (!NILP (component))
2118 CHECK_STRING (component, 1);
2119 if (!NILP (subclass))
2120 CHECK_STRING (subclass, 2);
2121 if (NILP (component) != NILP (subclass))
2122 error ("x-get-resource: must specify both COMPONENT and SUBCLASS or neither");
2124 validate_x_resource_name ();
2126 /* Allocate space for the components, the dots which separate them,
2127 and the final '\0'. Make them big enough for the worst case. */
2128 name_key = (char *) alloca (XSTRING (Vx_resource_name)->size
2129 + (STRINGP (component)
2130 ? XSTRING (component)->size : 0)
2131 + XSTRING (attribute)->size
2132 + 3);
2134 class_key = (char *) alloca (XSTRING (Vx_resource_class)->size
2135 + XSTRING (class)->size
2136 + (STRINGP (subclass)
2137 ? XSTRING (subclass)->size : 0)
2138 + 3);
2140 /* Start with emacs.FRAMENAME for the name (the specific one)
2141 and with `Emacs' for the class key (the general one). */
2142 strcpy (name_key, XSTRING (Vx_resource_name)->data);
2143 strcpy (class_key, XSTRING (Vx_resource_class)->data);
2145 strcat (class_key, ".");
2146 strcat (class_key, XSTRING (class)->data);
2148 if (!NILP (component))
2150 strcat (class_key, ".");
2151 strcat (class_key, XSTRING (subclass)->data);
2153 strcat (name_key, ".");
2154 strcat (name_key, XSTRING (component)->data);
2157 strcat (name_key, ".");
2158 strcat (name_key, XSTRING (attribute)->data);
2160 value = x_get_string_resource (check_x_display_info (Qnil)->xrdb,
2161 name_key, class_key);
2163 if (value != (char *) 0)
2164 return build_string (value);
2165 else
2166 return Qnil;
2169 /* Get an X resource, like Fx_get_resource, but for display DPYINFO. */
2171 static Lisp_Object
2172 display_x_get_resource (dpyinfo, attribute, class, component, subclass)
2173 struct x_display_info *dpyinfo;
2174 Lisp_Object attribute, class, component, subclass;
2176 register char *value;
2177 char *name_key;
2178 char *class_key;
2180 check_x ();
2182 CHECK_STRING (attribute, 0);
2183 CHECK_STRING (class, 0);
2185 if (!NILP (component))
2186 CHECK_STRING (component, 1);
2187 if (!NILP (subclass))
2188 CHECK_STRING (subclass, 2);
2189 if (NILP (component) != NILP (subclass))
2190 error ("x-get-resource: must specify both COMPONENT and SUBCLASS or neither");
2192 validate_x_resource_name ();
2194 /* Allocate space for the components, the dots which separate them,
2195 and the final '\0'. Make them big enough for the worst case. */
2196 name_key = (char *) alloca (XSTRING (Vx_resource_name)->size
2197 + (STRINGP (component)
2198 ? XSTRING (component)->size : 0)
2199 + XSTRING (attribute)->size
2200 + 3);
2202 class_key = (char *) alloca (XSTRING (Vx_resource_class)->size
2203 + XSTRING (class)->size
2204 + (STRINGP (subclass)
2205 ? XSTRING (subclass)->size : 0)
2206 + 3);
2208 /* Start with emacs.FRAMENAME for the name (the specific one)
2209 and with `Emacs' for the class key (the general one). */
2210 strcpy (name_key, XSTRING (Vx_resource_name)->data);
2211 strcpy (class_key, XSTRING (Vx_resource_class)->data);
2213 strcat (class_key, ".");
2214 strcat (class_key, XSTRING (class)->data);
2216 if (!NILP (component))
2218 strcat (class_key, ".");
2219 strcat (class_key, XSTRING (subclass)->data);
2221 strcat (name_key, ".");
2222 strcat (name_key, XSTRING (component)->data);
2225 strcat (name_key, ".");
2226 strcat (name_key, XSTRING (attribute)->data);
2228 value = x_get_string_resource (dpyinfo->xrdb, name_key, class_key);
2230 if (value != (char *) 0)
2231 return build_string (value);
2232 else
2233 return Qnil;
2236 /* Used when C code wants a resource value. */
2238 char *
2239 x_get_resource_string (attribute, class)
2240 char *attribute, *class;
2242 register char *value;
2243 char *name_key;
2244 char *class_key;
2246 /* Allocate space for the components, the dots which separate them,
2247 and the final '\0'. */
2248 name_key = (char *) alloca (XSTRING (Vinvocation_name)->size
2249 + strlen (attribute) + 2);
2250 class_key = (char *) alloca ((sizeof (EMACS_CLASS) - 1)
2251 + strlen (class) + 2);
2253 sprintf (name_key, "%s.%s",
2254 XSTRING (Vinvocation_name)->data,
2255 attribute);
2256 sprintf (class_key, "%s.%s", EMACS_CLASS, class);
2258 return x_get_string_resource (FRAME_X_DISPLAY_INFO (selected_frame)->xrdb,
2259 name_key, class_key);
2262 /* Types we might convert a resource string into. */
2263 enum resource_types
2265 number, boolean, string, symbol
2268 /* Return the value of parameter PARAM.
2270 First search ALIST, then Vdefault_frame_alist, then the X defaults
2271 database, using ATTRIBUTE as the attribute name and CLASS as its class.
2273 Convert the resource to the type specified by desired_type.
2275 If no default is specified, return Qunbound. If you call
2276 x_get_arg, make sure you deal with Qunbound in a reasonable way,
2277 and don't let it get stored in any Lisp-visible variables! */
2279 static Lisp_Object
2280 x_get_arg (dpyinfo, alist, param, attribute, class, type)
2281 struct x_display_info *dpyinfo;
2282 Lisp_Object alist, param;
2283 char *attribute;
2284 char *class;
2285 enum resource_types type;
2287 register Lisp_Object tem;
2289 tem = Fassq (param, alist);
2290 if (EQ (tem, Qnil))
2291 tem = Fassq (param, Vdefault_frame_alist);
2292 if (EQ (tem, Qnil))
2295 if (attribute)
2297 tem = display_x_get_resource (dpyinfo,
2298 build_string (attribute),
2299 build_string (class),
2300 Qnil, Qnil);
2302 if (NILP (tem))
2303 return Qunbound;
2305 switch (type)
2307 case number:
2308 return make_number (atoi (XSTRING (tem)->data));
2310 case boolean:
2311 tem = Fdowncase (tem);
2312 if (!strcmp (XSTRING (tem)->data, "on")
2313 || !strcmp (XSTRING (tem)->data, "true"))
2314 return Qt;
2315 else
2316 return Qnil;
2318 case string:
2319 return tem;
2321 case symbol:
2322 /* As a special case, we map the values `true' and `on'
2323 to Qt, and `false' and `off' to Qnil. */
2325 Lisp_Object lower;
2326 lower = Fdowncase (tem);
2327 if (!strcmp (XSTRING (lower)->data, "on")
2328 || !strcmp (XSTRING (lower)->data, "true"))
2329 return Qt;
2330 else if (!strcmp (XSTRING (lower)->data, "off")
2331 || !strcmp (XSTRING (lower)->data, "false"))
2332 return Qnil;
2333 else
2334 return Fintern (tem, Qnil);
2337 default:
2338 abort ();
2341 else
2342 return Qunbound;
2344 return Fcdr (tem);
2347 /* Like x_get_arg, but also record the value in f->param_alist. */
2349 static Lisp_Object
2350 x_get_and_record_arg (f, alist, param, attribute, class, type)
2351 struct frame *f;
2352 Lisp_Object alist, param;
2353 char *attribute;
2354 char *class;
2355 enum resource_types type;
2357 Lisp_Object value;
2359 value = x_get_arg (FRAME_X_DISPLAY_INFO (f), alist, param,
2360 attribute, class, type);
2361 if (! NILP (value))
2362 store_frame_param (f, param, value);
2364 return value;
2367 /* Record in frame F the specified or default value according to ALIST
2368 of the parameter named PARAM (a Lisp symbol).
2369 If no value is specified for PARAM, look for an X default for XPROP
2370 on the frame named NAME.
2371 If that is not found either, use the value DEFLT. */
2373 static Lisp_Object
2374 x_default_parameter (f, alist, prop, deflt, xprop, xclass, type)
2375 struct frame *f;
2376 Lisp_Object alist;
2377 Lisp_Object prop;
2378 Lisp_Object deflt;
2379 char *xprop;
2380 char *xclass;
2381 enum resource_types type;
2383 Lisp_Object tem;
2385 tem = x_get_arg (FRAME_X_DISPLAY_INFO (f), alist, prop, xprop, xclass, type);
2386 if (EQ (tem, Qunbound))
2387 tem = deflt;
2388 x_set_frame_parameters (f, Fcons (Fcons (prop, tem), Qnil));
2389 return tem;
2392 DEFUN ("x-parse-geometry", Fx_parse_geometry, Sx_parse_geometry, 1, 1, 0,
2393 "Parse an X-style geometry string STRING.\n\
2394 Returns an alist of the form ((top . TOP), (left . LEFT) ... ).\n\
2395 The properties returned may include `top', `left', `height', and `width'.\n\
2396 The value of `left' or `top' may be an integer,\n\
2397 or a list (+ N) meaning N pixels relative to top/left corner,\n\
2398 or a list (- N) meaning -N pixels relative to bottom/right corner.")
2399 (string)
2400 Lisp_Object string;
2402 int geometry, x, y;
2403 unsigned int width, height;
2404 Lisp_Object result;
2406 CHECK_STRING (string, 0);
2408 geometry = XParseGeometry ((char *) XSTRING (string)->data,
2409 &x, &y, &width, &height);
2411 #if 0
2412 if (!!(geometry & XValue) != !!(geometry & YValue))
2413 error ("Must specify both x and y position, or neither");
2414 #endif
2416 result = Qnil;
2417 if (geometry & XValue)
2419 Lisp_Object element;
2421 if (x >= 0 && (geometry & XNegative))
2422 element = Fcons (Qleft, Fcons (Qminus, Fcons (make_number (-x), Qnil)));
2423 else if (x < 0 && ! (geometry & XNegative))
2424 element = Fcons (Qleft, Fcons (Qplus, Fcons (make_number (x), Qnil)));
2425 else
2426 element = Fcons (Qleft, make_number (x));
2427 result = Fcons (element, result);
2430 if (geometry & YValue)
2432 Lisp_Object element;
2434 if (y >= 0 && (geometry & YNegative))
2435 element = Fcons (Qtop, Fcons (Qminus, Fcons (make_number (-y), Qnil)));
2436 else if (y < 0 && ! (geometry & YNegative))
2437 element = Fcons (Qtop, Fcons (Qplus, Fcons (make_number (y), Qnil)));
2438 else
2439 element = Fcons (Qtop, make_number (y));
2440 result = Fcons (element, result);
2443 if (geometry & WidthValue)
2444 result = Fcons (Fcons (Qwidth, make_number (width)), result);
2445 if (geometry & HeightValue)
2446 result = Fcons (Fcons (Qheight, make_number (height)), result);
2448 return result;
2451 /* Calculate the desired size and position of this window,
2452 and return the flags saying which aspects were specified.
2454 This function does not make the coordinates positive. */
2456 #define DEFAULT_ROWS 40
2457 #define DEFAULT_COLS 80
2459 static int
2460 x_figure_window_size (f, parms)
2461 struct frame *f;
2462 Lisp_Object parms;
2464 register Lisp_Object tem0, tem1, tem2;
2465 int height, width, left, top;
2466 register int geometry;
2467 long window_prompting = 0;
2468 struct x_display_info *dpyinfo = FRAME_X_DISPLAY_INFO (f);
2470 /* Default values if we fall through.
2471 Actually, if that happens we should get
2472 window manager prompting. */
2473 SET_FRAME_WIDTH (f, DEFAULT_COLS);
2474 f->height = DEFAULT_ROWS;
2475 /* Window managers expect that if program-specified
2476 positions are not (0,0), they're intentional, not defaults. */
2477 f->output_data.x->top_pos = 0;
2478 f->output_data.x->left_pos = 0;
2480 tem0 = x_get_arg (dpyinfo, parms, Qheight, 0, 0, number);
2481 tem1 = x_get_arg (dpyinfo, parms, Qwidth, 0, 0, number);
2482 tem2 = x_get_arg (dpyinfo, parms, Quser_size, 0, 0, number);
2483 if (! EQ (tem0, Qunbound) || ! EQ (tem1, Qunbound))
2485 if (!EQ (tem0, Qunbound))
2487 CHECK_NUMBER (tem0, 0);
2488 f->height = XINT (tem0);
2490 if (!EQ (tem1, Qunbound))
2492 CHECK_NUMBER (tem1, 0);
2493 SET_FRAME_WIDTH (f, XINT (tem1));
2495 if (!NILP (tem2) && !EQ (tem2, Qunbound))
2496 window_prompting |= USSize;
2497 else
2498 window_prompting |= PSize;
2501 f->output_data.x->vertical_scroll_bar_extra
2502 = (!FRAME_HAS_VERTICAL_SCROLL_BARS (f)
2504 : FRAME_SCROLL_BAR_PIXEL_WIDTH (f) > 0
2505 ? FRAME_SCROLL_BAR_PIXEL_WIDTH (f)
2506 : (FRAME_SCROLL_BAR_COLS (f) * FONT_WIDTH (f->output_data.x->font)));
2507 f->output_data.x->pixel_width = CHAR_TO_PIXEL_WIDTH (f, f->width);
2508 f->output_data.x->pixel_height = CHAR_TO_PIXEL_HEIGHT (f, f->height);
2510 tem0 = x_get_arg (dpyinfo, parms, Qtop, 0, 0, number);
2511 tem1 = x_get_arg (dpyinfo, parms, Qleft, 0, 0, number);
2512 tem2 = x_get_arg (dpyinfo, parms, Quser_position, 0, 0, number);
2513 if (! EQ (tem0, Qunbound) || ! EQ (tem1, Qunbound))
2515 if (EQ (tem0, Qminus))
2517 f->output_data.x->top_pos = 0;
2518 window_prompting |= YNegative;
2520 else if (CONSP (tem0) && EQ (XCONS (tem0)->car, Qminus)
2521 && CONSP (XCONS (tem0)->cdr)
2522 && INTEGERP (XCONS (XCONS (tem0)->cdr)->car))
2524 f->output_data.x->top_pos = - XINT (XCONS (XCONS (tem0)->cdr)->car);
2525 window_prompting |= YNegative;
2527 else if (CONSP (tem0) && EQ (XCONS (tem0)->car, Qplus)
2528 && CONSP (XCONS (tem0)->cdr)
2529 && INTEGERP (XCONS (XCONS (tem0)->cdr)->car))
2531 f->output_data.x->top_pos = XINT (XCONS (XCONS (tem0)->cdr)->car);
2533 else if (EQ (tem0, Qunbound))
2534 f->output_data.x->top_pos = 0;
2535 else
2537 CHECK_NUMBER (tem0, 0);
2538 f->output_data.x->top_pos = XINT (tem0);
2539 if (f->output_data.x->top_pos < 0)
2540 window_prompting |= YNegative;
2543 if (EQ (tem1, Qminus))
2545 f->output_data.x->left_pos = 0;
2546 window_prompting |= XNegative;
2548 else if (CONSP (tem1) && EQ (XCONS (tem1)->car, Qminus)
2549 && CONSP (XCONS (tem1)->cdr)
2550 && INTEGERP (XCONS (XCONS (tem1)->cdr)->car))
2552 f->output_data.x->left_pos = - XINT (XCONS (XCONS (tem1)->cdr)->car);
2553 window_prompting |= XNegative;
2555 else if (CONSP (tem1) && EQ (XCONS (tem1)->car, Qplus)
2556 && CONSP (XCONS (tem1)->cdr)
2557 && INTEGERP (XCONS (XCONS (tem1)->cdr)->car))
2559 f->output_data.x->left_pos = XINT (XCONS (XCONS (tem1)->cdr)->car);
2561 else if (EQ (tem1, Qunbound))
2562 f->output_data.x->left_pos = 0;
2563 else
2565 CHECK_NUMBER (tem1, 0);
2566 f->output_data.x->left_pos = XINT (tem1);
2567 if (f->output_data.x->left_pos < 0)
2568 window_prompting |= XNegative;
2571 if (!NILP (tem2) && ! EQ (tem2, Qunbound))
2572 window_prompting |= USPosition;
2573 else
2574 window_prompting |= PPosition;
2577 return window_prompting;
2580 #if !defined (HAVE_X11R4) && !defined (HAVE_XSETWMPROTOCOLS)
2582 Status
2583 XSetWMProtocols (dpy, w, protocols, count)
2584 Display *dpy;
2585 Window w;
2586 Atom *protocols;
2587 int count;
2589 Atom prop;
2590 prop = XInternAtom (dpy, "WM_PROTOCOLS", False);
2591 if (prop == None) return False;
2592 XChangeProperty (dpy, w, prop, XA_ATOM, 32, PropModeReplace,
2593 (unsigned char *) protocols, count);
2594 return True;
2596 #endif /* not HAVE_X11R4 && not HAVE_XSETWMPROTOCOLS */
2598 #ifdef USE_X_TOOLKIT
2600 /* If the WM_PROTOCOLS property does not already contain WM_TAKE_FOCUS,
2601 WM_DELETE_WINDOW, and WM_SAVE_YOURSELF, then add them. (They may
2602 already be present because of the toolkit (Motif adds some of them,
2603 for example, but Xt doesn't). */
2605 static void
2606 hack_wm_protocols (f, widget)
2607 FRAME_PTR f;
2608 Widget widget;
2610 Display *dpy = XtDisplay (widget);
2611 Window w = XtWindow (widget);
2612 int need_delete = 1;
2613 int need_focus = 1;
2614 int need_save = 1;
2616 BLOCK_INPUT;
2618 Atom type, *atoms = 0;
2619 int format = 0;
2620 unsigned long nitems = 0;
2621 unsigned long bytes_after;
2623 if ((XGetWindowProperty (dpy, w,
2624 FRAME_X_DISPLAY_INFO (f)->Xatom_wm_protocols,
2625 (long)0, (long)100, False, XA_ATOM,
2626 &type, &format, &nitems, &bytes_after,
2627 (unsigned char **) &atoms)
2628 == Success)
2629 && format == 32 && type == XA_ATOM)
2630 while (nitems > 0)
2632 nitems--;
2633 if (atoms[nitems] == FRAME_X_DISPLAY_INFO (f)->Xatom_wm_delete_window)
2634 need_delete = 0;
2635 else if (atoms[nitems] == FRAME_X_DISPLAY_INFO (f)->Xatom_wm_take_focus)
2636 need_focus = 0;
2637 else if (atoms[nitems] == FRAME_X_DISPLAY_INFO (f)->Xatom_wm_save_yourself)
2638 need_save = 0;
2640 if (atoms) XFree ((char *) atoms);
2643 Atom props [10];
2644 int count = 0;
2645 if (need_delete)
2646 props[count++] = FRAME_X_DISPLAY_INFO (f)->Xatom_wm_delete_window;
2647 if (need_focus)
2648 props[count++] = FRAME_X_DISPLAY_INFO (f)->Xatom_wm_take_focus;
2649 if (need_save)
2650 props[count++] = FRAME_X_DISPLAY_INFO (f)->Xatom_wm_save_yourself;
2651 if (count)
2652 XChangeProperty (dpy, w, FRAME_X_DISPLAY_INFO (f)->Xatom_wm_protocols,
2653 XA_ATOM, 32, PropModeAppend,
2654 (unsigned char *) props, count);
2656 UNBLOCK_INPUT;
2658 #endif
2660 #ifdef USE_X_TOOLKIT
2662 /* Create and set up the X widget for frame F. */
2664 static void
2665 x_window (f, window_prompting, minibuffer_only)
2666 struct frame *f;
2667 long window_prompting;
2668 int minibuffer_only;
2670 XClassHint class_hints;
2671 XSetWindowAttributes attributes;
2672 unsigned long attribute_mask;
2674 Widget shell_widget;
2675 Widget pane_widget;
2676 Widget frame_widget;
2677 Arg al [25];
2678 int ac;
2680 BLOCK_INPUT;
2682 /* Use the resource name as the top-level widget name
2683 for looking up resources. Make a non-Lisp copy
2684 for the window manager, so GC relocation won't bother it.
2686 Elsewhere we specify the window name for the window manager. */
2689 char *str = (char *) XSTRING (Vx_resource_name)->data;
2690 f->namebuf = (char *) xmalloc (strlen (str) + 1);
2691 strcpy (f->namebuf, str);
2694 ac = 0;
2695 XtSetArg (al[ac], XtNallowShellResize, 1); ac++;
2696 XtSetArg (al[ac], XtNinput, 1); ac++;
2697 XtSetArg (al[ac], XtNmappedWhenManaged, 0); ac++;
2698 XtSetArg (al[ac], XtNborderWidth, f->output_data.x->border_width); ac++;
2699 shell_widget = XtAppCreateShell (f->namebuf, EMACS_CLASS,
2700 applicationShellWidgetClass,
2701 FRAME_X_DISPLAY (f), al, ac);
2703 f->output_data.x->widget = shell_widget;
2704 /* maybe_set_screen_title_format (shell_widget); */
2706 pane_widget = lw_create_widget ("main", "pane", widget_id_tick++,
2707 (widget_value *) NULL,
2708 shell_widget, False,
2709 (lw_callback) NULL,
2710 (lw_callback) NULL,
2711 (lw_callback) NULL);
2713 f->output_data.x->column_widget = pane_widget;
2715 /* mappedWhenManaged to false tells to the paned window to not map/unmap
2716 the emacs screen when changing menubar. This reduces flickering. */
2718 ac = 0;
2719 XtSetArg (al[ac], XtNmappedWhenManaged, 0); ac++;
2720 XtSetArg (al[ac], XtNshowGrip, 0); ac++;
2721 XtSetArg (al[ac], XtNallowResize, 1); ac++;
2722 XtSetArg (al[ac], XtNresizeToPreferred, 1); ac++;
2723 XtSetArg (al[ac], XtNemacsFrame, f); ac++;
2724 frame_widget = XtCreateWidget (f->namebuf,
2725 emacsFrameClass,
2726 pane_widget, al, ac);
2728 f->output_data.x->edit_widget = frame_widget;
2730 XtManageChild (frame_widget);
2732 /* Do some needed geometry management. */
2734 int len;
2735 char *tem, shell_position[32];
2736 Arg al[2];
2737 int ac = 0;
2738 int extra_borders = 0;
2739 int menubar_size
2740 = (f->output_data.x->menubar_widget
2741 ? (f->output_data.x->menubar_widget->core.height
2742 + f->output_data.x->menubar_widget->core.border_width)
2743 : 0);
2744 extern char *lwlib_toolkit_type;
2746 #if 0 /* Experimentally, we now get the right results
2747 for -geometry -0-0 without this. 24 Aug 96, rms. */
2748 if (FRAME_EXTERNAL_MENU_BAR (f))
2750 Dimension ibw = 0;
2751 XtVaGetValues (pane_widget, XtNinternalBorderWidth, &ibw, NULL);
2752 menubar_size += ibw;
2754 #endif
2756 f->output_data.x->menubar_height = menubar_size;
2758 #ifndef USE_LUCID
2759 /* Motif seems to need this amount added to the sizes
2760 specified for the shell widget. The Athena/Lucid widgets don't.
2761 Both conclusions reached experimentally. -- rms. */
2762 XtVaGetValues (f->output_data.x->edit_widget, XtNinternalBorderWidth,
2763 &extra_borders, NULL);
2764 extra_borders *= 2;
2765 #endif
2767 /* Convert our geometry parameters into a geometry string
2768 and specify it.
2769 Note that we do not specify here whether the position
2770 is a user-specified or program-specified one.
2771 We pass that information later, in x_wm_set_size_hints. */
2773 int left = f->output_data.x->left_pos;
2774 int xneg = window_prompting & XNegative;
2775 int top = f->output_data.x->top_pos;
2776 int yneg = window_prompting & YNegative;
2777 if (xneg)
2778 left = -left;
2779 if (yneg)
2780 top = -top;
2782 if (window_prompting & USPosition)
2783 sprintf (shell_position, "=%dx%d%c%d%c%d",
2784 PIXEL_WIDTH (f) + extra_borders,
2785 PIXEL_HEIGHT (f) + menubar_size + extra_borders,
2786 (xneg ? '-' : '+'), left,
2787 (yneg ? '-' : '+'), top);
2788 else
2789 sprintf (shell_position, "=%dx%d",
2790 PIXEL_WIDTH (f) + extra_borders,
2791 PIXEL_HEIGHT (f) + menubar_size + extra_borders);
2794 len = strlen (shell_position) + 1;
2795 /* We don't free this because we don't know whether
2796 it is safe to free it while the frame exists.
2797 It isn't worth the trouble of arranging to free it
2798 when the frame is deleted. */
2799 tem = (char *) xmalloc (len);
2800 strncpy (tem, shell_position, len);
2801 XtSetArg (al[ac], XtNgeometry, tem); ac++;
2802 XtSetValues (shell_widget, al, ac);
2805 XtManageChild (pane_widget);
2806 XtRealizeWidget (shell_widget);
2808 FRAME_X_WINDOW (f) = XtWindow (frame_widget);
2810 validate_x_resource_name ();
2812 class_hints.res_name = (char *) XSTRING (Vx_resource_name)->data;
2813 class_hints.res_class = (char *) XSTRING (Vx_resource_class)->data;
2814 XSetClassHint (FRAME_X_DISPLAY (f), XtWindow (shell_widget), &class_hints);
2816 #ifdef HAVE_X_I18N
2817 #ifndef X_I18N_INHIBITED
2819 XIM xim;
2820 XIC xic = NULL;
2822 xim = XOpenIM (FRAME_X_DISPLAY (f), NULL, NULL, NULL);
2824 if (xim)
2826 xic = XCreateIC (xim,
2827 XNInputStyle, XIMPreeditNothing | XIMStatusNothing,
2828 XNClientWindow, FRAME_X_WINDOW(f),
2829 XNFocusWindow, FRAME_X_WINDOW(f),
2830 NULL);
2832 if (xic == 0)
2834 XCloseIM (xim);
2835 xim = NULL;
2838 FRAME_XIM (f) = xim;
2839 FRAME_XIC (f) = xic;
2841 #else /* X_I18N_INHIBITED */
2842 FRAME_XIM (f) = 0;
2843 FRAME_XIC (f) = 0;
2844 #endif /* X_I18N_INHIBITED */
2845 #endif /* HAVE_X_I18N */
2847 f->output_data.x->wm_hints.input = True;
2848 f->output_data.x->wm_hints.flags |= InputHint;
2849 XSetWMHints (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
2850 &f->output_data.x->wm_hints);
2852 hack_wm_protocols (f, shell_widget);
2854 #ifdef HACK_EDITRES
2855 XtAddEventHandler (shell_widget, 0, True, _XEditResCheckMessages, 0);
2856 #endif
2858 /* Do a stupid property change to force the server to generate a
2859 propertyNotify event so that the event_stream server timestamp will
2860 be initialized to something relevant to the time we created the window.
2862 XChangeProperty (XtDisplay (frame_widget), XtWindow (frame_widget),
2863 FRAME_X_DISPLAY_INFO (f)->Xatom_wm_protocols,
2864 XA_ATOM, 32, PropModeAppend,
2865 (unsigned char*) NULL, 0);
2867 /* Make all the standard events reach the Emacs frame. */
2868 attributes.event_mask = STANDARD_EVENT_SET;
2869 attribute_mask = CWEventMask;
2870 XChangeWindowAttributes (XtDisplay (shell_widget), XtWindow (shell_widget),
2871 attribute_mask, &attributes);
2873 XtMapWidget (frame_widget);
2875 /* x_set_name normally ignores requests to set the name if the
2876 requested name is the same as the current name. This is the one
2877 place where that assumption isn't correct; f->name is set, but
2878 the X server hasn't been told. */
2880 Lisp_Object name;
2881 int explicit = f->explicit_name;
2883 f->explicit_name = 0;
2884 name = f->name;
2885 f->name = Qnil;
2886 x_set_name (f, name, explicit);
2889 XDefineCursor (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
2890 f->output_data.x->text_cursor);
2892 UNBLOCK_INPUT;
2894 if (!minibuffer_only && FRAME_EXTERNAL_MENU_BAR (f))
2895 initialize_frame_menubar (f);
2896 lw_set_main_areas (pane_widget, f->output_data.x->menubar_widget, frame_widget);
2898 if (FRAME_X_WINDOW (f) == 0)
2899 error ("Unable to create window");
2902 #else /* not USE_X_TOOLKIT */
2904 /* Create and set up the X window for frame F. */
2906 x_window (f)
2907 struct frame *f;
2910 XClassHint class_hints;
2911 XSetWindowAttributes attributes;
2912 unsigned long attribute_mask;
2914 attributes.background_pixel = f->output_data.x->background_pixel;
2915 attributes.border_pixel = f->output_data.x->border_pixel;
2916 attributes.bit_gravity = StaticGravity;
2917 attributes.backing_store = NotUseful;
2918 attributes.save_under = True;
2919 attributes.event_mask = STANDARD_EVENT_SET;
2920 attribute_mask = (CWBackPixel | CWBorderPixel | CWBitGravity
2921 #if 0
2922 | CWBackingStore | CWSaveUnder
2923 #endif
2924 | CWEventMask);
2926 BLOCK_INPUT;
2927 FRAME_X_WINDOW (f)
2928 = XCreateWindow (FRAME_X_DISPLAY (f),
2929 f->output_data.x->parent_desc,
2930 f->output_data.x->left_pos,
2931 f->output_data.x->top_pos,
2932 PIXEL_WIDTH (f), PIXEL_HEIGHT (f),
2933 f->output_data.x->border_width,
2934 CopyFromParent, /* depth */
2935 InputOutput, /* class */
2936 FRAME_X_DISPLAY_INFO (f)->visual,
2937 attribute_mask, &attributes);
2938 #ifdef HAVE_X_I18N
2939 #ifndef X_I18N_INHIBITED
2941 XIM xim;
2942 XIC xic = NULL;
2944 xim = XOpenIM (FRAME_X_DISPLAY(f), NULL, NULL, NULL);
2946 if (xim)
2948 xic = XCreateIC (xim,
2949 XNInputStyle, XIMPreeditNothing | XIMStatusNothing,
2950 XNClientWindow, FRAME_X_WINDOW(f),
2951 XNFocusWindow, FRAME_X_WINDOW(f),
2952 NULL);
2954 if (!xic)
2956 XCloseIM (xim);
2957 xim = NULL;
2961 FRAME_XIM (f) = xim;
2962 FRAME_XIC (f) = xic;
2964 #else /* X_I18N_INHIBITED */
2965 FRAME_XIM (f) = 0;
2966 FRAME_XIC (f) = 0;
2967 #endif /* X_I18N_INHIBITED */
2968 #endif /* HAVE_X_I18N */
2970 validate_x_resource_name ();
2972 class_hints.res_name = (char *) XSTRING (Vx_resource_name)->data;
2973 class_hints.res_class = (char *) XSTRING (Vx_resource_class)->data;
2974 XSetClassHint (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f), &class_hints);
2976 /* The menubar is part of the ordinary display;
2977 it does not count in addition to the height of the window. */
2978 f->output_data.x->menubar_height = 0;
2980 /* This indicates that we use the "Passive Input" input model.
2981 Unless we do this, we don't get the Focus{In,Out} events that we
2982 need to draw the cursor correctly. Accursed bureaucrats.
2983 XWhipsAndChains (FRAME_X_DISPLAY (f), IronMaiden, &TheRack); */
2985 f->output_data.x->wm_hints.input = True;
2986 f->output_data.x->wm_hints.flags |= InputHint;
2987 XSetWMHints (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
2988 &f->output_data.x->wm_hints);
2989 f->output_data.x->wm_hints.icon_pixmap = None;
2991 /* Request "save yourself" and "delete window" commands from wm. */
2993 Atom protocols[2];
2994 protocols[0] = FRAME_X_DISPLAY_INFO (f)->Xatom_wm_delete_window;
2995 protocols[1] = FRAME_X_DISPLAY_INFO (f)->Xatom_wm_save_yourself;
2996 XSetWMProtocols (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f), protocols, 2);
2999 /* x_set_name normally ignores requests to set the name if the
3000 requested name is the same as the current name. This is the one
3001 place where that assumption isn't correct; f->name is set, but
3002 the X server hasn't been told. */
3004 Lisp_Object name;
3005 int explicit = f->explicit_name;
3007 f->explicit_name = 0;
3008 name = f->name;
3009 f->name = Qnil;
3010 x_set_name (f, name, explicit);
3013 XDefineCursor (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
3014 f->output_data.x->text_cursor);
3016 UNBLOCK_INPUT;
3018 if (FRAME_X_WINDOW (f) == 0)
3019 error ("Unable to create window");
3022 #endif /* not USE_X_TOOLKIT */
3024 /* Handle the icon stuff for this window. Perhaps later we might
3025 want an x_set_icon_position which can be called interactively as
3026 well. */
3028 static void
3029 x_icon (f, parms)
3030 struct frame *f;
3031 Lisp_Object parms;
3033 Lisp_Object icon_x, icon_y;
3034 struct x_display_info *dpyinfo = FRAME_X_DISPLAY_INFO (f);
3036 /* Set the position of the icon. Note that twm groups all
3037 icons in an icon window. */
3038 icon_x = x_get_and_record_arg (f, parms, Qicon_left, 0, 0, number);
3039 icon_y = x_get_and_record_arg (f, parms, Qicon_top, 0, 0, number);
3040 if (!EQ (icon_x, Qunbound) && !EQ (icon_y, Qunbound))
3042 CHECK_NUMBER (icon_x, 0);
3043 CHECK_NUMBER (icon_y, 0);
3045 else if (!EQ (icon_x, Qunbound) || !EQ (icon_y, Qunbound))
3046 error ("Both left and top icon corners of icon must be specified");
3048 BLOCK_INPUT;
3050 if (! EQ (icon_x, Qunbound))
3051 x_wm_set_icon_position (f, XINT (icon_x), XINT (icon_y));
3053 /* Start up iconic or window? */
3054 x_wm_set_window_state
3055 (f, (EQ (x_get_arg (dpyinfo, parms, Qvisibility, 0, 0, symbol), Qicon)
3056 ? IconicState
3057 : NormalState));
3059 x_text_icon (f, (char *) XSTRING ((!NILP (f->icon_name)
3060 ? f->icon_name
3061 : f->name))->data);
3063 UNBLOCK_INPUT;
3066 /* Make the GC's needed for this window, setting the
3067 background, border and mouse colors; also create the
3068 mouse cursor and the gray border tile. */
3070 static char cursor_bits[] =
3072 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
3073 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
3074 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
3075 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00
3078 static void
3079 x_make_gc (f)
3080 struct frame *f;
3082 XGCValues gc_values;
3083 GC temp_gc;
3084 XImage tileimage;
3086 BLOCK_INPUT;
3088 /* Create the GC's of this frame.
3089 Note that many default values are used. */
3091 /* Normal video */
3092 gc_values.font = f->output_data.x->font->fid;
3093 gc_values.foreground = f->output_data.x->foreground_pixel;
3094 gc_values.background = f->output_data.x->background_pixel;
3095 gc_values.line_width = 0; /* Means 1 using fast algorithm. */
3096 f->output_data.x->normal_gc = XCreateGC (FRAME_X_DISPLAY (f),
3097 FRAME_X_WINDOW (f),
3098 GCLineWidth | GCFont
3099 | GCForeground | GCBackground,
3100 &gc_values);
3102 /* Reverse video style. */
3103 gc_values.foreground = f->output_data.x->background_pixel;
3104 gc_values.background = f->output_data.x->foreground_pixel;
3105 f->output_data.x->reverse_gc = XCreateGC (FRAME_X_DISPLAY (f),
3106 FRAME_X_WINDOW (f),
3107 GCFont | GCForeground | GCBackground
3108 | GCLineWidth,
3109 &gc_values);
3111 /* Cursor has cursor-color background, background-color foreground. */
3112 gc_values.foreground = f->output_data.x->background_pixel;
3113 gc_values.background = f->output_data.x->cursor_pixel;
3114 gc_values.fill_style = FillOpaqueStippled;
3115 gc_values.stipple
3116 = XCreateBitmapFromData (FRAME_X_DISPLAY (f),
3117 FRAME_X_DISPLAY_INFO (f)->root_window,
3118 cursor_bits, 16, 16);
3119 f->output_data.x->cursor_gc
3120 = XCreateGC (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
3121 (GCFont | GCForeground | GCBackground
3122 | GCFillStyle | GCStipple | GCLineWidth),
3123 &gc_values);
3125 /* Create the gray border tile used when the pointer is not in
3126 the frame. Since this depends on the frame's pixel values,
3127 this must be done on a per-frame basis. */
3128 f->output_data.x->border_tile
3129 = (XCreatePixmapFromBitmapData
3130 (FRAME_X_DISPLAY (f), FRAME_X_DISPLAY_INFO (f)->root_window,
3131 gray_bits, gray_width, gray_height,
3132 f->output_data.x->foreground_pixel,
3133 f->output_data.x->background_pixel,
3134 DefaultDepth (FRAME_X_DISPLAY (f),
3135 XScreenNumberOfScreen (FRAME_X_SCREEN (f)))));
3137 UNBLOCK_INPUT;
3140 DEFUN ("x-create-frame", Fx_create_frame, Sx_create_frame,
3141 1, 1, 0,
3142 "Make a new X window, which is called a \"frame\" in Emacs terms.\n\
3143 Returns an Emacs frame object.\n\
3144 ALIST is an alist of frame parameters.\n\
3145 If the parameters specify that the frame should not have a minibuffer,\n\
3146 and do not specify a specific minibuffer window to use,\n\
3147 then `default-minibuffer-frame' must be a frame whose minibuffer can\n\
3148 be shared by the new frame.\n\
3150 This function is an internal primitive--use `make-frame' instead.")
3151 (parms)
3152 Lisp_Object parms;
3154 struct frame *f;
3155 Lisp_Object frame, tem;
3156 Lisp_Object name;
3157 int minibuffer_only = 0;
3158 long window_prompting = 0;
3159 int width, height;
3160 int count = specpdl_ptr - specpdl;
3161 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
3162 Lisp_Object display;
3163 struct x_display_info *dpyinfo;
3164 Lisp_Object parent;
3165 struct kboard *kb;
3167 check_x ();
3169 /* Use this general default value to start with
3170 until we know if this frame has a specified name. */
3171 Vx_resource_name = Vinvocation_name;
3173 display = x_get_arg (dpyinfo, parms, Qdisplay, 0, 0, string);
3174 if (EQ (display, Qunbound))
3175 display = Qnil;
3176 dpyinfo = check_x_display_info (display);
3177 #ifdef MULTI_KBOARD
3178 kb = dpyinfo->kboard;
3179 #else
3180 kb = &the_only_kboard;
3181 #endif
3183 name = x_get_arg (dpyinfo, parms, Qname, "name", "Name", string);
3184 if (!STRINGP (name)
3185 && ! EQ (name, Qunbound)
3186 && ! NILP (name))
3187 error ("Invalid frame name--not a string or nil");
3189 if (STRINGP (name))
3190 Vx_resource_name = name;
3192 /* See if parent window is specified. */
3193 parent = x_get_arg (dpyinfo, parms, Qparent_id, NULL, NULL, number);
3194 if (EQ (parent, Qunbound))
3195 parent = Qnil;
3196 if (! NILP (parent))
3197 CHECK_NUMBER (parent, 0);
3199 /* make_frame_without_minibuffer can run Lisp code and garbage collect. */
3200 /* No need to protect DISPLAY because that's not used after passing
3201 it to make_frame_without_minibuffer. */
3202 frame = Qnil;
3203 GCPRO4 (parms, parent, name, frame);
3204 tem = x_get_arg (dpyinfo, parms, Qminibuffer, "minibuffer", "Minibuffer", symbol);
3205 if (EQ (tem, Qnone) || NILP (tem))
3206 f = make_frame_without_minibuffer (Qnil, kb, display);
3207 else if (EQ (tem, Qonly))
3209 f = make_minibuffer_frame ();
3210 minibuffer_only = 1;
3212 else if (WINDOWP (tem))
3213 f = make_frame_without_minibuffer (tem, kb, display);
3214 else
3215 f = make_frame (1);
3217 XSETFRAME (frame, f);
3219 /* Note that X Windows does support scroll bars. */
3220 FRAME_CAN_HAVE_SCROLL_BARS (f) = 1;
3222 f->output_method = output_x_window;
3223 f->output_data.x = (struct x_output *) xmalloc (sizeof (struct x_output));
3224 bzero (f->output_data.x, sizeof (struct x_output));
3225 f->output_data.x->icon_bitmap = -1;
3227 f->icon_name
3228 = x_get_arg (dpyinfo, parms, Qicon_name, "iconName", "Title", string);
3229 if (! STRINGP (f->icon_name))
3230 f->icon_name = Qnil;
3232 FRAME_X_DISPLAY_INFO (f) = dpyinfo;
3233 #ifdef MULTI_KBOARD
3234 FRAME_KBOARD (f) = kb;
3235 #endif
3237 /* Specify the parent under which to make this X window. */
3239 if (!NILP (parent))
3241 f->output_data.x->parent_desc = parent;
3242 f->output_data.x->explicit_parent = 1;
3244 else
3246 f->output_data.x->parent_desc = FRAME_X_DISPLAY_INFO (f)->root_window;
3247 f->output_data.x->explicit_parent = 0;
3250 /* Note that the frame has no physical cursor right now. */
3251 f->phys_cursor_x = -1;
3253 /* Set the name; the functions to which we pass f expect the name to
3254 be set. */
3255 if (EQ (name, Qunbound) || NILP (name))
3257 f->name = build_string (dpyinfo->x_id_name);
3258 f->explicit_name = 0;
3260 else
3262 f->name = name;
3263 f->explicit_name = 1;
3264 /* use the frame's title when getting resources for this frame. */
3265 specbind (Qx_resource_name, name);
3268 /* Create fontsets from `global_fontset_alist' before handling fonts. */
3269 for (tem = Vglobal_fontset_alist; CONSP (tem); tem = XCONS (tem)->cdr)
3270 fs_register_fontset (f, XCONS (tem)->car);
3272 /* Extract the window parameters from the supplied values
3273 that are needed to determine window geometry. */
3275 Lisp_Object font;
3277 if (! STRINGP (font))
3278 font = x_get_arg (dpyinfo, parms, Qfont, "font", "Font", string);
3279 BLOCK_INPUT;
3280 /* First, try whatever font the caller has specified. */
3281 if (STRINGP (font))
3283 tem = Fquery_fontset (font);
3284 if (STRINGP (tem))
3285 font = x_new_fontset (f, XSTRING (tem)->data);
3286 else
3287 font = x_new_font (f, XSTRING (font)->data);
3289 /* Try out a font which we hope has bold and italic variations. */
3290 if (!STRINGP (font))
3291 font = x_new_font (f, "-misc-fixed-medium-r-normal-*-*-140-*-*-c-*-iso8859-1");
3292 if (! STRINGP (font))
3293 font = x_new_font (f, "-*-*-medium-r-normal-*-*-140-*-*-c-*-iso8859-1");
3294 if (! STRINGP (font))
3295 /* This was formerly the first thing tried, but it finds too many fonts
3296 and takes too long. */
3297 font = x_new_font (f, "-*-*-medium-r-*-*-*-*-*-*-c-*-iso8859-1");
3298 /* If those didn't work, look for something which will at least work. */
3299 if (! STRINGP (font))
3300 font = x_new_font (f, "-*-fixed-*-*-*-*-*-140-*-*-c-*-iso8859-1");
3301 UNBLOCK_INPUT;
3302 if (! STRINGP (font))
3303 font = build_string ("fixed");
3305 x_default_parameter (f, parms, Qfont, font,
3306 "font", "Font", string);
3309 #ifdef USE_LUCID
3310 /* Prevent lwlib/xlwmenu.c from crashing because of a bug
3311 whereby it fails to get any font. */
3312 xlwmenu_default_font = f->output_data.x->font;
3313 #endif
3315 x_default_parameter (f, parms, Qborder_width, make_number (2),
3316 "borderwidth", "BorderWidth", number);
3317 /* This defaults to 2 in order to match xterm. We recognize either
3318 internalBorderWidth or internalBorder (which is what xterm calls
3319 it). */
3320 if (NILP (Fassq (Qinternal_border_width, parms)))
3322 Lisp_Object value;
3324 value = x_get_arg (dpyinfo, parms, Qinternal_border_width,
3325 "internalBorder", "internalBorder", number);
3326 if (! EQ (value, Qunbound))
3327 parms = Fcons (Fcons (Qinternal_border_width, value),
3328 parms);
3330 x_default_parameter (f, parms, Qinternal_border_width, make_number (1),
3331 "internalBorderWidth", "internalBorderWidth", number);
3332 x_default_parameter (f, parms, Qvertical_scroll_bars, Qleft,
3333 "verticalScrollBars", "ScrollBars", boolean);
3335 /* Also do the stuff which must be set before the window exists. */
3336 x_default_parameter (f, parms, Qforeground_color, build_string ("black"),
3337 "foreground", "Foreground", string);
3338 x_default_parameter (f, parms, Qbackground_color, build_string ("white"),
3339 "background", "Background", string);
3340 x_default_parameter (f, parms, Qmouse_color, build_string ("black"),
3341 "pointerColor", "Foreground", string);
3342 x_default_parameter (f, parms, Qcursor_color, build_string ("black"),
3343 "cursorColor", "Foreground", string);
3344 x_default_parameter (f, parms, Qborder_color, build_string ("black"),
3345 "borderColor", "BorderColor", string);
3347 x_default_parameter (f, parms, Qmenu_bar_lines, make_number (1),
3348 "menuBar", "MenuBar", number);
3349 x_default_parameter (f, parms, Qscroll_bar_width, Qnil,
3350 "scrollBarWidth", "ScrollBarWidth", number);
3351 x_default_parameter (f, parms, Qbuffer_predicate, Qnil,
3352 "bufferPredicate", "BufferPredicate", symbol);
3353 x_default_parameter (f, parms, Qtitle, Qnil,
3354 "title", "Title", string);
3356 f->output_data.x->parent_desc = FRAME_X_DISPLAY_INFO (f)->root_window;
3357 window_prompting = x_figure_window_size (f, parms);
3359 if (window_prompting & XNegative)
3361 if (window_prompting & YNegative)
3362 f->output_data.x->win_gravity = SouthEastGravity;
3363 else
3364 f->output_data.x->win_gravity = NorthEastGravity;
3366 else
3368 if (window_prompting & YNegative)
3369 f->output_data.x->win_gravity = SouthWestGravity;
3370 else
3371 f->output_data.x->win_gravity = NorthWestGravity;
3374 f->output_data.x->size_hint_flags = window_prompting;
3376 #ifdef USE_X_TOOLKIT
3377 x_window (f, window_prompting, minibuffer_only);
3378 #else
3379 x_window (f);
3380 #endif
3381 x_icon (f, parms);
3382 x_make_gc (f);
3383 init_frame_faces (f);
3385 /* We need to do this after creating the X window, so that the
3386 icon-creation functions can say whose icon they're describing. */
3387 x_default_parameter (f, parms, Qicon_type, Qnil,
3388 "bitmapIcon", "BitmapIcon", symbol);
3390 x_default_parameter (f, parms, Qauto_raise, Qnil,
3391 "autoRaise", "AutoRaiseLower", boolean);
3392 x_default_parameter (f, parms, Qauto_lower, Qnil,
3393 "autoLower", "AutoRaiseLower", boolean);
3394 x_default_parameter (f, parms, Qcursor_type, Qbox,
3395 "cursorType", "CursorType", symbol);
3397 /* Dimensions, especially f->height, must be done via change_frame_size.
3398 Change will not be effected unless different from the current
3399 f->height. */
3400 width = f->width;
3401 height = f->height;
3402 f->height = 0;
3403 SET_FRAME_WIDTH (f, 0);
3404 change_frame_size (f, height, width, 1, 0);
3406 /* Tell the server what size and position, etc, we want,
3407 and how badly we want them. */
3408 BLOCK_INPUT;
3409 x_wm_set_size_hint (f, window_prompting, 0);
3410 UNBLOCK_INPUT;
3412 tem = x_get_arg (dpyinfo, parms, Qunsplittable, 0, 0, boolean);
3413 f->no_split = minibuffer_only || EQ (tem, Qt);
3415 UNGCPRO;
3417 /* It is now ok to make the frame official
3418 even if we get an error below.
3419 And the frame needs to be on Vframe_list
3420 or making it visible won't work. */
3421 Vframe_list = Fcons (frame, Vframe_list);
3423 /* Now that the frame is official, it counts as a reference to
3424 its display. */
3425 FRAME_X_DISPLAY_INFO (f)->reference_count++;
3427 /* Make the window appear on the frame and enable display,
3428 unless the caller says not to. However, with explicit parent,
3429 Emacs cannot control visibility, so don't try. */
3430 if (! f->output_data.x->explicit_parent)
3432 Lisp_Object visibility;
3434 visibility = x_get_arg (dpyinfo, parms, Qvisibility, 0, 0, symbol);
3435 if (EQ (visibility, Qunbound))
3436 visibility = Qt;
3438 if (EQ (visibility, Qicon))
3439 x_iconify_frame (f);
3440 else if (! NILP (visibility))
3441 x_make_frame_visible (f);
3442 else
3443 /* Must have been Qnil. */
3447 return unbind_to (count, frame);
3450 /* FRAME is used only to get a handle on the X display. We don't pass the
3451 display info directly because we're called from frame.c, which doesn't
3452 know about that structure. */
3454 Lisp_Object
3455 x_get_focus_frame (frame)
3456 struct frame *frame;
3458 struct x_display_info *dpyinfo = FRAME_X_DISPLAY_INFO (frame);
3459 Lisp_Object xfocus;
3460 if (! dpyinfo->x_focus_frame)
3461 return Qnil;
3463 XSETFRAME (xfocus, dpyinfo->x_focus_frame);
3464 return xfocus;
3467 #if 1
3468 #include "x-list-font.c"
3469 #else
3470 DEFUN ("x-list-fonts", Fx_list_fonts, Sx_list_fonts, 1, 4, 0,
3471 "Return a list of the names of available fonts matching PATTERN.\n\
3472 If optional arguments FACE and FRAME are specified, return only fonts\n\
3473 the same size as FACE on FRAME.\n\
3475 PATTERN is a string, perhaps with wildcard characters;\n\
3476 the * character matches any substring, and\n\
3477 the ? character matches any single character.\n\
3478 PATTERN is case-insensitive.\n\
3479 FACE is a face name--a symbol.\n\
3481 The return value is a list of strings, suitable as arguments to\n\
3482 set-face-font.\n\
3484 Fonts Emacs can't use (i.e. proportional fonts) may or may not be excluded\n\
3485 even if they match PATTERN and FACE.\n\
3487 The optional fourth argument MAXIMUM sets a limit on how many\n\
3488 fonts to match. The first MAXIMUM fonts are reported.")
3489 (pattern, face, frame, maximum)
3490 Lisp_Object pattern, face, frame, maximum;
3492 int num_fonts;
3493 char **names;
3494 #ifndef BROKEN_XLISTFONTSWITHINFO
3495 XFontStruct *info;
3496 #endif
3497 XFontStruct *size_ref;
3498 Lisp_Object list;
3499 FRAME_PTR f;
3500 Lisp_Object key;
3501 int maxnames;
3502 int count;
3504 check_x ();
3505 CHECK_STRING (pattern, 0);
3506 if (!NILP (face))
3507 CHECK_SYMBOL (face, 1);
3509 if (NILP (maximum))
3510 maxnames = 2000;
3511 else
3513 CHECK_NATNUM (maximum, 0);
3514 maxnames = XINT (maximum);
3517 f = check_x_frame (frame);
3519 /* Determine the width standard for comparison with the fonts we find. */
3521 if (NILP (face))
3522 size_ref = 0;
3523 else
3525 int face_id;
3527 /* Don't die if we get called with a terminal frame. */
3528 if (! FRAME_X_P (f))
3529 error ("Non-X frame used in `x-list-fonts'");
3531 face_id = face_name_id_number (f, face);
3533 if (face_id < 0 || face_id >= FRAME_N_PARAM_FACES (f)
3534 || FRAME_PARAM_FACES (f) [face_id] == 0)
3535 size_ref = f->output_data.x->font;
3536 else
3538 size_ref = FRAME_PARAM_FACES (f) [face_id]->font;
3539 if (size_ref == (XFontStruct *) (~0))
3540 size_ref = f->output_data.x->font;
3544 /* See if we cached the result for this particular query. */
3545 key = Fcons (pattern, maximum);
3546 list = Fassoc (key,
3547 XCONS (FRAME_X_DISPLAY_INFO (f)->name_list_element)->cdr);
3549 /* We have info in the cache for this PATTERN. */
3550 if (!NILP (list))
3552 Lisp_Object tem, newlist;
3554 /* We have info about this pattern. */
3555 list = XCONS (list)->cdr;
3557 if (size_ref == 0)
3558 return list;
3560 BLOCK_INPUT;
3562 /* Filter the cached info and return just the fonts that match FACE. */
3563 newlist = Qnil;
3564 for (tem = list; CONSP (tem); tem = XCONS (tem)->cdr)
3566 XFontStruct *thisinfo;
3568 count = x_catch_errors (FRAME_X_DISPLAY (f));
3570 thisinfo = XLoadQueryFont (FRAME_X_DISPLAY (f),
3571 XSTRING (XCONS (tem)->car)->data);
3573 x_check_errors (FRAME_X_DISPLAY (f), "XLoadQueryFont failure: %s");
3574 x_uncatch_errors (FRAME_X_DISPLAY (f), count);
3576 if (thisinfo && same_size_fonts (thisinfo, size_ref))
3577 newlist = Fcons (XCONS (tem)->car, newlist);
3579 if (thisinfo != 0)
3580 XFreeFont (FRAME_X_DISPLAY (f), thisinfo);
3583 UNBLOCK_INPUT;
3585 return newlist;
3588 BLOCK_INPUT;
3590 count = x_catch_errors (FRAME_X_DISPLAY (f));
3592 /* Solaris 2.3 has a bug in XListFontsWithInfo. */
3593 #ifndef BROKEN_XLISTFONTSWITHINFO
3594 if (size_ref)
3595 names = XListFontsWithInfo (FRAME_X_DISPLAY (f),
3596 XSTRING (pattern)->data,
3597 maxnames,
3598 &num_fonts, /* count_return */
3599 &info); /* info_return */
3600 else
3601 #endif
3602 names = XListFonts (FRAME_X_DISPLAY (f),
3603 XSTRING (pattern)->data,
3604 maxnames,
3605 &num_fonts); /* count_return */
3607 x_check_errors (FRAME_X_DISPLAY (f), "XListFonts failure: %s");
3608 x_uncatch_errors (FRAME_X_DISPLAY (f), count);
3610 UNBLOCK_INPUT;
3612 list = Qnil;
3614 if (names)
3616 int i;
3617 Lisp_Object full_list;
3619 /* Make a list of all the fonts we got back.
3620 Store that in the font cache for the display. */
3621 full_list = Qnil;
3622 for (i = 0; i < num_fonts; i++)
3623 full_list = Fcons (build_string (names[i]), full_list);
3624 XCONS (FRAME_X_DISPLAY_INFO (f)->name_list_element)->cdr
3625 = Fcons (Fcons (key, full_list),
3626 XCONS (FRAME_X_DISPLAY_INFO (f)->name_list_element)->cdr);
3628 /* Make a list of the fonts that have the right width. */
3629 list = Qnil;
3630 for (i = 0; i < num_fonts; i++)
3632 int keeper;
3634 if (!size_ref)
3635 keeper = 1;
3636 else
3638 #ifdef BROKEN_XLISTFONTSWITHINFO
3639 XFontStruct *thisinfo;
3641 BLOCK_INPUT;
3643 count = x_catch_errors (FRAME_X_DISPLAY (f));
3644 thisinfo = XLoadQueryFont (FRAME_X_DISPLAY (f), names[i]);
3645 x_check_errors (FRAME_X_DISPLAY (f),
3646 "XLoadQueryFont failure: %s");
3647 x_uncatch_errors (FRAME_X_DISPLAY (f), count);
3649 UNBLOCK_INPUT;
3651 keeper = thisinfo && same_size_fonts (thisinfo, size_ref);
3652 BLOCK_INPUT;
3653 if (thisinfo && ! keeper)
3654 XFreeFont (FRAME_X_DISPLAY (f), thisinfo);
3655 else if (thisinfo)
3656 XFreeFontInfo (NULL, thisinfo, 1);
3657 UNBLOCK_INPUT;
3658 #else
3659 keeper = same_size_fonts (&info[i], size_ref);
3660 #endif
3662 if (keeper)
3663 list = Fcons (build_string (names[i]), list);
3665 list = Fnreverse (list);
3667 BLOCK_INPUT;
3668 #ifndef BROKEN_XLISTFONTSWITHINFO
3669 if (size_ref)
3670 XFreeFontInfo (names, info, num_fonts);
3671 else
3672 #endif
3673 XFreeFontNames (names);
3674 UNBLOCK_INPUT;
3677 return list;
3679 #endif
3682 DEFUN ("x-color-defined-p", Fx_color_defined_p, Sx_color_defined_p, 1, 2, 0,
3683 "Return non-nil if color COLOR is supported on frame FRAME.\n\
3684 If FRAME is omitted or nil, use the selected frame.")
3685 (color, frame)
3686 Lisp_Object color, frame;
3688 XColor foo;
3689 FRAME_PTR f = check_x_frame (frame);
3691 CHECK_STRING (color, 1);
3693 if (defined_color (f, XSTRING (color)->data, &foo, 0))
3694 return Qt;
3695 else
3696 return Qnil;
3699 DEFUN ("x-color-values", Fx_color_values, Sx_color_values, 1, 2, 0,
3700 "Return a description of the color named COLOR on frame FRAME.\n\
3701 The value is a list of integer RGB values--(RED GREEN BLUE).\n\
3702 These values appear to range from 0 to 65280 or 65535, depending\n\
3703 on the system; white is (65280 65280 65280) or (65535 65535 65535).\n\
3704 If FRAME is omitted or nil, use the selected frame.")
3705 (color, frame)
3706 Lisp_Object color, frame;
3708 XColor foo;
3709 FRAME_PTR f = check_x_frame (frame);
3711 CHECK_STRING (color, 1);
3713 if (defined_color (f, XSTRING (color)->data, &foo, 0))
3715 Lisp_Object rgb[3];
3717 rgb[0] = make_number (foo.red);
3718 rgb[1] = make_number (foo.green);
3719 rgb[2] = make_number (foo.blue);
3720 return Flist (3, rgb);
3722 else
3723 return Qnil;
3726 DEFUN ("x-display-color-p", Fx_display_color_p, Sx_display_color_p, 0, 1, 0,
3727 "Return t if the X display supports color.\n\
3728 The optional argument DISPLAY specifies which display to ask about.\n\
3729 DISPLAY should be either a frame or a display name (a string).\n\
3730 If omitted or nil, that stands for the selected frame's display.")
3731 (display)
3732 Lisp_Object display;
3734 struct x_display_info *dpyinfo = check_x_display_info (display);
3736 if (dpyinfo->n_planes <= 2)
3737 return Qnil;
3739 switch (dpyinfo->visual->class)
3741 case StaticColor:
3742 case PseudoColor:
3743 case TrueColor:
3744 case DirectColor:
3745 return Qt;
3747 default:
3748 return Qnil;
3752 DEFUN ("x-display-grayscale-p", Fx_display_grayscale_p, Sx_display_grayscale_p,
3753 0, 1, 0,
3754 "Return t if the X display supports shades of gray.\n\
3755 Note that color displays do support shades of gray.\n\
3756 The optional argument DISPLAY specifies which display to ask about.\n\
3757 DISPLAY should be either a frame or a display name (a string).\n\
3758 If omitted or nil, that stands for the selected frame's display.")
3759 (display)
3760 Lisp_Object display;
3762 struct x_display_info *dpyinfo = check_x_display_info (display);
3764 if (dpyinfo->n_planes <= 1)
3765 return Qnil;
3767 switch (dpyinfo->visual->class)
3769 case StaticColor:
3770 case PseudoColor:
3771 case TrueColor:
3772 case DirectColor:
3773 case StaticGray:
3774 case GrayScale:
3775 return Qt;
3777 default:
3778 return Qnil;
3782 DEFUN ("x-display-pixel-width", Fx_display_pixel_width, Sx_display_pixel_width,
3783 0, 1, 0,
3784 "Returns the width in pixels of the X display DISPLAY.\n\
3785 The optional argument DISPLAY specifies which display to ask about.\n\
3786 DISPLAY should be either a frame or a display name (a string).\n\
3787 If omitted or nil, that stands for the selected frame's display.")
3788 (display)
3789 Lisp_Object display;
3791 struct x_display_info *dpyinfo = check_x_display_info (display);
3793 return make_number (dpyinfo->width);
3796 DEFUN ("x-display-pixel-height", Fx_display_pixel_height,
3797 Sx_display_pixel_height, 0, 1, 0,
3798 "Returns the height in pixels of the X display DISPLAY.\n\
3799 The optional argument DISPLAY specifies which display to ask about.\n\
3800 DISPLAY should be either a frame or a display name (a string).\n\
3801 If omitted or nil, that stands for the selected frame's display.")
3802 (display)
3803 Lisp_Object display;
3805 struct x_display_info *dpyinfo = check_x_display_info (display);
3807 return make_number (dpyinfo->height);
3810 DEFUN ("x-display-planes", Fx_display_planes, Sx_display_planes,
3811 0, 1, 0,
3812 "Returns the number of bitplanes of the X display DISPLAY.\n\
3813 The optional argument DISPLAY specifies which display to ask about.\n\
3814 DISPLAY should be either a frame or a display name (a string).\n\
3815 If omitted or nil, that stands for the selected frame's display.")
3816 (display)
3817 Lisp_Object display;
3819 struct x_display_info *dpyinfo = check_x_display_info (display);
3821 return make_number (dpyinfo->n_planes);
3824 DEFUN ("x-display-color-cells", Fx_display_color_cells, Sx_display_color_cells,
3825 0, 1, 0,
3826 "Returns the number of color cells of the X display DISPLAY.\n\
3827 The optional argument DISPLAY specifies which display to ask about.\n\
3828 DISPLAY should be either a frame or a display name (a string).\n\
3829 If omitted or nil, that stands for the selected frame's display.")
3830 (display)
3831 Lisp_Object display;
3833 struct x_display_info *dpyinfo = check_x_display_info (display);
3835 return make_number (DisplayCells (dpyinfo->display,
3836 XScreenNumberOfScreen (dpyinfo->screen)));
3839 DEFUN ("x-server-max-request-size", Fx_server_max_request_size,
3840 Sx_server_max_request_size,
3841 0, 1, 0,
3842 "Returns the maximum request size of the X server of display DISPLAY.\n\
3843 The optional argument DISPLAY specifies which display to ask about.\n\
3844 DISPLAY should be either a frame or a display name (a string).\n\
3845 If omitted or nil, that stands for the selected frame's display.")
3846 (display)
3847 Lisp_Object display;
3849 struct x_display_info *dpyinfo = check_x_display_info (display);
3851 return make_number (MAXREQUEST (dpyinfo->display));
3854 DEFUN ("x-server-vendor", Fx_server_vendor, Sx_server_vendor, 0, 1, 0,
3855 "Returns the vendor ID string of the X server of display DISPLAY.\n\
3856 The optional argument DISPLAY specifies which display to ask about.\n\
3857 DISPLAY should be either a frame or a display name (a string).\n\
3858 If omitted or nil, that stands for the selected frame's display.")
3859 (display)
3860 Lisp_Object display;
3862 struct x_display_info *dpyinfo = check_x_display_info (display);
3863 char *vendor = ServerVendor (dpyinfo->display);
3865 if (! vendor) vendor = "";
3866 return build_string (vendor);
3869 DEFUN ("x-server-version", Fx_server_version, Sx_server_version, 0, 1, 0,
3870 "Returns the version numbers of the X server of display DISPLAY.\n\
3871 The value is a list of three integers: the major and minor\n\
3872 version numbers of the X Protocol in use, and the vendor-specific release\n\
3873 number. See also the function `x-server-vendor'.\n\n\
3874 The optional argument DISPLAY specifies which display to ask about.\n\
3875 DISPLAY should be either a frame or a display name (a string).\n\
3876 If omitted or nil, that stands for the selected frame's display.")
3877 (display)
3878 Lisp_Object display;
3880 struct x_display_info *dpyinfo = check_x_display_info (display);
3881 Display *dpy = dpyinfo->display;
3883 return Fcons (make_number (ProtocolVersion (dpy)),
3884 Fcons (make_number (ProtocolRevision (dpy)),
3885 Fcons (make_number (VendorRelease (dpy)), Qnil)));
3888 DEFUN ("x-display-screens", Fx_display_screens, Sx_display_screens, 0, 1, 0,
3889 "Returns the number of screens on the X server of display DISPLAY.\n\
3890 The optional argument DISPLAY specifies which display to ask about.\n\
3891 DISPLAY should be either a frame or a display name (a string).\n\
3892 If omitted or nil, that stands for the selected frame's display.")
3893 (display)
3894 Lisp_Object display;
3896 struct x_display_info *dpyinfo = check_x_display_info (display);
3898 return make_number (ScreenCount (dpyinfo->display));
3901 DEFUN ("x-display-mm-height", Fx_display_mm_height, Sx_display_mm_height, 0, 1, 0,
3902 "Returns the height in millimeters of the X display DISPLAY.\n\
3903 The optional argument DISPLAY specifies which display to ask about.\n\
3904 DISPLAY should be either a frame or a display name (a string).\n\
3905 If omitted or nil, that stands for the selected frame's display.")
3906 (display)
3907 Lisp_Object display;
3909 struct x_display_info *dpyinfo = check_x_display_info (display);
3911 return make_number (HeightMMOfScreen (dpyinfo->screen));
3914 DEFUN ("x-display-mm-width", Fx_display_mm_width, Sx_display_mm_width, 0, 1, 0,
3915 "Returns the width in millimeters of the X display DISPLAY.\n\
3916 The optional argument DISPLAY specifies which display to ask about.\n\
3917 DISPLAY should be either a frame or a display name (a string).\n\
3918 If omitted or nil, that stands for the selected frame's display.")
3919 (display)
3920 Lisp_Object display;
3922 struct x_display_info *dpyinfo = check_x_display_info (display);
3924 return make_number (WidthMMOfScreen (dpyinfo->screen));
3927 DEFUN ("x-display-backing-store", Fx_display_backing_store,
3928 Sx_display_backing_store, 0, 1, 0,
3929 "Returns an indication of whether X display DISPLAY does backing store.\n\
3930 The value may be `always', `when-mapped', or `not-useful'.\n\
3931 The optional argument DISPLAY specifies which display to ask about.\n\
3932 DISPLAY should be either a frame or a display name (a string).\n\
3933 If omitted or nil, that stands for the selected frame's display.")
3934 (display)
3935 Lisp_Object display;
3937 struct x_display_info *dpyinfo = check_x_display_info (display);
3939 switch (DoesBackingStore (dpyinfo->screen))
3941 case Always:
3942 return intern ("always");
3944 case WhenMapped:
3945 return intern ("when-mapped");
3947 case NotUseful:
3948 return intern ("not-useful");
3950 default:
3951 error ("Strange value for BackingStore parameter of screen");
3955 DEFUN ("x-display-visual-class", Fx_display_visual_class,
3956 Sx_display_visual_class, 0, 1, 0,
3957 "Returns the visual class of the X display DISPLAY.\n\
3958 The value is one of the symbols `static-gray', `gray-scale',\n\
3959 `static-color', `pseudo-color', `true-color', or `direct-color'.\n\n\
3960 The optional argument DISPLAY specifies which display to ask about.\n\
3961 DISPLAY should be either a frame or a display name (a string).\n\
3962 If omitted or nil, that stands for the selected frame's display.")
3963 (display)
3964 Lisp_Object display;
3966 struct x_display_info *dpyinfo = check_x_display_info (display);
3968 switch (dpyinfo->visual->class)
3970 case StaticGray: return (intern ("static-gray"));
3971 case GrayScale: return (intern ("gray-scale"));
3972 case StaticColor: return (intern ("static-color"));
3973 case PseudoColor: return (intern ("pseudo-color"));
3974 case TrueColor: return (intern ("true-color"));
3975 case DirectColor: return (intern ("direct-color"));
3976 default:
3977 error ("Display has an unknown visual class");
3981 DEFUN ("x-display-save-under", Fx_display_save_under,
3982 Sx_display_save_under, 0, 1, 0,
3983 "Returns t if the X display DISPLAY supports the save-under feature.\n\
3984 The optional argument DISPLAY specifies which display to ask about.\n\
3985 DISPLAY should be either a frame or a display name (a string).\n\
3986 If omitted or nil, that stands for the selected frame's display.")
3987 (display)
3988 Lisp_Object display;
3990 struct x_display_info *dpyinfo = check_x_display_info (display);
3992 if (DoesSaveUnders (dpyinfo->screen) == True)
3993 return Qt;
3994 else
3995 return Qnil;
3999 x_pixel_width (f)
4000 register struct frame *f;
4002 return PIXEL_WIDTH (f);
4006 x_pixel_height (f)
4007 register struct frame *f;
4009 return PIXEL_HEIGHT (f);
4013 x_char_width (f)
4014 register struct frame *f;
4016 return FONT_WIDTH (f->output_data.x->font);
4020 x_char_height (f)
4021 register struct frame *f;
4023 return f->output_data.x->line_height;
4027 x_screen_planes (frame)
4028 Lisp_Object frame;
4030 return FRAME_X_DISPLAY_INFO (XFRAME (frame))->n_planes;
4033 #if 0 /* These no longer seem like the right way to do things. */
4035 /* Draw a rectangle on the frame with left top corner including
4036 the character specified by LEFT_CHAR and TOP_CHAR. The rectangle is
4037 CHARS by LINES wide and long and is the color of the cursor. */
4039 void
4040 x_rectangle (f, gc, left_char, top_char, chars, lines)
4041 register struct frame *f;
4042 GC gc;
4043 register int top_char, left_char, chars, lines;
4045 int width;
4046 int height;
4047 int left = (left_char * FONT_WIDTH (f->output_data.x->font)
4048 + f->output_data.x->internal_border_width);
4049 int top = (top_char * f->output_data.x->line_height
4050 + f->output_data.x->internal_border_width);
4052 if (chars < 0)
4053 width = FONT_WIDTH (f->output_data.x->font) / 2;
4054 else
4055 width = FONT_WIDTH (f->output_data.x->font) * chars;
4056 if (lines < 0)
4057 height = f->output_data.x->line_height / 2;
4058 else
4059 height = f->output_data.x->line_height * lines;
4061 XDrawRectangle (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
4062 gc, left, top, width, height);
4065 DEFUN ("x-draw-rectangle", Fx_draw_rectangle, Sx_draw_rectangle, 5, 5, 0,
4066 "Draw a rectangle on FRAME between coordinates specified by\n\
4067 numbers X0, Y0, X1, Y1 in the cursor pixel.")
4068 (frame, X0, Y0, X1, Y1)
4069 register Lisp_Object frame, X0, X1, Y0, Y1;
4071 register int x0, y0, x1, y1, top, left, n_chars, n_lines;
4073 CHECK_LIVE_FRAME (frame, 0);
4074 CHECK_NUMBER (X0, 0);
4075 CHECK_NUMBER (Y0, 1);
4076 CHECK_NUMBER (X1, 2);
4077 CHECK_NUMBER (Y1, 3);
4079 x0 = XINT (X0);
4080 x1 = XINT (X1);
4081 y0 = XINT (Y0);
4082 y1 = XINT (Y1);
4084 if (y1 > y0)
4086 top = y0;
4087 n_lines = y1 - y0 + 1;
4089 else
4091 top = y1;
4092 n_lines = y0 - y1 + 1;
4095 if (x1 > x0)
4097 left = x0;
4098 n_chars = x1 - x0 + 1;
4100 else
4102 left = x1;
4103 n_chars = x0 - x1 + 1;
4106 BLOCK_INPUT;
4107 x_rectangle (XFRAME (frame), XFRAME (frame)->output_data.x->cursor_gc,
4108 left, top, n_chars, n_lines);
4109 UNBLOCK_INPUT;
4111 return Qt;
4114 DEFUN ("x-erase-rectangle", Fx_erase_rectangle, Sx_erase_rectangle, 5, 5, 0,
4115 "Draw a rectangle drawn on FRAME between coordinates\n\
4116 X0, Y0, X1, Y1 in the regular background-pixel.")
4117 (frame, X0, Y0, X1, Y1)
4118 register Lisp_Object frame, X0, Y0, X1, Y1;
4120 register int x0, y0, x1, y1, top, left, n_chars, n_lines;
4122 CHECK_LIVE_FRAME (frame, 0);
4123 CHECK_NUMBER (X0, 0);
4124 CHECK_NUMBER (Y0, 1);
4125 CHECK_NUMBER (X1, 2);
4126 CHECK_NUMBER (Y1, 3);
4128 x0 = XINT (X0);
4129 x1 = XINT (X1);
4130 y0 = XINT (Y0);
4131 y1 = XINT (Y1);
4133 if (y1 > y0)
4135 top = y0;
4136 n_lines = y1 - y0 + 1;
4138 else
4140 top = y1;
4141 n_lines = y0 - y1 + 1;
4144 if (x1 > x0)
4146 left = x0;
4147 n_chars = x1 - x0 + 1;
4149 else
4151 left = x1;
4152 n_chars = x0 - x1 + 1;
4155 BLOCK_INPUT;
4156 x_rectangle (XFRAME (frame), XFRAME (frame)->output_data.x->reverse_gc,
4157 left, top, n_chars, n_lines);
4158 UNBLOCK_INPUT;
4160 return Qt;
4163 /* Draw lines around the text region beginning at the character position
4164 TOP_X, TOP_Y and ending at BOTTOM_X and BOTTOM_Y. GC specifies the
4165 pixel and line characteristics. */
4167 #define line_len(line) (FRAME_CURRENT_GLYPHS (f)->used[(line)])
4169 static void
4170 outline_region (f, gc, top_x, top_y, bottom_x, bottom_y)
4171 register struct frame *f;
4172 GC gc;
4173 int top_x, top_y, bottom_x, bottom_y;
4175 register int ibw = f->output_data.x->internal_border_width;
4176 register int font_w = FONT_WIDTH (f->output_data.x->font);
4177 register int font_h = f->output_data.x->line_height;
4178 int y = top_y;
4179 int x = line_len (y);
4180 XPoint *pixel_points
4181 = (XPoint *) alloca (((bottom_y - top_y + 2) * 4) * sizeof (XPoint));
4182 register XPoint *this_point = pixel_points;
4184 /* Do the horizontal top line/lines */
4185 if (top_x == 0)
4187 this_point->x = ibw;
4188 this_point->y = ibw + (font_h * top_y);
4189 this_point++;
4190 if (x == 0)
4191 this_point->x = ibw + (font_w / 2); /* Half-size for newline chars. */
4192 else
4193 this_point->x = ibw + (font_w * x);
4194 this_point->y = (this_point - 1)->y;
4196 else
4198 this_point->x = ibw;
4199 this_point->y = ibw + (font_h * (top_y + 1));
4200 this_point++;
4201 this_point->x = ibw + (font_w * top_x);
4202 this_point->y = (this_point - 1)->y;
4203 this_point++;
4204 this_point->x = (this_point - 1)->x;
4205 this_point->y = ibw + (font_h * top_y);
4206 this_point++;
4207 this_point->x = ibw + (font_w * x);
4208 this_point->y = (this_point - 1)->y;
4211 /* Now do the right side. */
4212 while (y < bottom_y)
4213 { /* Right vertical edge */
4214 this_point++;
4215 this_point->x = (this_point - 1)->x;
4216 this_point->y = ibw + (font_h * (y + 1));
4217 this_point++;
4219 y++; /* Horizontal connection to next line */
4220 x = line_len (y);
4221 if (x == 0)
4222 this_point->x = ibw + (font_w / 2);
4223 else
4224 this_point->x = ibw + (font_w * x);
4226 this_point->y = (this_point - 1)->y;
4229 /* Now do the bottom and connect to the top left point. */
4230 this_point->x = ibw + (font_w * (bottom_x + 1));
4232 this_point++;
4233 this_point->x = (this_point - 1)->x;
4234 this_point->y = ibw + (font_h * (bottom_y + 1));
4235 this_point++;
4236 this_point->x = ibw;
4237 this_point->y = (this_point - 1)->y;
4238 this_point++;
4239 this_point->x = pixel_points->x;
4240 this_point->y = pixel_points->y;
4242 XDrawLines (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
4243 gc, pixel_points,
4244 (this_point - pixel_points + 1), CoordModeOrigin);
4247 DEFUN ("x-contour-region", Fx_contour_region, Sx_contour_region, 1, 1, 0,
4248 "Highlight the region between point and the character under the mouse\n\
4249 selected frame.")
4250 (event)
4251 register Lisp_Object event;
4253 register int x0, y0, x1, y1;
4254 register struct frame *f = selected_frame;
4255 register int p1, p2;
4257 CHECK_CONS (event, 0);
4259 BLOCK_INPUT;
4260 x0 = XINT (Fcar (Fcar (event)));
4261 y0 = XINT (Fcar (Fcdr (Fcar (event))));
4263 /* If the mouse is past the end of the line, don't that area. */
4264 /* ReWrite this... */
4266 x1 = f->cursor_x;
4267 y1 = f->cursor_y;
4269 if (y1 > y0) /* point below mouse */
4270 outline_region (f, f->output_data.x->cursor_gc,
4271 x0, y0, x1, y1);
4272 else if (y1 < y0) /* point above mouse */
4273 outline_region (f, f->output_data.x->cursor_gc,
4274 x1, y1, x0, y0);
4275 else /* same line: draw horizontal rectangle */
4277 if (x1 > x0)
4278 x_rectangle (f, f->output_data.x->cursor_gc,
4279 x0, y0, (x1 - x0 + 1), 1);
4280 else if (x1 < x0)
4281 x_rectangle (f, f->output_data.x->cursor_gc,
4282 x1, y1, (x0 - x1 + 1), 1);
4285 XFlush (FRAME_X_DISPLAY (f));
4286 UNBLOCK_INPUT;
4288 return Qnil;
4291 DEFUN ("x-uncontour-region", Fx_uncontour_region, Sx_uncontour_region, 1, 1, 0,
4292 "Erase any highlighting of the region between point and the character\n\
4293 at X, Y on the selected frame.")
4294 (event)
4295 register Lisp_Object event;
4297 register int x0, y0, x1, y1;
4298 register struct frame *f = selected_frame;
4300 BLOCK_INPUT;
4301 x0 = XINT (Fcar (Fcar (event)));
4302 y0 = XINT (Fcar (Fcdr (Fcar (event))));
4303 x1 = f->cursor_x;
4304 y1 = f->cursor_y;
4306 if (y1 > y0) /* point below mouse */
4307 outline_region (f, f->output_data.x->reverse_gc,
4308 x0, y0, x1, y1);
4309 else if (y1 < y0) /* point above mouse */
4310 outline_region (f, f->output_data.x->reverse_gc,
4311 x1, y1, x0, y0);
4312 else /* same line: draw horizontal rectangle */
4314 if (x1 > x0)
4315 x_rectangle (f, f->output_data.x->reverse_gc,
4316 x0, y0, (x1 - x0 + 1), 1);
4317 else if (x1 < x0)
4318 x_rectangle (f, f->output_data.x->reverse_gc,
4319 x1, y1, (x0 - x1 + 1), 1);
4321 UNBLOCK_INPUT;
4323 return Qnil;
4326 #if 0
4327 int contour_begin_x, contour_begin_y;
4328 int contour_end_x, contour_end_y;
4329 int contour_npoints;
4331 /* Clip the top part of the contour lines down (and including) line Y_POS.
4332 If X_POS is in the middle (rather than at the end) of the line, drop
4333 down a line at that character. */
4335 static void
4336 clip_contour_top (y_pos, x_pos)
4338 register XPoint *begin = contour_lines[y_pos].top_left;
4339 register XPoint *end;
4340 register int npoints;
4341 register struct display_line *line = selected_frame->phys_lines[y_pos + 1];
4343 if (x_pos >= line->len - 1) /* Draw one, straight horizontal line. */
4345 end = contour_lines[y_pos].top_right;
4346 npoints = (end - begin + 1);
4347 XDrawLines (x_current_display, contour_window,
4348 contour_erase_gc, begin_erase, npoints, CoordModeOrigin);
4350 bcopy (end, begin + 1, contour_last_point - end + 1);
4351 contour_last_point -= (npoints - 2);
4352 XDrawLines (x_current_display, contour_window,
4353 contour_erase_gc, begin, 2, CoordModeOrigin);
4354 XFlush (x_current_display);
4356 /* Now, update contour_lines structure. */
4358 /* ______. */
4359 else /* |________*/
4361 register XPoint *p = begin + 1;
4362 end = contour_lines[y_pos].bottom_right;
4363 npoints = (end - begin + 1);
4364 XDrawLines (x_current_display, contour_window,
4365 contour_erase_gc, begin_erase, npoints, CoordModeOrigin);
4367 p->y = begin->y;
4368 p->x = ibw + (font_w * (x_pos + 1));
4369 p++;
4370 p->y = begin->y + font_h;
4371 p->x = (p - 1)->x;
4372 bcopy (end, begin + 3, contour_last_point - end + 1);
4373 contour_last_point -= (npoints - 5);
4374 XDrawLines (x_current_display, contour_window,
4375 contour_erase_gc, begin, 4, CoordModeOrigin);
4376 XFlush (x_current_display);
4378 /* Now, update contour_lines structure. */
4382 /* Erase the top horizontal lines of the contour, and then extend
4383 the contour upwards. */
4385 static void
4386 extend_contour_top (line)
4390 static void
4391 clip_contour_bottom (x_pos, y_pos)
4392 int x_pos, y_pos;
4396 static void
4397 extend_contour_bottom (x_pos, y_pos)
4401 DEFUN ("x-select-region", Fx_select_region, Sx_select_region, 1, 1, "e",
4403 (event)
4404 Lisp_Object event;
4406 register struct frame *f = selected_frame;
4407 register int point_x = f->cursor_x;
4408 register int point_y = f->cursor_y;
4409 register int mouse_below_point;
4410 register Lisp_Object obj;
4411 register int x_contour_x, x_contour_y;
4413 x_contour_x = x_mouse_x;
4414 x_contour_y = x_mouse_y;
4415 if (x_contour_y > point_y || (x_contour_y == point_y
4416 && x_contour_x > point_x))
4418 mouse_below_point = 1;
4419 outline_region (f, f->output_data.x->cursor_gc, point_x, point_y,
4420 x_contour_x, x_contour_y);
4422 else
4424 mouse_below_point = 0;
4425 outline_region (f, f->output_data.x->cursor_gc, x_contour_x, x_contour_y,
4426 point_x, point_y);
4429 while (1)
4431 obj = read_char (-1, 0, 0, Qnil, 0);
4432 if (!CONSP (obj))
4433 break;
4435 if (mouse_below_point)
4437 if (x_mouse_y <= point_y) /* Flipped. */
4439 mouse_below_point = 0;
4441 outline_region (f, f->output_data.x->reverse_gc, point_x, point_y,
4442 x_contour_x, x_contour_y);
4443 outline_region (f, f->output_data.x->cursor_gc, x_mouse_x, x_mouse_y,
4444 point_x, point_y);
4446 else if (x_mouse_y < x_contour_y) /* Bottom clipped. */
4448 clip_contour_bottom (x_mouse_y);
4450 else if (x_mouse_y > x_contour_y) /* Bottom extended. */
4452 extend_bottom_contour (x_mouse_y);
4455 x_contour_x = x_mouse_x;
4456 x_contour_y = x_mouse_y;
4458 else /* mouse above or same line as point */
4460 if (x_mouse_y >= point_y) /* Flipped. */
4462 mouse_below_point = 1;
4464 outline_region (f, f->output_data.x->reverse_gc,
4465 x_contour_x, x_contour_y, point_x, point_y);
4466 outline_region (f, f->output_data.x->cursor_gc, point_x, point_y,
4467 x_mouse_x, x_mouse_y);
4469 else if (x_mouse_y > x_contour_y) /* Top clipped. */
4471 clip_contour_top (x_mouse_y);
4473 else if (x_mouse_y < x_contour_y) /* Top extended. */
4475 extend_contour_top (x_mouse_y);
4480 unread_command_event = obj;
4481 if (mouse_below_point)
4483 contour_begin_x = point_x;
4484 contour_begin_y = point_y;
4485 contour_end_x = x_contour_x;
4486 contour_end_y = x_contour_y;
4488 else
4490 contour_begin_x = x_contour_x;
4491 contour_begin_y = x_contour_y;
4492 contour_end_x = point_x;
4493 contour_end_y = point_y;
4496 #endif
4498 DEFUN ("x-horizontal-line", Fx_horizontal_line, Sx_horizontal_line, 1, 1, "e",
4500 (event)
4501 Lisp_Object event;
4503 register Lisp_Object obj;
4504 struct frame *f = selected_frame;
4505 register struct window *w = XWINDOW (selected_window);
4506 register GC line_gc = f->output_data.x->cursor_gc;
4507 register GC erase_gc = f->output_data.x->reverse_gc;
4508 #if 0
4509 char dash_list[] = {6, 4, 6, 4};
4510 int dashes = 4;
4511 XGCValues gc_values;
4512 #endif
4513 register int previous_y;
4514 register int line = (x_mouse_y + 1) * f->output_data.x->line_height
4515 + f->output_data.x->internal_border_width;
4516 register int left = f->output_data.x->internal_border_width
4517 + (WINDOW_LEFT_MARGIN (w)
4518 * FONT_WIDTH (f->output_data.x->font));
4519 register int right = left + (w->width
4520 * FONT_WIDTH (f->output_data.x->font))
4521 - f->output_data.x->internal_border_width;
4523 #if 0
4524 BLOCK_INPUT;
4525 gc_values.foreground = f->output_data.x->cursor_pixel;
4526 gc_values.background = f->output_data.x->background_pixel;
4527 gc_values.line_width = 1;
4528 gc_values.line_style = LineOnOffDash;
4529 gc_values.cap_style = CapRound;
4530 gc_values.join_style = JoinRound;
4532 line_gc = XCreateGC (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
4533 GCLineStyle | GCJoinStyle | GCCapStyle
4534 | GCLineWidth | GCForeground | GCBackground,
4535 &gc_values);
4536 XSetDashes (FRAME_X_DISPLAY (f), line_gc, 0, dash_list, dashes);
4537 gc_values.foreground = f->output_data.x->background_pixel;
4538 gc_values.background = f->output_data.x->foreground_pixel;
4539 erase_gc = XCreateGC (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
4540 GCLineStyle | GCJoinStyle | GCCapStyle
4541 | GCLineWidth | GCForeground | GCBackground,
4542 &gc_values);
4543 XSetDashes (FRAME_X_DISPLAY (f), erase_gc, 0, dash_list, dashes);
4544 UNBLOCK_INPUT;
4545 #endif
4547 while (1)
4549 BLOCK_INPUT;
4550 if (x_mouse_y >= XINT (w->top)
4551 && x_mouse_y < XINT (w->top) + XINT (w->height) - 1)
4553 previous_y = x_mouse_y;
4554 line = (x_mouse_y + 1) * f->output_data.x->line_height
4555 + f->output_data.x->internal_border_width;
4556 XDrawLine (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
4557 line_gc, left, line, right, line);
4559 XFlush (FRAME_X_DISPLAY (f));
4560 UNBLOCK_INPUT;
4564 obj = read_char (-1, 0, 0, Qnil, 0);
4565 if (!CONSP (obj)
4566 || (! EQ (Fcar (Fcdr (Fcdr (obj))),
4567 Qvertical_scroll_bar))
4568 || x_mouse_grabbed)
4570 BLOCK_INPUT;
4571 XDrawLine (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
4572 erase_gc, left, line, right, line);
4573 unread_command_event = obj;
4574 #if 0
4575 XFreeGC (FRAME_X_DISPLAY (f), line_gc);
4576 XFreeGC (FRAME_X_DISPLAY (f), erase_gc);
4577 #endif
4578 UNBLOCK_INPUT;
4579 return Qnil;
4582 while (x_mouse_y == previous_y);
4584 BLOCK_INPUT;
4585 XDrawLine (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
4586 erase_gc, left, line, right, line);
4587 UNBLOCK_INPUT;
4590 #endif
4592 #if 0
4593 /* These keep track of the rectangle following the pointer. */
4594 int mouse_track_top, mouse_track_left, mouse_track_width;
4596 /* Offset in buffer of character under the pointer, or 0. */
4597 int mouse_buffer_offset;
4599 DEFUN ("x-track-pointer", Fx_track_pointer, Sx_track_pointer, 0, 0, 0,
4600 "Track the pointer.")
4603 static Cursor current_pointer_shape;
4604 FRAME_PTR f = x_mouse_frame;
4606 BLOCK_INPUT;
4607 if (EQ (Vmouse_frame_part, Qtext_part)
4608 && (current_pointer_shape != f->output_data.x->nontext_cursor))
4610 unsigned char c;
4611 struct buffer *buf;
4613 current_pointer_shape = f->output_data.x->nontext_cursor;
4614 XDefineCursor (FRAME_X_DISPLAY (f),
4615 FRAME_X_WINDOW (f),
4616 current_pointer_shape);
4618 buf = XBUFFER (XWINDOW (Vmouse_window)->buffer);
4619 c = *(BUF_CHAR_ADDRESS (buf, mouse_buffer_offset));
4621 else if (EQ (Vmouse_frame_part, Qmodeline_part)
4622 && (current_pointer_shape != f->output_data.x->modeline_cursor))
4624 current_pointer_shape = f->output_data.x->modeline_cursor;
4625 XDefineCursor (FRAME_X_DISPLAY (f),
4626 FRAME_X_WINDOW (f),
4627 current_pointer_shape);
4630 XFlush (FRAME_X_DISPLAY (f));
4631 UNBLOCK_INPUT;
4633 #endif
4635 #if 0
4636 DEFUN ("x-track-pointer", Fx_track_pointer, Sx_track_pointer, 1, 1, "e",
4637 "Draw rectangle around character under mouse pointer, if there is one.")
4638 (event)
4639 Lisp_Object event;
4641 struct window *w = XWINDOW (Vmouse_window);
4642 struct frame *f = XFRAME (WINDOW_FRAME (w));
4643 struct buffer *b = XBUFFER (w->buffer);
4644 Lisp_Object obj;
4646 if (! EQ (Vmouse_window, selected_window))
4647 return Qnil;
4649 if (EQ (event, Qnil))
4651 int x, y;
4653 x_read_mouse_position (selected_frame, &x, &y);
4656 BLOCK_INPUT;
4657 mouse_track_width = 0;
4658 mouse_track_left = mouse_track_top = -1;
4662 if ((x_mouse_x != mouse_track_left
4663 && (x_mouse_x < mouse_track_left
4664 || x_mouse_x > (mouse_track_left + mouse_track_width)))
4665 || x_mouse_y != mouse_track_top)
4667 int hp = 0; /* Horizontal position */
4668 int len = FRAME_CURRENT_GLYPHS (f)->used[x_mouse_y];
4669 int p = FRAME_CURRENT_GLYPHS (f)->bufp[x_mouse_y];
4670 int tab_width = XINT (b->tab_width);
4671 int ctl_arrow_p = !NILP (b->ctl_arrow);
4672 unsigned char c;
4673 int mode_line_vpos = XFASTINT (w->height) + XFASTINT (w->top) - 1;
4674 int in_mode_line = 0;
4676 if (! FRAME_CURRENT_GLYPHS (f)->enable[x_mouse_y])
4677 break;
4679 /* Erase previous rectangle. */
4680 if (mouse_track_width)
4682 x_rectangle (f, f->output_data.x->reverse_gc,
4683 mouse_track_left, mouse_track_top,
4684 mouse_track_width, 1);
4686 if ((mouse_track_left == f->phys_cursor_x
4687 || mouse_track_left == f->phys_cursor_x - 1)
4688 && mouse_track_top == f->phys_cursor_y)
4690 x_display_cursor (f, 1);
4694 mouse_track_left = x_mouse_x;
4695 mouse_track_top = x_mouse_y;
4696 mouse_track_width = 0;
4698 if (mouse_track_left > len) /* Past the end of line. */
4699 goto draw_or_not;
4701 if (mouse_track_top == mode_line_vpos)
4703 in_mode_line = 1;
4704 goto draw_or_not;
4707 if (tab_width <= 0 || tab_width > 20) tab_width = 8;
4710 c = FETCH_BYTE (p);
4711 if (len == f->width && hp == len - 1 && c != '\n')
4712 goto draw_or_not;
4714 switch (c)
4716 case '\t':
4717 mouse_track_width = tab_width - (hp % tab_width);
4718 p++;
4719 hp += mouse_track_width;
4720 if (hp > x_mouse_x)
4722 mouse_track_left = hp - mouse_track_width;
4723 goto draw_or_not;
4725 continue;
4727 case '\n':
4728 mouse_track_width = -1;
4729 goto draw_or_not;
4731 default:
4732 if (ctl_arrow_p && (c < 040 || c == 0177))
4734 if (p > ZV)
4735 goto draw_or_not;
4737 mouse_track_width = 2;
4738 p++;
4739 hp +=2;
4740 if (hp > x_mouse_x)
4742 mouse_track_left = hp - mouse_track_width;
4743 goto draw_or_not;
4746 else
4748 mouse_track_width = 1;
4749 p++;
4750 hp++;
4752 continue;
4755 while (hp <= x_mouse_x);
4757 draw_or_not:
4758 if (mouse_track_width) /* Over text; use text pointer shape. */
4760 XDefineCursor (FRAME_X_DISPLAY (f),
4761 FRAME_X_WINDOW (f),
4762 f->output_data.x->text_cursor);
4763 x_rectangle (f, f->output_data.x->cursor_gc,
4764 mouse_track_left, mouse_track_top,
4765 mouse_track_width, 1);
4767 else if (in_mode_line)
4768 XDefineCursor (FRAME_X_DISPLAY (f),
4769 FRAME_X_WINDOW (f),
4770 f->output_data.x->modeline_cursor);
4771 else
4772 XDefineCursor (FRAME_X_DISPLAY (f),
4773 FRAME_X_WINDOW (f),
4774 f->output_data.x->nontext_cursor);
4777 XFlush (FRAME_X_DISPLAY (f));
4778 UNBLOCK_INPUT;
4780 obj = read_char (-1, 0, 0, Qnil, 0);
4781 BLOCK_INPUT;
4783 while (CONSP (obj) /* Mouse event */
4784 && EQ (Fcar (Fcdr (Fcdr (obj))), Qnil) /* Not scroll bar */
4785 && EQ (Vmouse_depressed, Qnil) /* Only motion events */
4786 && EQ (Vmouse_window, selected_window) /* In this window */
4787 && x_mouse_frame);
4789 unread_command_event = obj;
4791 if (mouse_track_width)
4793 x_rectangle (f, f->output_data.x->reverse_gc,
4794 mouse_track_left, mouse_track_top,
4795 mouse_track_width, 1);
4796 mouse_track_width = 0;
4797 if ((mouse_track_left == f->phys_cursor_x
4798 || mouse_track_left - 1 == f->phys_cursor_x)
4799 && mouse_track_top == f->phys_cursor_y)
4801 x_display_cursor (f, 1);
4804 XDefineCursor (FRAME_X_DISPLAY (f),
4805 FRAME_X_WINDOW (f),
4806 f->output_data.x->nontext_cursor);
4807 XFlush (FRAME_X_DISPLAY (f));
4808 UNBLOCK_INPUT;
4810 return Qnil;
4812 #endif
4814 #if 0
4815 #include "glyphs.h"
4817 /* Draw a pixmap specified by IMAGE_DATA of dimensions WIDTH and HEIGHT
4818 on the frame F at position X, Y. */
4820 x_draw_pixmap (f, x, y, image_data, width, height)
4821 struct frame *f;
4822 int x, y, width, height;
4823 char *image_data;
4825 Pixmap image;
4827 image = XCreateBitmapFromData (FRAME_X_DISPLAY (f),
4828 FRAME_X_WINDOW (f), image_data,
4829 width, height);
4830 XCopyPlane (FRAME_X_DISPLAY (f), image, FRAME_X_WINDOW (f),
4831 f->output_data.x->normal_gc, 0, 0, width, height, x, y);
4833 #endif
4835 #if 0 /* I'm told these functions are superfluous
4836 given the ability to bind function keys. */
4838 #ifdef HAVE_X11
4839 DEFUN ("x-rebind-key", Fx_rebind_key, Sx_rebind_key, 3, 3, 0,
4840 "Rebind X keysym KEYSYM, with MODIFIERS, to generate NEWSTRING.\n\
4841 KEYSYM is a string which conforms to the X keysym definitions found\n\
4842 in X11/keysymdef.h, sans the initial XK_. MODIFIERS is nil or a\n\
4843 list of strings specifying modifier keys such as Control_L, which must\n\
4844 also be depressed for NEWSTRING to appear.")
4845 (x_keysym, modifiers, newstring)
4846 register Lisp_Object x_keysym;
4847 register Lisp_Object modifiers;
4848 register Lisp_Object newstring;
4850 char *rawstring;
4851 register KeySym keysym;
4852 KeySym modifier_list[16];
4854 check_x ();
4855 CHECK_STRING (x_keysym, 1);
4856 CHECK_STRING (newstring, 3);
4858 keysym = XStringToKeysym ((char *) XSTRING (x_keysym)->data);
4859 if (keysym == NoSymbol)
4860 error ("Keysym does not exist");
4862 if (NILP (modifiers))
4863 XRebindKeysym (x_current_display, keysym, modifier_list, 0,
4864 XSTRING (newstring)->data, XSTRING (newstring)->size);
4865 else
4867 register Lisp_Object rest, mod;
4868 register int i = 0;
4870 for (rest = modifiers; !NILP (rest); rest = Fcdr (rest))
4872 if (i == 16)
4873 error ("Can't have more than 16 modifiers");
4875 mod = Fcar (rest);
4876 CHECK_STRING (mod, 3);
4877 modifier_list[i] = XStringToKeysym ((char *) XSTRING (mod)->data);
4878 #ifndef HAVE_X11R5
4879 if (modifier_list[i] == NoSymbol
4880 || !(IsModifierKey (modifier_list[i])
4881 || ((unsigned)(modifier_list[i]) == XK_Mode_switch)
4882 || ((unsigned)(modifier_list[i]) == XK_Num_Lock)))
4883 #else
4884 if (modifier_list[i] == NoSymbol
4885 || !IsModifierKey (modifier_list[i]))
4886 #endif
4887 error ("Element is not a modifier keysym");
4888 i++;
4891 XRebindKeysym (x_current_display, keysym, modifier_list, i,
4892 XSTRING (newstring)->data, XSTRING (newstring)->size);
4895 return Qnil;
4898 DEFUN ("x-rebind-keys", Fx_rebind_keys, Sx_rebind_keys, 2, 2, 0,
4899 "Rebind KEYCODE to list of strings STRINGS.\n\
4900 STRINGS should be a list of 16 elements, one for each shift combination.\n\
4901 nil as element means don't change.\n\
4902 See the documentation of `x-rebind-key' for more information.")
4903 (keycode, strings)
4904 register Lisp_Object keycode;
4905 register Lisp_Object strings;
4907 register Lisp_Object item;
4908 register unsigned char *rawstring;
4909 KeySym rawkey, modifier[1];
4910 int strsize;
4911 register unsigned i;
4913 check_x ();
4914 CHECK_NUMBER (keycode, 1);
4915 CHECK_CONS (strings, 2);
4916 rawkey = (KeySym) ((unsigned) (XINT (keycode))) & 255;
4917 for (i = 0; i <= 15; strings = Fcdr (strings), i++)
4919 item = Fcar (strings);
4920 if (!NILP (item))
4922 CHECK_STRING (item, 2);
4923 strsize = XSTRING (item)->size;
4924 rawstring = (unsigned char *) xmalloc (strsize);
4925 bcopy (XSTRING (item)->data, rawstring, strsize);
4926 modifier[1] = 1 << i;
4927 XRebindKeysym (x_current_display, rawkey, modifier, 1,
4928 rawstring, strsize);
4931 return Qnil;
4933 #endif /* HAVE_X11 */
4934 #endif /* 0 */
4936 #ifndef HAVE_XSCREENNUMBEROFSCREEN
4938 XScreenNumberOfScreen (scr)
4939 register Screen *scr;
4941 register Display *dpy;
4942 register Screen *dpyscr;
4943 register int i;
4945 dpy = scr->display;
4946 dpyscr = dpy->screens;
4948 for (i = 0; i < dpy->nscreens; i++, dpyscr++)
4949 if (scr == dpyscr)
4950 return i;
4952 return -1;
4954 #endif /* not HAVE_XSCREENNUMBEROFSCREEN */
4956 Visual *
4957 select_visual (dpy, screen, depth)
4958 Display *dpy;
4959 Screen *screen;
4960 unsigned int *depth;
4962 Visual *v;
4963 XVisualInfo *vinfo, vinfo_template;
4964 int n_visuals;
4966 v = DefaultVisualOfScreen (screen);
4968 #ifdef HAVE_X11R4
4969 vinfo_template.visualid = XVisualIDFromVisual (v);
4970 #else
4971 vinfo_template.visualid = v->visualid;
4972 #endif
4974 vinfo_template.screen = XScreenNumberOfScreen (screen);
4976 vinfo = XGetVisualInfo (dpy,
4977 VisualIDMask | VisualScreenMask, &vinfo_template,
4978 &n_visuals);
4979 if (n_visuals != 1)
4980 fatal ("Can't get proper X visual info");
4982 if ((1 << vinfo->depth) == vinfo->colormap_size)
4983 *depth = vinfo->depth;
4984 else
4986 int i = 0;
4987 int n = vinfo->colormap_size - 1;
4988 while (n)
4990 n = n >> 1;
4991 i++;
4993 *depth = i;
4996 XFree ((char *) vinfo);
4997 return v;
5000 /* Return the X display structure for the display named NAME.
5001 Open a new connection if necessary. */
5003 struct x_display_info *
5004 x_display_info_for_name (name)
5005 Lisp_Object name;
5007 Lisp_Object names;
5008 struct x_display_info *dpyinfo;
5010 CHECK_STRING (name, 0);
5012 if (! EQ (Vwindow_system, intern ("x")))
5013 error ("Not using X Windows");
5015 for (dpyinfo = x_display_list, names = x_display_name_list;
5016 dpyinfo;
5017 dpyinfo = dpyinfo->next, names = XCONS (names)->cdr)
5019 Lisp_Object tem;
5020 tem = Fstring_equal (XCONS (XCONS (names)->car)->car, name);
5021 if (!NILP (tem))
5022 return dpyinfo;
5025 /* Use this general default value to start with. */
5026 Vx_resource_name = Vinvocation_name;
5028 validate_x_resource_name ();
5030 dpyinfo = x_term_init (name, (unsigned char *)0,
5031 (char *) XSTRING (Vx_resource_name)->data);
5033 if (dpyinfo == 0)
5034 error ("Cannot connect to X server %s", XSTRING (name)->data);
5036 x_in_use = 1;
5037 XSETFASTINT (Vwindow_system_version, 11);
5039 return dpyinfo;
5042 DEFUN ("x-open-connection", Fx_open_connection, Sx_open_connection,
5043 1, 3, 0, "Open a connection to an X server.\n\
5044 DISPLAY is the name of the display to connect to.\n\
5045 Optional second arg XRM-STRING is a string of resources in xrdb format.\n\
5046 If the optional third arg MUST-SUCCEED is non-nil,\n\
5047 terminate Emacs if we can't open the connection.")
5048 (display, xrm_string, must_succeed)
5049 Lisp_Object display, xrm_string, must_succeed;
5051 unsigned int n_planes;
5052 unsigned char *xrm_option;
5053 struct x_display_info *dpyinfo;
5055 CHECK_STRING (display, 0);
5056 if (! NILP (xrm_string))
5057 CHECK_STRING (xrm_string, 1);
5059 if (! EQ (Vwindow_system, intern ("x")))
5060 error ("Not using X Windows");
5062 if (! NILP (xrm_string))
5063 xrm_option = (unsigned char *) XSTRING (xrm_string)->data;
5064 else
5065 xrm_option = (unsigned char *) 0;
5067 validate_x_resource_name ();
5069 /* This is what opens the connection and sets x_current_display.
5070 This also initializes many symbols, such as those used for input. */
5071 dpyinfo = x_term_init (display, xrm_option,
5072 (char *) XSTRING (Vx_resource_name)->data);
5074 if (dpyinfo == 0)
5076 if (!NILP (must_succeed))
5077 fatal ("Cannot connect to X server %s.\n\
5078 Check the DISPLAY environment variable or use `-d'.\n\
5079 Also use the `xhost' program to verify that it is set to permit\n\
5080 connections from your machine.\n",
5081 XSTRING (display)->data);
5082 else
5083 error ("Cannot connect to X server %s", XSTRING (display)->data);
5086 x_in_use = 1;
5088 XSETFASTINT (Vwindow_system_version, 11);
5089 return Qnil;
5092 DEFUN ("x-close-connection", Fx_close_connection,
5093 Sx_close_connection, 1, 1, 0,
5094 "Close the connection to DISPLAY's X server.\n\
5095 For DISPLAY, specify either a frame or a display name (a string).\n\
5096 If DISPLAY is nil, that stands for the selected frame's display.")
5097 (display)
5098 Lisp_Object display;
5100 struct x_display_info *dpyinfo = check_x_display_info (display);
5101 struct x_display_info *tail;
5102 int i;
5104 if (dpyinfo->reference_count > 0)
5105 error ("Display still has frames on it");
5107 BLOCK_INPUT;
5108 /* Free the fonts in the font table. */
5109 for (i = 0; i < dpyinfo->n_fonts; i++)
5111 if (dpyinfo->font_table[i].name)
5112 free (dpyinfo->font_table[i].name);
5113 /* Don't free the full_name string;
5114 it is always shared with something else. */
5115 XFreeFont (dpyinfo->display, dpyinfo->font_table[i].font);
5117 x_destroy_all_bitmaps (dpyinfo);
5118 XSetCloseDownMode (dpyinfo->display, DestroyAll);
5120 #ifdef USE_X_TOOLKIT
5121 XtCloseDisplay (dpyinfo->display);
5122 #else
5123 XCloseDisplay (dpyinfo->display);
5124 #endif
5126 x_delete_display (dpyinfo);
5127 UNBLOCK_INPUT;
5129 return Qnil;
5132 DEFUN ("x-display-list", Fx_display_list, Sx_display_list, 0, 0, 0,
5133 "Return the list of display names that Emacs has connections to.")
5136 Lisp_Object tail, result;
5138 result = Qnil;
5139 for (tail = x_display_name_list; ! NILP (tail); tail = XCONS (tail)->cdr)
5140 result = Fcons (XCONS (XCONS (tail)->car)->car, result);
5142 return result;
5145 DEFUN ("x-synchronize", Fx_synchronize, Sx_synchronize, 1, 2, 0,
5146 "If ON is non-nil, report X errors as soon as the erring request is made.\n\
5147 If ON is nil, allow buffering of requests.\n\
5148 Turning on synchronization prohibits the Xlib routines from buffering\n\
5149 requests and seriously degrades performance, but makes debugging much\n\
5150 easier.\n\
5151 The optional second argument DISPLAY specifies which display to act on.\n\
5152 DISPLAY should be either a frame or a display name (a string).\n\
5153 If DISPLAY is omitted or nil, that stands for the selected frame's display.")
5154 (on, display)
5155 Lisp_Object display, on;
5157 struct x_display_info *dpyinfo = check_x_display_info (display);
5159 XSynchronize (dpyinfo->display, !EQ (on, Qnil));
5161 return Qnil;
5164 /* Wait for responses to all X commands issued so far for frame F. */
5166 void
5167 x_sync (f)
5168 FRAME_PTR f;
5170 BLOCK_INPUT;
5171 XSync (FRAME_X_DISPLAY (f), False);
5172 UNBLOCK_INPUT;
5175 syms_of_xfns ()
5177 /* This is zero if not using X windows. */
5178 x_in_use = 0;
5180 /* The section below is built by the lisp expression at the top of the file,
5181 just above where these variables are declared. */
5182 /*&&& init symbols here &&&*/
5183 Qauto_raise = intern ("auto-raise");
5184 staticpro (&Qauto_raise);
5185 Qauto_lower = intern ("auto-lower");
5186 staticpro (&Qauto_lower);
5187 Qbackground_color = intern ("background-color");
5188 staticpro (&Qbackground_color);
5189 Qbar = intern ("bar");
5190 staticpro (&Qbar);
5191 Qborder_color = intern ("border-color");
5192 staticpro (&Qborder_color);
5193 Qborder_width = intern ("border-width");
5194 staticpro (&Qborder_width);
5195 Qbox = intern ("box");
5196 staticpro (&Qbox);
5197 Qcursor_color = intern ("cursor-color");
5198 staticpro (&Qcursor_color);
5199 Qcursor_type = intern ("cursor-type");
5200 staticpro (&Qcursor_type);
5201 Qforeground_color = intern ("foreground-color");
5202 staticpro (&Qforeground_color);
5203 Qgeometry = intern ("geometry");
5204 staticpro (&Qgeometry);
5205 Qicon_left = intern ("icon-left");
5206 staticpro (&Qicon_left);
5207 Qicon_top = intern ("icon-top");
5208 staticpro (&Qicon_top);
5209 Qicon_type = intern ("icon-type");
5210 staticpro (&Qicon_type);
5211 Qicon_name = intern ("icon-name");
5212 staticpro (&Qicon_name);
5213 Qinternal_border_width = intern ("internal-border-width");
5214 staticpro (&Qinternal_border_width);
5215 Qleft = intern ("left");
5216 staticpro (&Qleft);
5217 Qright = intern ("right");
5218 staticpro (&Qright);
5219 Qmouse_color = intern ("mouse-color");
5220 staticpro (&Qmouse_color);
5221 Qnone = intern ("none");
5222 staticpro (&Qnone);
5223 Qparent_id = intern ("parent-id");
5224 staticpro (&Qparent_id);
5225 Qscroll_bar_width = intern ("scroll-bar-width");
5226 staticpro (&Qscroll_bar_width);
5227 Qsuppress_icon = intern ("suppress-icon");
5228 staticpro (&Qsuppress_icon);
5229 Qtop = intern ("top");
5230 staticpro (&Qtop);
5231 Qundefined_color = intern ("undefined-color");
5232 staticpro (&Qundefined_color);
5233 Qvertical_scroll_bars = intern ("vertical-scroll-bars");
5234 staticpro (&Qvertical_scroll_bars);
5235 Qvisibility = intern ("visibility");
5236 staticpro (&Qvisibility);
5237 Qwindow_id = intern ("window-id");
5238 staticpro (&Qwindow_id);
5239 Qx_frame_parameter = intern ("x-frame-parameter");
5240 staticpro (&Qx_frame_parameter);
5241 Qx_resource_name = intern ("x-resource-name");
5242 staticpro (&Qx_resource_name);
5243 Quser_position = intern ("user-position");
5244 staticpro (&Quser_position);
5245 Quser_size = intern ("user-size");
5246 staticpro (&Quser_size);
5247 Qdisplay = intern ("display");
5248 staticpro (&Qdisplay);
5249 /* This is the end of symbol initialization. */
5251 Fput (Qundefined_color, Qerror_conditions,
5252 Fcons (Qundefined_color, Fcons (Qerror, Qnil)));
5253 Fput (Qundefined_color, Qerror_message,
5254 build_string ("Undefined color"));
5256 init_x_parm_symbols ();
5258 DEFVAR_LISP ("x-bitmap-file-path", &Vx_bitmap_file_path,
5259 "List of directories to search for bitmap files for X.");
5260 Vx_bitmap_file_path = decode_env_path ((char *) 0, PATH_BITMAPS);
5262 DEFVAR_LISP ("x-pointer-shape", &Vx_pointer_shape,
5263 "The shape of the pointer when over text.\n\
5264 Changing the value does not affect existing frames\n\
5265 unless you set the mouse color.");
5266 Vx_pointer_shape = Qnil;
5268 DEFVAR_LISP ("x-resource-name", &Vx_resource_name,
5269 "The name Emacs uses to look up X resources.\n\
5270 `x-get-resource' uses this as the first component of the instance name\n\
5271 when requesting resource values.\n\
5272 Emacs initially sets `x-resource-name' to the name under which Emacs\n\
5273 was invoked, or to the value specified with the `-name' or `-rn'\n\
5274 switches, if present.\n\
5276 It may be useful to bind this variable locally around a call\n\
5277 to `x-get-resource'. See also the variable `x-resource-class'.");
5278 Vx_resource_name = Qnil;
5280 DEFVAR_LISP ("x-resource-class", &Vx_resource_class,
5281 "The class Emacs uses to look up X resources.\n\
5282 `x-get-resource' uses this as the first component of the instance class\n\
5283 when requesting resource values.\n\
5284 Emacs initially sets `x-resource-class' to \"Emacs\".\n\
5286 Setting this variable permanently is not a reasonable thing to do,\n\
5287 but binding this variable locally around a call to `x-get-resource'\n\
5288 is a reasonabvle practice. See also the variable `x-resource-name'.");
5289 Vx_resource_class = build_string (EMACS_CLASS);
5291 #if 0 /* This doesn't really do anything. */
5292 DEFVAR_LISP ("x-nontext-pointer-shape", &Vx_nontext_pointer_shape,
5293 "The shape of the pointer when not over text.\n\
5294 This variable takes effect when you create a new frame\n\
5295 or when you set the mouse color.");
5296 #endif
5297 Vx_nontext_pointer_shape = Qnil;
5299 #if 0 /* This doesn't really do anything. */
5300 DEFVAR_LISP ("x-mode-pointer-shape", &Vx_mode_pointer_shape,
5301 "The shape of the pointer when over the mode line.\n\
5302 This variable takes effect when you create a new frame\n\
5303 or when you set the mouse color.");
5304 #endif
5305 Vx_mode_pointer_shape = Qnil;
5307 DEFVAR_LISP ("x-sensitive-text-pointer-shape",
5308 &Vx_sensitive_text_pointer_shape,
5309 "The shape of the pointer when over mouse-sensitive text.\n\
5310 This variable takes effect when you create a new frame\n\
5311 or when you set the mouse color.");
5312 Vx_sensitive_text_pointer_shape = Qnil;
5314 DEFVAR_LISP ("x-cursor-fore-pixel", &Vx_cursor_fore_pixel,
5315 "A string indicating the foreground color of the cursor box.");
5316 Vx_cursor_fore_pixel = Qnil;
5318 DEFVAR_LISP ("x-no-window-manager", &Vx_no_window_manager,
5319 "Non-nil if no X window manager is in use.\n\
5320 Emacs doesn't try to figure this out; this is always nil\n\
5321 unless you set it to something else.");
5322 /* We don't have any way to find this out, so set it to nil
5323 and maybe the user would like to set it to t. */
5324 Vx_no_window_manager = Qnil;
5326 DEFVAR_LISP ("x-pixel-size-width-font-regexp",
5327 &Vx_pixel_size_width_font_regexp,
5328 "Regexp matching a font name whose width is the same as `PIXEL_SIZE'.\n\
5330 Since Emacs gets width of a font matching with this regexp from\n\
5331 PIXEL_SIZE field of the name, font finding mechanism gets faster for\n\
5332 such a font. This is especially effective for such large fonts as\n\
5333 Chinese, Japanese, and Korean.");
5334 Vx_pixel_size_width_font_regexp = Qnil;
5336 #ifdef USE_X_TOOLKIT
5337 Fprovide (intern ("x-toolkit"));
5338 #endif
5339 #ifdef USE_MOTIF
5340 Fprovide (intern ("motif"));
5341 #endif
5343 defsubr (&Sx_get_resource);
5344 #if 0
5345 defsubr (&Sx_draw_rectangle);
5346 defsubr (&Sx_erase_rectangle);
5347 defsubr (&Sx_contour_region);
5348 defsubr (&Sx_uncontour_region);
5349 #endif
5350 defsubr (&Sx_list_fonts);
5351 defsubr (&Sx_display_color_p);
5352 defsubr (&Sx_display_grayscale_p);
5353 defsubr (&Sx_color_defined_p);
5354 defsubr (&Sx_color_values);
5355 defsubr (&Sx_server_max_request_size);
5356 defsubr (&Sx_server_vendor);
5357 defsubr (&Sx_server_version);
5358 defsubr (&Sx_display_pixel_width);
5359 defsubr (&Sx_display_pixel_height);
5360 defsubr (&Sx_display_mm_width);
5361 defsubr (&Sx_display_mm_height);
5362 defsubr (&Sx_display_screens);
5363 defsubr (&Sx_display_planes);
5364 defsubr (&Sx_display_color_cells);
5365 defsubr (&Sx_display_visual_class);
5366 defsubr (&Sx_display_backing_store);
5367 defsubr (&Sx_display_save_under);
5368 #if 0
5369 defsubr (&Sx_rebind_key);
5370 defsubr (&Sx_rebind_keys);
5371 defsubr (&Sx_track_pointer);
5372 defsubr (&Sx_grab_pointer);
5373 defsubr (&Sx_ungrab_pointer);
5374 #endif
5375 defsubr (&Sx_parse_geometry);
5376 defsubr (&Sx_create_frame);
5377 #if 0
5378 defsubr (&Sx_horizontal_line);
5379 #endif
5380 defsubr (&Sx_open_connection);
5381 defsubr (&Sx_close_connection);
5382 defsubr (&Sx_display_list);
5383 defsubr (&Sx_synchronize);
5385 /* Setting callback functions for fontset handler. */
5386 get_font_info_func = x_get_font_info;
5387 list_fonts_func = x_list_fonts;
5388 load_font_func = x_load_font;
5389 query_font_func = x_query_font;
5390 set_frame_fontset_func = x_set_font;
5391 check_window_system_func = check_x;
5394 #endif /* HAVE_X_WINDOWS */