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