(init_sys_modes) [!HAVE_X_WINDOWS (MSDOS)]: Always call set_terminal_modes.
[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, Qbuffer_predicate;
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 Fsignal (Qerror, Fcons (build_string ("undefined color"),
1169 Fcons (arg, Qnil)));
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 {
1698 FRAME_EXTERNAL_MENU_BAR (f) = 1;
1699 if (f->output_data.x->menubar_widget == 0)
1700 /* Make sure next redisplay shows the menu bar. */
1701 XWINDOW (FRAME_SELECTED_WINDOW (f))->update_mode_line = Qt;
1702 }
1703 else
1704 {
1705 if (FRAME_EXTERNAL_MENU_BAR (f) == 1)
1706 free_frame_menubar (f);
1707 FRAME_EXTERNAL_MENU_BAR (f) = 0;
1708 f->output_data.x->menubar_widget = 0;
1709 }
1710 #else /* not USE_X_TOOLKIT */
1711 FRAME_MENU_BAR_LINES (f) = nlines;
1712 x_set_menu_bar_lines_1 (f->root_window, nlines - olines);
1713 #endif /* not USE_X_TOOLKIT */
1714 }
1715
1716 /* Change the name of frame F to NAME. If NAME is nil, set F's name to
1717 x_id_name.
1718
1719 If EXPLICIT is non-zero, that indicates that lisp code is setting the
1720 name; if NAME is a string, set F's name to NAME and set
1721 F->explicit_name; if NAME is Qnil, then clear F->explicit_name.
1722
1723 If EXPLICIT is zero, that indicates that Emacs redisplay code is
1724 suggesting a new name, which lisp code should override; if
1725 F->explicit_name is set, ignore the new name; otherwise, set it. */
1726
1727 void
1728 x_set_name (f, name, explicit)
1729 struct frame *f;
1730 Lisp_Object name;
1731 int explicit;
1732 {
1733 /* Make sure that requests from lisp code override requests from
1734 Emacs redisplay code. */
1735 if (explicit)
1736 {
1737 /* If we're switching from explicit to implicit, we had better
1738 update the mode lines and thereby update the title. */
1739 if (f->explicit_name && NILP (name))
1740 update_mode_lines = 1;
1741
1742 f->explicit_name = ! NILP (name);
1743 }
1744 else if (f->explicit_name)
1745 return;
1746
1747 /* If NAME is nil, set the name to the x_id_name. */
1748 if (NILP (name))
1749 {
1750 /* Check for no change needed in this very common case
1751 before we do any consing. */
1752 if (!strcmp (FRAME_X_DISPLAY_INFO (f)->x_id_name,
1753 XSTRING (f->name)->data))
1754 return;
1755 name = build_string (FRAME_X_DISPLAY_INFO (f)->x_id_name);
1756 }
1757 else
1758 CHECK_STRING (name, 0);
1759
1760 /* Don't change the name if it's already NAME. */
1761 if (! NILP (Fstring_equal (name, f->name)))
1762 return;
1763
1764 if (FRAME_X_WINDOW (f))
1765 {
1766 BLOCK_INPUT;
1767 #ifdef HAVE_X11R4
1768 {
1769 XTextProperty text, icon;
1770 Lisp_Object icon_name;
1771
1772 text.value = XSTRING (name)->data;
1773 text.encoding = XA_STRING;
1774 text.format = 8;
1775 text.nitems = XSTRING (name)->size;
1776
1777 icon_name = (!NILP (f->icon_name) ? f->icon_name : name);
1778
1779 icon.value = XSTRING (icon_name)->data;
1780 icon.encoding = XA_STRING;
1781 icon.format = 8;
1782 icon.nitems = XSTRING (icon_name)->size;
1783 #ifdef USE_X_TOOLKIT
1784 XSetWMName (FRAME_X_DISPLAY (f),
1785 XtWindow (f->output_data.x->widget), &text);
1786 XSetWMIconName (FRAME_X_DISPLAY (f), XtWindow (f->output_data.x->widget),
1787 &icon);
1788 #else /* not USE_X_TOOLKIT */
1789 XSetWMName (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f), &text);
1790 XSetWMIconName (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f), &icon);
1791 #endif /* not USE_X_TOOLKIT */
1792 }
1793 #else /* not HAVE_X11R4 */
1794 XSetIconName (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
1795 XSTRING (name)->data);
1796 XStoreName (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
1797 XSTRING (name)->data);
1798 #endif /* not HAVE_X11R4 */
1799 UNBLOCK_INPUT;
1800 }
1801
1802 f->name = name;
1803 }
1804
1805 /* This function should be called when the user's lisp code has
1806 specified a name for the frame; the name will override any set by the
1807 redisplay code. */
1808 void
1809 x_explicitly_set_name (f, arg, oldval)
1810 FRAME_PTR f;
1811 Lisp_Object arg, oldval;
1812 {
1813 x_set_name (f, arg, 1);
1814 }
1815
1816 /* This function should be called by Emacs redisplay code to set the
1817 name; names set this way will never override names set by the user's
1818 lisp code. */
1819 void
1820 x_implicitly_set_name (f, arg, oldval)
1821 FRAME_PTR f;
1822 Lisp_Object arg, oldval;
1823 {
1824 x_set_name (f, arg, 0);
1825 }
1826
1827 void
1828 x_set_autoraise (f, arg, oldval)
1829 struct frame *f;
1830 Lisp_Object arg, oldval;
1831 {
1832 f->auto_raise = !EQ (Qnil, arg);
1833 }
1834
1835 void
1836 x_set_autolower (f, arg, oldval)
1837 struct frame *f;
1838 Lisp_Object arg, oldval;
1839 {
1840 f->auto_lower = !EQ (Qnil, arg);
1841 }
1842
1843 void
1844 x_set_unsplittable (f, arg, oldval)
1845 struct frame *f;
1846 Lisp_Object arg, oldval;
1847 {
1848 f->no_split = !NILP (arg);
1849 }
1850
1851 void
1852 x_set_vertical_scroll_bars (f, arg, oldval)
1853 struct frame *f;
1854 Lisp_Object arg, oldval;
1855 {
1856 if (NILP (arg) != ! FRAME_HAS_VERTICAL_SCROLL_BARS (f))
1857 {
1858 FRAME_HAS_VERTICAL_SCROLL_BARS (f) = ! NILP (arg);
1859
1860 /* We set this parameter before creating the X window for the
1861 frame, so we can get the geometry right from the start.
1862 However, if the window hasn't been created yet, we shouldn't
1863 call x_set_window_size. */
1864 if (FRAME_X_WINDOW (f))
1865 x_set_window_size (f, 0, FRAME_WIDTH (f), FRAME_HEIGHT (f));
1866 }
1867 }
1868
1869 void
1870 x_set_scroll_bar_width (f, arg, oldval)
1871 struct frame *f;
1872 Lisp_Object arg, oldval;
1873 {
1874 if (NILP (arg))
1875 {
1876 FRAME_SCROLL_BAR_PIXEL_WIDTH (f) = 0;
1877 FRAME_SCROLL_BAR_COLS (f) = 2;
1878 }
1879 else if (INTEGERP (arg) && XINT (arg) > 0
1880 && XFASTINT (arg) != FRAME_SCROLL_BAR_PIXEL_WIDTH (f))
1881 {
1882 int wid = FONT_WIDTH (f->output_data.x->font);
1883 FRAME_SCROLL_BAR_PIXEL_WIDTH (f) = XFASTINT (arg);
1884 FRAME_SCROLL_BAR_COLS (f) = (XFASTINT (arg) + wid-1) / wid;
1885 if (FRAME_X_WINDOW (f))
1886 x_set_window_size (f, 0, FRAME_WIDTH (f), FRAME_HEIGHT (f));
1887 }
1888 }
1889 \f
1890 /* Subroutines of creating an X frame. */
1891
1892 /* Make sure that Vx_resource_name is set to a reasonable value.
1893 Fix it up, or set it to `emacs' if it is too hopeless. */
1894
1895 static void
1896 validate_x_resource_name ()
1897 {
1898 int len;
1899 /* Number of valid characters in the resource name. */
1900 int good_count = 0;
1901 /* Number of invalid characters in the resource name. */
1902 int bad_count = 0;
1903 Lisp_Object new;
1904 int i;
1905
1906 if (STRINGP (Vx_resource_name))
1907 {
1908 unsigned char *p = XSTRING (Vx_resource_name)->data;
1909 int i;
1910
1911 len = XSTRING (Vx_resource_name)->size;
1912
1913 /* Only letters, digits, - and _ are valid in resource names.
1914 Count the valid characters and count the invalid ones. */
1915 for (i = 0; i < len; i++)
1916 {
1917 int c = p[i];
1918 if (! ((c >= 'a' && c <= 'z')
1919 || (c >= 'A' && c <= 'Z')
1920 || (c >= '0' && c <= '9')
1921 || c == '-' || c == '_'))
1922 bad_count++;
1923 else
1924 good_count++;
1925 }
1926 }
1927 else
1928 /* Not a string => completely invalid. */
1929 bad_count = 5, good_count = 0;
1930
1931 /* If name is valid already, return. */
1932 if (bad_count == 0)
1933 return;
1934
1935 /* If name is entirely invalid, or nearly so, use `emacs'. */
1936 if (good_count == 0
1937 || (good_count == 1 && bad_count > 0))
1938 {
1939 Vx_resource_name = build_string ("emacs");
1940 return;
1941 }
1942
1943 /* Name is partly valid. Copy it and replace the invalid characters
1944 with underscores. */
1945
1946 Vx_resource_name = new = Fcopy_sequence (Vx_resource_name);
1947
1948 for (i = 0; i < len; i++)
1949 {
1950 int c = XSTRING (new)->data[i];
1951 if (! ((c >= 'a' && c <= 'z')
1952 || (c >= 'A' && c <= 'Z')
1953 || (c >= '0' && c <= '9')
1954 || c == '-' || c == '_'))
1955 XSTRING (new)->data[i] = '_';
1956 }
1957 }
1958
1959
1960 extern char *x_get_string_resource ();
1961
1962 DEFUN ("x-get-resource", Fx_get_resource, Sx_get_resource, 2, 4, 0,
1963 "Return the value of ATTRIBUTE, of class CLASS, from the X defaults database.\n\
1964 This uses `INSTANCE.ATTRIBUTE' as the key and `Emacs.CLASS' as the\n\
1965 class, where INSTANCE is the name under which Emacs was invoked, or\n\
1966 the name specified by the `-name' or `-rn' command-line arguments.\n\
1967 \n\
1968 The optional arguments COMPONENT and SUBCLASS add to the key and the\n\
1969 class, respectively. You must specify both of them or neither.\n\
1970 If you specify them, the key is `INSTANCE.COMPONENT.ATTRIBUTE'\n\
1971 and the class is `Emacs.CLASS.SUBCLASS'.")
1972 (attribute, class, component, subclass)
1973 Lisp_Object attribute, class, component, subclass;
1974 {
1975 register char *value;
1976 char *name_key;
1977 char *class_key;
1978
1979 check_x ();
1980
1981 CHECK_STRING (attribute, 0);
1982 CHECK_STRING (class, 0);
1983
1984 if (!NILP (component))
1985 CHECK_STRING (component, 1);
1986 if (!NILP (subclass))
1987 CHECK_STRING (subclass, 2);
1988 if (NILP (component) != NILP (subclass))
1989 error ("x-get-resource: must specify both COMPONENT and SUBCLASS or neither");
1990
1991 validate_x_resource_name ();
1992
1993 /* Allocate space for the components, the dots which separate them,
1994 and the final '\0'. Make them big enough for the worst case. */
1995 name_key = (char *) alloca (XSTRING (Vx_resource_name)->size
1996 + (STRINGP (component)
1997 ? XSTRING (component)->size : 0)
1998 + XSTRING (attribute)->size
1999 + 3);
2000
2001 class_key = (char *) alloca ((sizeof (EMACS_CLASS) - 1)
2002 + XSTRING (class)->size
2003 + (STRINGP (subclass)
2004 ? XSTRING (subclass)->size : 0)
2005 + 3);
2006
2007 /* Start with emacs.FRAMENAME for the name (the specific one)
2008 and with `Emacs' for the class key (the general one). */
2009 strcpy (name_key, XSTRING (Vx_resource_name)->data);
2010 strcpy (class_key, EMACS_CLASS);
2011
2012 strcat (class_key, ".");
2013 strcat (class_key, XSTRING (class)->data);
2014
2015 if (!NILP (component))
2016 {
2017 strcat (class_key, ".");
2018 strcat (class_key, XSTRING (subclass)->data);
2019
2020 strcat (name_key, ".");
2021 strcat (name_key, XSTRING (component)->data);
2022 }
2023
2024 strcat (name_key, ".");
2025 strcat (name_key, XSTRING (attribute)->data);
2026
2027 value = x_get_string_resource (check_x_display_info (Qnil)->xrdb,
2028 name_key, class_key);
2029
2030 if (value != (char *) 0)
2031 return build_string (value);
2032 else
2033 return Qnil;
2034 }
2035
2036 /* Used when C code wants a resource value. */
2037
2038 char *
2039 x_get_resource_string (attribute, class)
2040 char *attribute, *class;
2041 {
2042 register char *value;
2043 char *name_key;
2044 char *class_key;
2045
2046 /* Allocate space for the components, the dots which separate them,
2047 and the final '\0'. */
2048 name_key = (char *) alloca (XSTRING (Vinvocation_name)->size
2049 + strlen (attribute) + 2);
2050 class_key = (char *) alloca ((sizeof (EMACS_CLASS) - 1)
2051 + strlen (class) + 2);
2052
2053 sprintf (name_key, "%s.%s",
2054 XSTRING (Vinvocation_name)->data,
2055 attribute);
2056 sprintf (class_key, "%s.%s", EMACS_CLASS, class);
2057
2058 return x_get_string_resource (FRAME_X_DISPLAY_INFO (selected_frame)->xrdb,
2059 name_key, class_key);
2060 }
2061
2062 /* Types we might convert a resource string into. */
2063 enum resource_types
2064 {
2065 number, boolean, string, symbol
2066 };
2067
2068 /* Return the value of parameter PARAM.
2069
2070 First search ALIST, then Vdefault_frame_alist, then the X defaults
2071 database, using ATTRIBUTE as the attribute name and CLASS as its class.
2072
2073 Convert the resource to the type specified by desired_type.
2074
2075 If no default is specified, return Qunbound. If you call
2076 x_get_arg, make sure you deal with Qunbound in a reasonable way,
2077 and don't let it get stored in any Lisp-visible variables! */
2078
2079 static Lisp_Object
2080 x_get_arg (alist, param, attribute, class, type)
2081 Lisp_Object alist, param;
2082 char *attribute;
2083 char *class;
2084 enum resource_types type;
2085 {
2086 register Lisp_Object tem;
2087
2088 tem = Fassq (param, alist);
2089 if (EQ (tem, Qnil))
2090 tem = Fassq (param, Vdefault_frame_alist);
2091 if (EQ (tem, Qnil))
2092 {
2093
2094 if (attribute)
2095 {
2096 tem = Fx_get_resource (build_string (attribute),
2097 build_string (class),
2098 Qnil, Qnil);
2099
2100 if (NILP (tem))
2101 return Qunbound;
2102
2103 switch (type)
2104 {
2105 case number:
2106 return make_number (atoi (XSTRING (tem)->data));
2107
2108 case boolean:
2109 tem = Fdowncase (tem);
2110 if (!strcmp (XSTRING (tem)->data, "on")
2111 || !strcmp (XSTRING (tem)->data, "true"))
2112 return Qt;
2113 else
2114 return Qnil;
2115
2116 case string:
2117 return tem;
2118
2119 case symbol:
2120 /* As a special case, we map the values `true' and `on'
2121 to Qt, and `false' and `off' to Qnil. */
2122 {
2123 Lisp_Object lower;
2124 lower = Fdowncase (tem);
2125 if (!strcmp (XSTRING (lower)->data, "on")
2126 || !strcmp (XSTRING (lower)->data, "true"))
2127 return Qt;
2128 else if (!strcmp (XSTRING (lower)->data, "off")
2129 || !strcmp (XSTRING (lower)->data, "false"))
2130 return Qnil;
2131 else
2132 return Fintern (tem, Qnil);
2133 }
2134
2135 default:
2136 abort ();
2137 }
2138 }
2139 else
2140 return Qunbound;
2141 }
2142 return Fcdr (tem);
2143 }
2144
2145 /* Record in frame F the specified or default value according to ALIST
2146 of the parameter named PARAM (a Lisp symbol).
2147 If no value is specified for PARAM, look for an X default for XPROP
2148 on the frame named NAME.
2149 If that is not found either, use the value DEFLT. */
2150
2151 static Lisp_Object
2152 x_default_parameter (f, alist, prop, deflt, xprop, xclass, type)
2153 struct frame *f;
2154 Lisp_Object alist;
2155 Lisp_Object prop;
2156 Lisp_Object deflt;
2157 char *xprop;
2158 char *xclass;
2159 enum resource_types type;
2160 {
2161 Lisp_Object tem;
2162
2163 tem = x_get_arg (alist, prop, xprop, xclass, type);
2164 if (EQ (tem, Qunbound))
2165 tem = deflt;
2166 x_set_frame_parameters (f, Fcons (Fcons (prop, tem), Qnil));
2167 return tem;
2168 }
2169 \f
2170 DEFUN ("x-parse-geometry", Fx_parse_geometry, Sx_parse_geometry, 1, 1, 0,
2171 "Parse an X-style geometry string STRING.\n\
2172 Returns an alist of the form ((top . TOP), (left . LEFT) ... ).\n\
2173 The properties returned may include `top', `left', `height', and `width'.\n\
2174 The value of `left' or `top' may be an integer,\n\
2175 or a list (+ N) meaning N pixels relative to top/left corner,\n\
2176 or a list (- N) meaning -N pixels relative to bottom/right corner.")
2177 (string)
2178 Lisp_Object string;
2179 {
2180 int geometry, x, y;
2181 unsigned int width, height;
2182 Lisp_Object result;
2183
2184 CHECK_STRING (string, 0);
2185
2186 geometry = XParseGeometry ((char *) XSTRING (string)->data,
2187 &x, &y, &width, &height);
2188
2189 #if 0
2190 if (!!(geometry & XValue) != !!(geometry & YValue))
2191 error ("Must specify both x and y position, or neither");
2192 #endif
2193
2194 result = Qnil;
2195 if (geometry & XValue)
2196 {
2197 Lisp_Object element;
2198
2199 if (x >= 0 && (geometry & XNegative))
2200 element = Fcons (Qleft, Fcons (Qminus, Fcons (make_number (-x), Qnil)));
2201 else if (x < 0 && ! (geometry & XNegative))
2202 element = Fcons (Qleft, Fcons (Qplus, Fcons (make_number (x), Qnil)));
2203 else
2204 element = Fcons (Qleft, make_number (x));
2205 result = Fcons (element, result);
2206 }
2207
2208 if (geometry & YValue)
2209 {
2210 Lisp_Object element;
2211
2212 if (y >= 0 && (geometry & YNegative))
2213 element = Fcons (Qtop, Fcons (Qminus, Fcons (make_number (-y), Qnil)));
2214 else if (y < 0 && ! (geometry & YNegative))
2215 element = Fcons (Qtop, Fcons (Qplus, Fcons (make_number (y), Qnil)));
2216 else
2217 element = Fcons (Qtop, make_number (y));
2218 result = Fcons (element, result);
2219 }
2220
2221 if (geometry & WidthValue)
2222 result = Fcons (Fcons (Qwidth, make_number (width)), result);
2223 if (geometry & HeightValue)
2224 result = Fcons (Fcons (Qheight, make_number (height)), result);
2225
2226 return result;
2227 }
2228
2229 /* Calculate the desired size and position of this window,
2230 and return the flags saying which aspects were specified.
2231
2232 This function does not make the coordinates positive. */
2233
2234 #define DEFAULT_ROWS 40
2235 #define DEFAULT_COLS 80
2236
2237 static int
2238 x_figure_window_size (f, parms)
2239 struct frame *f;
2240 Lisp_Object parms;
2241 {
2242 register Lisp_Object tem0, tem1, tem2;
2243 int height, width, left, top;
2244 register int geometry;
2245 long window_prompting = 0;
2246
2247 /* Default values if we fall through.
2248 Actually, if that happens we should get
2249 window manager prompting. */
2250 f->width = DEFAULT_COLS;
2251 f->height = DEFAULT_ROWS;
2252 /* Window managers expect that if program-specified
2253 positions are not (0,0), they're intentional, not defaults. */
2254 f->output_data.x->top_pos = 0;
2255 f->output_data.x->left_pos = 0;
2256
2257 tem0 = x_get_arg (parms, Qheight, 0, 0, number);
2258 tem1 = x_get_arg (parms, Qwidth, 0, 0, number);
2259 tem2 = x_get_arg (parms, Quser_size, 0, 0, number);
2260 if (! EQ (tem0, Qunbound) || ! EQ (tem1, Qunbound))
2261 {
2262 if (!EQ (tem0, Qunbound))
2263 {
2264 CHECK_NUMBER (tem0, 0);
2265 f->height = XINT (tem0);
2266 }
2267 if (!EQ (tem1, Qunbound))
2268 {
2269 CHECK_NUMBER (tem1, 0);
2270 f->width = XINT (tem1);
2271 }
2272 if (!NILP (tem2) && !EQ (tem2, Qunbound))
2273 window_prompting |= USSize;
2274 else
2275 window_prompting |= PSize;
2276 }
2277
2278 f->output_data.x->vertical_scroll_bar_extra
2279 = (!FRAME_HAS_VERTICAL_SCROLL_BARS (f)
2280 ? 0
2281 : FRAME_SCROLL_BAR_PIXEL_WIDTH (f) > 0
2282 ? FRAME_SCROLL_BAR_PIXEL_WIDTH (f)
2283 : (FRAME_SCROLL_BAR_COLS (f) * FONT_WIDTH (f->output_data.x->font)));
2284 f->output_data.x->pixel_width = CHAR_TO_PIXEL_WIDTH (f, f->width);
2285 f->output_data.x->pixel_height = CHAR_TO_PIXEL_HEIGHT (f, f->height);
2286
2287 tem0 = x_get_arg (parms, Qtop, 0, 0, number);
2288 tem1 = x_get_arg (parms, Qleft, 0, 0, number);
2289 tem2 = x_get_arg (parms, Quser_position, 0, 0, number);
2290 if (! EQ (tem0, Qunbound) || ! EQ (tem1, Qunbound))
2291 {
2292 if (EQ (tem0, Qminus))
2293 {
2294 f->output_data.x->top_pos = 0;
2295 window_prompting |= YNegative;
2296 }
2297 else if (CONSP (tem0) && EQ (XCONS (tem0)->car, Qminus)
2298 && CONSP (XCONS (tem0)->cdr)
2299 && INTEGERP (XCONS (XCONS (tem0)->cdr)->car))
2300 {
2301 f->output_data.x->top_pos = - XINT (XCONS (XCONS (tem0)->cdr)->car);
2302 window_prompting |= YNegative;
2303 }
2304 else if (CONSP (tem0) && EQ (XCONS (tem0)->car, Qplus)
2305 && CONSP (XCONS (tem0)->cdr)
2306 && INTEGERP (XCONS (XCONS (tem0)->cdr)->car))
2307 {
2308 f->output_data.x->top_pos = XINT (XCONS (XCONS (tem0)->cdr)->car);
2309 }
2310 else if (EQ (tem0, Qunbound))
2311 f->output_data.x->top_pos = 0;
2312 else
2313 {
2314 CHECK_NUMBER (tem0, 0);
2315 f->output_data.x->top_pos = XINT (tem0);
2316 if (f->output_data.x->top_pos < 0)
2317 window_prompting |= YNegative;
2318 }
2319
2320 if (EQ (tem1, Qminus))
2321 {
2322 f->output_data.x->left_pos = 0;
2323 window_prompting |= XNegative;
2324 }
2325 else if (CONSP (tem1) && EQ (XCONS (tem1)->car, Qminus)
2326 && CONSP (XCONS (tem1)->cdr)
2327 && INTEGERP (XCONS (XCONS (tem1)->cdr)->car))
2328 {
2329 f->output_data.x->left_pos = - XINT (XCONS (XCONS (tem1)->cdr)->car);
2330 window_prompting |= XNegative;
2331 }
2332 else if (CONSP (tem1) && EQ (XCONS (tem1)->car, Qplus)
2333 && CONSP (XCONS (tem1)->cdr)
2334 && INTEGERP (XCONS (XCONS (tem1)->cdr)->car))
2335 {
2336 f->output_data.x->left_pos = XINT (XCONS (XCONS (tem1)->cdr)->car);
2337 }
2338 else if (EQ (tem1, Qunbound))
2339 f->output_data.x->left_pos = 0;
2340 else
2341 {
2342 CHECK_NUMBER (tem1, 0);
2343 f->output_data.x->left_pos = XINT (tem1);
2344 if (f->output_data.x->left_pos < 0)
2345 window_prompting |= XNegative;
2346 }
2347
2348 if (!NILP (tem2) && ! EQ (tem2, Qunbound))
2349 window_prompting |= USPosition;
2350 else
2351 window_prompting |= PPosition;
2352 }
2353
2354 return window_prompting;
2355 }
2356
2357 #if !defined (HAVE_X11R4) && !defined (HAVE_XSETWMPROTOCOLS)
2358
2359 Status
2360 XSetWMProtocols (dpy, w, protocols, count)
2361 Display *dpy;
2362 Window w;
2363 Atom *protocols;
2364 int count;
2365 {
2366 Atom prop;
2367 prop = XInternAtom (dpy, "WM_PROTOCOLS", False);
2368 if (prop == None) return False;
2369 XChangeProperty (dpy, w, prop, XA_ATOM, 32, PropModeReplace,
2370 (unsigned char *) protocols, count);
2371 return True;
2372 }
2373 #endif /* not HAVE_X11R4 && not HAVE_XSETWMPROTOCOLS */
2374 \f
2375 #ifdef USE_X_TOOLKIT
2376
2377 /* If the WM_PROTOCOLS property does not already contain WM_TAKE_FOCUS,
2378 WM_DELETE_WINDOW, and WM_SAVE_YOURSELF, then add them. (They may
2379 already be present because of the toolkit (Motif adds some of them,
2380 for example, but Xt doesn't). */
2381
2382 static void
2383 hack_wm_protocols (f, widget)
2384 FRAME_PTR f;
2385 Widget widget;
2386 {
2387 Display *dpy = XtDisplay (widget);
2388 Window w = XtWindow (widget);
2389 int need_delete = 1;
2390 int need_focus = 1;
2391 int need_save = 1;
2392
2393 BLOCK_INPUT;
2394 {
2395 Atom type, *atoms = 0;
2396 int format = 0;
2397 unsigned long nitems = 0;
2398 unsigned long bytes_after;
2399
2400 if ((XGetWindowProperty (dpy, w,
2401 FRAME_X_DISPLAY_INFO (f)->Xatom_wm_protocols,
2402 (long)0, (long)100, False, XA_ATOM,
2403 &type, &format, &nitems, &bytes_after,
2404 (unsigned char **) &atoms)
2405 == Success)
2406 && format == 32 && type == XA_ATOM)
2407 while (nitems > 0)
2408 {
2409 nitems--;
2410 if (atoms[nitems] == FRAME_X_DISPLAY_INFO (f)->Xatom_wm_delete_window)
2411 need_delete = 0;
2412 else if (atoms[nitems] == FRAME_X_DISPLAY_INFO (f)->Xatom_wm_take_focus)
2413 need_focus = 0;
2414 else if (atoms[nitems] == FRAME_X_DISPLAY_INFO (f)->Xatom_wm_save_yourself)
2415 need_save = 0;
2416 }
2417 if (atoms) XFree ((char *) atoms);
2418 }
2419 {
2420 Atom props [10];
2421 int count = 0;
2422 if (need_delete)
2423 props[count++] = FRAME_X_DISPLAY_INFO (f)->Xatom_wm_delete_window;
2424 if (need_focus)
2425 props[count++] = FRAME_X_DISPLAY_INFO (f)->Xatom_wm_take_focus;
2426 if (need_save)
2427 props[count++] = FRAME_X_DISPLAY_INFO (f)->Xatom_wm_save_yourself;
2428 if (count)
2429 XChangeProperty (dpy, w, FRAME_X_DISPLAY_INFO (f)->Xatom_wm_protocols,
2430 XA_ATOM, 32, PropModeAppend,
2431 (unsigned char *) props, count);
2432 }
2433 UNBLOCK_INPUT;
2434 }
2435 #endif
2436 \f
2437 #ifdef USE_X_TOOLKIT
2438
2439 /* Create and set up the X widget for frame F. */
2440
2441 static void
2442 x_window (f, window_prompting, minibuffer_only)
2443 struct frame *f;
2444 long window_prompting;
2445 int minibuffer_only;
2446 {
2447 XClassHint class_hints;
2448 XSetWindowAttributes attributes;
2449 unsigned long attribute_mask;
2450
2451 Widget shell_widget;
2452 Widget pane_widget;
2453 Widget frame_widget;
2454 Arg al [25];
2455 int ac;
2456
2457 BLOCK_INPUT;
2458
2459 /* Use the resource name as the top-level widget name
2460 for looking up resources. Make a non-Lisp copy
2461 for the window manager, so GC relocation won't bother it.
2462
2463 Elsewhere we specify the window name for the window manager. */
2464
2465 {
2466 char *str = (char *) XSTRING (Vx_resource_name)->data;
2467 f->namebuf = (char *) xmalloc (strlen (str) + 1);
2468 strcpy (f->namebuf, str);
2469 }
2470
2471 ac = 0;
2472 XtSetArg (al[ac], XtNallowShellResize, 1); ac++;
2473 XtSetArg (al[ac], XtNinput, 1); ac++;
2474 XtSetArg (al[ac], XtNmappedWhenManaged, 0); ac++;
2475 XtSetArg (al[ac], XtNborderWidth, f->output_data.x->border_width); ac++;
2476 shell_widget = XtAppCreateShell (f->namebuf, EMACS_CLASS,
2477 applicationShellWidgetClass,
2478 FRAME_X_DISPLAY (f), al, ac);
2479
2480 f->output_data.x->widget = shell_widget;
2481 /* maybe_set_screen_title_format (shell_widget); */
2482
2483 pane_widget = lw_create_widget ("main", "pane", widget_id_tick++,
2484 (widget_value *) NULL,
2485 shell_widget, False,
2486 (lw_callback) NULL,
2487 (lw_callback) NULL,
2488 (lw_callback) NULL);
2489
2490 f->output_data.x->column_widget = pane_widget;
2491
2492 /* mappedWhenManaged to false tells to the paned window to not map/unmap
2493 the emacs screen when changing menubar. This reduces flickering. */
2494
2495 ac = 0;
2496 XtSetArg (al[ac], XtNmappedWhenManaged, 0); ac++;
2497 XtSetArg (al[ac], XtNshowGrip, 0); ac++;
2498 XtSetArg (al[ac], XtNallowResize, 1); ac++;
2499 XtSetArg (al[ac], XtNresizeToPreferred, 1); ac++;
2500 XtSetArg (al[ac], XtNemacsFrame, f); ac++;
2501 frame_widget = XtCreateWidget (f->namebuf,
2502 emacsFrameClass,
2503 pane_widget, al, ac);
2504
2505 f->output_data.x->edit_widget = frame_widget;
2506
2507 XtManageChild (frame_widget);
2508
2509 /* Do some needed geometry management. */
2510 {
2511 int len;
2512 char *tem, shell_position[32];
2513 Arg al[2];
2514 int ac = 0;
2515 int extra_borders = 0;
2516 int menubar_size
2517 = (f->output_data.x->menubar_widget
2518 ? (f->output_data.x->menubar_widget->core.height
2519 + f->output_data.x->menubar_widget->core.border_width)
2520 : 0);
2521 extern char *lwlib_toolkit_type;
2522
2523 if (FRAME_EXTERNAL_MENU_BAR (f))
2524 {
2525 Dimension ibw = 0;
2526 XtVaGetValues (pane_widget, XtNinternalBorderWidth, &ibw, NULL);
2527 menubar_size += ibw;
2528 }
2529
2530 f->output_data.x->menubar_height = menubar_size;
2531
2532 /* Motif seems to need this amount added to the sizes
2533 specified for the shell widget. The Athena/Lucid widgets don't.
2534 Both conclusions reached experimentally. -- rms. */
2535 if (!strcmp (lwlib_toolkit_type, "motif"))
2536 XtVaGetValues (f->output_data.x->edit_widget, XtNinternalBorderWidth,
2537 &extra_borders, NULL);
2538
2539 /* Convert our geometry parameters into a geometry string
2540 and specify it.
2541 Note that we do not specify here whether the position
2542 is a user-specified or program-specified one.
2543 We pass that information later, in x_wm_set_size_hints. */
2544 {
2545 int left = f->output_data.x->left_pos;
2546 int xneg = window_prompting & XNegative;
2547 int top = f->output_data.x->top_pos;
2548 int yneg = window_prompting & YNegative;
2549 if (xneg)
2550 left = -left;
2551 if (yneg)
2552 top = -top;
2553
2554 if (window_prompting & USPosition)
2555 sprintf (shell_position, "=%dx%d%c%d%c%d",
2556 PIXEL_WIDTH (f) + extra_borders,
2557 PIXEL_HEIGHT (f) + menubar_size + extra_borders,
2558 (xneg ? '-' : '+'), left,
2559 (yneg ? '-' : '+'), top);
2560 else
2561 sprintf (shell_position, "=%dx%d",
2562 PIXEL_WIDTH (f) + extra_borders,
2563 PIXEL_HEIGHT (f) + menubar_size + extra_borders);
2564 }
2565
2566 len = strlen (shell_position) + 1;
2567 tem = (char *) xmalloc (len);
2568 strncpy (tem, shell_position, len);
2569 XtSetArg (al[ac], XtNgeometry, tem); ac++;
2570 XtSetValues (shell_widget, al, ac);
2571 }
2572
2573 XtManageChild (pane_widget);
2574 XtRealizeWidget (shell_widget);
2575
2576 FRAME_X_WINDOW (f) = XtWindow (frame_widget);
2577
2578 validate_x_resource_name ();
2579
2580 class_hints.res_name = (char *) XSTRING (Vx_resource_name)->data;
2581 class_hints.res_class = EMACS_CLASS;
2582 XSetClassHint (FRAME_X_DISPLAY (f), XtWindow (shell_widget), &class_hints);
2583
2584 f->output_data.x->wm_hints.input = True;
2585 f->output_data.x->wm_hints.flags |= InputHint;
2586 XSetWMHints (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
2587 &f->output_data.x->wm_hints);
2588
2589 hack_wm_protocols (f, shell_widget);
2590
2591 #ifdef HACK_EDITRES
2592 XtAddEventHandler (shell_widget, 0, True, _XEditResCheckMessages, 0);
2593 #endif
2594
2595 /* Do a stupid property change to force the server to generate a
2596 propertyNotify event so that the event_stream server timestamp will
2597 be initialized to something relevant to the time we created the window.
2598 */
2599 XChangeProperty (XtDisplay (frame_widget), XtWindow (frame_widget),
2600 FRAME_X_DISPLAY_INFO (f)->Xatom_wm_protocols,
2601 XA_ATOM, 32, PropModeAppend,
2602 (unsigned char*) NULL, 0);
2603
2604 /* Make all the standard events reach the Emacs frame. */
2605 attributes.event_mask = STANDARD_EVENT_SET;
2606 attribute_mask = CWEventMask;
2607 XChangeWindowAttributes (XtDisplay (shell_widget), XtWindow (shell_widget),
2608 attribute_mask, &attributes);
2609
2610 XtMapWidget (frame_widget);
2611
2612 /* x_set_name normally ignores requests to set the name if the
2613 requested name is the same as the current name. This is the one
2614 place where that assumption isn't correct; f->name is set, but
2615 the X server hasn't been told. */
2616 {
2617 Lisp_Object name;
2618 int explicit = f->explicit_name;
2619
2620 f->explicit_name = 0;
2621 name = f->name;
2622 f->name = Qnil;
2623 x_set_name (f, name, explicit);
2624 }
2625
2626 XDefineCursor (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
2627 f->output_data.x->text_cursor);
2628
2629 UNBLOCK_INPUT;
2630
2631 if (!minibuffer_only && FRAME_EXTERNAL_MENU_BAR (f))
2632 initialize_frame_menubar (f);
2633 lw_set_main_areas (pane_widget, f->output_data.x->menubar_widget, frame_widget);
2634
2635 if (FRAME_X_WINDOW (f) == 0)
2636 error ("Unable to create window");
2637 }
2638
2639 #else /* not USE_X_TOOLKIT */
2640
2641 /* Create and set up the X window for frame F. */
2642
2643 x_window (f)
2644 struct frame *f;
2645
2646 {
2647 XClassHint class_hints;
2648 XSetWindowAttributes attributes;
2649 unsigned long attribute_mask;
2650
2651 attributes.background_pixel = f->output_data.x->background_pixel;
2652 attributes.border_pixel = f->output_data.x->border_pixel;
2653 attributes.bit_gravity = StaticGravity;
2654 attributes.backing_store = NotUseful;
2655 attributes.save_under = True;
2656 attributes.event_mask = STANDARD_EVENT_SET;
2657 attribute_mask = (CWBackPixel | CWBorderPixel | CWBitGravity
2658 #if 0
2659 | CWBackingStore | CWSaveUnder
2660 #endif
2661 | CWEventMask);
2662
2663 BLOCK_INPUT;
2664 FRAME_X_WINDOW (f)
2665 = XCreateWindow (FRAME_X_DISPLAY (f),
2666 f->output_data.x->parent_desc,
2667 f->output_data.x->left_pos,
2668 f->output_data.x->top_pos,
2669 PIXEL_WIDTH (f), PIXEL_HEIGHT (f),
2670 f->output_data.x->border_width,
2671 CopyFromParent, /* depth */
2672 InputOutput, /* class */
2673 FRAME_X_DISPLAY_INFO (f)->visual,
2674 attribute_mask, &attributes);
2675
2676 validate_x_resource_name ();
2677
2678 class_hints.res_name = (char *) XSTRING (Vx_resource_name)->data;
2679 class_hints.res_class = EMACS_CLASS;
2680 XSetClassHint (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f), &class_hints);
2681
2682 /* The menubar is part of the ordinary display;
2683 it does not count in addition to the height of the window. */
2684 f->output_data.x->menubar_height = 0;
2685
2686 /* This indicates that we use the "Passive Input" input model.
2687 Unless we do this, we don't get the Focus{In,Out} events that we
2688 need to draw the cursor correctly. Accursed bureaucrats.
2689 XWhipsAndChains (FRAME_X_DISPLAY (f), IronMaiden, &TheRack); */
2690
2691 f->output_data.x->wm_hints.input = True;
2692 f->output_data.x->wm_hints.flags |= InputHint;
2693 XSetWMHints (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
2694 &f->output_data.x->wm_hints);
2695
2696 /* Request "save yourself" and "delete window" commands from wm. */
2697 {
2698 Atom protocols[2];
2699 protocols[0] = FRAME_X_DISPLAY_INFO (f)->Xatom_wm_delete_window;
2700 protocols[1] = FRAME_X_DISPLAY_INFO (f)->Xatom_wm_save_yourself;
2701 XSetWMProtocols (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f), protocols, 2);
2702 }
2703
2704 /* x_set_name normally ignores requests to set the name if the
2705 requested name is the same as the current name. This is the one
2706 place where that assumption isn't correct; f->name is set, but
2707 the X server hasn't been told. */
2708 {
2709 Lisp_Object name;
2710 int explicit = f->explicit_name;
2711
2712 f->explicit_name = 0;
2713 name = f->name;
2714 f->name = Qnil;
2715 x_set_name (f, name, explicit);
2716 }
2717
2718 XDefineCursor (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
2719 f->output_data.x->text_cursor);
2720
2721 UNBLOCK_INPUT;
2722
2723 if (FRAME_X_WINDOW (f) == 0)
2724 error ("Unable to create window");
2725 }
2726
2727 #endif /* not USE_X_TOOLKIT */
2728
2729 /* Handle the icon stuff for this window. Perhaps later we might
2730 want an x_set_icon_position which can be called interactively as
2731 well. */
2732
2733 static void
2734 x_icon (f, parms)
2735 struct frame *f;
2736 Lisp_Object parms;
2737 {
2738 Lisp_Object icon_x, icon_y;
2739
2740 /* Set the position of the icon. Note that twm groups all
2741 icons in an icon window. */
2742 icon_x = x_get_arg (parms, Qicon_left, 0, 0, number);
2743 icon_y = x_get_arg (parms, Qicon_top, 0, 0, number);
2744 if (!EQ (icon_x, Qunbound) && !EQ (icon_y, Qunbound))
2745 {
2746 CHECK_NUMBER (icon_x, 0);
2747 CHECK_NUMBER (icon_y, 0);
2748 }
2749 else if (!EQ (icon_x, Qunbound) || !EQ (icon_y, Qunbound))
2750 error ("Both left and top icon corners of icon must be specified");
2751
2752 BLOCK_INPUT;
2753
2754 if (! EQ (icon_x, Qunbound))
2755 x_wm_set_icon_position (f, XINT (icon_x), XINT (icon_y));
2756
2757 /* Start up iconic or window? */
2758 x_wm_set_window_state
2759 (f, (EQ (x_get_arg (parms, Qvisibility, 0, 0, symbol), Qicon)
2760 ? IconicState
2761 : NormalState));
2762
2763 x_text_icon (f, (char *) XSTRING ((!NILP (f->icon_name)
2764 ? f->icon_name
2765 : f->name))->data);
2766
2767 UNBLOCK_INPUT;
2768 }
2769
2770 /* Make the GC's needed for this window, setting the
2771 background, border and mouse colors; also create the
2772 mouse cursor and the gray border tile. */
2773
2774 static char cursor_bits[] =
2775 {
2776 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
2777 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
2778 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
2779 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00
2780 };
2781
2782 static void
2783 x_make_gc (f)
2784 struct frame *f;
2785 {
2786 XGCValues gc_values;
2787 GC temp_gc;
2788 XImage tileimage;
2789
2790 BLOCK_INPUT;
2791
2792 /* Create the GC's of this frame.
2793 Note that many default values are used. */
2794
2795 /* Normal video */
2796 gc_values.font = f->output_data.x->font->fid;
2797 gc_values.foreground = f->output_data.x->foreground_pixel;
2798 gc_values.background = f->output_data.x->background_pixel;
2799 gc_values.line_width = 0; /* Means 1 using fast algorithm. */
2800 f->output_data.x->normal_gc = XCreateGC (FRAME_X_DISPLAY (f),
2801 FRAME_X_WINDOW (f),
2802 GCLineWidth | GCFont
2803 | GCForeground | GCBackground,
2804 &gc_values);
2805
2806 /* Reverse video style. */
2807 gc_values.foreground = f->output_data.x->background_pixel;
2808 gc_values.background = f->output_data.x->foreground_pixel;
2809 f->output_data.x->reverse_gc = XCreateGC (FRAME_X_DISPLAY (f),
2810 FRAME_X_WINDOW (f),
2811 GCFont | GCForeground | GCBackground
2812 | GCLineWidth,
2813 &gc_values);
2814
2815 /* Cursor has cursor-color background, background-color foreground. */
2816 gc_values.foreground = f->output_data.x->background_pixel;
2817 gc_values.background = f->output_data.x->cursor_pixel;
2818 gc_values.fill_style = FillOpaqueStippled;
2819 gc_values.stipple
2820 = XCreateBitmapFromData (FRAME_X_DISPLAY (f),
2821 FRAME_X_DISPLAY_INFO (f)->root_window,
2822 cursor_bits, 16, 16);
2823 f->output_data.x->cursor_gc
2824 = XCreateGC (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
2825 (GCFont | GCForeground | GCBackground
2826 | GCFillStyle | GCStipple | GCLineWidth),
2827 &gc_values);
2828
2829 /* Create the gray border tile used when the pointer is not in
2830 the frame. Since this depends on the frame's pixel values,
2831 this must be done on a per-frame basis. */
2832 f->output_data.x->border_tile
2833 = (XCreatePixmapFromBitmapData
2834 (FRAME_X_DISPLAY (f), FRAME_X_DISPLAY_INFO (f)->root_window,
2835 gray_bits, gray_width, gray_height,
2836 f->output_data.x->foreground_pixel,
2837 f->output_data.x->background_pixel,
2838 DefaultDepth (FRAME_X_DISPLAY (f),
2839 XScreenNumberOfScreen (FRAME_X_SCREEN (f)))));
2840
2841 UNBLOCK_INPUT;
2842 }
2843
2844 DEFUN ("x-create-frame", Fx_create_frame, Sx_create_frame,
2845 1, 1, 0,
2846 "Make a new X window, which is called a \"frame\" in Emacs terms.\n\
2847 Returns an Emacs frame object.\n\
2848 ALIST is an alist of frame parameters.\n\
2849 If the parameters specify that the frame should not have a minibuffer,\n\
2850 and do not specify a specific minibuffer window to use,\n\
2851 then `default-minibuffer-frame' must be a frame whose minibuffer can\n\
2852 be shared by the new frame.\n\
2853 \n\
2854 This function is an internal primitive--use `make-frame' instead.")
2855 (parms)
2856 Lisp_Object parms;
2857 {
2858 struct frame *f;
2859 Lisp_Object frame, tem;
2860 Lisp_Object name;
2861 int minibuffer_only = 0;
2862 long window_prompting = 0;
2863 int width, height;
2864 int count = specpdl_ptr - specpdl;
2865 struct gcpro gcpro1;
2866 Lisp_Object display;
2867 struct x_display_info *dpyinfo;
2868 Lisp_Object parent;
2869 struct kboard *kb;
2870
2871 check_x ();
2872
2873 /* Use this general default value to start with
2874 until we know if this frame has a specified name. */
2875 Vx_resource_name = Vinvocation_name;
2876
2877 display = x_get_arg (parms, Qdisplay, 0, 0, string);
2878 if (EQ (display, Qunbound))
2879 display = Qnil;
2880 dpyinfo = check_x_display_info (display);
2881 #ifdef MULTI_KBOARD
2882 kb = dpyinfo->kboard;
2883 #else
2884 kb = &the_only_kboard;
2885 #endif
2886
2887 name = x_get_arg (parms, Qname, "title", "Title", string);
2888 if (!STRINGP (name)
2889 && ! EQ (name, Qunbound)
2890 && ! NILP (name))
2891 error ("Invalid frame name--not a string or nil");
2892
2893 if (STRINGP (name))
2894 Vx_resource_name = name;
2895
2896 /* See if parent window is specified. */
2897 parent = x_get_arg (parms, Qparent_id, NULL, NULL, number);
2898 if (EQ (parent, Qunbound))
2899 parent = Qnil;
2900 if (! NILP (parent))
2901 CHECK_NUMBER (parent, 0);
2902
2903 tem = x_get_arg (parms, Qminibuffer, 0, 0, symbol);
2904 if (EQ (tem, Qnone) || NILP (tem))
2905 f = make_frame_without_minibuffer (Qnil, kb, display);
2906 else if (EQ (tem, Qonly))
2907 {
2908 f = make_minibuffer_frame ();
2909 minibuffer_only = 1;
2910 }
2911 else if (WINDOWP (tem))
2912 f = make_frame_without_minibuffer (tem, kb, display);
2913 else
2914 f = make_frame (1);
2915
2916 /* Note that X Windows does support scroll bars. */
2917 FRAME_CAN_HAVE_SCROLL_BARS (f) = 1;
2918
2919 XSETFRAME (frame, f);
2920 GCPRO1 (frame);
2921
2922 f->output_method = output_x_window;
2923 f->output_data.x = (struct x_output *) xmalloc (sizeof (struct x_output));
2924 bzero (f->output_data.x, sizeof (struct x_output));
2925 f->output_data.x->icon_bitmap = -1;
2926
2927 f->icon_name
2928 = x_get_arg (parms, Qicon_name, "iconName", "Title", string);
2929 if (! STRINGP (f->icon_name))
2930 f->icon_name = Qnil;
2931
2932 FRAME_X_DISPLAY_INFO (f) = dpyinfo;
2933 #ifdef MULTI_KBOARD
2934 FRAME_KBOARD (f) = kb;
2935 #endif
2936
2937 /* Specify the parent under which to make this X window. */
2938
2939 if (!NILP (parent))
2940 {
2941 f->output_data.x->parent_desc = parent;
2942 f->output_data.x->explicit_parent = 1;
2943 }
2944 else
2945 {
2946 f->output_data.x->parent_desc = FRAME_X_DISPLAY_INFO (f)->root_window;
2947 f->output_data.x->explicit_parent = 0;
2948 }
2949
2950 /* Note that the frame has no physical cursor right now. */
2951 f->phys_cursor_x = -1;
2952
2953 /* Set the name; the functions to which we pass f expect the name to
2954 be set. */
2955 if (EQ (name, Qunbound) || NILP (name))
2956 {
2957 f->name = build_string (dpyinfo->x_id_name);
2958 f->explicit_name = 0;
2959 }
2960 else
2961 {
2962 f->name = name;
2963 f->explicit_name = 1;
2964 /* use the frame's title when getting resources for this frame. */
2965 specbind (Qx_resource_name, name);
2966 }
2967
2968 /* Extract the window parameters from the supplied values
2969 that are needed to determine window geometry. */
2970 {
2971 Lisp_Object font;
2972
2973 font = x_get_arg (parms, Qfont, "font", "Font", string);
2974 BLOCK_INPUT;
2975 /* First, try whatever font the caller has specified. */
2976 if (STRINGP (font))
2977 font = x_new_font (f, XSTRING (font)->data);
2978 /* Try out a font which we hope has bold and italic variations. */
2979 if (!STRINGP (font))
2980 font = x_new_font (f, "-misc-fixed-medium-r-normal-*-*-140-*-*-c-*-iso8859-1");
2981 if (! STRINGP (font))
2982 font = x_new_font (f, "-*-*-medium-r-normal-*-*-140-*-*-c-*-iso8859-1");
2983 if (! STRINGP (font))
2984 /* This was formerly the first thing tried, but it finds too many fonts
2985 and takes too long. */
2986 font = x_new_font (f, "-*-*-medium-r-*-*-*-*-*-*-c-*-iso8859-1");
2987 /* If those didn't work, look for something which will at least work. */
2988 if (! STRINGP (font))
2989 font = x_new_font (f, "-*-fixed-*-*-*-*-*-140-*-*-c-*-iso8859-1");
2990 UNBLOCK_INPUT;
2991 if (! STRINGP (font))
2992 font = build_string ("fixed");
2993
2994 x_default_parameter (f, parms, Qfont, font,
2995 "font", "Font", string);
2996 }
2997
2998 #ifdef USE_X_TOOLKIT
2999 /* Prevent lwlib/xlwmenu.c from crashing because of a bug
3000 whereby it fails to get any font. */
3001 xlwmenu_default_font = f->output_data.x->font;
3002 #endif
3003
3004 x_default_parameter (f, parms, Qborder_width, make_number (2),
3005 "borderwidth", "BorderWidth", number);
3006 /* This defaults to 2 in order to match xterm. We recognize either
3007 internalBorderWidth or internalBorder (which is what xterm calls
3008 it). */
3009 if (NILP (Fassq (Qinternal_border_width, parms)))
3010 {
3011 Lisp_Object value;
3012
3013 value = x_get_arg (parms, Qinternal_border_width,
3014 "internalBorder", "BorderWidth", number);
3015 if (! EQ (value, Qunbound))
3016 parms = Fcons (Fcons (Qinternal_border_width, value),
3017 parms);
3018 }
3019 x_default_parameter (f, parms, Qinternal_border_width, make_number (2),
3020 "internalBorderWidth", "BorderWidth", number);
3021 x_default_parameter (f, parms, Qvertical_scroll_bars, Qt,
3022 "verticalScrollBars", "ScrollBars", boolean);
3023
3024 /* Also do the stuff which must be set before the window exists. */
3025 x_default_parameter (f, parms, Qforeground_color, build_string ("black"),
3026 "foreground", "Foreground", string);
3027 x_default_parameter (f, parms, Qbackground_color, build_string ("white"),
3028 "background", "Background", string);
3029 x_default_parameter (f, parms, Qmouse_color, build_string ("black"),
3030 "pointerColor", "Foreground", string);
3031 x_default_parameter (f, parms, Qcursor_color, build_string ("black"),
3032 "cursorColor", "Foreground", string);
3033 x_default_parameter (f, parms, Qborder_color, build_string ("black"),
3034 "borderColor", "BorderColor", string);
3035
3036 x_default_parameter (f, parms, Qmenu_bar_lines, make_number (1),
3037 "menuBar", "MenuBar", number);
3038 x_default_parameter (f, parms, Qscroll_bar_width, Qnil,
3039 "scrollBarWidth", "ScrollBarWidth", number);
3040 x_default_parameter (f, parms, Qbuffer_predicate, Qnil,
3041 "bufferPredicate", "BufferPredicate", symbol);
3042
3043 f->output_data.x->parent_desc = FRAME_X_DISPLAY_INFO (f)->root_window;
3044 window_prompting = x_figure_window_size (f, parms);
3045
3046 if (window_prompting & XNegative)
3047 {
3048 if (window_prompting & YNegative)
3049 f->output_data.x->win_gravity = SouthEastGravity;
3050 else
3051 f->output_data.x->win_gravity = NorthEastGravity;
3052 }
3053 else
3054 {
3055 if (window_prompting & YNegative)
3056 f->output_data.x->win_gravity = SouthWestGravity;
3057 else
3058 f->output_data.x->win_gravity = NorthWestGravity;
3059 }
3060
3061 f->output_data.x->size_hint_flags = window_prompting;
3062
3063 #ifdef USE_X_TOOLKIT
3064 x_window (f, window_prompting, minibuffer_only);
3065 #else
3066 x_window (f);
3067 #endif
3068 x_icon (f, parms);
3069 x_make_gc (f);
3070 init_frame_faces (f);
3071
3072 /* We need to do this after creating the X window, so that the
3073 icon-creation functions can say whose icon they're describing. */
3074 x_default_parameter (f, parms, Qicon_type, Qnil,
3075 "bitmapIcon", "BitmapIcon", symbol);
3076
3077 x_default_parameter (f, parms, Qauto_raise, Qnil,
3078 "autoRaise", "AutoRaiseLower", boolean);
3079 x_default_parameter (f, parms, Qauto_lower, Qnil,
3080 "autoLower", "AutoRaiseLower", boolean);
3081 x_default_parameter (f, parms, Qcursor_type, Qbox,
3082 "cursorType", "CursorType", symbol);
3083
3084 /* Dimensions, especially f->height, must be done via change_frame_size.
3085 Change will not be effected unless different from the current
3086 f->height. */
3087 width = f->width;
3088 height = f->height;
3089 f->height = f->width = 0;
3090 change_frame_size (f, height, width, 1, 0);
3091
3092 /* Tell the server what size and position, etc, we want,
3093 and how badly we want them. */
3094 BLOCK_INPUT;
3095 x_wm_set_size_hint (f, window_prompting, 0);
3096 UNBLOCK_INPUT;
3097
3098 tem = x_get_arg (parms, Qunsplittable, 0, 0, boolean);
3099 f->no_split = minibuffer_only || EQ (tem, Qt);
3100
3101 UNGCPRO;
3102
3103 /* It is now ok to make the frame official
3104 even if we get an error below.
3105 And the frame needs to be on Vframe_list
3106 or making it visible won't work. */
3107 Vframe_list = Fcons (frame, Vframe_list);
3108
3109 /* Now that the frame is official, it counts as a reference to
3110 its display. */
3111 FRAME_X_DISPLAY_INFO (f)->reference_count++;
3112
3113 /* Make the window appear on the frame and enable display,
3114 unless the caller says not to. However, with explicit parent,
3115 Emacs cannot control visibility, so don't try. */
3116 if (! f->output_data.x->explicit_parent)
3117 {
3118 Lisp_Object visibility;
3119
3120 visibility = x_get_arg (parms, Qvisibility, 0, 0, symbol);
3121 if (EQ (visibility, Qunbound))
3122 visibility = Qt;
3123
3124 if (EQ (visibility, Qicon))
3125 x_iconify_frame (f);
3126 else if (! NILP (visibility))
3127 x_make_frame_visible (f);
3128 else
3129 /* Must have been Qnil. */
3130 ;
3131 }
3132
3133 return unbind_to (count, frame);
3134 }
3135
3136 /* FRAME is used only to get a handle on the X display. We don't pass the
3137 display info directly because we're called from frame.c, which doesn't
3138 know about that structure. */
3139 Lisp_Object
3140 x_get_focus_frame (frame)
3141 struct frame *frame;
3142 {
3143 struct x_display_info *dpyinfo = FRAME_X_DISPLAY_INFO (frame);
3144 Lisp_Object xfocus;
3145 if (! dpyinfo->x_focus_frame)
3146 return Qnil;
3147
3148 XSETFRAME (xfocus, dpyinfo->x_focus_frame);
3149 return xfocus;
3150 }
3151
3152 DEFUN ("focus-frame", Ffocus_frame, Sfocus_frame, 1, 1, 0,
3153 "This function is obsolete, and does nothing.")
3154 (frame)
3155 Lisp_Object frame;
3156 {
3157 return Qnil;
3158 }
3159
3160 DEFUN ("unfocus-frame", Funfocus_frame, Sunfocus_frame, 0, 0, 0,
3161 "This function is obsolete, and does nothing.")
3162 ()
3163 {
3164 return Qnil;
3165 }
3166 \f
3167 DEFUN ("x-list-fonts", Fx_list_fonts, Sx_list_fonts, 1, 3, 0,
3168 "Return a list of the names of available fonts matching PATTERN.\n\
3169 If optional arguments FACE and FRAME are specified, return only fonts\n\
3170 the same size as FACE on FRAME.\n\
3171 \n\
3172 PATTERN is a string, perhaps with wildcard characters;\n\
3173 the * character matches any substring, and\n\
3174 the ? character matches any single character.\n\
3175 PATTERN is case-insensitive.\n\
3176 FACE is a face name--a symbol.\n\
3177 \n\
3178 The return value is a list of strings, suitable as arguments to\n\
3179 set-face-font.\n\
3180 \n\
3181 Fonts Emacs can't use (i.e. proportional fonts) may or may not be excluded\n\
3182 even if they match PATTERN and FACE.")
3183 (pattern, face, frame)
3184 Lisp_Object pattern, face, frame;
3185 {
3186 int num_fonts;
3187 char **names;
3188 #ifndef BROKEN_XLISTFONTSWITHINFO
3189 XFontStruct *info;
3190 #endif
3191 XFontStruct *size_ref;
3192 Lisp_Object list;
3193 FRAME_PTR f;
3194
3195 check_x ();
3196 CHECK_STRING (pattern, 0);
3197 if (!NILP (face))
3198 CHECK_SYMBOL (face, 1);
3199
3200 f = check_x_frame (frame);
3201
3202 /* Determine the width standard for comparison with the fonts we find. */
3203
3204 if (NILP (face))
3205 size_ref = 0;
3206 else
3207 {
3208 int face_id;
3209
3210 /* Don't die if we get called with a terminal frame. */
3211 if (! FRAME_X_P (f))
3212 error ("non-X frame used in `x-list-fonts'");
3213
3214 face_id = face_name_id_number (f, face);
3215
3216 if (face_id < 0 || face_id >= FRAME_N_PARAM_FACES (f)
3217 || FRAME_PARAM_FACES (f) [face_id] == 0)
3218 size_ref = f->output_data.x->font;
3219 else
3220 {
3221 size_ref = FRAME_PARAM_FACES (f) [face_id]->font;
3222 if (size_ref == (XFontStruct *) (~0))
3223 size_ref = f->output_data.x->font;
3224 }
3225 }
3226
3227 /* See if we cached the result for this particular query. */
3228 list = Fassoc (pattern,
3229 XCONS (FRAME_X_DISPLAY_INFO (f)->name_list_element)->cdr);
3230
3231 /* We have info in the cache for this PATTERN. */
3232 if (!NILP (list))
3233 {
3234 Lisp_Object tem, newlist;
3235
3236 /* We have info about this pattern. */
3237 list = XCONS (list)->cdr;
3238
3239 if (size_ref == 0)
3240 return list;
3241
3242 BLOCK_INPUT;
3243
3244 /* Filter the cached info and return just the fonts that match FACE. */
3245 newlist = Qnil;
3246 for (tem = list; CONSP (tem); tem = XCONS (tem)->cdr)
3247 {
3248 XFontStruct *thisinfo;
3249
3250 thisinfo = XLoadQueryFont (FRAME_X_DISPLAY (f),
3251 XSTRING (XCONS (tem)->car)->data);
3252
3253 if (thisinfo && same_size_fonts (thisinfo, size_ref))
3254 newlist = Fcons (XCONS (tem)->car, newlist);
3255
3256 if (thisinfo != 0)
3257 XFreeFont (FRAME_X_DISPLAY (f), thisinfo);
3258 }
3259
3260 UNBLOCK_INPUT;
3261
3262 return newlist;
3263 }
3264
3265 BLOCK_INPUT;
3266
3267 /* Solaris 2.3 has a bug in XListFontsWithInfo. */
3268 #ifndef BROKEN_XLISTFONTSWITHINFO
3269 if (size_ref)
3270 names = XListFontsWithInfo (FRAME_X_DISPLAY (f),
3271 XSTRING (pattern)->data,
3272 2000, /* maxnames */
3273 &num_fonts, /* count_return */
3274 &info); /* info_return */
3275 else
3276 #endif
3277 names = XListFonts (FRAME_X_DISPLAY (f),
3278 XSTRING (pattern)->data,
3279 2000, /* maxnames */
3280 &num_fonts); /* count_return */
3281
3282 UNBLOCK_INPUT;
3283
3284 list = Qnil;
3285
3286 if (names)
3287 {
3288 int i;
3289 Lisp_Object full_list;
3290
3291 /* Make a list of all the fonts we got back.
3292 Store that in the font cache for the display. */
3293 full_list = Qnil;
3294 for (i = 0; i < num_fonts; i++)
3295 full_list = Fcons (build_string (names[i]), full_list);
3296 XCONS (FRAME_X_DISPLAY_INFO (f)->name_list_element)->cdr
3297 = Fcons (Fcons (pattern, full_list),
3298 XCONS (FRAME_X_DISPLAY_INFO (f)->name_list_element)->cdr);
3299
3300 /* Make a list of the fonts that have the right width. */
3301 list = Qnil;
3302 for (i = 0; i < num_fonts; i++)
3303 {
3304 int keeper;
3305
3306 if (!size_ref)
3307 keeper = 1;
3308 else
3309 {
3310 #ifdef BROKEN_XLISTFONTSWITHINFO
3311 XFontStruct *thisinfo;
3312
3313 BLOCK_INPUT;
3314 thisinfo = XLoadQueryFont (FRAME_X_DISPLAY (f), names[i]);
3315 UNBLOCK_INPUT;
3316
3317 keeper = thisinfo && same_size_fonts (thisinfo, size_ref);
3318 #else
3319 keeper = same_size_fonts (&info[i], size_ref);
3320 #endif
3321 }
3322 if (keeper)
3323 list = Fcons (build_string (names[i]), list);
3324 }
3325 list = Fnreverse (list);
3326
3327 BLOCK_INPUT;
3328 #ifndef BROKEN_XLISTFONTSWITHINFO
3329 if (size_ref)
3330 XFreeFontInfo (names, info, num_fonts);
3331 else
3332 #endif
3333 XFreeFontNames (names);
3334 UNBLOCK_INPUT;
3335 }
3336
3337 return list;
3338 }
3339
3340 \f
3341 DEFUN ("x-color-defined-p", Fx_color_defined_p, Sx_color_defined_p, 1, 2, 0,
3342 "Return non-nil if color COLOR is supported on frame FRAME.\n\
3343 If FRAME is omitted or nil, use the selected frame.")
3344 (color, frame)
3345 Lisp_Object color, frame;
3346 {
3347 XColor foo;
3348 FRAME_PTR f = check_x_frame (frame);
3349
3350 CHECK_STRING (color, 1);
3351
3352 if (defined_color (f, XSTRING (color)->data, &foo, 0))
3353 return Qt;
3354 else
3355 return Qnil;
3356 }
3357
3358 DEFUN ("x-color-values", Fx_color_values, Sx_color_values, 1, 2, 0,
3359 "Return a description of the color named COLOR on frame FRAME.\n\
3360 The value is a list of integer RGB values--(RED GREEN BLUE).\n\
3361 These values appear to range from 0 to 65280 or 65535, depending\n\
3362 on the system; white is (65280 65280 65280) or (65535 65535 65535).\n\
3363 If FRAME is omitted or nil, use the selected frame.")
3364 (color, frame)
3365 Lisp_Object color, frame;
3366 {
3367 XColor foo;
3368 FRAME_PTR f = check_x_frame (frame);
3369
3370 CHECK_STRING (color, 1);
3371
3372 if (defined_color (f, XSTRING (color)->data, &foo, 0))
3373 {
3374 Lisp_Object rgb[3];
3375
3376 rgb[0] = make_number (foo.red);
3377 rgb[1] = make_number (foo.green);
3378 rgb[2] = make_number (foo.blue);
3379 return Flist (3, rgb);
3380 }
3381 else
3382 return Qnil;
3383 }
3384
3385 DEFUN ("x-display-color-p", Fx_display_color_p, Sx_display_color_p, 0, 1, 0,
3386 "Return t if the X display supports color.\n\
3387 The optional argument DISPLAY specifies which display to ask about.\n\
3388 DISPLAY should be either a frame or a display name (a string).\n\
3389 If omitted or nil, that stands for the selected frame's display.")
3390 (display)
3391 Lisp_Object display;
3392 {
3393 struct x_display_info *dpyinfo = check_x_display_info (display);
3394
3395 if (dpyinfo->n_planes <= 2)
3396 return Qnil;
3397
3398 switch (dpyinfo->visual->class)
3399 {
3400 case StaticColor:
3401 case PseudoColor:
3402 case TrueColor:
3403 case DirectColor:
3404 return Qt;
3405
3406 default:
3407 return Qnil;
3408 }
3409 }
3410
3411 DEFUN ("x-display-grayscale-p", Fx_display_grayscale_p, Sx_display_grayscale_p,
3412 0, 1, 0,
3413 "Return t if the X display supports shades of gray.\n\
3414 Note that color displays do support shades of gray.\n\
3415 The optional argument DISPLAY specifies which display to ask about.\n\
3416 DISPLAY should be either a frame or a display name (a string).\n\
3417 If omitted or nil, that stands for the selected frame's display.")
3418 (display)
3419 Lisp_Object display;
3420 {
3421 struct x_display_info *dpyinfo = check_x_display_info (display);
3422
3423 if (dpyinfo->n_planes <= 1)
3424 return Qnil;
3425
3426 switch (dpyinfo->visual->class)
3427 {
3428 case StaticColor:
3429 case PseudoColor:
3430 case TrueColor:
3431 case DirectColor:
3432 case StaticGray:
3433 case GrayScale:
3434 return Qt;
3435
3436 default:
3437 return Qnil;
3438 }
3439 }
3440
3441 DEFUN ("x-display-pixel-width", Fx_display_pixel_width, Sx_display_pixel_width,
3442 0, 1, 0,
3443 "Returns the width in pixels of the X display DISPLAY.\n\
3444 The optional argument DISPLAY specifies which display to ask about.\n\
3445 DISPLAY should be either a frame or a display name (a string).\n\
3446 If omitted or nil, that stands for the selected frame's display.")
3447 (display)
3448 Lisp_Object display;
3449 {
3450 struct x_display_info *dpyinfo = check_x_display_info (display);
3451
3452 return make_number (dpyinfo->width);
3453 }
3454
3455 DEFUN ("x-display-pixel-height", Fx_display_pixel_height,
3456 Sx_display_pixel_height, 0, 1, 0,
3457 "Returns the height in pixels of the X display DISPLAY.\n\
3458 The optional argument DISPLAY specifies which display to ask about.\n\
3459 DISPLAY should be either a frame or a display name (a string).\n\
3460 If omitted or nil, that stands for the selected frame's display.")
3461 (display)
3462 Lisp_Object display;
3463 {
3464 struct x_display_info *dpyinfo = check_x_display_info (display);
3465
3466 return make_number (dpyinfo->height);
3467 }
3468
3469 DEFUN ("x-display-planes", Fx_display_planes, Sx_display_planes,
3470 0, 1, 0,
3471 "Returns the number of bitplanes of the X display DISPLAY.\n\
3472 The optional argument DISPLAY specifies which display to ask about.\n\
3473 DISPLAY should be either a frame or a display name (a string).\n\
3474 If omitted or nil, that stands for the selected frame's display.")
3475 (display)
3476 Lisp_Object display;
3477 {
3478 struct x_display_info *dpyinfo = check_x_display_info (display);
3479
3480 return make_number (dpyinfo->n_planes);
3481 }
3482
3483 DEFUN ("x-display-color-cells", Fx_display_color_cells, Sx_display_color_cells,
3484 0, 1, 0,
3485 "Returns the number of color cells of the X display DISPLAY.\n\
3486 The optional argument DISPLAY specifies which display to ask about.\n\
3487 DISPLAY should be either a frame or a display name (a string).\n\
3488 If omitted or nil, that stands for the selected frame's display.")
3489 (display)
3490 Lisp_Object display;
3491 {
3492 struct x_display_info *dpyinfo = check_x_display_info (display);
3493
3494 return make_number (DisplayCells (dpyinfo->display,
3495 XScreenNumberOfScreen (dpyinfo->screen)));
3496 }
3497
3498 DEFUN ("x-server-max-request-size", Fx_server_max_request_size,
3499 Sx_server_max_request_size,
3500 0, 1, 0,
3501 "Returns the maximum request size of the X server of display DISPLAY.\n\
3502 The optional argument DISPLAY specifies which display to ask about.\n\
3503 DISPLAY should be either a frame or a display name (a string).\n\
3504 If omitted or nil, that stands for the selected frame's display.")
3505 (display)
3506 Lisp_Object display;
3507 {
3508 struct x_display_info *dpyinfo = check_x_display_info (display);
3509
3510 return make_number (MAXREQUEST (dpyinfo->display));
3511 }
3512
3513 DEFUN ("x-server-vendor", Fx_server_vendor, Sx_server_vendor, 0, 1, 0,
3514 "Returns the vendor ID string of the X server of display DISPLAY.\n\
3515 The optional argument DISPLAY specifies which display to ask about.\n\
3516 DISPLAY should be either a frame or a display name (a string).\n\
3517 If omitted or nil, that stands for the selected frame's display.")
3518 (display)
3519 Lisp_Object display;
3520 {
3521 struct x_display_info *dpyinfo = check_x_display_info (display);
3522 char *vendor = ServerVendor (dpyinfo->display);
3523
3524 if (! vendor) vendor = "";
3525 return build_string (vendor);
3526 }
3527
3528 DEFUN ("x-server-version", Fx_server_version, Sx_server_version, 0, 1, 0,
3529 "Returns the version numbers of the X server of display DISPLAY.\n\
3530 The value is a list of three integers: the major and minor\n\
3531 version numbers of the X Protocol in use, and the vendor-specific release\n\
3532 number. See also the function `x-server-vendor'.\n\n\
3533 The optional argument DISPLAY specifies which display to ask about.\n\
3534 DISPLAY should be either a frame or a display name (a string).\n\
3535 If omitted or nil, that stands for the selected frame's display.")
3536 (display)
3537 Lisp_Object display;
3538 {
3539 struct x_display_info *dpyinfo = check_x_display_info (display);
3540 Display *dpy = dpyinfo->display;
3541
3542 return Fcons (make_number (ProtocolVersion (dpy)),
3543 Fcons (make_number (ProtocolRevision (dpy)),
3544 Fcons (make_number (VendorRelease (dpy)), Qnil)));
3545 }
3546
3547 DEFUN ("x-display-screens", Fx_display_screens, Sx_display_screens, 0, 1, 0,
3548 "Returns the number of screens on the X server of display DISPLAY.\n\
3549 The optional argument DISPLAY specifies which display to ask about.\n\
3550 DISPLAY should be either a frame or a display name (a string).\n\
3551 If omitted or nil, that stands for the selected frame's display.")
3552 (display)
3553 Lisp_Object display;
3554 {
3555 struct x_display_info *dpyinfo = check_x_display_info (display);
3556
3557 return make_number (ScreenCount (dpyinfo->display));
3558 }
3559
3560 DEFUN ("x-display-mm-height", Fx_display_mm_height, Sx_display_mm_height, 0, 1, 0,
3561 "Returns the height in millimeters of the X display DISPLAY.\n\
3562 The optional argument DISPLAY specifies which display to ask about.\n\
3563 DISPLAY should be either a frame or a display name (a string).\n\
3564 If omitted or nil, that stands for the selected frame's display.")
3565 (display)
3566 Lisp_Object display;
3567 {
3568 struct x_display_info *dpyinfo = check_x_display_info (display);
3569
3570 return make_number (HeightMMOfScreen (dpyinfo->screen));
3571 }
3572
3573 DEFUN ("x-display-mm-width", Fx_display_mm_width, Sx_display_mm_width, 0, 1, 0,
3574 "Returns the width in millimeters of the X display DISPLAY.\n\
3575 The optional argument DISPLAY specifies which display to ask about.\n\
3576 DISPLAY should be either a frame or a display name (a string).\n\
3577 If omitted or nil, that stands for the selected frame's display.")
3578 (display)
3579 Lisp_Object display;
3580 {
3581 struct x_display_info *dpyinfo = check_x_display_info (display);
3582
3583 return make_number (WidthMMOfScreen (dpyinfo->screen));
3584 }
3585
3586 DEFUN ("x-display-backing-store", Fx_display_backing_store,
3587 Sx_display_backing_store, 0, 1, 0,
3588 "Returns an indication of whether X display DISPLAY does backing store.\n\
3589 The value may be `always', `when-mapped', or `not-useful'.\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 switch (DoesBackingStore (dpyinfo->screen))
3599 {
3600 case Always:
3601 return intern ("always");
3602
3603 case WhenMapped:
3604 return intern ("when-mapped");
3605
3606 case NotUseful:
3607 return intern ("not-useful");
3608
3609 default:
3610 error ("Strange value for BackingStore parameter of screen");
3611 }
3612 }
3613
3614 DEFUN ("x-display-visual-class", Fx_display_visual_class,
3615 Sx_display_visual_class, 0, 1, 0,
3616 "Returns the visual class of the X display DISPLAY.\n\
3617 The value is one of the symbols `static-gray', `gray-scale',\n\
3618 `static-color', `pseudo-color', `true-color', or `direct-color'.\n\n\
3619 The optional argument DISPLAY specifies which display to ask about.\n\
3620 DISPLAY should be either a frame or a display name (a string).\n\
3621 If omitted or nil, that stands for the selected frame's display.")
3622 (display)
3623 Lisp_Object display;
3624 {
3625 struct x_display_info *dpyinfo = check_x_display_info (display);
3626
3627 switch (dpyinfo->visual->class)
3628 {
3629 case StaticGray: return (intern ("static-gray"));
3630 case GrayScale: return (intern ("gray-scale"));
3631 case StaticColor: return (intern ("static-color"));
3632 case PseudoColor: return (intern ("pseudo-color"));
3633 case TrueColor: return (intern ("true-color"));
3634 case DirectColor: return (intern ("direct-color"));
3635 default:
3636 error ("Display has an unknown visual class");
3637 }
3638 }
3639
3640 DEFUN ("x-display-save-under", Fx_display_save_under,
3641 Sx_display_save_under, 0, 1, 0,
3642 "Returns t if the X display DISPLAY supports the save-under feature.\n\
3643 The optional argument DISPLAY specifies which display to ask about.\n\
3644 DISPLAY should be either a frame or a display name (a string).\n\
3645 If omitted or nil, that stands for the selected frame's display.")
3646 (display)
3647 Lisp_Object display;
3648 {
3649 struct x_display_info *dpyinfo = check_x_display_info (display);
3650
3651 if (DoesSaveUnders (dpyinfo->screen) == True)
3652 return Qt;
3653 else
3654 return Qnil;
3655 }
3656 \f
3657 int
3658 x_pixel_width (f)
3659 register struct frame *f;
3660 {
3661 return PIXEL_WIDTH (f);
3662 }
3663
3664 int
3665 x_pixel_height (f)
3666 register struct frame *f;
3667 {
3668 return PIXEL_HEIGHT (f);
3669 }
3670
3671 int
3672 x_char_width (f)
3673 register struct frame *f;
3674 {
3675 return FONT_WIDTH (f->output_data.x->font);
3676 }
3677
3678 int
3679 x_char_height (f)
3680 register struct frame *f;
3681 {
3682 return f->output_data.x->line_height;
3683 }
3684
3685 int
3686 x_screen_planes (frame)
3687 Lisp_Object frame;
3688 {
3689 return FRAME_X_DISPLAY_INFO (XFRAME (frame))->n_planes;
3690 }
3691 \f
3692 #if 0 /* These no longer seem like the right way to do things. */
3693
3694 /* Draw a rectangle on the frame with left top corner including
3695 the character specified by LEFT_CHAR and TOP_CHAR. The rectangle is
3696 CHARS by LINES wide and long and is the color of the cursor. */
3697
3698 void
3699 x_rectangle (f, gc, left_char, top_char, chars, lines)
3700 register struct frame *f;
3701 GC gc;
3702 register int top_char, left_char, chars, lines;
3703 {
3704 int width;
3705 int height;
3706 int left = (left_char * FONT_WIDTH (f->output_data.x->font)
3707 + f->output_data.x->internal_border_width);
3708 int top = (top_char * f->output_data.x->line_height
3709 + f->output_data.x->internal_border_width);
3710
3711 if (chars < 0)
3712 width = FONT_WIDTH (f->output_data.x->font) / 2;
3713 else
3714 width = FONT_WIDTH (f->output_data.x->font) * chars;
3715 if (lines < 0)
3716 height = f->output_data.x->line_height / 2;
3717 else
3718 height = f->output_data.x->line_height * lines;
3719
3720 XDrawRectangle (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
3721 gc, left, top, width, height);
3722 }
3723
3724 DEFUN ("x-draw-rectangle", Fx_draw_rectangle, Sx_draw_rectangle, 5, 5, 0,
3725 "Draw a rectangle on FRAME between coordinates specified by\n\
3726 numbers X0, Y0, X1, Y1 in the cursor pixel.")
3727 (frame, X0, Y0, X1, Y1)
3728 register Lisp_Object frame, X0, X1, Y0, Y1;
3729 {
3730 register int x0, y0, x1, y1, top, left, n_chars, n_lines;
3731
3732 CHECK_LIVE_FRAME (frame, 0);
3733 CHECK_NUMBER (X0, 0);
3734 CHECK_NUMBER (Y0, 1);
3735 CHECK_NUMBER (X1, 2);
3736 CHECK_NUMBER (Y1, 3);
3737
3738 x0 = XINT (X0);
3739 x1 = XINT (X1);
3740 y0 = XINT (Y0);
3741 y1 = XINT (Y1);
3742
3743 if (y1 > y0)
3744 {
3745 top = y0;
3746 n_lines = y1 - y0 + 1;
3747 }
3748 else
3749 {
3750 top = y1;
3751 n_lines = y0 - y1 + 1;
3752 }
3753
3754 if (x1 > x0)
3755 {
3756 left = x0;
3757 n_chars = x1 - x0 + 1;
3758 }
3759 else
3760 {
3761 left = x1;
3762 n_chars = x0 - x1 + 1;
3763 }
3764
3765 BLOCK_INPUT;
3766 x_rectangle (XFRAME (frame), XFRAME (frame)->output_data.x->cursor_gc,
3767 left, top, n_chars, n_lines);
3768 UNBLOCK_INPUT;
3769
3770 return Qt;
3771 }
3772
3773 DEFUN ("x-erase-rectangle", Fx_erase_rectangle, Sx_erase_rectangle, 5, 5, 0,
3774 "Draw a rectangle drawn on FRAME between coordinates\n\
3775 X0, Y0, X1, Y1 in the regular background-pixel.")
3776 (frame, X0, Y0, X1, Y1)
3777 register Lisp_Object frame, X0, Y0, X1, Y1;
3778 {
3779 register int x0, y0, x1, y1, top, left, n_chars, n_lines;
3780
3781 CHECK_LIVE_FRAME (frame, 0);
3782 CHECK_NUMBER (X0, 0);
3783 CHECK_NUMBER (Y0, 1);
3784 CHECK_NUMBER (X1, 2);
3785 CHECK_NUMBER (Y1, 3);
3786
3787 x0 = XINT (X0);
3788 x1 = XINT (X1);
3789 y0 = XINT (Y0);
3790 y1 = XINT (Y1);
3791
3792 if (y1 > y0)
3793 {
3794 top = y0;
3795 n_lines = y1 - y0 + 1;
3796 }
3797 else
3798 {
3799 top = y1;
3800 n_lines = y0 - y1 + 1;
3801 }
3802
3803 if (x1 > x0)
3804 {
3805 left = x0;
3806 n_chars = x1 - x0 + 1;
3807 }
3808 else
3809 {
3810 left = x1;
3811 n_chars = x0 - x1 + 1;
3812 }
3813
3814 BLOCK_INPUT;
3815 x_rectangle (XFRAME (frame), XFRAME (frame)->output_data.x->reverse_gc,
3816 left, top, n_chars, n_lines);
3817 UNBLOCK_INPUT;
3818
3819 return Qt;
3820 }
3821
3822 /* Draw lines around the text region beginning at the character position
3823 TOP_X, TOP_Y and ending at BOTTOM_X and BOTTOM_Y. GC specifies the
3824 pixel and line characteristics. */
3825
3826 #define line_len(line) (FRAME_CURRENT_GLYPHS (f)->used[(line)])
3827
3828 static void
3829 outline_region (f, gc, top_x, top_y, bottom_x, bottom_y)
3830 register struct frame *f;
3831 GC gc;
3832 int top_x, top_y, bottom_x, bottom_y;
3833 {
3834 register int ibw = f->output_data.x->internal_border_width;
3835 register int font_w = FONT_WIDTH (f->output_data.x->font);
3836 register int font_h = f->output_data.x->line_height;
3837 int y = top_y;
3838 int x = line_len (y);
3839 XPoint *pixel_points
3840 = (XPoint *) alloca (((bottom_y - top_y + 2) * 4) * sizeof (XPoint));
3841 register XPoint *this_point = pixel_points;
3842
3843 /* Do the horizontal top line/lines */
3844 if (top_x == 0)
3845 {
3846 this_point->x = ibw;
3847 this_point->y = ibw + (font_h * top_y);
3848 this_point++;
3849 if (x == 0)
3850 this_point->x = ibw + (font_w / 2); /* Half-size for newline chars. */
3851 else
3852 this_point->x = ibw + (font_w * x);
3853 this_point->y = (this_point - 1)->y;
3854 }
3855 else
3856 {
3857 this_point->x = ibw;
3858 this_point->y = ibw + (font_h * (top_y + 1));
3859 this_point++;
3860 this_point->x = ibw + (font_w * top_x);
3861 this_point->y = (this_point - 1)->y;
3862 this_point++;
3863 this_point->x = (this_point - 1)->x;
3864 this_point->y = ibw + (font_h * top_y);
3865 this_point++;
3866 this_point->x = ibw + (font_w * x);
3867 this_point->y = (this_point - 1)->y;
3868 }
3869
3870 /* Now do the right side. */
3871 while (y < bottom_y)
3872 { /* Right vertical edge */
3873 this_point++;
3874 this_point->x = (this_point - 1)->x;
3875 this_point->y = ibw + (font_h * (y + 1));
3876 this_point++;
3877
3878 y++; /* Horizontal connection to next line */
3879 x = line_len (y);
3880 if (x == 0)
3881 this_point->x = ibw + (font_w / 2);
3882 else
3883 this_point->x = ibw + (font_w * x);
3884
3885 this_point->y = (this_point - 1)->y;
3886 }
3887
3888 /* Now do the bottom and connect to the top left point. */
3889 this_point->x = ibw + (font_w * (bottom_x + 1));
3890
3891 this_point++;
3892 this_point->x = (this_point - 1)->x;
3893 this_point->y = ibw + (font_h * (bottom_y + 1));
3894 this_point++;
3895 this_point->x = ibw;
3896 this_point->y = (this_point - 1)->y;
3897 this_point++;
3898 this_point->x = pixel_points->x;
3899 this_point->y = pixel_points->y;
3900
3901 XDrawLines (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
3902 gc, pixel_points,
3903 (this_point - pixel_points + 1), CoordModeOrigin);
3904 }
3905
3906 DEFUN ("x-contour-region", Fx_contour_region, Sx_contour_region, 1, 1, 0,
3907 "Highlight the region between point and the character under the mouse\n\
3908 selected frame.")
3909 (event)
3910 register Lisp_Object event;
3911 {
3912 register int x0, y0, x1, y1;
3913 register struct frame *f = selected_frame;
3914 register int p1, p2;
3915
3916 CHECK_CONS (event, 0);
3917
3918 BLOCK_INPUT;
3919 x0 = XINT (Fcar (Fcar (event)));
3920 y0 = XINT (Fcar (Fcdr (Fcar (event))));
3921
3922 /* If the mouse is past the end of the line, don't that area. */
3923 /* ReWrite this... */
3924
3925 x1 = f->cursor_x;
3926 y1 = f->cursor_y;
3927
3928 if (y1 > y0) /* point below mouse */
3929 outline_region (f, f->output_data.x->cursor_gc,
3930 x0, y0, x1, y1);
3931 else if (y1 < y0) /* point above mouse */
3932 outline_region (f, f->output_data.x->cursor_gc,
3933 x1, y1, x0, y0);
3934 else /* same line: draw horizontal rectangle */
3935 {
3936 if (x1 > x0)
3937 x_rectangle (f, f->output_data.x->cursor_gc,
3938 x0, y0, (x1 - x0 + 1), 1);
3939 else if (x1 < x0)
3940 x_rectangle (f, f->output_data.x->cursor_gc,
3941 x1, y1, (x0 - x1 + 1), 1);
3942 }
3943
3944 XFlush (FRAME_X_DISPLAY (f));
3945 UNBLOCK_INPUT;
3946
3947 return Qnil;
3948 }
3949
3950 DEFUN ("x-uncontour-region", Fx_uncontour_region, Sx_uncontour_region, 1, 1, 0,
3951 "Erase any highlighting of the region between point and the character\n\
3952 at X, Y on the selected frame.")
3953 (event)
3954 register Lisp_Object event;
3955 {
3956 register int x0, y0, x1, y1;
3957 register struct frame *f = selected_frame;
3958
3959 BLOCK_INPUT;
3960 x0 = XINT (Fcar (Fcar (event)));
3961 y0 = XINT (Fcar (Fcdr (Fcar (event))));
3962 x1 = f->cursor_x;
3963 y1 = f->cursor_y;
3964
3965 if (y1 > y0) /* point below mouse */
3966 outline_region (f, f->output_data.x->reverse_gc,
3967 x0, y0, x1, y1);
3968 else if (y1 < y0) /* point above mouse */
3969 outline_region (f, f->output_data.x->reverse_gc,
3970 x1, y1, x0, y0);
3971 else /* same line: draw horizontal rectangle */
3972 {
3973 if (x1 > x0)
3974 x_rectangle (f, f->output_data.x->reverse_gc,
3975 x0, y0, (x1 - x0 + 1), 1);
3976 else if (x1 < x0)
3977 x_rectangle (f, f->output_data.x->reverse_gc,
3978 x1, y1, (x0 - x1 + 1), 1);
3979 }
3980 UNBLOCK_INPUT;
3981
3982 return Qnil;
3983 }
3984
3985 #if 0
3986 int contour_begin_x, contour_begin_y;
3987 int contour_end_x, contour_end_y;
3988 int contour_npoints;
3989
3990 /* Clip the top part of the contour lines down (and including) line Y_POS.
3991 If X_POS is in the middle (rather than at the end) of the line, drop
3992 down a line at that character. */
3993
3994 static void
3995 clip_contour_top (y_pos, x_pos)
3996 {
3997 register XPoint *begin = contour_lines[y_pos].top_left;
3998 register XPoint *end;
3999 register int npoints;
4000 register struct display_line *line = selected_frame->phys_lines[y_pos + 1];
4001
4002 if (x_pos >= line->len - 1) /* Draw one, straight horizontal line. */
4003 {
4004 end = contour_lines[y_pos].top_right;
4005 npoints = (end - begin + 1);
4006 XDrawLines (x_current_display, contour_window,
4007 contour_erase_gc, begin_erase, npoints, CoordModeOrigin);
4008
4009 bcopy (end, begin + 1, contour_last_point - end + 1);
4010 contour_last_point -= (npoints - 2);
4011 XDrawLines (x_current_display, contour_window,
4012 contour_erase_gc, begin, 2, CoordModeOrigin);
4013 XFlush (x_current_display);
4014
4015 /* Now, update contour_lines structure. */
4016 }
4017 /* ______. */
4018 else /* |________*/
4019 {
4020 register XPoint *p = begin + 1;
4021 end = contour_lines[y_pos].bottom_right;
4022 npoints = (end - begin + 1);
4023 XDrawLines (x_current_display, contour_window,
4024 contour_erase_gc, begin_erase, npoints, CoordModeOrigin);
4025
4026 p->y = begin->y;
4027 p->x = ibw + (font_w * (x_pos + 1));
4028 p++;
4029 p->y = begin->y + font_h;
4030 p->x = (p - 1)->x;
4031 bcopy (end, begin + 3, contour_last_point - end + 1);
4032 contour_last_point -= (npoints - 5);
4033 XDrawLines (x_current_display, contour_window,
4034 contour_erase_gc, begin, 4, CoordModeOrigin);
4035 XFlush (x_current_display);
4036
4037 /* Now, update contour_lines structure. */
4038 }
4039 }
4040
4041 /* Erase the top horizontal lines of the contour, and then extend
4042 the contour upwards. */
4043
4044 static void
4045 extend_contour_top (line)
4046 {
4047 }
4048
4049 static void
4050 clip_contour_bottom (x_pos, y_pos)
4051 int x_pos, y_pos;
4052 {
4053 }
4054
4055 static void
4056 extend_contour_bottom (x_pos, y_pos)
4057 {
4058 }
4059
4060 DEFUN ("x-select-region", Fx_select_region, Sx_select_region, 1, 1, "e",
4061 "")
4062 (event)
4063 Lisp_Object event;
4064 {
4065 register struct frame *f = selected_frame;
4066 register int point_x = f->cursor_x;
4067 register int point_y = f->cursor_y;
4068 register int mouse_below_point;
4069 register Lisp_Object obj;
4070 register int x_contour_x, x_contour_y;
4071
4072 x_contour_x = x_mouse_x;
4073 x_contour_y = x_mouse_y;
4074 if (x_contour_y > point_y || (x_contour_y == point_y
4075 && x_contour_x > point_x))
4076 {
4077 mouse_below_point = 1;
4078 outline_region (f, f->output_data.x->cursor_gc, point_x, point_y,
4079 x_contour_x, x_contour_y);
4080 }
4081 else
4082 {
4083 mouse_below_point = 0;
4084 outline_region (f, f->output_data.x->cursor_gc, x_contour_x, x_contour_y,
4085 point_x, point_y);
4086 }
4087
4088 while (1)
4089 {
4090 obj = read_char (-1, 0, 0, Qnil, 0);
4091 if (!CONSP (obj))
4092 break;
4093
4094 if (mouse_below_point)
4095 {
4096 if (x_mouse_y <= point_y) /* Flipped. */
4097 {
4098 mouse_below_point = 0;
4099
4100 outline_region (f, f->output_data.x->reverse_gc, point_x, point_y,
4101 x_contour_x, x_contour_y);
4102 outline_region (f, f->output_data.x->cursor_gc, x_mouse_x, x_mouse_y,
4103 point_x, point_y);
4104 }
4105 else if (x_mouse_y < x_contour_y) /* Bottom clipped. */
4106 {
4107 clip_contour_bottom (x_mouse_y);
4108 }
4109 else if (x_mouse_y > x_contour_y) /* Bottom extended. */
4110 {
4111 extend_bottom_contour (x_mouse_y);
4112 }
4113
4114 x_contour_x = x_mouse_x;
4115 x_contour_y = x_mouse_y;
4116 }
4117 else /* mouse above or same line as point */
4118 {
4119 if (x_mouse_y >= point_y) /* Flipped. */
4120 {
4121 mouse_below_point = 1;
4122
4123 outline_region (f, f->output_data.x->reverse_gc,
4124 x_contour_x, x_contour_y, point_x, point_y);
4125 outline_region (f, f->output_data.x->cursor_gc, point_x, point_y,
4126 x_mouse_x, x_mouse_y);
4127 }
4128 else if (x_mouse_y > x_contour_y) /* Top clipped. */
4129 {
4130 clip_contour_top (x_mouse_y);
4131 }
4132 else if (x_mouse_y < x_contour_y) /* Top extended. */
4133 {
4134 extend_contour_top (x_mouse_y);
4135 }
4136 }
4137 }
4138
4139 unread_command_event = obj;
4140 if (mouse_below_point)
4141 {
4142 contour_begin_x = point_x;
4143 contour_begin_y = point_y;
4144 contour_end_x = x_contour_x;
4145 contour_end_y = x_contour_y;
4146 }
4147 else
4148 {
4149 contour_begin_x = x_contour_x;
4150 contour_begin_y = x_contour_y;
4151 contour_end_x = point_x;
4152 contour_end_y = point_y;
4153 }
4154 }
4155 #endif
4156
4157 DEFUN ("x-horizontal-line", Fx_horizontal_line, Sx_horizontal_line, 1, 1, "e",
4158 "")
4159 (event)
4160 Lisp_Object event;
4161 {
4162 register Lisp_Object obj;
4163 struct frame *f = selected_frame;
4164 register struct window *w = XWINDOW (selected_window);
4165 register GC line_gc = f->output_data.x->cursor_gc;
4166 register GC erase_gc = f->output_data.x->reverse_gc;
4167 #if 0
4168 char dash_list[] = {6, 4, 6, 4};
4169 int dashes = 4;
4170 XGCValues gc_values;
4171 #endif
4172 register int previous_y;
4173 register int line = (x_mouse_y + 1) * f->output_data.x->line_height
4174 + f->output_data.x->internal_border_width;
4175 register int left = f->output_data.x->internal_border_width
4176 + (w->left
4177 * FONT_WIDTH (f->output_data.x->font));
4178 register int right = left + (w->width
4179 * FONT_WIDTH (f->output_data.x->font))
4180 - f->output_data.x->internal_border_width;
4181
4182 #if 0
4183 BLOCK_INPUT;
4184 gc_values.foreground = f->output_data.x->cursor_pixel;
4185 gc_values.background = f->output_data.x->background_pixel;
4186 gc_values.line_width = 1;
4187 gc_values.line_style = LineOnOffDash;
4188 gc_values.cap_style = CapRound;
4189 gc_values.join_style = JoinRound;
4190
4191 line_gc = XCreateGC (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
4192 GCLineStyle | GCJoinStyle | GCCapStyle
4193 | GCLineWidth | GCForeground | GCBackground,
4194 &gc_values);
4195 XSetDashes (FRAME_X_DISPLAY (f), line_gc, 0, dash_list, dashes);
4196 gc_values.foreground = f->output_data.x->background_pixel;
4197 gc_values.background = f->output_data.x->foreground_pixel;
4198 erase_gc = XCreateGC (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
4199 GCLineStyle | GCJoinStyle | GCCapStyle
4200 | GCLineWidth | GCForeground | GCBackground,
4201 &gc_values);
4202 XSetDashes (FRAME_X_DISPLAY (f), erase_gc, 0, dash_list, dashes);
4203 UNBLOCK_INPUT;
4204 #endif
4205
4206 while (1)
4207 {
4208 BLOCK_INPUT;
4209 if (x_mouse_y >= XINT (w->top)
4210 && x_mouse_y < XINT (w->top) + XINT (w->height) - 1)
4211 {
4212 previous_y = x_mouse_y;
4213 line = (x_mouse_y + 1) * f->output_data.x->line_height
4214 + f->output_data.x->internal_border_width;
4215 XDrawLine (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
4216 line_gc, left, line, right, line);
4217 }
4218 XFlush (FRAME_X_DISPLAY (f));
4219 UNBLOCK_INPUT;
4220
4221 do
4222 {
4223 obj = read_char (-1, 0, 0, Qnil, 0);
4224 if (!CONSP (obj)
4225 || (! EQ (Fcar (Fcdr (Fcdr (obj))),
4226 Qvertical_scroll_bar))
4227 || x_mouse_grabbed)
4228 {
4229 BLOCK_INPUT;
4230 XDrawLine (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
4231 erase_gc, left, line, right, line);
4232 unread_command_event = obj;
4233 #if 0
4234 XFreeGC (FRAME_X_DISPLAY (f), line_gc);
4235 XFreeGC (FRAME_X_DISPLAY (f), erase_gc);
4236 #endif
4237 UNBLOCK_INPUT;
4238 return Qnil;
4239 }
4240 }
4241 while (x_mouse_y == previous_y);
4242
4243 BLOCK_INPUT;
4244 XDrawLine (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
4245 erase_gc, left, line, right, line);
4246 UNBLOCK_INPUT;
4247 }
4248 }
4249 #endif
4250 \f
4251 #if 0
4252 /* These keep track of the rectangle following the pointer. */
4253 int mouse_track_top, mouse_track_left, mouse_track_width;
4254
4255 /* Offset in buffer of character under the pointer, or 0. */
4256 int mouse_buffer_offset;
4257
4258 DEFUN ("x-track-pointer", Fx_track_pointer, Sx_track_pointer, 0, 0, 0,
4259 "Track the pointer.")
4260 ()
4261 {
4262 static Cursor current_pointer_shape;
4263 FRAME_PTR f = x_mouse_frame;
4264
4265 BLOCK_INPUT;
4266 if (EQ (Vmouse_frame_part, Qtext_part)
4267 && (current_pointer_shape != f->output_data.x->nontext_cursor))
4268 {
4269 unsigned char c;
4270 struct buffer *buf;
4271
4272 current_pointer_shape = f->output_data.x->nontext_cursor;
4273 XDefineCursor (FRAME_X_DISPLAY (f),
4274 FRAME_X_WINDOW (f),
4275 current_pointer_shape);
4276
4277 buf = XBUFFER (XWINDOW (Vmouse_window)->buffer);
4278 c = *(BUF_CHAR_ADDRESS (buf, mouse_buffer_offset));
4279 }
4280 else if (EQ (Vmouse_frame_part, Qmodeline_part)
4281 && (current_pointer_shape != f->output_data.x->modeline_cursor))
4282 {
4283 current_pointer_shape = f->output_data.x->modeline_cursor;
4284 XDefineCursor (FRAME_X_DISPLAY (f),
4285 FRAME_X_WINDOW (f),
4286 current_pointer_shape);
4287 }
4288
4289 XFlush (FRAME_X_DISPLAY (f));
4290 UNBLOCK_INPUT;
4291 }
4292 #endif
4293
4294 #if 0
4295 DEFUN ("x-track-pointer", Fx_track_pointer, Sx_track_pointer, 1, 1, "e",
4296 "Draw rectangle around character under mouse pointer, if there is one.")
4297 (event)
4298 Lisp_Object event;
4299 {
4300 struct window *w = XWINDOW (Vmouse_window);
4301 struct frame *f = XFRAME (WINDOW_FRAME (w));
4302 struct buffer *b = XBUFFER (w->buffer);
4303 Lisp_Object obj;
4304
4305 if (! EQ (Vmouse_window, selected_window))
4306 return Qnil;
4307
4308 if (EQ (event, Qnil))
4309 {
4310 int x, y;
4311
4312 x_read_mouse_position (selected_frame, &x, &y);
4313 }
4314
4315 BLOCK_INPUT;
4316 mouse_track_width = 0;
4317 mouse_track_left = mouse_track_top = -1;
4318
4319 do
4320 {
4321 if ((x_mouse_x != mouse_track_left
4322 && (x_mouse_x < mouse_track_left
4323 || x_mouse_x > (mouse_track_left + mouse_track_width)))
4324 || x_mouse_y != mouse_track_top)
4325 {
4326 int hp = 0; /* Horizontal position */
4327 int len = FRAME_CURRENT_GLYPHS (f)->used[x_mouse_y];
4328 int p = FRAME_CURRENT_GLYPHS (f)->bufp[x_mouse_y];
4329 int tab_width = XINT (b->tab_width);
4330 int ctl_arrow_p = !NILP (b->ctl_arrow);
4331 unsigned char c;
4332 int mode_line_vpos = XFASTINT (w->height) + XFASTINT (w->top) - 1;
4333 int in_mode_line = 0;
4334
4335 if (! FRAME_CURRENT_GLYPHS (f)->enable[x_mouse_y])
4336 break;
4337
4338 /* Erase previous rectangle. */
4339 if (mouse_track_width)
4340 {
4341 x_rectangle (f, f->output_data.x->reverse_gc,
4342 mouse_track_left, mouse_track_top,
4343 mouse_track_width, 1);
4344
4345 if ((mouse_track_left == f->phys_cursor_x
4346 || mouse_track_left == f->phys_cursor_x - 1)
4347 && mouse_track_top == f->phys_cursor_y)
4348 {
4349 x_display_cursor (f, 1);
4350 }
4351 }
4352
4353 mouse_track_left = x_mouse_x;
4354 mouse_track_top = x_mouse_y;
4355 mouse_track_width = 0;
4356
4357 if (mouse_track_left > len) /* Past the end of line. */
4358 goto draw_or_not;
4359
4360 if (mouse_track_top == mode_line_vpos)
4361 {
4362 in_mode_line = 1;
4363 goto draw_or_not;
4364 }
4365
4366 if (tab_width <= 0 || tab_width > 20) tab_width = 8;
4367 do
4368 {
4369 c = FETCH_CHAR (p);
4370 if (len == f->width && hp == len - 1 && c != '\n')
4371 goto draw_or_not;
4372
4373 switch (c)
4374 {
4375 case '\t':
4376 mouse_track_width = tab_width - (hp % tab_width);
4377 p++;
4378 hp += mouse_track_width;
4379 if (hp > x_mouse_x)
4380 {
4381 mouse_track_left = hp - mouse_track_width;
4382 goto draw_or_not;
4383 }
4384 continue;
4385
4386 case '\n':
4387 mouse_track_width = -1;
4388 goto draw_or_not;
4389
4390 default:
4391 if (ctl_arrow_p && (c < 040 || c == 0177))
4392 {
4393 if (p > ZV)
4394 goto draw_or_not;
4395
4396 mouse_track_width = 2;
4397 p++;
4398 hp +=2;
4399 if (hp > x_mouse_x)
4400 {
4401 mouse_track_left = hp - mouse_track_width;
4402 goto draw_or_not;
4403 }
4404 }
4405 else
4406 {
4407 mouse_track_width = 1;
4408 p++;
4409 hp++;
4410 }
4411 continue;
4412 }
4413 }
4414 while (hp <= x_mouse_x);
4415
4416 draw_or_not:
4417 if (mouse_track_width) /* Over text; use text pointer shape. */
4418 {
4419 XDefineCursor (FRAME_X_DISPLAY (f),
4420 FRAME_X_WINDOW (f),
4421 f->output_data.x->text_cursor);
4422 x_rectangle (f, f->output_data.x->cursor_gc,
4423 mouse_track_left, mouse_track_top,
4424 mouse_track_width, 1);
4425 }
4426 else if (in_mode_line)
4427 XDefineCursor (FRAME_X_DISPLAY (f),
4428 FRAME_X_WINDOW (f),
4429 f->output_data.x->modeline_cursor);
4430 else
4431 XDefineCursor (FRAME_X_DISPLAY (f),
4432 FRAME_X_WINDOW (f),
4433 f->output_data.x->nontext_cursor);
4434 }
4435
4436 XFlush (FRAME_X_DISPLAY (f));
4437 UNBLOCK_INPUT;
4438
4439 obj = read_char (-1, 0, 0, Qnil, 0);
4440 BLOCK_INPUT;
4441 }
4442 while (CONSP (obj) /* Mouse event */
4443 && EQ (Fcar (Fcdr (Fcdr (obj))), Qnil) /* Not scroll bar */
4444 && EQ (Vmouse_depressed, Qnil) /* Only motion events */
4445 && EQ (Vmouse_window, selected_window) /* In this window */
4446 && x_mouse_frame);
4447
4448 unread_command_event = obj;
4449
4450 if (mouse_track_width)
4451 {
4452 x_rectangle (f, f->output_data.x->reverse_gc,
4453 mouse_track_left, mouse_track_top,
4454 mouse_track_width, 1);
4455 mouse_track_width = 0;
4456 if ((mouse_track_left == f->phys_cursor_x
4457 || mouse_track_left - 1 == f->phys_cursor_x)
4458 && mouse_track_top == f->phys_cursor_y)
4459 {
4460 x_display_cursor (f, 1);
4461 }
4462 }
4463 XDefineCursor (FRAME_X_DISPLAY (f),
4464 FRAME_X_WINDOW (f),
4465 f->output_data.x->nontext_cursor);
4466 XFlush (FRAME_X_DISPLAY (f));
4467 UNBLOCK_INPUT;
4468
4469 return Qnil;
4470 }
4471 #endif
4472 \f
4473 #if 0
4474 #include "glyphs.h"
4475
4476 /* Draw a pixmap specified by IMAGE_DATA of dimensions WIDTH and HEIGHT
4477 on the frame F at position X, Y. */
4478
4479 x_draw_pixmap (f, x, y, image_data, width, height)
4480 struct frame *f;
4481 int x, y, width, height;
4482 char *image_data;
4483 {
4484 Pixmap image;
4485
4486 image = XCreateBitmapFromData (FRAME_X_DISPLAY (f),
4487 FRAME_X_WINDOW (f), image_data,
4488 width, height);
4489 XCopyPlane (FRAME_X_DISPLAY (f), image, FRAME_X_WINDOW (f),
4490 f->output_data.x->normal_gc, 0, 0, width, height, x, y);
4491 }
4492 #endif
4493 \f
4494 #if 0 /* I'm told these functions are superfluous
4495 given the ability to bind function keys. */
4496
4497 #ifdef HAVE_X11
4498 DEFUN ("x-rebind-key", Fx_rebind_key, Sx_rebind_key, 3, 3, 0,
4499 "Rebind X keysym KEYSYM, with MODIFIERS, to generate NEWSTRING.\n\
4500 KEYSYM is a string which conforms to the X keysym definitions found\n\
4501 in X11/keysymdef.h, sans the initial XK_. MODIFIERS is nil or a\n\
4502 list of strings specifying modifier keys such as Control_L, which must\n\
4503 also be depressed for NEWSTRING to appear.")
4504 (x_keysym, modifiers, newstring)
4505 register Lisp_Object x_keysym;
4506 register Lisp_Object modifiers;
4507 register Lisp_Object newstring;
4508 {
4509 char *rawstring;
4510 register KeySym keysym;
4511 KeySym modifier_list[16];
4512
4513 check_x ();
4514 CHECK_STRING (x_keysym, 1);
4515 CHECK_STRING (newstring, 3);
4516
4517 keysym = XStringToKeysym ((char *) XSTRING (x_keysym)->data);
4518 if (keysym == NoSymbol)
4519 error ("Keysym does not exist");
4520
4521 if (NILP (modifiers))
4522 XRebindKeysym (x_current_display, keysym, modifier_list, 0,
4523 XSTRING (newstring)->data, XSTRING (newstring)->size);
4524 else
4525 {
4526 register Lisp_Object rest, mod;
4527 register int i = 0;
4528
4529 for (rest = modifiers; !NILP (rest); rest = Fcdr (rest))
4530 {
4531 if (i == 16)
4532 error ("Can't have more than 16 modifiers");
4533
4534 mod = Fcar (rest);
4535 CHECK_STRING (mod, 3);
4536 modifier_list[i] = XStringToKeysym ((char *) XSTRING (mod)->data);
4537 #ifndef HAVE_X11R5
4538 if (modifier_list[i] == NoSymbol
4539 || !(IsModifierKey (modifier_list[i])
4540 || ((unsigned)(modifier_list[i]) == XK_Mode_switch)
4541 || ((unsigned)(modifier_list[i]) == XK_Num_Lock)))
4542 #else
4543 if (modifier_list[i] == NoSymbol
4544 || !IsModifierKey (modifier_list[i]))
4545 #endif
4546 error ("Element is not a modifier keysym");
4547 i++;
4548 }
4549
4550 XRebindKeysym (x_current_display, keysym, modifier_list, i,
4551 XSTRING (newstring)->data, XSTRING (newstring)->size);
4552 }
4553
4554 return Qnil;
4555 }
4556
4557 DEFUN ("x-rebind-keys", Fx_rebind_keys, Sx_rebind_keys, 2, 2, 0,
4558 "Rebind KEYCODE to list of strings STRINGS.\n\
4559 STRINGS should be a list of 16 elements, one for each shift combination.\n\
4560 nil as element means don't change.\n\
4561 See the documentation of `x-rebind-key' for more information.")
4562 (keycode, strings)
4563 register Lisp_Object keycode;
4564 register Lisp_Object strings;
4565 {
4566 register Lisp_Object item;
4567 register unsigned char *rawstring;
4568 KeySym rawkey, modifier[1];
4569 int strsize;
4570 register unsigned i;
4571
4572 check_x ();
4573 CHECK_NUMBER (keycode, 1);
4574 CHECK_CONS (strings, 2);
4575 rawkey = (KeySym) ((unsigned) (XINT (keycode))) & 255;
4576 for (i = 0; i <= 15; strings = Fcdr (strings), i++)
4577 {
4578 item = Fcar (strings);
4579 if (!NILP (item))
4580 {
4581 CHECK_STRING (item, 2);
4582 strsize = XSTRING (item)->size;
4583 rawstring = (unsigned char *) xmalloc (strsize);
4584 bcopy (XSTRING (item)->data, rawstring, strsize);
4585 modifier[1] = 1 << i;
4586 XRebindKeysym (x_current_display, rawkey, modifier, 1,
4587 rawstring, strsize);
4588 }
4589 }
4590 return Qnil;
4591 }
4592 #endif /* HAVE_X11 */
4593 #endif /* 0 */
4594 \f
4595 #ifndef HAVE_XSCREENNUMBEROFSCREEN
4596 int
4597 XScreenNumberOfScreen (scr)
4598 register Screen *scr;
4599 {
4600 register Display *dpy;
4601 register Screen *dpyscr;
4602 register int i;
4603
4604 dpy = scr->display;
4605 dpyscr = dpy->screens;
4606
4607 for (i = 0; i < dpy->nscreens; i++, dpyscr++)
4608 if (scr == dpyscr)
4609 return i;
4610
4611 return -1;
4612 }
4613 #endif /* not HAVE_XSCREENNUMBEROFSCREEN */
4614
4615 Visual *
4616 select_visual (dpy, screen, depth)
4617 Display *dpy;
4618 Screen *screen;
4619 unsigned int *depth;
4620 {
4621 Visual *v;
4622 XVisualInfo *vinfo, vinfo_template;
4623 int n_visuals;
4624
4625 v = DefaultVisualOfScreen (screen);
4626
4627 #ifdef HAVE_X11R4
4628 vinfo_template.visualid = XVisualIDFromVisual (v);
4629 #else
4630 vinfo_template.visualid = v->visualid;
4631 #endif
4632
4633 vinfo_template.screen = XScreenNumberOfScreen (screen);
4634
4635 vinfo = XGetVisualInfo (dpy,
4636 VisualIDMask | VisualScreenMask, &vinfo_template,
4637 &n_visuals);
4638 if (n_visuals != 1)
4639 fatal ("Can't get proper X visual info");
4640
4641 if ((1 << vinfo->depth) == vinfo->colormap_size)
4642 *depth = vinfo->depth;
4643 else
4644 {
4645 int i = 0;
4646 int n = vinfo->colormap_size - 1;
4647 while (n)
4648 {
4649 n = n >> 1;
4650 i++;
4651 }
4652 *depth = i;
4653 }
4654
4655 XFree ((char *) vinfo);
4656 return v;
4657 }
4658
4659 /* Return the X display structure for the display named NAME.
4660 Open a new connection if necessary. */
4661
4662 struct x_display_info *
4663 x_display_info_for_name (name)
4664 Lisp_Object name;
4665 {
4666 Lisp_Object names;
4667 struct x_display_info *dpyinfo;
4668
4669 CHECK_STRING (name, 0);
4670
4671 if (! EQ (Vwindow_system, intern ("x")))
4672 error ("Not using X Windows");
4673
4674 for (dpyinfo = x_display_list, names = x_display_name_list;
4675 dpyinfo;
4676 dpyinfo = dpyinfo->next, names = XCONS (names)->cdr)
4677 {
4678 Lisp_Object tem;
4679 tem = Fstring_equal (XCONS (XCONS (names)->car)->car, name);
4680 if (!NILP (tem))
4681 return dpyinfo;
4682 }
4683
4684 /* Use this general default value to start with. */
4685 Vx_resource_name = Vinvocation_name;
4686
4687 validate_x_resource_name ();
4688
4689 dpyinfo = x_term_init (name, (unsigned char *)0,
4690 (char *) XSTRING (Vx_resource_name)->data);
4691
4692 if (dpyinfo == 0)
4693 error ("Cannot connect to X server %s", XSTRING (name)->data);
4694
4695 x_in_use = 1;
4696 XSETFASTINT (Vwindow_system_version, 11);
4697
4698 return dpyinfo;
4699 }
4700
4701 DEFUN ("x-open-connection", Fx_open_connection, Sx_open_connection,
4702 1, 3, 0, "Open a connection to an X server.\n\
4703 DISPLAY is the name of the display to connect to.\n\
4704 Optional second arg XRM-STRING is a string of resources in xrdb format.\n\
4705 If the optional third arg MUST-SUCCEED is non-nil,\n\
4706 terminate Emacs if we can't open the connection.")
4707 (display, xrm_string, must_succeed)
4708 Lisp_Object display, xrm_string, must_succeed;
4709 {
4710 unsigned int n_planes;
4711 unsigned char *xrm_option;
4712 struct x_display_info *dpyinfo;
4713
4714 CHECK_STRING (display, 0);
4715 if (! NILP (xrm_string))
4716 CHECK_STRING (xrm_string, 1);
4717
4718 if (! EQ (Vwindow_system, intern ("x")))
4719 error ("Not using X Windows");
4720
4721 if (! NILP (xrm_string))
4722 xrm_option = (unsigned char *) XSTRING (xrm_string)->data;
4723 else
4724 xrm_option = (unsigned char *) 0;
4725
4726 /* Use this general default value to start with. */
4727 Vx_resource_name = Vinvocation_name;
4728
4729 validate_x_resource_name ();
4730
4731 /* This is what opens the connection and sets x_current_display.
4732 This also initializes many symbols, such as those used for input. */
4733 dpyinfo = x_term_init (display, xrm_option,
4734 (char *) XSTRING (Vx_resource_name)->data);
4735
4736 if (dpyinfo == 0)
4737 {
4738 if (!NILP (must_succeed))
4739 fatal ("Cannot connect to X server %s.\n\
4740 Check the DISPLAY environment variable or use `-d'.\n\
4741 Also use the `xhost' program to verify that it is set to permit\n\
4742 connections from your machine.\n",
4743 XSTRING (display)->data);
4744 else
4745 error ("Cannot connect to X server %s", XSTRING (display)->data);
4746 }
4747
4748 x_in_use = 1;
4749
4750 XSETFASTINT (Vwindow_system_version, 11);
4751 return Qnil;
4752 }
4753
4754 DEFUN ("x-close-connection", Fx_close_connection,
4755 Sx_close_connection, 1, 1, 0,
4756 "Close the connection to DISPLAY's X server.\n\
4757 For DISPLAY, specify either a frame or a display name (a string).\n\
4758 If DISPLAY is nil, that stands for the selected frame's display.")
4759 (display)
4760 Lisp_Object display;
4761 {
4762 struct x_display_info *dpyinfo = check_x_display_info (display);
4763 struct x_display_info *tail;
4764 int i;
4765
4766 if (dpyinfo->reference_count > 0)
4767 error ("Display still has frames on it");
4768
4769 BLOCK_INPUT;
4770 /* Free the fonts in the font table. */
4771 for (i = 0; i < dpyinfo->n_fonts; i++)
4772 {
4773 if (dpyinfo->font_table[i].name)
4774 free (dpyinfo->font_table[i].name);
4775 /* Don't free the full_name string;
4776 it is always shared with something else. */
4777 XFreeFont (dpyinfo->display, dpyinfo->font_table[i].font);
4778 }
4779 x_destroy_all_bitmaps (dpyinfo);
4780 XSetCloseDownMode (dpyinfo->display, DestroyAll);
4781
4782 #ifdef USE_X_TOOLKIT
4783 XtCloseDisplay (dpyinfo->display);
4784 #else
4785 XCloseDisplay (dpyinfo->display);
4786 #endif
4787
4788 x_delete_display (dpyinfo);
4789 UNBLOCK_INPUT;
4790
4791 return Qnil;
4792 }
4793
4794 DEFUN ("x-display-list", Fx_display_list, Sx_display_list, 0, 0, 0,
4795 "Return the list of display names that Emacs has connections to.")
4796 ()
4797 {
4798 Lisp_Object tail, result;
4799
4800 result = Qnil;
4801 for (tail = x_display_name_list; ! NILP (tail); tail = XCONS (tail)->cdr)
4802 result = Fcons (XCONS (XCONS (tail)->car)->car, result);
4803
4804 return result;
4805 }
4806
4807 DEFUN ("x-synchronize", Fx_synchronize, Sx_synchronize, 1, 2, 0,
4808 "If ON is non-nil, report X errors as soon as the erring request is made.\n\
4809 If ON is nil, allow buffering of requests.\n\
4810 Turning on synchronization prohibits the Xlib routines from buffering\n\
4811 requests and seriously degrades performance, but makes debugging much\n\
4812 easier.\n\
4813 The optional second argument DISPLAY specifies which display to act on.\n\
4814 DISPLAY should be either a frame or a display name (a string).\n\
4815 If DISPLAY is omitted or nil, that stands for the selected frame's display.")
4816 (on, display)
4817 Lisp_Object display, on;
4818 {
4819 struct x_display_info *dpyinfo = check_x_display_info (display);
4820
4821 XSynchronize (dpyinfo->display, !EQ (on, Qnil));
4822
4823 return Qnil;
4824 }
4825
4826 /* Wait for responses to all X commands issued so far for frame F. */
4827
4828 void
4829 x_sync (f)
4830 FRAME_PTR f;
4831 {
4832 BLOCK_INPUT;
4833 XSync (FRAME_X_DISPLAY (f), False);
4834 UNBLOCK_INPUT;
4835 }
4836 \f
4837 syms_of_xfns ()
4838 {
4839 /* This is zero if not using X windows. */
4840 x_in_use = 0;
4841
4842 /* The section below is built by the lisp expression at the top of the file,
4843 just above where these variables are declared. */
4844 /*&&& init symbols here &&&*/
4845 Qauto_raise = intern ("auto-raise");
4846 staticpro (&Qauto_raise);
4847 Qauto_lower = intern ("auto-lower");
4848 staticpro (&Qauto_lower);
4849 Qbackground_color = intern ("background-color");
4850 staticpro (&Qbackground_color);
4851 Qbar = intern ("bar");
4852 staticpro (&Qbar);
4853 Qborder_color = intern ("border-color");
4854 staticpro (&Qborder_color);
4855 Qborder_width = intern ("border-width");
4856 staticpro (&Qborder_width);
4857 Qbox = intern ("box");
4858 staticpro (&Qbox);
4859 Qcursor_color = intern ("cursor-color");
4860 staticpro (&Qcursor_color);
4861 Qcursor_type = intern ("cursor-type");
4862 staticpro (&Qcursor_type);
4863 Qfont = intern ("font");
4864 staticpro (&Qfont);
4865 Qforeground_color = intern ("foreground-color");
4866 staticpro (&Qforeground_color);
4867 Qgeometry = intern ("geometry");
4868 staticpro (&Qgeometry);
4869 Qicon_left = intern ("icon-left");
4870 staticpro (&Qicon_left);
4871 Qicon_top = intern ("icon-top");
4872 staticpro (&Qicon_top);
4873 Qicon_type = intern ("icon-type");
4874 staticpro (&Qicon_type);
4875 Qicon_name = intern ("icon-name");
4876 staticpro (&Qicon_name);
4877 Qinternal_border_width = intern ("internal-border-width");
4878 staticpro (&Qinternal_border_width);
4879 Qleft = intern ("left");
4880 staticpro (&Qleft);
4881 Qmouse_color = intern ("mouse-color");
4882 staticpro (&Qmouse_color);
4883 Qnone = intern ("none");
4884 staticpro (&Qnone);
4885 Qparent_id = intern ("parent-id");
4886 staticpro (&Qparent_id);
4887 Qscroll_bar_width = intern ("scroll-bar-width");
4888 staticpro (&Qscroll_bar_width);
4889 Qsuppress_icon = intern ("suppress-icon");
4890 staticpro (&Qsuppress_icon);
4891 Qtop = intern ("top");
4892 staticpro (&Qtop);
4893 Qundefined_color = intern ("undefined-color");
4894 staticpro (&Qundefined_color);
4895 Qvertical_scroll_bars = intern ("vertical-scroll-bars");
4896 staticpro (&Qvertical_scroll_bars);
4897 Qvisibility = intern ("visibility");
4898 staticpro (&Qvisibility);
4899 Qwindow_id = intern ("window-id");
4900 staticpro (&Qwindow_id);
4901 Qx_frame_parameter = intern ("x-frame-parameter");
4902 staticpro (&Qx_frame_parameter);
4903 Qx_resource_name = intern ("x-resource-name");
4904 staticpro (&Qx_resource_name);
4905 Quser_position = intern ("user-position");
4906 staticpro (&Quser_position);
4907 Quser_size = intern ("user-size");
4908 staticpro (&Quser_size);
4909 Qdisplay = intern ("display");
4910 staticpro (&Qdisplay);
4911 /* This is the end of symbol initialization. */
4912
4913 Fput (Qundefined_color, Qerror_conditions,
4914 Fcons (Qundefined_color, Fcons (Qerror, Qnil)));
4915 Fput (Qundefined_color, Qerror_message,
4916 build_string ("Undefined color"));
4917
4918 init_x_parm_symbols ();
4919
4920 DEFVAR_LISP ("x-bitmap-file-path", &Vx_bitmap_file_path,
4921 "List of directories to search for bitmap files for X.");
4922 Vx_bitmap_file_path = decode_env_path ((char *) 0, PATH_BITMAPS);
4923
4924 DEFVAR_LISP ("x-pointer-shape", &Vx_pointer_shape,
4925 "The shape of the pointer when over text.\n\
4926 Changing the value does not affect existing frames\n\
4927 unless you set the mouse color.");
4928 Vx_pointer_shape = Qnil;
4929
4930 DEFVAR_LISP ("x-resource-name", &Vx_resource_name,
4931 "The name Emacs uses to look up X resources; for internal use only.\n\
4932 `x-get-resource' uses this as the first component of the instance name\n\
4933 when requesting resource values.\n\
4934 Emacs initially sets `x-resource-name' to the name under which Emacs\n\
4935 was invoked, or to the value specified with the `-name' or `-rn'\n\
4936 switches, if present.");
4937 Vx_resource_name = Qnil;
4938
4939 #if 0 /* This doesn't really do anything. */
4940 DEFVAR_INT ("x-nontext-pointer-shape", &Vx_nontext_pointer_shape,
4941 "The shape of the pointer when not over text.\n\
4942 This variable takes effect when you create a new frame\n\
4943 or when you set the mouse color.");
4944 #endif
4945 Vx_nontext_pointer_shape = Qnil;
4946
4947 #if 0 /* This doesn't really do anything. */
4948 DEFVAR_INT ("x-mode-pointer-shape", &Vx_mode_pointer_shape,
4949 "The shape of the pointer when over the mode line.\n\
4950 This variable takes effect when you create a new frame\n\
4951 or when you set the mouse color.");
4952 #endif
4953 Vx_mode_pointer_shape = Qnil;
4954
4955 DEFVAR_INT ("x-sensitive-text-pointer-shape",
4956 &Vx_sensitive_text_pointer_shape,
4957 "The shape of the pointer when over mouse-sensitive text.\n\
4958 This variable takes effect when you create a new frame\n\
4959 or when you set the mouse color.");
4960 Vx_sensitive_text_pointer_shape = Qnil;
4961
4962 DEFVAR_LISP ("x-cursor-fore-pixel", &Vx_cursor_fore_pixel,
4963 "A string indicating the foreground color of the cursor box.");
4964 Vx_cursor_fore_pixel = Qnil;
4965
4966 DEFVAR_LISP ("x-no-window-manager", &Vx_no_window_manager,
4967 "Non-nil if no X window manager is in use.\n\
4968 Emacs doesn't try to figure this out; this is always nil\n\
4969 unless you set it to something else.");
4970 /* We don't have any way to find this out, so set it to nil
4971 and maybe the user would like to set it to t. */
4972 Vx_no_window_manager = Qnil;
4973
4974 #ifdef USE_X_TOOLKIT
4975 Fprovide (intern ("x-toolkit"));
4976 #endif
4977 #ifdef USE_MOTIF
4978 Fprovide (intern ("motif"));
4979 #endif
4980
4981 defsubr (&Sx_get_resource);
4982 #if 0
4983 defsubr (&Sx_draw_rectangle);
4984 defsubr (&Sx_erase_rectangle);
4985 defsubr (&Sx_contour_region);
4986 defsubr (&Sx_uncontour_region);
4987 #endif
4988 defsubr (&Sx_list_fonts);
4989 defsubr (&Sx_display_color_p);
4990 defsubr (&Sx_display_grayscale_p);
4991 defsubr (&Sx_color_defined_p);
4992 defsubr (&Sx_color_values);
4993 defsubr (&Sx_server_max_request_size);
4994 defsubr (&Sx_server_vendor);
4995 defsubr (&Sx_server_version);
4996 defsubr (&Sx_display_pixel_width);
4997 defsubr (&Sx_display_pixel_height);
4998 defsubr (&Sx_display_mm_width);
4999 defsubr (&Sx_display_mm_height);
5000 defsubr (&Sx_display_screens);
5001 defsubr (&Sx_display_planes);
5002 defsubr (&Sx_display_color_cells);
5003 defsubr (&Sx_display_visual_class);
5004 defsubr (&Sx_display_backing_store);
5005 defsubr (&Sx_display_save_under);
5006 #if 0
5007 defsubr (&Sx_rebind_key);
5008 defsubr (&Sx_rebind_keys);
5009 defsubr (&Sx_track_pointer);
5010 defsubr (&Sx_grab_pointer);
5011 defsubr (&Sx_ungrab_pointer);
5012 #endif
5013 defsubr (&Sx_parse_geometry);
5014 defsubr (&Sx_create_frame);
5015 defsubr (&Sfocus_frame);
5016 defsubr (&Sunfocus_frame);
5017 #if 0
5018 defsubr (&Sx_horizontal_line);
5019 #endif
5020 defsubr (&Sx_open_connection);
5021 defsubr (&Sx_close_connection);
5022 defsubr (&Sx_display_list);
5023 defsubr (&Sx_synchronize);
5024 }
5025
5026 #endif /* HAVE_X_WINDOWS */