x11.c revision 5dfecf96 
1/*
2 * Copyright (c) 2001 by The XFree86 Project, Inc.
3 *
4 * Permission is hereby granted, free of charge, to any person obtaining a
5 * copy of this software and associated documentation files (the "Software"),
6 * to deal in the Software without restriction, including without limitation
7 * the rights to use, copy, modify, merge, publish, distribute, sublicense,
8 * and/or sell copies of the Software, and to permit persons to whom the
9 * Software is furnished to do so, subject to the following conditions:
10 *
11 * The above copyright notice and this permission notice shall be included in
12 * all copies or substantial portions of the Software.
13 *
14 * THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
15 * IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
16 * FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.  IN NO EVENT SHALL
17 * THE XFREE86 PROJECT BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
18 * WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF
19 * OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
20 * SOFTWARE.
21 *
22 * Except as contained in this notice, the name of the XFree86 Project shall
23 * not be used in advertising or otherwise to promote the sale, use or other
24 * dealings in this Software without prior written authorization from the
25 * XFree86 Project.
26 *
27 * Author: Paulo César Pereira de Andrade
28 */
29
30/* $XFree86: xc/programs/xedit/lisp/modules/x11.c,v 1.11tsi Exp $ */
31
32#include <stdlib.h>
33#include <string.h>
34#include "lisp/internal.h"
35#include "lisp/private.h"
36#include <X11/Xlib.h>
37
38/*
39 * Prototypes
40 */
41int x11LoadModule(void);
42
43LispObj *Lisp_XOpenDisplay(LispBuiltin *builtin);
44LispObj *Lisp_XCloseDisplay(LispBuiltin *builtin);
45LispObj *Lisp_XDefaultRootWindow(LispBuiltin *builtin);
46LispObj *Lisp_XDefaultScreen(LispBuiltin *builtin);
47LispObj *Lisp_XDefaultScreenOfDisplay(LispBuiltin *builtin);
48LispObj *Lisp_XBlackPixel(LispBuiltin *builtin);
49LispObj *Lisp_XBlackPixelOfScreen(LispBuiltin *builtin);
50LispObj *Lisp_XWidthOfScreen(LispBuiltin *builtin);
51LispObj *Lisp_XHeightOfScreen(LispBuiltin *builtin);
52LispObj *Lisp_XWhitePixel(LispBuiltin *builtin);
53LispObj *Lisp_XWhitePixelOfScreen(LispBuiltin *builtin);
54LispObj *Lisp_XDefaultGC(LispBuiltin *builtin);
55LispObj *Lisp_XDefaultGCOfScreen(LispBuiltin *builtin);
56LispObj *Lisp_XCreateSimpleWindow(LispBuiltin *builtin);
57LispObj *Lisp_XMapWindow(LispBuiltin *builtin);
58LispObj *Lisp_XDestroyWindow(LispBuiltin *builtin);
59LispObj *Lisp_XFlush(LispBuiltin *builtin);
60LispObj *Lisp_XRaiseWindow(LispBuiltin *builtin);
61LispObj *Lisp_XBell(LispBuiltin *builtin);
62
63LispObj *Lisp_XDrawLine(LispBuiltin *builtin);
64
65/*
66 * Initialization
67 */
68static LispBuiltin lispbuiltins[] = {
69    {LispFunction, Lisp_XOpenDisplay, "x-open-display &optional display-name"},
70    {LispFunction, Lisp_XCloseDisplay, "x-close-display display"},
71    {LispFunction, Lisp_XDefaultRootWindow, "x-default-root-window display"},
72    {LispFunction, Lisp_XDefaultScreen, "x-default-screen display"},
73    {LispFunction, Lisp_XDefaultScreenOfDisplay, "x-default-screen-of-display display"},
74    {LispFunction, Lisp_XBlackPixel, "x-black-pixel display &optional screen"},
75    {LispFunction, Lisp_XBlackPixelOfScreen, "x-black-pixel-of-screen screen"},
76    {LispFunction, Lisp_XWhitePixel, "x-white-pixel display &optional screen"},
77    {LispFunction, Lisp_XWhitePixelOfScreen, "x-white-pixel-of-screen screen"},
78    {LispFunction, Lisp_XDefaultGC, "x-default-gc display &optional screen"},
79    {LispFunction, Lisp_XDefaultGCOfScreen, "x-default-gc-of-screen screen"},
80    {LispFunction, Lisp_XCreateSimpleWindow, "x-create-simple-window display parent x y width height &optional border-width border background"},
81    {LispFunction, Lisp_XMapWindow, "x-map-window display window"},
82    {LispFunction, Lisp_XDestroyWindow, "X-DESTROY-WINDOW"},
83    {LispFunction, Lisp_XFlush, "x-flush display"},
84    {LispFunction, Lisp_XDrawLine, "x-draw-line display drawable gc x1 y1 x2 y2"},
85    {LispFunction, Lisp_XBell, "x-bell display &optional percent"},
86    {LispFunction, Lisp_XRaiseWindow, "x-raise-window display window"},
87    {LispFunction, Lisp_XWidthOfScreen, "x-width-of-screen screen"},
88    {LispFunction, Lisp_XHeightOfScreen, "x-height-of-screen screen"},
89};
90
91LispModuleData x11LispModuleData = {
92    LISP_MODULE_VERSION,
93    x11LoadModule
94};
95
96static int x11Display_t, x11Screen_t, x11Window_t, x11GC_t;
97
98/*
99 * Implementation
100 */
101int
102x11LoadModule(void)
103{
104    int i;
105
106    x11Display_t = LispRegisterOpaqueType("Display*");
107    x11Screen_t = LispRegisterOpaqueType("Screen*");
108    x11Window_t = LispRegisterOpaqueType("Window");
109    x11GC_t = LispRegisterOpaqueType("GC");
110
111    for (i = 0; i < sizeof(lispbuiltins) / sizeof(lispbuiltins[0]); i++)
112	LispAddBuiltinFunction(&lispbuiltins[i]);
113
114    return (1);
115}
116
117LispObj *
118Lisp_XOpenDisplay(LispBuiltin *builtin)
119/*
120x-open-display &optional display-name
121 */
122{
123    LispObj *display_name;
124    char *dname;
125
126    display_name = ARGUMENT(0);
127
128    if (display_name == UNSPEC)
129	dname = NULL;
130    else {
131	CHECK_STRING(display_name);
132	dname = THESTR(display_name);
133    }
134
135    return (OPAQUE(XOpenDisplay(dname), x11Display_t));
136}
137
138LispObj *
139Lisp_XCloseDisplay(LispBuiltin *builtin)
140/*
141 x-close-display display
142 */
143{
144    LispObj *display;
145
146    display = ARGUMENT(0);
147
148    if (!CHECKO(display, x11Display_t))
149	LispDestroy("%s: cannot convert %s to Display*",
150		    STRFUN(builtin), STROBJ(display));
151
152    XCloseDisplay((Display*)(display->data.opaque.data));
153
154    return (NIL);
155}
156
157LispObj *
158Lisp_XDefaultRootWindow(LispBuiltin *builtin)
159/*
160 x-default-root-window display
161 */
162{
163    LispObj *display;
164
165    display = ARGUMENT(0);
166
167    if (!CHECKO(display, x11Display_t))
168	LispDestroy("%s: cannot convert %s to Display*",
169		    STRFUN(builtin), STROBJ(display));
170
171    return (OPAQUE(DefaultRootWindow((Display*)(display->data.opaque.data)),
172		   x11Window_t));
173}
174
175LispObj *
176Lisp_XDefaultScreen(LispBuiltin *builtin)
177/*
178 x-default-screen display
179 */
180{
181    LispObj *display;
182
183    display = ARGUMENT(0);
184
185    if (!CHECKO(display, x11Display_t))
186	LispDestroy("%s: cannot convert %s to Display*",
187		    STRFUN(builtin), STROBJ(display));
188
189    return (INTEGER(DefaultScreen((Display*)(display->data.opaque.data))));
190}
191
192LispObj *
193Lisp_XDefaultScreenOfDisplay(LispBuiltin *builtin)
194/*
195 x-default-screen-of-display display
196 */
197{
198    LispObj *display;
199
200    display = ARGUMENT(0);
201
202    if (!CHECKO(display, x11Display_t))
203	LispDestroy("%s: cannot convert %s to Display*",
204		    STRFUN(builtin), STROBJ(display));
205
206    return (OPAQUE(DefaultScreenOfDisplay((Display*)(display->data.opaque.data)),
207		   x11Screen_t));
208}
209
210LispObj *
211Lisp_XBlackPixel(LispBuiltin *builtin)
212/*
213 x-black-pixel display &optional screen
214 */
215{
216    Display *display;
217    int screen;
218
219    LispObj *odisplay, *oscreen;
220
221    oscreen = ARGUMENT(1);
222    odisplay = ARGUMENT(0);
223
224    if (!CHECKO(odisplay, x11Display_t))
225	LispDestroy("%s: cannot convert %s to Display*",
226		    STRFUN(builtin), STROBJ(odisplay));
227    display = (Display*)(odisplay->data.opaque.data);
228
229    if (oscreen == UNSPEC)
230	screen = DefaultScreen(display);
231    else {
232	CHECK_INDEX(oscreen);
233	screen = FIXNUM_VALUE(oscreen);
234    }
235
236    if (screen >= ScreenCount(display))
237	LispDestroy("%s: screen index %d too large, %d screens available",
238		    STRFUN(builtin), screen, ScreenCount(display));
239
240    return (INTEGER(BlackPixel(display, screen)));
241}
242
243LispObj *
244Lisp_XBlackPixelOfScreen(LispBuiltin *builtin)
245/*
246 x-black-pixel-of-screen screen
247 */
248{
249    LispObj *screen;
250
251    screen = ARGUMENT(0);
252
253    if (!CHECKO(screen, x11Screen_t))
254	LispDestroy("%s: cannot convert %s to Screen*",
255		    STRFUN(builtin), STROBJ(screen));
256
257    return (INTEGER(XBlackPixelOfScreen((Screen*)(screen->data.opaque.data))));
258}
259
260LispObj *
261Lisp_XWhitePixel(LispBuiltin *builtin)
262/*
263 x-white-pixel display &optional screen
264 */
265{
266    Display *display;
267    int screen;
268
269    LispObj *odisplay, *oscreen;
270
271    oscreen = ARGUMENT(1);
272    odisplay = ARGUMENT(0);
273
274    if (!CHECKO(odisplay, x11Display_t))
275	LispDestroy("%s: cannot convert %s to Display*",
276		    STRFUN(builtin), STROBJ(odisplay));
277    display = (Display*)(odisplay->data.opaque.data);
278
279    if (oscreen == UNSPEC)
280	screen = DefaultScreen(display);
281    else {
282	CHECK_FIXNUM(oscreen);
283	screen = FIXNUM_VALUE(oscreen);
284    }
285
286    if (screen >= ScreenCount(display))
287	LispDestroy("%s: screen index %d too large, %d screens available",
288		    STRFUN(builtin), screen, ScreenCount(display));
289
290    return (INTEGER(WhitePixel(display, screen)));
291}
292
293LispObj *
294Lisp_XWhitePixelOfScreen(LispBuiltin *builtin)
295/*
296 x-white-pixel-of-screen screen
297 */
298{
299    LispObj *screen;
300
301    screen = ARGUMENT(0);
302
303    if (!CHECKO(screen, x11Screen_t))
304	LispDestroy("%s: cannot convert %s to Screen*",
305		    STRFUN(builtin), STROBJ(screen));
306
307    return (INTEGER(WhitePixelOfScreen((Screen*)(screen->data.opaque.data))));
308}
309
310LispObj *
311Lisp_XDefaultGC(LispBuiltin *builtin)
312/*
313 x-default-gc display &optional screen
314 */
315{
316    Display *display;
317    int screen;
318
319    LispObj *odisplay, *oscreen;
320
321    oscreen = ARGUMENT(1);
322    odisplay = ARGUMENT(0);
323
324    if (!CHECKO(odisplay, x11Display_t))
325	LispDestroy("%s: cannot convert %s to Display*",
326		    STRFUN(builtin), STROBJ(odisplay));
327    display = (Display*)(odisplay->data.opaque.data);
328
329    if (oscreen == UNSPEC)
330	screen = DefaultScreen(display);
331    else {
332	CHECK_FIXNUM(oscreen);
333	screen = FIXNUM_VALUE(oscreen);
334    }
335
336    if (screen >= ScreenCount(display))
337	LispDestroy("%s: screen index %d too large, %d screens available",
338		    STRFUN(builtin), screen, ScreenCount(display));
339
340    return (OPAQUE(DefaultGC(display, screen), x11GC_t));
341}
342
343LispObj *
344Lisp_XDefaultGCOfScreen(LispBuiltin *builtin)
345/*
346 x-default-gc-of-screen screen
347 */
348{
349    LispObj *screen;
350
351    screen = ARGUMENT(0);
352
353    if (!CHECKO(screen, x11Screen_t))
354	LispDestroy("%s: cannot convert %s to Screen*",
355		    STRFUN(builtin), STROBJ(screen));
356
357    return (OPAQUE(DefaultGCOfScreen((Screen*)(screen->data.opaque.data)),
358		   x11GC_t));
359}
360
361LispObj *
362Lisp_XCreateSimpleWindow(LispBuiltin *builtin)
363/*
364 x-create-simple-window display parent x y width height &optional border-width border background
365 */
366{
367    Display *display;
368    Window parent;
369    int x, y;
370    unsigned int width, height, border_width;
371    unsigned long border, background;
372
373    LispObj *odisplay, *oparent, *ox, *oy, *owidth, *oheight,
374	    *oborder_width, *oborder, *obackground;
375
376    obackground = ARGUMENT(8);
377    oborder = ARGUMENT(7);
378    oborder_width = ARGUMENT(6);
379    oheight = ARGUMENT(5);
380    owidth = ARGUMENT(4);
381    oy = ARGUMENT(3);
382    ox = ARGUMENT(2);
383    oparent = ARGUMENT(1);
384    odisplay = ARGUMENT(0);
385
386    if (!CHECKO(odisplay, x11Display_t))
387	LispDestroy("%s: cannot convert %s to Display*",
388		    STRFUN(builtin), STROBJ(odisplay));
389    display = (Display*)(odisplay->data.opaque.data);
390
391    if (!CHECKO(oparent, x11Window_t))
392	LispDestroy("%s: cannot convert %s to Window",
393		    STRFUN(builtin), STROBJ(oparent));
394    parent = (Window)(oparent->data.opaque.data);
395
396    CHECK_FIXNUM(ox);
397    x = FIXNUM_VALUE(ox);
398
399    CHECK_FIXNUM(oy);
400    y = FIXNUM_VALUE(oy);
401
402    CHECK_INDEX(owidth);
403    width = FIXNUM_VALUE(owidth);
404
405    CHECK_INDEX(oheight);
406    height = FIXNUM_VALUE(oheight);
407
408    /* check &OPTIONAL parameters */
409    if (oborder_width == UNSPEC)
410	border_width = 1;
411    else {
412	CHECK_INDEX(oborder_width);
413	border_width = FIXNUM_VALUE(oborder_width);
414    }
415
416    if (oborder == UNSPEC)
417	border = BlackPixel(display, DefaultScreen(display));
418    else {
419	CHECK_LONGINT(oborder);
420	border = LONGINT_VALUE(oborder);
421    }
422
423    if (obackground == UNSPEC)
424	background = WhitePixel(display, DefaultScreen(display));
425    else {
426	CHECK_LONGINT(obackground);
427	background = LONGINT_VALUE(obackground);
428    }
429
430    return (OPAQUE(
431	    XCreateSimpleWindow(display, parent, x, y, width, height,
432				border_width, border, background),
433	    x11Window_t));
434}
435
436LispObj *
437Lisp_XMapWindow(LispBuiltin *builtin)
438/*
439 x-map-window display window
440 */
441{
442    Display *display;
443    Window window;
444
445    LispObj *odisplay, *owindow;
446
447    owindow = ARGUMENT(1);
448    odisplay = ARGUMENT(0);
449
450    if (!CHECKO(odisplay, x11Display_t))
451	LispDestroy("%s: cannot convert %s to Display*",
452		    STRFUN(builtin), STROBJ(odisplay));
453    display = (Display*)(odisplay->data.opaque.data);
454
455    if (!CHECKO(owindow, x11Window_t))
456	LispDestroy("%s: cannot convert %s to Window",
457		    STRFUN(builtin), STROBJ(owindow));
458    window = (Window)(owindow->data.opaque.data);
459
460    XMapWindow(display, window);
461
462    return (owindow);
463}
464
465LispObj *
466Lisp_XDestroyWindow(LispBuiltin *builtin)
467/*
468 x-destroy-window display window
469 */
470{
471    Display *display;
472    Window window;
473
474    LispObj *odisplay, *owindow;
475
476    owindow = ARGUMENT(1);
477    odisplay = ARGUMENT(0);
478
479    if (!CHECKO(odisplay, x11Display_t))
480	LispDestroy("%s: cannot convert %s to Display*",
481		    STRFUN(builtin), STROBJ(odisplay));
482    display = (Display*)(odisplay->data.opaque.data);
483
484    if (!CHECKO(owindow, x11Window_t))
485	LispDestroy("%s: cannot convert %s to Window",
486		    STRFUN(builtin), STROBJ(owindow));
487    window = (Window)(owindow->data.opaque.data);
488
489    XDestroyWindow(display, window);
490
491    return (NIL);
492}
493
494LispObj *
495Lisp_XFlush(LispBuiltin *builtin)
496/*
497 x-flush display
498 */
499{
500    Display *display;
501
502    LispObj *odisplay;
503
504    odisplay = ARGUMENT(0);
505
506    if (!CHECKO(odisplay, x11Display_t))
507	LispDestroy("%s: cannot convert %s to Display*",
508		    STRFUN(builtin), STROBJ(odisplay));
509    display = (Display*)(odisplay->data.opaque.data);
510
511    XFlush(display);
512
513    return (odisplay);
514}
515
516LispObj *
517Lisp_XDrawLine(LispBuiltin *builtin)
518/*
519 x-draw-line display drawable gc x1 y1 x2 y2
520 */
521{
522    Display *display;
523    Drawable drawable;
524    GC gc;
525    int x1, y1, x2, y2;
526
527    LispObj *odisplay, *odrawable, *ogc, *ox1, *oy1, *ox2, *oy2;
528
529    oy2 = ARGUMENT(6);
530    ox2 = ARGUMENT(5);
531    oy1 = ARGUMENT(4);
532    ox1 = ARGUMENT(3);
533    ogc = ARGUMENT(2);
534    odrawable = ARGUMENT(1);
535    odisplay = ARGUMENT(0);
536
537    if (!CHECKO(odisplay, x11Display_t))
538	LispDestroy("%s: cannot convert %s to Display*",
539		    STRFUN(builtin), STROBJ(odisplay));
540    display = (Display*)(odisplay->data.opaque.data);
541
542    /* XXX correct check when drawing to pixmaps implemented */
543    if (!CHECKO(odrawable, x11Window_t))
544	LispDestroy("%s: cannot convert %s to Drawable",
545		    STRFUN(builtin), STROBJ(odrawable));
546    drawable = (Drawable)(odrawable->data.opaque.data);
547
548    if (!CHECKO(ogc, x11GC_t))
549	LispDestroy("%s: cannot convert %s to Display*",
550		    STRFUN(builtin), STROBJ(ogc));
551    gc = (GC)(ogc->data.opaque.data);
552
553    CHECK_FIXNUM(ox1);
554    x1 = FIXNUM_VALUE(ox1);
555
556    CHECK_FIXNUM(oy1);
557    y1 = FIXNUM_VALUE(oy1);
558
559    CHECK_FIXNUM(ox2);
560    x2 = FIXNUM_VALUE(ox2);
561
562    CHECK_FIXNUM(oy2);
563    y2 = FIXNUM_VALUE(oy2);
564
565    XDrawLine(display, drawable, gc, x1, y1, x2, y2);
566
567    return (odrawable);
568}
569
570LispObj *
571Lisp_XBell(LispBuiltin *builtin)
572/*
573 x-bell &optional percent
574 */
575{
576    Display *display;
577    int percent;
578
579    LispObj *odisplay, *opercent;
580
581    opercent = ARGUMENT(1);
582    odisplay = ARGUMENT(0);
583
584    if (!CHECKO(odisplay, x11Display_t))
585	LispDestroy("%s: cannot convert %s to Display*",
586		    STRFUN(builtin), STROBJ(odisplay));
587    display = (Display*)(odisplay->data.opaque.data);
588
589    if (opercent == UNSPEC)
590	percent = 0;
591    else {
592	CHECK_FIXNUM(opercent);
593	percent = FIXNUM_VALUE(opercent);
594    }
595
596    if (percent < -100 || percent > 100)
597	LispDestroy("%s: percent value %d out of range -100 to 100",
598		    STRFUN(builtin), percent);
599
600    XBell(display, percent);
601
602    return (odisplay);
603}
604
605LispObj *
606Lisp_XRaiseWindow(LispBuiltin *builtin)
607/*
608 x-raise-window display window
609 */
610{
611    Display *display;
612    Window window;
613
614    LispObj *odisplay, *owindow;
615
616    owindow = ARGUMENT(1);
617    odisplay = ARGUMENT(0);
618
619    if (!CHECKO(odisplay, x11Display_t))
620	LispDestroy("%s: cannot convert %s to Display*",
621		    STRFUN(builtin), STROBJ(odisplay));
622    display = (Display*)(odisplay->data.opaque.data);
623
624    if (!CHECKO(owindow, x11Window_t))
625	LispDestroy("%s: cannot convert %s to Window",
626		    STRFUN(builtin), STROBJ(owindow));
627    window = (Window)(owindow->data.opaque.data);
628
629    XRaiseWindow(display, window);
630
631    return (owindow);
632}
633
634LispObj *
635Lisp_XWidthOfScreen(LispBuiltin *builtin)
636/*
637 x-width-of-screen screen
638 */
639{
640    LispObj *screen;
641
642    screen = ARGUMENT(0);
643
644    if (!CHECKO(screen, x11Screen_t))
645	LispDestroy("%s: cannot convert %s to Screen*",
646		    STRFUN(builtin), STROBJ(screen));
647
648    return (FIXNUM(WidthOfScreen((Screen*)(screen->data.opaque.data))));
649}
650
651LispObj *
652Lisp_XHeightOfScreen(LispBuiltin *builtin)
653/*
654 x-height-of-screen screen
655 */
656{
657    LispObj *screen;
658
659    screen = ARGUMENT(0);
660
661    if (!CHECKO(screen, x11Screen_t))
662	LispDestroy("%s: cannot convert %s to Screen*",
663		    STRFUN(builtin), STROBJ(screen));
664
665    return (FIXNUM(HeightOfScreen((Screen*)(screen->data.opaque.data))));
666}
667