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