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