(unibyte_display_through_language_environment):
[bpt/emacs.git] / src / xfns.c
1 /* Functions for the X window system.
2 Copyright (C) 1989, 92, 93, 94, 95, 96, 1997 Free Software Foundation.
3
4 This file is part of GNU Emacs.
5
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.
10
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.
15
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. */
20
21 /* Completely rewritten by Richard Stallman. */
22
23 /* Rewritten for X11 by Joseph Arceneaux */
24
25 #include <signal.h>
26 #include <config.h>
27
28 /* This makes the fields of a Display accessible, in Xlib header files. */
29 #define XLIB_ILLEGAL_ACCESS
30
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"
42
43 #ifdef HAVE_X_WINDOWS
44 extern void abort ();
45
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
52
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
62
63 #ifdef USE_X_TOOLKIT
64 #include <X11/Shell.h>
65
66 #ifndef USE_MOTIF
67 #include <X11/Xaw/Paned.h>
68 #include <X11/Xaw/Label.h>
69 #endif /* USE_MOTIF */
70
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
78
79 #include "widget.h"
80
81 #include "../lwlib/lwlib.h"
82
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 */
89
90 /* Unique id counter for widgets created by the Lucid Widget
91 Library. */
92 extern LWLIB_ID widget_id_tick;
93
94 #ifdef USE_LUCID
95 /* This is part of a kludge--see lwlib/xlwmenu.c. */
96 extern XFontStruct *xlwmenu_default_font;
97 #endif
98
99 extern void free_frame_menubar ();
100 #endif /* USE_X_TOOLKIT */
101
102 #define min(a,b) ((a) < (b) ? (a) : (b))
103 #define max(a,b) ((a) > (b) ? (a) : (b))
104
105 #ifdef HAVE_X11R4
106 #define MAXREQUEST(dpy) (XMaxRequestSize (dpy))
107 #else
108 #define MAXREQUEST(dpy) ((dpy)->max_request_size)
109 #endif
110
111 /* The name we're using in resource queries. Most often "emacs". */
112 Lisp_Object Vx_resource_name;
113
114 /* The application class we're using in resource queries.
115 Normally "Emacs". */
116 Lisp_Object Vx_resource_class;
117
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;
123
124 /* Color of chars displayed in cursor box. */
125 Lisp_Object Vx_cursor_fore_pixel;
126
127 /* Nonzero if using X. */
128 static int x_in_use;
129
130 /* Non nil if no window manager is in use. */
131 Lisp_Object Vx_no_window_manager;
132
133 /* Search path for bitmap files. */
134 Lisp_Object Vx_bitmap_file_path;
135
136 /* Regexp matching a font name whose width is the same as `PIXEL_SIZE'. */
137 Lisp_Object Vx_pixel_size_width_font_regexp;
138
139 /* A flag to control how to display unibyte 8-bit character. */
140 int unibyte_display_via_language_environment;
141
142 /* Evaluate this expression to rebuild the section of syms_of_xfns
143 that initializes and staticpros the symbols declared below. Note
144 that Emacs 18 has a bug that keeps C-x C-e from being able to
145 evaluate this expression.
146
147 (progn
148 ;; Accumulate a list of the symbols we want to initialize from the
149 ;; declarations at the top of the file.
150 (goto-char (point-min))
151 (search-forward "/\*&&& symbols declared here &&&*\/\n")
152 (let (symbol-list)
153 (while (looking-at "Lisp_Object \\(Q[a-z_]+\\)")
154 (setq symbol-list
155 (cons (buffer-substring (match-beginning 1) (match-end 1))
156 symbol-list))
157 (forward-line 1))
158 (setq symbol-list (nreverse symbol-list))
159 ;; Delete the section of syms_of_... where we initialize the symbols.
160 (search-forward "\n /\*&&& init symbols here &&&*\/\n")
161 (let ((start (point)))
162 (while (looking-at "^ Q")
163 (forward-line 2))
164 (kill-region start (point)))
165 ;; Write a new symbol initialization section.
166 (while symbol-list
167 (insert (format " %s = intern (\"" (car symbol-list)))
168 (let ((start (point)))
169 (insert (substring (car symbol-list) 1))
170 (subst-char-in-region start (point) ?_ ?-))
171 (insert (format "\");\n staticpro (&%s);\n" (car symbol-list)))
172 (setq symbol-list (cdr symbol-list)))))
173
174 */
175
176 /*&&& symbols declared here &&&*/
177 Lisp_Object Qauto_raise;
178 Lisp_Object Qauto_lower;
179 Lisp_Object Qbackground_color;
180 Lisp_Object Qbar;
181 Lisp_Object Qborder_color;
182 Lisp_Object Qborder_width;
183 Lisp_Object Qbox;
184 Lisp_Object Qcursor_color;
185 Lisp_Object Qcursor_type;
186 Lisp_Object Qforeground_color;
187 Lisp_Object Qgeometry;
188 Lisp_Object Qicon_left;
189 Lisp_Object Qicon_top;
190 Lisp_Object Qicon_type;
191 Lisp_Object Qicon_name;
192 Lisp_Object Qinternal_border_width;
193 Lisp_Object Qleft;
194 Lisp_Object Qright;
195 Lisp_Object Qmouse_color;
196 Lisp_Object Qnone;
197 Lisp_Object Qparent_id;
198 Lisp_Object Qscroll_bar_width;
199 Lisp_Object Qsuppress_icon;
200 Lisp_Object Qtop;
201 Lisp_Object Qundefined_color;
202 Lisp_Object Qvertical_scroll_bars;
203 Lisp_Object Qvisibility;
204 Lisp_Object Qwindow_id;
205 Lisp_Object Qx_frame_parameter;
206 Lisp_Object Qx_resource_name;
207 Lisp_Object Quser_position;
208 Lisp_Object Quser_size;
209 Lisp_Object Qdisplay;
210
211 /* The below are defined in frame.c. */
212 extern Lisp_Object Qheight, Qminibuffer, Qname, Qonly, Qwidth;
213 extern Lisp_Object Qunsplittable, Qmenu_bar_lines, Qbuffer_predicate, Qtitle;
214
215 extern Lisp_Object Vwindow_system_version;
216
217 Lisp_Object Qface_set_after_frame_default;
218 \f
219 /* Error if we are not connected to X. */
220 void
221 check_x ()
222 {
223 if (! x_in_use)
224 error ("X windows are not in use or not initialized");
225 }
226
227 /* Nonzero if we can use mouse menus.
228 You should not call this unless HAVE_MENUS is defined. */
229
230 int
231 have_menus_p ()
232 {
233 return x_in_use;
234 }
235
236 /* Extract a frame as a FRAME_PTR, defaulting to the selected frame
237 and checking validity for X. */
238
239 FRAME_PTR
240 check_x_frame (frame)
241 Lisp_Object frame;
242 {
243 FRAME_PTR f;
244
245 if (NILP (frame))
246 f = selected_frame;
247 else
248 {
249 CHECK_LIVE_FRAME (frame, 0);
250 f = XFRAME (frame);
251 }
252 if (! FRAME_X_P (f))
253 error ("Non-X frame used");
254 return f;
255 }
256
257 /* Let the user specify an X display with a frame.
258 nil stands for the selected frame--or, if that is not an X frame,
259 the first X display on the list. */
260
261 static struct x_display_info *
262 check_x_display_info (frame)
263 Lisp_Object frame;
264 {
265 if (NILP (frame))
266 {
267 if (FRAME_X_P (selected_frame))
268 return FRAME_X_DISPLAY_INFO (selected_frame);
269 else if (x_display_list != 0)
270 return x_display_list;
271 else
272 error ("X windows are not in use or not initialized");
273 }
274 else if (STRINGP (frame))
275 return x_display_info_for_name (frame);
276 else
277 {
278 FRAME_PTR f;
279
280 CHECK_LIVE_FRAME (frame, 0);
281 f = XFRAME (frame);
282 if (! FRAME_X_P (f))
283 error ("Non-X frame used");
284 return FRAME_X_DISPLAY_INFO (f);
285 }
286 }
287 \f
288 /* Return the Emacs frame-object corresponding to an X window.
289 It could be the frame's main window or an icon window. */
290
291 /* This function can be called during GC, so use GC_xxx type test macros. */
292
293 struct frame *
294 x_window_to_frame (dpyinfo, wdesc)
295 struct x_display_info *dpyinfo;
296 int wdesc;
297 {
298 Lisp_Object tail, frame;
299 struct frame *f;
300
301 for (tail = Vframe_list; GC_CONSP (tail); tail = XCONS (tail)->cdr)
302 {
303 frame = XCONS (tail)->car;
304 if (!GC_FRAMEP (frame))
305 continue;
306 f = XFRAME (frame);
307 if (f->output_data.nothing == 1 || FRAME_X_DISPLAY_INFO (f) != dpyinfo)
308 continue;
309 #ifdef USE_X_TOOLKIT
310 if ((f->output_data.x->edit_widget
311 && XtWindow (f->output_data.x->edit_widget) == wdesc)
312 || f->output_data.x->icon_desc == wdesc)
313 return f;
314 #else /* not USE_X_TOOLKIT */
315 if (FRAME_X_WINDOW (f) == wdesc
316 || f->output_data.x->icon_desc == wdesc)
317 return f;
318 #endif /* not USE_X_TOOLKIT */
319 }
320 return 0;
321 }
322
323 #ifdef USE_X_TOOLKIT
324 /* Like x_window_to_frame but also compares the window with the widget's
325 windows. */
326
327 struct frame *
328 x_any_window_to_frame (dpyinfo, wdesc)
329 struct x_display_info *dpyinfo;
330 int wdesc;
331 {
332 Lisp_Object tail, frame;
333 struct frame *f;
334 struct x_output *x;
335
336 for (tail = Vframe_list; GC_CONSP (tail); tail = XCONS (tail)->cdr)
337 {
338 frame = XCONS (tail)->car;
339 if (!GC_FRAMEP (frame))
340 continue;
341 f = XFRAME (frame);
342 if (f->output_data.nothing == 1 || FRAME_X_DISPLAY_INFO (f) != dpyinfo)
343 continue;
344 x = f->output_data.x;
345 /* This frame matches if the window is any of its widgets. */
346 if (wdesc == XtWindow (x->widget)
347 || wdesc == XtWindow (x->column_widget)
348 || wdesc == XtWindow (x->edit_widget))
349 return f;
350 /* Match if the window is this frame's menubar. */
351 if (lw_window_is_in_menubar (wdesc, x->menubar_widget))
352 return f;
353 }
354 return 0;
355 }
356
357 /* Likewise, but exclude the menu bar widget. */
358
359 struct frame *
360 x_non_menubar_window_to_frame (dpyinfo, wdesc)
361 struct x_display_info *dpyinfo;
362 int wdesc;
363 {
364 Lisp_Object tail, frame;
365 struct frame *f;
366 struct x_output *x;
367
368 for (tail = Vframe_list; GC_CONSP (tail); tail = XCONS (tail)->cdr)
369 {
370 frame = XCONS (tail)->car;
371 if (!GC_FRAMEP (frame))
372 continue;
373 f = XFRAME (frame);
374 if (f->output_data.nothing == 1 || FRAME_X_DISPLAY_INFO (f) != dpyinfo)
375 continue;
376 x = f->output_data.x;
377 /* This frame matches if the window is any of its widgets. */
378 if (wdesc == XtWindow (x->widget)
379 || wdesc == XtWindow (x->column_widget)
380 || wdesc == XtWindow (x->edit_widget))
381 return f;
382 }
383 return 0;
384 }
385
386 /* Likewise, but consider only the menu bar widget. */
387
388 struct frame *
389 x_menubar_window_to_frame (dpyinfo, wdesc)
390 struct x_display_info *dpyinfo;
391 int wdesc;
392 {
393 Lisp_Object tail, frame;
394 struct frame *f;
395 struct x_output *x;
396
397 for (tail = Vframe_list; GC_CONSP (tail); tail = XCONS (tail)->cdr)
398 {
399 frame = XCONS (tail)->car;
400 if (!GC_FRAMEP (frame))
401 continue;
402 f = XFRAME (frame);
403 if (f->output_data.nothing == 1 || FRAME_X_DISPLAY_INFO (f) != dpyinfo)
404 continue;
405 x = f->output_data.x;
406 /* Match if the window is this frame's menubar. */
407 if (lw_window_is_in_menubar (wdesc, x->menubar_widget))
408 return f;
409 }
410 return 0;
411 }
412
413 /* Return the frame whose principal (outermost) window is WDESC.
414 If WDESC is some other (smaller) window, we return 0. */
415
416 struct frame *
417 x_top_window_to_frame (dpyinfo, wdesc)
418 struct x_display_info *dpyinfo;
419 int wdesc;
420 {
421 Lisp_Object tail, frame;
422 struct frame *f;
423 struct x_output *x;
424
425 for (tail = Vframe_list; GC_CONSP (tail); tail = XCONS (tail)->cdr)
426 {
427 frame = XCONS (tail)->car;
428 if (!GC_FRAMEP (frame))
429 continue;
430 f = XFRAME (frame);
431 if (f->output_data.nothing == 1 || FRAME_X_DISPLAY_INFO (f) != dpyinfo)
432 continue;
433 x = f->output_data.x;
434 /* This frame matches if the window is its topmost widget. */
435 if (wdesc == XtWindow (x->widget))
436 return f;
437 #if 0 /* I don't know why it did this,
438 but it seems logically wrong,
439 and it causes trouble for MapNotify events. */
440 /* Match if the window is this frame's menubar. */
441 if (x->menubar_widget
442 && wdesc == XtWindow (x->menubar_widget))
443 return f;
444 #endif
445 }
446 return 0;
447 }
448 #endif /* USE_X_TOOLKIT */
449
450 \f
451
452 /* Code to deal with bitmaps. Bitmaps are referenced by their bitmap
453 id, which is just an int that this section returns. Bitmaps are
454 reference counted so they can be shared among frames.
455
456 Bitmap indices are guaranteed to be > 0, so a negative number can
457 be used to indicate no bitmap.
458
459 If you use x_create_bitmap_from_data, then you must keep track of
460 the bitmaps yourself. That is, creating a bitmap from the same
461 data more than once will not be caught. */
462
463
464 /* Functions to access the contents of a bitmap, given an id. */
465
466 int
467 x_bitmap_height (f, id)
468 FRAME_PTR f;
469 int id;
470 {
471 return FRAME_X_DISPLAY_INFO (f)->bitmaps[id - 1].height;
472 }
473
474 int
475 x_bitmap_width (f, id)
476 FRAME_PTR f;
477 int id;
478 {
479 return FRAME_X_DISPLAY_INFO (f)->bitmaps[id - 1].width;
480 }
481
482 int
483 x_bitmap_pixmap (f, id)
484 FRAME_PTR f;
485 int id;
486 {
487 return FRAME_X_DISPLAY_INFO (f)->bitmaps[id - 1].pixmap;
488 }
489
490
491 /* Allocate a new bitmap record. Returns index of new record. */
492
493 static int
494 x_allocate_bitmap_record (f)
495 FRAME_PTR f;
496 {
497 struct x_display_info *dpyinfo = FRAME_X_DISPLAY_INFO (f);
498 int i;
499
500 if (dpyinfo->bitmaps == NULL)
501 {
502 dpyinfo->bitmaps_size = 10;
503 dpyinfo->bitmaps
504 = (struct x_bitmap_record *) xmalloc (dpyinfo->bitmaps_size * sizeof (struct x_bitmap_record));
505 dpyinfo->bitmaps_last = 1;
506 return 1;
507 }
508
509 if (dpyinfo->bitmaps_last < dpyinfo->bitmaps_size)
510 return ++dpyinfo->bitmaps_last;
511
512 for (i = 0; i < dpyinfo->bitmaps_size; ++i)
513 if (dpyinfo->bitmaps[i].refcount == 0)
514 return i + 1;
515
516 dpyinfo->bitmaps_size *= 2;
517 dpyinfo->bitmaps
518 = (struct x_bitmap_record *) xrealloc (dpyinfo->bitmaps,
519 dpyinfo->bitmaps_size * sizeof (struct x_bitmap_record));
520 return ++dpyinfo->bitmaps_last;
521 }
522
523 /* Add one reference to the reference count of the bitmap with id ID. */
524
525 void
526 x_reference_bitmap (f, id)
527 FRAME_PTR f;
528 int id;
529 {
530 ++FRAME_X_DISPLAY_INFO (f)->bitmaps[id - 1].refcount;
531 }
532
533 /* Create a bitmap for frame F from a HEIGHT x WIDTH array of bits at BITS. */
534
535 int
536 x_create_bitmap_from_data (f, bits, width, height)
537 struct frame *f;
538 char *bits;
539 unsigned int width, height;
540 {
541 struct x_display_info *dpyinfo = FRAME_X_DISPLAY_INFO (f);
542 Pixmap bitmap;
543 int id;
544
545 bitmap = XCreateBitmapFromData (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
546 bits, width, height);
547
548 if (! bitmap)
549 return -1;
550
551 id = x_allocate_bitmap_record (f);
552 dpyinfo->bitmaps[id - 1].pixmap = bitmap;
553 dpyinfo->bitmaps[id - 1].file = NULL;
554 dpyinfo->bitmaps[id - 1].refcount = 1;
555 dpyinfo->bitmaps[id - 1].depth = 1;
556 dpyinfo->bitmaps[id - 1].height = height;
557 dpyinfo->bitmaps[id - 1].width = width;
558
559 return id;
560 }
561
562 /* Create bitmap from file FILE for frame F. */
563
564 int
565 x_create_bitmap_from_file (f, file)
566 struct frame *f;
567 Lisp_Object file;
568 {
569 struct x_display_info *dpyinfo = FRAME_X_DISPLAY_INFO (f);
570 unsigned int width, height;
571 Pixmap bitmap;
572 int xhot, yhot, result, id;
573 Lisp_Object found;
574 int fd;
575 char *filename;
576
577 /* Look for an existing bitmap with the same name. */
578 for (id = 0; id < dpyinfo->bitmaps_last; ++id)
579 {
580 if (dpyinfo->bitmaps[id].refcount
581 && dpyinfo->bitmaps[id].file
582 && !strcmp (dpyinfo->bitmaps[id].file, (char *) XSTRING (file)->data))
583 {
584 ++dpyinfo->bitmaps[id].refcount;
585 return id + 1;
586 }
587 }
588
589 /* Search bitmap-file-path for the file, if appropriate. */
590 fd = openp (Vx_bitmap_file_path, file, "", &found, 0);
591 if (fd < 0)
592 return -1;
593 close (fd);
594
595 filename = (char *) XSTRING (found)->data;
596
597 result = XReadBitmapFile (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
598 filename, &width, &height, &bitmap, &xhot, &yhot);
599 if (result != BitmapSuccess)
600 return -1;
601
602 id = x_allocate_bitmap_record (f);
603 dpyinfo->bitmaps[id - 1].pixmap = bitmap;
604 dpyinfo->bitmaps[id - 1].refcount = 1;
605 dpyinfo->bitmaps[id - 1].file
606 = (char *) xmalloc (STRING_BYTES (XSTRING (file)) + 1);
607 dpyinfo->bitmaps[id - 1].depth = 1;
608 dpyinfo->bitmaps[id - 1].height = height;
609 dpyinfo->bitmaps[id - 1].width = width;
610 strcpy (dpyinfo->bitmaps[id - 1].file, XSTRING (file)->data);
611
612 return id;
613 }
614
615 /* Remove reference to bitmap with id number ID. */
616
617 void
618 x_destroy_bitmap (f, id)
619 FRAME_PTR f;
620 int id;
621 {
622 struct x_display_info *dpyinfo = FRAME_X_DISPLAY_INFO (f);
623
624 if (id > 0)
625 {
626 --dpyinfo->bitmaps[id - 1].refcount;
627 if (dpyinfo->bitmaps[id - 1].refcount == 0)
628 {
629 BLOCK_INPUT;
630 XFreePixmap (FRAME_X_DISPLAY (f), dpyinfo->bitmaps[id - 1].pixmap);
631 if (dpyinfo->bitmaps[id - 1].file)
632 {
633 free (dpyinfo->bitmaps[id - 1].file);
634 dpyinfo->bitmaps[id - 1].file = NULL;
635 }
636 UNBLOCK_INPUT;
637 }
638 }
639 }
640
641 /* Free all the bitmaps for the display specified by DPYINFO. */
642
643 static void
644 x_destroy_all_bitmaps (dpyinfo)
645 struct x_display_info *dpyinfo;
646 {
647 int i;
648 for (i = 0; i < dpyinfo->bitmaps_last; i++)
649 if (dpyinfo->bitmaps[i].refcount > 0)
650 {
651 XFreePixmap (dpyinfo->display, dpyinfo->bitmaps[i].pixmap);
652 if (dpyinfo->bitmaps[i].file)
653 free (dpyinfo->bitmaps[i].file);
654 }
655 dpyinfo->bitmaps_last = 0;
656 }
657 \f
658 /* Connect the frame-parameter names for X frames
659 to the ways of passing the parameter values to the window system.
660
661 The name of a parameter, as a Lisp symbol,
662 has an `x-frame-parameter' property which is an integer in Lisp
663 that is an index in this table. */
664
665 struct x_frame_parm_table
666 {
667 char *name;
668 void (*setter)( /* struct frame *frame, Lisp_Object val, oldval */ );
669 };
670
671 void x_set_foreground_color ();
672 void x_set_background_color ();
673 void x_set_mouse_color ();
674 void x_set_cursor_color ();
675 void x_set_border_color ();
676 void x_set_cursor_type ();
677 void x_set_icon_type ();
678 void x_set_icon_name ();
679 void x_set_font ();
680 void x_set_border_width ();
681 void x_set_internal_border_width ();
682 void x_explicitly_set_name ();
683 void x_set_autoraise ();
684 void x_set_autolower ();
685 void x_set_vertical_scroll_bars ();
686 void x_set_visibility ();
687 void x_set_menu_bar_lines ();
688 void x_set_scroll_bar_width ();
689 void x_set_title ();
690 void x_set_unsplittable ();
691
692 static struct x_frame_parm_table x_frame_parms[] =
693 {
694 "auto-raise", x_set_autoraise,
695 "auto-lower", x_set_autolower,
696 "background-color", x_set_background_color,
697 "border-color", x_set_border_color,
698 "border-width", x_set_border_width,
699 "cursor-color", x_set_cursor_color,
700 "cursor-type", x_set_cursor_type,
701 "font", x_set_font,
702 "foreground-color", x_set_foreground_color,
703 "icon-name", x_set_icon_name,
704 "icon-type", x_set_icon_type,
705 "internal-border-width", x_set_internal_border_width,
706 "menu-bar-lines", x_set_menu_bar_lines,
707 "mouse-color", x_set_mouse_color,
708 "name", x_explicitly_set_name,
709 "scroll-bar-width", x_set_scroll_bar_width,
710 "title", x_set_title,
711 "unsplittable", x_set_unsplittable,
712 "vertical-scroll-bars", x_set_vertical_scroll_bars,
713 "visibility", x_set_visibility,
714 };
715
716 /* Attach the `x-frame-parameter' properties to
717 the Lisp symbol names of parameters relevant to X. */
718
719 void
720 init_x_parm_symbols ()
721 {
722 int i;
723
724 for (i = 0; i < sizeof (x_frame_parms) / sizeof (x_frame_parms[0]); i++)
725 Fput (intern (x_frame_parms[i].name), Qx_frame_parameter,
726 make_number (i));
727 }
728 \f
729 /* Change the parameters of frame F as specified by ALIST.
730 If a parameter is not specially recognized, do nothing;
731 otherwise call the `x_set_...' function for that parameter. */
732
733 void
734 x_set_frame_parameters (f, alist)
735 FRAME_PTR f;
736 Lisp_Object alist;
737 {
738 Lisp_Object tail;
739
740 /* If both of these parameters are present, it's more efficient to
741 set them both at once. So we wait until we've looked at the
742 entire list before we set them. */
743 int width, height;
744
745 /* Same here. */
746 Lisp_Object left, top;
747
748 /* Same with these. */
749 Lisp_Object icon_left, icon_top;
750
751 /* Record in these vectors all the parms specified. */
752 Lisp_Object *parms;
753 Lisp_Object *values;
754 int i;
755 int left_no_change = 0, top_no_change = 0;
756 int icon_left_no_change = 0, icon_top_no_change = 0;
757
758 i = 0;
759 for (tail = alist; CONSP (tail); tail = Fcdr (tail))
760 i++;
761
762 parms = (Lisp_Object *) alloca (i * sizeof (Lisp_Object));
763 values = (Lisp_Object *) alloca (i * sizeof (Lisp_Object));
764
765 /* Extract parm names and values into those vectors. */
766
767 i = 0;
768 for (tail = alist; CONSP (tail); tail = Fcdr (tail))
769 {
770 Lisp_Object elt, prop, val;
771
772 elt = Fcar (tail);
773 parms[i] = Fcar (elt);
774 values[i] = Fcdr (elt);
775 i++;
776 }
777
778 top = left = Qunbound;
779 icon_left = icon_top = Qunbound;
780
781 /* Provide default values for HEIGHT and WIDTH. */
782 if (FRAME_NEW_WIDTH (f))
783 width = FRAME_NEW_WIDTH (f);
784 else
785 width = FRAME_WIDTH (f);
786
787 if (FRAME_NEW_HEIGHT (f))
788 height = FRAME_NEW_HEIGHT (f);
789 else
790 height = FRAME_HEIGHT (f);
791
792 /* Now process them in reverse of specified order. */
793 for (i--; i >= 0; i--)
794 {
795 Lisp_Object prop, val;
796
797 prop = parms[i];
798 val = values[i];
799
800 if (EQ (prop, Qwidth) && NUMBERP (val))
801 width = XFASTINT (val);
802 else if (EQ (prop, Qheight) && NUMBERP (val))
803 height = XFASTINT (val);
804 else if (EQ (prop, Qtop))
805 top = val;
806 else if (EQ (prop, Qleft))
807 left = val;
808 else if (EQ (prop, Qicon_top))
809 icon_top = val;
810 else if (EQ (prop, Qicon_left))
811 icon_left = val;
812 else
813 {
814 register Lisp_Object param_index, old_value;
815
816 param_index = Fget (prop, Qx_frame_parameter);
817 old_value = get_frame_param (f, prop);
818 store_frame_param (f, prop, val);
819 if (NATNUMP (param_index)
820 && (XFASTINT (param_index)
821 < sizeof (x_frame_parms)/sizeof (x_frame_parms[0])))
822 (*x_frame_parms[XINT (param_index)].setter)(f, val, old_value);
823 }
824 }
825
826 /* Don't die if just one of these was set. */
827 if (EQ (left, Qunbound))
828 {
829 left_no_change = 1;
830 if (f->output_data.x->left_pos < 0)
831 left = Fcons (Qplus, Fcons (make_number (f->output_data.x->left_pos), Qnil));
832 else
833 XSETINT (left, f->output_data.x->left_pos);
834 }
835 if (EQ (top, Qunbound))
836 {
837 top_no_change = 1;
838 if (f->output_data.x->top_pos < 0)
839 top = Fcons (Qplus, Fcons (make_number (f->output_data.x->top_pos), Qnil));
840 else
841 XSETINT (top, f->output_data.x->top_pos);
842 }
843
844 /* If one of the icon positions was not set, preserve or default it. */
845 if (EQ (icon_left, Qunbound) || ! INTEGERP (icon_left))
846 {
847 icon_left_no_change = 1;
848 icon_left = Fcdr (Fassq (Qicon_left, f->param_alist));
849 if (NILP (icon_left))
850 XSETINT (icon_left, 0);
851 }
852 if (EQ (icon_top, Qunbound) || ! INTEGERP (icon_top))
853 {
854 icon_top_no_change = 1;
855 icon_top = Fcdr (Fassq (Qicon_top, f->param_alist));
856 if (NILP (icon_top))
857 XSETINT (icon_top, 0);
858 }
859
860 /* Don't set these parameters unless they've been explicitly
861 specified. The window might be mapped or resized while we're in
862 this function, and we don't want to override that unless the lisp
863 code has asked for it.
864
865 Don't set these parameters unless they actually differ from the
866 window's current parameters; the window may not actually exist
867 yet. */
868 {
869 Lisp_Object frame;
870
871 check_frame_size (f, &height, &width);
872
873 XSETFRAME (frame, f);
874
875 if (width != FRAME_WIDTH (f)
876 || height != FRAME_HEIGHT (f)
877 || FRAME_NEW_HEIGHT (f) || FRAME_NEW_WIDTH (f))
878 Fset_frame_size (frame, make_number (width), make_number (height));
879
880 if ((!NILP (left) || !NILP (top))
881 && ! (left_no_change && top_no_change)
882 && ! (NUMBERP (left) && XINT (left) == f->output_data.x->left_pos
883 && NUMBERP (top) && XINT (top) == f->output_data.x->top_pos))
884 {
885 int leftpos = 0;
886 int toppos = 0;
887
888 /* Record the signs. */
889 f->output_data.x->size_hint_flags &= ~ (XNegative | YNegative);
890 if (EQ (left, Qminus))
891 f->output_data.x->size_hint_flags |= XNegative;
892 else if (INTEGERP (left))
893 {
894 leftpos = XINT (left);
895 if (leftpos < 0)
896 f->output_data.x->size_hint_flags |= XNegative;
897 }
898 else if (CONSP (left) && EQ (XCONS (left)->car, Qminus)
899 && CONSP (XCONS (left)->cdr)
900 && INTEGERP (XCONS (XCONS (left)->cdr)->car))
901 {
902 leftpos = - XINT (XCONS (XCONS (left)->cdr)->car);
903 f->output_data.x->size_hint_flags |= XNegative;
904 }
905 else if (CONSP (left) && EQ (XCONS (left)->car, Qplus)
906 && CONSP (XCONS (left)->cdr)
907 && INTEGERP (XCONS (XCONS (left)->cdr)->car))
908 {
909 leftpos = XINT (XCONS (XCONS (left)->cdr)->car);
910 }
911
912 if (EQ (top, Qminus))
913 f->output_data.x->size_hint_flags |= YNegative;
914 else if (INTEGERP (top))
915 {
916 toppos = XINT (top);
917 if (toppos < 0)
918 f->output_data.x->size_hint_flags |= YNegative;
919 }
920 else if (CONSP (top) && EQ (XCONS (top)->car, Qminus)
921 && CONSP (XCONS (top)->cdr)
922 && INTEGERP (XCONS (XCONS (top)->cdr)->car))
923 {
924 toppos = - XINT (XCONS (XCONS (top)->cdr)->car);
925 f->output_data.x->size_hint_flags |= YNegative;
926 }
927 else if (CONSP (top) && EQ (XCONS (top)->car, Qplus)
928 && CONSP (XCONS (top)->cdr)
929 && INTEGERP (XCONS (XCONS (top)->cdr)->car))
930 {
931 toppos = XINT (XCONS (XCONS (top)->cdr)->car);
932 }
933
934
935 /* Store the numeric value of the position. */
936 f->output_data.x->top_pos = toppos;
937 f->output_data.x->left_pos = leftpos;
938
939 f->output_data.x->win_gravity = NorthWestGravity;
940
941 /* Actually set that position, and convert to absolute. */
942 x_set_offset (f, leftpos, toppos, -1);
943 }
944
945 if ((!NILP (icon_left) || !NILP (icon_top))
946 && ! (icon_left_no_change && icon_top_no_change))
947 x_wm_set_icon_position (f, XINT (icon_left), XINT (icon_top));
948 }
949 }
950
951 /* Store the screen positions of frame F into XPTR and YPTR.
952 These are the positions of the containing window manager window,
953 not Emacs's own window. */
954
955 void
956 x_real_positions (f, xptr, yptr)
957 FRAME_PTR f;
958 int *xptr, *yptr;
959 {
960 int win_x, win_y;
961 Window child;
962
963 /* This is pretty gross, but seems to be the easiest way out of
964 the problem that arises when restarting window-managers. */
965
966 #ifdef USE_X_TOOLKIT
967 Window outer = XtWindow (f->output_data.x->widget);
968 #else
969 Window outer = f->output_data.x->window_desc;
970 #endif
971 Window tmp_root_window;
972 Window *tmp_children;
973 int tmp_nchildren;
974
975 while (1)
976 {
977 int count = x_catch_errors (FRAME_X_DISPLAY (f));
978 Window outer_window;
979
980 XQueryTree (FRAME_X_DISPLAY (f), outer, &tmp_root_window,
981 &f->output_data.x->parent_desc,
982 &tmp_children, &tmp_nchildren);
983 XFree ((char *) tmp_children);
984
985 win_x = win_y = 0;
986
987 /* Find the position of the outside upper-left corner of
988 the inner window, with respect to the outer window. */
989 if (f->output_data.x->parent_desc != FRAME_X_DISPLAY_INFO (f)->root_window)
990 outer_window = f->output_data.x->parent_desc;
991 else
992 outer_window = outer;
993
994 XTranslateCoordinates (FRAME_X_DISPLAY (f),
995
996 /* From-window, to-window. */
997 outer_window,
998 FRAME_X_DISPLAY_INFO (f)->root_window,
999
1000 /* From-position, to-position. */
1001 0, 0, &win_x, &win_y,
1002
1003 /* Child of win. */
1004 &child);
1005
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)))
1012 {
1013 x_uncatch_errors (FRAME_X_DISPLAY (f), count);
1014 break;
1015 }
1016
1017 x_uncatch_errors (FRAME_X_DISPLAY (f), count);
1018 }
1019
1020 *xptr = win_x - f->output_data.x->border_width;
1021 *yptr = win_y - f->output_data.x->border_width;
1022 }
1023
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. */
1029
1030 void
1031 x_report_frame_params (f, alistptr)
1032 struct frame *f;
1033 Lisp_Object *alistptr;
1034 {
1035 char buf[16];
1036 Lisp_Object tem;
1037
1038 /* Represent negative positions (off the top or left screen edge)
1039 in a way that Fmodify_frame_parameters will understand correctly. */
1040 XSETINT (tem, f->output_data.x->left_pos);
1041 if (f->output_data.x->left_pos >= 0)
1042 store_in_alist (alistptr, Qleft, tem);
1043 else
1044 store_in_alist (alistptr, Qleft, Fcons (Qplus, Fcons (tem, Qnil)));
1045
1046 XSETINT (tem, f->output_data.x->top_pos);
1047 if (f->output_data.x->top_pos >= 0)
1048 store_in_alist (alistptr, Qtop, tem);
1049 else
1050 store_in_alist (alistptr, Qtop, Fcons (Qplus, Fcons (tem, Qnil)));
1051
1052 store_in_alist (alistptr, Qborder_width,
1053 make_number (f->output_data.x->border_width));
1054 store_in_alist (alistptr, Qinternal_border_width,
1055 make_number (f->output_data.x->internal_border_width));
1056 sprintf (buf, "%ld", (long) FRAME_X_WINDOW (f));
1057 store_in_alist (alistptr, Qwindow_id,
1058 build_string (buf));
1059 store_in_alist (alistptr, Qicon_name, f->icon_name);
1060 FRAME_SAMPLE_VISIBILITY (f);
1061 store_in_alist (alistptr, Qvisibility,
1062 (FRAME_VISIBLE_P (f) ? Qt
1063 : FRAME_ICONIFIED_P (f) ? Qicon : Qnil));
1064 store_in_alist (alistptr, Qdisplay,
1065 XCONS (FRAME_X_DISPLAY_INFO (f)->name_list_element)->car);
1066
1067 if (f->output_data.x->parent_desc == FRAME_X_DISPLAY_INFO (f)->root_window)
1068 tem = Qnil;
1069 else
1070 XSETFASTINT (tem, f->output_data.x->parent_desc);
1071 store_in_alist (alistptr, Qparent_id, tem);
1072 }
1073 \f
1074
1075 /* Decide if color named COLOR is valid for the display associated with
1076 the selected frame; if so, return the rgb values in COLOR_DEF.
1077 If ALLOC is nonzero, allocate a new colormap cell. */
1078
1079 int
1080 defined_color (f, color, color_def, alloc)
1081 FRAME_PTR f;
1082 char *color;
1083 XColor *color_def;
1084 int alloc;
1085 {
1086 register int status;
1087 Colormap screen_colormap;
1088 Display *display = FRAME_X_DISPLAY (f);
1089
1090 BLOCK_INPUT;
1091 screen_colormap = DefaultColormap (display, XDefaultScreen (display));
1092
1093 status = XParseColor (display, screen_colormap, color, color_def);
1094 if (status && alloc)
1095 {
1096 status = XAllocColor (display, screen_colormap, color_def);
1097 if (!status)
1098 {
1099 /* If we got to this point, the colormap is full, so we're
1100 going to try and get the next closest color.
1101 The algorithm used is a least-squares matching, which is
1102 what X uses for closest color matching with StaticColor visuals. */
1103
1104 XColor *cells;
1105 int no_cells;
1106 int nearest;
1107 long nearest_delta, trial_delta;
1108 int x;
1109
1110 no_cells = XDisplayCells (display, XDefaultScreen (display));
1111 cells = (XColor *) alloca (sizeof (XColor) * no_cells);
1112
1113 for (x = 0; x < no_cells; x++)
1114 cells[x].pixel = x;
1115
1116 XQueryColors (display, screen_colormap, cells, no_cells);
1117 nearest = 0;
1118 /* I'm assuming CSE so I'm not going to condense this. */
1119 nearest_delta = ((((color_def->red >> 8) - (cells[0].red >> 8))
1120 * ((color_def->red >> 8) - (cells[0].red >> 8)))
1121 +
1122 (((color_def->green >> 8) - (cells[0].green >> 8))
1123 * ((color_def->green >> 8) - (cells[0].green >> 8)))
1124 +
1125 (((color_def->blue >> 8) - (cells[0].blue >> 8))
1126 * ((color_def->blue >> 8) - (cells[0].blue >> 8))));
1127 for (x = 1; x < no_cells; x++)
1128 {
1129 trial_delta = ((((color_def->red >> 8) - (cells[x].red >> 8))
1130 * ((color_def->red >> 8) - (cells[x].red >> 8)))
1131 +
1132 (((color_def->green >> 8) - (cells[x].green >> 8))
1133 * ((color_def->green >> 8) - (cells[x].green >> 8)))
1134 +
1135 (((color_def->blue >> 8) - (cells[x].blue >> 8))
1136 * ((color_def->blue >> 8) - (cells[x].blue >> 8))));
1137 if (trial_delta < nearest_delta)
1138 {
1139 XColor temp;
1140 temp.red = cells[x].red;
1141 temp.green = cells[x].green;
1142 temp.blue = cells[x].blue;
1143 status = XAllocColor (display, screen_colormap, &temp);
1144 if (status)
1145 {
1146 nearest = x;
1147 nearest_delta = trial_delta;
1148 }
1149 }
1150 }
1151 color_def->red = cells[nearest].red;
1152 color_def->green = cells[nearest].green;
1153 color_def->blue = cells[nearest].blue;
1154 status = XAllocColor (display, screen_colormap, color_def);
1155 }
1156 }
1157 UNBLOCK_INPUT;
1158
1159 if (status)
1160 return 1;
1161 else
1162 return 0;
1163 }
1164
1165 /* Given a string ARG naming a color, compute a pixel value from it
1166 suitable for screen F.
1167 If F is not a color screen, return DEF (default) regardless of what
1168 ARG says. */
1169
1170 int
1171 x_decode_color (f, arg, def)
1172 FRAME_PTR f;
1173 Lisp_Object arg;
1174 int def;
1175 {
1176 XColor cdef;
1177
1178 CHECK_STRING (arg, 0);
1179
1180 if (strcmp (XSTRING (arg)->data, "black") == 0)
1181 return BLACK_PIX_DEFAULT (f);
1182 else if (strcmp (XSTRING (arg)->data, "white") == 0)
1183 return WHITE_PIX_DEFAULT (f);
1184
1185 if (FRAME_X_DISPLAY_INFO (f)->n_planes == 1)
1186 return def;
1187
1188 /* defined_color is responsible for coping with failures
1189 by looking for a near-miss. */
1190 if (defined_color (f, XSTRING (arg)->data, &cdef, 1))
1191 return cdef.pixel;
1192
1193 Fsignal (Qerror, Fcons (build_string ("undefined color"),
1194 Fcons (arg, Qnil)));
1195 }
1196 \f
1197 /* Functions called only from `x_set_frame_param'
1198 to set individual parameters.
1199
1200 If FRAME_X_WINDOW (f) is 0,
1201 the frame is being created and its X-window does not exist yet.
1202 In that case, just record the parameter's new value
1203 in the standard place; do not attempt to change the window. */
1204
1205 void
1206 x_set_foreground_color (f, arg, oldval)
1207 struct frame *f;
1208 Lisp_Object arg, oldval;
1209 {
1210 unsigned long pixel
1211 = x_decode_color (f, arg, BLACK_PIX_DEFAULT (f));
1212
1213 if (f->output_data.x->foreground_pixel != f->output_data.x->mouse_pixel
1214 && f->output_data.x->foreground_pixel != f->output_data.x->cursor_pixel
1215 && f->output_data.x->foreground_pixel != f->output_data.x->cursor_foreground_pixel)
1216 unload_color (f, f->output_data.x->foreground_pixel);
1217 f->output_data.x->foreground_pixel = pixel;
1218
1219 if (FRAME_X_WINDOW (f) != 0)
1220 {
1221 BLOCK_INPUT;
1222 XSetForeground (FRAME_X_DISPLAY (f), f->output_data.x->normal_gc,
1223 f->output_data.x->foreground_pixel);
1224 XSetBackground (FRAME_X_DISPLAY (f), f->output_data.x->reverse_gc,
1225 f->output_data.x->foreground_pixel);
1226 UNBLOCK_INPUT;
1227 recompute_basic_faces (f);
1228 if (FRAME_VISIBLE_P (f))
1229 redraw_frame (f);
1230 }
1231 }
1232
1233 void
1234 x_set_background_color (f, arg, oldval)
1235 struct frame *f;
1236 Lisp_Object arg, oldval;
1237 {
1238 Pixmap temp;
1239 int mask;
1240
1241 unsigned long pixel
1242 = x_decode_color (f, arg, WHITE_PIX_DEFAULT (f));
1243
1244 if (f->output_data.x->background_pixel != f->output_data.x->mouse_pixel
1245 && f->output_data.x->background_pixel != f->output_data.x->cursor_pixel
1246 && f->output_data.x->background_pixel != f->output_data.x->cursor_foreground_pixel)
1247 unload_color (f, f->output_data.x->background_pixel);
1248 f->output_data.x->background_pixel = pixel;
1249
1250 if (FRAME_X_WINDOW (f) != 0)
1251 {
1252 BLOCK_INPUT;
1253 /* The main frame area. */
1254 XSetBackground (FRAME_X_DISPLAY (f), f->output_data.x->normal_gc,
1255 f->output_data.x->background_pixel);
1256 XSetForeground (FRAME_X_DISPLAY (f), f->output_data.x->reverse_gc,
1257 f->output_data.x->background_pixel);
1258 XSetForeground (FRAME_X_DISPLAY (f), f->output_data.x->cursor_gc,
1259 f->output_data.x->background_pixel);
1260 XSetWindowBackground (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
1261 f->output_data.x->background_pixel);
1262 {
1263 Lisp_Object bar;
1264 for (bar = FRAME_SCROLL_BARS (f); !NILP (bar);
1265 bar = XSCROLL_BAR (bar)->next)
1266 XSetWindowBackground (FRAME_X_DISPLAY (f),
1267 SCROLL_BAR_X_WINDOW (XSCROLL_BAR (bar)),
1268 f->output_data.x->background_pixel);
1269 }
1270 UNBLOCK_INPUT;
1271
1272 recompute_basic_faces (f);
1273
1274 if (FRAME_VISIBLE_P (f))
1275 redraw_frame (f);
1276 }
1277 }
1278
1279 void
1280 x_set_mouse_color (f, arg, oldval)
1281 struct frame *f;
1282 Lisp_Object arg, oldval;
1283 {
1284 Cursor cursor, nontext_cursor, mode_cursor, cross_cursor;
1285 int count;
1286 int mask_color;
1287 unsigned long pixel = f->output_data.x->mouse_pixel;
1288
1289 if (!EQ (Qnil, arg))
1290 pixel = x_decode_color (f, arg, BLACK_PIX_DEFAULT (f));
1291
1292 mask_color = f->output_data.x->background_pixel;
1293 /* No invisible pointers. */
1294 if (mask_color == pixel
1295 && mask_color == f->output_data.x->background_pixel)
1296 pixel = f->output_data.x->foreground_pixel;
1297
1298 if (f->output_data.x->background_pixel != f->output_data.x->mouse_pixel
1299 && f->output_data.x->foreground_pixel != f->output_data.x->mouse_pixel
1300 && f->output_data.x->cursor_pixel != f->output_data.x->mouse_pixel
1301 && f->output_data.x->cursor_foreground_pixel != f->output_data.x->mouse_pixel)
1302 unload_color (f, f->output_data.x->mouse_pixel);
1303 f->output_data.x->mouse_pixel = pixel;
1304
1305 BLOCK_INPUT;
1306
1307 /* It's not okay to crash if the user selects a screwy cursor. */
1308 count = x_catch_errors (FRAME_X_DISPLAY (f));
1309
1310 if (!EQ (Qnil, Vx_pointer_shape))
1311 {
1312 CHECK_NUMBER (Vx_pointer_shape, 0);
1313 cursor = XCreateFontCursor (FRAME_X_DISPLAY (f), XINT (Vx_pointer_shape));
1314 }
1315 else
1316 cursor = XCreateFontCursor (FRAME_X_DISPLAY (f), XC_xterm);
1317 x_check_errors (FRAME_X_DISPLAY (f), "bad text pointer cursor: %s");
1318
1319 if (!EQ (Qnil, Vx_nontext_pointer_shape))
1320 {
1321 CHECK_NUMBER (Vx_nontext_pointer_shape, 0);
1322 nontext_cursor = XCreateFontCursor (FRAME_X_DISPLAY (f),
1323 XINT (Vx_nontext_pointer_shape));
1324 }
1325 else
1326 nontext_cursor = XCreateFontCursor (FRAME_X_DISPLAY (f), XC_left_ptr);
1327 x_check_errors (FRAME_X_DISPLAY (f), "bad nontext pointer cursor: %s");
1328
1329 if (!EQ (Qnil, Vx_mode_pointer_shape))
1330 {
1331 CHECK_NUMBER (Vx_mode_pointer_shape, 0);
1332 mode_cursor = XCreateFontCursor (FRAME_X_DISPLAY (f),
1333 XINT (Vx_mode_pointer_shape));
1334 }
1335 else
1336 mode_cursor = XCreateFontCursor (FRAME_X_DISPLAY (f), XC_xterm);
1337 x_check_errors (FRAME_X_DISPLAY (f), "bad modeline pointer cursor: %s");
1338
1339 if (!EQ (Qnil, Vx_sensitive_text_pointer_shape))
1340 {
1341 CHECK_NUMBER (Vx_sensitive_text_pointer_shape, 0);
1342 cross_cursor
1343 = XCreateFontCursor (FRAME_X_DISPLAY (f),
1344 XINT (Vx_sensitive_text_pointer_shape));
1345 }
1346 else
1347 cross_cursor = XCreateFontCursor (FRAME_X_DISPLAY (f), XC_crosshair);
1348
1349 /* Check and report errors with the above calls. */
1350 x_check_errors (FRAME_X_DISPLAY (f), "can't set cursor shape: %s");
1351 x_uncatch_errors (FRAME_X_DISPLAY (f), count);
1352
1353 {
1354 XColor fore_color, back_color;
1355
1356 fore_color.pixel = f->output_data.x->mouse_pixel;
1357 back_color.pixel = mask_color;
1358 XQueryColor (FRAME_X_DISPLAY (f),
1359 DefaultColormap (FRAME_X_DISPLAY (f),
1360 DefaultScreen (FRAME_X_DISPLAY (f))),
1361 &fore_color);
1362 XQueryColor (FRAME_X_DISPLAY (f),
1363 DefaultColormap (FRAME_X_DISPLAY (f),
1364 DefaultScreen (FRAME_X_DISPLAY (f))),
1365 &back_color);
1366 XRecolorCursor (FRAME_X_DISPLAY (f), cursor,
1367 &fore_color, &back_color);
1368 XRecolorCursor (FRAME_X_DISPLAY (f), nontext_cursor,
1369 &fore_color, &back_color);
1370 XRecolorCursor (FRAME_X_DISPLAY (f), mode_cursor,
1371 &fore_color, &back_color);
1372 XRecolorCursor (FRAME_X_DISPLAY (f), cross_cursor,
1373 &fore_color, &back_color);
1374 }
1375
1376 if (FRAME_X_WINDOW (f) != 0)
1377 {
1378 XDefineCursor (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f), cursor);
1379 }
1380
1381 if (cursor != f->output_data.x->text_cursor && f->output_data.x->text_cursor != 0)
1382 XFreeCursor (FRAME_X_DISPLAY (f), f->output_data.x->text_cursor);
1383 f->output_data.x->text_cursor = cursor;
1384
1385 if (nontext_cursor != f->output_data.x->nontext_cursor
1386 && f->output_data.x->nontext_cursor != 0)
1387 XFreeCursor (FRAME_X_DISPLAY (f), f->output_data.x->nontext_cursor);
1388 f->output_data.x->nontext_cursor = nontext_cursor;
1389
1390 if (mode_cursor != f->output_data.x->modeline_cursor
1391 && f->output_data.x->modeline_cursor != 0)
1392 XFreeCursor (FRAME_X_DISPLAY (f), f->output_data.x->modeline_cursor);
1393 f->output_data.x->modeline_cursor = mode_cursor;
1394 if (cross_cursor != f->output_data.x->cross_cursor
1395 && f->output_data.x->cross_cursor != 0)
1396 XFreeCursor (FRAME_X_DISPLAY (f), f->output_data.x->cross_cursor);
1397 f->output_data.x->cross_cursor = cross_cursor;
1398
1399 XFlush (FRAME_X_DISPLAY (f));
1400 UNBLOCK_INPUT;
1401 }
1402
1403 void
1404 x_set_cursor_color (f, arg, oldval)
1405 struct frame *f;
1406 Lisp_Object arg, oldval;
1407 {
1408 unsigned long fore_pixel, pixel;
1409
1410 if (!EQ (Vx_cursor_fore_pixel, Qnil))
1411 fore_pixel = x_decode_color (f, Vx_cursor_fore_pixel,
1412 WHITE_PIX_DEFAULT (f));
1413 else
1414 fore_pixel = f->output_data.x->background_pixel;
1415 pixel = x_decode_color (f, arg, BLACK_PIX_DEFAULT (f));
1416
1417 /* Make sure that the cursor color differs from the background color. */
1418 if (pixel == f->output_data.x->background_pixel)
1419 {
1420 pixel = f->output_data.x->mouse_pixel;
1421 if (pixel == fore_pixel)
1422 fore_pixel = f->output_data.x->background_pixel;
1423 }
1424
1425 if (f->output_data.x->background_pixel != f->output_data.x->cursor_foreground_pixel
1426 && f->output_data.x->foreground_pixel != f->output_data.x->cursor_foreground_pixel
1427 && f->output_data.x->mouse_pixel != f->output_data.x->cursor_foreground_pixel
1428 && f->output_data.x->cursor_pixel != f->output_data.x->cursor_foreground_pixel)
1429 unload_color (f, f->output_data.x->cursor_foreground_pixel);
1430 f->output_data.x->cursor_foreground_pixel = fore_pixel;
1431
1432 if (f->output_data.x->background_pixel != f->output_data.x->cursor_pixel
1433 && f->output_data.x->foreground_pixel != f->output_data.x->cursor_pixel
1434 && f->output_data.x->mouse_pixel != f->output_data.x->cursor_pixel
1435 && f->output_data.x->cursor_foreground_pixel != f->output_data.x->cursor_pixel)
1436 unload_color (f, f->output_data.x->cursor_pixel);
1437 f->output_data.x->cursor_pixel = pixel;
1438
1439 if (FRAME_X_WINDOW (f) != 0)
1440 {
1441 BLOCK_INPUT;
1442 XSetBackground (FRAME_X_DISPLAY (f), f->output_data.x->cursor_gc,
1443 f->output_data.x->cursor_pixel);
1444 XSetForeground (FRAME_X_DISPLAY (f), f->output_data.x->cursor_gc,
1445 fore_pixel);
1446 UNBLOCK_INPUT;
1447
1448 if (FRAME_VISIBLE_P (f))
1449 {
1450 x_update_cursor (f, 0);
1451 x_update_cursor (f, 1);
1452 }
1453 }
1454 }
1455 \f
1456 /* Set the border-color of frame F to value described by ARG.
1457 ARG can be a string naming a color.
1458 The border-color is used for the border that is drawn by the X server.
1459 Note that this does not fully take effect if done before
1460 F has an x-window; it must be redone when the window is created.
1461
1462 Note: this is done in two routines because of the way X10 works.
1463
1464 Note: under X11, this is normally the province of the window manager,
1465 and so emacs' border colors may be overridden. */
1466
1467 void
1468 x_set_border_color (f, arg, oldval)
1469 struct frame *f;
1470 Lisp_Object arg, oldval;
1471 {
1472 unsigned char *str;
1473 int pix;
1474
1475 CHECK_STRING (arg, 0);
1476 str = XSTRING (arg)->data;
1477
1478 pix = x_decode_color (f, arg, BLACK_PIX_DEFAULT (f));
1479
1480 x_set_border_pixel (f, pix);
1481 }
1482
1483 /* Set the border-color of frame F to pixel value PIX.
1484 Note that this does not fully take effect if done before
1485 F has an x-window. */
1486
1487 void
1488 x_set_border_pixel (f, pix)
1489 struct frame *f;
1490 int pix;
1491 {
1492 unload_color (f, f->output_data.x->border_pixel);
1493 f->output_data.x->border_pixel = pix;
1494
1495 if (FRAME_X_WINDOW (f) != 0 && f->output_data.x->border_width > 0)
1496 {
1497 Pixmap temp;
1498 int mask;
1499
1500 BLOCK_INPUT;
1501 XSetWindowBorder (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
1502 (unsigned long)pix);
1503 UNBLOCK_INPUT;
1504
1505 if (FRAME_VISIBLE_P (f))
1506 redraw_frame (f);
1507 }
1508 }
1509
1510 void
1511 x_set_cursor_type (f, arg, oldval)
1512 FRAME_PTR f;
1513 Lisp_Object arg, oldval;
1514 {
1515 if (EQ (arg, Qbar))
1516 {
1517 FRAME_DESIRED_CURSOR (f) = bar_cursor;
1518 f->output_data.x->cursor_width = 2;
1519 }
1520 else if (CONSP (arg) && EQ (XCONS (arg)->car, Qbar)
1521 && INTEGERP (XCONS (arg)->cdr))
1522 {
1523 FRAME_DESIRED_CURSOR (f) = bar_cursor;
1524 f->output_data.x->cursor_width = XINT (XCONS (arg)->cdr);
1525 }
1526 else
1527 /* Treat anything unknown as "box cursor".
1528 It was bad to signal an error; people have trouble fixing
1529 .Xdefaults with Emacs, when it has something bad in it. */
1530 FRAME_DESIRED_CURSOR (f) = filled_box_cursor;
1531
1532 /* Make sure the cursor gets redrawn. This is overkill, but how
1533 often do people change cursor types? */
1534 update_mode_lines++;
1535 }
1536 \f
1537 void
1538 x_set_icon_type (f, arg, oldval)
1539 struct frame *f;
1540 Lisp_Object arg, oldval;
1541 {
1542 Lisp_Object tem;
1543 int result;
1544
1545 if (STRINGP (arg))
1546 {
1547 if (STRINGP (oldval) && EQ (Fstring_equal (oldval, arg), Qt))
1548 return;
1549 }
1550 else if (!STRINGP (oldval) && EQ (oldval, Qnil) == EQ (arg, Qnil))
1551 return;
1552
1553 BLOCK_INPUT;
1554 if (NILP (arg))
1555 result = x_text_icon (f,
1556 (char *) XSTRING ((!NILP (f->icon_name)
1557 ? f->icon_name
1558 : f->name))->data);
1559 else
1560 result = x_bitmap_icon (f, arg);
1561
1562 if (result)
1563 {
1564 UNBLOCK_INPUT;
1565 error ("No icon window available");
1566 }
1567
1568 XFlush (FRAME_X_DISPLAY (f));
1569 UNBLOCK_INPUT;
1570 }
1571
1572 /* Return non-nil if frame F wants a bitmap icon. */
1573
1574 Lisp_Object
1575 x_icon_type (f)
1576 FRAME_PTR f;
1577 {
1578 Lisp_Object tem;
1579
1580 tem = assq_no_quit (Qicon_type, f->param_alist);
1581 if (CONSP (tem))
1582 return XCONS (tem)->cdr;
1583 else
1584 return Qnil;
1585 }
1586
1587 void
1588 x_set_icon_name (f, arg, oldval)
1589 struct frame *f;
1590 Lisp_Object arg, oldval;
1591 {
1592 Lisp_Object tem;
1593 int result;
1594
1595 if (STRINGP (arg))
1596 {
1597 if (STRINGP (oldval) && EQ (Fstring_equal (oldval, arg), Qt))
1598 return;
1599 }
1600 else if (!STRINGP (oldval) && EQ (oldval, Qnil) == EQ (arg, Qnil))
1601 return;
1602
1603 f->icon_name = arg;
1604
1605 if (f->output_data.x->icon_bitmap != 0)
1606 return;
1607
1608 BLOCK_INPUT;
1609
1610 result = x_text_icon (f,
1611 (char *) XSTRING ((!NILP (f->icon_name)
1612 ? f->icon_name
1613 : !NILP (f->title)
1614 ? f->title
1615 : f->name))->data);
1616
1617 if (result)
1618 {
1619 UNBLOCK_INPUT;
1620 error ("No icon window available");
1621 }
1622
1623 XFlush (FRAME_X_DISPLAY (f));
1624 UNBLOCK_INPUT;
1625 }
1626 \f
1627 void
1628 x_set_font (f, arg, oldval)
1629 struct frame *f;
1630 Lisp_Object arg, oldval;
1631 {
1632 Lisp_Object result;
1633 Lisp_Object fontset_name;
1634 Lisp_Object frame;
1635
1636 CHECK_STRING (arg, 1);
1637
1638 fontset_name = Fquery_fontset (arg, Qnil);
1639
1640 BLOCK_INPUT;
1641 result = (STRINGP (fontset_name)
1642 ? x_new_fontset (f, XSTRING (fontset_name)->data)
1643 : x_new_font (f, XSTRING (arg)->data));
1644 UNBLOCK_INPUT;
1645
1646 if (EQ (result, Qnil))
1647 error ("Font `%s' is not defined", XSTRING (arg)->data);
1648 else if (EQ (result, Qt))
1649 error ("the characters of the given font have varying widths");
1650 else if (STRINGP (result))
1651 {
1652 recompute_basic_faces (f);
1653 store_frame_param (f, Qfont, result);
1654 }
1655 else
1656 abort ();
1657
1658 XSETFRAME (frame, f);
1659 call1 (Qface_set_after_frame_default, frame);
1660 }
1661
1662 void
1663 x_set_border_width (f, arg, oldval)
1664 struct frame *f;
1665 Lisp_Object arg, oldval;
1666 {
1667 CHECK_NUMBER (arg, 0);
1668
1669 if (XINT (arg) == f->output_data.x->border_width)
1670 return;
1671
1672 if (FRAME_X_WINDOW (f) != 0)
1673 error ("Cannot change the border width of a window");
1674
1675 f->output_data.x->border_width = XINT (arg);
1676 }
1677
1678 void
1679 x_set_internal_border_width (f, arg, oldval)
1680 struct frame *f;
1681 Lisp_Object arg, oldval;
1682 {
1683 int mask;
1684 int old = f->output_data.x->internal_border_width;
1685
1686 CHECK_NUMBER (arg, 0);
1687 f->output_data.x->internal_border_width = XINT (arg);
1688 if (f->output_data.x->internal_border_width < 0)
1689 f->output_data.x->internal_border_width = 0;
1690
1691 #ifdef USE_X_TOOLKIT
1692 if (f->output_data.x->edit_widget)
1693 widget_store_internal_border (f->output_data.x->edit_widget);
1694 #endif
1695
1696 if (f->output_data.x->internal_border_width == old)
1697 return;
1698
1699 if (FRAME_X_WINDOW (f) != 0)
1700 {
1701 BLOCK_INPUT;
1702 x_set_window_size (f, 0, f->width, f->height);
1703 #if 0
1704 x_set_resize_hint (f);
1705 #endif
1706 XFlush (FRAME_X_DISPLAY (f));
1707 UNBLOCK_INPUT;
1708 SET_FRAME_GARBAGED (f);
1709 }
1710 }
1711
1712 void
1713 x_set_visibility (f, value, oldval)
1714 struct frame *f;
1715 Lisp_Object value, oldval;
1716 {
1717 Lisp_Object frame;
1718 XSETFRAME (frame, f);
1719
1720 if (NILP (value))
1721 Fmake_frame_invisible (frame, Qt);
1722 else if (EQ (value, Qicon))
1723 Ficonify_frame (frame);
1724 else
1725 Fmake_frame_visible (frame);
1726 }
1727 \f
1728 static void
1729 x_set_menu_bar_lines_1 (window, n)
1730 Lisp_Object window;
1731 int n;
1732 {
1733 struct window *w = XWINDOW (window);
1734
1735 XSETFASTINT (w->top, XFASTINT (w->top) + n);
1736 XSETFASTINT (w->height, XFASTINT (w->height) - n);
1737
1738 /* Handle just the top child in a vertical split. */
1739 if (!NILP (w->vchild))
1740 x_set_menu_bar_lines_1 (w->vchild, n);
1741
1742 /* Adjust all children in a horizontal split. */
1743 for (window = w->hchild; !NILP (window); window = w->next)
1744 {
1745 w = XWINDOW (window);
1746 x_set_menu_bar_lines_1 (window, n);
1747 }
1748 }
1749
1750 void
1751 x_set_menu_bar_lines (f, value, oldval)
1752 struct frame *f;
1753 Lisp_Object value, oldval;
1754 {
1755 int nlines;
1756 int olines = FRAME_MENU_BAR_LINES (f);
1757
1758 /* Right now, menu bars don't work properly in minibuf-only frames;
1759 most of the commands try to apply themselves to the minibuffer
1760 frame itslef, and get an error because you can't switch buffers
1761 in or split the minibuffer window. */
1762 if (FRAME_MINIBUF_ONLY_P (f))
1763 return;
1764
1765 if (INTEGERP (value))
1766 nlines = XINT (value);
1767 else
1768 nlines = 0;
1769
1770 /* Make sure we redisplay all windows in this frame. */
1771 windows_or_buffers_changed++;
1772
1773 #ifdef USE_X_TOOLKIT
1774 FRAME_MENU_BAR_LINES (f) = 0;
1775 if (nlines)
1776 {
1777 FRAME_EXTERNAL_MENU_BAR (f) = 1;
1778 if (FRAME_X_P (f) && f->output_data.x->menubar_widget == 0)
1779 /* Make sure next redisplay shows the menu bar. */
1780 XWINDOW (FRAME_SELECTED_WINDOW (f))->update_mode_line = Qt;
1781 }
1782 else
1783 {
1784 if (FRAME_EXTERNAL_MENU_BAR (f) == 1)
1785 free_frame_menubar (f);
1786 FRAME_EXTERNAL_MENU_BAR (f) = 0;
1787 if (FRAME_X_P (f))
1788 f->output_data.x->menubar_widget = 0;
1789 }
1790 #else /* not USE_X_TOOLKIT */
1791 FRAME_MENU_BAR_LINES (f) = nlines;
1792 x_set_menu_bar_lines_1 (f->root_window, nlines - olines);
1793 #endif /* not USE_X_TOOLKIT */
1794 }
1795 \f
1796 /* Change the name of frame F to NAME. If NAME is nil, set F's name to
1797 x_id_name.
1798
1799 If EXPLICIT is non-zero, that indicates that lisp code is setting the
1800 name; if NAME is a string, set F's name to NAME and set
1801 F->explicit_name; if NAME is Qnil, then clear F->explicit_name.
1802
1803 If EXPLICIT is zero, that indicates that Emacs redisplay code is
1804 suggesting a new name, which lisp code should override; if
1805 F->explicit_name is set, ignore the new name; otherwise, set it. */
1806
1807 void
1808 x_set_name (f, name, explicit)
1809 struct frame *f;
1810 Lisp_Object name;
1811 int explicit;
1812 {
1813 /* Make sure that requests from lisp code override requests from
1814 Emacs redisplay code. */
1815 if (explicit)
1816 {
1817 /* If we're switching from explicit to implicit, we had better
1818 update the mode lines and thereby update the title. */
1819 if (f->explicit_name && NILP (name))
1820 update_mode_lines = 1;
1821
1822 f->explicit_name = ! NILP (name);
1823 }
1824 else if (f->explicit_name)
1825 return;
1826
1827 /* If NAME is nil, set the name to the x_id_name. */
1828 if (NILP (name))
1829 {
1830 /* Check for no change needed in this very common case
1831 before we do any consing. */
1832 if (!strcmp (FRAME_X_DISPLAY_INFO (f)->x_id_name,
1833 XSTRING (f->name)->data))
1834 return;
1835 name = build_string (FRAME_X_DISPLAY_INFO (f)->x_id_name);
1836 }
1837 else
1838 CHECK_STRING (name, 0);
1839
1840 /* Don't change the name if it's already NAME. */
1841 if (! NILP (Fstring_equal (name, f->name)))
1842 return;
1843
1844 f->name = name;
1845
1846 /* For setting the frame title, the title parameter should override
1847 the name parameter. */
1848 if (! NILP (f->title))
1849 name = f->title;
1850
1851 if (FRAME_X_WINDOW (f))
1852 {
1853 BLOCK_INPUT;
1854 #ifdef HAVE_X11R4
1855 {
1856 XTextProperty text, icon;
1857 Lisp_Object icon_name;
1858
1859 text.value = XSTRING (name)->data;
1860 text.encoding = XA_STRING;
1861 text.format = 8;
1862 text.nitems = STRING_BYTES (XSTRING (name));
1863
1864 icon_name = (!NILP (f->icon_name) ? f->icon_name : name);
1865
1866 icon.value = XSTRING (icon_name)->data;
1867 icon.encoding = XA_STRING;
1868 icon.format = 8;
1869 icon.nitems = STRING_BYTES (XSTRING (icon_name));
1870 #ifdef USE_X_TOOLKIT
1871 XSetWMName (FRAME_X_DISPLAY (f),
1872 XtWindow (f->output_data.x->widget), &text);
1873 XSetWMIconName (FRAME_X_DISPLAY (f), XtWindow (f->output_data.x->widget),
1874 &icon);
1875 #else /* not USE_X_TOOLKIT */
1876 XSetWMName (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f), &text);
1877 XSetWMIconName (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f), &icon);
1878 #endif /* not USE_X_TOOLKIT */
1879 }
1880 #else /* not HAVE_X11R4 */
1881 XSetIconName (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
1882 XSTRING (name)->data);
1883 XStoreName (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
1884 XSTRING (name)->data);
1885 #endif /* not HAVE_X11R4 */
1886 UNBLOCK_INPUT;
1887 }
1888 }
1889
1890 /* This function should be called when the user's lisp code has
1891 specified a name for the frame; the name will override any set by the
1892 redisplay code. */
1893 void
1894 x_explicitly_set_name (f, arg, oldval)
1895 FRAME_PTR f;
1896 Lisp_Object arg, oldval;
1897 {
1898 x_set_name (f, arg, 1);
1899 }
1900
1901 /* This function should be called by Emacs redisplay code to set the
1902 name; names set this way will never override names set by the user's
1903 lisp code. */
1904 void
1905 x_implicitly_set_name (f, arg, oldval)
1906 FRAME_PTR f;
1907 Lisp_Object arg, oldval;
1908 {
1909 x_set_name (f, arg, 0);
1910 }
1911 \f
1912 /* Change the title of frame F to NAME.
1913 If NAME is nil, use the frame name as the title.
1914
1915 If EXPLICIT is non-zero, that indicates that lisp code is setting the
1916 name; if NAME is a string, set F's name to NAME and set
1917 F->explicit_name; if NAME is Qnil, then clear F->explicit_name.
1918
1919 If EXPLICIT is zero, that indicates that Emacs redisplay code is
1920 suggesting a new name, which lisp code should override; if
1921 F->explicit_name is set, ignore the new name; otherwise, set it. */
1922
1923 void
1924 x_set_title (f, name)
1925 struct frame *f;
1926 Lisp_Object name;
1927 {
1928 /* Don't change the title if it's already NAME. */
1929 if (EQ (name, f->title))
1930 return;
1931
1932 update_mode_lines = 1;
1933
1934 f->title = name;
1935
1936 if (NILP (name))
1937 name = f->name;
1938 else
1939 CHECK_STRING (name, 0);
1940
1941 if (FRAME_X_WINDOW (f))
1942 {
1943 BLOCK_INPUT;
1944 #ifdef HAVE_X11R4
1945 {
1946 XTextProperty text, icon;
1947 Lisp_Object icon_name;
1948
1949 text.value = XSTRING (name)->data;
1950 text.encoding = XA_STRING;
1951 text.format = 8;
1952 text.nitems = STRING_BYTES (XSTRING (name));
1953
1954 icon_name = (!NILP (f->icon_name) ? f->icon_name : name);
1955
1956 icon.value = XSTRING (icon_name)->data;
1957 icon.encoding = XA_STRING;
1958 icon.format = 8;
1959 icon.nitems = STRING_BYTES (XSTRING (icon_name));
1960 #ifdef USE_X_TOOLKIT
1961 XSetWMName (FRAME_X_DISPLAY (f),
1962 XtWindow (f->output_data.x->widget), &text);
1963 XSetWMIconName (FRAME_X_DISPLAY (f), XtWindow (f->output_data.x->widget),
1964 &icon);
1965 #else /* not USE_X_TOOLKIT */
1966 XSetWMName (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f), &text);
1967 XSetWMIconName (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f), &icon);
1968 #endif /* not USE_X_TOOLKIT */
1969 }
1970 #else /* not HAVE_X11R4 */
1971 XSetIconName (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
1972 XSTRING (name)->data);
1973 XStoreName (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
1974 XSTRING (name)->data);
1975 #endif /* not HAVE_X11R4 */
1976 UNBLOCK_INPUT;
1977 }
1978 }
1979 \f
1980 void
1981 x_set_autoraise (f, arg, oldval)
1982 struct frame *f;
1983 Lisp_Object arg, oldval;
1984 {
1985 f->auto_raise = !EQ (Qnil, arg);
1986 }
1987
1988 void
1989 x_set_autolower (f, arg, oldval)
1990 struct frame *f;
1991 Lisp_Object arg, oldval;
1992 {
1993 f->auto_lower = !EQ (Qnil, arg);
1994 }
1995
1996 void
1997 x_set_unsplittable (f, arg, oldval)
1998 struct frame *f;
1999 Lisp_Object arg, oldval;
2000 {
2001 f->no_split = !NILP (arg);
2002 }
2003
2004 void
2005 x_set_vertical_scroll_bars (f, arg, oldval)
2006 struct frame *f;
2007 Lisp_Object arg, oldval;
2008 {
2009 if ((EQ (arg, Qleft) && FRAME_HAS_VERTICAL_SCROLL_BARS_ON_RIGHT (f))
2010 || (EQ (arg, Qright) && FRAME_HAS_VERTICAL_SCROLL_BARS_ON_LEFT (f))
2011 || (NILP (arg) && FRAME_HAS_VERTICAL_SCROLL_BARS (f))
2012 || (!NILP (arg) && ! FRAME_HAS_VERTICAL_SCROLL_BARS (f)))
2013 {
2014 FRAME_VERTICAL_SCROLL_BAR_TYPE (f)
2015 = (NILP (arg)
2016 ? vertical_scroll_bar_none
2017 : EQ (Qright, arg)
2018 ? vertical_scroll_bar_right
2019 : vertical_scroll_bar_left);
2020
2021 /* We set this parameter before creating the X window for the
2022 frame, so we can get the geometry right from the start.
2023 However, if the window hasn't been created yet, we shouldn't
2024 call x_set_window_size. */
2025 if (FRAME_X_WINDOW (f))
2026 x_set_window_size (f, 0, FRAME_WIDTH (f), FRAME_HEIGHT (f));
2027 }
2028 }
2029
2030 void
2031 x_set_scroll_bar_width (f, arg, oldval)
2032 struct frame *f;
2033 Lisp_Object arg, oldval;
2034 {
2035 int wid = FONT_WIDTH (f->output_data.x->font);
2036
2037 if (NILP (arg))
2038 {
2039 /* Make the actual width at least 14 pixels
2040 and a multiple of a character width. */
2041 FRAME_SCROLL_BAR_COLS (f) = (14 + wid - 1) / wid;
2042 /* Use all of that space (aside from required margins)
2043 for the scroll bar. */
2044 FRAME_SCROLL_BAR_PIXEL_WIDTH (f) = 0;
2045
2046 if (FRAME_X_WINDOW (f))
2047 x_set_window_size (f, 0, FRAME_WIDTH (f), FRAME_HEIGHT (f));
2048 }
2049 else if (INTEGERP (arg) && XINT (arg) > 0
2050 && XFASTINT (arg) != FRAME_SCROLL_BAR_PIXEL_WIDTH (f))
2051 {
2052 if (XFASTINT (arg) <= 2 * VERTICAL_SCROLL_BAR_WIDTH_TRIM)
2053 XSETINT (arg, 2 * VERTICAL_SCROLL_BAR_WIDTH_TRIM + 1);
2054
2055 FRAME_SCROLL_BAR_PIXEL_WIDTH (f) = XFASTINT (arg);
2056 FRAME_SCROLL_BAR_COLS (f) = (XFASTINT (arg) + wid-1) / wid;
2057 if (FRAME_X_WINDOW (f))
2058 x_set_window_size (f, 0, FRAME_WIDTH (f), FRAME_HEIGHT (f));
2059 }
2060
2061 change_frame_size (f, 0, FRAME_WIDTH (f), 0, 0);
2062 FRAME_CURSOR_X (f) = FRAME_LEFT_SCROLL_BAR_WIDTH (f);
2063 }
2064 \f
2065 /* Subroutines of creating an X frame. */
2066
2067 /* Make sure that Vx_resource_name is set to a reasonable value.
2068 Fix it up, or set it to `emacs' if it is too hopeless. */
2069
2070 static void
2071 validate_x_resource_name ()
2072 {
2073 int len;
2074 /* Number of valid characters in the resource name. */
2075 int good_count = 0;
2076 /* Number of invalid characters in the resource name. */
2077 int bad_count = 0;
2078 Lisp_Object new;
2079 int i;
2080
2081 if (!STRINGP (Vx_resource_class))
2082 Vx_resource_class = build_string (EMACS_CLASS);
2083
2084 if (STRINGP (Vx_resource_name))
2085 {
2086 unsigned char *p = XSTRING (Vx_resource_name)->data;
2087 int i;
2088
2089 len = STRING_BYTES (XSTRING (Vx_resource_name));
2090
2091 /* Only letters, digits, - and _ are valid in resource names.
2092 Count the valid characters and count the invalid ones. */
2093 for (i = 0; i < len; i++)
2094 {
2095 int c = p[i];
2096 if (! ((c >= 'a' && c <= 'z')
2097 || (c >= 'A' && c <= 'Z')
2098 || (c >= '0' && c <= '9')
2099 || c == '-' || c == '_'))
2100 bad_count++;
2101 else
2102 good_count++;
2103 }
2104 }
2105 else
2106 /* Not a string => completely invalid. */
2107 bad_count = 5, good_count = 0;
2108
2109 /* If name is valid already, return. */
2110 if (bad_count == 0)
2111 return;
2112
2113 /* If name is entirely invalid, or nearly so, use `emacs'. */
2114 if (good_count == 0
2115 || (good_count == 1 && bad_count > 0))
2116 {
2117 Vx_resource_name = build_string ("emacs");
2118 return;
2119 }
2120
2121 /* Name is partly valid. Copy it and replace the invalid characters
2122 with underscores. */
2123
2124 Vx_resource_name = new = Fcopy_sequence (Vx_resource_name);
2125
2126 for (i = 0; i < len; i++)
2127 {
2128 int c = XSTRING (new)->data[i];
2129 if (! ((c >= 'a' && c <= 'z')
2130 || (c >= 'A' && c <= 'Z')
2131 || (c >= '0' && c <= '9')
2132 || c == '-' || c == '_'))
2133 XSTRING (new)->data[i] = '_';
2134 }
2135 }
2136
2137
2138 extern char *x_get_string_resource ();
2139
2140 DEFUN ("x-get-resource", Fx_get_resource, Sx_get_resource, 2, 4, 0,
2141 "Return the value of ATTRIBUTE, of class CLASS, from the X defaults database.\n\
2142 This uses `INSTANCE.ATTRIBUTE' as the key and `Emacs.CLASS' as the\n\
2143 class, where INSTANCE is the name under which Emacs was invoked, or\n\
2144 the name specified by the `-name' or `-rn' command-line arguments.\n\
2145 \n\
2146 The optional arguments COMPONENT and SUBCLASS add to the key and the\n\
2147 class, respectively. You must specify both of them or neither.\n\
2148 If you specify them, the key is `INSTANCE.COMPONENT.ATTRIBUTE'\n\
2149 and the class is `Emacs.CLASS.SUBCLASS'.")
2150 (attribute, class, component, subclass)
2151 Lisp_Object attribute, class, component, subclass;
2152 {
2153 register char *value;
2154 char *name_key;
2155 char *class_key;
2156
2157 check_x ();
2158
2159 CHECK_STRING (attribute, 0);
2160 CHECK_STRING (class, 0);
2161
2162 if (!NILP (component))
2163 CHECK_STRING (component, 1);
2164 if (!NILP (subclass))
2165 CHECK_STRING (subclass, 2);
2166 if (NILP (component) != NILP (subclass))
2167 error ("x-get-resource: must specify both COMPONENT and SUBCLASS or neither");
2168
2169 validate_x_resource_name ();
2170
2171 /* Allocate space for the components, the dots which separate them,
2172 and the final '\0'. Make them big enough for the worst case. */
2173 name_key = (char *) alloca (STRING_BYTES (XSTRING (Vx_resource_name))
2174 + (STRINGP (component)
2175 ? STRING_BYTES (XSTRING (component)) : 0)
2176 + STRING_BYTES (XSTRING (attribute))
2177 + 3);
2178
2179 class_key = (char *) alloca (STRING_BYTES (XSTRING (Vx_resource_class))
2180 + STRING_BYTES (XSTRING (class))
2181 + (STRINGP (subclass)
2182 ? STRING_BYTES (XSTRING (subclass)) : 0)
2183 + 3);
2184
2185 /* Start with emacs.FRAMENAME for the name (the specific one)
2186 and with `Emacs' for the class key (the general one). */
2187 strcpy (name_key, XSTRING (Vx_resource_name)->data);
2188 strcpy (class_key, XSTRING (Vx_resource_class)->data);
2189
2190 strcat (class_key, ".");
2191 strcat (class_key, XSTRING (class)->data);
2192
2193 if (!NILP (component))
2194 {
2195 strcat (class_key, ".");
2196 strcat (class_key, XSTRING (subclass)->data);
2197
2198 strcat (name_key, ".");
2199 strcat (name_key, XSTRING (component)->data);
2200 }
2201
2202 strcat (name_key, ".");
2203 strcat (name_key, XSTRING (attribute)->data);
2204
2205 value = x_get_string_resource (check_x_display_info (Qnil)->xrdb,
2206 name_key, class_key);
2207
2208 if (value != (char *) 0)
2209 return build_string (value);
2210 else
2211 return Qnil;
2212 }
2213
2214 /* Get an X resource, like Fx_get_resource, but for display DPYINFO. */
2215
2216 static Lisp_Object
2217 display_x_get_resource (dpyinfo, attribute, class, component, subclass)
2218 struct x_display_info *dpyinfo;
2219 Lisp_Object attribute, class, component, subclass;
2220 {
2221 register char *value;
2222 char *name_key;
2223 char *class_key;
2224
2225 check_x ();
2226
2227 CHECK_STRING (attribute, 0);
2228 CHECK_STRING (class, 0);
2229
2230 if (!NILP (component))
2231 CHECK_STRING (component, 1);
2232 if (!NILP (subclass))
2233 CHECK_STRING (subclass, 2);
2234 if (NILP (component) != NILP (subclass))
2235 error ("x-get-resource: must specify both COMPONENT and SUBCLASS or neither");
2236
2237 validate_x_resource_name ();
2238
2239 /* Allocate space for the components, the dots which separate them,
2240 and the final '\0'. Make them big enough for the worst case. */
2241 name_key = (char *) alloca (STRING_BYTES (XSTRING (Vx_resource_name))
2242 + (STRINGP (component)
2243 ? STRING_BYTES (XSTRING (component)) : 0)
2244 + STRING_BYTES (XSTRING (attribute))
2245 + 3);
2246
2247 class_key = (char *) alloca (STRING_BYTES (XSTRING (Vx_resource_class))
2248 + STRING_BYTES (XSTRING (class))
2249 + (STRINGP (subclass)
2250 ? STRING_BYTES (XSTRING (subclass)) : 0)
2251 + 3);
2252
2253 /* Start with emacs.FRAMENAME for the name (the specific one)
2254 and with `Emacs' for the class key (the general one). */
2255 strcpy (name_key, XSTRING (Vx_resource_name)->data);
2256 strcpy (class_key, XSTRING (Vx_resource_class)->data);
2257
2258 strcat (class_key, ".");
2259 strcat (class_key, XSTRING (class)->data);
2260
2261 if (!NILP (component))
2262 {
2263 strcat (class_key, ".");
2264 strcat (class_key, XSTRING (subclass)->data);
2265
2266 strcat (name_key, ".");
2267 strcat (name_key, XSTRING (component)->data);
2268 }
2269
2270 strcat (name_key, ".");
2271 strcat (name_key, XSTRING (attribute)->data);
2272
2273 value = x_get_string_resource (dpyinfo->xrdb, name_key, class_key);
2274
2275 if (value != (char *) 0)
2276 return build_string (value);
2277 else
2278 return Qnil;
2279 }
2280
2281 /* Used when C code wants a resource value. */
2282
2283 char *
2284 x_get_resource_string (attribute, class)
2285 char *attribute, *class;
2286 {
2287 register char *value;
2288 char *name_key;
2289 char *class_key;
2290
2291 /* Allocate space for the components, the dots which separate them,
2292 and the final '\0'. */
2293 name_key = (char *) alloca (STRING_BYTES (XSTRING (Vinvocation_name))
2294 + strlen (attribute) + 2);
2295 class_key = (char *) alloca ((sizeof (EMACS_CLASS) - 1)
2296 + strlen (class) + 2);
2297
2298 sprintf (name_key, "%s.%s",
2299 XSTRING (Vinvocation_name)->data,
2300 attribute);
2301 sprintf (class_key, "%s.%s", EMACS_CLASS, class);
2302
2303 return x_get_string_resource (FRAME_X_DISPLAY_INFO (selected_frame)->xrdb,
2304 name_key, class_key);
2305 }
2306
2307 /* Types we might convert a resource string into. */
2308 enum resource_types
2309 {
2310 number, boolean, string, symbol
2311 };
2312
2313 /* Return the value of parameter PARAM.
2314
2315 First search ALIST, then Vdefault_frame_alist, then the X defaults
2316 database, using ATTRIBUTE as the attribute name and CLASS as its class.
2317
2318 Convert the resource to the type specified by desired_type.
2319
2320 If no default is specified, return Qunbound. If you call
2321 x_get_arg, make sure you deal with Qunbound in a reasonable way,
2322 and don't let it get stored in any Lisp-visible variables! */
2323
2324 static Lisp_Object
2325 x_get_arg (dpyinfo, alist, param, attribute, class, type)
2326 struct x_display_info *dpyinfo;
2327 Lisp_Object alist, param;
2328 char *attribute;
2329 char *class;
2330 enum resource_types type;
2331 {
2332 register Lisp_Object tem;
2333
2334 tem = Fassq (param, alist);
2335 if (EQ (tem, Qnil))
2336 tem = Fassq (param, Vdefault_frame_alist);
2337 if (EQ (tem, Qnil))
2338 {
2339
2340 if (attribute)
2341 {
2342 tem = display_x_get_resource (dpyinfo,
2343 build_string (attribute),
2344 build_string (class),
2345 Qnil, Qnil);
2346
2347 if (NILP (tem))
2348 return Qunbound;
2349
2350 switch (type)
2351 {
2352 case number:
2353 return make_number (atoi (XSTRING (tem)->data));
2354
2355 case boolean:
2356 tem = Fdowncase (tem);
2357 if (!strcmp (XSTRING (tem)->data, "on")
2358 || !strcmp (XSTRING (tem)->data, "true"))
2359 return Qt;
2360 else
2361 return Qnil;
2362
2363 case string:
2364 return tem;
2365
2366 case symbol:
2367 /* As a special case, we map the values `true' and `on'
2368 to Qt, and `false' and `off' to Qnil. */
2369 {
2370 Lisp_Object lower;
2371 lower = Fdowncase (tem);
2372 if (!strcmp (XSTRING (lower)->data, "on")
2373 || !strcmp (XSTRING (lower)->data, "true"))
2374 return Qt;
2375 else if (!strcmp (XSTRING (lower)->data, "off")
2376 || !strcmp (XSTRING (lower)->data, "false"))
2377 return Qnil;
2378 else
2379 return Fintern (tem, Qnil);
2380 }
2381
2382 default:
2383 abort ();
2384 }
2385 }
2386 else
2387 return Qunbound;
2388 }
2389 return Fcdr (tem);
2390 }
2391
2392 /* Like x_get_arg, but also record the value in f->param_alist. */
2393
2394 static Lisp_Object
2395 x_get_and_record_arg (f, alist, param, attribute, class, type)
2396 struct frame *f;
2397 Lisp_Object alist, param;
2398 char *attribute;
2399 char *class;
2400 enum resource_types type;
2401 {
2402 Lisp_Object value;
2403
2404 value = x_get_arg (FRAME_X_DISPLAY_INFO (f), alist, param,
2405 attribute, class, type);
2406 if (! NILP (value))
2407 store_frame_param (f, param, value);
2408
2409 return value;
2410 }
2411
2412 /* Record in frame F the specified or default value according to ALIST
2413 of the parameter named PROP (a Lisp symbol).
2414 If no value is specified for PROP, look for an X default for XPROP
2415 on the frame named NAME.
2416 If that is not found either, use the value DEFLT. */
2417
2418 static Lisp_Object
2419 x_default_parameter (f, alist, prop, deflt, xprop, xclass, type)
2420 struct frame *f;
2421 Lisp_Object alist;
2422 Lisp_Object prop;
2423 Lisp_Object deflt;
2424 char *xprop;
2425 char *xclass;
2426 enum resource_types type;
2427 {
2428 Lisp_Object tem;
2429
2430 tem = x_get_arg (FRAME_X_DISPLAY_INFO (f), alist, prop, xprop, xclass, type);
2431 if (EQ (tem, Qunbound))
2432 tem = deflt;
2433 x_set_frame_parameters (f, Fcons (Fcons (prop, tem), Qnil));
2434 return tem;
2435 }
2436 \f
2437 DEFUN ("x-parse-geometry", Fx_parse_geometry, Sx_parse_geometry, 1, 1, 0,
2438 "Parse an X-style geometry string STRING.\n\
2439 Returns an alist of the form ((top . TOP), (left . LEFT) ... ).\n\
2440 The properties returned may include `top', `left', `height', and `width'.\n\
2441 The value of `left' or `top' may be an integer,\n\
2442 or a list (+ N) meaning N pixels relative to top/left corner,\n\
2443 or a list (- N) meaning -N pixels relative to bottom/right corner.")
2444 (string)
2445 Lisp_Object string;
2446 {
2447 int geometry, x, y;
2448 unsigned int width, height;
2449 Lisp_Object result;
2450
2451 CHECK_STRING (string, 0);
2452
2453 geometry = XParseGeometry ((char *) XSTRING (string)->data,
2454 &x, &y, &width, &height);
2455
2456 #if 0
2457 if (!!(geometry & XValue) != !!(geometry & YValue))
2458 error ("Must specify both x and y position, or neither");
2459 #endif
2460
2461 result = Qnil;
2462 if (geometry & XValue)
2463 {
2464 Lisp_Object element;
2465
2466 if (x >= 0 && (geometry & XNegative))
2467 element = Fcons (Qleft, Fcons (Qminus, Fcons (make_number (-x), Qnil)));
2468 else if (x < 0 && ! (geometry & XNegative))
2469 element = Fcons (Qleft, Fcons (Qplus, Fcons (make_number (x), Qnil)));
2470 else
2471 element = Fcons (Qleft, make_number (x));
2472 result = Fcons (element, result);
2473 }
2474
2475 if (geometry & YValue)
2476 {
2477 Lisp_Object element;
2478
2479 if (y >= 0 && (geometry & YNegative))
2480 element = Fcons (Qtop, Fcons (Qminus, Fcons (make_number (-y), Qnil)));
2481 else if (y < 0 && ! (geometry & YNegative))
2482 element = Fcons (Qtop, Fcons (Qplus, Fcons (make_number (y), Qnil)));
2483 else
2484 element = Fcons (Qtop, make_number (y));
2485 result = Fcons (element, result);
2486 }
2487
2488 if (geometry & WidthValue)
2489 result = Fcons (Fcons (Qwidth, make_number (width)), result);
2490 if (geometry & HeightValue)
2491 result = Fcons (Fcons (Qheight, make_number (height)), result);
2492
2493 return result;
2494 }
2495
2496 /* Calculate the desired size and position of this window,
2497 and return the flags saying which aspects were specified.
2498
2499 This function does not make the coordinates positive. */
2500
2501 #define DEFAULT_ROWS 40
2502 #define DEFAULT_COLS 80
2503
2504 static int
2505 x_figure_window_size (f, parms)
2506 struct frame *f;
2507 Lisp_Object parms;
2508 {
2509 register Lisp_Object tem0, tem1, tem2;
2510 int height, width, left, top;
2511 register int geometry;
2512 long window_prompting = 0;
2513 struct x_display_info *dpyinfo = FRAME_X_DISPLAY_INFO (f);
2514
2515 /* Default values if we fall through.
2516 Actually, if that happens we should get
2517 window manager prompting. */
2518 SET_FRAME_WIDTH (f, DEFAULT_COLS);
2519 f->height = DEFAULT_ROWS;
2520 /* Window managers expect that if program-specified
2521 positions are not (0,0), they're intentional, not defaults. */
2522 f->output_data.x->top_pos = 0;
2523 f->output_data.x->left_pos = 0;
2524
2525 tem0 = x_get_arg (dpyinfo, parms, Qheight, 0, 0, number);
2526 tem1 = x_get_arg (dpyinfo, parms, Qwidth, 0, 0, number);
2527 tem2 = x_get_arg (dpyinfo, parms, Quser_size, 0, 0, number);
2528 if (! EQ (tem0, Qunbound) || ! EQ (tem1, Qunbound))
2529 {
2530 if (!EQ (tem0, Qunbound))
2531 {
2532 CHECK_NUMBER (tem0, 0);
2533 f->height = XINT (tem0);
2534 }
2535 if (!EQ (tem1, Qunbound))
2536 {
2537 CHECK_NUMBER (tem1, 0);
2538 SET_FRAME_WIDTH (f, XINT (tem1));
2539 }
2540 if (!NILP (tem2) && !EQ (tem2, Qunbound))
2541 window_prompting |= USSize;
2542 else
2543 window_prompting |= PSize;
2544 }
2545
2546 f->output_data.x->vertical_scroll_bar_extra
2547 = (!FRAME_HAS_VERTICAL_SCROLL_BARS (f)
2548 ? 0
2549 : FRAME_SCROLL_BAR_PIXEL_WIDTH (f) > 0
2550 ? FRAME_SCROLL_BAR_PIXEL_WIDTH (f)
2551 : (FRAME_SCROLL_BAR_COLS (f) * FONT_WIDTH (f->output_data.x->font)));
2552 f->output_data.x->pixel_width = CHAR_TO_PIXEL_WIDTH (f, f->width);
2553 f->output_data.x->pixel_height = CHAR_TO_PIXEL_HEIGHT (f, f->height);
2554
2555 tem0 = x_get_arg (dpyinfo, parms, Qtop, 0, 0, number);
2556 tem1 = x_get_arg (dpyinfo, parms, Qleft, 0, 0, number);
2557 tem2 = x_get_arg (dpyinfo, parms, Quser_position, 0, 0, number);
2558 if (! EQ (tem0, Qunbound) || ! EQ (tem1, Qunbound))
2559 {
2560 if (EQ (tem0, Qminus))
2561 {
2562 f->output_data.x->top_pos = 0;
2563 window_prompting |= YNegative;
2564 }
2565 else if (CONSP (tem0) && EQ (XCONS (tem0)->car, Qminus)
2566 && CONSP (XCONS (tem0)->cdr)
2567 && INTEGERP (XCONS (XCONS (tem0)->cdr)->car))
2568 {
2569 f->output_data.x->top_pos = - XINT (XCONS (XCONS (tem0)->cdr)->car);
2570 window_prompting |= YNegative;
2571 }
2572 else if (CONSP (tem0) && EQ (XCONS (tem0)->car, Qplus)
2573 && CONSP (XCONS (tem0)->cdr)
2574 && INTEGERP (XCONS (XCONS (tem0)->cdr)->car))
2575 {
2576 f->output_data.x->top_pos = XINT (XCONS (XCONS (tem0)->cdr)->car);
2577 }
2578 else if (EQ (tem0, Qunbound))
2579 f->output_data.x->top_pos = 0;
2580 else
2581 {
2582 CHECK_NUMBER (tem0, 0);
2583 f->output_data.x->top_pos = XINT (tem0);
2584 if (f->output_data.x->top_pos < 0)
2585 window_prompting |= YNegative;
2586 }
2587
2588 if (EQ (tem1, Qminus))
2589 {
2590 f->output_data.x->left_pos = 0;
2591 window_prompting |= XNegative;
2592 }
2593 else if (CONSP (tem1) && EQ (XCONS (tem1)->car, Qminus)
2594 && CONSP (XCONS (tem1)->cdr)
2595 && INTEGERP (XCONS (XCONS (tem1)->cdr)->car))
2596 {
2597 f->output_data.x->left_pos = - XINT (XCONS (XCONS (tem1)->cdr)->car);
2598 window_prompting |= XNegative;
2599 }
2600 else if (CONSP (tem1) && EQ (XCONS (tem1)->car, Qplus)
2601 && CONSP (XCONS (tem1)->cdr)
2602 && INTEGERP (XCONS (XCONS (tem1)->cdr)->car))
2603 {
2604 f->output_data.x->left_pos = XINT (XCONS (XCONS (tem1)->cdr)->car);
2605 }
2606 else if (EQ (tem1, Qunbound))
2607 f->output_data.x->left_pos = 0;
2608 else
2609 {
2610 CHECK_NUMBER (tem1, 0);
2611 f->output_data.x->left_pos = XINT (tem1);
2612 if (f->output_data.x->left_pos < 0)
2613 window_prompting |= XNegative;
2614 }
2615
2616 if (!NILP (tem2) && ! EQ (tem2, Qunbound))
2617 window_prompting |= USPosition;
2618 else
2619 window_prompting |= PPosition;
2620 }
2621
2622 return window_prompting;
2623 }
2624
2625 #if !defined (HAVE_X11R4) && !defined (HAVE_XSETWMPROTOCOLS)
2626
2627 Status
2628 XSetWMProtocols (dpy, w, protocols, count)
2629 Display *dpy;
2630 Window w;
2631 Atom *protocols;
2632 int count;
2633 {
2634 Atom prop;
2635 prop = XInternAtom (dpy, "WM_PROTOCOLS", False);
2636 if (prop == None) return False;
2637 XChangeProperty (dpy, w, prop, XA_ATOM, 32, PropModeReplace,
2638 (unsigned char *) protocols, count);
2639 return True;
2640 }
2641 #endif /* not HAVE_X11R4 && not HAVE_XSETWMPROTOCOLS */
2642 \f
2643 #ifdef USE_X_TOOLKIT
2644
2645 /* If the WM_PROTOCOLS property does not already contain WM_TAKE_FOCUS,
2646 WM_DELETE_WINDOW, and WM_SAVE_YOURSELF, then add them. (They may
2647 already be present because of the toolkit (Motif adds some of them,
2648 for example, but Xt doesn't). */
2649
2650 static void
2651 hack_wm_protocols (f, widget)
2652 FRAME_PTR f;
2653 Widget widget;
2654 {
2655 Display *dpy = XtDisplay (widget);
2656 Window w = XtWindow (widget);
2657 int need_delete = 1;
2658 int need_focus = 1;
2659 int need_save = 1;
2660
2661 BLOCK_INPUT;
2662 {
2663 Atom type, *atoms = 0;
2664 int format = 0;
2665 unsigned long nitems = 0;
2666 unsigned long bytes_after;
2667
2668 if ((XGetWindowProperty (dpy, w,
2669 FRAME_X_DISPLAY_INFO (f)->Xatom_wm_protocols,
2670 (long)0, (long)100, False, XA_ATOM,
2671 &type, &format, &nitems, &bytes_after,
2672 (unsigned char **) &atoms)
2673 == Success)
2674 && format == 32 && type == XA_ATOM)
2675 while (nitems > 0)
2676 {
2677 nitems--;
2678 if (atoms[nitems] == FRAME_X_DISPLAY_INFO (f)->Xatom_wm_delete_window)
2679 need_delete = 0;
2680 else if (atoms[nitems] == FRAME_X_DISPLAY_INFO (f)->Xatom_wm_take_focus)
2681 need_focus = 0;
2682 else if (atoms[nitems] == FRAME_X_DISPLAY_INFO (f)->Xatom_wm_save_yourself)
2683 need_save = 0;
2684 }
2685 if (atoms) XFree ((char *) atoms);
2686 }
2687 {
2688 Atom props [10];
2689 int count = 0;
2690 if (need_delete)
2691 props[count++] = FRAME_X_DISPLAY_INFO (f)->Xatom_wm_delete_window;
2692 if (need_focus)
2693 props[count++] = FRAME_X_DISPLAY_INFO (f)->Xatom_wm_take_focus;
2694 if (need_save)
2695 props[count++] = FRAME_X_DISPLAY_INFO (f)->Xatom_wm_save_yourself;
2696 if (count)
2697 XChangeProperty (dpy, w, FRAME_X_DISPLAY_INFO (f)->Xatom_wm_protocols,
2698 XA_ATOM, 32, PropModeAppend,
2699 (unsigned char *) props, count);
2700 }
2701 UNBLOCK_INPUT;
2702 }
2703 #endif
2704 \f
2705 #ifdef USE_X_TOOLKIT
2706
2707 /* Create and set up the X widget for frame F. */
2708
2709 static void
2710 x_window (f, window_prompting, minibuffer_only)
2711 struct frame *f;
2712 long window_prompting;
2713 int minibuffer_only;
2714 {
2715 XClassHint class_hints;
2716 XSetWindowAttributes attributes;
2717 unsigned long attribute_mask;
2718
2719 Widget shell_widget;
2720 Widget pane_widget;
2721 Widget frame_widget;
2722 Arg al [25];
2723 int ac;
2724
2725 BLOCK_INPUT;
2726
2727 /* Use the resource name as the top-level widget name
2728 for looking up resources. Make a non-Lisp copy
2729 for the window manager, so GC relocation won't bother it.
2730
2731 Elsewhere we specify the window name for the window manager. */
2732
2733 {
2734 char *str = (char *) XSTRING (Vx_resource_name)->data;
2735 f->namebuf = (char *) xmalloc (strlen (str) + 1);
2736 strcpy (f->namebuf, str);
2737 }
2738
2739 ac = 0;
2740 XtSetArg (al[ac], XtNallowShellResize, 1); ac++;
2741 XtSetArg (al[ac], XtNinput, 1); ac++;
2742 XtSetArg (al[ac], XtNmappedWhenManaged, 0); ac++;
2743 XtSetArg (al[ac], XtNborderWidth, f->output_data.x->border_width); ac++;
2744 shell_widget = XtAppCreateShell (f->namebuf, EMACS_CLASS,
2745 applicationShellWidgetClass,
2746 FRAME_X_DISPLAY (f), al, ac);
2747
2748 f->output_data.x->widget = shell_widget;
2749 /* maybe_set_screen_title_format (shell_widget); */
2750
2751 pane_widget = lw_create_widget ("main", "pane", widget_id_tick++,
2752 (widget_value *) NULL,
2753 shell_widget, False,
2754 (lw_callback) NULL,
2755 (lw_callback) NULL,
2756 (lw_callback) NULL);
2757
2758 f->output_data.x->column_widget = pane_widget;
2759
2760 /* mappedWhenManaged to false tells to the paned window to not map/unmap
2761 the emacs screen when changing menubar. This reduces flickering. */
2762
2763 ac = 0;
2764 XtSetArg (al[ac], XtNmappedWhenManaged, 0); ac++;
2765 XtSetArg (al[ac], XtNshowGrip, 0); ac++;
2766 XtSetArg (al[ac], XtNallowResize, 1); ac++;
2767 XtSetArg (al[ac], XtNresizeToPreferred, 1); ac++;
2768 XtSetArg (al[ac], XtNemacsFrame, f); ac++;
2769 frame_widget = XtCreateWidget (f->namebuf,
2770 emacsFrameClass,
2771 pane_widget, al, ac);
2772
2773 f->output_data.x->edit_widget = frame_widget;
2774
2775 XtManageChild (frame_widget);
2776
2777 /* Do some needed geometry management. */
2778 {
2779 int len;
2780 char *tem, shell_position[32];
2781 Arg al[2];
2782 int ac = 0;
2783 int extra_borders = 0;
2784 int menubar_size
2785 = (f->output_data.x->menubar_widget
2786 ? (f->output_data.x->menubar_widget->core.height
2787 + f->output_data.x->menubar_widget->core.border_width)
2788 : 0);
2789 extern char *lwlib_toolkit_type;
2790
2791 #if 0 /* Experimentally, we now get the right results
2792 for -geometry -0-0 without this. 24 Aug 96, rms. */
2793 if (FRAME_EXTERNAL_MENU_BAR (f))
2794 {
2795 Dimension ibw = 0;
2796 XtVaGetValues (pane_widget, XtNinternalBorderWidth, &ibw, NULL);
2797 menubar_size += ibw;
2798 }
2799 #endif
2800
2801 f->output_data.x->menubar_height = menubar_size;
2802
2803 #ifndef USE_LUCID
2804 /* Motif seems to need this amount added to the sizes
2805 specified for the shell widget. The Athena/Lucid widgets don't.
2806 Both conclusions reached experimentally. -- rms. */
2807 XtVaGetValues (f->output_data.x->edit_widget, XtNinternalBorderWidth,
2808 &extra_borders, NULL);
2809 extra_borders *= 2;
2810 #endif
2811
2812 /* Convert our geometry parameters into a geometry string
2813 and specify it.
2814 Note that we do not specify here whether the position
2815 is a user-specified or program-specified one.
2816 We pass that information later, in x_wm_set_size_hints. */
2817 {
2818 int left = f->output_data.x->left_pos;
2819 int xneg = window_prompting & XNegative;
2820 int top = f->output_data.x->top_pos;
2821 int yneg = window_prompting & YNegative;
2822 if (xneg)
2823 left = -left;
2824 if (yneg)
2825 top = -top;
2826
2827 if (window_prompting & USPosition)
2828 sprintf (shell_position, "=%dx%d%c%d%c%d",
2829 PIXEL_WIDTH (f) + extra_borders,
2830 PIXEL_HEIGHT (f) + menubar_size + extra_borders,
2831 (xneg ? '-' : '+'), left,
2832 (yneg ? '-' : '+'), top);
2833 else
2834 sprintf (shell_position, "=%dx%d",
2835 PIXEL_WIDTH (f) + extra_borders,
2836 PIXEL_HEIGHT (f) + menubar_size + extra_borders);
2837 }
2838
2839 len = strlen (shell_position) + 1;
2840 /* We don't free this because we don't know whether
2841 it is safe to free it while the frame exists.
2842 It isn't worth the trouble of arranging to free it
2843 when the frame is deleted. */
2844 tem = (char *) xmalloc (len);
2845 strncpy (tem, shell_position, len);
2846 XtSetArg (al[ac], XtNgeometry, tem); ac++;
2847 XtSetValues (shell_widget, al, ac);
2848 }
2849
2850 XtManageChild (pane_widget);
2851 XtRealizeWidget (shell_widget);
2852
2853 FRAME_X_WINDOW (f) = XtWindow (frame_widget);
2854
2855 validate_x_resource_name ();
2856
2857 class_hints.res_name = (char *) XSTRING (Vx_resource_name)->data;
2858 class_hints.res_class = (char *) XSTRING (Vx_resource_class)->data;
2859 XSetClassHint (FRAME_X_DISPLAY (f), XtWindow (shell_widget), &class_hints);
2860
2861 #ifdef HAVE_X_I18N
2862 #ifndef X_I18N_INHIBITED
2863 {
2864 XIM xim;
2865 XIC xic = NULL;
2866
2867 xim = XOpenIM (FRAME_X_DISPLAY (f), NULL, NULL, NULL);
2868
2869 if (xim)
2870 {
2871 xic = XCreateIC (xim,
2872 XNInputStyle, XIMPreeditNothing | XIMStatusNothing,
2873 XNClientWindow, FRAME_X_WINDOW(f),
2874 XNFocusWindow, FRAME_X_WINDOW(f),
2875 NULL);
2876
2877 if (xic == 0)
2878 {
2879 XCloseIM (xim);
2880 xim = NULL;
2881 }
2882 }
2883 FRAME_XIM (f) = xim;
2884 FRAME_XIC (f) = xic;
2885 }
2886 #else /* X_I18N_INHIBITED */
2887 FRAME_XIM (f) = 0;
2888 FRAME_XIC (f) = 0;
2889 #endif /* X_I18N_INHIBITED */
2890 #endif /* HAVE_X_I18N */
2891
2892 f->output_data.x->wm_hints.input = True;
2893 f->output_data.x->wm_hints.flags |= InputHint;
2894 XSetWMHints (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
2895 &f->output_data.x->wm_hints);
2896
2897 hack_wm_protocols (f, shell_widget);
2898
2899 #ifdef HACK_EDITRES
2900 XtAddEventHandler (shell_widget, 0, True, _XEditResCheckMessages, 0);
2901 #endif
2902
2903 /* Do a stupid property change to force the server to generate a
2904 propertyNotify event so that the event_stream server timestamp will
2905 be initialized to something relevant to the time we created the window.
2906 */
2907 XChangeProperty (XtDisplay (frame_widget), XtWindow (frame_widget),
2908 FRAME_X_DISPLAY_INFO (f)->Xatom_wm_protocols,
2909 XA_ATOM, 32, PropModeAppend,
2910 (unsigned char*) NULL, 0);
2911
2912 /* Make all the standard events reach the Emacs frame. */
2913 attributes.event_mask = STANDARD_EVENT_SET;
2914 attribute_mask = CWEventMask;
2915 XChangeWindowAttributes (XtDisplay (shell_widget), XtWindow (shell_widget),
2916 attribute_mask, &attributes);
2917
2918 XtMapWidget (frame_widget);
2919
2920 /* x_set_name normally ignores requests to set the name if the
2921 requested name is the same as the current name. This is the one
2922 place where that assumption isn't correct; f->name is set, but
2923 the X server hasn't been told. */
2924 {
2925 Lisp_Object name;
2926 int explicit = f->explicit_name;
2927
2928 f->explicit_name = 0;
2929 name = f->name;
2930 f->name = Qnil;
2931 x_set_name (f, name, explicit);
2932 }
2933
2934 XDefineCursor (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
2935 f->output_data.x->text_cursor);
2936
2937 UNBLOCK_INPUT;
2938
2939 if (!minibuffer_only && FRAME_EXTERNAL_MENU_BAR (f))
2940 initialize_frame_menubar (f);
2941 lw_set_main_areas (pane_widget, f->output_data.x->menubar_widget, frame_widget);
2942
2943 if (FRAME_X_WINDOW (f) == 0)
2944 error ("Unable to create window");
2945 }
2946
2947 #else /* not USE_X_TOOLKIT */
2948
2949 /* Create and set up the X window for frame F. */
2950
2951 void
2952 x_window (f)
2953 struct frame *f;
2954
2955 {
2956 XClassHint class_hints;
2957 XSetWindowAttributes attributes;
2958 unsigned long attribute_mask;
2959
2960 attributes.background_pixel = f->output_data.x->background_pixel;
2961 attributes.border_pixel = f->output_data.x->border_pixel;
2962 attributes.bit_gravity = StaticGravity;
2963 attributes.backing_store = NotUseful;
2964 attributes.save_under = True;
2965 attributes.event_mask = STANDARD_EVENT_SET;
2966 attribute_mask = (CWBackPixel | CWBorderPixel | CWBitGravity
2967 #if 0
2968 | CWBackingStore | CWSaveUnder
2969 #endif
2970 | CWEventMask);
2971
2972 BLOCK_INPUT;
2973 FRAME_X_WINDOW (f)
2974 = XCreateWindow (FRAME_X_DISPLAY (f),
2975 f->output_data.x->parent_desc,
2976 f->output_data.x->left_pos,
2977 f->output_data.x->top_pos,
2978 PIXEL_WIDTH (f), PIXEL_HEIGHT (f),
2979 f->output_data.x->border_width,
2980 CopyFromParent, /* depth */
2981 InputOutput, /* class */
2982 FRAME_X_DISPLAY_INFO (f)->visual,
2983 attribute_mask, &attributes);
2984 #ifdef HAVE_X_I18N
2985 #ifndef X_I18N_INHIBITED
2986 {
2987 XIM xim;
2988 XIC xic = NULL;
2989
2990 xim = XOpenIM (FRAME_X_DISPLAY(f), NULL, NULL, NULL);
2991
2992 if (xim)
2993 {
2994 xic = XCreateIC (xim,
2995 XNInputStyle, XIMPreeditNothing | XIMStatusNothing,
2996 XNClientWindow, FRAME_X_WINDOW(f),
2997 XNFocusWindow, FRAME_X_WINDOW(f),
2998 NULL);
2999
3000 if (!xic)
3001 {
3002 XCloseIM (xim);
3003 xim = NULL;
3004 }
3005 }
3006
3007 FRAME_XIM (f) = xim;
3008 FRAME_XIC (f) = xic;
3009 }
3010 #else /* X_I18N_INHIBITED */
3011 FRAME_XIM (f) = 0;
3012 FRAME_XIC (f) = 0;
3013 #endif /* X_I18N_INHIBITED */
3014 #endif /* HAVE_X_I18N */
3015
3016 validate_x_resource_name ();
3017
3018 class_hints.res_name = (char *) XSTRING (Vx_resource_name)->data;
3019 class_hints.res_class = (char *) XSTRING (Vx_resource_class)->data;
3020 XSetClassHint (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f), &class_hints);
3021
3022 /* The menubar is part of the ordinary display;
3023 it does not count in addition to the height of the window. */
3024 f->output_data.x->menubar_height = 0;
3025
3026 /* This indicates that we use the "Passive Input" input model.
3027 Unless we do this, we don't get the Focus{In,Out} events that we
3028 need to draw the cursor correctly. Accursed bureaucrats.
3029 XWhipsAndChains (FRAME_X_DISPLAY (f), IronMaiden, &TheRack); */
3030
3031 f->output_data.x->wm_hints.input = True;
3032 f->output_data.x->wm_hints.flags |= InputHint;
3033 XSetWMHints (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
3034 &f->output_data.x->wm_hints);
3035 f->output_data.x->wm_hints.icon_pixmap = None;
3036
3037 /* Request "save yourself" and "delete window" commands from wm. */
3038 {
3039 Atom protocols[2];
3040 protocols[0] = FRAME_X_DISPLAY_INFO (f)->Xatom_wm_delete_window;
3041 protocols[1] = FRAME_X_DISPLAY_INFO (f)->Xatom_wm_save_yourself;
3042 XSetWMProtocols (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f), protocols, 2);
3043 }
3044
3045 /* x_set_name normally ignores requests to set the name if the
3046 requested name is the same as the current name. This is the one
3047 place where that assumption isn't correct; f->name is set, but
3048 the X server hasn't been told. */
3049 {
3050 Lisp_Object name;
3051 int explicit = f->explicit_name;
3052
3053 f->explicit_name = 0;
3054 name = f->name;
3055 f->name = Qnil;
3056 x_set_name (f, name, explicit);
3057 }
3058
3059 XDefineCursor (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
3060 f->output_data.x->text_cursor);
3061
3062 UNBLOCK_INPUT;
3063
3064 if (FRAME_X_WINDOW (f) == 0)
3065 error ("Unable to create window");
3066 }
3067
3068 #endif /* not USE_X_TOOLKIT */
3069
3070 /* Handle the icon stuff for this window. Perhaps later we might
3071 want an x_set_icon_position which can be called interactively as
3072 well. */
3073
3074 static void
3075 x_icon (f, parms)
3076 struct frame *f;
3077 Lisp_Object parms;
3078 {
3079 Lisp_Object icon_x, icon_y;
3080 struct x_display_info *dpyinfo = FRAME_X_DISPLAY_INFO (f);
3081
3082 /* Set the position of the icon. Note that twm groups all
3083 icons in an icon window. */
3084 icon_x = x_get_and_record_arg (f, parms, Qicon_left, 0, 0, number);
3085 icon_y = x_get_and_record_arg (f, parms, Qicon_top, 0, 0, number);
3086 if (!EQ (icon_x, Qunbound) && !EQ (icon_y, Qunbound))
3087 {
3088 CHECK_NUMBER (icon_x, 0);
3089 CHECK_NUMBER (icon_y, 0);
3090 }
3091 else if (!EQ (icon_x, Qunbound) || !EQ (icon_y, Qunbound))
3092 error ("Both left and top icon corners of icon must be specified");
3093
3094 BLOCK_INPUT;
3095
3096 if (! EQ (icon_x, Qunbound))
3097 x_wm_set_icon_position (f, XINT (icon_x), XINT (icon_y));
3098
3099 /* Start up iconic or window? */
3100 x_wm_set_window_state
3101 (f, (EQ (x_get_arg (dpyinfo, parms, Qvisibility, 0, 0, symbol), Qicon)
3102 ? IconicState
3103 : NormalState));
3104
3105 x_text_icon (f, (char *) XSTRING ((!NILP (f->icon_name)
3106 ? f->icon_name
3107 : f->name))->data);
3108
3109 UNBLOCK_INPUT;
3110 }
3111
3112 /* Make the GC's needed for this window, setting the
3113 background, border and mouse colors; also create the
3114 mouse cursor and the gray border tile. */
3115
3116 static char cursor_bits[] =
3117 {
3118 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
3119 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
3120 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
3121 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00
3122 };
3123
3124 static void
3125 x_make_gc (f)
3126 struct frame *f;
3127 {
3128 XGCValues gc_values;
3129 GC temp_gc;
3130 XImage tileimage;
3131
3132 BLOCK_INPUT;
3133
3134 /* Create the GC's of this frame.
3135 Note that many default values are used. */
3136
3137 /* Normal video */
3138 gc_values.font = f->output_data.x->font->fid;
3139 gc_values.foreground = f->output_data.x->foreground_pixel;
3140 gc_values.background = f->output_data.x->background_pixel;
3141 gc_values.line_width = 0; /* Means 1 using fast algorithm. */
3142 f->output_data.x->normal_gc = XCreateGC (FRAME_X_DISPLAY (f),
3143 FRAME_X_WINDOW (f),
3144 GCLineWidth | GCFont
3145 | GCForeground | GCBackground,
3146 &gc_values);
3147
3148 /* Reverse video style. */
3149 gc_values.foreground = f->output_data.x->background_pixel;
3150 gc_values.background = f->output_data.x->foreground_pixel;
3151 f->output_data.x->reverse_gc = XCreateGC (FRAME_X_DISPLAY (f),
3152 FRAME_X_WINDOW (f),
3153 GCFont | GCForeground | GCBackground
3154 | GCLineWidth,
3155 &gc_values);
3156
3157 /* Cursor has cursor-color background, background-color foreground. */
3158 gc_values.foreground = f->output_data.x->background_pixel;
3159 gc_values.background = f->output_data.x->cursor_pixel;
3160 gc_values.fill_style = FillOpaqueStippled;
3161 gc_values.stipple
3162 = XCreateBitmapFromData (FRAME_X_DISPLAY (f),
3163 FRAME_X_DISPLAY_INFO (f)->root_window,
3164 cursor_bits, 16, 16);
3165 f->output_data.x->cursor_gc
3166 = XCreateGC (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
3167 (GCFont | GCForeground | GCBackground
3168 | GCFillStyle | GCStipple | GCLineWidth),
3169 &gc_values);
3170
3171 /* Create the gray border tile used when the pointer is not in
3172 the frame. Since this depends on the frame's pixel values,
3173 this must be done on a per-frame basis. */
3174 f->output_data.x->border_tile
3175 = (XCreatePixmapFromBitmapData
3176 (FRAME_X_DISPLAY (f), FRAME_X_DISPLAY_INFO (f)->root_window,
3177 gray_bits, gray_width, gray_height,
3178 f->output_data.x->foreground_pixel,
3179 f->output_data.x->background_pixel,
3180 DefaultDepth (FRAME_X_DISPLAY (f),
3181 XScreenNumberOfScreen (FRAME_X_SCREEN (f)))));
3182
3183 UNBLOCK_INPUT;
3184 }
3185
3186 DEFUN ("x-create-frame", Fx_create_frame, Sx_create_frame,
3187 1, 1, 0,
3188 "Make a new X window, which is called a \"frame\" in Emacs terms.\n\
3189 Returns an Emacs frame object.\n\
3190 ALIST is an alist of frame parameters.\n\
3191 If the parameters specify that the frame should not have a minibuffer,\n\
3192 and do not specify a specific minibuffer window to use,\n\
3193 then `default-minibuffer-frame' must be a frame whose minibuffer can\n\
3194 be shared by the new frame.\n\
3195 \n\
3196 This function is an internal primitive--use `make-frame' instead.")
3197 (parms)
3198 Lisp_Object parms;
3199 {
3200 struct frame *f;
3201 Lisp_Object frame, tem;
3202 Lisp_Object name;
3203 int minibuffer_only = 0;
3204 long window_prompting = 0;
3205 int width, height;
3206 int count = specpdl_ptr - specpdl;
3207 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
3208 Lisp_Object display;
3209 struct x_display_info *dpyinfo;
3210 Lisp_Object parent;
3211 struct kboard *kb;
3212
3213 check_x ();
3214
3215 /* Use this general default value to start with
3216 until we know if this frame has a specified name. */
3217 Vx_resource_name = Vinvocation_name;
3218
3219 display = x_get_arg (dpyinfo, parms, Qdisplay, 0, 0, string);
3220 if (EQ (display, Qunbound))
3221 display = Qnil;
3222 dpyinfo = check_x_display_info (display);
3223 #ifdef MULTI_KBOARD
3224 kb = dpyinfo->kboard;
3225 #else
3226 kb = &the_only_kboard;
3227 #endif
3228
3229 name = x_get_arg (dpyinfo, parms, Qname, "name", "Name", string);
3230 if (!STRINGP (name)
3231 && ! EQ (name, Qunbound)
3232 && ! NILP (name))
3233 error ("Invalid frame name--not a string or nil");
3234
3235 if (STRINGP (name))
3236 Vx_resource_name = name;
3237
3238 /* See if parent window is specified. */
3239 parent = x_get_arg (dpyinfo, parms, Qparent_id, NULL, NULL, number);
3240 if (EQ (parent, Qunbound))
3241 parent = Qnil;
3242 if (! NILP (parent))
3243 CHECK_NUMBER (parent, 0);
3244
3245 /* make_frame_without_minibuffer can run Lisp code and garbage collect. */
3246 /* No need to protect DISPLAY because that's not used after passing
3247 it to make_frame_without_minibuffer. */
3248 frame = Qnil;
3249 GCPRO4 (parms, parent, name, frame);
3250 tem = x_get_arg (dpyinfo, parms, Qminibuffer, "minibuffer", "Minibuffer", symbol);
3251 if (EQ (tem, Qnone) || NILP (tem))
3252 f = make_frame_without_minibuffer (Qnil, kb, display);
3253 else if (EQ (tem, Qonly))
3254 {
3255 f = make_minibuffer_frame ();
3256 minibuffer_only = 1;
3257 }
3258 else if (WINDOWP (tem))
3259 f = make_frame_without_minibuffer (tem, kb, display);
3260 else
3261 f = make_frame (1);
3262
3263 XSETFRAME (frame, f);
3264
3265 /* Note that X Windows does support scroll bars. */
3266 FRAME_CAN_HAVE_SCROLL_BARS (f) = 1;
3267
3268 f->output_method = output_x_window;
3269 f->output_data.x = (struct x_output *) xmalloc (sizeof (struct x_output));
3270 bzero (f->output_data.x, sizeof (struct x_output));
3271 f->output_data.x->icon_bitmap = -1;
3272 f->output_data.x->fontset = -1;
3273
3274 f->icon_name
3275 = x_get_arg (dpyinfo, parms, Qicon_name, "iconName", "Title", string);
3276 if (! STRINGP (f->icon_name))
3277 f->icon_name = Qnil;
3278
3279 FRAME_X_DISPLAY_INFO (f) = dpyinfo;
3280 #ifdef MULTI_KBOARD
3281 FRAME_KBOARD (f) = kb;
3282 #endif
3283
3284 /* Specify the parent under which to make this X window. */
3285
3286 if (!NILP (parent))
3287 {
3288 f->output_data.x->parent_desc = (Window) XFASTINT (parent);
3289 f->output_data.x->explicit_parent = 1;
3290 }
3291 else
3292 {
3293 f->output_data.x->parent_desc = FRAME_X_DISPLAY_INFO (f)->root_window;
3294 f->output_data.x->explicit_parent = 0;
3295 }
3296
3297 /* Note that the frame has no physical cursor right now. */
3298 f->phys_cursor_x = -1;
3299
3300 /* Set the name; the functions to which we pass f expect the name to
3301 be set. */
3302 if (EQ (name, Qunbound) || NILP (name))
3303 {
3304 f->name = build_string (dpyinfo->x_id_name);
3305 f->explicit_name = 0;
3306 }
3307 else
3308 {
3309 f->name = name;
3310 f->explicit_name = 1;
3311 /* use the frame's title when getting resources for this frame. */
3312 specbind (Qx_resource_name, name);
3313 }
3314
3315 /* Create fontsets from `global_fontset_alist' before handling fonts. */
3316 for (tem = Vglobal_fontset_alist; CONSP (tem); tem = XCONS (tem)->cdr)
3317 fs_register_fontset (f, XCONS (tem)->car);
3318
3319 /* Extract the window parameters from the supplied values
3320 that are needed to determine window geometry. */
3321 {
3322 Lisp_Object font;
3323
3324 font = x_get_arg (dpyinfo, parms, Qfont, "font", "Font", string);
3325
3326 BLOCK_INPUT;
3327 /* First, try whatever font the caller has specified. */
3328 if (STRINGP (font))
3329 {
3330 tem = Fquery_fontset (font, Qnil);
3331 if (STRINGP (tem))
3332 font = x_new_fontset (f, XSTRING (tem)->data);
3333 else
3334 font = x_new_font (f, XSTRING (font)->data);
3335 }
3336 /* Try out a font which we hope has bold and italic variations. */
3337 if (!STRINGP (font))
3338 font = x_new_font (f, "-misc-fixed-medium-r-normal-*-*-140-*-*-c-*-iso8859-1");
3339 if (! STRINGP (font))
3340 font = x_new_font (f, "-*-*-medium-r-normal-*-*-140-*-*-c-*-iso8859-1");
3341 if (! STRINGP (font))
3342 /* This was formerly the first thing tried, but it finds too many fonts
3343 and takes too long. */
3344 font = x_new_font (f, "-*-*-medium-r-*-*-*-*-*-*-c-*-iso8859-1");
3345 /* If those didn't work, look for something which will at least work. */
3346 if (! STRINGP (font))
3347 font = x_new_font (f, "-*-fixed-*-*-*-*-*-140-*-*-c-*-iso8859-1");
3348 UNBLOCK_INPUT;
3349 if (! STRINGP (font))
3350 font = build_string ("fixed");
3351
3352 x_default_parameter (f, parms, Qfont, font,
3353 "font", "Font", string);
3354 }
3355
3356 #ifdef USE_LUCID
3357 /* Prevent lwlib/xlwmenu.c from crashing because of a bug
3358 whereby it fails to get any font. */
3359 xlwmenu_default_font = f->output_data.x->font;
3360 #endif
3361
3362 x_default_parameter (f, parms, Qborder_width, make_number (2),
3363 "borderWidth", "BorderWidth", number);
3364 /* This defaults to 2 in order to match xterm. We recognize either
3365 internalBorderWidth or internalBorder (which is what xterm calls
3366 it). */
3367 if (NILP (Fassq (Qinternal_border_width, parms)))
3368 {
3369 Lisp_Object value;
3370
3371 value = x_get_arg (dpyinfo, parms, Qinternal_border_width,
3372 "internalBorder", "internalBorder", number);
3373 if (! EQ (value, Qunbound))
3374 parms = Fcons (Fcons (Qinternal_border_width, value),
3375 parms);
3376 }
3377 x_default_parameter (f, parms, Qinternal_border_width, make_number (1),
3378 "internalBorderWidth", "internalBorderWidth", number);
3379 x_default_parameter (f, parms, Qvertical_scroll_bars, Qleft,
3380 "verticalScrollBars", "ScrollBars", symbol);
3381
3382 /* Also do the stuff which must be set before the window exists. */
3383 x_default_parameter (f, parms, Qforeground_color, build_string ("black"),
3384 "foreground", "Foreground", string);
3385 x_default_parameter (f, parms, Qbackground_color, build_string ("white"),
3386 "background", "Background", string);
3387 x_default_parameter (f, parms, Qmouse_color, build_string ("black"),
3388 "pointerColor", "Foreground", string);
3389 x_default_parameter (f, parms, Qcursor_color, build_string ("black"),
3390 "cursorColor", "Foreground", string);
3391 x_default_parameter (f, parms, Qborder_color, build_string ("black"),
3392 "borderColor", "BorderColor", string);
3393
3394 x_default_parameter (f, parms, Qmenu_bar_lines, make_number (1),
3395 "menuBar", "MenuBar", number);
3396 x_default_parameter (f, parms, Qscroll_bar_width, Qnil,
3397 "scrollBarWidth", "ScrollBarWidth", number);
3398 x_default_parameter (f, parms, Qbuffer_predicate, Qnil,
3399 "bufferPredicate", "BufferPredicate", symbol);
3400 x_default_parameter (f, parms, Qtitle, Qnil,
3401 "title", "Title", string);
3402
3403 f->output_data.x->parent_desc = FRAME_X_DISPLAY_INFO (f)->root_window;
3404 window_prompting = x_figure_window_size (f, parms);
3405
3406 if (window_prompting & XNegative)
3407 {
3408 if (window_prompting & YNegative)
3409 f->output_data.x->win_gravity = SouthEastGravity;
3410 else
3411 f->output_data.x->win_gravity = NorthEastGravity;
3412 }
3413 else
3414 {
3415 if (window_prompting & YNegative)
3416 f->output_data.x->win_gravity = SouthWestGravity;
3417 else
3418 f->output_data.x->win_gravity = NorthWestGravity;
3419 }
3420
3421 f->output_data.x->size_hint_flags = window_prompting;
3422
3423 #ifdef USE_X_TOOLKIT
3424 x_window (f, window_prompting, minibuffer_only);
3425 #else
3426 x_window (f);
3427 #endif
3428 x_icon (f, parms);
3429 x_make_gc (f);
3430 init_frame_faces (f);
3431
3432 /* We need to do this after creating the X window, so that the
3433 icon-creation functions can say whose icon they're describing. */
3434 x_default_parameter (f, parms, Qicon_type, Qnil,
3435 "bitmapIcon", "BitmapIcon", symbol);
3436
3437 x_default_parameter (f, parms, Qauto_raise, Qnil,
3438 "autoRaise", "AutoRaiseLower", boolean);
3439 x_default_parameter (f, parms, Qauto_lower, Qnil,
3440 "autoLower", "AutoRaiseLower", boolean);
3441 x_default_parameter (f, parms, Qcursor_type, Qbox,
3442 "cursorType", "CursorType", symbol);
3443
3444 /* Dimensions, especially f->height, must be done via change_frame_size.
3445 Change will not be effected unless different from the current
3446 f->height. */
3447 width = f->width;
3448 height = f->height;
3449 f->height = 0;
3450 SET_FRAME_WIDTH (f, 0);
3451 change_frame_size (f, height, width, 1, 0);
3452
3453 /* Tell the server what size and position, etc, we want,
3454 and how badly we want them. */
3455 BLOCK_INPUT;
3456 x_wm_set_size_hint (f, window_prompting, 0);
3457 UNBLOCK_INPUT;
3458
3459 tem = x_get_arg (dpyinfo, parms, Qunsplittable, 0, 0, boolean);
3460 f->no_split = minibuffer_only || EQ (tem, Qt);
3461
3462 UNGCPRO;
3463
3464 /* It is now ok to make the frame official
3465 even if we get an error below.
3466 And the frame needs to be on Vframe_list
3467 or making it visible won't work. */
3468 Vframe_list = Fcons (frame, Vframe_list);
3469
3470 /* Now that the frame is official, it counts as a reference to
3471 its display. */
3472 FRAME_X_DISPLAY_INFO (f)->reference_count++;
3473
3474 /* Make the window appear on the frame and enable display,
3475 unless the caller says not to. However, with explicit parent,
3476 Emacs cannot control visibility, so don't try. */
3477 if (! f->output_data.x->explicit_parent)
3478 {
3479 Lisp_Object visibility;
3480
3481 visibility = x_get_arg (dpyinfo, parms, Qvisibility, 0, 0, symbol);
3482 if (EQ (visibility, Qunbound))
3483 visibility = Qt;
3484
3485 if (EQ (visibility, Qicon))
3486 x_iconify_frame (f);
3487 else if (! NILP (visibility))
3488 x_make_frame_visible (f);
3489 else
3490 /* Must have been Qnil. */
3491 ;
3492 }
3493
3494 return unbind_to (count, frame);
3495 }
3496
3497 /* FRAME is used only to get a handle on the X display. We don't pass the
3498 display info directly because we're called from frame.c, which doesn't
3499 know about that structure. */
3500
3501 Lisp_Object
3502 x_get_focus_frame (frame)
3503 struct frame *frame;
3504 {
3505 struct x_display_info *dpyinfo = FRAME_X_DISPLAY_INFO (frame);
3506 Lisp_Object xfocus;
3507 if (! dpyinfo->x_focus_frame)
3508 return Qnil;
3509
3510 XSETFRAME (xfocus, dpyinfo->x_focus_frame);
3511 return xfocus;
3512 }
3513 \f
3514 #if 1
3515 #include "x-list-font.c"
3516 #else
3517 DEFUN ("x-list-fonts", Fx_list_fonts, Sx_list_fonts, 1, 4, 0,
3518 "Return a list of the names of available fonts matching PATTERN.\n\
3519 If optional arguments FACE and FRAME are specified, return only fonts\n\
3520 the same size as FACE on FRAME.\n\
3521 \n\
3522 PATTERN is a string, perhaps with wildcard characters;\n\
3523 the * character matches any substring, and\n\
3524 the ? character matches any single character.\n\
3525 PATTERN is case-insensitive.\n\
3526 FACE is a face name--a symbol.\n\
3527 \n\
3528 The return value is a list of strings, suitable as arguments to\n\
3529 set-face-font.\n\
3530 \n\
3531 Fonts Emacs can't use (i.e. proportional fonts) may or may not be excluded\n\
3532 even if they match PATTERN and FACE.\n\
3533 \n\
3534 The optional fourth argument MAXIMUM sets a limit on how many\n\
3535 fonts to match. The first MAXIMUM fonts are reported.")
3536 (pattern, face, frame, maximum)
3537 Lisp_Object pattern, face, frame, maximum;
3538 {
3539 int num_fonts;
3540 char **names;
3541 #ifndef BROKEN_XLISTFONTSWITHINFO
3542 XFontStruct *info;
3543 #endif
3544 XFontStruct *size_ref;
3545 Lisp_Object list;
3546 FRAME_PTR f;
3547 Lisp_Object key;
3548 int maxnames;
3549 int count;
3550
3551 check_x ();
3552 CHECK_STRING (pattern, 0);
3553 if (!NILP (face))
3554 CHECK_SYMBOL (face, 1);
3555
3556 if (NILP (maximum))
3557 maxnames = 2000;
3558 else
3559 {
3560 CHECK_NATNUM (maximum, 0);
3561 maxnames = XINT (maximum);
3562 }
3563
3564 f = check_x_frame (frame);
3565
3566 /* Determine the width standard for comparison with the fonts we find. */
3567
3568 if (NILP (face))
3569 size_ref = 0;
3570 else
3571 {
3572 int face_id;
3573
3574 /* Don't die if we get called with a terminal frame. */
3575 if (! FRAME_X_P (f))
3576 error ("Non-X frame used in `x-list-fonts'");
3577
3578 face_id = face_name_id_number (f, face);
3579
3580 if (face_id < 0 || face_id >= FRAME_N_PARAM_FACES (f)
3581 || FRAME_PARAM_FACES (f) [face_id] == 0)
3582 size_ref = f->output_data.x->font;
3583 else
3584 {
3585 size_ref = FRAME_PARAM_FACES (f) [face_id]->font;
3586 if (size_ref == (XFontStruct *) (~0))
3587 size_ref = f->output_data.x->font;
3588 }
3589 }
3590
3591 /* See if we cached the result for this particular query. */
3592 key = Fcons (pattern, maximum);
3593 list = Fassoc (key,
3594 XCONS (FRAME_X_DISPLAY_INFO (f)->name_list_element)->cdr);
3595
3596 /* We have info in the cache for this PATTERN. */
3597 if (!NILP (list))
3598 {
3599 Lisp_Object tem, newlist;
3600
3601 /* We have info about this pattern. */
3602 list = XCONS (list)->cdr;
3603
3604 if (size_ref == 0)
3605 return list;
3606
3607 BLOCK_INPUT;
3608
3609 /* Filter the cached info and return just the fonts that match FACE. */
3610 newlist = Qnil;
3611 for (tem = list; CONSP (tem); tem = XCONS (tem)->cdr)
3612 {
3613 XFontStruct *thisinfo;
3614
3615 count = x_catch_errors (FRAME_X_DISPLAY (f));
3616
3617 thisinfo = XLoadQueryFont (FRAME_X_DISPLAY (f),
3618 XSTRING (XCONS (tem)->car)->data);
3619
3620 x_check_errors (FRAME_X_DISPLAY (f), "XLoadQueryFont failure: %s");
3621 x_uncatch_errors (FRAME_X_DISPLAY (f), count);
3622
3623 if (thisinfo && same_size_fonts (thisinfo, size_ref))
3624 newlist = Fcons (XCONS (tem)->car, newlist);
3625
3626 if (thisinfo != 0)
3627 XFreeFont (FRAME_X_DISPLAY (f), thisinfo);
3628 }
3629
3630 UNBLOCK_INPUT;
3631
3632 return newlist;
3633 }
3634
3635 BLOCK_INPUT;
3636
3637 count = x_catch_errors (FRAME_X_DISPLAY (f));
3638
3639 /* Solaris 2.3 has a bug in XListFontsWithInfo. */
3640 #ifndef BROKEN_XLISTFONTSWITHINFO
3641 if (size_ref)
3642 names = XListFontsWithInfo (FRAME_X_DISPLAY (f),
3643 XSTRING (pattern)->data,
3644 maxnames,
3645 &num_fonts, /* count_return */
3646 &info); /* info_return */
3647 else
3648 #endif
3649 names = XListFonts (FRAME_X_DISPLAY (f),
3650 XSTRING (pattern)->data,
3651 maxnames,
3652 &num_fonts); /* count_return */
3653
3654 x_check_errors (FRAME_X_DISPLAY (f), "XListFonts failure: %s");
3655 x_uncatch_errors (FRAME_X_DISPLAY (f), count);
3656
3657 UNBLOCK_INPUT;
3658
3659 list = Qnil;
3660
3661 if (names)
3662 {
3663 int i;
3664 Lisp_Object full_list;
3665
3666 /* Make a list of all the fonts we got back.
3667 Store that in the font cache for the display. */
3668 full_list = Qnil;
3669 for (i = 0; i < num_fonts; i++)
3670 full_list = Fcons (build_string (names[i]), full_list);
3671 XCONS (FRAME_X_DISPLAY_INFO (f)->name_list_element)->cdr
3672 = Fcons (Fcons (key, full_list),
3673 XCONS (FRAME_X_DISPLAY_INFO (f)->name_list_element)->cdr);
3674
3675 /* Make a list of the fonts that have the right width. */
3676 list = Qnil;
3677 for (i = 0; i < num_fonts; i++)
3678 {
3679 int keeper;
3680
3681 if (!size_ref)
3682 keeper = 1;
3683 else
3684 {
3685 #ifdef BROKEN_XLISTFONTSWITHINFO
3686 XFontStruct *thisinfo;
3687
3688 BLOCK_INPUT;
3689
3690 count = x_catch_errors (FRAME_X_DISPLAY (f));
3691 thisinfo = XLoadQueryFont (FRAME_X_DISPLAY (f), names[i]);
3692 x_check_errors (FRAME_X_DISPLAY (f),
3693 "XLoadQueryFont failure: %s");
3694 x_uncatch_errors (FRAME_X_DISPLAY (f), count);
3695
3696 UNBLOCK_INPUT;
3697
3698 keeper = thisinfo && same_size_fonts (thisinfo, size_ref);
3699 BLOCK_INPUT;
3700 if (thisinfo && ! keeper)
3701 XFreeFont (FRAME_X_DISPLAY (f), thisinfo);
3702 else if (thisinfo)
3703 XFreeFontInfo (NULL, thisinfo, 1);
3704 UNBLOCK_INPUT;
3705 #else
3706 keeper = same_size_fonts (&info[i], size_ref);
3707 #endif
3708 }
3709 if (keeper)
3710 list = Fcons (build_string (names[i]), list);
3711 }
3712 list = Fnreverse (list);
3713
3714 BLOCK_INPUT;
3715 #ifndef BROKEN_XLISTFONTSWITHINFO
3716 if (size_ref)
3717 XFreeFontInfo (names, info, num_fonts);
3718 else
3719 #endif
3720 XFreeFontNames (names);
3721 UNBLOCK_INPUT;
3722 }
3723
3724 return list;
3725 }
3726 #endif
3727
3728 \f
3729 DEFUN ("x-color-defined-p", Fx_color_defined_p, Sx_color_defined_p, 1, 2, 0,
3730 "Return non-nil if color COLOR is supported on frame FRAME.\n\
3731 If FRAME is omitted or nil, use the selected frame.")
3732 (color, frame)
3733 Lisp_Object color, frame;
3734 {
3735 XColor foo;
3736 FRAME_PTR f = check_x_frame (frame);
3737
3738 CHECK_STRING (color, 1);
3739
3740 if (defined_color (f, XSTRING (color)->data, &foo, 0))
3741 return Qt;
3742 else
3743 return Qnil;
3744 }
3745
3746 DEFUN ("x-color-values", Fx_color_values, Sx_color_values, 1, 2, 0,
3747 "Return a description of the color named COLOR on frame FRAME.\n\
3748 The value is a list of integer RGB values--(RED GREEN BLUE).\n\
3749 These values appear to range from 0 to 65280 or 65535, depending\n\
3750 on the system; white is (65280 65280 65280) or (65535 65535 65535).\n\
3751 If FRAME is omitted or nil, use the selected frame.")
3752 (color, frame)
3753 Lisp_Object color, frame;
3754 {
3755 XColor foo;
3756 FRAME_PTR f = check_x_frame (frame);
3757
3758 CHECK_STRING (color, 1);
3759
3760 if (defined_color (f, XSTRING (color)->data, &foo, 0))
3761 {
3762 Lisp_Object rgb[3];
3763
3764 rgb[0] = make_number (foo.red);
3765 rgb[1] = make_number (foo.green);
3766 rgb[2] = make_number (foo.blue);
3767 return Flist (3, rgb);
3768 }
3769 else
3770 return Qnil;
3771 }
3772
3773 DEFUN ("x-display-color-p", Fx_display_color_p, Sx_display_color_p, 0, 1, 0,
3774 "Return t if the X display supports color.\n\
3775 The optional argument DISPLAY specifies which display to ask about.\n\
3776 DISPLAY should be either a frame or a display name (a string).\n\
3777 If omitted or nil, that stands for the selected frame's display.")
3778 (display)
3779 Lisp_Object display;
3780 {
3781 struct x_display_info *dpyinfo = check_x_display_info (display);
3782
3783 if (dpyinfo->n_planes <= 2)
3784 return Qnil;
3785
3786 switch (dpyinfo->visual->class)
3787 {
3788 case StaticColor:
3789 case PseudoColor:
3790 case TrueColor:
3791 case DirectColor:
3792 return Qt;
3793
3794 default:
3795 return Qnil;
3796 }
3797 }
3798
3799 DEFUN ("x-display-grayscale-p", Fx_display_grayscale_p, Sx_display_grayscale_p,
3800 0, 1, 0,
3801 "Return t if the X display supports shades of gray.\n\
3802 Note that color displays do support shades of gray.\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;
3808 {
3809 struct x_display_info *dpyinfo = check_x_display_info (display);
3810
3811 if (dpyinfo->n_planes <= 1)
3812 return Qnil;
3813
3814 switch (dpyinfo->visual->class)
3815 {
3816 case StaticColor:
3817 case PseudoColor:
3818 case TrueColor:
3819 case DirectColor:
3820 case StaticGray:
3821 case GrayScale:
3822 return Qt;
3823
3824 default:
3825 return Qnil;
3826 }
3827 }
3828
3829 DEFUN ("x-display-pixel-width", Fx_display_pixel_width, Sx_display_pixel_width,
3830 0, 1, 0,
3831 "Returns the width in pixels 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;
3837 {
3838 struct x_display_info *dpyinfo = check_x_display_info (display);
3839
3840 return make_number (dpyinfo->width);
3841 }
3842
3843 DEFUN ("x-display-pixel-height", Fx_display_pixel_height,
3844 Sx_display_pixel_height, 0, 1, 0,
3845 "Returns the height in pixels of the X display DISPLAY.\n\
3846 The optional argument DISPLAY specifies which display to ask about.\n\
3847 DISPLAY should be either a frame or a display name (a string).\n\
3848 If omitted or nil, that stands for the selected frame's display.")
3849 (display)
3850 Lisp_Object display;
3851 {
3852 struct x_display_info *dpyinfo = check_x_display_info (display);
3853
3854 return make_number (dpyinfo->height);
3855 }
3856
3857 DEFUN ("x-display-planes", Fx_display_planes, Sx_display_planes,
3858 0, 1, 0,
3859 "Returns the number of bitplanes of the X display DISPLAY.\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;
3865 {
3866 struct x_display_info *dpyinfo = check_x_display_info (display);
3867
3868 return make_number (dpyinfo->n_planes);
3869 }
3870
3871 DEFUN ("x-display-color-cells", Fx_display_color_cells, Sx_display_color_cells,
3872 0, 1, 0,
3873 "Returns the number of color cells of the X display DISPLAY.\n\
3874 The optional argument DISPLAY specifies which display to ask about.\n\
3875 DISPLAY should be either a frame or a display name (a string).\n\
3876 If omitted or nil, that stands for the selected frame's display.")
3877 (display)
3878 Lisp_Object display;
3879 {
3880 struct x_display_info *dpyinfo = check_x_display_info (display);
3881
3882 return make_number (DisplayCells (dpyinfo->display,
3883 XScreenNumberOfScreen (dpyinfo->screen)));
3884 }
3885
3886 DEFUN ("x-server-max-request-size", Fx_server_max_request_size,
3887 Sx_server_max_request_size,
3888 0, 1, 0,
3889 "Returns the maximum request size of the X server of display DISPLAY.\n\
3890 The optional argument DISPLAY specifies which display to ask about.\n\
3891 DISPLAY should be either a frame or a display name (a string).\n\
3892 If omitted or nil, that stands for the selected frame's display.")
3893 (display)
3894 Lisp_Object display;
3895 {
3896 struct x_display_info *dpyinfo = check_x_display_info (display);
3897
3898 return make_number (MAXREQUEST (dpyinfo->display));
3899 }
3900
3901 DEFUN ("x-server-vendor", Fx_server_vendor, Sx_server_vendor, 0, 1, 0,
3902 "Returns the vendor ID string of the X server of display DISPLAY.\n\
3903 The optional argument DISPLAY specifies which display to ask about.\n\
3904 DISPLAY should be either a frame or a display name (a string).\n\
3905 If omitted or nil, that stands for the selected frame's display.")
3906 (display)
3907 Lisp_Object display;
3908 {
3909 struct x_display_info *dpyinfo = check_x_display_info (display);
3910 char *vendor = ServerVendor (dpyinfo->display);
3911
3912 if (! vendor) vendor = "";
3913 return build_string (vendor);
3914 }
3915
3916 DEFUN ("x-server-version", Fx_server_version, Sx_server_version, 0, 1, 0,
3917 "Returns the version numbers of the X server of display DISPLAY.\n\
3918 The value is a list of three integers: the major and minor\n\
3919 version numbers of the X Protocol in use, and the vendor-specific release\n\
3920 number. See also the function `x-server-vendor'.\n\n\
3921 The optional argument DISPLAY specifies which display to ask about.\n\
3922 DISPLAY should be either a frame or a display name (a string).\n\
3923 If omitted or nil, that stands for the selected frame's display.")
3924 (display)
3925 Lisp_Object display;
3926 {
3927 struct x_display_info *dpyinfo = check_x_display_info (display);
3928 Display *dpy = dpyinfo->display;
3929
3930 return Fcons (make_number (ProtocolVersion (dpy)),
3931 Fcons (make_number (ProtocolRevision (dpy)),
3932 Fcons (make_number (VendorRelease (dpy)), Qnil)));
3933 }
3934
3935 DEFUN ("x-display-screens", Fx_display_screens, Sx_display_screens, 0, 1, 0,
3936 "Returns the number of screens on the X server of display DISPLAY.\n\
3937 The optional argument DISPLAY specifies which display to ask about.\n\
3938 DISPLAY should be either a frame or a display name (a string).\n\
3939 If omitted or nil, that stands for the selected frame's display.")
3940 (display)
3941 Lisp_Object display;
3942 {
3943 struct x_display_info *dpyinfo = check_x_display_info (display);
3944
3945 return make_number (ScreenCount (dpyinfo->display));
3946 }
3947
3948 DEFUN ("x-display-mm-height", Fx_display_mm_height, Sx_display_mm_height, 0, 1, 0,
3949 "Returns the height in millimeters of the X display DISPLAY.\n\
3950 The optional argument DISPLAY specifies which display to ask about.\n\
3951 DISPLAY should be either a frame or a display name (a string).\n\
3952 If omitted or nil, that stands for the selected frame's display.")
3953 (display)
3954 Lisp_Object display;
3955 {
3956 struct x_display_info *dpyinfo = check_x_display_info (display);
3957
3958 return make_number (HeightMMOfScreen (dpyinfo->screen));
3959 }
3960
3961 DEFUN ("x-display-mm-width", Fx_display_mm_width, Sx_display_mm_width, 0, 1, 0,
3962 "Returns the width in millimeters of the X display DISPLAY.\n\
3963 The optional argument DISPLAY specifies which display to ask about.\n\
3964 DISPLAY should be either a frame or a display name (a string).\n\
3965 If omitted or nil, that stands for the selected frame's display.")
3966 (display)
3967 Lisp_Object display;
3968 {
3969 struct x_display_info *dpyinfo = check_x_display_info (display);
3970
3971 return make_number (WidthMMOfScreen (dpyinfo->screen));
3972 }
3973
3974 DEFUN ("x-display-backing-store", Fx_display_backing_store,
3975 Sx_display_backing_store, 0, 1, 0,
3976 "Returns an indication of whether X display DISPLAY does backing store.\n\
3977 The value may be `always', `when-mapped', or `not-useful'.\n\
3978 The optional argument DISPLAY specifies which display to ask about.\n\
3979 DISPLAY should be either a frame or a display name (a string).\n\
3980 If omitted or nil, that stands for the selected frame's display.")
3981 (display)
3982 Lisp_Object display;
3983 {
3984 struct x_display_info *dpyinfo = check_x_display_info (display);
3985
3986 switch (DoesBackingStore (dpyinfo->screen))
3987 {
3988 case Always:
3989 return intern ("always");
3990
3991 case WhenMapped:
3992 return intern ("when-mapped");
3993
3994 case NotUseful:
3995 return intern ("not-useful");
3996
3997 default:
3998 error ("Strange value for BackingStore parameter of screen");
3999 }
4000 }
4001
4002 DEFUN ("x-display-visual-class", Fx_display_visual_class,
4003 Sx_display_visual_class, 0, 1, 0,
4004 "Returns the visual class of the X display DISPLAY.\n\
4005 The value is one of the symbols `static-gray', `gray-scale',\n\
4006 `static-color', `pseudo-color', `true-color', or `direct-color'.\n\n\
4007 The optional argument DISPLAY specifies which display to ask about.\n\
4008 DISPLAY should be either a frame or a display name (a string).\n\
4009 If omitted or nil, that stands for the selected frame's display.")
4010 (display)
4011 Lisp_Object display;
4012 {
4013 struct x_display_info *dpyinfo = check_x_display_info (display);
4014
4015 switch (dpyinfo->visual->class)
4016 {
4017 case StaticGray: return (intern ("static-gray"));
4018 case GrayScale: return (intern ("gray-scale"));
4019 case StaticColor: return (intern ("static-color"));
4020 case PseudoColor: return (intern ("pseudo-color"));
4021 case TrueColor: return (intern ("true-color"));
4022 case DirectColor: return (intern ("direct-color"));
4023 default:
4024 error ("Display has an unknown visual class");
4025 }
4026 }
4027
4028 DEFUN ("x-display-save-under", Fx_display_save_under,
4029 Sx_display_save_under, 0, 1, 0,
4030 "Returns t if the X display DISPLAY supports the save-under feature.\n\
4031 The optional argument DISPLAY specifies which display to ask about.\n\
4032 DISPLAY should be either a frame or a display name (a string).\n\
4033 If omitted or nil, that stands for the selected frame's display.")
4034 (display)
4035 Lisp_Object display;
4036 {
4037 struct x_display_info *dpyinfo = check_x_display_info (display);
4038
4039 if (DoesSaveUnders (dpyinfo->screen) == True)
4040 return Qt;
4041 else
4042 return Qnil;
4043 }
4044 \f
4045 int
4046 x_pixel_width (f)
4047 register struct frame *f;
4048 {
4049 return PIXEL_WIDTH (f);
4050 }
4051
4052 int
4053 x_pixel_height (f)
4054 register struct frame *f;
4055 {
4056 return PIXEL_HEIGHT (f);
4057 }
4058
4059 int
4060 x_char_width (f)
4061 register struct frame *f;
4062 {
4063 return FONT_WIDTH (f->output_data.x->font);
4064 }
4065
4066 int
4067 x_char_height (f)
4068 register struct frame *f;
4069 {
4070 return f->output_data.x->line_height;
4071 }
4072
4073 int
4074 x_screen_planes (f)
4075 register struct frame *f;
4076 {
4077 return FRAME_X_DISPLAY_INFO (f)->n_planes;
4078 }
4079 \f
4080 #if 0 /* These no longer seem like the right way to do things. */
4081
4082 /* Draw a rectangle on the frame with left top corner including
4083 the character specified by LEFT_CHAR and TOP_CHAR. The rectangle is
4084 CHARS by LINES wide and long and is the color of the cursor. */
4085
4086 void
4087 x_rectangle (f, gc, left_char, top_char, chars, lines)
4088 register struct frame *f;
4089 GC gc;
4090 register int top_char, left_char, chars, lines;
4091 {
4092 int width;
4093 int height;
4094 int left = (left_char * FONT_WIDTH (f->output_data.x->font)
4095 + f->output_data.x->internal_border_width);
4096 int top = (top_char * f->output_data.x->line_height
4097 + f->output_data.x->internal_border_width);
4098
4099 if (chars < 0)
4100 width = FONT_WIDTH (f->output_data.x->font) / 2;
4101 else
4102 width = FONT_WIDTH (f->output_data.x->font) * chars;
4103 if (lines < 0)
4104 height = f->output_data.x->line_height / 2;
4105 else
4106 height = f->output_data.x->line_height * lines;
4107
4108 XDrawRectangle (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
4109 gc, left, top, width, height);
4110 }
4111
4112 DEFUN ("x-draw-rectangle", Fx_draw_rectangle, Sx_draw_rectangle, 5, 5, 0,
4113 "Draw a rectangle on FRAME between coordinates specified by\n\
4114 numbers X0, Y0, X1, Y1 in the cursor pixel.")
4115 (frame, X0, Y0, X1, Y1)
4116 register Lisp_Object frame, X0, X1, Y0, Y1;
4117 {
4118 register int x0, y0, x1, y1, top, left, n_chars, n_lines;
4119
4120 CHECK_LIVE_FRAME (frame, 0);
4121 CHECK_NUMBER (X0, 0);
4122 CHECK_NUMBER (Y0, 1);
4123 CHECK_NUMBER (X1, 2);
4124 CHECK_NUMBER (Y1, 3);
4125
4126 x0 = XINT (X0);
4127 x1 = XINT (X1);
4128 y0 = XINT (Y0);
4129 y1 = XINT (Y1);
4130
4131 if (y1 > y0)
4132 {
4133 top = y0;
4134 n_lines = y1 - y0 + 1;
4135 }
4136 else
4137 {
4138 top = y1;
4139 n_lines = y0 - y1 + 1;
4140 }
4141
4142 if (x1 > x0)
4143 {
4144 left = x0;
4145 n_chars = x1 - x0 + 1;
4146 }
4147 else
4148 {
4149 left = x1;
4150 n_chars = x0 - x1 + 1;
4151 }
4152
4153 BLOCK_INPUT;
4154 x_rectangle (XFRAME (frame), XFRAME (frame)->output_data.x->cursor_gc,
4155 left, top, n_chars, n_lines);
4156 UNBLOCK_INPUT;
4157
4158 return Qt;
4159 }
4160
4161 DEFUN ("x-erase-rectangle", Fx_erase_rectangle, Sx_erase_rectangle, 5, 5, 0,
4162 "Draw a rectangle drawn on FRAME between coordinates\n\
4163 X0, Y0, X1, Y1 in the regular background-pixel.")
4164 (frame, X0, Y0, X1, Y1)
4165 register Lisp_Object frame, X0, Y0, X1, Y1;
4166 {
4167 register int x0, y0, x1, y1, top, left, n_chars, n_lines;
4168
4169 CHECK_LIVE_FRAME (frame, 0);
4170 CHECK_NUMBER (X0, 0);
4171 CHECK_NUMBER (Y0, 1);
4172 CHECK_NUMBER (X1, 2);
4173 CHECK_NUMBER (Y1, 3);
4174
4175 x0 = XINT (X0);
4176 x1 = XINT (X1);
4177 y0 = XINT (Y0);
4178 y1 = XINT (Y1);
4179
4180 if (y1 > y0)
4181 {
4182 top = y0;
4183 n_lines = y1 - y0 + 1;
4184 }
4185 else
4186 {
4187 top = y1;
4188 n_lines = y0 - y1 + 1;
4189 }
4190
4191 if (x1 > x0)
4192 {
4193 left = x0;
4194 n_chars = x1 - x0 + 1;
4195 }
4196 else
4197 {
4198 left = x1;
4199 n_chars = x0 - x1 + 1;
4200 }
4201
4202 BLOCK_INPUT;
4203 x_rectangle (XFRAME (frame), XFRAME (frame)->output_data.x->reverse_gc,
4204 left, top, n_chars, n_lines);
4205 UNBLOCK_INPUT;
4206
4207 return Qt;
4208 }
4209
4210 /* Draw lines around the text region beginning at the character position
4211 TOP_X, TOP_Y and ending at BOTTOM_X and BOTTOM_Y. GC specifies the
4212 pixel and line characteristics. */
4213
4214 #define line_len(line) (FRAME_CURRENT_GLYPHS (f)->used[(line)])
4215
4216 static void
4217 outline_region (f, gc, top_x, top_y, bottom_x, bottom_y)
4218 register struct frame *f;
4219 GC gc;
4220 int top_x, top_y, bottom_x, bottom_y;
4221 {
4222 register int ibw = f->output_data.x->internal_border_width;
4223 register int font_w = FONT_WIDTH (f->output_data.x->font);
4224 register int font_h = f->output_data.x->line_height;
4225 int y = top_y;
4226 int x = line_len (y);
4227 XPoint *pixel_points
4228 = (XPoint *) alloca (((bottom_y - top_y + 2) * 4) * sizeof (XPoint));
4229 register XPoint *this_point = pixel_points;
4230
4231 /* Do the horizontal top line/lines */
4232 if (top_x == 0)
4233 {
4234 this_point->x = ibw;
4235 this_point->y = ibw + (font_h * top_y);
4236 this_point++;
4237 if (x == 0)
4238 this_point->x = ibw + (font_w / 2); /* Half-size for newline chars. */
4239 else
4240 this_point->x = ibw + (font_w * x);
4241 this_point->y = (this_point - 1)->y;
4242 }
4243 else
4244 {
4245 this_point->x = ibw;
4246 this_point->y = ibw + (font_h * (top_y + 1));
4247 this_point++;
4248 this_point->x = ibw + (font_w * top_x);
4249 this_point->y = (this_point - 1)->y;
4250 this_point++;
4251 this_point->x = (this_point - 1)->x;
4252 this_point->y = ibw + (font_h * top_y);
4253 this_point++;
4254 this_point->x = ibw + (font_w * x);
4255 this_point->y = (this_point - 1)->y;
4256 }
4257
4258 /* Now do the right side. */
4259 while (y < bottom_y)
4260 { /* Right vertical edge */
4261 this_point++;
4262 this_point->x = (this_point - 1)->x;
4263 this_point->y = ibw + (font_h * (y + 1));
4264 this_point++;
4265
4266 y++; /* Horizontal connection to next line */
4267 x = line_len (y);
4268 if (x == 0)
4269 this_point->x = ibw + (font_w / 2);
4270 else
4271 this_point->x = ibw + (font_w * x);
4272
4273 this_point->y = (this_point - 1)->y;
4274 }
4275
4276 /* Now do the bottom and connect to the top left point. */
4277 this_point->x = ibw + (font_w * (bottom_x + 1));
4278
4279 this_point++;
4280 this_point->x = (this_point - 1)->x;
4281 this_point->y = ibw + (font_h * (bottom_y + 1));
4282 this_point++;
4283 this_point->x = ibw;
4284 this_point->y = (this_point - 1)->y;
4285 this_point++;
4286 this_point->x = pixel_points->x;
4287 this_point->y = pixel_points->y;
4288
4289 XDrawLines (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
4290 gc, pixel_points,
4291 (this_point - pixel_points + 1), CoordModeOrigin);
4292 }
4293
4294 DEFUN ("x-contour-region", Fx_contour_region, Sx_contour_region, 1, 1, 0,
4295 "Highlight the region between point and the character under the mouse\n\
4296 selected frame.")
4297 (event)
4298 register Lisp_Object event;
4299 {
4300 register int x0, y0, x1, y1;
4301 register struct frame *f = selected_frame;
4302 register int p1, p2;
4303
4304 CHECK_CONS (event, 0);
4305
4306 BLOCK_INPUT;
4307 x0 = XINT (Fcar (Fcar (event)));
4308 y0 = XINT (Fcar (Fcdr (Fcar (event))));
4309
4310 /* If the mouse is past the end of the line, don't that area. */
4311 /* ReWrite this... */
4312
4313 x1 = f->cursor_x;
4314 y1 = f->cursor_y;
4315
4316 if (y1 > y0) /* point below mouse */
4317 outline_region (f, f->output_data.x->cursor_gc,
4318 x0, y0, x1, y1);
4319 else if (y1 < y0) /* point above mouse */
4320 outline_region (f, f->output_data.x->cursor_gc,
4321 x1, y1, x0, y0);
4322 else /* same line: draw horizontal rectangle */
4323 {
4324 if (x1 > x0)
4325 x_rectangle (f, f->output_data.x->cursor_gc,
4326 x0, y0, (x1 - x0 + 1), 1);
4327 else if (x1 < x0)
4328 x_rectangle (f, f->output_data.x->cursor_gc,
4329 x1, y1, (x0 - x1 + 1), 1);
4330 }
4331
4332 XFlush (FRAME_X_DISPLAY (f));
4333 UNBLOCK_INPUT;
4334
4335 return Qnil;
4336 }
4337
4338 DEFUN ("x-uncontour-region", Fx_uncontour_region, Sx_uncontour_region, 1, 1, 0,
4339 "Erase any highlighting of the region between point and the character\n\
4340 at X, Y on the selected frame.")
4341 (event)
4342 register Lisp_Object event;
4343 {
4344 register int x0, y0, x1, y1;
4345 register struct frame *f = selected_frame;
4346
4347 BLOCK_INPUT;
4348 x0 = XINT (Fcar (Fcar (event)));
4349 y0 = XINT (Fcar (Fcdr (Fcar (event))));
4350 x1 = f->cursor_x;
4351 y1 = f->cursor_y;
4352
4353 if (y1 > y0) /* point below mouse */
4354 outline_region (f, f->output_data.x->reverse_gc,
4355 x0, y0, x1, y1);
4356 else if (y1 < y0) /* point above mouse */
4357 outline_region (f, f->output_data.x->reverse_gc,
4358 x1, y1, x0, y0);
4359 else /* same line: draw horizontal rectangle */
4360 {
4361 if (x1 > x0)
4362 x_rectangle (f, f->output_data.x->reverse_gc,
4363 x0, y0, (x1 - x0 + 1), 1);
4364 else if (x1 < x0)
4365 x_rectangle (f, f->output_data.x->reverse_gc,
4366 x1, y1, (x0 - x1 + 1), 1);
4367 }
4368 UNBLOCK_INPUT;
4369
4370 return Qnil;
4371 }
4372
4373 #if 0
4374 int contour_begin_x, contour_begin_y;
4375 int contour_end_x, contour_end_y;
4376 int contour_npoints;
4377
4378 /* Clip the top part of the contour lines down (and including) line Y_POS.
4379 If X_POS is in the middle (rather than at the end) of the line, drop
4380 down a line at that character. */
4381
4382 static void
4383 clip_contour_top (y_pos, x_pos)
4384 {
4385 register XPoint *begin = contour_lines[y_pos].top_left;
4386 register XPoint *end;
4387 register int npoints;
4388 register struct display_line *line = selected_frame->phys_lines[y_pos + 1];
4389
4390 if (x_pos >= line->len - 1) /* Draw one, straight horizontal line. */
4391 {
4392 end = contour_lines[y_pos].top_right;
4393 npoints = (end - begin + 1);
4394 XDrawLines (x_current_display, contour_window,
4395 contour_erase_gc, begin_erase, npoints, CoordModeOrigin);
4396
4397 bcopy (end, begin + 1, contour_last_point - end + 1);
4398 contour_last_point -= (npoints - 2);
4399 XDrawLines (x_current_display, contour_window,
4400 contour_erase_gc, begin, 2, CoordModeOrigin);
4401 XFlush (x_current_display);
4402
4403 /* Now, update contour_lines structure. */
4404 }
4405 /* ______. */
4406 else /* |________*/
4407 {
4408 register XPoint *p = begin + 1;
4409 end = contour_lines[y_pos].bottom_right;
4410 npoints = (end - begin + 1);
4411 XDrawLines (x_current_display, contour_window,
4412 contour_erase_gc, begin_erase, npoints, CoordModeOrigin);
4413
4414 p->y = begin->y;
4415 p->x = ibw + (font_w * (x_pos + 1));
4416 p++;
4417 p->y = begin->y + font_h;
4418 p->x = (p - 1)->x;
4419 bcopy (end, begin + 3, contour_last_point - end + 1);
4420 contour_last_point -= (npoints - 5);
4421 XDrawLines (x_current_display, contour_window,
4422 contour_erase_gc, begin, 4, CoordModeOrigin);
4423 XFlush (x_current_display);
4424
4425 /* Now, update contour_lines structure. */
4426 }
4427 }
4428
4429 /* Erase the top horizontal lines of the contour, and then extend
4430 the contour upwards. */
4431
4432 static void
4433 extend_contour_top (line)
4434 {
4435 }
4436
4437 static void
4438 clip_contour_bottom (x_pos, y_pos)
4439 int x_pos, y_pos;
4440 {
4441 }
4442
4443 static void
4444 extend_contour_bottom (x_pos, y_pos)
4445 {
4446 }
4447
4448 DEFUN ("x-select-region", Fx_select_region, Sx_select_region, 1, 1, "e",
4449 "")
4450 (event)
4451 Lisp_Object event;
4452 {
4453 register struct frame *f = selected_frame;
4454 register int point_x = f->cursor_x;
4455 register int point_y = f->cursor_y;
4456 register int mouse_below_point;
4457 register Lisp_Object obj;
4458 register int x_contour_x, x_contour_y;
4459
4460 x_contour_x = x_mouse_x;
4461 x_contour_y = x_mouse_y;
4462 if (x_contour_y > point_y || (x_contour_y == point_y
4463 && x_contour_x > point_x))
4464 {
4465 mouse_below_point = 1;
4466 outline_region (f, f->output_data.x->cursor_gc, point_x, point_y,
4467 x_contour_x, x_contour_y);
4468 }
4469 else
4470 {
4471 mouse_below_point = 0;
4472 outline_region (f, f->output_data.x->cursor_gc, x_contour_x, x_contour_y,
4473 point_x, point_y);
4474 }
4475
4476 while (1)
4477 {
4478 obj = read_char (-1, 0, 0, Qnil, 0);
4479 if (!CONSP (obj))
4480 break;
4481
4482 if (mouse_below_point)
4483 {
4484 if (x_mouse_y <= point_y) /* Flipped. */
4485 {
4486 mouse_below_point = 0;
4487
4488 outline_region (f, f->output_data.x->reverse_gc, point_x, point_y,
4489 x_contour_x, x_contour_y);
4490 outline_region (f, f->output_data.x->cursor_gc, x_mouse_x, x_mouse_y,
4491 point_x, point_y);
4492 }
4493 else if (x_mouse_y < x_contour_y) /* Bottom clipped. */
4494 {
4495 clip_contour_bottom (x_mouse_y);
4496 }
4497 else if (x_mouse_y > x_contour_y) /* Bottom extended. */
4498 {
4499 extend_bottom_contour (x_mouse_y);
4500 }
4501
4502 x_contour_x = x_mouse_x;
4503 x_contour_y = x_mouse_y;
4504 }
4505 else /* mouse above or same line as point */
4506 {
4507 if (x_mouse_y >= point_y) /* Flipped. */
4508 {
4509 mouse_below_point = 1;
4510
4511 outline_region (f, f->output_data.x->reverse_gc,
4512 x_contour_x, x_contour_y, point_x, point_y);
4513 outline_region (f, f->output_data.x->cursor_gc, point_x, point_y,
4514 x_mouse_x, x_mouse_y);
4515 }
4516 else if (x_mouse_y > x_contour_y) /* Top clipped. */
4517 {
4518 clip_contour_top (x_mouse_y);
4519 }
4520 else if (x_mouse_y < x_contour_y) /* Top extended. */
4521 {
4522 extend_contour_top (x_mouse_y);
4523 }
4524 }
4525 }
4526
4527 unread_command_event = obj;
4528 if (mouse_below_point)
4529 {
4530 contour_begin_x = point_x;
4531 contour_begin_y = point_y;
4532 contour_end_x = x_contour_x;
4533 contour_end_y = x_contour_y;
4534 }
4535 else
4536 {
4537 contour_begin_x = x_contour_x;
4538 contour_begin_y = x_contour_y;
4539 contour_end_x = point_x;
4540 contour_end_y = point_y;
4541 }
4542 }
4543 #endif
4544
4545 DEFUN ("x-horizontal-line", Fx_horizontal_line, Sx_horizontal_line, 1, 1, "e",
4546 "")
4547 (event)
4548 Lisp_Object event;
4549 {
4550 register Lisp_Object obj;
4551 struct frame *f = selected_frame;
4552 register struct window *w = XWINDOW (selected_window);
4553 register GC line_gc = f->output_data.x->cursor_gc;
4554 register GC erase_gc = f->output_data.x->reverse_gc;
4555 #if 0
4556 char dash_list[] = {6, 4, 6, 4};
4557 int dashes = 4;
4558 XGCValues gc_values;
4559 #endif
4560 register int previous_y;
4561 register int line = (x_mouse_y + 1) * f->output_data.x->line_height
4562 + f->output_data.x->internal_border_width;
4563 register int left = f->output_data.x->internal_border_width
4564 + (WINDOW_LEFT_MARGIN (w)
4565 * FONT_WIDTH (f->output_data.x->font));
4566 register int right = left + (w->width
4567 * FONT_WIDTH (f->output_data.x->font))
4568 - f->output_data.x->internal_border_width;
4569
4570 #if 0
4571 BLOCK_INPUT;
4572 gc_values.foreground = f->output_data.x->cursor_pixel;
4573 gc_values.background = f->output_data.x->background_pixel;
4574 gc_values.line_width = 1;
4575 gc_values.line_style = LineOnOffDash;
4576 gc_values.cap_style = CapRound;
4577 gc_values.join_style = JoinRound;
4578
4579 line_gc = XCreateGC (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
4580 GCLineStyle | GCJoinStyle | GCCapStyle
4581 | GCLineWidth | GCForeground | GCBackground,
4582 &gc_values);
4583 XSetDashes (FRAME_X_DISPLAY (f), line_gc, 0, dash_list, dashes);
4584 gc_values.foreground = f->output_data.x->background_pixel;
4585 gc_values.background = f->output_data.x->foreground_pixel;
4586 erase_gc = XCreateGC (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
4587 GCLineStyle | GCJoinStyle | GCCapStyle
4588 | GCLineWidth | GCForeground | GCBackground,
4589 &gc_values);
4590 XSetDashes (FRAME_X_DISPLAY (f), erase_gc, 0, dash_list, dashes);
4591 UNBLOCK_INPUT;
4592 #endif
4593
4594 while (1)
4595 {
4596 BLOCK_INPUT;
4597 if (x_mouse_y >= XINT (w->top)
4598 && x_mouse_y < XINT (w->top) + XINT (w->height) - 1)
4599 {
4600 previous_y = x_mouse_y;
4601 line = (x_mouse_y + 1) * f->output_data.x->line_height
4602 + f->output_data.x->internal_border_width;
4603 XDrawLine (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
4604 line_gc, left, line, right, line);
4605 }
4606 XFlush (FRAME_X_DISPLAY (f));
4607 UNBLOCK_INPUT;
4608
4609 do
4610 {
4611 obj = read_char (-1, 0, 0, Qnil, 0);
4612 if (!CONSP (obj)
4613 || (! EQ (Fcar (Fcdr (Fcdr (obj))),
4614 Qvertical_scroll_bar))
4615 || x_mouse_grabbed)
4616 {
4617 BLOCK_INPUT;
4618 XDrawLine (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
4619 erase_gc, left, line, right, line);
4620 unread_command_event = obj;
4621 #if 0
4622 XFreeGC (FRAME_X_DISPLAY (f), line_gc);
4623 XFreeGC (FRAME_X_DISPLAY (f), erase_gc);
4624 #endif
4625 UNBLOCK_INPUT;
4626 return Qnil;
4627 }
4628 }
4629 while (x_mouse_y == previous_y);
4630
4631 BLOCK_INPUT;
4632 XDrawLine (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
4633 erase_gc, left, line, right, line);
4634 UNBLOCK_INPUT;
4635 }
4636 }
4637 #endif
4638 \f
4639 #if 0
4640 /* These keep track of the rectangle following the pointer. */
4641 int mouse_track_top, mouse_track_left, mouse_track_width;
4642
4643 /* Offset in buffer of character under the pointer, or 0. */
4644 int mouse_buffer_offset;
4645
4646 DEFUN ("x-track-pointer", Fx_track_pointer, Sx_track_pointer, 0, 0, 0,
4647 "Track the pointer.")
4648 ()
4649 {
4650 static Cursor current_pointer_shape;
4651 FRAME_PTR f = x_mouse_frame;
4652
4653 BLOCK_INPUT;
4654 if (EQ (Vmouse_frame_part, Qtext_part)
4655 && (current_pointer_shape != f->output_data.x->nontext_cursor))
4656 {
4657 unsigned char c;
4658 struct buffer *buf;
4659
4660 current_pointer_shape = f->output_data.x->nontext_cursor;
4661 XDefineCursor (FRAME_X_DISPLAY (f),
4662 FRAME_X_WINDOW (f),
4663 current_pointer_shape);
4664
4665 buf = XBUFFER (XWINDOW (Vmouse_window)->buffer);
4666 c = *(BUF_CHAR_ADDRESS (buf, mouse_buffer_offset));
4667 }
4668 else if (EQ (Vmouse_frame_part, Qmodeline_part)
4669 && (current_pointer_shape != f->output_data.x->modeline_cursor))
4670 {
4671 current_pointer_shape = f->output_data.x->modeline_cursor;
4672 XDefineCursor (FRAME_X_DISPLAY (f),
4673 FRAME_X_WINDOW (f),
4674 current_pointer_shape);
4675 }
4676
4677 XFlush (FRAME_X_DISPLAY (f));
4678 UNBLOCK_INPUT;
4679 }
4680 #endif
4681
4682 #if 0
4683 DEFUN ("x-track-pointer", Fx_track_pointer, Sx_track_pointer, 1, 1, "e",
4684 "Draw rectangle around character under mouse pointer, if there is one.")
4685 (event)
4686 Lisp_Object event;
4687 {
4688 struct window *w = XWINDOW (Vmouse_window);
4689 struct frame *f = XFRAME (WINDOW_FRAME (w));
4690 struct buffer *b = XBUFFER (w->buffer);
4691 Lisp_Object obj;
4692
4693 if (! EQ (Vmouse_window, selected_window))
4694 return Qnil;
4695
4696 if (EQ (event, Qnil))
4697 {
4698 int x, y;
4699
4700 x_read_mouse_position (selected_frame, &x, &y);
4701 }
4702
4703 BLOCK_INPUT;
4704 mouse_track_width = 0;
4705 mouse_track_left = mouse_track_top = -1;
4706
4707 do
4708 {
4709 if ((x_mouse_x != mouse_track_left
4710 && (x_mouse_x < mouse_track_left
4711 || x_mouse_x > (mouse_track_left + mouse_track_width)))
4712 || x_mouse_y != mouse_track_top)
4713 {
4714 int hp = 0; /* Horizontal position */
4715 int len = FRAME_CURRENT_GLYPHS (f)->used[x_mouse_y];
4716 int p = FRAME_CURRENT_GLYPHS (f)->bufp[x_mouse_y];
4717 int tab_width = XINT (b->tab_width);
4718 int ctl_arrow_p = !NILP (b->ctl_arrow);
4719 unsigned char c;
4720 int mode_line_vpos = XFASTINT (w->height) + XFASTINT (w->top) - 1;
4721 int in_mode_line = 0;
4722
4723 if (! FRAME_CURRENT_GLYPHS (f)->enable[x_mouse_y])
4724 break;
4725
4726 /* Erase previous rectangle. */
4727 if (mouse_track_width)
4728 {
4729 x_rectangle (f, f->output_data.x->reverse_gc,
4730 mouse_track_left, mouse_track_top,
4731 mouse_track_width, 1);
4732
4733 if ((mouse_track_left == f->phys_cursor_x
4734 || mouse_track_left == f->phys_cursor_x - 1)
4735 && mouse_track_top == f->phys_cursor_y)
4736 {
4737 x_display_cursor (f, 1);
4738 }
4739 }
4740
4741 mouse_track_left = x_mouse_x;
4742 mouse_track_top = x_mouse_y;
4743 mouse_track_width = 0;
4744
4745 if (mouse_track_left > len) /* Past the end of line. */
4746 goto draw_or_not;
4747
4748 if (mouse_track_top == mode_line_vpos)
4749 {
4750 in_mode_line = 1;
4751 goto draw_or_not;
4752 }
4753
4754 if (tab_width <= 0 || tab_width > 20) tab_width = 8;
4755 do
4756 {
4757 c = FETCH_BYTE (p);
4758 if (len == f->width && hp == len - 1 && c != '\n')
4759 goto draw_or_not;
4760
4761 switch (c)
4762 {
4763 case '\t':
4764 mouse_track_width = tab_width - (hp % tab_width);
4765 p++;
4766 hp += mouse_track_width;
4767 if (hp > x_mouse_x)
4768 {
4769 mouse_track_left = hp - mouse_track_width;
4770 goto draw_or_not;
4771 }
4772 continue;
4773
4774 case '\n':
4775 mouse_track_width = -1;
4776 goto draw_or_not;
4777
4778 default:
4779 if (ctl_arrow_p && (c < 040 || c == 0177))
4780 {
4781 if (p > ZV)
4782 goto draw_or_not;
4783
4784 mouse_track_width = 2;
4785 p++;
4786 hp +=2;
4787 if (hp > x_mouse_x)
4788 {
4789 mouse_track_left = hp - mouse_track_width;
4790 goto draw_or_not;
4791 }
4792 }
4793 else
4794 {
4795 mouse_track_width = 1;
4796 p++;
4797 hp++;
4798 }
4799 continue;
4800 }
4801 }
4802 while (hp <= x_mouse_x);
4803
4804 draw_or_not:
4805 if (mouse_track_width) /* Over text; use text pointer shape. */
4806 {
4807 XDefineCursor (FRAME_X_DISPLAY (f),
4808 FRAME_X_WINDOW (f),
4809 f->output_data.x->text_cursor);
4810 x_rectangle (f, f->output_data.x->cursor_gc,
4811 mouse_track_left, mouse_track_top,
4812 mouse_track_width, 1);
4813 }
4814 else if (in_mode_line)
4815 XDefineCursor (FRAME_X_DISPLAY (f),
4816 FRAME_X_WINDOW (f),
4817 f->output_data.x->modeline_cursor);
4818 else
4819 XDefineCursor (FRAME_X_DISPLAY (f),
4820 FRAME_X_WINDOW (f),
4821 f->output_data.x->nontext_cursor);
4822 }
4823
4824 XFlush (FRAME_X_DISPLAY (f));
4825 UNBLOCK_INPUT;
4826
4827 obj = read_char (-1, 0, 0, Qnil, 0);
4828 BLOCK_INPUT;
4829 }
4830 while (CONSP (obj) /* Mouse event */
4831 && EQ (Fcar (Fcdr (Fcdr (obj))), Qnil) /* Not scroll bar */
4832 && EQ (Vmouse_depressed, Qnil) /* Only motion events */
4833 && EQ (Vmouse_window, selected_window) /* In this window */
4834 && x_mouse_frame);
4835
4836 unread_command_event = obj;
4837
4838 if (mouse_track_width)
4839 {
4840 x_rectangle (f, f->output_data.x->reverse_gc,
4841 mouse_track_left, mouse_track_top,
4842 mouse_track_width, 1);
4843 mouse_track_width = 0;
4844 if ((mouse_track_left == f->phys_cursor_x
4845 || mouse_track_left - 1 == f->phys_cursor_x)
4846 && mouse_track_top == f->phys_cursor_y)
4847 {
4848 x_display_cursor (f, 1);
4849 }
4850 }
4851 XDefineCursor (FRAME_X_DISPLAY (f),
4852 FRAME_X_WINDOW (f),
4853 f->output_data.x->nontext_cursor);
4854 XFlush (FRAME_X_DISPLAY (f));
4855 UNBLOCK_INPUT;
4856
4857 return Qnil;
4858 }
4859 #endif
4860 \f
4861 #if 0
4862 #include "glyphs.h"
4863
4864 /* Draw a pixmap specified by IMAGE_DATA of dimensions WIDTH and HEIGHT
4865 on the frame F at position X, Y. */
4866
4867 x_draw_pixmap (f, x, y, image_data, width, height)
4868 struct frame *f;
4869 int x, y, width, height;
4870 char *image_data;
4871 {
4872 Pixmap image;
4873
4874 image = XCreateBitmapFromData (FRAME_X_DISPLAY (f),
4875 FRAME_X_WINDOW (f), image_data,
4876 width, height);
4877 XCopyPlane (FRAME_X_DISPLAY (f), image, FRAME_X_WINDOW (f),
4878 f->output_data.x->normal_gc, 0, 0, width, height, x, y);
4879 }
4880 #endif
4881 \f
4882 #if 0 /* I'm told these functions are superfluous
4883 given the ability to bind function keys. */
4884
4885 #ifdef HAVE_X11
4886 DEFUN ("x-rebind-key", Fx_rebind_key, Sx_rebind_key, 3, 3, 0,
4887 "Rebind X keysym KEYSYM, with MODIFIERS, to generate NEWSTRING.\n\
4888 KEYSYM is a string which conforms to the X keysym definitions found\n\
4889 in X11/keysymdef.h, sans the initial XK_. MODIFIERS is nil or a\n\
4890 list of strings specifying modifier keys such as Control_L, which must\n\
4891 also be depressed for NEWSTRING to appear.")
4892 (x_keysym, modifiers, newstring)
4893 register Lisp_Object x_keysym;
4894 register Lisp_Object modifiers;
4895 register Lisp_Object newstring;
4896 {
4897 char *rawstring;
4898 register KeySym keysym;
4899 KeySym modifier_list[16];
4900
4901 check_x ();
4902 CHECK_STRING (x_keysym, 1);
4903 CHECK_STRING (newstring, 3);
4904
4905 keysym = XStringToKeysym ((char *) XSTRING (x_keysym)->data);
4906 if (keysym == NoSymbol)
4907 error ("Keysym does not exist");
4908
4909 if (NILP (modifiers))
4910 XRebindKeysym (x_current_display, keysym, modifier_list, 0,
4911 XSTRING (newstring)->data,
4912 STRING_BYTES (XSTRING (newstring)));
4913 else
4914 {
4915 register Lisp_Object rest, mod;
4916 register int i = 0;
4917
4918 for (rest = modifiers; !NILP (rest); rest = Fcdr (rest))
4919 {
4920 if (i == 16)
4921 error ("Can't have more than 16 modifiers");
4922
4923 mod = Fcar (rest);
4924 CHECK_STRING (mod, 3);
4925 modifier_list[i] = XStringToKeysym ((char *) XSTRING (mod)->data);
4926 #ifndef HAVE_X11R5
4927 if (modifier_list[i] == NoSymbol
4928 || !(IsModifierKey (modifier_list[i])
4929 || ((unsigned)(modifier_list[i]) == XK_Mode_switch)
4930 || ((unsigned)(modifier_list[i]) == XK_Num_Lock)))
4931 #else
4932 if (modifier_list[i] == NoSymbol
4933 || !IsModifierKey (modifier_list[i]))
4934 #endif
4935 error ("Element is not a modifier keysym");
4936 i++;
4937 }
4938
4939 XRebindKeysym (x_current_display, keysym, modifier_list, i,
4940 XSTRING (newstring)->data,
4941 STRING_BYTES (XSTRING (newstring)));
4942 }
4943
4944 return Qnil;
4945 }
4946
4947 DEFUN ("x-rebind-keys", Fx_rebind_keys, Sx_rebind_keys, 2, 2, 0,
4948 "Rebind KEYCODE to list of strings STRINGS.\n\
4949 STRINGS should be a list of 16 elements, one for each shift combination.\n\
4950 nil as element means don't change.\n\
4951 See the documentation of `x-rebind-key' for more information.")
4952 (keycode, strings)
4953 register Lisp_Object keycode;
4954 register Lisp_Object strings;
4955 {
4956 register Lisp_Object item;
4957 register unsigned char *rawstring;
4958 KeySym rawkey, modifier[1];
4959 int strsize;
4960 register unsigned i;
4961
4962 check_x ();
4963 CHECK_NUMBER (keycode, 1);
4964 CHECK_CONS (strings, 2);
4965 rawkey = (KeySym) ((unsigned) (XINT (keycode))) & 255;
4966 for (i = 0; i <= 15; strings = Fcdr (strings), i++)
4967 {
4968 item = Fcar (strings);
4969 if (!NILP (item))
4970 {
4971 CHECK_STRING (item, 2);
4972 strsize = STRING_BYTES (XSTRING (item));
4973 rawstring = (unsigned char *) xmalloc (strsize);
4974 bcopy (XSTRING (item)->data, rawstring, strsize);
4975 modifier[1] = 1 << i;
4976 XRebindKeysym (x_current_display, rawkey, modifier, 1,
4977 rawstring, strsize);
4978 }
4979 }
4980 return Qnil;
4981 }
4982 #endif /* HAVE_X11 */
4983 #endif /* 0 */
4984 \f
4985 #ifndef HAVE_XSCREENNUMBEROFSCREEN
4986 int
4987 XScreenNumberOfScreen (scr)
4988 register Screen *scr;
4989 {
4990 register Display *dpy;
4991 register Screen *dpyscr;
4992 register int i;
4993
4994 dpy = scr->display;
4995 dpyscr = dpy->screens;
4996
4997 for (i = 0; i < dpy->nscreens; i++, dpyscr++)
4998 if (scr == dpyscr)
4999 return i;
5000
5001 return -1;
5002 }
5003 #endif /* not HAVE_XSCREENNUMBEROFSCREEN */
5004
5005 Visual *
5006 select_visual (dpy, screen, depth)
5007 Display *dpy;
5008 Screen *screen;
5009 unsigned int *depth;
5010 {
5011 Visual *v;
5012 XVisualInfo *vinfo, vinfo_template;
5013 int n_visuals;
5014
5015 v = DefaultVisualOfScreen (screen);
5016
5017 #ifdef HAVE_X11R4
5018 vinfo_template.visualid = XVisualIDFromVisual (v);
5019 #else
5020 vinfo_template.visualid = v->visualid;
5021 #endif
5022
5023 vinfo_template.screen = XScreenNumberOfScreen (screen);
5024
5025 vinfo = XGetVisualInfo (dpy,
5026 VisualIDMask | VisualScreenMask, &vinfo_template,
5027 &n_visuals);
5028 if (n_visuals != 1)
5029 fatal ("Can't get proper X visual info");
5030
5031 if ((1 << vinfo->depth) == vinfo->colormap_size)
5032 *depth = vinfo->depth;
5033 else
5034 {
5035 int i = 0;
5036 int n = vinfo->colormap_size - 1;
5037 while (n)
5038 {
5039 n = n >> 1;
5040 i++;
5041 }
5042 *depth = i;
5043 }
5044
5045 XFree ((char *) vinfo);
5046 return v;
5047 }
5048
5049 /* Return the X display structure for the display named NAME.
5050 Open a new connection if necessary. */
5051
5052 struct x_display_info *
5053 x_display_info_for_name (name)
5054 Lisp_Object name;
5055 {
5056 Lisp_Object names;
5057 struct x_display_info *dpyinfo;
5058
5059 CHECK_STRING (name, 0);
5060
5061 if (! EQ (Vwindow_system, intern ("x")))
5062 error ("Not using X Windows");
5063
5064 for (dpyinfo = x_display_list, names = x_display_name_list;
5065 dpyinfo;
5066 dpyinfo = dpyinfo->next, names = XCONS (names)->cdr)
5067 {
5068 Lisp_Object tem;
5069 tem = Fstring_equal (XCONS (XCONS (names)->car)->car, name);
5070 if (!NILP (tem))
5071 return dpyinfo;
5072 }
5073
5074 /* Use this general default value to start with. */
5075 Vx_resource_name = Vinvocation_name;
5076
5077 validate_x_resource_name ();
5078
5079 dpyinfo = x_term_init (name, (unsigned char *)0,
5080 (char *) XSTRING (Vx_resource_name)->data);
5081
5082 if (dpyinfo == 0)
5083 error ("Cannot connect to X server %s", XSTRING (name)->data);
5084
5085 x_in_use = 1;
5086 XSETFASTINT (Vwindow_system_version, 11);
5087
5088 return dpyinfo;
5089 }
5090
5091 DEFUN ("x-open-connection", Fx_open_connection, Sx_open_connection,
5092 1, 3, 0, "Open a connection to an X server.\n\
5093 DISPLAY is the name of the display to connect to.\n\
5094 Optional second arg XRM-STRING is a string of resources in xrdb format.\n\
5095 If the optional third arg MUST-SUCCEED is non-nil,\n\
5096 terminate Emacs if we can't open the connection.")
5097 (display, xrm_string, must_succeed)
5098 Lisp_Object display, xrm_string, must_succeed;
5099 {
5100 unsigned int n_planes;
5101 unsigned char *xrm_option;
5102 struct x_display_info *dpyinfo;
5103
5104 CHECK_STRING (display, 0);
5105 if (! NILP (xrm_string))
5106 CHECK_STRING (xrm_string, 1);
5107
5108 if (! EQ (Vwindow_system, intern ("x")))
5109 error ("Not using X Windows");
5110
5111 if (! NILP (xrm_string))
5112 xrm_option = (unsigned char *) XSTRING (xrm_string)->data;
5113 else
5114 xrm_option = (unsigned char *) 0;
5115
5116 validate_x_resource_name ();
5117
5118 /* This is what opens the connection and sets x_current_display.
5119 This also initializes many symbols, such as those used for input. */
5120 dpyinfo = x_term_init (display, xrm_option,
5121 (char *) XSTRING (Vx_resource_name)->data);
5122
5123 if (dpyinfo == 0)
5124 {
5125 if (!NILP (must_succeed))
5126 fatal ("Cannot connect to X server %s.\n\
5127 Check the DISPLAY environment variable or use `-d'.\n\
5128 Also use the `xhost' program to verify that it is set to permit\n\
5129 connections from your machine.\n",
5130 XSTRING (display)->data);
5131 else
5132 error ("Cannot connect to X server %s", XSTRING (display)->data);
5133 }
5134
5135 x_in_use = 1;
5136
5137 XSETFASTINT (Vwindow_system_version, 11);
5138 return Qnil;
5139 }
5140
5141 DEFUN ("x-close-connection", Fx_close_connection,
5142 Sx_close_connection, 1, 1, 0,
5143 "Close the connection to DISPLAY's X server.\n\
5144 For DISPLAY, specify either a frame or a display name (a string).\n\
5145 If DISPLAY is nil, that stands for the selected frame's display.")
5146 (display)
5147 Lisp_Object display;
5148 {
5149 struct x_display_info *dpyinfo = check_x_display_info (display);
5150 struct x_display_info *tail;
5151 int i;
5152
5153 if (dpyinfo->reference_count > 0)
5154 error ("Display still has frames on it");
5155
5156 BLOCK_INPUT;
5157 /* Free the fonts in the font table. */
5158 for (i = 0; i < dpyinfo->n_fonts; i++)
5159 {
5160 if (dpyinfo->font_table[i].name)
5161 free (dpyinfo->font_table[i].name);
5162 /* Don't free the full_name string;
5163 it is always shared with something else. */
5164 XFreeFont (dpyinfo->display, dpyinfo->font_table[i].font);
5165 }
5166 x_destroy_all_bitmaps (dpyinfo);
5167 XSetCloseDownMode (dpyinfo->display, DestroyAll);
5168
5169 #ifdef USE_X_TOOLKIT
5170 XtCloseDisplay (dpyinfo->display);
5171 #else
5172 XCloseDisplay (dpyinfo->display);
5173 #endif
5174
5175 x_delete_display (dpyinfo);
5176 UNBLOCK_INPUT;
5177
5178 return Qnil;
5179 }
5180
5181 DEFUN ("x-display-list", Fx_display_list, Sx_display_list, 0, 0, 0,
5182 "Return the list of display names that Emacs has connections to.")
5183 ()
5184 {
5185 Lisp_Object tail, result;
5186
5187 result = Qnil;
5188 for (tail = x_display_name_list; ! NILP (tail); tail = XCONS (tail)->cdr)
5189 result = Fcons (XCONS (XCONS (tail)->car)->car, result);
5190
5191 return result;
5192 }
5193
5194 DEFUN ("x-synchronize", Fx_synchronize, Sx_synchronize, 1, 2, 0,
5195 "If ON is non-nil, report X errors as soon as the erring request is made.\n\
5196 If ON is nil, allow buffering of requests.\n\
5197 Turning on synchronization prohibits the Xlib routines from buffering\n\
5198 requests and seriously degrades performance, but makes debugging much\n\
5199 easier.\n\
5200 The optional second argument DISPLAY specifies which display to act on.\n\
5201 DISPLAY should be either a frame or a display name (a string).\n\
5202 If DISPLAY is omitted or nil, that stands for the selected frame's display.")
5203 (on, display)
5204 Lisp_Object display, on;
5205 {
5206 struct x_display_info *dpyinfo = check_x_display_info (display);
5207
5208 XSynchronize (dpyinfo->display, !EQ (on, Qnil));
5209
5210 return Qnil;
5211 }
5212
5213 /* Wait for responses to all X commands issued so far for frame F. */
5214
5215 void
5216 x_sync (f)
5217 FRAME_PTR f;
5218 {
5219 BLOCK_INPUT;
5220 XSync (FRAME_X_DISPLAY (f), False);
5221 UNBLOCK_INPUT;
5222 }
5223 \f
5224 void
5225 syms_of_xfns ()
5226 {
5227 /* This is zero if not using X windows. */
5228 x_in_use = 0;
5229
5230 /* The section below is built by the lisp expression at the top of the file,
5231 just above where these variables are declared. */
5232 /*&&& init symbols here &&&*/
5233 Qauto_raise = intern ("auto-raise");
5234 staticpro (&Qauto_raise);
5235 Qauto_lower = intern ("auto-lower");
5236 staticpro (&Qauto_lower);
5237 Qbackground_color = intern ("background-color");
5238 staticpro (&Qbackground_color);
5239 Qbar = intern ("bar");
5240 staticpro (&Qbar);
5241 Qborder_color = intern ("border-color");
5242 staticpro (&Qborder_color);
5243 Qborder_width = intern ("border-width");
5244 staticpro (&Qborder_width);
5245 Qbox = intern ("box");
5246 staticpro (&Qbox);
5247 Qcursor_color = intern ("cursor-color");
5248 staticpro (&Qcursor_color);
5249 Qcursor_type = intern ("cursor-type");
5250 staticpro (&Qcursor_type);
5251 Qforeground_color = intern ("foreground-color");
5252 staticpro (&Qforeground_color);
5253 Qgeometry = intern ("geometry");
5254 staticpro (&Qgeometry);
5255 Qicon_left = intern ("icon-left");
5256 staticpro (&Qicon_left);
5257 Qicon_top = intern ("icon-top");
5258 staticpro (&Qicon_top);
5259 Qicon_type = intern ("icon-type");
5260 staticpro (&Qicon_type);
5261 Qicon_name = intern ("icon-name");
5262 staticpro (&Qicon_name);
5263 Qinternal_border_width = intern ("internal-border-width");
5264 staticpro (&Qinternal_border_width);
5265 Qleft = intern ("left");
5266 staticpro (&Qleft);
5267 Qright = intern ("right");
5268 staticpro (&Qright);
5269 Qmouse_color = intern ("mouse-color");
5270 staticpro (&Qmouse_color);
5271 Qnone = intern ("none");
5272 staticpro (&Qnone);
5273 Qparent_id = intern ("parent-id");
5274 staticpro (&Qparent_id);
5275 Qscroll_bar_width = intern ("scroll-bar-width");
5276 staticpro (&Qscroll_bar_width);
5277 Qsuppress_icon = intern ("suppress-icon");
5278 staticpro (&Qsuppress_icon);
5279 Qtop = intern ("top");
5280 staticpro (&Qtop);
5281 Qundefined_color = intern ("undefined-color");
5282 staticpro (&Qundefined_color);
5283 Qvertical_scroll_bars = intern ("vertical-scroll-bars");
5284 staticpro (&Qvertical_scroll_bars);
5285 Qvisibility = intern ("visibility");
5286 staticpro (&Qvisibility);
5287 Qwindow_id = intern ("window-id");
5288 staticpro (&Qwindow_id);
5289 Qx_frame_parameter = intern ("x-frame-parameter");
5290 staticpro (&Qx_frame_parameter);
5291 Qx_resource_name = intern ("x-resource-name");
5292 staticpro (&Qx_resource_name);
5293 Quser_position = intern ("user-position");
5294 staticpro (&Quser_position);
5295 Quser_size = intern ("user-size");
5296 staticpro (&Quser_size);
5297 Qdisplay = intern ("display");
5298 staticpro (&Qdisplay);
5299 /* This is the end of symbol initialization. */
5300
5301 Qface_set_after_frame_default = intern ("face-set-after-frame-default");
5302 staticpro (&Qface_set_after_frame_default);
5303
5304 Fput (Qundefined_color, Qerror_conditions,
5305 Fcons (Qundefined_color, Fcons (Qerror, Qnil)));
5306 Fput (Qundefined_color, Qerror_message,
5307 build_string ("Undefined color"));
5308
5309 init_x_parm_symbols ();
5310
5311 DEFVAR_LISP ("x-bitmap-file-path", &Vx_bitmap_file_path,
5312 "List of directories to search for bitmap files for X.");
5313 Vx_bitmap_file_path = decode_env_path ((char *) 0, PATH_BITMAPS);
5314
5315 DEFVAR_LISP ("x-pointer-shape", &Vx_pointer_shape,
5316 "The shape of the pointer when over text.\n\
5317 Changing the value does not affect existing frames\n\
5318 unless you set the mouse color.");
5319 Vx_pointer_shape = Qnil;
5320
5321 DEFVAR_LISP ("x-resource-name", &Vx_resource_name,
5322 "The name Emacs uses to look up X resources.\n\
5323 `x-get-resource' uses this as the first component of the instance name\n\
5324 when requesting resource values.\n\
5325 Emacs initially sets `x-resource-name' to the name under which Emacs\n\
5326 was invoked, or to the value specified with the `-name' or `-rn'\n\
5327 switches, if present.\n\
5328 \n\
5329 It may be useful to bind this variable locally around a call\n\
5330 to `x-get-resource'. See also the variable `x-resource-class'.");
5331 Vx_resource_name = Qnil;
5332
5333 DEFVAR_LISP ("x-resource-class", &Vx_resource_class,
5334 "The class Emacs uses to look up X resources.\n\
5335 `x-get-resource' uses this as the first component of the instance class\n\
5336 when requesting resource values.\n\
5337 Emacs initially sets `x-resource-class' to \"Emacs\".\n\
5338 \n\
5339 Setting this variable permanently is not a reasonable thing to do,\n\
5340 but binding this variable locally around a call to `x-get-resource'\n\
5341 is a reasonabvle practice. See also the variable `x-resource-name'.");
5342 Vx_resource_class = build_string (EMACS_CLASS);
5343
5344 #if 0 /* This doesn't really do anything. */
5345 DEFVAR_LISP ("x-nontext-pointer-shape", &Vx_nontext_pointer_shape,
5346 "The shape of the pointer when not over text.\n\
5347 This variable takes effect when you create a new frame\n\
5348 or when you set the mouse color.");
5349 #endif
5350 Vx_nontext_pointer_shape = Qnil;
5351
5352 #if 0 /* This doesn't really do anything. */
5353 DEFVAR_LISP ("x-mode-pointer-shape", &Vx_mode_pointer_shape,
5354 "The shape of the pointer when over the mode line.\n\
5355 This variable takes effect when you create a new frame\n\
5356 or when you set the mouse color.");
5357 #endif
5358 Vx_mode_pointer_shape = Qnil;
5359
5360 DEFVAR_LISP ("x-sensitive-text-pointer-shape",
5361 &Vx_sensitive_text_pointer_shape,
5362 "The shape of the pointer when over mouse-sensitive text.\n\
5363 This variable takes effect when you create a new frame\n\
5364 or when you set the mouse color.");
5365 Vx_sensitive_text_pointer_shape = Qnil;
5366
5367 DEFVAR_LISP ("x-cursor-fore-pixel", &Vx_cursor_fore_pixel,
5368 "A string indicating the foreground color of the cursor box.");
5369 Vx_cursor_fore_pixel = Qnil;
5370
5371 DEFVAR_LISP ("x-no-window-manager", &Vx_no_window_manager,
5372 "Non-nil if no X window manager is in use.\n\
5373 Emacs doesn't try to figure this out; this is always nil\n\
5374 unless you set it to something else.");
5375 /* We don't have any way to find this out, so set it to nil
5376 and maybe the user would like to set it to t. */
5377 Vx_no_window_manager = Qnil;
5378
5379 DEFVAR_LISP ("x-pixel-size-width-font-regexp",
5380 &Vx_pixel_size_width_font_regexp,
5381 "Regexp matching a font name whose width is the same as `PIXEL_SIZE'.\n\
5382 \n\
5383 Since Emacs gets width of a font matching with this regexp from\n\
5384 PIXEL_SIZE field of the name, font finding mechanism gets faster for\n\
5385 such a font. This is especially effective for such large fonts as\n\
5386 Chinese, Japanese, and Korean.");
5387 Vx_pixel_size_width_font_regexp = Qnil;
5388
5389 DEFVAR_BOOL ("unibyte-display-via-language-environment",
5390 &unibyte_display_via_language_environment,
5391 "*Non-nil means display unibyte text according to language environment.\n\
5392 Specifically this means that unibyte non-ASCII characters\n\
5393 are displayed by converting them to the equivalent multibyte characters\n\
5394 according to the current language environment. As a result, they are\n\
5395 displayed according to the current fontset.");
5396 unibyte_display_via_language_environment = 0;
5397
5398 #ifdef USE_X_TOOLKIT
5399 Fprovide (intern ("x-toolkit"));
5400 #endif
5401 #ifdef USE_MOTIF
5402 Fprovide (intern ("motif"));
5403 #endif
5404
5405 defsubr (&Sx_get_resource);
5406 #if 0
5407 defsubr (&Sx_draw_rectangle);
5408 defsubr (&Sx_erase_rectangle);
5409 defsubr (&Sx_contour_region);
5410 defsubr (&Sx_uncontour_region);
5411 #endif
5412 defsubr (&Sx_list_fonts);
5413 defsubr (&Sx_display_color_p);
5414 defsubr (&Sx_display_grayscale_p);
5415 defsubr (&Sx_color_defined_p);
5416 defsubr (&Sx_color_values);
5417 defsubr (&Sx_server_max_request_size);
5418 defsubr (&Sx_server_vendor);
5419 defsubr (&Sx_server_version);
5420 defsubr (&Sx_display_pixel_width);
5421 defsubr (&Sx_display_pixel_height);
5422 defsubr (&Sx_display_mm_width);
5423 defsubr (&Sx_display_mm_height);
5424 defsubr (&Sx_display_screens);
5425 defsubr (&Sx_display_planes);
5426 defsubr (&Sx_display_color_cells);
5427 defsubr (&Sx_display_visual_class);
5428 defsubr (&Sx_display_backing_store);
5429 defsubr (&Sx_display_save_under);
5430 #if 0
5431 defsubr (&Sx_rebind_key);
5432 defsubr (&Sx_rebind_keys);
5433 defsubr (&Sx_track_pointer);
5434 defsubr (&Sx_grab_pointer);
5435 defsubr (&Sx_ungrab_pointer);
5436 #endif
5437 defsubr (&Sx_parse_geometry);
5438 defsubr (&Sx_create_frame);
5439 #if 0
5440 defsubr (&Sx_horizontal_line);
5441 #endif
5442 defsubr (&Sx_open_connection);
5443 defsubr (&Sx_close_connection);
5444 defsubr (&Sx_display_list);
5445 defsubr (&Sx_synchronize);
5446
5447 /* Setting callback functions for fontset handler. */
5448 get_font_info_func = x_get_font_info;
5449 list_fonts_func = x_list_fonts;
5450 load_font_func = x_load_font;
5451 find_ccl_program_func = x_find_ccl_program;
5452 query_font_func = x_query_font;
5453 set_frame_fontset_func = x_set_font;
5454 check_window_system_func = check_x;
5455 }
5456
5457 #endif /* HAVE_X_WINDOWS */