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_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))); }
/* 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_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); }
/* 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_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); }
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_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); }
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_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_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); }
/* * Implementation */ int LispGet(void) { int ch = EOF; LispUngetInfo *unget = lisp__data.unget[lisp__data.iunget]; if (unget->offset) ch = ((unsigned char*)unget->buffer)[--unget->offset]; else if (SINPUT->data.stream.readable) { LispFile *file = NULL; switch (SINPUT->data.stream.type) { case LispStreamStandard: case LispStreamFile: file = FSTREAMP(SINPUT); break; case LispStreamPipe: file = IPSTREAMP(SINPUT); break; case LispStreamString: ch = LispSgetc(SSTREAMP(SINPUT)); break; default: ch = EOF; break; } if (file != NULL) { if (file->nonblock) { if (fcntl(file->descriptor, F_SETFL, 0) < 0) LispDestroy("fcntl: %s", strerror(errno)); file->nonblock = 0; } ch = LispFgetc(file); } } else LispDestroy("cannot read from *STANDARD-INPUT*"); if (ch == EOF) lisp__data.eof = 1; return (ch); }
/* 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)))); }
void LispPopInput(LispObj *stream) { if (!CONSP(lisp__data.input_list) || stream != CAR(lisp__data.input_list)) LispDestroy("bad stream at POP-INPUT"); lisp__data.input_list = CDR(lisp__data.input_list); SINPUT = CONSP(lisp__data.input_list) ? CAR(lisp__data.input_list) : lisp__data.input_list; --lisp__data.iunget; lisp__data.eof = 0; }
/* 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); }
void LispPushInput(LispObj *stream) { if (!STREAMP(stream) || !stream->data.stream.readable) LispDestroy("bad stream at PUSH-INPUT"); lisp__data.input_list = CONS(stream, lisp__data.input_list); SINPUT = stream; if (lisp__data.iunget + 1 == lisp__data.nunget) { LispUngetInfo **info = realloc(lisp__data.unget, sizeof(LispUngetInfo) * (lisp__data.nunget + 1)); if (!info || (info[lisp__data.nunget] = calloc(1, sizeof(LispUngetInfo))) == NULL) LispDestroy("out of memory"); lisp__data.unget = info; ++lisp__data.nunget; } ++lisp__data.iunget; memset(lisp__data.unget[lisp__data.iunget], '\0', sizeof(LispUngetInfo)); lisp__data.eof = 0; }
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)))); }