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