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