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