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