1 /* -*-C-*-
2
3 Copyright (C) 1986, 1987, 1988, 1989, 1990, 1991, 1992, 1993, 1994,
4 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005,
5 2006, 2007, 2008, 2009, 2010, 2011, 2012, 2013, 2014 Massachusetts
6 Institute of Technology
7
8 This file is part of MIT/GNU Scheme.
9
10 MIT/GNU Scheme is free software; you can redistribute it and/or modify
11 it under the terms of the GNU General Public License as published by
12 the Free Software Foundation; either version 2 of the License, or (at
13 your option) any later version.
14
15 MIT/GNU Scheme is distributed in the hope that it will be useful, but
16 WITHOUT ANY WARRANTY; without even the implied warranty of
17 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
18 General Public License for more details.
19
20 You should have received a copy of the GNU General Public License
21 along with MIT/GNU Scheme; if not, write to the Free Software
22 Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301,
23 USA.
24
25 */
26
27 /* X11 terminal for Edwin. */
28
29 #include "scheme.h"
30 #include "prims.h"
31 #include "x11.h"
32
33 struct xterm_extra
34 {
35 /* Dimensions of the window, in characters. Valid character
36 coordinates are nonnegative integers strictly less than these
37 limits. */
38 unsigned int x_size;
39 unsigned int y_size;
40
41 /* Position of the cursor, in character coordinates. */
42 unsigned int cursor_x;
43 unsigned int cursor_y;
44
45 /* Character map of the window's contents. See `XTERM_CHAR_LOC' for
46 the address arithmetic. */
47 char * character_map;
48
49 /* Bit map of the window's highlighting. */
50 char * highlight_map;
51
52 /* Nonzero iff the cursor is drawn on the window. */
53 char cursor_visible_p;
54
55 /* Nonzero iff the cursor should be drawn on the window. */
56 char cursor_enabled_p;
57 };
58
59 struct xwindow_term
60 {
61 struct xwindow xw;
62 struct xterm_extra extra;
63 };
64
65 #define XW_EXTRA(xw) (& (((struct xwindow_term *) xw) -> extra))
66
67 #define XW_X_CSIZE(xw) ((XW_EXTRA (xw)) -> x_size)
68 #define XW_Y_CSIZE(xw) ((XW_EXTRA (xw)) -> y_size)
69 #define XW_CURSOR_X(xw) ((XW_EXTRA (xw)) -> cursor_x)
70 #define XW_CURSOR_Y(xw) ((XW_EXTRA (xw)) -> cursor_y)
71 #define XW_CHARACTER_MAP(xw) ((XW_EXTRA (xw)) -> character_map)
72 #define XW_HIGHLIGHT_MAP(xw) ((XW_EXTRA (xw)) -> highlight_map)
73 #define XW_CURSOR_VISIBLE_P(xw) ((XW_EXTRA (xw)) -> cursor_visible_p)
74 #define XW_CURSOR_ENABLED_P(xw) ((XW_EXTRA (xw)) -> cursor_enabled_p)
75
76 #define XTERM_CHAR_INDEX(xw, x, y) (((y) * (XW_X_CSIZE (xw))) + (x))
77 #define XTERM_CHAR_LOC(xw, index) ((XW_CHARACTER_MAP (xw)) + (index))
78 #define XTERM_CHAR(xw, index) (* (XTERM_CHAR_LOC (xw, index)))
79 #define XTERM_HL_LOC(xw, index) ((XW_HIGHLIGHT_MAP (xw)) + (index))
80 #define XTERM_HL(xw, index) (* (XTERM_HL_LOC (xw, index)))
81
82 #define XTERM_HL_GC(xw, hl) (hl ? (XW_REVERSE_GC (xw)) : (XW_NORMAL_GC (xw)))
83
84 #define HL_ARG(arg) arg_index_integer (arg, 2)
85
86 #define RESOURCE_NAME "schemeTerminal"
87 #define RESOURCE_CLASS "SchemeTerminal"
88 #define DEFAULT_GEOMETRY "80x40+0+0"
89 #define BLANK_CHAR ' '
90 #define DEFAULT_HL 0
91
92 #define XTERM_X_PIXEL(xw, x) \
93 (((x) * (FONT_WIDTH (XW_FONT (xw)))) + (XW_INTERNAL_BORDER_WIDTH (xw)))
94
95 #define XTERM_Y_PIXEL(xw, y) \
96 (((y) * (FONT_HEIGHT (XW_FONT (xw)))) + (XW_INTERNAL_BORDER_WIDTH (xw)))
97
98 #define XTERM_DRAW_CHARS(xw, x, y, s, n, gc) \
99 XDrawImageString \
100 ((XW_DISPLAY (xw)), \
101 (XW_WINDOW (xw)), \
102 gc, \
103 (XTERM_X_PIXEL (xw, x)), \
104 ((XTERM_Y_PIXEL (xw, y)) + (FONT_BASE (XW_FONT (xw)))), \
105 s, \
106 n)
107
108 #define CURSOR_IN_RECTANGLE(xw, x_start, x_end, y_start, y_end) \
109 (((x_start) <= (XW_CURSOR_X (xw))) \
110 && ((XW_CURSOR_X (xw)) < (x_end)) \
111 && ((y_start) <= (XW_CURSOR_Y (xw))) \
112 && ((XW_CURSOR_Y (xw)) < (y_end)))
113
114 static void
xterm_erase_cursor(struct xwindow * xw)115 xterm_erase_cursor (struct xwindow * xw)
116 {
117 if (XW_CURSOR_VISIBLE_P (xw))
118 {
119 unsigned int x = (XW_CURSOR_X (xw));
120 unsigned int y = (XW_CURSOR_Y (xw));
121 unsigned int index = (XTERM_CHAR_INDEX (xw, x, y));
122 XTERM_DRAW_CHARS
123 (xw, x, y,
124 (XTERM_CHAR_LOC (xw, index)),
125 1,
126 (XTERM_HL_GC (xw, (XTERM_HL (xw, index)))));
127 (XW_CURSOR_VISIBLE_P (xw)) = 0;
128 }
129 }
130
131 static void
xterm_draw_cursor(struct xwindow * xw)132 xterm_draw_cursor (struct xwindow * xw)
133 {
134 if ((XW_CURSOR_ENABLED_P (xw)) && (! (XW_CURSOR_VISIBLE_P (xw))))
135 {
136 unsigned int x = (XW_CURSOR_X (xw));
137 unsigned int y = (XW_CURSOR_Y (xw));
138 unsigned int index = (XTERM_CHAR_INDEX (xw, x, y));
139 int hl = (XTERM_HL (xw, index));
140 XTERM_DRAW_CHARS
141 (xw, x, y,
142 (XTERM_CHAR_LOC (xw, index)),
143 1,
144 ((hl && ((XW_FOREGROUND_PIXEL (xw)) == (XW_CURSOR_PIXEL (xw))))
145 ? (XW_NORMAL_GC (xw))
146 : (XW_CURSOR_GC (xw))));
147 (XW_CURSOR_VISIBLE_P (xw)) = 1;
148 }
149 }
150
151 static void
xterm_process_event(struct xwindow * xw,XEvent * event)152 xterm_process_event (struct xwindow * xw, XEvent * event)
153 {
154 }
155
156 static XSizeHints *
xterm_make_size_hints(XFontStruct * font,unsigned int extra)157 xterm_make_size_hints (XFontStruct * font, unsigned int extra)
158 {
159 XSizeHints * size_hints = (XAllocSizeHints ());
160 if (size_hints == 0)
161 error_external_return ();
162 (size_hints -> flags) = (PResizeInc | PMinSize | PBaseSize);
163 (size_hints -> width_inc) = (FONT_WIDTH (font));
164 (size_hints -> height_inc) = (FONT_HEIGHT (font));
165 (size_hints -> min_width) = extra;
166 (size_hints -> min_height) = extra;
167 (size_hints -> base_width) = extra;
168 (size_hints -> base_height) = extra;
169 return (size_hints);
170 }
171
172 static void
xterm_set_wm_normal_hints(struct xwindow * xw,XSizeHints * size_hints)173 xterm_set_wm_normal_hints (struct xwindow * xw, XSizeHints * size_hints)
174 {
175 XSetWMNormalHints ((XW_DISPLAY (xw)), (XW_WINDOW (xw)), size_hints);
176 XFree (size_hints);
177 }
178
179 static void
xterm_update_normal_hints(struct xwindow * xw)180 xterm_update_normal_hints (struct xwindow * xw)
181 {
182 xterm_set_wm_normal_hints
183 (xw,
184 (xterm_make_size_hints
185 ((XW_FONT (xw)),
186 (2 * (XW_INTERNAL_BORDER_WIDTH (xw))))));
187 }
188
189 static void
xterm_deallocate(struct xwindow * xw)190 xterm_deallocate (struct xwindow * xw)
191 {
192 free (XW_CHARACTER_MAP (xw));
193 free (XW_HIGHLIGHT_MAP (xw));
194 }
195
196 static SCHEME_OBJECT
xterm_x_coordinate_map(struct xwindow * xw,unsigned int x)197 xterm_x_coordinate_map (struct xwindow * xw, unsigned int x)
198 {
199 return (ulong_to_integer (x / (FONT_WIDTH (XW_FONT (xw)))));
200 }
201
202 static SCHEME_OBJECT
xterm_y_coordinate_map(struct xwindow * xw,unsigned int y)203 xterm_y_coordinate_map (struct xwindow * xw, unsigned int y)
204 {
205 return (ulong_to_integer (y / (FONT_HEIGHT (XW_FONT (xw)))));
206 }
207
208 static void
xterm_copy_map_line(struct xwindow * xw,unsigned int x_start,unsigned int x_end,unsigned int y_from,unsigned int y_to)209 xterm_copy_map_line (struct xwindow * xw,
210 unsigned int x_start,
211 unsigned int x_end,
212 unsigned int y_from,
213 unsigned int y_to)
214 {
215 {
216 char * from_scan =
217 (XTERM_CHAR_LOC (xw, (XTERM_CHAR_INDEX (xw, x_start, y_from))));
218 char * from_end =
219 (XTERM_CHAR_LOC (xw, (XTERM_CHAR_INDEX (xw, x_end, y_from))));
220 char * to_scan =
221 (XTERM_CHAR_LOC (xw, (XTERM_CHAR_INDEX (xw, x_start, y_to))));
222 while (from_scan < from_end)
223 (*to_scan++) = (*from_scan++);
224 }
225 {
226 char * from_scan =
227 (XTERM_HL_LOC (xw, (XTERM_CHAR_INDEX (xw, x_start, y_from))));
228 char * from_end =
229 (XTERM_HL_LOC (xw, (XTERM_CHAR_INDEX (xw, x_end, y_from))));
230 char * to_scan =
231 (XTERM_HL_LOC (xw, (XTERM_CHAR_INDEX (xw, x_start, y_to))));
232 while (from_scan < from_end)
233 (*to_scan++) = (*from_scan++);
234 }
235 }
236
237 static void
xterm_dump_contents(struct xwindow * xw,unsigned int x_start,unsigned int x_end,unsigned int y_start,unsigned int y_end)238 xterm_dump_contents (struct xwindow * xw,
239 unsigned int x_start,
240 unsigned int x_end,
241 unsigned int y_start,
242 unsigned int y_end)
243 {
244 char * character_map = (XW_CHARACTER_MAP (xw));
245 char * highlight_map = (XW_HIGHLIGHT_MAP (xw));
246 if (x_start < x_end)
247 {
248 unsigned int yi;
249 for (yi = y_start; (yi < y_end); yi += 1)
250 {
251 unsigned int index = (XTERM_CHAR_INDEX (xw, 0, yi));
252 char * line_char = (&character_map[index]);
253 char * line_hl = (&highlight_map[index]);
254 unsigned int xi = x_start;
255 while (1)
256 {
257 unsigned int hl = (line_hl[xi]);
258 unsigned int xj = (xi + 1);
259 while ((xj < x_end) && ((line_hl[xj]) == hl))
260 xj += 1;
261 XTERM_DRAW_CHARS (xw, xi, yi,
262 (&line_char[xi]),
263 (xj - xi),
264 (XTERM_HL_GC (xw, hl)));
265 if (xj == x_end)
266 break;
267 xi = xj;
268 }
269 }
270 if (CURSOR_IN_RECTANGLE (xw, x_start, x_end, y_start, y_end))
271 {
272 (XW_CURSOR_VISIBLE_P (xw)) = 0;
273 xterm_draw_cursor (xw);
274 }
275 }
276 }
277
278 static void
xterm_dump_rectangle(struct xwindow * xw,int signed_x,int signed_y,unsigned int width,unsigned int height)279 xterm_dump_rectangle (struct xwindow * xw,
280 int signed_x,
281 int signed_y,
282 unsigned int width,
283 unsigned int height)
284 {
285 XFontStruct * font = (XW_FONT (xw));
286 unsigned int x = ((signed_x < 0) ? 0 : ((unsigned int) signed_x));
287 unsigned int y = ((signed_y < 0) ? 0 : ((unsigned int) signed_y));
288 unsigned int fwidth = (FONT_WIDTH (font));
289 unsigned int fheight = (FONT_HEIGHT (font));
290 unsigned int border = (XW_INTERNAL_BORDER_WIDTH (xw));
291 if (x < border)
292 {
293 width -= (border - x);
294 x = 0;
295 }
296 else
297 x -= border;
298 if ((x + width) > (XW_X_SIZE (xw)))
299 width = ((XW_X_SIZE (xw)) - x);
300 if (y < border)
301 {
302 height -= (border - y);
303 y = 0;
304 }
305 else
306 y -= border;
307 if ((y + height) > (XW_Y_SIZE (xw)))
308 height = ((XW_Y_SIZE (xw)) - y);
309 {
310 unsigned int x_start = (x / fwidth);
311 unsigned int x_end = (((x + width) + (fwidth - 1)) / fwidth);
312 unsigned int y_start = (y / fheight);
313 unsigned int y_end = (((y + height) + (fheight - 1)) / fheight);
314 if (x_end > (XW_X_CSIZE (xw)))
315 x_end = (XW_X_CSIZE (xw));
316 if (y_end > (XW_Y_CSIZE (xw)))
317 y_end = (XW_Y_CSIZE (xw));
318 xterm_dump_contents (xw, x_start, x_end, y_start, y_end);
319 }
320 XFlush (XW_DISPLAY (xw));
321 }
322
323 #define MIN(x, y) (((x) < (y)) ? (x) : (y))
324
325 static void
xterm_reconfigure(struct xwindow * xw,unsigned int x_csize,unsigned int y_csize)326 xterm_reconfigure (struct xwindow * xw,
327 unsigned int x_csize,
328 unsigned int y_csize)
329 {
330 if ((x_csize != (XW_X_CSIZE (xw))) || (y_csize != (XW_Y_CSIZE (xw))))
331 {
332 char * new_char_map = (x_malloc (x_csize * y_csize));
333 char * new_hl_map = (x_malloc (x_csize * y_csize));
334 unsigned int old_x_csize = (XW_X_CSIZE (xw));
335 unsigned int min_x_csize = (MIN (x_csize, old_x_csize));
336 unsigned int min_y_csize = (MIN (y_csize, (XW_Y_CSIZE (xw))));
337 int x_clipped = (old_x_csize - x_csize);
338 char * new_scan_char = new_char_map;
339 char * new_scan_hl = new_hl_map;
340 char * new_end;
341 char * old_scan_char = (XW_CHARACTER_MAP (xw));
342 char * old_scan_hl = (XW_HIGHLIGHT_MAP (xw));
343 char * old_end;
344 unsigned int new_y = 0;
345 for (; (new_y < min_y_csize); new_y += 1)
346 {
347 old_end = (old_scan_char + min_x_csize);
348 while (old_scan_char < old_end)
349 {
350 (*new_scan_char++) = (*old_scan_char++);
351 (*new_scan_hl++) = (*old_scan_hl++);
352 }
353 if (x_clipped < 0)
354 {
355 new_end = (new_scan_char + ((unsigned int) (- x_clipped)));
356 while (new_scan_char < new_end)
357 {
358 (*new_scan_char++) = BLANK_CHAR;
359 (*new_scan_hl++) = DEFAULT_HL;
360 }
361 }
362 else if (x_clipped > 0)
363 {
364 old_scan_char += ((unsigned int) x_clipped);
365 old_scan_hl += ((unsigned int) x_clipped);
366 }
367 }
368 for (; (new_y < y_csize); new_y += 1)
369 {
370 new_end = (new_scan_char + x_csize);
371 while (new_scan_char < new_end)
372 {
373 (*new_scan_char++) = BLANK_CHAR;
374 (*new_scan_hl++) = DEFAULT_HL;
375 }
376 }
377 free (XW_CHARACTER_MAP (xw));
378 free (XW_HIGHLIGHT_MAP (xw));
379 {
380 unsigned int x_size = (XTERM_X_PIXEL (xw, x_csize));
381 unsigned int y_size = (XTERM_Y_PIXEL (xw, x_csize));
382 (XW_X_SIZE (xw)) = x_size;
383 (XW_Y_SIZE (xw)) = y_size;
384 (XW_CLIP_X (xw)) = 0;
385 (XW_CLIP_Y (xw)) = 0;
386 (XW_CLIP_WIDTH (xw)) = x_size;
387 (XW_CLIP_HEIGHT (xw)) = y_size;
388 }
389 (XW_X_CSIZE (xw)) = x_csize;
390 (XW_Y_CSIZE (xw)) = y_csize;
391 (XW_CHARACTER_MAP (xw))= new_char_map;
392 (XW_HIGHLIGHT_MAP (xw))= new_hl_map;
393 XClearWindow ((XW_DISPLAY (xw)), (XW_WINDOW (xw)));
394 xterm_dump_contents (xw, 0, 0, x_csize, y_csize);
395 xterm_update_normal_hints (xw);
396 XFlush (XW_DISPLAY (xw));
397 }
398 }
399
400 DEFINE_PRIMITIVE ("XTERM-RECONFIGURE", Prim_xterm_reconfigure, 3, 3, 0)
401 {
402 PRIMITIVE_HEADER (3);
403 xterm_reconfigure ((x_window_arg (1)),
404 (arg_ulong_integer (2)),
405 (arg_ulong_integer (3)));
406 PRIMITIVE_RETURN (UNSPECIFIC);
407 }
408
409 DEFINE_PRIMITIVE ("XTERM-DUMP-RECTANGLE", Prim_xterm_dump_rectangle, 5, 5, 0)
410 {
411 PRIMITIVE_HEADER (5);
412 xterm_dump_rectangle ((x_window_arg (1)),
413 (arg_integer (2)),
414 (arg_integer (3)),
415 (arg_ulong_integer (4)),
416 (arg_ulong_integer (5)));
417 PRIMITIVE_RETURN (UNSPECIFIC);
418 }
419
420 DEFINE_PRIMITIVE ("XTERM-MAP-X-COORDINATE", Prim_xterm_map_x_coordinate, 2, 2, 0)
421 {
422 PRIMITIVE_HEADER (2);
423 {
424 struct xwindow * xw = (x_window_arg (1));
425 int signed_xp = (arg_integer (2));
426 unsigned int xp = ((signed_xp < 0) ? 0 : ((unsigned int) signed_xp));
427 int bx = (xp - (XW_INTERNAL_BORDER_WIDTH (xw)));
428 PRIMITIVE_RETURN
429 (long_to_integer
430 (((bx < 0) ? 0
431 : (bx >= (XW_X_SIZE (xw))) ? ((XW_X_SIZE (xw)) - 1)
432 : bx)
433 / (FONT_WIDTH (XW_FONT (xw)))));
434 }
435 }
436
437 DEFINE_PRIMITIVE ("XTERM-MAP-Y-COORDINATE", Prim_xterm_map_y_coordinate, 2, 2, 0)
438 {
439 PRIMITIVE_HEADER (2);
440 {
441 struct xwindow * xw = (x_window_arg (1));
442 int signed_yp = (arg_integer (2));
443 unsigned int yp = ((signed_yp < 0) ? 0 : ((unsigned int) signed_yp));
444 int by = (yp - (XW_INTERNAL_BORDER_WIDTH (xw)));
445 PRIMITIVE_RETURN
446 (long_to_integer
447 (((by < 0) ? 0
448 : (by >= (XW_Y_SIZE (xw))) ? ((XW_Y_SIZE (xw)) - 1)
449 : by)
450 / (FONT_HEIGHT (XW_FONT (xw)))));
451 }
452 }
453
454 DEFINE_PRIMITIVE ("XTERM-MAP-X-SIZE", Prim_xterm_map_x_size, 2, 2, 0)
455 {
456 PRIMITIVE_HEADER (2);
457 {
458 struct xwindow * xw = (x_window_arg (1));
459 int width =
460 ((arg_nonnegative_integer (2)) - (2 * (XW_INTERNAL_BORDER_WIDTH (xw))));
461 PRIMITIVE_RETURN
462 (ulong_to_integer
463 ((width < 0) ? 0 : (width / (FONT_WIDTH (XW_FONT (xw))))));
464 }
465 }
466
467 DEFINE_PRIMITIVE ("XTERM-MAP-Y-SIZE", Prim_xterm_map_y_size, 2, 2, 0)
468 {
469 PRIMITIVE_HEADER (2);
470 {
471 struct xwindow * xw = (x_window_arg (1));
472 int height =
473 ((arg_nonnegative_integer (2)) - (2 * (XW_INTERNAL_BORDER_WIDTH (xw))));
474 PRIMITIVE_RETURN
475 (ulong_to_integer
476 ((height < 0) ? 0 : (height / (FONT_HEIGHT (XW_FONT (xw))))));
477 }
478 }
479
480 DEFINE_PRIMITIVE ("XTERM-OPEN-WINDOW", Prim_xterm_open_window, 3, 3, 0)
481 {
482 PRIMITIVE_HEADER (3);
483 {
484 struct xdisplay * xd = (x_display_arg (1));
485 Display * display = (XD_DISPLAY (xd));
486 struct drawing_attributes attributes;
487 struct xwindow_methods methods;
488 const char * resource_name = RESOURCE_NAME;
489 const char * resource_class = RESOURCE_CLASS;
490 int map_p;
491 XSizeHints * size_hints;
492 int x_pos;
493 int y_pos;
494 int x_size;
495 int y_size;
496 unsigned int x_csize;
497 unsigned int y_csize;
498 Window window;
499 struct xwindow * xw;
500 unsigned int map_size;
501
502 x_decode_window_map_arg
503 ((ARG_REF (3)), (&resource_name), (&resource_class), (&map_p));
504 x_default_attributes
505 (display, resource_name, resource_class, (&attributes));
506 (methods.deallocator) = xterm_deallocate;
507 (methods.event_processor) = xterm_process_event;
508 (methods.x_coordinate_map) = xterm_x_coordinate_map;
509 (methods.y_coordinate_map) = xterm_y_coordinate_map;
510 (methods.update_normal_hints) = xterm_update_normal_hints;
511
512 size_hints
513 = (xterm_make_size_hints ((attributes.font),
514 (2 * (attributes.internal_border_width))));
515 XWMGeometry (display,
516 (DefaultScreen (display)),
517 (((ARG_REF (2)) == SHARP_F)
518 ? (x_get_default
519 (display, resource_name, resource_class,
520 "geometry", "Geometry", 0))
521 : (STRING_ARG (2))),
522 DEFAULT_GEOMETRY,
523 (attributes.border_width),
524 size_hints,
525 (&x_pos), (&y_pos), (&x_size), (&y_size),
526 (& (size_hints->win_gravity)));
527 x_csize
528 = ((x_size - (size_hints->base_width)) / (size_hints->width_inc));
529 y_csize
530 = ((y_size - (size_hints->base_height)) / (size_hints->height_inc));
531
532 window = (XCreateSimpleWindow
533 (display, (RootWindow (display, (DefaultScreen (display)))),
534 x_pos, y_pos, x_size, y_size,
535 (attributes.border_width),
536 (attributes.border_pixel),
537 (attributes.background_pixel)));
538 if (window == 0)
539 error_external_return ();
540
541 xw = (x_make_window
542 (xd,
543 window,
544 (x_size - (size_hints->base_width)),
545 (y_size - (size_hints->base_height)),
546 (&attributes),
547 (&methods),
548 (sizeof (struct xwindow_term))));
549 (XW_X_CSIZE (xw)) = x_csize;
550 (XW_Y_CSIZE (xw)) = y_csize;
551 (XW_CURSOR_X (xw)) = 0;
552 (XW_CURSOR_Y (xw)) = 0;
553 (XW_CURSOR_VISIBLE_P (xw)) = 0;
554 (XW_CURSOR_ENABLED_P (xw)) = 1;
555
556 map_size = (x_csize * y_csize);
557 (XW_CHARACTER_MAP (xw)) = (x_malloc (map_size));
558 memset ((XW_CHARACTER_MAP (xw)), BLANK_CHAR, map_size);
559 (XW_HIGHLIGHT_MAP (xw)) = (x_malloc (map_size));
560 memset ((XW_CHARACTER_MAP (xw)), DEFAULT_HL, map_size);
561
562 (size_hints->flags) |= PWinGravity;
563 xterm_set_wm_normal_hints (xw, size_hints);
564 xw_set_wm_input_hint (xw, 1);
565 xw_set_wm_name (xw, "scheme-terminal");
566 xw_set_wm_icon_name (xw, "scheme-terminal");
567 xw_make_window_map (xw, resource_name, resource_class, map_p);
568 PRIMITIVE_RETURN (XW_TO_OBJECT (xw));
569 }
570 }
571
572 DEFINE_PRIMITIVE ("XTERM-X-SIZE", Prim_xterm_x_size, 1, 1, 0)
573 {
574 PRIMITIVE_HEADER (1);
575 PRIMITIVE_RETURN (ulong_to_integer (XW_X_CSIZE (x_window_arg (1))));
576 }
577
578 DEFINE_PRIMITIVE ("XTERM-Y-SIZE", Prim_xterm_y_size, 1, 1, 0)
579 {
580 PRIMITIVE_HEADER (1);
581 PRIMITIVE_RETURN (ulong_to_integer (XW_Y_CSIZE (x_window_arg (1))));
582 }
583
584 DEFINE_PRIMITIVE ("XTERM-SET-SIZE", Prim_xterm_set_size, 3, 3, 0)
585 {
586 struct xwindow * xw;
587 int extra;
588 XFontStruct * font;
589 PRIMITIVE_HEADER (3);
590 xw = (x_window_arg (1));
591 extra = (2 * (XW_INTERNAL_BORDER_WIDTH (xw)));
592 #ifdef __APPLE__
593 extra += 1;
594 #endif
595 font = (XW_FONT (xw));
596 XResizeWindow
597 ((XW_DISPLAY (xw)),
598 (XW_WINDOW (xw)),
599 (((arg_ulong_integer (2)) * (FONT_WIDTH (font))) + extra),
600 (((arg_ulong_integer (3)) * (FONT_HEIGHT (font))) + extra));
601 PRIMITIVE_RETURN (UNSPECIFIC);
602 }
603
604 DEFINE_PRIMITIVE ("XTERM-ENABLE-CURSOR", Prim_xterm_enable_cursor, 2, 2, 0)
605 {
606 PRIMITIVE_HEADER (2);
607 (XW_CURSOR_ENABLED_P (x_window_arg (1))) = (BOOLEAN_ARG (2));
608 PRIMITIVE_RETURN (UNSPECIFIC);
609 }
610
611 DEFINE_PRIMITIVE ("XTERM-ERASE-CURSOR", Prim_xterm_erase_cursor, 1, 1, 0)
612 {
613 PRIMITIVE_HEADER (1);
614 xterm_erase_cursor (x_window_arg (1));
615 PRIMITIVE_RETURN (UNSPECIFIC);
616 }
617
618 DEFINE_PRIMITIVE ("XTERM-DRAW-CURSOR", Prim_xterm_draw_cursor, 1, 1, 0)
619 {
620 PRIMITIVE_HEADER (1);
621 xterm_draw_cursor (x_window_arg (1));
622 PRIMITIVE_RETURN (UNSPECIFIC);
623 }
624
625 DEFINE_PRIMITIVE ("XTERM-WRITE-CURSOR!", Prim_xterm_write_cursor, 3, 3, 0)
626 {
627 PRIMITIVE_HEADER (3);
628 {
629 struct xwindow * xw = (x_window_arg (1));
630 unsigned int x = (arg_ulong_index_integer (2, (XW_X_CSIZE (xw))));
631 unsigned int y = (arg_ulong_index_integer (3, (XW_Y_CSIZE (xw))));
632 if ((x != (XW_CURSOR_X (xw))) || (y != (XW_CURSOR_Y (xw))))
633 {
634 xterm_erase_cursor (xw);
635 (XW_CURSOR_X (xw)) = x;
636 (XW_CURSOR_Y (xw)) = y;
637 }
638 xterm_draw_cursor (xw);
639 }
640 PRIMITIVE_RETURN (UNSPECIFIC);
641 }
642
643 DEFINE_PRIMITIVE ("XTERM-WRITE-CHAR!", Prim_xterm_write_char, 5, 5, 0)
644 {
645 PRIMITIVE_HEADER (5);
646 {
647 struct xwindow * xw = (x_window_arg (1));
648 unsigned int x = (arg_ulong_index_integer (2, (XW_X_CSIZE (xw))));
649 unsigned int y = (arg_ulong_index_integer (3, (XW_Y_CSIZE (xw))));
650 int c = (arg_ascii_char (4));
651 unsigned int hl = (HL_ARG (5));
652 unsigned int index = (XTERM_CHAR_INDEX (xw, x, y));
653 char * map_ptr = (XTERM_CHAR_LOC (xw, index));
654 (*map_ptr) = c;
655 (XTERM_HL (xw, index)) = hl;
656 XTERM_DRAW_CHARS (xw, x, y, map_ptr, 1, (XTERM_HL_GC (xw, hl)));
657 if (((XW_CURSOR_X (xw)) == x) && ((XW_CURSOR_Y (xw)) == y))
658 {
659 (XW_CURSOR_VISIBLE_P (xw)) = 0;
660 xterm_draw_cursor (xw);
661 }
662 }
663 PRIMITIVE_RETURN (UNSPECIFIC);
664 }
665
666 DEFINE_PRIMITIVE ("XTERM-WRITE-SUBSTRING!", Prim_xterm_write_substring, 7, 7, 0)
667 {
668 PRIMITIVE_HEADER (7);
669 CHECK_ARG (4, STRING_P);
670 {
671 struct xwindow * xw = (x_window_arg (1));
672 unsigned int x = (arg_ulong_index_integer (2, (XW_X_CSIZE (xw))));
673 unsigned int y = (arg_ulong_index_integer (3, (XW_Y_CSIZE (xw))));
674 SCHEME_OBJECT string = (ARG_REF (4));
675 unsigned int end
676 = (arg_ulong_index_integer (6, ((STRING_LENGTH (string)) + 1)));
677 unsigned int start = (arg_ulong_index_integer (5, (end + 1)));
678 unsigned int hl = (HL_ARG (7));
679 unsigned int length = (end - start);
680 unsigned int index = (XTERM_CHAR_INDEX (xw, x, y));
681 if ((x + length) > (XW_X_CSIZE (xw)))
682 error_bad_range_arg (2);
683 {
684 unsigned char * string_scan = (STRING_LOC (string, start));
685 unsigned char * string_end = (STRING_LOC (string, end));
686 char * char_scan = (XTERM_CHAR_LOC (xw, index));
687 char * hl_scan = (XTERM_HL_LOC (xw, index));
688 while (string_scan < string_end)
689 {
690 (*char_scan++) = (*string_scan++);
691 (*hl_scan++) = hl;
692 }
693 }
694 XTERM_DRAW_CHARS
695 (xw, x, y, (XTERM_CHAR_LOC (xw, index)), length, (XTERM_HL_GC (xw, hl)));
696 if ((x <= (XW_CURSOR_X (xw))) && ((XW_CURSOR_X (xw)) < (x + length))
697 && (y == (XW_CURSOR_Y (xw))))
698 {
699 (XW_CURSOR_VISIBLE_P (xw)) = 0;
700 xterm_draw_cursor (xw);
701 }
702 }
703 PRIMITIVE_RETURN (UNSPECIFIC);
704 }
705
706 static void
xterm_clear_rectangle(struct xwindow * xw,unsigned int x_start,unsigned int x_end,unsigned int y_start,unsigned int y_end,unsigned int hl)707 xterm_clear_rectangle (struct xwindow * xw,
708 unsigned int x_start,
709 unsigned int x_end,
710 unsigned int y_start,
711 unsigned int y_end,
712 unsigned int hl)
713 {
714 unsigned int x_length = (x_end - x_start);
715 unsigned int y;
716 for (y = y_start; (y < y_end); y += 1)
717 {
718 unsigned int index = (XTERM_CHAR_INDEX (xw, x_start, y));
719 {
720 char * scan = (XTERM_CHAR_LOC (xw, index));
721 char * end = (scan + x_length);
722 while (scan < end)
723 (*scan++) = BLANK_CHAR;
724 }
725 {
726 char * scan = (XTERM_HL_LOC (xw, index));
727 char * end = (scan + x_length);
728 while (scan < end)
729 (*scan++) = hl;
730 }
731 }
732 if (hl != 0)
733 {
734 GC hl_gc = (XTERM_HL_GC (xw, hl));
735 for (y = y_start; (y < y_end); y += 1)
736 XTERM_DRAW_CHARS
737 (xw, x_start, y,
738 (XTERM_CHAR_LOC (xw, (XTERM_CHAR_INDEX (xw, x_start, y)))),
739 x_length, hl_gc);
740 }
741 else if ((x_start == 0)
742 && (y_start == 0)
743 && (x_end == (XW_X_CSIZE (xw)))
744 && (y_end == (XW_Y_CSIZE (xw))))
745 XClearWindow ((XW_DISPLAY (xw)), (XW_WINDOW (xw)));
746 else
747 XClearArea ((XW_DISPLAY (xw)),
748 (XW_WINDOW (xw)),
749 (XTERM_X_PIXEL (xw, x_start)),
750 (XTERM_Y_PIXEL (xw, y_start)),
751 (x_length * (FONT_WIDTH (XW_FONT (xw)))),
752 ((y_end - y_start) * (FONT_HEIGHT (XW_FONT (xw)))),
753 False);
754 }
755
756 DEFINE_PRIMITIVE ("XTERM-CLEAR-RECTANGLE!", Prim_xterm_clear_rectangle, 6, 6, 0)
757 {
758 PRIMITIVE_HEADER (6);
759 {
760 struct xwindow * xw = (x_window_arg (1));
761 unsigned int x_end
762 = (arg_ulong_index_integer (3, ((XW_X_CSIZE (xw)) + 1)));
763 unsigned int y_end
764 = (arg_ulong_index_integer (5, ((XW_Y_CSIZE (xw)) + 1)));
765 unsigned int x_start = (arg_ulong_index_integer (2, (x_end + 1)));
766 unsigned int y_start = (arg_ulong_index_integer (4, (y_end + 1)));
767 unsigned int hl = (HL_ARG (6));
768 if ((x_start < x_end) && (y_start < y_end))
769 {
770 xterm_clear_rectangle (xw, x_start, x_end, y_start, y_end, hl);
771 if (CURSOR_IN_RECTANGLE (xw, x_start, x_end, y_start, y_end))
772 {
773 (XW_CURSOR_VISIBLE_P (xw)) = 0;
774 xterm_draw_cursor (xw);
775 }
776 }
777 }
778 PRIMITIVE_RETURN (UNSPECIFIC);
779 }
780
781 static void
xterm_scroll_lines_up(struct xwindow * xw,unsigned int x_start,unsigned int x_end,unsigned int y_start,unsigned int y_end,unsigned int lines)782 xterm_scroll_lines_up (struct xwindow * xw,
783 unsigned int x_start,
784 unsigned int x_end,
785 unsigned int y_start,
786 unsigned int y_end,
787 unsigned int lines)
788 {
789 {
790 unsigned int y_to = y_start;
791 unsigned int y_from = (y_to + lines);
792 while (y_from < y_end)
793 xterm_copy_map_line (xw, x_start, x_end, (y_from++), (y_to++));
794 }
795 XCopyArea ((XW_DISPLAY (xw)),
796 (XW_WINDOW (xw)),
797 (XW_WINDOW (xw)),
798 (XW_NORMAL_GC (xw)),
799 (XTERM_X_PIXEL (xw, x_start)),
800 (XTERM_Y_PIXEL (xw, (y_start + lines))),
801 ((x_end - x_start) * (FONT_WIDTH (XW_FONT (xw)))),
802 (((y_end - y_start) - lines) * (FONT_HEIGHT (XW_FONT (xw)))),
803 (XTERM_X_PIXEL (xw, x_start)),
804 (XTERM_Y_PIXEL (xw, y_start)));
805 }
806
807 DEFINE_PRIMITIVE ("XTERM-SCROLL-LINES-UP", Prim_xterm_scroll_lines_up, 6, 6,
808 "(XTERM-SCROLL-LINES-UP XTERM X-START X-END Y-START Y-END LINES)\n\
809 Scroll the contents of the region up by LINES.")
810 {
811 PRIMITIVE_HEADER (6);
812 {
813 struct xwindow * xw = (x_window_arg (1));
814 unsigned int x_end
815 = (arg_ulong_index_integer (3, ((XW_X_CSIZE (xw)) + 1)));
816 unsigned int x_start = (arg_ulong_index_integer (2, (x_end + 1)));
817 unsigned int y_end
818 = (arg_ulong_index_integer (5, ((XW_Y_CSIZE (xw)) + 1)));
819 unsigned int y_start = (arg_ulong_index_integer (4, (y_end + 1)));
820 unsigned int lines = (arg_ulong_index_integer (6, (y_end - y_start)));
821 if ((0 < lines) && (x_start < x_end) && (y_start < y_end))
822 {
823 if (CURSOR_IN_RECTANGLE (xw, x_start, x_end, (y_start + lines), y_end))
824 {
825 xterm_erase_cursor (xw);
826 xterm_scroll_lines_up (xw, x_start, x_end, y_start, y_end, lines);
827 xterm_draw_cursor (xw);
828 }
829 else
830 {
831 xterm_scroll_lines_up (xw, x_start, x_end, y_start, y_end, lines);
832 if (CURSOR_IN_RECTANGLE
833 (xw, x_start, x_end, y_start, (y_end - lines)))
834 {
835 (XW_CURSOR_VISIBLE_P (xw)) = 0;
836 xterm_draw_cursor (xw);
837 }
838 }
839 }
840 }
841 PRIMITIVE_RETURN (UNSPECIFIC);
842 }
843
844 static void
xterm_scroll_lines_down(struct xwindow * xw,unsigned int x_start,unsigned int x_end,unsigned int y_start,unsigned int y_end,unsigned int lines)845 xterm_scroll_lines_down (struct xwindow * xw,
846 unsigned int x_start,
847 unsigned int x_end,
848 unsigned int y_start,
849 unsigned int y_end,
850 unsigned int lines)
851 {
852 {
853 unsigned int y_to = y_end;
854 unsigned int y_from = (y_to - lines);
855 while (y_from > y_start)
856 xterm_copy_map_line (xw, x_start, x_end, (--y_from), (--y_to));
857 }
858 XCopyArea ((XW_DISPLAY (xw)),
859 (XW_WINDOW (xw)),
860 (XW_WINDOW (xw)),
861 (XW_NORMAL_GC (xw)),
862 (XTERM_X_PIXEL (xw, x_start)),
863 (XTERM_Y_PIXEL (xw, y_start)),
864 ((x_end - x_start) * (FONT_WIDTH (XW_FONT (xw)))),
865 (((y_end - y_start) - lines) * (FONT_HEIGHT (XW_FONT (xw)))),
866 (XTERM_X_PIXEL (xw, x_start)),
867 (XTERM_Y_PIXEL (xw, (y_start + lines))));
868 }
869
870 DEFINE_PRIMITIVE ("XTERM-SCROLL-LINES-DOWN", Prim_xterm_scroll_lines_down, 6, 6,
871 "(XTERM-SCROLL-LINES-DOWN XTERM X-START X-END Y-START Y-END LINES)\n\
872 Scroll the contents of the region down by LINES.")
873 {
874 PRIMITIVE_HEADER (6);
875 {
876 struct xwindow * xw = (x_window_arg (1));
877 unsigned int x_end
878 = (arg_ulong_index_integer (3, ((XW_X_CSIZE (xw)) + 1)));
879 unsigned int x_start = (arg_ulong_index_integer (2, (x_end + 1)));
880 unsigned int y_end
881 = (arg_ulong_index_integer (5, ((XW_Y_CSIZE (xw)) + 1)));
882 unsigned int y_start = (arg_ulong_index_integer (4, (y_end + 1)));
883 unsigned int lines = (arg_ulong_index_integer (6, (y_end - y_start)));
884 if ((0 < lines) && (x_start < x_end) && (y_start < y_end))
885 {
886 if (CURSOR_IN_RECTANGLE (xw, x_start, x_end, y_start, (y_end - lines)))
887 {
888 xterm_erase_cursor (xw);
889 xterm_scroll_lines_down
890 (xw, x_start, x_end, y_start, y_end, lines);
891 xterm_draw_cursor (xw);
892 }
893 else
894 {
895 xterm_scroll_lines_down
896 (xw, x_start, x_end, y_start, y_end, lines);
897 if (CURSOR_IN_RECTANGLE
898 (xw, x_start, x_end, (y_start + lines), y_end))
899 {
900 (XW_CURSOR_VISIBLE_P (xw)) = 0;
901 xterm_draw_cursor (xw);
902 }
903 }
904 }
905 }
906 PRIMITIVE_RETURN (UNSPECIFIC);
907 }
908
909 DEFINE_PRIMITIVE ("XTERM-SAVE-CONTENTS", Prim_xterm_save_contents, 5, 5,
910 "(XTERM-SAVE-CONTENTS XW X-START X-END Y-START Y-END)\n\
911 Get the contents of the terminal screen rectangle as a string.\n\
912 The string contains alternating (CHARACTER, HIGHLIGHT) pairs.\n\
913 The pairs are organized in row-major order from (X-START, Y-START).")
914 {
915 PRIMITIVE_HEADER (5);
916 {
917 struct xwindow * xw = (x_window_arg (1));
918 unsigned int x_end
919 = (arg_ulong_index_integer (3, ((XW_X_CSIZE (xw)) + 1)));
920 unsigned int y_end
921 = (arg_ulong_index_integer (5, ((XW_Y_CSIZE (xw)) + 1)));
922 unsigned int x_start = (arg_ulong_index_integer (2, (x_end + 1)));
923 unsigned int y_start = (arg_ulong_index_integer (4, (y_end + 1)));
924 unsigned int x_length = (x_end - x_start);
925 unsigned int string_length = (2 * x_length * (y_end - y_start));
926 SCHEME_OBJECT string = (allocate_string (string_length));
927 if (string_length > 0)
928 {
929 char * string_scan = (STRING_POINTER (string));
930 unsigned int y;
931 for (y = y_start; (y < y_end); y += 1)
932 {
933 unsigned int index = (XTERM_CHAR_INDEX (xw, x_start, y));
934 char * char_scan = (XTERM_CHAR_LOC (xw, index));
935 char * char_end = (char_scan + x_length);
936 char * hl_scan = (XTERM_HL_LOC (xw, index));
937 while (char_scan < char_end)
938 {
939 (*string_scan++) = (*char_scan++);
940 (*string_scan++) = (*hl_scan++);
941 }
942 }
943 }
944 PRIMITIVE_RETURN (string);
945 }
946 }
947
948 DEFINE_PRIMITIVE ("XTERM-RESTORE-CONTENTS", Prim_xterm_restore_contents, 6, 6,
949 "(xterm-restore-contents xterm x-start x-end y-start y-end contents)\n\
950 Replace the terminal screen rectangle with CONTENTS.\n\
951 See `XTERM-SCREEN-CONTENTS' for the format of CONTENTS.")
952 {
953 PRIMITIVE_HEADER (6);
954 CHECK_ARG (6, STRING_P);
955 {
956 struct xwindow * xw = (x_window_arg (1));
957 unsigned int x_end
958 = (arg_ulong_index_integer (3, ((XW_X_CSIZE (xw)) + 1)));
959 unsigned int y_end
960 = (arg_ulong_index_integer (5, ((XW_Y_CSIZE (xw)) + 1)));
961 unsigned int x_start = (arg_ulong_index_integer (2, (x_end + 1)));
962 unsigned int y_start = (arg_ulong_index_integer (4, (y_end + 1)));
963 unsigned int x_length = (x_end - x_start);
964 unsigned int string_length = (2 * x_length * (y_end - y_start));
965 SCHEME_OBJECT string = (ARG_REF (6));
966 if ((STRING_LENGTH (string)) != string_length)
967 error_bad_range_arg (6);
968 if (string_length > 0)
969 {
970 char * string_scan = (STRING_POINTER (string));
971 unsigned int y;
972 for (y = y_start; (y < y_end); y += 1)
973 {
974 unsigned int index = (XTERM_CHAR_INDEX (xw, x_start, y));
975 char * char_scan = (XTERM_CHAR_LOC (xw, index));
976 char * char_end = (char_scan + x_length);
977 char * hl_scan = (XTERM_HL_LOC (xw, index));
978 while (char_scan < char_end)
979 {
980 (*char_scan++) = (*string_scan++);
981 (*hl_scan++) = (*string_scan++);
982 }
983 }
984 xterm_dump_contents (xw, x_start, x_end, y_start, y_end);
985 }
986 }
987 PRIMITIVE_RETURN (UNSPECIFIC);
988 }
989
990 #ifdef COMPILE_AS_MODULE
991
992 /* sed -n -e 's/^DEFINE_PRIMITIVE *(\([^)]*\))$/ declare_primitive (\1);/pg' \
993 -e 's/^DEFINE_PRIMITIVE *(\([^)]*\)$/ declare_primitive (\1 0);/pg' */
994
995 void
dload_initialize_x11term(void)996 dload_initialize_x11term (void)
997 {
998 declare_primitive ("XTERM-CLEAR-RECTANGLE!", Prim_xterm_clear_rectangle, 6, 6, 0);
999 declare_primitive ("XTERM-DRAW-CURSOR", Prim_xterm_draw_cursor, 1, 1, 0);
1000 declare_primitive ("XTERM-DUMP-RECTANGLE", Prim_xterm_dump_rectangle, 5, 5, 0);
1001 declare_primitive ("XTERM-ENABLE-CURSOR", Prim_xterm_enable_cursor, 2, 2, 0);
1002 declare_primitive ("XTERM-ERASE-CURSOR", Prim_xterm_erase_cursor, 1, 1, 0);
1003 declare_primitive ("XTERM-MAP-X-COORDINATE", Prim_xterm_map_x_coordinate, 2, 2, 0);
1004 declare_primitive ("XTERM-MAP-X-SIZE", Prim_xterm_map_x_size, 2, 2, 0);
1005 declare_primitive ("XTERM-MAP-Y-COORDINATE", Prim_xterm_map_y_coordinate, 2, 2, 0);
1006 declare_primitive ("XTERM-MAP-Y-SIZE", Prim_xterm_map_y_size, 2, 2, 0);
1007 declare_primitive ("XTERM-OPEN-WINDOW", Prim_xterm_open_window, 3, 3, 0);
1008 declare_primitive ("XTERM-RECONFIGURE", Prim_xterm_reconfigure, 3, 3, 0);
1009 declare_primitive ("XTERM-RESTORE-CONTENTS", Prim_xterm_restore_contents, 6, 6, 0);
1010 declare_primitive ("XTERM-SAVE-CONTENTS", Prim_xterm_save_contents, 5, 5, 0);
1011 declare_primitive ("XTERM-SCROLL-LINES-DOWN", Prim_xterm_scroll_lines_down, 6, 6, 0);
1012 declare_primitive ("XTERM-SCROLL-LINES-UP", Prim_xterm_scroll_lines_up, 6, 6, 0);
1013 declare_primitive ("XTERM-SET-SIZE", Prim_xterm_set_size, 3, 3, 0);
1014 declare_primitive ("XTERM-WRITE-CHAR!", Prim_xterm_write_char, 5, 5, 0);
1015 declare_primitive ("XTERM-WRITE-CURSOR!", Prim_xterm_write_cursor, 3, 3, 0);
1016 declare_primitive ("XTERM-WRITE-SUBSTRING!", Prim_xterm_write_substring, 7, 7, 0);
1017 declare_primitive ("XTERM-X-SIZE", Prim_xterm_x_size, 1, 1, 0);
1018 declare_primitive ("XTERM-Y-SIZE", Prim_xterm_y_size, 1, 1, 0);
1019 }
1020
1021 #endif /* defined (COMPILE_AS_MODULE) */
1022