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