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