示例#1
0
文件: x11.c 项目: aosm/X11
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));
}
示例#2
0
文件: x11.c 项目: aosm/X11
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);
}
示例#3
0
文件: x11.c 项目: aosm/X11
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);
}
示例#4
0
文件: xaw.c 项目: aosm/X11
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)));
}
示例#5
0
文件: string.c 项目: 8l/xedit
/* 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);
}
示例#6
0
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);
}
示例#7
0
文件: x11.c 项目: aosm/X11
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);
}
示例#8
0
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);
}
示例#9
0
/* 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);
}
示例#10
0
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);
}
示例#11
0
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);
}
示例#12
0
文件: string.c 项目: 8l/xedit
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);
}
示例#13
0
文件: string.c 项目: 8l/xedit
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);
}
示例#14
0
文件: xaw.c 项目: aosm/X11
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);
}
示例#15
0
文件: string.c 项目: 8l/xedit
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]));
}
示例#16
0
文件: xaw.c 项目: aosm/X11
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);
}
示例#17
0
文件: xaw.c 项目: aosm/X11
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);
}
示例#18
0
文件: xaw.c 项目: aosm/X11
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);
}
示例#19
0
文件: psql.c 项目: aosm/X11
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));
}
示例#20
0
文件: psql.c 项目: aosm/X11
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));
}
示例#21
0
文件: psql.c 项目: aosm/X11
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));
}
示例#22
0
文件: psql.c 项目: aosm/X11
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);
}
示例#23
0
文件: io.c 项目: aosm/X11
/*
 * 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);
}
示例#24
0
/*
 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))));
}
示例#25
0
/*
 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))));
}
示例#26
0
文件: io.c 项目: aosm/X11
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;
}
示例#27
0
文件: string.c 项目: 8l/xedit
/* 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);
}
示例#28
0
文件: package.c 项目: 8l/xedit
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);
}
示例#29
0
文件: io.c 项目: aosm/X11
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;
}
示例#30
0
文件: xaw.c 项目: aosm/X11
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))));
}