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