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