LispObj *
Lisp_XDefaultGC(LispBuiltin *builtin)
/*
x-default-gc display &optional screen
*/
{
Display *display;
int screen;
LispObj *odisplay, *oscreen;
oscreen = ARGUMENT(1);
odisplay = ARGUMENT(0);
if (!CHECKO(odisplay, x11Display_t))
LispDestroy("%s: cannot convert %s to Display*",
STRFUN(builtin), STROBJ(odisplay));
display = (Display*)(odisplay->data.opaque.data);
if (oscreen == UNSPEC)
screen = DefaultScreen(display);
else {
CHECK_FIXNUM(oscreen);
screen = FIXNUM_VALUE(oscreen);
}
if (screen >= ScreenCount(display))
LispDestroy("%s: screen index %d too large, %d screens available",
STRFUN(builtin), screen, ScreenCount(display));
return (OPAQUE(DefaultGC(display, screen), x11GC_t));
}
LispObj *
Lisp_XawTextGetSource(LispBuiltin *builtin)
/*
xaw-text-get-source widget
*/
{
LispObj *owidget;
owidget = ARGUMENT(0);
if (!CHECKO(owidget, xawWidget_t))
LispDestroy("%s: cannot convert %s to Widget",
STRFUN(builtin), STROBJ(owidget));
return (OPAQUE(XawTextGetSource((Widget)(owidget->data.opaque.data)),
xawWidget_t));
}
LispObj *
Lisp_XDefaultGCOfScreen(LispBuiltin *builtin)
/*
x-default-gc-of-screen screen
*/
{
LispObj *screen;
screen = ARGUMENT(0);
if (!CHECKO(screen, x11Screen_t))
LispDestroy("%s: cannot convert %s to Screen*",
STRFUN(builtin), STROBJ(screen));
return (OPAQUE(DefaultGCOfScreen((Screen*)(screen->data.opaque.data)),
x11GC_t));
}
LispObj *
Lisp_XDefaultRootWindow(LispBuiltin *builtin)
/*
x-default-root-window display
*/
{
LispObj *display;
display = ARGUMENT(0);
if (!CHECKO(display, x11Display_t))
LispDestroy("%s: cannot convert %s to Display*",
STRFUN(builtin), STROBJ(display));
return (OPAQUE(DefaultRootWindow((Display*)(display->data.opaque.data)),
x11Window_t));
}
LispObj *
Lisp_XDefaultScreenOfDisplay(LispBuiltin *builtin)
/*
x-default-screen-of-display display
*/
{
LispObj *display;
display = ARGUMENT(0);
if (!CHECKO(display, x11Display_t))
LispDestroy("%s: cannot convert %s to Display*",
STRFUN(builtin), STROBJ(display));
return (OPAQUE(DefaultScreenOfDisplay((Display*)(display->data.opaque.data)),
x11Screen_t));
}
LispObj *
Lisp_XOpenDisplay(LispBuiltin *builtin)
/*
x-open-display &optional display-name
*/
{
LispObj *display_name;
char *dname;
display_name = ARGUMENT(0);
if (display_name == UNSPEC)
dname = NULL;
else {
CHECK_STRING(display_name);
dname = THESTR(display_name);
}
return (OPAQUE(XOpenDisplay(dname), x11Display_t));
}
LispObj *
Lisp_PQexec(LispBuiltin *builtin)
/*
pq-exec connection query
*/
{
PGconn *conn;
PGresult *res;
LispObj *connection, *query;
query = ARGUMENT(1);
connection = ARGUMENT(0);
if (!CHECKO(connection, PGconn_t))
LispDestroy("%s: cannot convert %s to PGconn*",
STRFUN(builtin), STROBJ(connection));
conn = (PGconn*)(connection->data.opaque.data);
CHECK_STRING(query);
res = PQexec(conn, THESTR(query));
return (res ? OPAQUE(res, PGresult_t) : NIL);
}
/*
* Implementation
*/
int
xawLoadModule(void)
{
int i;
char *fname = "XAW-LOAD-MODULE";
xawWidget_t = LispRegisterOpaqueType("Widget");
xawWidgetClass_t = LispRegisterOpaqueType("WidgetClass");
xawListReturnStruct_t = LispRegisterOpaqueType("XawListReturnStruct");
xawFloatp_t = LispRegisterOpaqueType("float*");
LispExecute("(DEFSTRUCT XAW-LIST-RETURN-STRUCT STRING INDEX)\n");
GCDisable();
(void)LispSetVariable(ATOM2("ASCII-SINK-OBJECT-CLASS"),
OPAQUE(asciiSinkObjectClass, xawWidgetClass_t),
fname, 0);
(void)LispSetVariable(ATOM2("ASCII-SRC-OBJECT-CLASS"),
OPAQUE(asciiSinkObjectClass, xawWidgetClass_t),
fname, 0);
(void)LispSetVariable(ATOM2("ASCII-TEXT-WIDGET-CLASS"),
OPAQUE(asciiTextWidgetClass, xawWidgetClass_t),
fname, 0);
(void)LispSetVariable(ATOM2("BOX-WIDGET-CLASS"),
OPAQUE(boxWidgetClass, xawWidgetClass_t),
fname, 0);
(void)LispSetVariable(ATOM2("COMMAND-WIDGET-CLASS"),
OPAQUE(commandWidgetClass, xawWidgetClass_t),
fname, 0);
(void)LispSetVariable(ATOM2("DIALOG-WIDGET-CLASS"),
OPAQUE(dialogWidgetClass, xawWidgetClass_t),
fname, 0);
(void)LispSetVariable(ATOM2("FORM-WIDGET-CLASS"),
OPAQUE(formWidgetClass, xawWidgetClass_t),
fname, 0);
(void)LispSetVariable(ATOM2("GRIP-WIDGET-CLASS"),
OPAQUE(gripWidgetClass, xawWidgetClass_t),
fname, 0);
(void)LispSetVariable(ATOM2("LABEL-WIDGET-CLASS"),
OPAQUE(labelWidgetClass, xawWidgetClass_t),
fname, 0);
(void)LispSetVariable(ATOM2("LIST-WIDGET-CLASS"),
OPAQUE(listWidgetClass, xawWidgetClass_t),
fname, 0);
(void)LispSetVariable(ATOM2("MENU-BUTTON-WIDGET-CLASS"),
OPAQUE(menuButtonWidgetClass, xawWidgetClass_t),
fname, 0);
(void)LispSetVariable(ATOM2("MULTI-SINK-OBJEC-TCLASS"),
OPAQUE(multiSinkObjectClass, xawWidgetClass_t),
fname, 0);
(void)LispSetVariable(ATOM2("MULTI-SRC-OBJECT-CLASS"),
OPAQUE(multiSrcObjectClass, xawWidgetClass_t),
fname, 0);
(void)LispSetVariable(ATOM2("PANED-WIDGET-CLASS"),
OPAQUE(panedWidgetClass, xawWidgetClass_t),
fname, 0);
(void)LispSetVariable(ATOM2("PANNER-WIDGET-CLASS"),
OPAQUE(pannerWidgetClass, xawWidgetClass_t),
fname, 0);
(void)LispSetVariable(ATOM2("PORTHOLE-WIDGET-CLASS"),
OPAQUE(portholeWidgetClass, xawWidgetClass_t),
fname, 0);
(void)LispSetVariable(ATOM2("REPEATER-WIDGET-CLASS"),
OPAQUE(repeaterWidgetClass, xawWidgetClass_t),
fname, 0);
(void)LispSetVariable(ATOM2("SCROLLBAR-WIDGET-CLASS"),
OPAQUE(scrollbarWidgetClass, xawWidgetClass_t),
fname, 0);
(void)LispSetVariable(ATOM2("SIMPLE-MENU-WIDGET-CLASS"),
OPAQUE(simpleMenuWidgetClass, xawWidgetClass_t),
fname, 0);
(void)LispSetVariable(ATOM2("SIMPLE-WIDGET-CLASS"),
OPAQUE(simpleWidgetClass, xawWidgetClass_t),
fname, 0);
(void)LispSetVariable(ATOM2("SME-BSB-OBJECT-CLASS"),
OPAQUE(smeBSBObjectClass, xawWidgetClass_t),
fname, 0);
(void)LispSetVariable(ATOM2("SME-LINE-OBJECT-CLASS"),
OPAQUE(smeLineObjectClass, xawWidgetClass_t),
fname, 0);
(void)LispSetVariable(ATOM2("SME-OBJECT-CLASS"),
OPAQUE(smeObjectClass, xawWidgetClass_t),
fname, 0);
(void)LispSetVariable(ATOM2("STRIP-CHART-WIDGET-CLASS"),
OPAQUE(stripChartWidgetClass, xawWidgetClass_t),
fname, 0);
(void)LispSetVariable(ATOM2("TEXT-WIDGET-CLASS"),
OPAQUE(textWidgetClass, xawWidgetClass_t),
fname, 0);
(void)LispSetVariable(ATOM2("TEXT-SINKOBJECT-CLASS"),
OPAQUE(textSinkObjectClass, xawWidgetClass_t),
fname, 0);
(void)LispSetVariable(ATOM2("TEXT-SRC-OBJECT-CLASS"),
OPAQUE(textSrcObjectClass, xawWidgetClass_t),
fname, 0);
(void)LispSetVariable(ATOM2("TIP-WIDGET-CLASS"),
OPAQUE(tipWidgetClass, xawWidgetClass_t),
fname, 0);
(void)LispSetVariable(ATOM2("TOGGLE-WIDGET-CLASS"),
OPAQUE(toggleWidgetClass, xawWidgetClass_t),
fname, 0);
(void)LispSetVariable(ATOM2("TREE-WIDGET-CLASS"),
OPAQUE(treeWidgetClass, xawWidgetClass_t),
fname, 0);
(void)LispSetVariable(ATOM2("VIEWPORT-WIDGET-CLASS"),
OPAQUE(viewportWidgetClass, xawWidgetClass_t),
fname, 0);
(void)LispSetVariable(ATOM2("VENDOR-SHELL-WIDGET-CLASS"),
OPAQUE(vendorShellWidgetClass, xawWidgetClass_t),
fname, 0);
/* return codes of XawTextReplace */
(void)LispSetVariable(ATOM2("XAW-REPLACE-ERROR"),
INTEGER(XawReplaceError), fname, 0);
(void)LispSetVariable(ATOM2("XAW-EDIT-DONE"),
INTEGER(XawEditDone), fname, 0);
(void)LispSetVariable(ATOM2("XAW-EDIT-ERROR"),
INTEGER(XawEditError), fname, 0);
(void)LispSetVariable(ATOM2("XAW-POSITION-ERROR"),
INTEGER(XawPositionError), fname, 0);
/* return code of XawTextSearch */
(void)LispSetVariable(ATOM2("XAW-TEXT-SEARCH-ERROR"),
INTEGER(XawTextSearchError), fname, 0);
/* enum XawTextScanDirection */
(void)LispSetVariable(ATOM2("XAWSD-LEFT"),
INTEGER(XawsdLeft), fname, 0);
(void)LispSetVariable(ATOM2("XAWSD-RIGHT"),
INTEGER(XawsdRight), fname, 0);
GCEnable();
for (i = 0; i < sizeof(lispbuiltins) / sizeof(lispbuiltins[0]); i++)
LispAddBuiltinFunction(&lispbuiltins[i]);
return (1);
}
LispObj *
Lisp_XCreateSimpleWindow(LispBuiltin *builtin)
/*
x-create-simple-window display parent x y width height &optional border-width border background
*/
{
Display *display;
Window parent;
int x, y;
unsigned int width, height, border_width;
unsigned long border, background;
LispObj *odisplay, *oparent, *ox, *oy, *owidth, *oheight,
*oborder_width, *oborder, *obackground;
obackground = ARGUMENT(8);
oborder = ARGUMENT(7);
oborder_width = ARGUMENT(6);
oheight = ARGUMENT(5);
owidth = ARGUMENT(4);
oy = ARGUMENT(3);
ox = ARGUMENT(2);
oparent = ARGUMENT(1);
odisplay = ARGUMENT(0);
if (!CHECKO(odisplay, x11Display_t))
LispDestroy("%s: cannot convert %s to Display*",
STRFUN(builtin), STROBJ(odisplay));
display = (Display*)(odisplay->data.opaque.data);
if (!CHECKO(oparent, x11Window_t))
LispDestroy("%s: cannot convert %s to Window",
STRFUN(builtin), STROBJ(oparent));
parent = (Window)(oparent->data.opaque.data);
CHECK_FIXNUM(ox);
x = FIXNUM_VALUE(ox);
CHECK_FIXNUM(oy);
y = FIXNUM_VALUE(oy);
CHECK_INDEX(owidth);
width = FIXNUM_VALUE(owidth);
CHECK_INDEX(oheight);
height = FIXNUM_VALUE(oheight);
/* check &OPTIONAL parameters */
if (oborder_width == UNSPEC)
border_width = 1;
else {
CHECK_INDEX(oborder_width);
border_width = FIXNUM_VALUE(oborder_width);
}
if (oborder == UNSPEC)
border = BlackPixel(display, DefaultScreen(display));
else {
CHECK_LONGINT(oborder);
border = LONGINT_VALUE(oborder);
}
if (obackground == UNSPEC)
background = WhitePixel(display, DefaultScreen(display));
else {
CHECK_LONGINT(obackground);
background = LONGINT_VALUE(obackground);
}
return (OPAQUE(
XCreateSimpleWindow(display, parent, x, y, width, height,
border_width, border, background),
x11Window_t));
}
#define OPAQUE(r,g,b) (0xff<<24 |((r)<<16) | ((g)<<8) | (b))
#define TR__80(r,g,b) (0xcc<<24 |((r)<<16) | ((g)<<8) | (b)) /// TR 80%
#define TR__90(r,g,b) (0xe6<<24 |((r)<<16) | ((g)<<8) | (b)) /// TR 90%
#define TR__95(r,g,b) (0xf2<<24 |((r)<<16) | ((g)<<8) | (b)) /// TR 95%
#define TRANSPARENT 0x00000000
/////////////////////////////////////////////////////////////////////////////
// System Palette Table for RGB Mode
//
XmSTATIC XmPALETTE amMenuPalette[XmCOLOR_MAX] = {
TRANSPARENT, /* 0 */
TR__80(0x1f,0x1f,0x1f), /* 1 */
TR__90(0x3b,0x3b,0x3b), /* 2 */
OPAQUE(0x4a,0x4a,0x4a), /* 3 */
OPAQUE(0x4c,0x4c,0x4c), /* 4 */
OPAQUE(0x00,0xff,0x00), /* 5 */
OPAQUE(0x00,0xff,0x00), /* 6 */
OPAQUE(0x00,0xff,0x00), /* 7 */
OPAQUE(0x1f,0x1f,0x1f), /* 8 */
OPAQUE(0x1f,0x1f,0x1f), /* 9 */
OPAQUE(0x1f,0x1f,0x1f), /* 10 */
OPAQUE(0x1f,0x1f,0x1f), /* 11 */
OPAQUE(0x1f,0x1f,0x1f), /* 12 */
OPAQUE(0x1f,0x1f,0x1f), /* 13 */
OPAQUE(0x1f,0x1f,0x1f), /* 14 */
OPAQUE(0x1f,0x1f,0x1f), /* 15 */
OPAQUE(0xb0,0xb0,0xb0), /* 16 */
TR__95(0x72,0x8c,0xaa), /* 17 */
TR__95(0x15,0x29,0x69), /* 18 */
LispObj *
LispPQsetdb(LispBuiltin *builtin, int loginp)
/*
pq-setdb host port options tty dbname
pq-setdb-login host port options tty dbname login password
*/
{
PGconn *conn;
char *host, *port, *options, *tty, *dbname, *login, *password;
LispObj *ohost, *oport, *ooptions, *otty, *odbname, *ologin, *opassword;
if (loginp) {
opassword = ARGUMENT(6);
ologin = ARGUMENT(5);
}
else
opassword = ologin = NIL;
odbname = ARGUMENT(4);
otty = ARGUMENT(3);
ooptions = ARGUMENT(2);
oport = ARGUMENT(1);
ohost = ARGUMENT(0);
if (ohost != NIL) {
CHECK_STRING(ohost);
host = THESTR(ohost);
}
else
host = NULL;
if (oport != NIL) {
CHECK_STRING(oport);
port = THESTR(oport);
}
else
port = NULL;
if (ooptions != NIL) {
CHECK_STRING(ooptions);
options = THESTR(ooptions);
}
else
options = NULL;
if (otty != NIL) {
CHECK_STRING(otty);
tty = THESTR(otty);
}
else
tty = NULL;
if (odbname != NIL) {
CHECK_STRING(odbname);
dbname = THESTR(odbname);
}
else
dbname = NULL;
if (ologin != NIL) {
CHECK_STRING(ologin);
login = THESTR(ologin);
}
else
login = NULL;
if (opassword != NIL) {
CHECK_STRING(opassword);
password = THESTR(opassword);
}
else
password = NULL;
conn = PQsetdbLogin(host, port, options, tty, dbname, login, password);
return (conn ? OPAQUE(conn, PGconn_t) : NIL);
}
void
simtk_container_clear_all (struct simtk_container *cont)
{
if (cont->background_dirty)
{
if (cont->background != NULL)
draw_to_display (cont->disp, cont->background, 0, 0, 0xff);
else
fbox (cont->disp, cont->x, cont->y, cont->x + cont->width - 1, cont->y + cont->height - 1, OPAQUE (0));
cont->background_dirty = 0;
}
}
