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