LispObj *
Lisp_XRaiseWindow(LispBuiltin *builtin)
/*
x-raise-window display window
*/
{
Display *display;
Window window;
LispObj *odisplay, *owindow;
owindow = 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(owindow, x11Window_t))
LispDestroy("%s: cannot convert %s to Window",
STRFUN(builtin), STROBJ(owindow));
window = (Window)(owindow->data.opaque.data);
XRaiseWindow(display, window);
return (owindow);
}
LispObj *
Lisp_XBell(LispBuiltin *builtin)
/*
x-bell &optional percent
*/
{
Display *display;
int percent;
LispObj *odisplay, *opercent;
opercent = 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 (opercent == UNSPEC)
percent = 0;
else {
CHECK_FIXNUM(opercent);
percent = FIXNUM_VALUE(opercent);
}
if (percent < -100 || percent > 100)
LispDestroy("%s: percent value %d out of range -100 to 100",
STRFUN(builtin), percent);
XBell(display, percent);
return (odisplay);
}
LispObj *
Lisp_XawTextSearch(LispBuiltin *builtin)
/*
xaw-text-search widget direction text
*/
{
Widget widget;
XawTextScanDirection direction;
XawTextBlock block;
LispObj *owidget, *odirection, *otext;
otext = ARGUMENT(2);
odirection = ARGUMENT(1);
owidget = ARGUMENT(0);
if (!CHECKO(owidget, xawWidget_t))
LispDestroy("%s: cannot convert %s to Widget",
STRFUN(builtin), STROBJ(owidget));
widget = (Widget)(owidget->data.opaque.data);
CHECK_INDEX(odirection);
direction = (XawTextPosition)FIXNUM_VALUE(odirection);
if (direction != XawsdLeft && direction != XawsdRight)
LispDestroy("%s: %d does not fit in XawTextScanDirection",
STRFUN(builtin), direction);
CHECK_STRING(otext);
block.firstPos = 0;
block.ptr = THESTR(otext);
block.length = strlen(block.ptr);
block.format = FMT8BIT;
return (FIXNUM(XawTextSearch(widget, direction, &block)));
}
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));
}
/* helper function for setf
* DONT explicitly call. Non standard function
*/
LispObj *
Lisp_XeditCharStore(LispBuiltin *builtin)
/*
xedit::char-store string index value
*/
{
int character;
long offset, length;
LispObj *ostring, *oindex, *ovalue;
ovalue = ARGUMENT(2);
oindex = ARGUMENT(1);
ostring = ARGUMENT(0);
CHECK_STRING(ostring);
CHECK_INDEX(oindex);
length = STRLEN(ostring);
offset = FIXNUM_VALUE(oindex);
if (offset >= length)
LispDestroy("%s: index %ld too large for string length %ld",
STRFUN(builtin), offset, length);
CHECK_SCHAR(ovalue);
CHECK_STRING_WRITABLE(ostring);
character = SCHAR_VALUE(ovalue);
if (character < 0 || character > 255)
LispDestroy("%s: cannot represent character %d",
STRFUN(builtin), character);
THESTR(ostring)[offset] = character;
return (ovalue);
}
LispObj *
Lisp_RenameFile(LispBuiltin *builtin)
/*
rename-file filename new-name
*/
{
int code;
GC_ENTER();
char *from, *to;
LispObj *old_truename, *new_truename;
LispObj *filename, *new_name;
new_name = ARGUMENT(1);
filename = ARGUMENT(0);
if (STRINGP(filename)) {
filename = APPLY1(Oparse_namestring, filename);
GC_PROTECT(filename);
}
else if (STREAMP(filename)) {
if (filename->data.stream.type != LispStreamFile)
LispDestroy("%s: %s is not a FILE-STREAM",
STRFUN(builtin), STROBJ(filename));
filename = filename->data.stream.pathname;
}
else {
CHECK_PATHNAME(filename);
}
old_truename = APPLY1(Otruename, filename);
GC_PROTECT(old_truename);
if (STRINGP(new_name)) {
new_name = APPLY3(Oparse_namestring, new_name, NIL, filename);
GC_PROTECT(new_name);
}
else {
CHECK_PATHNAME(new_name);
}
from = THESTR(CAR(filename->data.pathname));
to = THESTR(CAR(new_name->data.pathname));
code = LispRename(from, to);
if (code)
LispDestroy("%s: rename(%s, %s): %s",
STRFUN(builtin), from, to, strerror(errno));
GC_LEAVE();
new_truename = APPLY1(Otruename, new_name);
RETURN_COUNT = 2;
RETURN(0) = old_truename;
RETURN(1) = new_truename;
return (new_name);
}
LispObj *
Lisp_XDrawLine(LispBuiltin *builtin)
/*
x-draw-line display drawable gc x1 y1 x2 y2
*/
{
Display *display;
Drawable drawable;
GC gc;
int x1, y1, x2, y2;
LispObj *odisplay, *odrawable, *ogc, *ox1, *oy1, *ox2, *oy2;
oy2 = ARGUMENT(6);
ox2 = ARGUMENT(5);
oy1 = ARGUMENT(4);
ox1 = ARGUMENT(3);
ogc = ARGUMENT(2);
odrawable = 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);
/* XXX correct check when drawing to pixmaps implemented */
if (!CHECKO(odrawable, x11Window_t))
LispDestroy("%s: cannot convert %s to Drawable",
STRFUN(builtin), STROBJ(odrawable));
drawable = (Drawable)(odrawable->data.opaque.data);
if (!CHECKO(ogc, x11GC_t))
LispDestroy("%s: cannot convert %s to Display*",
STRFUN(builtin), STROBJ(ogc));
gc = (GC)(ogc->data.opaque.data);
CHECK_FIXNUM(ox1);
x1 = FIXNUM_VALUE(ox1);
CHECK_FIXNUM(oy1);
y1 = FIXNUM_VALUE(oy1);
CHECK_FIXNUM(ox2);
x2 = FIXNUM_VALUE(ox2);
CHECK_FIXNUM(oy2);
y2 = FIXNUM_VALUE(oy2);
XDrawLine(display, drawable, gc, x1, y1, x2, y2);
return (odrawable);
}
LispObj *
Lisp_PQfnumber(LispBuiltin *builtin)
/*
pq-fnumber result field-name
*/
{
int number;
int field;
PGresult *res;
LispObj *result, *field_name;
field_name = ARGUMENT(1);
result = ARGUMENT(0);
if (!CHECKO(result, PGresult_t))
LispDestroy("%s: cannot convert %s to PGresult*",
STRFUN(builtin), STROBJ(result));
res = (PGresult*)(result->data.opaque.data);
CHECK_STRING(field_name);
number = PQfnumber(res, THESTR(field_name));
return (INTEGER(number));
}
LispObj *
Lisp_PQfname(LispBuiltin *builtin)
/*
pq-fname result field-number
*/
{
char *string;
int field;
PGresult *res;
LispObj *result, *field_number;
field_number = ARGUMENT(1);
result = ARGUMENT(0);
if (!CHECKO(result, PGresult_t))
LispDestroy("%s: cannot convert %s to PGresult*",
STRFUN(builtin), STROBJ(result));
res = (PGresult*)(result->data.opaque.data);
CHECK_INDEX(field_number);
field = FIXNUM_VALUE(field_number);
string = PQfname(res, field);
return (string ? STRING(string) : NIL);
}
LispObj *
Lisp_DeleteFile(LispBuiltin *builtin)
/*
delete-file filename
*/
{
GC_ENTER();
LispObj *filename;
filename = ARGUMENT(0);
if (STRINGP(filename)) {
filename = APPLY1(Oparse_namestring, filename);
GC_PROTECT(filename);
}
else if (STREAMP(filename)) {
if (filename->data.stream.type != LispStreamFile)
LispDestroy("%s: %s is not a FILE-STREAM",
STRFUN(builtin), STROBJ(filename));
filename = filename->data.stream.pathname;
}
else {
CHECK_PATHNAME(filename);
}
GC_LEAVE();
return (LispUnlink(THESTR(CAR(filename->data.pathname))) ? NIL : T);
}
LispObj *
Lisp_GetOutputStreamString(LispBuiltin *builtin)
/*
get-output-stream-string string-output-stream
*/
{
int length;
char *string;
LispObj *string_output_stream, *result;
string_output_stream = ARGUMENT(0);
if (!STREAMP(string_output_stream) ||
string_output_stream->data.stream.type != LispStreamString ||
string_output_stream->data.stream.readable ||
!string_output_stream->data.stream.writable)
LispDestroy("%s: %s is not an output string stream",
STRFUN(builtin), STROBJ(string_output_stream));
string = LispGetSstring(SSTREAMP(string_output_stream), &length);
result = LSTRING(string, length);
/* reset string */
SSTREAMP(string_output_stream)->output =
SSTREAMP(string_output_stream)->length =
SSTREAMP(string_output_stream)->column = 0;
return (result);
}
LispObj *
Lisp_Listen(LispBuiltin *builtin)
/*
listen &optional input-stream
*/
{
LispFile *file = NULL;
LispObj *result = NIL;
LispObj *stream;
stream = ARGUMENT(0);
if (stream == UNSPEC)
stream = NIL;
else if (stream != NIL) {
CHECK_STREAM(stream);
}
else
stream = lisp__data.standard_input;
if (stream->data.stream.readable) {
switch (stream->data.stream.type) {
case LispStreamString:
if (SSTREAMP(stream)->input < SSTREAMP(stream)->length)
result = T;
break;
case LispStreamFile:
file = FSTREAMP(stream);
break;
case LispStreamStandard:
file = FSTREAMP(stream);
break;
case LispStreamPipe:
file = IPSTREAMP(stream);
break;
}
if (file != NULL) {
if (file->available || file->offset < file->length)
result = T;
else {
unsigned char c;
if (!file->nonblock) {
if (fcntl(file->descriptor, F_SETFL, O_NONBLOCK) < 0)
LispDestroy("%s: fcntl: %s",
STRFUN(builtin), strerror(errno));
file->nonblock = 1;
}
if (read(file->descriptor, &c, 1) == 1) {
LispFungetc(file, c);
result = T;
}
}
}
}
return (result);
}
LispObj *
Lisp_DigitCharP(LispBuiltin *builtin)
/*
digit-char-p character &optional radix
*/
{
long radix = 10, character;
LispObj *ochar, *oradix, *result = NIL;
oradix = ARGUMENT(1);
ochar = ARGUMENT(0);
CHECK_SCHAR(ochar);
character = SCHAR_VALUE(ochar);
if (oradix != UNSPEC) {
CHECK_INDEX(oradix);
radix = FIXNUM_VALUE(oradix);
}
if (radix < 2 || radix > 36)
LispDestroy("%s: radix must be >= 2 and <= 36, not %ld",
STRFUN(builtin), radix);
if (character >= '0' && character <= '9')
character -= '0';
else if (character >= 'A' && character <= 'Z')
character -= 'A' - 10;
else if (character >= 'a' && character <= 'z')
character -= 'a' - 10;
if (character < radix)
result = FIXNUM(character);
return (result);
}
LispObj *
Lisp_DigitChar(LispBuiltin *builtin)
/*
digit-char weight &optional radix
*/
{
long radix = 10, weight;
LispObj *oweight, *oradix, *result = NIL;
oradix = ARGUMENT(1);
oweight = ARGUMENT(0);
CHECK_FIXNUM(oweight);
weight = FIXNUM_VALUE(oweight);
if (oradix != UNSPEC) {
CHECK_INDEX(oradix);
radix = FIXNUM_VALUE(oradix);
}
if (radix < 2 || radix > 36)
LispDestroy("%s: radix must be >= 2 and <= 36, not %ld",
STRFUN(builtin), radix);
if (weight >= 0 && weight < radix) {
if (weight < 9)
weight += '0';
else
weight += 'A' - 10;
result = SCHAR(weight);
}
return (result);
}
/* Helper function, primarily for use with the xt module
*/
LispObj *
Lisp_PipeBroken(LispBuiltin *builtin)
/*
pipe-broken pipe-stream
*/
{
int pid, status, retval;
LispObj *result = NIL;
LispObj *pipe_stream;
pipe_stream = ARGUMENT(0);
if (!STREAMP(pipe_stream) ||
pipe_stream->data.stream.type != LispStreamPipe)
LispDestroy("%s: %s is not a pipe stream",
STRFUN(builtin), STROBJ(pipe_stream));
if ((pid = PIDPSTREAMP(pipe_stream)) > 0) {
retval = waitpid(pid, &status, WNOHANG | WUNTRACED);
if (retval == pid || (retval == -1 && errno == ECHILD))
result = T;
}
return (result);
}
LispObj *
Lisp_PQgetlength(LispBuiltin *builtin)
/*
pq-getlength result tupple field-number
*/
{
PGresult *res;
int tuple, field, length;
LispObj *result, *otupple, *field_number;
field_number = ARGUMENT(2);
otupple = ARGUMENT(1);
result = ARGUMENT(0);
if (!CHECKO(result, PGresult_t))
LispDestroy("%s: cannot convert %s to PGresult*",
STRFUN(builtin), STROBJ(result));
res = (PGresult*)(result->data.opaque.data);
CHECK_INDEX(otupple);
tuple = FIXNUM_VALUE(otupple);
CHECK_INDEX(field_number);
field = FIXNUM_VALUE(field_number);
length = PQgetlength(res, tuple, field);
return (INTEGER(length));
}
LispObj *
Lisp_PQfsize(LispBuiltin *builtin)
/*
pq-fsize result field-number
*/
{
int size, field;
PGresult *res;
LispObj *result, *field_number;
field_number = ARGUMENT(1);
result = ARGUMENT(0);
if (!CHECKO(result, PGresult_t))
LispDestroy("%s: cannot convert %s to PGresult*",
STRFUN(builtin), STROBJ(result));
res = (PGresult*)(result->data.opaque.data);
CHECK_INDEX(field_number);
field = FIXNUM_VALUE(field_number);
size = PQfsize(res, field);
return (INTEGER(size));
}
LispObj *
Lisp_XawScrollbarSetThumb(LispBuiltin *builtin)
/*
xaw-scrollbar-set-thumb widget top &optional shown
*/
{
Widget widget;
double top, shown;
LispObj *owidget, *otop, *oshown;
oshown = ARGUMENT(2);
otop = ARGUMENT(1);
owidget = ARGUMENT(0);
if (!CHECKO(owidget, xawWidget_t))
LispDestroy("%s: cannot convert %s to Widget",
STRFUN(builtin), STROBJ(owidget));
widget = (Widget)(owidget->data.opaque.data);
CHECK_DFLOAT(otop);
top = DFLOAT_VALUE(otop);
if (oshown == UNSPEC)
shown = 1.0;
else {
CHECK_DFLOAT(oshown);
shown = DFLOAT_VALUE(oshown);
}
XawScrollbarSetThumb(widget, top, shown);
return (oshown == UNSPEC ? DFLOAT(shown) : oshown);
}
LispObj *
Lisp_Char(LispBuiltin *builtin)
/*
char string index
schar simple-string index
*/
{
unsigned char *string;
long offset, length;
LispObj *ostring, *oindex;
oindex = ARGUMENT(1);
ostring = ARGUMENT(0);
CHECK_STRING(ostring);
CHECK_INDEX(oindex);
offset = FIXNUM_VALUE(oindex);
string = (unsigned char*)THESTR(ostring);
length = STRLEN(ostring);
if (offset >= length)
LispDestroy("%s: index %ld too large for string length %ld",
STRFUN(builtin), offset, length);
return (SCHAR(string[offset]));
}
LispObj *
Lisp_XawCoerceToListReturnStruct(LispBuiltin *builtin)
/*
xaw-coerce-to-list-return-struct opaque
*/
{
LispObj *result, *code, *ocod = COD;
XawListReturnStruct *retlist;
LispObj *opaque;
opaque = ARGUMENT(0);
if (!CHECKO(opaque, xawListReturnStruct_t))
LispDestroy("%s: cannot convert %s to XawListReturnStruct",
STRFUN(builtin), STROBJ(opaque));
retlist = (XawListReturnStruct*)(opaque->data.opaque.data);
GCDisable();
code = CONS(ATOM("MAKE-XAW-LIST-RETURN-STRUCT"),
CONS(KEYWORD("STRING"),
CONS(STRING(retlist->string),
CONS(KEYWORD("INDEX"),
CONS(INTEGER(retlist->list_index), NIL)))));
COD = CONS(code, COD);
GCEnable();
result = EVAL(code);
COD = ocod;
return (result);
}
LispObj *
Lisp_XawListHighlight(LispBuiltin *builtin)
/*
xaw-list-highlight widget index
*/
{
Widget widget;
int position;
LispObj *owidget, *oindex;
oindex = ARGUMENT(1);
owidget = ARGUMENT(0);
if (!CHECKO(owidget, xawWidget_t))
LispDestroy("%s: cannot convert %s to Widget",
STRFUN(builtin), STROBJ(owidget));
widget = (Widget)(owidget->data.opaque.data);
CHECK_INDEX(oindex);
position = FIXNUM_VALUE(oindex);
XawListHighlight(widget, position);
return (oindex);
}
LispObj *
Lisp_XawTextSetInsertionPoint(LispBuiltin *builtin)
/*
xaw-text-set-insertion-point widget position
*/
{
Widget widget;
XawTextPosition position;
LispObj *owidget, *oposition;
oposition = ARGUMENT(1);
owidget = ARGUMENT(0);
if (!CHECKO(owidget, xawWidget_t))
LispDestroy("%s: cannot convert %s to Widget",
STRFUN(builtin), STROBJ(owidget));
widget = (Widget)(owidget->data.opaque.data);
CHECK_INDEX(oposition);
position = (XawTextPosition)FIXNUM_VALUE(oposition);
XawTextSetInsertionPoint(widget, position);
return (oposition);
}
/*
Helper function, primarily for use with the xt module
*/
LispObj *
Lisp_PipeInputDescriptor(LispBuiltin *builtin)
/*
pipe-input-descriptor pipe-stream
*/
{
LispObj *pipe_stream;
pipe_stream = ARGUMENT(0);
if (!STREAMP(pipe_stream) ||
pipe_stream->data.stream.type != LispStreamPipe)
LispDestroy("%s: %s is not a pipe stream",
STRFUN(builtin), STROBJ(pipe_stream));
if (!IPSTREAMP(pipe_stream))
LispDestroy("%s: pipe %s is unreadable",
STRFUN(builtin), STROBJ(pipe_stream));
return (INTEGER(LispFileno(IPSTREAMP(pipe_stream))));
}
/*
Helper function, primarily for use with the xt module
*/
LispObj *
Lisp_PipeErrorDescriptor(LispBuiltin *builtin)
/*
pipe-error-descriptor pipe-stream
*/
{
LispObj *pipe_stream;
pipe_stream = ARGUMENT(0);
if (!STREAMP(pipe_stream) ||
pipe_stream->data.stream.type != LispStreamPipe)
LispDestroy("%s: %s is not a pipe stream",
STRFUN(builtin), STROBJ(pipe_stream));
if (!EPSTREAMP(pipe_stream))
LispDestroy("%s: pipe %s is closed",
STRFUN(builtin), STROBJ(pipe_stream));
return (INTEGER(LispFileno(EPSTREAMP(pipe_stream))));
}
/* XXX preserve-whitespace is being ignored */
LispObj *
Lisp_ReadFromString(LispBuiltin *builtin)
/*
read-from-string string &optional eof-error-p eof-value &key start end preserve-whitespace
*/
{
GC_ENTER();
char *string;
LispObj *stream, *result;
long length, start, end, bytes_read;
LispObj *ostring, *eof_error_p, *eof_value, *ostart, *oend;
oend = ARGUMENT(4);
ostart = ARGUMENT(3);
eof_value = ARGUMENT(2);
eof_error_p = ARGUMENT(1);
ostring = ARGUMENT(0);
CHECK_STRING(ostring);
string = THESTR(ostring);
LispCheckSequenceStartEnd(builtin, ostring, ostart, oend,
&start, &end, &length);
if (start > 0 || end < length)
length = end - start;
stream = LSTRINGSTREAM(string + start, STREAM_READ, length);
if (eof_value == UNSPEC)
eof_value = NIL;
LispPushInput(stream);
result = LispRead();
/* stream->data.stream.source.string->input is
* the offset of the last byte read in string */
bytes_read = stream->data.stream.source.string->input;
LispPopInput(stream);
if (result == NULL) {
if (eof_error_p == NIL)
result = eof_value;
else
LispDestroy("%s: unexpected end of input", STRFUN(builtin));
}
GC_PROTECT(result);
RETURN(0) = FIXNUM(start + bytes_read);
RETURN_COUNT = 1;
GC_LEAVE();
return (result);
}
static LispObj *
LispFindPackageOrDie(LispBuiltin *builtin, LispObj *name)
{
LispObj *package;
package = LispFindPackage(name);
if (package == NIL)
LispDestroy("%s: package %s is not available",
STRFUN(builtin), STROBJ(name));
return (package);
}
LispObj *
Lisp_XawTextGetInsertionPoint(LispBuiltin *builtin)
/*
xaw-text-get-insertion-point widget
*/
{
LispObj *owidget;
owidget = ARGUMENT(0);
if (!CHECKO(owidget, xawWidget_t))
LispDestroy("%s: cannot convert %s to Widget",
STRFUN(builtin), STROBJ(owidget));
return (FIXNUM(XawTextGetInsertionPoint((Widget)(owidget->data.opaque.data))));
}
LispObj *
Lisp_XawTextLastPosition(LispBuiltin *builtin)
/*
xaw-text-last-position widget
*/
{
LispObj *owidget;
owidget = ARGUMENT(0);
if (!CHECKO(owidget, xawWidget_t))
LispDestroy("%s: cannot convert %s to Widget",
STRFUN(builtin), STROBJ(owidget));
return (FIXNUM(XawTextLastPosition((Widget)(owidget->data.opaque.data))));
}
LispObj *
Lisp_XHeightOfScreen(LispBuiltin *builtin)
/*
x-height-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 (FIXNUM(HeightOfScreen((Screen*)(screen->data.opaque.data))));
}
LispObj *
Lisp_XWhitePixelOfScreen(LispBuiltin *builtin)
/*
x-white-pixel-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 (INTEGER(WhitePixelOfScreen((Screen*)(screen->data.opaque.data))));
}
