(set-auto-mode): New arg JUST-FROM-FILE-NAME.
[emacs.git] / src / xfns.c
blob56ec4455c7fda08064408904a4cca9695d2e0a52
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 /* Used when C code wants a resource value. */
2171 char *
2172 x_get_resource_string (attribute, class)
2173 char *attribute, *class;
2175 register char *value;
2176 char *name_key;
2177 char *class_key;
2179 /* Allocate space for the components, the dots which separate them,
2180 and the final '\0'. */
2181 name_key = (char *) alloca (XSTRING (Vinvocation_name)->size
2182 + strlen (attribute) + 2);
2183 class_key = (char *) alloca ((sizeof (EMACS_CLASS) - 1)
2184 + strlen (class) + 2);
2186 sprintf (name_key, "%s.%s",
2187 XSTRING (Vinvocation_name)->data,
2188 attribute);
2189 sprintf (class_key, "%s.%s", EMACS_CLASS, class);
2191 return x_get_string_resource (FRAME_X_DISPLAY_INFO (selected_frame)->xrdb,
2192 name_key, class_key);
2195 /* Types we might convert a resource string into. */
2196 enum resource_types
2198 number, boolean, string, symbol
2201 /* Return the value of parameter PARAM.
2203 First search ALIST, then Vdefault_frame_alist, then the X defaults
2204 database, using ATTRIBUTE as the attribute name and CLASS as its class.
2206 Convert the resource to the type specified by desired_type.
2208 If no default is specified, return Qunbound. If you call
2209 x_get_arg, make sure you deal with Qunbound in a reasonable way,
2210 and don't let it get stored in any Lisp-visible variables! */
2212 static Lisp_Object
2213 x_get_arg (alist, param, attribute, class, type)
2214 Lisp_Object alist, param;
2215 char *attribute;
2216 char *class;
2217 enum resource_types type;
2219 register Lisp_Object tem;
2221 tem = Fassq (param, alist);
2222 if (EQ (tem, Qnil))
2223 tem = Fassq (param, Vdefault_frame_alist);
2224 if (EQ (tem, Qnil))
2227 if (attribute)
2229 tem = Fx_get_resource (build_string (attribute),
2230 build_string (class),
2231 Qnil, Qnil);
2233 if (NILP (tem))
2234 return Qunbound;
2236 switch (type)
2238 case number:
2239 return make_number (atoi (XSTRING (tem)->data));
2241 case boolean:
2242 tem = Fdowncase (tem);
2243 if (!strcmp (XSTRING (tem)->data, "on")
2244 || !strcmp (XSTRING (tem)->data, "true"))
2245 return Qt;
2246 else
2247 return Qnil;
2249 case string:
2250 return tem;
2252 case symbol:
2253 /* As a special case, we map the values `true' and `on'
2254 to Qt, and `false' and `off' to Qnil. */
2256 Lisp_Object lower;
2257 lower = Fdowncase (tem);
2258 if (!strcmp (XSTRING (lower)->data, "on")
2259 || !strcmp (XSTRING (lower)->data, "true"))
2260 return Qt;
2261 else if (!strcmp (XSTRING (lower)->data, "off")
2262 || !strcmp (XSTRING (lower)->data, "false"))
2263 return Qnil;
2264 else
2265 return Fintern (tem, Qnil);
2268 default:
2269 abort ();
2272 else
2273 return Qunbound;
2275 return Fcdr (tem);
2278 /* Like x_get_arg, but also record the value in f->param_alist. */
2280 static Lisp_Object
2281 x_get_and_record_arg (f, alist, param, attribute, class, type)
2282 struct frame *f;
2283 Lisp_Object alist, param;
2284 char *attribute;
2285 char *class;
2286 enum resource_types type;
2288 Lisp_Object value;
2290 value = x_get_arg (alist, param, attribute, class, type);
2291 if (! NILP (value))
2292 store_frame_param (f, param, value);
2294 return value;
2297 /* Record in frame F the specified or default value according to ALIST
2298 of the parameter named PARAM (a Lisp symbol).
2299 If no value is specified for PARAM, look for an X default for XPROP
2300 on the frame named NAME.
2301 If that is not found either, use the value DEFLT. */
2303 static Lisp_Object
2304 x_default_parameter (f, alist, prop, deflt, xprop, xclass, type)
2305 struct frame *f;
2306 Lisp_Object alist;
2307 Lisp_Object prop;
2308 Lisp_Object deflt;
2309 char *xprop;
2310 char *xclass;
2311 enum resource_types type;
2313 Lisp_Object tem;
2315 tem = x_get_arg (alist, prop, xprop, xclass, type);
2316 if (EQ (tem, Qunbound))
2317 tem = deflt;
2318 x_set_frame_parameters (f, Fcons (Fcons (prop, tem), Qnil));
2319 return tem;
2322 DEFUN ("x-parse-geometry", Fx_parse_geometry, Sx_parse_geometry, 1, 1, 0,
2323 "Parse an X-style geometry string STRING.\n\
2324 Returns an alist of the form ((top . TOP), (left . LEFT) ... ).\n\
2325 The properties returned may include `top', `left', `height', and `width'.\n\
2326 The value of `left' or `top' may be an integer,\n\
2327 or a list (+ N) meaning N pixels relative to top/left corner,\n\
2328 or a list (- N) meaning -N pixels relative to bottom/right corner.")
2329 (string)
2330 Lisp_Object string;
2332 int geometry, x, y;
2333 unsigned int width, height;
2334 Lisp_Object result;
2336 CHECK_STRING (string, 0);
2338 geometry = XParseGeometry ((char *) XSTRING (string)->data,
2339 &x, &y, &width, &height);
2341 #if 0
2342 if (!!(geometry & XValue) != !!(geometry & YValue))
2343 error ("Must specify both x and y position, or neither");
2344 #endif
2346 result = Qnil;
2347 if (geometry & XValue)
2349 Lisp_Object element;
2351 if (x >= 0 && (geometry & XNegative))
2352 element = Fcons (Qleft, Fcons (Qminus, Fcons (make_number (-x), Qnil)));
2353 else if (x < 0 && ! (geometry & XNegative))
2354 element = Fcons (Qleft, Fcons (Qplus, Fcons (make_number (x), Qnil)));
2355 else
2356 element = Fcons (Qleft, make_number (x));
2357 result = Fcons (element, result);
2360 if (geometry & YValue)
2362 Lisp_Object element;
2364 if (y >= 0 && (geometry & YNegative))
2365 element = Fcons (Qtop, Fcons (Qminus, Fcons (make_number (-y), Qnil)));
2366 else if (y < 0 && ! (geometry & YNegative))
2367 element = Fcons (Qtop, Fcons (Qplus, Fcons (make_number (y), Qnil)));
2368 else
2369 element = Fcons (Qtop, make_number (y));
2370 result = Fcons (element, result);
2373 if (geometry & WidthValue)
2374 result = Fcons (Fcons (Qwidth, make_number (width)), result);
2375 if (geometry & HeightValue)
2376 result = Fcons (Fcons (Qheight, make_number (height)), result);
2378 return result;
2381 /* Calculate the desired size and position of this window,
2382 and return the flags saying which aspects were specified.
2384 This function does not make the coordinates positive. */
2386 #define DEFAULT_ROWS 40
2387 #define DEFAULT_COLS 80
2389 static int
2390 x_figure_window_size (f, parms)
2391 struct frame *f;
2392 Lisp_Object parms;
2394 register Lisp_Object tem0, tem1, tem2;
2395 int height, width, left, top;
2396 register int geometry;
2397 long window_prompting = 0;
2399 /* Default values if we fall through.
2400 Actually, if that happens we should get
2401 window manager prompting. */
2402 SET_FRAME_WIDTH (f, DEFAULT_COLS);
2403 f->height = DEFAULT_ROWS;
2404 /* Window managers expect that if program-specified
2405 positions are not (0,0), they're intentional, not defaults. */
2406 f->output_data.x->top_pos = 0;
2407 f->output_data.x->left_pos = 0;
2409 tem0 = x_get_arg (parms, Qheight, 0, 0, number);
2410 tem1 = x_get_arg (parms, Qwidth, 0, 0, number);
2411 tem2 = x_get_arg (parms, Quser_size, 0, 0, number);
2412 if (! EQ (tem0, Qunbound) || ! EQ (tem1, Qunbound))
2414 if (!EQ (tem0, Qunbound))
2416 CHECK_NUMBER (tem0, 0);
2417 f->height = XINT (tem0);
2419 if (!EQ (tem1, Qunbound))
2421 CHECK_NUMBER (tem1, 0);
2422 SET_FRAME_WIDTH (f, XINT (tem1));
2424 if (!NILP (tem2) && !EQ (tem2, Qunbound))
2425 window_prompting |= USSize;
2426 else
2427 window_prompting |= PSize;
2430 f->output_data.x->vertical_scroll_bar_extra
2431 = (!FRAME_HAS_VERTICAL_SCROLL_BARS (f)
2433 : FRAME_SCROLL_BAR_PIXEL_WIDTH (f) > 0
2434 ? FRAME_SCROLL_BAR_PIXEL_WIDTH (f)
2435 : (FRAME_SCROLL_BAR_COLS (f) * FONT_WIDTH (f->output_data.x->font)));
2436 f->output_data.x->pixel_width = CHAR_TO_PIXEL_WIDTH (f, f->width);
2437 f->output_data.x->pixel_height = CHAR_TO_PIXEL_HEIGHT (f, f->height);
2439 tem0 = x_get_arg (parms, Qtop, 0, 0, number);
2440 tem1 = x_get_arg (parms, Qleft, 0, 0, number);
2441 tem2 = x_get_arg (parms, Quser_position, 0, 0, number);
2442 if (! EQ (tem0, Qunbound) || ! EQ (tem1, Qunbound))
2444 if (EQ (tem0, Qminus))
2446 f->output_data.x->top_pos = 0;
2447 window_prompting |= YNegative;
2449 else if (CONSP (tem0) && EQ (XCONS (tem0)->car, Qminus)
2450 && CONSP (XCONS (tem0)->cdr)
2451 && INTEGERP (XCONS (XCONS (tem0)->cdr)->car))
2453 f->output_data.x->top_pos = - XINT (XCONS (XCONS (tem0)->cdr)->car);
2454 window_prompting |= YNegative;
2456 else if (CONSP (tem0) && EQ (XCONS (tem0)->car, Qplus)
2457 && CONSP (XCONS (tem0)->cdr)
2458 && INTEGERP (XCONS (XCONS (tem0)->cdr)->car))
2460 f->output_data.x->top_pos = XINT (XCONS (XCONS (tem0)->cdr)->car);
2462 else if (EQ (tem0, Qunbound))
2463 f->output_data.x->top_pos = 0;
2464 else
2466 CHECK_NUMBER (tem0, 0);
2467 f->output_data.x->top_pos = XINT (tem0);
2468 if (f->output_data.x->top_pos < 0)
2469 window_prompting |= YNegative;
2472 if (EQ (tem1, Qminus))
2474 f->output_data.x->left_pos = 0;
2475 window_prompting |= XNegative;
2477 else if (CONSP (tem1) && EQ (XCONS (tem1)->car, Qminus)
2478 && CONSP (XCONS (tem1)->cdr)
2479 && INTEGERP (XCONS (XCONS (tem1)->cdr)->car))
2481 f->output_data.x->left_pos = - XINT (XCONS (XCONS (tem1)->cdr)->car);
2482 window_prompting |= XNegative;
2484 else if (CONSP (tem1) && EQ (XCONS (tem1)->car, Qplus)
2485 && CONSP (XCONS (tem1)->cdr)
2486 && INTEGERP (XCONS (XCONS (tem1)->cdr)->car))
2488 f->output_data.x->left_pos = XINT (XCONS (XCONS (tem1)->cdr)->car);
2490 else if (EQ (tem1, Qunbound))
2491 f->output_data.x->left_pos = 0;
2492 else
2494 CHECK_NUMBER (tem1, 0);
2495 f->output_data.x->left_pos = XINT (tem1);
2496 if (f->output_data.x->left_pos < 0)
2497 window_prompting |= XNegative;
2500 if (!NILP (tem2) && ! EQ (tem2, Qunbound))
2501 window_prompting |= USPosition;
2502 else
2503 window_prompting |= PPosition;
2506 return window_prompting;
2509 #if !defined (HAVE_X11R4) && !defined (HAVE_XSETWMPROTOCOLS)
2511 Status
2512 XSetWMProtocols (dpy, w, protocols, count)
2513 Display *dpy;
2514 Window w;
2515 Atom *protocols;
2516 int count;
2518 Atom prop;
2519 prop = XInternAtom (dpy, "WM_PROTOCOLS", False);
2520 if (prop == None) return False;
2521 XChangeProperty (dpy, w, prop, XA_ATOM, 32, PropModeReplace,
2522 (unsigned char *) protocols, count);
2523 return True;
2525 #endif /* not HAVE_X11R4 && not HAVE_XSETWMPROTOCOLS */
2527 #ifdef USE_X_TOOLKIT
2529 /* If the WM_PROTOCOLS property does not already contain WM_TAKE_FOCUS,
2530 WM_DELETE_WINDOW, and WM_SAVE_YOURSELF, then add them. (They may
2531 already be present because of the toolkit (Motif adds some of them,
2532 for example, but Xt doesn't). */
2534 static void
2535 hack_wm_protocols (f, widget)
2536 FRAME_PTR f;
2537 Widget widget;
2539 Display *dpy = XtDisplay (widget);
2540 Window w = XtWindow (widget);
2541 int need_delete = 1;
2542 int need_focus = 1;
2543 int need_save = 1;
2545 BLOCK_INPUT;
2547 Atom type, *atoms = 0;
2548 int format = 0;
2549 unsigned long nitems = 0;
2550 unsigned long bytes_after;
2552 if ((XGetWindowProperty (dpy, w,
2553 FRAME_X_DISPLAY_INFO (f)->Xatom_wm_protocols,
2554 (long)0, (long)100, False, XA_ATOM,
2555 &type, &format, &nitems, &bytes_after,
2556 (unsigned char **) &atoms)
2557 == Success)
2558 && format == 32 && type == XA_ATOM)
2559 while (nitems > 0)
2561 nitems--;
2562 if (atoms[nitems] == FRAME_X_DISPLAY_INFO (f)->Xatom_wm_delete_window)
2563 need_delete = 0;
2564 else if (atoms[nitems] == FRAME_X_DISPLAY_INFO (f)->Xatom_wm_take_focus)
2565 need_focus = 0;
2566 else if (atoms[nitems] == FRAME_X_DISPLAY_INFO (f)->Xatom_wm_save_yourself)
2567 need_save = 0;
2569 if (atoms) XFree ((char *) atoms);
2572 Atom props [10];
2573 int count = 0;
2574 if (need_delete)
2575 props[count++] = FRAME_X_DISPLAY_INFO (f)->Xatom_wm_delete_window;
2576 if (need_focus)
2577 props[count++] = FRAME_X_DISPLAY_INFO (f)->Xatom_wm_take_focus;
2578 if (need_save)
2579 props[count++] = FRAME_X_DISPLAY_INFO (f)->Xatom_wm_save_yourself;
2580 if (count)
2581 XChangeProperty (dpy, w, FRAME_X_DISPLAY_INFO (f)->Xatom_wm_protocols,
2582 XA_ATOM, 32, PropModeAppend,
2583 (unsigned char *) props, count);
2585 UNBLOCK_INPUT;
2587 #endif
2589 #ifdef USE_X_TOOLKIT
2591 /* Create and set up the X widget for frame F. */
2593 static void
2594 x_window (f, window_prompting, minibuffer_only)
2595 struct frame *f;
2596 long window_prompting;
2597 int minibuffer_only;
2599 XClassHint class_hints;
2600 XSetWindowAttributes attributes;
2601 unsigned long attribute_mask;
2603 Widget shell_widget;
2604 Widget pane_widget;
2605 Widget frame_widget;
2606 Arg al [25];
2607 int ac;
2609 BLOCK_INPUT;
2611 /* Use the resource name as the top-level widget name
2612 for looking up resources. Make a non-Lisp copy
2613 for the window manager, so GC relocation won't bother it.
2615 Elsewhere we specify the window name for the window manager. */
2618 char *str = (char *) XSTRING (Vx_resource_name)->data;
2619 f->namebuf = (char *) xmalloc (strlen (str) + 1);
2620 strcpy (f->namebuf, str);
2623 ac = 0;
2624 XtSetArg (al[ac], XtNallowShellResize, 1); ac++;
2625 XtSetArg (al[ac], XtNinput, 1); ac++;
2626 XtSetArg (al[ac], XtNmappedWhenManaged, 0); ac++;
2627 XtSetArg (al[ac], XtNborderWidth, f->output_data.x->border_width); ac++;
2628 shell_widget = XtAppCreateShell (f->namebuf, EMACS_CLASS,
2629 applicationShellWidgetClass,
2630 FRAME_X_DISPLAY (f), al, ac);
2632 f->output_data.x->widget = shell_widget;
2633 /* maybe_set_screen_title_format (shell_widget); */
2635 pane_widget = lw_create_widget ("main", "pane", widget_id_tick++,
2636 (widget_value *) NULL,
2637 shell_widget, False,
2638 (lw_callback) NULL,
2639 (lw_callback) NULL,
2640 (lw_callback) NULL);
2642 f->output_data.x->column_widget = pane_widget;
2644 /* mappedWhenManaged to false tells to the paned window to not map/unmap
2645 the emacs screen when changing menubar. This reduces flickering. */
2647 ac = 0;
2648 XtSetArg (al[ac], XtNmappedWhenManaged, 0); ac++;
2649 XtSetArg (al[ac], XtNshowGrip, 0); ac++;
2650 XtSetArg (al[ac], XtNallowResize, 1); ac++;
2651 XtSetArg (al[ac], XtNresizeToPreferred, 1); ac++;
2652 XtSetArg (al[ac], XtNemacsFrame, f); ac++;
2653 frame_widget = XtCreateWidget (f->namebuf,
2654 emacsFrameClass,
2655 pane_widget, al, ac);
2657 f->output_data.x->edit_widget = frame_widget;
2659 XtManageChild (frame_widget);
2661 /* Do some needed geometry management. */
2663 int len;
2664 char *tem, shell_position[32];
2665 Arg al[2];
2666 int ac = 0;
2667 int extra_borders = 0;
2668 int menubar_size
2669 = (f->output_data.x->menubar_widget
2670 ? (f->output_data.x->menubar_widget->core.height
2671 + f->output_data.x->menubar_widget->core.border_width)
2672 : 0);
2673 extern char *lwlib_toolkit_type;
2675 #if 0 /* Experimentally, we now get the right results
2676 for -geometry -0-0 without this. 24 Aug 96, rms. */
2677 if (FRAME_EXTERNAL_MENU_BAR (f))
2679 Dimension ibw = 0;
2680 XtVaGetValues (pane_widget, XtNinternalBorderWidth, &ibw, NULL);
2681 menubar_size += ibw;
2683 #endif
2685 f->output_data.x->menubar_height = menubar_size;
2687 #ifndef USE_LUCID
2688 /* Motif seems to need this amount added to the sizes
2689 specified for the shell widget. The Athena/Lucid widgets don't.
2690 Both conclusions reached experimentally. -- rms. */
2691 XtVaGetValues (f->output_data.x->edit_widget, XtNinternalBorderWidth,
2692 &extra_borders, NULL);
2693 extra_borders *= 2;
2694 #endif
2696 /* Convert our geometry parameters into a geometry string
2697 and specify it.
2698 Note that we do not specify here whether the position
2699 is a user-specified or program-specified one.
2700 We pass that information later, in x_wm_set_size_hints. */
2702 int left = f->output_data.x->left_pos;
2703 int xneg = window_prompting & XNegative;
2704 int top = f->output_data.x->top_pos;
2705 int yneg = window_prompting & YNegative;
2706 if (xneg)
2707 left = -left;
2708 if (yneg)
2709 top = -top;
2711 if (window_prompting & USPosition)
2712 sprintf (shell_position, "=%dx%d%c%d%c%d",
2713 PIXEL_WIDTH (f) + extra_borders,
2714 PIXEL_HEIGHT (f) + menubar_size + extra_borders,
2715 (xneg ? '-' : '+'), left,
2716 (yneg ? '-' : '+'), top);
2717 else
2718 sprintf (shell_position, "=%dx%d",
2719 PIXEL_WIDTH (f) + extra_borders,
2720 PIXEL_HEIGHT (f) + menubar_size + extra_borders);
2723 len = strlen (shell_position) + 1;
2724 /* We don't free this because we don't know whether
2725 it is safe to free it while the frame exists.
2726 It isn't worth the trouble of arranging to free it
2727 when the frame is deleted. */
2728 tem = (char *) xmalloc (len);
2729 strncpy (tem, shell_position, len);
2730 XtSetArg (al[ac], XtNgeometry, tem); ac++;
2731 XtSetValues (shell_widget, al, ac);
2734 XtManageChild (pane_widget);
2735 XtRealizeWidget (shell_widget);
2737 FRAME_X_WINDOW (f) = XtWindow (frame_widget);
2739 validate_x_resource_name ();
2741 class_hints.res_name = (char *) XSTRING (Vx_resource_name)->data;
2742 class_hints.res_class = (char *) XSTRING (Vx_resource_class)->data;
2743 XSetClassHint (FRAME_X_DISPLAY (f), XtWindow (shell_widget), &class_hints);
2745 #ifdef HAVE_X_I18N
2746 #ifndef X_I18N_INHIBITED
2748 XIM xim;
2749 XIC xic = NULL;
2751 xim = XOpenIM (FRAME_X_DISPLAY (f), NULL, NULL, NULL);
2753 if (xim)
2755 xic = XCreateIC (xim,
2756 XNInputStyle, XIMPreeditNothing | XIMStatusNothing,
2757 XNClientWindow, FRAME_X_WINDOW(f),
2758 XNFocusWindow, FRAME_X_WINDOW(f),
2759 NULL);
2761 if (xic == 0)
2763 XCloseIM (xim);
2764 xim = NULL;
2767 FRAME_XIM (f) = xim;
2768 FRAME_XIC (f) = xic;
2770 #else /* X_I18N_INHIBITED */
2771 FRAME_XIM (f) = 0;
2772 FRAME_XIC (f) = 0;
2773 #endif /* X_I18N_INHIBITED */
2774 #endif /* HAVE_X_I18N */
2776 f->output_data.x->wm_hints.input = True;
2777 f->output_data.x->wm_hints.flags |= InputHint;
2778 XSetWMHints (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
2779 &f->output_data.x->wm_hints);
2781 hack_wm_protocols (f, shell_widget);
2783 #ifdef HACK_EDITRES
2784 XtAddEventHandler (shell_widget, 0, True, _XEditResCheckMessages, 0);
2785 #endif
2787 /* Do a stupid property change to force the server to generate a
2788 propertyNotify event so that the event_stream server timestamp will
2789 be initialized to something relevant to the time we created the window.
2791 XChangeProperty (XtDisplay (frame_widget), XtWindow (frame_widget),
2792 FRAME_X_DISPLAY_INFO (f)->Xatom_wm_protocols,
2793 XA_ATOM, 32, PropModeAppend,
2794 (unsigned char*) NULL, 0);
2796 /* Make all the standard events reach the Emacs frame. */
2797 attributes.event_mask = STANDARD_EVENT_SET;
2798 attribute_mask = CWEventMask;
2799 XChangeWindowAttributes (XtDisplay (shell_widget), XtWindow (shell_widget),
2800 attribute_mask, &attributes);
2802 XtMapWidget (frame_widget);
2804 /* x_set_name normally ignores requests to set the name if the
2805 requested name is the same as the current name. This is the one
2806 place where that assumption isn't correct; f->name is set, but
2807 the X server hasn't been told. */
2809 Lisp_Object name;
2810 int explicit = f->explicit_name;
2812 f->explicit_name = 0;
2813 name = f->name;
2814 f->name = Qnil;
2815 x_set_name (f, name, explicit);
2818 XDefineCursor (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
2819 f->output_data.x->text_cursor);
2821 UNBLOCK_INPUT;
2823 if (!minibuffer_only && FRAME_EXTERNAL_MENU_BAR (f))
2824 initialize_frame_menubar (f);
2825 lw_set_main_areas (pane_widget, f->output_data.x->menubar_widget, frame_widget);
2827 if (FRAME_X_WINDOW (f) == 0)
2828 error ("Unable to create window");
2831 #else /* not USE_X_TOOLKIT */
2833 /* Create and set up the X window for frame F. */
2835 x_window (f)
2836 struct frame *f;
2839 XClassHint class_hints;
2840 XSetWindowAttributes attributes;
2841 unsigned long attribute_mask;
2843 attributes.background_pixel = f->output_data.x->background_pixel;
2844 attributes.border_pixel = f->output_data.x->border_pixel;
2845 attributes.bit_gravity = StaticGravity;
2846 attributes.backing_store = NotUseful;
2847 attributes.save_under = True;
2848 attributes.event_mask = STANDARD_EVENT_SET;
2849 attribute_mask = (CWBackPixel | CWBorderPixel | CWBitGravity
2850 #if 0
2851 | CWBackingStore | CWSaveUnder
2852 #endif
2853 | CWEventMask);
2855 BLOCK_INPUT;
2856 FRAME_X_WINDOW (f)
2857 = XCreateWindow (FRAME_X_DISPLAY (f),
2858 f->output_data.x->parent_desc,
2859 f->output_data.x->left_pos,
2860 f->output_data.x->top_pos,
2861 PIXEL_WIDTH (f), PIXEL_HEIGHT (f),
2862 f->output_data.x->border_width,
2863 CopyFromParent, /* depth */
2864 InputOutput, /* class */
2865 FRAME_X_DISPLAY_INFO (f)->visual,
2866 attribute_mask, &attributes);
2867 #ifdef HAVE_X_I18N
2868 #ifndef X_I18N_INHIBITED
2870 XIM xim;
2871 XIC xic = NULL;
2873 xim = XOpenIM (FRAME_X_DISPLAY(f), NULL, NULL, NULL);
2875 if (xim)
2877 xic = XCreateIC (xim,
2878 XNInputStyle, XIMPreeditNothing | XIMStatusNothing,
2879 XNClientWindow, FRAME_X_WINDOW(f),
2880 XNFocusWindow, FRAME_X_WINDOW(f),
2881 NULL);
2883 if (!xic)
2885 XCloseIM (xim);
2886 xim = NULL;
2890 FRAME_XIM (f) = xim;
2891 FRAME_XIC (f) = xic;
2893 #else /* X_I18N_INHIBITED */
2894 FRAME_XIM (f) = 0;
2895 FRAME_XIC (f) = 0;
2896 #endif /* X_I18N_INHIBITED */
2897 #endif /* HAVE_X_I18N */
2899 validate_x_resource_name ();
2901 class_hints.res_name = (char *) XSTRING (Vx_resource_name)->data;
2902 class_hints.res_class = (char *) XSTRING (Vx_resource_class)->data;
2903 XSetClassHint (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f), &class_hints);
2905 /* The menubar is part of the ordinary display;
2906 it does not count in addition to the height of the window. */
2907 f->output_data.x->menubar_height = 0;
2909 /* This indicates that we use the "Passive Input" input model.
2910 Unless we do this, we don't get the Focus{In,Out} events that we
2911 need to draw the cursor correctly. Accursed bureaucrats.
2912 XWhipsAndChains (FRAME_X_DISPLAY (f), IronMaiden, &TheRack); */
2914 f->output_data.x->wm_hints.input = True;
2915 f->output_data.x->wm_hints.flags |= InputHint;
2916 XSetWMHints (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
2917 &f->output_data.x->wm_hints);
2918 f->output_data.x->wm_hints.icon_pixmap = None;
2920 /* Request "save yourself" and "delete window" commands from wm. */
2922 Atom protocols[2];
2923 protocols[0] = FRAME_X_DISPLAY_INFO (f)->Xatom_wm_delete_window;
2924 protocols[1] = FRAME_X_DISPLAY_INFO (f)->Xatom_wm_save_yourself;
2925 XSetWMProtocols (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f), protocols, 2);
2928 /* x_set_name normally ignores requests to set the name if the
2929 requested name is the same as the current name. This is the one
2930 place where that assumption isn't correct; f->name is set, but
2931 the X server hasn't been told. */
2933 Lisp_Object name;
2934 int explicit = f->explicit_name;
2936 f->explicit_name = 0;
2937 name = f->name;
2938 f->name = Qnil;
2939 x_set_name (f, name, explicit);
2942 XDefineCursor (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
2943 f->output_data.x->text_cursor);
2945 UNBLOCK_INPUT;
2947 if (FRAME_X_WINDOW (f) == 0)
2948 error ("Unable to create window");
2951 #endif /* not USE_X_TOOLKIT */
2953 /* Handle the icon stuff for this window. Perhaps later we might
2954 want an x_set_icon_position which can be called interactively as
2955 well. */
2957 static void
2958 x_icon (f, parms)
2959 struct frame *f;
2960 Lisp_Object parms;
2962 Lisp_Object icon_x, icon_y;
2964 /* Set the position of the icon. Note that twm groups all
2965 icons in an icon window. */
2966 icon_x = x_get_and_record_arg (f, parms, Qicon_left, 0, 0, number);
2967 icon_y = x_get_and_record_arg (f, parms, Qicon_top, 0, 0, number);
2968 if (!EQ (icon_x, Qunbound) && !EQ (icon_y, Qunbound))
2970 CHECK_NUMBER (icon_x, 0);
2971 CHECK_NUMBER (icon_y, 0);
2973 else if (!EQ (icon_x, Qunbound) || !EQ (icon_y, Qunbound))
2974 error ("Both left and top icon corners of icon must be specified");
2976 BLOCK_INPUT;
2978 if (! EQ (icon_x, Qunbound))
2979 x_wm_set_icon_position (f, XINT (icon_x), XINT (icon_y));
2981 /* Start up iconic or window? */
2982 x_wm_set_window_state
2983 (f, (EQ (x_get_arg (parms, Qvisibility, 0, 0, symbol), Qicon)
2984 ? IconicState
2985 : NormalState));
2987 x_text_icon (f, (char *) XSTRING ((!NILP (f->icon_name)
2988 ? f->icon_name
2989 : f->name))->data);
2991 UNBLOCK_INPUT;
2994 /* Make the GC's needed for this window, setting the
2995 background, border and mouse colors; also create the
2996 mouse cursor and the gray border tile. */
2998 static char cursor_bits[] =
3000 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
3001 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
3002 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
3003 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00
3006 static void
3007 x_make_gc (f)
3008 struct frame *f;
3010 XGCValues gc_values;
3011 GC temp_gc;
3012 XImage tileimage;
3014 BLOCK_INPUT;
3016 /* Create the GC's of this frame.
3017 Note that many default values are used. */
3019 /* Normal video */
3020 gc_values.font = f->output_data.x->font->fid;
3021 gc_values.foreground = f->output_data.x->foreground_pixel;
3022 gc_values.background = f->output_data.x->background_pixel;
3023 gc_values.line_width = 0; /* Means 1 using fast algorithm. */
3024 f->output_data.x->normal_gc = XCreateGC (FRAME_X_DISPLAY (f),
3025 FRAME_X_WINDOW (f),
3026 GCLineWidth | GCFont
3027 | GCForeground | GCBackground,
3028 &gc_values);
3030 /* Reverse video style. */
3031 gc_values.foreground = f->output_data.x->background_pixel;
3032 gc_values.background = f->output_data.x->foreground_pixel;
3033 f->output_data.x->reverse_gc = XCreateGC (FRAME_X_DISPLAY (f),
3034 FRAME_X_WINDOW (f),
3035 GCFont | GCForeground | GCBackground
3036 | GCLineWidth,
3037 &gc_values);
3039 /* Cursor has cursor-color background, background-color foreground. */
3040 gc_values.foreground = f->output_data.x->background_pixel;
3041 gc_values.background = f->output_data.x->cursor_pixel;
3042 gc_values.fill_style = FillOpaqueStippled;
3043 gc_values.stipple
3044 = XCreateBitmapFromData (FRAME_X_DISPLAY (f),
3045 FRAME_X_DISPLAY_INFO (f)->root_window,
3046 cursor_bits, 16, 16);
3047 f->output_data.x->cursor_gc
3048 = XCreateGC (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
3049 (GCFont | GCForeground | GCBackground
3050 | GCFillStyle | GCStipple | GCLineWidth),
3051 &gc_values);
3053 /* Create the gray border tile used when the pointer is not in
3054 the frame. Since this depends on the frame's pixel values,
3055 this must be done on a per-frame basis. */
3056 f->output_data.x->border_tile
3057 = (XCreatePixmapFromBitmapData
3058 (FRAME_X_DISPLAY (f), FRAME_X_DISPLAY_INFO (f)->root_window,
3059 gray_bits, gray_width, gray_height,
3060 f->output_data.x->foreground_pixel,
3061 f->output_data.x->background_pixel,
3062 DefaultDepth (FRAME_X_DISPLAY (f),
3063 XScreenNumberOfScreen (FRAME_X_SCREEN (f)))));
3065 UNBLOCK_INPUT;
3068 DEFUN ("x-create-frame", Fx_create_frame, Sx_create_frame,
3069 1, 1, 0,
3070 "Make a new X window, which is called a \"frame\" in Emacs terms.\n\
3071 Returns an Emacs frame object.\n\
3072 ALIST is an alist of frame parameters.\n\
3073 If the parameters specify that the frame should not have a minibuffer,\n\
3074 and do not specify a specific minibuffer window to use,\n\
3075 then `default-minibuffer-frame' must be a frame whose minibuffer can\n\
3076 be shared by the new frame.\n\
3078 This function is an internal primitive--use `make-frame' instead.")
3079 (parms)
3080 Lisp_Object parms;
3082 struct frame *f;
3083 Lisp_Object frame, tem;
3084 Lisp_Object name;
3085 int minibuffer_only = 0;
3086 long window_prompting = 0;
3087 int width, height;
3088 int count = specpdl_ptr - specpdl;
3089 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
3090 Lisp_Object display;
3091 struct x_display_info *dpyinfo;
3092 Lisp_Object parent;
3093 struct kboard *kb;
3095 check_x ();
3097 /* Use this general default value to start with
3098 until we know if this frame has a specified name. */
3099 Vx_resource_name = Vinvocation_name;
3101 display = x_get_arg (parms, Qdisplay, 0, 0, string);
3102 if (EQ (display, Qunbound))
3103 display = Qnil;
3104 dpyinfo = check_x_display_info (display);
3105 #ifdef MULTI_KBOARD
3106 kb = dpyinfo->kboard;
3107 #else
3108 kb = &the_only_kboard;
3109 #endif
3111 name = x_get_arg (parms, Qname, "name", "Name", string);
3112 if (!STRINGP (name)
3113 && ! EQ (name, Qunbound)
3114 && ! NILP (name))
3115 error ("Invalid frame name--not a string or nil");
3117 if (STRINGP (name))
3118 Vx_resource_name = name;
3120 /* See if parent window is specified. */
3121 parent = x_get_arg (parms, Qparent_id, NULL, NULL, number);
3122 if (EQ (parent, Qunbound))
3123 parent = Qnil;
3124 if (! NILP (parent))
3125 CHECK_NUMBER (parent, 0);
3127 /* make_frame_without_minibuffer can run Lisp code and garbage collect. */
3128 /* No need to protect DISPLAY because that's not used after passing
3129 it to make_frame_without_minibuffer. */
3130 frame = Qnil;
3131 GCPRO4 (parms, parent, name, frame);
3132 tem = x_get_arg (parms, Qminibuffer, "minibuffer", "Minibuffer", symbol);
3133 if (EQ (tem, Qnone) || NILP (tem))
3134 f = make_frame_without_minibuffer (Qnil, kb, display);
3135 else if (EQ (tem, Qonly))
3137 f = make_minibuffer_frame ();
3138 minibuffer_only = 1;
3140 else if (WINDOWP (tem))
3141 f = make_frame_without_minibuffer (tem, kb, display);
3142 else
3143 f = make_frame (1);
3145 XSETFRAME (frame, f);
3147 /* Note that X Windows does support scroll bars. */
3148 FRAME_CAN_HAVE_SCROLL_BARS (f) = 1;
3150 f->output_method = output_x_window;
3151 f->output_data.x = (struct x_output *) xmalloc (sizeof (struct x_output));
3152 bzero (f->output_data.x, sizeof (struct x_output));
3153 f->output_data.x->icon_bitmap = -1;
3155 f->icon_name
3156 = x_get_arg (parms, Qicon_name, "iconName", "Title", string);
3157 if (! STRINGP (f->icon_name))
3158 f->icon_name = Qnil;
3160 FRAME_X_DISPLAY_INFO (f) = dpyinfo;
3161 #ifdef MULTI_KBOARD
3162 FRAME_KBOARD (f) = kb;
3163 #endif
3165 /* Specify the parent under which to make this X window. */
3167 if (!NILP (parent))
3169 f->output_data.x->parent_desc = parent;
3170 f->output_data.x->explicit_parent = 1;
3172 else
3174 f->output_data.x->parent_desc = FRAME_X_DISPLAY_INFO (f)->root_window;
3175 f->output_data.x->explicit_parent = 0;
3178 /* Note that the frame has no physical cursor right now. */
3179 f->phys_cursor_x = -1;
3181 /* Set the name; the functions to which we pass f expect the name to
3182 be set. */
3183 if (EQ (name, Qunbound) || NILP (name))
3185 f->name = build_string (dpyinfo->x_id_name);
3186 f->explicit_name = 0;
3188 else
3190 f->name = name;
3191 f->explicit_name = 1;
3192 /* use the frame's title when getting resources for this frame. */
3193 specbind (Qx_resource_name, name);
3196 /* Create fontsets from `global_fontset_alist' before handling fonts. */
3197 for (tem = Vglobal_fontset_alist; CONSP (tem); tem = XCONS (tem)->cdr)
3198 fs_register_fontset (f, XCONS (tem)->car);
3200 /* Extract the window parameters from the supplied values
3201 that are needed to determine window geometry. */
3203 Lisp_Object font;
3205 font = x_get_arg (parms, Qfont, "font", "Font", string);
3206 if (!STRINGP (font))
3207 font = x_get_arg (parms, Qfontset, "fontset", "Fontset", string);
3208 BLOCK_INPUT;
3209 /* First, try whatever font the caller has specified. */
3210 if (STRINGP (font))
3212 Lisp_Object fontset = Fquery_fontset (font);
3213 if (STRINGP (fontset))
3214 font = x_new_fontset (f, XSTRING (fontset)->data);
3215 else
3216 font = x_new_font (f, XSTRING (font)->data);
3218 /* Try out a font which we hope has bold and italic variations. */
3219 if (!STRINGP (font))
3220 font = x_new_font (f, "-misc-fixed-medium-r-normal-*-*-140-*-*-c-*-iso8859-1");
3221 if (! STRINGP (font))
3222 font = x_new_font (f, "-*-*-medium-r-normal-*-*-140-*-*-c-*-iso8859-1");
3223 if (! STRINGP (font))
3224 /* This was formerly the first thing tried, but it finds too many fonts
3225 and takes too long. */
3226 font = x_new_font (f, "-*-*-medium-r-*-*-*-*-*-*-c-*-iso8859-1");
3227 /* If those didn't work, look for something which will at least work. */
3228 if (! STRINGP (font))
3229 font = x_new_font (f, "-*-fixed-*-*-*-*-*-140-*-*-c-*-iso8859-1");
3230 UNBLOCK_INPUT;
3231 if (! STRINGP (font))
3232 font = build_string ("fixed");
3234 x_default_parameter (f, parms, Qfont, font,
3235 "font", "Font", string);
3238 #ifdef USE_LUCID
3239 /* Prevent lwlib/xlwmenu.c from crashing because of a bug
3240 whereby it fails to get any font. */
3241 xlwmenu_default_font = f->output_data.x->font;
3242 #endif
3244 x_default_parameter (f, parms, Qborder_width, make_number (2),
3245 "borderwidth", "BorderWidth", number);
3246 /* This defaults to 2 in order to match xterm. We recognize either
3247 internalBorderWidth or internalBorder (which is what xterm calls
3248 it). */
3249 if (NILP (Fassq (Qinternal_border_width, parms)))
3251 Lisp_Object value;
3253 value = x_get_arg (parms, Qinternal_border_width,
3254 "internalBorder", "internalBorder", number);
3255 if (! EQ (value, Qunbound))
3256 parms = Fcons (Fcons (Qinternal_border_width, value),
3257 parms);
3259 x_default_parameter (f, parms, Qinternal_border_width, make_number (1),
3260 "internalBorderWidth", "internalBorderWidth", number);
3261 x_default_parameter (f, parms, Qvertical_scroll_bars, Qleft,
3262 "verticalScrollBars", "ScrollBars", boolean);
3264 /* Also do the stuff which must be set before the window exists. */
3265 x_default_parameter (f, parms, Qforeground_color, build_string ("black"),
3266 "foreground", "Foreground", string);
3267 x_default_parameter (f, parms, Qbackground_color, build_string ("white"),
3268 "background", "Background", string);
3269 x_default_parameter (f, parms, Qmouse_color, build_string ("black"),
3270 "pointerColor", "Foreground", string);
3271 x_default_parameter (f, parms, Qcursor_color, build_string ("black"),
3272 "cursorColor", "Foreground", string);
3273 x_default_parameter (f, parms, Qborder_color, build_string ("black"),
3274 "borderColor", "BorderColor", string);
3276 x_default_parameter (f, parms, Qmenu_bar_lines, make_number (1),
3277 "menuBar", "MenuBar", number);
3278 x_default_parameter (f, parms, Qscroll_bar_width, Qnil,
3279 "scrollBarWidth", "ScrollBarWidth", number);
3280 x_default_parameter (f, parms, Qbuffer_predicate, Qnil,
3281 "bufferPredicate", "BufferPredicate", symbol);
3282 x_default_parameter (f, parms, Qtitle, Qnil,
3283 "title", "Title", string);
3285 f->output_data.x->parent_desc = FRAME_X_DISPLAY_INFO (f)->root_window;
3286 window_prompting = x_figure_window_size (f, parms);
3288 if (window_prompting & XNegative)
3290 if (window_prompting & YNegative)
3291 f->output_data.x->win_gravity = SouthEastGravity;
3292 else
3293 f->output_data.x->win_gravity = NorthEastGravity;
3295 else
3297 if (window_prompting & YNegative)
3298 f->output_data.x->win_gravity = SouthWestGravity;
3299 else
3300 f->output_data.x->win_gravity = NorthWestGravity;
3303 f->output_data.x->size_hint_flags = window_prompting;
3305 #ifdef USE_X_TOOLKIT
3306 x_window (f, window_prompting, minibuffer_only);
3307 #else
3308 x_window (f);
3309 #endif
3310 x_icon (f, parms);
3311 x_make_gc (f);
3312 init_frame_faces (f);
3314 /* We need to do this after creating the X window, so that the
3315 icon-creation functions can say whose icon they're describing. */
3316 x_default_parameter (f, parms, Qicon_type, Qnil,
3317 "bitmapIcon", "BitmapIcon", symbol);
3319 x_default_parameter (f, parms, Qauto_raise, Qnil,
3320 "autoRaise", "AutoRaiseLower", boolean);
3321 x_default_parameter (f, parms, Qauto_lower, Qnil,
3322 "autoLower", "AutoRaiseLower", boolean);
3323 x_default_parameter (f, parms, Qcursor_type, Qbox,
3324 "cursorType", "CursorType", symbol);
3326 /* Dimensions, especially f->height, must be done via change_frame_size.
3327 Change will not be effected unless different from the current
3328 f->height. */
3329 width = f->width;
3330 height = f->height;
3331 f->height = 0;
3332 SET_FRAME_WIDTH (f, 0);
3333 change_frame_size (f, height, width, 1, 0);
3335 /* Tell the server what size and position, etc, we want,
3336 and how badly we want them. */
3337 BLOCK_INPUT;
3338 x_wm_set_size_hint (f, window_prompting, 0);
3339 UNBLOCK_INPUT;
3341 tem = x_get_arg (parms, Qunsplittable, 0, 0, boolean);
3342 f->no_split = minibuffer_only || EQ (tem, Qt);
3344 UNGCPRO;
3346 /* It is now ok to make the frame official
3347 even if we get an error below.
3348 And the frame needs to be on Vframe_list
3349 or making it visible won't work. */
3350 Vframe_list = Fcons (frame, Vframe_list);
3352 /* Now that the frame is official, it counts as a reference to
3353 its display. */
3354 FRAME_X_DISPLAY_INFO (f)->reference_count++;
3356 /* Make the window appear on the frame and enable display,
3357 unless the caller says not to. However, with explicit parent,
3358 Emacs cannot control visibility, so don't try. */
3359 if (! f->output_data.x->explicit_parent)
3361 Lisp_Object visibility;
3363 visibility = x_get_arg (parms, Qvisibility, 0, 0, symbol);
3364 if (EQ (visibility, Qunbound))
3365 visibility = Qt;
3367 if (EQ (visibility, Qicon))
3368 x_iconify_frame (f);
3369 else if (! NILP (visibility))
3370 x_make_frame_visible (f);
3371 else
3372 /* Must have been Qnil. */
3376 return unbind_to (count, frame);
3379 /* FRAME is used only to get a handle on the X display. We don't pass the
3380 display info directly because we're called from frame.c, which doesn't
3381 know about that structure. */
3383 Lisp_Object
3384 x_get_focus_frame (frame)
3385 struct frame *frame;
3387 struct x_display_info *dpyinfo = FRAME_X_DISPLAY_INFO (frame);
3388 Lisp_Object xfocus;
3389 if (! dpyinfo->x_focus_frame)
3390 return Qnil;
3392 XSETFRAME (xfocus, dpyinfo->x_focus_frame);
3393 return xfocus;
3396 #if 1
3397 #include "x-list-font.c"
3398 #else
3399 DEFUN ("x-list-fonts", Fx_list_fonts, Sx_list_fonts, 1, 4, 0,
3400 "Return a list of the names of available fonts matching PATTERN.\n\
3401 If optional arguments FACE and FRAME are specified, return only fonts\n\
3402 the same size as FACE on FRAME.\n\
3404 PATTERN is a string, perhaps with wildcard characters;\n\
3405 the * character matches any substring, and\n\
3406 the ? character matches any single character.\n\
3407 PATTERN is case-insensitive.\n\
3408 FACE is a face name--a symbol.\n\
3410 The return value is a list of strings, suitable as arguments to\n\
3411 set-face-font.\n\
3413 Fonts Emacs can't use (i.e. proportional fonts) may or may not be excluded\n\
3414 even if they match PATTERN and FACE.\n\
3416 The optional fourth argument MAXIMUM sets a limit on how many\n\
3417 fonts to match. The first MAXIMUM fonts are reported.")
3418 (pattern, face, frame, maximum)
3419 Lisp_Object pattern, face, frame, maximum;
3421 int num_fonts;
3422 char **names;
3423 #ifndef BROKEN_XLISTFONTSWITHINFO
3424 XFontStruct *info;
3425 #endif
3426 XFontStruct *size_ref;
3427 Lisp_Object list;
3428 FRAME_PTR f;
3429 Lisp_Object key;
3430 int maxnames;
3431 int count;
3433 check_x ();
3434 CHECK_STRING (pattern, 0);
3435 if (!NILP (face))
3436 CHECK_SYMBOL (face, 1);
3438 if (NILP (maximum))
3439 maxnames = 2000;
3440 else
3442 CHECK_NATNUM (maximum, 0);
3443 maxnames = XINT (maximum);
3446 f = check_x_frame (frame);
3448 /* Determine the width standard for comparison with the fonts we find. */
3450 if (NILP (face))
3451 size_ref = 0;
3452 else
3454 int face_id;
3456 /* Don't die if we get called with a terminal frame. */
3457 if (! FRAME_X_P (f))
3458 error ("Non-X frame used in `x-list-fonts'");
3460 face_id = face_name_id_number (f, face);
3462 if (face_id < 0 || face_id >= FRAME_N_PARAM_FACES (f)
3463 || FRAME_PARAM_FACES (f) [face_id] == 0)
3464 size_ref = f->output_data.x->font;
3465 else
3467 size_ref = FRAME_PARAM_FACES (f) [face_id]->font;
3468 if (size_ref == (XFontStruct *) (~0))
3469 size_ref = f->output_data.x->font;
3473 /* See if we cached the result for this particular query. */
3474 key = Fcons (pattern, maximum);
3475 list = Fassoc (key,
3476 XCONS (FRAME_X_DISPLAY_INFO (f)->name_list_element)->cdr);
3478 /* We have info in the cache for this PATTERN. */
3479 if (!NILP (list))
3481 Lisp_Object tem, newlist;
3483 /* We have info about this pattern. */
3484 list = XCONS (list)->cdr;
3486 if (size_ref == 0)
3487 return list;
3489 BLOCK_INPUT;
3491 /* Filter the cached info and return just the fonts that match FACE. */
3492 newlist = Qnil;
3493 for (tem = list; CONSP (tem); tem = XCONS (tem)->cdr)
3495 XFontStruct *thisinfo;
3497 count = x_catch_errors (FRAME_X_DISPLAY (f));
3499 thisinfo = XLoadQueryFont (FRAME_X_DISPLAY (f),
3500 XSTRING (XCONS (tem)->car)->data);
3502 x_check_errors (FRAME_X_DISPLAY (f), "XLoadQueryFont failure: %s");
3503 x_uncatch_errors (FRAME_X_DISPLAY (f), count);
3505 if (thisinfo && same_size_fonts (thisinfo, size_ref))
3506 newlist = Fcons (XCONS (tem)->car, newlist);
3508 if (thisinfo != 0)
3509 XFreeFont (FRAME_X_DISPLAY (f), thisinfo);
3512 UNBLOCK_INPUT;
3514 return newlist;
3517 BLOCK_INPUT;
3519 count = x_catch_errors (FRAME_X_DISPLAY (f));
3521 /* Solaris 2.3 has a bug in XListFontsWithInfo. */
3522 #ifndef BROKEN_XLISTFONTSWITHINFO
3523 if (size_ref)
3524 names = XListFontsWithInfo (FRAME_X_DISPLAY (f),
3525 XSTRING (pattern)->data,
3526 maxnames,
3527 &num_fonts, /* count_return */
3528 &info); /* info_return */
3529 else
3530 #endif
3531 names = XListFonts (FRAME_X_DISPLAY (f),
3532 XSTRING (pattern)->data,
3533 maxnames,
3534 &num_fonts); /* count_return */
3536 x_check_errors (FRAME_X_DISPLAY (f), "XListFonts failure: %s");
3537 x_uncatch_errors (FRAME_X_DISPLAY (f), count);
3539 UNBLOCK_INPUT;
3541 list = Qnil;
3543 if (names)
3545 int i;
3546 Lisp_Object full_list;
3548 /* Make a list of all the fonts we got back.
3549 Store that in the font cache for the display. */
3550 full_list = Qnil;
3551 for (i = 0; i < num_fonts; i++)
3552 full_list = Fcons (build_string (names[i]), full_list);
3553 XCONS (FRAME_X_DISPLAY_INFO (f)->name_list_element)->cdr
3554 = Fcons (Fcons (key, full_list),
3555 XCONS (FRAME_X_DISPLAY_INFO (f)->name_list_element)->cdr);
3557 /* Make a list of the fonts that have the right width. */
3558 list = Qnil;
3559 for (i = 0; i < num_fonts; i++)
3561 int keeper;
3563 if (!size_ref)
3564 keeper = 1;
3565 else
3567 #ifdef BROKEN_XLISTFONTSWITHINFO
3568 XFontStruct *thisinfo;
3570 BLOCK_INPUT;
3572 count = x_catch_errors (FRAME_X_DISPLAY (f));
3573 thisinfo = XLoadQueryFont (FRAME_X_DISPLAY (f), names[i]);
3574 x_check_errors (FRAME_X_DISPLAY (f),
3575 "XLoadQueryFont failure: %s");
3576 x_uncatch_errors (FRAME_X_DISPLAY (f), count);
3578 UNBLOCK_INPUT;
3580 keeper = thisinfo && same_size_fonts (thisinfo, size_ref);
3581 BLOCK_INPUT;
3582 if (thisinfo && ! keeper)
3583 XFreeFont (FRAME_X_DISPLAY (f), thisinfo);
3584 else if (thisinfo)
3585 XFreeFontInfo (NULL, thisinfo, 1);
3586 UNBLOCK_INPUT;
3587 #else
3588 keeper = same_size_fonts (&info[i], size_ref);
3589 #endif
3591 if (keeper)
3592 list = Fcons (build_string (names[i]), list);
3594 list = Fnreverse (list);
3596 BLOCK_INPUT;
3597 #ifndef BROKEN_XLISTFONTSWITHINFO
3598 if (size_ref)
3599 XFreeFontInfo (names, info, num_fonts);
3600 else
3601 #endif
3602 XFreeFontNames (names);
3603 UNBLOCK_INPUT;
3606 return list;
3608 #endif
3611 DEFUN ("x-color-defined-p", Fx_color_defined_p, Sx_color_defined_p, 1, 2, 0,
3612 "Return non-nil if color COLOR is supported on frame FRAME.\n\
3613 If FRAME is omitted or nil, use the selected frame.")
3614 (color, frame)
3615 Lisp_Object color, frame;
3617 XColor foo;
3618 FRAME_PTR f = check_x_frame (frame);
3620 CHECK_STRING (color, 1);
3622 if (defined_color (f, XSTRING (color)->data, &foo, 0))
3623 return Qt;
3624 else
3625 return Qnil;
3628 DEFUN ("x-color-values", Fx_color_values, Sx_color_values, 1, 2, 0,
3629 "Return a description of the color named COLOR on frame FRAME.\n\
3630 The value is a list of integer RGB values--(RED GREEN BLUE).\n\
3631 These values appear to range from 0 to 65280 or 65535, depending\n\
3632 on the system; white is (65280 65280 65280) or (65535 65535 65535).\n\
3633 If FRAME is omitted or nil, use the selected frame.")
3634 (color, frame)
3635 Lisp_Object color, frame;
3637 XColor foo;
3638 FRAME_PTR f = check_x_frame (frame);
3640 CHECK_STRING (color, 1);
3642 if (defined_color (f, XSTRING (color)->data, &foo, 0))
3644 Lisp_Object rgb[3];
3646 rgb[0] = make_number (foo.red);
3647 rgb[1] = make_number (foo.green);
3648 rgb[2] = make_number (foo.blue);
3649 return Flist (3, rgb);
3651 else
3652 return Qnil;
3655 DEFUN ("x-display-color-p", Fx_display_color_p, Sx_display_color_p, 0, 1, 0,
3656 "Return t if the X display supports color.\n\
3657 The optional argument DISPLAY specifies which display to ask about.\n\
3658 DISPLAY should be either a frame or a display name (a string).\n\
3659 If omitted or nil, that stands for the selected frame's display.")
3660 (display)
3661 Lisp_Object display;
3663 struct x_display_info *dpyinfo = check_x_display_info (display);
3665 if (dpyinfo->n_planes <= 2)
3666 return Qnil;
3668 switch (dpyinfo->visual->class)
3670 case StaticColor:
3671 case PseudoColor:
3672 case TrueColor:
3673 case DirectColor:
3674 return Qt;
3676 default:
3677 return Qnil;
3681 DEFUN ("x-display-grayscale-p", Fx_display_grayscale_p, Sx_display_grayscale_p,
3682 0, 1, 0,
3683 "Return t if the X display supports shades of gray.\n\
3684 Note that color displays do support shades of gray.\n\
3685 The optional argument DISPLAY specifies which display to ask about.\n\
3686 DISPLAY should be either a frame or a display name (a string).\n\
3687 If omitted or nil, that stands for the selected frame's display.")
3688 (display)
3689 Lisp_Object display;
3691 struct x_display_info *dpyinfo = check_x_display_info (display);
3693 if (dpyinfo->n_planes <= 1)
3694 return Qnil;
3696 switch (dpyinfo->visual->class)
3698 case StaticColor:
3699 case PseudoColor:
3700 case TrueColor:
3701 case DirectColor:
3702 case StaticGray:
3703 case GrayScale:
3704 return Qt;
3706 default:
3707 return Qnil;
3711 DEFUN ("x-display-pixel-width", Fx_display_pixel_width, Sx_display_pixel_width,
3712 0, 1, 0,
3713 "Returns the width in pixels of the X display DISPLAY.\n\
3714 The optional argument DISPLAY specifies which display to ask about.\n\
3715 DISPLAY should be either a frame or a display name (a string).\n\
3716 If omitted or nil, that stands for the selected frame's display.")
3717 (display)
3718 Lisp_Object display;
3720 struct x_display_info *dpyinfo = check_x_display_info (display);
3722 return make_number (dpyinfo->width);
3725 DEFUN ("x-display-pixel-height", Fx_display_pixel_height,
3726 Sx_display_pixel_height, 0, 1, 0,
3727 "Returns the height in pixels of the X display DISPLAY.\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 return make_number (dpyinfo->height);
3739 DEFUN ("x-display-planes", Fx_display_planes, Sx_display_planes,
3740 0, 1, 0,
3741 "Returns the number of bitplanes of the X display DISPLAY.\n\
3742 The optional argument DISPLAY specifies which display to ask about.\n\
3743 DISPLAY should be either a frame or a display name (a string).\n\
3744 If omitted or nil, that stands for the selected frame's display.")
3745 (display)
3746 Lisp_Object display;
3748 struct x_display_info *dpyinfo = check_x_display_info (display);
3750 return make_number (dpyinfo->n_planes);
3753 DEFUN ("x-display-color-cells", Fx_display_color_cells, Sx_display_color_cells,
3754 0, 1, 0,
3755 "Returns the number of color cells of the X display DISPLAY.\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 return make_number (DisplayCells (dpyinfo->display,
3765 XScreenNumberOfScreen (dpyinfo->screen)));
3768 DEFUN ("x-server-max-request-size", Fx_server_max_request_size,
3769 Sx_server_max_request_size,
3770 0, 1, 0,
3771 "Returns the maximum request size of the X server of display DISPLAY.\n\
3772 The optional argument DISPLAY specifies which display to ask about.\n\
3773 DISPLAY should be either a frame or a display name (a string).\n\
3774 If omitted or nil, that stands for the selected frame's display.")
3775 (display)
3776 Lisp_Object display;
3778 struct x_display_info *dpyinfo = check_x_display_info (display);
3780 return make_number (MAXREQUEST (dpyinfo->display));
3783 DEFUN ("x-server-vendor", Fx_server_vendor, Sx_server_vendor, 0, 1, 0,
3784 "Returns the vendor ID string of the X server of 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);
3792 char *vendor = ServerVendor (dpyinfo->display);
3794 if (! vendor) vendor = "";
3795 return build_string (vendor);
3798 DEFUN ("x-server-version", Fx_server_version, Sx_server_version, 0, 1, 0,
3799 "Returns the version numbers of the X server of display DISPLAY.\n\
3800 The value is a list of three integers: the major and minor\n\
3801 version numbers of the X Protocol in use, and the vendor-specific release\n\
3802 number. See also the function `x-server-vendor'.\n\n\
3803 The optional argument DISPLAY specifies which display to ask about.\n\
3804 DISPLAY should be either a frame or a display name (a string).\n\
3805 If omitted or nil, that stands for the selected frame's display.")
3806 (display)
3807 Lisp_Object display;
3809 struct x_display_info *dpyinfo = check_x_display_info (display);
3810 Display *dpy = dpyinfo->display;
3812 return Fcons (make_number (ProtocolVersion (dpy)),
3813 Fcons (make_number (ProtocolRevision (dpy)),
3814 Fcons (make_number (VendorRelease (dpy)), Qnil)));
3817 DEFUN ("x-display-screens", Fx_display_screens, Sx_display_screens, 0, 1, 0,
3818 "Returns the number of screens on the X server of display DISPLAY.\n\
3819 The optional argument DISPLAY specifies which display to ask about.\n\
3820 DISPLAY should be either a frame or a display name (a string).\n\
3821 If omitted or nil, that stands for the selected frame's display.")
3822 (display)
3823 Lisp_Object display;
3825 struct x_display_info *dpyinfo = check_x_display_info (display);
3827 return make_number (ScreenCount (dpyinfo->display));
3830 DEFUN ("x-display-mm-height", Fx_display_mm_height, Sx_display_mm_height, 0, 1, 0,
3831 "Returns the height in millimeters of the X display DISPLAY.\n\
3832 The optional argument DISPLAY specifies which display to ask about.\n\
3833 DISPLAY should be either a frame or a display name (a string).\n\
3834 If omitted or nil, that stands for the selected frame's display.")
3835 (display)
3836 Lisp_Object display;
3838 struct x_display_info *dpyinfo = check_x_display_info (display);
3840 return make_number (HeightMMOfScreen (dpyinfo->screen));
3843 DEFUN ("x-display-mm-width", Fx_display_mm_width, Sx_display_mm_width, 0, 1, 0,
3844 "Returns the width in millimeters of the X display DISPLAY.\n\
3845 The optional argument DISPLAY specifies which display to ask about.\n\
3846 DISPLAY should be either a frame or a display name (a string).\n\
3847 If omitted or nil, that stands for the selected frame's display.")
3848 (display)
3849 Lisp_Object display;
3851 struct x_display_info *dpyinfo = check_x_display_info (display);
3853 return make_number (WidthMMOfScreen (dpyinfo->screen));
3856 DEFUN ("x-display-backing-store", Fx_display_backing_store,
3857 Sx_display_backing_store, 0, 1, 0,
3858 "Returns an indication of whether X display DISPLAY does backing store.\n\
3859 The value may be `always', `when-mapped', or `not-useful'.\n\
3860 The optional argument DISPLAY specifies which display to ask about.\n\
3861 DISPLAY should be either a frame or a display name (a string).\n\
3862 If omitted or nil, that stands for the selected frame's display.")
3863 (display)
3864 Lisp_Object display;
3866 struct x_display_info *dpyinfo = check_x_display_info (display);
3868 switch (DoesBackingStore (dpyinfo->screen))
3870 case Always:
3871 return intern ("always");
3873 case WhenMapped:
3874 return intern ("when-mapped");
3876 case NotUseful:
3877 return intern ("not-useful");
3879 default:
3880 error ("Strange value for BackingStore parameter of screen");
3884 DEFUN ("x-display-visual-class", Fx_display_visual_class,
3885 Sx_display_visual_class, 0, 1, 0,
3886 "Returns the visual class of the X display DISPLAY.\n\
3887 The value is one of the symbols `static-gray', `gray-scale',\n\
3888 `static-color', `pseudo-color', `true-color', or `direct-color'.\n\n\
3889 The optional argument DISPLAY specifies which display to ask about.\n\
3890 DISPLAY should be either a frame or a display name (a string).\n\
3891 If omitted or nil, that stands for the selected frame's display.")
3892 (display)
3893 Lisp_Object display;
3895 struct x_display_info *dpyinfo = check_x_display_info (display);
3897 switch (dpyinfo->visual->class)
3899 case StaticGray: return (intern ("static-gray"));
3900 case GrayScale: return (intern ("gray-scale"));
3901 case StaticColor: return (intern ("static-color"));
3902 case PseudoColor: return (intern ("pseudo-color"));
3903 case TrueColor: return (intern ("true-color"));
3904 case DirectColor: return (intern ("direct-color"));
3905 default:
3906 error ("Display has an unknown visual class");
3910 DEFUN ("x-display-save-under", Fx_display_save_under,
3911 Sx_display_save_under, 0, 1, 0,
3912 "Returns t if the X display DISPLAY supports the save-under feature.\n\
3913 The optional argument DISPLAY specifies which display to ask about.\n\
3914 DISPLAY should be either a frame or a display name (a string).\n\
3915 If omitted or nil, that stands for the selected frame's display.")
3916 (display)
3917 Lisp_Object display;
3919 struct x_display_info *dpyinfo = check_x_display_info (display);
3921 if (DoesSaveUnders (dpyinfo->screen) == True)
3922 return Qt;
3923 else
3924 return Qnil;
3928 x_pixel_width (f)
3929 register struct frame *f;
3931 return PIXEL_WIDTH (f);
3935 x_pixel_height (f)
3936 register struct frame *f;
3938 return PIXEL_HEIGHT (f);
3942 x_char_width (f)
3943 register struct frame *f;
3945 return FONT_WIDTH (f->output_data.x->font);
3949 x_char_height (f)
3950 register struct frame *f;
3952 return f->output_data.x->line_height;
3956 x_screen_planes (frame)
3957 Lisp_Object frame;
3959 return FRAME_X_DISPLAY_INFO (XFRAME (frame))->n_planes;
3962 #if 0 /* These no longer seem like the right way to do things. */
3964 /* Draw a rectangle on the frame with left top corner including
3965 the character specified by LEFT_CHAR and TOP_CHAR. The rectangle is
3966 CHARS by LINES wide and long and is the color of the cursor. */
3968 void
3969 x_rectangle (f, gc, left_char, top_char, chars, lines)
3970 register struct frame *f;
3971 GC gc;
3972 register int top_char, left_char, chars, lines;
3974 int width;
3975 int height;
3976 int left = (left_char * FONT_WIDTH (f->output_data.x->font)
3977 + f->output_data.x->internal_border_width);
3978 int top = (top_char * f->output_data.x->line_height
3979 + f->output_data.x->internal_border_width);
3981 if (chars < 0)
3982 width = FONT_WIDTH (f->output_data.x->font) / 2;
3983 else
3984 width = FONT_WIDTH (f->output_data.x->font) * chars;
3985 if (lines < 0)
3986 height = f->output_data.x->line_height / 2;
3987 else
3988 height = f->output_data.x->line_height * lines;
3990 XDrawRectangle (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
3991 gc, left, top, width, height);
3994 DEFUN ("x-draw-rectangle", Fx_draw_rectangle, Sx_draw_rectangle, 5, 5, 0,
3995 "Draw a rectangle on FRAME between coordinates specified by\n\
3996 numbers X0, Y0, X1, Y1 in the cursor pixel.")
3997 (frame, X0, Y0, X1, Y1)
3998 register Lisp_Object frame, X0, X1, Y0, Y1;
4000 register int x0, y0, x1, y1, top, left, n_chars, n_lines;
4002 CHECK_LIVE_FRAME (frame, 0);
4003 CHECK_NUMBER (X0, 0);
4004 CHECK_NUMBER (Y0, 1);
4005 CHECK_NUMBER (X1, 2);
4006 CHECK_NUMBER (Y1, 3);
4008 x0 = XINT (X0);
4009 x1 = XINT (X1);
4010 y0 = XINT (Y0);
4011 y1 = XINT (Y1);
4013 if (y1 > y0)
4015 top = y0;
4016 n_lines = y1 - y0 + 1;
4018 else
4020 top = y1;
4021 n_lines = y0 - y1 + 1;
4024 if (x1 > x0)
4026 left = x0;
4027 n_chars = x1 - x0 + 1;
4029 else
4031 left = x1;
4032 n_chars = x0 - x1 + 1;
4035 BLOCK_INPUT;
4036 x_rectangle (XFRAME (frame), XFRAME (frame)->output_data.x->cursor_gc,
4037 left, top, n_chars, n_lines);
4038 UNBLOCK_INPUT;
4040 return Qt;
4043 DEFUN ("x-erase-rectangle", Fx_erase_rectangle, Sx_erase_rectangle, 5, 5, 0,
4044 "Draw a rectangle drawn on FRAME between coordinates\n\
4045 X0, Y0, X1, Y1 in the regular background-pixel.")
4046 (frame, X0, Y0, X1, Y1)
4047 register Lisp_Object frame, X0, Y0, X1, Y1;
4049 register int x0, y0, x1, y1, top, left, n_chars, n_lines;
4051 CHECK_LIVE_FRAME (frame, 0);
4052 CHECK_NUMBER (X0, 0);
4053 CHECK_NUMBER (Y0, 1);
4054 CHECK_NUMBER (X1, 2);
4055 CHECK_NUMBER (Y1, 3);
4057 x0 = XINT (X0);
4058 x1 = XINT (X1);
4059 y0 = XINT (Y0);
4060 y1 = XINT (Y1);
4062 if (y1 > y0)
4064 top = y0;
4065 n_lines = y1 - y0 + 1;
4067 else
4069 top = y1;
4070 n_lines = y0 - y1 + 1;
4073 if (x1 > x0)
4075 left = x0;
4076 n_chars = x1 - x0 + 1;
4078 else
4080 left = x1;
4081 n_chars = x0 - x1 + 1;
4084 BLOCK_INPUT;
4085 x_rectangle (XFRAME (frame), XFRAME (frame)->output_data.x->reverse_gc,
4086 left, top, n_chars, n_lines);
4087 UNBLOCK_INPUT;
4089 return Qt;
4092 /* Draw lines around the text region beginning at the character position
4093 TOP_X, TOP_Y and ending at BOTTOM_X and BOTTOM_Y. GC specifies the
4094 pixel and line characteristics. */
4096 #define line_len(line) (FRAME_CURRENT_GLYPHS (f)->used[(line)])
4098 static void
4099 outline_region (f, gc, top_x, top_y, bottom_x, bottom_y)
4100 register struct frame *f;
4101 GC gc;
4102 int top_x, top_y, bottom_x, bottom_y;
4104 register int ibw = f->output_data.x->internal_border_width;
4105 register int font_w = FONT_WIDTH (f->output_data.x->font);
4106 register int font_h = f->output_data.x->line_height;
4107 int y = top_y;
4108 int x = line_len (y);
4109 XPoint *pixel_points
4110 = (XPoint *) alloca (((bottom_y - top_y + 2) * 4) * sizeof (XPoint));
4111 register XPoint *this_point = pixel_points;
4113 /* Do the horizontal top line/lines */
4114 if (top_x == 0)
4116 this_point->x = ibw;
4117 this_point->y = ibw + (font_h * top_y);
4118 this_point++;
4119 if (x == 0)
4120 this_point->x = ibw + (font_w / 2); /* Half-size for newline chars. */
4121 else
4122 this_point->x = ibw + (font_w * x);
4123 this_point->y = (this_point - 1)->y;
4125 else
4127 this_point->x = ibw;
4128 this_point->y = ibw + (font_h * (top_y + 1));
4129 this_point++;
4130 this_point->x = ibw + (font_w * top_x);
4131 this_point->y = (this_point - 1)->y;
4132 this_point++;
4133 this_point->x = (this_point - 1)->x;
4134 this_point->y = ibw + (font_h * top_y);
4135 this_point++;
4136 this_point->x = ibw + (font_w * x);
4137 this_point->y = (this_point - 1)->y;
4140 /* Now do the right side. */
4141 while (y < bottom_y)
4142 { /* Right vertical edge */
4143 this_point++;
4144 this_point->x = (this_point - 1)->x;
4145 this_point->y = ibw + (font_h * (y + 1));
4146 this_point++;
4148 y++; /* Horizontal connection to next line */
4149 x = line_len (y);
4150 if (x == 0)
4151 this_point->x = ibw + (font_w / 2);
4152 else
4153 this_point->x = ibw + (font_w * x);
4155 this_point->y = (this_point - 1)->y;
4158 /* Now do the bottom and connect to the top left point. */
4159 this_point->x = ibw + (font_w * (bottom_x + 1));
4161 this_point++;
4162 this_point->x = (this_point - 1)->x;
4163 this_point->y = ibw + (font_h * (bottom_y + 1));
4164 this_point++;
4165 this_point->x = ibw;
4166 this_point->y = (this_point - 1)->y;
4167 this_point++;
4168 this_point->x = pixel_points->x;
4169 this_point->y = pixel_points->y;
4171 XDrawLines (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
4172 gc, pixel_points,
4173 (this_point - pixel_points + 1), CoordModeOrigin);
4176 DEFUN ("x-contour-region", Fx_contour_region, Sx_contour_region, 1, 1, 0,
4177 "Highlight the region between point and the character under the mouse\n\
4178 selected frame.")
4179 (event)
4180 register Lisp_Object event;
4182 register int x0, y0, x1, y1;
4183 register struct frame *f = selected_frame;
4184 register int p1, p2;
4186 CHECK_CONS (event, 0);
4188 BLOCK_INPUT;
4189 x0 = XINT (Fcar (Fcar (event)));
4190 y0 = XINT (Fcar (Fcdr (Fcar (event))));
4192 /* If the mouse is past the end of the line, don't that area. */
4193 /* ReWrite this... */
4195 x1 = f->cursor_x;
4196 y1 = f->cursor_y;
4198 if (y1 > y0) /* point below mouse */
4199 outline_region (f, f->output_data.x->cursor_gc,
4200 x0, y0, x1, y1);
4201 else if (y1 < y0) /* point above mouse */
4202 outline_region (f, f->output_data.x->cursor_gc,
4203 x1, y1, x0, y0);
4204 else /* same line: draw horizontal rectangle */
4206 if (x1 > x0)
4207 x_rectangle (f, f->output_data.x->cursor_gc,
4208 x0, y0, (x1 - x0 + 1), 1);
4209 else if (x1 < x0)
4210 x_rectangle (f, f->output_data.x->cursor_gc,
4211 x1, y1, (x0 - x1 + 1), 1);
4214 XFlush (FRAME_X_DISPLAY (f));
4215 UNBLOCK_INPUT;
4217 return Qnil;
4220 DEFUN ("x-uncontour-region", Fx_uncontour_region, Sx_uncontour_region, 1, 1, 0,
4221 "Erase any highlighting of the region between point and the character\n\
4222 at X, Y on the selected frame.")
4223 (event)
4224 register Lisp_Object event;
4226 register int x0, y0, x1, y1;
4227 register struct frame *f = selected_frame;
4229 BLOCK_INPUT;
4230 x0 = XINT (Fcar (Fcar (event)));
4231 y0 = XINT (Fcar (Fcdr (Fcar (event))));
4232 x1 = f->cursor_x;
4233 y1 = f->cursor_y;
4235 if (y1 > y0) /* point below mouse */
4236 outline_region (f, f->output_data.x->reverse_gc,
4237 x0, y0, x1, y1);
4238 else if (y1 < y0) /* point above mouse */
4239 outline_region (f, f->output_data.x->reverse_gc,
4240 x1, y1, x0, y0);
4241 else /* same line: draw horizontal rectangle */
4243 if (x1 > x0)
4244 x_rectangle (f, f->output_data.x->reverse_gc,
4245 x0, y0, (x1 - x0 + 1), 1);
4246 else if (x1 < x0)
4247 x_rectangle (f, f->output_data.x->reverse_gc,
4248 x1, y1, (x0 - x1 + 1), 1);
4250 UNBLOCK_INPUT;
4252 return Qnil;
4255 #if 0
4256 int contour_begin_x, contour_begin_y;
4257 int contour_end_x, contour_end_y;
4258 int contour_npoints;
4260 /* Clip the top part of the contour lines down (and including) line Y_POS.
4261 If X_POS is in the middle (rather than at the end) of the line, drop
4262 down a line at that character. */
4264 static void
4265 clip_contour_top (y_pos, x_pos)
4267 register XPoint *begin = contour_lines[y_pos].top_left;
4268 register XPoint *end;
4269 register int npoints;
4270 register struct display_line *line = selected_frame->phys_lines[y_pos + 1];
4272 if (x_pos >= line->len - 1) /* Draw one, straight horizontal line. */
4274 end = contour_lines[y_pos].top_right;
4275 npoints = (end - begin + 1);
4276 XDrawLines (x_current_display, contour_window,
4277 contour_erase_gc, begin_erase, npoints, CoordModeOrigin);
4279 bcopy (end, begin + 1, contour_last_point - end + 1);
4280 contour_last_point -= (npoints - 2);
4281 XDrawLines (x_current_display, contour_window,
4282 contour_erase_gc, begin, 2, CoordModeOrigin);
4283 XFlush (x_current_display);
4285 /* Now, update contour_lines structure. */
4287 /* ______. */
4288 else /* |________*/
4290 register XPoint *p = begin + 1;
4291 end = contour_lines[y_pos].bottom_right;
4292 npoints = (end - begin + 1);
4293 XDrawLines (x_current_display, contour_window,
4294 contour_erase_gc, begin_erase, npoints, CoordModeOrigin);
4296 p->y = begin->y;
4297 p->x = ibw + (font_w * (x_pos + 1));
4298 p++;
4299 p->y = begin->y + font_h;
4300 p->x = (p - 1)->x;
4301 bcopy (end, begin + 3, contour_last_point - end + 1);
4302 contour_last_point -= (npoints - 5);
4303 XDrawLines (x_current_display, contour_window,
4304 contour_erase_gc, begin, 4, CoordModeOrigin);
4305 XFlush (x_current_display);
4307 /* Now, update contour_lines structure. */
4311 /* Erase the top horizontal lines of the contour, and then extend
4312 the contour upwards. */
4314 static void
4315 extend_contour_top (line)
4319 static void
4320 clip_contour_bottom (x_pos, y_pos)
4321 int x_pos, y_pos;
4325 static void
4326 extend_contour_bottom (x_pos, y_pos)
4330 DEFUN ("x-select-region", Fx_select_region, Sx_select_region, 1, 1, "e",
4332 (event)
4333 Lisp_Object event;
4335 register struct frame *f = selected_frame;
4336 register int point_x = f->cursor_x;
4337 register int point_y = f->cursor_y;
4338 register int mouse_below_point;
4339 register Lisp_Object obj;
4340 register int x_contour_x, x_contour_y;
4342 x_contour_x = x_mouse_x;
4343 x_contour_y = x_mouse_y;
4344 if (x_contour_y > point_y || (x_contour_y == point_y
4345 && x_contour_x > point_x))
4347 mouse_below_point = 1;
4348 outline_region (f, f->output_data.x->cursor_gc, point_x, point_y,
4349 x_contour_x, x_contour_y);
4351 else
4353 mouse_below_point = 0;
4354 outline_region (f, f->output_data.x->cursor_gc, x_contour_x, x_contour_y,
4355 point_x, point_y);
4358 while (1)
4360 obj = read_char (-1, 0, 0, Qnil, 0);
4361 if (!CONSP (obj))
4362 break;
4364 if (mouse_below_point)
4366 if (x_mouse_y <= point_y) /* Flipped. */
4368 mouse_below_point = 0;
4370 outline_region (f, f->output_data.x->reverse_gc, point_x, point_y,
4371 x_contour_x, x_contour_y);
4372 outline_region (f, f->output_data.x->cursor_gc, x_mouse_x, x_mouse_y,
4373 point_x, point_y);
4375 else if (x_mouse_y < x_contour_y) /* Bottom clipped. */
4377 clip_contour_bottom (x_mouse_y);
4379 else if (x_mouse_y > x_contour_y) /* Bottom extended. */
4381 extend_bottom_contour (x_mouse_y);
4384 x_contour_x = x_mouse_x;
4385 x_contour_y = x_mouse_y;
4387 else /* mouse above or same line as point */
4389 if (x_mouse_y >= point_y) /* Flipped. */
4391 mouse_below_point = 1;
4393 outline_region (f, f->output_data.x->reverse_gc,
4394 x_contour_x, x_contour_y, point_x, point_y);
4395 outline_region (f, f->output_data.x->cursor_gc, point_x, point_y,
4396 x_mouse_x, x_mouse_y);
4398 else if (x_mouse_y > x_contour_y) /* Top clipped. */
4400 clip_contour_top (x_mouse_y);
4402 else if (x_mouse_y < x_contour_y) /* Top extended. */
4404 extend_contour_top (x_mouse_y);
4409 unread_command_event = obj;
4410 if (mouse_below_point)
4412 contour_begin_x = point_x;
4413 contour_begin_y = point_y;
4414 contour_end_x = x_contour_x;
4415 contour_end_y = x_contour_y;
4417 else
4419 contour_begin_x = x_contour_x;
4420 contour_begin_y = x_contour_y;
4421 contour_end_x = point_x;
4422 contour_end_y = point_y;
4425 #endif
4427 DEFUN ("x-horizontal-line", Fx_horizontal_line, Sx_horizontal_line, 1, 1, "e",
4429 (event)
4430 Lisp_Object event;
4432 register Lisp_Object obj;
4433 struct frame *f = selected_frame;
4434 register struct window *w = XWINDOW (selected_window);
4435 register GC line_gc = f->output_data.x->cursor_gc;
4436 register GC erase_gc = f->output_data.x->reverse_gc;
4437 #if 0
4438 char dash_list[] = {6, 4, 6, 4};
4439 int dashes = 4;
4440 XGCValues gc_values;
4441 #endif
4442 register int previous_y;
4443 register int line = (x_mouse_y + 1) * f->output_data.x->line_height
4444 + f->output_data.x->internal_border_width;
4445 register int left = f->output_data.x->internal_border_width
4446 + (WINDOW_LEFT_MARGIN (w)
4447 * FONT_WIDTH (f->output_data.x->font));
4448 register int right = left + (w->width
4449 * FONT_WIDTH (f->output_data.x->font))
4450 - f->output_data.x->internal_border_width;
4452 #if 0
4453 BLOCK_INPUT;
4454 gc_values.foreground = f->output_data.x->cursor_pixel;
4455 gc_values.background = f->output_data.x->background_pixel;
4456 gc_values.line_width = 1;
4457 gc_values.line_style = LineOnOffDash;
4458 gc_values.cap_style = CapRound;
4459 gc_values.join_style = JoinRound;
4461 line_gc = XCreateGC (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
4462 GCLineStyle | GCJoinStyle | GCCapStyle
4463 | GCLineWidth | GCForeground | GCBackground,
4464 &gc_values);
4465 XSetDashes (FRAME_X_DISPLAY (f), line_gc, 0, dash_list, dashes);
4466 gc_values.foreground = f->output_data.x->background_pixel;
4467 gc_values.background = f->output_data.x->foreground_pixel;
4468 erase_gc = XCreateGC (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
4469 GCLineStyle | GCJoinStyle | GCCapStyle
4470 | GCLineWidth | GCForeground | GCBackground,
4471 &gc_values);
4472 XSetDashes (FRAME_X_DISPLAY (f), erase_gc, 0, dash_list, dashes);
4473 UNBLOCK_INPUT;
4474 #endif
4476 while (1)
4478 BLOCK_INPUT;
4479 if (x_mouse_y >= XINT (w->top)
4480 && x_mouse_y < XINT (w->top) + XINT (w->height) - 1)
4482 previous_y = x_mouse_y;
4483 line = (x_mouse_y + 1) * f->output_data.x->line_height
4484 + f->output_data.x->internal_border_width;
4485 XDrawLine (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
4486 line_gc, left, line, right, line);
4488 XFlush (FRAME_X_DISPLAY (f));
4489 UNBLOCK_INPUT;
4493 obj = read_char (-1, 0, 0, Qnil, 0);
4494 if (!CONSP (obj)
4495 || (! EQ (Fcar (Fcdr (Fcdr (obj))),
4496 Qvertical_scroll_bar))
4497 || x_mouse_grabbed)
4499 BLOCK_INPUT;
4500 XDrawLine (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
4501 erase_gc, left, line, right, line);
4502 unread_command_event = obj;
4503 #if 0
4504 XFreeGC (FRAME_X_DISPLAY (f), line_gc);
4505 XFreeGC (FRAME_X_DISPLAY (f), erase_gc);
4506 #endif
4507 UNBLOCK_INPUT;
4508 return Qnil;
4511 while (x_mouse_y == previous_y);
4513 BLOCK_INPUT;
4514 XDrawLine (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
4515 erase_gc, left, line, right, line);
4516 UNBLOCK_INPUT;
4519 #endif
4521 #if 0
4522 /* These keep track of the rectangle following the pointer. */
4523 int mouse_track_top, mouse_track_left, mouse_track_width;
4525 /* Offset in buffer of character under the pointer, or 0. */
4526 int mouse_buffer_offset;
4528 DEFUN ("x-track-pointer", Fx_track_pointer, Sx_track_pointer, 0, 0, 0,
4529 "Track the pointer.")
4532 static Cursor current_pointer_shape;
4533 FRAME_PTR f = x_mouse_frame;
4535 BLOCK_INPUT;
4536 if (EQ (Vmouse_frame_part, Qtext_part)
4537 && (current_pointer_shape != f->output_data.x->nontext_cursor))
4539 unsigned char c;
4540 struct buffer *buf;
4542 current_pointer_shape = f->output_data.x->nontext_cursor;
4543 XDefineCursor (FRAME_X_DISPLAY (f),
4544 FRAME_X_WINDOW (f),
4545 current_pointer_shape);
4547 buf = XBUFFER (XWINDOW (Vmouse_window)->buffer);
4548 c = *(BUF_CHAR_ADDRESS (buf, mouse_buffer_offset));
4550 else if (EQ (Vmouse_frame_part, Qmodeline_part)
4551 && (current_pointer_shape != f->output_data.x->modeline_cursor))
4553 current_pointer_shape = f->output_data.x->modeline_cursor;
4554 XDefineCursor (FRAME_X_DISPLAY (f),
4555 FRAME_X_WINDOW (f),
4556 current_pointer_shape);
4559 XFlush (FRAME_X_DISPLAY (f));
4560 UNBLOCK_INPUT;
4562 #endif
4564 #if 0
4565 DEFUN ("x-track-pointer", Fx_track_pointer, Sx_track_pointer, 1, 1, "e",
4566 "Draw rectangle around character under mouse pointer, if there is one.")
4567 (event)
4568 Lisp_Object event;
4570 struct window *w = XWINDOW (Vmouse_window);
4571 struct frame *f = XFRAME (WINDOW_FRAME (w));
4572 struct buffer *b = XBUFFER (w->buffer);
4573 Lisp_Object obj;
4575 if (! EQ (Vmouse_window, selected_window))
4576 return Qnil;
4578 if (EQ (event, Qnil))
4580 int x, y;
4582 x_read_mouse_position (selected_frame, &x, &y);
4585 BLOCK_INPUT;
4586 mouse_track_width = 0;
4587 mouse_track_left = mouse_track_top = -1;
4591 if ((x_mouse_x != mouse_track_left
4592 && (x_mouse_x < mouse_track_left
4593 || x_mouse_x > (mouse_track_left + mouse_track_width)))
4594 || x_mouse_y != mouse_track_top)
4596 int hp = 0; /* Horizontal position */
4597 int len = FRAME_CURRENT_GLYPHS (f)->used[x_mouse_y];
4598 int p = FRAME_CURRENT_GLYPHS (f)->bufp[x_mouse_y];
4599 int tab_width = XINT (b->tab_width);
4600 int ctl_arrow_p = !NILP (b->ctl_arrow);
4601 unsigned char c;
4602 int mode_line_vpos = XFASTINT (w->height) + XFASTINT (w->top) - 1;
4603 int in_mode_line = 0;
4605 if (! FRAME_CURRENT_GLYPHS (f)->enable[x_mouse_y])
4606 break;
4608 /* Erase previous rectangle. */
4609 if (mouse_track_width)
4611 x_rectangle (f, f->output_data.x->reverse_gc,
4612 mouse_track_left, mouse_track_top,
4613 mouse_track_width, 1);
4615 if ((mouse_track_left == f->phys_cursor_x
4616 || mouse_track_left == f->phys_cursor_x - 1)
4617 && mouse_track_top == f->phys_cursor_y)
4619 x_display_cursor (f, 1);
4623 mouse_track_left = x_mouse_x;
4624 mouse_track_top = x_mouse_y;
4625 mouse_track_width = 0;
4627 if (mouse_track_left > len) /* Past the end of line. */
4628 goto draw_or_not;
4630 if (mouse_track_top == mode_line_vpos)
4632 in_mode_line = 1;
4633 goto draw_or_not;
4636 if (tab_width <= 0 || tab_width > 20) tab_width = 8;
4639 c = FETCH_BYTE (p);
4640 if (len == f->width && hp == len - 1 && c != '\n')
4641 goto draw_or_not;
4643 switch (c)
4645 case '\t':
4646 mouse_track_width = tab_width - (hp % tab_width);
4647 p++;
4648 hp += mouse_track_width;
4649 if (hp > x_mouse_x)
4651 mouse_track_left = hp - mouse_track_width;
4652 goto draw_or_not;
4654 continue;
4656 case '\n':
4657 mouse_track_width = -1;
4658 goto draw_or_not;
4660 default:
4661 if (ctl_arrow_p && (c < 040 || c == 0177))
4663 if (p > ZV)
4664 goto draw_or_not;
4666 mouse_track_width = 2;
4667 p++;
4668 hp +=2;
4669 if (hp > x_mouse_x)
4671 mouse_track_left = hp - mouse_track_width;
4672 goto draw_or_not;
4675 else
4677 mouse_track_width = 1;
4678 p++;
4679 hp++;
4681 continue;
4684 while (hp <= x_mouse_x);
4686 draw_or_not:
4687 if (mouse_track_width) /* Over text; use text pointer shape. */
4689 XDefineCursor (FRAME_X_DISPLAY (f),
4690 FRAME_X_WINDOW (f),
4691 f->output_data.x->text_cursor);
4692 x_rectangle (f, f->output_data.x->cursor_gc,
4693 mouse_track_left, mouse_track_top,
4694 mouse_track_width, 1);
4696 else if (in_mode_line)
4697 XDefineCursor (FRAME_X_DISPLAY (f),
4698 FRAME_X_WINDOW (f),
4699 f->output_data.x->modeline_cursor);
4700 else
4701 XDefineCursor (FRAME_X_DISPLAY (f),
4702 FRAME_X_WINDOW (f),
4703 f->output_data.x->nontext_cursor);
4706 XFlush (FRAME_X_DISPLAY (f));
4707 UNBLOCK_INPUT;
4709 obj = read_char (-1, 0, 0, Qnil, 0);
4710 BLOCK_INPUT;
4712 while (CONSP (obj) /* Mouse event */
4713 && EQ (Fcar (Fcdr (Fcdr (obj))), Qnil) /* Not scroll bar */
4714 && EQ (Vmouse_depressed, Qnil) /* Only motion events */
4715 && EQ (Vmouse_window, selected_window) /* In this window */
4716 && x_mouse_frame);
4718 unread_command_event = obj;
4720 if (mouse_track_width)
4722 x_rectangle (f, f->output_data.x->reverse_gc,
4723 mouse_track_left, mouse_track_top,
4724 mouse_track_width, 1);
4725 mouse_track_width = 0;
4726 if ((mouse_track_left == f->phys_cursor_x
4727 || mouse_track_left - 1 == f->phys_cursor_x)
4728 && mouse_track_top == f->phys_cursor_y)
4730 x_display_cursor (f, 1);
4733 XDefineCursor (FRAME_X_DISPLAY (f),
4734 FRAME_X_WINDOW (f),
4735 f->output_data.x->nontext_cursor);
4736 XFlush (FRAME_X_DISPLAY (f));
4737 UNBLOCK_INPUT;
4739 return Qnil;
4741 #endif
4743 #if 0
4744 #include "glyphs.h"
4746 /* Draw a pixmap specified by IMAGE_DATA of dimensions WIDTH and HEIGHT
4747 on the frame F at position X, Y. */
4749 x_draw_pixmap (f, x, y, image_data, width, height)
4750 struct frame *f;
4751 int x, y, width, height;
4752 char *image_data;
4754 Pixmap image;
4756 image = XCreateBitmapFromData (FRAME_X_DISPLAY (f),
4757 FRAME_X_WINDOW (f), image_data,
4758 width, height);
4759 XCopyPlane (FRAME_X_DISPLAY (f), image, FRAME_X_WINDOW (f),
4760 f->output_data.x->normal_gc, 0, 0, width, height, x, y);
4762 #endif
4764 #if 0 /* I'm told these functions are superfluous
4765 given the ability to bind function keys. */
4767 #ifdef HAVE_X11
4768 DEFUN ("x-rebind-key", Fx_rebind_key, Sx_rebind_key, 3, 3, 0,
4769 "Rebind X keysym KEYSYM, with MODIFIERS, to generate NEWSTRING.\n\
4770 KEYSYM is a string which conforms to the X keysym definitions found\n\
4771 in X11/keysymdef.h, sans the initial XK_. MODIFIERS is nil or a\n\
4772 list of strings specifying modifier keys such as Control_L, which must\n\
4773 also be depressed for NEWSTRING to appear.")
4774 (x_keysym, modifiers, newstring)
4775 register Lisp_Object x_keysym;
4776 register Lisp_Object modifiers;
4777 register Lisp_Object newstring;
4779 char *rawstring;
4780 register KeySym keysym;
4781 KeySym modifier_list[16];
4783 check_x ();
4784 CHECK_STRING (x_keysym, 1);
4785 CHECK_STRING (newstring, 3);
4787 keysym = XStringToKeysym ((char *) XSTRING (x_keysym)->data);
4788 if (keysym == NoSymbol)
4789 error ("Keysym does not exist");
4791 if (NILP (modifiers))
4792 XRebindKeysym (x_current_display, keysym, modifier_list, 0,
4793 XSTRING (newstring)->data, XSTRING (newstring)->size);
4794 else
4796 register Lisp_Object rest, mod;
4797 register int i = 0;
4799 for (rest = modifiers; !NILP (rest); rest = Fcdr (rest))
4801 if (i == 16)
4802 error ("Can't have more than 16 modifiers");
4804 mod = Fcar (rest);
4805 CHECK_STRING (mod, 3);
4806 modifier_list[i] = XStringToKeysym ((char *) XSTRING (mod)->data);
4807 #ifndef HAVE_X11R5
4808 if (modifier_list[i] == NoSymbol
4809 || !(IsModifierKey (modifier_list[i])
4810 || ((unsigned)(modifier_list[i]) == XK_Mode_switch)
4811 || ((unsigned)(modifier_list[i]) == XK_Num_Lock)))
4812 #else
4813 if (modifier_list[i] == NoSymbol
4814 || !IsModifierKey (modifier_list[i]))
4815 #endif
4816 error ("Element is not a modifier keysym");
4817 i++;
4820 XRebindKeysym (x_current_display, keysym, modifier_list, i,
4821 XSTRING (newstring)->data, XSTRING (newstring)->size);
4824 return Qnil;
4827 DEFUN ("x-rebind-keys", Fx_rebind_keys, Sx_rebind_keys, 2, 2, 0,
4828 "Rebind KEYCODE to list of strings STRINGS.\n\
4829 STRINGS should be a list of 16 elements, one for each shift combination.\n\
4830 nil as element means don't change.\n\
4831 See the documentation of `x-rebind-key' for more information.")
4832 (keycode, strings)
4833 register Lisp_Object keycode;
4834 register Lisp_Object strings;
4836 register Lisp_Object item;
4837 register unsigned char *rawstring;
4838 KeySym rawkey, modifier[1];
4839 int strsize;
4840 register unsigned i;
4842 check_x ();
4843 CHECK_NUMBER (keycode, 1);
4844 CHECK_CONS (strings, 2);
4845 rawkey = (KeySym) ((unsigned) (XINT (keycode))) & 255;
4846 for (i = 0; i <= 15; strings = Fcdr (strings), i++)
4848 item = Fcar (strings);
4849 if (!NILP (item))
4851 CHECK_STRING (item, 2);
4852 strsize = XSTRING (item)->size;
4853 rawstring = (unsigned char *) xmalloc (strsize);
4854 bcopy (XSTRING (item)->data, rawstring, strsize);
4855 modifier[1] = 1 << i;
4856 XRebindKeysym (x_current_display, rawkey, modifier, 1,
4857 rawstring, strsize);
4860 return Qnil;
4862 #endif /* HAVE_X11 */
4863 #endif /* 0 */
4865 #ifndef HAVE_XSCREENNUMBEROFSCREEN
4867 XScreenNumberOfScreen (scr)
4868 register Screen *scr;
4870 register Display *dpy;
4871 register Screen *dpyscr;
4872 register int i;
4874 dpy = scr->display;
4875 dpyscr = dpy->screens;
4877 for (i = 0; i < dpy->nscreens; i++, dpyscr++)
4878 if (scr == dpyscr)
4879 return i;
4881 return -1;
4883 #endif /* not HAVE_XSCREENNUMBEROFSCREEN */
4885 Visual *
4886 select_visual (dpy, screen, depth)
4887 Display *dpy;
4888 Screen *screen;
4889 unsigned int *depth;
4891 Visual *v;
4892 XVisualInfo *vinfo, vinfo_template;
4893 int n_visuals;
4895 v = DefaultVisualOfScreen (screen);
4897 #ifdef HAVE_X11R4
4898 vinfo_template.visualid = XVisualIDFromVisual (v);
4899 #else
4900 vinfo_template.visualid = v->visualid;
4901 #endif
4903 vinfo_template.screen = XScreenNumberOfScreen (screen);
4905 vinfo = XGetVisualInfo (dpy,
4906 VisualIDMask | VisualScreenMask, &vinfo_template,
4907 &n_visuals);
4908 if (n_visuals != 1)
4909 fatal ("Can't get proper X visual info");
4911 if ((1 << vinfo->depth) == vinfo->colormap_size)
4912 *depth = vinfo->depth;
4913 else
4915 int i = 0;
4916 int n = vinfo->colormap_size - 1;
4917 while (n)
4919 n = n >> 1;
4920 i++;
4922 *depth = i;
4925 XFree ((char *) vinfo);
4926 return v;
4929 /* Return the X display structure for the display named NAME.
4930 Open a new connection if necessary. */
4932 struct x_display_info *
4933 x_display_info_for_name (name)
4934 Lisp_Object name;
4936 Lisp_Object names;
4937 struct x_display_info *dpyinfo;
4939 CHECK_STRING (name, 0);
4941 if (! EQ (Vwindow_system, intern ("x")))
4942 error ("Not using X Windows");
4944 for (dpyinfo = x_display_list, names = x_display_name_list;
4945 dpyinfo;
4946 dpyinfo = dpyinfo->next, names = XCONS (names)->cdr)
4948 Lisp_Object tem;
4949 tem = Fstring_equal (XCONS (XCONS (names)->car)->car, name);
4950 if (!NILP (tem))
4951 return dpyinfo;
4954 /* Use this general default value to start with. */
4955 Vx_resource_name = Vinvocation_name;
4957 validate_x_resource_name ();
4959 dpyinfo = x_term_init (name, (unsigned char *)0,
4960 (char *) XSTRING (Vx_resource_name)->data);
4962 if (dpyinfo == 0)
4963 error ("Cannot connect to X server %s", XSTRING (name)->data);
4965 x_in_use = 1;
4966 XSETFASTINT (Vwindow_system_version, 11);
4968 return dpyinfo;
4971 DEFUN ("x-open-connection", Fx_open_connection, Sx_open_connection,
4972 1, 3, 0, "Open a connection to an X server.\n\
4973 DISPLAY is the name of the display to connect to.\n\
4974 Optional second arg XRM-STRING is a string of resources in xrdb format.\n\
4975 If the optional third arg MUST-SUCCEED is non-nil,\n\
4976 terminate Emacs if we can't open the connection.")
4977 (display, xrm_string, must_succeed)
4978 Lisp_Object display, xrm_string, must_succeed;
4980 unsigned int n_planes;
4981 unsigned char *xrm_option;
4982 struct x_display_info *dpyinfo;
4984 CHECK_STRING (display, 0);
4985 if (! NILP (xrm_string))
4986 CHECK_STRING (xrm_string, 1);
4988 if (! EQ (Vwindow_system, intern ("x")))
4989 error ("Not using X Windows");
4991 if (! NILP (xrm_string))
4992 xrm_option = (unsigned char *) XSTRING (xrm_string)->data;
4993 else
4994 xrm_option = (unsigned char *) 0;
4996 validate_x_resource_name ();
4998 /* This is what opens the connection and sets x_current_display.
4999 This also initializes many symbols, such as those used for input. */
5000 dpyinfo = x_term_init (display, xrm_option,
5001 (char *) XSTRING (Vx_resource_name)->data);
5003 if (dpyinfo == 0)
5005 if (!NILP (must_succeed))
5006 fatal ("Cannot connect to X server %s.\n\
5007 Check the DISPLAY environment variable or use `-d'.\n\
5008 Also use the `xhost' program to verify that it is set to permit\n\
5009 connections from your machine.\n",
5010 XSTRING (display)->data);
5011 else
5012 error ("Cannot connect to X server %s", XSTRING (display)->data);
5015 x_in_use = 1;
5017 XSETFASTINT (Vwindow_system_version, 11);
5018 return Qnil;
5021 DEFUN ("x-close-connection", Fx_close_connection,
5022 Sx_close_connection, 1, 1, 0,
5023 "Close the connection to DISPLAY's X server.\n\
5024 For DISPLAY, specify either a frame or a display name (a string).\n\
5025 If DISPLAY is nil, that stands for the selected frame's display.")
5026 (display)
5027 Lisp_Object display;
5029 struct x_display_info *dpyinfo = check_x_display_info (display);
5030 struct x_display_info *tail;
5031 int i;
5033 if (dpyinfo->reference_count > 0)
5034 error ("Display still has frames on it");
5036 BLOCK_INPUT;
5037 /* Free the fonts in the font table. */
5038 for (i = 0; i < dpyinfo->n_fonts; i++)
5040 if (dpyinfo->font_table[i].name)
5041 free (dpyinfo->font_table[i].name);
5042 /* Don't free the full_name string;
5043 it is always shared with something else. */
5044 XFreeFont (dpyinfo->display, dpyinfo->font_table[i].font);
5046 x_destroy_all_bitmaps (dpyinfo);
5047 XSetCloseDownMode (dpyinfo->display, DestroyAll);
5049 #ifdef USE_X_TOOLKIT
5050 XtCloseDisplay (dpyinfo->display);
5051 #else
5052 XCloseDisplay (dpyinfo->display);
5053 #endif
5055 x_delete_display (dpyinfo);
5056 UNBLOCK_INPUT;
5058 return Qnil;
5061 DEFUN ("x-display-list", Fx_display_list, Sx_display_list, 0, 0, 0,
5062 "Return the list of display names that Emacs has connections to.")
5065 Lisp_Object tail, result;
5067 result = Qnil;
5068 for (tail = x_display_name_list; ! NILP (tail); tail = XCONS (tail)->cdr)
5069 result = Fcons (XCONS (XCONS (tail)->car)->car, result);
5071 return result;
5074 DEFUN ("x-synchronize", Fx_synchronize, Sx_synchronize, 1, 2, 0,
5075 "If ON is non-nil, report X errors as soon as the erring request is made.\n\
5076 If ON is nil, allow buffering of requests.\n\
5077 Turning on synchronization prohibits the Xlib routines from buffering\n\
5078 requests and seriously degrades performance, but makes debugging much\n\
5079 easier.\n\
5080 The optional second argument DISPLAY specifies which display to act on.\n\
5081 DISPLAY should be either a frame or a display name (a string).\n\
5082 If DISPLAY is omitted or nil, that stands for the selected frame's display.")
5083 (on, display)
5084 Lisp_Object display, on;
5086 struct x_display_info *dpyinfo = check_x_display_info (display);
5088 XSynchronize (dpyinfo->display, !EQ (on, Qnil));
5090 return Qnil;
5093 /* Wait for responses to all X commands issued so far for frame F. */
5095 void
5096 x_sync (f)
5097 FRAME_PTR f;
5099 BLOCK_INPUT;
5100 XSync (FRAME_X_DISPLAY (f), False);
5101 UNBLOCK_INPUT;
5104 syms_of_xfns ()
5106 /* This is zero if not using X windows. */
5107 x_in_use = 0;
5109 /* The section below is built by the lisp expression at the top of the file,
5110 just above where these variables are declared. */
5111 /*&&& init symbols here &&&*/
5112 Qauto_raise = intern ("auto-raise");
5113 staticpro (&Qauto_raise);
5114 Qauto_lower = intern ("auto-lower");
5115 staticpro (&Qauto_lower);
5116 Qbackground_color = intern ("background-color");
5117 staticpro (&Qbackground_color);
5118 Qbar = intern ("bar");
5119 staticpro (&Qbar);
5120 Qborder_color = intern ("border-color");
5121 staticpro (&Qborder_color);
5122 Qborder_width = intern ("border-width");
5123 staticpro (&Qborder_width);
5124 Qbox = intern ("box");
5125 staticpro (&Qbox);
5126 Qcursor_color = intern ("cursor-color");
5127 staticpro (&Qcursor_color);
5128 Qcursor_type = intern ("cursor-type");
5129 staticpro (&Qcursor_type);
5130 Qforeground_color = intern ("foreground-color");
5131 staticpro (&Qforeground_color);
5132 Qgeometry = intern ("geometry");
5133 staticpro (&Qgeometry);
5134 Qicon_left = intern ("icon-left");
5135 staticpro (&Qicon_left);
5136 Qicon_top = intern ("icon-top");
5137 staticpro (&Qicon_top);
5138 Qicon_type = intern ("icon-type");
5139 staticpro (&Qicon_type);
5140 Qicon_name = intern ("icon-name");
5141 staticpro (&Qicon_name);
5142 Qinternal_border_width = intern ("internal-border-width");
5143 staticpro (&Qinternal_border_width);
5144 Qleft = intern ("left");
5145 staticpro (&Qleft);
5146 Qright = intern ("right");
5147 staticpro (&Qright);
5148 Qmouse_color = intern ("mouse-color");
5149 staticpro (&Qmouse_color);
5150 Qnone = intern ("none");
5151 staticpro (&Qnone);
5152 Qparent_id = intern ("parent-id");
5153 staticpro (&Qparent_id);
5154 Qscroll_bar_width = intern ("scroll-bar-width");
5155 staticpro (&Qscroll_bar_width);
5156 Qsuppress_icon = intern ("suppress-icon");
5157 staticpro (&Qsuppress_icon);
5158 Qtop = intern ("top");
5159 staticpro (&Qtop);
5160 Qundefined_color = intern ("undefined-color");
5161 staticpro (&Qundefined_color);
5162 Qvertical_scroll_bars = intern ("vertical-scroll-bars");
5163 staticpro (&Qvertical_scroll_bars);
5164 Qvisibility = intern ("visibility");
5165 staticpro (&Qvisibility);
5166 Qwindow_id = intern ("window-id");
5167 staticpro (&Qwindow_id);
5168 Qx_frame_parameter = intern ("x-frame-parameter");
5169 staticpro (&Qx_frame_parameter);
5170 Qx_resource_name = intern ("x-resource-name");
5171 staticpro (&Qx_resource_name);
5172 Quser_position = intern ("user-position");
5173 staticpro (&Quser_position);
5174 Quser_size = intern ("user-size");
5175 staticpro (&Quser_size);
5176 Qdisplay = intern ("display");
5177 staticpro (&Qdisplay);
5178 /* This is the end of symbol initialization. */
5180 Fput (Qundefined_color, Qerror_conditions,
5181 Fcons (Qundefined_color, Fcons (Qerror, Qnil)));
5182 Fput (Qundefined_color, Qerror_message,
5183 build_string ("Undefined color"));
5185 init_x_parm_symbols ();
5187 DEFVAR_LISP ("x-bitmap-file-path", &Vx_bitmap_file_path,
5188 "List of directories to search for bitmap files for X.");
5189 Vx_bitmap_file_path = decode_env_path ((char *) 0, PATH_BITMAPS);
5191 DEFVAR_LISP ("x-pointer-shape", &Vx_pointer_shape,
5192 "The shape of the pointer when over text.\n\
5193 Changing the value does not affect existing frames\n\
5194 unless you set the mouse color.");
5195 Vx_pointer_shape = Qnil;
5197 DEFVAR_LISP ("x-resource-name", &Vx_resource_name,
5198 "The name Emacs uses to look up X resources.\n\
5199 `x-get-resource' uses this as the first component of the instance name\n\
5200 when requesting resource values.\n\
5201 Emacs initially sets `x-resource-name' to the name under which Emacs\n\
5202 was invoked, or to the value specified with the `-name' or `-rn'\n\
5203 switches, if present.\n\
5205 It may be useful to bind this variable locally around a call\n\
5206 to `x-get-resource'. See also the variable `x-resource-class'.");
5207 Vx_resource_name = Qnil;
5209 DEFVAR_LISP ("x-resource-class", &Vx_resource_class,
5210 "The class Emacs uses to look up X resources.\n\
5211 `x-get-resource' uses this as the first component of the instance class\n\
5212 when requesting resource values.\n\
5213 Emacs initially sets `x-resource-class' to \"Emacs\".\n\
5215 Setting this variable permanently is not a reasonable thing to do,\n\
5216 but binding this variable locally around a call to `x-get-resource'\n\
5217 is a reasonabvle practice. See also the variable `x-resource-name'.");
5218 Vx_resource_class = build_string (EMACS_CLASS);
5220 #if 0 /* This doesn't really do anything. */
5221 DEFVAR_LISP ("x-nontext-pointer-shape", &Vx_nontext_pointer_shape,
5222 "The shape of the pointer when not over text.\n\
5223 This variable takes effect when you create a new frame\n\
5224 or when you set the mouse color.");
5225 #endif
5226 Vx_nontext_pointer_shape = Qnil;
5228 #if 0 /* This doesn't really do anything. */
5229 DEFVAR_LISP ("x-mode-pointer-shape", &Vx_mode_pointer_shape,
5230 "The shape of the pointer when over the mode line.\n\
5231 This variable takes effect when you create a new frame\n\
5232 or when you set the mouse color.");
5233 #endif
5234 Vx_mode_pointer_shape = Qnil;
5236 DEFVAR_LISP ("x-sensitive-text-pointer-shape",
5237 &Vx_sensitive_text_pointer_shape,
5238 "The shape of the pointer when over mouse-sensitive text.\n\
5239 This variable takes effect when you create a new frame\n\
5240 or when you set the mouse color.");
5241 Vx_sensitive_text_pointer_shape = Qnil;
5243 DEFVAR_LISP ("x-cursor-fore-pixel", &Vx_cursor_fore_pixel,
5244 "A string indicating the foreground color of the cursor box.");
5245 Vx_cursor_fore_pixel = Qnil;
5247 DEFVAR_LISP ("x-no-window-manager", &Vx_no_window_manager,
5248 "Non-nil if no X window manager is in use.\n\
5249 Emacs doesn't try to figure this out; this is always nil\n\
5250 unless you set it to something else.");
5251 /* We don't have any way to find this out, so set it to nil
5252 and maybe the user would like to set it to t. */
5253 Vx_no_window_manager = Qnil;
5255 DEFVAR_LISP ("x-pixel-size-width-font-regexp",
5256 &Vx_pixel_size_width_font_regexp,
5257 "Regexp matching a font name whose width is the same as `PIXEL_SIZE'.\n\
5259 Since Emacs gets width of a font matching with this regexp from\n\
5260 PIXEL_SIZE field of the name, font finding mechanism gets faster for\n\
5261 such a font. This is especially effective for such large fonts as\n\
5262 Chinese, Japanese, and Korean.");
5263 Vx_pixel_size_width_font_regexp = Qnil;
5265 #ifdef USE_X_TOOLKIT
5266 Fprovide (intern ("x-toolkit"));
5267 #endif
5268 #ifdef USE_MOTIF
5269 Fprovide (intern ("motif"));
5270 #endif
5272 defsubr (&Sx_get_resource);
5273 #if 0
5274 defsubr (&Sx_draw_rectangle);
5275 defsubr (&Sx_erase_rectangle);
5276 defsubr (&Sx_contour_region);
5277 defsubr (&Sx_uncontour_region);
5278 #endif
5279 defsubr (&Sx_list_fonts);
5280 defsubr (&Sx_display_color_p);
5281 defsubr (&Sx_display_grayscale_p);
5282 defsubr (&Sx_color_defined_p);
5283 defsubr (&Sx_color_values);
5284 defsubr (&Sx_server_max_request_size);
5285 defsubr (&Sx_server_vendor);
5286 defsubr (&Sx_server_version);
5287 defsubr (&Sx_display_pixel_width);
5288 defsubr (&Sx_display_pixel_height);
5289 defsubr (&Sx_display_mm_width);
5290 defsubr (&Sx_display_mm_height);
5291 defsubr (&Sx_display_screens);
5292 defsubr (&Sx_display_planes);
5293 defsubr (&Sx_display_color_cells);
5294 defsubr (&Sx_display_visual_class);
5295 defsubr (&Sx_display_backing_store);
5296 defsubr (&Sx_display_save_under);
5297 #if 0
5298 defsubr (&Sx_rebind_key);
5299 defsubr (&Sx_rebind_keys);
5300 defsubr (&Sx_track_pointer);
5301 defsubr (&Sx_grab_pointer);
5302 defsubr (&Sx_ungrab_pointer);
5303 #endif
5304 defsubr (&Sx_parse_geometry);
5305 defsubr (&Sx_create_frame);
5306 #if 0
5307 defsubr (&Sx_horizontal_line);
5308 #endif
5309 defsubr (&Sx_open_connection);
5310 defsubr (&Sx_close_connection);
5311 defsubr (&Sx_display_list);
5312 defsubr (&Sx_synchronize);
5314 /* Setting callback functions for fontset handler. */
5315 get_font_info_func = x_get_font_info;
5316 list_fonts_func = x_list_fonts;
5317 load_font_func = x_load_font;
5318 query_font_func = x_query_font;
5319 set_frame_fontset_func = x_set_font;
5320 check_window_system_func = check_x;
5323 #endif /* HAVE_X_WINDOWS */