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