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