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