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