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