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