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