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