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