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